From 7063d1b1c912c73df642c0db7ff52ddb63cb228f Mon Sep 17 00:00:00 2001 From: admin_d Date: Sat, 12 Sep 2026 16:50:30 +0500 Subject: [PATCH] sync: restore source from Google Drive --- MANIFEST.sha256 | 38 + README.md | 219 + RUN_ME_FIRST.txt | 31 + config/toolchain.lock.json | 7 + dist/20260908T161945Z-3f43e1f3/apks.json | 4 + dist/20260908T164542Z-0843e132/apks.json | 4 + dist/LATEST.json | 5 + docs/COVERAGE.md | 39 + docs/FIRST_SERVER_RUN_DIAGNOSIS.md | 8 + docs/SOURCES.md | 27 + docs/TROUBLESHOOTING.md | 45 + reports/LATEST-SUMMARY.md | 42 + reports/LATEST.json | 6 + reports/preparation/VALIDATION.md | 27 + .../preparation/actual-preflight-SUMMARY.md | 42 + .../preparation/actual-preflight-result.json | 275 + .../actual-preflight-toolchain.json | 23 + reports/preparation/android-preflight.log | 6 + reports/preparation/environment.json | 22 + reports/preparation/harness-tests.log | 108 + reports/preparation/manifest-validation.json | 92 + .../docker-command.json | 28 + .../runs/20260908T164542Z-0843e132/SUMMARY.md | 42 + .../20260908T164542Z-0843e132/adb-version.log | 5 + .../castle-version.log | 2 + .../core_streams/CastleEngineManifest.xml | 88 + .../core_streams/ProbeImports.pas | 31 + .../core_streams/compile-link.log | 19 + .../core_streams/target.json | 92 + .../core_types/CastleEngineManifest.xml | 88 + .../core_types/ProbeImports.pas | 20 + .../core_types/compile-link.log | 19 + .../core_types/target.json | 92 + .../20260908T164542Z-0843e132/evidence.zip | Bin 0 -> 256870 bytes .../20260908T164542Z-0843e132/fpc-version.log | 2 + .../integration/CastleEngineManifest.xml | 88 + .../integration/ProbeImports.pas | 31 + .../integration/compile-link.log | 19 + .../integration/target.json | 100 + .../java-version.log | 4 + .../legacy_audio/CastleEngineManifest.xml | 88 + .../legacy_audio/ProbeImports.pas | 12 + .../legacy_audio/compile-link.log | 12 + .../legacy_audio/target.json | 91 + .../legacy_render/CastleEngineManifest.xml | 88 + .../legacy_render/ProbeImports.pas | 12 + .../legacy_render/compile-link.log | 12 + .../legacy_render/target.json | 91 + .../mission_info/CastleEngineManifest.xml | 88 + .../mission_info/ProbeImports.pas | 12 + .../mission_info/compile-link.log | 19 + .../mission_info/target.json | 91 + .../mission_tokens/CastleEngineManifest.xml | 88 + .../mission_tokens/ProbeImports.pas | 12 + .../mission_tokens/compile-link.log | 15 + .../mission_tokens/target.json | 91 + .../mission_world/CastleEngineManifest.xml | 88 + .../mission_world/ProbeImports.pas | 12 + .../mission_world/compile-link.log | 19 + .../mission_world/target.json | 91 + .../platform/CastleEngineManifest.xml | 18 + .../platform/ProbeImports.pas | 12 + .../platform/compile-link.log | 15 + .../platform/target.json | 18 + .../result-in-progress.json | 1852 + .../20260908T164542Z-0843e132/result.json | 1853 + .../script_vm/CastleEngineManifest.xml | 88 + .../script_vm/ProbeImports.pas | 12 + .../script_vm/compile-link.log | 14 + .../script_vm/target.json | 92 + .../scripting/CastleEngineManifest.xml | 88 + .../scripting/ProbeImports.pas | 12 + .../scripting/compile-link.log | 65 + .../scripting/target.json | 91 + .../simulation/CastleEngineManifest.xml | 88 + .../simulation/ProbeImports.pas | 12 + .../simulation/compile-link.log | 19 + .../simulation/target.json | 91 + .../source-inventory.json | 66063 ++++++++++++++++ .../source-receipt.json | 8089 ++ .../sprite_loader/CastleEngineManifest.xml | 88 + .../sprite_loader/ProbeImports.pas | 12 + .../sprite_loader/compile-link.log | 12 + .../sprite_loader/target.json | 91 + .../terrain_io/CastleEngineManifest.xml | 88 + .../terrain_io/ProbeImports.pas | 12 + .../terrain_io/compile-link.log | 19 + .../terrain_io/target.json | 91 + .../CastleEngineManifest.xml | 88 + .../terrain_pathfinding/ProbeImports.pas | 12 + .../terrain_pathfinding/compile-link.log | 12 + .../terrain_pathfinding/target.json | 91 + .../20260908T164542Z-0843e132/toolchain.json | 59 + vendor/README.md | 17 + vendor/kam_remake/Installer/License.bel.txt | 8 + vendor/kam_remake/Installer/License.bul.txt | 7 + vendor/kam_remake/Installer/License.chn.txt | 7 + vendor/kam_remake/Installer/License.cze.txt | 8 + vendor/kam_remake/Installer/License.dut.txt | 8 + vendor/kam_remake/Installer/License.eng.txt | 7 + vendor/kam_remake/Installer/License.est.txt | 7 + vendor/kam_remake/Installer/License.fin.txt | 7 + vendor/kam_remake/Installer/License.fre.txt | 8 + vendor/kam_remake/Installer/License.ger.txt | 8 + vendor/kam_remake/Installer/License.hun.txt | 10 + vendor/kam_remake/Installer/License.ita.txt | 7 + vendor/kam_remake/Installer/License.jpn.txt | 7 + vendor/kam_remake/Installer/License.kor.txt | 7 + vendor/kam_remake/Installer/License.nor.txt | 7 + vendor/kam_remake/Installer/License.pol.txt | 8 + vendor/kam_remake/Installer/License.ptb.txt | 8 + vendor/kam_remake/Installer/License.rom.txt | 7 + vendor/kam_remake/Installer/License.rus.txt | 7 + vendor/kam_remake/Installer/License.slv.txt | 7 + vendor/kam_remake/Installer/License.spa.txt | 7 + vendor/kam_remake/Installer/License.srb.txt | 7 + vendor/kam_remake/Installer/License.svk.txt | 7 + vendor/kam_remake/Installer/License.swe.txt | 8 + vendor/kam_remake/Installer/License.tur.txt | 5 + vendor/kam_remake/Installer/License.ukr.txt | 7 + vendor/kam_remake/KM_NetProtocolRevision.inc | 1 + vendor/kam_remake/KM_Revision.inc | 1 + vendor/kam_remake/KM_TextIDs.inc | 1677 + vendor/kam_remake/KaM_Remake.inc | 87 + vendor/kam_remake/LICENSE.txt | 661 + vendor/kam_remake/SOURCE_RECEIPT.json | 8089 ++ vendor/kam_remake/Utils/RVO2/LICENSE.txt | 13 + vendor/kam_remake/src/KM_Console.pas | 351 + vendor/kam_remake/src/KM_Crashreport.pas | 189 + vendor/kam_remake/src/KM_Exceptions.pas | 189 + vendor/kam_remake/src/KM_GameApp.pas | 1462 + vendor/kam_remake/src/KM_Log.pas | 614 + vendor/kam_remake/src/KM_Main.pas | 959 + vendor/kam_remake/src/KM_Projectiles.pas | 489 + vendor/kam_remake/src/KM_System.pas | 244 + vendor/kam_remake/src/ai/KM_AI.pas | 702 + .../kam_remake/src/ai/KM_AIArmyEvaluation.pas | 351 + vendor/kam_remake/src/ai/KM_AIAttacks.pas | 210 + vendor/kam_remake/src/ai/KM_AICityPlanner.pas | 606 + vendor/kam_remake/src/ai/KM_AIDefensePos.pas | 525 + vendor/kam_remake/src/ai/KM_AIFields.pas | 162 + vendor/kam_remake/src/ai/KM_AIGeneral.pas | 813 + vendor/kam_remake/src/ai/KM_AIGoals.pas | 252 + vendor/kam_remake/src/ai/KM_AIInfluences.pas | 860 + vendor/kam_remake/src/ai/KM_AIMayor.pas | 1053 + .../kam_remake/src/ai/KM_AIMayorBalance.pas | 1077 + vendor/kam_remake/src/ai/KM_AISetup.pas | 214 + vendor/kam_remake/src/ai/KM_AITypes.pas | 47 + .../src/ai/newAI/KM_AIParameters.pas | 762 + .../kam_remake/src/ai/newAI/KM_ArmyAttack.pas | 1784 + .../src/ai/newAI/KM_ArmyAttackNew.pas | 921 + .../src/ai/newAI/KM_ArmyDefence.pas | 597 + .../src/ai/newAI/KM_ArmyManagement.pas | 586 + .../src/ai/newAI/KM_CityBuilder.pas | 2391 + .../src/ai/newAI/KM_CityManagement.pas | 1131 + .../src/ai/newAI/KM_CityPlanner.pas | 3605 + .../src/ai/newAI/KM_CityPredictor.pas | 911 + vendor/kam_remake/src/ai/newAI/KM_Eye.pas | 1977 + .../kam_remake/src/ai/newAI/KM_Supervisor.pas | 1518 + .../src/common/KM_CommonClasses.pas | 1894 + .../src/common/KM_CommonClassesExt.pas | 443 + .../src/common/KM_CommonExceptions.pas | 29 + .../src/common/KM_CommonGameTypes.pas | 10 + .../kam_remake/src/common/KM_CommonTypes.pas | 337 + vendor/kam_remake/src/common/KM_Defaults.pas | 1130 + vendor/kam_remake/src/common/KM_Entity.pas | 87 + vendor/kam_remake/src/common/KM_Lists.pas | 198 + vendor/kam_remake/src/common/KM_Points.pas | 1291 + .../kam_remake/src/common/KM_WorkerThread.pas | 301 + .../src/common/KM_WorkerThreadUtils.pas | 116 + .../kam_remake/src/controls/KM_Controls.pas | 2138 + .../src/controls/KM_ControlsBase.pas | 848 + .../src/controls/KM_ControlsChart.pas | 519 + .../src/controls/KM_ControlsColor.pas | 152 + .../src/controls/KM_ControlsDragger.pas | 109 + .../src/controls/KM_ControlsDrop.pas | 792 + .../src/controls/KM_ControlsEdit.pas | 1050 + .../src/controls/KM_ControlsForm.pas | 350 + .../src/controls/KM_ControlsList.pas | 2093 + .../src/controls/KM_ControlsMemo.pas | 783 + .../src/controls/KM_ControlsMinimapView.pas | 339 + .../src/controls/KM_ControlsPopUp.pas | 176 + .../src/controls/KM_ControlsProgressBar.pas | 350 + .../src/controls/KM_ControlsScroll.pas | 823 + .../src/controls/KM_ControlsSwitch.pas | 455 + .../src/controls/KM_ControlsTrackBar.pas | 266 + .../src/controls/KM_ControlsTypes.pas | 23 + .../src/controls/KM_ControlsUtils.pas | 62 + .../src/controls/KM_ControlsWaresRow.pas | 309 + .../src/ext/BGRABitmap/basiccolorspace.inc | 1635 + .../kam_remake/src/ext/BGRABitmap/bezier.inc | 1463 + .../src/ext/BGRABitmap/bgraanimatedgif.pas | 1225 + .../src/ext/BGRABitmap/bgraarrow.pas | 527 + .../src/ext/BGRABitmap/bgrabitmap.inc | 34 + .../src/ext/BGRABitmap/bgrabitmap.pas | 508 + .../src/ext/BGRABitmap/bgrabitmappack.pas | 36 + .../ext/BGRABitmap/bgrabitmappack4fpgui.pas | 30 + .../ext/BGRABitmap/bgrabitmappack4nogui.pas | 31 + .../src/ext/BGRABitmap/bgrabitmaptypes.pas | 1533 + .../src/ext/BGRABitmap/bgrablend.pas | 1974 + .../src/ext/BGRABitmap/bgrablurgl.pas | 200 + .../src/ext/BGRABitmap/bgracanvas.pas | 1909 + .../src/ext/BGRABitmap/bgracanvas2d.pas | 2851 + .../src/ext/BGRABitmap/bgracanvasgl.pas | 1840 + .../src/ext/BGRABitmap/bgraclasses.pas | 251 + .../src/ext/BGRABitmap/bgracolorint.pas | 363 + .../ext/BGRABitmap/bgracolorquantization.pas | 2037 + .../ext/BGRABitmap/bgracompressablebitmap.pas | 317 + .../src/ext/BGRABitmap/bgracoordpool3d.pas | 435 + .../src/ext/BGRABitmap/bgracustombitmap.inc | 1859 + .../src/ext/BGRABitmap/bgracustomtextfx.pas | 600 + .../src/ext/BGRABitmap/bgradefaultbitmap.pas | 4639 ++ .../src/ext/BGRABitmap/bgradithering.pas | 761 + .../src/ext/BGRABitmap/bgradnetdeserial.pas | 1522 + .../src/ext/BGRABitmap/bgrafillinfo.pas | 1758 + .../src/ext/BGRABitmap/bgrafilterblur.pas | 1146 + .../src/ext/BGRABitmap/bgrafilters.pas | 962 + .../src/ext/BGRABitmap/bgrafilterscanner.pas | 788 + .../src/ext/BGRABitmap/bgrafiltertype.pas | 464 + .../src/ext/BGRABitmap/bgrafontgl.pas | 694 + .../src/ext/BGRABitmap/bgrafpcanvas.inc | 286 + .../src/ext/BGRABitmap/bgrafpgui.inc | 78 + .../src/ext/BGRABitmap/bgrafpgui_uses.inc | 1 + .../src/ext/BGRABitmap/bgrafpguibitmap.pas | 268 + .../src/ext/BGRABitmap/bgrafreetype.pas | 1606 + .../src/ext/BGRABitmap/bgragifformat.pas | 1219 + .../ext/BGRABitmap/bgragradientoriginal.pas | 945 + .../src/ext/BGRABitmap/bgragradients.pas | 1215 + .../ext/BGRABitmap/bgragradientscanner.pas | 2192 + .../src/ext/BGRABitmap/bgragraphics.pas | 724 + .../src/ext/BGRABitmap/bgragrayscalemask.pas | 1450 + .../src/ext/BGRABitmap/bgragtkbitmap.pas | 339 + .../src/ext/BGRABitmap/bgraiconcursor.pas | 865 + .../src/ext/BGRABitmap/bgralayeroriginal.pas | 2252 + .../src/ext/BGRABitmap/bgralayers.pas | 3617 + .../src/ext/BGRABitmap/bgralazpaint.pas | 264 + .../src/ext/BGRABitmap/bgralazresource.pas | 416 + .../src/ext/BGRABitmap/bgralclbitmap.pas | 997 + .../src/ext/BGRABitmap/bgralzpcommon.pas | 643 + .../src/ext/BGRABitmap/bgramacbitmap.pas | 84 + .../src/ext/BGRABitmap/bgramatrix3d.pas | 900 + .../src/ext/BGRABitmap/bgramemdirectory.pas | 697 + .../src/ext/BGRABitmap/bgramsegui.inc | 349 + .../src/ext/BGRABitmap/bgramsegui_text.inc | 80 + .../src/ext/BGRABitmap/bgramsegui_uses.inc | 1 + .../src/ext/BGRABitmap/bgramseguibitmap.pas | 255 + .../src/ext/BGRABitmap/bgramultifiletype.pas | 500 + .../src/ext/BGRABitmap/bgranogui.inc | 80 + .../src/ext/BGRABitmap/bgranogui_uses.inc | 1 + .../src/ext/BGRABitmap/bgranoguibitmap.pas | 163 + .../src/ext/BGRABitmap/bgraopengl.pas | 2006 + .../src/ext/BGRABitmap/bgraopengl3d.pas | 1017 + .../src/ext/BGRABitmap/bgraopengltype.pas | 1753 + .../src/ext/BGRABitmap/bgraopenraster.pas | 1139 + .../src/ext/BGRABitmap/bgrapaintnet.pas | 660 + .../src/ext/BGRABitmap/bgrapalette.pas | 1408 + .../src/ext/BGRABitmap/bgrapath.pas | 3118 + .../kam_remake/src/ext/BGRABitmap/bgrapen.pas | 1324 + .../src/ext/BGRABitmap/bgraphongtypes.pas | 85 + .../src/ext/BGRABitmap/bgraphoxo.pas | 602 + .../src/ext/BGRABitmap/bgrapixel.inc | 744 + .../src/ext/BGRABitmap/bgrapolygon.pas | 1585 + .../src/ext/BGRABitmap/bgrapolygonaliased.pas | 982 + .../src/ext/BGRABitmap/bgraqtbitmap.pas | 158 + .../src/ext/BGRABitmap/bgrareadbmp.pas | 1112 + .../src/ext/BGRABitmap/bgrareadbmpmiomap.pas | 260 + .../src/ext/BGRABitmap/bgrareadgif.pas | 381 + .../src/ext/BGRABitmap/bgrareadico.pas | 149 + .../src/ext/BGRABitmap/bgrareadjpeg.pas | 63 + .../src/ext/BGRABitmap/bgrareadlzp.pas | 377 + .../src/ext/BGRABitmap/bgrareadpcx.pas | 228 + .../src/ext/BGRABitmap/bgrareadpng.pas | 1452 + .../src/ext/BGRABitmap/bgrareadpsd.pas | 620 + .../src/ext/BGRABitmap/bgrareadtga.pas | 192 + .../src/ext/BGRABitmap/bgrareadtiff.pas | 2863 + .../src/ext/BGRABitmap/bgrareadwebp.pas | 151 + .../src/ext/BGRABitmap/bgrareadxpm.pas | 91 + .../src/ext/BGRABitmap/bgrarenderer3d.pas | 842 + .../src/ext/BGRABitmap/bgraresample.pas | 1532 + .../src/ext/BGRABitmap/bgrascanner.inc | 266 + .../src/ext/BGRABitmap/bgrascene3d.pas | 1643 + .../src/ext/BGRABitmap/bgrascenetypes.pas | 1199 + .../src/ext/BGRABitmap/bgraslicescaling.pas | 778 + .../src/ext/BGRABitmap/bgraspritegl.pas | 586 + .../kam_remake/src/ext/BGRABitmap/bgrasse.inc | 28 + .../kam_remake/src/ext/BGRABitmap/bgrasse.pas | 656 + .../src/ext/BGRABitmap/bgrastreamlayers.pas | 393 + .../kam_remake/src/ext/BGRABitmap/bgrasvg.pas | 1330 + .../src/ext/BGRABitmap/bgrasvgoriginal.pas | 702 + .../src/ext/BGRABitmap/bgrasvgshapes.pas | 4748 ++ .../src/ext/BGRABitmap/bgrasvgtype.pas | 2468 + .../src/ext/BGRABitmap/bgratext.pas | 1870 + .../src/ext/BGRABitmap/bgratextbidi.pas | 3487 + .../src/ext/BGRABitmap/bgratextfx.pas | 902 + .../src/ext/BGRABitmap/bgrathumbnail.pas | 520 + .../src/ext/BGRABitmap/bgratransform.pas | 2051 + .../src/ext/BGRABitmap/bgratypewriter.pas | 1293 + .../src/ext/BGRABitmap/bgraunicode.pas | 1301 + .../src/ext/BGRABitmap/bgraunicodetext.pas | 960 + .../src/ext/BGRABitmap/bgraunits.pas | 572 + .../src/ext/BGRABitmap/bgrautf8.pas | 1509 + .../src/ext/BGRABitmap/bgravectorize.pas | 2405 + .../src/ext/BGRABitmap/bgrawinbitmap.pas | 263 + .../src/ext/BGRABitmap/bgrawinresource.pas | 1165 + .../src/ext/BGRABitmap/bgrawritebmpmiomap.pas | 390 + .../src/ext/BGRABitmap/bgrawritelzp.pas | 430 + .../src/ext/BGRABitmap/bgrawritepng.pas | 965 + .../src/ext/BGRABitmap/bgrawritetiff.pas | 1023 + .../src/ext/BGRABitmap/bgrawritewebp.pas | 119 + .../src/ext/BGRABitmap/blendpixelinline.inc | 1312 + .../src/ext/BGRABitmap/blendpixels.inc | 497 + .../src/ext/BGRABitmap/blendpixelsover.inc | 1154 + .../kam_remake/src/ext/BGRABitmap/blurbox.inc | 464 + .../src/ext/BGRABitmap/blurfast.inc | 233 + .../src/ext/BGRABitmap/blurnormal.inc | 253 + .../src/ext/BGRABitmap/csscolorconst.inc | 888 + .../src/ext/BGRABitmap/density256.inc | 98 + .../src/ext/BGRABitmap/expandedbitmap.pas | 762 + .../src/ext/BGRABitmap/extendedcolorspace.inc | 1454 + .../kam_remake/src/ext/BGRABitmap/face3d.inc | 505 + .../ext/BGRABitmap/generatedcolorspace.inc | 7103 ++ .../src/ext/BGRABitmap/generatedunicode.inc | 1209 + .../src/ext/BGRABitmap/generatedutf8.inc | 1231 + .../src/ext/BGRABitmap/geometrytypes.inc | 1686 + .../kam_remake/src/ext/BGRABitmap/libwebp.pas | 649 + .../src/ext/BGRABitmap/lightingclasses3d.inc | 174 + .../src/ext/BGRABitmap/linearrgbabitmap.pas | 616 + .../src/ext/BGRABitmap/lineartexscan.inc | 114 + .../src/ext/BGRABitmap/lineartexscan2.inc | 54 + .../src/ext/BGRABitmap/linuxlib.pas | 114 + .../src/ext/BGRABitmap/multishapeline.inc | 65 + .../src/ext/BGRABitmap/object3d.inc | 310 + .../src/ext/BGRABitmap/paletteformats.inc | 643 + .../kam_remake/src/ext/BGRABitmap/part3d.inc | 581 + .../ext/BGRABitmap/perspectivecolorscan.inc | 104 + .../src/ext/BGRABitmap/perspectivescan.inc | 168 + .../src/ext/BGRABitmap/perspectivescan2.inc | 205 + .../src/ext/BGRABitmap/phongdraw.inc | 289 + .../src/ext/BGRABitmap/phongdrawsse.inc | 164 + .../src/ext/BGRABitmap/phonglight.inc | 62 + .../src/ext/BGRABitmap/phonglightsse.inc | 105 + .../src/ext/BGRABitmap/polyaliaspersp.inc | 605 + .../src/ext/BGRABitmap/shapes3d.inc | 79 + .../src/ext/BGRABitmap/spectraldata.inc | 197 + .../src/ext/BGRABitmap/unibitmap.inc | 3995 + .../src/ext/BGRABitmap/unibitmapgeneric.inc | 1141 + .../src/ext/BGRABitmap/universaldrawer.pas | 1177 + .../src/ext/BGRABitmap/unzipperext.pas | 129 + .../src/ext/BGRABitmap/uunittest.pas | 47 + .../src/ext/BGRABitmap/vertex3d.inc | 457 + .../src/ext/BGRABitmap/wordxyzabitmap.pas | 777 + .../src/ext/BGRABitmap/xyzabitmap.pas | 673 + vendor/kam_remake/src/ext/BinaryHeapStub.pas | 81 + vendor/kam_remake/src/ext/Delaunay.pas | 399 + vendor/kam_remake/src/ext/FastMM4.pas | 12979 +++ .../src/ext/FastMM4DataCollector.pas | 401 + .../src/ext/FastMM4LockFreeStack.pas | 352 + vendor/kam_remake/src/ext/FastMM4Messages.pas | 158 + vendor/kam_remake/src/ext/FastMM4Options.inc | 438 + vendor/kam_remake/src/ext/FastMM5.pas | 10355 +++ .../kam_remake/src/ext/FastMMUsageTracker.pas | 1186 + vendor/kam_remake/src/ext/JsonDataObjects.pas | 8391 ++ vendor/kam_remake/src/ext/KromIOUtils.pas | 54 + vendor/kam_remake/src/ext/LNet/LICENSE | 481 + vendor/kam_remake/src/ext/LNet/lcommon.pp | 536 + vendor/kam_remake/src/ext/LNet/levents.pp | 624 + vendor/kam_remake/src/ext/LNet/lhttp.pp | 2312 + vendor/kam_remake/src/ext/LNet/lhttputil.pp | 260 + vendor/kam_remake/src/ext/LNet/lnet.pp | 1721 + vendor/kam_remake/src/ext/LNet/lnetssl.pp | 637 + vendor/kam_remake/src/ext/LNet/lstrbuffer.pp | 91 + vendor/kam_remake/src/ext/LNet/lws2tcpip.pp | 70 + vendor/kam_remake/src/ext/LNet/openssl.pas | 1569 + .../src/ext/LNet/sys/lepolleventer.inc | 219 + .../src/ext/LNet/sys/lepolleventerh.inc | 32 + .../src/ext/LNet/sys/lkqueueeventer.inc | 147 + .../src/ext/LNet/sys/lkqueueeventerh.inc | 25 + .../src/ext/LNet/sys/lspawnfcgiunix.inc | 51 + .../src/ext/LNet/sys/lspawnfcgiwin.inc | 7 + .../kam_remake/src/ext/LNet/sys/osunits.inc | 18 + .../ext/LazarusOpenGL/glcarbonaglcontext.pas | 312 + .../src/ext/LazarusOpenGL/glgtkglxcontext.pas | 835 + .../src/ext/LazarusOpenGL/glqtcontext.pas | 255 + .../ext/LazarusOpenGL/glwin32wglcontext.pas | 462 + .../src/ext/LazarusOpenGL/openglcontext.pas | 487 + vendor/kam_remake/src/ext/OBJLoader.pas | 258 + vendor/kam_remake/src/ext/OggVorbis/Codec.pas | 251 + .../kam_remake/src/ext/OggVorbis/OSTypes.pas | 81 + vendor/kam_remake/src/ext/OggVorbis/Ogg.pas | 208 + .../src/ext/OggVorbis/VorbisFile.pas | 251 + .../Source/Extras/OverbyteIcsConApp.pas | 466 + .../Source/Extras/OverbyteIcsLibrary.pas | 1251 + .../Source/Extras/OverbyteIcsPop3ProtOld.pas | 2759 + .../Source/Extras/OverbyteIcsWinsock2.pas | 371 + .../Source/Ics.Fmx.OverByteIcsWSocketE.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsBlacklist.pas | 4 + .../Ics.Fmx.OverbyteIcsCharsetComboBox.pas | 237 + .../Source/Ics.Fmx.OverbyteIcsDnsQuery.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsFileCopy.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsFingCli.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsFtpCli.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsFtpMulti.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsFtpSrv.pas | 5 + .../Ics.Fmx.OverbyteIcsHttpAppServer.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsHttpMulti.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsHttpProt.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsHttpSrv.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsIcmp.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsMailQueue.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas | 5 + ....Fmx.OverbyteIcsMultipartFtpDownloader.pas | 5 + ...Fmx.OverbyteIcsMultipartHttpDownloader.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsNntpCli.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsPing.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsPop3Prot.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsProxy.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsReg.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsSmtpProt.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsSntp.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsSocketUtils.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsSslJose.pas | 4 + .../Ics.Fmx.OverbyteIcsSslSessionCache.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas | 5 + .../Ics.Fmx.OverbyteIcsSslX509Certs.pas | 5 + .../Ics.Fmx.OverbyteIcsSslX509Utils.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsThreadTimer.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsWSocket.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsWSocketS.pas | 5 + .../Source/Ics.Fmx.OverbyteIcsWhoisCli.pas | 4 + .../Source/Ics.Fmx.OverbyteIcsWndControl.pas | 5 + .../Source/Ics.Posix.KEventApi.pas | 60 + .../Source/Ics.Posix.KEventTypes.pas | 375 + .../Source/Ics.Posix.Messages.pas | 2111 + .../Source/Ics.Posix.WinTypes.pas | 82 + .../Source/Ics.Vcl.OverbyteIcsReg.pas | 5 + .../Source/Include/Ics.InterlockedApi.inc | 53 + .../Source/Include/OverbyteIcsDefs.inc | 1852 + .../Include/OverbyteIcsDotNetSockImpl.inc | 90 + .../Include/OverbyteIcsDotNetSockTypes.inc | 368 + .../Source/Include/OverbyteIcsSslDefs.inc | 43 + .../Source/Include/OverbyteIcsWinsockImpl.inc | 1946 + .../Include/OverbyteIcsWinsockTypes.inc | 1778 + .../Source/Include/OverbyteIcsZlib.inc | 6 + .../Source/Include/OverbyteVclZip.inc | 4 + .../Source/OverByteIcsFtpSrvT.pas | 746 + .../Source/OverByteIcsFtpSrvWT.pas | 835 + .../Source/OverByteIcsWSocketE.pas | 165 + .../Source/OverbyteIcsAsn1Utils.pas | 580 + .../Source/OverbyteIcsAvlTrees.pas | 2159 + .../Source/OverbyteIcsBlacklist.pas | 1468 + .../Overbyte ICS 8/Source/OverbyteIcsCRC.pas | 590 + .../Source/OverbyteIcsCharsetComboBox.pas | 376 + .../Source/OverbyteIcsCharsetUtils.pas | 1864 + .../Source/OverbyteIcsCookies.pas | 684 + .../Source/OverbyteIcsCryptUiApi.pas | 1278 + .../Overbyte ICS 8/Source/OverbyteIcsCsc.pas | 1963 + .../Overbyte ICS 8/Source/OverbyteIcsDES.pas | 336 + .../Source/OverbyteIcsDigestAuth.pas | 787 + .../Source/OverbyteIcsDnsQuery.pas | 1521 + .../Source/OverbyteIcsDprUpdFix.pas | 466 + .../Source/OverbyteIcsEmulVT.pas | 4597 ++ .../Source/OverbyteIcsFileCopy.pas | 3177 + .../Source/OverbyteIcsFileCopyW.pas | 2983 + .../Source/OverbyteIcsFingCli.pas | 253 + .../Source/OverbyteIcsFormDataDecoder.pas | 1640 + .../Source/OverbyteIcsFtpCli.pas | 7455 ++ .../Source/OverbyteIcsFtpCliW.pas | 7264 ++ .../Source/OverbyteIcsFtpMulti.pas | 5880 ++ .../Source/OverbyteIcsFtpMultiW.pas | 5935 ++ .../Source/OverbyteIcsFtpSrv.pas | 9113 +++ .../Source/OverbyteIcsFtpSrvW.pas | 8818 +++ .../Source/OverbyteIcsHtmlPars.pas | 981 + .../Source/OverbyteIcsHttpAppServer.pas | 2065 + .../Source/OverbyteIcsHttpCCodZLib.pas | 120 + .../Source/OverbyteIcsHttpContCod.pas | 671 + .../Source/OverbyteIcsHttpMulti.pas | 1508 + .../Source/OverbyteIcsHttpMultiW.pas | 1511 + .../Source/OverbyteIcsHttpProt.pas | 5377 ++ .../Source/OverbyteIcsHttpSrv.pas | 7315 ++ .../Overbyte ICS 8/Source/OverbyteIcsIcmp.pas | 977 + .../Source/OverbyteIcsIconv.pas | 146 + .../Source/OverbyteIcsIniFiles.pas | 593 + .../Source/OverbyteIcsIpStreamLog.pas | 3043 + .../Source/OverbyteIcsJwaWinCrypt.inc | 19752 +++++ .../Source/OverbyteIcsLIBEAY.pas | 4375 + .../Source/OverbyteIcsLibeayEx.pas | 492 + .../Source/OverbyteIcsLogger.pas | 507 + .../Overbyte ICS 8/Source/OverbyteIcsMD4.pas | 420 + .../Overbyte ICS 8/Source/OverbyteIcsMD5.pas | 1093 + .../Source/OverbyteIcsMLang.pas | 218 + .../Source/OverbyteIcsMailQueue.pas | 2281 + .../Source/OverbyteIcsMimeDec.pas | 2658 + .../Source/OverbyteIcsMimeUtils.pas | 3025 + .../Source/OverbyteIcsMsSslUtils.pas | 687 + .../Source/OverbyteIcsMultiProgressBar.pas | 216 + .../OverbyteIcsMultipartFtpDownloader.pas | 1090 + .../OverbyteIcsMultipartHttpDownloader.pas | 874 + .../Source/OverbyteIcsNntpCli.pas | 2054 + .../Source/OverbyteIcsNtlmMsgs.pas | 1174 + .../Source/OverbyteIcsNtlmSsp.pas | 867 + .../Source/OverbyteIcsOneTimePw.pas | 796 + .../Overbyte ICS 8/Source/OverbyteIcsPing.pas | 759 + .../Source/OverbyteIcsPop3Prot.pas | 2990 + .../Source/OverbyteIcsProxy.pas | 4599 ++ .../Overbyte ICS 8/Source/OverbyteIcsReg.pas | 400 + .../Source/OverbyteIcsSSLEAY.pas | 3058 + .../Overbyte ICS 8/Source/OverbyteIcsSha1.pas | 639 + .../Source/OverbyteIcsSmtpProt.pas | 5860 ++ .../Source/OverbyteIcsSmtpSrv.pas | 3006 + .../Source/OverbyteIcsSnmpCli.pas | 561 + .../Source/OverbyteIcsSnmpMsgs.pas | 1068 + .../Overbyte ICS 8/Source/OverbyteIcsSntp.pas | 1019 + .../Source/OverbyteIcsSocketUtils.pas | 577 + .../Source/OverbyteIcsSslHttpRest.pas | 3260 + .../Source/OverbyteIcsSslJose.pas | 1033 + .../Source/OverbyteIcsSslSessionCache.pas | 808 + .../Source/OverbyteIcsSslThrdLock.pas | 363 + .../Source/OverbyteIcsSslX509Certs.pas | 8153 ++ .../Source/OverbyteIcsSslX509Utils.pas | 4256 + .../Overbyte ICS 8/Source/OverbyteIcsSspi.pas | 646 + .../Source/OverbyteIcsStreams.pas | 2966 + .../Source/OverbyteIcsSuperObject.pas | 6600 ++ .../Source/OverbyteIcsSuperXMLParser.pas | 1616 + .../Source/OverbyteIcsSysLogClient.pas | 268 + .../Source/OverbyteIcsSysLogDefs.pas | 124 + .../Source/OverbyteIcsSysLogServer.pas | 784 + .../Source/OverbyteIcsThreadTimer.pas | 639 + .../Source/OverbyteIcsTicks64.pas | 452 + .../Source/OverbyteIcsTimeList.pas | 415 + .../Source/OverbyteIcsTnCnx.pas | 810 + .../Source/OverbyteIcsTnEmulVT.pas | 947 + .../Source/OverbyteIcsTnOptFrm.pas | 597 + .../Source/OverbyteIcsTnScript.pas | 653 + .../Source/OverbyteIcsTypes.pas | 132 + .../Overbyte ICS 8/Source/OverbyteIcsUrl.pas | 498 + .../Source/OverbyteIcsUtils.pas | 7615 ++ .../Source/OverbyteIcsWSockBuf.pas | 654 + .../Source/OverbyteIcsWSocket.pas | 25378 ++++++ .../Source/OverbyteIcsWSocketS.pas | 4145 + .../Source/OverbyteIcsWSocketTS.pas | 943 + .../Source/OverbyteIcsWebSession.pas | 1179 + .../Source/OverbyteIcsWebSockets.pas | 1646 + .../Source/OverbyteIcsWhoisCli.pas | 728 + .../Source/OverbyteIcsWinCrypt.pas | 86 + .../Source/OverbyteIcsWinnls.pas | 99 + .../Source/OverbyteIcsWinsock.pas | 89 + .../Overbyte ICS 8/Source/OverbyteIcsWmi.pas | 1321 + .../Source/OverbyteIcsWndControl.pas | 1504 + .../Source/OverbyteIcsZLibDll.pas | 1085 + .../Source/OverbyteIcsZLibObj.pas | 683 + .../Source/OverbyteIcsZlibHigh.pas | 468 + .../Source/WbemScripting_TLB.pas | 4624 ++ vendor/kam_remake/src/ext/PolyTriangulate.pas | 289 + vendor/kam_remake/src/ext/SciZipFile.pas | 518 + vendor/kam_remake/src/ext/URLUtils.pas | 244 + vendor/kam_remake/src/ext/Unit_Vector.pas | 197 + vendor/kam_remake/src/ext/VerySimpleXML.pas | 619 + .../Source/VirtualTrees.Accessibility.pas | 797 + .../VirtualTrees.AccessibilityFactory.pas | 178 + .../Source/VirtualTrees.Actions.pas | 327 + .../Source/VirtualTrees.Classes.pas | 213 + .../Source/VirtualTrees.ClipBoard.pas | 407 + .../Source/VirtualTrees.Export.pas | 1139 + .../Source/VirtualTrees.HeaderPopup.pas | 273 + .../Source/VirtualTrees.StyleHooks.pas | 972 + .../Source/VirtualTrees.Utils.pas | 1379 + .../Source/VirtualTrees.WorkerThread.pas | 235 + .../Virtual-TreeView/Source/VirtualTrees.pas | 35133 ++++++++ vendor/kam_remake/src/ext/Xml.VerySimple.pas | 1748 + vendor/kam_remake/src/ext/Zippit.pas | 137 + vendor/kam_remake/src/ext/bass.pas | 886 + vendor/kam_remake/src/ext/dglOpenGL.pas | 17859 +++++ .../src/ext/iaWin.NameDelphiThreads.pas | 77 + vendor/kam_remake/src/ext/libZPlay.pas | 2110 + vendor/kam_remake/src/ext/openal.pas | 2304 + .../DataAbstract/DataAbstract_Scripting.pas | 23 + .../DataAbstract_Scripting_Reg.pas | 29 + .../DataAbstract/uDAPSScriptingProvider.pas | 230 + .../Addon/DataAbstract/uDAPascalScript.pas | 2119 + .../RemObjects SDK/PascalScript_RO_Reg.pas | 32 + .../Addon/RemObjects SDK/uROPSImports.pas | 560 + .../Addon/RemObjects SDK/uROPSServerLink.pas | 1345 + .../src/ext/pascalscript_submodule/LICENSE.md | 18 + .../Samples/Debug/dlgConfirmReplace.pas | 107 + .../Samples/Debug/dlgReplaceText.pas | 121 + .../Samples/Debug/dlgSearchText.pas | 216 + .../Samples/Debug/ide_debugoutput.pas | 33 + .../Samples/Debug/ide_editor.pas | 649 + .../Samples/Debug/uFrmGotoLine.pas | 79 + .../Samples/IDE/dlgConfirmReplace.pas | 107 + .../Samples/IDE/dlgReplaceText.pas | 121 + .../Samples/IDE/dlgSearchText.pas | 216 + .../Samples/IDE/ide_debugoutput.pas | 33 + .../Samples/IDE/ide_editor.pas | 649 + .../Samples/IDE/uFrmGotoLine.pas | 79 + .../Samples/Import/fDwin.pas | 27 + .../Samples/Import/fMain.pas | 473 + .../Samples/Kylix/fDwin.pas | 27 + .../Samples/Kylix/fMain.pas | 330 + .../Samples/RemObjects SDK Client/fMain.pas | 174 + .../Samples/TestApp/fMain.pas | 153 + .../Source/InvokeCall.inc | 214 + .../pascalscript_submodule/Source/PS_KMR.inc | 5 + .../Source/PascalScript.inc | 75 + .../Source/PascalScriptFPC.inc | 29 + .../Source/PascalScript_Core_Ext_Reg.pas | 30 + .../Source/PascalScript_Core_Reg.pas | 61 + .../Source/PascalScript_Core_Reg_noDB.pas | 48 + .../Source/ThirdParty/uPSI_Dialogs.pas | 1320 + .../Source/ThirdParty/uPSI_IBX.pas | 3891 + .../Source/ThirdParty/uPSI_JvMail.pas | 647 + .../Source/ThirdParty/uPSI_Mask.pas | 244 + .../Source/ThirdParty/uPSI_Registry.pas | 681 + .../Source/ThirdParty/uPS_ExtReg.pas | 17 + .../ext/pascalscript_submodule/Source/arm.inc | 400 + .../Source/eDefines.inc | 672 + .../Source/pascalscript.pas | 29 + .../pascalscript_submodule/Source/powerpc.inc | 412 + .../pascalscript_submodule/Source/uPSC_DB.pas | 902 + .../Source/uPSC_buttons.pas | 99 + .../Source/uPSC_classes.pas | 360 + .../Source/uPSC_comobj.pas | 53 + .../Source/uPSC_controls.pas | 265 + .../Source/uPSC_dateutils.pas | 34 + .../Source/uPSC_dll.pas | 158 + .../Source/uPSC_extctrls.pas | 416 + .../Source/uPSC_forms.pas | 291 + .../Source/uPSC_graphics.pas | 285 + .../Source/uPSC_menus.pas | 214 + .../Source/uPSC_std.pas | 87 + .../Source/uPSC_stdctrls.pas | 693 + .../Source/uPSCompiler.pas | 16028 ++++ .../Source/uPSComponent.pas | 1572 + .../Source/uPSComponentExt.pas | 1010 + .../Source/uPSComponent_COM.pas | 38 + .../Source/uPSComponent_Controls.pas | 65 + .../Source/uPSComponent_DB.pas | 36 + .../Source/uPSComponent_Default.pas | 81 + .../Source/uPSComponent_Forms.pas | 65 + .../Source/uPSComponent_StdCtrls.pas | 65 + .../Source/uPSDebugger.pas | 731 + .../Source/uPSDisassembly.pas | 507 + .../Source/uPSPreProcessor.pas | 803 + .../pascalscript_submodule/Source/uPSR_DB.pas | 4628 ++ .../Source/uPSR_buttons.pas | 38 + .../Source/uPSR_classes.pas | 1133 + .../Source/uPSR_comobj.pas | 118 + .../Source/uPSR_controls.pas | 531 + .../Source/uPSR_dateutils.pas | 63 + .../Source/uPSR_dll.pas | 320 + .../Source/uPSR_extctrls.pas | 275 + .../Source/uPSR_forms.pas | 589 + .../Source/uPSR_graphics.pas | 539 + .../Source/uPSR_menus.pas | 981 + .../Source/uPSR_std.pas | 124 + .../Source/uPSR_stdctrls.pas | 518 + .../Source/uPSRuntime.pas | 13303 ++++ .../Source/uPSUtils.pas | 1734 + .../ext/pascalscript_submodule/Source/x64.inc | 791 + .../ext/pascalscript_submodule/Source/x86.inc | 784 + .../dunit/CompileTestExtended.pas | 146 + .../dunit/CompilerTestBase.pas | 141 + .../dunit/CompilerTestFunctions.pas | 217 + .../dunit/CompilerTestSimple.pas | 282 + .../unit-importing/FormSettings.pas | 47 + .../unit-importing/Import/Extendedreg.pas | 18 + .../unit-importing/Import/IFSIR_Dialogs.pas | 420 + .../unit-importing/Import/IFSI_BigIni.pas | 490 + .../unit-importing/Import/IFSI_Dialogs.pas | 812 + .../Import/IFSI_IBCustomDataSet.pas | 496 + .../unit-importing/Import/IFSI_IBDatabase.pas | 704 + .../unit-importing/Import/IFSI_IBQuery.pas | 225 + .../unit-importing/Import/IFSI_IBSQL.pas | 1043 + .../unit-importing/Import/IFSI_IBTable.pas | 302 + .../unit-importing/Import/IFSI_IBX.pas | 2210 + .../unit-importing/Import/IFSI_IBXreg.pas | 18 + .../unit-importing/Import/IFSI_IniFiles.pas | 248 + .../unit-importing/Import/IFSI_JvMail.pas | 424 + .../unit-importing/Import/IFSI_Registry.pas | 529 + .../unit-importing/Main.pas | 699 + .../unit-importing/ParserU.pas | 2551 + .../unit-importing/ParserUtils.pas | 173 + .../unit-importing/UFrmGotoLine.pas | 79 + .../unit-importing/bigini.pas | 1454 + .../kam_remake/src/forms/KM_FormLoading.pas | 67 + .../kam_remake/src/forms/KM_FormLogistics.pas | 858 + vendor/kam_remake/src/forms/KM_FormMain.pas | 2256 + .../kam_remake/src/forms/KM_VCLMenuHint.pas | 102 + vendor/kam_remake/src/forms/KM_VclHelpers.pas | 90 + vendor/kam_remake/src/game/KM_FogOfWar.pas | 634 + vendor/kam_remake/src/game/KM_Game.pas | 3406 + vendor/kam_remake/src/game/KM_GameClasses.pas | 138 + vendor/kam_remake/src/game/KM_GameInfo.pas | 331 + vendor/kam_remake/src/game/KM_GameOptions.pas | 80 + vendor/kam_remake/src/game/KM_GameParams.pas | 364 + .../kam_remake/src/game/KM_GameSavePoints.pas | 490 + vendor/kam_remake/src/game/KM_GameTypes.pas | 57 + .../src/game/gip/KM_GameInputProcess.pas | 2086 + .../game/gip/KM_GameInputProcess_Multi.pas | 517 + .../game/gip/KM_GameInputProcess_Single.pas | 108 + .../src/game/misc/KM_GameUIDTracker.pas | 66 + .../src/game/misc/KM_RandomChecks.pas | 592 + .../src/game/notifications/KM_Alerts.pas | 430 + .../src/game/notifications/KM_MessageLog.pas | 188 + .../game/notifications/KM_MessageStack.pas | 168 + vendor/kam_remake/src/gui/KM_Cursor.pas | 116 + .../src/gui/KM_InterfaceDefaults.pas | 754 + .../kam_remake/src/gui/KM_InterfaceGame.pas | 707 + .../src/gui/KM_InterfaceGamePlay.pas | 4941 ++ .../src/gui/KM_InterfaceMainMenu.pas | 481 + .../src/gui/KM_InterfaceMapEditor.pas | 1723 + .../kam_remake/src/gui/KM_InterfaceTypes.pas | 57 + vendor/kam_remake/src/gui/KM_Viewport.pas | 534 + .../pages_common/KM_GUICommonGameOptions.pas | 114 + .../src/gui/pages_common/KM_GUICommonKeys.pas | 260 + .../gui/pages_common/KM_GUICommonOptions.pas | 959 + .../src/gui/pages_game/KM_GUIGameBuild.pas | 223 + .../src/gui/pages_game/KM_GUIGameChat.pas | 455 + .../src/gui/pages_game/KM_GUIGameHouse.pas | 1704 + .../src/gui/pages_game/KM_GUIGameRatios.pas | 220 + .../gui/pages_game/KM_GUIGameResultsMP.pas | 2014 + .../gui/pages_game/KM_GUIGameResultsSP.pas | 549 + .../gui/pages_game/KM_GUIGameSpectator.pas | 648 + .../KM_GUIGameSpectatorItemLines.pas | 641 + .../src/gui/pages_game/KM_GUIGameStats.pas | 292 + .../src/gui/pages_game/KM_GUIGameUnit.pas | 652 + .../src/gui/pages_maped/KM_GUIMapEdExtras.pas | 210 + .../src/gui/pages_maped/KM_GUIMapEdHouse.pas | 794 + .../pages_maped/KM_GUIMapEdMarkerDefence.pas | 183 + .../pages_maped/KM_GUIMapEdMarkerReveal.pas | 124 + .../gui/pages_maped/KM_GUIMapEdMessage.pas | 89 + .../src/gui/pages_maped/KM_GUIMapEdUnit.pas | 462 + .../gui/pages_maped/menu/KM_GUIMapEdMenu.pas | 211 + .../pages_maped/menu/KM_GUIMapEdMenuLoad.pas | 213 + .../menu/KM_GUIMapEdMenuQuickPlay.pas | 356 + .../pages_maped/menu/KM_GUIMapEdMenuQuit.pas | 78 + .../menu/KM_GUIMapEdMenuResize.pas | 270 + .../pages_maped/menu/KM_GUIMapEdMenuSave.pas | 149 + .../mission/KM_GUIMapEdMission.pas | 175 + .../mission/KM_GUIMapEdMissionAlliances.pas | 170 + .../mission/KM_GUIMapEdMissionMode.pas | 446 + .../mission/KM_GUIMapEdMissionPlayers.pas | 475 + .../pages_maped/player/KM_GUIMapEdPlayer.pas | 231 + .../player/KM_GUIMapEdPlayerBlockHouse.pas | 122 + .../player/KM_GUIMapEdPlayerBlockTrade.pas | 107 + .../player/KM_GUIMapEdPlayerBlockUnit.pas | 229 + .../player/KM_GUIMapEdPlayerColors.pas | 230 + .../player/KM_GUIMapEdPlayerGoalPopUp.pas | 192 + .../player/KM_GUIMapEdPlayerGoals.pas | 196 + .../player/KM_GUIMapEdPlayerView.pas | 146 + .../pages_maped/terrain/KM_GUIMapEdRMG.pas | 824 + .../terrain/KM_GUIMapEdTerrain.pas | 291 + .../terrain/KM_GUIMapEdTerrainBrushes.pas | 444 + .../terrain/KM_GUIMapEdTerrainHeights.pas | 277 + .../terrain/KM_GUIMapEdTerrainObjects.pas | 930 + .../terrain/KM_GUIMapEdTerrainOverlays.pas | 139 + .../terrain/KM_GUIMapEdTerrainSelection.pas | 292 + .../terrain/KM_GUIMapEdTerrainTiles.pas | 534 + .../gui/pages_maped/town/KM_GUIMapEdTown.pas | 270 + .../town/KM_GUIMapEdTownAttackPopUp.pas | 270 + .../town/KM_GUIMapEdTownDefence.pas | 282 + .../town/KM_GUIMapEdTownFormationsPopUp.pas | 152 + .../town/KM_GUIMapEdTownHouses.pas | 309 + .../town/KM_GUIMapEdTownOffence.pas | 250 + .../town/KM_GUIMapEdTownScript.pas | 261 + .../pages_maped/town/KM_GUIMapEdTownUnits.pas | 245 + .../src/gui/pages_menu/KM_GUIMenuCampaign.pas | 454 + .../gui/pages_menu/KM_GUIMenuCampaigns.pas | 242 + .../src/gui/pages_menu/KM_GUIMenuCredits.pas | 142 + .../src/gui/pages_menu/KM_GUIMenuError.pas | 63 + .../src/gui/pages_menu/KM_GUIMenuLoad.pas | 496 + .../src/gui/pages_menu/KM_GUIMenuLoading.pas | 58 + .../src/gui/pages_menu/KM_GUIMenuLobby.pas | 3031 + .../src/gui/pages_menu/KM_GUIMenuMain.pas | 119 + .../gui/pages_menu/KM_GUIMenuMapEditor.pas | 1184 + .../gui/pages_menu/KM_GUIMenuMultiplayer.pas | 1032 + .../src/gui/pages_menu/KM_GUIMenuOptions.pas | 97 + .../src/gui/pages_menu/KM_GUIMenuReplays.pas | 649 + .../gui/pages_menu/KM_GUIMenuSingleMap.pas | 882 + .../gui/pages_menu/KM_GUIMenuSinglePlayer.pas | 108 + vendor/kam_remake/src/hands/KM_Hand.pas | 2319 + .../src/hands/KM_HandConstructions.pas | 1445 + vendor/kam_remake/src/hands/KM_HandEntity.pas | 306 + .../src/hands/KM_HandEntityHelper.pas | 64 + vendor/kam_remake/src/hands/KM_HandLocks.pas | 170 + .../kam_remake/src/hands/KM_HandLogistics.pas | 3126 + .../kam_remake/src/hands/KM_HandSpectator.pas | 430 + vendor/kam_remake/src/hands/KM_HandStats.pas | 1074 + vendor/kam_remake/src/hands/KM_HandTypes.pas | 36 + .../src/hands/KM_HandsCollection.pas | 1392 + .../src/hands/KM_WareDistribution.pas | 143 + .../src/houses/KM_HouseArmorWorkshop.pas | 82 + .../src/houses/KM_HouseBarracks.pas | 438 + .../src/houses/KM_HouseCollection.pas | 478 + vendor/kam_remake/src/houses/KM_HouseInn.pas | 178 + .../kam_remake/src/houses/KM_HouseMarket.pas | 643 + .../kam_remake/src/houses/KM_HouseSchool.pas | 366 + .../kam_remake/src/houses/KM_HouseStore.pas | 280 + .../src/houses/KM_HouseSwineStable.pas | 116 + .../src/houses/KM_HouseTownHall.pas | 209 + .../src/houses/KM_HouseWoodcutters.pas | 106 + vendor/kam_remake/src/houses/KM_Houses.pas | 2658 + vendor/kam_remake/src/maped/KM_MapEdTypes.pas | 107 + vendor/kam_remake/src/maped/KM_MapEditor.pas | 1251 + .../src/maped/KM_MapEditorHistory.pas | 862 + vendor/kam_remake/src/media/KM_Audio.pas | 27 + vendor/kam_remake/src/media/KM_MediaTypes.pas | 10 + vendor/kam_remake/src/media/KM_Music.pas | 729 + .../kam_remake/src/media/KM_ScriptSound.pas | 421 + vendor/kam_remake/src/media/KM_Sound.pas | 898 + vendor/kam_remake/src/media/KM_VLC.pas | 253 + vendor/kam_remake/src/media/KM_Video.pas | 725 + vendor/kam_remake/src/minimap/KM_Minimap.pas | 205 + .../kam_remake/src/minimap/KM_MinimapGame.pas | 177 + .../src/minimap/KM_MinimapMission.pas | 96 + .../src/mission/KM_CampaignClasses.pas | 85 + .../src/mission/KM_CampaignTypes.pas | 14 + .../src/mission/KM_CampaignUtils.pas | 31 + .../kam_remake/src/mission/KM_Campaigns.pas | 1154 + vendor/kam_remake/src/mission/KM_MapTypes.pas | 105 + vendor/kam_remake/src/mission/KM_MapUtils.pas | 66 + .../kam_remake/src/mission/KM_MapUtilsExt.pas | 88 + vendor/kam_remake/src/mission/KM_Maps.pas | 2024 + .../src/mission/KM_MissionScript.pas | 330 + .../src/mission/KM_MissionScript_Info.pas | 149 + .../src/mission/KM_MissionScript_Preview.pas | 266 + .../src/mission/KM_MissionScript_Standard.pas | 1236 + vendor/kam_remake/src/navmesh/KM_NavMesh.pas | 560 + .../src/navmesh/KM_NavMeshArmyPositioning.pas | 1078 + .../src/navmesh/KM_NavMeshArmyVectorField.pas | 1639 + .../src/navmesh/KM_NavMeshDefences.pas | 1092 + .../src/navmesh/KM_NavMeshFloodFill.pas | 249 + .../navmesh/KM_NavMeshFloodPositioning.pas | 85 + .../src/navmesh/KM_NavMeshGenerator.pas | 1228 + .../src/navmesh/KM_NavMeshInfluences.pas | 260 + .../src/navmesh/KM_NavMeshPathFinding.pas | 450 + vendor/kam_remake/src/navmesh/KM_Outline.pas | 142 + .../src/navmesh/KM_PolySimplify.pas | 937 + .../kam_remake/src/net/KM_NetAuthUnsecure.pas | 41 + vendor/kam_remake/src/net/KM_NetClient.pas | 286 + .../kam_remake/src/net/KM_NetClientLNet.pas | 204 + .../src/net/KM_NetClientOverbyte.pas | 193 + vendor/kam_remake/src/net/KM_NetConsts.pas | 43 + .../src/net/KM_NetDedicatedServer.pas | 178 + .../kam_remake/src/net/KM_NetFileTransfer.pas | 531 + vendor/kam_remake/src/net/KM_NetGameInfo.pas | 153 + vendor/kam_remake/src/net/KM_NetRoom.pas | 1719 + vendor/kam_remake/src/net/KM_NetServer.pas | 1286 + .../kam_remake/src/net/KM_NetServerLNet.pas | 313 + .../src/net/KM_NetServerLocator.pas | 168 + .../src/net/KM_NetServerOverbyte.pas | 215 + .../kam_remake/src/net/KM_NetServerPoller.pas | 652 + vendor/kam_remake/src/net/KM_NetTypes.pas | 375 + vendor/kam_remake/src/net/KM_NetUDP.pas | 229 + vendor/kam_remake/src/net/KM_NetUDPLNet.pas | 102 + .../kam_remake/src/net/KM_NetUDPOverbyte.pas | 115 + vendor/kam_remake/src/net/KM_NetworkUtils.pas | 32 + vendor/kam_remake/src/net/KM_Networking.pas | 2848 + .../kam_remake/src/net/http/KM_HTTPClient.pas | 78 + .../src/net/http/KM_HTTPClientLNet.pas | 110 + .../src/net/http/KM_HTTPClientOverbyte.pas | 91 + .../src/pathfinding/KM_PathFinding.pas | 565 + .../pathfinding/KM_PathFindingAStarNew.pas | 197 + .../pathfinding/KM_PathFindingAStarOld.pas | 149 + .../src/pathfinding/KM_PathFindingJPS.pas | 414 + .../src/pathfinding/KM_PathFindingRoad.pas | 181 + .../kam_remake/src/perflog/KM_DevPerfLog.pas | 404 + .../src/perflog/KM_DevPerfLogForm.pas | 415 + .../src/perflog/KM_DevPerfLogSingle.pas | 358 + .../src/perflog/KM_DevPerfLogStack.pas | 660 + .../src/perflog/KM_DevPerfLogTypes.pas | 147 + vendor/kam_remake/src/render/KM_Render.pas | 416 + vendor/kam_remake/src/render/KM_RenderAux.pas | 706 + .../src/render/KM_RenderControl.pas | 143 + .../kam_remake/src/render/KM_RenderDebug.pas | 526 + .../src/render/KM_RenderGameAux.pas | 280 + .../kam_remake/src/render/KM_RenderPool.pas | 2268 + .../kam_remake/src/render/KM_RenderQuery.pas | 131 + .../src/render/KM_RenderTerrain.pas | 1442 + .../kam_remake/src/render/KM_RenderTypes.pas | 28 + vendor/kam_remake/src/render/KM_RenderUI.pas | 1071 + vendor/kam_remake/src/res/KM_Pics.pas | 29 + vendor/kam_remake/src/res/KM_ResCursors.pas | 51 + vendor/kam_remake/src/res/KM_ResExporter.pas | 871 + vendor/kam_remake/src/res/KM_ResFonts.pas | 865 + vendor/kam_remake/src/res/KM_ResFontsEdit.pas | 673 + vendor/kam_remake/src/res/KM_ResHouses.pas | 994 + .../src/res/KM_ResInterpolation.pas | 222 + vendor/kam_remake/src/res/KM_ResKeyFuncs.pas | 154 + vendor/kam_remake/src/res/KM_ResKeys.pas | 325 + vendor/kam_remake/src/res/KM_ResLocales.pas | 216 + .../kam_remake/src/res/KM_ResMapElements.pas | 307 + vendor/kam_remake/src/res/KM_ResPalettes.pas | 171 + vendor/kam_remake/src/res/KM_ResSound.pas | 621 + vendor/kam_remake/src/res/KM_ResSprites.pas | 2276 + .../kam_remake/src/res/KM_ResSpritesEdit.pas | 860 + vendor/kam_remake/src/res/KM_ResTexts.pas | 445 + vendor/kam_remake/src/res/KM_ResTileset.pas | 854 + .../kam_remake/src/res/KM_ResTilesetTypes.pas | 330 + vendor/kam_remake/src/res/KM_ResTypes.pas | 345 + vendor/kam_remake/src/res/KM_ResUnits.pas | 726 + vendor/kam_remake/src/res/KM_ResWares.pas | 318 + vendor/kam_remake/src/res/KM_Resource.pas | 278 + vendor/kam_remake/src/res/KM_Saves.pas | 788 + .../src/scripting/KM_ScriptErrorHandler.pas | 266 + .../scripting/KM_ScriptFilesCollection.pas | 134 + .../src/scripting/KM_ScriptPreProcessor.pas | 494 + .../scripting/KM_ScriptPreProcessorGame.pas | 119 + .../scripting/KM_ScriptValidatorResult.pas | 159 + .../kam_remake/src/scripting/KM_Scripting.pas | 2159 + .../src/scripting/KM_ScriptingActions.pas | 5484 ++ .../scripting/KM_ScriptingConsoleCommands.pas | 1357 + .../src/scripting/KM_ScriptingEvents.pas | 1323 + .../src/scripting/KM_ScriptingIdCache.pas | 321 + .../src/scripting/KM_ScriptingStates.pas | 6001 ++ .../src/scripting/KM_ScriptingTypes.pas | 149 + .../src/scripting/KM_ScriptingUtils.pas | 1182 + .../src/settings/KM_GameAppSettings.pas | 162 + .../src/settings/KM_GameAppSettingsPart.pas | 25 + .../src/settings/KM_GameSettings.pas | 826 + .../src/settings/KM_KeysSettings.pas | 100 + .../src/settings/KM_MainSettings.pas | 178 + .../src/settings/KM_Resolutions.pas | 291 + .../src/settings/KM_ServerSettings.pas | 320 + .../kam_remake/src/settings/KM_Settings.pas | 142 + .../src/settings/KM_SettingsDev.pas | 299 + .../src/settings/KM_SettingsXML.pas | 62 + .../src/settings/KM_WindowParams.pas | 145 + vendor/kam_remake/src/terrain/KM_RMGUtils.pas | 1119 + .../src/terrain/KM_RandomMapGenerator.pas | 5456 ++ vendor/kam_remake/src/terrain/KM_Terrain.pas | 5503 ++ .../src/terrain/KM_TerrainDeposits.pas | 219 + .../src/terrain/KM_TerrainFinder.pas | 302 + .../src/terrain/KM_TerrainPainter.pas | 2309 + .../src/terrain/KM_TerrainSelection.pas | 1004 + .../src/terrain/KM_TerrainTypes.pas | 330 + .../src/terrain/KM_TerrainUtils.pas | 231 + .../src/terrain/KM_TerrainWalkConnect.pas | 454 + .../src/terrain/KM_TestMapGenerator.pas | 832 + vendor/kam_remake/src/units/KM_UnitGroup.pas | 2589 + .../src/units/KM_UnitGroupTypes.pas | 37 + vendor/kam_remake/src/units/KM_UnitVisual.pas | 177 + .../kam_remake/src/units/KM_UnitWarrior.pas | 1161 + .../kam_remake/src/units/KM_UnitWorkPlan.pas | 690 + vendor/kam_remake/src/units/KM_Units.pas | 2876 + .../src/units/KM_UnitsCollection.pas | 415 + .../actions/KM_UnitActionAbandonWalk.pas | 130 + .../src/units/actions/KM_UnitActionFight.pas | 414 + .../units/actions/KM_UnitActionGoInOut.pas | 522 + .../src/units/actions/KM_UnitActionStay.pas | 153 + .../src/units/actions/KM_UnitActionSteer.pas | 209 + .../actions/KM_UnitActionStormAttack.pas | 222 + .../src/units/actions/KM_UnitActionWalkTo.pas | 1428 + .../units/tasks/KM_UnitTaskAttackHouse.pas | 216 + .../src/units/tasks/KM_UnitTaskBuild.pas | 1029 + .../src/units/tasks/KM_UnitTaskDelivery.pas | 607 + .../src/units/tasks/KM_UnitTaskDie.pas | 119 + .../src/units/tasks/KM_UnitTaskDismiss.pas | 157 + .../src/units/tasks/KM_UnitTaskGoEat.pas | 209 + .../src/units/tasks/KM_UnitTaskGoHome.pas | 68 + .../tasks/KM_UnitTaskGoOutShowHungry.pas | 61 + .../src/units/tasks/KM_UnitTaskMining.pas | 442 + .../src/units/tasks/KM_UnitTaskSelfTrain.pas | 129 + .../src/units/tasks/KM_UnitTaskThrowRock.pas | 118 + .../kam_remake/src/unused/KM_Achievements.pas | 196 + .../kam_remake/src/unused/KM_CommonSave.pas | 504 + vendor/kam_remake/src/unused/KM_PerfLog.pas | 353 + .../src/utils/KM_CommonShellUtils.pas | 97 + .../kam_remake/src/utils/KM_CommonUtils.pas | 2077 + .../kam_remake/src/utils/KM_ConsoleTimer.pas | 134 + vendor/kam_remake/src/utils/KM_Utils.pas | 330 + vendor/kam_remake/src/utils/KM_UtilsExt.pas | 97 + vendor/kam_remake/src/utils/KromOGLUtils.pas | 286 + .../kam_remake/src/utils/KromShellUtils.pas | 146 + vendor/kam_remake/src/utils/KromUtils.pas | 582 + .../src/utils/algorithms/BinaryHeap.pas | 147 + .../src/utils/algorithms/BinaryHeapGen.pas | 187 + .../src/utils/algorithms/KM_BinPacking.pas | 293 + .../src/utils/algorithms/KM_FloodFill.pas | 188 + .../src/utils/algorithms/KM_Hungarian.pas | 451 + .../utils/algorithms/KM_MarchingSquares.pas | 266 + .../src/utils/algorithms/KM_SoftShadows.pas | 367 + .../src/utils/algorithms/KM_Sort.pas | 66 + vendor/kam_remake/src/utils/io/KM_FileIO.pas | 651 + .../src/utils/io/KM_IoGraphicUtils.pas | 81 + vendor/kam_remake/src/utils/io/KM_IoJSON.pas | 416 + vendor/kam_remake/src/utils/io/KM_IoPNG.pas | 127 + vendor/kam_remake/src/utils/io/KM_IoXML.pas | 461 + .../utils/method_parser/KM_MethodParser.pas | 493 + .../method_parser/KM_MethodParserParams.pas | 86 + vendor/kam_remake/upstream-tree.json | 14022 ++++ 993 files changed, 949976 insertions(+) create mode 100644 MANIFEST.sha256 create mode 100644 README.md create mode 100644 RUN_ME_FIRST.txt create mode 100644 config/toolchain.lock.json create mode 100644 dist/20260908T161945Z-3f43e1f3/apks.json create mode 100644 dist/20260908T164542Z-0843e132/apks.json create mode 100644 dist/LATEST.json create mode 100644 docs/COVERAGE.md create mode 100644 docs/FIRST_SERVER_RUN_DIAGNOSIS.md create mode 100644 docs/SOURCES.md create mode 100644 docs/TROUBLESHOOTING.md create mode 100644 reports/LATEST-SUMMARY.md create mode 100644 reports/LATEST.json create mode 100644 reports/preparation/VALIDATION.md create mode 100644 reports/preparation/actual-preflight-SUMMARY.md create mode 100644 reports/preparation/actual-preflight-result.json create mode 100644 reports/preparation/actual-preflight-toolchain.json create mode 100644 reports/preparation/android-preflight.log create mode 100644 reports/preparation/environment.json create mode 100644 reports/preparation/harness-tests.log create mode 100644 reports/preparation/manifest-validation.json create mode 100644 reports/runs/20260908T164541Z-61b94997/docker-command.json create mode 100644 reports/runs/20260908T164542Z-0843e132/SUMMARY.md create mode 100644 reports/runs/20260908T164542Z-0843e132/adb-version.log create mode 100644 reports/runs/20260908T164542Z-0843e132/castle-version.log create mode 100644 reports/runs/20260908T164542Z-0843e132/core_streams/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/core_streams/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/core_streams/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/core_types/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/core_types/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/core_types/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/evidence.zip create mode 100644 reports/runs/20260908T164542Z-0843e132/fpc-version.log create mode 100644 reports/runs/20260908T164542Z-0843e132/integration/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/integration/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/integration/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/integration/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/java-version.log create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_audio/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_audio/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_audio/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_render/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_render/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/legacy_render/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_info/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_info/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_info/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_tokens/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_tokens/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_tokens/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_world/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_world/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/mission_world/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/platform/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/platform/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/platform/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/platform/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/result-in-progress.json create mode 100644 reports/runs/20260908T164542Z-0843e132/result.json create mode 100644 reports/runs/20260908T164542Z-0843e132/script_vm/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/script_vm/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/script_vm/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/scripting/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/scripting/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/scripting/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/simulation/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/simulation/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/simulation/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/source-inventory.json create mode 100644 reports/runs/20260908T164542Z-0843e132/source-receipt.json create mode 100644 reports/runs/20260908T164542Z-0843e132/sprite_loader/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/sprite_loader/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/sprite_loader/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_io/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_io/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_io/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/CastleEngineManifest.xml create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/ProbeImports.pas create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log create mode 100644 reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/target.json create mode 100644 reports/runs/20260908T164542Z-0843e132/toolchain.json create mode 100644 vendor/README.md create mode 100644 vendor/kam_remake/Installer/License.bel.txt create mode 100644 vendor/kam_remake/Installer/License.bul.txt create mode 100644 vendor/kam_remake/Installer/License.chn.txt create mode 100644 vendor/kam_remake/Installer/License.cze.txt create mode 100644 vendor/kam_remake/Installer/License.dut.txt create mode 100644 vendor/kam_remake/Installer/License.eng.txt create mode 100644 vendor/kam_remake/Installer/License.est.txt create mode 100644 vendor/kam_remake/Installer/License.fin.txt create mode 100644 vendor/kam_remake/Installer/License.fre.txt create mode 100644 vendor/kam_remake/Installer/License.ger.txt create mode 100644 vendor/kam_remake/Installer/License.hun.txt create mode 100644 vendor/kam_remake/Installer/License.ita.txt create mode 100644 vendor/kam_remake/Installer/License.jpn.txt create mode 100644 vendor/kam_remake/Installer/License.kor.txt create mode 100644 vendor/kam_remake/Installer/License.nor.txt create mode 100644 vendor/kam_remake/Installer/License.pol.txt create mode 100644 vendor/kam_remake/Installer/License.ptb.txt create mode 100644 vendor/kam_remake/Installer/License.rom.txt create mode 100644 vendor/kam_remake/Installer/License.rus.txt create mode 100644 vendor/kam_remake/Installer/License.slv.txt create mode 100644 vendor/kam_remake/Installer/License.spa.txt create mode 100644 vendor/kam_remake/Installer/License.srb.txt create mode 100644 vendor/kam_remake/Installer/License.svk.txt create mode 100644 vendor/kam_remake/Installer/License.swe.txt create mode 100644 vendor/kam_remake/Installer/License.tur.txt create mode 100644 vendor/kam_remake/Installer/License.ukr.txt create mode 100644 vendor/kam_remake/KM_NetProtocolRevision.inc create mode 100644 vendor/kam_remake/KM_Revision.inc create mode 100644 vendor/kam_remake/KM_TextIDs.inc create mode 100644 vendor/kam_remake/KaM_Remake.inc create mode 100644 vendor/kam_remake/LICENSE.txt create mode 100644 vendor/kam_remake/SOURCE_RECEIPT.json create mode 100644 vendor/kam_remake/Utils/RVO2/LICENSE.txt create mode 100644 vendor/kam_remake/src/KM_Console.pas create mode 100644 vendor/kam_remake/src/KM_Crashreport.pas create mode 100644 vendor/kam_remake/src/KM_Exceptions.pas create mode 100644 vendor/kam_remake/src/KM_GameApp.pas create mode 100644 vendor/kam_remake/src/KM_Log.pas create mode 100644 vendor/kam_remake/src/KM_Main.pas create mode 100644 vendor/kam_remake/src/KM_Projectiles.pas create mode 100644 vendor/kam_remake/src/KM_System.pas create mode 100644 vendor/kam_remake/src/ai/KM_AI.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIArmyEvaluation.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIAttacks.pas create mode 100644 vendor/kam_remake/src/ai/KM_AICityPlanner.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIDefensePos.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIFields.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIGeneral.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIGoals.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIInfluences.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIMayor.pas create mode 100644 vendor/kam_remake/src/ai/KM_AIMayorBalance.pas create mode 100644 vendor/kam_remake/src/ai/KM_AISetup.pas create mode 100644 vendor/kam_remake/src/ai/KM_AITypes.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_AIParameters.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_ArmyAttack.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_ArmyAttackNew.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_ArmyDefence.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_ArmyManagement.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_CityBuilder.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_CityManagement.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_CityPlanner.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_CityPredictor.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_Eye.pas create mode 100644 vendor/kam_remake/src/ai/newAI/KM_Supervisor.pas create mode 100644 vendor/kam_remake/src/common/KM_CommonClasses.pas create mode 100644 vendor/kam_remake/src/common/KM_CommonClassesExt.pas create mode 100644 vendor/kam_remake/src/common/KM_CommonExceptions.pas create mode 100644 vendor/kam_remake/src/common/KM_CommonGameTypes.pas create mode 100644 vendor/kam_remake/src/common/KM_CommonTypes.pas create mode 100644 vendor/kam_remake/src/common/KM_Defaults.pas create mode 100644 vendor/kam_remake/src/common/KM_Entity.pas create mode 100644 vendor/kam_remake/src/common/KM_Lists.pas create mode 100644 vendor/kam_remake/src/common/KM_Points.pas create mode 100644 vendor/kam_remake/src/common/KM_WorkerThread.pas create mode 100644 vendor/kam_remake/src/common/KM_WorkerThreadUtils.pas create mode 100644 vendor/kam_remake/src/controls/KM_Controls.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsBase.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsChart.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsColor.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsDragger.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsDrop.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsEdit.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsForm.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsList.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsMemo.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsMinimapView.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsPopUp.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsProgressBar.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsScroll.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsSwitch.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsTrackBar.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsTypes.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsUtils.pas create mode 100644 vendor/kam_remake/src/controls/KM_ControlsWaresRow.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/basiccolorspace.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bezier.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraanimatedgif.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraarrow.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4fpgui.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4nogui.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrabitmaptypes.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrablend.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrablurgl.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracanvas.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracanvas2d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracanvasgl.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraclasses.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracolorint.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracolorquantization.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracompressablebitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracoordpool3d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracustombitmap.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgracustomtextfx.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgradefaultbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgradithering.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgradnetdeserial.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafillinfo.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafilterblur.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafilters.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafilterscanner.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafiltertype.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafontgl.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafpcanvas.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui_uses.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafpguibitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrafreetype.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragifformat.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragradientoriginal.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragradients.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragradientscanner.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragraphics.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragrayscalemask.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgragtkbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraiconcursor.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralayeroriginal.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralayers.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralazpaint.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralazresource.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralclbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgralzpcommon.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramacbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramatrix3d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramemdirectory.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramsegui.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_text.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_uses.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramseguibitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgramultifiletype.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgranogui.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgranogui_uses.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgranoguibitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraopengl.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraopengl3d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraopengltype.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraopenraster.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapaintnet.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapalette.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapath.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapen.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraphongtypes.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraphoxo.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapixel.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapolygon.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrapolygonaliased.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraqtbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmpmiomap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadgif.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadico.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadjpeg.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadlzp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadpcx.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadpng.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadpsd.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadtga.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadtiff.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadwebp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrareadxpm.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrarenderer3d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraresample.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrascanner.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrascene3d.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrascenetypes.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraslicescaling.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraspritegl.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasse.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasse.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrastreamlayers.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasvg.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasvgoriginal.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasvgshapes.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrasvgtype.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgratext.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgratextbidi.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgratextfx.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrathumbnail.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgratransform.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgratypewriter.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraunicode.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraunicodetext.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgraunits.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrautf8.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgravectorize.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawinbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawinresource.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawritebmpmiomap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawritelzp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawritepng.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawritetiff.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/bgrawritewebp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blendpixelinline.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blendpixels.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blendpixelsover.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blurbox.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blurfast.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/blurnormal.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/csscolorconst.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/density256.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/expandedbitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/extendedcolorspace.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/face3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/generatedcolorspace.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/generatedunicode.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/generatedutf8.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/geometrytypes.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/libwebp.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/lightingclasses3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/linearrgbabitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/lineartexscan.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/lineartexscan2.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/linuxlib.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/multishapeline.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/object3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/paletteformats.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/part3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/perspectivecolorscan.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/perspectivescan.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/perspectivescan2.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/phongdraw.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/phongdrawsse.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/phonglight.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/phonglightsse.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/polyaliaspersp.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/shapes3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/spectraldata.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/unibitmap.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/unibitmapgeneric.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/universaldrawer.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/unzipperext.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/uunittest.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/vertex3d.inc create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/wordxyzabitmap.pas create mode 100644 vendor/kam_remake/src/ext/BGRABitmap/xyzabitmap.pas create mode 100644 vendor/kam_remake/src/ext/BinaryHeapStub.pas create mode 100644 vendor/kam_remake/src/ext/Delaunay.pas create mode 100644 vendor/kam_remake/src/ext/FastMM4.pas create mode 100644 vendor/kam_remake/src/ext/FastMM4DataCollector.pas create mode 100644 vendor/kam_remake/src/ext/FastMM4LockFreeStack.pas create mode 100644 vendor/kam_remake/src/ext/FastMM4Messages.pas create mode 100644 vendor/kam_remake/src/ext/FastMM4Options.inc create mode 100644 vendor/kam_remake/src/ext/FastMM5.pas create mode 100644 vendor/kam_remake/src/ext/FastMMUsageTracker.pas create mode 100644 vendor/kam_remake/src/ext/JsonDataObjects.pas create mode 100644 vendor/kam_remake/src/ext/KromIOUtils.pas create mode 100644 vendor/kam_remake/src/ext/LNet/LICENSE create mode 100644 vendor/kam_remake/src/ext/LNet/lcommon.pp create mode 100644 vendor/kam_remake/src/ext/LNet/levents.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lhttp.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lhttputil.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lnet.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lnetssl.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lstrbuffer.pp create mode 100644 vendor/kam_remake/src/ext/LNet/lws2tcpip.pp create mode 100644 vendor/kam_remake/src/ext/LNet/openssl.pas create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lepolleventer.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lepolleventerh.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lkqueueeventer.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lkqueueeventerh.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lspawnfcgiunix.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/lspawnfcgiwin.inc create mode 100644 vendor/kam_remake/src/ext/LNet/sys/osunits.inc create mode 100644 vendor/kam_remake/src/ext/LazarusOpenGL/glcarbonaglcontext.pas create mode 100644 vendor/kam_remake/src/ext/LazarusOpenGL/glgtkglxcontext.pas create mode 100644 vendor/kam_remake/src/ext/LazarusOpenGL/glqtcontext.pas create mode 100644 vendor/kam_remake/src/ext/LazarusOpenGL/glwin32wglcontext.pas create mode 100644 vendor/kam_remake/src/ext/LazarusOpenGL/openglcontext.pas create mode 100644 vendor/kam_remake/src/ext/OBJLoader.pas create mode 100644 vendor/kam_remake/src/ext/OggVorbis/Codec.pas create mode 100644 vendor/kam_remake/src/ext/OggVorbis/OSTypes.pas create mode 100644 vendor/kam_remake/src/ext/OggVorbis/Ogg.pas create mode 100644 vendor/kam_remake/src/ext/OggVorbis/VorbisFile.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsLibrary.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsWinsock2.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/Ics.InterlockedApi.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDefs.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockImpl.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockTypes.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsSslDefs.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockImpl.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockTypes.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsZlib.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include/OverbyteVclZip.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsJwaWinCrypt.inc create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas create mode 100644 vendor/kam_remake/src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas create mode 100644 vendor/kam_remake/src/ext/PolyTriangulate.pas create mode 100644 vendor/kam_remake/src/ext/SciZipFile.pas create mode 100644 vendor/kam_remake/src/ext/URLUtils.pas create mode 100644 vendor/kam_remake/src/ext/Unit_Vector.pas create mode 100644 vendor/kam_remake/src/ext/VerySimpleXML.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas create mode 100644 vendor/kam_remake/src/ext/Virtual-TreeView/Source/VirtualTrees.pas create mode 100644 vendor/kam_remake/src/ext/Xml.VerySimple.pas create mode 100644 vendor/kam_remake/src/ext/Zippit.pas create mode 100644 vendor/kam_remake/src/ext/bass.pas create mode 100644 vendor/kam_remake/src/ext/dglOpenGL.pas create mode 100644 vendor/kam_remake/src/ext/iaWin.NameDelphiThreads.pas create mode 100644 vendor/kam_remake/src/ext/libZPlay.pas create mode 100644 vendor/kam_remake/src/ext/openal.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting_Reg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPSScriptingProvider.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK/PascalScript_RO_Reg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSImports.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/LICENSE.md create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import/fDwin.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import/fMain.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PS_KMR.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PascalScript.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PascalScriptFPC.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PascalScript_Core_Ext_Reg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg_noDB.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty/uPS_ExtReg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/arm.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/eDefines.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/pascalscript.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/powerpc.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_DB.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_buttons.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_classes.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_comobj.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_controls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_dateutils.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_dll.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_forms.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_graphics.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_menus.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_std.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponentExt.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_COM.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_Controls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_DB.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_Default.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_Forms.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSComponent_StdCtrls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSDebugger.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSDisassembly.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_DB.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_buttons.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_classes.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_comobj.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_controls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_dateutils.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_dll.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_forms.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_graphics.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_menus.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_std.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSUtils.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/x64.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/Source/x86.inc create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/FormSettings.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/Extendedreg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_BigIni.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBXreg.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Main.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/ParserU.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/ParserUtils.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas create mode 100644 vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/bigini.pas create mode 100644 vendor/kam_remake/src/forms/KM_FormLoading.pas create mode 100644 vendor/kam_remake/src/forms/KM_FormLogistics.pas create mode 100644 vendor/kam_remake/src/forms/KM_FormMain.pas create mode 100644 vendor/kam_remake/src/forms/KM_VCLMenuHint.pas create mode 100644 vendor/kam_remake/src/forms/KM_VclHelpers.pas create mode 100644 vendor/kam_remake/src/game/KM_FogOfWar.pas create mode 100644 vendor/kam_remake/src/game/KM_Game.pas create mode 100644 vendor/kam_remake/src/game/KM_GameClasses.pas create mode 100644 vendor/kam_remake/src/game/KM_GameInfo.pas create mode 100644 vendor/kam_remake/src/game/KM_GameOptions.pas create mode 100644 vendor/kam_remake/src/game/KM_GameParams.pas create mode 100644 vendor/kam_remake/src/game/KM_GameSavePoints.pas create mode 100644 vendor/kam_remake/src/game/KM_GameTypes.pas create mode 100644 vendor/kam_remake/src/game/gip/KM_GameInputProcess.pas create mode 100644 vendor/kam_remake/src/game/gip/KM_GameInputProcess_Multi.pas create mode 100644 vendor/kam_remake/src/game/gip/KM_GameInputProcess_Single.pas create mode 100644 vendor/kam_remake/src/game/misc/KM_GameUIDTracker.pas create mode 100644 vendor/kam_remake/src/game/misc/KM_RandomChecks.pas create mode 100644 vendor/kam_remake/src/game/notifications/KM_Alerts.pas create mode 100644 vendor/kam_remake/src/game/notifications/KM_MessageLog.pas create mode 100644 vendor/kam_remake/src/game/notifications/KM_MessageStack.pas create mode 100644 vendor/kam_remake/src/gui/KM_Cursor.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceDefaults.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceGame.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceGamePlay.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceMainMenu.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceMapEditor.pas create mode 100644 vendor/kam_remake/src/gui/KM_InterfaceTypes.pas create mode 100644 vendor/kam_remake/src/gui/KM_Viewport.pas create mode 100644 vendor/kam_remake/src/gui/pages_common/KM_GUICommonGameOptions.pas create mode 100644 vendor/kam_remake/src/gui/pages_common/KM_GUICommonKeys.pas create mode 100644 vendor/kam_remake/src/gui/pages_common/KM_GUICommonOptions.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameBuild.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameChat.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameHouse.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameRatios.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameResultsMP.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameResultsSP.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameSpectator.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameStats.pas create mode 100644 vendor/kam_remake/src/gui/pages_game/KM_GUIGameUnit.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdExtras.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdHouse.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdMessage.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/KM_GUIMapEdUnit.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/mission/KM_GUIMapEdMission.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTown.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas create mode 100644 vendor/kam_remake/src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuCampaign.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuCampaigns.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuCredits.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuError.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuLoad.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuLoading.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuLobby.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuMain.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuMapEditor.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuMultiplayer.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuOptions.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuReplays.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuSingleMap.pas create mode 100644 vendor/kam_remake/src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas create mode 100644 vendor/kam_remake/src/hands/KM_Hand.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandConstructions.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandEntity.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandEntityHelper.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandLocks.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandLogistics.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandSpectator.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandStats.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandTypes.pas create mode 100644 vendor/kam_remake/src/hands/KM_HandsCollection.pas create mode 100644 vendor/kam_remake/src/hands/KM_WareDistribution.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseArmorWorkshop.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseBarracks.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseCollection.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseInn.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseMarket.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseSchool.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseStore.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseSwineStable.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseTownHall.pas create mode 100644 vendor/kam_remake/src/houses/KM_HouseWoodcutters.pas create mode 100644 vendor/kam_remake/src/houses/KM_Houses.pas create mode 100644 vendor/kam_remake/src/maped/KM_MapEdTypes.pas create mode 100644 vendor/kam_remake/src/maped/KM_MapEditor.pas create mode 100644 vendor/kam_remake/src/maped/KM_MapEditorHistory.pas create mode 100644 vendor/kam_remake/src/media/KM_Audio.pas create mode 100644 vendor/kam_remake/src/media/KM_MediaTypes.pas create mode 100644 vendor/kam_remake/src/media/KM_Music.pas create mode 100644 vendor/kam_remake/src/media/KM_ScriptSound.pas create mode 100644 vendor/kam_remake/src/media/KM_Sound.pas create mode 100644 vendor/kam_remake/src/media/KM_VLC.pas create mode 100644 vendor/kam_remake/src/media/KM_Video.pas create mode 100644 vendor/kam_remake/src/minimap/KM_Minimap.pas create mode 100644 vendor/kam_remake/src/minimap/KM_MinimapGame.pas create mode 100644 vendor/kam_remake/src/minimap/KM_MinimapMission.pas create mode 100644 vendor/kam_remake/src/mission/KM_CampaignClasses.pas create mode 100644 vendor/kam_remake/src/mission/KM_CampaignTypes.pas create mode 100644 vendor/kam_remake/src/mission/KM_CampaignUtils.pas create mode 100644 vendor/kam_remake/src/mission/KM_Campaigns.pas create mode 100644 vendor/kam_remake/src/mission/KM_MapTypes.pas create mode 100644 vendor/kam_remake/src/mission/KM_MapUtils.pas create mode 100644 vendor/kam_remake/src/mission/KM_MapUtilsExt.pas create mode 100644 vendor/kam_remake/src/mission/KM_Maps.pas create mode 100644 vendor/kam_remake/src/mission/KM_MissionScript.pas create mode 100644 vendor/kam_remake/src/mission/KM_MissionScript_Info.pas create mode 100644 vendor/kam_remake/src/mission/KM_MissionScript_Preview.pas create mode 100644 vendor/kam_remake/src/mission/KM_MissionScript_Standard.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMesh.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshArmyPositioning.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshArmyVectorField.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshDefences.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshFloodFill.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshFloodPositioning.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshGenerator.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshInfluences.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_NavMeshPathFinding.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_Outline.pas create mode 100644 vendor/kam_remake/src/navmesh/KM_PolySimplify.pas create mode 100644 vendor/kam_remake/src/net/KM_NetAuthUnsecure.pas create mode 100644 vendor/kam_remake/src/net/KM_NetClient.pas create mode 100644 vendor/kam_remake/src/net/KM_NetClientLNet.pas create mode 100644 vendor/kam_remake/src/net/KM_NetClientOverbyte.pas create mode 100644 vendor/kam_remake/src/net/KM_NetConsts.pas create mode 100644 vendor/kam_remake/src/net/KM_NetDedicatedServer.pas create mode 100644 vendor/kam_remake/src/net/KM_NetFileTransfer.pas create mode 100644 vendor/kam_remake/src/net/KM_NetGameInfo.pas create mode 100644 vendor/kam_remake/src/net/KM_NetRoom.pas create mode 100644 vendor/kam_remake/src/net/KM_NetServer.pas create mode 100644 vendor/kam_remake/src/net/KM_NetServerLNet.pas create mode 100644 vendor/kam_remake/src/net/KM_NetServerLocator.pas create mode 100644 vendor/kam_remake/src/net/KM_NetServerOverbyte.pas create mode 100644 vendor/kam_remake/src/net/KM_NetServerPoller.pas create mode 100644 vendor/kam_remake/src/net/KM_NetTypes.pas create mode 100644 vendor/kam_remake/src/net/KM_NetUDP.pas create mode 100644 vendor/kam_remake/src/net/KM_NetUDPLNet.pas create mode 100644 vendor/kam_remake/src/net/KM_NetUDPOverbyte.pas create mode 100644 vendor/kam_remake/src/net/KM_NetworkUtils.pas create mode 100644 vendor/kam_remake/src/net/KM_Networking.pas create mode 100644 vendor/kam_remake/src/net/http/KM_HTTPClient.pas create mode 100644 vendor/kam_remake/src/net/http/KM_HTTPClientLNet.pas create mode 100644 vendor/kam_remake/src/net/http/KM_HTTPClientOverbyte.pas create mode 100644 vendor/kam_remake/src/pathfinding/KM_PathFinding.pas create mode 100644 vendor/kam_remake/src/pathfinding/KM_PathFindingAStarNew.pas create mode 100644 vendor/kam_remake/src/pathfinding/KM_PathFindingAStarOld.pas create mode 100644 vendor/kam_remake/src/pathfinding/KM_PathFindingJPS.pas create mode 100644 vendor/kam_remake/src/pathfinding/KM_PathFindingRoad.pas create mode 100644 vendor/kam_remake/src/perflog/KM_DevPerfLog.pas create mode 100644 vendor/kam_remake/src/perflog/KM_DevPerfLogForm.pas create mode 100644 vendor/kam_remake/src/perflog/KM_DevPerfLogSingle.pas create mode 100644 vendor/kam_remake/src/perflog/KM_DevPerfLogStack.pas create mode 100644 vendor/kam_remake/src/perflog/KM_DevPerfLogTypes.pas create mode 100644 vendor/kam_remake/src/render/KM_Render.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderAux.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderControl.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderDebug.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderGameAux.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderPool.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderQuery.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderTerrain.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderTypes.pas create mode 100644 vendor/kam_remake/src/render/KM_RenderUI.pas create mode 100644 vendor/kam_remake/src/res/KM_Pics.pas create mode 100644 vendor/kam_remake/src/res/KM_ResCursors.pas create mode 100644 vendor/kam_remake/src/res/KM_ResExporter.pas create mode 100644 vendor/kam_remake/src/res/KM_ResFonts.pas create mode 100644 vendor/kam_remake/src/res/KM_ResFontsEdit.pas create mode 100644 vendor/kam_remake/src/res/KM_ResHouses.pas create mode 100644 vendor/kam_remake/src/res/KM_ResInterpolation.pas create mode 100644 vendor/kam_remake/src/res/KM_ResKeyFuncs.pas create mode 100644 vendor/kam_remake/src/res/KM_ResKeys.pas create mode 100644 vendor/kam_remake/src/res/KM_ResLocales.pas create mode 100644 vendor/kam_remake/src/res/KM_ResMapElements.pas create mode 100644 vendor/kam_remake/src/res/KM_ResPalettes.pas create mode 100644 vendor/kam_remake/src/res/KM_ResSound.pas create mode 100644 vendor/kam_remake/src/res/KM_ResSprites.pas create mode 100644 vendor/kam_remake/src/res/KM_ResSpritesEdit.pas create mode 100644 vendor/kam_remake/src/res/KM_ResTexts.pas create mode 100644 vendor/kam_remake/src/res/KM_ResTileset.pas create mode 100644 vendor/kam_remake/src/res/KM_ResTilesetTypes.pas create mode 100644 vendor/kam_remake/src/res/KM_ResTypes.pas create mode 100644 vendor/kam_remake/src/res/KM_ResUnits.pas create mode 100644 vendor/kam_remake/src/res/KM_ResWares.pas create mode 100644 vendor/kam_remake/src/res/KM_Resource.pas create mode 100644 vendor/kam_remake/src/res/KM_Saves.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptErrorHandler.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptFilesCollection.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptPreProcessor.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptPreProcessorGame.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptValidatorResult.pas create mode 100644 vendor/kam_remake/src/scripting/KM_Scripting.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingActions.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingConsoleCommands.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingEvents.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingIdCache.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingStates.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingTypes.pas create mode 100644 vendor/kam_remake/src/scripting/KM_ScriptingUtils.pas create mode 100644 vendor/kam_remake/src/settings/KM_GameAppSettings.pas create mode 100644 vendor/kam_remake/src/settings/KM_GameAppSettingsPart.pas create mode 100644 vendor/kam_remake/src/settings/KM_GameSettings.pas create mode 100644 vendor/kam_remake/src/settings/KM_KeysSettings.pas create mode 100644 vendor/kam_remake/src/settings/KM_MainSettings.pas create mode 100644 vendor/kam_remake/src/settings/KM_Resolutions.pas create mode 100644 vendor/kam_remake/src/settings/KM_ServerSettings.pas create mode 100644 vendor/kam_remake/src/settings/KM_Settings.pas create mode 100644 vendor/kam_remake/src/settings/KM_SettingsDev.pas create mode 100644 vendor/kam_remake/src/settings/KM_SettingsXML.pas create mode 100644 vendor/kam_remake/src/settings/KM_WindowParams.pas create mode 100644 vendor/kam_remake/src/terrain/KM_RMGUtils.pas create mode 100644 vendor/kam_remake/src/terrain/KM_RandomMapGenerator.pas create mode 100644 vendor/kam_remake/src/terrain/KM_Terrain.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainDeposits.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainFinder.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainPainter.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainSelection.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainTypes.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainUtils.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TerrainWalkConnect.pas create mode 100644 vendor/kam_remake/src/terrain/KM_TestMapGenerator.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitGroup.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitGroupTypes.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitVisual.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitWarrior.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitWorkPlan.pas create mode 100644 vendor/kam_remake/src/units/KM_Units.pas create mode 100644 vendor/kam_remake/src/units/KM_UnitsCollection.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionAbandonWalk.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionFight.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionGoInOut.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionStay.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionSteer.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionStormAttack.pas create mode 100644 vendor/kam_remake/src/units/actions/KM_UnitActionWalkTo.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskAttackHouse.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskBuild.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskDelivery.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskDie.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskDismiss.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskGoEat.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskGoHome.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskGoOutShowHungry.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskMining.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskSelfTrain.pas create mode 100644 vendor/kam_remake/src/units/tasks/KM_UnitTaskThrowRock.pas create mode 100644 vendor/kam_remake/src/unused/KM_Achievements.pas create mode 100644 vendor/kam_remake/src/unused/KM_CommonSave.pas create mode 100644 vendor/kam_remake/src/unused/KM_PerfLog.pas create mode 100644 vendor/kam_remake/src/utils/KM_CommonShellUtils.pas create mode 100644 vendor/kam_remake/src/utils/KM_CommonUtils.pas create mode 100644 vendor/kam_remake/src/utils/KM_ConsoleTimer.pas create mode 100644 vendor/kam_remake/src/utils/KM_Utils.pas create mode 100644 vendor/kam_remake/src/utils/KM_UtilsExt.pas create mode 100644 vendor/kam_remake/src/utils/KromOGLUtils.pas create mode 100644 vendor/kam_remake/src/utils/KromShellUtils.pas create mode 100644 vendor/kam_remake/src/utils/KromUtils.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/BinaryHeap.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/BinaryHeapGen.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_BinPacking.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_FloodFill.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_Hungarian.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_MarchingSquares.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_SoftShadows.pas create mode 100644 vendor/kam_remake/src/utils/algorithms/KM_Sort.pas create mode 100644 vendor/kam_remake/src/utils/io/KM_FileIO.pas create mode 100644 vendor/kam_remake/src/utils/io/KM_IoGraphicUtils.pas create mode 100644 vendor/kam_remake/src/utils/io/KM_IoJSON.pas create mode 100644 vendor/kam_remake/src/utils/io/KM_IoPNG.pas create mode 100644 vendor/kam_remake/src/utils/io/KM_IoXML.pas create mode 100644 vendor/kam_remake/src/utils/method_parser/KM_MethodParser.pas create mode 100644 vendor/kam_remake/src/utils/method_parser/KM_MethodParserParams.pas create mode 100644 vendor/kam_remake/upstream-tree.json diff --git a/MANIFEST.sha256 b/MANIFEST.sha256 new file mode 100644 index 0000000..8fb244b --- /dev/null +++ b/MANIFEST.sha256 @@ -0,0 +1,38 @@ +b3dae83832de92453a8e6e932bbcbe997c58bc9a4b74066ff7e53c908a1abeab .gitignore +5168a04ba9abf1b8143c037f17bbf7e56d84a1fabe6f9a538b3c6035d0f34522 README.md +ad9d3d135525d0ee5b2be814fc84b6217f7d41eb88ac2b7a143e55f2d6c4ecd0 RUN_ME_FIRST.txt +ee5e86375f332c31f6a91fa9bf2a276929af3d6b1669a5f937ef677e914ec37d build-android.sh +3d16bbc8fadf90395353d0b8b4b14454a2aea0dd9a8344cdcd96f04423a3a3e7 code/GameInitialize.pas +af0efa5a633b6de18442174173e9d9f8ac1fafe20979571568c97811d51bf4a8 code/GameViewMain.pas +59e7e9cbd9c4116293770bb2681e4827ea6cdc5323b299aa5e0abf582e6fd3dc code/ProbeAssets.pas +7541f1787bd9fe448dc5ea6922ac4591259c284b6c7228fde32b037cfba04bb2 code/ProbeCamera.pas +e72474c482bfa40700cdab80dcb7b0b113bf0a14daa76c1e75334f1e7380e390 code/ProbePlatform.pas +7709bc7fd77a51b852d09a024237da0a783c3f02162fbbe6bed237db76ad36cc code/ProbeReport.pas +bed130782b3019af6518c1f0fd20b7b1ef06068cf79625765583d9d32e7052f2 config/extra-paths.json +f0dd08f7d300f295d9ac5d861fc73a92b33bb3be372bea96c1a4d5ae9bb6cd94 config/profiles.json +794a2d1eb3af8e9e830874dfe4b1db9da5a1ec040b809f0c9277fa77ec4c63d7 config/upstream.json +34cece697fb7158ddeeb46e9e7f04835a8309c03aa8ea2ad59b359181ba83406 docs/COVERAGE.md +73628325c98e1273422110869293cc90ae7dcd1d633f9b0125b720a134cc0338 docs/FIRST_SERVER_RUN_DIAGNOSIS.md +a70be70ca6764bfc9642e13136e0007de284f19b225ea1c0cc4d9ef628d7a006 docs/SOURCES.md +99776dc1bafcdb98f2204200eb36974dc7477b7c7e2bc74ff1d74da9d329c699 docs/TROUBLESHOOTING.md +41918629f548736f8e508c7f4732e682a3267da1cfe396434326c7b23a20cc4f private-assets/README.md +4c0ed27fb55041d095e3d815cb3bf27b517903a12d7ab4a71e1a8590b659737d reports/preparation/VALIDATION.md +62eead6b2c40c82146d8b7bea5c4080df31fa2b5f3db677276ab70d515c36139 reports/preparation/actual-preflight-SUMMARY.md +a043f356d1cff302ccb3e906d18e6b725abc2be6b839a1aada90c3e83a77de06 reports/preparation/actual-preflight-result.json +719875282fb142ab6afe9eef1d9b3498f47efb4dbf1f97ca24f7ef3542ab1c8d reports/preparation/actual-preflight-toolchain.json +55311bc64f07389b889d3c4de385d2777eb8d044d5c82ac3471c312ba6dbb1cf reports/preparation/android-preflight.log +621ecd1ce1d7f2a35a995ab51d9a6f05ceb1350bcf2907c1415dfec67b6d1774 reports/preparation/environment.json +fe3957cf8d7d2e31d950906db700e277d90422d1fd00568efc9642cea4274d75 reports/preparation/harness-tests.log +694851e41898b814cc346b74f208e968ce970ba597f9b308997fcbb15819c0e3 reports/preparation/manifest-validation.json +5ecf07e8765e01637c2388b3f7e4653f749e972c7d36919eaf315e15fca348ee test-harness.sh +b6c6e8b34c3ef0bad463679f746d03c5174263110171a2cded886e04dae122f0 tests/helpers.py +914aefcca9fa4c7b72db477359503e74ab82c3aa8978925a1d6ce3008f6620f4 tests/test_pipeline.py +5f49078b0f6dd8ef8a1862518ddf949782c35bb0c82e1cae2ae5282a522a3050 tests/test_probe.py +2969d5fd87b45a14a15c2e6812a13e858cec31fd1094006873109e9227161b41 tools/artifacts.py +fc31ac45930fb44ced0c3b4a439eebb549f12d2de6d9b757be46a2c653ece8cc tools/common.py +979bed409a3140c7df1eb371dbb850b3bcbd5ea0fc5a2e9f381fe528bf218595 tools/device.py +08b9399bcebbe2ab7593ce6da5c36bb63832d026c8a7248089a02f7a024a29a6 tools/generate.py +6793b6fb39e7a0fc95aecb76ad768fb9405aecdcee815f81d0a3f122835d0f6d tools/runner.py +3724a3a6e3a0683753592f0c84defe55a8fdc59ce6126e4fc397d6288d2ef4e0 tools/source_audit.py +1ba90c4c89b639b2e15860b1a796b7b037fc1be9c28e3de2e66b73b967a2c29c tools/source_fetch.py +f33d4c3762d17a868cafd915f41a9514ee777ecb1085452becba77c1ba5b618a vendor/README.md diff --git a/README.md b/README.md new file mode 100644 index 0000000..ac59dd3 --- /dev/null +++ b/README.md @@ -0,0 +1,219 @@ +# KaM r16020 — Android Architecture Probe 0.3.1 + +**Кодовый теÑÑ‚ архитектуры: KaM core + Free Pascal + Castle Game Engine → Android.** + +ЗдеÑÑŒ нет desktop target, готовой игры, игровых бинарных реÑурÑов или ÑобÑтвенного Ð·Ð°Ð¼ÐµÐ½Ð¸Ñ‚ÐµÐ»Ñ KaM core. ТеÑÑ‚ не требует `data/` Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð²ÐµÑ€ÐºÐ¸ компилÑции и линковки. Он проверÑет, какие **наÑтоÑщие иÑходные модули r16020** можно включить в Android-библиотеку вмеÑте Ñ Castle и где возникают конкретные препÑÑ‚ÑтвиÑ. + +**Ðрхив Ñодержит код Ñтенда и автоматизацию, не заранее Ñобранный APK.** Во Ð²Ñ€ÐµÐ¼Ñ Ð¿Ð¾Ð´Ð³Ð¾Ñ‚Ð¾Ð²ÐºÐ¸ проверены Python-Ñкрипты и их контрольные Ñценарии. ÐаÑтоÑÑ‰Ð°Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»ÑÑ†Ð¸Ñ Pascal/Android здеÑÑŒ не выполнÑлаÑÑŒ: FPC, Castle, Docker и ADB в Ñреде подготовки отÑутÑтвовали. Подробнее: `reports/preparation/VALIDATION.md`. + +## 1. ЗапуÑк на Ñервере — без реÑурÑов + +ТребуютÑÑ Linux x86_64 или Linux-Ñреда WSL2, Bash, Python **3.10+**, работающий Docker и доÑтуп в интернет. Папка проекта должна быть доÑтупна на запиÑÑŒ. Ðа Ñервере ARM64 Docker-образ Linux/amd64 потребует отдельно наÑтроенной ÑмулÑции; Ñто не оÑновной путь Ñтого теÑта. + +```bash +unzip kam-android-architecture-probe-r16020.zip +cd kam-android-architecture-probe-r16020 +chmod +x build-android.sh test-harness.sh +./build-android.sh +``` + +Команда выполнÑет веÑÑŒ **Android ARM64** цикл, а не Ñборку Linux-верÑии игры: + +1. Получает официальный Docker-образ инÑтрументов CGE. При первом запуÑке фикÑирует его неизменÑемый digest в `config/toolchain.lock.json`; при Ñледующих иÑпользует его же. +2. Загружает **только текÑтовые иÑходники** KaM по commit `962fb850324b79bbe5480e1c2087d98f83a60917` и иÑходники PascalScript по gitlink из Ñтого commit. Полный checkout, иÑÑ‚Ð¾Ñ€Ð¸Ñ Git, release-архивы и игровые реÑурÑÑ‹ не ÑкачиваютÑÑ. +3. Создаёт 15 изолированных Android-проектов: компилирует и полноÑтью линкует каждый, Ð¿Ñ€Ð¾Ð´Ð¾Ð»Ð¶Ð°Ñ Ð¾Ñтальные проверки поÑле ошибки одной подÑиÑтемы. +4. По умолчанию упаковывает три ключевых проекта в APK, когда их линковка уÑпешна: `platform`, `core_types`, `integration`. +5. СохранÑет результаты, конкретные ошибки, верÑии инÑтрументов, идентификаторы иÑходников и архив журналов без Ñодержимого реÑурÑов. + +**СиÑтемные инÑтрументы Ñборки — бинарные программы и будут Ñкачаны Docker на Ñервере. Запрет на Ñкачивание игровых бинарных реÑурÑов Ñоблюдён; полноÑтью автономный комплект SDK/NDK/FPC в Ñтот ZIP не вложен.** Полный оригинальный код KaM также не вложен: его автоматичеÑки получает Ñерверный загрузчик по фикÑированному commit. Ð’ архиве нет ÑÑылок на изменÑемый `master` KaM. + +`config/toolchain.lock.json` поÑвлÑетÑÑ Ð¿Ñ€Ð¸ первом реальном получении Docker-образа, а не Ñодержит выдуманный digest. Ð”Ð»Ñ Ð¾Ð´Ð¸Ð½Ð°ÐºÐ¾Ð²Ð¾Ð³Ð¾ Ð¾ÐºÑ€ÑƒÐ¶ÐµÐ½Ð¸Ñ Ð½Ð° другом Ñервере перенеÑите Ñтот lock вмеÑте Ñ Ð¿Ñ€Ð¾ÐµÐºÑ‚Ð¾Ð¼. Сам первый выбор CGE-образа завиÑит от даты запуÑка; KaM вÑегда зафикÑирован на r16020. + +## 2. Что проверÑетÑÑ + +| Проба | Реальные модули / граница | По умолчанию | +|---|---|---| +| `platform` | CGE + FPC: Android shell, ÑиÑтемные потоки, файловые пути, zlib, изображение, input, audio API | Compile + native link + APK | +| `core_types` | `KM_CommonTypes`, `KM_Points`; наÑтоÑщие функции координат | Compile + native link + APK | +| `core_streams` | `KM_CommonClasses`; наÑтоÑÑ‰Ð°Ñ ÑÐµÑ€Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¸ завиÑимоÑти | Compile + native link | +| `mission_tokens` | `KM_MissionScript` | Compile + native link | +| `mission_info` | `KM_MissionScript_Info` | Compile + native link | +| `terrain_io` | `KM_TerrainUtils` | Compile + native link | +| `sprite_loader` | `KM_ResSprites` и его реальные завиÑимоÑти | Compile + native link | +| `terrain_pathfinding` | `KM_Terrain` и его реальные завиÑимоÑти | Compile + native link | +| `mission_world` | `KM_MissionScript_Standard` | Compile + native link | +| `simulation` | `KM_Game` как иÑходный модуль, **не desktop executable** | Compile + native link | +| `script_vm` | `uPSCompiler`, `uPSRuntime` из закреплённого PascalScript | Compile + native link | +| `scripting` | `KM_ScriptingEvents` | Compile + native link | +| `legacy_render` | `KM_Render`, диагноÑтика прежнего backend | Compile + native link; необÑÐ·Ð°Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ð±Ð° | +| `legacy_audio` | `KM_Sound`, диагноÑтика прежнего backend | Compile + native link; необÑÐ·Ð°Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ð±Ð° | +| `integration` | ОÑновные корни KaM **вмеÑте Ñ Castle в одной Android-библиотеке** | Compile + native link + APK | + +Ðикаких `test_shims`, пуÑÑ‚Ñ‹Ñ… `KM_*.pas` вмеÑто оригиналов или ÑамоÑтоÑтельно перепиÑанных MAP/RXX readers в Ñборочных проектах нет. Модули Ñ Ñ‚Ñ€Ð°Ð½Ð·Ð¸Ñ‚Ð¸Ð²Ð½Ñ‹Ð¼Ð¸ завиÑимоÑÑ‚Ñми компилируютÑÑ ÐºÐ°Ðº еÑÑ‚ÑŒ; их ошибка не ÑкрываетÑÑ. + +ИÑпользуетÑÑ Ð¾Ð´Ð¸Ð½ уже ÑущеÑтвующий upstream define: **`DBG_SKIP_SECURE_AUTH`**. Он отключает необÑзательный приватный модуль аутентификации multiplayer, недоÑтупный в обычном иÑходном комплекте. Это локальный Android-проект, не теÑÑ‚ Ñетевого ÑервиÑа. Define запиÑываетÑÑ Ð² каждый ÑоответÑтвующий `target.json`. ОÑтальные игровые подÑиÑтемы не отключаютÑÑ Ð´Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Ð·ÐµÐ»Ñ‘Ð½Ð¾Ð³Ð¾ отчёта. + +Линковка не отключена через `-Cn`. Стенд запрашивает переÑборку (`-B`), отключает smart linking/удаление неиÑпользуемых Ñекций и включает проверку undefined symbols. Это намеренно более ÑÑ‚Ñ€Ð¾Ð³Ð°Ñ Ð¿Ñ€Ð¾Ð²ÐµÑ€ÐºÐ° завиÑимоÑтей, чем пуÑтой вызов одной функции Ñ Ð²Ñ‹Ð±Ñ€Ð¾ÑˆÐµÐ½Ð½Ñ‹Ð¼ оÑтальным кодом. ПроверÑÑŽÑ‚ÑÑ Ñвежие корневые `.ppu`, ELF нужного ABI, отÑутÑтвие `DT_TEXTREL`, Ñтруктура APK и его native dependencies. ЕÑли упаковщик удалил только debug symbols, библиотека ÑопоÑтавлÑетÑÑ Ð¿Ð¾ неизменным allocated sections и program headers, а не ошибочно отклонÑетÑÑ Ð¸Ð·-за другой полной SHA-256. ПодпиÑÑŒ APK проверÑетÑÑ `apksigner`, когда он найден; иначе проверка подпиÑи помечена `NOT_RUN`. + +## 3. Результаты и коды возврата + +Ðачинайте Ñ: + +```text +reports/LATEST-SUMMARY.md +reports/LATEST.json +``` + +Полный результат конкретного запуÑка: + +```text +reports/runs//SUMMARY.md +reports/runs//result.json +reports/runs///compile-link.log +reports/runs///package.log +reports/runs//source-inventory.json +reports/runs//evidence.zip +``` + +При уÑпешной упаковке: + +```text +dist//kam_probe_platform-aarch64-debug.apk +dist//kam_probe_core_types-aarch64-debug.apk +dist//kam_probe_integration-aarch64-debug.apk +dist/LATEST.json +``` + +Каждый APK поÑвлÑетÑÑ **только еÑли ÑоответÑÑ‚Ð²ÑƒÑŽÑ‰Ð°Ñ Ð¿Ñ€Ð¾Ð±Ð° дейÑтвительно Ñобрана и упакована**. Ошибка `integration` не удалÑет уÑпешно полученный `platform` APK. Старые артефакты лежат в Ñвоих каталогах build-id и не заÑчитываютÑÑ Ð² новый результат. + +| Итог | Exit code | Значение | +|---|---:|---| +| `ANDROID_BUILD_GATE_PASS` | 0 | Ð’Ñе обÑзательные Android compile/link-пробы и три обÑзательных APK прошли. Runtime ещё не подразумеваетÑÑ. | +| `NOT_BUILDABLE_AS_IS` | 1 | ОбÑÐ·Ð°Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ð±Ð° вÑтретила ошибку компилÑции, линковки или упаковки. Смотреть конкретный журнал. | +| `BLOCKED` | 2 | Проверке мешает отÑутÑтвующий инÑтрумент, иÑходник, окружение или другой незавершённый Ñтап. Ðе уÑпех. | +| `PARTIAL_SELECTION` | 2 | Выбрана лишь чаÑÑ‚ÑŒ профилей. Даже уÑпешный platform APK не ÑчитаетÑÑ Ð¿Ð¾Ð´Ñ‚Ð²ÐµÑ€Ð¶Ð´ÐµÐ½Ð¸ÐµÐ¼ вÑего core. | + +Отдельные неудачи `legacy_render`/`legacy_audio` не требуют ÑÐ¾Ñ…Ñ€Ð°Ð½ÐµÐ½Ð¸Ñ Ñтарых backend и не проваливают gate Ñами по Ñебе. Ðо еÑли Ñти завиÑимоÑти реально входÑÑ‚ в обÑзательный KaM-корень, ошибка будет видна и заблокирует Ñтот корень. + +**`PASS` означает только указанную проверку.** КомпилÑÑ†Ð¸Ñ `KM_Game` не означает, что Ñкономика/AI уже запущены, и ошибка `Graphics` не означает «веÑÑŒ KaM нужно перепиÑать». Результат даёт конкретную точку Ð´Ð»Ñ Ð½ÐµÐ±Ð¾Ð»ÑŒÑˆÐ¾Ð³Ð¾ Android-адаптера, доработки или Ð¿Ð¾Ð´ÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ ÑущеÑтвующей библиотеки. Матрица интерпретации еÑÑ‚ÑŒ в `SUMMARY.md` и `docs/COVERAGE.md`. + +## 4. Другие режимы + +Уже уÑтановленный CGE/FPC Android toolchain, без Docker: + +```bash +./build-android.sh --local +``` + +`--local` означает иÑпользовать инÑтрументы Ñервера; **target оÑтаётÑÑ Android**. `castle-engine`, `fpc`, Java, Android SDK/NDK и cross-compiler должны быть ÑоглаÑованно наÑтроены. Стенд не уÑтанавливает SDK через root и не изменÑет ÑиÑтемную конфигурацию. + +Повторный запуÑк Ñ ÑƒÐ¶Ðµ загруженным и проверенным кодом: + +```bash +./build-android.sh --no-fetch +``` + +Только проверка Android shell и типов: + +```bash +./build-android.sh --profiles platform,core_types +``` + +Получить APK Ð´Ð»Ñ ÐºÐ°Ð¶Ð´Ð¾Ð¹ уÑпешно Ñлинкованной пробы: + +```bash +./build-android.sh --package-all +``` + +Другие Android ABI, отдельные запуÑки: + +```bash +./build-android.sh --cpu arm +./build-android.sh --cpu x86_64 +``` + +Android x86_64 — вариант Ð´Ð»Ñ ÑоответÑтвующего Android-уÑтройÑтва/ÑмулÑтора, **не деÑÐºÑ‚Ð¾Ð¿Ð½Ð°Ñ Ñборка**. УÑпех одного ABI не заÑчитываетÑÑ Ð·Ð° другой. + +Пути к дополнительному иÑходному пакету или Android native libraries задаютÑÑ Ð² `config/extra-paths.json`. Пути отноÑительно ÐºÐ¾Ñ€Ð½Ñ Ð¿Ñ€Ð¾ÐµÐºÑ‚Ð° предпочтительны, чтобы одинаково работать внутри Docker и Ñнаружи. По умолчанию ÑпиÑки пуÑÑ‚Ñ‹. Стенд не подÑтавлÑет другую библиотеку автоматичеÑки и не принимает extra path, который обнаруженно перекрывает оригинальный KaM unit. + +## 5. РеÑурÑÑ‹ — позже, на вашем Ñервере + +Ð”Ð»Ñ Ð¸Ñходной проверки Ñборки Ñтот раздел можно полноÑтью пропуÑтить. + +Положите Ñ€Ñдом каталоги уÑтановленной игры, Ñохранив имена и региÑÑ‚Ñ€: + +```text +/srv/kam-r16020/ + data/ + SpriteResource/ + Maps/ + MapsMP/ + Campaigns/ + Tutorials/ +``` + +Содержимое Ñобираете вы из ÑоответÑтвующих уÑтановок. Стенд не получает игровые файлы из Ñети. Ð’ Docker папка монтируетÑÑ read-only; в отдельные Ñборочные каталоги помещаютÑÑ ÐµÑ‘ точные копии. + +```bash +./build-android.sh --assets /srv/kam-r16020 +``` + +Это добавлÑет реÑурÑÑ‹ в упаковываемые KaM-пробы (`core_types`, `integration`, либо выбранные Ñ `--package-all`). ÐезавиÑимый `platform` оÑтаётÑÑ Ð±ÐµÐ· игровых реÑурÑов. Ð”Ð»Ñ ÐºÐ°Ð¶Ð´Ð¾Ð¹ копии на Ñервере проверÑетÑÑ SHA-256. При запуÑке Android получает файлы из assets и копирует в приватный каталог Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ð´Ð»Ñ Ð¾Ð±Ñ‹Ñ‡Ð½Ñ‹Ñ… `TFileStream`-путей, проверÑÑ Ñ€Ð°Ð·Ð¼ÐµÑ€ копии. Ðикакой конвертации `.map/.dat/.rxx` нет. + +**Добавление файлов не запуÑкает миÑÑию автоматичеÑки.** Этот режим проверÑет доÑтавку данных и нативные файловые пути, а не полноценное декодирование/Ñоздание мира. Runtime checksum оригинальных реÑурÑов и штатные загрузки мира не заÑвлены как выполненные проверки Ñтого Ñтенда. Большой комплект может заметно увеличить APK, Ð²Ñ€ÐµÐ¼Ñ Ð¸Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ð¸ и занÑтое меÑто; Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð²ÐµÑ€ÐºÐ¸ Ñборки он не нужен. + +Ðе передавайте проприетарные файлы через публичный Git. `private-assets/`, `vendor/`, `build/`, `dist/` иÑключены в `.gitignore`. Ð’ `evidence.zip` Ñодержимого реÑурÑов нет, но имена/размеры/хеши могут приÑутÑтвовать в metadata — проÑмотрите их перед публичной публикацией. + +## 6. ЗапуÑк APK на Android — дополнительный Ñтап + +Ð”Ð»Ñ Ð¾Ñ‚Ð²ÐµÑ‚Ð° «ÑобираетÑÑ Ð»Ð¸ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð°Ñ Ð°Ñ€Ñ…Ð¸Ñ‚ÐµÐºÑ‚ÑƒÑ€Ð°?» доÑтаточно Ñерверного compile/link/package-отчёта. Проверка запуÑка — отдельное ÑвидетельÑтво. + +Ðа машине Ñ ADB и одним авторизованным Android-уÑтройÑтвом: + +```bash +python3 tools/device.py --profile platform --exercise-lifecycle +python3 tools/device.py --profile core_types --exercise-lifecycle +python3 tools/device.py --profile integration --exercise-lifecycle +``` + +Указывать профиль имеет ÑмыÑл только поÑле Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ ÐµÐ³Ð¾ APK. ÐеÑколько уÑтройÑтв: добавьте `--serial `. Скрипт уÑтанавливает/обновлÑет **только выбранное теÑтовое приложение**, запуÑкает его и читает приватный отчёт через `run-as`. Старый `runtime.json` Ñтого теÑта удалÑетÑÑ Ð¿ÐµÑ€ÐµÐ´ запуÑком; реÑурÑÑ‹, наÑтройки игры и ÑÐ¾Ñ…Ñ€Ð°Ð½ÐµÐ½Ð¸Ñ Ð½Ðµ очищаютÑÑ. ADB не запуÑкаетÑÑ Ð²Ð½ÑƒÑ‚Ñ€Ð¸ Ñтандартного Docker build-контейнера. + +Ð’ APK: Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð½Ð°Ñ ÐºÐ»ÐµÑ‚Ð¾Ñ‡Ð½Ð°Ñ ÐºÐ°Ñ€Ñ‚Ð¸Ð½ÐºÐ°, drag/pinch/tap, кнопки ÑÐ¾Ñ…Ñ€Ð°Ð½ÐµÐ½Ð¸Ñ Ð¾Ñ‚Ñ‡Ñ‘Ñ‚Ð° и звука. ÐвтоматичеÑки проверÑÑŽÑ‚ÑÑ ABI, native-файлы/seek, FPC zlib, поток и frame callbacks. Ð’ профильных APK вызываютÑÑ Ð½Ð°ÑтоÑщие `KMPoint`/`KMPointRight`; в `core_streams` и `integration` — `TKMemoryStreamBinary`. УÑпешное доÑтижение UI также показывает, что unit initialization импортированного набора не прервало запуÑк. + +Вывод находитÑÑ Ð² `reports/device//`. Видимое изображение, удобÑтво жеÑтов и Ñлышимый звук требуют наблюдениÑ: возвращение `SoundEngine.Play` не подменÑет проверку звука. КаМ-terrain, Ð·Ð´Ð°Ð½Ð¸Ñ Ð¸ ÑимулÑÑ†Ð¸Ñ Ñтим APK не изображаютÑÑ. + +## 7. Проверка Ñамого Ñтенда + +```bash +./test-harness.sh +``` + +Это Python unit/integration tests инÑÑ‚Ñ€ÑƒÐ¼ÐµÐ½Ñ‚Ð°Ñ€Ð¸Ñ Ð±ÐµÐ· Ñети, Docker и реÑурÑов. Они проверÑÑŽÑ‚ выбор иÑходников, пути, gate, генерацию проектов, ELF/APK parser, отказ при Ñтаром/неверном артефакте, отказ при пуÑтом выводе компилÑтора, продолжение поÑле ошибки и приватноÑÑ‚ÑŒ evidence. + +**Сквозные контрольные теÑÑ‚Ñ‹ иÑпользуют Ñвно помеченные временные test doubles компилÑтора/ELF/APK.** Это теÑтирование ÑƒÐ¿Ñ€Ð°Ð²Ð»ÐµÐ½Ð¸Ñ Ñборкой, не ÑмулÑÑ†Ð¸Ñ Ð½Ð°ÑтоÑщего KaM и не доказательÑтво компилÑции Pascal. Test doubles ÑущеÑтвуют только в `TemporaryDirectory`; в реальные targets и результаты Android они не попадают. + +## 8. Структура + +```text +build-android.sh ЕдинÑÑ‚Ð²ÐµÐ½Ð½Ð°Ñ Ñ‚Ð¾Ñ‡ÐºÐ° входа Ñборки +code/ Общий Android/CGE runtime Ñтенда +tools/ Загрузка иÑходников, 15 targets, Ñборка, аудит, ADB +config/profiles.json Корни проверÑемых подÑиÑтем +config/upstream.json ЗафикÑÐ¸Ñ€Ð¾Ð²Ð°Ð½Ð½Ð°Ñ Ð±Ð°Ð·Ð° +config/extra-paths.json Явно добавленные завиÑимоÑти (изначально пуÑто) +tests/ ТеÑÑ‚Ñ‹ инÑтрументариÑ; не игровое Ñдро +reports/preparation/ Проверки, реально выполненные при подготовке ZIP +docs/ Границы доказательÑтв, иÑточники, разбор ошибок +vendor/ ИÑточники поÑвлÑÑŽÑ‚ÑÑ Ð¿Ñ€Ð¸ запуÑке на Ñервере +private-assets/ ÐеобÑзательное закрытое меÑто ваших данных +``` + +`CastleEngineManifest.xml`, `ProbeBuild.pas`, `ProbeImports.pas` ÑоздаютÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾ Ð´Ð»Ñ ÐºÐ°Ð¶Ð´Ð¾Ð³Ð¾ Ð¿Ñ€Ð¾Ñ„Ð¸Ð»Ñ Ð² `build///`. Корень ZIP Ñам по Ñебе не ÑвлÑетÑÑ Ð¾Ð´Ð½Ð¸Ð¼ CGE-проектом; запуÑкайте `build-android.sh`, а не `castle-engine compile` без target из корнÑ. + +Полноценный порт не требуетÑÑ Ð´Ð»Ñ Ñтого теÑта. Следующее решение принимаетÑÑ Ð¿Ð¾ реальному Ñерверному отчёту: уÑтранить обнаруженный общий блокер и повторить те же Android-пробы, не перепиÑывать работающие игровые подÑиÑтемы заранее. + +## 0.3.1 — correction after first server report + +- Removed global FPC `-Mdelphi`. KaM units already select Delphi mode through `KaM_Remake.inc`; forcing it globally also changed Castle Game Engine units and broke `CastleLocalizationGetText` before any KaM code was compiled. +- Source inventory now reads Pascal files with `utf-8-sig`, so UTF-8 BOM files such as `src/game/KM_Game.pas` are recognized. +- Added regression tests for both failures. diff --git a/RUN_ME_FIRST.txt b/RUN_ME_FIRST.txt new file mode 100644 index 0000000..4aebb6f --- /dev/null +++ b/RUN_ME_FIRST.txt @@ -0,0 +1,31 @@ +KaM r16020 — Android Architecture Probe 0.3.1 + +ТОЛЬКО ANDROID. ИГРОВЫХ РЕСУРСОВ И ГОТОВОГО APK Ð’ ÐРХИВЕ ÐЕТ. + +Ðа Linux-Ñервере Ñ Python 3.10+ и Docker: + + chmod +x build-android.sh test-harness.sh + ./build-android.sh + +По умолчанию: Android ARM64, 15 наÑтоÑщих compile/link-проб, +три APK при уÑпешной Ñборке их профилей. Ðи один desktop target не ÑтроитÑÑ. +ИÑходники r16020 и toolchain автоматичеÑки получает Ñервер; игровые данные не ÑкачиваютÑÑ. + +Смотреть: + reports/LATEST-SUMMARY.md + reports/runs//evidence.zip + dist//*.apk + +Код возврата: + 0 = обÑзательный Android build gate пройден; + 1 = обÑÐ·Ð°Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ñборка/линковка/упаковка вÑтретила ошибку; + 2 = проверка заблокирована или выбран неполный набор профилей. + +РеÑурÑÑ‹ можно подключить ПОЗЖЕ: + ./build-android.sh --assets /srv/kam-r16020 + +ЗдеÑÑŒ Pascal/APK фактичеÑки не ÑобиралиÑÑŒ. Проверено управление теÑтами; +Ñреда подготовки не Ñодержала FPC/CGE/Docker. Это кодовый Ñборочный теÑÑ‚, +а не заÑвление, что ÑущеÑтвующий core уже портирован. + +ÐŸÐ¾Ð»Ð½Ð°Ñ Ð¸Ð½ÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ â€” README.md. diff --git a/config/toolchain.lock.json b/config/toolchain.lock.json new file mode 100644 index 0000000..b2bdd01 --- /dev/null +++ b/config/toolchain.lock.json @@ -0,0 +1,7 @@ +{ + "image": "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "image_id": "sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "resolved_from": "kambi/castle-engine-cloud-builds-tools:cge-unstable", + "locked_at": "20260908T161942Z", + "note": "Subsequent runs use this digest, never silently advance the tag." +} diff --git a/dist/20260908T161945Z-3f43e1f3/apks.json b/dist/20260908T161945Z-3f43e1f3/apks.json new file mode 100644 index 0000000..e163417 --- /dev/null +++ b/dist/20260908T161945Z-3f43e1f3/apks.json @@ -0,0 +1,4 @@ +{ + "build_id": "20260908T161945Z-3f43e1f3", + "packages": [] +} diff --git a/dist/20260908T164542Z-0843e132/apks.json b/dist/20260908T164542Z-0843e132/apks.json new file mode 100644 index 0000000..964c0b5 --- /dev/null +++ b/dist/20260908T164542Z-0843e132/apks.json @@ -0,0 +1,4 @@ +{ + "build_id": "20260908T164542Z-0843e132", + "packages": [] +} diff --git a/dist/LATEST.json b/dist/LATEST.json new file mode 100644 index 0000000..98805ce --- /dev/null +++ b/dist/LATEST.json @@ -0,0 +1,5 @@ +{ + "build_id": "20260908T164542Z-0843e132", + "directory": "dist/20260908T164542Z-0843e132", + "packages": [] +} diff --git a/docs/COVERAGE.md b/docs/COVERAGE.md new file mode 100644 index 0000000..d8200f8 --- /dev/null +++ b/docs/COVERAGE.md @@ -0,0 +1,39 @@ +# Что можно заключить по Ñтому теÑту + +## Цель + +Получить реальные ошибки или уÑпешные результаты **компилÑции, полной native-линковки и APK-упаковки** KaM r16020 + FPC/CGE Ð´Ð»Ñ Android. Отдельно проверить проÑтейший запуÑк уже Ñобранных APK. Ðи desktop-Ñборка, ни Ð¿Ð¾Ð»Ð½Ð°Ñ Ð¸Ð³Ñ€Ð° Ð´Ð»Ñ Ñтой цели не нужны. + +## Границы ÑвидетельÑтв + +| СвидетельÑтво | Подтверждает | Ðе подтверждает | +|---|---|---| +| `platform` compile/link | Сборочные наÑтройки CGE/FPC Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð³Ð¾ Android ABI | СовмеÑтимоÑÑ‚ÑŒ KaM | +| Корневой модуль compile/link | Этот иÑходник и активные транзитивные завиÑимоÑти компилируютÑÑ/линкуютÑÑ Ð¿Ñ€Ð¸ запиÑанных defines | ПравильноÑÑ‚ÑŒ каждого метода, чтение вÑех реÑурÑов | +| `integration` compile/link | СовмеÑтную линковку выбранных наÑтоÑщих корней KaM и CGE | Старт миÑÑии, simulation parity, готовноÑÑ‚ÑŒ renderer | +| APK inspection | Корректную оболочку ZIP/DEX, нужный ABI, ÑопоÑтавление библиотеки и ÑтатичеÑки объÑвленных завиÑимоÑтей | Ð’Ñе dynamic `dlopen` пути, запуÑк Android loader, подпиÑÑŒ без отдельной проверки | +| `apksigner` | ПодпиÑÑŒ конкретного артефакта при уÑпешной проверке | Корректную работу Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ | +| Runtime startup | Прохождение ÑоответÑтвующих инициализаторов и Ñтарт CGE UI | Полную игровую инициализацию | +| Реальные point/stream smoke | ÐеÑколько конкретных штатных операций и размеров типов на Android | Ð’Ñе Ñценарии бинарной ÑовмеÑтимоÑти Ñохранений | +| Procedural GPU image / кадры | Вызовы render/update в CGE; визуально — проÑтой texture path | КаМ выÑоты, Ñортировку Ñпрайтов, terrain, draw performance | +| ЛекÑичеÑкий inventory | МеÑта потенциальных завиÑимоÑтей Ñ Ñ„Ð°Ð¹Ð»Ð°Ð¼Ð¸ и Ñтроками | ÐктивноÑÑ‚ÑŒ ветви `ifdef` и наличие реальной ошибки компилÑции | + +Флаг `elf_16k_alignment_candidate` — только ÑтатичеÑкое ÑвойÑтво Ñегментов ELF. Это не Ñертификат ÑовмеÑтимоÑти Ñ 16 KB Android page size и не подтверждение требований Google Play. ZIP alignment и поведение на ÑоответÑтвующем уÑтройÑтве отдельно Ñтим флагом не проверены. + +## ПринÑтие Ñ€ÐµÑˆÐµÐ½Ð¸Ñ Ð´Ð»Ñ Ð´Ð¾ÐºÑƒÐ¼ÐµÐ½Ñ‚Ð°Ñ†Ð¸Ð¸ + +`REUSE_CANDIDATE`: иÑходный модуль ÑобралÑÑ Ð±ÐµÐ· изменений. Формулировка Ð´Ð»Ñ Ð´Ð¾ÐºÑƒÐ¼ÐµÐ½Ñ‚Ð°Ñ†Ð¸Ð¸: «ПереиÑпользуем, compile/link подтверждён на ABI X в окружении Y; runtime/поведение проверÑÑŽÑ‚ÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾Â». + +`PLATFORM_ADAPTER_CANDIDATE`: ошибка на Windows/LCL/Ñтаром graphics/audio API. Сначала найти путь завиÑимоÑти. ПеренеÑти конкретную платформенную операцию за границу, а не заменÑÑ‚ÑŒ loader или simulation module целиком. + +`DEPENDENCY_BUILD_OR_CONFIG`: отÑутÑтвующий unit/include/native symbol. Различать некомплектный иÑходный пакет, неверный search path, библиотеку без Android-варианта, CPU-specific assembler и дейÑтвительно непереноÑимый API. ЗапиÑанный triage — подÑказка, не окончательный диагноз. + +`SOURCE_PATCH_CANDIDATE`: ошибка Ñзыка/RTL/ABI в наÑтоÑщем иÑходнике. Ðужна Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ð²ÐµÑ€ÑÐµÐ¼Ð°Ñ Ð¿Ñ€Ð°Ð²ÐºÐ°, её оÑнование, повторный результат. Этот Ñтенд намеренно хранит baseline неизменным и не делает такую правку автоматичеÑки. + +`NEW_IMPLEMENTATION`: **никогда не назначаетÑÑ Ð°Ð²Ñ‚Ð¾Ð¼Ð°Ñ‚Ð¸Ñ‡ÐµÑки** по одной ошибке компилÑции. Ðужны иÑÑледование ÑущеÑтвующего кода и Ñвное обоÑнование, почему адаптациÑ/подключение библиотеки не подходÑÑ‚. Ðовый мобильный UI и touch presentation ожидаемы, но Ñто не довод перепиÑывать core. + +## Что не входит в текущий Ð·Ð°Ð¿Ñ€Ð¾Ñ + +Ðе иÑполнÑÑŽÑ‚ÑÑ Ð¼Ð¸ÑÑии, Ñкономика, AI, ÑтроительÑтво, боÑ, save/load игрового мира, кампании и библиотечные script-файлы. Их код входит в ÑоответÑтвующие dependency/link-пробы, но поведенчеÑкого Ð¿Ð¾ÐºÑ€Ñ‹Ñ‚Ð¸Ñ Ð¾Ñ‚ Ñтого не поÑвлÑетÑÑ. Полный KaM renderer и мобильные игровые панели не реализованы. MAP/DAT форматы не менÑлиÑÑŒ. РеÑурÑÑ‹ не заменены ÑинтетичеÑкими файлами «под KaM». + +ПоÑле первого Ñерверного запуÑка можно предметно опиÑывать **Ñборочные и платформенные границы** проекта. ЗаÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¾ полной игровой ÑовмеÑтимоÑти потребуют других теÑтов; они не нужны Ð´Ð»Ñ Ð¾Ñ‚Ð²ÐµÑ‚Ð° на текущий Ð²Ð¾Ð¿Ñ€Ð¾Ñ Â«Ñ‡Ñ‚Ð¾ мешает Ñобрать нашу архитектуру под Android». diff --git a/docs/FIRST_SERVER_RUN_DIAGNOSIS.md b/docs/FIRST_SERVER_RUN_DIAGNOSIS.md new file mode 100644 index 0000000..642e44e --- /dev/null +++ b/docs/FIRST_SERVER_RUN_DIAGNOSIS.md @@ -0,0 +1,8 @@ +# First server run diagnosis (2026-09-08) + +The first server report did **not** reach KaM portability errors. Two harness defects blocked it first. + +1. `tools/generate.py` passed `-Mdelphi` as a global FPC command-line option. This changed compilation mode for Castle Game Engine units too. `CastleLocalizationGetText` relies on its normal CGE/FPC mode and failed with `Variable identifier expected` and overload errors. KaM units do not need a global mode flag because `KaM_Remake.inc` contains `{$MODE Delphi}` under FPC. Fix: remove global `-Mdelphi`. +2. `tools/source_audit.py` read UTF-8 files without BOM stripping. `src/game/KM_Game.pas` begins with a UTF-8 BOM, so the lexical `^unit` matcher did not index it and the simulation/integration profiles were incorrectly marked `Missing required original source units: KM_Game`. Fix: read with `utf-8-sig`. + +After these fixes, rerun the same Android profiles. New failures should be treated as the first meaningful evidence about KaM/FPC/Android dependencies. diff --git a/docs/SOURCES.md b/docs/SOURCES.md new file mode 100644 index 0000000..88cd0f9 --- /dev/null +++ b/docs/SOURCES.md @@ -0,0 +1,27 @@ +# Первичные иÑточники + +Проверено при подготовке: 8 ÑентÑÐ±Ñ€Ñ 2026 года. Это ÑÑылки Ð´Ð»Ñ Ð²Ð¾ÑÐ¿Ñ€Ð¾Ð¸Ð·Ð²ÐµÐ´ÐµÐ½Ð¸Ñ API/Ñборочных решений, не утверждение, что Android APK был Ñобран в Ñреде подготовки. + +## ЗафикÑированный KaM + +- База и иÑходники: https://github.com/reyandme/kam_remake/tree/962fb850324b79bbe5480e1c2087d98f83a60917 +- Переключатели FPC/ÑущеÑтвующий `DBG_SKIP_SECURE_AUTH`: https://github.com/reyandme/kam_remake/blob/962fb850324b79bbe5480e1c2087d98f83a60917/KaM_Remake.inc +- Подмодуль PascalScript: https://github.com/reyandme/kam_remake/blob/962fb850324b79bbe5480e1c2087d98f83a60917/.gitmodules +- Оригинальные координаты: https://github.com/reyandme/kam_remake/blob/962fb850324b79bbe5480e1c2087d98f83a60917/src/common/KM_Points.pas +- Оригинальные потоки: https://github.com/reyandme/kam_remake/blob/962fb850324b79bbe5480e1c2087d98f83a60917/src/common/KM_CommonClasses.pas + +Upstream revision, blob SHA-1 и SHA-256 Ð´Ð»Ñ Ð²Ñех реально иÑпользуемых файлов запиÑывает `tools/source_fetch.py`. ИÑпользуетÑÑ SHA gitlink Ð¿Ð¾Ð´Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¸Ð· закреплённого дерева, не его Ñ‚ÐµÐºÑƒÑ‰Ð°Ñ Ð²ÐµÑ‚ÐºÐ°. + +## Castle / Android + +- Build tool, Android `--os/--cpu`, `--assume-compiled`, debug APK: https://castle-engine.io/build_tool +- Формат manifest, game_units, search_paths, defines, custom_options: https://castle-engine.io/project_manifest +- Официальный toolchain Docker image и его ÑоÑтав: https://castle-engine.io/docker +- Android: https://castle-engine.io/android +- Android assets: https://castle-engine.io/android_faq +- Lifecycle callbacks: https://castle-engine.io/apidoc/html/CastleApplicationProperties.TCastleApplicationProperties.html +- Файлы и config URLs: https://castle-engine.io/apidoc/html/CastleUriUtils.html +- Android ABI: https://developer.android.com/ndk/guides/abis +- Проверка реального уÑтройÑтва: https://developer.android.com/studio/run/device + +CGE API развиваетÑÑ. Именно поÑтому первый реальный запуÑк ÑохранÑет digest toolchain, а ошибка платформенного API в `platform` не называетÑÑ Ð¾ÑˆÐ¸Ð±ÐºÐ¾Ð¹ KaM. Default SDK/NDK берутÑÑ Ð¸Ð· выбранного CGE, а не из неподтверждённой ÑобÑтвенной таблицы верÑий. diff --git a/docs/TROUBLESHOOTING.md b/docs/TROUBLESHOOTING.md new file mode 100644 index 0000000..5421498 --- /dev/null +++ b/docs/TROUBLESHOOTING.md @@ -0,0 +1,45 @@ +# Разбор результатов + +## Ðе запуÑкаетÑÑ Docker или нет меÑта/доÑтупа в Ñеть + +Это проблема окружениÑ, не аргумент против FPC/Castle. Смотрите bootstrap report и `docker-pull.log`. Ðе запуÑкайте Ñкрипт через `sudo` автоматичеÑки: Ñначала наÑтройте доÑтуп к Docker и права на папку проекта. Образ Ñодержит инÑтрументы Ð´Ð»Ñ Ð¼Ð½Ð¾Ð³Ð¸Ñ… целей; его размер не равен размеру нашего иÑходного ZIP. + +## `platform` не ÑобралÑÑ + +Сначала Ñмотреть `platform/compile-link.log`, `toolchain.json` и `platform/CastleEngineManifest.xml`. Это ÑамоÑтоÑÑ‚ÐµÐ»ÑŒÐ½Ð°Ñ CGE/FPC проба без KaM. Причиной может быть верÑÐ¸Ñ API CGE, Android cross-compiler, NDK/linker либо ошибка кода Ñамого Ñтенда. Ðе припиÑывайте её KaM. ОÑтальные пробы вÑÑ‘ равно запуÑкаютÑÑ Ð´Ð»Ñ Ñбора диагноÑтик. + +## `Can't find unit Graphics / Forms / LCL...` + +Стенд не добавлÑет desktop LCL в Android автоматичеÑки и не Ñоздаёт пуÑтую замену. ЛекÑичеÑкий `source-inventory.json` помогает найти меÑта завиÑимоÑти, но Ñмотреть нужно активную цепочку в compile log. У неÑкольких проб может быть один общий блокер. Ðе Ñчитать каждый упавший профиль отдельной перепиÑываемой ÑиÑтемой. + +## ОтÑутÑтвующий `.res`, generated include или native object + +Загрузчик намеренно выбирает только иÑходный текÑÑ‚, а не Ñкомпилированные Windows-реÑурÑÑ‹/объекты. Ð¢Ð°ÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° может означать, что реÑÑƒÑ€Ñ Ð½ÑƒÐ¶Ð½Ð¾ штатно генерировать Ð´Ð»Ñ Android или отделить платформенный модуль, а не что игровой формат неÑовмеÑтим. Запишите запроÑивший файл и найдите ÑоответÑтвующий upstream build step. Стенд не подменÑет необходимый вход пуÑтым файлом. + +## `No fresh Pascal unit artifact` + +КомпилÑтор завершилÑÑ, но Ñтенд не нашёл ожидаемый `.ppu` внутри Ñвежего проекта. ÐÐµÐ»ÑŒÐ·Ñ Ð±ÐµÐ· проверки проÑто оÑлабить Ñто уÑловие: Ñначала уÑтановить, куда текущий CGE положил units, дейÑтвительно ли Ñобран именно иÑходный корень и не иÑпользован чужой cache. Ð’ `target.json` еÑÑ‚ÑŒ ÑпиÑок иÑточников и options. Это диагноÑтичеÑÐºÐ°Ñ Ð¿Ñ€Ð¾Ð²ÐµÑ€ÐºÐ° Ñтенда, не обÑзательное ÑвидетельÑтво ошибки core. + +## Undefined symbols / native `.so` отÑутÑтвует в APK + +Проверка линковки Ñпециально ÑтрогаÑ. ПоÑмотреть библиотеку и ABI, транзитивные native завиÑимоÑти и имеющийÑÑ Ð²Ð°Ñ€Ð¸Ð°Ð½Ñ‚ Ð´Ð»Ñ Android. `extra-paths.json` позволÑет Ñвно добавить пути к проверенной библиотеке/иÑходникам. Ðе добавлÑÑ‚ÑŒ Windows DLL, desktop `.so` или заглушку Ñ Ñ‚ÐµÐ¼ же именем unit. ÐаÑтроить library search path недоÑтаточно, еÑли библиотека ещё должна отдельно упаковыватьÑÑ Ð² APK: отчёт `DT_NEEDED` Ñто обнаружит. + +## APK Ñлинкован, но упаковка отказала из-за native identity + +Сравнение разрешает удаление неиÑполнÑемой debug-информации, но требует ÑÐ¾Ð²Ð¿Ð°Ð´ÐµÐ½Ð¸Ñ allocated sections и program headers. Другие Ð¸Ð·Ð¼ÐµÐ½ÐµÐ½Ð¸Ñ ÑƒÐ¿Ð°ÐºÐ¾Ð²Ñ‰Ð¸ÐºÐ° требуют отдельного иÑÑледованиÑ. Ðе принимать произвольный `.apk` из Ñтарого `dist/` за новый. При неÑкольких разных APK outputs Ñтенд конÑервативно отказываетÑÑ Ð²Ñ‹Ð±Ð¸Ñ€Ð°Ñ‚ÑŒ Ñлучайный; изучите Ñвежий target, прежде чем менÑÑ‚ÑŒ правило отбора. + +## Source modified / Unrecorded binary + +Baseline под `vendor/kam_remake/` проверÑетÑÑ Ð¿Ð¾ receipt до и поÑле Ñборки. Ðе редактируйте его Ð´Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Â«Ð½ÐµÐ¸Ð·Ð¼ÐµÐ½Ñ‘Ð½Ð½Ð¾Ð³Ð¾ upstream PASS». Ð”Ð»Ñ Ð¸ÑÑÐ»ÐµÐ´Ð¾Ð²Ð°Ð½Ð¸Ñ Ð°Ð´Ð°Ð¿Ñ‚Ð°Ñ†Ð¸Ð¸ нужна Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð°Ñ Ñвно Ð¾Ð±Ð¾Ð·Ð½Ð°Ñ‡ÐµÐ½Ð½Ð°Ñ ÐºÐ¾Ð¿Ð¸Ñ/patch-ветка и запиÑÑŒ разницы; текущий Ñтенд проверÑет as-is baseline. ÐŸÐ¾Ð²Ñ‚Ð¾Ñ€Ð½Ð°Ñ Ð·Ð°Ð³Ñ€ÑƒÐ·ÐºÐ° не затирает ваши Ð¸Ð·Ð¼ÐµÐ½ÐµÐ½Ð¸Ñ Ð¼Ð¾Ð»Ñ‡Ð°. + +## Код возврата 2 поÑле platform-only + +Это ожидаемый `PARTIAL_SELECTION`. Смотрите индивидуальные ÑтатуÑÑ‹. УÑпешный platform-only запуÑк Ñпециально не делает глобальный architecture gate зелёным. + +## APK запуÑкаетÑÑ Ð¸ Ñразу закрываетÑÑ + +Это может быть ошибка native loader, unit initialization или попытка штатного кода обратитьÑÑ Ðº данным до Ñтарта UI. `runtime.json` при раннем падении может не ÑоздатьÑÑ. Сохраните журнал Android Ð´Ð»Ñ Ñтого package и библиотек. Device tool не заÑчитывает отÑутÑтвие отчёта за уÑпех. Ð”Ð»Ñ Ð¿Ð¾Ð»Ð½Ð¾Ð³Ð¾ crash stack может потребоватьÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾Ðµ чтение native crash log на уÑтройÑтве. + +## Что передавать Ð´Ð»Ñ Ñледующего разбора + +`reports/runs//evidence.zip` Ñодержит верÑии инÑтрументов, source hashes, manifests, generated imports, compile/package logs и result. Ð’ нём нет игровых файлов, APK и полного upstream дерева. По нему можно выделить первый общий блокер. Ð”Ð»Ñ runtime дополнительно нужны файлы конкретного `reports/device//`; Ñначала проверьте, нет ли в журналах нежелательных личных путей/данных. diff --git a/reports/LATEST-SUMMARY.md b/reports/LATEST-SUMMARY.md new file mode 100644 index 0000000..f9fd860 --- /dev/null +++ b/reports/LATEST-SUMMARY.md @@ -0,0 +1,42 @@ +# KaM r16020 — Android architecture probe + +Build ID: `20260908T164542Z-0843e132` · CPU: `aarch64` · Gate: **NOT_BUILDABLE_AS_IS** + +Ðет desktop target. УÑпех означает Ñборку выбранных Android-корней, не игровую ÑовмеÑтимоÑÑ‚ÑŒ. + +| Проба | Compile + native link | APK | Ошибка / Ñледующий шаг | +|---|---|---|---| +| platform | FAIL | NOT_RUN | /work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" | +| core_types | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| core_streams | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| mission_tokens | FAIL | NOT_RUN | /work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" | +| mission_info | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| terrain_io | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| sprite_loader | FAIL | NOT_RUN | /work/vendor/kam_remake/src/res/KM_ResSprites.pas(5,17) Fatal: Can't find unit LCLIntf used by KM_ResSprites | +| terrain_pathfinding | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/KromUtils.pas(7,18) Fatal: Can't find unit LCLType used by KromUtils | +| mission_world | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| simulation | FAIL | NOT_RUN | /work/vendor/kam_remake/src/settings/KM_GameSettings.pas(6,15) Fatal: Can't find unit Forms used by KM_GameSettings | +| script_vm | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,13) Error: Illegal expression | +| scripting | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(116,5) Error: Wrong number of parameters specified for call to "Invoke" | +| legacy_render | FAIL | NOT_RUN | /work/vendor/kam_remake/src/render/KM_Render.pas(6,17) Fatal: Can't find unit LCLIntf used by KM_Render | +| legacy_audio | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/openal.pas(76,1) Fatal: Syntax error, "identifier" expected but "TYPE" found | +| integration | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | + +## Что уÑтановлено + +`PASS` compile_link = FPC завершилÑÑ ÑƒÑпешно, найден Ñвежий ELF нужного ABI, проверены корневые PPU. Линковка не отключена; требуютÑÑ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»Ñ‘Ð½Ð½Ñ‹Ðµ Ñимволы. `PASS` APK = упаковка завершилаÑÑŒ, проверены ZIP/DEX, правильный ABI, Ñовпадение native library и DT_NEEDED. ПодпиÑÑŒ проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾, еÑли доÑтупен apksigner. `runtime=NOT_RUN` до реального запуÑка на Android. + +`NOT_BUILDABLE_AS_IS` — найдено препÑÑ‚Ñтвие в текущем коде/окружении, а не доказательÑтво, что core надо перепиÑать. Ошибки legacy_render/legacy_audio диагноÑтичеÑкие и не входÑÑ‚ в обÑзательный gate, но их транзитивное попадание в core вÑÑ‘ равно видно. + +## Как принимать решение + +| СвидетельÑтво | Разумное решение | +|---|---| +| Корень ÑобираетÑÑ Ñ Ð¾Ñ€Ð¸Ð³Ð¸Ð½Ð°Ð»ÑŒÐ½Ñ‹Ð¼Ð¸ иÑходниками | Кандидат на reuse; поведение ещё проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾ | +| ÐÐºÑ‚Ð¸Ð²Ð½Ð°Ñ Ð·Ð°Ð²Ð¸ÑимоÑÑ‚ÑŒ Windows/LCL/desktop GL | ИÑÑледовать минимальное отделение платформенной чаÑти | +| ОтÑутÑтвует source unit / package | Проверить комплектноÑÑ‚ÑŒ иÑходников, уÑловные defines и пакет Ð´Ð»Ñ Android | +| Undefined reference / отÑутÑтвует native library | Сборка/подключение Android-библиотеки либо адаптер Castle | +| Один и тот же блокер у многих модулей | ИÑправить общий корень и повторить пробы; не Ñчитать Ñто множеÑтвом отдельных перепиÑываний | +| Срабатывает exception при запуÑке | СнÑÑ‚ÑŒ logcat; проверить unit initialization/lifecycle/доÑтуп к данным | + +Ðи один автоматичеÑкий результат здеÑÑŒ не выноÑит решение «напиÑать подÑиÑтему Ñ Ð½ÑƒÐ»Ñ». diff --git a/reports/LATEST.json b/reports/LATEST.json new file mode 100644 index 0000000..9026e0b --- /dev/null +++ b/reports/LATEST.json @@ -0,0 +1,6 @@ +{ + "run_id": "20260908T164542Z-0843e132", + "directory": "reports/runs/20260908T164542Z-0843e132", + "gate": "NOT_BUILDABLE_AS_IS", + "summary": "reports/runs/20260908T164542Z-0843e132/SUMMARY.md" +} diff --git a/reports/preparation/VALIDATION.md b/reports/preparation/VALIDATION.md new file mode 100644 index 0000000..8e96b12 --- /dev/null +++ b/reports/preparation/VALIDATION.md @@ -0,0 +1,27 @@ +# Проверки при подготовке ZIP + +Дата: 8 ÑентÑÐ±Ñ€Ñ 2026 года. Это результаты подготовки кода Ñтенда, **не результаты Android-Ñборки на Ñервере пользователÑ**. + +| Проверка | ФактичеÑкий результат | +|---|---| +| Python unit / pipeline-control tests | **103/103 PASS**, Ñм. `harness-tests.log` | +| Shell syntax | `bash -n build-android.sh test-harness.sh` — PASS | +| Python syntax | `python3 -m compileall -q tools tests` — PASS | +| Реальный preflight без Ñкачиваний | `./build-android.sh --local --no-fetch` — **BLOCKED, exit 2** | +| КомпилÑÑ†Ð¸Ñ Pascal | **NOT_RUN**: FPC/CGE отÑутÑтвуют | +| Android native link и упаковка APK | **NOT_RUN** | +| ЗапуÑк на Android-уÑтройÑтве | **NOT_RUN**: ADB/уÑтройÑтва отÑутÑтвуют | +| Загрузка игровых бинарных реÑурÑов | Ðе выполнÑлаÑÑŒ | +| Загрузка полного upstream в Ñтой Ñреде | Ðе выполнÑлаÑÑŒ; загрузчик предуÑмотрен Ð´Ð»Ñ Ñервера | + +`environment.json` фикÑирует обнаруженные инÑтрументы. ЕÑÑ‚ÑŒ Java, но Ñто не заменÑет FPC, CGE, SDK/NDK и cross-compiler. `actual-preflight-result.json`, `actual-preflight-toolchain.json`, `actual-preflight-SUMMARY.md` — копии дейÑтвительно полученного результата. Пути в Ñтих копиÑÑ… отноÑÑÑ‚ÑÑ Ðº Ñреде подготовки; временный `reports/runs//` не поÑтавлÑетÑÑ, чтобы не оÑтавлÑÑ‚ÑŒ пользователю чужой `LATEST`. + +## Что означает чиÑло 103 + +Это проверки Python-инÑтрументариÑ: выбор только иÑходных текÑтов, защита путей, проверки receipt, ELF/ABI/DT_NEEDED, APK identity, допуÑтимое удаление debug sections, Ð³ÐµÐ½ÐµÑ€Ð°Ñ†Ð¸Ñ targets, правила gate и обработка ошибок. Семь Ñквозных Ñценариев проверÑÑŽÑ‚ оркеÑтратор Ñ Ñвно обозначенными временными **test doubles**, в том чиÑле отÑутÑтвие выходного файла при коде 0 и подменённый APK. + +Эти test doubles **не компилируют Pascal и не показывают ÑовмеÑтимоÑÑ‚ÑŒ KaM Ñ Android**. Они проверÑÑŽÑ‚, что Ñтенд не объÑвит уÑпех при отÑутÑтвующих/неверных результатах. Реальные проекты вÑегда вызывают `castle-engine` Ñ `--os=android` и импортируют оригинальные units по проверенному receipt, без подмен KaM-клаÑÑов. + +## Что должен дать первый Ñерверный запуÑк + +Реальные compile/link/package logs Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð³Ð¾ toolchain и r16020, конкретные активные блокеры и APK только уÑпешно упакованных профилей. Заранее неизвеÑтно, какие иÑходные KaM-корни ÑоберутÑÑ ÐºÐ°Ðº еÑÑ‚ÑŒ. Ðайденный блокер — полезный результат теÑта архитектуры; он не ÑвлÑетÑÑ Ð¾Ð±Ð¾Ñнованием перепиÑÑ‹Ð²Ð°Ð½Ð¸Ñ Ð²Ñего core. diff --git a/reports/preparation/actual-preflight-SUMMARY.md b/reports/preparation/actual-preflight-SUMMARY.md new file mode 100644 index 0000000..d54d4f7 --- /dev/null +++ b/reports/preparation/actual-preflight-SUMMARY.md @@ -0,0 +1,42 @@ +# KaM r16020 — Android architecture probe + +Build ID: `20260908T135846Z-0d69d090` · CPU: `aarch64` · Gate: **BLOCKED** + +Ðет desktop target. УÑпех означает Ñборку выбранных Android-корней, не игровую ÑовмеÑтимоÑÑ‚ÑŒ. + +| Проба | Compile + native link | APK | Ошибка / Ñледующий шаг | +|---|---|---|---| +| platform | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| core_types | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| core_streams | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| mission_tokens | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| mission_info | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| terrain_io | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| sprite_loader | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| terrain_pathfinding | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| mission_world | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| simulation | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| script_vm | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| scripting | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| legacy_render | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| legacy_audio | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | +| integration | BLOCKED | NOT_RUN | castle-engine not installed; no Android compilation attempted | + +## Что уÑтановлено + +`PASS` compile_link = FPC завершилÑÑ ÑƒÑпешно, найден Ñвежий ELF нужного ABI, проверены корневые PPU. Линковка не отключена; требуютÑÑ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»Ñ‘Ð½Ð½Ñ‹Ðµ Ñимволы. `PASS` APK = упаковка завершилаÑÑŒ, проверены ZIP/DEX, правильный ABI, Ñовпадение native library и DT_NEEDED. ПодпиÑÑŒ проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾, еÑли доÑтупен apksigner. `runtime=NOT_RUN` до реального запуÑка на Android. + +`NOT_BUILDABLE_AS_IS` — найдено препÑÑ‚Ñтвие в текущем коде/окружении, а не доказательÑтво, что core надо перепиÑать. Ошибки legacy_render/legacy_audio диагноÑтичеÑкие и не входÑÑ‚ в обÑзательный gate, но их транзитивное попадание в core вÑÑ‘ равно видно. + +## Как принимать решение + +| СвидетельÑтво | Разумное решение | +|---|---| +| Корень ÑобираетÑÑ Ñ Ð¾Ñ€Ð¸Ð³Ð¸Ð½Ð°Ð»ÑŒÐ½Ñ‹Ð¼Ð¸ иÑходниками | Кандидат на reuse; поведение ещё проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾ | +| ÐÐºÑ‚Ð¸Ð²Ð½Ð°Ñ Ð·Ð°Ð²Ð¸ÑимоÑÑ‚ÑŒ Windows/LCL/desktop GL | ИÑÑледовать минимальное отделение платформенной чаÑти | +| ОтÑутÑтвует source unit / package | Проверить комплектноÑÑ‚ÑŒ иÑходников, уÑловные defines и пакет Ð´Ð»Ñ Android | +| Undefined reference / отÑутÑтвует native library | Сборка/подключение Android-библиотеки либо адаптер Castle | +| Один и тот же блокер у многих модулей | ИÑправить общий корень и повторить пробы; не Ñчитать Ñто множеÑтвом отдельных перепиÑываний | +| Срабатывает exception при запуÑке | СнÑÑ‚ÑŒ logcat; проверить unit initialization/lifecycle/доÑтуп к данным | + +Ðи один автоматичеÑкий результат здеÑÑŒ не выноÑит решение «напиÑать подÑиÑтему Ñ Ð½ÑƒÐ»Ñ». diff --git a/reports/preparation/actual-preflight-result.json b/reports/preparation/actual-preflight-result.json new file mode 100644 index 0000000..a0d41f1 --- /dev/null +++ b/reports/preparation/actual-preflight-result.json @@ -0,0 +1,275 @@ +{ + "schema": "kam-android-build/1", + "run_id": "20260908T135846Z-0d69d090", + "cpu": "aarch64", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "desktop_target": false, + "shims": false, + "runtime": "NOT_RUN", + "profiles": [ + { + "id": "platform", + "required": true, + "purpose": "Castle/FPC Android shell, storage, threads, compression, touch, procedural GPU image, audio API, lifecycle", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "core_types", + "required": true, + "purpose": "Original core types, point arithmetic and ABI witness", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "core_streams", + "required": true, + "purpose": "Original serialization stream, records, strings and compression dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "mission_tokens", + "required": true, + "purpose": "Original DAT tokenizer and its real transitive dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "mission_info", + "required": true, + "purpose": "Original MAP/DAT metadata loader dependency and native-link boundary; no world execution", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "terrain_io", + "required": true, + "purpose": "Original terrain binary I/O dependency boundary", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "sprite_loader", + "required": true, + "purpose": "Original RX/RXX loader and its graphics/palette/compression dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "terrain_pathfinding", + "required": true, + "purpose": "Original terrain/pathfinding dependency graph", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "mission_world", + "required": true, + "purpose": "Original full mission loader, buildings/units command dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "simulation", + "required": true, + "purpose": "Original game core dependency graph, not the desktop executable", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "script_vm", + "required": true, + "purpose": "Pinned PascalScript submodule source and ARM ABI support", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "scripting", + "required": true, + "purpose": "KaM scripting integration dependency graph", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "legacy_render", + "required": false, + "purpose": "Diagnostic only: discover original renderer's platform dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "legacy_audio", + "required": false, + "purpose": "Diagnostic only: discover original audio's platform dependencies", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + }, + { + "id": "integration", + "required": true, + "purpose": "Link actual core roots together with Castle in ONE Android native library and APK", + "compile_link": { + "status": "BLOCKED", + "reason": "castle-engine not installed; no Android compilation attempted" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [] + } + ], + "toolchain": { + "castle": { + "status": "NOT_INSTALLED" + }, + "fpc": { + "status": "NOT_INSTALLED" + }, + "java": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.065, + "command": [ + "java", + "-version" + ], + "log": "reports/runs/20260908T135846Z-0d69d090/java-version.log", + "output": "$ java -version\nopenjdk version \"21.0.11\" 2026-04-21\nOpenJDK Runtime Environment (build 21.0.11+10-1-deb13u2-Debian)\nOpenJDK 64-Bit Server VM (build 21.0.11+10-1-deb13u2-Debian, mixed mode, sharing)\n" + }, + "adb": { + "status": "NOT_INSTALLED" + }, + "paths": {} + }, + "gate": "BLOCKED" +} diff --git a/reports/preparation/actual-preflight-toolchain.json b/reports/preparation/actual-preflight-toolchain.json new file mode 100644 index 0000000..df8bbfa --- /dev/null +++ b/reports/preparation/actual-preflight-toolchain.json @@ -0,0 +1,23 @@ +{ + "castle": { + "status": "NOT_INSTALLED" + }, + "fpc": { + "status": "NOT_INSTALLED" + }, + "java": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.065, + "command": [ + "java", + "-version" + ], + "log": "reports/runs/20260908T135846Z-0d69d090/java-version.log", + "output": "$ java -version\nopenjdk version \"21.0.11\" 2026-04-21\nOpenJDK Runtime Environment (build 21.0.11+10-1-deb13u2-Debian)\nOpenJDK 64-Bit Server VM (build 21.0.11+10-1-deb13u2-Debian, mixed mode, sharing)\n" + }, + "adb": { + "status": "NOT_INSTALLED" + }, + "paths": {} +} diff --git a/reports/preparation/android-preflight.log b/reports/preparation/android-preflight.log new file mode 100644 index 0000000..d6842a7 --- /dev/null +++ b/reports/preparation/android-preflight.log @@ -0,0 +1,6 @@ + +BLOCKED +Report: /mnt/data/kam-android-architecture-probe-r16020/reports/runs/20260908T135846Z-0d69d090/SUMMARY.md +Evidence (no game assets): /mnt/data/kam-android-architecture-probe-r16020/reports/runs/20260908T135846Z-0d69d090/evidence.zip + +ACTUAL_EXIT_CODE=2 diff --git a/reports/preparation/environment.json b/reports/preparation/environment.json new file mode 100644 index 0000000..d9bce68 --- /dev/null +++ b/reports/preparation/environment.json @@ -0,0 +1,22 @@ +{ + "python": "3.13.5 (main, Jul 15 2026, 20:25:40) [GCC 14.2.0]", + "platform": "Linux-6.18.35-x86_64-with-glibc2.41", + "tools": { + "fpc": null, + "castle-engine": null, + "docker": null, + "adb": null, + "java": "/usr/bin/java" + }, + "actual_command": "./build-android.sh --local --no-fetch", + "actual_gate": "BLOCKED", + "pascal_compile_executed": false, + "android_native_link_executed": false, + "apk_packaging_executed": false, + "device_execution": false, + "game_resource_downloads": false, + "upstream_source_downloads_in_preparation": false, + "harness_tests_passed": 103, + "harness_end_to_end_compilers": "explicit temporary test doubles only", + "note": "No FPC/CGE/Docker/ADB available. Java exists; no Android build was attempted." +} diff --git a/reports/preparation/harness-tests.log b/reports/preparation/harness-tests.log new file mode 100644 index 0000000..317572a --- /dev/null +++ b/reports/preparation/harness-tests.log @@ -0,0 +1,108 @@ +test_all_stages_can_reach_build_gate_with_test_double (test_pipeline.PipelineTests.test_all_stages_can_reach_build_gate_with_test_double) ... ok +test_core_failure_does_not_stop_later_probes (test_pipeline.PipelineTests.test_core_failure_does_not_stop_later_probes) ... ok +test_missing_sources_do_not_block_independent_platform_probe (test_pipeline.PipelineTests.test_missing_sources_do_not_block_independent_platform_probe) ... ok +test_no_resource_data_in_evidence (test_pipeline.PipelineTests.test_no_resource_data_in_evidence) ... ok +test_partial_selection_never_means_whole_architecture_ready (test_pipeline.PipelineTests.test_partial_selection_never_means_whole_architecture_ready) ... ok +test_stale_apk_library_rejected_end_to_end (test_pipeline.PipelineTests.test_stale_apk_library_rejected_end_to_end) ... ok +test_zero_exit_without_library_is_not_a_pass (test_pipeline.PipelineTests.test_zero_exit_without_library_is_not_a_pass) ... ok +test_apk_container_accepts_matching_mock_library (test_probe.ArtifactTests.test_apk_container_accepts_matching_mock_library) ... ok +test_apk_debug_stripping_not_false_stale_failure (test_probe.ArtifactTests.test_apk_debug_stripping_not_false_stale_failure) ... ok +test_apk_runtime_change_rejected_with_stripping (test_probe.ArtifactTests.test_apk_runtime_change_rejected_with_stripping) ... ok +test_arm64_elf (test_probe.ArtifactTests.test_arm64_elf) ... ok +test_arm_elf (test_probe.ArtifactTests.test_arm_elf) ... ok +test_bad_headers_rejected (test_probe.ArtifactTests.test_bad_headers_rejected) ... ok +test_identity_no_sections_cannot_bypass_sha (test_probe.ArtifactTests.test_identity_no_sections_cannot_bypass_sha) ... ok +test_missing_dex_rejected (test_probe.ArtifactTests.test_missing_dex_rejected) ... ok +test_needed_parsed (test_probe.ArtifactTests.test_needed_parsed) ... ok +test_random_nonelf_rejected (test_probe.ArtifactTests.test_random_nonelf_rejected) ... ok +test_runtime_identity_detects_changed_code (test_probe.ArtifactTests.test_runtime_identity_detects_changed_code) ... ok +test_runtime_identity_ignores_debug_only_changes (test_probe.ArtifactTests.test_runtime_identity_ignores_debug_only_changes) ... ok +test_stale_apk_library_rejected (test_probe.ArtifactTests.test_stale_apk_library_rejected) ... ok +test_textrel_rejected (test_probe.ArtifactTests.test_textrel_rejected) ... ok +test_unpackaged_dependency_rejected (test_probe.ArtifactTests.test_unpackaged_dependency_rejected) ... ok +test_wrong_abi_rejected (test_probe.ArtifactTests.test_wrong_abi_rejected) ... ok +test_x86_android_elf (test_probe.ArtifactTests.test_x86_android_elf) ... ok +test_empty_pass_is_not_runtime_success (test_probe.DeviceValidationTests.test_empty_pass_is_not_runtime_success) ... ok +test_missing_frame_evidence (test_probe.DeviceValidationTests.test_missing_frame_evidence) ... ok +test_scoped_report_path (test_probe.DeviceValidationTests.test_scoped_report_path) ... ok +test_stale_report_rejected (test_probe.DeviceValidationTests.test_stale_report_rejected) ... ok +test_actual_point_calls (test_probe.GenerationTests.test_actual_point_calls) ... ok +test_actual_stream_calls (test_probe.GenerationTests.test_actual_stream_calls) ... ok +test_asset_symlinks_rejected (test_probe.GenerationTests.test_asset_symlinks_rejected) ... ok +test_audit_flags_are_hints (test_probe.GenerationTests.test_audit_flags_are_hints) ... ok +test_empty_platform_has_no_core_imports (test_probe.GenerationTests.test_empty_platform_has_no_core_imports) ... ok +test_fresh_target_required (test_probe.GenerationTests.test_fresh_target_required) ... ok +test_manifest_no_standalone_target (test_probe.GenerationTests.test_manifest_no_standalone_target) ... ok +test_no_asset_network_call_by_default (test_probe.GenerationTests.test_no_asset_network_call_by_default) ... ok +test_optional_assets_preserved (test_probe.GenerationTests.test_optional_assets_preserved) ... ok +test_blocked_is_not_pass (test_probe.OrchestrationTests.test_blocked_is_not_pass) ... ok +test_core_failure_fails_gate (test_probe.OrchestrationTests.test_core_failure_fails_gate) ... ok +test_failed_subprocess_not_swallowed (test_probe.OrchestrationTests.test_failed_subprocess_not_swallowed) ... ok +test_full_gate (test_probe.OrchestrationTests.test_full_gate) ... ok +test_invalid_profile_rejected (test_probe.OrchestrationTests.test_invalid_profile_rejected) ... ok +test_lcl_classification (test_probe.OrchestrationTests.test_lcl_classification) ... ok +test_linker_strictness (test_probe.OrchestrationTests.test_linker_strictness) ... ok +test_missing_apk_does_not_pass (test_probe.OrchestrationTests.test_missing_apk_does_not_pass) ... ok +test_missing_required_row (test_probe.OrchestrationTests.test_missing_required_row) ... ok +test_missing_tool_is_blocked (test_probe.OrchestrationTests.test_missing_tool_is_blocked) ... ok +test_no_native_host_target (test_probe.OrchestrationTests.test_no_native_host_target) ... ok +test_no_smart_link_elimination (test_probe.OrchestrationTests.test_no_smart_link_elimination) ... ok +test_no_vacuous_pass (test_probe.OrchestrationTests.test_no_vacuous_pass) ... ok +test_optional_legacy_failure_recorded_not_mandatory (test_probe.OrchestrationTests.test_optional_legacy_failure_recorded_not_mandatory) ... ok +test_platform_alone_is_not_core_success (test_probe.OrchestrationTests.test_platform_alone_is_not_core_success) ... ok +test_platform_baseline_added (test_probe.OrchestrationTests.test_platform_baseline_added) ... ok +test_accept_path_00 (test_probe.PathsTests.test_accept_path_00) ... ok +test_accept_path_01 (test_probe.PathsTests.test_accept_path_01) ... ok +test_accept_path_02 (test_probe.PathsTests.test_accept_path_02) ... ok +test_accept_path_03 (test_probe.PathsTests.test_accept_path_03) ... ok +test_reject_path_00 (test_probe.PathsTests.test_reject_path_00) ... ok +test_reject_path_01 (test_probe.PathsTests.test_reject_path_01) ... ok +test_reject_path_02 (test_probe.PathsTests.test_reject_path_02) ... ok +test_reject_path_03 (test_probe.PathsTests.test_reject_path_03) ... ok +test_reject_path_04 (test_probe.PathsTests.test_reject_path_04) ... ok +test_reject_path_05 (test_probe.PathsTests.test_reject_path_05) ... ok +test_reject_path_06 (test_probe.PathsTests.test_reject_path_06) ... ok +test_reject_path_07 (test_probe.PathsTests.test_reject_path_07) ... ok +test_reject_path_08 (test_probe.PathsTests.test_reject_path_08) ... ok +test_reject_path_09 (test_probe.PathsTests.test_reject_path_09) ... ok +test_reject_path_10 (test_probe.PathsTests.test_reject_path_10) ... ok +test_reject_path_11 (test_probe.PathsTests.test_reject_path_11) ... ok +test_cached_native_units_rejected (test_probe.ReceiptTests.test_cached_native_units_rejected) ... ok +test_empty_receipt_rejected (test_probe.ReceiptTests.test_empty_receipt_rejected) ... ok +test_modified_source_rejected (test_probe.ReceiptTests.test_modified_source_rejected) ... ok +test_unrecorded_source_rejected (test_probe.ReceiptTests.test_unrecorded_source_rejected) ... ok +test_valid_receipt (test_probe.ReceiptTests.test_valid_receipt) ... ok +test_wrong_commit_rejected (test_probe.ReceiptTests.test_wrong_commit_rejected) ... ok +test_binary_or_unneeded_excluded_00 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_00) ... ok +test_binary_or_unneeded_excluded_01 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_01) ... ok +test_binary_or_unneeded_excluded_02 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_02) ... ok +test_binary_or_unneeded_excluded_03 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_03) ... ok +test_binary_or_unneeded_excluded_04 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_04) ... ok +test_binary_or_unneeded_excluded_05 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_05) ... ok +test_binary_or_unneeded_excluded_06 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_06) ... ok +test_binary_or_unneeded_excluded_07 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_07) ... ok +test_binary_or_unneeded_excluded_08 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_08) ... ok +test_binary_or_unneeded_excluded_09 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_09) ... ok +test_binary_or_unneeded_excluded_10 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_10) ... ok +test_binary_or_unneeded_excluded_11 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_11) ... ok +test_binary_or_unneeded_excluded_12 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_12) ... ok +test_binary_or_unneeded_excluded_13 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_13) ... ok +test_binary_or_unneeded_excluded_14 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_14) ... ok +test_binary_or_unneeded_excluded_15 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_15) ... ok +test_binary_or_unneeded_excluded_16 (test_probe.SourceSelectionTests.test_binary_or_unneeded_excluded_16) ... ok +test_excludes_symlinks_and_gitlinks (test_probe.SourceSelectionTests.test_excludes_symlinks_and_gitlinks) ... ok +test_keeps_case_and_sha (test_probe.SourceSelectionTests.test_keeps_case_and_sha) ... ok +test_known_git_blob (test_probe.SourceSelectionTests.test_known_git_blob) ... ok +test_source_allowed_00 (test_probe.SourceSelectionTests.test_source_allowed_00) ... ok +test_source_allowed_01 (test_probe.SourceSelectionTests.test_source_allowed_01) ... ok +test_source_allowed_02 (test_probe.SourceSelectionTests.test_source_allowed_02) ... ok +test_source_allowed_03 (test_probe.SourceSelectionTests.test_source_allowed_03) ... ok +test_source_allowed_04 (test_probe.SourceSelectionTests.test_source_allowed_04) ... ok +test_source_allowed_05 (test_probe.SourceSelectionTests.test_source_allowed_05) ... ok +test_source_allowed_06 (test_probe.SourceSelectionTests.test_source_allowed_06) ... ok +test_source_allowed_07 (test_probe.SourceSelectionTests.test_source_allowed_07) ... ok + +---------------------------------------------------------------------- +Ran 103 tests in 9.002s + +OK diff --git a/reports/preparation/manifest-validation.json b/reports/preparation/manifest-validation.json new file mode 100644 index 0000000..1deb6ac --- /dev/null +++ b/reports/preparation/manifest-validation.json @@ -0,0 +1,92 @@ +[ + { + "profile": "platform", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "core_types", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "core_streams", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "mission_tokens", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "mission_info", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "terrain_io", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "sprite_loader", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "terrain_pathfinding", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "mission_world", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "simulation", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "script_vm", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "scripting", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "legacy_render", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "legacy_audio", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + }, + { + "profile": "integration", + "generated_xml": "PASS", + "assets": 0, + "compilation": "NOT_RUN" + } +] diff --git a/reports/runs/20260908T164541Z-61b94997/docker-command.json b/reports/runs/20260908T164541Z-61b94997/docker-command.json new file mode 100644 index 0000000..ccdc604 --- /dev/null +++ b/reports/runs/20260908T164541Z-61b94997/docker-command.json @@ -0,0 +1,28 @@ +{ + "command": [ + "docker", + "run", + "--rm", + "--platform=linux/amd64", + "--user", + "0:0", + "-e", + "HOME=/work/.cache/home", + "-v", + "/codex/kam/src/kam-android-architecture-probe-r16020:/work", + "-w", + "/work", + "--entrypoint", + "python3", + "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "tools/runner.py", + "--local", + "--cpu", + "aarch64", + "--profiles", + "all", + "--timeout", + "1800" + ], + "image": "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218" +} diff --git a/reports/runs/20260908T164542Z-0843e132/SUMMARY.md b/reports/runs/20260908T164542Z-0843e132/SUMMARY.md new file mode 100644 index 0000000..f9fd860 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/SUMMARY.md @@ -0,0 +1,42 @@ +# KaM r16020 — Android architecture probe + +Build ID: `20260908T164542Z-0843e132` · CPU: `aarch64` · Gate: **NOT_BUILDABLE_AS_IS** + +Ðет desktop target. УÑпех означает Ñборку выбранных Android-корней, не игровую ÑовмеÑтимоÑÑ‚ÑŒ. + +| Проба | Compile + native link | APK | Ошибка / Ñледующий шаг | +|---|---|---|---| +| platform | FAIL | NOT_RUN | /work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" | +| core_types | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| core_streams | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| mission_tokens | FAIL | NOT_RUN | /work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" | +| mission_info | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| terrain_io | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| sprite_loader | FAIL | NOT_RUN | /work/vendor/kam_remake/src/res/KM_ResSprites.pas(5,17) Fatal: Can't find unit LCLIntf used by KM_ResSprites | +| terrain_pathfinding | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/KromUtils.pas(7,18) Fatal: Can't find unit LCLType used by KromUtils | +| mission_world | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | +| simulation | FAIL | NOT_RUN | /work/vendor/kam_remake/src/settings/KM_GameSettings.pas(6,15) Fatal: Can't find unit Forms used by KM_GameSettings | +| script_vm | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,13) Error: Illegal expression | +| scripting | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(116,5) Error: Wrong number of parameters specified for call to "Invoke" | +| legacy_render | FAIL | NOT_RUN | /work/vendor/kam_remake/src/render/KM_Render.pas(6,17) Fatal: Can't find unit LCLIntf used by KM_Render | +| legacy_audio | FAIL | NOT_RUN | /work/vendor/kam_remake/src/ext/openal.pas(76,1) Fatal: Syntax error, "identifier" expected but "TYPE" found | +| integration | FAIL | NOT_RUN | /work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO | + +## Что уÑтановлено + +`PASS` compile_link = FPC завершилÑÑ ÑƒÑпешно, найден Ñвежий ELF нужного ABI, проверены корневые PPU. Линковка не отключена; требуютÑÑ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»Ñ‘Ð½Ð½Ñ‹Ðµ Ñимволы. `PASS` APK = упаковка завершилаÑÑŒ, проверены ZIP/DEX, правильный ABI, Ñовпадение native library и DT_NEEDED. ПодпиÑÑŒ проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾, еÑли доÑтупен apksigner. `runtime=NOT_RUN` до реального запуÑка на Android. + +`NOT_BUILDABLE_AS_IS` — найдено препÑÑ‚Ñтвие в текущем коде/окружении, а не доказательÑтво, что core надо перепиÑать. Ошибки legacy_render/legacy_audio диагноÑтичеÑкие и не входÑÑ‚ в обÑзательный gate, но их транзитивное попадание в core вÑÑ‘ равно видно. + +## Как принимать решение + +| СвидетельÑтво | Разумное решение | +|---|---| +| Корень ÑобираетÑÑ Ñ Ð¾Ñ€Ð¸Ð³Ð¸Ð½Ð°Ð»ÑŒÐ½Ñ‹Ð¼Ð¸ иÑходниками | Кандидат на reuse; поведение ещё проверÑетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾ | +| ÐÐºÑ‚Ð¸Ð²Ð½Ð°Ñ Ð·Ð°Ð²Ð¸ÑимоÑÑ‚ÑŒ Windows/LCL/desktop GL | ИÑÑледовать минимальное отделение платформенной чаÑти | +| ОтÑутÑтвует source unit / package | Проверить комплектноÑÑ‚ÑŒ иÑходников, уÑловные defines и пакет Ð´Ð»Ñ Android | +| Undefined reference / отÑутÑтвует native library | Сборка/подключение Android-библиотеки либо адаптер Castle | +| Один и тот же блокер у многих модулей | ИÑправить общий корень и повторить пробы; не Ñчитать Ñто множеÑтвом отдельных перепиÑываний | +| Срабатывает exception при запуÑке | СнÑÑ‚ÑŒ logcat; проверить unit initialization/lifecycle/доÑтуп к данным | + +Ðи один автоматичеÑкий результат здеÑÑŒ не выноÑит решение «напиÑать подÑиÑтему Ñ Ð½ÑƒÐ»Ñ». diff --git a/reports/runs/20260908T164542Z-0843e132/adb-version.log b/reports/runs/20260908T164542Z-0843e132/adb-version.log new file mode 100644 index 0000000..a20b644 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/adb-version.log @@ -0,0 +1,5 @@ +$ adb version +Android Debug Bridge version 1.0.41 +Version 37.0.1-15733141 +Installed as /usr/local/android/android-sdk/platform-tools/adb +Running on Linux 6.8.0-139-generic (x86_64) diff --git a/reports/runs/20260908T164542Z-0843e132/castle-version.log b/reports/runs/20260908T164542Z-0843e132/castle-version.log new file mode 100644 index 0000000..6158311 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/castle-version.log @@ -0,0 +1,2 @@ +$ castle-engine --version +castle-engine 7.0-alpha.3.snapshot diff --git a/reports/runs/20260908T164542Z-0843e132/core_streams/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/core_streams/CastleEngineManifest.xml new file mode 100644 index 0000000..b02d2f1 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_streams/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/core_streams/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/core_streams/ProbeImports.pas new file mode 100644 index 0000000..0b85e56 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_streams/ProbeImports.pas @@ -0,0 +1,31 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_CommonClasses, KM_Points; +procedure RunUpstreamChecks(R:TProbeReport); +var P,Q:TKMPoint; + S:TKMemoryStreamBinary; I:Integer; U:UnicodeString; +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_CommonClasses, KM_Points; this does not execute a game world'); + try + P:=KMPoint(17,-3); Q:=KMPointRight(P); + R.Check('core.points',(P.X=17) and (P.Y=-3) and (Q.X=18) and (Q.Y=-3), + 'Calls original KMPoint / KMPointRight, not a local replacement'); + R.Check('core.point_layout',(SizeOf(TKMPoint)=8) and (SizeOf(TKMPointF)=8), + Format('TKMPoint=%d TKMPointF=%d',[SizeOf(TKMPoint),SizeOf(TKMPointF)])); + except on E:Exception do R.Add('core.points','FAIL',E.ClassName+': '+E.Message);end; + try + S:=TKMemoryStreamBinary.Create; + try + S.Write(Integer(123456)); S.Write(P); S.WriteW(UnicodeString('KaM Android')); + S.Position:=0; S.Read(I); S.Read(Q); S.ReadW(U); + R.Check('core.stream_roundtrip',(I=123456) and (Q.X=P.X) and (Q.Y=P.Y) + and (U=UnicodeString('KaM Android')) and (S.Position=S.Size), + 'Calls original TKMemoryStreamBinary Read/Write/ReadW/WriteW'); + finally S.Free;end; + except on E:Exception do R.Add('core.stream_roundtrip','FAIL',E.ClassName+': '+E.Message);end; +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log b/reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log new file mode 100644 index 0000000..14765ed --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_core_streams" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/core_streams/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/core_streams/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/core_streams/target.json b/reports/runs/20260908T164542Z-0843e132/core_streams/target.json new file mode 100644 index 0000000..bee75b5 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_streams/target.json @@ -0,0 +1,92 @@ +{ + "profile": "core_streams", + "name": "kam_probe_core_streams", + "package": "org.kammobile.archprobe.corestreams", + "cpu": "aarch64", + "units": [ + "KM_CommonClasses", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/core_types/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/core_types/CastleEngineManifest.xml new file mode 100644 index 0000000..f6a6f9b --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_types/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/core_types/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/core_types/ProbeImports.pas new file mode 100644 index 0000000..a302671 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_types/ProbeImports.pas @@ -0,0 +1,20 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_CommonTypes, KM_Points; +procedure RunUpstreamChecks(R:TProbeReport); +var P,Q:TKMPoint; +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_CommonTypes, KM_Points; this does not execute a game world'); + try + P:=KMPoint(17,-3); Q:=KMPointRight(P); + R.Check('core.points',(P.X=17) and (P.Y=-3) and (Q.X=18) and (Q.Y=-3), + 'Calls original KMPoint / KMPointRight, not a local replacement'); + R.Check('core.point_layout',(SizeOf(TKMPoint)=8) and (SizeOf(TKMPointF)=8), + Format('TKMPoint=%d TKMPointF=%d',[SizeOf(TKMPoint),SizeOf(TKMPointF)])); + except on E:Exception do R.Add('core.points','FAIL',E.ClassName+': '+E.Message);end; +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log b/reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log new file mode 100644 index 0000000..3394e10 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_core_types" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/core_types/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/core_types/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/core_types/target.json b/reports/runs/20260908T164542Z-0843e132/core_types/target.json new file mode 100644 index 0000000..091a3ac --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/core_types/target.json @@ -0,0 +1,92 @@ +{ + "profile": "core_types", + "name": "kam_probe_core_types", + "package": "org.kammobile.archprobe.coretypes", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/evidence.zip b/reports/runs/20260908T164542Z-0843e132/evidence.zip new file mode 100644 index 0000000000000000000000000000000000000000..90d0cfce70e9cc44ba7214c1be5c668c239053f4 GIT binary patch literal 256870 zcmd42Q*@@?*1s85Y_pPzZL5MxDyZ0Y#ZE;P+qP}nwr$%s|4-ii?eE3z-aWdH`rtmv z7#UBpo;BCHesf;8v^XdjDi9D5Bv42&xdw=ggkLuV5YPY$5D+xrr*aAs68y3%wC4Jw z%34x5O6czQ`Rs%U%RfCkeJ0GZxDn|i(V|pY%p9I|{VsjOFvpddwuws|fvOZ#J6Y9? z@fAy(%xC?1Zw!8%^mxF@@^+3WEl5?h+n&`{8b`6pC=CgAIiB(Czm2u8^BB@j;yu&) zJ}wp>QaqiHwHu9<`+2I7aM|(x(%bC`m6qXwos*|^DBg5dprlpLpFJ!*TrB)5p`kW5 zKBk_U_@=LWv^0Vi+s@c3Mwd42V*Kg1*&G8Gk)_3QWs_t)-TJdtqm5~9Lk+!yX`yr? zl~T~|aJ+5f&2mlZsf>b9vbA*n0z8{Mx9DN`qJ^_x?l?J*M0$QJ^Wf+Fz>{7vCZ19I zsqGV_T>nM4rJiuG-_DD?U?E>n4l7TNa!+rJQXc4XQ*S6VQw5G>?nq3#^p<>=R?QHC zHAFTjxDrNo>nL6&?^vgO>Wp~{W;LWH@dxYm?%N2*Z`m&0%IqNC^WO(~{asKDN%bqY zP;i&GfD}mr|FfO$Q zD^cQHKQgT#r6DVzJg(D_bGM)MZmv6)nmavcO+@IsmOGdG0_%Oj*{HDFf7Vni@QN9U zFD)@UccELdv22=F6vm)z<0Y-IRoWD!33t|ZRm^W>zEmq#U~-pNl{Ha`U3n}NhokIp zrii}TwB--7bL8lD=c-zxx7;jwUH9&vFsIQj2DctMXbXbBr0sQVDNQ7+pt_vp>1F#( z2A8t=ZcMwVQDz6+jRc-G_8nWk9lcM6r~Nnm^O1%-kE4=0MlrpQ2HJfpKkBR?qINIL z2_^S~Uxol0Lt41JJUWXE{xn2+PYrXs{LS{Q4)gvN5pU7*Wj=NP!upVkLsv#!my{Q@ zirwk2f;gGG{eq_~qC_7QYo-<|Pg_&C3j(WFiY$>{h8wYihNYps`i&&KaV=MpGNA|y z<`6?=^=un~`p-&d?S89T@M1h6G%4o`X);JGb0++?n-s;k%mUw4LS+|M#50AR&42#n zb~osN6&jbrsr!DUgXe@5s0SXfMi}UZCo|cOaFkTfV>xx3dVlq}cv%d}j_(gVc7xOP zqmy&?6md+z=6eChF1@b;R6XV5$U6?7eK$_q? zPnAoM>y(f0Uw0Fl?EFq(3#ggA?mYm}47 zYFwb~>#Fe%izNx(zs-oqJ#Ykzi^u1DHx8b)9`=1bWHPRU77tb){k%zr|A>mYXMy&` zIq^YA* zC`riFL2+UGDA!yrxdBk3`vm_5tEf|{sLFJ;f#eGKI+E`1nis&T8>=T9xxy~8)G9E( z?FlS#y6JcWmEV`_rjM_Xw&+ic((9{CGx01kdGdUBhgt=6GAn@aT_6I{i8)=)1}Ya( z&U!*CF9KO_I(%|zPA&Z}RO_eBu=)qeEQQbf!jH0ND?EG33X@5NlnmGcg+#UD!6a9# zNGsVqMV@GQn{H;~N6?BH$6*a2iYLEt45vX}@LVDZI0ry(@%)5hK02+Tg6fn-f5YvT zmn1wbhc`Pm6bM$b2I>gpM#L$-;JZ_vO2bir%O(N((b1Dh?Z=?!Xmt?6n8G5!AU(MW z>}5XL4V|Cy@NMJ(Q{8{j5H`J3f7#K6zrs&CDP^HUnG_978xK|@s!u&*{4)A`rXUnw zvQBzZiRh0xzH-)6M3FYaXzQ$?)TOO{QH^&kTVd06hi^^AaPfTIHqil$=C9g0%NTe= z*R%I0raf7v+Mz=T;R+>3riI33p`fV`63VsN``;xb$d5S2 zUYymIr=yi?77$ZIGeO>0C(<~X4J^55$J#vn-SiG2!}H(2&E0}VT+m8@;t78K$(I|> z-`nXu(8XeKo4>z2@_5)@**%hOQ((`oHWA*D(Y7RrImVw3HGg8@j)C#Zz|%o5z?GV~ zrhjZ;aAr7;`$!3Os~gmrxYVPKj9UF_EUz`wh+fKc>&Qr6-Asd{lE(fX9Q=(CG6Hwr zp(D^}GDTIPA!dTqc7fTQ5ezc5!{OBu8`i#eUadG_zDXbyIE&=2y~hWphkVhPmoq1j zB+?>u1?;4u)89W&o|#;_WjSssE?uGwNkh!ACF*oTH&j;&%R%ht?E*R}V%;_tL=FWy z{;=EI-XzP;fbTFxCq8zM_jl5_{do_2l4_4PSe-I14eTYu7Z!afCGWM;>e|H9^@$vi zac*=)`rKy(9X9W+#7D=jc-4CWvEls$nKi)?c(_Ph<7{`t0tuNi3=W{9%2 zR`4ZGLY^H2jdlBP5=%tGw)3&oyBWrKZJ7aqMYHc=U}|-{ z$MXKfbI5Vuev3sfK!V~QCI@2$1)54lciZYPHFCpooF9W3T47L}^p1B43f6nWON!T> zixK`pa?LACOS#_Z9n?Q_m;T?YzSfsqBO?#SS4=$^qhB6+jz8H@1;EqDU(f2OWaxpK7DPapz$G1!F3<|zA1vWLg8cm-=&Q)D zW&-@-Jb(uo@aXB-+L;;r^?#6)5s{>(9Tc6F7!@BM5m%U)r4gs092*(m7C>X0XPS^0 zp%@UEVVa{F6Q?F08=%_+0s8YJZ2ZVIzB~m|IDi5HL7@Wyk$ilFrHz4>t(}d5j=3$J z;2)nSWMOD*VIZMnVf@p;){fTE+^kkv+;W*6vF%<7vTcW$Nr*CVvG4e zBBQ5r1P))7H>IK7%|EJ2qkkElD+m~m*rv_0V6$alt2SNKmLke(tAwbtCCkoHk4wM_Q=Cww7jA(;IGfg;lYU-l;^%P%6?D@G*4hIJ~Zj6CUQ$?^b)2Im>@Bg@oS)+?9MLybyYhzs}AcW^lk z*z4k+7Lhk&gfE$eN1*KeB(q9Ql!AS_+OpnM;G&Z5>RIu;WAQ|c1g69+>|E@^66Y_XgNo)UUpI**Lq;Ceno zFbYB=^eK3!YAi$qyGjwAk~e^#n0~r*8jGGjhI!W}y1Vxn#LXsQYpFp}h;;ixHFDl3 zy|OV_y!2@x4x{*lM{V)I#N1?;41eGY$j&fl57Jh-oCZ+pBt z$^(04&aG??wcBEH&~Z3nzOmVcv3HDBgzTthc4=2WZZ{0RF1GpA`l4P&OV_rd8Fx+R z(2il2fV*&)A%y2z;rxCE@Be(R;-*=#dAmE(JOAQutL4skAFu|^R_sWe{=vwsv0Rr;*1O$Zl&&rjyvD7sX zHMg>~v9qPM(y@(|Teg_yLv+1Y8WD^%pKXW%5vqGZ%=-3?WTPh(TA*ObIe!rP_q=L( zX68{lQyXimbZq?X$=GYkwiq;Mr6LCVFifrlmg@ZP#w|$PYF#3WvU}dMb!7qUnRsfU zV#-Q0lsIKFAH__Cpq44fVX?BHDI@(yNAJV&DHZU1u1X7|z?K2}@5Tv8Vs*1o=8cSm zRGnOj>EQ}#R2*ZMz(ux!ms)!>v zK&3`;kAS$CvCwAC0xN@rEri`b%ZugLuK3B(Wtq!l(R>RnYU-Sj zrD+6K1x~}h%HM`JUfqZy7|YLY?Pd2FYY6p;2<5WWu;ftD+EWX}3cC3iop=PNhemgU zccgBD$A(*`>+l_G=?}Kl;&sAo-v%8T#k~#~@SgOl;Oc;GD^X9=jddmtiH~sGc%85B z@ZdNdx740T8i};}d39_tMayCdfPZbwv*;-VITsT+E09GyHZs{l*fJ!@TZ=Rgt3DH@ zm@0@$u0rctp#Pd)g$~rO%O;*mTt@T0`-R5CVg3Du-ZJKa#T4`u0qqg9M%vP5g1~Nq zdUnaM6_@UK#7vw@ibZ#PzFPkR(RUv@>#NH#-Je@`3~=duZbJ3;2W(w0Ko0+pt*d8g zZe+cRzJT4wyYGl?PCRC_h+8L)Q#ZyKyQ8F{5DYkMaRWoW$ zMZVvd)@ME?#?o4A>aLk({+?E=k;<%-#(Bkof#~EZpVQxIpsnew{RQr10J>lVI?vXj zUD@QlK|Yuf4Z}x%0gYIL+*whtP6LErX@m;}>tCaTsMBlSNkYxZx{zHdKqcaLN$;0_ zNj|n<)Fpgau2^L&m2=w}a5~nhGU;!`DFJ?C4E6{dCyUdGrY;($&>G2Sm9ZLzd%xh# zdQWZXL!IcrlN3f;FB2Cw{m`$?EQ%5mmCzaz12;$=S^9!iLhSHO2F}!Cyw4hw#Pwk; zG|S_smCCFvY8UY9VfX}|Nlvsve*mkn5~7Q&;z|uZ*akD0gP7y{>RdZ`NHz)(zRxm$ zDIO)+ftc7CyNJ2@_qU`PUw5P*-`l<`m~^|$VU|4bFq%Sxlu(u~%*NklX{<(7nPZLT zZ$7jjXo>y;UvDs*cpBlKl{ad*R{lKQ6?Q&px(6A9JNb;HwvHc(K5r+|7|78b%V3W_NLh}w_2iF0( z67!#jubqyKp@AK(iLIqYX}pBxGCi!{`70X#nC&ktKb?A)OqeMep=fkazs?NvzByfS z5E7PAzt{Ug`=~scrOIH-xR;h02#TO5*SX_cxWicL%J;%~DHa_wyf5-~?`3a=876Nf znL(fl+Ak>#5oKR2=_MYW_^49Bg7^81Cj-VzCy69XTt)>$T^!f%oJdmPTGs`Mm<_eI zBH{C93cyS&(du56REs?P?!twQYx7a{K+D(}30RZnw%`@=L}y?KO0+|NbJ4w^$H{^d z^4S#Br~rq{huIl(oQTQwf?O}T;*M1-%6SYaZ=)~aJDsppfp}xV^!xyUi4g-Y=AKa< zv<>%ahBogMn6$3oR8^8Sklm%mHC8Y|7t6#5{9cu!FBjFvKxQ&IOFmp7NEks4QM2gz z$!|f=H^w2#VT}(w-vV6jEE1(rzgMf+`$cQB+6SVbG8`f?s)`m_TFlf<6V;$qQz@D1-9#K zVno#2dLL~?Q6=p^mgaq{$};~-q*HI^=H?$`hIf~jEp(o(%xr+BqG_r(um29a%;#(DCQUk_jFc&51eb@$bc|f6aH1kSoVgn^Ui{(S4)!%y;Vz8egpvGl`YK@1zy2Tl= z&%TEVuV;1N*Jq#qLZ!falvegndd=)wyxlj}w^lO4?Yqu%z3MC7GitfKAk-YmQ@Ye; zY-&vF@lM{|htPOkGRN;~o;Uwe+|&py-dFwA&>i^CvmF&s8H5WmBfkKF0u&G^i2hv} zc1~6X|1C}oTP$-TuHI9DSyn|QW+iX^5huzb>ptRyWJYi02oA42AWmqlXXa!`tU#QR zgVaO}aQM$yX{KzgdMhr%f20ZA*0j&~2HKQVIfYVTx(hp&;cKIsXra~b{AeF(;>Q^v zP3XfJ7~sX|tb3&Eqge{*CaPZ{EUrKr=01=;t9bQS)Rv(R zy0(AHIHSZK3FXX*!f>q!SRs*CE2${n1P$7&3#G89wI#MmnnJ!f+HwynQ{6WFG*4S>UI?5w_GFB z0d15Ng*3=@<@~}0eRX-G97@yVA5lTIlb~oNlW<^YFakD|ir9gs(UZK5BuM5DlHTjG zlZXKW#7&W;zKWEf4WU)?HQh2+`t-9s^lf4x!8_@9h{#DzE0a>$}nMK<%s$o$gAW{2eF%l&)h95D8)#; z_0|JIIt7Zk?8nEmHb;b6?w9hTAE}|8h>7@KTYXk}(U*o}(Sdmi-pjP3NKrd=pPQqF zw;F+U!v&!LoMd?4EOhG`<9S%8^3h{-O|EdmGie5CP?D}}Kc8{pIPu%n8&PA0(dG+| z!=x6AHtib1Mq|;j+VNb}kxY1d*NYouFWOqm+%wSPm04`70TqshP-tu5xnh$C#^?+9 zxpO`8nLiUN?s-HJm4z7o{8CVXHnV1=?%wb;>74peUlTCek|jb&>Q}IStrhr%DS65u zq#ACFF6_Du&++-s^_rm>R~DhB6H3Q3vX_e{)*N1VHml?pX28enJL>NO?dmDvB5O;# zjxX`QN$~r!-JN?D6UBH6F5{Yk@%Kg}P;dGp`Yh_E0;N`bUl()^9y>8kDn7zQGxLj4 z$*=Y5-b10rCUrMTrG3Nn^6}xv{bYBTIjK7{sSF`B*NP|Ob9nz|K$uXic)NWZS&V8KQe7ebUbT-`JX6Tc30FvO&Y@$p4}34bC_ZS5V-tEGM5cIGxM`4&;Ioa*e%{mkwZ z6a#f|_AOLqe-Z%-?KARK!LK^uMGl`Lruk9?cp;``o!9Apg*qqnqjW9K31io)yW(-hf&VmlXYR*IIA-bvM zlMq=0b)F7_#Hd)KVy0_d)SpM=D(2^lnLB);efIG_YnxA)ozq#m`-Bxfd}C_u7U@Bc z4Cz7@pbu2+z26OW^Lb4UxFT_a+2R-#&UcAN(Z}JUh4s7{F~eMf0bWhw`D;m7YuTZ2 zaO)`uh1zsY+e+^?c$DtURaYguqp%LlF*cGeD`zkpvZN;%=KEVz{CoF3(c$f;Yp6Mp zsdn1vGnXs-(%8eNH*8|HA9PAXBzvRiP43RYcS;2`Gs5pZUHn$##Vj;7>KIEKOL!(Vz-Bd`$2i&*%B%cV zsQMFup9oMN9uR9l{^W39e0bw-g07%tFL7l%{fh5;zKRjB+d8o8+cGJYlRlwS_@(+7 zY3#?|NXx0-)maFWc1f@YvyfMy)VZu)R1HzM#m+>Y8+^@ppUx^F%+FNTAXOOgotg0@ zEV8Nb@-OQFasq&t+nl=+o)IsocUxlDvS5#i;CWja!YJWq$ym5Y6m{f8vQ&AVOj;v;(qsijvmc1z6G?&i&&{43{%Fj%A_QAg%Pm$ygPA*rcvJOi30| z?^}75C3r+`-n#;oO|-BoJIt_fO?~81nWCP&Afu$4ExT*IdY-?ikhs5sGYJsHOr`f& zE5CvNxqClYLuysv+Ztf^mH{XnfE)j6UjBI>Hmecg8{pMLf}upT6{{Sz;?d zq|R9g2#|AHOGXQ#EMFOD@Vhvq`VQI(Dc{k_YbMM1WyxuC(=8p{&#>&Z5!} z?d+uGLWP|QD*$Lqx=Q0~xcu7Dko7`t9SaOKcE5E)$5S%0{8&=`Oy`&2l1}Y05C$@B z&m3~q-OMqhaUSS1Q#%qEq4CZnBaNsbQ8a4Y)2b=znLe2s?xH9uY<#>^4wgC&}mp!9c3=)A%^1hqbUag3yM_C z5P!@)khul(5lCj=_WQkj0crR6}}?6eF$CFV^O5J@0j2aVSy${6CZ*E^;#kv_eN zS+-d|O8SgAOP&Nl(~>Mfd+F+14&vlSpkplWEiGSdJS4g$29sf{_sM9y8BMH=%KupC zP$HrV14&Fs{KN`r4Lo5)i$rt|hiuUr%WBK+>E{#YQNhLb=pnIA=}h$4N)4-(HKIRW z&+R_k{jwV*#P&Rj#*Plp;N*_oP?I4<6JwlEvzqkF=eMt39BNb2Auxo9p;=o$kvf;u zi13iw7!+kHCmRbU_*mvxn~2d&y+A3Ibui`SspY-oDg|I>B!s!h2F7w9B|VpACpQ8I z$eWNj^OPt-7eblkYkFlW0Px;R-wr(jfOq>1qNJiV?^<J)8f(;JKKb`dkvrRlHhPm?j|djt%@%xG zZnzz`8uJc)=w8?|Qte$U0C;CfYYA%g*Z@4|EP1$_&^cuSUSAsXDy!&)l{3u5t%@;?83K!l~#WCBRk?`~jTQs$x(wZAtalC_6J$P!?YNPSqWo@^8^v=aO;(o3*LIOZe7vjQT(FOaL32?WupAc0u z)Kb}khiZChP6=c<0-aSZpMsdR>VT#LVKIMqiV6#z7#ZGGl=0g{vh&eas@Th1-@KqY zCga&C7eJAd1G+9?7ZQwgjHaI}@K zL09y|;iIEr1Fh;Y>dnSOTBo%OFc5A5K-0z+JbwM z^NpO%#AS`(=4YGp*<-eu18q@@9hCbqlEyKljeV2z1>0HJIV5(dT~J0P1$YCg}}c z3w-Av;$l`i@uNzQtwzt^WH&l3%uqtVGBXkZO*ec#+UUXxMvCOyJCtzyUz$z9fSten zOw8#6*!k{&`0~%4|Nop{%#a6qA>m>yOfycwak2;QM6(p)LWuKE-Co1g^K0TMyl*Mv zPEzija<4Ce#Vk^LkcvvBA+savV9F@7g@l5uj4@J@ZQ}FYa*u^Yn1dzcrmE)9Xep_e zXl^XQhtB}4z z4zkaC)*0%-!{C_w&G82gIMUoooO)N)cW)kSagd0RZEM)C+oCDegE10QTB-W@X?)4w ziR!o@$aWF47OAl&^N~=)E25Sl%QggTN|Hmtyg*OwQ5`$ZY8&;0sPubX4hGE_Tf?rH z#kcXZ2bm@4#dPnw$Z@Kp)GKPgde-iQ5gb`}pNgXU%P{(!uaI9c`Cm6hW}(8DFueh- z>UrCh9cdfs*}-*^8T2aL^8-l=T4no$uUo$AwXt)0oohDWF)wA>c+uu;g?Z1+-EEZf zbKPNRI$!VD1}_XjL6U_%(PUnaAex>|LrpA^oQgvnxi*%vP>} z!0#!v+S}{l{4SVm7f7n9NLyu_+sRI0XldNMG9!WU88y*-PCQBiJMzc}ZY3Vg{o zp2YW6MIaJ4CCQy$GmoNMO1R=$LL!2{a0)O>#c>x?7*yd9i=$G zDGlU@OC-m4shGWneSP3+41R)^7<^RqE{)8))y!h6I&&8k!{ zP~682*%aVqm#JZ4s>o#R!oysuuuOu-i>F{ShQU;DTYhKFh*-S9DjL-54|kqabc*K7 zX&hEFHKa0#gPoMeQfyq~8;s}jwzOk1MF#0=$dDF2Rluf5mHEw{Sx(rn4thfM?b|_fz*n6%5q+SkMoHmT@5)REkTLeA#7)nQx#Kcz|90K zY?%bET)_X5P|k5=w?=ox$S13sq(ME`u?$Omcwgzcqo9muY7%DKw2=1U>7DdBOxKE7 zfhr1KQzRFQVGd`siDxr_OfswkOJX{& zci=oc=eFCz<4D(&su0>&=xuH~uSQ@;)C%W(b=%~NEDmGB<89g8HjiOU(c%-{X<-9G z#9T!`XT-Kc8CDl-zw~-4GwSHB{C(%VCo;bt+!I!|O;(<7BN>ay?+G9=L z@5;GfX}A@VvukE*RwC5&U~Vgr$g#7fS!hM|UbElHct<^HOIKYVCWxTCaIEa(dVce( zHXe`a=-R8Q#2GgoA@5jZOPX`^UL%Jl+kPg;y~F?6UGPl*-ZZa3cd-Z8?zFm>RpN%x zpx^LhdyDaBReeODnF7_uP(U^H0-lc;WTIoQ^VbaIJIVvoMUU8b*_ysZ4v+qu1Zs*? zTmuyebw$o*rg)F=5XQ}g3stEf;_Yi1nw@=>2TE_6H}R&#R3jNRj;sb+5k2Ln>>q(e z0@=~SxOm4X>ff;zP;m9PFngk5D=dWFIFuKD`eWmz^l9ECd2{ahA9GE2jJGOUClXyc>mXiV1W zdouhz%d5V{_Dtx+P3$pJ1a%B{S%J)qz1g-684<2Q$~B)JrpCSWDqo~AvCHrF$}f^!zOQ1HKHtj&MPSb+Hn>a1Ck zNz~&Ia6;FIjAij}87oli_752g?++R4F`0V!_q9IPhm1A0HoEq|GL{%X#xgVgw~RG; zQE}@3KQh)_G_J(h&ywHvf0wa>{wZVO{6)r!{x34tIr9U}zho?&f5}+O>GYKdY(3|_Gq0?OTS+!sQJ)`znI8_N!0V^K^4Y^=HA zW2BdeV_{E2aq{g5*H^e#6DJNrr{nnTORe)*7wqsitKe#w*t3j2IR^+{>ZC6u2k{i4 ztLC{V>5VYYmD3Z$q2r5}3aYdp5p4Tk5v)Au_V&oOvaRL8=C=xU+sbQVwOf@Tm&cyM zP3KW}GZ*ez+y3-*%56EFA#IzaJLml^hAqN$Vdb<@lR?1x!0had;Ji7$*dD;fN~2QY zJiALReFE56E`o{GZ@La|cz-Y5D2h_*3BYM13K*h%C@p_0-G7F#SgBz#P=3UgaiyCt z6-eD~e0QiV@oGEIgHUl6q1Sy@Q_hVsT zbr;x&cUzj;Tgfj!9nSucW+9>j4=vV_X7GhlM-fqS4`?LDbYRnS9yV=teamjeifJ&~ z+z6&Xeu-jr+Y>}eHoktiVe~tCOwatD(nCeKdY&+^@fvww_2Y{zlDXh&qwI#+etj3nEXI&rhnrFOi*-h86i^3SFCh@(icCt~k_ zWe5eFWdE@g|D^KLX#VgedPLvzm!Qbm?lLe2us9H8e`rtnTWMl@g<1t)Ttgs?{yNez z+LQ8gcDUI)<-&Y@GsCre((!Y?Vop`u3@&VcddvssLUqx#81;h*>R3Y8BuUxbVr}ZF zD@5k_SUPJJ-AP=)8C1HIZ~Yx|$2}{IV614#R%T;uOXl!clO^{O1U_x!8lJeMPKv-H z3Yn7wxQ|~JXi_Yoq<*msh^`=c07Rt^#s^YO!PG!!wz88+*1W~rI?j;8W!(Q!9^TM~ z{c%#v{xp$UeGpd)>FkClWbgXYBRnjlp{viCaj285xB?mi1{Q)ht-)HV&5?6Bi=i&2 z@Yaeqg(oa8+F$g|oIXXOj~#pes#Gpfbd+_6byV9_K|hERrl{@rz;pH`kBiLC!UPDf zVkfpa;Y{QdKUU4(is)}dtnty&_dCC*D$&Cm6@A)pt)W{YhtK*;hBY1 z*Y=J=BO&A3&CJad*bqeY2hGEk2MUg$skJ{R8*$Pv`=8+)Sel}I zv-Y(mYRY29VriAxr-~S_=@X`-Wkx!u1Njl&W!HPsRPhM1(HgsmSFl^)d4-GDx^)fdpwHfA}=tY8nJ zQZ0Q}BwmRd9Y2q#D(zpht2t=J2)rmV*R~$XAK2+AB|zQ3i`21$-^SJw#~1?XEqGymH@ zMBKlc`6`q{ zE=}Q4USm*uh++Gf8|a@WsSBVU;;eP*KID8@Ks%oF&r8L|z(U`^=Dz^pKO6GW>i>5Q zc}8cwKN|8EU4VxC7ypljyp$NJ8lWNXYJcVI>>TAmD?wuCYLEQF>H7Q1?T*s4YMK*Z)hSnpjhJB*gaWkzvLv5 zl~jRJaj5uyuhGcbXmF@Aij{lEv<661Cg}wiU$A!Q-%*NItqBaq4SS&EPqR(W%Y666 zx0EDb~&DoMNdZ;D;CB(x! z_F=$9ZDmkU=$Mc%cu^(mBuSw%3a)e~bazIUZYFX{5SnU+ z1>;h01#uS3I;9m3B{nw_me9OFKd!g|P;;DL&|1C}VZxDag4U-!p{qQ+hk(4IduCj40&YJbln9VL%aqSKG6}hwq1;Q0q zEkz+eVa^^~tQu}?z@i;EE%;YaFU@;NihFM%-3AnhIx9b+>I^i#`MNbW;6}FG4qrZ$ zJIHc}et&-nh=##h|APm|#*+a&82-V7KBa9|#}0b=ncd#w3zu@Liok2RoAceO_dIGT zTD!%^yYVi+oGx$g7}MQbpCc*(Jop=YbZDbRW_7OO;%c-wme=l8)rS!26 z9ux73=o2`DS<0@B=BlPv%!AjB z8EHXMB!+ii{6Bz@NzZu@0E92ut=NA7!nXYnAhZSKz)h^f^uoUbq1oSou z>|;j#ylE_8&vH4(S)+<<^*pOC7m^E@=^K+V61^356RKWf*O0clCsMxtG% zp!h(VV#P2^-&$Sxpw?8=j}5o@;O`cs1Wo=3A^plV*v6gxgmU=$rOUU;N0%2L!O0YO z8KoqIh=yhbD=>5&OPk&5vcnf*YjIM>OwHURQY?HgdvRWuvoS4Z-9LL#Kcu$-)lwC$ zQF_H+IiI2=G$dqlN7FC(_^Jp~tBXxEj!U(}d^=Q;Qy?J54^!&1Q{COlRG2#G;&+@I z!TK-W2L!)sIA_o0-cu{6-#jl=`avBrCWS}iWrxW-8xWmu>I?8*wN`Hqq(*i`h_?}0 zuL1}oka-SQ^GD+?W;Z3ugAn2?bkV9k#Fp-n?33t$MfGc1fjR5SOz4{Bf;wDhL0(^v7+@Gb;- zmhYcA+Sn7yJSVQ2H>lGFV>L}BwQ}Qf|I3?cAD7>qS*g?<00uJwFo^XZ74$b6{9nH# zi}x>n$I}1!9VpWegj#cGJr4b%O=V^wsgrHJgXiui59%&2*VLlUeMhkcmG@r`XO%(L zf1)dR*4^hl7V*`k&k?OQ@V(gfgu1l%gb<)or%O16@XfaXPPd$?EkuU#f(?CV0rb z<nf{>C9W{T71{(jw4{{&WV|K@;ZH2<)#(MM`^5tcnj}jB`zR%& z@q1_KH>F7F8`P4(xmammX%eXK%|$FwJR$`cqEXSf^<9oz0(ej0Bv^MwG>}oCO_Y2f zdMA+rl#cwvY>1PE$!|VMHYKPz52lNlJ~>{~U1Gm0k#SvM)l@%05(=vZ(q_kJL5xxz z^-J=P?Sn!U@r_U^I!P@pvZ`WQUGe?`L9meMPM*+_j$eY-ngqZgQqq{%O)TwJ<4-)A zbo@t8nfklHFilK+aS6EPceN9$piY#+wFo=M@06oRdfvfK?gZSI#Kx%c>Bhe82AdEI z8$ZEkdr1_SsfKaPZTW-hp3xZUNv^BaY98nG7_n%h?#(9a6yz^MD|q=*X=%1XJ4UH? z!EybYxQrPwYzl*=w~a$kCG7Eyvl$|xjcam0`;4EFh3SH{e7c#Mb=NN7$x~EkM$?Nw65|PW+BN_p9+SaOI!3vc!D1-|{!AiC;wRZUM zItZ}lKt8;VZvd}D9qT=D*-QmWP2KZ$IXds4)$p#qX8|bD@x3OIRYR?!og&ZsIdOV3 z-tPTncf%<)Pb~in>s+Ow`+=4Hxp*4q3JcEjqgNo7uk~%}o_5>h2BF#yGNnab?v}Lh z>bKjgZEtvWvrIK-hvrfrGr!`8VaL1UlfS&|MdeSf(bofq@nKc}yEABRZ2R#VtCq3F z&;Q?a26Lqb1d>8iKg8;-MD=T_#jX#rnusfAlfkU?_#5w{EMCTV#7(=r;~6aQS249he(?H76- zi*hulB!^g31OLOTCQ<&IR}D}z z#6HxF53jn2*TYs__D?lKHv*t$kT@T1|4Yq~{a-bMja6Gsy7oiO$nF8C85jUH1K}@f z2I&+)&G6&) zt)fevre^qtzd9Q3*o7Lniei&VdYacz>aZ#_!y?E_byIu3MJ)A>A|; zc*<=w&oVG`c@}~q{@UuM)jdyo+J1?)HPdjHcF{9E1r2L(zu zn}G7ep4?N(V~%~<;lD!CWomb26EeruNwz;`k6F@ z&S|kc-QD_}vzJzt-Ep$3b9~wF-UYEPQBkUSJIuB$TIUDuZo}>Vg_J)E?FpL9x#qOWm5Wxj$z8HeL9Txtvx82-%y<2*pb{GQj*`Q3W?~dW#!T>gen?BqU=L=E8qiih zeF-_ej$})tS+YNu1uB4Cqn!t2@vkoc{%u+Q3527u|F6Vjic`P~fUQ9!T>Gw?hc5pY zF91$u6(n=)=Pei%Y8@7#BagbsVbqk^1zsax|AbjhUdwt#Gl8j{Y_GIJT)F-~ti4rO zT-(;Q8wl>fHMnbVC%C)2ySuvuOK^90cbDMq4#C|$NKTPt@13>Q{?32C=RY?vGK!m2 z&0e$5x3|`YnPeFDd|aiHNgb+L&i~#4ctP<~c+B%J;j#9s@L1%p!sF@x&%)y`zlF!{ z2eGiKyvz$j8C_y_!pO6gySEnD!Ln1qfXO{QqyKPmd^W=CdpLTyf+2-jq=_7XZ0^kI@oD%?(tUO%uZz3c$MYs`gzUFIWFgOsh^-3a30<(7QtSr z>Q`>w4V02YR2J9jDQnM#-5$ipTK-FVEC!Gs_q|Gw;eJVvFB4InJicf#2xo@lqabpL z+T%CXr5(CN2M)^K)Z9Wg?!_`T<$AQq7}V4i*82D9Js72#aEkS?dL=lYCo_n3Un7qp zML)o@s?x(wA3Syq_UYP*75yks9~tY{WpoA1?zex=?unUhhmT%o_oeXSQ&9{mHa}&*0 z75taxbP(W{KnOZ>h3eU(XhjyBOkv3liedkhhWAkxg3y#mk~#_`fz@i#nUI9=C0aSpyF@1))k z@*Yr`A|h3~zv!@%Lp#a|Q_(FfJnZF$=iR8d9ka(XrdIdSF-7~KLD)>B(?zXpaFsQ+ zWgH86AEt&Y9-_IS(k75$ez*y$Wn~abJyI(-RjKGt>2VPhTqLI)dk)30uDzidstP0i zmQDH%3-LfWlXX$6AgZc=UpT0qP$#gcT;&k|a_VL#;(N1NfcCh*E7@XH)QAWg^)pEY zGBnc$CFc7?78d`lQxX&!IyUdSJbX~a2AQv;b$IH#*C?i3cv{z6pMcR4 znN7~?5mqvX1JKG9n4s-M4$+*(r*88nYG|HL7mj(d-?WlE27z)pU5V&8XmlKRf(R?P z?Z9O6kqq^u>Q#EY#i=kkg$IxxuanK|$QL%Jk<@b+Deh8o0(^f(r-YV_Bm~8E^eYkP zieEwpa~Nzi6uv6t$Blo!8NnNlMb@{W6R}WHa4Y>KJ&rj`WM5VfH}21WGt(ZFDqQT09w?(OqODZo!1ui2rPLOU^o@(@9c~|48sQ5KGeT%vt z>ze}`6sD@F)hZol`S2iV2H~7XlRFRZ^VU#;A_82vxs8!_o(+o*G=TBXePLmA&#{mU zrsRwf{3;?C?Lv>a?K4`;sM*-UrYY6PFS@5=q z%3bye=MOUdh#he>j3`_q4wmD*kElwUAeD!JjM;YoCRYlo;9AhL;1=qpz`?aszfy}? zz%`Gg7}4!I(cSXerqW(0;!VTnQbm{{gon;avWaS#0y$WfzBzGikQj8_v6&=mgOj@@ z;43nT!lCI|eiO4;LNw?`NX$X=_BBjILR%OI#jBMqji@xvZ7L~c4uJ-4v(o<_+_mR9 zAGf>f{zd@JRYls4ku9zIbkVmw+;H**6?wh;hcKP7IA*9VFG#j*?4&{E?VN~kKt+V2 zf`tPO1*1$vT?mb6Z}K-EC?#|-6cp&VZwjRoz>YDKmfUy%T1ox~tz`U7E9+UI;$iZe z(RY=7U8A0+;XDN7XWc8~p^GbO6@$WiJ9EL5&;3$g8b8u{Cenf%d{lxqv#GZUmoe)# zy;yRwfElXSi(zm@K(}XV^pK(cF33>IcumAlf7+q)5!?+}AM31Wd07Z#YbP@8fR)o( zot_^CzRxfsEo~hTCL&BYg4YOqY(aT^RZ3Ve|MrK@+uOTOW-?Wr2IfTT9ShoU!=u6$ zyS`$eUuLpDi#T~Xa`2#~uZ;^tf5{k(5QN_2X@ot^2lBkJeKRhpxsIg{VJ5)!3}yd_ zkIdq7Npbr=dZ(Adby$gHAv)QeaJ{YaJ$%XmPWsI$C?|}u1#3FK;rz-r4f2ozZ?{RS z;z$y$G?uD-7N$P9gGt9KozufUwYM#gj=1KKOoYykt0KlI>dKYthRwmwukm#=`Q}Zi zI3P>}FupDk^3#VV>jsRkp`Yz+|2@9WbHV=d@_En!&;^Hi0XT*|H3w z?zu5{)-S~$jFnNfRZ?3D%qiYe5mtBVUeDSwq&z=N`*3)%eKzLxN7B%1?bZ~KO3wpoRu#~v;{LOC|JkYjmjN~+M9ZKm35Q|*U~6J}mkD5k z-TWRzTB|s#rMU2LlWm$NkT6{XhFrX$92yN~ptCQ;dcJq-S+Z(eq{1zL0yqhjs~sdQ zlsue{*!TM;ysVv{6FgF14b|h#3))?|{Bd@m|2Vt-dCl@UP4I}4$xW;0Vzo#cjQ-}m z_7$PjpG~SpnJQDuDBa8?zj|^5ox&k}KqGccg&JuY4pkjob#^p!$P&lB6de zt?^Z-XF$$(vD9uL|I?(t-r}R}kJKdqw|FE#z{-DlPyXJf*2P)^hLS&XDpIMmN~bXQ zvM4P9>MJvT2!y!$3o=Hw!8#^;i(#kzp@O|sLnI^-h!1N-x4lh2&c>YYK+HD$yFVP3 z%|L8bU5IC485{7YEIEneYqX_EZI0C{Q8)}ol$kCkgC)Q!t)d3e4iKyE}X;z7duT3^)VP?%$dFfrY$fj6$qN06s6&R!;zIX-QD zl9|AF6Pb=GVLqe4Dtqr}QYX?crPrq6e*hJv{s7x+g6yjG2Kzn`t(}Ux;{ampFl+{d zHbVgMcs~H7zw}IprI#ne;0*Pp$R@nbKqRQcilagKjVy-n(x8oT>(ysU{^wECeX?gdwV~<8NPH4Pwzi_lTf}3pLDYbc3^^f&E-XD> ze~{4E;)LF+0bT)Ih$Vnt6Z4d$WTa|+{Yx0&7UEn{y>#w)lrry1)QvRNh-!)@0Sf4M=teNql8g~3p6IK z?AU>FS=n%j1mZ{u|2W(`xb+|Gsu zLwv&c_|KFHzJA*9@w{fg(I3>eu)W^`70OiEJ#^v#DHC0birybTyGApHUeUI8uUDVr zgf}omTpp)VCZqI5(34kXpV$g^TP-{tzn5&bMVAb^+RsUBumq$`@b|eEZU*wU;%jus zmUkJ+IFd^0d8(DHD7#=2y2h-6FPTVuRWLVf1m7s(py-1i>(teHhm@qq&EsJF-L*Uy z-PhmCtS7sg9{@yM0&l3EgOX|{Js7zdK{Dr1)IN02{EV3($+@Vas>8P>(w~+Tgcq*9 zX@Sqy6(svoHwLOUKYu)QKfi(+7A@fg*=PAVIr~fc;wmEl+uR0Nt!fa(1WwJ z9h3C=sCSPPXJLY`;riA|U2e6NriXTGa6IOZ=P!&9GR+W7qOVSWjK=@fY&u)pSs47k zjK=>rT1l4M|4XeTfQW8RvJ;c2_NGLBdJV3trvn7ny$rwwxWK3%u_sB_#{z=ucmTn5 zQFx(J{*E^=b^A_keVTQaH=}OF=|w_|1eh34i`!7^%J&pe`&jf!N-UoQxl;0z4chJA zM4P6QsK?l<(fw)5nGCfl$&0R0dJI zehZu0nksoGv3Af1>M5V!f|5~|F#noc7XdsTFVlzr_#Nx}?4_N+vCU1LOPW zVd^m&g=T+D=~bNjN|T`2OznI|r-nEwk6oJMU#(^hpw-lPlb*NH-wT+GYo}|Y939Q> z>3OKB=68cziEHWo3DI z&4y>W|B6JN|AItcE4Q~|ReKF^7c>7o8UJhL{NH1fWQJ&+ zh~xtdP_M6v_a%mGiKvn?X*VJT7*v1IP2N)sd$s-OZ99T_+#ZmZDZ%b(wRB1FuSQbg zvi_ouS`?!@l6uWr2y4Rday1k(h7I#^-3lQ=@*%5%)7V03)QSP7?%DunM3ax~1_M|l zs%#6so9XEU!a)xxoay5ysB0m8Szu`6BS@ML92UhWQ1`H94}Z+b?E&vhpITaG5a2!^ z2yipK&dLA!&iuXK{3jOu?Pv02{2hx%G)W;Y6g};>Tx9$O6 zd1*(|dxRUv%ezJ%)XiAHTaohf7&*Y`V&H=Jtu&l#tLK$tHdxA@1A_khPQ##(-8?AP4#y4F4kUrjh z>;a)I;s~eRWHI@Dg?D!DcP?5w?u0oiL@dLvL zL1vCHF%A=IrHZ+bYEjI-il^W&w&m+@oZRoOJ?EiWN|D{n? zmj;B1^shf4%VwZG(MwLRxgnK6QD%eUXOXjuO2yQW)bBv&rQELW5#>41)%Pql5WPHq zNwcqc-XaQhTPh@0TzEvjF{_S`m6#h+a6QvxpvbZcR+1t0mH6=RHWy!=chYVMxxlwf z5z`{wZ*WM-v03pXg#H8zh;bzNZj}Ylr=H)?v?Yx#L^r)n@*i~9eKIep z97=&ff-PS`3Z)wtTge%Tdp9}-J6GB56g?jt$b|9s-A8N+`7Y?cbgPozes-%E*yG6! z3Tp&mrM&vTav6xoRd%v0wQOY|@0gYVV$Llc$$A>m-B&hhq)Luz)~(FQ8I3};jQZX_ z3suv<8is=r>=TMlIb~&Mq<08pLZ6S)jsw9|a&;O*84cYON{Urkylo`VWwG#b`a-e_$O-9jy_OwW*8gwaD#st)s{DVtRjiGY z_b6N7#@{LnKZT4?WZ)hqd8Jd53w_JXSgI^MmSJ%OtEf!RTc@*UPX3Y~{ELkWCA$4& zqx6`#!vHoa{417$NWG&U4^t`NQsqb^)6sMEG~Bz)vWjeQJ3(hVK3wohl}puh zo2Z){_-6hDaf1|#D8bzsp~}_CkvItpLpYv_kY6VSg|r_lDci$E1nP(umrN{omQ3?ZOc8fuu_m8GhP9+z{-SW~xk%kBHdJ*vCmE$kx(Fr6c5%eMR& z$;Y^PcnGvK#%^y@6@Xo1nD>peXUuwx9Zd%V{PL5s)g!p`fW7{eNj}~auI9KMJP(m! zi$e5e!M4C)TF$Abnrpj}tEZIQn0CdVH`&)uVmkQiNekc;zy*97ud>te)O-)c z9}dQ#@_nX^BC-O8rnPCOSs`M+9pjulo>BYks?Ih8tf^cSL% zmy!|G)CO%?A)SWoCj6XktOCImm36vIlr=420J_3li2B^~vG*g!{)F$%Ih7<009|p! zS`wWz5(f(h)IrFZsK7RV!}^|C>Pt^O1?nAR^TC9I2q$+ zJGHh*~O5kaTX@B344UE0wfpE3buN_^_^Dr2+&J<+B=>lyl z(&|KE0_tv8x9g;t)!lzArzzA_k0?+enPamf>M46%JI45^Fo)z!--=}Izqcd@ZjVW( z=7H7@+j_P-)EVhAR(=Qn0EOOdl-V7Y8GG;<><5y&-$Zz>W94b-c%ktu|~ zHfxfjdC@MHp-o8Cq5$*jTalNG71LLv4xayN(WmJMke6eBIgH~gQh7fMCq$@3J`XLy z5*p|>%31j3h#0ExMlI8reyDPn>Z2M<%c+wpd&0iB-q)U=OGV;|hREm2)TR)%&0uFTPyQk?Oyy(0Sf zu9akPAC6qCEY?zZqr90G2U1GcAsy-O=3jW^?8GG$utb>ArW_d|AcU7O%9f_i)Jzx( zmY6Cm0#JX{*l{vhb@H}gdSY0qyOl&r6!hmJPpMvg6ndoDjzGO01c@6mA39nhPphIF zYuA>s+S{9XP$@UO=_Z|$lV&AaF_7v0U`&5Mi(ik&z>L)ucqB2LPZ*XopJXCnsY(@J zoG}3DSmY=ICQpL#Q0}!)R0s;0oUn`pEOkS*>m2ofO(QTG1eV-R=a^N2zz)n(Z6aXU zt!JK2$Rv(FGll0w^&LDeJtyw6*F#owLTF`f*Pb7$KWmmgYUCz&RD$m$Q%1lMxNc+niI5Ic1$%Hs{1^E!(Si+} z@!fJ;_EO^?O z>s5o$quqkJW}SKmcpju9vletvq{TkXu1qo`ZP4fKNId*9O3%$B{(7_(C&;*!w6Vlt zSO|d_#?MRJ9L`zIV^@3kV(oGj?L9;tmzyPGR}CY~fint1QFQbzy2*sFqxMZZCK@Kj zXgx@UVl7*w-^7%(4Zo4p{n$j@7bKB|^ix52s{`B3Z>TfwOU0@d>HfBY4z%B4WPu2q zHUSTovX{CI#FZ7Zd!lpVGlMQXGYsfmGX?&!NKgtnXK^zj``if+0$&Iy(@@MXrkCXO zz;Zcqe2fNv8;blVX$3l>gj=~8M=?b)NgA5W;k?L<$%kF>YhGI;yJWu9WxDCa0@?Ed z>Om9>HxB(V#z5ff>#yC#(uFhi+)f@6A%j(7cOfW58iw={9#G&MLECgsV)8)fk7R+! z@V5B9-RGQ5e33nJpGwd~pQ==Y7tlq7Xe%)C(V?dHp9X zlCj@Ta_ElHSypS9=8u_WX$_?!${N%s6qB0E&r5E+WgYO_E}P#x^+9rDsKP45v% zKwZwX*4C$%qP0-5vnTq|u;F=#zJWBh8tL)rA}5jq$QAZNo_TM@u+wbJtWLqzUXxiCBT5|X0w zZA;Ge4Rg)*#H+!3we^-N=}j4^=85^0b^3{9%tCO;6ARK;phkdW)i6BugN`C!E*8D~ z0>^eyN1nel;P=3*S>QI@nvcV$wPNdJS{xd|pm080m#Kg0iIB znL3s`ph?dvp?yZ>i1F6!WHQ^k-*;HxF?SArR=N_eV6yPQctW){)i$YLHc4laQt#PP zYH)O2X|{OTl4ZqG*a&e!?K4PKd-~#I51L;sKwnupcl^yS+3q2ex!Oxuf?2tSfBD-n zsm!vT7Hyll8CEk|6Ck#*KE>0Cr70pxV!%qDF+v>ShSFaz3xRPbXxc5j!vMkjCc`raaqB9su=&FGX-8pS4uQNfx0iZ zyg}1p$b+#Ee>p3*g9E(m=-p0X@VG!q!CV}aQR0Hi+DeH3b#r628uE>8VQX2+`*+$P z`QKl#z*Om~bqu-&{Gvb!p@mSxsnGx2So0TseN7t{TFQQ;8*$ghy%jSqZ?h9EqC8)P zE_|{Oaxq-RuRGOR&9(g`DuY73XKgAq2 zb`B-^SnGRQZ{{Y3Wol_q3&|8YNsuEb6c&z(K~1k_P&;4}HAzBE_^;(@FTv~5AS1lq zeGNU;!40h^XDnfOONe%IY@t#0n|%F%P(jQjS2cHmrxTbu<+k{azw>~O{>nX=hy~p) zPmJEKb;mWE1$D_hE1yGfd3G`hy#}1>WmsiMW8BB{mJ0n zAVIVsQJBbIHdg&bUte2CjMjY5{h*0+`<)S;eMeBW5-E-Ev+8IqE7&!$t3oe-MU#xICC z$ghfI)}k4d1*-}@cqlb9&aD#BkLn|c5X1~)L^Y+FQu%Yk37+KjHO~!3=2@@B36zE! z1(5n-%fNVmFVFwPW_vA#$cOrcye47|)D*jJW7ngMl6wzs@vf2gb}hpCO)Gc0XRB2Q zM!oY#{i7W_C0b7cd;Tyr#nrQq?? zq2|8)0bd@#P>#oJr+aTQRcEJn4NLL1qnVQ@!##L|7B?&}JAD@Vu9sW36WtAllVYDM zn22nyzg)&s%qxh@S%coBv(ft^>?I68!e6h+#x5Jz`+Z@(3Do1Qy>i<9a((~iRTKhh z&h6z7>EIuPSvevxjd&LgOP&id^jaDrUc*rjJ5^m;-~<4 zp$~`2LDT6glkB63*w`o4;-y)$KYz5(3ToaALh655Nh}aVb9&zED?5JQ6Jxp2xPsSRj~e_nfZV51ku8N6qU>9SM*q<)fH3e{$v z$014kmp;D5v~0*ui_Dg?If0$EU< zdT&a3T?*ee6FeHeeOrMr(RZ_?!rj782b8{=mGpj``B}7?eOOl?0_^VT3a_3PoI+BZ z7(k}bx;Uv=-|H5_eOf@o0Aa|ZT`v8)-g0!kM`s`Lf$LL>t|eFX86RTi)CwZUYBrQh z_*=h2;hlF1goQ#f5t*30Onzn{vk=9v8!x=#uZy!mg4exm*N=`3lbq(M^+Ek*R!5hO zj*A*rxGxCYv|CWR81hW?QELy#nsetp$gNc! ztRz9*EorF(4UoaL73@;-tau!K<%ro*=2_CvxwxnY#s?m6uJ=T3QGK?)jz2AWnO*9+ zxx+=V^x*=HsD5-|AS17aLawWNNO9%whTdk+;ji5e3p|36{W64N)|BmKS<-d5jz1l& zO(LdtOP$ai#17qvy5P1T&Z{ofpO^W7p@{iVTa&Xq zm6*Y+Um{ycu=;C~9OUBdbpDS*w(p`FCF#f)Yw4-rO1O785K->q)XHN|?_k-YS5hn8 zSq>+X4Q-Yc@0~@ND$=JZ>*Pe0S(ca?qYR4z!AYBqsyLU}o_O{WS(YxRk=Wu~a1>|E zu{JxEphwot-38pns~X_W=nd^T!$6K(>>2hjdFNctzp#@3QmSm zx4m6@J~|Qxstp@06hq%_<-uDejK91Gl{G@*E;H0gYrOyTC@K9ilI z8VXAhBTulcy;xtS^nBU+)>4CBSfybE`*U6*am7y72VJ^3-%K3U5@#!+I-G@UFYu6S zn&&re^I{{YR&+z>LU4}>1<`<;vf1L7M)^~O7-^l>Bw}WH(?Q>=F;~3vgEBUG7HXPuM`l9f zUMy73bnI|;KRI!{selG|W;n*SMyWWqWUH^sWyEaODCEGXX~seYd{nfCud8tl0`M5G z<*ujeq9Bztl_9fi*hTH!w|BaPLYCFPC&9Io%|Z{BfR+^%h>T>#K>Q?qpAzW}&a)w< zk`XA`77}^&k-d>-vBQHVsrg7WV^v%G-VT4|8>Ho-8}qc(cgrcLl(0qyqh;4kH@+$I zVI*r3jJg$0-z8cidrcbbMhXx6cv2a%7}fS%X0{V;L~eM6LTg)IwP&mJ1&{6#j%lM3 zJ#r42cRjmfOtHGEu(RmzZ#)#cRzyqOohpEw7pU)GYeS_u3CE)`w>0WKr?ufRp~>Z8;n$#xy;?I3a-h1pNw zQZt_F$x*OEPE+{UzBF)@2cMghZX?pzn;C#KW^i93j?KGk!5svx-1M2hpSh;o?&8x@ zwMzL6PbAWz>|ftigK0z3$#;24BnA*3xhrHVO4lq^* z7oUa%d*?iq&Fblj%6N|#uHh*>l}nI^d#jr>BbsukQS*_@#g7yTlJ>-dRRh>{vpyZ7 z@>aMsyc2ACR6x2?iRDF%0bOx2Np!?>#>8Vc5{jOo2(sgo3d7?>)2~!hNF$V?Bq<`! zo!3# z8#m*Vb+uJ!{fUQ_lc)FbBvXqn)QNobJuT`VO{-hc-J<#Z0&2^zMKj?SwQTwc73{2; zjo-82BT!GVA4XfR_#ZZpXKb1Gs@1%J#XJp#(Nc`A)Ab|D$zuq14;&|(mNPP~Z`GIB zW_hx+NM%y2YDM~(yL!g?F3&uK31_0I3J^o+@x%BqLBPlPdZJZ-yZ^j`<>E`unx#)d zvSHAKY^p+Tb&xmEbAb>97UYx)ZCtBM);g~YsVhvsBC%mRi!)he^}`oIjJi-ZU26`; zELm{vBDZq&8uPF$k=LWx55KK8BdeUDSkBDN7D$uE|0$J*Svwm(lp$;yW^=_isgEFx zkIquG;@djD#T@P=|cROf;) zxq-_kaB|e3y#thP?08;{HWB)P5;W!bmAASVWwWDm8+GL42#da80nS0O=!L9&qX`n2 zpN(p^(Lb$`+eefR+T|s&l?b|F*o#R-v3cdEmyUAM`osGbP8TLsQS&o>X`WY&^{Yav zD7kNrO`pUKzetQgAayQ`OS&6=D@SrB1YWi~yENw4ObhZ8O8a`#WQmSd^U@vdJrD(VIj!*EBC zmrVNdW(%fT+=I&7uhlmtUJQZe8`HLOEYiWc#h}D6;G_aj%mVUS(j|C~Z5Tplwz$jq;LAb4vRm2$uLsi1W(U_U90aO@Kw*D@RdggfI z1KT6eOufborFHz0(5ax+V{+q(QO2sI6%vtr^)kq4!PIhn*(KI1V)5{niWcVD)i& zZA$L`oldJ6v`~xOw;`bs#T$DR>7a0DA`l@iE)5n?AF;`;kBo%B?qwC}o(J*%ow57{ zx&R(>0sQ3~T9021c1>jf+e%WYkYN(*xob%UIVy}kqZuzVVSOguo_f@J%NsZjg^O=* zM5C*GmlL_28JIi7ac$R= zGerUj%ioYoJ~iRL=nDWiye_wm0l+1K0_H`)3hN-|!xQnDi1JbIZ{SjfEDmn{FW`cR zo-#p)q?~Y3j)|Iz=33cG_I5xmBINAhD%uk@NPoVQy+6xdc2Fkt0|Z0-lP}rux*dFf7Gj ze=(N7Ko`^DPygaC?o~gRi=;Ux8FfOWZCy>aGcB#GR;gZRq+=gKm9_$$FgjhC9 z#>SNqa#eC%F8%wv$TIOmcMKOE)4*XS)30rNC=kpk`Hduh6fJq*+X{x@xQeA{sv`f+SpI}A zOI(SsK<1W|v{ssX!DswAQkpAbrZ|i7L!g0ris2QA(EZnxB97BKQq;*iugR)5v8?eR zQ>qBhA}-lPN-2}AL)yq`5{GF4krb+g zT{3@x-eV7?I)=XzmcJpF7Vwx?9P_fx$UN<}IDo=(B>_@DjuROF-It~37jOxn?jo-# z>tZv-aopI|`vqJYegc<@pTOnmr4pykSwuf&)=aCy1MeNh$r5vlTuS9K0JvQI1}->j zZ13A(qs-GacDS{66xi_W$*_;zZ9>!|H*~v)iP$iobJl@ELcXK6CVUENm=dPPkU|uH z8}zo#u`XPNb+_VX4V(o`R)CORs>t{6xFvjm)e_?uc?lnI0l-B7gdrKP@pYa#N~`lW zcccyH-Lr4FdfYl@J<4jx*k@~+CtA5!Pzdrl3eIp*r$rNYI~m>FoVOi2*-9!nTKQx? zmtU{B{rN#_{^((ei}FPi3WC2s<4Y2e9-mJ7n=1} z+?AV{3ZEeS>K<6{d0G)i8@m_C1U7O+$7w!YC>O#!9bRneZQu%Zw9+aMxoOd^qCE-# z>F<9yFRZ-7j;>TWd*r(ze|VR@ax+i}y7khceXT8F`aZTKF9zxPeoLfIP@R8+%Ex@7>@Bjyjh=cA#nuNzP=6V@La+DxPA>bQ}X%r-gQNGaDI6Ib4DM|tjEcl z)r;xIw^}%k4*k+wpTU|5TR7G%VQ{CZFS*?Uys}je1=r5FX}ud6r+xP?&r2k1WzoeCEmWSe{THqhxSo+`SPq`;$i|IE{y=3lATH|NmAqRW zz`u!$Q>Ql8P3s@T<(xkf@i%c{`bAt8GXcZ}@ICuqh)ex{B`(K}*#bX_3&W`f(of>j z@r$^GkpCnuItC(3Kmg)`-xdaE8fX*4dR~hqWWgP;uohTwc&E&E*o0u2qhP_fhL;`T zdXIvzv;)I;63gXV?BEVmRJL>TeJrh-`Rf}M|8p5|hu+)aATTYwOv%H#5D%wd9VpHg zeg=+oOYj&6$M~K;1ejCMJzfiKIK`!Uu}{m+<2|k_E}VW@KZ#2qL*B5Z65{cyV=#1L z6G`HG;?c_b_iWdAkTRy0A!$~!pqza`yf-7kZC9F1XdB==!qOA20xCz7FvY24RX|MiO{jt}9?LdtK%=*08XdeH0|Uf+ z<%%%+$J9ApNMXlNpdy|9W#>>^hJ%cANCoCXFGS6y?$^4Nk?HQBRVg8xyr1G~ymDlz zPzu`;C-w67*&Q~<0-SeB%ie4w2d~LrDdJkSJ8q^?o{z6D|A)BP0lyNLit8W%ak=U1 zxq*L=V*PjGQsO9?4ZTfKz+a0zoL7P^`-LJFGqBogr|>6n5e5(!_A%ImZeO+#;k7S- zr(q(wC-a(2G%Dt~;dU(_0C5=$j`M0$^WkO2pa&2aZ*Ff5HtF4`cvXS2(CrY89K`CA zV96h{=1>0J%3S2TZCq^drQD|+2n2WO>gB1RgqU_jO-zP&Rx?>lCEx1DC)ZJCTitjo zm?%&*SNGW`1nSFB->=*!_gvI*EAoNmPS_CbX1hB!2a}Bm^#(xgyHnQAy>V*VeSJvTES`<+%Mvy|C_j|q4oP~-7Vag zIj=3sh!*#YU7VGTmjQ^&T>IKck5n!TlxzptM3Z7gAEWg5ldV&oEnV`T#6>)D9za~| zT^=!X2-|a$pv#3Qnf2SX9{fz9*C{|e`(U3hIwpvR>b_@59YsLa4aE%wFqtGVIU3E9 zM5vi+lrWFJWuByTG-9HD|MoB~Mcxv;-eiJTuT7lCXRQv=J^<}A{ZrNO%T7sd-uE1}Tf(*Q zmam)g=+?U-Jql`ex~01=w>S=sSci#XU@w!VwoHhSoEV>7@iIQjX^_OO#0HJam81wK ztk!JJy#sMJH*pAVa{l3Z_lF&46d?S)lcw{v1K4ri0KDG>fM53dcBVEC+D`woz_Bjz zXG&$zohMXRN~uBqem?6@-?x6QWhg6bGm?od)l~pm92)8Av@;pG3DTV(L+Bf7qUawi z$b(7vs;%x56wAI>Q^_$o^V3^7FcOA=j5mX_Fey(blP!xS*|xVlg?vVhK{10k^ThF` zS=Vtfl4Q(U)IDGRW*hUKXPRe8yhT`0jm6 zXc>!aQG3V?J8T!6I|3k^=vXlx<+<=Rv|I^W8esY+#RBG8!t9PqaUAn#Vr1+`_ zUvy>I(^F5|-FID$vIMN}O zIn!chYMNq3IdJoocp^pf9Pnb594v@p)PQY;GDbwpm|4J~ud=@meVs-4G&JKtC>dI! z0Q`FBYh90=jll=U5J%gTm+AL>a`L0#HlM{0)l6$(RKq@tI+mjou|3&_lw5nYV$%J8P-MGIG+qyU)kk7V0Jv~E z;Z7Qm`o?hmwrJabANVTdN)y0j(e*Z?g3GB5Q+I#^Yd*7L?tr`3xTJRn;^=2!IkZYY z{?&K1Cp%kif>upHU^(rb7n`)3`)$=3OMoAJA>m9?mvp;*NP1( z<)B^!RH`vRn)hld{ZGaILkKI=V%0+jvvPxi4a_PC>-~`vRCQ^zG6i0y)LcS=Rs=bj zaiBxFjKkqzVg~}zxt}o1I14`zDP0pr)ULt`>!;T{@T_5UdP}nkEmxU~KQ6o#O2`A! z4Mjc?kV+KMi>nVvC4z(AZD_@DrtN5iZ_`7g#%={fmMb?LB!B5SP~Hqm=4x#d5T*(sB)d>0~+fJ7APn<&$t&t-Z6u zJKqb`WC;eQ;I-M=+MA$Tlm(BQf2*W8^G&<5-M9ZB119I9qv;V3Yc-7W?VTYOxm)~X zkZ^z;2svY^8y#yV{19fMfopuvoky(ngGrxo?-v?F+;qCt!ID+(?!eZ73lDCLsmTut zq>Zz4l)B&iQ5PD^!2I4~-2sjf!Y%XurdZ-ID!&i#ind@$haD08V8$K|h5Ss)<{dxC zKqLB=Hs-rrmOC_=V$Zy0H?g1miv%}qVf?Howm zDcq}AwoR7YtK%ly;o%;4|Gnahf6Y5dg_-c5V%Z7(9}$aDKeBTBxigE(_6DimV_o=g zx(r^RHyx?1=m*ymsMlgXEY)ifSP$PcJxCw-dUy%uJqxfx-(hNFB8 z$aDfTFI<8E69uaUIzl5!8Vk)nx{SD+lSirR!!)sxzKN})dg{dEUVFX{(J6@|HJZ+|T)fM%9`Hhx+% zvzK;bxw9on9II6>h=Y{N_2WeE#)o?D*_6KG9DD?n7*a46;gE9iu5|51KLioQv{Jiv zl|Lh&U&|7o$P?$)>sd`P$3~d_DVpg&^ri1GpZ_7G@Gg|RL?uP z=mruI_9D-ifiqmWRKXr?v^1%Cl{N$vrw)ha&+57!&C#pyH{rmGFtoh+QA2c|VCdh( z$uNbMH|g!>>*4<8eyfsY!=dV*@uB_l)uQYqx=dzgsoHHBm6*!bct6f`mx>e*1|)EkJ>4%mYDis^ z4XR~ADY`S;2{RBnw}PB^C)ZIN2Rm8>63ia)Q_~wnve-{briJ!?yYE3ML&}M=_Q_Rn z%Am9CvY-$@JIR_Nnr-dl>#mWAN|{~7H_8UL3yB7CsX_Z~`_$7%cA~rIMnY*#T*3-C z95%D$=VMcXkiTFugW(r_W2~Igq5=WO?TJ?c^8569r0GH4ex|GN^8&@dg9i~W$|u)e zu`^N9WdZ27Qrrbf-@2$xU2xc8iuu$x#MM6hKZLzyR27?RIc9J8u1J9-*TuUCu(Xh2+7F;%qbfx$Dnj}ADcCjz? z*B`T-Ais&#pU~WW<}=$2-hMdc@_r5g#C2ZvKHNx>#O8W z_TWpb=D6l;MmJ2b4((*<$&g7Wwe9X zW!)HY<%r|obtU+J)Rk6t7XQDEGxeJPXz`}_ z-#VP$nvqacMiPZ(gAR}mC(&am52PavjD2X&9q^3r4TG%!5`mg%czM0}1%-xwtEx+> zHS~^7fuLL%W zkkT!1%uvw6vJ|*}kXv6l#N_VU(pK`qNIn$LpS41D`}KAGqnx=tuzbIfa>)_Pans|` z?vd*NZQj#eU{I6(rnt85ZH2M8p@@(vPO3Phi+soO%~ z=m-{;WI3Y)frO-?HVZ9n1`IL2t7XHjX%>~to9e1s=G)D3rGs3gKVj+KYf8HJnzEeZ z0|+Dpsww{ycqviG8r=s5l4E0?IA9Xu$#K?D2WEzb#r;ve0sp?0U`=nELS{0-S~7+e zOc5r`G$C`gHw=y*Hh&oQdGs}D;sJQ^Oir;+Wo=zUV zMj#RC1MwGRnH1&){NB4Nkciay3Ouu|Ncp{{1c^xht|{l(Beu7Mx4ZH}uFn3hDerj# z_DU=5D|BQ_B?Vs*u0R+e4Ua4BGf30nTD9Bk3V;h1=Pgyc&H;oz#}z^A(TdD3lCgP* zRg~p^{w6kd!+ky6`w+feq4%xdze(fLNZ@f# z@_SavH4F%MNpNnoiX<)4fn;@T{x94mQK&w#PbW&wBm%fcYA6Y+jh=r4PaBO!>hSo^ z;q&qEjVJG$)0KPY<6!m)UR^N=cPZ@O(!EhBJgkT~%WW|B-FNhF3y!;|9e`NA5$S@U zsd-4yWd^hxKj>v`=Fmq1S~z5ggG->2*U zDk|ef-xWAt&#o|i;Q&3=sBwbO=$PnTmAu2IMa#C|h0VR55k1`{=YnCGK?tFT(&E!i zEz6uP^hTyoiYAq!WJDNK!>y6Msl(mN@_EF`MB-c-34J8NcBFqJgji*R+%(wx_F7Lt z%P#X#3N=yKDEf5{=dz3E*{EGyQ@f|Hj<^_-M#6d>s&sGcui+7G9}kzZSdR*y*BP1n zIWx^W2txV1EMsVavSFJVVgUW-N9oT)IZ%}BnUht|MJP305qb5hu3EP}84 z$d(EHLs9vTv0g=-mo@~Ilo&MsEGyqH$$yuXCmFUjTReXOgphKXwH-G5c^th2=Z9^7 z9CwD;rgjlY#-B*%RWRa7pLY8_5-iwNt?>Wimzu(SE^IJWyUOgCJ_w&cHNSjaw@mZrf(+a#)@gmLU-r~AV$sL;0i4|=hkvUG5uCR?KXei@Tk^h1Uq9bJAv9_ zb*1^N$(mIIflY+FoHwb90N3Bi6R-x!9Ij`->oq|VGic}4RZfh#20$jXpkAkz=E=(y z%15nc$lsLvT@+-bRe?y#6K5`qfx66JVz*qkD}K6I($$ z%F$s7gVZU7>xaHPw&r@0#B}}!yF$dRQ=Bhi#KR~th7>Gny<*hS0~pBhoHSa?8z^u( zF;~(A61db4>9%s)%`iAd`BoeyHHho|@FufK&ef@65}Gq@?15Q9&2o4|$^uMbKLe18 z7z?Z*)ru|4S<2_@H#}~wZJOEptX%G+*~c%6!p3-beTXpLh*%U*eJi@9KeQszzQs7! zn3Wc^Y*vL}KTYK3QG%Zco#8ERGDl*L66JxFI5Alc?Fs`Zn^-u0OIVR1*C!j%nql(q z$h49=B-{m=We6O`2Vl!x#r!4&^!K?XAA@5aHnVUUG^;4rrQ@pTCQ6_SI7&s}JJ!u8N`;((aV zHQrD}#$8?MkgCIpu_Z%qsUzG|<{do%#3bANSPn-v{df-lf_7)WekU&VKxjFG* zMIEx%v0?-#$VbYMZq!T2)L4vmdK}BLFXO+m!lR=JAS3!Cp^oK>)NEi=RmCX+tqB_0 zBrZyOYk9guAv$X53EH(h5Fv%?4Xp#8ZHUja3B37@&o6|!OIcZcyoko&192L_XmU=^ zU;aTid%sodCWOk(fr3WPe*}&9`_lg{XoODvMKAq}CsmUo6(md8xZmPVvG8q+bo3uQ zsT@~6J(C;Jl=+v*gXU?Ot%9Kzl0#;MQgaV@H96Iw3vfeHJ<(N`#ofIgH9j((J;SLy zrSBv(${5!8*6UOKZVWUBL@}#Vh;0h(y|opV*8!336JaFChc4B$eK0;XMQHT4sX>3_ zbd;E9jiF@$ke3OdXmAb=%irWFtVBHKdI3 z4ldP7y}bC`kp1+7orY2`L&4Ph+t?ja3)?GuV{dC5R|~|^9JTyJg@s$=XX^l@6;a!A z`6cXQyGSK}erJwfQEubz-s8hG%6tgZnkwV3(;I-kD-Ne$R$OjZ&|-KYb&u+`+-ueT z=;KsdWgcAk%et|ftE10Hi715ie~{anR_F#p(U0VhM2n<-uXo?}bPPA)}{}kq@+XeV^tmg}f(j zes-2D=VqA2;^lVj<>iy~mtjeeAHgrNUC>L|KbdpZCv1{BgFa2(u4%|IKVTUii{cJ0 zn}X8b*o3QTJtrZg@-Mwo4HT-M4S@Q55L2{^;sN~^CIPtGsw07pV!T29l#1Q3ZOh~} zt71&TJFawLn{bI9fRO(X;ZvZ5{LwL4{-1KC6Gf0*X_-;RKIkvGQmIjx_q$x_6(m>E zXCM3qk}LJU%at5s5cuuCy~~w|XGi4Az;R$5=S7zNRvkLtb(^=u`yWA6eH1Ft%C#^5 zpX3?_x|N{K#`ClPkt?Z2Muv$)+1SUpe7^6~6z`ST$`gfD(^|4jP%Vc?DK-qT`=V6y z1zw>SfziR1ZIM@mi)qvyVL2rdM)9-6M9d%724%e8cKNw^jNgJNgG;DFFVqZmDcOP>LA+8ky)|4NI8e}d{)<T&hXE1fyu^BkT9@k;SQywaFz zV*88(&ea<`sAXgjuXL5nOyeKC(&&HlN>wd8KtaRp48$wtH>7{(mHyZf2k}Z%maoJ& z9FBJ2=+0(;LAYx5aAT#Gr{aKuhDHojf6AAyWP6V|AczzI1d(C_L8Rto9fgTsrpOf( z%zT3J?VD^I{3bv_!ygnhyyyWpAvzr-{78br_t8W`1!h?5diZ{V<*qLem)imc2IcMB zN3~N`8Wsk>7?_7NhOLdsN7_UdSux>s7>}=C=d!ZcOmy}nx(-2paEm_J)|9^ zSJF@%d`}u}cN)`VEa=@npLQ{w{*a39vsxU;39^T@A+@c4xIAl6fU45h7n#vH#9~gr zWhJa}Rte{IJ#2Ld6hY#TapGk@wP%*`k?>)KRF#&h{j{a?r-U{XT=%0Cj(?i+Hx@g7 zV-I=RHowR2wu7W!gI%2#iIn#X6>m~u3|te38y62_JkL{C;fWsN`Af)GKw1qidgq_! zGsoP%24SH!9QK{6);FJ(m7kKx<_I; z^N;59_w_(IZ?V#z3ZZ#5%y$|;5HKnVJ%hD5?9&o5 zmqh%DY@S+5G)2*<(2GKLZH0F#o2Ef;(fr-pOTp9%B2AO)2g%|FQL<=>MW$b+(b!nf zW>ZW&+&fH)zWGNIQXEn8D$1IF6Qi&n{b7brHHsNIB>cN4MI8E%bPy0)>+|d=-9^j5 zxE6nh(HmClu6=UAH2o6=O^SK{jOGIIZ(dXZNvu^TX;;Qlf~@APX|<$@G+2V8z_$%q zfe2@=bfENOed6&HhJ`bWaf`EqItp3FXaag0zKCN$^0b5lbZUah3V;HQ(6aGo52Rbw z=-tDbq;(r07)`UR7DAS;dwl~fSbTL7@UxLG%EHa_z5d`9HyXS>=`7|Mr zN6~9S?v`9`PE_QV4#}7L|!u2EZ4wK4-#04TZ0qycVhi%`kv22h~ zhI#kvlPSM^E#}HRCAW^BzD%K1nP9cH{s#?YcQVmWs5QE_@qn+YRUFJu=WF$~ z>CoAc4~>A)AT~7qIimeH9tt0Xhw7W%9?tn6Jk&-kWo*(|@sQJeG8-o%13tGS&-i2J z2h*|tFFe%j2YYXdhSXT6$2}Bm&H(_;*Dan_X`8wZI{AHeY{=tV->eq>r9 zouBk-#ABQ$o)12Cs6j`I7JPn20x5?G4R4L}8koTr%JoJE=YeV&kW?^J^Y>RNcs$%-mL$DnJzp(gJ7nvxbk69`)!(a?=VxzcbI8`NGthrtMY%s zOo`uNrqut2nMVDMhpN*3)pjR zuq*)jV!A(j+bYU=RURKwdrW=1D(cWJVqRbve0!X#0}%UXB=-u~0D)4MIfZJeeQ{Bt*UuB=B-md1jOXx~S%3RdcktrW;>1ngt zM<$aQZRO!|&ip9Ma0c1r)#*jgC!d{w+VRSsO{5f+!_eto>88-}&wbD7avh~Z!pc*t zo-%5d&!Bhfb1M=|zjr5fux?RX4K`iw;y)OE1s zMNKC$4Dv1vpIRvVl5^r(l6@j4Ps2ie;A1ow!&;ItI8kN^H@nmZR`{9tCqWfO93(FM z{&GB+<7R~`m&J9|`FmwZ@i;d6hZ0`<;@z#JghR4w9}P#}EBd7PqmR=JYhQ~C#{g24 z!jX8i^bBnWq%j4{SpRjpc)dx$@i)OgTB*^!42d7L@`vki=P$%2N0}%E$RDrzWPQBJ3r@S-}0Or<}idzjQpCLk$9l}vha*$iCNqApV9TeNG`^p6=FWS7pB)p-qB z^F9qSVd=#l)s;z5u`T0G{U7(-58>& z#Hl1IK#dY7=03^AOK{~z(_Q7-k}7fKhG%FD8nbewVIG&u9{x@a=FKrrzP|2|2aM27 zYwl5H!Fkb?1vbhDGRg6wn@Zw90K4U&7^lo40_^1Y@RG3lv~&c`#888`T?d6NqH}7J zwUWznwWo{Qml$+g*JfHohEDBHLDnRlc%UB?XvQdew zE@b;gsJY~wIjg2-&i2u=t9-V=@c0mIr=fH_;-Ikf>-1@qytl>&K5ji#X=7KQ^j_5Q z2Aa7~3}}h!OhKWxulQsfwggXCJSh@l!G*(ku@C}RPZS>baTbliQk;qM*8i=)+q#Ar z3i7il^(GWf0seBNl%cY_mbny; zIcVA?mU*fruAE42Q{}eS zFx1Dm6%>K`6kwQ)nK@(VHLSqpy+EHT#LYfe2^0ju5hE*VSweH* z$eWHa{_Hn@P=9l=tul(KSEI;bqx7Irh6q@=DaYsQq8Cc>@*wHnaN(3*2tCFQN^>LT z@bRTW6Ew5eX3(MtRYAD)B}0kI=bSre%l(}D#~nq-1LHf?LfNmi(zM1YS`k>*%!08! zn?{*Q0)6)wq<#6@tp4T7rXh{;L%}0Ga87bE#I+e@^qcZB;E)wM+_cbgF*J8nl(AOW z@Zqeq(9v2BKL`_(US_VX#MeOl(h_aT3PxZpM)(^-NI!I)FT{ucjNSrsfoKT0SHN!iIE?eC-Y0O zRRH8qEWGf#9cjnQKe!gq4Et^p)4wMA*x^rD?V%{E{5o5(HhbnTay=}dV3}R!I5?LZ zCo|2o3-@3udl)`)FVDThKs92K3X+TQS85X~94xh)b&0K~UCqSANHms8D{5lxfyaXo zSbFA4@?trib$URR+3$LGalS%TH_zs9yW&zT*=i8{oi5G2SZHE(`x>>Qu>qVSw3@48lipYU2d+{IWOfd6crFt6Trl7I&5S2{U@v|U3+|JM2J<2p=;J@laYaMNG+z`NGhuL0|HfYE3* zGw9lZxdq&T7q3eVkE(zZQ_?wLAyxEqn)&P_4( zGbds@q3rOCj+#mmb@u_6RWDs+125}}ZjYvso_6ZKrPC#sRjyhTJb9H{oOO`XKx^ z$564)l1;U>hGc0flJT9q*d>*{a%!dbhDrx!%xtCN)_ZuOyfgT6nW2;OA*BA4svACK z%Org!SLGT9QDkp_&$zv*4?o3%b!|DIz*#TZ_4e{qhhR)WedsYpX9IOl{ob^9x-18h zBqaFKaMRhoNs6DclHr~)iTl-ALU=gvyu)nnKYFuJ&X^E!(edjS^}m7}Q-Wwh%_usB=!s@h`GxbG~~jXXr4?UJ*JpB@(=Bww_HN%Dbzr z-ppZ}EWC3r5qxSZytQ2YWz~eG}!!bg1bmjLIdk zI&P#^p>Y*9V*mMjMX6%hgE&=eh)dI0Jw^{zurvAN0;_QG&nH14k{N0z(wvQe+WXA` zu_lx1RLEMDKYOV&liAs6MQ%qb8&h{ztVrIio8>0I%x%vOStg3WS89c|TYqv-i`>5; zrOorl2fGt3GJLQ90=;m@PHJ)_*1-VAocda$wOjU82=8oUy$zk1dYbp4jj;9B^A?DH z=Zi|bm~+W&bCSbW z?wS;p58Ep)`0R`6U6Ys3%Bwo6!kNuU{BT#*vWB{{InIfhc?Y_mnkmk8;`9rlkK5K` zx>Sopo6pD(g#(PjF^0-2g>l7K#2-a|OpC7cK1|-0g}&j`7_5HM!nyN5nfJDNwW%L> zqj^kQ`YFfrAapl>Sm$I?XUJCwJ@Dna)jk4Vglu!h&&F@B22yCL%~?uz9vT>wTMmGi&K`DA({}aI5n-g> zp8L1Q-X306?TWJ}X?GLX3ZAhQktTNomG|{E?Cs8XrcNgrEl2&^_I?0zn#39Y2VcIH zVE?$_sySPf`lm+f>y@9`5 zZceO=xsfo*idM*rz&<;|lTSx2{L{mL#fRIgsT}e7@hIWo>YUjAh2WRyuk5hh-yu{L z1VAGvaZf)eU4V$ZU9Z9uyCX6A;T92V1)8Hnpxnoue>7`c7U%8KWqh&Ruce8&5stS} zqXmp3CGFlAK4q><59XUTSlpC=@A+{aR}MQl%Jv7e*`rJFJTLtsQ!l)TB9q4l(^~r* z|NDx(Gkz^t|8y_=%Q2RaBD7b_4y0AO|+w zW^})dn;q|b87~Fw=!8krGwl7~x1H=~cVAeYKaz2*E0%m!MYo7})IA#<5Japm5-PO0 z9EGNC7rb$7rXn`t84+<#Ibnf3L|TeFoBQ;fUT=hAq_xa{DOE%;KFXZv((JhSz3FRR z%3uLTs;&HrHGURJWj z`+M&3R!D7Po9^-Hy3aikE)8M}tA~Uy-fn>XvW9)Tqh8i?KVZY1YS*3oc@+-T*(1Af z*v@MtvUiS3#lloZZ?!pp=0Y`$!;H5&WBc!c!xKn1tYPy9NDe=&fnW zOLoP+_k#JMsYR2b``n0td5*)wV^2HF<>2dcx~FDO-IPt%0yo$wLU6(>;Dg*El=;i2 z0SmQSh34+ivxJ2a?KP_uj5QA%BfY~nqgb3pR8Cud^Q*hl=?&?eyuk}Hqa62H3!iwF zSYeWFMZX=zc*?7jjyBz|%xRyRs@H@C1}Jsphx0!wA_P2`mZ``(Y$vsUS9f=)<4$1{cC|p78wITFkV6(P_Aiq{^(3v?pUM(k zUERjwP@>vsneTuY+Pm`DcL%$@)Z-8&#wfBnMbez!NQ}q%1z%Hc0)WD(BU4q*nR-nP zijAH)w*gyvx{>TO)h~;TZCruFi)2BO3u4Ep2VvGtG?|m_SciIjH{$iJ9BAy3FR&@x zJ(XZ@k``|xfb**&u`zvLlHI=K^I}U241YhK+U#&eEaBGO1zAPE4%K0bVpVQw&63ug zJH|)Fl|Buyv(;5-?Fug_zsRiQ?=>!c{S_7dPdQtP7?pPOx&Ry)y^)NUyO) zlvmiTOkoB&b_4F4OLD(ZCl7$X$b?nq%nh3b+1sg`L?_Ig8p-1E7Ra^>#-EzzH@2oN ze5qax1~&67y?H9@*7Q3WvL2de&`sbEc>1> zWv)ax3#M^Avs#07B<|f`OF)PgHlS-4f{$bjwG8MuhT1XHKIZ9Yg|?uz55xb!Id0_B zd1PapZQoZ<*_cJfi-0VaNU#XKUQ_>Gm3!OoevlgBNX_WYcLvA>14v zlzi~!)il9K>7AQ6iD8dL%e+a6w`_46^s&e#3doFEb=ntNAj*)Jblk==^mmI!TtzvV z{2J3mWIj0}d29*L*dHlivLLn~Fv|EoIt6q9{nQFNa~AaC@ome^vfCRksKy2`lp-MrL zaoP?~aR7(ArQEh~h>T&^t6`%C4_IaXu-)ftl{Z}asoY~je##vkCGbAlnO-ptRDb?YNq6r$ia@X`Qyv48S|aFi;|8ux#7n3BM*Y~g_D zcB9%TC;7rvqKPtd;|!St{KEk0N~7QI^u#75sA{0R8Rojxm}I@} zRb+n+W#Hw4qk6d8I-#e{&Wa)#L~W;M^^D^FMp^51GNS(2pkGi+Wdy?(kp-Y61!2hGK)V@_p(ekZi8VPP?0NO5B<4N z>;+cJ5v;BxHKI+~)ckiHF7a2K0q%-rEo#{9F9nJR=aEtD!7b`?yY8=nFe}pGs#-WO zQbk-2we~p{Q^%=^=@Cy~T1s!gmy#BIcBjAprc2l^J~T(2`I#rwu1Jp{AR?v@=aBk)ZaBO<~y!?%d{i-ry6s{y* zPw!#ZC{^DWd&UV@jmI!^$G}Xz!1sP-v_NVl+#~L+MVRc`s=ktBMLltRyAG1nQ?PJh zQ|Z!0&$I0eOiF*{$Q#_#*6#F^=K_6BL>-fxc>@_~(~MPig9Yq!Z6*L+$`84oJ#^1i z(LUtniZ*A(mDTEYeYYd)Pkv1&*T6TW=S1~o+um}9Uzb0CBG@GAW2aUw8=uec^^Var zD;9Z|R_;D4oammM-d=XLEZC7$oBuqUCFOO{SU_c~R_V|nSfI_Z|G1?!p0GnVh&{Q! z|FE^2^D_nvA~{k{We2Fvl~Nkuc0ie5L!vCT2j*d?BFoc{;G9FnM9J(6^oE4 zCpEZD+h0EGZbWE{>pUk$uCx}hJLi<6kOTSh6rZ9CQ3XcCLgmRxvrn*5JnJseOjQ){ zL4OqXT=VSU`Q`w4+09Rk!;}H+Yu%Kqg=VX8v<>j1VI7&=3=}wLV4myO67-HG{e4}1 zw}IN#UZH>+D!0p6EqTE!o}SjT50kJ8vsVCz25T!esYPtVFU^Him>+qFUT4hf=6zbM=n2NTxh!sj&2Y0Ce*O|B)XJ(D5Gv6do2frdn47(~! z=YywI3MuQJp*O|Xu0piR`LQ_3U4_@}vVTD@46Y5L9YEv(Rw;i!Kyw%<&GG$Rz{ zHj>t6<{l(*+EN!V1*yowTdJj*+4?dMu2e@CjXT}+@rBP?K)+F^9A ztW(uLRwnFTkkJW5u3*ur_MBW z8J(ok;*LG)Vo;nF6JCB^R;RU9kSkTpR3(gfz5PQF{8abFfR8zJI6mJ`wHCoF-aE5z0PEhcYm6%PCW0k^j@clJ>f?yYr8TX{A)L)zWBZH3i5EkB?nR~@v z*^%P(TNiN0#&i;11Y;<-$#=e1qH2bzinbb3u|{7xoD`WBXg#S>KmACDadb$j|Jgx*h8C zV!-14b_jZ@HeQC1gMruHP-D$YRjil0e_j`vmd?)lgOq%N9b)*PYAT*!616?xFf+B& z(7lE0+2c+4jwuzR#k8=*G?J;aabtmx13YD6+fMtnyaSEVQ?nRPCcgsKb3498*wda| z(HV0`!>&3m8C_jlC99+M)Mt$5Fzz$>;%B~Xo=%FO&)DSG7VEgh%=EFDUc?ler zqQ;n1-M4~tc+!&|?Ai-=XfRx@Pi1Dy^=}_OC*G_h+~r;mX51I9qWtzb+(+y3o3w!zV#8%m(Qw2i$HD8%fd{Uj?4^+^S9yAe0 zCH9**l)y#(YUZ zJt*^?3S~rgwFf9>B-bf$I6|Dr-#5$t9$eb@&t_7oVLloAO@-dCl`fYdK{w!$7(^b& zddux7G+<|@af_c2_mD5U9+%4L)E(zCDYQ$G)a92Ez$oUO;IMCTo8JP3;@Ou$^ohb* z!hgFiEY5WBO5Yy%T*8#tXD5XSbR)<}wk28KG+W9!sL0xm7@gK%{o#CUTy=t1ejDEP zC+@Ue=c=J&nz+krjS{E$#DxCYjuYIDMAZ?X<8C}z8waK72bGYo%rAw)){-?nC`jqa z)kqd_8bks1)|$M}B!vJl-uZm~OKpmY_KKGuzt^v&Qn4<#YVz8mNq5l%7uRzdK88!w z3FQF8?Aq%50mJ6W9b&;JWrR4so%_v^lVqWXZGyNC@0&b6kJZ$Wz+~kF&uZVvWFk09 zMjtGnc9l>4W_HHX>&m3|IOyB8L{Pakc;3|-P=|V1t63Lr{7{|~8~}=dK`AFn{@nY8 zg5%5q$J6mu2NO$M%WafDK_eaRBjurSm~lD_5*Q1;^;e^msgI%eU9=%&9nRJ)<65lD zIS1U1kKdVX`8LeHTT7!huiiwqWXk$gyN*}RtDr3FYvfE*ab;JvF7=j+dXrj#H%oIV zF4+o}7!wRFP!)Wx6)DXXW;4|@1wff5dL-8kQ*c`^QzmI1_kJgnZx5(#^AN+kB8%eQ z&a7jKS#zIf9v1d5SDik*&~ZFCN-xOPkee#63zg zSi}ShEF6l#tsQcmsHj(kjYAzP2{lS<25Hf%E>vsXq8T)E2>dKRuDA;nIu(=4tC8+e z-tJpp`s8qa2anRYN_E;gZfeb_UKYmTxRq}=m_^_q#6izS@6>Ck+)P;Hx|M97#pF#gbPjrU$1 zE2ERDHlRV_bQWmk*A54C@L_45LyxxFvTLNom1?I()jr?CY7)g2?qdcEW%<8nK9fudP-oTL#p5Fq# zKGexS3Kb~Sb{Iv!m6PJ(WE{tq=)sK^chf+o9eh`5!Oy6nR+$&e#grAowzjoWHv0-I z`(xD}gMA}uNE5ym<;_{Xcb#^9RKj#J;t%-O%TCRgp7KMo?H-C8mqEN`mha-uX*?-0 z<*4>mF5%?>o#p&r&6FXvPFLvIB2D}QYMu)P+x;HuuSyu%Z^YYkgC~*_9=!*f>Tb{R zeu9+r5r$*!G&p@)g`+0CXT)$t@OqI|dI{>1i^4ABf&A$%0dSAE-x^1^n6GZ= z>=oU#kNw@7>|zbf*q@Yp)-=?l{rZf&PY;XACbo;-mi_(|c(>W#ZOx1bVO`wS7y(de zU$7w2zZyZl+=srz+RxubJ#G=)3bz}*fevr}&!I1N60&G2KV{fiw2`jV~}-sD|pfguZKa8{G`C+kb?fvtl(9OeJSa~YQzt) zo=y~Bq{&XQAh7%u6co%e{~R(+J+UX7Co3@SE}n?kK3L#Ua^TR|xPkdWDSV*MzHbY8 z9L7(D`!5NL(0D_}YN}Zb3AY`RXmBk|IOvay5&LzeoJXs4{p=}&&s%$m&11*5TWDzI z^a93>a;PRQu=(A%nUEZT&^1~9bFO|4R$Xx6m62c`G8nYgN*`!fisB)j3hQaxC`9T` zq|<3+a9|t!2?qxk>7K#&r?AXv@h&EA$>-WHGpR)ddb!u0ud%}9@yV-PiaZen03JQ7 z$@yRkPjd27!N=JW7Z#s(<8VlP(CJ`oo=ysI%fGlT5J#bYs;goO8CXg+2dOU^o9ijN3TDtMVohMt-uc18XkgLJ8( zP@OhwVe7gp#w#-6d6k?CZtIg7cKj@IQi$EdLM3a}lZ{i=MVXR=)-vM*_QHxJA3Gk( zgP9?;34uWSyH_8)Hh%whI0mFHxVy9N2e!HzQH0;iXf|tRK@l^)yD<`NTyBz$cX)q>|_^@6;YOz*bB2JvLYHpU|zP5bM z4jnmb?&1?Be{Hv4g=PpGxzxt#m9qd>Tbf$Epv8=z zt$nzay$lRn^IaYUnch_16>(P=c@7)0Dj(jYHzMO#DES0sX~QE%jiM(XB~nx80)Cm{ z>~e!3-u1$77{R@>-_vNs*x{KXxH5JNdvTNO*Zv?t_3kr_j!-48gW#CR7rKv=lYR7U zbQ!SzRs%%^1;W=Pk%-2Ii@hHpyutK+CN|@Ii^OZp&=^}H2Ag{oD}##czyn>0-~(D> zl3)aJm9g2U%J+9`kcGkaGva{M8s=m*ZdLiX8=2cPjnmW`Cv!7xAxp42%N77jad!4T zd1Z>ITkS>*^inexNOy&>&FUDu$h@cDV$uU_HEQB1$K};~X%f05>dIRe)p55rDX)dO zzGwrAgtwy7RwpZPUP;?lJNB82%qX5RKaUV9cf4Y69~C4Vesq$Nu#j(NbJ3#o&^A2cz-EUnPE;`lyQGP{TM zG^oDF!t#ub6(M7+y4hsXL-5fALxT*-?*U;CS}=Uu^B)3E6Ois*T;1%2;gP@d3pN2! z>V5ad@3)^-mj%=C_?LYa~Y%{&4F>q1*f6Az{ga7sRs!AX%}rx&Rt#wpq>{-2j@9{7LS|N zj$#R^!RD>5z^1+bJZ^%iL`WRe@7(hkU>BU2drA16;~XqCI6r6jGhzD*T;TCtyYV#3 zVlk@5F=|_;+Ye*g!mYUUU~!r~%M|BVeAUE3uVi&aJSW6YKP+wO5Q9!gW&eDxwhHfp z02X{1L4*)PuY{zrECX<}p=j#Ej%zK#jw;0V%va)d(+Jk0Lx{d8rw26ivO%wPZt*TU zjwWJ428I2e4U_~hxG$}x?IcfAIY>csGwf$ysRj5t6N8Txuz}r{cp&ZD4S;1yQq@8v zZv`K6#DDG7I8UhTu7S@L+8132_InTGU3Tcj~1cfVwL`ENQsHUM2kAc*LEWh2#|D#V5w95oFppv8RhsW9CMn? zRrE`aD%8fXIaKYFs5(Wqwcs}}_o^4z3(TL%VW07-GiWea*1L`hF6}-e9V7mtr2_>5 zBcY1KTxXlCUo@f08yGHOe6&S%FFPEAi4cpLn<6hKNoXkelk0FM?3{~dg66%Ol~Aky z4*;V;T)!0JNgDr_W9ZeHBWb5=j-!}f*(OG3Rt}(#AqagGGzJ3O6ZFHl(t|61R=F_a zCW-6pnnVgWMezEVL*NscI9!9r`(*Zr?f%FV0E21N|T4N+BU>w`p^`FNam0^~{B$%i2+)+ZtceWXLiXr?r- zX)5$Gva^XbQ=ClkFlA!TtH!)Y`qF-2E(QsnzB(s6e5i38#Terdu#?FFaHC2Rz;V#- zyQGbMc*K8L^ALTXRLj?HN7vicWeJLL%`&iNWySGEEG?X*PMEPQQ@;-ZUDgz=!WODrIQuBc~L2?npdA)2s3!^<<1^*Zq@ekNEu7Zw6QDQ4pli&`Wc_*cue}@fQvB7^i#iNapTPtHqhkk_kB3nEHfnAt~ zMx4;8VZwQc za>C<5KGU5{3q4qnVT zDT>L>*@tl`+F8;GjHsmwpF(75)`f06h2M6;?0Te0LUY;zXGQ8wc=yx|Quse23BL4U zkD{KgvwTjx>;Zcl0t9k31bNuckSe0^3S^AVSCLtudm%%hYf3T#kHE?tYt!1#=2UBN zlf%J_Q7F~J2adj19NGp*RXWdR$bAx-h3sm&nn)3xa;j3W)rm8>Ag9Ky&k+zB7euC^ z6TP#Ku;W-x47SJbQa*6TlQG!R2w+6(tnH!MHbsA4 zLdIwvg@|ztCr;rmL|L;tK{~&|g~CU0oIrw;ga;DbDCNZ_w`!>!2q$hk*5i~-;U>AF zCi~CuMj$G^o$#2hvrMqF5+lrralmUi&?wSQs^PIA#7y8$5YSrC^&>zx70ytEP%(yy z+IzOOZj$O-imh5>#e@{Bh|>p-V%}C&xit(!W2Hi#Qyicf2Qf<2?)<<)vch`^!-{aG*@+^tY3R&~15`c4GX@3faq%iD)QDddger97TE+ z9C|q$K2_q-Z?*3n;k9~4$6-4`GDNWf2Mk-~q#y4U{RnU9$9h3O&P(-?-l>oDm_KZj z;*8lCs`#ZW=d*Pa!6vD~3=&2YL=%gn4Whjnt{_j5qo{ll4uX4&96{;qu^6qpCxASB zH78ABg#?x+o+ojXj+RWqw+1ATE(9kxlGd@2>ldf%yyiv+FBk#`qg)V;Ga`)@MLf}Z zz`ll&kVS_(Aqp8mDob#wOo-xElM+_gN?IIT64Syu^C~g0kx3J96G+Pk31glKEvpWb za~Q>%jYiF)+Q{}Fwj|;-2wVzr zxuecKTY8OCPeahv6JrP!GiL9LES{4ePf*)+0EKC$2!iK1kpfP4A_G5(@5DqX33}O4 z1fj-HglGeP2uv}vi8$qV?`4*D+IE%qadEsJpK?Lfjy(+Y7&8)1(--G2vvk$9Pgtk&AgzVzTH_cHg<&D( zl}*A`MAJ*VG3r~Cjc*aE%QPmu6tE4t&gx++prt2;;lh*B%E7x)Uf&|n;;6Z#rJ>P4 zi)uQKC1{4hm$LenR`-u)7M}Ymfy972LV|eBIug+89&pUFkLYRnIPLn9L zi(nGFpW1UvcO`HVTQt$&kxr2@SyfpRRx3*>*T|V5dBRCwf+wvH>1%}fJDd=#DZve@ zi%hVX7GPr^0Svp5FiD#xD;7azF;ib!JtVVK*Sf8l4D?<}hSr0nAYP6q3FMn&vsN z%A=j~8IpQ6Bo50c7SLz%9X%$M|DAggqP52)#cPJ3Ngh)K2U5=wJV-f7@Ky5(H^{UI znxvmBIE;F{ks$RFo}{R3wb1oC(rk1Eh*! z@Gy_TO0jfm&6GxO8d;FmH1ePbjpI2!w$Y`)5yD}#3dwMMbeln`l!z~mT8$)>vj5Mj za`5p@eTNYYeG?BMUIvW>dG)!-QJFIb%kF}QvZD07k11j~YNZ}>v@2(dp4p;nQx5}{qa2nDN4Y|wDB3|uF|>n{ zVW$DJ%h1V+WN0TD3gR3lh(Rf*28N=Zs3?xgkg)|(&b)kubRj36 zquR3;ilgf7c5x9nsz`=*G*A$)se%M~3{MAVGBf`RyjUyK)N06bl;euwsLmWR4E1Eg zl|^T9*#6R+KnkVxYbl1-uVol2zm{UCeNqyl^+_p+%9J}sWOyHYdzAdB)OnOVCsO6~ z?%PeeEJG&M`lLW=l+GL8MwaE-a zWs@m}+9s0_txcvNDw|B32VK~NR1tNo!7;9*z|;m^G!JnoQ3kcw%#an?GFg4jhF@h@ zPY?o1ZQps8*Lp(Y`51Z;xA`>^&Hi}>Jwy)HRXZ7pIIlTLBxY4= zybGin>@JwJxh@wl?~&IqI3?%Rk^6ry0-V!4sb!&oCU6zPbBcv zLr_4e$B$4=pW!ItVs@^V+KM>sU~;sa$0+BCYF|TO>Bgz62Xu=&Cr-CBB;(ZXDAJ|6 zZrFsz0tY-p(GE@;<1@^iB-OOb($w~XB`L=?%~1^;p;F4o^yWf$s1DH-b;j81>}I%x-m&^kKn&63oXcK5VEpjNXStqO4C@yYIz8 zR2yF;L^agt##N8A-NP$^n!|FmW|jl_m~4Qha%lygdc2Bd(~l1Ur=G?+mUg&t9PNk` zII2O%any4q2T~1SQJIvJlB}3I-$YRkT&2Es{W)gu!*F_ai!#I@vyr5bcLE&9%CG#aL8rz?f)Z?e>LHZ zn`9OaF%DgXl1$DQ>nxn}vAm3d!A%&?xJ#4y>CHG8v0U9`z8yI zG~n8DXdvTc_KgDdeZD}H&YH;-l`FuaFh^d7jFRFh2`)-U`2`*UEXVrbSFSG4PxLNiK$nFo4Kpgj%+5k+I zrtT1xn`4}adFKAEEe@K@fX~#rao5RfgjTvqnkst<*UH;fTHGad6JD=zk`;|n%Ww|9 zaAO(B($Rr`HgFPU2zFM%+=)TySeUD-7Uu&a3=}l69 z3m+V+wWEZI;DIU^Od=+HbSW1-tO`A@m(wE2g1r~z3QEE#*4Gk7v&NPk`BZ$* zR;#pv_MRLr%lB2czZweCE;Oa)QLK4cGyfT0|8of7d-hN{CXY!3SHpl}xXxaIFLo{7 zM(9JGA9S||SZL}tdmQVqta&txuyC`AZLB$lsWucW4pT*NjGdJ6-Am`}t_lc?-f9%5 zzB_J^R^hI1+t|@Yn_bUc0!KW6wrW4{aCsf4L~%k*;T(IeBUYWl``#=vUn0d_B1I=U zSPcE?NT>NaxJ)SSaIq7Nd1lm%)u?8$4XWTdz8M2wuCG zCTinC!77k0&$6mrEWSo?*=FTDxXbLC{4|?qQR0EORkp~A@K~;K0Ar!HVb55+O|yrF zLk#9At?DE{tCHt1dv~1`X;R%?o<`W@`R%`ckF-_P`U9b3?@L+D;}q%qWtA9LXC6+< zv*~j>4MY^{7sH8R-eT-CM%%Ddo;I?Wf3yd4BJO_jKz-l4SZW_!0BZL`d6a%v)Wy>6 zjS4i69a4!FvQH{;y>?4^p!c4sfb`rs<%vG~ry@)L}9A;*+=AYKD&u>vnlr!d6;@z&|x`zwg-d-qIOG8G?nU|8KK#fyI?%Y!w`lkAFFg zrgCpr82&yxybcdI;sU~Nm)6mEk&Ur>56~4mh`KuW+YfZ{w7Y`Bir;r{Q0Qd89YWC= z&~7*h7QrJ@{IQH2DQ1BlGp>WBw+1{=9Vuo}9+6@POBpHVX+Du+fff`g7Px+qVixEh zDdv&Bkz$tU6)Bcz>PRsQ^NSQaaXxbq3-yQ?u`I7hF-!A|6tg_9NU=auMv8foGE&Tg z{369X&m&Uog84*>S*BN{n5Fqdig}oCq?jivBgH((H&Ve;@Tf#F3vq8#e(hhiWJMe5!o2~+{lsF ztooZmE?&%#SS*@8!tRKQ=54=#DmD z3}|ym5Qio#K_1-#aw6c3ADV>Cyh3+k#}szQ2Exb15TYF!bTPDJgQj?>Hw{wk{Wxl+ z+uN348m(st_^@N^quImaP#U$T3xXey5Zgm%2N<0T8-pq@(E)*6M2;~vhU`E7fyxIu zFC0W`Oz2{0jY$L-NCN2{7@DItN;F1eM`!}HX)girBQ+dFV?tOZQQGE>av!iz1)-(! z5kt!_XQ6;PUD)BW28SI_S!av91m0T+Zi(%&#o#eJ*h~sCX)c<=wjl+B_thX;{DxEP zsX2KU;|yH+xJinc5~(J>m*&JRF`G6#XB(!rE}TYhk)kP84M)bHeXrYdWU&f{1vL9d zoC6x4g?O~O$in7-nW1n2`upEOsxE*O?d&LyuAv<;&EZ!UOS^azaG>|)E|AUx+dsMQ z-Gd@VrBNaY4%a!$gRf_tD3x|Ps|Rk)xf>jeD1sp5f{YWTSZ%pk@B@G%O8uZ6qFEZ7 zAo4Jy;4Bh0Wx5p|3(Gh;@YNZlts|N{n*hHl;6%ZpFq8yG#@)bhz1nOO&R&8!ox2|a z1n)2-1qugs>I7aVfJoTcb0%TSU-75k_r5z3q-o*}(s)rmb<>M_58h%kv0G%iG>vi%y z3aiJlsx~U~Je^_p99>!ghFEvi2(mj2L}7V^Vkm5nK+)L^2BhwL4g~LTi~XazDJqdP z`%V%^b7Pw0nD+f_d_-svh#d}2y9@&KtEI+JIMxCNzMCaNpy}%EYHx@&U@5pc5DS9a z0}+GHDF6f5;0y1FOWhZx?Z9$>L@%J5dkjk?8s{8N~z8(R<@Qa1M}3s_x}cszE82NIN8D8h+wMM5zx_xvL3}ZJDF7IL)^RK|q$G z&;h9+iZ9Kx9EDbk2+(Rt)zPW5L{dgFMV4}}jAg+OrAUOUq5)nJWeHY1LWeKr-+l=Z zZ@&F9PebZq3$V&wrt2U`o=tGjR*mNF)8+ExT%EyOfn98QgDAjXeG79tUWCr|lu^R&&%;Yhedv9`K;JBotr{H^Y zjzOV+5tIkw^Ui+cGGwrdBz(L&3xqlvAP5|;PMX5ub+T^Ku~XHcBEXqo^Xw?q~)eaED(YV8K(CfLpnpMGaC{ zj)JS}O)`rxZdgjBf+%(|L=HX%MT~0vuq0SvS%ShINTtA(o+ZFazk72gyh(WwbWTJ9 zC>9rc>zSbOBY+e`$Wa{S^e*9`1(XDUA9`|C3Ud!6iYW}5@=Zt)1uf0@4MUJhN+iV)kuaF;aa9Sl z8xlrgI9#Ps4Y2+vy1biMfT()h!NF~i0~D);JS>odhTlFCK+z6Q8P^9;?^Tb_b{Wlrc1_zNL4BSaFKxH;iZA+=T+6CSgP>>}fm9UL7;=Nc80ZAVG2oHR z0kE65QWY>OusvZPrlKT6qoE`Ke=1F=g;K3Z4(tpIG}azD5E&x?Lb2mHkd-7 zN=;|3&_^18U+AR>3Uy8c&ZrQ=x*PD;!OZcFWl}-vE_>$tkVtjawgWw7z6+>~_m&4$;QzT$P5veY!VZedl zlfnW3JLJm&bgzPNls}tt`bRozf)M}o7lvK4?T!D)@~Sb$Fz_M96#{jygi5Hin&Dt; zpH_Iey2;9$K$|6!lP;HZeRTKX2|Xo^6IYD!OcuCbPY@ZR833DZ+{4B26eYw z&B7K~3`5tP1VGiCggibO2(1vSHG40LK$!O1c%i*QL3G_h5jr*fb$kx&14>m39x^KjWySoYMuO&PQzm)6hx;K z6hSrpQGh&~KBrUAFQWm)`UQGARccCgpV)7ihjt0U(DeubP<*nTB`Ago(+tYy+@0$` zE=qIV#6d!~Mq~uM6Cq>ps|XGbuDB8gKb{V?&UPm!fTkHyQi<>*K)aLyC7}r(-X}sKR9zxf1|G`-1Tsy6JU)V@LMSY)fYIFe65F+`=Hs%= z13B1vnO@za=n9L%dzwWkJDWe>hHGw~&CYH}JVpX3Mzy0jc>LZ)LgSAZ2UQ>e zc2%@bZA7RVI4-u=@Pm4tfhc-hD2C?3tHjaukr~EEV9Zu)FS+IN1(55%FdEdK0!Y!P zj^dyvMO_?t47&QJ^Y(5 zj>2e%e~hokI55!lat9+`Zz*r_J7~DYbCxL_qcVT-zNzDCBGkM@`m%~Zf(=%bPnLVhw_EYE=&1mE?8g=6-ipYzE(V1aE zRZyEiBka!gfBYl7Np$zBwmlIz2E*P~5(=T~oG9;B2^`!SPz2N#upOcqeBST<3I$LN zIQE4reAa7UG7Qm73V^F6mp$GL96_az9K>Em52-`%``uoctD;G(hh&zXLT7F$#P#U< zvvCrk2X!fVETX}+fx@=19f|F6a^l#O!Acj|tekr`{r2yt**xx0y!a(-B(??WD|fabQ7|gP$n` zdVEblKrYVXdO0nUEG&-6QWT?KDhL{P1R&_x!jE_<`HUyTvKsU>_t_7it4pdXIY?q+&9}9WR5tB!W>Bj(OD9a z1TKL%1~_S&l0MrV!LZk*d5of6SqA>5q+A_c=g2Js$Bbl-#v>3xpw*Wd@B)X$U`vW^ zMjf zXo#fVL=gzW$C=z!@VqS-2a3{&2+Vx42rx?gB`YGlrpHony%h_hcu$Yzm>=flb4W?> z(IX?UEqJj(l;3|8S*p=&NOx&nuB%y?r4u+RoskNo{93ew7PFb)#lFD7)^Co2U`D1r z5*p_XI~k?udXWQ1+T1nMb-NR{|Ii%<41L&&gD6`&b9E)9En zhDCrczwq+&6nuMzMd++h;PWwJkLXn+_yHM~qU>Ax2^mep2E8F85YR_t#P)=H=KN)q z6!UZ*xGIt{Sl_sd5~)_7itH(^>Lfp_l4sXaTt@x&U%x{W=vFZf#OJSt`NdHgMi!eV zud^aes=Le6lfWK!fv`SCiUaqu3#RJl-N5s0AP#^v3@5#+%9(MjWZ}b#`c}cg!D`}w zKzp%IENsAg5w*4)pvHf^)io00jHA2mo@20{{pV+yFW4 zFJ;6@HeI`12v>90QoYsqYi-X z+g-l% z1AZPWE0XH4xw-j= z*ZvkGJ9*4+r+@f~zP~7Q=gSL>@VKnAmv@t9?p)xD0HcO=W5|G6oj;Umoz0(Y>{aW~s(SL@Q<&$lN`^uDK==ep#XqsB$V20Dp z`J7Z)0$Nas15M9v47QF2ic=O%RfabYa45tLIm?o~T!eRdGaofoc%6(pABA&SW%FRj z>AGpkB0_&JqtxjpE!N>mvoW^8Ln>QMD`<|CFys1Ud?iDEt;@oi_1n#-8i%%~Ntf?1 zlY_A!bKyW~>^oK}lL9&Wh`}(+im~qQuZ=~kT$yVu|) zX(#5w_1YFAdtOzgr|7BcidXzB8|N81MzDS@X65t`zg%iRapoof!3j6yCYjw%PV(Twm|ud`rTsld7j?g% zxn69-iw5npbTMvCJlMZq1;5u{RyiO&Hb~< z+~$Lo{#S#$q-JUS_g}t*E*>2e)RZ_d@Ko>MKp}f~X)x>LrXV)TL2(ay2LM{dx^yLu z%C$cOv!@HAFhfpM%&Ntu#Zke{z`D%W4o&PnXc%HFL;_|gLR)IK9FUd`|L=M{NpkM4pt80T;i7e)uX*Vjh+Y^q7 zoIECfi`qeF|BQ+I*yPKb+I0llBz$+Ve0kS5MvwOVM>8sy)AF=@A#@x*O{%9~-2C#T0v}EKC}lVPF902n{+?BqjNCo-k5-3)L{~^w>pvCOhhXc zWSs{)l>Dfy(u;Ck%#+6X5i=MX4`?kS;Pzmk@#c$Nk!oqY;SX7` z{=TKa98Nc}XX>M9N{@H)l-th(z{p*dd`Ctv?~7(Nsh;i$?;5`C;ihSfGE7r@+zhTi zhu@7N(llP3n-;sS-BW{F;ulI&JXD0_=oW?oNVhQLKz`~v|5>n9H^41+@dpHawH4RqtrWoa!A?J{$QbdeYNB52;kJu zv-}!2L4_Z91G<4~~`jmTyS%p9)0Q&2{4XSh>tXcfApceoo>@ z%Bh3H1h;g+;*X$tn;sUWHajfI{mvDvlfmueZD`Iivy^U5)}|_vn%+s&_5cs`+#0}u z>eFZtR@c)IGIob!C$W3PqW;%9tp*P1Q66XH(8oo_ zY0Z7dq}CjcJX=+tR`ZLDiUcSN$C1>X%z<3q4)KXZp!)bVYRrnSB-OlNUfjPA?>joFylPggO@ zf=ld&STq;Lk0L}Ze+Cf^F8AyN4{PQ-VumDbphi%Dc?zGRbiv{nL=o$05hbR-NtCF5rc5G6>TyqF zMsfVC*?<(!ob}Uek67c-VqsPi@w|8mr?$=xbXqe<(n2O62QX5{2HeGrIQx(=@RGBWqYukE$G~KAeSY#^@p#u) zr%`#o=h^gqw!jZzxQW-CYI* zJmr3t(0oyr5-?qFGElThI?M6nfC{q5?vkR|+YRC)uqSmsF~cG&i%~Lrj5C0TS^W0T z|M|bv))nR7*c{@}kE7&AQ119jeH3Lrh7uo9d5@*EM^{#lRj#w3bJbH^E}ZhAFc&V4 zYY?=4a1rBlvUVSz$0)b)8IXP#9~f)uMYXdx)vIc!;nv=q-7;f@fM}4nI~yhVLz8@6 z;_v_vQ#17uD!$u1j!<#1IDSUtg}0O0c^Y40GyT@cB6N3hC??fsMwECyQ)1*3ZUEJ9 zri~i6auPi!@8Cmo0>^K*jc{lVXfDtBHf|W(UCKb`-of_w?nN8n@7_B$dDPyAF{|<7 zemu;_3n6IxmDQfiA%OmmkTYj#nt2w7qz#nvMbf@4BEj^>j#$*itY}o;j8sFtA4Aag z!pcpAHVX?X6F~oiWIQZ}a)do{A1`n&G@1IqDM|A>rbTePj%mpTQSaU`yi?!#UoM~D z6aJC+upLDG7PcFx+`*QCF$Qahlg${pI0v#YxZhG3WJjAvXz(PW{}ZbjqF4VYig47n z^aza0K(9j*GE)By4QTu8fT(xGqDDL&yeR4y!#{|;U*OV5 zZw~<|r`AP?y#?Vw`g#cww+kFJk1uT<*HHk%wXv~kSK)oL%*RO;>%nUWPJJHmebcN? zR;x)`Jw>~rj4;(cjtIT-KLQGJIEFiRj%UtRgBoSBGGF;j(YpX1@v*nV%@)CS%KbH>>D^N zGeB>m-obGJb(e6&CXC}09P1j6hHcZ1tMWK-{V_NVU44x~1NS}hq|8Hq^huL}#}OzN zePN#jv+B6|Q8@iw2acq_?EvVChgEYBJ!~4MDRH8(DBZ)ybPdFK1wL*;_21_O zpdXujc~dK{@FVJ4D?Tv^meDX{B75Hij!4xmD;zlAjZoLv*SnPtVw`Cw$eE6KA6Lft zxB_u*zA~gh2O#cUPKFpTT}Qlv$>72!TE|UA{X84_CLnW zIY2B7yg2UEaqa-B$@r;scl*X`iTEvWgqjnL>UHWH7z)S2D!o7%=i>yriE7tZMtZuH zkuUH8w#sWM5%a#bn-{x$+FOEdqVLhltJ!iD$-AUbzV4C0(mHMwDxfPIIGyG>VBu{R zVWPd7l|`%t2+8u-5d!Al72BH^k!s4|yelj7)Pq9Csjs1Myy)E#;5GwDWuL6NBA5k1 zto6Pdsa8au=y{LHP1LIoj|?%@Jk=xQAs)78z-R zpQ^;5*V*(4P+h3Op-kb+d1VG#Ps4|fFK%^s-(7KCE*_iM>T2ls-@UTXt=V;1jI&~K zBy{UFN1msm4y@x0s3Q%e;|`#s4V)tmm?I99BMguu4-D1dqid$%+!z?G(fz6)+=(?!N9xBEJG^ZX^2&dE5X)-f>euIRkrNHry4 zaf{};#&Q&`nB7kQ2&H)|@XgsjB2|+o-KQ`3+`wbhy=b>fkB-te(}3h{xNokLB33}@ zCdu-DtHK&*>pdPKTdR>0&8FykqX?}&5o)DbQxP#fPu zG)EcTLXgVX7KGGAwnX&_k87#$%0;+_?XjxW;JwzistlIO8*&=>Sy7v$RRldG;QE_r zkQI-pipNmFBdOleRPHFMb`%vmzG`V>DF`&uoZd^Ly^M-5mC9sXpR;rp%eka!A)XOU z^j?67IJHY8(oTvx(|&f*QC+o1MC1H*+R2MuKK=POH*@ruRJHbf=eL5y8!9Ak)7OUg z?k-&z!>BR14yeAjNm_rRQ64jKmC$QMOF*A7E%Eg0SqJbYQJg__!F+9wtDEC1PNZJ$ z59@jsm*-_B-WXp*n~zV_3d-x) zb@?~fL371k5BD1m_NLGgO&x^ywskT+hOt9)I93Yz^aZSNquzrl02e&}1&{#k_> z3^}uZLw)|;_3*NMI9)X~J{H|n63NubIIU@8XaT0oNsLuvUsEOHw5Exn=^x2rK>9bb z?m8v@&=msj^0uhuh+>9#V%BX_79pV-DsKwOp5xAMLdD=$=cTXNfva}3t zFV>@op>aHq^HdyaZx(2DvjBtiHrnpiJ3Gg3hyXZyd^0KzfAI#uMQ=UjBo9 zt|DO`VIPtcGT+I(IGyP`GYKs9@jVfyJs?iP_LkSG17I$k@{F1br+#AF2~<9?jqo(j zYdhOdIqh&`B7&cQqP26cj*ACfQLyjBJSgAeCYhq>`WJLuDi=#PV(Ub7T{xBw9HH-z z-sjq*+Ad&(sXWZBbr5~uhjwwjt`NAOn$I0OS*nuVrGqe!U0myWmw?2Xl0dN1_+V7^ z)mRLxJO>Ix?Q7|Aq09-+xS6OAh~d~Hw#dQBuJ~m?S*<2%^%R}Gv0kHcIW14im&o+p zNqho*qx!Z{ecGe?vXOn*xW4Ogeb!_6s>ktBBm1V2ebTtTXj~sO zqVIVepEJI%8Pms%?^_l>6WFN7wF|T%?$(V$+h^B-sGOFR9 z6w8Q4&|2tt(`XFuI-*w{+nbK;MGt(!FHxPsXtYgLBbKhUDY1AvBNYoccyuHV_I$a{ zKjWvlW!QZ&Dq=Z(_eJEQO=eZ5*hGVj{CzAdzkMbz9xZq;so!{pcOB16DbGzfmKuE<3rB+Lt)*sFh3fD`ZES)`H8mp!}OFIH7lz)?LBMgyrR>r9h zQ*yli{HDAl!XdqTR_3XDm%-^TBXA`BWdx4Y*`iN{nQ!NjV5ZfSv1g8V<$omDjf|$q zySH3t??xAK6wk2iSR0j9`cSTmdD3KM5p%?8pYD~Ar+bz=B2oDiht%caCyX@oNa}x_ z0w1@aN^ct=sxQX?O#PAtfhz8vAVXAhH3r~Cudmku$8E4Jp0C2wyevF{3-nY7Vu+){ z<9z%Sp7uGZvZPRK960K#y`CcD^lx&=JiT{8u>2f60_5l45g>2(j%E3IcLXlbxf6-8 zMt-1cM-an3JH|lydtoxr!wF-$CXNpV!sF>EMLu2Qktubd@hC5jR-Zxurow3b7r)<* z&|gRBr{ngI`pA|W>E|}PnVP)_fT;At9X+FU!)09T=2K3bn~n2G-nU58&%rd#+gBEG zYG0YAd417=VFlV&H&nZJaTB%H+DSaAi@!zb=7SWv0K!%v-Y^kf7xdA@m=9cXJYS3I z#!cRzC`_uG=c6SK3M8uyy{yP_3VOT(D!Zr6JLZSq1Y(Fi;Hll>6_Yj;&wWZ~WF|1GTAbqS!-icHXaVK%|nCAJ(_$mg{ zXWHj!A+tY1joCfE8tNqKT>>Xk`?#Ax+)t%>cngCnU-QDC(NxKQD#w_LkNh|kK7tFU z%OIXDjS|6D;nnvib$H)PXX;$+rL1UrNo3*i)|9#qzm^(bQAO8BuAxyIcWfPJOdV+~ z9cc_5ckCQ-%p7g39A}LD8^(tA)i+$(Mx%0W-@-fw+6-qykL}thkFY^d?ZpvLdG#A| z5ZCujJg_ai4vt}iZoNvY+vy+aOr^^0K#jLl6mTBPM2hCOo})-%YdM)1tL^;Pa01O| z{U+c%)@~FnXx-)j>ep;s_l7Sj97T;!jH241rq{t#^Y&b>SkXQR>oFFg!WJ`Qy<=lN zc3dE?TBjstkOu;SqZT-hAplE$JhJx0B;Je4lany`Mm)^DNSDox|e77CQhoYJ2*ReHYSa?c-v4EPz;K&?*R_>X$-d=SSJaQRSdFgdTWR z>{-M22|{c590Jq^c+4{s#ym z&Fuox+bFo1>aG`%gJfsvLv*s*@$P@vA!b+6$gr*wnSNd6s=4lNrhx4Ck=Ep4SZ}3r zlH>JNfTrHJJN$MRF_xmbiRzs|0qJ*8!3k8KrEn6JD-0qgr>7F_1B{v6;*G|ONG0!|Zc~P6#!2MqjT4L08UYrhHBL0h-f#iOAbAg}n5Wf%ryPsW zqV;~inw16qL2LO9N8R`oSkVfl`*NlLQhpajYNuwNMJbYfG_y&XC&f;TKpWrdwhRQ6 z>JAorgwQiYNAh}~Qn}E7N`*t7Y>;*nDw~Ct(Q`J5da6}|-8H%Lc$TARx}5;Wv!|+~ zKN3rSkVUShat}p%n-fyJ7t!iBC|LzJ?3dXYA00HXHZBj zr<=ZRa6FcMV$T-dIWbr8prEUjq5MM z)UV^as(N-B2c|@=El2~z&nJ_J zeomQ4^zx+0ehz$+L4o#qUk9;hk&66pC~9X8>76Jm7~P=(n+sLFW;L26#DgMgFA z1pk6NMDz%RK-f8cdg04snbo75d!R}`UCTVRm%`vej5dSxIPt}yLR=^(GFq4T&L}cY z{gjG>r$5CcHDQE!v4XC(zkssGEAVj(s_e4um-r%CjqYG^G+1k2j!N_P7e(CNx@e3& zdv{edX;rS&r#of(efpwM85-s90xaWASu9H3xkHk#k!4AG`^uu!p?ZlFR=JpZ;BSQp zMVO|`?oLWpEWX}fD^6YvVJEXDdrE%`L5#|!S*(Q+J||U{6q-oZ+msV&l(>NU5zG=p zJTU+ov83KJfQzU$JuL9z<~QZ#MxLd=D9N(|b{P<6Otpz|8UiZwvA{azw4Xpe%VQZ1 zhUPnREY2F!c!eWq-i6Dv>HBQ)_;2EAjRc1y8bm}6=htCxxVyngfo5JO1!^QG1-k_A z#N6iT=E=Y?&ZL=t9$g1QFsH)Zz<_r%F7wxWo7-ZYC(YoqjvsEmj?2th6bHo}i=E7} z-?NoHN8%R}=H($R9%X$*d_|A5l_d1V5>w?m2K&sfr4$9n|H-W-&F^J(;*W`6$Defkzn|4BLB% zbXULPHG{-EK`xphJnu2Z(#%hVdtV)*MePZrGbf(26kAvA5Z|gntO<0KXRFgPspkJS zqJH9JiQYqlC3-51tArkt!}-gqtb+E60Gwxa-7t?nVW9AfY9P$RRPiwF=%q>CYAoWS z>D-p5_xVMh{@OFnh8{27!@W{%F&xyqLJao)YFZYkB>);KD^wvopX;rc2$LFrR4$kHY1c@&$z$#e zoWot|G4Ms4-Z_$RN)z&>tiGky=0(6*Glc~89QP8^d-wyD*N$5Nsn?%a6^<0iistwn zt%3XuWgNQ}!JCO%bfP=x7D z?EtdVo#g~z;_ao1=-#3*4lsNcVO_Xb1>6StS!7p3+#^#_cC&iD{8{ zACqNzmgZ);*jatQJ_A`;4}vgA|3TKT&&hrM-lX{ZFETIBroWH#ggO}GZY53_YZgu# zY6njE^XM9k7H|Yix-?pv436hRMW;ovHlt;s&Z0$^%Nke~n7JW2nbu8Ze8;c5W6i`2 zLZte7mo8$^*Jmf=q@E@D=DSIekdxi7c34oXox@i}b2!9B)br zP3NOxI4)ijF!VcDS(y^}R2xIB$CFXHT$M#yIJ8L5`|5hH+6UP=tdY2YkpWp}CrZ76 zx$Pb9hs1e(8wQ@P>#Q(KVEY9*^Z&|N1+^pLKAE~)N0^5jI7J^lrpqMa@WCc3uzYv7 zaLM{j<6R^H5~Co<=oiFwmdOn=YZ^e)WzObZg-}d*|LBIB)Je$qPhEwHqqyd0`zf+e zhKC)Nff@rWlPS4cI^ zopnOo0|&^?Uf@U&DQAw$)NVq!%IzxSUS+#UDx)Qm-iCf~8{e1q?rjjp0Pf2e{e@37 za<^AWQQPK;Vfs*KY@RPhW$}xqheF`u)|JS6|IPnJU?eLCnZ=!HQJ7^CUq~`h! zY_zEY2QM0m6A5QoZ7tYxnmdkBil6^riEy0!dLIH(5Ok zoMbkn-eC779nR&xopn(yFUzL9&I)hURV)NWNPl_fPdNyQh@idN`*<@F0Q0yd0=VrV z5HMd`B4E2F0s!-?#3De(St0pkBt0aP*IGv^oazBOI+`{0K*T zsOpb!^pNo*9Q`944R^+maI}wh{s>3^2uJ@2M{DJOgrmJ1{zo|aM>smLseXi`e}tod zgrof!Kf=*J!qGp%(f?lwM?aiBXN8wClaiPglcJdVlA@5-k&>9Y(V0SeMv4LoM#@2& zMM`2`H{CCgHa^@WzIsGSf_g-Wf_g-WVtPbLf_g+|`v0=`rt57ZTe{}0)YBJ`J0%b4 z{3*{$OP022r*~I(KlwluBx9Q*SRm;kuf73Nl4WTP-?t(F=$x~ERGm60$IFF?6>EwK z(<7-VqDN9YOpm0NpdN|i64xX6SeMosing`JaGS~AoHLWjd z@3v31!;@M+`|EV(91hZdINTIVL-ZeBuAIvO_0J7A-Tdk_VOk}&fA`l}&<1UOJgM<{ z+~!{Dci8Z5+lRfyrsLAYf0ro!y9DvKVS?T6-b8r+ObGG*nGoasGaBUmGalvr6ZElS z+XUAhkDJiZ5!)t2PSEIx4db!XxKT_rg!pGPhWICveToeeBE=LfM$B4YA>s%T&wr9L z{X~%!kj{n2cj{i6;Rw)V(WVU zaWVgKG5?3Vn1SlvKV4bbT?P7AYYFpQfN9Zg8on3au8F(UeDVpTgLmb!UN`RDqYwRfWn6M=Xm@a2&0;JH}5A#(qk*KOxzn>ivbQR7`^%v@;L zgxTaunlPn&c5Ghx+~`yQB#zGq9}aF*I-czRb(JK9(kqLA?Km?4#Qmy11-N$e204>E%o*LLT!Va+i^j`_{N@$JG zDWNerpL7B^mt+7wkA(Ig_uoE0`Zx)8-qG9l?~V?Ft@oe4_}BXv@80gk0nv8dI}0bp zGT3MPPhY>-d;a2GP+#9a|MQu5O|kmRlYa)Ax-WOAKl$PPetd+U9vp>#_}O~7sxP{+ znv}u$wf_`(PD5?{&vofNB)e(+$Coxq4!(G10C3|Zw*gW&T}Bka$s?lI>S#Pxso5M6y;s24)Z4tn$JfGedvG(9xH z;)kC~kpWFyEe19gIUcdI7;>37MWkncovc?Y_uY7x0_mDhp^Jke=CoLqYu_rm9A=3@ z7R1{K=@QCsD`3so#Q>|nE(2RdbukydvvnEnB0fUM(65lU%JbAFN(mI$vn{jbT?Way zK#_SVE!)aembEAeg6{uzILA#1K343xzASzQ+)Ck7a?Fu;nf%PV)Hw!hxOWLz{0y{3 z$z^2mGw(9^8DO6oLP+mdAj8Am1G8eR1ZmucB4q}qK@N()i)Ot%E~cN0^AdP-@iLxE zNI9kUZTbxufS=;*Bnfl~Rt5MGs3(b`LtrtsMCP`sXQUw7I+?ouuT6dLvCiO)Z z6Z8N;`|&!UNR=T`xvzdJIuuI#qglBdZj4(?1(5vt?SDV=!kQkNg9Tr${p$N-e|}a& z?YAY1lmQS4%qNHdqWo_$uq@nxB=!Y0r7eh`A9_8SOu!2Xw`(a021aA>YAQfzO%)gs zWtB0!zRH~Re!)wc4ycQ(=S>!2xGAJ?xH+JVb`D6kxkTIhP4ysoGD#GAHc60}>KPxxncX>Y--70|d z;Lp9T9Yv><1|T%dK!7sb*zuGghDk}5WQlGU_^HGbG*1=-9$E{+m?MXS3G*&3?NOS? ze;e*asWFh(NX=dzzJEIPgJ7vCe%?fCjjG){W0ML#QmGqVR6_D+fVVuGh^L_E(7z&C z23!PvvkyL;sT+n=0zRDTZXx0;(l#7v0K$yO0C3s3r{>AxLu>x;tbJC@5GHQc(h-a* z$^^!=s0?^NjqxSvVq}m4UFq#}M278&^lg9!gPJDt2E5ev@HgCT{b62xi?!@-5Lt&? zpMIaus*|A5tFpPM{N+`#?XsSJF5Q<8f6DVx1}u5EqmBTdK(HCaEYh}2;+>JU=~8JA z=YC3iw8X45XMBqczz*nZty2du>DP%LH@3Rs3Y5HGR!87IEq%wW&cJ=MM#vzO$Vdy~nFc=MyT@87-)H$Qwane4ra z|NN_Wd&jT$pM~4+AHF)+pS+JY-+T7{ZAyD|*2o7%aATix&_ryFTN~qi2_=7OPNE@* zU|d7s@wi4{oR`Xg@BA_tge6vcBmGn0^-mp<;X}|x-77V|>(E!_#V_wxEB_)t1(DJg zk0<2z_|%fye}Nu$(cAA$SJju&zj8`x4yPq@bF2_8w|x)prB|AxHTXVS@6DIhWYtu2 z;Et>hQfU$O3u0qfWyRLeh+nQ!zb}{FDTs1@TE<)(z`?!-5$JMdz56%*wW0uUjjq;X ztUO=2YX8NRhfFq)FLkSM%U2 zH5LH7{n{d6{b>=Pd0+vs{Mi%%ssmUAV4=@yo~#L2LB%3q>)mD_wA$VwY{FGg-2|_G zHrnsMMDBj}0Lb0V9s?Rr4}#s^-2KycS3mg6qPR0G)!AbCAdvwX8kd4u8yAC_92fHp zd0)$?AUf+(FcSuR5@N?(3}DRsL4pjDi-9K6X0|-7&iCh4TvrqTJibbMJWjVEP&)0) z;fHkwffs}?0o@O!%m<-8GaH2F{9F(q)J#y?WAi|0 z%s5V=Iqqeo&S#vZ)ccHY5!=6b_wMN3v!mzUc4(79xh4St8Y1z><1MM|K_uXTy4d_* z?eKg1xUKf6+1WmCo?^67y9NiZo)V(_o% zE)1jnwOmPn+4^F8DkV{l&b%!qt7bg~$0B80h{s?SdsGO%E#$B3=iC##j)EXuk3yjR zkHTS`kb!_akc9JlOGS(isSLmeRBq1>r%WLRQwJbJDYwQ4Qt3o|L0Sf& z>(O%S!(xGK&yXAcF`fDQhwb)hzyF2VD5EhzBYkZ|0PY+8-BjF(L}(UcVqU!*+Fxl0sXXjBh-wmea6GR`cr2pY^gz zUIgWa?pBc+zOU<9YbnA#H7Sc`>YOGqngjPqNv)5IW?42LVpI3}3_w7ykb^u@%MUM` zi&yokKB(qSlydcHw*c4yV5Ko;m$k;wM=Oml|8uxKvTavs3eDe}@}=~6{G7c3z)tz! z)T~GdU;(gDz#@Q`4H$$!u^TQ7LUKQXx13laV7Ijx1mrqKqd63Om;;Gjdt<5sYVs3~ zGssP$iI8#%t>op0hGx35=f6d1`_4i3@kRZ8JI@f z49qfIGrC+(x{#6`T!jOvxd*{)zWYhf4)*7(vt)>WXP*c8vualBV)ni%Q@@Ec1)4mN zKl3P@Nl_qqw3oCA3WYIE3Ig(R{?|~}NmCWhwkQT&?)RdG@7Eu1_W;V=E%jQxMQb64?=6a6LECsVo z8;*;nNEny)PgjN2=jE3aOy?1kzbV;JY^~OdZ;QHd7hDVsnc9gehelpf<3FdfUnWI& zgVXYtBvAXOmeoz3*Oj-*ZGFtAayHvL-VXzq95=qYX?+2c1;$qqtWQ8=U~we^dBel9 z-oeO=BLWs^p!PRj&~`Xh2nHHJAjor>h(Ov>g<+2kN?M>~(p*suR}=$t3;yJvsC zSg$T$_fGX4se$&T?|}RHW)K<7%?$(^9U2I9<-$fl>lRjDpk)Gsfn~Y|08aG{2A1vL zu!GTr+dv?BkKUY6OHBYgWjH@N`&cx=h+l3T@K+89H5w|0$j(*9ab01nXfh#rOg5kK z<+yCluwVk9VEwv@p>APbmGiP`W3yj=1kW*0R}QM1&t>!eQ&Sdx+^I0$maDHVrdu%& z5{_Gyf7x2|1O$pd2ld#ul%wDS*Rb(QV?X{fd|Zcvf62it0T6 z39SSvZIizKN_f9i zODHQuAjh-9U;gw!$tn(q)q4Avb%LFMOF~L}sNkTqg+04w_LD3m6P}oe#0mZrq>Z9e z%=L%;=kJ?h`Z+$;_x3kluv{T!28j{xP&5;g+QKQ2)cEpQz_{co8UV+ZQe!CAS4Ih{ ztV?atMPaEex}qRzCtS_f+!$2jHGNW|||n9|h$?s5tD zER$t=URLGoG~B+;BND?^AobU@1GvM%Hr>dYiW%HNO9y7|60`@G|2a>bo7g-_0oWBK z12b8)j3OZ}+ys_s>Rc_C?N@B=Ru;%#DJt?askK@2(*oGw2`1Zr9kzj_bM}j%Oamjl1}QYK^_U1cZSxVs==|0pfd zNQ$7SB~>-+gA1W9AxSUWc;Q`Lhn+UQEm)uC2lcc_h?vM_OQ%qkTI);Ftfa;_tI#;; zDqxX()x5eWuy{zG}hbWQ%PY^9jq`o z17-GV8irCjMGn+mD9x#mOlRPwQnNep-nd%A$)WB#i_%yHLk+URV5(C3*HClka?P(V z3OjvN5VshoVyKa}DEL_4Sj)VlGV|%t$-h%E;q`1C8Jb@vj&|TCZBjQ_N^f;OF<*5I z(?MI!OPp#Ngwkvc!iT~hDM$Yh>s&u=K*%*uENB!(5t3iV}Z8=15YEOq>pud zI$f{eWigM5E}J@>>#D@Fb};K%*;%cwikX8Q38(=e6HA&nGDbF8nWk98&;y#1t;?=w zST-UTmpCwLGla#;rL<(`Vt~+dTpoxCku46qa_kHlc#Qz4N$4UNfXc-oHU$DSs#XVB z26nj$K;|3KjpIBlT6>5Es|fCC(R3SJ@;Ua&^b@*pis0VYU+1rjSw7%oRX16bc|+T4 zF6yRpQOi$tmZ=t57IBb!v$DxUVyi8#d+OHNKlta7F;|E0+w)mWam!@kbv8H(iuM2H zimq%%>3!A^ITVzuw6yTq!N$TQ6&enuWnwf)k!j%|OvZ&GAEoCSW=9&V-Fa!j0LGjp zDPe~SruJ_^M6zO!5%H}V5HT|@#pRi5lzC{#LqF2)oa`o7<)*tF867i4rkI&=QRAUP zaDhCLqQXi(v|T3ca@Pi7I5YI@=CF8Ql?r~6NQItCI-|HodKIv9RV3s^DE#yz@!kx z(M!%`)rJ|l##w{WBdvkBu@))pXp0bNyq~R`Wql`rL%URN&Dd0x0QREVzSGt26cw5b ztDrsbsGSNRj-aRv>R8U*a|^eC=#4!tXnSwZ%Pb)1%&H4QHP;8BCt+RE#!&SD^IzWt zf#6g_P;faOgk@6rH}n}C7YUnamju~qMlmK|tCjaY96kitk_ZTcE=9yx;2IJR+gpFj zLW6xD27^!eaJYOk>(XiEKpn1^mGgovNW$_EghbU4ppQh3=VJ36U&8wN-j~#PK!VV* zfCS;KszjlK013jGWl;>;>r0f7MNvT6B#Ol#3XF|E6bye{*Z;~)6YSc@Bx5d*)Im!W z9t$qM`QOGyeL5&lZ_}3nc|bG^w5=Pud(oB#UM=@Os+}t3d|4jX8M>Sd12hGvyrTjE zuMzPu#L69l;-d%!#@35H9(rd8X5*j&GKON}d(F8Z>l1)oBGVup#HB!*f^*@mMj`HE z!YpncyF_I>n@QT;L6{?`l|bm_)ChyybA& z!l8*|mgaC`APQG_u`E%6MN(L#=jhZ$fkvy}2$Ii56(V@l6hUEUX%P~7hYiAtCEN-u zQcy5@3p+53(6FnypuWGkx}B%b(AQNF8hF44K@r<{p_znlu|RS83&LIV?{|VoT7_13Mf?BGQ8x+qG_ru{S~d6YpycaS4K*w3M!)qqEC)Q zpy1`VP-s9FF3lK^t%7QaMW8^hY8!C19~xPNE7=A!WAF3jY$H;EcF&@^n+=3q7Xc@5 z@XZ1+5xxrmvTx);du+CYH|`Sy5?d@Xm|1~8ih9NQd8RBhyn>+5H}qa$5Eob}(P4oF zB?Xpcx#Uf7aY|2Up-Z8OGC;1+gwID)RWSSoE7rSsPbNW5{#L&{uMM z2rXBUZMugSTHX52_Vv>|`As&<3*T#cWA;?@?ls%wMO+O;uf1v@dPzeAam$<{||-NOL!wFR@s0xNF@FHitBXxIOSU(iFS89)2O ze)pHFsnG{Bub@qNO0A;#$QMn+1V}#cpa!lxAbHdx41zp4A&Ou=kSp~eJUVg(pj|0# z(S`?1aN=X>H5niIuI$9jirikYa>%S2qtN4AUCP(%4H2`NUMkNsIN9b&WO3GUe^kZI z_VZ*-(Sc?2c6{mD9sydiE2Ea4Q79yOU#LZ5lM{s$$W9azo1Q2beuJrw3Zyz(Hw6+3 z1rWgd_(X1hBSH*qa74f_>xQTuTEvKJ(rIjhW{~KtQD?Dxnk-f*8q{$=m5VY- z$nMCqVEmRmi^lHBvshi&*ZrB?=z<`(LFB8tm>t)P51D%M3QljifS~o)%tStr_L-M& z^XC8by;ZjbvWLNX@om)WN=OLM8IUN12{8ARg z8aCF|ZMdAB_|J9KDqC0D&x+Y*mZjf$~t~`5<7%WpmxRzA{sB=}mAe8#DqL zJtJT46(80_C)ahReXBiMkk#7Lv)lz?y<%X%+Kxszgff1ub(-{0*;i`}S7_C~gIA@D z-Y1vt4H6u;*o+Kvp!X9R5NJ8fXb+|!1_6y@90a_P+2Fvg)-@L3dl}Nf!k{5VSom8{ z0PN;JLl@vdF1&O?@}Tttm`S`8Ms_EZB%n}cZh%bu9itQir0q0bWG#H`Zr<`21R*L99*4Kg4hUM$Mq$uWHVWgMg$fIJ z35mtKZi#|DiRSB4h7aP6pe{}}Q2Upc>p8HP@3CTD*XVH0-Krqgaw;Hb!vpYHq}R_C zA}btjc4UjObH>3wi!-=B54ymO;DNV|5yZ`Ngvh06F0=ioN3RaD4R4ow^F~7FakJ76 zU1n=Cqcd^5UCo{)0r4OHdL{uSU1jEk(^kGL94;-&mJ;R64{}EFIkRSyg`Q%^Xn8zw zC>+yS*zsSm>vK&UF5Avsn8};DXU*De7;|~WPq&TTj<3+I<0ga%(o_f;pdlPIII~!E z@ymiSF45v->21cao4t)~VsR+!hAH>sa8KiKU|a5R!2L8n2zGlO2Q^67R}0?4psUIT z0zKbjBcOvl27*X=H3XXNYVBD=EHX$tEHU0tNAX-xvW`Vfu*b?F7@0$uB+m0W7{>8A zDD?6vj0RmNkD(6B3n-WcP}oj)o5i|z1q1GCaldO>&r&r2-AQ0m*eFBAaBk1|COoQl zr+yA=%Vc;qh6;Fe3>EJvm>ge(-fs5l=3T{!UR8#WZdHUZ@qq{+V-%4Q@H8HWaWx)` zd2$0p;`MKY_OWQidsqACa9tj=mlA?eQHX{@OWqbE6s>76E@v_+n*(BS@FAked`D!E z36I8LG9Im4*pNlzq#MU82=Wq(r@~YKrBQO|Zud9pI&Dvjk<(x35!BF{{!NJa0`J7GgmgBn^jlO)KBs~syK};a-!kA4SCXk6JRY)kL zRB2JaYy#QEI2FbkC>0d6<%VF~j5fO~hcuM^wLp{swm_T(HhY?~G1qTXrIid+4pX~O zA#5o|2a)9%6%@;zZ5(OT0TyM~0p7Du1#lA+0YtZnqr5;B2*GldAdAT6%@!-PTh4=a zrXPF941i^`MsM(4a)?ZnFEUt^J90Wb;%{B+l+D=DKGSA#ZqsCuA&)Z(nZA$8J8Z27 zZxjGnR6OlyJ+~0%(XxGFtVZ?Y)z3WP!d+0@zniRpe>Zs%|1JW99!X>c)K=uAx=Rrn zoS*V2Ts{&I3%x~TbaE+L5)F7oT+k7#-|5|qAuB1;(jo+7IJ4QeV1%H4Z629I z(Si1Tk*GyuQ58k6uOb1vIwy0@@0c(C@#Jw@K|@L(k4b!O<>e|%UbXQKi`UPq;c-H%R;`XQAl4P8!n*xOmqROPhT zVNc)*oE1nfML|?1hX+SL?g~voV?NOwqWs;-?PtN}Dv?3Mnwfum_}x4Z_NQF}(9QZ` zdhXd83rQ>}ew#2o4cLu!XeUthb`;8K?`PYUq_Yzdq<4@Qtf!I~0Y~Lv7(eBp z0tHHiNX=-2K?RHI*U=6}A~DgDA_;hpx(#8Rw}FW4HCAvzM`zG7An4MN!AjPhPWq4GI(085lCK!$@dshtbd#a*T%WT*r9K;VzrV zOhB8|=`gry%Ln1h*fuK=ZrMQC(%2ZrJ9#8Ll5k~$qX3r#2Ld-9?@lyXNtd?h1g3Cn zP*}?;cL{4XbKD^Vfhg;n`4$<7$z1$m0%?nxdR2=F!RyK%LDv*!d!IX)0kCMp9bG2;`JBj!?WB*;c91=8H3+a zY+{(qbpzU5JJoESgPtY_DJF~xR!kBdwAeH@crj^_@B;->VF(JPazPYIr*Iyaj!Qfs z6`!~;c%=`*#o`r@niWR9Adf>iTk7$m@e#t!2BYH}0LXbsM8d4&LI+S=;JflmStuyo~1WP2jfPEwo%Ni}Uo5U&in@OXh^km5bsmm5SqyiHhRqfPrGwOGR;2 zeDmuvqPWSOxQ$F@P_crziHwaAQg@>1-NDW=QSxS|3Ea3vGnBYD2EwV-SoBl=5vO^l;haB3Css?2xlL zAS+B=byo0wzry}7np{6SCN%mofWrP9&qyyEAW7kM-4f4U1NE3 zug<5K_xKS4Bqru2jLpzZSj2Rzu&CKZfVAyJpxk~C5c;xipwo^NG+^2-Y*I{U%bR)X zgkl0+Lb`D4eQ?NznL`tBPaZETj6BhSAT#PqLP^cz(m{~}%m3BcV4?e)AaW>VvVnoP z$pP{)s{`Z;mnM+gw{w-F=W+Y#OL7`0A#}*L9%k^ORzC49cMla+)huOtTP}W1UY6uC zXsS#K>8gy1YO715_0=U(E3Z0{wmOPnq4-Pv$k4P@X_1L(!t#*;1VZfza>!AdOIxIb~`-Uayz_0 z2|*#oC%r0StZJa(LKZ|}(X&+H)^d=dF;ZVIdFiK}kicmdmb;kZRUs z3>R3*4Bj%zoRDF3QJh^=aS1A+GH?Bh!}>Ibq__UX-fUJC^J%)O-2E3_eV}Y|fceR5 zqH;{IH}pYaOD5LN`FhA%bd{G;okK?8hkD)u(u-COkGNG8<#Fp^4liiXRbJF8tH1>F zj4&g18sT#5VK|qKXMJ*XDq76&Vg!cH$%`6En;G*f4wDS;F*zenYZEf$F(eY|O=O|S z#6>NLgNqms2g&8X5c06Rs52uY*3Ci244VRt+B69lj0hxD(0MB#8MQJBE)v-pC^lV( zlq9E3h#G!kFdh4{v+*N2nZ>i9tLAQcSaF{+Z z;xm0}#3A|Am`?(@@O!fuH|p+mB6sVBM~m1not9|EY;ZnW)IFQTkc+WpjJQ;bNP5*R zD%C#96spWDBWTkqV->^2WPP>?m^95*o+Cv?W@L^ED4lZ$q=Dah_$42L8)~l<0Zid;J>%J!h8K0ZEZf}B++(k|h zGCbLHT@&RagXM|KggcAvkXgZ!l?;npA(t00K`wLi4{}4PHF=OpE-jej&0aI=h)9*e z0ao1Ls@Q;AP+2Ly#vSH}(NUp6A7k)B-oWBT?6%Q~)RU&S>W|0u;=>|!h1tQei^2{r z<^@z-+;$_#fcZwS0b`3`L-y7J2i?Dg3(N8AY-VKfsDB9 z??lSG)~D1L?LT-`&da7??n;({sb=gF!39||hrK&W=^@s6Xc*GZsu<4s=+aO2CSPIDW?$h%Ouvt!%)gGK&5w?vOpx_~{B1}&Exw6dXWsf3Pn-4fQx;)w{fpOS zb^fUji8mLV<;NbK{JTvgdH_#KHbcQ>{!%t=G@V0e+92DgOcQ`idn}nqw*^c}%D3yh zkeR-kws{Ei3NFDb`NW8G@~PC>PMAub!Nj>-vH^4Hyu&3Y`$!#~pBRZU zbXxSbPaDiuPHY-mL~&{Dc)!d+_FxLcr9aIha9x^y)i$n z6EFY4ar-~5q3FTx>#`(_xh|d9d6r4JT2=G& zK1@)=ap~C1hBE57bYhC*x+)Iku@DN4z3IuNMeL123%Y297ID!ED(a#YTn-nlqoXd` zCq`VfPmRG;iquSE_YY^~MVXr$iU3XGo04BWap!eDV04cg@aeH&6>yu8uu{incJ9%z@_MB$ zM~JvSBSX=Qj_u*&L%vqWB?SZuHdx&@qzwBC6B#q=HZo^F#)AS& z#-RBHrh3Hw{@A0CC&N{F!5r7(MY3F#7tC{2Uc^7Bu&9Gjfl>cz0i$jKVMhFd#f>@! zi<#_lE%?eL=HR;6~Sp&GSDjreVq6{`1YwA>mVEqofhP$XgSLQ#apOW4|HU?UYzRjWgBi7s3$ zCUMPe#Jg+ItPUY^H58yYoW|5&)3acK!Fgc;zBwNvd zgVdy99izKd4vyhau1N0P$CtgKT8LYd4 zqSF+GLtkHQu_E3^VI>FnIydCOd>rk)d?f9;d?Z^Q#Gt$@^r0a)sADrL(anF=m2r#C zAuPEYBb{Gh^9mi6;yn`{+h)-cG*#iF5{8ZlY0fsWO%49<2^a+vmRAGi@ z$O#=}BrkN3k?6re(ouxN3q=ziGZIxe%xDyVW9euBN7GS(j}AFUA4}(mJ~G9XVf4(% zkn2FO0dEOmdC!DNOB?OW8hi#TD3fU8Cu2hPNk%0nJt{V2?OYmdF47X^3wJ!_D+Y^Hpu%#-EKJ{e50`*IkmC>AJG`w%(N91lS1ZJ@23W_%8 z3MXXG6;{;p`Z(J3`bg^W5DXb84C&A`*Qj#?Q&)$@mK}7SR;SKGPl={=YRFewxPa9+ zrQ=-^pp|s2VGm0-edO)GPU8*Z8B2y#fQkfK~lB!=y8(@``;uckC$SWGOfK#+&<9(uU zv+|8dAYoQnc`Yej<21D{4=JPn2_=v!EfS4vH_m1VAVd%yKZul2_#l%a(St}z4jwdW zD0c8*bm-s#X+N(4v-TZrEi_Pyi*nV4w%h7p@Mc>>g&dv^3)D;v7{9sSfbpK#fbk)R z12k1Qfd zL6CP?UeG2hDW7uX;%@o%a8ciyFN;T^*}gey?~}72K(2h>7_-w7E5+SfI>*|{raTog zE7oeul*y-ZHrqSK`%A{Ku1NhP_zo$ZlBavSHKSBU#C5nN%5kVP+ES^cxbgFmoLNwL zv{6t=ZD_J8v9&};BGMFFB)m}OkvNlXkq+ulM@g9Jpx4GEZ_|FB7{3z2C_meE1x7{uVj)kwUGt1^*R;N;|ca;ByBkV9YIF;G;Zqv>U!T%l+JernSdD2rc?Wh&16&CyfTeiz+6vyr9h=E+=F z<)p`_Zz78c1}Rfd=Na}kzWZ7?pS$oro%F7*i87b!MDiHOVzHU9FTN!QE!~{mTP$)- z+ez7cDI1oyd1^T!+mPC`$%e!T1k(Xh!B2SWh|Bqr zNMTbu9YdLXLz)b|%R0nO6jrV7uB?$o5|u+1N>mP6EKxbU2~t3uEmR;OW9G9si{|q< zv*z=d%pTz}**(PLGkgTgtjZxgE-OcfY-VmTne5!;gfdTynBX4)C~3xZVovGkBRaOW z(D|~3;~la6oqVLL^P;h{^|hHiG#x9NBS59U4vUP3Y|Y54w0V4gEZy_;Hjwf;5^|l_ z+L~%HE54V>!JtlJ!$F-yU2fo@*qBg9QBk3eVWVB0^rrpCN3RZYeP1MCg=kdB3K6NG z6(Uk$D@3FMSBOZwq~S8@0K}1yj~YxM<^4=jJRrod89(}Mx!T4g$K5R(c%W`VshW&Q z3dLWLVrT5bU{L3c3t888c^SW$4zWENxjNzUxRBAKQ7ayP&t=rSoPv>gggtL>E+J&H zDcQo$VD#>p6=r|X(PHzGKw_MxP?(@mL9ijLf(e9o8YvKW>Oyr6inZ4|t^EgEeY*N5 z$wVd;(J5UTK3iuJY5O?+%k?~mWY;|gzjtrq!toY>q>PR=4d`gqR^JR1=7tv?L-`;} zzc~M6t36YFGD%dJW0J@a$7E6AjY-NhderSac8BMgB9X+wrUlAr@5(M-NImGUP{`7k zLLnm#g~Eml3Wf<>6hzF_S}-nr@kvZ&%BL|^DWAqvqTk_O-)V5z8 z6AokmWTpvmIjHdEslZgtVLHg5S*PUdd15EA4q?M0i^K&pCW#6_Y?<UV?qFg$1F)f zJU*yEuv{Qu5g9jRal)|x1kE-_V%w?gA)(`U3&;9BhedflPp*81ijJdf(YT<)GsvuC zcAQ1F?+k3Z+2W3qH)~j&n7@}a`z} z8i0>Q(^SBVDhdL8+SzKI-Vqzj{yg5k{m%#Wc^i!**35(;@3b0#$*PE}6>gIhz{~pl z=%7#DW491cwzWfifc&g_>bHhMlX1K%A}hP|P&ZNf9HW z)ADE|7uTqmr`5b@T034W+S!sr4>I(4mX4;v5|zSK&#aEgq|!`H%Hnj}iMeGK&lJ5c zmY<)Ov+7IPq<ZG*@HT`qHJlU3cMcRU;1I#ww| zq{9~AED*Y!X7*6Jbqmx4ZO8WIxNOdHeB2Kd?oTF*c2X4bH9qjtOerZ35!O> z6J93~j>8>YmxSnB1hju^hpBwt8uz9;S>sx*z_{d6qXcZONg{?y;c#|a@0>(Qs6@#S z0}rtb2ySz>UoArL%^^1pZvehPLBGN@Ffeef$6$mjV+NCniG0itYm|W(*og=bbMzQz ziEI|G={^VduRe?Mur`gixCjrob~cT&zBY=e!}(K*h@5>`uFm3O6PrbC+;Hb(78Kqg zAT%=Y`e_Lungv-9vg-{@#xJ9L-2idQpn-5j*9aMez^#)zyAonEN$Zp|<#lo5d8WEY1|F7{;7~Gz! zVlb0Rg%D*ey;CDL%%o*NB#%(QbZt|$M6FX8q|zxAavCX=$i$XVTu>k)hRo141UkfMuDMq?u4KAs2qLW|C+yOj2a3>Of+)nNksPiVfm| zIhVy~gFS$_6LUHIym66PzmuAZ&IoW>l}#gk9WaduXLVh`%rYen8uyh3h_N{ahMPqi z2sbp=7r~RzfzUJ1;gKo2L(9JE<&WuKbsUV zFgB1W(%K}>TG=el(iki*4KYAefztlCkh*44hU7zI8iX7DR87pW>q)y)A+aMk)lJj0 zM0HQt=6CnY8~A*I)^j-qkIAl+ZZXk^pNn&K#@_l{96@AGX&WT7?TpkwWI&Z+XJz6( z$SfNm)hL4A?T~gP)*vuJjeY;E}dQR1k!^RJvQ%i}uj zd$9P>BVgBHnA(no+b)90%Pba=Y@6m5yQ$2vB}@eFpfYqboLxDPbj`yH2|lG8@Kh31 zR`38!WdU;^;01mjELZT6=nBZ(2eMpwJU$1x3RhAibA=N+ujxVgP(T5N;zymuhLJic z6ld!=*4*l(fbG^{kuX=M#bPU+7oC=7=jCB>aj2meQA2Mdb8+(Ne;|jk6(gI5W$yk+ zz-ZIp$KF6*KJ%E(2k@b!V`{ry51)|3mnaZEV2c8=GqH@7%xJ=0)ZY5Es>4x%*!m5+ zny0lsTraC>xHUJ^Ha~R>0vb!H>C-mWi?y6pC;#0&Egx%*$8l0?d@WpTj`>jWhnc8R z0U*mrT3g2YZC9MOnw=vwH+XN@vM$2HwAv=YgJomD=-!4LmZw#b{88}4v4w%$v5jCO zNS~Ht#4$_mF&cltE#t(JNJoouzIPC7`-WKiPoFt?3_=c5kT`qOrkm6{>Fd#rYGPx^ z#fdGSSH-LbA`!9i2XLuJ?ydT?^us8z>7R9TQZ2hxji8pm0Y#cY)n_Y~g=DkE=~h_% z6tp6)5s>)EHW%1P{(121HsND6KdrxpnjSnm*q^V?f=#|5)W*gT>0uNfcq69CJDdRoj9WY{cKF8sQW)gCT+Xb`OGqP51N zW34q_1gPfKMUj3{v&R8TKq@7}2cb(~G5{|K$?dV4jv_o>PTB%C!QR~-*qfCN-UABc zO2z~V(-(>q@FpXKLMf+$!qyL51iC5$_R)GXuhe^s|Ly6ZrP!RQjht+baybQw`W(&0W%eDsj*Kt#RsmibESXQ$X z66=T+4C90JZ(`@JPQp#(v*Kb=ROi>BS!(F!@ZkQw;%xtQDkc2dhYAQ~xIPV5YZV2T z8&tv@Vne+JIYv%dT7bi1kqqEwfvEqtG&+ez_#mH?Ln6?%8tRrh6(QTHe*&D%SiL|5 z%ZRF^3v~6jbX9?!iUUEbC=O<_XsT5@CcR&fn9FLPZmG#g(&B(8Tr9+X{jWp6RCsMs zQz9~*L2d`O&TXO$F~A@{M`OVLM`JJ>z&HQ!#kZu}!EFrWk6i@UBLXHdO>8Eb1Hny3~98WL)35qkEr$^o~Oe~ zjcu(WXz=bRkO^*UBWUmrH-ec{o!>@@K>X`cf}$2#EhFPmFEr%9q*{$-P?6)V7Hx~P}4x;{PbZbWXCqni75c9(eE z2Cgrw`Dp?S4yBd$Q0%OK2%NrnnwL5cP!p^Z@I%8oV{iXuRnAV~57}!jzTecSgu!u8 zfwA(50i)qVIUC~h@UjPt1miK7hlhAD@}|vtSpippVPw|a0DXz1#}ti8zF=_XnSH~G zWE63ec9+nrF&OoEu_`lN!m%D7PON-IJ2@7B~O@1hKqm_1^fe~@Hs_{`3Hj< z@(+l;%nZ%#beO8g?UXjbe`$<><1$bIk7dv}S7m^r4nRY)CfX2CDV?QuSoXREKn-+XKRG&p zW(Vj;ne-M5y^YS}ya|@7EgbammuxB#aoaE;EQ^LG5FtNE{1G&jy zu%1@)qWS*11n$#;1Y=EzO=IVjO(W+31f$nhy$|N=6E=}{S%@ZMUioOfnpJc8)~wn0 zNp-Q9RcC%dOUE$NN})h=-1-n`9{%*by-?s#$$~(gVF9|oy>F^we!iZynYXWU)*pThtj=q%5$#-n9eA>ZV z;EnX3|8;5~OAyR;TLgZjBuaXBoPyVb-yP4?e$_yH&uFBp|Gqz6ew@_P&rDw-%=zi% zCE4lNkJY@B5CYZn(^RTE?0|&y|)?GyKzA5I*vox)>IH;mo3@TS~QFMIa@EB9!px`aP z4(jjasws<$RLp-LR42(_g;yAn?#Y3f6koE8R^VO`6v|!^;&YLUHhcHc&C9^x=af0oTQmo1SS29eH&72sXn z{{P~7EH$Uhq6A&kQyKu@K2Bz8xfr&FmKPA`~TXFu^A%g=?F3KEc6fhCjVY&Jc!PD_L3*0f7<61U_I zx#jp0Ij|j2A&gzkmDJ|SwhhjFS+`Mgb%9kXWYBc=sZG(4<+7h9Tj~@_EuZR?8D$Gn z3c){Db&`8T=5!YP{rls~Dtam{(8V(7!#nU1L*V=P*_okUZG-rJ%3H5ynUi!VQLVN? z-1Ir_B9rvlBV*zo&Eb*OTc!P2AIrj`>&!k9EHe9`j9tbD7BY>W<*HP?4RbUsmtgI` z_*yrgVVw8~0Xn6%7Yxv?M>^r4TBZSLJ0OA>jp=4i+^h+$(NPeZCdwV@KN-W!6Pd96 z1Cu{m95i#h`lm?)ni6a(&B=jH*>7;O*OR&-HE=KxWOw8Z+CU&4XZNu(@uQ9GG1gQ|x@OvmY5Y$0r3}}Kf zh{HHFoq`8RIs;x())C|~nGWKX63j9BX*DA?=iTNoh zNrnBiPd5%j!wb#NkUm%M;_Y6)w0T~yv1L9T0WNQO);vR>1XieQSYqFPU#`l;nb{f9 zy#;VS#)H6b7kQ=_yIs|zWY9ZiVbq*Qcv<5{0X-Og>I69a)Db`Z5l(DD9+chP`sc}= zl$5F37-)INM!;(qjwIcm2}Wx2?2`gr3?!_tSF6QwQ~SMcoC3p-8YLdBv`(VINfmOO z4IQ;iM;~nrcxjjoLC=|!xPU^wtBWi)M&hJ=pu&sH zUT*C!1GI)Qb>%eny` zurj)Fd-ys9@rGMyGC@E7IB7KpSV}`_-L=WNU|GMj8^8n>x|Hfj16pg7vc1LTga1es zKtb-paWKo5HDZ%*jYP7Qktna4V)3b(refH+E-@yn(`T!On(t!2@Mc58y!f`tAq_hr zB}UkaDKMfOLa=fOH(3Dw+m-3h>FjkmTOfB}IpS=Ve|`!0LW9PeMFU0#3K9uD%Vks0 z?LRK1Q==SeNxKbm=CR{{86qT`Y?(ujx(o>fi3*6H9x^Cw=Nw!%>A+kHAi=A!7>kW3 z3>F{aIIw&qDt_CB)#(#Z!m#sCVnn8&$O+6oiGweR`2uyGDYOmJLHEH-ieWS&ulXj3 zoR20eeG-KXp#lmTXp@$25NW$=pEzL!6KQDpc&UQHU{7w126<|0D7cebA1%uHtAj4N zE5G^s4`jya`D}{`w!i)ZdM}`Z`RBT9{0nRy2&Ppkgi%cy0(&62Ipj%SL}mR-bXYEz#W}1t&&!i_(z=t4p?rr1;T@Sx;^wBv z3T5K9Y==cN{Z!4*C;zi9n&dCt+uuA>w=9qABoyI##rCB0*FLB7dWi_Ul;Cl|(xr{z zyr)J1cRK@+k9B=IU9X^*Q``>1HZ40+k^60YS{CDxL!048mOL8`uVbPhMy$=juJnvS z!LaU7!I1Vx|0eMHXb;0$A)Q2+L>oe76FQ2S^E!nyi!LXRK9eTj1YKq+c?2V)G#$j- zw&VJ4?8((f6#`Ksl?Z`6L&GF9=mAnFd;n~MxcFB=9V45jYy#sY6b4nsP#Aw!<<~{s zpy`__31_|(6k|yhL>KN*9!uje@ujJBo$bk>!8Ze$L=Y8&NtE;kGYIe{2qp=;yTC-iZ;P6gOM7|T{?97ajz3#B$a^pD zh^HIxS53Y4k4OPVGeZPINBG)zrHc}ae$~i|OnzNX2BGk$8tllZssG)X9OS+zWO`+R zWO3e99;H)qge5IzzcV_EdRC-c_m*~8EMCmYi!wt{yPPbVYL(#&GlY_R`^?C1w{#>1 z8CPoC4~7i76bcb{DFimf)Gz^sF;M{%N72 z*cY5qc-Oeb%nA$CRRsubc0~s721HEaknxjEVX#(269wC?tucszMo?e$G>4)8X#h4j zG{z!v7#KUQG0<>s7RR|y7L1i<%?XaK$|Gz=Gr zsu+B9bwQTL#jIR`&OpQvUQTR}hCi}a;L)%Q_X(29=`x^<&l?$l>bu;UQFfW|hF^{GNU(;f z9LCeA5JuN!2$5eYQZU(-`XNW_)vTIBsg=sW<1Yg-`#z~I7PIOM+0$hY44Md85I9r( zIbVv;V3Wg4MH7Tt1QS9|B9Dcuk4Iu=CBP!nbAX5!4m=obR{`nZA`2#5wxIx*myu7* zGp*myJ0q8G%I`1N^Sh;UVgxk=V;oclkw0n-)V65tqcvWQM|uMXgDSIuY5%m$p)*A2 z(EVik2c-;krjAg);<}5{`U2IFt0y(%lUO039jY{EOn`EcT9L@;XBy!Yk7&G$MMceq0X$WS#G)5#&+a8p-1;URxs_nr;j&gf) zSVYFB)6j;oPGvZw-gSs)SwX1g$AX0YDerJrCKP;Zz-cec`kKCC-vEC@~J?VK21G?i(w`O zt~YshB~3%%5J!~)T#@!%M!H9)vN}(k3_6zqffvAa23wE3BuNXGeB`E3$mlI`>wrOd zUKO)CxnBaIQ_3a;1HsySaVrCFwNrOQ7?@Znm|-J=OQM4x9mQ-hb792ZWxu!RKrzp* z6a&V`RVkY|?5~Q26{&kdyito}8|JX(v9*j#+@?9V0Q9~yk#bP{{o(z~C*k%)XNc_? zyC?$)`z!*em|7+TG(!X7F`GuXQRt6SP}h594-<4kCQw=-Be-Ez7@ZmVV{-I1jlpfrU;1G1{(x-sD@!or^dj` z1{#4$ltf0VYEaJ1`UAZAQO2I_At0np*t7FlnH?s)x4 zYmZi*#P-A>i0v755COcI(J+je(HM+E8H}rA>S+}Cpo+o3D>?>*NJR_^xx?5XF|{QF zgI?2VGVscjrE_>q%AmmOF9zcy_&AEipifncEW+JtvTXO7#0iYU)?@(JlC5 z)23RiUNlYJbhi)B#49eg|EQXS_wPYWCMbr0#08IpfVp}Rw@NMwGg1C0;`R#ZE_}uz zG-&EsmxLxJK8dhYX19};${9l1Q8+w21x!H zdK0R+SQOQHwkZ|z+zt@;Mh*y#jS&{Lwkc>p#;%59q$w)H-PLNfzTSNcFYzP z9xcj{ckB780v;By80nw#yjpfWdT}!IugWnw-II3bDP6+XUR)A0Rb>w8_sGza>t$#AMbY269*n7l@WDTr3k7 zh+I@70EmoGX#KiaCbYgje4B1mE)RL9$-}0#@(9y$p^PDuSQWzLt}+Bqwk+3^%T%;~ zd)C_fdRBJa?m^GY(;Ir+$m#TS6C26GZ+OGhC{f{X)+Q>G}u9hq02s{Yv;^bAcW(y=X zG~Zm-=>w%ks5dp4iTh zreX>lHttnZuNOI^2r?lyS!7;pPl`-3F&oyAz`V`YURLw&r1!fTc=inU_PI19%V%Dz zTBcFRmxXLdc^w73V;;^av!&3%#R?FJ9R5@*M5*NvhsRem9AGFz_nE;Fa=>(;?e!*I z*73jmuv~qrPmi(V(F7OYoXw6B*#(!`<}F(2dP|2%tB;J~N{KRqpLYs});O6HS;SUJ z`~tFyimhJBxR7a5QLL|3LGgm0iX;ORU$pSLg()H#`lzfxlZDD2y?j}#7_9?6_H!EFpG zE!UU@;v^Lmo;x~`G^;8oo+GJ9(on0M!-8EXFhwFwzRC*ZMD{S|SBy})V0|!|xcS<~ zZiG;Yu?;xZx5jp9`Kp%-7)^f7Z_b1YBmydn-j5=a==4n$h>gsQFUtXGF1~Med@xCg zAyQ=bh>GL#N)xlU$YHc2v9RsnvRduXLc2+OUo1aQ%Gud_ZfVx`EBwX`o5$|Uuxac@ z3P(0>lZOrCH)UAXnyf@vs9docx8cFWWHYn$z62*jA@d#Wl3+eT(MYt1)Ie;aBXao6 zGU@K)Ys&UVlTu|7!DqNKhVB*-lM*~@z)<3?!B`!#g~Gb*GCsI|h3OV8w9@S`yH7wL zeZo=5*>Rsny-4Nb4mVr4v*D;G$bB4k;NIcDlhfhszuiBpkjrTu4rI3czJXoLEmRvJ z$L}`yN&9X=&;qE%cv&|<^llM8fd0~Aw14i3A@C7Uy&cc=p2Pd+9(_zom8Tn-Xm z^Y%I2zsQ5ZE?Ne@3>vwgf{mc}uo$TAw-}e%_iT+tk`4+s*AC}nH9xJtg2gR|g-s9# z5}6em@G6FhfoGwO!Kyo6*HBfx^nS^qGb#hUJ*(f|cmrMxbJ_fP`6anOB?er$ z(;2vFQW2n%>LSz^&sI(1XVmjmQ>QUrd|M^UF3?|A?v2rj5uo#$*T7)-nCEcPxw#Nd%cG!ZTOF2$|;7_U@ zz7kgz;OFI(_W1L13IL1RHR)R$K1ZH$Q`(aiJp+S21EmwtC0PUUa#q);ZMfsFr5liU zMXPZahs9#EMATin=+o{tN$h9@2zQtZ!*mdl2~`7xbv;H|XtKAecSpItko5rvs3bP;bq8Ih&N& zJhd;0t%$DDr`m$czkDoapWAF;-ga-Ax?vkgbp*C+)Uwj>!9VjmuzONy+_j_L93QcijHZD#>0aI}Ui4vaKrM6WJyNI|ijApzzvm4zBas zkW|}9Z8S8dAGx8`(D_6I%bp$fqKX&arsV?LC2)y)UM}io6~9@@!7$;y#$dyIjS~pd z4HOry8z8jQ;*%(IWpKJUmy2UAqw9phmkI39%ap*ttDsQAsM0tkQZcdIM8%OBX>>Xp zZUHDtFR#LgG~=dF=-P+EVWx?KVCRYUMM3@6aqPU)N!(P?Ig!$YP7CJHUjJu;@rGPy zF)^g^dFuwb_YdiJDw)(tgmv;pEz=atgyExho5cp+=HQWOk)z_(s%~Ca%l3c6$*?`8 zp-s`KsmUV}GmC#bfN|GPba&p7=H0_F4oqeJIi0m~Rg04bu8gRxkJY?bRKK8`PCXp$ z=yg)i!CFAhFC=RfYyz{nbY#?UM`D}B6_2SqF z${cFQgfp93}u z)H54Gcz2+mz#~2Yilk^o5a1kE^Xj7T?*K$ZLQR)Tg10T>nwd@0S-0;3!IT8z zWc$i(R`S8WNfTi4NhTm3T)aeB*i*@%T)Bn-zf>87<*^s&Z91UF!nuY^!=ICfVAxmw z7^GW_(B)_1&osjcA% zOeG|CBYHN{pDgL)nL3tejNk!4Q|n_30sT~iFKPk36M3}C_vi-o2yzPco;Jrmp5 z5O~?g?Bn(PylAQ-t!I90zwXlR_i3{d-mh#y*sZbH*L8PVUu=Vrd|n!PgxA*uWPQP# z`017qDbUz45M1ZMFnOGHI;H#DpVe|*5YsjBw&@!`nUKerlpK;!VXsVqLm9a_70W2! z0k6)OeSzCO6TzK?@$>{+a_}e_J`F!bc{Aouh?^BeD9zGY)CABm#9Y)N>HSM-vDd+z zQ&MQu^wuPz=C=ZY&6LufNqH1RxM-n|6p{Ss5Go`#)HjeZSVB=Dwml)b_hhz_<7SR! z_|Oc9HbAPDD`cU;XC=>5zA&PLm~_t`x2-RIS)G5vJSjqBJTt;0k}d=XoyEmrT*_qH z2s{)qF*zI*Uc9$CWZlN|nCYJG%I-ZcPu5r#W_J>i^>`mgoC@{b4Q{UL=JWBaNZO3* za020^4r2mAokFduIxJ$o>5wdA#>IlBFj+o|iMJgJ^Jc04b$JA%+^{JRVfnpjhATjL zAD`Hm%ORx8Aj7{Lu`sDyeKiJUGZV{S+Tn7-CyBcr@yVe!2cK><8T)f=YH2$+iBLOf z&!z}~v*GyOZfzdHS+w-kiJg{ggGjTgDi8b?sYZd9EE9L3>*`0P=Q;viI#K38qBWpO z9|{1EMKn{uR!ua^%IvgA+Tw0~Ot>*|RL$yyZRWdo(%pTzNzOCS@Ct;@VQLRH2`&?O zm=fG*;BmM@gH0n!DjFzK@v~S@*VQbp+ER? z^y7n;7u7Ot=5NJm=hx&@{k7X$k)flz4cv3A5@TWT$ILy_`%g{%^ zAV!vyZo0`^$nesN!HgwtCXY+MOcaxdnIIy3F*!^mrh_u|HJ;z-3_`I9E5wJ+Yn*rgpiZuq@Uh z>KX6mJW+e-l0se)p;EpP0pe2xp%MNT!BN%#1hOBz&1w@Iuz^WX6O9*85L-0dFMfZ!8x`|q=|eJXs*ypPJoVFM2L16ebwDr!^z zyVD5dfmcYdTr&tRs{UMKOt$L^C}QvwRKQ$mLdD&UM`S0q&I>p&9Y)(#9YtjB9*Wg@ zokZI}1&$LTEPUO ze4WHP4xPm7Q5k<^!NG*|QQ*)DDKMfoL`KCYzs$=rYOzUYePEW+i)y%v;ydfdHi-<1 zuEJG^^zybyo&i`s&?JQEQYtGt=^Y>&$*VYewyPvMEmKMC0zxV^d#4Bj;WaOgx+*Mo3$ zZz8j4e5gjG()g;5p&PW@FsBfHuoHms`)*+?Nce60^#tw9E8iME;&VG*Uo(+8QcBvpQ(0Eq=YS#Mx$+#1|p}Z zh9QlbhGC*gi^J);M&Z`n914NJALP*@#?-TYoy#mKd#S9NL6yps*D;fV3euSfnjCNTk^_NSq}$K(qa4r@oWp5_8pU2$kjB#&7%6w^MB)#>eF z{Nx!gVgl1cEWSIiXDq6IY5L+IDKsN?sF8$;O;&}(&eosr`AP036BqkX51I9g14HV`$8LeVabHqO%|=Gh-zQ_j-b%&M zilLIo`k%_-^vc9^_xUbn-~(kQjlR;_q|w$?C6Vsk=CId5`^3rDYF6k?# zb<9FVb1B0ix z!?}tLv1_40SU0{&EGR*CggKrS-`m84Fc9F^xt#4lPl_+$a+OYidPZ*!J1rf7XXaP; zO5Os5E+hDOy>OYwP*!`KTBkAW_7i=W-1aHx=c`wv{jR=Xvt%G zQJhY?GaB99%V-dwsoA^k?%IoIpGxFHEgOYwf_v7w*m_pJuP*Lh-GQsB&cF?t&X|0k zPmfOiod$Vc73cFBI|pD3gC_T)18p-aNae-W`$q{sohCRu&yw7lrperzNUAf*;Q?$$ zYJZ>$V497A7lp#Hf%Vf^U0(;hDZhj5yCcdeswlOu=c}ehCxQS#t*X`@^151M*llY7 z*k@}1&I}0vdL|1DG~_qhcN55I-~PWxuMR{-K0TiuEz0?;gE%6k?e_c6;s8vE4Z!)# z(?O$gO4C_&lF)kXtA6|c>Nz52eM|)0^*RDfAWQ~41-!%?&_W&Y;r+`e$4xyg-51ep zNs7N;m$Sv|_lLlwN-k`e45Y+j0@^@#R-Y#!Kp$r^(BilWIsHCw=PQ6nn`~+GEOCmZ z&91bGl|HA^r&B_*^0b;4&G*-3v3ONxc!EsAVIWDH3g}oYR=&2K+&|7bgFIc^t z)%9tctj?m}paS52R0(+g({0!+nyLuzbWs8DSEvMNDAm?w~yHa(JQDDTfJZf&ZPvQ*8_kQ;A7^wwin@HqJ6Q&kO`S(+mdG%SQWc z*GfnCHS3}V1D|tYL?1gW>$dRhY&WfnMypWS&(ey~|!C4TtPBl3%aWeZkf4r39?MBEC`*SQhI;hVTo$E6vQh)VsFrG0T(tdUK z*HM1;u7VBmtG#B~>bO1(#rSxVq5klryWg8LxzK+1!EbkUDzEv_e)(Y}ouYpEu&CyW z(d;dyF@Ceh5GdcTGVxEoU!}rK{bzr>Yn9EPJj>ohaZjg#X{8{OHMW$NwpRATR(rft1Lsc#oT`1=dZ#p-}u#sz162P{;0h% z3IE+b-JtQaJCFOcl-3XbdiRU5nY2J>Qc-m>?CmQ?^RDg6}zXbT| zhqn)eDrM^MfVar<^uL;NS~tp`6iJrnU^jItO zclU0LI;uR6?#7U#$|F?mGAC(@IPLey`BPM&jS!ZHdrODxKG_jAUsUsIRTZ=9?_zTW z`CTdg-}$Y7LWr}yK|$7$!5xStOf<;vLzr;D*oQFTX+#UNHG`K&M>hZWuv<=H34ZU< z$ABX22>aBAmSOkN_%b~BwYO~xgbd`W(f_70JQQmDdDbTh5qevLmt=TaEajRk*%4_r zN|j>w!H@%zRSawenG|DC-FWt?P!4_#svOViS>22;#`C5)KQHfvAhmMB;$BFx!=Cd< znzC8Nh)-EV4EC6C(v*F1THS*gt4gu+h^+4<=|)yD;<}-V@$f;96+fywdfP)o$?+R~ za-}ah*g5+(MUHOU*Z6Z*m15@!DaSdyqfCS3deAlk|1{{+t)^*3II81Vxu zaJ)?lB-}GKszAF!);+F3;muk-3G`6doIT|HTB-Y@h2t4{>~laC;Yys*WZ8K_RU`6lIQU# zL5M2P0B3tRc}AIE(_;Rmkd5La;oj(R1rn|q8dadj!VZ9;1lrZKh|W3o-#$P3IO#zY zexF8vqR@+KeTmYB8uv*SdJ9W$vOE$F?TjYN4*O6?pR%ww=kzAaZun$Ae6ETYDV$aG zCXz70M;EF03sh*49`}D|NkFFFui~L)lC~L+E|YM%^H4IK%WJ~BI$1*A3Gnw;LCy zw=UWVTgzVhXg7R0WsiNdE8JNS|wrx?@vj<8F z6*lJ?jHfM{@Fd@T5$(Yk<#kV}@YQF13N^|?geO!u3GGv;U16(J-!|2eNLaD$SEAGH zeKFSB|AR5K9FR-62L3+C_4wf!D_w|O(a^7FxrA!?{g5l_sQZ=c_wdbo{mQkovvWTM zd-zz0YlhiQaayfDm2FHfKUpQ54IQArOp(Hs*&an2Wg6Ndjj~`u#o{0pVrl!OUg*NhhD84@ffkOBh-W4k*1z0)T8?-)Nf;K z6L5rjxHCrW*b_?FlstYo;_st02%w4F6&soEy#TK)kP-40#>WgA$qX)&KG4|>YNyuy5dX$8`52r^-$jeK6l!UyP zvOh_7N7=4#i!^2s(iGoYuP`ewisfhdXwewkkbJRr!f8vta!Ggc-3z(G$LV^O>%kbC z0sE9IDN_gJx~KXzN=@;6_1W4iJgEOOMG>~^_jXC1BS~Lxf6F$Fu)(sqyM)4rFGLNxJ=NO$)mN6WeggcMMmuZXzO~($5a=BSGt>@Eqvs9kY z6qd*P^J4ASmW^3n6PA5@^JKm>4}`FGzImDCud`}aE(L*Jw*URbw`#fStA`#4wcD{} z+IjfP`kSi$0|8)gi{KRkAAbGDoCQ&WYMGjdMw`<0*tK z@#D)hMoK;VdoisqE|d$6!i9(Q#fXbyYVHplF6hWEN!XFtl8iFXoX#1emga~w-ib?F zu<*5gX??Y7s&Du2axPP@o$zk+=$%E5I745!Xp0jz+Wm+#_;r-FPT#NI*?knhK(r5W z!WW!}#VIdNtJYAg>gIdiYeq5{p=D{G2N-1;-IZ#T)goW2Q9=Pvs^9LVRJ-9DJNp$Y z91x_4HLo4T8eP%JE_zi&zaQ9*=Q-iy_Y_J3g#Y3g3;{QwQyga)Y%Y(8E#A^;#m^csq_Qcd0N%S~;Q)zD!jq=#GCDHHUJB-sLT79}dXF*kIcEb0t^drtF7dGnR{5D3! zW{5M!b#baVyQ2izhB#x~3#E%QO0=(v^FXS$4wFB&VYL!3j&_;L;#2)ixs80p@JttK z#86fhYRo{ko_#-8_FjgsR!VYchCuPh!81tIPLpC;DlavTV!nO39**MWe7VN)zJOd~ z+`|vZB~>TxhhX8$uKN~jl$S#w!N!Qo|HpjAZpe!%Oi6^ev$sw4rXWJZ+1s9adu)VV zYvV{V$|*5hTgIr5m=cY0M$D8*+P~AgL`_+oo?Ivb-BqLhwl-OU#ACMPpxY8Fd~s2~ zV(mze&<&GeUW#>5)!EM-W$QCTxLv{F57%+$)tRzqH6&FwxvHu1R?v{wnwo+LweI1D z?ca-1emPUv$Tgf)v%j?s(0Bdba8fO%-<0~(-F3JDrBa?g-FZ0LEh8JTmU3G1Sh%rv zIH^|Wg|a1XOm$yXXR`4OpHWH;s#J->?+*7S(N1_HT8|=)u`ut5G)9fp7HO1=^&FAL z$USY5M!D1ve@^{N=IWM)N%8y6utBqLQjy>g8 z@bOYCN3zz@41HwSl}NZ>w`YlF)wJxcM6Q&ub9e9!h08@#tx9!Q_z2e1lxP%tZb~%D zbsTmdjdH7YiB$)NUsaef0&rEBF%~d2VTAJ^V{6XN#sv2gLtFp{m>|EAai@~*p=b#oCLFjWR&Tce{k`){8geVpW#;?Wa&9kmxRgu>$p zV(dJ5Jk~7gWICx%E5+!Iu`$pT>Cq^A+)R;n9*$B_H)Y!0eH@KgTWmQ$En|MP6Y5M} z&w3&}n=z1%e_CIh%!^9)6OV+;5C@X$`=b2X<*Uk56=Up8bYvQ5S;P}+lvmGOp~fgS zxI&F$&>f-TFE;il)F{`zI6^%L-@2V5)Oub`>r?G0{AelLrC55PJ4T@32^GH&yhowJ z<^Dc}8t2S_D^>W$(q5(dZA81ECs)FuzIz~*uv2Idsg#H8A3YwcOtD^_JyBL}*wWJ1 zgwm2K#slGT&3@PXbWwy5#T8|K`m$=4tIU!J>HHXT_6_k=UZp3nU4lAl)friLxt% zren!6%Dqj_Nc}d(Ja1)c%4NN7rpino@i`_}wh`}8@nri=I667NXm({#=iKCoIS3+N z_$|qS#JktMw>#o4H$c1x!tFxClx;S`X-63!3J(SjD3*3=Pzcut9ZOBF--T740lP~* z3lpx$CtF-qq*1Oxw?!HyW4A>bXMNm}X_O0n9hr7VNxDp#o{Vx~oTK8SypZSVxRAyV zXf^eddcTh0{K{{OqT4TJrD#K&b3i6xH`eGf4SxqQAe8i)+4w>YekFRZLPeKWA)$so ze2oYdzQ;8x)T}yD?dBul{*!)oLEBQ$JJW+THB$S|sz-(Q!-VzOGFfLkxekwbVdZX`j5(Op20`=TNP`Eg&6 zfuea|knsCN*=O${g1ju2tHZ;Ga%oQx!Q4i^`Q5W(T7qjT){je#2m!%Wp_D^4w%Vlw%L%XHTvjcthu5iclP(Ll~>mRDe9}crl zVTthg(ICORCBkpQz25_i@cS@Z98D3z7uD`f4s#fuaIL*80P*KSe#+*c!S0HJ${Qbcxy5)%8*_L(3|l4q5X`M^eV}i^6ZAU?ndM}sHdM_ zHf1?k71Pgh8Q|{3%5QFbF@(D%$Ly7GB`@Zz0f7d5mjxCoep;=UK?}bV+}EImm!bL+ zC|vXFO`xb+Zw30$!pl5pUiUy=bs+(+`LJQl_!_bP_`)54bZ{L@1IX?i*YVrTi6 zrTeLe`f1^iX6`ac#$V3!(Z2~t!-vwc--K#-(lNFLHrV@D>@bMC?h3XZ3v5)U$DgAZ}qrB_QvCea;8PkzU9iH02i}56P9L>jhm=6@$D`Bjn|MD5yCRvr%`)2%;sOT zZ=_c?dn$GRv8?Ca+UU{Azssrez=w40Y(`IoiO}nAMMQ)Lf}I&ygeP>RnW^yfCPD5_ z7+)10(D6!s8FnAttvopQ>%8w?mziuHiq0ws{ggpJf;@P5x8gjKAoLYX{Rr~t*SnT` z3_-$g*~7bCAtw^P2ahU^K%#_uge(M3A;)6^IHM;}(zOqPWWl_#Id*=+B4AN%!#x8>>|vuS;CQO|!_ECh?s#wE-> zh~BU72qDR!Ki}*9i|)@0hZQpxvAmz({k7Np#Qk|;qv()7zsrt&-p;2tW99w%VJ^Ac zicx+k=ba(GE5<{5GghD%^q&vAq^zAV%&BQlih-`K^ToIqz40J?+%B^igWMG2&XeJ8 zzu$`TX|-C&R&$V@3yu)+hpX}l@pzak9c>|=gl9=mh;RB0M>>it$*uQ>|BHwOlnP>$9_NZAOT22B{zcg2b1qc|pD| zcURLzCE5((9C@FkQ!mQ-Mp3YnYUZ>(!*`Xqzb(`sawop#r|$|SykP|pLYpB480N4o zpo3u-$}hFM((DcxecN&j7x!9nJQy%TH02oP?q^qy#{)(hrW^x>8pYp5vtAyxlDsPTDLBN|bX6JR(uQhm2w(^}3rpBGNeaT=*gMg$zFKo~JsyZ2VK2fvMyEnuRJk}PAQ-Qxkhx54OxVIE5QS+uTZ zY>Opq7Vjq{%`ZwyIGSIYgyf+YVfN>%vz~+@6JqWf23DG$x2=-WJQQ{S^;9=Mdiuvf zU7V`N-usN9oZl8)S9xAczyEbU6Mp&he75c19KXH$P*^`Ue*Ap)v^=k}bouT>VF`Vx zpBC2t2Ks4fBaQjfFXmt%>}c5&`ix+AGVjH=YPmwy{QUgSx;d$q|9DoPmQ(rY%pk!K zBFT<$liO&b46;4|i89Q!nvf{M@!GL^<tj_v=` z8O9M;9AI&NA9$4h*Ai#v*FkCqggp1He+H=z5b_LcgdKTyg~P97&h}m5VZpwVsV`-7 z@_kkQ*Z#A~e?9rfq+U1E@*gk0t(sza{m1?3@>xCK`~TT{vn@GpEKT=Sa-I858DMkY zag%1(Gjb#)xK*9U+=HW*N6S_)pnv+l89vZ zijMkXB&N%!*zConv@Wg>BYl>)Jm?dxFHHMq+ceuwjcm=4v$bx^mP8=6ZP5Mz=`hpm zI&<#&AgzYDdRx~x^~L^hqts;6xZwNy)2okv|JopVFAg{I_-KDM>>utwYD~~*jga)* zulF~bkAMHi6V-q~Jt}G%CB>RBc3)8E(tOKKSNG+ls^+7f*L9eY=4{>ZkPBV{7=EKQd%N908`+oPp z)|-9tGm5i*oU!z`sX6gcFq!zySq|C&WHdDqKO>r+q zUPPK;eNW0rU9Rs(={!?D;(k-T%M&^FP!I-ZIiU~VTbS>vYaqjqJ*fWl;pcep)8qBU;ltb2xk90x%#djJ zJ%N7$HcoiJew(7+3$G>&l$`L&yF0rA?Y($b|2Rt09S8=L{jw;Yk;tZTx#C-JT5xtB=%|pCry+t_d z4r%e=YGUwVK5#^+CL1_nM)j=i`&Qx(V?~&*q#`!y)n{b?!$V+ft)~j8W5fSBq2X5i4p1@Yl5a{ZAWR zDpsP5@-=8_lM+p6L@U3T!2r)>882ESw1%)LVn6g5`H0a7Iq^A9!t<>_4xg@%?=}yv zH*}hF+5>2Yv+hzIm5%6+A5-G_hs%5E;?ZT2_PRjn{0teFGLy$XGi5F>rVEsryiA%Y zW6d7BFQ)TI>8O|`%jCWHh8|>QJ&wb(B-dbBH$abrMKt7&X)<`E%5$~e*^};kt`U|-1w@A#lHQwHD590d$X7sg$=ZbdsdKl3j?RUq+e*5o^X4wPK zr=~bVE~2Y!Ot;CjVlGV+{pl{RWS%?FoGqI}hto(qnyB~cS);*$NNQf1R*hxS0#n(8 zkM`HPh|Asei>4IJWY%KDa{;W8j=NMG`a5@?**pv2v!+X`^8K@Ul*4BXXI)?&^UN_u zn82|{^{fKq#O(FF0EsC8k){c)<0CpvXSIM8Q6-iYU`;%j=d{DgXQQl=gG8Z1l7dwu zW$8SX*l#9`5wd1^yaE~_siLy{_M6p2>xAsql6B5kJR&7$M4E9*${#dtXTn(I0-ANS zBaq)oxidswOMa$I<2>pr>XtM247Rw2 zp|gt`6O$J_m$SLMe6-cnS0{ZM^GfF3N<34xq#cTVlX*37&J!(hri6)&n5U4);LLZ1@x z&w&VwI&rvW1!UXawNs-{o>>QK{RW-}v?pSSS%UIRI%=(B&7))0D$$h546#+LeI{<| z8VQg|N&Fhtj-StY?TFZJwye2Cf7a;#hNxa#(EvJ73+SiEYn=w7Rpc z5s!D+SV34*`M_BxWkiHaT%l+{YwRZ(d(S8^(DfNi3pPm-MmTQyEFZ6lZWyuK5*Yai zahKEn)}?(EDdqy!O?6i!XT;|oFY=vqVOT?A6l$6mG!tVc6FiNKnar*-GG;O!#cavs zzmP1OMs+60hUb!vc!H#Jlv*NXGIDf92WFZ49}BD_${gdzeKd)2jOaTaIgH_pEaI|p zqLwUy_ojg(S}Mnn7wFg$KW>}Y2=5~ow%R(~EaHJ}1>sC3pNGGfv(qJ}$eww{5m zu}_}}6ED!HeET+rq5N^3xU;V>k4)IO7Ip@4d38ltu8J3 z*5#AUzioK7bkbbswEOP zvLY;r&}4q*N=>wYPm=X&hRh`G-DqAF-8oP);-MiWrLG-K+7|}{T1m{b&jgK1&`o0D zYgUekbEPmE*6-^%(*?4lbx#l0&mzxWK7RGXMVxy<4G_&|Z&^u5yL?uU+XoI}t{yM# z`^N^d_O*Zx9e4wosv7CyY+wblRW(w^c}{Um+og6k{9{tWT+O83Z9#PB(r4p%eR24p z+3>VgK6#OYjMKER)$Ivt8G8o0km`N)nlMCWJy2XF)EFd)@E0#Qh zL4)PtlItR9IXJ%O$Cigzt_g%^;g-{E70>uG)I?fAE(=!^iNmqqPW3l6FXL2q^zum% z*FzGGH?o6dz4LyDuvxT_u4M~RA#<{#wUC)~7Bwp5Tw0oZcRXG{xW2xShYz~Wm)3Qf zUIV~^06i+gKL=sb3HKoYJzEri62!!{AuAA@OzJh4QA?uTehN*qOj;57P??f8d6*c> zq>XbqY;4ljxw_at>7z&c=|7)u2Kqwf5lCL-%q63L8IQ8$t3T|OxYIsH~|LAOs2s9N~w7O%fhnOuo3x;xv&uq za~iXM{n90|aD3r~GI2CLNfUPwUOIgC`R1WaFdbm}f|jKtn9B%`1x~7=b%uI`J1=Ks z%zOfK2F#|)%&661_Ghu0Ez6^lUSYmI?2q(X5>=g1jU5A7!gBC4C98=n!szy)o~}&W zO3A#bX-kMbvjwnQ&z8<%ZfvxDO*_-}eBr3F`ebIbp0dx#*w<3#6f)96_QZo{c95)a z9u*gplIr4{-?3yR&&L}vQRd@}Xe(kXVsw_#Vm*<~V)Uw`wM}nQ4_Pw7)hulVn~}}B z^v}C(;}0!>QFx|s4qj5MO-=8>og-Vti4K)10@HfHDt)UPBVbkE6~obop&1ElqV6!O zC9Lh+X~kYb`y8LxgpKtvjJ(PAJ-^~EVVTS5GvhLL8Kp{Tt@^giq_W*i>0B!p(LrjP ze5!i%kQtTo86flV+V$O+GU>MPY`nVGB<|gHiQ_u#S~TK1$F#GxT;1IpoCjChspWdE zwEmKwD{Z_*%f)!onijuY*)CWVFkI$XK4R;o}cjl1b}Jd86of@Uf|sMSdqb7>JnsU59wRiEfS`0>#)4l&0SfO z*D?Yz1FLZ9O0!JbnJugfW*kz9CL$o}kWgSHGaopFMo?;QweClQxL* zP3BQ$pDS9@!Z-t2NfoKb9A{%>tI|(*H|?r(bkMV|Gcfkf`7WNLZc^HPzH-i+Po_wV1A|0CXc+`8o(R}K?vt>*AxM@V=jV+sJ zTgC`S$du^Dj0upiQPXH)6J%C7Ge%ODNw32N$ULGTW=Q8u-g$SGAguu&VvWz@HLr?LwWIB z?C8`9!VQn;5c%cu=nmxzCN|rD-pX64iB+Yox>=x08%yyG=Q%O?%<+D9~i70N6ZxJy2HS9C!W@tuqjstlPr!DUF zIbfE=#M~s#hgpJ`&Tp0xDRb#Dws0_OA{dhdb8{sh%aPu2OMAj|fu{-0_6aT`ntj(G zzj;tbHljaiJ_~2QLi#FeLCN0k!}Mo${Zr%214gKah^4|2SP}ujG^VNvGLu%gX2wj6X#-16RO{cpefpJzc{*1`Pl zxY^PjXc!S8iL9 zDt+?j0%AwZ@yZRc%HRRTtUt<(tZV~jOElj~Wqg@1t2|nCE@1Y=^uP>votMt1Gv;#g zT=JBcFbU@%M@;92l%6qfE^fAZ&cwE(8P3`|^Bi(tpi69>EzsHeEK%2vDBFnXD*K1a zd+8z`yG)9o{~VaLv*qCVrCO=$jU81L@6k@4GuxPHGG|6=^(<;kQk%n9~d9F9+q*N^u< z@3wm}X$mlj1gw}QTR>3X3DbX0)Uy3NvN zk|tt-oJ$J!dgLyXKAFEFtBJ*n%vmUh5Tv0b*`JNoA&{Kt1SAf5|4C78(>#)%)wHc( zZCHu^`)M7;70fJ`r!Sjz&Lo=ka(BFbwB4*O^Dss>p6(A~3K7FEAq*(akEN zzVwUcS(KkKTv8**JDNw8cfM?i?HUuDLu*U_8JH$OhxkTZK*lqvcQ-=zdBiYY9=BI7 zZZ0+1z?Rp0@pa%uP9qZ* zP+e6<0&V#I?qgFhRqS-$IWF~Pp1$l9EP1jN;m+v~V#Od57w8Zgh z6B=>kBAa18$ueHFNNBmdH<%b15%*XJ`SKKecn4t@1GCLv9M_o)R5LT?k*k01j6@Z$ zT~m!9(<+Q|vc7wR(#+I&wUci*SMv4GtNWFFiF1nEX|pFNA3nIah{8rafu-{V%&fJu zVE22A7AT3djQl7Y=V(P-N>{llZhSouED&bm`Mus~<{>biG!p8U%cGThj$lchDUV#9 zA3@KMtk2|O@%8??e0|s-X}hJiES2(^9rS^n94njz;4=Nz<(s$7Y2n;B9%Pppqg*%7l{QZ$$_LpqPB@CIL;xAR0xYft$Fi*y6BB_od(U|5@#LM?7u5$vkfCnWAx*cdFHzsb7tUH*Guk_wPpj*U;gY)Ip4mJHn$MYzXmptm z9WU;NN250aF%p)>2V(s}HLwhNcIyK66Jwumj^$7QvMjOfyk#L+ZE z=J6u4U;(-oy!Z~$7%9t4l9`Q^O(x}*3y^tKI2j>3eg;>kE6-ph>yBvIne52~q!)(| ztEFXBCs_}cIO1`BVAiR-0ip_8xU_x3y`y<{+s~8Dp>ayAEwx1p;1r)F9ObZQ14lIh zPG*m4A#)i{ZG!BH6yhY$uO`OMHE}H-BkMBh|6zhG3!-i&nK8P%(zgvxnmq2C%%>VY zQ?#@;pHDL1TJB8Q2(LDcZUdvf9ipX!Hv4qYOkhMpQRMsJ70t60IZHOGk6JE!>ckdr z;nHRqcxQ{ZaEZ0*adnrum?a2Wu0Cxudo34Lvylf_omixKER)o!rQ7VBnB2wyEOnzSkW$Zk5o>k|vqE(m88U2s_jie!odlXkcdPMVY zTbwJL!)rvWO-=kza;|K|aL|0tn{(K~zjdR9ES(!B$CJiYl}%hk%b3edH!xn{h;R10 zM`Cv~A5&<&>J(m@AZI9|-b}q8AT&m*MusT0wreMt^Zoi5( z8?R=W)w#28kXP6>#CBIdXr7?X4IcbEVP??Mxu;-k(%N~hLhQ}2i2)jUu4zYf z{K}J*70%7}gSg@PJab-V;iH)Vv+#0FfDV&WqXH5RMpl5O%L;mT(LD2Izko3T8<(c{ zQSV4cEMY1)!h~686D%-MHrDy(NfwhhmHA<|d6~S1(z;wmi7kS<4-|`RoDtpp^90Rg zg7GqFHr4yfq|S*MahH@DIgv7hv9LIh^FdU5pwEvAbLE^2-sLJVO+qDc&W+>Fq;=&(;~W8QFvCwXAfEBQZZqI ztaBMQVTN?|tYShE*_ru4mYLL^-CoPXtKq-ps2Nae`^fgQUt4Sek9xa`X<~=K%YFG` z@+A%#F5tmZ%;8aTnKFkr$t6M4v^mtcFH`0)YI=c^D8f%;-!5>nE)#QNiL=kd%3b8l zq>Ooivvz*kjmz2OVo5G?X5u?6apuzIaEY@fF8tz9y)Yy76zacTJbx_?H}asl^@*!q zS0Gl_i~;+&-a&)wi~(A38bX%MF>2f2lCwcvKb(7 z0(~rJ&7+d-%xK^3?icVW_E^L(oOs+syIO4yf}^=egC=x$_a3SXqkahG?>%CZPFtGyZhbR2kOO7|GJ6q#Dr@ z%Rd7e@m3nuDlniWZXn(a1j|PmjYVns-<2Y~d2Sk)F}K`a);QR=25N6b*1hDM2Ft>|#7@ zt~D>)RnmGE|7>1&_iW)9TVPT$6s!SIv0v3^jn8Y$N%nq|I z)Azh`dNLxWnh9CrrdNg`TSSwyOvqeH#XO2LzhL<;SroF8-F+^~gREkA#aZ;$Uj{r* zh}*^K1iR_!=5TY2Ku5&LSJ1u0cf-S##a-Vxo29GkHvL=-6JBTC;5a5;L*yW4v$st_ zlwakuc+9y0>u-M--Y#(s8AUUMYhv?=MIv$S#j`-t&Q!nzDD|71@|YHhat>GlSg~iP6&AOkgGPypqL=RfNHx#fmXb zB=Z=_Ca>w83v72UX)bIPQGA@ojxuUiWz0lp<3&hsOKDGA;{NJq3&&G8FE<{zI&ERE zk*!PHP1wX%6UIk2o7xfcsvZg%OFf|ChUpQ z&#VY*R$7lvicHAaT_Z0q!jeeV&WW(hC12YJ>D-LTZ;;ujkDVL!#bfM=SMxNlgT_l! zIA`ZaJd^O^GO4mzuytIwJSJu9d@!#C{;kvB4szTdVxaQ6BrKmajeoyzUT6w4l7~P1 zfO)QtH?oyP;530VO2gIGHLhWtDji+g++p*XHj|FPM#$dToqu^cx6gK-!*d$U z(ls|QDkiU;TVVy_e5*T~87LZGY++RNdD11F-r}FlzrBBsaH(ern(3THo^NF=hYS4N zoBd8#scmf@`mgRN*UC+}R@cqXMGM#enKbB&D7&FDV|x88Y-ZkaHN1mSd;J6%zG(iU)@ z!Tet2e93NL&98Oj;_jwbvWyok5*qQql&k{$iZ-T*O5vDC&KH$$`}5qm9O|bc>|)}o zuJghoBg=V!CGPyK10z!U(l~;<=}W1kuA<=%XS|%qB{s`>rGK$~$sI{J$z_R+sJqOC zttG-O25mgYKh?9gim+lJDYbHm|s=q6-(>%ui=kv|*cuQltRCoBh+P=v=Uh6YO zt4dqv+p{7z!8zxH`z}*8K{8?jTnhPe{)~B~&6pYU7}ITL%;QM_v#yg6BD_jBP8Dl9sG6{;=6@ zj-TjN3u`-jq9k&qJ_VfU-wa}qMHx03!^$gCKhYgkiA z^f;Mwo?zoVUi@3ao|6^A2?hTbtuLMLdJ;ZA8oh~1+Y)aIE1r+s9+2#rpNjFgKWGGR z$i#HNsEn`!13l8M1Xuq;x`N*_x*x>!*V8eghe>3k-vsB-hwFjoBk38>yAiGD;~Cj~ zkGAT2G^cgCly|}7o6hqloA8Ljh#<|E?+wa$q;}RTNjKLI_u?>Rdm?@Fc|Vgzz>tkP zJn&UPTOa!XOs`tZfI*X%6Y)h|K;FA*XRBm5AD5XJAd}MCe)92pf6#Q4vkYO|W%=Bj z&hoV)fG=R83pWhyzG%s1jbAp;a>fA13g?NN{(S%=ClN`* zP)mr6B@gBVLG*lcE{>nJ^1J>1CyncO_ijg(hzoc`z%I5rSs-M#8ZUr8UfSd2o=O0~ z$k!xfKffe^c8w6dAckxm;RCQI>Wfl30q>3*P0L(jDPzkV1KeG|KDNv@z$FiR`DODg z1`Tk@m582=YVng1T*gPvey~K$Gso>KVB#&E6I`^Vt0Lvv{##HIeNS_wj8b`gU&=0@ z3@rmC5e{D4d1_^4#XSjYqW&Z^LigGO?>qg&{_vALynTO=Lh}}t+<*vz=vmz?GO~>1 zIr(B{>6!%ao9K+Xr1A<5gpCqm+8=QgJ@(HJD5+`rrAacqODn1 z*-DB?Yery2)>FQyJgcTZ_hMy86(D}RQU~R*TFGDQ&xfik7%@uTccJ=y@CZjGA3W9& z>N_XA{%#m78@$H7u*RYO-I>xk+7QWWiqk>gozL0pjJeBQ;~KGvvx=-BMggVEUf1N) z+;0YK1jN?4`)r(TE^9_~Z3*%Bisw5yHwV-tRH ztRI^ZdCk5rq4Dz$%f6LQK5lM~E29FYuSaO{X862o_kbr>9pp_{Jqo~pf0btQEh{B# zL$mrX2Q4-*{J=r8IrQJf+-1EbCPxzPXC2pt9p7`#=2Nx^5S8Bhh zwQT}^Q!B&*ep4^IOdtL6-OFc>UOj$t-;dwDxl13%zv{lH$>}(K|K!cZvsW+g`|Z0g zZ|lGP_Q}8A-uL@XN9@NZhr|Bxtvo*3Px8L^if~>6n8}9kM+p!az8|IAPsZPmlAxyl zK9QReEC8paXowW$n5z)!`_tw2)wSGxOSd+yh;WL>#?%WR58HEK>El6Pp%*?*j7p04 zal%24_VKbK?!LSfmyjo*Hj)%?17ptwTMFJ`iXe4-bIKJQe`8bvSX8!p1@^F+N zJ!%*#G7})LcL^fOD6l1nC{s+AAY4O59wDkYb8#0S`Y2Yo8KQO`iQp3=hm~M$M>OXP z)+lr%VATBmrMQxh<@Wmh=5v<1#!?SyF4=&%^nQH(EDMe>3*yubGsueE743^h*X7u5 zH^YCv#@*DcM$leQ3*Qdf*TVR1+fw77ZI0u@PaV{cGk&`v-dud<;F^E%#`-7s`*qtr z_xSaOxMnLt=5O~Go5|CUUpWQseG(9Jl%o>VM1ny8o5jpP^xTfk&=3!x(HV#VbMYCX zyeSwN+BokjW(HzDX>5i*&il?D&V<;~@~I2jkk0hwrnfYN=JjQehVK%?d_5W>rXRQ` zVk_oPUtQgNx;e^~X*b5jwpBvP0e!GCqH6ds@qo4P;m`lFdw*D;Ul#Z$ChAoqeK^$~ z6Jtx_e3*#FMEbCG!i}d7bKYrxW^d_x=I?6_>KNa5kCA&*m~qMwjC#a5I&Pm7U_1*E zYrstF!HFcPG$2HG-y|TB;?yRDmM}R2AmH1h*xsDRivM_XJ6!Fj+pYZO!8Gl6-#iva z@nE<)9>jS3-EV&Ubq=|v7seg*Ky^Ip@oyhLczybZKclaWtr`vL$H3iRuC#28sBh%e ztKq-pc)a=B#p8c`bNlAi>x&C{_#h9@H@lzK=5l(p!+q1%#KZ;Pde1j=L*!B9&RoZt zJLUZ_7sTCL$1SZ23o-(?tBCLqPDC!w;-vIZOj!ToI!>{=e{SdU@WeOM9o);!yb!8p z^X8k!a=5+xX4+mp+VAGg;p&aN-inbf<|JNQJU(qE1hs1nmk`vVRa`R0dy z?{G;Z?q8&$5=B)_v+;i-WiV zXGBP1wqugTynTAO`gVWZKL=N)?v`)F07jW_MBirFB42VZ%V7m$n`Yh-z3ReekDr{w zYiBr2uh%*proXElj?w4!z87V@D;^Lt#5K?Qg)t-Op09QNfm(5U&Aue^! zubN>HLtN=>Uo^w;1-Q^Tzh(wP^nRUlf5{BQ=>0-x{ffC3FrjztzJ_t{boTF;zd&aC zdg&i8$W_kq<#GjE!goujm5YCOvwgE%1(@{3at&eH_sUg-S(se;zE!RwO!`u}f-vzr z2Duav7O)4oxzK}`QbsVK94p9}%$-R#QuZE_V|V&5t2cgY}tezo4!_5N`DW`2xs z=68KP!}-0sp5Z)RThC-(udF>=#OvxCF344VAu_(IzTkpfRbO!auc|My5LeZLE&f&Y z1{e3L5+iA1+wMz#Oc6?t#_ojl;=J??HI@4?KozCk;_fF^UYI{fXd6`|{;$2_=bbc=E z{`N4+Z(g7N_Tuy3KH4ATk8dR1LAbt)xoBDb&8K1c8Tjq{&0&JOcl`9t?dywYKYlq# znuq5UvL-yIAE^_b(}Vm859vh`dBKbzlOk~XlukCFjC0pM%U08E?TDW}{Fk3A|LW!2 zH?N*wL}j#1&idim%g3*Nh|0)$JTFF`}p=56wCPN$HxyfZj$x; z|5N;9PdA5~V{o=oJ6hAk_7YzWjmDD>@mT{%4CT%YFat-;1X$<3f^{8byz_kkUB|mb z0_^&`!f#PR2a?aj?eVzZX<}KHQ}661SVxAt^k{aS;Kr>wN*Xv~6jiMBwv~vS@S|c5 zLHZi=%ekSKGM$sM0?u;Adt|!1nk1TMvP{<}>BRCC9saTLc+jn#C7pNK=atU8@SByJ z?c=_B^Vd&UzxxY@gf-Z8hOvL>nXzN@f z?-%rq?p3w2e{*~K?B(O9&)!_T&5_M>x{HC$y3d7Lx0g@;6=B)z(fnrOXwmw@zWYY3 z)8@h!>$LTRi;&4_b3u!A+Ny@%-O@BEBX7)E83}6$PjIG`ho*DO%DC~Fm9d0qeRbm_ z-t|$U=e8^$61fF`A=)F}z08@N#kO#00sQRwlZ&@+o;-LF3DIGrBO~TeytslgkKp10 zrSq$ncS=+86}QZu^slFV(s@pXS)xmBhsY(&OkQ;tG4n`@Sir1G=bi>pF|)B_r!8FpX^jz(5i!lY_LdPv|CteHQn~lWT-=bdp#DT>C~mMEv*+Ew@rUNK@WLmT_uVv? zT_l-Uy_zodP4G(h{L%BbpRQ%Hjg6~mujKAlgJ$c*`4%Gn(7Ycwe`vl>n}N)-AyK|$ z-@bY9`nzY3{Dljw(4uwq^Nsf6$;HKkZ=d*MGuD$4+5R!B-8|FzmLRvg%bal2vEUr`N|VCKxXoaWFV}a zyE#WA%p*){AZ${Gny1^{=J?H*(rGnUEn=k7ToW64+{99xS>@c@y-=|YJ&wH zBfP5!9a8TSKE2(IYG3H%N!*_Vt7v9)u9^2z$Ye{)2;ViLdbGwRGDkCBT~3q(rxsBc z8#T9y4i;EO^}<{)10Zkj62@ImMf<-tr!l3Q-Q_pxt?NP_)vwpO7U6?dff>EL8U$v% z{~KgrKp$7<{)pk-+|Z0(%#c4oewjl2?CHg`H^z}nNnTN7!G^fz!C<}L_h6&}F8+O3 zqf3Bruz^K^5tewvNGS=7ti)qRNUdh6yY(hRc5kDW3YiteV_9bM z?5!Adj}b&Cz|7$3`N8>__!`da%zB!Wm2Jw&+%Ci|(Xc9aV&~kMG{l_snLSqij(WE_ zbyT8F`V{>PTw$ps)2zg>VVXDLJ0%UpnouqM{h*Op6K7^;*MM3P1DvutxyDJ=xh=FA zmM9ipA&WyUG>*kC*OU=oY$4>8FE;N2N(+|$h1g=vqTgX}Y$2Y0v~VTSk9MK?;%jjb zSCCLX`S9<&k%xDh{OA-DZY=;gv$cOtDdw{n{cf_Ek!Y}<8)IqPY$5?;)tm#PrKo-u zospHyx=Hd$@LWU{Jl5^7qchg_J&2<-Hbm{(UyLq{*3Fy~Fk1I#|BI1&QXujwA{MmR zpfcy;+32Y5lR%&R>+O@5kDok_r+nPUvUw{uD;zL_s;>BYgocJ zV+e=GH>3A3#Ufz(aD~GfMh{zfXABX(7&e!i-9}TUde=sezKAA1VzzvgQByXEcZ15A zAvQ$8u1RT+~lvn@B5a$ya-ol zy^?@g4<@_vy$CE^n&4UjBGBc#W!Op-Uf)Ft=Qw=-==lq|yZsIhs1F@wuOs{eSZawS zfbhPoX98OrW$E+5`qp2HEBX08T)vur5C=_I#q!5ruclXh-+8E;Wq0adV7?WaKG~)1 zSlZQB!T+b%UxF3i4%KgP@zbm!igSFa#^oQpsBCYZ&#$xIwshF%*UOYYyGtsN&4b7y z0I!O>7cMG5LzK7&0(fK?XAUPV7RH76AWw04&2Udb1o|eq++6=c^K5s0dwhM^k2uvD z?>U^+ZVyx2=W+&J9ZG40)7n;KQSAvUGQtVVgNzsLT`>@(Fw2DYM&PB)NQa))$18zp2pX(C8EB<1cq=^9Y%;?uQ65>+%_of zE-Q^39nn)P1xHV0XQ$z~8@Nrw5iGaFiX#u{#fx|rxcRyeCSM{D>ml!9KzgG6N0Jp` zJmg!O6-jN~QZf(;r$+lGA*rgcVMQC3vLJ-3=Ze@r0;y~rl_QbVE;2$`+9U3Ek&&W| z=Tk3m1k0?n;;4uO!xZaL5sj!)tVc9^5(0U?iOAmXV6Ya(C_{P)#J6NV2}Pef;@36o~B*E?bcAH}YpyhMQzN zj32M8{aeqUPyEvdt6)%{zgF(dkK_L8YQH|4VyB8@H`4b`H;XE=|f z`EGx!nO??h4afUmCBHEDyiEoePM9f1no9@8upX!6mWFj$9Q!GK_ZBzrcAHGJfk%>i zo?k6VP+#2+g%MSX9vv}D7~9F(Az@0QW+53&1pDDiT+8VT%gIO73z(qs3~L%j6xsN` z*;Y8gis21B7AGhCUg<@!rLgg_Q+gQdiF2;|bR~DUUn8lw`af?s<4;L)bnZtMO%hRP zs0Q!nhvlb zGqUf?79p~?1g8XwJmh*W{L=Z}SQA~eJ8^x2_?qrB*0+1HeZ9Yacb#!&w1FJAOxbIEc;fZpWJ!-zGhC7DzcRQ%mFwdK>Vug6r+)KhmU{#ya+Tu!o1+ zoA)|P#4<0*=NSuwx4!hn175H;Ve9$6lbg%;x=KvT*R%k;>lx4Y?i%rIGYA6g?yKRy z<*4C{Wo^cy^L_M8bSd@Nn#CjZMu3#!b)Xk=3s9KvnVv%5e7?`2nJ^pMl9uVx3whkul4i&FeFO=Sc}3~6SPZ) zB~DJe0AE0$zf@OY3%f0Gs4@Wm`OB+ucuS~ zX3rn6RFl}xPokOZ+X7Hk#|WL+F~vVkZ=}M>#ECG$#9x|=&F*rmsz2$)ArcLIiN^P0 zH=TNXeurOZ(i}?XM&D}#_rIffwBOwv54WSfq>j~hRlDaYu(m|Rn6Z#VPj<)6QDgVS z-7OP|YddJ~B)oJzF#b^pvosZo^EGlqS(sewdV@m1aNY)gt^6I%#kCxdLT73@H|chh zE*But$T{atvYTJ9632NOco-a_yKfjARp9cONB!!dI2?qw1^!)Y#`n>&p>b_17KA2( z8DT-goHchC9A^m_1gEURTUfuxd9>e}k{nolH-O?>L;N1-Vtl{fZ~e+;*Tpfg5bbi3 zv2dciA}ow<4!f&r@XNuSZF0{XM1kLVakyS$o$>2B^u#X*tDI+N`Q8`;B*;9fUyD*d zzrKIE))K`r?$+`U@$#fR?#|?Wczgx#*Vk6B{C;mcSYdt4cO?N8^jHkf@201l!_Cnj zgiBZB-Skp^^vFOM*6|mjxqDw@FGSe{EyZ3-(T1gv(?%$Y2e;E^zqW!Y1i*{io6SfI zCt}8#r#FT*U)TNgLai9_@rMsCF4BB?fa37-Wvvtn{xhfhvVLIfpZU{VD_yjo_I1cu zsU5~?`muk!kVn`b^XAeIMHh4==$b7c27$&UC|#zDuUGji0NjkPmFoVN?|;q{zS!St z-fnr=+1|f#XbBj%Y%BB_zT5uN)5il&URm*ZYi;-HTJ9b^_w%FcyY58!y0swm`gN_n z|EK>tFSNF8l&_~e^Sns8@>OS@4fj?F+l%8tiYqS&bsfjCF%UF&qjr%Op(W;O#$AM# z=v)(-Ah4tV3&Ho#AFWQ%@>6RP_o540D%_+Kx+-KzH{1|?-QYY|A8OF z(PP0M@c*K)qaY&Ee^LBJQ9IArT~F~_+uDV$3B-IepAO?{4x&L_3XZnRgM$@BTmD2K z4*3fqKp1lfa;>*8EI9JGGR*Mm=)vOn4daElHe|G37Zq~#K0zc;JfLZXSRI5%Cz6mWUDZ zGWo_CvS!jjbwt^^*E|x({j;weh=XN)uB@Zud zeV@p%i3&iNKq>ZtNUutP(FV`-S%ty6;CWZ;IQl%+gBPw@H#QE$N|YGB%u1B#r{p<) zMc>~$B*t{0X>E4oY5?NJCe>OvSMU2r3E%Ny{RR;c<76z(F_Hi*L=-zP%c~FaFnl`F zLyH*?Hb>5qBdcX`?lKu@m*UHQGmmqNM+ctAa@vgID5nc~_^`TBwD&`--0ZgpvAdZy z3@q$Zp%qEc=#&kKOVf}rBt-u(e=qtrAo`r%`#LjPQ(U^}{_gtoweScmw(-@d_jd2w!cp3WHdN6d0@uUXHht zBceTS5~I+M}m4`1BI>>-lqrxFY&0Vf?|xQ5;@s>Z8Js%X9<_ujuq(|MB{QUaSn6h+ZSU zndD*K?oT|A<%ie!-Sa(t&MgNCJ>4I!R^0Vq-(TNEk3>-TKJ1Zi590d$W=xH7pWX1q z5NbyVmFUMr434p`->xM_uw=f2+)eVJFy5Sg<>QvF-itsVU$+CRJ|67BW!2XS<>jZ( z=BlrAqScJ)`Gg8^WVfQ1%erp|x4+j3fZ%U5>yBdh+2ZRsh&d2}IUd}8TpfZ9BOP@F9r0Qd z;%;icZ!4ahZl~_+L}F&tpPrZj6!E8L#3-7mKR&b8&VGM>Yu)Jh^M7$LB6_bj1i_LS zY#@l9p}yL|+hACSw1X^0Yr7bMwj>J-B2*YgMVcV&EZBQMd@HV`PF|J4W)}RB;`Ls$ z4xt{s0s^>s(pmsU^m~rI3yjy1Tq*+s6$19JyA1%ul4qlI(yb8n1*UNlMIH+NeppJ zjSy7fm;cLZM4&olq}r6$IyM_%Q(7uxHu9!8w`K}+R|sz~DNgWIJUg7=8F2T$&U{pndjyhv_#o8v}oH~%A!oBfWU_^;i6?f&o&tpK|DOmp+- z_HeU5=ms=7%EZ-`!@qGn`FOpDIjgH*vmA|mxjKn!B|%N}ER9Rh5!Q`&f~Wi4Q8VAp z?&IsT=+=Ckv!F@TYY@u9dN93Jr}A|S87xEChV5$@oSVg1jwSj7%aduNsnd#dHM9T$ z6WLY*5YjQ=snBvX#5|@H9JRA^BR?LMg*lu{|j;b zWGkD@PuxzMJprJCaSv7n<5sM`OMh0+2VcJe(GZBPLa`Bu=x}5NM!3L% zh4RJqVWX4D5d@;wuUm^m!`CDDd#2Cxf(X!ij|3SBIMIJHDnUaihA2oXy#nGPf2 z(Zq+a@A2;FcN-~)4k+=Lq7OU&aUDfx-*qAc1>xF-+z^WZSs-oYk-$-7>0@Jd1drFw zunI7vDv-^!1=APkYh9OS6#5yJN; z{E9;TOuCVC_QQ)Em%;?$ntJE#f0<~AeoldD-t9J;W6~0>tAlKh9)Y;8ftO={dl>0H zeBq4^pWn7JGcLpjU5vJi@ra@Seo55i#r=MaJ7D;}y~gtUeWKVT?)PJ8Oa1q&D4|;Y z_gi9+kH48>H{)S*ef-h|?c(&CCx^rS@SWIAx}M|2g7^yEJK+#7;YoRj77HE^j0+NX znM-#sq}K=e`mi6d(7LG@L^gC{q>3m)PmUB+`M4nkeK#VIv<-oaps(r{B;nf)*}w#^ z2C;x~pAx+~)7XZl51#jILDM^rczLoqm+YKzT%Se%WH=8-m0zZF4v4affX2@PPF)bs zMPYHCe9$I4bwpiUSeR$iBQd_$4VX$JdQ41IMO11gMwRL$hjN})c26k%$Rp>LewKkT zTdv-<(YY6{cgM|EBb!{g?km5~3&~X?{97S4t}*(5FC+)S zJe;p=h4?kX3$fW55eVPaH-mcE*xs7VMoT+wbt>}L6rX1)Cf*L?=c(B~-lp166p!Tx zAM3Dwnt%<2WisYHHbX~nS3UcA?+eSY?%mIZfk;sHR7GTU9xN%soJv*)8?|AFk;iHf z-D7=*V8257Eb~wDE~fB4er_$J2uxjOs<4kfD=FLyGS_;kD?!3fqg}fqZSc8UYe~ZQ z;9pIW&zc0!Lt9D0ojn8pB*EWr?vlI~r~j&^DuqyaL1mkfh7q1_I-0_H=Cx(G%XXEV zUjgsUbs@KM)Rx5GHCq;4J@pqkaIAAVZ9%H=BP*?ungps!A5nHTChmQd^-L^$zfLP0 z9;p?_@1SmuFU0k?awiYssL2)yH3rU>BUmFHTM%9boLqdX(x?@R%BTMJu)n?5WvDq{ zskNu~cPKxI!(pRakl=lI!=w0L6(Z?68A|ZpyWvp+99!=E{_3BFkSWPn!so*MjzyES zO-;&(PEk8kxb2IMB6w724TXEYf=>#fhC4n*S32iNc%)$5Ir`!ggHt7$K`|cfwj$y@>Fu5dtAbV&eTF)Uo1cC~dW+vYyxnZ+23oE2C>M)`y1kK;!g;j6y4vql zxgKp`xOyn-6O2}~I9s0qSe!k#04&V;nKT59vn?0`CZ{9AsaegweYn*u!GrX-Drxa6 zl=pJG)h99%HnWdx2TKUcZgrm%q@H@m2o~J6ExymyLOhzjMFEt|?UNmGSt z#y0V7pBb(SQClDHC+A(z24!mqh}oX82~w|t!xTSv0?4$ub#v=JPc$<19FOt+`E|*D z>ppMm9ofo&!~W{kx6cg$1((HNQ7yRg^Pvg_SAIUUcf9m{Mzl1JOF(3n_?hng+xHiO zHI^lT4o6@qS`_>W*vAVh(20&<+0-Beg5_ZA5D4KVqGtl@ zh~+YZty-{tlvzfwZ|mS-ngS!GW=N?NlHP!{hu`3m5znIDBhzMru+0I^1feDh1tKFj zR}?$EE1E%EgNVLC+VDjRYfdMTNS9_kG9q#AN$GWKD(9qY-wRSXcd)Q05!=iCVRL+c zb@R=`%}yLXeJ2H7LKtb2)νr2SAt&I9Sg5#_f=!TZG65)tp{iHV4TsHuspAJY zd|J&BMUAZ4muT1a+5SH+UcJ<0&RORvJKq-*Miq7z^zSkL_2Riky#}2nx)vfruF{n} zzTZzjUW>zxJSd(Qr$2ao`n|^Zxjz>E^Z!%-*#GnSzwy8S_W$ZRe@iI*J#i8Oa^PcEaMp@WR+5)ZQI%6Q zS9RIkvwsni+SB<=B@gHR&@U5}x z=Dy+6RJLFmSUnAcz+Ux|k5g6kE8JG)yPuu|wM$WO{LAK|5q&?jo!arS9%RLEDXWrU zZ~9saiBmg{Q_cHf917Vt1$L(7GcT7B#70p(c%~!hrn>8jZZ3v?Y9u~ch^Z1y({)2p z&3!f1%_PRTpK)4oZyFqfrWREzB@Pdc>Ux3)hpSIdK8WqDxZB3zs}&jNrkk4)_k+p0 zsY_9c9-rz#D8>SJK`Nn9h@vQ&XlpE!gplAknd8JO8=m7)j6Z2lM?YhaAq63xhO%tL z+`*-T{HU=%Bja;f$+~BPivowU;N93Z(Y)>A*WJ!E;Kq*sf-DT;cOFdJ6HoqmCNEN8j9 zk+1jqYg0B|UCv`uDS=f_MOm||EZVM^Dl8VnTE(iKF|L{pGf}DkZ0os|_0%Wi-OTuz=eC?=)zy6gSZan8OzM(qL7k9qgU9auI+i>h_>mbsq5Qm=x}R9!TO@W-&TAc zhxHiGcJuaD?nb?6?b*Z%$j-TEJyxC1xING>FhNRe6LgQ5hn|M4C8?FvMtA^ zz%dcE#pQV+KK-$a-ESDBWKd%;bf#jQ)Xv~Iv|ZJV6Haf}HTW_VPu+|Sw0||i=xK0} zAqZ<|=ZSMmjE4fZc+}crRf7}Tm-u;c1P2&CtXA992ppaPdj<{Ma;QPx)VvxC-g5|K zoSgw`3YWNBPjexUe{3828%8}sOhT5lN{E*IRKmEx_VmqEw|xhhG1gr4vMgpOq!I$A zgq&|W7*1SWU<+A7^t$~GWA317+IfPOg~ViadomD5`8W1qAA#dgaN6V53>hQA)(ry$k>xdn~9$*uOZV&}8VG1<3PB^*BOltb7 zWkrhv3uRrEqQid&5}CJC+pSZD1kX$Pv(|ndp`WocxXmz*I6lPZLUsV+eD21vgEVd@ zh`Jj43E2eWp^OR1pb96L zH_%X=cik-7xvK}*ZybMR5A;Ip#HGBFJFTx%&V4zRqJ{ZT6}Z?VhnvBfgmpCuSaC4j zs%jXE4$89|E8MV-!T5(hfc3}OI-~AaCS^UG`YP$Iho*vJ8i!$k8io9Q#blG$i?loJbc*P8D9Stj}Q<(aF$?l^LifPAq;ij z^{lQYQNW~tea=U9?O8d&w_?3IHPAN#j%_=vu(-xk`RZ?ltdF+p9aXD3U`!}GL&ymi zy{+m3<^zM#QK*%G+uCC3U|awJ8m&>*X*uC+LkjU3dW1Ox-6^E{N>=xfeK-&>waN)j zJZs^?PBZ*l2&NLJX@rM`n_l9;!#3~KMXMSK%V!W}@4~bkf5Fx2W>|tfQ{j#g3U#as z1}hcrWYbRrgLs6`3(KsK@ax(ZZeLr$1eo9kS8KexKQgIcjL{Bh3*2fLot4D5J5l2* zbHS>vuS$;V1!cj?wpPDsAVbI2)hX|?}uJMYq{YNAt4mAGQmEGwS7vs;NQaG+bo?e>p7UB5cjE$;a^LoQ-* zSdV>?lZuB(KFbPQ0|_`PH7m=e#tuSzDS6n!ZtP*xu@%v>-&mgPju44@7psM`!bupW z5e}yM-~iR3eDE6fV~_tMP63h*(uh?`r!Qji*jROtI%CUA zxJ_fPlxfRU6p_JP7Vz$BITv+NLg3Umt*`<*D0x<{u%CY;`C)(fNgm$5KS(iYWirgK zQ91Z^Sr)KEi*kU00WGc$@jRFC9H1S#epC)Qv?eUa?i6B?UDG$?3L}H&A>NLDgTjr0 zI9A`OVSF*c1S}2+YiQ7>VnyE#kkM^1;Ph}dHN#ZFH-+%7no^FHT;X#4(gWa2EdKOs zZES0R{aG}u!qIJE*bi(TST~i>VIyomjw=Ii5C6zqtI#V}i%&JAazsux@UekwbyX8P4-OE3+NuyfVL(h+ru%bJDheg&V{I0UBFzMAaa<*-?fkfMF%xIKuYjQbnVDiNg@hr zuMI2|aEu{d7>t}6=cWJ+^nAr2vKh1m@M@*juv{=pnx<7TPGZr+Gx)b ze047H)nVeWd%AHNphb8M{aV4~z==_>Oj7ciK~lpR8I|5G2HC@1t&4VrcSsSbf>do_ ztb+$O!YYGc>ZCFtAfh=J;{d<4E=N{(eZyuLLol>E6;&(*?i|#}Bw;bGFzG2GrP8$a z&)mTe6D4*}dGkWC8_^4Swbv0z zUc#*zdkF3d?mhhaavt~$Q+|MXhC{{STQ|6ST?@aYlCAQH;PME_B?t z`e0rOXQOR;rLv&K3V34!3`bnQ39=f7T90jlEG=Lgh+5Rpbz=>K3BG;P%xhxLB+_Aj zd5||yE&3OWrZ3BSo(oo~xTnOyhd^ijG)mZRaJF&a=c%vQ43fGZ;bQW(>9Dja@>V#m z)y0Va)CTIsD7XXxZXFEDqJ-ib;gHp^3ZxW6Sxmg=(6zD{IgVC6W3AdAe^j>s^(oNYZMb-%%V)#P+C}iDLWnb`4y-#ykOtQyKgV7C_w#V+_)=d?Ig@Oa< z#`N|e#-9wk$5~g7BTUKyo)IgXwwU{=uApu!M37Vssz zah2~#P?;Pf=u(J)S+rf#O8D_*Kf+*w%!U(!h3Rqqar?`5hFb#2K^Y3Xkx+!n`WzgM zC!=*)^f2Lup)KKRj~&$6025#q-P}UCjpGC@%i#NW9h|66hyi~(&&sv|+yslx4e1Ag ztM_KFl~RzHI7+RMJ;dYyYrL=3UKIk)Kdet)!rSl0u4@Km=nZ|%eluJigiylsD5uNKtd*W^3)f?S(>CJhmJ&z3u0|M~u<05$z{iF( zoy(bb)gZ^N>UpOkxv+^l0Jba66vcHo7*=ZRaEC_Nl}%sZ?DTNjU6cn0SWGP>k$^rK$7<+AJ=JXuZw^b;3>9Zp ziFF#)y%YU7jt#UnY%18IuyL9dCD&S{Yr|87dX{5-3C&W?9fT%VZXUE+(PE+0lPfl? zRT&I$LS+LX+shJeatmF=dMxWbv8ws{@^+*5JQOwcymljDY30!t5i7ZV#7QgJCL$slhV9BV~hZ8SIo{#O0JtIpA!pkM`z`kIRZeh(WZoSdeGRlUMCCXhz4`yljT9~}0+5T%5l1zWRH$wPGw!;`7p zCHTd#XW&~2IP~yVN67TCDU{3Ab}Ayh!iLczaqZUO{LEDWH@(5NFNUG7r%?#lov;;P z4>ynk%7rdQXvn!%f&y2dgn))<$Wm0Q?B%{2I2$!p%vWsm#S!@a0f z_8DA3Hul9SKSUH2E1(1gD^?gW6qAZ=Z1hiY1uXMQj#E{`7Hwz2`(8N|u;<#-S4Sw9 zzExQRN;S8$vWVfs!g%ioQLRY<(?R{;Td_NSY2>N(nBh)A0I4-K^w_aRrJiD6l{V_I{r!qCEQz;2OxOGUw$xrp9IPHEycg z=Vq?O40EUL@n=KL3zZX8a%DF_RPjnh{b5_!IynrNTT_DXW9ppSpxH93VhB&Rky?Dsy;(0_xy#_ne7(m0@SUq(1tTF|$9^6;d_!JNL#I}7Y*MQSom;~pq6+wz<+F4yynqR zM|n`Dg!a&nRo~$}msMTEkRDY!U<0eA=xW)(ifL6^YdI8CRlw{6IJY|WFbmQ2~q z`bepiT{qzv!LNqJUKQ|51^glKPB0;+3Ql&36F)*l;k?)CVRY!H64H!M+;J1(_3Le% zww((I$7&p^x`BDc3OGC?{K683YRd{0e23D;#bo0+h+e3dxfy1MXjRt4iuW4|NjYO? zQQBay7(9m>>KX3y*uXcfAig2qOIS9toLIqom^xK4m9XKbt{mDLdK`ZUZRF-%%m*n= z`!}k5${wBqym=VUOjLuM3l;eo_|QW(U~3!oh+8$V`;{#XL0gsh8<_IAj!saQn|aju+Ib+Yf1npDy4Yj z?g+c^av2{CCu$o`IQZv6sFub zH)Z_`oK|wxL#J}whjJ)Y@&T-gcIL3&d-y=GO&L6B_|B6mE9&Kd-_%v7_OdQDpjgR$>*V%We>D^>}Gh}@T@x+HYGIWNq+ocL4726h;3-`sa9zzaFX8kNq_!$X^R*Y|RE zT(09!X7M$S45D6Tb*Lwmv5~xORTe`lanc%_8t}+Ab9`X~mo@mt3FDB?A{FPM6DllJXhzQsm{iyK!MzGG!j@XV{ z^EE7H+_X|1W@SN%8rN$cdI`zd${rRLOc_=Tby2|YE|nn<|6+n7Ql)F~yWJu<+yA-# zoM@!=tg#uqC`-sK9O!BunW_p@ar&|pGaP>ydyxB(8y#yaJ{3}>IpU!6p;X?F6V;U% z&1;2o(n3_im@hbN2B>Cu)@1=P*$%3z1riFv6!xEr-85~}brA9##>B|$7I)E+>Uh|E z)CVD|(_^#B$S>4eMmZHYI_)gl7Or-$A||4POo!80OWcD|bg(q=lZcKtP?c^QcqOl< z%|WWfYHdEDz)y_@f_Za#JLIamwX47=lraV$5q@?*Lx-zWLKw`ofQJp|2$~%yZcVKe z1$HAB4d)Igmld7LRf7`~Tm!-8o>%42sO$*VKphQYb_BcK z9yhAo++;l~qoEyO{}s@GGi(@m6k{t+^`czWf^r7)aIRE-L}PV z;^}E+A!<{}N*TsIWad!x75w`G%BAjMfx^weNg6ALwVFm1fu3OjO{%(go~Chv*mqNk z`)j$=du8nOW-lPNuryr<HUX;NzNP#0p%m0Zd7{fSYqQw^;BFIT`|C|94eTKtmXH>I*6O2-i#M>!x_$y z%Bd+;S#Q_C{KK7ud!ypElYs8wO^Y?eFX}>tG^?qGtpj~st;wq)uui7KPHL?Ou0kD? z$^^srDn7Q&2)??8M*#^SstPuafb~$d-2|ytRB$VyqsyUhMpa1d2nD%t)bAe~dl)W7 z*{b9RC_FYy-PFT^f^R)Sj>--fflVV+WhF|6{Zoa~9HLdW(C&^*M{PpQz&U(B6-0&~ zTFw(TuD~KmSOnM}m3suy1x3?#J!}{;;Mf&xn(B#5S-|CR1Cm;E0eYi{%Yp+7SErn? zgw>A`uoh+>?9pDODhix!Sjkw&rj$+TcEGRS?{}BR_usZFaP=97?F5Mf ze{de*;!Ngs;UNn7K!HAoN zVi@2U!_(@Uy2PP^h1?IdY=>&b8jWyGnX2w-;7nuTCYTklMxD_9@4^!bcBJi;4O6N} z9~J{Uh+C&h0i@vY;Ds#bMn(OY6rvp9Xg3Xv3RQDBmX1)W3ShX>GT}~FRSiQFj{MXX zvVfr{`>w``8i6&|aM)oZKzyGxVKYLU0;Pp4E&FauOmz7Lgm2@s;U-lEG+p+RfCOM0sj{YV=Pq~X02+EIL;M= z|0Qc^l2SeDHxqOmd}$$|kYzg#%><9OfmmgZk2;F!zpthCT~0t4$)S|+;M+rwmOTUHZ1fnkCZ+)lXpu!!fOftZBf z*H6_{K&#+j;pD@}8lVfY(=e}Oe@d{f-5$tKOolgA7zl8Z1&(t!)~6brMwTNN$`V&W z(XocS9PxLpdII3>srwB~=5EAEUz510W4h7G^IE{$!zRsxoS@tA?NXJA3OQkmSSQp= z$|)rbc5v61-CT(Yexiio4k04k*XejE^x5UzjD;#8Jm*eU{R9`GQy~u3IRlrlE9*)% z)T(><5v)}mlDG=xR*ev_MBN1x+)=HBf)Ujgm4u;Ez^rQOrh&dwC3#X}r6iLbgT5)1 zFVoGC_9`)Q>_<4sP|KC$o0o$6Sq^%|H_h;Mq04af+PaD>KUeA2jqH9!xIhE$7^k^NijEA1<|Uu-)EUH;GAL+_@O;Z*U>qcB%>-*&OIJ>w?5=IpaT`U5`%W1-;fP{B5^lnDEllp}cjPbb`WYk=ktQ*+1%)yj?mr=Ou0M<}>L zOe$4*Y%BQ5*f-eDO`}q)-IUDDb~8%#nq~VydBo<6Gs8zT&e}LZHL$jU5~)#_JAe2Oh)BpmWCprk;v- zcB*NVDtA{^Rw{aitA`Dp9CO}pP8~?i?=_uDtHrr3%2SqcH>(l~Rc)d?Rn<>wZooQ< zvhKP@J(t7Hkag8TA#ql&>6$`;ebApKSaL&AaCp946xGxVrfR=uF~bL(RcT49>cA%K zsY?DRYn7fQVdRxiHpQBbl{C-NQ`@LKrveM361^a+`-#J(f{|5MvMf$fKB>wD;oHD2 z$NDu8uB|9>sA?!qXD$#Jgo3I*>pHAUHO>Mio$^(R?v&p?;`)sO>bII9Kl=hJHxA`6 zv?{-x@u4rv(eapnxHN?p)f-I>C%kWmrYLaL8wep-lme${P@OImF&3q4XO*1{XN<8C zCfGQ@aAvccqEX3@`iwc8sS>taD^(sL8`)4a`2EO=PQr8MecM(L=N!hvSX3n}PSw7z zRvq+I8J#oGu$lA)3dOA2J&tt;%S1wj;G-=Z7g6&O#!D}Trf+e`8N9-l6{?%UtP=2* zGY@&-cJIt7qKxB4&ovz2LaM%Sa=@?PqhlS^wO8$eI`!KgXR3t_3{wj}bHiHI*ABAX z4e9;u)vyyAeN=xadj?g{diV-L<=9JsOISdfb2twLV?|L;y-MX%<+5-V=4oikS;<%U zhi)dq@gR0Lv!S3EG64QJE_yxJ!zq0NmkRDB)&UkuIZM^%6|VU-_EMP(3^sg^OIR>j z3D*~8b?bgsdQTfam%QbZgwnt=L3@-{A>b;^l66u_=ofhL@YE~SSFOaNO(1Vo1zIye zbXJZJY`443xSzE0pyaSvhG`Ndhe$7B&&gq!C-|MEk`hHzzyd4^rEq#a@^Nld;1<3G zZwoPxZr;onCX-m0I`!DkRX|*{Q?I&bKuq>HP^t|=)y%No2MO89+F|Oj&+vIz!$;Wn zL(kUq6rs8F30BZ_u%J{W9MrCAXjHLU)C^|uT&eC-a0VH;I`tURvA%-C)pE&&y0a5@ z+KuQqcUq-~O~VnXRl)TDEeH3#>xNTno?dd5Mq4pn@}Y$HheaH!4u(Pt3ksH%oY(aF zB!E7g-jFx{qfaQTn5sx0o4KfjRE0lH%V50?)d-q$#9`;?&7Rlp2L*C7SL!XYJC1)~vWPtdd!4)rSsZ zNRZJb$$`J`F7FiDh0DB51ksZh_at%m$}Trh2LSOXSz449=p;ez;!meAs&7w{>SQ$V z)-!^-aC4S}*?lbjEA$yXoH!ZDlSVQESTwm0*wcEE1T_DVH_v_&dwZDX2?V zLZtJaT5Xv;U^rY2=ILr8OC}B?Yb8bEEb#-AO^s>#7HbNW!(yO@&)8a*?u0T#-K#5M zEVdWLC%RC{;;tlkdIY2ou$6~ig(QtL5*6QiLQSiacJ7m-T7P=mZlx1)`Hcof3QTIy zPA}o5IP{iPr4&P$C6%Jrl5*LCyt&R4po);iO2WK9k(K9p&%25qf|7-#2gHuKNq1D%s(Z+A@GKE9DH_BSTfG z`@*x}6&lRWfh6zNY~4tPTKa#(lQx=t`r&&oMD?)F3+*g;aZs0f;`TPcEr% zL{pMZQwFvrD0?_~Q}9C&pR|Ye;_mh9bx9ys!&tI6;1Biud2C&fB5N^2F_PM)h6 zOl{!fO#}L|23VAZvj9oL!8`jOBKkrT%CF8}%30EDmqsZNk)veuNGmp2udBY6}+dQ}NvIhvoZND3wBzs#{ z&3rsttM{cGy#W6Z#Ba46CvBq(Hxp1CaF6Q}5spLmqZ%DgMH2V*B;(UWg+@pQg6YUS ze7lhJb5MB?7KVR)cXz8T{AHI5&3P4$&VlycxM`zl&P!(s%F#w)D|afA9?7aSpNg04 zm|HbSz+|Ktc3uY;N9N?8eR)yJNcVhELtX(?-xttG>h7$KwB%1s1SUx|T^Fd*oT<@E zb}g#cch)27oeJdhe_szDz5Yvk{o7x>q^T_bZW_dp*sRX%Ru5CtbI1lZM2Wp^-Q9$} zyi8#>n`r@Bdo4$2KR*Pr{_tVS>=y$u08#$W*9`zp)23lMj6u_t(dMf7^sHKPoOK(G zLPHQ&)@_!rK;?s+;zJ{`AOE-rACJNRn4ai-IHZN=+tqh5`xeR;2lgq zb4r~pbuin02<6lT`-@RXy`v5<1FQ(RI5ch0~?{z2|!y=gR+2D!?L1MWikGqxN(I_5HTeDrhXdeYUNg?d0d&T*`2?R~<=0q?0udYZa1qwf#r4cJ3%6?rMQdqav?mE z5`XX%eEIReety?3c#!lkGrUqg%K{mEv%QTZn&e?&SRmHVu3@2CzzGfprAEOGHeEAE z%juV|Uj6RwzTdq2=*8V!mbL;`CnDgbz7u#mIfjQ7$SQd zENMRq=hfN!-M)&(-f|ox1Up>Qn~N@?JA7M+J*h1!a?~r>9LTyIIlxx$wyswWzM20| zC?EcpOi<4*jvVDO6v4=+rl{{vZX@ia;O5>Xnk1c4w(pi3o>U~M^}$=^FV^T_M1NTK z{m&2UpFVr>@}J5_FHbKSAAS0#hx_*KumA9~@$SXl?FDO3yR*~IF=;_NOR6E9RFpk@ z*eB>-ntKqi?IbI9o0RLUP5gBTpsIs}>u9WB-M#f+-QPWY`TA^&S%RhxzU3rkL8e0w zx&Q*Ov{hwC1T=_6?=R$a4Y5(aQ{8bZx3zv$(&U!|Cc=OI^_xHav;OJFA0qztB^-M_ ze0r9pOzXD1Fy!9~8;VPF1)I`Hj_uN{HxbY~A_>mdUL_Q3J;=i@Qu7h#&|~5Lu)rU` zhH1XOpsnrHmXLtJhMLv#l5^NH5sq*I^pb9tkqEzgN(zp2=Ol06Ab$KL>skBZ7vh!f z{=4lV}u#FqoAZCSQH3G$;m(lHvlc6v%gP?HwP+a`Y+QQ8Rp{m1)tewNqEJ zJqS1thpSxn;_mI)a4or8mXP6OV^_zXYQZI&3Bl`%1S&;UntmoSztO~|KWW@ed5v7} z$o)0k+gC4MpY0AZn%Qn55!FiBffa7V8u;W>eVt(Hn!ytqHE-Q+U!of4sq%2am9M_I z4{t97JEb`;a6{?0nlS*JHV>}X_$ccR?a;f()*F`xIF21UKiUXmXX}r+Sv)n^FEm+w zzRjs{&R}fNk*UW(*kY19oeXDX(JjRvvxeR%oEkDUeX5tu*wvzW6q!9C+?V%%ID5*> z+BJ~*slX}fVZe2H{ID%gKE+mk6tV&X;FcsIrv^mHOXE4+9DNKs9PDo%9^O)jU#|N< zoX4D{EXfa3!Zh=iY68tU4NPn^)rx@mLewuw5uOCg?nKGhb}p9sCB5)J_1fg8|PlZ zEW4xLFJ_01L4CralI$F)9D6ri?#+HwnCWn|pN;bqi*uYt;K}-&{Q`AM5N#F==qv7@ z)85JMt>3kEe{EUgtV&H`X5(Ia-+uP?<*9%Bf~P!NA@ONdu;P?K_mb=*WJL`~O_ zqCW5k=eRKD*n> z3?R_+pUQEf;bgN!Zfsw+qT@3$8*5b&V{x7Jp3jA3hN#5iy*)S*NYPwV|eA>YGg;dW742=YJN1JEEEnTU(k&v)u#pGMr(>Lm?bd=cpxt{QXIKjvxZL2QV!B& zdo=3%x;8B$)IXgi8DVuvfD}px5La)DMq)QCo*XQ<1zJ+_qFlyz@&L?U#YjAaI;th- z%CUZZevCT7ECD+^=_1(&*#fI?D9@g{(fdt-1FbAqgC%cU$sFvHJ8bp{bfW2zPYtkF@tuO0Eb*QyX-U+C#_30C0%J0Q#D zz?NMv5ga&A-Rdrowq){FKxE7qbOle)Ldv@w8_4Qc-bJh^sbG z4mqUPtwEkFw!DVqvD>o7OD7~Odu^oi!HxEtn>Xi?q$JKW! zqGly*%AgOCtTCJ)fcLID?9vZE#T||KhuikE>&qbS7-*Zg9$uIi?T9O2wdYp*I}Xj9n%&Vbcq zl2}8KGG(nK4uAdP@$L6_H}5XsbW$*oC&KTSqptb6*}7BiC8UTIyj-kV>?Bu?D07Zs zk}lMo*MF~`)xN!*Klsa?Egs$r!>lz-hr;=pr4HDndZT6_okdcE9tfk}cc;-ioLgBP zh!S#sZopsNy}S9-KmXgO>e>3$+q3K1BMAWVAQwzS750U1A7m0Bom~+l@EY*g+2SJL zqS)Lar)=)DDc;ZC20sq-;-fFH*RGT4v~5M&Z!(8iy5(mN`z*OUmx7w)m6UC3P~o!S z8b%M(=}PPQSPN;?LQ=id)Kn)af&bNf8@kmCa%K(k$#WsAiGFvpWCcgY7Gq&nnw06|B_?nvZn$6fcYu_3Kkk;JJK~5Z5zSC;7TkBbS^KYX3_H3Az zeOOQKSiXkE@l8HDJ*gz4CebWvL)MZWmi$ykt*-L3^vR-vx1NOnp73g&k{7yevGTEj zP?huR2QaHeJ0&H(_8_TdYN_PS`Udc3jueF;!ZV+}nm_EyU%k7v7XcOZyGiYMnnkr4 z4w%${D-^0&q+8NwWiOVXIqh0O1k$_)NU0;B%;)dTzr^{6*WcW)3*9miUZR2`!12htsW`L;~2tzJ!&TivFfY?TsEmgTi zLQKG>jeNDD)S)R_&udHg+h{MIq%uy|DK5vlvW|K*v&+kg^f*rM;(qDYXpLoyDOm?8 z`Yl@*8F@YHmgpzVN_W4%Ie(B!Yeq_VOX4l+m55R@P2FhlI!UC6WW_EW4U(1W&=^f1 zGn_1;>(PO<$D_Re^V^5t-dw_T+q>WaAx(ZHtf`u1<-$R<7Kpz|SZM}ncFC(peF^IQ za+bIaW$9XhzB}Jg2&qds#ynRgamwls%H(UDQq$fi-CU6oJ0!SP)!^%8E~nOBSp!}v z!cRUuOOHyD3shdzA~SWrX9Ir;#dl#_nJR!Wyl#ialD|P&wa++GG^8z7@maX|#}VED zHXnZV{=9y(ZcLKga7LF@rcn{perk>Yv@`SD< z`TT4?Eu^Ojf3(hmH90iPII|VC&f1d+UW&fSETc;_IM1X>wCBCm|2WLI_rHBRe|>W{ zYo?j|Nk||oS$g%D%DAw}GedqqOF~~pBj}WIOV00&RK!73AL=+dOZjM=pT2qj`gdo6 zT;p3C^-D_VVeXU3A|WboW@BBDj7Csb_0$mhkdabclYd8|d^=q$$j4f@NO}_1fL1u^ z61u!44+^C792X$oXnpn^y@P5_CokYGSZ@G!Gy8rmAorIrzdcJbbcv8=(`cPb-TN&I zwwO6jF=POT(dFJQr*V-m0mv1au21hlbw}M?4#at}waogd%Vi*ZoU&pwdWTpwcUz++ znNsJ~^(&u-IHeXOs~}b#Y&?xUI`{v0ly~=UG^zK=l1|V0S725w2N|`kK4lHCcbRKe z4H~KSzo>U)xa8$D3G!?}>6&IKY*}lM%CkNm?ZwAma*t8pe54-9bR(SP$c-Fm2gSxg z>&7foUSDL@Ew>!W&?lLotivjn2ZKDjJ$LNn8eov?b~#@;Gcs$7#S$w^wWSDgdQIP3 zO>ZkiveO_zSpm|kZO=!#u_Tf@QHpcBx+AkQvk z)G(Y?51Vu3o6T95`+(hLgD8`CMoONeaA14`SZZE{*jL-?g!9*m@;47}UVqijOJ%Bb zs~@|lvp@!)YZ4AvNnM%Hirt{Omc*$x=L}=hO>zf3E&ffjkB+ZA9_E1_Op-X|nsnq# zlb*L2MBEZqlP&vpt3Z!@Ut7lKvl8EFkau~F(U);8oTOM^ytteH_4#>u6;^eHJX;-5 z$dX~d#0gkxQ& z`DuBy*8MC4IK`Ta)z{#=PG4H)sHMm8IL{vZE(!IWpl3!pcPS@%RuJ*1NjjZ;`A9CH zur9ZYFrG0^P7Q2k*y!~R{v+Kdx`i2Sb|_@3Qgnb(#L;#fq=HqV*nG2@LexTNk`-O7 zquJJYKEO4<`-NOzWhM%I_b^Ti3XamhgAnUYPTEM(`7Z0-Zek?+Q|qk-P4Ve7M?YQb z99`1vzl2n=2j& z5~$#&s0%})jGz*7_|k(xl=`)qZfHu!%Z=8omP@PUdF_!u4)gIQWl51kf5VPh(oY($ z2?a(mtFApHJ4XGN_X{aW8oZW#6bHO*44P_QmI4EWhz|N*P4MyMpv)~3?u_0PLI@1 zVY{JBtHy=3#nlFtr*PV?1~|X?}?GO#?sY5WG)dXNR>cEwt3A__FG&j3($dEX?;arQ) zey{vXoHuXQC+COb$tlr+e7aleov{+|BWn3n+CE72q;sMHq) zQC@sx39MM{UfqFRotGpawe{r9;bFg8jT|J{M{iP=9vT5r!Fy2Gt4%8{~_Trub(SPH~wk`{b?g6@)Wl&nv*Y} zJkvr>(<~cpbv{^t=5*e)B0=jc+3~eBg9aFo5#{xc*3(8yLTaf1-)-MZ#z`z>F{6|z zsrguZ2Mb8VHpywJZF&3xP7=p6LZ$b$64xUmB?aa%OEe{SSq62Whc36_MW%4-C{zZ% z;c{{f29?wXW+J0+v_h7T~k@+jzv@hWxEG-aJ zdba!s+iA>e`P!*zTO>bUD{m>xm+#Ip59nj_|FSFy5+iXCzZj_O6;Ivj9PQ{ZEpT}&wjW~cU> z;w&Fs$|>8J9sSkrm@dr^`Q%CHmU=3!FB0fTnZhqe$1-KklEu}lmN$o!k)rT?*(t(@ z)79RuADbImpmH``^(}Tu(~n8OvJHeVc^RIrC|^0?+>m^39(`$2RwB*pi=(zgkB512 zUdZ~)0k@s6ZHKO4`S#E?su9dR$jETaDE~+5E450Jl5T4glLY3x)>2+*oNFNt`FVT6 z%eH0x1_&7vpD{3UYdj<=833PTt9wd=vM+ro*#WGpp^}#`KfgfUQgU&Pld|y&x;B<8 zor#=sIo#(KgQwyQ&Pb{n9+Ct&2&>v$q``D8u>A7-X3ugW%b&Q|W)dC&(^GFK<7@Rn z8cd$Tzb2o3^81&BK!}$g>ZJU#DgM_&O^?l4bvKugQAqNV&V<^$o`fBo&Da9e?*d19 znwjdGX_15k2m!RlWsi#A9}4rrO_v1-4ZZ0vD0)xI*%ZlDqo?$W04r5> zdJV`){h&&5EvWSJ_RU3EjM7F9i(?YyWA0X(g>S32Q`wPf5v%8zxDQhYeHIUy1DZB7 zVtC&8?a!jTRKH`Jl<7#Uk~IboX-J8LG<*&zlN;qFFzN}E!p?0u-E0<_Q$p&WH$(oD zFwc+F#k@#)PV2Wr0nSq+l_B>?5>%71s||71Ahcw9_Gz*!!(>M^ACG!(Js#rYqjZuO zR)+9CPrTNdW@M9!LO9)=la$+N+U`;lt?$er*V-G^JZ{ zL~g^?5XgbixS$Ih;AWO7Uy0p8iKdzplO!~I3ZZ4NJn#|%r()V5ovd!IiP-bCZfBuE z=X*LO|4`hiA)w|$(hp0w*#<62m~Hu(y4Bmdw3>FEWA2coXFx*TSL;#w@Mv)UaU;QI zCIx6Yule5S`LZ_2omzGYt$HWdr^+c?i2_w4#fv;kR)xGD^__Y=%J*;A{Rb)Wv$uBM z*$NzXN~Jl>U1gS=3OKoDG8SK)(-XSP$fp!5dYQ8E(IaQH^=g1gk^biwpR0Z0f-qC{ zma1KH3LYj7T3VU!z4gAOCt)(?V3)2`PTd$9>r=0ChivF&JM2Y8yC&PfKB{ zrEiK*cCn1=DhNO8v3Tv2Aycq8h>El3TCW}lCU(1b4LDnQ~a>jzB zCiP&bha4aa1wo$C&dQGD9OXrO_d@hn5Et0S*39=!fOmB!75L&h%Y8Lr$ zGGa8Qt36b^BEp?n-K$0UW_^BPAg1Rb&j70|Z%3;a{-bWwud|o38My6b_~5p>)i>r zwmt0ChD^S>z1%Pj)a+`8&T8xLFlE-Zw+;0*oTE)n@_LS+fwSG4hEen~CkyNfGlf$*!57%4(#9*dy})!wPHL?jDGz7te>G;6WEd^jgz%^8o=UC zHE(q^FO}Vs4oXWYwAn$#Rl}o$BjovkhP_rTe?%anC#ZRBgjYz~xkDx?(zzI5I@lwE znrl;k8eGH#Gq$?XASRlDX|-Mp96u%uq3a&IHxI4cH|DQ^*n~UeH!JuWgw=X z5$*vUVso0Up<#bmdH!IS-<*xp_o-YXxMLi_E!}vKBSWbsc~MSiB^ff=QPsm>`dVz{ z(t=yE5x-WPtN(Dta5k%_X?28wxss}l!H2q(l;p-z8n9>0N)mO&4H@di+Kd#fJ4JPt ztEEc?dRo%+qKPCv>8+oh`m!#Jldp?XSS%H0?Wle=!#bx@BxKDdk-H6;*zRbr_VE6g z6iDr*kOyHzGE9S=MQMY}>4(i(S!+Qt*HBG{wW zP98NO>auR|Sq%lfaL8>B-J5MBS`Mh2x}O7*UTtH(IlCt{2@2(kSwrd?9pE6Z#ksMD zY&3^#0uqo;cJ0piCX<5*!jrhRd#142k0X3kmL|;_O@j0+10HJ}>lRX}PUbl$VLLg5 zTcd03Cg@&0w5t+GK9cD&G_(yK9JZu=mM*u~)=bfM zl2d-L$!?=ISxs_qxpJ^x2x80-kmxO!5Ag&P$$0EV!#iDU~B z7)2I7K#dwxu3$juV}bl`-T(RJ&6~Hc*MENT`S~@m(Qh_j0mJu`%3D@fzh(`FG$3T9 zybGL?L`88jGLVZ|V{w$yqZR3QH}?SxKghoPY7F7ee)Ia~ z;cUZ-^O7&vMzex-NGcj^m*u1~QkD9`5<ilA}|0wldBBr~TnL}6N(w%&F;He4|0cbfx1@;;4M9#Qs*biX*^D~AW%&ZO| zTW6FB0c^fZ>pjIDtR(GgvC|EkpYmjy9Fw4t=#XvLNADXBMf&1(d-v}A&4{{C_a1Ut z3^PkUFR^; z0f^FMZVQnFPDsQ`&bE41PI{ZEw(MHfy6V+Q+19~KeJIf1EVa;nb@%rD`MwNO<$s|` z4vDUFR*1`{oL2`IW`JLj;<-HMW}*nf09a5fw_y)zJP2G4Mf>vM&#%{S?(TkncE9HC zW|qiPCZF3PtvVTSt*D`-wb-^^!^Io?y}Px`*wxe&NPgz`x`XBCP_UOpj3|y2-(76g zk+!v42W}2Bs`9(@Hzv7j+Eja1i3}?RU?3Pw+~p|WI~3=)clW!GU*`W7bSJ8DtR?N`t^fkjhJN^+h{n+%V4NnE>_mOk= zQbLebBsI+eSt~>_V(qtaj59U;;-hX}dx}60~rlhz-2cqw}$w;w4p}S3|34Pt=Mi<>? zBL&XO?u{zMMj4~oGFmt)tR*AWcK%@_R11+a^0e+QWgSwsiv0Uvlr6>9>uB;R&;!kI z(Dz2}$zhu|ra8zr`NKzh{qDpqzkBz-zqy<5U$2jTHRs*!M-r&{Re$$z54`-zUwrph zGJ0Ns!JC+>ZWS^sB45>3`dVv~3`;O4pV~QDMjs?mHRLZUd5KlX0!Mw1o*Vsl7h1o; zzEBbCW$PH4L^=3@Bzgf+f-0p}eB8T)Hf4aMNq313jC#7;?c*R6J^mBC|KwL+z5HwB zU)|sR;pW1OkNSWG>U>KOEHM_>O$zGC3RL*))Z&_b&+<@ez}I;)4h9Iin!G#smh-ge zPrv!{nkIg(&( zA633nWw~5zO!8%yN{OE1s_q#{h~VC+p)HC^W${xw2*!@a{6nzctn)tJrYA~Zm=e;7 zd+6JzG@~8?8)P9v56SI;(jx^r2oXODoGox>2Y+#JR`6)RFIT%C-(QN?`Zi~%i%FqDiewgq{&LDG-wARav&@tQZ6?hdz5Rwt*m zo=qGsRU_eW{to=2){(lnZmT5eCSRq!rAKGH6oArE)vrUrzW??8n}4}`xFbcJ@1Li7 zbO7rlAP(4yRo<0)CC;#lAc+uJutMX_=#iu$tvau1s_jZWdh`28xSxIU>Ho3>@k7M_ zThhZ1;r=g44vO}FQ)>82yq6P0b{T%&;Ul>hIFj$J8yO-~j{!OH#8aZgazXkMBPc+i zo|lQHhTINz6C4Qje@|LC!LpC`Cx5&-+w0~jr-U|dSaQI8Vp>ROLw-T`>ng&(7Kgm z52=nt&ir&&3H0Co{QBlkk1VLhi{%w7ec$b5+~K5CDHOkcOQp*fQU)p6H*d*i znpuQvJP+*tEY3^o2^aJ75{G$aNL()RK#*^^NeRM`h;mB3E;Z`vY&P(l`&tV*%dwNRDO2`+|Tc{KEQytV+q6KCXskD&&C}5oAva3aArUqQ5k-cJ^)D@}V zEAsoV67Y}z>G_^{iGid5lJT;Vw;|ZlC;3;y2m9nq=WJHNXkHFcp;XNe_n6Hb&t;V# z;$$^ne0M(QdaoB$dF=2%x@nXd(BjmcaAgIqSNNIiE~GQ^#D`t7TL9pXlILcP_z%e?j4Eq?#CMe||A%&9<&+bVU3M}h9U`}2YUu|u<(1PyvLQj~UTO^$N>4b^NS zYz2T=<(pUfX=QJdIHW%7cgy` z64|ziuf9N5Adz5oL!*8*_Qur$eY0-gpFcswQ>>pFD`V-@I|(ukeM*(KOr>+F1(eb{ z6+Ko>#ad|2p6W67*Go$89?mu%5tSExB_6Zop`;dG7?V0WCRoqPvb@$chTI7Eu2O!r z)mrH8>et~Ye~Izp3DOv~HJo6dI6R!By>ySQ93MeV9Y(?rq36WZSvwOm}{u{4P+H6YJV|hE_G#b&{9^F$w^XWd(~+DkO2B(O-21J$XIhAVQ}uQ2I>A1>US@` z{NnuN5yVaBcWVH}P%xclUE>%UZca`E6jRuEa zrm<#IQw4lzD4jrZvC?^7lzJbi1A}T=8efpDC?Fp@eHR4+TloPSC97P!+de6AS7Us++(^?N!K+tke-;FCCCmW z*cK4o)AZ_4*stJpI(tK$oRKts0d*GWg-yXNjOAJ#-M7_mGN~- zi(bzfdl_{~vaM5`G797{9(ALBJj|PS;(2fS>kCsUZq}Z2uPaeY`G3~z9LZGBX3#yr z4=iZ;d8!0`YbAZzK{-w^)OA!|;L%9Gx?f-2-)So4{4=4cJr>QvLy)a2X{+@tn(gg0 z&WEaTM4*Z<8rgP5rl4!aER7Lx%u(s-M??MkQnn%;S)g%fq)t(g5E3LxddVPvzOk*Q zQuQHBwuAwB(M>DKc94?Y)d>FAk6lDWsl=Eb>njO#<#O>CG*%v?a~j0 zdAaZp=d4K~)DU&GpHg+;5v#Gi9^|Lm05B4NgcrIwl48~FQmp$qib|BD4FCxIv zt2o^+ddo+ZRtU+{sFej?CDSnZWK^HsiTYKri7Z0Z5IM~CD%01OE+T@D+b;HKo}*?X zLC9o0;56#)Mz4J=VXF{PLj@>J4vb3raDDllUF#y^>qjpl znq2LR6{Ko4iv4ucQ{nqs*SQcsMfuo8L>Rey0FWb-^GVfzTjuFMgX6z!w?i%@Q)*y# zpHSZLYb>`(vG%BW%Yi^IUPNSX<+Dlt4w{JvT`a)U(qx%+u}rJ#2xXBp?MVeGOZ-{c z)-R1}TrJ8A7ZI}SCVi76-CTx)yg|!*gp-apvFlBDak#-oETp$GVXUR_E9?BQ*Q-O1 zT|{)wZx}5}&b`_-gXCSCtRm!vV}dcIy8_bazPiHx=#t}!gMR`fnAgIcU%$V7xOsEF zH)$upuja8f{M}8Hfa+mMpsv}IXF7at1g}RDsGY#w2KPnwLxo;n<=u`bFORavDXkTs zf$Kvak8q^cLF|UVpS;AA;hjVyw~$e%qYU&wU8&wB(_tpDfc)Jb=9`|2Yx z`j_iLzdm20_+#rPBLR`*%GaivJa?Cxi%Tr#Nl$_ZmlVo5WMEaBv*e{hvg3KT&_9d! zhaSMc9JTuk9Y3T2VLWMk_z62Qtx;%o`M}ZAHGf!yntB1nW@=c}fT~TJpY|<1FU$UN z)SvzO0gFBSiIqWZ!IJ;h%@E z&d2@T$2YG&yFG7`M0!ZJPZ^m)sj9B79OPv!*|=GFOO62~IG2<91<}P|x>qBA%xun@BC;TdQk{+;)(k)?3Pia5u zTl4pXufY3-0#g@=w^w;wgxc86MU%(5&Lu4X2!k53HjAt|QA&XZF2<)RA6`K8f zBL9!~>wIHSVdX;IhAkb3A1&{g`A63vh{-2!bkOZILhLMQpH5mfpQ+vcBr z{PI7}&R540eGmkaGH%~V#c`<7CRL7Ql>)#X$*hs8UhsxmP^}D#EyT+vo7T^l zNxdrQ`4|o%AL5nNdrlRc@@{Y)m=9xv%v*Bckms3X)4?n~CZk^Te_YsSy9vRR97mQh z&a$SwjRreGq9JX|mTx$j7Vl<)Sg3}@6G8|a$os z8m^Zb>NiR9nsHz1r=O;85JuU9WY$|95_ZcrTipbV2;0sQjCOO5V1v9z+mxEvmeGNI z=Kbl<;{0F(@!Rvt3Sc3fAbU!l>6I-#NYgNaBbUFY z%hHej?TgbB?&o)HUXaWf2hZgQ^8XN-J`K$4SqWGy3ds3lU+gE7;$kSzy%%k(hBa$rmSHI(1I z`234?`~EjK=UZ?96QL(1FSfAm4#>HE&fsTB&_fCySx~aHWRvP8&62Wn)|;x~s3Sf{ z{}au4{hRgr?YcjI<1Xm~(v)T6usvEhb@^wqtS15ZC8692`jlRKlICNv5_FF~M~RRf zsK&3_oAu!%z4~&0d)~pBpVa_Z$da5Sv&WDt$l`dfy#S8-5^9qSp_<@Nvh2RpQ+Fas z)*jIw{YxbO($3$X*0ssfb#x;gs@BbpZZ7(Grm(8(9xMo>u9zk7*7tKF5RB*VH%%VCW z^4_aSk!`5ewA*H^ZU{KtI>jlgMhL?BKWWAAV>eIop>bNkza~ zo&kba6UV$ue!#X-Bw!yk<{*8nNFZt=2Y-Yqm3>lAIwG%sDXQ;IUhC)I=1q0h%HSvu zeZ5GsnVnS{)y%*)W8=?G@FB?LMNWto)UkF7vW9qOY%f6<=ZSp|g$+`d&Jzd`1S8c< zBiPHD!7kzeUIv>tdunQAtgr#3U#Wl39jNE0;NIN48-I!Jx1W9T&3zlcztCkR$D<8% zH{R&jk6t0e@}Y+|Gz%4;Q(E7A(h6p;x#tGgoThG&Wj;WHe-hN!?RMV1dGY-k=an*z zI(+?XHj@>n+|jGIp-aI%r@Ty-5@6(Wc>$rct>p1Z+({;q>xfe3DWu!Ghnsyf+9^{i zwqL!zpbd#IC1@*=L^XGi#_RS}4SAZ9v8$Sd_58j#lx9c=`~c|q<*2@3 zW3^Wcw0QnDG*US0-ZGgEY4o%?jq(xULpgR)GG1zMVaNrL^x!;o&uFM3&*N$0Tx2gF z+Ih=^))w5Z!Gk8p%#l^qVoZ7697QiIAb7yHW~0kLc~W#jr9yk^wmaf(^6LGKf_d@& z{zBWEb!;Yi;zqUJvocdM9;uWWQ}(^eY*=cLw$)^c#B<m#lch&;)`u`YyM0*q zQpNhA#r1p^H5~b!y)0R&IAnquIwYgV4OF#i8kcFG9VaWDykSPA%hIi~NdCy>$&N~ga?naE3^I;$ zy-rZV;#ce_=@A7ZId(Y!4*sdsZjS}>mgM(NU5#(D>j8UMn&y4Wj)}PN`J5-Ln;Uk%xT#Y%y zV95=vAqP+MPO8UFcGBeYFpH5!E2*_f26Y~}2Dup8BMTSX_9=}C?gS4s4q8-8i70FV zwXeRN1_$(dJm8pVZZc`|{B!;Vf5cMdf1>*@Qza|cF~_oHTS>2Gm=KncABC?6%gir^^_#o*=ifnvi456$1|#LPlpx<6N}xfN z_mE#rqLIU8He2GCUY;afW2w&Vd58|5i|cD4nDZTfF{*t(YSd)GVyw@Dj5eoyE8|e( z2S`FDea%_NUJG4_Ve47fQK+61*m@_#@Wof>lg8lB?Ucb9Dq!X0)nc31T@&!h)wVbW zv9h4Td)wGdxz>xEKK42Sj30^Z<=NO0`)k|kyD`bii`MFuH~{0w_Zo|-)F+8F?`3v# zzIw@m%KhESJ>p3T?PsyQe7nX&yHF-K&`%AqU9KSf(aFe+aA~4gBlo)Vmfkc8x5II^ z>0O4-YNCuVpt}nuzA4e!LodEXL3QZnFN;`&$JR(RQFkv;eg}ltWbdhlAj5(t6!rWq~AXdOkMpyUAgnb4rWWn zvfb5_CuCEfG8r~6Sc*B_y$Y?T;p%=2??sXO%3IZm??^N7^-yLbg@bxXuAw)&+x+kE=##Hfdovu|0lQtR@nX{l~dl=Drt3$?Tsm$YJlpGKxz z!+{7>IqCP22h(uPA90ELn+R`C*2F&v^5&vjv3FimBz*ynItRv%JiJYFBo9ts&}a=h zn;~^vDqTr-+d>88boW%p-*c$X#`vq(uWuSf?>zRC@ptkj?>6+7-P?-0+nu9sEWHL` zq&Hle%`#P%w?q$WID&u=d&GwCc(7mG&9fg~?ITkIPDR=We9OqnfpjQzoU01v3-X2T zJ+iEz`lNdn*|Mq6cpcGTIv%GI(S>LEWwRsJ>C{-1n%TaFlgIbcGi&n}$UuRX@z5r_ z&$9eUq{DX&Mn3I=o(+&J4Z+RZGf zTKty$>>`jhwlVn%*NgDu*LUOh7lEUV8f?sZ{^&+pYZE-3TMl#8J~bHCnk8%IDqSWo z17U%mS-`qT575V<6^VPciicu|X6(!2n0*T!Bs_b$NkNbpp2>5W4TZM03&=uhH& zmqUGV_xkSqVG0`9tH6mkmaIDj9QDcs;&8c4-+XeqW!97UWO*GGUDBMgV)C^-i347a z^Iz`T>#y$K{`RaVpbVQLKvU~vqO^E&?rc^Ilc_#UfI7&?SSlqe%W(^Cc4F;NY!{9= zoINGf^Bl2x#bhmqh1H5m`VQh)A|c6IAW}P>S3i>nyXUnvpuM|#Bs>uBdSU7={n9Ma z&TuaiWm`x3jLjw^Whfmk4oh2$jM_sG@o2g`?*?#6J^-Nn9VzNz-QTyHpXB?mzxbE4 zbrY5fl8k9YA8JpMJ=c4u_oDk0|6Vc}0M4k^63P|7R~CWWXjbxwKL3IEzWMOC&NAAy zWjq+Tjl%n5-P4m*%2M=5`)E_k3FI>R~&wpJr ztvH+4=>fhFMm}|bcn8-t(l)5t&sO<;=vAChYdbR7_JmOXu< zvVqyv)oyy#gRdOedmk=AM`zoRkqAHXoI7gP5v`EpvA$fd*J=9o?84S2_h07?nN)=l z+&&l3)MaUy7w1SoH&D8>TxOgf07-liy92v%Qhy zQ%&-Fwxj!1LB~=F84|8EUOMc_sL|v)(f#T{Z6p^!3 z<%aAF2Ni%)UmB!YbENTf<<;Yn{?-G5K5~KC{K+BG8s|cCt0Z0b#+FJR>Zc%lxTkaj zTX32bresPi%rD!h_kUN({DmOZ&;6lM=i-Wb$Zm0JA6j-eN>25X-C52_xJ3HpU=L$8 z_cy4i(Wa0Bsg`{(Mm{37bR^gl^Ej_{P;DY*dTV6_IY1!IMjc?8==?xPic z6l$1X%N*?uc`V4w){bz>J-j>$CI@N7#e(hLr-W-Dmc?z|D9n(3O(cDel3@RAVJinc z?IGuUjG{y5o1#X5?4$-0mwb+9WLJ|y73{rB;NL=lJx5-w`J_Z`9cgLo8na{ppA_Pc zF1`5Wi}vPiyLoj!OD0b8G}cExvrU_vE=fuUMK8(J4LZ-phcIjAsH8555Sc88S$1Kc zULmyeeK#({&K=2{KQ}Gu+fT{-R;Np0PK~A&3BIb))pLqD%Iv*vIP29Pv6nv|+r4b5 z&SM`nM@}};Vj(=_(6y{u0~@Q7^Xn~pQ2E&XG_3)t97Y19ai4~jo`xrW8ri4!_ZMD- z<$0SV&Kg4W%abQegXVB3<#KN|)v{*QsDhQ(h}0&tv>u9$o89+}xGvrEgZDU-Csm9> z`3KupzLP&04A+{;e5Mx8XWN|OUWb{mTce@4tcQrF9nrrH>%wf5nyHGa>~_w`2}Er` z&^$g~YI@<^t`yR)8!JXluWJ|w++`qw0~YqI$a+8DCfHZ(V)}cL40Itak7nJI#Y}GV zYLX95H~2eN5bTn>$?hDELC!v+gmX5oO8|#Jc)#;fd>d*&FuGiXJ^AT0%GhU=XP`+o zP(^d52s8;sEwAoeeugCd*j3llF#pfPdZcNvHIqWFS>ldaMi`_3@2Z8_xe!g*p^fG= zW=_&)V+9RryDTl^Aa}m!#HQZ;w-;|kfg7{7TI$GcK#4TNn7nM(z@EvpB%8&$r<28t zV6$c6iW(ANdo3Mll0O&SBb{f3gs{xY(s2i1O4xT-C5a6?&PG&}gOPi!Kowa4!0`a6 zo%O4M#P^KIPDYUDS(_D(h|z-?DynJT7#NT(R8~#g07d%N^hWDX zeE0onWFICT*mLKHXF(H67^|7cR!e&{DpOD+1ck}LbV}7UrN(_$SAFoXWC(q*rnjeE z(fm?umoMRac9s8Tij%a&iYl~KM6;Jl&V4+*@7wJ> zwafp8U!3m-53nrnOlul2PF)r!Z1*sh^GQQ%e!{SO(~~%nP?n%O%6C}?LI?KNPr`V? zHh;K(e_2~f-Okx+))oYo0AcU~n~c-VpNdZJ?6j`S=@loy+zkkV90qN;jm~YP@O243dHjIR`s;-OBCJsm}t?T-0Y_wq)v_x_2J$0IXtKeHnjh4cpX{ zD1EWfwq|%l7MB1TR0p%6}TqrG`2q3o}=tt!3J2x4O}yx(!+h zvV8X>>{>f8Ia6Gk*sZQHg2rWKZ}r4jE_Uo|=*5l-NLL$9=XA@5D6NwiiX@_%D7GLF%d>U?VYd-vk*^&^*hUGFrLbFOj*-l%cty#^TKgCwDw8cfue(|yRc zr6`k5iG{+ho9zcKdHx#Fx9xs?BJGcx{{B)(au1@?o3V3|xlAxaMp-kKsKIX-^{L;A zl23uFhUk`P3~AitY>y~Het)_FIjxd@^{e|gclY1k-T(gG_jl*-Zs4EOK;R5y)CAbD zTF{CV{HS0F~$x(gW?lnqy!KsIGJ!K@I(eJ<)DH=0z zNv<8rgAVXv?Ib0@5r*iWd_HIMs`N*sXMYyZfz2dAB53X;Gx`BLF|fQUsV5tj24a#Z zGdoK|&eem9OfayOsT>X@esV~k-JXp_a|*iJu$%2%rFj}Ud4Lb7mwy{Id{uRUL}l+3 zwj$qFT^7MS<4i}6{ZC^#bu*s54GN(qs?<>H!SrTMsfO+o6PF*19fpIpors-!1s#A} zYC=(${?c}MayT!?_jh+^+bScZr|iUL%~4IylP^N9acyW?Vz%Y8yd6@}!!7W-#~^Pd z^`Nlj$B_j6vv8;uXRq_*kX|>WJB7YEk}jEu!04!G>{)m*_ z&jR}P?rx6v4-Xf*el+c}MsI#rwR#0Bj}wrhx=zci*|h%Q6`kUt%^jw%fyJbfuyXO~ zi*!C47HNg0P?uT`!4g4+%c0~hvuN9A4?Ax@l;hCHURkHE-io#RVly3J*?;Z8{cyK> zvCP*5*IT&(a9Wip#{~BUQ+g5(%$liejx9X)qMRl{#tf$Bm_dQ|fz$QVU@jWf+h&`g zluz~D#uPI+l#QKq0|81*vq)GK9MUAV3m`O-{xPm;->1&ObnA;&=j zq(HwQZB#FHdGmiuJGU*piepRP@0aO3A1<*m*t?C<0BrA@9(&}`)UZ&|B?)g|^t<;r zS79V1{Y$H4h7F}s!5>;HGh)unh&jEa^J5?>`c-rFUM_SY>kdj!RdgYwHSgLn zWBz*H-P8z)V(&cqEkoF2=AF$eKTt`e6fbXv?YpG>!HlxPp6X^*HyDLvUzxo7C62H3 z#p#-n%SN)v8Xs+-K7pW{`o^s#|946QD3Ax0yCxNNPibT?Wm7PwivT?(nAb1w#!V_= z)&82I@x_*vNW(FkRA5?QhOJPHCZM1d?ENZc+@nU6^U$KYqQCY_9FO-W-`>BzP1Jc2 z;1xrD+r^mQQfRA;X_5-i~jgIgJA@Qu1DPgwa-0ez9Y0b84*!(M{ek#y!U z%HCMa>MjhXYQObMb~^9J^O4@{EXhaN=f$H2~{-?R-Ov;N>NhgYCCL-VTeru!Wu}(ydDc#XXTFN=aGVTo>WL!^9Y)e z_IbtdX)%37{U-)q+nOa+wT*dySouXGFEe$hjA+d1zG&oAM0T@sD^R2COCZD7pI09Al(!%~F8lc4K%i@vn6{&a0 zvP>Q|a}Fc5;h?_b&QnmabUYVeItz@f0ERD_J+SN*&Bb2_b8ZijppCPcq014kx&ZR- za1{zCJQ(OuA(RjZCp%EJnv=1la_Wj&c&|XL_k%g{p@hD{92b>g*DA;O9LRl?C*Z{1 zvK1do{)9Q#7!UsssAq3rQ#WA|Pup9>bE4!Kr9MOX8NzRJTqnJXfbdoI}Cib(g!?Ts=vKi9QVj)*!<+tvt z&E3k9>k9b071pzd_0vg9a$=*ggB+VWZFc_5MM4j=Q`=0Zx&wX4(O^_**l3`~2iDfs z&1$+d9d$D@`1y<39&TbXIce1~b*fATGDI>P$%$>%b+PXn6wv1BXA&MGI*e|-8PI*)@or3N5A8_=41(y1w&b7bxKI@+pY zeNzV>Qa1RMSU!9B;h)d$U*73N?xd96N-3BL0r-AdQ`;ocAJ=YGQ5Fo1Nmh8j?Y?W}pwM~pF1%Y3N04;yvy*wnrZ1k~-_I}ZPR@Q>k{P@_?@ByGGkc$*?%?Ipx3%%2A=y*<*Kuud zIH*7qNm)?UPkK;CP#4zMhN62rRA&Q`#vu?)A=<<{g z7a9cL4~hi;{PpSDs$nE3hd``U*Jp`Dmov;j*N7Bi{vqweTx6|5snpOUj0)JP8gQX7 zzaP~ze)o&J7pFqZWAM)8@Xg=KX05@x0pZ3tstkmaB+B>IhOSW#8;eF0#*(Dzu2;Io z-U{pM*RP(Rh-o*tneLkSJTi8ZpGz9-`?^MMI=T-gY+rQ2pwgrEUiH)(-OW?HFJRuc zVtID|{GW%1(%rs!SjEb=jmo^>{gceVTGnOHo*G{T@2Vdlz;Shxs9p=87vy+?lS43< zByC@;SI7HWuReSI>ia*xc)7;w+h^r#gczDPvSEQiLRW$hB(1XLo+VNGt#jZVYyeF0 zq`GDv$)>jIsa`0^Z{qpw^Scvgc1Q8eru#W;fRDuJJj|poqfXnT6JK6j9stX&NsF$L zuTfGs44P-W@~Ym6$UAO}NoPe`pg z(6A)fFA&PNB2tIRZ6Yb(8z_>A{AYtFy->i&GV*|*0Q3%{P4e-Po}WOI1j%Aa3#1-X zdeXD`d`*c~uKDeH_~~{x2bp9C$@)z>XcYN^M91pMrN&aq!DvC}MuN9MxJZ5mNfjR< zbd`$tl#t}^@!dmv@p9jeha?yC7J;tnzFUXhFhJK!$AjvS=9<0uv0H9=WzD-*8F=cf ziR|>GZS_&@Y7Nw7d9x+bexRHheMVXojx?;%q$l`{b+UX|Rdi+#IT-0I(q3_xd=twz z_xC^Co31VJOEp%fL^5&L z31{}DNtnsy$_{sCLDZU5=Vp?Vy80Nju!G4BlFdd8SL)@v(cF(Sv;!vA9R(S-r7Vmk z;a92gtymL4RhD^y+{v0xsNTQYXU0->d3%RE!Mdic2#Hf z+KARCG{K%N>)nU`r1yML<{{OJ)rQ+LAcHdj)fdP#JTr17P_q!a2k;D$VBbbd8p z9XeMpliKQi?z-)DzJ*<{cp<)t=k(x;$L-a#8pmN_tycJ1)KF@6*|66Td5J|=l^}Tm zXkFRODd$eFxAv4k{`~n(`8XZi@7mZqax$eF0g8((#hi9?ubmV$MhiwCP13cx=xx0S z^aX!KKJiy!ob9G0AM9yTNK3s%Yw$W;b;d#LVen&uG?fi`FmW%JrW+BwW4F;gL%2en z-wx$tE0-6<&K=Q{;^ivrS&=i@uz3Ly`qgU9Zny$q*Q=DnW?;Pl0LP5(%Kg`yaQ<=s z@b}Y`MaZyZH*=9m-IO_FHUtK}n}_|FpjQl(DbgT}kaP&uXU%kZ50kT>8q5hv;135c zvTExGbsA$NzC{g+R(kkuOVE7D2&CHWHNv>TV@Vnn9_V~U)K8&&|LWCovGM!wzI%3# zJ{KvUEK8EDeFb)INbrE*+sZwUG6tz{4SRU6SC`0lZM4*<0nMj;#mnZy@tiGXjiteV zmnEO5e{gI1mHaAWl-`fhRCN**nqjeMRa3o!cWOC=7+%~}@5l79H4UY8aRD5tQJ@wI zIMtI#Qp~PsL-(p7`L4v=OxZRmL&}Z;-bK70k4sO}79KR`9a4wBYt}D;#c1)jr`>H+s>Gq*#=rzF)Aakk&ZAj2r zLZ4D*)C}K9c85_yC`R{tI>O>ZMFS+1JUJp}K-~q62 zS!|B&+GL;svoKWpB$WdvQ2+0Q_07qM*Xq;i#3F!JD|OcdB?PGIg5bosr2xblOv4?* zX&_lJOQ~>1RiSwS!~VD)_VfEArq9<;&-m4ecYxbRUp;U=%YYa7C8Y;S?;$kgni{o} z#?@D&6ib2L_%sh6wj#HzPYg%%$v4mMtQ2shhG`cZ0)(W2-VkPEi>_ntrmF{TvN1J} zY=)fe0RpqjDdtl{I`{4fkYe9i+bxb!wy`V`BlVs`Q#q^_0dl%Saz3%RXVj6^mIE+V z&|g~R9}McuTfrNs#I`Z;D4@%IDis;3PJsgfUUp$=nbFk#SA8jRSu1UIpg$`wUtrN6 zjOi3kmL;2qL8>l><+MY$PQCX@hImOLcHJ5lny!U`+fZ2_)r~P{i@{$xE_;vx_Mv0* z&GFUEyp(n43qtA8d2e(Y4lkmbkSc+4ekpT%sJt-08a4D{WlOqsZ++#W=-o&@d;LGR zPZ4|esZFb6#2sn`hw$o1=3s78krcu`d9nCfNl7qQmYWA#24GFRvZmh+=C}7RUOn9I zw{0LJmz;N92AeaqPWD!22B;M2HUsU4Mlm38smPHgWFV!p)!D^QKRuw&SATu`#8(3> zE5%mj+@r24@4aNYTw%K}cD`pZH%Vs12}6ikNj(W7P<;G_OOAKL(V55D3rnCgn2ureW7Pj?$kpjK1tRftf5Vzb`2ty&KT8lkVu8mn=XewZyZpd&qv2 zlC%9e+2Rk7z9U=#A`$ZG__cU;y1KN+R7mxdLQ9*7T&l z;ARIE#M@fOr=;(t81&a_T+;nQfP9fFzj1HnCK@ zc#!00ww#RbpB~Pi|8TRwy9!=Rb@c9)RGe*vH&Y~Ie;h*_P$c-RR-R!w)OKr|5NtcP zyVO|!@YoLh>|`9wrPS(3Eyz`_k@-osTTf_o0&%kBsokr+3L-QP4C18#F*FQRu5>H@ z9K<*4<)abM?MXSdj>h}Dl<8Z~YSPqkbLbj=81l4?KvxIJom=NX0kWGZ3awxCX?PRL z@BT+7C1QjFGwET8IH<7q)WLL(Wno165lmO49O{}&nt-o*07 z{fXzDlB^sF4>RtPG&h(*$6Z3r-NdC!ltck{klF2>k>1xF)X>qF{9K+Kh}yDmUrGkA zVRQD5x}^H_l4&&E14Vtz{2rxJ0=RQa#9^5rlkq;Oma$&4NqZB_c@Mt{$+LCgDxj;T zB_VMSNRBr!RwLgyaE`{CVh>v)hEi} zek_KNid%IX2t;X7ak>fV;#+n*$Y16Kx(PNeR~jeZ1oXexKfieW;`W}_t(tnKBoS|# zgei2pR63<0Hwy}u#TLJtHg7I%Xg)k~>3d_@-o$xf!2C@dI`%%%`D#nt2;vsiECpI3?aLy|X+0;wWV5k9^*Iww5UQ|fe#L@YL#gU8>E$1oGp<-N`eNHM=!35zJN>Z0eo2qP`7ckV6T8O5I<3jo8=Rs^*e6 z=sTJn^LkRE`#F@;yc=PKB#=Xfp%hb%%j9<7`q(l>(a{JfWo{$0p22S4)oQvs)J^Sv z(uV$S{m+TE<0$%18=ct_lgaV8z;bJCor8c{R?FM8ai}n`hpU^cEvYHj%}aYyAkytS zxy08@5-5Qx1Z>j@AZX1sjb%;)-1l7CAEBG>KukN;=6t2?>`fr|uODt}(OG43bvUn;*GkgGNNd?Ndx(v991R8BQWY9@fwP#kVi?r|w@vmN_Z3P*X2vFK5+Swd^5I4z4q5vaBYpVypZNsH|QR zDe;Q6{6_*in{c8Ulr|DL!b_Pr4?>a#*wAW^a{;p=v`;->iQkKA2;WBSgYu~~pY}%o z(w^T<^*}s2qur)>*{AKSYL;B>Sp3ixGsx3^B`Qj(GBbxuP0h4R!jB~>!Ckpiqzky` z1F@ala`j2J1RzVeo4q+w0S2)fjE249A@KpV43(UrGYch52{f!x_Zs_(ZPth5`RpTF zLy*tJlaY&QK4zYz-I)gUG&qg+0H+&|Oir`|pzi{CWwfe3Hcxf?)Ued1cK>|Ic~Yt% zHxUU@0g99?%_u7FRaVnhGTBmTC=xA9vY5y^;{ZVG8k(|G`7fAsA*Fseyx;wFhVLbD z9Tk@ZGo_WFIZ$7CV_PQ`!CUH41QLzoz|PmBSHkgc14yHts`kolVi&sXC0hSaWTS$#MxiSC?mv);F`cF-DM z-j7|>!%m%)C;`h~5~6a!oC&a7Dv!^kB;V)_?)RU(!p;qIgSw03*czn!!ndGQ|Zr_u-(IFkouOsTeAdVf$wqBuaraSs3EkKg|Mt=oBPP^^J9g|$89OAmNy$*O6H zN7dtmpbgTLali>bla=ygZ)`!Z`V}sF64bMH+iJM4YPuZDA`^(5#uS)<#}OYW3miA7_pEEu zV31F*bPc^7(N~9d{CPxbJOq@Iq@>jB3_%RFBPpj%Ld#s1NKid#Y?!G`x{ue6rD9nfFzUd;P{kQ&<$ zw-Jg_x#BMemC@K{vL=G>lnpC6z)|>zq|npWAZM-eF*JZ>9qyPbE;nyEGJNyZm#1~j z**aLGy9_CGjI}qg*KAz}>H-d$V&(Z9%mgy&;O+RCRMk=CC~Qv)1~_^D!&mLck4}cc zm$Ia{j>|v`rcH->Ml-26%Zs!fw#AREkcI?r6A{Y>0mv?+kf%MPkKCimo{=}!`Ex^0 zmJV$qTzx1PS#Tt1R}d+X#ob{FqceRkAC|)!{z5T(KbFtekDBQ_IpB#!*wE|@*_>%g zUQ^=IT~6I8K;RT8JV0UyffWX@)X8Z!n^ksURlgsT`nXO`5XK_EO=x!?#e@yNBSTM~ z5>L(KIAy>a2(KG&ka+Byt$_q|uC!jj70bGi0g;vO# z(+w#tr3NDLQsJvpY``_A(O|iC^$P^${g6KD&myhsDl~f_9}CEaBTe4X%!g_%B+5-2 z4y}al)IA|}N%FV^o%@v@iuZ#$h1=?n&OpYMmJ~O28RX(7K9H<6B+R9zRKX@m-L)dE z^@LYW4kqPE!)3JFYdy>bxXf$CxlTG|5g%t}UGc22a=dCPZmPH4BF(1=)D0 zXnoRa`)hmtcWCbm-rddTWTO7~^2oHAf}!()F|x9z#CwV{Qa|=_>E4PL1&E3<-)rUS;OhN^$t<{ERQzkh*W{d012TB)vzQA`4Dtqj9J$#kr?GoWI#C__Dxp4UHo%m>$nk9kdx~H-ZWNXMZ z%~ol%dzlh6QC2^qk|anHutH4k!cpmCMD6h?@?ViXo=kq$1=x<{c=OGX@+cjU)F6W- zm!x-Oij_)p(n;HKE9l8JmbaK=&Yk_gLkYT@Y?l|(2jlxfZg{unA{Q@5%BiF2JjAkM zMjF|vk&`O#o7+0F*|OWtO+u>_4}rGr>b#=1eG=K1_kVct_3PULH+fRud1T;wp)ws# zZt8tq6D(9gl@bUYhxS%Kyv1Ns6*$mR%i&5N{z+`#zPfEzK5Y)GN=_iG7L3VK@&bD_ z8N?;HRCmzcB;Sy{Y+_GV3sovp9nR^Be)4Hx>tyt|%w!gPG4_?EOspok-I_Bcvjsg5 zD)g{QG;U-bUK?pP?`N%2M7%Ole;V2S!w-*UY&R=$1yGt$)9}*ak(QiXi%XXj?WObj z5=7kF?sZ?k0w7{0?OaVmcDcS@xeB@w+izaq-5%fZp6ct?Hhfyu#DeZ-Jq3BjnY&t3 z9o$@ZdUnXk$*-Za7uW__*@g>b=0;SXujh9^oi!Ox9u7FYfMfzsjQplPY}Lsjo3H?E zX|=g-prn4an9R|{1M=`DTwi7H2X=RR3MB6}q_SsqHoj!NKE)5ZOKZ17{)6|IV{xv? zEtg!uR)9w6e1G%{N2@nudMR0|+l`7=U1hmVUA3DH;$#ypR=b*s)aOK9mHzM^Qfv;B ztPzVg$Zi3$@yT(0dH=h1n?{iJ%{1~%3tBD5-9?veiI*3Q1RqnG9xkzs?%L&fze7@C z^(*X8e_CJO|Nj2ux>)+tMtuil3L{Hv`FruTCJ=Jh{XtA6l&(pzt)qKtt5pZNuj=sl zH^QP$e*69XKYsuE#oul(d`%Uy@kdmrbVyK_sz#%1R1R%yDX=eDUIj`4LsSKuyxkzJ z?Z7`jIX;PZo`~|4NFvQrco>lk0d0q~hPbq{SKk%%*sKIjnhuZ@fCblmpALpdKqbfvx^2` z`z4(7uV_9p2H8Ol z9O$j*^8I@L{9MEn!rC-kLhESR1<)Y^w}2%jaBuN>*U z6Vhokz^GNAUqM}eRANm&)fCckNw<_My}C71s4CJ)A^Ys57v3yO>`H}s6V1_+@!j1I zw;?i&%gQg3l9u7CgLM?#QX?@5(ic;xdR5&@SrZIHx_HYE-54!9{FQ#BU&1+kETmv{ zJZfmg#Q{y-hSp~l)V7WBMcsQ?ZEQ=c{c1tNE5Q@k#2N_EQ8C+j1M037csOjvOIOKMqPo$Anp0z?jP=6egDJD|Mi=@7wzGnzhAfY%BS$OgPH(fNwRIh z*jl$R;wdp>-Jk9Oq=cf6UI9UY0_OTyIl%p{$Z?(o_2s%*)t!%u2f{(+mWI+IGY4I5 zz&pu{YB$^}6&s?QdkzCM#G-2Eke9#0&)Cy#`6lkX+mjkYKOVJ<$oR5M-@4JG80@aUGl1NBzb!bSE8i1Sv_NT zFR@90+OX=DF9a-&Nl9vu!7gvPUxy_m+aB(2A9o7C`Z`AjP~6i?o_U|jb4j&HecAJwgTcan-Pn}M0*_%bmtnP%W?#NP@ zffQv2xYF`NO*eQ@11IhAbjAPoF`~QsW3}HsUw`=eW~JlxOtmgq-HPW-4yV42!`NKs zz)vo!+0u}xf;P6pnJp$JBzG<>lfPm_i(Vx7)ZMRxd z)V`C*N16B2qOkzQbZD_n3J#nS2r;iT)BZY^XMg(g=3@axZx*k_nbK;YZ0LQZ76%D< zH+h}GG2{zrG=5e?1ZvM|26x`evo#58HMUo?gwDv&z&Z7eKMWuUi}`5^>g02m@v&W!MjP#k~%KmYOn{^S1xP)h>@6aWAK2mrN(C|xaxg-P8m z0RS?U1ppHO0047ub#h~6EplaJWodA9E^2dcZp^)1lVr(p9r(V#g2rcwh%fhu*f)ZN zXfTmn7(q#9T3ds8czDbdQC-!lss?5t(|_ON*&qQiqq;KhJX~Q0J^hh>^R|10`#BN* z@jw5szxa#4eAVymllNX z_Vr`)`S(wc&oXWPMlRoyLc&u*`{&3hrvBf*e(dYJ{pR`U(I5Br^2NUX_LuSLd474c zSN!h(i{JT+zxbb*AMt0Ol;{|i6XEF z{Os=^)Sh1LuZBJT)!PqmfBwRsp5N>@cS+o0lYjRYyvytt+3z0Sels4Q$8TQ0m*|fu zMY5)3W95~W46#A0Q|PkR7^TFamU~%$dc^C)9}JR2?N7h;y(D6PoLH)H)~aR77_u}% z`6=W`Jh)I;Gp<QerYj86Wl%AtS(-N3QZ)Cj)8Yu!dzCD8q?o(5 zT2jNGr+YQ8-#^`{`HjRmn$I)y=*(@A^tob4ScWz-v@Ua%8v7`fmRxB*@ovr67-B1H z6oWb?R0z)~YEh;zs~fq%C~OuKHtMs6YNc{tG0i4)x90y~_iFxH;vCJJq%=o^YP8qb zB;oS|lH5WL6`p3n1!*i-nuk#~nhzCwgvP7`uMve>ZK=yxy+z@vb&VKk1-u|fHr2jX zD=j4|IpWprUd_)hZ+B{bBXN@ENd~nJr_hH6!u~H4(b002FjqEX3KVO&_BM$(ngx0OAO2MzmYg8!cqn9 zNNi$UQi(EhAGv6xFeBD(g6evi^?J?IPV-aDEHd+mt80c^&j=l+teK*i6i$keVkHKN z5x?RD&)*81{?d@{_BQr<@0#C8oTK>w_nHh2Ib-cHVHMWmej1S$!FBdAsqnP1@isfn zhmr)bvna>BLYEaDU90g)%<$6H^Oct&e1%y z;-0)vo9kkNmMsmyz$&q&(io7$I_tH!iFJo<3{GlJC>Nfq)Eos*)mdW+HFx7qx$~MO zMZy1agLw!@v*SCclsxa&{L8%&b|Z0)=BZarJ(tiI*^nH1hS%XJP#S1Z3ad+y(yle% zb`f^KfIM3n3%EU3Feld1n$Q6kOnQ_<(5fwwA5DOZZOcjn*aXGz20UcagOG}buv&S2xd{O!G<*h&8a1fE@kEp zvOPx&pndRXUzu zI&lpQKr^ZKXvtcPguse@1uMWr75)u4=x#s%FQ4yS^BakCG~c3ANMS;BHGq2r*iI|u zsTATeQdyxxY1h~$^^N8M{ue-GQG*X*Th{QXJZA=%ngd@%ieIl4S`Uo~(4HtaK&U2} zC5?ME|J&z#{rpDaqzLOcFcz!u=h*kL!N+8v%2_}%GZuT$0=_e^HD7k#re=;qK$&Ps zh7mLVJAsz)luA+z?#EU%>0EeJL#R#!6Zq6!cqxrSCMglw^ zqk}cE1$Y_Y)7s$3r6RL>w+v zNhBfm%JfidsZ1JoC=UVf; z#q(|E0q7$5;sgi@?ivt8M&VYIDT6No&IDpV_>WGT@lh*-2Mn~*{hI&sdavfMCC<^j zR6t007sv%8@+cTNc7dm-q}(Tz-&fy~5GpTod$O0NWn6Gz5R z`t_RcJ3n7kQW&}Atkwe+LG;Xi1SEl5j$x4`1%S7@S{a(xTpEeGb^siLQ@dC5pYLT- z8;Nr?KT0fMIPTMR^aTbAW>YEUl}Hi!fJ9oQwz-FmJ3Qa47U?Vsw77!JMGHiY5<$bc zLDL3mweYs9!m~@%h)+!7JiBApyS>fp%e@hHBXJU{>>xJgyfcSDl!hhNRk3Cjj8kV# ztI61``BuY5^X#|TP^J2TbLv>o7HFi{;jqBiGz7s<;o_)I1Ds)UtBj=e;_B|kHm|?? z?Y)}6mN<#SuAEyC18b56P>En0z$OuOd0{<@t~}tnuTP1~{=}>^*MP;F!>EYRB_pN+ z%rjms6bVtr$Q3-6LeIeb3`7YC6pMmYh~9l0`1<>MPl-1YC!LtZo?@DS8IkHt5(daA zNWLSI6xnK+bs^|(nAA@5!dSw9ORT_@TK%ReBVq_3Bc&;`1bCcK7(Y`4;K=0nz!7F{ z_@aJygnj#RFNfVooTGUTl*uN-Y}F2(Bg(}Ru@M|kR&}E=OTNxM$aQympr*hn*hST( z1#JwMV%RhxwW&E9HN$36R)peKfL3*dnld58Pq*5=n*Z|Kdo{n2I7jn3wE(Y61j<9? zo2)rhEJ?VA7>#n41&B`9=Qb2}w}E(*)hSA*#(rD|2bTOYHU~0*Q=XpDBMQI?yxA%+ zO&uUp((?kaW&O71|MNfm<{$0tS1-?R&-(oMPxiZq*N5k)zj}DmcU6Cz$VunKvv}f> zHL%v&3Gt3Ah-U-w%qdPO&EwzmS7CiFutQ$m*l6q(@1*m;xgl-8y ztc*a5IK8spvQJu#N|6s$f2+R#&r)&$Ko?tB%pfulNaRO~3qVA$Dysp?!0*;;!kTv2 z-6|HWPHDj6c((@h3BOVitk(cIpOjjaG*gQmAsX;B!KSs(;CUqAwjV0_pY4aYU;gdu zM>>AzV<%xnKt!PO%4LEo#sxJi{=!LDY6A}n3U~pWeWl_a0&g>zCUBofTGfvqOB!=^ z8xxB*7S1W*aWzH+*1`ZtVxC%tMGh3H#^IxL_x~)uMqMA@*7Ca_J1IX8Onj`mibukV zA4l(Sv2dMv#u^a`XR1P*yA6t4U`W!y`QhN<85%{(m)uAN>nVL@&@T3)#b&@netoEZ zQnOkgh?-zX{B0%w{V)IK7ytO{UwktxzVn&0E~+JFn`zGFc^Q72))e5c#R;tw0@!L1 zn%_8MN;}E}DAN`ojCKX=)@&;T&nE+|1d|8CGpyS#*dajPSj#+=@W4>g#epA2y zz{RU zD-E7KhLU4mps@=O2QaV=%40+tlcbNC2v3EFS~G?)f+qNr@)5)L%zQZCzj=OoeSWmR z`Yf;SD*W3YJxAGz0Sb~j90;qoHXA86_KXFchw zgEPE&xg^>-91p`bnM=&MC;TR$(aP>aZsIg(8Ckg?srBvTiBXSH0_&a?7 z`u?cIzmre)*PlP%qVIP;dXlme{_4<#Ujml|VqJ+RkCkdO2phuOYGHHzjE~3N#Y6|> zYk5guDHd`Mu1YW(whnw(z}69bizP&fl0hR2AzXr67WlJ8?Y0H}_s`$mqUp`YPP%q0 z3#@r1utXq)RJ)&ESO=l28N1s|YpWpYS6Yr(vAd)2;JmM!6LI$v(Q_67Mm$v%(7hQr zQjJ*0U5o+%Oa~8DNuJT9LHY;iua8bZ{4Lv z1Bt{5L$VlnDdJ(##1%i}AkeIqw(#0><_Ze{6wWaOZl+t(SxW!l(EE>S{PmBoZ}#aH zh3`Lk5(vZ^^joxrhYUhEtODjZlMr^c7qCdT+3R)E3Y_xJks!!HX)CbwK5BEPtTe2| zaVaQ*W9ejGXKJdG66oUy))5%|Z?Vz`nOd$ud2k*6^)Elv^m`vXX;Fjw)!>y|932%{ z2A9snz$PFm748-uMkHM?>O_49L)xU)LR(>g9U4>{WENq@u0eR{WqPiPuD%dB0aiTw zlnKb*F08(OaKQKH3jFJrPe1d_iu}xbhDr}$2JhzJV6r#BwIoJq6Rl$ zP@C7?4TQGqz!`JfG0doo{Z0n}B^ohh!H$7~JM1D}Lk1@TEFL6;9HkOAfdP9be5ua# z(J|})rp~uF(cgaT(Leb7Nr1(3R6zd#;r!;yR)s2hZ-GHN%Nn7T2;_LZ`VoA09=$L4 zW$;FDoRR%Hv}Nu9<^*4(F?mKD^(aa3UK~=>%3xlIrZ&0Oa06cXS2h04!`qL)dX%Rp zd%0Ql-;g=U%fmB(gbNgtr(gCuW@fhnz@vk?UfWu>IrRoH+9u?tNF%p~jROnRnQQ@? zgZ-!gB>}OA6*JAQwS(}pGogw<34zpNDIX-E|G6&z)|Ow9{p$JlmH)oTNlvE)EPEml z!NsKpGnuY=l~8Mx<#j+@HU$7!y4y6lnz3#C(xNyCq8T#9l0$8t8PkCwfi6pr5oD7n zO7R~nt!gyc;ri{`|4$G0IB(bd{^Mtzw7?Hj@S=4CfQc#{sGK{^3F^{k1!wHEyF|`? zd%OiOTB7*PO$Ho=FB5opj(LPSykeRWBVfp`gUDLT)+T;hTOY;KD{fc%-x(Z-Jl?GJ zcRqho*2IjK{6+%!FM>{T<5f$Eb%6g%VxkOvjO(n4gqXZ@HJl7=KF>%XyaB5?Pb&?W z2mqZ&m<@52D%kH}2@4>e#%N#=aCD-o_vrmu9&cak+fSc#Ywv8drsXwk~6&dDs|r(K@@8F&(&CcUZWGfx2h4O;~( z-5u%nI3xW2^o{{=A!+$rh*;|xKF9DqYxI=yvQ`R#4v&;_&B_4|9=z>#?f--P_Awzn@IAFO}#(jWXL zTNp_S0tygcou1}CbLWEh=h%{To;x4TWc#A;59Xw)A!0-J!%OWBUY*g-dAG5Am+5!`eR4=!80Xs;l zc!9<2qt?U?fRzgn43lc53?Gm8sJHoYcChgxOc+%R>3sE!z z3bvGbPt_O{vjX|B=u9xm#Jb(wcx0fM-3dYiYYni(BABlTWdL|yvw1_d={KYu>jDKXA6#tIRNZsPKjj z-&j|}cXdnnqxwpb9m_qvrb&8z z(&-tayItY8z0*6v^;rUdsCs66iiTh`Ws+YxmI5H$6ac|12!@|yjF4vmNQ<{!X#JZ? z{p9%PUmhOkZKut*$ench7Dvssg;Y2j^ap&SijbPB*8@bso>0WsYv9!2*S5z%g;&xs zMx{lmWA6YBS0W2(c%M{<0^#DoKoMF2^#*|slNx>>b}IMV;oz?Lw&+P`6mTCA{zyTP zE8;Ui5lC&QYyhLwOp`QCn-l2bt$lVl7T9T|rPu@FMdyD0UJcfU-(mU>8Zjn1FpJZwT0oGY!@4%BSQ}Cu#MN;AlmLVZpUf1Uq zi1m33V@I+Ca1^*B+=EOg_F7mA)STv83%`Vg;;L3c_WqtL(t>>=zDgp9tuGr<_xsEN0E4wNrzUSEabAtPFj7Y^vZ0OS9JH{p6PUrB3yL zFiNV+G?@D>$zY7tzdK9HfKT2*s7F7Zy~`HA`0+mAwE6s5bxx_pTAC!u1r7vYW|UZ4 z^9F7?u97k~L%#-0z(m{9g@p(c5%syG#%!GN5S}^1)m2WHj<+-cRQ(pT!w|xt(oDGw z);8?6bBuq}2%DaT zbxq|E!?z(p1f(I93>uzjsdPN3BbD4fc>$C%K{K;T?Vc;)joc((R&W zUDdZR`xJQVfq)Db9=#(!HGrcW;sQk$>U>@Q8bhURvUmqugPWH%^6Wvt%4yD3G?hzB z1=Ai4P!-WV8W@D*rNSnC4axn8HSS2(zg_gCtcfu!Of4cD{H^DMBMhIuOWH=MJeVbvO)l&-Y&59 zl9Olmt`_~K4!=N%Vjae*T11dgpjgoE`z>+I3jYULAh*$zCO?%<3UoO`ma$-h$lg_= zPFNu08CMp7PIr8IYPj@A^vE0(d&?H$#)vihuBy%y!iYL)>PRCr8^hbC8(@}Nm^U!E zKPmHXZONC%w|n&ep2$h3N~^S4rokTx6DbTZyw|6zCJr5x`s6XMAuD!C*aqnejH(OV z4O_s^Y1^gNG+SC;2I?$L{j|?A6WmkD>YNR1rS%1Y8)}IDq{?4By@7n)q5HkSNvSQ~ zKQwj_1L;uH43YwtBqFEeILwB-C9K?yRj(p{NF#k-nHhppFe8`NpBG`w`HDB4AhPLTB@x;t6wS*WPtF9`Nm(L*S_;6ii-4%L&_5AR3 zm)`dRCml*uog;vkNdjn3t_DB0nKJy$u6CB?)r*^39av?1K$HdBCMx*0O$C?m%8u@* zcHVzJc}0dw2no9=;LSk>2mw~dXqGtU8*ZHcq{#pF{PJ6S`RDInOy(W>|CZQUcRGOl zLuyG;gZD^hs$L5;bAe+R7B3C{;&pSy8n@|10P{mV^_FrDjW}d*YiiE{Vk>)65HLS5jRM(GB35X((TAU=c>`Rl2&I}4 zC9gL{**3cbzVQPnXqa-GejSmb6|Xld-a);$0lHknKq$a2WUtm?yyNn_3@vs;u8}@J zy}dj?zW%Z3|MK%2?C`PBNry#U0MSV}OX&k!!@M0s4N7aaSV3~3x?DF^>)so7V}Upl zm^R0P*jq#H1N1JonI{O?1nvjKfw`OCWP8CW_C}fn%BHnXu=5*k)ppAKxx9XSW_qjO zN%6r``+-fM3O~pUesaXQ`FUoA#xxMu5q9a-nYUDI*us0%ILaD5+pyX3f;PO%E-2pe zb8xTI^Pz|0M-yvCP%>DpHN(Cfk;4EM1}2Nw-q?0$W{ z;6rA%jlxTrAO|r>Mez4_y?&lrBItCieZef`XG-S9D4Dr>z40`dAD*#-{vET#FXqFs zaIq6SskapaRGPNsWlLDRt-*)P(8?mO+?hUe5_oje-Vwfj+ZL~bB|_U{Ch&A1;b9>q zYPpqE3^Bo5{g@^AM3Dq08-;aA50=0CA z`~6H+#B7>%_-Hc1mxSxnyq@#6V5h-^>RcU^+WdeTd^!Q64Qx2d8mV=Ti?E^i0+eU) zt|8(n&2!Wn?)`WA^wXk4hS&+71fY8N8DyrMq|?-iH9CEWmFK5ih_;U)*c|S0>}7Y% zR972NJVHzH?A4aiP^~j$?6qlQAWS4-?xbE23#)_M&5`~1X=dsN0n|T0?}se06FkW| zb!mtbjU%OGQoS!~p5C4}4pAS`9Hu9;UdQXidD|H^k~v^KK#LdER(F_O{Q18eLsDDGlS)t+npu_E`#|}PO^!Zj5~N$a{))&S7uzO@GH*=*{UQu= z_j9EI&;%zqNhMb7f`PRQ;VS}QuTN`jUWIr|Ve?j@FVEk-*z4=h2 zB>9}`HG7E*cA&18NoU-!p}dMH9NZzlR{Z#J$^Y%5XB`wqrCfQjC*0?jz>&Rw9D+wu zXeskbQR4L;Ns;>wTZu{ng;$@um1@WYXds~35x;FRGH8BJwS$~%LL{MuJyN|sjPS|` zO$V*<`-eCE{+KnkqGz?!ZB{Av=%t+1vLLW716n1l;uu362>Eq)K;`#BJ8NY2F$ys? zL9`BtMk+?F*%dQTf^N`nc{v4E4FEf z3Bh$>`Qj@8jIIpQ0_}3m0DuuMs#u5f8H``OR`?w|hp=MQh-Z$BII`k?B!6R)2|zdhLDe({r_6@o3?#ijLW9#J{M zXEEpO=?HOlQ*0u@t84nfc{~2D_#DSfiLCjR#quc|L;bGFhoyF}3INcWR#gx-;#@U3 z&ynmS!ul;;e*V2$?GF$3adW40-@SA95Z?BM!jom1NdkmRQ}`r(H!@IwhH~!3ur00OpYs3kZvk zS}J(Ol>q0sgCMRO$oNK~rW420kTMk8KNM+iuXy~J0mhAG&NKJyBE=ckzBz^>R! zo&<0^JU2chT%wi&y99)eOe%n)ULw8RSIOoQwie#mqI7tnk%KhzORUj^CIJ`#F2%v4 zq*yY1lsfB^uAZ-+s>hY46JPeh{M2u1^z$t}Z0?diDUnJG`^a`p9cvdWmVtQ)OfA_! zDAys`bCWlTva5R5&W{5{f|K*cql`<76F#hBDPrycRtE zlTgHuZ~Vr0LB=LJ6K#Yp&j_yMD50{>L=JU#z(^K74S(&5QU zGpKq?R~}$!z`gK3&KlYXV01pk3kY@7$N&&wW1fgW1j2V2RtY%e2LRNu6~We*4DgTI zmt?lOU`A=7WuBpA$=z23-OzjJUDdwbbeMIY_(|wXN(6laWp6;Rv8F0*A-ohrH~_cc z3dbgKQ>B#awxm0()?r5S(OsnAH{CCStEZV}FH;%|@du>SrepxI1+GHaP}s5Fb|)NQ zh_2R0d-}L~;8wwtEa6ivQg>Do!5`+l%%p^00j+4@>8pFY_00%OIGp_m%!XKnhXO~D z7flwQ?*m^pz#Bo@JNK19(c$1gQzC*4e#09OWgm7G>J8WFTZMjk`R?O8shcHFs^yUE zVU~D|q3m4(Q!fb5;3wwQWlib?q25fS+K)<_VNAxdH(SvOCIKsG{yL!@-{bYL()t7& zq~r}W1Fad=f)%c9q#JTfHVRdF`kfr|QhUjhwndo;<;{SRQdX>35OA+@7cccyZ|&;i z0_t^=E>YN~g$_jZ9>lx<`bgd4gJ+0Vvgq@De82%d$k>HzOads2q#Qgou{Q6CaKr83 zyBbZ0eAIigCq;1!LneD(E*HNsf>$50G;h%hTx`1Ve4f|c4qB(}pe4kJRRTgk1Kfr& zJgG}$0&GzWJ`uS1iJ1j;GI}{mMvw;zqANpL4b({WvjICG}TRoM-O%9tHJ{H#(pc5IoBnrchAL|VC)xt zYj3cLx5)Nm-nu-gBx#zUg##4yz@^l`s`P(+k*BwZKioD=>&Qb+itgs~PlDy1;r7>( zN+otG(q~{@YT#pYu6`{ zh|}9cVGZi-6x>i=X8=2a3Igs<4G2m)s?V0fZuQEC$UZa|p3To$TJ^Tk2Tk<+GCw~* zKjvc??0xZ*nk}r_wN4{XeTV*H@Or-xQ{XUq^4oWWolSLZjCp%hkHFG>^ow{f&n;za zjmE~!=J1l4sDlj$e)#ntwjN*;N{5|F)NLbT3BY`(sfWH^t-VO zmVDURB>;fcXwxTFEs_Px){fsBlzao`ocsjA`*9TSACtu~0KS!a#C{FO4u|L04oAmh z%r_r!(nZ${k)*^lW1fCmADS^(#vJfS6$>238e?834*6`-wmbMjSO*Wm4(t|t<`}70 zub$4A`{ZgqawfuY6}4tPr|D-ok?F!T^Ek#R=fm6g2ITwkQ1E+%&l(c|c49`(}%lSv5mNo>N=m}V+eXIs(l*u%9G zD-`2)v^aSZm(PTl;6lL3F|&I|1w89sE)A-$eQCnJOnHvxn@1BilL|oeF}tjX$H#}K z^>O*z9kM5}mxaKala37MAA4C2$W~ctAS#rKcmoH+8)RItsdk=AEddO}8)Aon?gK&e z?!$s(s>6mN&Q~877rn5K2DjkJk!k~f1<_iMrFKE5Z}#HH?*}dNj`T^uSZ9rC!~}{5 zXxigiK64H6MA*j*B%Lwjw&_CF_I)RVmfjGy+aFSyax~O*|7Ye4BTW;^J#}MkLg1@`syLzGd5^d2>%po=xx&k?tQ>X ztUk>|m*y8Dr34ae67Ozhi@ch%=h2eqFkZ)as@v4yAvFtFV@U(i9$UdLxmMFAmK)sR zymahN2Db>X4cC^sZyM(@k>V}=S>IKx-=`lp%TD?v++_wZ+&Tl6GT0-6O97jM+e(Pe zIe_qADtdPr65Eb674)XHiO^AjzYN4tbCK2J@C!`*15P9v0ba!d!aI5M(9tJ0CU#Fc z=)0bu-j3a@>?O~tqE2yz)dj(#YX-M7o*sfd)179S;N!k^u5ID{>vy)OD|p4JjzS#N zVleTRT$&Z;iNV{Uq*egHqUsQQaU;M0Zc@E5{tZpDb{hTs$GhAEhb!;No|Hz;qFCZ#GzVc<_VAO$ox7?P;Ta*Rc*jya0T_W1T2k&A&kkN6F^f&N z1>V&x4SZ~Q_Lp~CKL~v<$#REmu@O9}I}n><0Y~6dU1bI(I1jIWs{y~^)8!f!1YcBo{9NlB;%B+56|{$x78J&%)WO{-0benE zNkjzhli=7l?yBwP)j-bzJ7!AWS2-!(@N)2K)m$T7r|oLkVzFB=MHKrOz?^dUpD(#hSf!Zn(~ppxCyp@YP32Lx5xS zJfbLN*a}{MIKch^6A+QuyHpnrV|rTA$}kW9WTXauc*q{#J*@To@<|Te%)cvqQW%*z z0q%PLg;qR^!BzuX<{A){XUw(M3<|huZ3gzYvxqmk*Cdj_&V`+)2e`d%-ip^p^y2Yr zVi}Z6vrS&!-4V+|*Bp|tkB(Wy&u;Ar>U;R^;px~p<44apYmN#7P>sB@!DqF#O7?7t z%oY$^Kt(#f0-W*MJ|S&$ARTbE43scZSWU)~2qrS9!wtsjGXTBP1Sk&#q-9z;dnz%H z5u<0Y9=kC4SKS^uNqJZJtW2*-YgF?NXHlmDi&k>PwX$}p&5DQqdVMPIL!Y*Tln3-n zVdRm0YDA4zSBgn`gas4e@eF{*;5lANKky5@v%4|Mpp<;@^!MMCdi*rygGZcnjTOfL zVc@>Vm?LHQltnf1GDPAKN1lz6To<2kFT9QT0hFA5FrZLOv1Y(*?4ICL2F>THWV~}& z)?pmdwt$aUComU$G9A76#lN4wf6$}bWh;Bu_)?!N8iw~ejy(h|o;e354O9donRIxE z(RJ;=BEs~JF!tmLj$={p-E&{Se?U4xM7xxf7!E6N#a3BF)j7Vh57?fbTht4_^{735 z#4>+`rd|(~(0%g(C!MU2nrAYW3`Q8d%~NR=EWZ16Iq&P&qQ<~kCrq;WygFEHzx5w$qyTT`7F?^~5b#-ru z1z0o}oPYPxA1iV2`wjya+;kZ7ek(h0tkJCbq!w>crwm?SeP~5BL>TsIb}*${9M(tb z(U>Nj7XW(js+5Cdvia$U^J9f>rprKuHtaSq|rOVN|wHSESI-{xW4bLq3%Mv4-Q<= zaR8&I=tuQY`sm{GEk!x&_pkaWRLV= z&NlEz=EHf2ylkkjmacBR&Jx?PtE@+TJPx?t6+WvJ-c{7S!&87G2WwwB<&ar&in<12 zv!t;Zr0rg7J1cJiRAmp{ese1XB(+92P{V3HOmFfP!=Mmi_2Nmyu%L7F)SMa%g8f*Na^=?4 zyLK};5mf-Lg9dqfdHCU2&B=SRCneCsulwO`9<##9kH*uyvjbI*xeWyO4)&0*IU;<1 z+69qv=}hhg4Z*t+JmTrkKJp7q=BoaYGjD{Dh=NXBT7r`4Umr6!#>T27gN{Y zA)9;<{@b0}~JE#Mm zQ%n$%BWOjDR<5fV!M3*tTNb#Nk^Eq5skh~t#9l|_V+5Q5f(8QWdMcL>SF(tpqA+{p z;NyJ`Zjp;Zf8)hF$L+BdKPisnzNS^~v#O?|xzkKGv!A0#>SiDpGRNj51-^e5M`nW= zEzFFcfqsDMfVCIx_<&|alx!ZZ#A&3GPs@N`EDK)*3dHMJ2I?QRdNg6>8{%hC5+~_P z!;lvZmZI;B zJt1YtGI=L|XP{YF*;ObF(+JUkEo@ZD2_pGs~C9w}3wsfCoJ$8--DZmGb~py{D3mOZ zHT>FRP(aL0*AuM)Z00&2~mA3&#oToWGMPoe;Xnq8m$ zas+wY*dkuW^~j=uP|=$AgdRS6jLFk0v-ZmkWAv+BgqW562so$9AVBKLj-6|L)#$Nf zl=oy$O5#dne%lQ~2M6N(I&kvrVD7DesMiRGUul;+_g)_Abk{i{xoBCPkNPb!7uHashlWqBjDSiOgH@xoEW z4gqTi4R0xIaBrh+Dr(OOv51t@r3Yt%L2SXw)C4853>6)4jcW;t8(wH?+30@?uIPQ(~$) zgb?Fqcl5mFAwBx}RSe$9pn`{#IA)vPSrF=7taf5;5iVkh0E&)|o$KshD%0!J@C z+%o}o!p#S%z*K|l+$5AD!fbETb#$+Hi&eo$COlQ^G7CZX6OJw>Q_%gI@O8bA3_<8_ zz{7EHHqOW5_vi1QpT0ZXSpI$Kvl>5G15IFn-Ru_d5ep$9c*nMe2$u@{3v6|L>dyPy z+ZF(6V+sIB=Bd|9>u8f1+u_nYQlvE%pHxXT_cnUGY#z_m!e8K6k{p!!!=W}cTfvhE zhnEj5L|6Ewv2-d3q0e<~cuZ+yOt_P&c@wxRmz^cr$SrtVdGf)aab_(0j98&L`K@|_ zN8}PbR)Dcj9VJWX;;Hu7Ht}GF+~5 z5OY~QdGRdVM`DJ9nXpmw!wsJemg;pthe@~9)8O_!7v(WQ^ao=@W$ZZ0h~}o=v(f4( z3ywIXQTA%~P~tcI}Q)$Ji=pLxid8rVQ< zWmDT$0Ec&69F(v5?O^uub?gHK5Ww3EJD8+|M_FF%rR>o}^6;3&Lp&L;X+CI<7n37^T~dN~>xxRV8^}lj zoa^vxcJLU{^?Go~>pP++5fFHbkm1)6T{FY$dvz>0GJx+CAAr<4SmP$cq|?4iXZ6-R zUC6AomOZPe6P|9X2L;_1KrnpI@=65+8CWHPpobZpIVv4HA#sg9=phR7j_6tQltjIk zKNZv5YJ|oXNa2i?3b&cLw>WK6GX)~CBk1_=OaKJr!;bxmJRyX{8k}y-h(Kouv0|NGsC9J>>Al|KIA zaO~KKo|Fow&>g_g9C0wg20n^UqOD9mtypFdJb5#LFJi&(5)@;K%Lwt=ha8WBf4m_! zq7s+~0twtVbuFUbyygOD{=2~$~AIAjT79hO_gZVKy|12{!_V9tg4o5h2Rk$@6 z-Fo%RQ93s4;-b-Goygx2Jt=H3DMybK)-`C-6r=YT3xz?@6rMc#wZ}EoEs3{05QNTa zKLp{rDS3ffX3LtyvlP6MgA%x(;?JtLYf5#k7L{T4N)6(iutc25(@@eR6P*c%zhY&G-lXdN*@Z6YQy;8g?VRFeuy69aJD93y$hjlv>J=5ey|_OK4K zjh*aCo1-I;aw*WJ&N|>VJo}?4&}Yb18z+PBr)x;n{90sp;gP|`i*bNoVn3*4)1FDP z8FmLKe~Wog_SBxXz}ey1mUdmkU%MP^7wbCxy^X`5YA1VA=;%N}y?L#(E!f3?OT}Bi zAa?O_#LWLWPWsMA{zU`&FL%3lv7CvCH4#bY- zZOh958*c#2)Dcfo;#wI<*AOWxFA9+tHjE8#NO1JT>S@}Gy&TIzd|&#ks;Ia!;;Cl_ zQWF`($Qf4DxW?-9!ltWPxho7L@k-Xz7e$JQepNP_5;5OWaO=8H1$ia=r!*^ zFy0PAM1%%X@(RKpLF&Q($^_DF1b2n7(k5&z>XRx{%?m6rh1&C+2>syc$F8IPwIknw zi`sWYPwFcpz*GgGAKrTaT*=@SO*#+ILB!ua{jOH7IeD*bm!xYwd%heMFV($FW^+sn zShc!OytLu1{z3gUAf%9h1_qsBDW!PH*ga?rd$MER>K)OOkS+pu91TQTlKH@*$aw-z zA*zE_b8G-UmFG3@C^gk>g>#H)g<-8(&ai+)ykcUjV0cvnxMt2ZCmY=cvk=(3&Ji-U z4tVFm86p>z9!~FhU;3o1lHiG-!>c)%5V~ul0tI$%q?fVkSh*RVMvOSx%MUO)B8dYAAnJ`mK77i#+;3@i{`---PgwlHSdmiaBSPR43D_Ij<6JkaPHj4KFkbpOBQd&!~9V;bpWggiM*J39n>DGcJzu=B^#%R6F!K2Px zy|yySq!A{#z_ksqw6{^bIq7SN7z&L`Ow~C zMCLl^nchIGKOJwL_$~R9^5AFz1}TsfwgLX5WSqIe6wt4Mtc&>Mit9YM_)a^^7R2Wi za{#u2UD~P@$_Fs;6kbq~xEQ8V$gK8c2b=1G1|F_ zxsUdl-h--n&%P|+$*fVA8vfm6Siufk#(@YNLTaNY31xPPG$MiAFY;R^2Wwy#hZ zFmLsIwt&sx18!sXj;|#-vvE!sE~T6%h#lC3T>u<>-2JSQ5y5F9P93!h-ry+lcu)8w zi-h9yhAh-JOZTa#eW+3I)&{t8>7X7fZ&IuPwc57BXkmb{hAmNad7A*wq6%$DSb$l} zRF>U0!Ix1?qho&_1XREK?r8DsJEA9@lT`25ZjMNkcfW_a5{O2GUW&Fx z&AdW(lSB;|w(TtH4HL;nyw$-WfJrbYo)Lhp$^gR@w-xq6t_u;$n&-c(0RsTsjku1T zB3^n`9WcdC?kw6zqc*^+CaL&{?gS^*3SZJXhiAQ|7R$JHR19devx6U2S&rVh!6&6h zjbQxvHOPIl0MggpGa|N74jSMS$tM~XC;l;(a%@+)KF7m+IBJWX>`9=imWe3N-bd1V zO;z)r$cW!%nNK|EHA^XJQ*@I+(YKSj!xHQng;kdr$ORN$BUPt13bG-CdqpshSOql( zQ|u6(J$f=V!0s_r>dKn*_|tbXccKIULZ^Iu+ufVVhvu)u?3t#h;)kM*^B`~J(P@gxt2 zkkz}wC#Af>sZ=b{EIqayr%%!zv(DsInpn&DEi&7ru%`guva`s@cv7v=TO(qhRPmNQ zAxItx5G}+Qf@jC)4r|eIg4WQ;>%BkJyx#@hl{>On^B*ZI5$! z3PlRhiX3g+?!f5xe*AZ+1;+c*C$(JYy=0##BtFT`vvAydOjpj)?7Jbw@jD~UnFprAcW;$XV))J5BfY0LEU#m zPlCF5hIvnrkY#r45d;pcqrk&cr97a&0p>h5w@__c-H{VPY);7u6g^WE8)MB{I6D9i z91IrnZj7NPO}f}?(y<*=^=`1o60ZKJ(xZs?8{#JcUv8e|?*;f7&Z|~7zs^qHsw8+h zly&nFH=8t{*mrbrHXkIBysd@cC4dn_Epy0fvUG5(=Uf=+UW5P2A zwgQWvizlD5GU8lglfYi`9_=bT6e0nc)C|;IW*V&x&!(y!JQEwF#FW#>(Hi#5C`}Kj2lvK)dDaBNw8zNy3pxQnNsu(@so~R?1|F7tOGl)Y6RcOqgVl%$0iNk@Yaa*Fz2yQ zejyM)sj&ImPdLdoDNu$wYZ;zc3wG^myDkIl6^&$G{onc8g<+-huG)ZkQdo#33HU54 zcz$pw*_{0fc4Nk?Tlopm}@MR-6)kg3VVw;-5mP%ZQGJs z!_3|gTn(`#5#cEvyd00!IY=^)ua9Dlt8hW|2N!{Nn?rpjLON2g_GnM@(ogK+3IE=o z68C}pNoMf@5V}H7HBt-|y^6mREpX_ep@GI@QbCi;teUa8EiK04mDHT8`w4 z{z;|JzdKM0@@?^xilt^(O$ltV3W)rit*y>Jy%Bg6F`%!e0WSY~kCdEu3|@SiooBk6 zPcDwesV)UXh%teU5_U{)i19I}%PDZ>k${p%gzKyl?LeBt+ zbzPtI)=>6s0KA_xH%T2I@V?UUO+ZeqP149L z|DU;cU9;>qjznK&p1{T>arc>OpUDvofs+}AHs5MnJumr$!N=p_ zVcfsF|1j?FUhWppK73N9NSdiIn6Ptc6_3Y4=qqp{Qi{O_(CP|pbBGngRwWf45h&j+ zxfFJyIX`;o%Tp`DAur&!EwSs|z!0MX1mN$q7%Lae*~_ckZQfzye!$1S)ErMgc~YFR z%LMS|K+2J+E%?mZt5|$3Sqhalz|zWQ-fr2peaufzq|$0fnn$9UVF9dehAn09 zcV}415Tj&F;x^ACDo^Ek?~C-FK*C1`>vzTFVjRxrwG?CD4m@@+pS{>N03~c%exW_~ zPn|RcpxfflBbe(Lkvblnls~bH0Z<5pyiglubFRweJ0ZJv1kq#JewDIU68P6R_U`PDn+n;l;6VX~y?kbHgoUXgRQ z0$$p>=9qY~0$y<_M7TKIHZF_V)f(F;)I9v>zOs>Oy=7fXf8A&FvSBO=^c^5a=QZ8&Y zKqQ4SQm!oDZ34a-4BrdC?bX}xEe?XVsz^<7CF-g-%6rF<Q=p1S@>=$H%vK-;8(c zEq{19-ul@E&YFqbRtV7va_|~CtxK^~ilEqSND+rrkPz{&{R4<~V;CzSmqAjYWCaJ& za3X*LTaU_`;TEZTU!(Uev1`HMr@`3O@J$6E;^oMTS4#Tf!#7<&jW7P(^JmS)n!u`Y zIoAP+XXTyu{IL(vTxH=e0#V-};s#K=V)4u}hhJFHmzG?0VKqz01iL9SZg;A}S)!f_(F>Vf@a4eWS@`29 z1`?@6JRFZ!MjQ!7^&Bn(*20^1eE27*L1I(C`yPq<6Jpl(xszg50DUeokB)zUPhX1T zN*P5!7C^(zrCEd9@Wbr3(*hRY?u>14pjJuIk`IlC@;q49aOqVykjF9stnsx2Cn>`B zU<5eJdU>e&_PckFZ!hispHkoO{L?1|D+CLf2;a39P7S@xx2#CEAZ>FX&$dvKjO)px zh;X|Ws*VsBtG0}nT^)!yAQT4(bv8PH|5NmQ&B9YGya+6BuwwX01hAI$6Y3W4`~RNf z@#QG%sprmWo|=Xv%bDRb4xU1(a*9&RpwAVK0wR)Axu%1;Z6}92$GIpo;){(nf?ZTz z79wEcJSU*65?WuZi-UzIap7mPo`CSyaKLvjHp7qVziiml#~0JV=bt{wB-E{S4tO(6 ziXAWuw^#vqtXIS%>@Z&0xXBqvGP|U~Q{pkY7(aTfD8LC0NOvLtdM}h&)^F)DrK?$h>D)>W?ll<~ilK1n&!+Qjp zw||}=PisE`GMR~lNdP-AiFj&RS9?}d$HbdPxBWMS8SMWZiRh?I- zF~U@r(eO5hYU%DGv2GctOlqBr$xCAZ!w-sY8ee6eS6b%3k5P2AT=Sy*wab)&q6h*= zqEFx+vCjtdTUyv0EyishZWtktv8a=4E{lfIl^_djqlxQ^l@Tb%1oIeTxtecHdUw2K z?9E<24fen6>Wdl3&pm(E1OcmVwTnS2c=hVk;_iS&2>Kka)aPYD==J$Y+iFA#lTTP# zsD~7yEkFq0Li3HXoNUI{KyB_k33)5vF|dU3+`m>3`%mx{DrnmW{mYB(@zjH7jgm9q z9Swjx0+6LkS1X~A zWi?|}iosNb#1PVu0k?U1x8dLR^ApC7KKJZNIEyFbAtf!zgPCy%kVhh^L&5GER&t4B zHm<`J0MzdMD$FRl;7m2to*0%qz8A7o2!L1-@hTy)6B5@fg{AS`^IU%TvhZDAe&BoA z(#xUkCmCb=3GE+Q~+Dvfs0pc+| zzCw;|4AGZgNl`reqMUun$uG9ZvrnINaT^@R=cXXTkD6Lj4OKkHi8lN}D_J>OZqua` z!?syH*+3KuGke}i;XkL15dzML37 z_1sBEy3)-YRa#m%7Xfr_`h`Hm8Q+<837v&Io8rZ|b&WRQNW(5uv4SC;FUoPI&^yus z+#n*06iuaiiRL>zWnJoimn%8DPngPkfv6w!o#~^#*c8t^dy-p7mQa$bRIjxWS%i=~ zr&tv{E}YQRmzL`ekSyDBh9m_XvJZr*w7gNr8+fTCy-4SLZ0Q{WvKWI;xr+lg=_?7l zbAn$l9|Zf|-P<3p^rG4%d)ot zDpt=?)JQ|CA^wDk)V<&zdXda2uaJ3iSW zPdtBCz*-}Qj>NjED49Uk4TuDvXr^ zXBzcWbXvZ<`;WKp0gygnV%al~o^+nr{p6^NvPupv`j`hrHd%a77GCt~lp|!WZ=-0g zoiXs~_)NAkQ0K0IicC)l=aoum?jqwIi)hv`5zY`P6X0;w5vhXl3E1j84jg-&4=*>x zQxBe$MOGM5sexX`;CPvYw|RENl$BdUfFCkP^Vf$}0q^_95O6JkBa)NWQAjc ztIQ0Lm8DW8r1ZeUcEx81+fk6j@X0_EFOOA-G>`N9mxJ7=o;&HNYAwF3p*M4(djXNI zJjA82IZzOxXfd_jH21nKTo7cKyrQ4Z!qOZ%Ae8o0z$WrsoprnTb6$@F;ueE9Mh7m* z|0NK@mpjB??myV~Km5lhmRvpm^htM8qR8IJxtZh2O5h|nRf`Q#!=^(Hp-jQ1gDpt* zyFxgirjp@YEgLvrK}Jd)AU8QnKCTE@Rgi{Khr=mFC`t{c_?Xl^LZrOB#{JXn@!!oB zET2ZUcHjr22q;GiAvI3P@-guY3871UxjrB90Ia*S+>Tt}0x_(8Y-V%AU5;>z4J$y- zgMFMC004qOeZPB+tgsKi^a#DG)>8Vd+57FCe)!=Zr@nvl_}z^)J76XzXIKTsnXg$>31%v7Ocg-tt{=GJ`|KOguJ9T82anDna2Q4b^Ovg}k$tO~gPC zVwpVleT-~Qs6Kz&=6^ol>34Vf!%f@%)DNFEme0jDi}(^tt_@EH?9dW76R_oK3iR*0 zY$T%meo*3U0RXjmc47jf8er*IQd7eVpM4C0-O+V%`U3u$MrbOApXmYIGRGSm{C}el zk6(QyH*NS6KYLP3KwqW>ky!vjb9GsxLuBvP03;K_L-*>EUZWsHh_F?0)S%TuAFYfM zS#Z->`0P4pq2MhJA>%bq5_6y=nz5cYboPND+mtRha_Jv8@pFCD&+gy7yG;9h$?iY< z;7RP+ahL@)da0vb&gL|MGtP={FzdeDkQ|PcN~=vk#thCjnd%vHR4J zlf^;Mwg!uoh7Fwnq%k!1lwVnb)7p0_7ceGMfIhPGGGb{DYM|9~M(CQ|Asn%m6CcnN zkZ7bPtHL9AXwu}y@`4}t^Q-yrpx@l6^z<{&oCSHPyVNGT==1^^sr6ft1{x^BLf*6( zv0qo)U)p|(v>&y@b1c^g(BpZ}lz?!1Xt8ks8MpvK6I*7YN7R!T0IvefU|FobEF%5x z{o~vFyW7eGpMT_}23H@ZAY&@Hu`bK8cL%_;nx9@%1>`|YYMbd(!IfzWEdBY%PHM_a6Ck?|B*_^#wzJ2|K`xg=iIyd0 z<6mr!67RAhEm3gBZ{Lc^f-+uACe|dcS z?zYW;=I2j32A#f}upqUSI5{hxXA8w~NJJUEwvhoJ!=?t@Z;yH?Lza4QOPWueg<&9Z z_&cO-o_a?QD3rQ1O8Q~x&{8ale+O2oSsOQ&fPeYhiU0fJvtR%A&98rU&!76?ldfX| zHr2(206eu|o90S`AwCzyDx8(+8I7*r^c1!g#YF{d3eGV=nO%$k^eodTHe;uNZ>z1( zWg&A=Fg~qQ1uHw54tc(&8wUwqHt`*I;{NXM-oL+X)Av7r(u-aRDXB(@I1^k)dMv(| zRVCG2N`WmBTivc-^qAxBEC=vZIcxw)dRk!XZe%|YlWK`eyko74Eo%D6n$(zMRg<6i zz}~9fc$V{VALpOv9Ygi4`@a48v-W)e{dG4+bZeQ-GChxcRa)`EW6!~^%H}W`K)mku z-B}CR&9)S1(tIASBSfhV&?+#1zyVPB(qIW~Ii&Dekkbq0tYU+Q+&G2#<39fJ@$vob zyT1A9lR!M)!rC}VY1q8nfGlc7=E~tTVkP0t4`U9IXA1w^$e%uL^+qv|1rqPvrWpjN zV|Q-0Mh6lBF40T`4@Vc_T*hc+CRiaWI9nt7DJFOaUb62Gk01JXYmt85y7f;za+Xw%<=GNNS!4lM ztCj#%W4bOj$-c5^ux-j0YT9jna)5{??3x8qiuej4`=L@f_G03bQYxJjev=F21Bf;3 z!@)0+Y7nDdviW~`2#@3a+ZSZkC!RR#&IH)8Ntl9E7*}dDfIK0sI+p?U08TPLnPt8Sr8RCx!XkjG=+?^17WZJjD<3$gGt$BAjEjzyYEdq7%YVb{wSjlC8ggKkqK_ z;|8kw+yiITiU80!pvAOWp;RU%NoR3ha~~tf9N?|8QF=s9*dCR2&w=X{jqI>qi)6x+ z!jV8oWxyh{l-@aV7f2o{05B5!?z|<-&exZ~nui}A0L$O=%8A(g#;N$XJ$h37_cmH} z)l*w}vfZq7tbmA&=fSb?wg&){>xp|=+|CU~LdHP+(R2|GT!62fWgT_0Y}8@r5qv4= zV!SYMoLmWD?^PYJkuNWCgR33=<14Ij_3TOFn^i1P9NT~sbDj|#R5i1ZU$9xC(YM~p zHSTQNpu|f>buH+`yFV)yWQhnVEc;?7$NEj)2t<}IRws0!RV)TXBv)PpJ1;x>r~mWa z{BC}lZ#?_#Su?8uN4*6ZNRw&Qq6@qfM2V9RV@<+w-ELDj64Q2wtFI2YURvlR11ZEF zfo+?MQ$qy9^1auL3=Y^ueWT|4NJUHH3|DElD&0J>r7!i4=N~=^FM)(voIWAI#2H$X zlEGjX&?S{NoG)$imA;Nvc{>Cq+US5-)Y@_e#s&E0I|r_VcLA-=xGZ%SY)w{x#xYk< zl<*k%w#Zm7wa3GI{mb1N-@N_q?(J<79ydOFQm|s{FyCEGUIj2_^=4kZxXTnU08qAm z$)>8!ZAtQS0_LC|zJTP?0GB4`YK#~>@Tpd+ZWb`_$O%dcUx}qV>%5vo(3BVFj=yc` zU*6s}QQ@{nPdcIVb@-f-PcNs?W3XVEG8-B|z&O||S#z?%v)f?`-mFO`Ul@Y0=VuB< z#;{7i7%>l>tqn@wG=WjF2G}~Qk3w1Vd1E2;-!}CA;iCffi>&a(LnqZcwAN#`8WBiF z86a5Ze8{c4kt4_DkQY0>?(_58%+2#R0O2+=^0#v}cz}V4Y*YfpD4buJiF!^0;Sl!w zfq>vo*`Sl%%{MUmANt|Dhu?u8{C{8m{WtH1e(3jiieKE{-7GEt(nZd?u|c%5P+HdF z5nEW2n*%VG8>2-8_c*97bnPE4ZuPi&aRc$kGUc4cbb`nP14l<$I**lI1_94u^yGkv zy~{j|N&{T8tvqgQQU0%c`_1E@zIpfkYpnC^3MWndroy6n0GydY6FL%d7Ac(Q<{Y@- z1ic%5<2pgwR>m0-FH;Dr_oxfRMjHEaN)NTP#EM)tu{Fwev2v81v^`J`Rk|;x{u6EU ze;!|BmnWY-327Ox9hY|!J5Qj3;Z^2Tiqz*^rIh6}3oNe7x9WC^E;7Sp#asi;K+MX1 z0^3rf05q@-SDn)d)FrS-NR4$|BaAQw5TfVUZiT-8WmA!zWBAMK!r9NPagupjuCPzw zXqLvY_MHgGPi!;TVy0;7@}X>wZL$Ab5l(8GXKxiK0VWBdf@$Kr84w&5KC0(1zJ|== z@%`AwmXLIY>z5O(TPt1u-@WCr)N5?>?DHp~u!g)HIh2jJM%36Uyt~KSorY4&89B)7 zZWy1Wt!z{&EhdCTo}Kqp6_gW>=Q;Sti5Yf2TTc|9H>5Dt%z+seR)NPBe2Lra^1EOC z)0g*ZHj1BOl@oY}z_;3|F&&$*z3J<%ZZG{iu9QFrUr^zXj;=3nnW^tTUx|Jl9Gaoff} z|IArqssOC0`ZqZBIeA-hQPL_ihGEhL%m5jDLpvY9~$Zc*<-L?%@WqL2GDY3k2R&C_2WpnK=Git&B2 zNK#80NbvY7_|;TuW_HPe)xTLlT@t`*tB6OS_W>x@w-^?C#&4_y`_G;H_>bSbeK%id zf~OxmOL94{zE(wK24*QRMvxM#wMm)4kYkMa%gtU8XGQ(@H=iqwFB1Bf~^{t0}9 z+#td5LCIw>7l+il+R&chfvgRQp3DQzaHA#uJU{dw9_Rn~;k!k@bNu9-PiAqBQCiETf49TSoKfKTQJ$MiD%(2${@@@a1A8u>r zeC3*F!GIC`g;S4~5tM|(bptGk6y3~si;fn#Ch@W6vSTDvz~N<>fv_~Vm`w0@-$r!9 zRsaHyIyzNtjiW`g38J8}D{Dp0%)Au_+_=}jzkeTp|Ka}eckk>_8$Pq{N#|r0X+9$R zgtP$PoTSx~T;MQ_;d_ZqQufzaf&DlW6+uC$SMQN8;0F)p8JaWj=W2!YK(;P0MhCBz5QVd~x`QUg-*DBD^xUoih zzuDN`zx&O%-~S!|_E$gd_8aW=eEjt*O!$ITPl~3lb~bM#Ss}em5tkgC!r(Z0gwhiB zb^5r`1K&+kG4uFFAgob@!L1D}8KhY!7e*^@fK{Tek_X`YjuTo^HTM7^+DL5N+!A-e4W&9<;6xC|0j zgKu+?2r24VLpC#|82kj z)&2L!TJmQWKMA0=IU@&r1&cMpEpn~N!)sRc+7R|&f$lf<%(3oH#3u{?@IZ+8dwf6h zTC|mwRR@QAjiJD!Mu824)iJ`zK1aujaUIrftj)Q3&p*F=_+Q`6S0U6Fta?(-=ZcZt zxtU6HegaftGAXEbKRF(p_;`0C)4ti1iLd1rFqnL(yYqja^TmAU{c=K)7Jnf98wsfg%&^W5E zgIe_9=Nu_f>u5ctrM5d^+nvx@rg$nar_JGe_PVGdwPu-a4Y+1VMmf9%6jiBbKbCaZ zddOHHHTDZw?<*?b9d5tvs%N$PbaT9NcT1*Mm!qe~Gk8GkJ+olDG-~kN8b3n?h6&9Q zLSkH_hf=e0l6D8G;c(eD5Htq|mxd)_%(SXR35enB-9O%fZ$A9_aQki6Jc-#mR^M@u z#b~be2&jR81}6eIq!c%j6$h-{>VMJA)g&P*&YTlRIEKzjSY$U|t_{RXtgHzh=W8xG zG$H({o@c#Xq`QgvEUPK?V^hx(d5zY`D!W}YRTiy7po+4cc z(QR4nlkH&Fw)8tstaS?YtWveK*t(R;qQXpAZuBDA)zGrXCplBe2(S{Zx62to>ucP4 zYxI&0{{@2Slgpk}xW@K&m!+iaK4SjlSS&7aG@U`g(M|fbPAq(Eck$i95x`JMfAs=jiF0r|KFjvcFQG%2-q2W)aHpO9W1GHdYC zCLRoqljPvgg0Hm_2VYWes&~-O3DUocfaI^G98qE2Zfst@d8@w|-@fL;_r?`ZVuH=h zD&TtAmlgXm07b0E18Ky*(Kt~=db^(Fvc0OeF;|cRZVs#oCTTeb)(d6lS#DkOTG_9~ zpIV&a<>7;cr*1=;|Bg<7U%Y?w_+jd|U*6wX*K)wZCyo3{4p4*5&s0Q1L}R_2vo>52 zotzsTiD% zSCesaNi03*4yMN}3yRsS<=P|Mud^Y>VCtMW8%_$Yey4eqJ9^TzP+wFjL z&zd}3Vjorl2wKe*WKglQsg|fCj#$%b-2+l?thgVH)miq(xl3upSpv)m+qD^NEDoKQ zHEIwqwm9M`Rb|n!>y4Vdt{fdvFQ}iA-{9k)-~Z+A-3!WW1^xv!N+ccq4M6eF2`LToV;g zX77=mGKc%!wo4MiJPV*cz z22)T|UJ@e=FXUs(5gv@}T&i+HFh!ozr07!=HN0U++n||2Zyoh@^Va|N?iV;2e`3*- z4p!abd?|pG5X>(_LhCgIY^*F(pq7vNT)V5qoqv{9tAsh1rWhRJZJQY%02;|dhH1-J zFc28e2L-AHd9A$=0!@|#kE4&~e*gCFU?96&@uZ=_z7nId#SJDK-XYIflA`8Df%7bF zYlV%L*OrK6Rj+Nv&bg_T>W}1#&6UCWoeVo!(q$CZTdcT2fOTz31viPw>Cuk&*Yd)H zjrYW=C*A5hi?w9@WKRZYNuW7XjWsVy5XC&WfhjI956&h zhv^m|s)B)lV2;%}@_Efrz%JQ%gwTC-T?Y2~`-89aw@aRs_MCMS%7fwgP=IB80@55Y z*4P~|s5gX9+le&nj&EkKHcAEkm%cbL8oACQ+$#@OC6qgp-gx&PIcI{R zh6kJOpXb3rbF<)CC8i@sj>u%8ya!24l1nco3P6Rq5Ge(n(#C9Cu%fNx(pF|Kc0|5( z7a7W8J+lrnS#5B=!o$?23CT1UO3&!X;5^x0)n~EUhlx%MS z&@;2cbg;Rlh`Wr;F97~yGv9O{Glk&~B)(({vv&kfpiI9?ccYbBbOdE}4kwdari;(O zcD>$QXOcadPQ1B$Jowynx8g}1#$zV)l)PV|WR~$t8B`q$A|$boF8v`?!rVP@?i3>Qth%WZKC6=EkM>WI_WY-Tq%o87$4mm2I};IQVIg-^OV zRH_t|mROloCVP!DqFi%LL$RS2l{51;g&5mrr;f+rW0u{dtat)_a3v^(I1^_U!=b_N zql2YA>jXw}_=3ErYAK9%H0*ry@Qx(=pKleIJ!0XrCb)W@ch!`DH^9#kA9-^$-H2fz zd(GiT#)3DVe{%*h(%cAm5oQQpsNLYWbZn&u0cDt+GIVKicip;Q9YI{R;;B$>?LB|N zcK_4;!@;NDPb_+tN-E3ao0Hn8H4Z|p9Jq(9i2Rf&UAuy|w7WpuHLX=r18ZhJD#em2 z;v_X=7ANw04G5Xy5n6p03kqiFw1k>`^wc)dU%-BE=EK9=`@7F{{PB1@KDYQuBO5P` z6+FD0npVtM3UP3hQ2}-gRALktz_vI3xMLJSU83+zTgFNFU?{oN#fvEl>Sm7f<-qcO z8CU?HHJY`7G)_rX+|i5zTmJPQKN!{a4!7k~3!g;l1=t^W5ik`tbA=P^d@TSZLNyNM z33w0v*8B);8+nXV@Nx_*g<5ef44F1Lzrvd&mOaAEeHg25Ksl7-4uEF;8oz*F{#$bG zv-#mhxu-)`K5e9J@iBsZbMiBIUIktBA-FO#VkBD&7yfux=(al<4QXXg>{L9|1Yak0 z<)A`V=WF8x`BXIyShV;`YLoLyqor1O!d(wXtRMILmw>F#tb7vdU(*07IWiSI9X`pT z{UV&(?Rfh%5EEmqyV$z3B%@n;`pR>hvz= z;W?k==reA_zp3{1+i#D)cY0>wlkO6&y9S0H@WZWTB*wyN#w(EyP-$kZOtsS+W2+%% zW-6&_4%xFnG50ns#+h2Acn7{GDCUX?x{309Ar4NLW{YX|S9+|VB(xU>`-gwuP;n%FUiXCaM2(W18sMtmLJN#s;W2wA* z#Gm-M=4u^W(|9}SYRyL%z5Te=Z+;O2Uafl4ol_XeCe;aY;CZK{CegfW#R($o^3xY; zciedVHVal;v4PdA4~>=IfT$r@o@=&NfnpniXK-_}4@#QI%-|voxHTTn{{QgD`?n8= zU-v$>>PZKvwNDUo3d6;K?Bv?Y0Q~qR@{|jcl9aM^*NC`l2Ikntm6PT=gXR*cZl@M4 zI>6H@F?n%tNx&p830@k8%k0Gnk^ecIXZ+#LKD)nr{BVDp$jAZfo;5d(&DWgw&VdM{ zWL@57OwvZJW2CHOthN~nysw$UYCO=McpdtRp0`>PX|d^S6#XLH0Vw4Juf)NE<~T4a z%tB#nxcsXxGJcOu{QmF$=dU@l{~zAJ*8hHHwUg>io2gGR0n&pA&OTS^R5OywX2LGL zh7@<>)`Cx4@t6d>nX+^d=VENJa%P?v0G8gA6&TJuM-O={T!L267=>qg(28DPA3A@! z$uAf~`04ANL;~^d&)~qglONdfu02mUUh7Uk!NJSN7-ek|Ud&;a@>&7T0dLRUD^aY3 zNP!t1ytNSv< zetyA|_;@XoQ+pboinXuRgK;*Kg<9czygF#nkKM?%o!OAbJb*o%l|42E_@ykf1q32V z9VeAcO`)$rDK4pgro=ZU%@uN%*R@dGjd$PK$KC#dx zrJAR(tB+Gk>Wib;!RKnD@)p}*c65BJXE$<8rGU;)US_1~2Y9&E9)Kr}HQq>iiNj!L z95sW4P#bk2`$br>y4Rg>{R_Kmh=2*z(kn2%B#s4-*#YhtNSKEP!#dlAmG<1(Q-z+VTQXJls3ixTUJFk9F{0QK-YVKu(kW;)-AnX&i{3Go6 zh3vUq{G@89J^*Xj-2!qBR&AczE$cF6i}yaD0WOWPsZ%R%n;pF`NTs1U0Hlsg2vX;z zfr-pZ{}Mn_2w{N6C(*jF3ck2rG_(-QV|rbs+V!Ttd3bkxe0^fklPt(eBr#XESwtLC z#O@}rjF5D^va{uSuYVlCA2098_SVoKyAT}TEia&1nFA!Ou zTlu6a8KJbbfhIcTkbG}#tm(A?SaRx&Z&HHWgw>3X+IeM}vnhPpwGojNORuBl0UKr( zICiERF>@ybYE+9-hzYWOFJ6({QJAN{a73BRy+yg47J3b-0q$0Z2MIB1GUYl zrktahgK6V#yz{Q&P(2TIR>tREX1Tc%;xdgBJRYR5#6W>&H9sSJCn!t-(%+3;{%mVI z(sCf^|Ni#`t1CQfO5EC{*6meBBoqzz?=+!=gHCl406lG4BU3ia0?S^rj95 zZ2i))#*bS?CK4=s6NogfjQDz}#r|-p$*xyBDK@g2Z?4X{gKIkA6HS!m;(c41H6qQ0 z*5~zoUi4|J5bbri=EM{42o|n60!Jc^W!G!B!o~jnsz&K2 zyL`aN`x{m}DK5_H3ph4`WXD=LvNfSub=k+h24Z8sg4o*dO_0R`g?3wl2UFPs zF}Vn0u%!vFZ5*cdx>M_)Zu6htef?p+>U!vg)lLHaqbARezgU6rW0%?CBrFb+&`TsK z2O8Jw>7kbjvmJCy)9KO@>(Vi-#lfjFoDE}_dFL=oT9m6~TcFC4$p)4%I)`vccopdX z$u1uuCvnSiCl&kk5ZN}erVaq{?!8#-#p^Fvdy3U^JmA{YqQWv_dv)q6J%GZ z&0agOVz9;ek#Gi%LMv9;7rOzBK$Bb9meC8of(NLf9CII@1xd|v7O6{Er;=Pr9+`74 zD}iU0QVf@}3vg_%Fy;KQUoZeR4I;-UeE@O=W7M^NY_C1+r~S(fuXW6L9aZ?z4z z_HA1lT}v!URS{KZMm}^h8cj~)`S(fsg$Z<12at-qfkotSPLEqN1j{p zB*mmv;zWeP#(80t7?Mu)BC)9=-;{;_CX3hgDg~drE#@1ScIQx1n}q-}IqRXDj~uN= z^#CwKzY5s3ulSw>Bq=V~k>{fBRmYP*-Rb-LKfOH)kUX*2N#52=9h67u6apxSjR>EV zM*#!I1`hF;HiAvPinOiFRaJF1kQRj(ZNSYZOx6VM=A>X{Sgpf`tUQ|`o4~DQ)E+48L4noaVMgclRh3~s-RFlJRk%N4 zp_8s`SbmIMhjn}!E4FNGNY92Oqsgh&HGSAjx6Yx4T}&(u>lK*YW&=l?)Br&oY>C2V z4X%YR$i@RdO1T_{co1ryjX0i~xT9Fw=f8eUcgXV#opq?cJe6yz0oysa)|wUgqgotZ zXRZiUNH}RX-Vp$B7Ynl>w3eBpIpe4fFZiwG6l5W;&e0>1RkAifA}#_t-4X}}fR2M# zz3Q6uryKnCoB8ng58plh@gRdex!y^36B&lg)u$OSw_Bh9*vwSw3chRQ%tp<9Q;yDR zf*q$GR$wUh3b268@lYzQ1mp-vv4-oeDZ*vdU{w4YVFHDycM9(l|2jpZpYHSP)!=Se z?WCrU7{R4ws$0dy74rfbpxj=Bll20|n>+H+<|5m-{roC7-9q>iRth-)&JJgS)g>(J zP5}*j_cg%za*8T#_&$VLGi#3Vb-E2d-R1Wm{^h;>=IucY?aAd%V%I%|+T8*-;}9?e zE3n~<*!$1|1{~LHqV*be1n1)}LW0?K7$C($N)`)6Bn&Tt^GkAW%Y$uq z1-=JF0TW-NABFFK{q1+}{`Iw&G0(1b+PPJ&Q{fqrSH?Lnj$LpQj%G?}6a3FY*bKDI zRm$#&SP>E(h1`Q?GZuuvrPPs_73YJ@S(0?ek&h*>VLaZPhG#7CRO={%9U!xK!)hlP zEddO~GzTJ?P}qy|C5i+G+%U#ur*LvEZ0@M>p=qm;*&?9(pzbv6vqIqqv@(1IrpV| z^@5l`zt~BaG1Q{%BgdX#o|IY#OmHzqL`PShmn18JMqQbV4F$W4>S&xJH5|B@3Of!~ zNwbyiTk@c6S-n)A=?_ab6@LhKhCikP{^$KsXT`s{|M2bS`lz4JasRpj?zb;`67pX> z9}E@FF{|}40_`?9z1D^91Piw1a=$)rj3sQxFuTj=f=_L&Y7^gPAjMU%3JMR6 zkfRT!mmF17AfX3GEZ*y@+CF}|*{_|{{d@U%ea-^*deQW`UHa7Q!?q`S% z&|_E}sd^X=KC~o(mQfR7tuS~IlK}q*7=Y(p+hJ+#_2P&(tacK+9!;0l?7C0BX|qI8 z%M6&naSA$GV(6;Z_tk7Z+_rinr2*X7T(w3koCX)XCE$OT*Fq*MJ%Y%O)jFtk^Tru( z_&DPYfMfI4u|_-2)Aq}qbQvSaKGpHor4|lAsMGaPNvR7(U>yEGPTe&R!`F5Y5;3qR z5bKCk2rnLiCuLH^fcjG%oN?o7w??h*5aE_1iw%vzPgh{r!kb6jC3;B z@I?!L1<3EQwN$Nl7DfOvM?7=o8h?mO`vVakYvkAv0)447;!8Nfj}~1Tq|?O^8nZ~m z-#H{wq|?!C!khIX8-1w3j`OnJVrLbIjEGnUbl7K?AOV92S9I;F4cPyER)|KsDg z?|!cz4!Wd%YPGWlk*cpfElz^L{xu*Dm&aILSA=gUI9fsi+DtBKev3hPyx0m545!u@ zJarmu6P=^}wg+uj34n=)cO|e}mC`h;+Zq#3y0s3o*)eL{w=Q`SOXICH>px=TARi~S zH?>%OUOD&RJ#|80fNPeP5&m|Eke>5u*xy}s<(XJOkXBnQBgORa3qz{n=;t_U~W5?Z+AKsTEI}8PwnaoO=;L+2ZIiAU?u;nmT->^bEsR zgu3f+Dcg>j!b;_0+6He|336b!z?sl>E-*kXFp~AjS?ZO;@v53oZqKjLoE=rJdfDjv zyGQKxftK4Zcv9y~LNEgj2F^oH1KZLzJxvyM0F%#}Qsh{lYb+V|Q@DN9xhxbm#!$I8 zEjAjeaOzVSF>$7F1mj2!21Y;)(O+(~mvgO^d8E@F$lLy#iP?jqg`kq7)G&H04NQ3P zxSoUycv8lksciZRa}L{C_{eF##9S9=ZVfhNSI}<_Q7ex_v<%fAtzz8*k7Ru$U=CID zTAr>RndpurZcndw5k54FRC_73WPzeXmO!WofSSfAc z>YQ*gx4h#$#E~KLFuMK3VkcdVwlO*$E@c*njdrO;cEhidmrYY$<|EwY8jUzX;@X%D z9#cjJ^p}`@S_Z^erTWVGy`lD)0_Ryy5PG(IFN9<7*QyATU>q$Ug-5;^-@ZmH>t|Lv z3HIlU4(b{@lJ@}niZC^#xZHiHx9}sj@Dx%kA!Wx9jJ#|?< zHeg2hQL+p(^;N9Ewc&b;SEJI7%4J`S`@4gjYrE7*M_KSF8^WHYlkUBx3978X{f+I+o~?N@P;qFJepGLO0o z{o?K|>jVxu6?tm4lWx;i*WM|x>Qb~2`T&#*7A&d^>)9$NQjF`mN6*&xjm<16Z&MLL zDH0&AQctIGWGqm9&XXPTK%X=7bW>K**aF8JYN^`l>&E*0beG@1dHgW-+b{25Gi>s< z1y8zEbKO(JUGf?Q?>k4N!6u8vIU3edYm*|=n-U-F_jZntu*cJ6rBY*&(A=;LTu!U3 zr^kxo*fIgoJ!%8MLkRV1*ZM24Gkj!semuY(qKV9*NRtf^BgRs^15Kk=b&gGI0sW3K z)Zk~I@p7?N!o(-nqfq0QU;OIV|M34G<8b@6&Ju;^o)w^kg?L%DOd`jG3}kf$VEyS3 z@a($MIMkfn?!e!tTx)Z_0aI}9)^JiQYkX>3xy)hJfgjY6y2OxHiw%BVd(Do@66>fI zr!U|3sXzSspi1MXRy&EC&1lnk?`Gw&h#9Qbxnkm^vxpZT0MWG-uP@eu_-z~S?6zV{ zt5ZA)cx2j)HTpU@;TM3?Y7t)Dd6&#A^J4;N24& z02$eH1Zcnd^=V?+PYBUyafSs0&uR#tu6NSqxdJ@6nsBhAZ@`9>Mnx9mM6<+}8JH^c z*9~+0=??4LcmM0V`Q2+|Yj0WZBnA!66mm-?hrvm>Ei~A$N%b&f@i3uM5PT;A2Kcu# zTQo4P0z>7v{9rXz&)r}(d{RZi@)Dv?GE-wAkFCaUAgQM?LeTW;S!I9S=eOU^&*wp{ z)K4sS(!FLQq6VjRHj{PMVuhY!B)%qH-r)+4o{J2l#Y=c%e!7JvtGoL5DV^g^O6K}U$xYU`;~4<=Ch zQDwwmankpZc6)NYlWsP>r!p4@dH`_)&U@br_;c&EXIUMN7;~G~1t0;NziqA#mV5$7 zp1>|2`*QIaRsio4Vy-jfxW4eZfVD4aaJpU<1e)TC$e%|YGG18@o_>83rH{^6)GM zZxtU=j5OzSB2 z@Y}ls8`+*%>?FF^swHuXz*>N9LNK^ojiaf;iiv969!TVR$Z-iSZ6}>wL{<{MLGK}4 z#HHAY4RA~CsyIq^8Wb-`(Coo03i$ctRYPnpi5_*}_1njH-+uM*%|T%1snt%3n~SrJ z7YMhkkg$if$B^cjSvlRMH!!|X$FtyN1j;hB=BiP24dN|bib&Ej>y%EA9aG56%Qwf z8sc?XUG)2MpRg*vi7JAfE}j|(1lk;8iE&hQqRq`!d$@=b(fg450QFs$Ukn2{8hjnZG{_Rocmb;bC8a6U>^Uiy1 z2wOms7EAEcMlKbufv6=Rr?i=!l}p-P2gDpfvwa-i0ZxF&VI?d&sbh+e$Kkx3%S*2- zY?*??jl`MNY2k^(=0E=a{(U^IaP_IxPQo7Sp=s^XkFm(MO3)>m1!hwUX`rbL7gpHtxjsaA> z4PlRf=UAsS5{pTAmZFwxSWJ3AlV(Tx*z3fApI_*#;vVGw)j3l*PmbNm=10ROx+@3u3JMS-vL0{J0Am_}yGH7*!S;f{8@q4W@lrNv>p2fC(np#FZa5D+ zTYmHA%fo7W_G_JlG&o09d=JKUUT|SVEd)p8u_c)${gYzza$P0@hua^8$Sq&G`@y1hT*GD7}p`2i=t~Xw{jpaea5W_a7|1s@_ zwc)Fihx`bwjdchkYUBh#qD%*x4Oqi-evTP2&T-cSbe|P*8UDvc)8mYGSdYvTi=8#a z7?H0@%Q^bS$vGh|3Z8W!IN*ca5WaHS%$w#Mx@}DK>NvE?kPvcQ(WqH6dbft)ILkchxc|-Fx5phOKC#$Il|EGy!WA#DN9{$O>ca0VTQH9H zYbDH9;s(&Sxb2iNHX#bo3P&daqEF5opLxNhvcQeuT`dA)1lIWj^H`0*p-J)4BS|@G zN+&n@xWmM!Ry)aNu`B>;rG5#hwT-64mXB}vMLfZ1nQ zQCXC-Ml3=l-jI>%M!Vd&A(JBVvU9LTPCf`jj~eU#=I-&Jlf>OhX9=Z^uGD)OoTwwC z#$_N!5l9=z+yEHFA#`ny5jpaEXR9({`#`T+QfFJ$Cvq=DR!_9@ad@OP;eo#EC1yhs z6GO~Y*#9U3_EAFcz~X~v7CfzZKj?IZXC0f<>*}SH247o%Ch<~7lA>;orvTx1ZE2wb z`L8@k*!s+#Rm&U^E}Yz|bs+<$6*>N&^OTB&M9qsyiLTX#*#zJw1Swu?Zby~@Xfs%)JU;pug zeTnpRnDw4o@GR9kHVrz#BJeoGM*O}YYJnkJOf6;LL?mR=4!HvYKPM*_@eRy^xeGP@j=-AbK9hJh>)#FXl4skVN(!PF+# zooo0E!26x&v6@`rtv%IRQxB1JqZrU;oULaOPIC2lH)@|e@PfZrcp#h|)+|T08oqfr zO8aiN(pk6F8mhMzut=ybC)3h{jY@ScP&^rawoo>`yaZN+6w$M$z;Q> za~fbToiSyQ_%gM^gIBX*OE_z$fzGYNBo;o7CpgN-_KTe)EWg4izzd-^Kfs4YI#1y% z826YIzxvhqGpv5qz%MEa4=8$Jgg_quJ z{f-@>^C*jb_kMo(UH{*697W)sUhph&3WvkBOp3i0FqCpgiw~wEp{DXuND_Yz4mJtQoSK5q2qa~+lHo?P#w=6YSct@J#v)Z~4(1xy~KNa$HtuG2=J z<=Sl7Z9BGgM2~zntTi7jgtmqmXh50b6wU`q?kk7z=2Y#%zm0N-mxi|p=6I;tj+|2c z+=?ebOY7nnwp*p@0wNS2neS@I5yacYCYqdG-@!$SgYJNexCK!G7buV&Rm*xpG;4b!6ExgLg;GMfm!UK!e8e;Db!}%z|e%af6@X!2&i7v;Z3| z#7hoPtzgbN7Z`$$T@yDToJ5T?>MR9FpGUVzkGYtmCjSE zoh7wKadA9EfwUwVfK6B_oTz2NngiNY~bs=&+ZNyp|xG=q{f+rkQ8If+LOmm!!1%-wdRoo z@Gq@Vk%Bh2Z-Hh1JM0fP@zm)x*6hQ5MIxtC1KhNvvf|7(Od{N?uEgn2Hi2PhFS-T- z?P1nBQmXf<)y_g7h*WFRQgy;YF;d^twOC5dp~h-#kl&Q`NBH9I!gMWG#^Q16(D&&P z3P;zK@GIbu1;`&c=+gvXu>;(2CLXJjId;Cn)`!{bckds6^Wod0Y_?zRq|@Vw;D)z+ zv>Cd_J^(g+q~t+BjLZmd*_Ec(GmgQq+b$}CVvpiQI>-KqPDVNeNw73df7G}rYiJ{w z;Ir}!%ca&~!cm*HZbx0)e0}$3e0cl*s7&_6YG*ZD#|j=*))Ec{H*YM^Pk|Hn0|37? zr!Dr)iGRpp=VwTOj<*Nee4EjOWLLK9mR^lwu$_XJbx^Qoy0rjzq6f7H%2}cJ<7TgZ z{lojC<{WRAI_Yu^Y_}An1Rf8Pk_#?Gof%u1T8K5x($&W16bm?T2ks{T3;;&v{hD_` z^poR1=g{GbB{r6_nV=yCvPvPHG11U9JcuwvGK`S9)-Q*9PH$xyj3*Rw6wiWd-G zmz9t_r_7nQqX2b>wVOtrTH0BvSdcmZ{Wz^U8i-xa9ahgPTgaL@H7gHIlY`OJwP7jv z48~o-AJ$==ga_V!{x`bzS|fZ2c#HaBTB=`M4@NTshz zrQK51KoESuFQqX0)z&~BN>VD+^WLUYwLy^Ta_V4#IUHrKKd^@JSKqB;EcVoDCl!hK z0q}+&cdGyi<~5Q6AZQoYXK=0R2rFzFt9^T7^ce>eIuBYPp^D|vz>Uo)&!rLRaIE1% z(VRuC&sJM6J`Mm6Ku$mWQRj<)_*i#(pvkTmJBf!ifj0ieHGrBspDKVYRm*Uxn*X4L+lA8n|g)tEpt=GD_`K$pMXk#>%=!YR3A`$;D zd+)X-*>N0+{>uEoh;hF>k^m{%Ol(atYP0)UnKJH$1DL#AStp<$Ze^@%W|BFBe3st=-Boeti6!aP3e_2A2B2Nf}VS-T;SVDnZ>k& zrG*w?tQm6`msfV9A~Ls|@iFf6#X)X_9v^<*Su%9G>ZGDkutNBJV5052@9Rm4pMRPX^A6#+Z@n<+#7 z%OBp}eYjbp;X_Y5DMkjbHD+mJjKGiuRuz1xv!|Y?0{*R*%BChHr2X&`8Xug?XW$I* zK3zHRRzPy0?vo`C$iDWL;X*j-F}H%oK)0zR@y$7gGn;CjfOtxY^A)G$kkU;$KB zNYnTmU~hmXL({E}^0CQpZbhv3&pPQCAIN+f+s_Pf&aWlGa<7F21mXh6yE>UWMWwcF zdy*D9Laol6eCWJrLCn)pLjWyfFI8D=Jk7{lxloQm{N(w*b4dnbI=@ro*A}a-O6CEZa$mbOf_J zb53C+q=cNbJquo0yGJ0cg|{dqwBa2PzRrq-RTOUII=*L=pawK42H+2fT5kpv z-zZ0izkhq9BjJaichZGR&QUz_f8s1o5HVhItxJ1!m;)P}LEFk^hI~%R?>ww%&kjq9 zxfGWG8%ipzhXTk5SHh2j<=~t=hUT?&kD|S6n(UIv^;RMA-+ps9K7Vy1qdoAjlR~0- ztnmv^0yF@Tj`PxS!GIM5yP}C9#{H}4)MMVYT|4+qga2kVVWm`7#lt9G*GB}siy;z@ zfH+rW@wXw(t?DbFNtAjsO2$q8?fAd9v)JZgCs}NP81b6XS!RKbI##E7&$HYXSz6y0 zGTf%%BjvdBv1;VUnb%$`#IiU#0fcNtj|bKX3)RSht!vn-y~$E4Wv#(-D#qtqS?tx_ z`1RfQf4Gs!9(dYG;sye96)@%|BMxs0$MAg_tJOHjVq}oBw&}O_C6xWp_>?a|eWccxSWB^WNYkX8-SjLo_REJ-EeIYM;+k>y2YaQ`yw^$)lFcW=J`?%Ut|;sq9a z@>wU5=j?)(2+qu-B!{g8TpXg+gG~)!6O~rF+nfvc8n;4@7n}%^Je!h(w;bAfam%opkyF?5u{8#yw48anSJ&4)t|q8eoo*$Kpe5l*F!^ITkhS3VkDGf)Ua(Fn@^%oUZ1cH6gP#ZQU1SBcIe+ zPrAa;Ix~<<;;53|~5`-eV!(uk{tu+MUnBoZ?((utfvC`VYud8v&Z`}2Nzbg5f4usA?AeJB#} z#Zr|ioqCC72oPA;;ZyD*SQ-UPNW}q{<9n}}=S8LOpoqio-r(Qk_cpO#$M*c;&z~fo zLC`yD>$yeWUFX53xi|#xe~i`ZSk14#sWggidsB-Cv@jyJu;hVI-YM1#0PLsc#(_pD zS#=p$7*wUTSwN8RALTGQk%LYAzqj{){^suWyI1zFU;gIM#y`5^q!@z_54@CNg~~x} z)0%>Xn?>FNOwoxgH|}2DeLN;^ z{qo12Q~_pnfD&+IA|ehpIs(C7Dk}r4Slw`v{MZa_j_!eJ4KX1lFUnxAKAVlPO2oU8 z%Pjb3-;BrCmCfHJMGD_^O0sb%gymfRZdUx2Flzn1jQPORPr|$oh;$S$nT<}!&b>Mr z;1#W!z|OG;KeE4n5>Vn+{xyM?=H>!bWm#^!h6Aj2eKn^w4H6V~d?N%XKmo#V^})H^ zfuA`A{I(|jc=z_rF@W%r2cCqL5&oFZO-hdD47d#j{9!sQwpT=BjB_(micoKNYc#q= zYRvntAem`tDG1Ur!r@(#(wt)z*|MQ(Kq(3skq}`mRpig3b+d=|`LkE@;lsgF=a)S2 zB*l!%^g74@kbky6SuA39Kp9(?~d=H)geL`WJ7^f5Fufo z5)x8lt)*G>2@WTj-QoD^K6WbyIp)EAzI*qJxAI|aIg`0BR(4ro_ZYG>*EJe&wt!W{g3dr)(k*l@K`$g51V6qLH~KyhhB*VUDMInUZz%WzFj2=>PHiMBsdVw0SW|Jd zIO)(f|I6F=f3){M$X(pdc#l2xBpXr+y#r-b;CRGL7j3~wVnZ@SLSns{=<@gLI7{13 zhXx)o2_4Ss`ph*up3DQV*2()U??kER70c=>e&xZlfxb!zZnEk1mL|NJ)&5%;s)JI^ zg#?4JSR02AjiS=iN&|?ZWyH>+qijy%BL%XzCGMKrh*_v`C@oZ^&spn;5&&NDEkjJa zpR~lk;Cst~ME0?;s7-gYo8(_#zxs#&I(0l`mB*KyRM`g_HDhrhrOaB_jF&Z!!h3Kk zDu6@P(BU|{V7C>T350s9;>|~l3kCxwj!pCdzd1Y%TRk{igGK7f-bdJA#uZo2ZsMbha={X3lqK%=l}?Ic)-QR=2Q<{ z5fEsc_3#5Nt21S172(LuoLiz8VQ(d7N=M?i3)n!)2RrMBd^i?%b{{-z$nHXVjWhHB z))N}CcM7rRL0MFld{KW4>pu5MzHLRrM@`PyKS%*w*Q2a5LKs1S>3|auSuEnmH8u5( zb8akIk~xF8w#Lx}px?jx?K^w(kH;=O9{luaS|5=|)Lt|+4jN26Nb{W5<2fcROH0}O z{g=C6Al7cv`*75BjGRRc5Ef#iT5Zn&zd`UW4?Gsxqp=8tlEiq>5?+OPaHVyyChkuD z_wp`|r!-`b2Rcy3$Uhu{_FCEkfSjTq!ErN&~EBV}i^d#t5O9qNZm}yQGd396} zv(XXq!LWN|5r)laYNXFpec`{rk#%SZY7`0(+)%#VNd58wS~ z?bxGsdiGPcCj9AF-5JsFisi{h4kSd2GZ~PhTOQz!+Qx_#oVt+xBSv(10(BY2WNDJ~ z4mi;vxOQ0FGb;cG0jU)m|hJa{>G+?1a_|M^$n{O87h z_5SU@-{}+jqtAZIStiWh#XPBSBMBh6!vaw<+p-LFuFg1R;P3nQbj@!^5pa?w?{W~# z<8mx|2*Z`c@e#={utd%RtZ{&oSP=)xPyZY<#L!C&2emk^v*G2#2b93BUw)R=`iz~k z2jCB(bnG^q%pB)Z4J0Pcy_%WwYxk@MXc%@iDl^sM)KRCBZDJJN=)traP|fm5QmX~T z9e8~CT3RNx1je(P11C=$tnzx)Y+u{!9|i|}_+Q_A{!c&q>9&9O^=}Ub(CZ&^n&Zu( z@DhOPKJn%kO8|sU0Y~65Y*dIKm3iL3DX81&w$8Jp7%rP*u$22WRt0mIG{=6&YF2wh zs0;(FAo1iaV~L9slp*$`vv#gA;HR&D`_(sJyyorb_W?X^>iZBAcPD292sn6N89DOZ)bq-Vs=}c-{1K3l!|UM}iO|8$t6}xAh_p*hA?nAOzIcE)*cuOid^e zmd#dD>;y-yKpOB)*f3g5z={+9;BITFZ%p3LKU{C9hu59vQOE~#^nkx6J2QM1UQ5?p zMo$SOOtr37H`mjp?x2H@qMADJxobLmbO8h)&CZb=$ZJl6!hvHZH#WQ@uCPl$8h9P> zy}az$me9Z-S$(sRHm1q+l~Ch}6JWsyguXV(Nuo+)41MBlOzAE4#y{GQE4M zx#{Sl(~b~5)yT0oEFI{=COcnTX-FA7?n_>PH>TSth}O7oIbOW37@$jnM3*N>wUZq9 zJBIKHhCNswCmkGEBC-Aoy|9TDZ$nuJ>l_c6=+m#>zy8O!AKwB!Ujro`TXvS247t*q zbI2!7*|J>$wvnx*xR5KgSve3YY&yeR+79AQ9q`$~d3eV)Eq4z%PYt}f;!5Ij1wzr@ z)XkBB!UJ0m1DtGy){nMaK4GOVKL6!2G2fw;|AY8$i1>co@oVwk)64z`?cEUV{kYv% zV!bC<{SVT+A=2Y+KL_U>Soc3D?{+BfFWY?u#(R9pS;kowJmQVBS!$*%c*7Qjl7P)- z=4DZucO+OIcwy+4`V@^Y)>~*wOM;tPo8YgY@AUt30_;X(+O|iz2Ua}G=CT5n+ z$U%kA1LnCJ-#xYHf6(16(cR_7;b-gf|G0Zxr~1f(vn=CRa5;AGa-V?{uWcl3RBX8vOG9#AMP|G7xEm*8FF$T; zm@nl@!|WEEb_`x>XPGn%F_Y_Ht2N~oB1?fIU|n+;;Jqn*55DiNZM$EV*?S;>(;&me z8_+ZyNhsABk{Vm{=7@_edr5{z5LC95b(qZ`tWkZ!H2?JHS9gE9!et)${AnH&fPew6 zf@P|3BOQ=~AV&|7{5BEHW(G*OUj?z30H-8-%4&gAKv$>|d2ucXSqnQq7km$4vJrbs zFTjRTq6g?!q@M^}eM_?(c9=&#f0kK*dYeTHoPGe1CPf1vH1htW{A^X&h!>~#%URn4 z-T%E~pDE!fb(TnxoNP$*%a!85aA6fS1CA5GKNT>nQHE*eoo@~PHW=-%FHHZ}5A)iu zu+tUmPlMK8M1ib)D3xMZAVLlVvkxDEfQQA^2kT<*-?p~x;E~2rGt(>RXsvC=o>!et z+gwQfUMdye2S8zKxw8(DwG8d}|**{`}p$D=hWsiu3AD^5nz_wgGqU zX(`mq2lJn1DS>Mm70>P~YNW6oQ_Y zIt&~KCL;rlJzPLr0+xdpR>?2D@wvaxzxwL4YfZCRa$03vQJ$EkfQ@usD;N&Qd81-| zXPLjMHiZ294fJiR+B~V}L#ZDmjxr1AOSBHEpOK*uq=sB(Xoh7Pl9!lTbOn?XxrIHY z;bp~Do1Omdv$yZH`)sz~?SOKz9enKr6hhI*f^x#lgGD%lLdoi zLN$ChTRz1c!s3u&e1k69*u1>v3r`Fl+3@e)y#4%fwe71{pJg)`rese!^4@Y3mg7ec zI$5g%Bp_XNc4BWviuurY^v4kSc-+PjoIqncG28hcEWM?Gv+4r*CfrWQ3G)wIy*`MI&1fJjeW^| zKkz<9f0;7tV=10Pj#6V+l2cC2u?j{jphm3oaRiu!N_1vDAu?KP@$X@$|L@b zVDl7lQL8$ntu)uBr5dZgnbIjfZ+ZC%W1YW7b5rL;@8CbRcVaTVV~n7a(W1HyF9nLFj&H;aR4- z)E87~){r$c73%=(r8w86yA_gFV8Pt(-}dd508>{*#sj5ZZUTEC0Rpf46=zEbe1WP> zQbTjC0mFk7y8sUhE>8T5;&5nDX;+0zJZ#op&RFViH;(!#McprN5I5GKBK0sP}Wzx@w;|85@flLtO}+KH+(FrHFpk6n295<{7pIyVkXu~V78 z0GsV3xLw>Gc=rJO4Mv+=@-@c98ZFK%l7i3}W~ps}`}74Ip~J?A=0hPJ^4;g24=QUt zZVu$=&%Qf$%JaZSPZL}~I1#M3B)k_=7weLaRfBVe7Q;+QYcoEIB|lqv(MVlUc$(oq z?Cwr@jDh7`>UsJot~(8b^IQSQZO9nhn8$9gy74c2+MJ^H=8XXfkJRwztEszuoCY6&}z)@Yg z^e_yMAeK{FrKcE=PMJDjmw8}3#DUMBr%7BtEQp*OVw^E-5SsvCr}%}1cy>fU4AVNSyG#8)UdNkcGz0u?81_p*OW8wl)(N2 zzH6d#IeuUV@QrwMv=U`bjXnpREtuWprtZgWzKn{#!e1U(aGGU`2P*ERIiE9-k}E5h zMgd3ia|O5sC<;qA@N18Y@fE<5ugDaM0^c1fRhend-z$B=8FXUDuW;)p@I85 zAc3f9+=QrHc3S15eR@(m{?Llk?g&QDrN*^LQzpmS;+ej5FpV;27R|}P_cjfud8?AO zD34aOHO`_0K4$GST+i5F<-ISVaoA9kf**u%7@B~(fZosH%Lwk^G@B!~d1CPQ6Q4Z| z9V3x&vL>rHsI*^N6>4BQ&cs8`2Gvjy&HEbGY2U5rZMw{X8y-Y*X`VICKBu)+B0xou zX%l|rSMfsON8Z1ViA=;JPO#OR*#jS&AKzc$Di19pYT%7>;)Gpz4W~N$VAId(IrA3Wd?RaK+AgQS0+A)_*n77+%Q2$b zLL#XyYWKhqoMYc@0#l>~)Hi2IzIz{dG=QiQVMv7=fKQ4(iodted<4K zhZxt|ip1cpMOaukV<%;YFQgXR;6Rg<2O=22F@hFsXLVAYy@nPX^3DzI^7f6rIdseN z*ym5XzaQOk5^6QddvX>gnVTjB@958U}JT4Bx-VOnl z&=Lk%CeXkXd^-+isC_Mvrm~P{WW2Da?fypp@+tj}LrYGhFJ&6zs(mF>Kn$(84$qW5&Y(sv5Ei_c4t7svR}&h|J10 zMZ&B_$z>y!%GV^eu&8S%X4ZqmK>*IRw%Ip&iKPrFW@ zR!8V9#GEC!AS1EIS|d-KZ3T`B3Txj-wH21v34+3|9Rm(SAnRf9maKU!Se6S25qRjF ztgp!u=i;<6{&>Jfe{=x!6_z@FkNL=w^G=&tsKT+b-lB(y2<50b0Nebf&vnNqjo^O1)`hQ-yzCpc~_di6C6F`S<4)((n>*nAF%zqc|78W}`tcteTh1DI^ zSL#E!*%q*OqM&~RHgMWgslBKQY?=nV?)KsCSJxb>J-+HRtnHE5M*tPYel}~VgUwSC zr)LUsaYk=z-Zm#VY1{n95x;=wX_&7TRFhOzp}R|Wn{`m(vS1Q~JQp1B9t>AC#SwFw z0T}$|Hu~nHes&E>eRAPxXKky89wO%fdckIux?B$vX(^cjUB~4{EqPN@lk?6}#fCT- zWjLOkQ8{8xU^opP))~FSpCrTqv=E9)!taN=3h-V7%yci6`S{NbzX*VSf0(O2^zqX~ zaahz+^RzfpL^gMRke@d5oX_f%_mQ!u`^uBNBi$t{Z(*@dJsZN!eSE+u zxb0o*BexY6E1Z02WpPAPb}M>ySOc^j-Rd*81z!ox0J2SUm6ehHWZf$He0>~U?>>6k zwRBe>l23EQju-iIG_#PG@kGy?OC6W8s7)xVzHeh$0&>PONdjKO3+R-JMSu)f@Kq7F ze0RNu)@1qy@UEG?hG0Syd@0ZTh75pYtCbMAKXZFeaWw$yF{rbu( z!3RHo+95$I%VEtJ$&@Gg!%Nmx$^t1xTJAEDDB}H#HbAy5!GT94o=RKu#1N@8%X#Sn zPzzm0;4~l06sZi$1Flo_b#{)(?!za!Rqp@#x+=kkK7N`W5yyj-6)88&;W`u8xb|5G z$AtmG1`WWoKLxGrY5s6a{+)2xCjE8n}f=TV=C)A;YqQGbCum^ zb*^|zt6X)u_V9w!WN_L9v8)0NrbSvKN7rH%6a+ivLkK`+A#H9#5sh}|(=!B?u7k8@ zcBhxpL5qf8YH1+XAc>LOItNk;RI!{|lcC9l;R_Pl?GpaARf3PKIPFl)A}C}Oomp&( zCD3u?W%87iM5bt-({B}Vx7tymWov=GG7$hF!R8Yj#!*7QwwX9G)8P$>HCzfiKy9-F zRNzp*>27xt@bwi{g4@rY#`p7VJqflStX}ZC%HjkMcBQY37?bb_74po94`gSzsuKMA+A6_^7o2ux2DFvQ z{xXF%Q}k|DAM&OB&)S@Wq6}8 za!&m;a8?958pR`m>aB{NzP_qR@PSXCcGld1oH#;#HL5|Dff$y{9Ec?3c+>-#)PsVDAhG~t5s47>i*>7Av}|ZTMNxN=j94xq_k%hjNO1ye)5~9z zlDmHR2@|n-rUkz)Hvu!+w6H*OKsj$_nrn&#ANcfXM`Iy^bJsZI5{|bno#Q}x;?Hu9 z0kVnB)Ux3&bw3TZM(lbRAdD&VMh3Xf;Dl1NAvQMkbi)O1DK00l8(-l+Lbela$-14t z9Iq1Ge)hE54Zj2scACZN4fLY&CQDaEc#>YJPTRWMbkJn)cE|g9BBv)Zl%VE-u$E#u zzL^!5VJB*%8T~KAG%otSdg-mzpd&7g4cbBU1z?4U#q*G5EWv-oBX@Opk<1j?@a$aYS^vTh%7|`VO1+8p5BB+YSFp(K zXHPo~iv?&ar5Q)gaEyg0!x;{9X=Np?%OrSpGlQ-7wmS`rS%(`4hc-HhCr2HLjG?@; zfpMxTfSIEL0BdWz2GGqx5uvVt$>k=5@+ig<*mYlFBaw_^skojBCBxJ zoq}9j^XvlLM60qrEylJ}vk}M^zA!;Nq61e16KN_GM5}#t8RDa(z`cO0;HSX$i~UTl z+@#$6Ppup>!~Kt)$KLB@f(a$j1FI*?YBg2x5SI(fSU7#t*Za5itjpWZv9aLc0Iq-` zD*FVxY0Wu^wurI$9*B@t`aR|-AV-RutCW-9pF=J<7a$y!QM|>lfHPo0_ zD6A)JYS|-Pjmf6JI((SwjcVN^^ge^WEQS2lZolVt|3W@Ip52cvISqGJwkp+;ysk9> zS98gIL!tn#0*M5gDuxJHl`F$T|a8~AU_3G3V;An6<|^# z%l8^93)o_eH}s&(R{!eLoB8qXsawe_)}7X$*+O#cX+_!xk&GGmE9(SZ31S^Aqm4qc ze$P(G;X8PYOwaC%QnF?0Vgk@ngjPL+Xw00GoDo!6UDG|_*o>@guZ=?qS6?q1I&go# zzq#W)lq-$2Uv!#8@iX*S#m8xSQ0yFLEV35;y&yBFt8$_gP{WH%#LfQScb5TacW=J`8OtfZv5)-q z}n{E^Byv+f4B;KVR0l`8V7B<3zi^K!Ep8NMv5U`ZV9-kU(r? zE?S$E1gOn3`5Z!OT7e-#VVU0jbDI>lXdC>7mt?>o8g*%Q0^~kfEepKBF6d-|Y8{k~ zs<~;7nwu{PQ8P+;+1bE;)4%xDH(z{xNHYBy>rboO1WjF7DjvqmNK)i52zIUxJSdK~ zYT|9^rZn&YrH6snz$h~NMT`0hTbN^UDRKmb_$ z0KRNh*XZmp2n)c&K%eofVl^kHMJ)gsf+_%uPzE=JqE6e(N;@9e_Ln)^e>Y#tW57On znkExUF(Y!h(K-NkiarB|zz2aPHg^qWJ5f(Vr1ls7uOm|?aA4&G@#zt7r*;7_0mexJ zn$QGntgOJ|oyOqV$_uBqJ+kj#{Nl4uA3nZ){keP;K#S*^?}^8pcI{1#T5Mla@d{*! z7^XmztL9pi7{$WiDbeO+2^?#8#X2>23EHhvlA^3KslAh$3`ED+Ybz9cY4}whfcaX? zFZ^AFy{-DPYU)S#pF2OEV$aWd!fBnS9qgksu=C(4tY}5lY?Qo3_+0lDD)8j()DZYi>dSfR^#T3Vl`H-z z*Z}4%sks%SaO{rZn+lR?;vBS?@zEUgh215OZu>X?{F~?7Y_s@03b*D8sc?)Oh!+sw zWDO6va0{2aq*OTo>;CyW2a)cJf^$r~gvRY07d`;$xRb+PQ2*RSa{(dHV zbN8#eS5Ne{JY)T7{H=gzuaR=4O9jBVh>g{HX&WDzf;=+XrnZvG<~tP9Ii;?&VbVaN zOSC96R7r4Q_5vFIkNy2Vv)QSFY5+tg^)V=%Q|jLh_#c>GcJ=D>e9bs8COYF3=-HhN z(5NQ8EE`&?_1>-Z%^1g)x3jU>vk?t`#Xj1$q6Q6_JXRJT%WOBsLu~ntB5uX$|2d61?l~n-7Q_f%m^}gXkiD75B)F`8! zLDyWs6F8i`w~>KC;CL%_@68*?M3$vLO!bbOv5Mq306D`=FKgf-Z>}-a?(?UW%mSe| z*aV2sORmnDDEKW4^<1`K_@g|!ZtDQuu8vt9kDy~)6Tp2)pGlon4^p1YW`@mcRm4Em znK;*G4bdUe0X`N>2XASZujKs)d;hy@Z1cd9^R#H&Kg3A=}|g!*Lwd(0nQ*gCh_&zN|d$Z?^k)zk2`rAK!j_`*r>+Zz%D^9b`^gUEnPXF_6l|`{^PT5|dL9-5a zjcMJC(JT)br<54G1JnSpXP*>szE63vJdW)k6iyj_07hny_~xUhoV2eKbSnej9VoTE zG>iT0pT4}PU;XB-D0cNx0~}qnwZR|d^>=ul{Lyw6=p`V9W)~5?YexW~dbs%sW>fJ3 zu7+J;apofy2vk?(@FWu1(0t=iOR6Gy!eek5pJPpHr%Aunbe@3Cj#ivLiy?ejOW1br zT0P219!Qj@H#KntT9d&lnmbAU@r!ud2JL6D=Tb7Fxe@yyJwg+jY58b6wER{@IWLf z7#a2y9>RdA?jK0xB#u(`W1$lE4xgm?wuX&y-cpovOTWyC0qgU2 z#m@huJkf6V)Q8X6aYSaXE{Bxx7M3(x8F*Z4l2R&Etqx)2wGq_uo)Sg717KU=$bAmC zA}`z4EC@e6CJ=R_hV>W=L5&5<(|LRv>;cgSrm;X*yKc)rJ0LT4aLqXe7{&?;r#dnv z*p^U`ld2rPf#Y`UP45*I^g?43Rx^dm5k6bz$YevXCHu=pu|A}PcewGj+~+YbRU2F?&j zrY5A&W+$lL3MR6BI+FNVXY7>|)

OE4-Og|S{O-!U zyIpY-&}3B!<%99zb)lZf1xrAAVgpef(U6ndyx$@~O}fq2ujXV1=^nf75_<%U2nwhs zB89-UJj)~jItea$zaBs%WK8x|cWFnr{`kL0UJT4R|E+ zipNI@ZdvFfB0G{cehU4(N1PO@N({=j8h{yLQ%z*2VVTtb_m){u z1t2wd1qWe!vx6VrgZJ4ZZA`|h3{s#2J~F%0gj9lTt^?*vNwc4&!#vG9TP3Zu4zxl& zy0zcjz4`u$^2TRA*5dh(Ej_bmK!_v#vzP|e~|FXBg`{MI&-^={t z6Vn2&Tze9>EpGLa$54)e>XxZbn=3-nU{8{xw5$)hX+TSEm)J!YU@G#Ji;g&UvTC(Q zs(_e@_vHc@MnypDxlozDN|mIpugO#LE6wpWw(0Hb&;DTZj|WrBk(DPU`W14kvv9Ck zMC=FHbyk;F;H=)4Hmkg1-k2i$wsQ@~F@h0cuY%Djm|LQR`iP>va&{hzQ&&ceio94T z%g5Pz=1=dlTR2erd)d)9Z$I9xyD1mO#;yJND|>$w@E%-z(&1|17$*r6@3I3M3%#=Y zfGYmgau5gVtubwKiO0{~F+aTI-I)v2gleG_1yF$dQ4SdNyDw0j0*V79<}b?klzcQ` zFgIrhS%0oYzC;#~@9j5lpT6w8_5mklkr-<1h&0X57<^foikRxKouN&wEx~MLYkzB* zl(!1b9$DSZPEoZr6I`$?;4gz8A~*%)jN*Xw0L5pG(E|*JC}TK|RIhp*6hE}D-+V+$ zc$sOok2uL~)YXPqUPf`Ft_cK&9Rv14tOwhRiMl4k-4A5RZ6$+6Ou%>sfE{oZzR2Ks z$HMEq4o@88a&D^}xRwwkMa%FBu3DpO0Ch(Y*rz*gAPba(I(d+@Rj*wr%7-a29c>BXd+U7OP@g*>sspjiXPN6^z`x;0HCB zGz|w>Y#b7pEgYdFKWyR`Z$8@lCDVQ!8h0RV99($PQEiju@a}7v*`?IRj0^M-ITfJR zQ5LS1g1md5t%p!{Nn9LI?5Ytz9bdr!ZZ+}9edHBDOE`#j6v|}q;(FEv$kxW{lLGe| zkMv#r?S>w^9y+k-Bt$!+=CBqU-CQZYB+ptrcnA^#d%!Do6m4e#-?x&ouBX{kjxgga zZu%s?hsLIqi7WnFwJYGwF&BAjmQCBWG2Lugu zMxlf{M@+>=86bg?gQ`|2b5pxlLH2f;AbZ|CE9l8`3KOhY{TP!|VvreNp}`xdFa-pX z)tpK?*g$L$ph^$VFa=9pSa5N*DIQvQQdj~H^9a&L3TCx9O_@6X)v9kt@|t2_bnh#7f#-N+?- zq>J5U2J*OFxEYc_Lk<8@u!4Aor-m@P!eI=*LY5F!P8)MESDpdmPgh(AU;TIBS06ZD z>h;?Y;(%~LuOn46D&O|zl7j!;k6m!QooPk~lywMAu9nbqt$hZ>Ke!Sw z)kLD_xnYnLJGgh!<~ken>X7Q%)FVaTk8bQu{O7-w?{Ltx1mhquX5X|tJN5v7^H4mb zW-xW^=w_$|RZw;bUcl?i)LxbVQUOn8%KEbKuk{Ib0~l?sQR{6+a2{P?g(c$8u>h`m zjfMX67W{W#Fev@v)7`7b<(02re$w%})zqixDl;R~Qxk|2s8Xun%>_h){lk7UCJ|U_ zcWXOgRLc!t#{$4r_aPfK;#ad0`~bqL$#|pQ>mry)ZBQJ7SGST|yvl9-J^gB$|@ zhgY9O5b-9LQ4nha=YE-EFSxN1utpc80q}-i>vrmU+uhY-^AWN1BGHep5@8Ev^@3vq z=7>>%$HF2$3#IxF-sq-F$y`*E*bg3-Yij8dc}$BCo`Ngk}-L}8K{DiTd$sn_WEmk1X* z`K5=-4IkRpuX#>>O>Q}~{v^8~OyQNSB~y#3)a<9jMy5Gj1;waD&$HG|yIre0XQ`P2 zmJar0%aRly>jZ;Qpfe!jNoihQ(u1u_V2h=t!L!~)!L^{_Acfy=t9{^+?U!G@z%ma# z;v~H6v%7R7#=%=uqFF>XWC7mTMq~(<;)YElQgvmU^8<%bmoWyZXl~xmREL+yP7Fyc zAY3B-=MIPB#nf`X)-tIX#878PE^nXM+HYQNo%@eCiFYFF$HESoOLx(weajHrhEX|$ zU5>M|5cGbc;f?u@?<2n~{NZq}_)=o>6tPPY4mkp6VE2LV+)7;LmW0^jLSS>8ZQc|= z^aa-W=AF%ta`YVRx<{N8*kAzx?VA-_Nuh&w>7-ma^xlgMM73F@-q&LaE^HId%7|Be zaRgII*!%+L&|;bZo@e&#<7RUp228)8Do?W9r`(~@4^;8H@I1wCac%rj8C(wZp1*oiNq=);*(S9ouvtm*X!19J{guEXWL|2z* zTO)wmg7E?7I$#AnR~mkLLf*ld^-&{smD&QQ=Rzi|MXj@uM{m_lDGZOwTwjqPLxy-9q zvygL+92DR3$lk-+o})tq-xPVrMN2(7UQIL}_u-4Qg9Vj8-B-?e|LfQOU;tr2p1&2- zwGTPz?!XXCK;ymC)fBJ1fpvHR1I?AXOHx>9v?=o|VcQl-<=}|e82WUjh;Vo&xMnrv zH+Siky4X#Ow0qE55sv&Fl(cyTJt-C|5_lnm zv%%h$v=*IfQ|=UZHGshAm4|qMX<4$*aV5(<50ACVoKop(#Wncq06K|qQ)5{H5>%X{ zUv(M!@c#bur@Q&b!!?@Ee%eVUtE&WLcdBCc;G(iJfc4-DtY}0k3U$_V-j9BG@D75@ z=wq$O@%1{~g$FHJ9WW$H^3f{7B7&VKg)OO;-05?7VD~tZh#T3c3Rv#9)1|16UFVT*tGt?Ny7_)#ah6?Um& zPh*Zfa{_d6jxT@5Ls{2`%K5tQ&pheg0_3LveIsi{HdIbsg|f_j zwUoo+Q0?Ar-A`dTZ&O$We268wx@1y2a){+MJm&+#Z`sMq!tT_l)4`J}-{MFdIuKl% zK0PNWKDgCizSU=h#;YE8j?p@6t4nsB8qpOzsU&zyf-6Wc7L0b2;Whyho4$>Z6yH`r zdIuEY1VQg2LfsJi8W2hMkph$n*36w!XZUH|YFR#W_$KhlEv-f%enb@X#ZNrxfE^Jn z0vS4lus%bYNH|?bs|`M}V()A5jAJ9_RN*2U+Zp}<#?!#D1VtPL+JQWl7**sX`Ve^% z7;D1oQB47XQch*XF%$mi83FU%Wj}wq(Le0))h0XoppyzCz>z&Wc!onh(v0w=rCXDl zTMY(G4j7j=!gHKPyra%-YH13WV!54-&N42S#svS$fkP|SfZO)UNoG-|rJ6w`YRxhg z-g!Gi{o>Wz`N!woT3!FhlQ5*XKIbxXc*{K})WYpV$0D;16&R&vo(CR1cJ~>Xt5>Q= z3|CcyHl=t9$X*|+u$_npF{^zUh~EHa<>|ZPX4(S=uTgJlby%lh0q_&b9o;+$+1+1Jt zjP6%i3Y3yb<MK`m3LKRwbs>Y5@o#g2r9WMGBs1X`}_TU~Je9Bj5MC z8vKq96kc=TztMB}ZQ=Ofm`dR|_PGE+1{(!K0-p!9Henz5=o~2Sfr@lpRh;zrMt}D9 z)!S#llItFK5(&^bCp}|~0jegvl+4*xq`fiv0{7AtceB|mOtK@~KC;0R=9z|do!4B{ zba7zuwP}=C0vlo}FRAdoP~QSe)=Ct;V`sVEt3+%cosgI{w<2PN#$KsHYRTJX+&$2c$YL3EZKmFHP2Py#IvT z0llOE@CpDMVbe5kY`WXI+xBTEd0RmqD^zxAIk**yaD)RGoA=!p@PUS{oaz4UX3k|x z-XzjK-UD{PlQLO%SkduD8(0Md+|3Xo2RK9lLa~(==f_cjH?IDSQ{#s=neEOuv)Jxo zXZ5b>;9Tfoh>W6CSm=|}(S+9Qk3ZV`_j31F-1zG+|M6;59ed14eYuGzx>(bi z3Dvwqr?fW}Vt79(F}YA}(=rXZyiHukfo*^waE9OUv6 zGd^20dqH4cXV17b+idT*Km67$EcL*n&bm1pk>fKH81TeWiNO{qSWcYcs0^=OWpK7&i4y_O@SAOE#@`)akwP5Fv4;fg(5cm{ln9>M;a|M} z^x+TBI5WQbi61#d{; zguu+3>^ykoR*i9TlxN(mJ-pGs9sk$nO-=W}6HmHl1LW=_77wEAOX^+NPM_f!rEwt9 zih|e}@0%{B(08`u4Nt`10nXY$`0OI9*-1^_AEK4#p8_vuZzu5 z>rM+m{?tw(??^F1HrCBhkZDy`UM06w@cO{LRi1(QAKvM2>=oSPId|L7c;;E%U43}- z96QLF(hG>6no^m=uzG|;a0F*>n;A52Kk5_is}wPg4$O@wR)sU2+H9d}>+r{DiPzw~ zAPr4}kJ2w~l+{tiLtOQz=_qBz(F;3ztM8w36PBlV!4ckp=S^G@pD(*e@U zz6Le`O&_V>-2pU=HQO*>vo+kN{=3(*^DAIcEr25M)Z{r-bh(;fD4aYm@FN#>xuSUqAwKH}YqQ6k zhWvvR`|VuqiD#bVZn>{eLWvRE>%f7v3P2q;8%~orQeyHB^L~`fA@9r=vyB$0y3g<7 z9h)ye<}GlDr(2vto162?@jN<$;FVPHTLnf6+sY7o0)m8@34OC9?ZZ+AkSRpjKjl1N-@X~5GDstDN|~zCI!8S zow{C$mu|5(Ki!Rt_1ks3*!aM+PAaBD0IO_sz*ZtmMwZr@sm7t4&eJGqT0_1s2;AKM z@)O}sbtyvX)CAATy#Uwe0GtRUsCiaoInhyP@-pj~(qPo-HJZ7j+RRUF@i+7R-Mj0n z430nQq;uoK%NUIsMp7`bSY-C(kl4s^LBwFT8r%KJBb*<$ZMg`xW(?9`@S>ItPPE3* zp6WvIY+fIDZW0#EYI*$bj$a6O|faai@T8Q|@nAIK6x0 z9OO6GB!CXX@WmQ?3Vl|Uz)nqIifM~8c7UG@^)xy!MiS@y~1$K^XFGzgwh=B4ycQ)5Rjr*2ppOeiVuy@TTU7vnzHS-%WyN+3V5DIr8>Ylly+~`ht~%t_nmyeMf2R%7Q5=Sdh@Yc z1JrGtKN&|>Yim>md(At|XW2zC4u5Dop@WZ|%f^{YtW!eNDoPbD5UU0<8iwU;&3cNn zHGqqyJU;v-dH;`(y`Sp;Kd}6w?IIEZf|ktXEiSWB2goSw<5zJGv|j*puSm7ZUH zk$Pax9Q7c>TNX!_B5xgE)w``<=5P5bX3{k0oxj1%VWmmvplWFX{_YKn( zpYTa*9omrdv4tYXUBZ6_pR<|Rx$E|y8}-cWrgM+Ds2Bn%0B>t-K(lylN5(&+_raMq zNHZf)JJYvKhd4sdc5pI#C|O%(tJa8M1>740fJH~{$}RzZ4-S+20ykIYU@qG zF!dLChtu1?J>5We_#qcTGa-lC*lMt2N*x?14y~k$VrhefJ!A=M)ue zNT7#CajsZP6ubaw;nQf*-ixdm5IX}eVLi4_qh#tRLCcXz;~z5a`57t49&i-|aB@S( zlCWMI!cHtO8bvruuY=P{=UVrHE%>|}(AWTm%~`D+a#m#whfGF*yvnlbSQ`dlP`e0A zCo~tu=dY<_3rPaw`2~*oi+y{xYUt1dF1qAdHT1zMp)q_3oJt)y=?4^%#{p)&XX@46 z!vL6e$7DRulryCP!7l@LLxiJk6(6IyiLk{fRpiB;Z{?} zxy)q^RTVNI_y(>Y*2D{2x#@cz4a62awrKLM>$&>!ooUZEZ6ANiMM-C{&?mGUBS)MX zP@7YeENrX*j<#5Rh7Iq1RMPHppw}SyzdB>A@NH*-zf#!|NX}7&Bx>yrsCrII4f%-2 zY{F8m-UP(+c^7>R%iQLO{~o`1))gQ9?u&v}o2haj1~^7avAPaJ_sHY@=*VX%9D!hS ze^wc>gLX)aIv@iWKotm&Ln0!wM!{Dt#F8mzz!K%I6la9l7rtVF9H-WB==kL)R{R8c z`R&uYaV*0hUwTm!j8!C9M{9*_5`&K`h*AO_TpW*M=}gJ@8dp)UOLoZ}G^iqv_|8V& zfc*no7Z=#4!~>Szkybj}Z!OOOw~dy4Z$rg2<$i$Q|HP!fd;Rv|?enDmz?zHd>k9{3 zE#_|I3fN~&P>9KUuux{fE*eP0c)eNVg_@gd=l0g?P|kX8ih4WY();5_SRmi(`WH*X)tX$O2@*+t6Zy_lmK zROqga+1Pb6vZ%g`pVT*S@ZXqiYN}GejwG<>?G%g<&>#1uPE@O8D9`>`u zDQI9XQ5}(E0k9jAuG87z_^hR4%Py*L)~-2#{({OS^)(f$O={y2ELGWO#%7sw6Np0F z)?Olx&1k?`@iud02{J&l1^Tcmd16|eMuP1@DgQ1hSx}|eHKLG)Bej=5HRqujJ zYDxmb^`vlQi6GRxT?I_(9AN+pabjB?qum$dMen!W_HME0L=dOi^wTd6cF9y@)s}n! z(gLp*=@oc%N+&2ztW*Z6hckjdn+J}~dVhY&MPg@dS@W%XkqBTUibSAhD^i(2EV1XQ z`*lA}ByV#tOPKwT4jhFz)`3F})EKV9xg}EwLke$BZclGJ#8Zx`c=( zc~BOlg6<)=D}J*`(?|tV^;&W-ess^H*r~oBsMr6uLI0*t_FLrDr-%OToGYGNc@Z#; ziLYi()E_R052dLO(_)&e@AZ+T3;-{iJyCX>0+FmOF*jDlXD~^Q_fs}=%c`+arJqL@ zLvzkRQSgefj0Du$)#~e!qHuS&*cgWBl>wkO2jW`^o!9`gT=wG1^4LE*IGd%_$R75B=){WsmKun` z?05xcTDN+YI;65e`m{s-L!X}X5M4O7?xIXx1rQ}NnQE`VETNc0)>EAIH#;U7{w>E zFtIC2=_%d@D#P2+x#T)NFX=U?<7r>~;q_@JY?fT5uz}z`SF1^Q$!t+zYv+pwzPKRK zYgDB0`%|Q}A2n^6?dO`{IiM~bwo>OXN-xwP^>pPD_AB@RS}}6tZ6JFS@R9Q@MnwtZCI`eS)qPyvkw|Jc9Fo>PF?-<*mwf7K@FuRYuL6Z#xlezz~9tg`GAzZy?*ka^`Hrb0i>^XOl7*s;2Iv{QgMBo+F*FVy{lub^LBWXkQtMd}m%Wjb1w&i+JeG?u=Dn?vt z9EX}$Ve^bsmUCtv<6#GOcsj9ov$0?_a4LA~&BAGC-1;>2)#;e@p>-EUr2+cZflnC2 zJ@Ry#)E5JIOv1N2@W`jG4Sg$VSJ&j1mx7$kwi{}fVFQ2;4CMae24`tFJa-N-x61Mm zznY&^NyY9!aFp}(?Qf5dbG&=|_K3#*@ugSwF)dK#3WBwOSjGf_C<_GGoU$w<#?id* zn?9x>+k1vZHM-F?PT|Cn1g|>D;0G4qX{kKRy(wo#xHym>MoHK^)hjkiKEEeUyWm%1 zcx(X*iA{$^CWs2X2ISA|vcZ5Aj3L{!O?7N*G4G-g63Gy39Wld6(~dB@dme9$0gg%r+k3dhA&fUQ@)R9s)vx z6Lvm2n(3e?KqlcZQ8(qWOvp_`0(m9foC^B zu99nu3Awqj02!V}i~~^hmQ7=*)gi=zjz<^xdFPSwr1z%${lgnt?gdWxz{-mho+t}H zN>3pVP*rEFxM+<>IyHMZhi%+RH$*MREk;F{aT9aD%?G7LfAelWJU;J$kAC|_RbK#&06ZS4F=hZqtxdc(pM$!X z3!8fe0{MO3MXcHpGhT!uqAbY`kl&{ckf}(mjwc{dI9V@pZZ=p$qMq;MoJ3AV(H_=1 zfPwyP#LxMQgTep#H5ZLX<{McMby*(7saeCpI6N6*26Yl95R9Mq@yEyAd9@cuc~8*0 z?9=pF{8Y}T_C8l2-4(J1?1I|CjVoo$92|}X$??ao1EA*zOTK&aFiseL_w5%Y+`zGB zEpj|TRhiye0_s7S?;N_M4oTRi+~48{7u!~T({oy6!G~(TS;5E2)s=?4-BVdKyaNm! z!)0JnVVPskL%e|RAu)slP1*l8<9h**FCX6>C^0><=%Se875sE9P|`Yd#I9?Mv<4hv zEVNstij0j061#(UwT*}^R0Yoz#ieX!9jz9iPe97r!kC@vn%11>3B}?rX%-7lzhei| zJ#dHlgE3Fq{?}u51I{%C0M?=|+4^-Z+2>xZvi9uGHIE&>5@$=N~^gZu8AIUvxj5)CH;(>Z)Z_ z#B8T+;k7FqH+Iv+cA;+uYPNmR#K7wvd_+24rUkG1py&e<=s=*!oMYt?eVPU{3Na$M zH$}E>!E%hv4%CqTV8e%LCjia%+b@EVd5)w>Bm-x64pj!FG7c`SJpc!~1DoIWaG}5rlxBt#}&z{Ava_V?*cxidhfw>+Zq}{z5;mF5kmFw`T^klmM7o; z@_EZYyX30g8V9890c#A&65M_TUfL3LZa9f;mf`P8FG#GrNFZ z35c-g4rn&qTl46U<-;qlnq_hmV=^BUrc;(fAjNW^VL%49!n21K#|CVs?NNUPVTyS5 zYrY-nRCv};8&fPhQ6yrA-^3X45t9RRz_UYLk$UATmvDsB{xE#?doiU?Ug?`72b{;3 zUNx{45RfOlStrOQNGjfAS4XUU(jy!;!b7)*@Jpx4U&H2~2 z4+n;t9bI^lu3w)qSSiwBH~{rPX(SDNQ4urx3JE_XZEnDt-w^`5-obZdV+5N3W;-Tj zPqcOpTa~Ij`~ku9Y^y14Xh+miH`!vKETMRjA712xUy1#rtGVS?W*rXyBd`+BpBK#2 zr;oCHnBwLB_y-HOGuvI^AZj);*HQ5)N@R0RY$NBEJnS9#p+d;h`_PRebd7^Z0EkoU z{!pg=w=qB0Z%+rK53RXKu7`7~Y)!|@*_?wVqtMY@$>T`|%sD7YcApSZ*os@>#mBFB zepEC~Afq|waDZR%i7UC|UFY!|2dOqVK{L>76XXx1bMx^)z35L(c{&DtXw6mUK&%K7 zyp70~v4z;gAspv2qJV8UHrkDtYfMhR1Aqci}2I+TsXb9#F03jy-=4v zfM5&fbc0(&grv|o!1T!F%e^Uo_s{3c^=eu9b}S8q zgQ%94_pC-t*jTlfpv%D8Sa!9pC@*pfvT-g%>3OZwS}j0;t*a$cPzE zQ3PzoCh$6IqEwh{3Ls=Fpj$`jop+9)!5qafdIBr6)RAyKK3C)b6OBF01X7(!SHVxf zR>5Ck_H^V5>;v}vfBx`#9XPZ*v-+aM;6%bK$dPU4Nuh2)nQ9W3BIw}3c+0D8>P1;? zxIH-SCgK~XDi3fA_IG0sDBve`KdT2o3T~vCJ$5AADvek2zIG3?R*&3^eaNU^JlS_g zX6c@Nz*XI6HBMa!-=(Mznn8R?-w@*y%vU@Di^k3LECDjzIHmwF!OH<~v@BrOSz8~` zP4aQqgHj#`>^WEO6Mj=b8WWPoqLf~V{$$4fiCw>Z3!CZFfxDcuPq;|1B6u*jQfJp} z0XdhFX&KqI=P-cqi|-)T{vJ$a0XNtsa*0*OWH&Ot!NC<%!7G54Iz?QACZw1;<1D<| zfqOXYGx;T~anW{Q)4bO2zOgr7)3Sfk?>@&bpLNFbOD;lDGqhI3!9YN)HM$6RG$&tL z3Vh&!V86L6`!lg66|Jencqu^b;;BvVhH|v({_V7TKJpt@p`sw;q9JfdwmK%Ka%v zY;h~4lLgqew>A?f1eiMX3`Uw}EK&>enSnf-<>|}Zb_r4+z>2Ad;p3-U?nH_A4y7SHS126#@se8&9 z^8U#wr`J*)4?EFC;o*3z+GSdqeSw{K?4@Ak*gT|r%l>OX*z-)}_|l6=34%+SHM?FN zd-j%)0OBhwk74b)u_J$Ml<`{K?i9A@*r2ZZ@Es|B)d~Jm#9{>N?89ej!2};t@=`P0 zfhd`g=x4OJ(t#W6dy{_p>hW=Y`f#8-;l$dDaypos&4Dn(lROGs(0E{m6@a)Yq6t_- zahs8fF70|Zy_Vr-S=6}8A@jBGGs#MEP|lSID?8Bk5Y%p>3ldqQ15YKSnf0R0aWm;J z%PP-3;v$k#l||ctt3qKr%IK^Va@8R=yI%YVzb;PyLr>mVqbZ_D64#CukGoOF3*XzS2dj{79Xfu43=Do&ftR4 zC~L?W>4+?FKX9^mZ__XEr=LE&J~TJt z)ar|9N{eMB8?pJ?TN$%0e>)1y3FNTx1`yQF->dle?e z7=n)=i1<3km*?fW2PvIv4E&tQ`tSp%jz6;MpWnTG_3--n+MMT?Tm-K=cpM@L6`_3@ zgSFR|SD7FrfL3|2@lfXdnJ;47E}d(btS(M4Fm{y|1A-a=w8FkEDgq>s&)6u`z=IS{ za^UTw(R9X20u1SQPdSaDHi zB*RKUV&3#Z18Rj`g&>l)SMDAxo4~tB)6|B!ja~zL2~@L9-rqFEC=G3^DsWx!Y&8mU zBvaViTUfETzj^oe>%YE!W8>X{e)MC@E-J%U%7)+t&YeejVhgO#rgloqxBgz?6TtWW zC~&3&v4u_1+tda|=!F~Tz)9i{#{A^f zgS~$K+T*ze7jX)_@CZ2+OiIklbDt5OW@cnG0r13 z#FD-_v(2(q^OQUb<^QLzt@KzB{aNWr1thk%!wU_#cMfsY)$GB!Ybr`H(E{9*50s(( z$evUzKR^y#VYw)$r!7`x8HyaR*5Y=bM&QSSJobV4O!1kPd2-+*-R8 z{w26N3Zj3U8JyW+-^E;7le!L6K>c9QPaj^{S5Nx-%{t|Wk1e|hkh19(;bJZ~V{Vi= zB}*O&0V(tX&MeD`ZASUAoqq>NW6gE3y7Im3*vKJ)1iRP-bgy#S!t5=MrB$m{Yg7y{ z1S5)6fvcbK0^1%A)g3&)IC2}-#@{UF==4vU!Bg%zecaK)=urmi)`(<2NS^zx(!! zTH_4K*Q#SdaE3)PEZi3`iVn^IEt5suGi_w$0fKfg)Mr0Ht`OH}Cc>8HhLlP>mtFQ&vA6`hQIkKSss>b>rECt-hAPg37`TS1lOwaF(7n zL&K=;wPU}?1d8`~I^jrwF$U+pEg;)kTL>#=Rfivh*BgmsSXsU=9l-_*pjJN6{`_-8 zo+JPtUUZR~f0o4Cdtohn<<$$YkZPLhYBke<*E73xe+-1+w2k&`eSqO7dk~Sr6|C38 zS;#2CSq@G;QtQNbxlDCoCgkL*MtGmOEWnya{!`B@O5o37BBd4A z0ovW*$U{{&(A`6yeN{l{o~jlgxLPVNXz*EjbikLHT@z{5Vi@GAHd`&|g>HvZ|vO%3adfp4*=MLoQF)Ijo9)zfi3IDt!zM$yu`R%Y@c2z41+dI>w zRHFi~P~0?kui|1%iRTCwIrDRaLCdxfqk)A{#GH~kK998wd&0sB9uT)UcB2e)JebqQ z>Kv*RQ?xKdO-tsfv~a8q<(colNP#NM;fyoZVegzcA8mmPjg@kpb&Uyt0>f;yFtXnY z-yxJlj_Ayz`!$VI?`PxuNC$XTd6R$u)u_Ox98X;)RjTI1u0tw9L^@;lzy9`%6IS1R z_eHm09Raw?4C)8sed&lhGnJlsp_ti_7Co@|Ci184FdYg5EKz_RcKCuu`xx*sGT!yX zay=w?PQFWyW(L*u)F#y4cnt;;aVqk|h$rFC2Uc7qzSCg{Bvwzc!8id{nx_YBGzMRt zl*Q0{(}(@rUf3^zHK`cqQW*T1f&>?kMu4-heURoWOJ-tT7Rn4GuMz-vsoRi_lu7>B zkT1x%A6a#k=3Or&`IH8q0H4_R3$JG>;{2$?x7-$x;(a+J-s#=V3#DtZqjI#?edPIb z#uq%8U5(jNQ;`}*0G<+trX;}q2>0Hz>@OUVKl;I#|9E`*`?03C18XjVouvZmC?fkD zGY&u)S%}Txzgco99#l2E7VoPfYS?W61&7ip^>(p8@kwUoT)ZK1_FNo?d?lon=s?DL zr~3awJemTY>=&5wS?eDvgm`YnMHer=JI)#PmZ^t75EnEi~OUI1=_1m{MeT(0J z_0<p4l5s@Mi z@1(FuP6;WsgA{?DBEH1?PAf#J?cpc2v27agQ|F+xiMK|C_bKt|BQ{+=9oH!n!SVQj?U_TpCs2$s_) z1JD6Dp0GVpy~CDdUGON4w`mK>tP7{qX7ySDvvRJ5RZ0gAx<72$|M|t2zrZh>)mKTw znX8!-ox!$;#));YT8t7q=wPl3i6CwIt-M1#+xUbzKIF-gZEy_*3(+}2$+bt^Y6a$zLAzmu!~Z@{1CFYN_Q}@Mgz`M~qSNP6Kuob}Guq zpmywFxIY2+d6)35PtRKGv{IBVoZ$oTn*${nTh0r?t0VuE0T@vIDz17kNJ&+BdNL1O zhJI^L>(%4UqQAB8zQFJP_;?`KA6a#g3;6yQ<1Dbojs^8uK?X+@4BpXr1u~5sWe4_vrShZ*5kBj6nDbY z0me)a!(8X=qzMRC-~l&Eo*qAJa`1Y8sV}}nkU21}>crZs&dWQ(yGIJ2Z6ZUoRAR4{ z{mqL)dm#ZMwXu-NVXLVz!uAht*7p(1FE&8JT{_Pl*-+BBf7Ej z@*I>~L&<%TXz(_$`RR-G)sQ^gP>u?d*qY);HnpA{{sxGYFZ9N-JG7Xf52I=9azGF2312FvBd(A!#i5G*B9<@Or9DKS%ct>4dV0 zMobktXE)nQ zLRlJwC9v={4J;yf&_?jN7Dd1&!a`JvF_f8{_xVVU{<$qbd3^o$>A+ysgX^xU+t3JP zgv^ORG4WF78i8`wbO=BRtZpVLwy9o?LALiv4Is6Ic&j_MnG~N&$fFxx_ewsYZGc>N zEw$ha;P=)05WEC$`0n#=_^tJK&r^p(t1b#f$*s%?jF6EFfD(W|A_?f5@=-{givy@O zoEk`TKj%R}3rbeR_gXp4Bt}r`DWL(W8bB-1uminzAdRe2tEAqAC%9c=JfNEKb8E69 z`z7J%1M4mdNybS^9WSYy;#)Q#7th?Ox6T`Dl(uZ~-Vd#8JKMDAP+v1_Tal7ex(#=* z!-0$Y1~d_OIVSdqc4@SZ55&tM5o{Es9(+Y~=HmTWh)0K#@ohHq7Z2meTmQlDz35aZBi&8) zX<7-5T_h~`O-P0a470a@*u&n~`>VFL?PVwcO`|A?SO6yr24X>_7)nK#f+P%2^vKyJ z)%v&{ZO2p*{3#pWj*NEumj(Y~Z$5eV^ycxv1oLNCT%|5KGpD|km{ckINdf7#Zk9(% z%|Pq9`ptwNAL0)47y_1OEfdG?X|J4D$OdMLSd9f+r;;67HkOD?J<>%bYq8HI3CUN*qBSa39n1FMdZ!IOgAOSwds>aKUB zxpiw&2uK~~@$(CdK5D0atMFDLsA50NhzJix#=5DV2#~9GRFX zm)w*#RWgMOcc+)5!y%g-KPK3IS@HXe6%dj5|`G?nt+}}RF(zi!O>m6Ko zkspu|tAR_wUI{O69-Lg&C_*H&r97jiIodto;kc8H8$2adkxF3m(jsMFqNUOT_!_V) zc1EUmIF!Kbri$B=7APeJpWKr1Yd^As`j}ILap( z|9_^Ej`Rxt#F8fs|0^-NkHe)nBrHc=d7wbaiC4c!kDxoPI*$~*dE>p`-?)Ti32e5& zcktotRx}ied2vuuiav>pt0e?tN`N0h%sJ;yJxdKnMVcP6hlg z@Fu@~d+PQ7(2|Q{kHYL&o;^W-;C+;5kNy~v3lgGwO6_iRW8?m6Wj1n(%{2FbQhdj1HI5`K0};mn^*y4EQm3@xt(A!Ie-AKA zlb!9W=lOB0QmUsy6u4XVEK5}1Kq-J(+oEu0tUR)>D!{cyHMUGyPCG@h{$$?0*JCog4VWi-@eLb1e>%NDi1#Yty+YGC>O60ZruFE85P--q$w55TJzQj}6KXD-LIiUHK{qt1D-G2W??>=z4fpjV|A@FuL^9?V1RpVf5 zL?T}dFYhMq0GsR%HP>jgq+<&#T;OWHi4p~~#j0}+!?Z4^fIky>$AkY){C)D*530>_i{KbZZ*1CN@bN-=wJ(Yx&0_WJqTS9KO%a?L*Za<3v4kk zJ8){DhT~|v0rQ$kB~qsj>s|oV8_4d)2a7;`~4T4DF~D~tUjKz1=5iK^c(yOY8{TX@Xc|WX1K~?cysJ0zS@XSwiCuP_SAD799e>xi-+a-D zvCpaJhCqv@np{$wz#Xj5klw=ZC2^M4X68oNUszF5l*(n~!MuS?5*LTr1m{{>HD*wQ z%3@{jDJsPiqdu~$TD2hB95}pubDQ$|ueQ--}w+BAUfjS~dGS$Wy5i%Hot71yc}p?y|B znR^f#Ti!7N0H;19LKMQ?Y7=`>I1RowZX6o}+*e{xP2fXN?JRx_B;`as5DJjI$T?p; z*%wcb!`{3(AQ*dc{Z*%O*$l}7@AC>uy`r3XRhUx8lO~760X1y|j5v8|3sNZ%m}<`} zj0KO^;y^PzN2r)b@&H1z?l=li9Ei7VQ*#oLGTT5!h_v8!ZP; zw*g1=nIp=Vo-^$=v2(MZU?>-pAdw-tjKe6_Qe*Vykw~&c!Dbj zsN>$ezx(b`MZlTG7oA;MYq0_iN2i^G#!ZB+fPGE8{V`ZvQeD`nOtlhs`5yQoXZoaQ z0=fczuzZ^jGZzc2Q^Y2%S+GlQ%~4TqGR^_3(gciq8BE4+{xCn$@%4*<*oRkNr7`R{ z39WYpO?S?6v*HuyadGsi@w9e<{%>d{c>2yIK);|W;HX5(U@&Y!NR_9FmH9p40~h$L z$zabu@EM{fAq5;%bRIay-5d4Gw|e9X`^@5t`fbQzHQ|0hkqXJab zR`1VWSUa}uQ_$XT!7nknTZ{wblvB&|m;@GJDF~1tNM)9?Tod@-A$tX17eHQoadJ6! zyK!ReMdeJR*2Gr5G998xwG8%MwSuGDuwG>zutar(ZgkENL zi!wS>5Vm?tqR3Cx@Zs2)X7~t`?f$^T2QHZQCOxLcePZoJ?r0*&y@>5e*~_}LP-Dt< zpkfM940RON-i&6Zw%YC>eo;pXv=d-A7x6i9)>K}88MY0WJBKWZR$jB?ry$j{mp>Pq zzVv!1V%b|7@pjUC>%;%{+b{q1rRV)|eC-Pajw986A2I0{ z`gDN6pId*?(aP$5hCvaWS#1r8ix(!AmL{jQhT)g=jri1F=%Smro{;kk()XN5Db1-a ze3)8=w*xMBut^Fp;Nc)CihYT!MFL6Ia^5R1-XXuP?J+}198|)p?>1YoW^)SXmN&l^ zTY`FR=I#}uqnEa=1uyV{rqtBwE%?PU6Cg1ATGr^C5|JCYDAGOL+p}qKONHOHhN}k( zqke2q7S+GV6CYc6(T+gS?xhcdWnD)=;oWVt>gVti5Vdy7F4&H>m)*rV#dL}hibNI16Ki7xXFLK1k7G8yLHC7LP zP(uhav4CD$;FMEj66*0F`hy$X1FBs8R&b&Eflma^kvPB2!S(|m4?e|bY`o`n5=YY& zVys9Rj-o#J23&BYWUdvXn7g&uzfx_hO`~==|Er>wp^hQ59cinqJrRk9bMq+H~_V<726R( z?jM`;{am&e?TC*ry{Nn-_qp&wavU>tL8xe|h!xsGBmo4UrmEwH^&vWKyW~=hodr}D zTib?Tx*I{dkp@BO5NVKZkPhi?>28ox8c9j%5^0c-?(Rmq^Pl&8|M{$QT;F!FP#1IY z%suvGOk(~NG#VTBD8Z8 zcHC*jMJs4^1VymMFR-JLWqF%;3!ohd&+Ceq>2K;9LdI#0Uzrg%$~azmGs4TLt0Fen zm#xNjFTJ+E(@DQS6tS8t`h-~B*^DaF56XH+Dwns+$e6W!o0>D;l~hxW$GTO0^Il0W zqDU4M{;6;bbTf72)#z8O=Gx&dLPr=_{?D;*`0jXU&tAp|WZK^u*x!9yI(5H+>w4#D z&qV2Au_O|S&P%E*5ROO~5A{SZEr) zj;nsl(5wPiV4wd7a$M3ToNm$qZt4wjI;t+82;<}MZ=b)s;fR6MHk(h#plGzeko^+I zG!!0x>pI5SMRGGdbhUUY4B59XvRxm7=q(LOcIAi^H(i)Hs@X4grhCFyaYFu$_sj8^ zC)WE=6(sAR=2^_VWCKNU_S5%c*ZrR`&rZpnH8n)o7e<;?ys)W)F{nv9hOSbn*(75T z3NxV2jtaDxQ-MhrM&ydl-)HQ3%nY~f5XIEch2cu(f)up|dI>2$E{9uSWG8MMqTVP?iy4S&1b(N zOjIiKS?g=QMtRr-@n8m-p+_2CD^w?O>;*>X+lyr>9t|q+B;YJeT4h@5Uw2$7(NeX` z4$JZ4ZFxFY5%apO*9m@i8~dFclA_Biw@;P_!5%Kt!kkIM)wZH~8^mxGvN%P@FM6Y^ zH5}^H1;{Vltw#(drr;*Dl&}I^p#8?<6dh2>JQCh_3hKtYR_CtsK;81yC4A=W39WL| zR9WPIN;lx&u=v1qj;EA&g+)qKSn?A&^HW2|0pmwS$UDu?VqV*)QDc*6I%9YjLpk7j z-4oK1wRKveqE{K$tZ>66ARj31MI~uSeTqZ*XjH)!&f%#fWNTUin=ZrK$D!@^0q@fd zCpMdXhLwUT6KJ>G^MuOkBDwME`cc$J9g43F&3Gj09uZP1fl$8b_;G?z-iU+tPApc4 zqdPrSK4@`$u3~S#<@ncsYFmFOzSq^B0=`vlTJjw8iWsQf<+VzJ*K#eCg+47yQ-Dsim)ND zg=UecT~OI!#mZ!R1A;2MNOCEHJC=PFwWTlQtt#SGx>lNPcX`+mMlyGC?sm5h=V}J( zmoBMriMW-Cw7sKy3=Q5HO?GNnP4@+)WhdHqR1d$E+J=S+NvgDoC zEP6ZzGd7K@dKf^gw$i#6y7LsIlUg=U~NXL*UCqQ zA>yNP#9tGT<;A(Lfk==h|YZ8dl9oVPdZ zEETdVKP>e7hGiCatGD4Cxe)5tAnS|#$0X@@cOCQ|X)Qz=ju@=?D(0PL(dx|utlQ5! zcbBsvuf10w$%@PK_mPUNHdI<>Q}r8cgHfVZTgwlOs+6ArZUF>&fA^~!LN$Jy+Cq+q zQRgFgtw$aj-b;vk>s~e<+XWeUyTI&Gkl(-D}kP1qbcz*^3FmrWB8_B8;xsepabZ^CRdSdTFTZ z>tpMp?L?HDD-2_4dsJ*Ee3BXEV8;{SBn$JaSMg)2PFiy_lWA0;*$&{1Q)JCwPbCed?7FMJ~tDdClY76n79-Sxk+dkXEhAaVigb9Am%zZcD4?OpWwU#TG2(ftlAaFlYrJ4dUtUFd)vWxasc2z-6Gbq3O3U7x+#X#c9t{#Ox+?!{I zC7;;2R%=h7_?SqZ782Dea9?{D7C5Z$i(;!2WNrOhryyx( z-R2tgl)4t*no#&Dt}4^~BMJylk=>Zl*d-x2)U^Wc9_Z5)$aiuoJaW00@}KzmJ&u!W zf&z=1b|0%o#7ezkcn*8kEt$>GGt$uG_NJwKQ|f5;Wyl0}4TY-V$$CtjW?qx*oU1m? zJky-xs!^9Iy>0Z`@&iT71l3~3Q`6XEG0!)#!DWqZH&l010!!qagNt$Aiw4hRjn*QY zRajZr!$4Y4#n6%Eu3p(O0;C4YV%zH=h~Wcb8%s!Q1{;O(kgMl!IE8C8M3xx$pO{s0 zsmAb!pzbz57=7K_IL6_1U!&F3YCYd{P~*b^mukO`f$J)kP@WuYc1zp>n*s%$GD6K+ zZpHm6fXd5DKuu^?`$fl=no{tiP;Am|R`adVH*G844S8XWV%vEdW`eKCJfT$fgENn# zS9{?Yu1WTZwfR0$dKn*zK&l`Jqc^0+Hoyhn2KQ2(t$Z1qL~bN!R^7f zD_v7#&kJ+MA*I+#N<`Uc9@dMH*rF4dj>EGob?`{?Nx5>!_^=8kdRzS2?P9O1eLi-F zxjrqXlM7BQK$U|=j3Xh5vx}Q-fMOF(o7u8m1k~KK=Z1)#?|1ad34z)I2c59LY&~)E zVXzUxki3YHvtEEn(jfvDB50Pq-hsDccII@cW68YYB$Gl?+mc5n48Cb#;dOUG0C6Z|G!=^O=R!}Q(kJQY;P{5X;WF^L(priRuro7DRQmgF#G$u|V#-fD9Vs29 zltb+aVaV689(jfb-t^ZYr@VQuTrR9>b6NVtC&8YAQZ4C**WJSX)z|>BSDqN&eOU*t zR<4a9>XB7wgFU7I_AYbq1uLit)H)t)YW05NOjy0;XwIQu>;`gbDOX`=$xcwAXOjJR z{X_x}OEMS|8!P;nhEYR*O!Wbz^!DYK<{g247FJb0UM2PFk!Q4X z!gfJH&#yh2nZ=2s++AUzOwZJ&@<1zZNsbux*!4mh!$2-sx9M_#v zK`adqJP>XPvtsKE1+5k1TqS)$qS!0C%K5CJLu3ZWb?x1|E}i?B^C88uK$S~0H*WLL zp_SBg?%cuKm9n(zUW2ij2s}uouVn1H3&eCgW%y~~bge2N;ChIjv zf`FIa9gR)MM%`cZt}Mltt)SI@fS%ERz|Jv%u?m|mj-k4Ffy?!>EhU5G(z91s)p>)- zMedw9y=^gOE6LGv859l?Q8mJaA>+gGT;&E=J>S(`26wp@g^g$VowK#YaCQ@(j=-cd z92^Dks&)AtC4_hd_~LW3_xf)f4jUQ$olfETi;ZoQao!O2s7wJLruJc%>0C;BQO_H$ z*~~@(F8N%6d|!adM(GPfGxphNu8u)i?)0! z?T=`&NZ&noS;WBF)p~J|aOD!^^BKE_@wk|_c=+Wx(h%%>)C)&m`PU_w(;`CP%JTR^CA0eGLuke*tU)bM%%9Gf=2&*L>^ySq_Tl zx)7-<{&ndLNSz~h-*qe-kD;mbJ_KtsI6Kb)uDsu`gmjldV)P9x+FC=>(BUz}8wmll zcWI1J0&Wpa)v6yOt4Ij7UE>4O6s{Xr$V9EaR-+6yO^J2Qt0aau>b;icHVRjGQ+mjY$VduxGA-z=ukUjT&HX`aI?K~|5Z84HcswC;M6C}6 zMm@Pf&1^iux1w$=x7*C0rD{H%#Mp^)e-C5s`B896Wn`Z6_7`Z{{MpsqaDQgI3>}G9 zc(qMx|7Ti8`C>hscHBpPkFCuHbokuuS5?lt3c{=q2yAF&F=L^d znRkzL?sbO3NIv&UWv@8O#_@c3%Ge&ETUKZ{IUo9T#)-Xh230aY5o#Iv4B642<#-uc zVSg$+Bm=EBcM!%m@@C%St)ze9Bhhjg zlXHvJ6k~^!`=l(8&&+n#x^v(!UP9^X^J3Xf;sr80*5Hf003@9Er{sEBo4VWyMI4B8`m3YzvvW$deo$HLay{ zJFzm-HuJH`_1Np?OPjgJ)&4>Me z*jTukT`Ffu5+3=AMfYdu87EZ^h)gkmyhkJofh<2SqqTmO7xZo`98daM;{fVxHY4j5 zUR>~!e|ZO1C`=<<+8fcmuQ<9CEq1&L-!AP7A-~8;HJ z_bW_;&x=hEwmh9J0K3J}z;sHnyl&G0AaYMMt)g zZs&=v&E@j*5pE&!0#6LNZ9PoGu#S`lzZYmy@fy7MU zD)2Ku4<|b>f==U2S39D^sSI;0k=C%GC? zZCu`!OjtCh`sz(ijYrEU#^exW@MD~#aPx0=%OLi$)beN4SzE+tBYW~yxZJCciVz<6 zfHI491#EYXh?zv8ncJm>8rleaLE8;&3+qOEmq)grZ;#AVqwZZ2&H2mkGR=qMTnf=3 z)65Z#6)n7pSRYT)6*Gc-Xjb@FUN2OiXOD!=?wupkdKy(sUm@aQ=P?=Lhi1I?5n2r7 zf8;3&A8Ah%l-yBFVb=Eg6Y;~hwhl`oMrMxNh>L+`52DXUU~9xLMclh?3i~Cu;GESE;P`{kzs4ebIIabsR^e zPUBq5?vt3}{isWX>Mne^7!5k;OiAeuez;jqM3;5@hW7s8Vk*}2`m~KxXfTT5v*am^ zySqO*WUypNN-$}*6eW_$vIRwNdE=I4YjPt!`b&^eu!V5qX8Ijs;?ZP6LryCx3l?>EEZ|lt z4B|-WXC3dBnN}MVBi6d-&nfz(F}vDpb8hR|p+1B7^Z}kf$!Cs`Mz1nHmn^^&lZ}#F@v9n#r3rxQ#+KmnCFoE7@WgIlDS2xj#Z}nyZt4Lp3K>MSVM_N1 zL<_|l`J)0M)CZ(k$J1p9uyzNq@ZZF|DMpTn5ttpJT;&=LGsb)4<#WEGh8f@%%YjN2 zL>qHnnh!**=;DR9>fIege7?Q1ZEcse-ra(|x7N8>KD+jt=R6G$yAWz^Z05no{#w$T z^4>qBRK|5FkW!u^hse^|GYoi7IKlFV81CfNcixghhSr7YKJkN&5TBSxeN=+PmTO{Y zl^>eH^Bo5pY4*s$}sNkq(aBR5#zZ}ce8(gD{$9ze|Qfi zCj|wK4FZASfy+&!)vD*?>k0(|A>)8R)WHAR+t`^p80lD8>lqr^F$?M0J6ITrSiLf} zGLqJ_GBq}`cVKd{w5U>(vYz2YZ#-9pZ(KEG6JhRnZoAYjI4=H)cKOMsbVhsGR}>Nr z{*>CLMj;77jYQqNkC?cG-%pM95|>lq`4Yh+DC{0P2&)+7280k3yFLLUB#M;y<*40f!Cy+N zN@6b!rSf%SZn5fO2oN$ipQx!0$c0(uy_!{?QCTR;ax*TFuMQT4^Ru^&~C%+bh_-*)b@&_em@+z72$t619FqXuo?(&8jx#|_V z<@T-Jxn0X)vV)bmElPvp(Te`oYU2Y_^dP=$5*mEs>RWWw+>fv7+uPh?vbv|j9S2au zOCzaPcm{7E?gV^YRfpulrO44EGK-<_{!O1Vv)<$)+gK7Ei1+mw?@hW~6{z1<;xxXxC%Ww6yV1o^!I%+}x0^XpVPoFNU1ky}{Wy^rlEs{i^ON2l zf@3NccGOXr1|_gM$OR$-CV@baXDHrzi;MJ5TvpeD0MhaGOt5YPemNVF*y5ef*XUM1 zTV;b+xYeur3q#^O@Ffrgnm!(B$Ezo9izF7!cf|52bO}Kg5zE)A*S&gmm%)Af3i*p6 z8lxE9{U5DxH&_R+6NQfsne7aQS}!^FGMh}BUwRNW+bd3-kH^R0%MUcQ-gv@yprkeQ zcz9blmi5n9R7I3zuFtnSGixC`xSeAX2eGje4n!B2TOpE2S&AsJ;C~e7IzBbU z+ELo>tcM_)mgNZ7;)nU7Glw?WqeK^qQPhCmieJ6z!z>vk^-+|?HE#vyL^^R##l2cv zJ8CiLB?ls}=5xHD-5u*q)!tr=Zp|jbsC&1Mt0OKa%r%^! z-wcw8wg^d)r>k>N8}L(ZX%%;;HtWkfCwcZdUXRaNQt^2ray0`lB3^1q^Eu3&Np+{( zPW0GQNqw1XtWfq6?2fdiu^(Uf*5C9?^0pVCKNtnD1^ znQZjziyw z8hctg$p3|6&plMVC!?R9gt4nNCy{w$?Axh`E&A#!Ho-C9a`-2W(0-C!GNn)b98iLk zDBCWQ@kXT7cfPGK?~P?lK7xxP73B={<7bN7Mev z777hsW()uH=W6)dMkISvdb|4N=a`SyA@2ZVi*wD(vRW(($BkN8`yf4>n+0!Wl1LSY~0My)w)gt z)R<{TPQS{F4(3x3>{p>H2mz0iZ2U~b`Rq@*e>k$_8FAL|Y!XDJeNY8_7?uI{bZ;m=)VLl(Cs-w;g zu}uBu2y@u9LaC+7-f2~79ddk`MznyI?v*AYKM<|mjrbba(D;;+h&n!yF#kOFvLM4s zp!mHEWTO5NZr8Kwz|6HL4>o*?9q}#Fpp1+Px%ZWVGQVDkf>4h4EIHQW9oWM?QJ9w; zuV@pqv?>*5kPH?yddy_;s9|3MZ;y`1t*RA?H^=O=Loin}Fu%AQXjSNZ1}%;nzjd$? zDn=((Ury+hlW*)JvciD6q3)&V+oOJ*Fs*6$=IO()>ZI$KY8gtbYHRPuCDUGG&yJf& z;epqg=esNR##Y7Jt5D_mp>W_p_e1dAklwYl{8*_K6ymv{g!MPu@a#Po6kgBUcd>_ ziJwGV&ed2uWSDEbzj}zA)L>unk&W&IZvz4mg!20~d8MOJ+q^eP1LK>LsX_J;49w{y zmx4AmXCaX~4@sn?VP@_%cj-f0u=3|i9bCT9^+90yg}Hi>5*<^TV!usy4QMi2f{U(U z^V?pIp-+0y5s|A@p83sFq}6KbW*3Kcjys&XP2@zIVY)h$zVXc}uhL-*x;3ShHZ6xP z+lTsC>N5Uf$31%9h&K)0dlZ&WsP)weq-XsOridP_@QB%@sJ06m#ScWyC3>crQ;9BS zq)(TA*qyZ8M(!_5%UO7A&#n=k`y~)Gn){qy^qt#TXOpfuD}H*90s-bDR`xlSqdnp3 zyA#1DMU(}K#r7fNrzoFT@7QWO%H!g6AnLwJD4xu-U2E!_c)zIiQ^=H_z}dA9JzVr$ zce$XN7x3b8(f(34T!t3mxH(0_oigY0rUS>huhWy?`njl{nnxbjJL@O4;y5GS%HvFcU%ke!Y5P+QMu{gVR00vShpfaQYa>BvL z&Q8zNO2^dt4`pGm)eJZK+&Mk8b$Lu;X7ci1WnsyiYH(R7lhIN3m4IIfC<}EK-e+e> z&%*7|KvqU~alQILw$Va6&u0?rfsxxBPk1)hbP(^xfI!+^+Hv=QW8E z8QaUY?$yX0OtEn}Ser;GMM<7+x_SS0*1A=a@;Z!u$wS$*3g{?3bFD`QEhRa=5@%2C zs5mf%r))JvNxp3cOLI^9-&o77xB*D&p~2!WS}mMX#N7{T&&mW_{M35AHF( zehLlLe~Ia1f^CU{XW?7XgSAAk^W;G?D((aP{LblI3W<*CO&`SZO<3Ph7&5L0VQJy@ z-6rX?F~RKac`erYCh)?Bm~-N>&*|eKW<}NMrk7|qS>L&}vouPEhpnccp<^Z$G!765 zJ0u%*sX4qTuCq_FW4GZx=#sVyigN7A$_-#1Z^<^q*K6l(Z5 z0wv+W)vkLf#P#cEPifToUzuYsG)?NDhV{W&oTW*^pp9lniaWX4@(INIXb(`voRf41 zh#+k&)P~&^K-eF8f(Dee7Bp%Sl%m{j9;}}W(UcslSIxt9CA=!!Wz?M7q%+%UVbJrF-tG+<=iTy# zH=}e;=EIgAd$J-uB;pJAZ?;=w@YMSbFZ~)d@)AM^RKj{O`pG6DAO~L)^Oh9zKV$GsSM-TeG!*81uhM!i5aOAfg`MQ^vU| z=bw|7ORP9}3`ka0pb8@RIcfjLa&T&uAvTqDhLhRYjpgy`f>s4_d-7W|nu5@R5}$x- zF5-h##jgt7j_MaCf;dbO?w=Wm_dkaEkv1hl6yU^7WgJ>=D)rcU7vp7{Pv(*1bqa(( zobOfm=-gE4oT{Hr$m{!X>EU|i-OIDqlELlEHOHV7lpun`fn6xzg)MKaIL4WhuPCft zwa1H+zUA)cW$6+2F))m6!34NGXO9%nn>eX~>+TA$Na+cr@y80JBNY-`5hQucGxGul zeHTUJ6z01c;Ay?Cy+JexnAY9lepBPuVz4h>3n&J$1NV>VQH@JsQ)upjlcDV%KZnYh z!8iE?6oci!^L+7C6y2s3I!zQ4TjRZPEp88_ocgaDhA&;dDxKwk7 zGP6bGIqdtT%X$@>hLss9lP+_aOw_k9H>lS8aOydLdXRn;$1KZBe~GkqV=M`WtAq%@ zEkFZ_s9BVtwh;n0Y>Wt6Ob|9z4fNb63Qdq69r<95eG^SZtHBS;0B70f7Ved)W) z3OF#~Q7dQU7l~gFuBWXXPfvSy@>-FyiqNEn->|9K zoX)q1%9&eX3-%-w6*g8MxYK)~4)WX;6Jg1I_Su-`q#Hyss7!<~FVY*HV9VN~zGSw- z@11_U%%R4FUAWU4Eh5u4m|-4Hj+cbJNik@F*{`{$#fzg>gV}Oyz(N82oc30NFlf#C zd;bMb!8BOoW79zYO#{kOU>5#y3jV1k?Y08$V*>YG5!*KC8n8u%k~y*iN4SGiNuSBV zQbciM(EzRvH6OeX!7eI}jR=p}B8gX)!b>gFNj25iRk+CC-1^ie7sy>&i) z1f$H>7)Xbz=6h)0`m8>%!RN`^21JnqW>G3sjtB+UJ|&NcnY*+Qio44~q$^b_O4j)j zRYQMcd#{SailOPX-icsnnTNGdNEkR@AK93Hdm-8B*v4Od;>6Mz?*G zZxEto%kv@IQf>`Z1tWzu20~M1GaN}h>=3c?6hpLcr`>j zdFf6nxR&Tjg}9-{Gb0@49rszbxY^O9K?7`48Ue00pTYxFEIv zPeHnIS)40eo@rS_u2*B>dFLHxL3EazC9ug@F~<&=ftKzNDG&&_mgfFtbZTComxmoXgOy6-ac6r4#~n#^?n-w)!&5R_a)Sy>S`t~q9a)kS z(HvpN0!OBydLKR2&ZhNhHJq4odeRy`)6hNMiYBT+*e-v1nvUs8%a*&`hbYc$Vp*R| z?%kaa8Y0PaC`j;k1}g*{Ip=^+g~$11Y#@-%L6*f*)Hp`?m4jHjJ#6ZPPWy!@$3(1) zO~uVkHn<=S+_S0)DB7M-zA)mwc042ao(^@r!iwSg7gP!m*VMemUp3E$>gxJ+7QOO#5e98y!( zcR#(4>x-~a2^A;>k__ZCV!pWm*=2P0OeX4*7h~&{1w$lOS^hrdGo<>fTW8S5uLN z!BBZ4&LcGvfz6$tMkG3?)dyImW(wN#WOmP@tA`3Q_gni%-EyUPiym>|r^u+Ee`|){ zQR7C1OA=_l7h~C{!w&V&`&4pZ(TH^WKsW8$t0W3Jh_DOfq51jomv(i zJROezs#4JtOrzK#{zNJa%L^I51%)B>;4UZ@Kr~*AD@%#l*WK0x z!d)JGQ@EC=x^DC=1NLdV+B&mn?2GPEA7Ej6-~Q!R&aAO4xVIaV)>FBp9+%fTK6HY@uYz?JFL+0s|vTa*86CoARqn~=sFcA;7Wh|!FbGq!$U`+O)cr8E}f$Xc|J{N53Y-}^8=cwm|&seO(E)+ zEOE%J4o^@WP>1Xkz1ohME4P0b(eOfOfG2!B9l(BN3NWhun&s#S^$VAs-fK*#o7 zi-t+jq(lW}bPxvqLq>+dKyaPHLo>X|U zDdA*;cWOVzUk z8<+Fq7B};tFeuz8WL|XUNSREts(cY&;y$s8JbmuE)Ht1>tSQ6rj#_N5#|(gR88Mk1 zVi6wBklXzkS+!iBU zYL!Pfo;w0tfN?o^nYn_|5N49Kj#OY2r~4BAvyT9bGqLCKD1nQpCJ!d9q<;kOd-!Z< zxMpbE0hXD{?NN_fTH}dQW6TQg_{x0>O0hu=m5Wk07s>5uZ^!zjnk>IwA0|Fl>bY_| z>@wn63@#0C6DWigP6OW&>s46^OLVRJ;lK}-VAt|h3<;8+MK>!796T1Jn97$`2b=SP zL1*l#8CK0w=zhyoSR2ljcTRs!WA$-ku3Pj#ZS^$ZJg;Qs9c(SCbJ zyg32Os-B3fG6|{TPzg1XMc<|X7B`d?q=fSANqT&l}VH87p8VwCaTVm`g8NXZmj3SGw z4b5+CrpE3Ret|a!jhe@j+yp930YL|xw=oRdj?4`1))<9+Mw4!K&qAwm<7>qL?=oV+ z|7lTa)z#6$cklA(Z|^c6>|J6#1-wgZuy=X=kKU!W3-;{9f4oaR>AMM=Y@-}?ngC@= z;%>y4K5_gn4u83pOO_;y8CnFoK4j-=v}>uWV+393qmEv!j9l{KDtA>D;?GsuO!ab7 zU-lrs6xY;-J76``@L^x7$rS4&xcZ{fQnCSsKsQiCFVFpjdx~8X+Hlu?8ya;tG>9Xg zB7^RUgz8b!chB;51jEO)^maj;sI$b#g@@^q(lE*Q_Gc)4i-}4f)w$hutAG-*rNa^I zSyBU@rH*R^;8{NU!Luv|Jj-&+jW?wP>;j*}BsoyCx^0L(u#cUJmP4(nxX_dvNZU0- zb~t)aCXoyFawUpn%~P)tWeq5;3$DcpB0|*0MX}Dw-4BI3E?O`MaUVRES6@3ekj+is z&#Z3n2DD)xQN}f!E^^JPYonGVBYH=|~K!wO<8nQ=TaW9Ds6^)SoKF(w$0_K{z z!=-eFi+H}{dchg4N!7NO1A!T43N8*lrHQsL!dYVxkR|6#UdW`-7m#3A?##haAZTe+M*Mm-rwiZ(z9Mp%n><*ag&t z31UQduvH^JiF>%2Cmixv;JQIJPUTXjJCIyGI9_=p^j(GrX^P#o8L6TaE%@Dd ztnQUmSA#Yxtuie7E@9!%IBvNrg)v{iN<758URHW2SDmy=_F2dS zO}E0(?dR-I#}!n1v>m9!ms?pPkcptsS2`k3m8 zz4i#^I<;qAUPgubE>$s`ry5H?{S@nLpYL?(eURy?E_ymT{v#M8!G}1}gCGS+3pq+C z0RmxDet%#8$EE&>_p?zF^2jR;-Vlb5isSjxpE03>H308SCLv2H7a#9eG*iir34H6zkqXj819oPn#WnEYx5F(I2 zf46KO@ZS`brKJTG)R`;|e>@JHcNw`4cjJJcr~_f=+h+%$=^5%XIvLs7n_63e z*Ij=-xU)2`f(VQ>XCUbjfcrwKpN>aE z0FJk|Gt#klurt!LwEx%J!yiKeBV(0Y=e&WL)gJ}~BKis0jr5I>{*0i}M5?$=W9M-(_J|32kUs{pDRIPl?5QHcV&{e=2q+W(P)4N%A@<-a-t za{axo^EW8lNB6=1Qyg4vjQ%&Vz`#q0y0s>tisb^JV9)vQmhFQBtfl@H)_;J1k_vo& zb*bss0l@kFZP$JWp#t0=Kz|Yn9FgqYbK!XaR00SE_Raoo**;%^OYj5eUt|Jz>6atZ zO5omz4t)LGrRPaOAY&VYf9sMgKpvg#+#7+d3OL}mgA4n=Tec4o83<%*q$e&4lkA5co zNoH_NYz{7dWWZTk0~+D}6jK=8&!j)-Jo-VSE&@2X1NZ`K{ddduSz-i%%=Db}{!Qqy zP#Uf0&+YGBfDnGq{S+n;$inEAo`I{5o}=L(7A=3w4=^%@wwPfMh(ZGB(myAxD(f%E zKS>Q12qS)1@*coM01^I-(gy~-pQ8Jd*5Ii68q=-8R&eTXxu5d%7u3Iq?G8{9Z1t+a zL*?JQ{l1G`#Q9%}osrd__Wu2-7nrFvo!$@DOA0tq@TQx;TeiRdaKPd)|>&&89b{tUbJ)jtPPsiUa+b3V(SJuBsMju3@)!B}M3mz_i z?_t%?K_E+0d+@ZTV`^pm@5|ypDh5XOKBNwq1;R1-t%q5O{(}6IVBi&kCO*iif1X_e z#C}2jNiT3zi5N$w;5{$}zx6ON$zM?aA{ThNYuA#Q2KO*DVB`aalmE7C9}Vg66bEZ_ zBdh;yh5@*c@f04Q}pFz}7;-wl{y3z*w~hS4ef2K$p} z;K-0xDj;V8SRo)9{@-B%-?M!xlzxN#i)>&gC4QKv7J3fG)^?WvlUiWhNKpH?PXLAlK>j>j zfDC`Y{YfZr>Cr-TcP9))v=99&=IBSvpELqTle-mBQUOGx07L^W&;M@OK9;Y3h~{79 z0Z;S(IV{cM7$A_3IK(fLvw{f-WM^dWXyL$UYQ<<{XZ;HJm;GON$Ulx$;QN6FqGn8O z0Fntnkp7MV_@3=E;QBY@w*&itYkV%t;$sK&XK?vN{?mafVZbJH13Ob22OX#X?dpJe zAw@ilQvl}`pvTX71|Rh!?@yQK5iluK%H4&_0GHW+2_Q@@9f2(WU#n;^@RXSCF}PL{12h6|DgN8CeL8b~0{%%P z@byG{~{B3ut-&e z_^dPq0ZJgi`K2?)6#)!uM>_)}Al03WtQ@TETz|_~@ZAn$aDc=d69kAg9tH&5`~SCP z`w#%b{{JKFj0}u`y!{REPtTG3P0044t%CX=pDOvWM}wKaZg2n2T(A9=`KJr^Pg}#k zv(D;%W&P=z{nKvY?=0qqUs?Zh+5TyR<#&uw6V#7;J%s+{DV!hm0t0{D{Pi7p(fSkc zPh$PkzNzmZ*!G`5e^Tn7Hn4mLb$0#)`WKo0Y1#ifW3>A_ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/integration/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/integration/ProbeImports.pas new file mode 100644 index 0000000..2853e69 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/integration/ProbeImports.pas @@ -0,0 +1,31 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_CommonTypes, KM_Points, KM_CommonClasses, KM_MissionScript_Info, KM_TerrainUtils, KM_ResSprites, KM_Terrain, KM_MissionScript_Standard, KM_Game, KM_ScriptingEvents; +procedure RunUpstreamChecks(R:TProbeReport); +var P,Q:TKMPoint; + S:TKMemoryStreamBinary; I:Integer; U:UnicodeString; +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_CommonTypes, KM_Points, KM_CommonClasses, KM_MissionScript_Info, KM_TerrainUtils, KM_ResSprites, KM_Terrain, KM_MissionScript_Standard, KM_Game, KM_ScriptingEvents; this does not execute a game world'); + try + P:=KMPoint(17,-3); Q:=KMPointRight(P); + R.Check('core.points',(P.X=17) and (P.Y=-3) and (Q.X=18) and (Q.Y=-3), + 'Calls original KMPoint / KMPointRight, not a local replacement'); + R.Check('core.point_layout',(SizeOf(TKMPoint)=8) and (SizeOf(TKMPointF)=8), + Format('TKMPoint=%d TKMPointF=%d',[SizeOf(TKMPoint),SizeOf(TKMPointF)])); + except on E:Exception do R.Add('core.points','FAIL',E.ClassName+': '+E.Message);end; + try + S:=TKMemoryStreamBinary.Create; + try + S.Write(Integer(123456)); S.Write(P); S.WriteW(UnicodeString('KaM Android')); + S.Position:=0; S.Read(I); S.Read(Q); S.ReadW(U); + R.Check('core.stream_roundtrip',(I=123456) and (Q.X=P.X) and (Q.Y=P.Y) + and (U=UnicodeString('KaM Android')) and (S.Position=S.Size), + 'Calls original TKMemoryStreamBinary Read/Write/ReadW/WriteW'); + finally S.Free;end; + except on E:Exception do R.Add('core.stream_roundtrip','FAIL',E.ClassName+': '+E.Message);end; +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/integration/compile-link.log b/reports/runs/20260908T164542Z-0843e132/integration/compile-link.log new file mode 100644 index 0000000..85d4a5b --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/integration/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_integration" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/integration/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/integration/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/integration/target.json b/reports/runs/20260908T164542Z-0843e132/integration/target.json new file mode 100644 index 0000000..58db1a6 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/integration/target.json @@ -0,0 +1,100 @@ +{ + "profile": "integration", + "name": "kam_probe_integration", + "package": "org.kammobile.archprobe.integration", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points", + "KM_CommonClasses", + "KM_MissionScript_Info", + "KM_TerrainUtils", + "KM_ResSprites", + "KM_Terrain", + "KM_MissionScript_Standard", + "KM_Game", + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/java-version.log b/reports/runs/20260908T164542Z-0843e132/java-version.log new file mode 100644 index 0000000..f5d626d --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/java-version.log @@ -0,0 +1,4 @@ +$ java -version +openjdk version "17.0.20" 2026-07-21 +OpenJDK Runtime Environment (build 17.0.20+8-1-deb12u1-Debian) +OpenJDK 64-Bit Server VM (build 17.0.20+8-1-deb12u1-Debian, mixed mode, sharing) diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_audio/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/legacy_audio/CastleEngineManifest.xml new file mode 100644 index 0000000..5e18868 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_audio/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_audio/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/legacy_audio/ProbeImports.pas new file mode 100644 index 0000000..019920c --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_audio/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_Sound; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_Sound; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log b/reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log new file mode 100644 index 0000000..aac1bcb --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log @@ -0,0 +1,12 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_legacy_audio" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/legacy_audio/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/legacy_audio/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/ext/openal.pas(76,1) Fatal: Syntax error, "identifier" expected but "TYPE" found +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_audio/target.json b/reports/runs/20260908T164542Z-0843e132/legacy_audio/target.json new file mode 100644 index 0000000..0058a01 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_audio/target.json @@ -0,0 +1,91 @@ +{ + "profile": "legacy_audio", + "name": "kam_probe_legacy_audio", + "package": "org.kammobile.archprobe.legacyaudio", + "cpu": "aarch64", + "units": [ + "KM_Sound" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_render/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/legacy_render/CastleEngineManifest.xml new file mode 100644 index 0000000..4a0e9bc --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_render/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_render/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/legacy_render/ProbeImports.pas new file mode 100644 index 0000000..27c5f01 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_render/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_Render; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_Render; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log b/reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log new file mode 100644 index 0000000..0dc6ed8 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log @@ -0,0 +1,12 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_legacy_render" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/legacy_render/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/legacy_render/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/render/KM_Render.pas(6,17) Fatal: Can't find unit LCLIntf used by KM_Render +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/legacy_render/target.json b/reports/runs/20260908T164542Z-0843e132/legacy_render/target.json new file mode 100644 index 0000000..d682694 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/legacy_render/target.json @@ -0,0 +1,91 @@ +{ + "profile": "legacy_render", + "name": "kam_probe_legacy_render", + "package": "org.kammobile.archprobe.legacyrender", + "cpu": "aarch64", + "units": [ + "KM_Render" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/mission_info/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/mission_info/CastleEngineManifest.xml new file mode 100644 index 0000000..4f93b29 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_info/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/mission_info/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/mission_info/ProbeImports.pas new file mode 100644 index 0000000..331f506 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_info/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_MissionScript_Info; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_MissionScript_Info; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log b/reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log new file mode 100644 index 0000000..7e0130c --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_mission_info" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/mission_info/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/mission_info/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/mission_info/target.json b/reports/runs/20260908T164542Z-0843e132/mission_info/target.json new file mode 100644 index 0000000..d44d233 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_info/target.json @@ -0,0 +1,91 @@ +{ + "profile": "mission_info", + "name": "kam_probe_mission_info", + "package": "org.kammobile.archprobe.missioninfo", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Info" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/mission_tokens/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/mission_tokens/CastleEngineManifest.xml new file mode 100644 index 0000000..2215e23 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_tokens/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/mission_tokens/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/mission_tokens/ProbeImports.pas new file mode 100644 index 0000000..2c08f58 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_tokens/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_MissionScript; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_MissionScript; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log b/reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log new file mode 100644 index 0000000..dc1b901 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log @@ -0,0 +1,15 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_mission_tokens" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/mission_tokens/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/mission_tokens/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" +/work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(108,10) Warning: Symbol "Left" is deprecated: "use Translation.X" +/work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(108,39) Warning: Symbol "Bottom" is deprecated: "use Translation.Y" +GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/mission_tokens/target.json b/reports/runs/20260908T164542Z-0843e132/mission_tokens/target.json new file mode 100644 index 0000000..88d93de --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_tokens/target.json @@ -0,0 +1,91 @@ +{ + "profile": "mission_tokens", + "name": "kam_probe_mission_tokens", + "package": "org.kammobile.archprobe.missiontokens", + "cpu": "aarch64", + "units": [ + "KM_MissionScript" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/mission_world/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/mission_world/CastleEngineManifest.xml new file mode 100644 index 0000000..f0f3bd0 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_world/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/mission_world/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/mission_world/ProbeImports.pas new file mode 100644 index 0000000..8d9b517 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_world/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_MissionScript_Standard; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_MissionScript_Standard; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log b/reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log new file mode 100644 index 0000000..ed0d1b6 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_mission_world" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/mission_world/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/mission_world/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/mission_world/target.json b/reports/runs/20260908T164542Z-0843e132/mission_world/target.json new file mode 100644 index 0000000..dcf5f06 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/mission_world/target.json @@ -0,0 +1,91 @@ +{ + "profile": "mission_world", + "name": "kam_probe_mission_world", + "package": "org.kammobile.archprobe.missionworld", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Standard" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/platform/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/platform/CastleEngineManifest.xml new file mode 100644 index 0000000..74a2ab1 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/platform/CastleEngineManifest.xml @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/platform/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/platform/ProbeImports.pas new file mode 100644 index 0000000..54e957a --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/platform/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','NOT_RUN','Platform-only APK; no KaM modules imported'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/platform/compile-link.log b/reports/runs/20260908T164542Z-0843e132/platform/compile-link.log new file mode 100644 index 0000000..40474c1 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/platform/compile-link.log @@ -0,0 +1,15 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_platform" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/platform/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/platform/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(47,10) Error: identifier idents no member "Enabled" +/work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(108,10) Warning: Symbol "Left" is deprecated: "use Translation.X" +/work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(108,39) Warning: Symbol "Bottom" is deprecated: "use Translation.Y" +GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/platform/target.json b/reports/runs/20260908T164542Z-0843e132/platform/target.json new file mode 100644 index 0000000..2d60411 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/platform/target.json @@ -0,0 +1,18 @@ +{ + "profile": "platform", + "name": "kam_probe_platform", + "package": "org.kammobile.archprobe.platform", + "cpu": "aarch64", + "units": [], + "source_paths": [], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/result-in-progress.json b/reports/runs/20260908T164542Z-0843e132/result-in-progress.json new file mode 100644 index 0000000..66a6547 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/result-in-progress.json @@ -0,0 +1,1852 @@ +{ + "schema": "kam-android-build/1", + "run_id": "20260908T164542Z-0843e132", + "cpu": "aarch64", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "desktop_target": false, + "shims": false, + "runtime": "NOT_RUN", + "profiles": [ + { + "id": "platform", + "required": true, + "purpose": "Castle/FPC Android shell, storage, threads, compression, touch, procedural GPU image, audio API, lifecycle", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 171.39, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/platform/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(47,10) Error: identifier idents no member \"Enabled\"", + "GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "platform", + "name": "kam_probe_platform", + "package": "org.kammobile.archprobe.platform", + "cpu": "aarch64", + "units": [], + "source_paths": [], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "core_types", + "required": true, + "purpose": "Original core types, point arithmetic and ABI witness", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 175.586, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "core_types", + "name": "kam_probe_core_types", + "package": "org.kammobile.archprobe.coretypes", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "core_streams", + "required": true, + "purpose": "Original serialization stream, records, strings and compression dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 172.136, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "core_streams", + "name": "kam_probe_core_streams", + "package": "org.kammobile.archprobe.corestreams", + "cpu": "aarch64", + "units": [ + "KM_CommonClasses", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "mission_tokens", + "required": true, + "purpose": "Original DAT tokenizer and its real transitive dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 173.655, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(47,10) Error: identifier idents no member \"Enabled\"", + "GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_tokens", + "name": "kam_probe_mission_tokens", + "package": "org.kammobile.archprobe.missiontokens", + "cpu": "aarch64", + "units": [ + "KM_MissionScript" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "mission_info", + "required": true, + "purpose": "Original MAP/DAT metadata loader dependency and native-link boundary; no world execution", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 175.864, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_info", + "name": "kam_probe_mission_info", + "package": "org.kammobile.archprobe.missioninfo", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Info" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "terrain_io", + "required": true, + "purpose": "Original terrain binary I/O dependency boundary", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 173.096, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "terrain_io", + "name": "kam_probe_terrain_io", + "package": "org.kammobile.archprobe.terrainio", + "cpu": "aarch64", + "units": [ + "KM_TerrainUtils" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "sprite_loader", + "required": true, + "purpose": "Original RX/RXX loader and its graphics/palette/compression dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.942, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/res/KM_ResSprites.pas(5,17) Fatal: Can't find unit LCLIntf used by KM_ResSprites", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "sprite_loader", + "name": "kam_probe_sprite_loader", + "package": "org.kammobile.archprobe.spriteloader", + "cpu": "aarch64", + "units": [ + "KM_ResSprites" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "terrain_pathfinding", + "required": true, + "purpose": "Original terrain/pathfinding dependency graph", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 170.349, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/KromUtils.pas(7,18) Fatal: Can't find unit LCLType used by KromUtils", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "terrain_pathfinding", + "name": "kam_probe_terrain_pathfinding", + "package": "org.kammobile.archprobe.terrainpathfinding", + "cpu": "aarch64", + "units": [ + "KM_Terrain" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "mission_world", + "required": true, + "purpose": "Original full mission loader, buildings/units command dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.363, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_world", + "name": "kam_probe_mission_world", + "package": "org.kammobile.archprobe.missionworld", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Standard" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "simulation", + "required": true, + "purpose": "Original game core dependency graph, not the desktop executable", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 167.246, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/settings/KM_GameSettings.pas(6,15) Fatal: Can't find unit Forms used by KM_GameSettings", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "simulation", + "name": "kam_probe_simulation", + "package": "org.kammobile.archprobe.simulation", + "cpu": "aarch64", + "units": [ + "KM_Game" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "script_vm", + "required": true, + "purpose": "Pinned PascalScript submodule source and ARM ABI support", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.33, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,13) Error: Illegal expression", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,17) Fatal: Syntax error, \";\" expected but \"identifier BTYPE\" found", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "script_vm", + "name": "kam_probe_script_vm", + "package": "org.kammobile.archprobe.scriptvm", + "cpu": "aarch64", + "units": [ + "uPSCompiler", + "uPSRuntime" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "scripting", + "required": true, + "purpose": "KaM scripting integration dependency graph", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 162.015, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(116,5) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(121,65) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(123,62) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(124,59) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(126,56) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(127,56) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;" + ], + "target": { + "profile": "scripting", + "name": "kam_probe_scripting", + "package": "org.kammobile.archprobe.scripting", + "cpu": "aarch64", + "units": [ + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "legacy_render", + "required": false, + "purpose": "Diagnostic only: discover original renderer's platform dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 166.4, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/render/KM_Render.pas(6,17) Fatal: Can't find unit LCLIntf used by KM_Render", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "legacy_render", + "name": "kam_probe_legacy_render", + "package": "org.kammobile.archprobe.legacyrender", + "cpu": "aarch64", + "units": [ + "KM_Render" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "legacy_audio", + "required": false, + "purpose": "Diagnostic only: discover original audio's platform dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 169.51, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/openal.pas(76,1) Fatal: Syntax error, \"identifier\" expected but \"TYPE\" found", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "legacy_audio", + "name": "kam_probe_legacy_audio", + "package": "org.kammobile.archprobe.legacyaudio", + "cpu": "aarch64", + "units": [ + "KM_Sound" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "integration", + "required": true, + "purpose": "Link actual core roots together with Castle in ONE Android native library and APK", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 170.77, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/integration/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "integration", + "name": "kam_probe_integration", + "package": "org.kammobile.archprobe.integration", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points", + "KM_CommonClasses", + "KM_MissionScript_Info", + "KM_TerrainUtils", + "KM_ResSprites", + "KM_Terrain", + "KM_MissionScript_Standard", + "KM_Game", + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + } + ], + "toolchain": { + "castle": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.008, + "command": [ + "castle-engine", + "--version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/castle-version.log", + "output": "$ castle-engine --version\ncastle-engine 7.0-alpha.3.snapshot\n" + }, + "fpc": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "fpc", + "-iV" + ], + "log": "reports/runs/20260908T164542Z-0843e132/fpc-version.log", + "output": "$ fpc -iV\n3.2.2\n" + }, + "java": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.067, + "command": [ + "java", + "-version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/java-version.log", + "output": "$ java -version\nopenjdk version \"17.0.20\" 2026-07-21\nOpenJDK Runtime Environment (build 17.0.20+8-1-deb12u1-Debian)\nOpenJDK 64-Bit Server VM (build 17.0.20+8-1-deb12u1-Debian, mixed mode, sharing)\n" + }, + "adb": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "adb", + "version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/adb-version.log", + "output": "$ adb version\nAndroid Debug Bridge version 1.0.41\nVersion 37.0.1-15733141\nInstalled as /usr/local/android/android-sdk/platform-tools/adb\nRunning on Linux 6.8.0-139-generic (x86_64)\n" + }, + "paths": { + "CASTLE_ENGINE_PATH": "/usr/local/castle-engine/", + "ANDROID_HOME": "/usr/local/android/android-sdk/", + "JAVA_HOME": "/usr/lib/jvm/java-17-openjdk-amd64/", + "FPCDIR": "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/" + }, + "docker_image_lock": { + "image": "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "image_id": "sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "resolved_from": "kambi/castle-engine-cloud-builds-tools:cge-unstable", + "locked_at": "20260908T161942Z", + "note": "Subsequent runs use this digest, never silently advance the tag." + } + }, + "asset_count": 0 +} diff --git a/reports/runs/20260908T164542Z-0843e132/result.json b/reports/runs/20260908T164542Z-0843e132/result.json new file mode 100644 index 0000000..749f996 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/result.json @@ -0,0 +1,1853 @@ +{ + "schema": "kam-android-build/1", + "run_id": "20260908T164542Z-0843e132", + "cpu": "aarch64", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "desktop_target": false, + "shims": false, + "runtime": "NOT_RUN", + "profiles": [ + { + "id": "platform", + "required": true, + "purpose": "Castle/FPC Android shell, storage, threads, compression, touch, procedural GPU image, audio API, lifecycle", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 171.39, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/platform/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/build/20260908T164542Z-0843e132/platform/./code/GameViewMain.pas(47,10) Error: identifier idents no member \"Enabled\"", + "GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "platform", + "name": "kam_probe_platform", + "package": "org.kammobile.archprobe.platform", + "cpu": "aarch64", + "units": [], + "source_paths": [], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "core_types", + "required": true, + "purpose": "Original core types, point arithmetic and ABI witness", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 175.586, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/core_types/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "core_types", + "name": "kam_probe_core_types", + "package": "org.kammobile.archprobe.coretypes", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "core_streams", + "required": true, + "purpose": "Original serialization stream, records, strings and compression dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 172.136, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/core_streams/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "core_streams", + "name": "kam_probe_core_streams", + "package": "org.kammobile.archprobe.corestreams", + "cpu": "aarch64", + "units": [ + "KM_CommonClasses", + "KM_Points" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "mission_tokens", + "required": true, + "purpose": "Original DAT tokenizer and its real transitive dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 173.655, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_tokens/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/build/20260908T164542Z-0843e132/mission_tokens/./code/GameViewMain.pas(47,10) Error: identifier idents no member \"Enabled\"", + "GameViewMain.pas(236) Fatal: There were 1 errors compiling module, stopping", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_tokens", + "name": "kam_probe_mission_tokens", + "package": "org.kammobile.archprobe.missiontokens", + "cpu": "aarch64", + "units": [ + "KM_MissionScript" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "mission_info", + "required": true, + "purpose": "Original MAP/DAT metadata loader dependency and native-link boundary; no world execution", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 175.864, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_info/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_info", + "name": "kam_probe_mission_info", + "package": "org.kammobile.archprobe.missioninfo", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Info" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "terrain_io", + "required": true, + "purpose": "Original terrain binary I/O dependency boundary", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 173.096, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "terrain_io", + "name": "kam_probe_terrain_io", + "package": "org.kammobile.archprobe.terrainio", + "cpu": "aarch64", + "units": [ + "KM_TerrainUtils" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "sprite_loader", + "required": true, + "purpose": "Original RX/RXX loader and its graphics/palette/compression dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.942, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/res/KM_ResSprites.pas(5,17) Fatal: Can't find unit LCLIntf used by KM_ResSprites", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "sprite_loader", + "name": "kam_probe_sprite_loader", + "package": "org.kammobile.archprobe.spriteloader", + "cpu": "aarch64", + "units": [ + "KM_ResSprites" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "terrain_pathfinding", + "required": true, + "purpose": "Original terrain/pathfinding dependency graph", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 170.349, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/KromUtils.pas(7,18) Fatal: Can't find unit LCLType used by KromUtils", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "terrain_pathfinding", + "name": "kam_probe_terrain_pathfinding", + "package": "org.kammobile.archprobe.terrainpathfinding", + "cpu": "aarch64", + "units": [ + "KM_Terrain" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "mission_world", + "required": true, + "purpose": "Original full mission loader, buildings/units command dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.363, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/mission_world/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "mission_world", + "name": "kam_probe_mission_world", + "package": "org.kammobile.archprobe.missionworld", + "cpu": "aarch64", + "units": [ + "KM_MissionScript_Standard" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + }, + { + "id": "simulation", + "required": true, + "purpose": "Original game core dependency graph, not the desktop executable", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 167.246, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/settings/KM_GameSettings.pas(6,15) Fatal: Can't find unit Forms used by KM_GameSettings", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "simulation", + "name": "kam_probe_simulation", + "package": "org.kammobile.archprobe.simulation", + "cpu": "aarch64", + "units": [ + "KM_Game" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "script_vm", + "required": true, + "purpose": "Pinned PascalScript submodule source and ARM ABI support", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 168.33, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,13) Error: Illegal expression", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,17) Fatal: Syntax error, \";\" expected but \"identifier BTYPE\" found", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "script_vm", + "name": "kam_probe_script_vm", + "package": "org.kammobile.archprobe.scriptvm", + "cpu": "aarch64", + "units": [ + "uPSCompiler", + "uPSRuntime" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "scripting", + "required": true, + "purpose": "KaM scripting integration dependency graph", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 162.015, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(116,5) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(121,65) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(123,62) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(124,59) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(126,56) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(127,56) Error: Wrong number of parameters specified for call to \"Invoke\"", + "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):;" + ], + "target": { + "profile": "scripting", + "name": "kam_probe_scripting", + "package": "org.kammobile.archprobe.scripting", + "cpu": "aarch64", + "units": [ + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "legacy_render", + "required": false, + "purpose": "Diagnostic only: discover original renderer's platform dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 166.4, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/legacy_render/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/render/KM_Render.pas(6,17) Fatal: Can't find unit LCLIntf used by KM_Render", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "legacy_render", + "name": "kam_probe_legacy_render", + "package": "org.kammobile.archprobe.legacyrender", + "cpu": "aarch64", + "units": [ + "KM_Render" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "PLATFORM_BOUNDARY" + }, + { + "id": "legacy_audio", + "required": false, + "purpose": "Diagnostic only: discover original audio's platform dependencies", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 169.51, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/legacy_audio/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/ext/openal.pas(76,1) Fatal: Syntax error, \"identifier\" expected but \"TYPE\" found", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "legacy_audio", + "name": "kam_probe_legacy_audio", + "package": "org.kammobile.archprobe.legacyaudio", + "cpu": "aarch64", + "units": [ + "KM_Sound" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_TOOLCHAIN_REVIEW" + }, + { + "id": "integration", + "required": true, + "purpose": "Link actual core roots together with Castle in ONE Android native library and APK", + "compile_link": { + "status": "FAIL", + "exit_code": 1, + "seconds": 170.77, + "command": [ + "castle-engine", + "--os=android", + "--cpu=aarch64", + "--compiler=fpc", + "--mode=debug", + "compile" + ], + "log": "reports/runs/20260908T164542Z-0843e132/integration/compile-link.log" + }, + "package": { + "status": "NOT_RUN" + }, + "runtime": { + "status": "NOT_RUN" + }, + "errors": [ + "/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO", + "Fatal: Compilation aborted", + "Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode" + ], + "target": { + "profile": "integration", + "name": "kam_probe_integration", + "package": "org.kammobile.archprobe.integration", + "cpu": "aarch64", + "units": [ + "KM_CommonTypes", + "KM_Points", + "KM_CommonClasses", + "KM_MissionScript_Info", + "KM_TerrainUtils", + "KM_ResSprites", + "KM_Terrain", + "KM_MissionScript_Standard", + "KM_Game", + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false + }, + "triage": "SOURCE_OR_PACKAGE_DEPENDENCY" + } + ], + "toolchain": { + "castle": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.008, + "command": [ + "castle-engine", + "--version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/castle-version.log", + "output": "$ castle-engine --version\ncastle-engine 7.0-alpha.3.snapshot\n" + }, + "fpc": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "fpc", + "-iV" + ], + "log": "reports/runs/20260908T164542Z-0843e132/fpc-version.log", + "output": "$ fpc -iV\n3.2.2\n" + }, + "java": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.067, + "command": [ + "java", + "-version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/java-version.log", + "output": "$ java -version\nopenjdk version \"17.0.20\" 2026-07-21\nOpenJDK Runtime Environment (build 17.0.20+8-1-deb12u1-Debian)\nOpenJDK 64-Bit Server VM (build 17.0.20+8-1-deb12u1-Debian, mixed mode, sharing)\n" + }, + "adb": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "adb", + "version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/adb-version.log", + "output": "$ adb version\nAndroid Debug Bridge version 1.0.41\nVersion 37.0.1-15733141\nInstalled as /usr/local/android/android-sdk/platform-tools/adb\nRunning on Linux 6.8.0-139-generic (x86_64)\n" + }, + "paths": { + "CASTLE_ENGINE_PATH": "/usr/local/castle-engine/", + "ANDROID_HOME": "/usr/local/android/android-sdk/", + "JAVA_HOME": "/usr/lib/jvm/java-17-openjdk-amd64/", + "FPCDIR": "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/" + }, + "docker_image_lock": { + "image": "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "image_id": "sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "resolved_from": "kambi/castle-engine-cloud-builds-tools:cge-unstable", + "locked_at": "20260908T161942Z", + "note": "Subsequent runs use this digest, never silently advance the tag." + } + }, + "asset_count": 0, + "gate": "NOT_BUILDABLE_AS_IS" +} diff --git a/reports/runs/20260908T164542Z-0843e132/script_vm/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/script_vm/CastleEngineManifest.xml new file mode 100644 index 0000000..b74fdb1 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/script_vm/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/script_vm/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/script_vm/ProbeImports.pas new file mode 100644 index 0000000..b3de4bb --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/script_vm/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,uPSCompiler, uPSRuntime; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: uPSCompiler, uPSRuntime; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log b/reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log new file mode 100644 index 0000000..058704e --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/script_vm/compile-link.log @@ -0,0 +1,14 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_script_vm" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/script_vm/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/script_vm/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(5499,3) Note: Local variable "C" is assigned but never used +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,13) Error: Illegal expression +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSCompiler.pas(6844,17) Fatal: Syntax error, ";" expected but "identifier BTYPE" found +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/script_vm/target.json b/reports/runs/20260908T164542Z-0843e132/script_vm/target.json new file mode 100644 index 0000000..0b208be --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/script_vm/target.json @@ -0,0 +1,92 @@ +{ + "profile": "script_vm", + "name": "kam_probe_script_vm", + "package": "org.kammobile.archprobe.scriptvm", + "cpu": "aarch64", + "units": [ + "uPSCompiler", + "uPSRuntime" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/scripting/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/scripting/CastleEngineManifest.xml new file mode 100644 index 0000000..ebe3321 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/scripting/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/scripting/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/scripting/ProbeImports.pas new file mode 100644 index 0000000..0794409 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/scripting/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_ScriptingEvents; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_ScriptingEvents; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log b/reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log new file mode 100644 index 0000000..961e9a3 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/scripting/compile-link.log @@ -0,0 +1,65 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_scripting" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/scripting/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/scripting/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(13,37) Warning: Unit "Rtti" is experimental +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1368,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1374,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1380,17) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1385,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1391,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(1397,17) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(3592,37) Warning: Implicit string type conversion from "Char" to "WideString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(3614,37) Warning: Implicit string type conversion from "Char" to "WideString" +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(3921,10) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(9022,9) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(9022,9) Warning: Converting pointers to signed integers may result in wrong comparison results and range errors, use an unsigned type instead. +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(9057,8) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(9057,8) Warning: Converting pointers to signed integers may result in wrong comparison results and range errors, use an unsigned type instead. +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(29,15) Warning: Local variable "Args" of a managed type does not seem to be initialized +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(116,5) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(121,65) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(123,62) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(124,59) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(126,56) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(127,56) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(128,64) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(129,70) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(130,60) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(131,60) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(132,64) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(134,58) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(135,56) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(143,39) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(144,39) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/InvokeCall.inc(146,46) Error: Wrong number of parameters specified for call to "Invoke" +/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/units/aarch64-android/rtl-objpas/rtti.ppu:rtti.pp(2321,10) Error: Found declaration: Invoke(Pointer;const TArray$1$crc9240FF1D;TCallConv;PTypeInfo;Boolean;Boolean):; +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10266,15) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10280,16) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10370,17) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10410,13) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10459,13) Warning: Conversion between ordinals and pointers is not portable +/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/uPSRuntime.pas(10901,69) Warning: Conversion between ordinals and pointers is not portable +uPSRuntime.pas(13304) Fatal: There were 32 errors compiling module, stopping +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/scripting/target.json b/reports/runs/20260908T164542Z-0843e132/scripting/target.json new file mode 100644 index 0000000..acb0022 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/scripting/target.json @@ -0,0 +1,91 @@ +{ + "profile": "scripting", + "name": "kam_probe_scripting", + "package": "org.kammobile.archprobe.scripting", + "cpu": "aarch64", + "units": [ + "KM_ScriptingEvents" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/simulation/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/simulation/CastleEngineManifest.xml new file mode 100644 index 0000000..d957de8 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/simulation/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/simulation/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/simulation/ProbeImports.pas new file mode 100644 index 0000000..5b0c58a --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/simulation/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_Game; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_Game; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log b/reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log new file mode 100644 index 0000000..7929de6 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/simulation/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_simulation" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/simulation/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/simulation/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/settings/KM_GameSettings.pas(6,15) Fatal: Can't find unit Forms used by KM_GameSettings +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/simulation/target.json b/reports/runs/20260908T164542Z-0843e132/simulation/target.json new file mode 100644 index 0000000..006351d --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/simulation/target.json @@ -0,0 +1,91 @@ +{ + "profile": "simulation", + "name": "kam_probe_simulation", + "package": "org.kammobile.archprobe.simulation", + "cpu": "aarch64", + "units": [ + "KM_Game" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/source-inventory.json b/reports/runs/20260908T164542Z-0843e132/source-inventory.json new file mode 100644 index 0000000..ab9f973 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/source-inventory.json @@ -0,0 +1,66063 @@ +{ + "scope": "Lexical, both conditional branches included; compilation decides active blockers.", + "units": { + "km_console": [ + "src/KM_Console.pas" + ], + "km_crashreport": [ + "src/KM_Crashreport.pas" + ], + "km_exceptions": [ + "src/KM_Exceptions.pas" + ], + "km_gameapp": [ + "src/KM_GameApp.pas" + ], + "km_log": [ + "src/KM_Log.pas" + ], + "km_main": [ + "src/KM_Main.pas" + ], + "km_projectiles": [ + "src/KM_Projectiles.pas" + ], + "km_system": [ + "src/KM_System.pas" + ], + "km_ai": [ + "src/ai/KM_AI.pas" + ], + "km_aiarmyevaluation": [ + "src/ai/KM_AIArmyEvaluation.pas" + ], + "km_aiattacks": [ + "src/ai/KM_AIAttacks.pas" + ], + "km_aicityplanner": [ + "src/ai/KM_AICityPlanner.pas" + ], + "km_aidefensepos": [ + "src/ai/KM_AIDefensePos.pas" + ], + "km_aifields": [ + "src/ai/KM_AIFields.pas" + ], + "km_aigeneral": [ + "src/ai/KM_AIGeneral.pas" + ], + "km_aigoals": [ + "src/ai/KM_AIGoals.pas" + ], + "km_aiinfluences": [ + "src/ai/KM_AIInfluences.pas" + ], + "km_aimayor": [ + "src/ai/KM_AIMayor.pas" + ], + "km_aimayorbalance": [ + "src/ai/KM_AIMayorBalance.pas" + ], + "km_aisetup": [ + "src/ai/KM_AISetup.pas" + ], + "km_aitypes": [ + "src/ai/KM_AITypes.pas" + ], + "km_aiparameters": [ + "src/ai/newAI/KM_AIParameters.pas" + ], + "km_armyattack": [ + "src/ai/newAI/KM_ArmyAttack.pas" + ], + "km_armyattacknew": [ + "src/ai/newAI/KM_ArmyAttackNew.pas" + ], + "km_armydefence": [ + "src/ai/newAI/KM_ArmyDefence.pas" + ], + "km_armymanagement": [ + "src/ai/newAI/KM_ArmyManagement.pas" + ], + "km_citybuilder": [ + "src/ai/newAI/KM_CityBuilder.pas" + ], + "km_citymanagement": [ + "src/ai/newAI/KM_CityManagement.pas" + ], + "km_cityplanner": [ + "src/ai/newAI/KM_CityPlanner.pas" + ], + "km_citypredictor": [ + "src/ai/newAI/KM_CityPredictor.pas" + ], + "km_eye": [ + "src/ai/newAI/KM_Eye.pas" + ], + "km_supervisor": [ + "src/ai/newAI/KM_Supervisor.pas" + ], + "km_commonclasses": [ + "src/common/KM_CommonClasses.pas" + ], + "km_commonclassesext": [ + "src/common/KM_CommonClassesExt.pas" + ], + "km_commonexceptions": [ + "src/common/KM_CommonExceptions.pas" + ], + "km_commongametypes": [ + "src/common/KM_CommonGameTypes.pas" + ], + "km_commontypes": [ + "src/common/KM_CommonTypes.pas" + ], + "km_defaults": [ + "src/common/KM_Defaults.pas" + ], + "km_entity": [ + "src/common/KM_Entity.pas" + ], + "km_lists": [ + "src/common/KM_Lists.pas" + ], + "km_points": [ + "src/common/KM_Points.pas" + ], + "km_workerthread": [ + "src/common/KM_WorkerThread.pas" + ], + "km_workerthreadutils": [ + "src/common/KM_WorkerThreadUtils.pas" + ], + "km_controls": [ + "src/controls/KM_Controls.pas" + ], + "km_controlsbase": [ + "src/controls/KM_ControlsBase.pas" + ], + "km_controlschart": [ + "src/controls/KM_ControlsChart.pas" + ], + "km_controlscolor": [ + "src/controls/KM_ControlsColor.pas" + ], + "km_controlsdragger": [ + "src/controls/KM_ControlsDragger.pas" + ], + "km_controlsdrop": [ + "src/controls/KM_ControlsDrop.pas" + ], + "km_controlsedit": [ + "src/controls/KM_ControlsEdit.pas" + ], + "km_controlsform": [ + "src/controls/KM_ControlsForm.pas" + ], + "km_controlslist": [ + "src/controls/KM_ControlsList.pas" + ], + "km_controlsmemo": [ + "src/controls/KM_ControlsMemo.pas" + ], + "km_controlsminimapview": [ + "src/controls/KM_ControlsMinimapView.pas" + ], + "km_controlspopup": [ + "src/controls/KM_ControlsPopUp.pas" + ], + "km_controlsprogressbar": [ + "src/controls/KM_ControlsProgressBar.pas" + ], + "km_controlsscroll": [ + "src/controls/KM_ControlsScroll.pas" + ], + "km_controlsswitch": [ + "src/controls/KM_ControlsSwitch.pas" + ], + "km_controlstrackbar": [ + "src/controls/KM_ControlsTrackBar.pas" + ], + "km_controlstypes": [ + "src/controls/KM_ControlsTypes.pas" + ], + "km_controlsutils": [ + "src/controls/KM_ControlsUtils.pas" + ], + "km_controlswaresrow": [ + "src/controls/KM_ControlsWaresRow.pas" + ], + "bgraanimatedgif": [ + "src/ext/BGRABitmap/bgraanimatedgif.pas" + ], + "bgraarrow": [ + "src/ext/BGRABitmap/bgraarrow.pas" + ], + "bgrabitmap": [ + "src/ext/BGRABitmap/bgrabitmap.pas" + ], + "bgrabitmappack": [ + "src/ext/BGRABitmap/bgrabitmappack.pas" + ], + "bgrabitmappack4fpgui": [ + "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas" + ], + "bgrabitmappack4nogui": [ + "src/ext/BGRABitmap/bgrabitmappack4nogui.pas" + ], + "bgrabitmaptypes": [ + "src/ext/BGRABitmap/bgrabitmaptypes.pas" + ], + "bgrablend": [ + "src/ext/BGRABitmap/bgrablend.pas" + ], + "bgrablurgl": [ + "src/ext/BGRABitmap/bgrablurgl.pas" + ], + "bgracanvas": [ + "src/ext/BGRABitmap/bgracanvas.pas" + ], + "bgracanvas2d": [ + "src/ext/BGRABitmap/bgracanvas2d.pas" + ], + "bgracanvasgl": [ + "src/ext/BGRABitmap/bgracanvasgl.pas" + ], + "bgraclasses": [ + "src/ext/BGRABitmap/bgraclasses.pas" + ], + "bgracolorint": [ + "src/ext/BGRABitmap/bgracolorint.pas" + ], + "bgracolorquantization": [ + "src/ext/BGRABitmap/bgracolorquantization.pas" + ], + "bgracompressablebitmap": [ + "src/ext/BGRABitmap/bgracompressablebitmap.pas" + ], + "bgracoordpool3d": [ + "src/ext/BGRABitmap/bgracoordpool3d.pas" + ], + "bgracustomtextfx": [ + "src/ext/BGRABitmap/bgracustomtextfx.pas" + ], + "bgradefaultbitmap": [ + "src/ext/BGRABitmap/bgradefaultbitmap.pas" + ], + "bgradithering": [ + "src/ext/BGRABitmap/bgradithering.pas" + ], + "bgradnetdeserial": [ + "src/ext/BGRABitmap/bgradnetdeserial.pas" + ], + "bgrafillinfo": [ + "src/ext/BGRABitmap/bgrafillinfo.pas" + ], + "bgrafilterblur": [ + "src/ext/BGRABitmap/bgrafilterblur.pas" + ], + "bgrafilters": [ + "src/ext/BGRABitmap/bgrafilters.pas" + ], + "bgrafilterscanner": [ + "src/ext/BGRABitmap/bgrafilterscanner.pas" + ], + "bgrafiltertype": [ + "src/ext/BGRABitmap/bgrafiltertype.pas" + ], + "bgrafontgl": [ + "src/ext/BGRABitmap/bgrafontgl.pas" + ], + "bgrafpguibitmap": [ + "src/ext/BGRABitmap/bgrafpguibitmap.pas" + ], + "bgrafreetype": [ + "src/ext/BGRABitmap/bgrafreetype.pas" + ], + "bgragifformat": [ + "src/ext/BGRABitmap/bgragifformat.pas" + ], + "bgragradientoriginal": [ + "src/ext/BGRABitmap/bgragradientoriginal.pas" + ], + "bgragradients": [ + "src/ext/BGRABitmap/bgragradients.pas" + ], + "bgragradientscanner": [ + "src/ext/BGRABitmap/bgragradientscanner.pas" + ], + "bgragraphics": [ + "src/ext/BGRABitmap/bgragraphics.pas" + ], + "bgragrayscalemask": [ + "src/ext/BGRABitmap/bgragrayscalemask.pas" + ], + "bgragtkbitmap": [ + "src/ext/BGRABitmap/bgragtkbitmap.pas" + ], + "bgraiconcursor": [ + "src/ext/BGRABitmap/bgraiconcursor.pas" + ], + "bgralayeroriginal": [ + "src/ext/BGRABitmap/bgralayeroriginal.pas" + ], + "bgralayers": [ + "src/ext/BGRABitmap/bgralayers.pas" + ], + "bgralazpaint": [ + "src/ext/BGRABitmap/bgralazpaint.pas" + ], + "bgralazresource": [ + "src/ext/BGRABitmap/bgralazresource.pas" + ], + "bgralclbitmap": [ + "src/ext/BGRABitmap/bgralclbitmap.pas" + ], + "bgralzpcommon": [ + "src/ext/BGRABitmap/bgralzpcommon.pas" + ], + "bgramacbitmap": [ + "src/ext/BGRABitmap/bgramacbitmap.pas" + ], + "bgramatrix3d": [ + "src/ext/BGRABitmap/bgramatrix3d.pas" + ], + "bgramemdirectory": [ + "src/ext/BGRABitmap/bgramemdirectory.pas" + ], + "bgramseguibitmap": [ + "src/ext/BGRABitmap/bgramseguibitmap.pas" + ], + "bgramultifiletype": [ + "src/ext/BGRABitmap/bgramultifiletype.pas" + ], + "bgranoguibitmap": [ + "src/ext/BGRABitmap/bgranoguibitmap.pas" + ], + "bgraopengl": [ + "src/ext/BGRABitmap/bgraopengl.pas" + ], + "bgraopengl3d": [ + "src/ext/BGRABitmap/bgraopengl3d.pas" + ], + "bgraopengltype": [ + "src/ext/BGRABitmap/bgraopengltype.pas" + ], + "bgraopenraster": [ + "src/ext/BGRABitmap/bgraopenraster.pas" + ], + "bgrapaintnet": [ + "src/ext/BGRABitmap/bgrapaintnet.pas" + ], + "bgrapalette": [ + "src/ext/BGRABitmap/bgrapalette.pas" + ], + "bgrapath": [ + "src/ext/BGRABitmap/bgrapath.pas" + ], + "bgrapen": [ + "src/ext/BGRABitmap/bgrapen.pas" + ], + "bgraphongtypes": [ + "src/ext/BGRABitmap/bgraphongtypes.pas" + ], + "bgraphoxo": [ + "src/ext/BGRABitmap/bgraphoxo.pas" + ], + "bgrapolygon": [ + "src/ext/BGRABitmap/bgrapolygon.pas" + ], + "bgrapolygonaliased": [ + "src/ext/BGRABitmap/bgrapolygonaliased.pas" + ], + "bgraqtbitmap": [ + "src/ext/BGRABitmap/bgraqtbitmap.pas" + ], + "bgrareadbmp": [ + "src/ext/BGRABitmap/bgrareadbmp.pas" + ], + "bgrareadbmpmiomap": [ + "src/ext/BGRABitmap/bgrareadbmpmiomap.pas" + ], + "bgrareadgif": [ + "src/ext/BGRABitmap/bgrareadgif.pas" + ], + "bgrareadico": [ + "src/ext/BGRABitmap/bgrareadico.pas" + ], + "bgrareadjpeg": [ + "src/ext/BGRABitmap/bgrareadjpeg.pas" + ], + "bgrareadlzp": [ + "src/ext/BGRABitmap/bgrareadlzp.pas" + ], + "bgrareadpcx": [ + "src/ext/BGRABitmap/bgrareadpcx.pas" + ], + "bgrareadpng": [ + "src/ext/BGRABitmap/bgrareadpng.pas" + ], + "bgrareadpsd": [ + "src/ext/BGRABitmap/bgrareadpsd.pas" + ], + "bgrareadtga": [ + "src/ext/BGRABitmap/bgrareadtga.pas" + ], + "bgrareadtiff": [ + "src/ext/BGRABitmap/bgrareadtiff.pas" + ], + "bgrareadwebp": [ + "src/ext/BGRABitmap/bgrareadwebp.pas" + ], + "bgrareadxpm": [ + "src/ext/BGRABitmap/bgrareadxpm.pas" + ], + "bgrarenderer3d": [ + "src/ext/BGRABitmap/bgrarenderer3d.pas" + ], + "bgraresample": [ + "src/ext/BGRABitmap/bgraresample.pas" + ], + "bgrascene3d": [ + "src/ext/BGRABitmap/bgrascene3d.pas" + ], + "bgrascenetypes": [ + "src/ext/BGRABitmap/bgrascenetypes.pas" + ], + "bgraslicescaling": [ + "src/ext/BGRABitmap/bgraslicescaling.pas" + ], + "bgraspritegl": [ + "src/ext/BGRABitmap/bgraspritegl.pas" + ], + "bgrasse": [ + "src/ext/BGRABitmap/bgrasse.pas" + ], + "bgrastreamlayers": [ + "src/ext/BGRABitmap/bgrastreamlayers.pas" + ], + "bgrasvg": [ + "src/ext/BGRABitmap/bgrasvg.pas" + ], + "bgrasvgoriginal": [ + "src/ext/BGRABitmap/bgrasvgoriginal.pas" + ], + "bgrasvgshapes": [ + "src/ext/BGRABitmap/bgrasvgshapes.pas" + ], + "bgrasvgtype": [ + "src/ext/BGRABitmap/bgrasvgtype.pas" + ], + "bgratext": [ + "src/ext/BGRABitmap/bgratext.pas" + ], + "bgratextbidi": [ + "src/ext/BGRABitmap/bgratextbidi.pas" + ], + "bgratextfx": [ + "src/ext/BGRABitmap/bgratextfx.pas" + ], + "bgrathumbnail": [ + "src/ext/BGRABitmap/bgrathumbnail.pas" + ], + "bgratransform": [ + "src/ext/BGRABitmap/bgratransform.pas" + ], + "bgratypewriter": [ + "src/ext/BGRABitmap/bgratypewriter.pas" + ], + "bgraunicode": [ + "src/ext/BGRABitmap/bgraunicode.pas" + ], + "bgraunicodetext": [ + "src/ext/BGRABitmap/bgraunicodetext.pas" + ], + "bgraunits": [ + "src/ext/BGRABitmap/bgraunits.pas" + ], + "bgrautf8": [ + "src/ext/BGRABitmap/bgrautf8.pas" + ], + "bgravectorize": [ + "src/ext/BGRABitmap/bgravectorize.pas" + ], + "bgrawinbitmap": [ + "src/ext/BGRABitmap/bgrawinbitmap.pas" + ], + "bgrawinresource": [ + "src/ext/BGRABitmap/bgrawinresource.pas" + ], + "bgrawritebmpmiomap": [ + "src/ext/BGRABitmap/bgrawritebmpmiomap.pas" + ], + "bgrawritelzp": [ + "src/ext/BGRABitmap/bgrawritelzp.pas" + ], + "bgrawritepng": [ + "src/ext/BGRABitmap/bgrawritepng.pas" + ], + "bgrawritetiff": [ + "src/ext/BGRABitmap/bgrawritetiff.pas" + ], + "bgrawritewebp": [ + "src/ext/BGRABitmap/bgrawritewebp.pas" + ], + "expandedbitmap": [ + "src/ext/BGRABitmap/expandedbitmap.pas" + ], + "libwebp": [ + "src/ext/BGRABitmap/libwebp.pas" + ], + "linearrgbabitmap": [ + "src/ext/BGRABitmap/linearrgbabitmap.pas" + ], + "linuxlib": [ + "src/ext/BGRABitmap/linuxlib.pas" + ], + "universaldrawer": [ + "src/ext/BGRABitmap/universaldrawer.pas" + ], + "unzipperext": [ + "src/ext/BGRABitmap/unzipperext.pas" + ], + "uunittest": [ + "src/ext/BGRABitmap/uunittest.pas" + ], + "wordxyzabitmap": [ + "src/ext/BGRABitmap/wordxyzabitmap.pas" + ], + "xyzabitmap": [ + "src/ext/BGRABitmap/xyzabitmap.pas" + ], + "binaryheapstub": [ + "src/ext/BinaryHeapStub.pas" + ], + "delaunay": [ + "src/ext/Delaunay.pas" + ], + "fastmm4": [ + "src/ext/FastMM4.pas" + ], + "fastmm4datacollector": [ + "src/ext/FastMM4DataCollector.pas" + ], + "fastmm4lockfreestack": [ + "src/ext/FastMM4LockFreeStack.pas" + ], + "fastmm4messages": [ + "src/ext/FastMM4Messages.pas" + ], + "fastmm5": [ + "src/ext/FastMM5.pas" + ], + "fastmmusagetracker": [ + "src/ext/FastMMUsageTracker.pas" + ], + "jsondataobjects": [ + "src/ext/JsonDataObjects.pas" + ], + "kromioutils": [ + "src/ext/KromIOUtils.pas" + ], + "lcommon": [ + "src/ext/LNet/lcommon.pp" + ], + "levents": [ + "src/ext/LNet/levents.pp" + ], + "lhttp": [ + "src/ext/LNet/lhttp.pp" + ], + "lhttputil": [ + "src/ext/LNet/lhttputil.pp" + ], + "lnet": [ + "src/ext/LNet/lnet.pp" + ], + "lnetssl": [ + "src/ext/LNet/lnetssl.pp" + ], + "lstrbuffer": [ + "src/ext/LNet/lstrbuffer.pp" + ], + "lws2tcpip": [ + "src/ext/LNet/lws2tcpip.pp" + ], + "openssl": [ + "src/ext/LNet/openssl.pas" + ], + "glcarbonaglcontext": [ + "src/ext/LazarusOpenGL/glcarbonaglcontext.pas" + ], + "glgtkglxcontext": [ + "src/ext/LazarusOpenGL/glgtkglxcontext.pas" + ], + "glqtcontext": [ + "src/ext/LazarusOpenGL/glqtcontext.pas" + ], + "glwin32wglcontext": [ + "src/ext/LazarusOpenGL/glwin32wglcontext.pas" + ], + "openglcontext": [ + "src/ext/LazarusOpenGL/openglcontext.pas" + ], + "objloader": [ + "src/ext/OBJLoader.pas" + ], + "codec": [ + "src/ext/OggVorbis/Codec.pas" + ], + "ostypes": [ + "src/ext/OggVorbis/OSTypes.pas" + ], + "ogg": [ + "src/ext/OggVorbis/Ogg.pas" + ], + "vorbisfile": [ + "src/ext/OggVorbis/VorbisFile.pas" + ], + "overbyteicsconapp": [ + "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas" + ], + "overbyteicspop3prot": [ + "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas" + ], + "ics.fmx.overbyteicswsockete": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas" + ], + "ics.fmx.overbyteicsblacklist": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas" + ], + "ics.fmx.overbyteicscharsetcombobox": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas" + ], + "ics.fmx.overbyteicsdnsquery": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas" + ], + "ics.fmx.overbyteicsfilecopy": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas" + ], + "ics.fmx.overbyteicsfingcli": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas" + ], + "ics.fmx.overbyteicsftpcli": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas" + ], + "ics.fmx.overbyteicsftpmulti": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas" + ], + "ics.fmx.overbyteicsftpsrv": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas" + ], + "ics.fmx.overbyteicshttpappserver": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas" + ], + "ics.fmx.overbyteicshttpmulti": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas" + ], + "ics.fmx.overbyteicshttpprot": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas" + ], + "ics.fmx.overbyteicshttpsrv": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas" + ], + "ics.fmx.overbyteicsicmp": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas" + ], + "ics.fmx.overbyteicsipstreamlog": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas" + ], + "ics.fmx.overbyteicsmailqueue": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas" + ], + "ics.fmx.overbyteicsmssslutils": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas" + ], + "ics.fmx.overbyteicsmultipartftpdownloader": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas" + ], + "ics.fmx.overbyteicsmultiparthttpdownloader": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas" + ], + "ics.fmx.overbyteicsnntpcli": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas" + ], + "ics.fmx.overbyteicsping": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas" + ], + "ics.fmx.overbyteicspop3prot": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas" + ], + "ics.fmx.overbyteicsproxy": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas" + ], + "ics.fmx.overbyteicsreg": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas" + ], + "ics.fmx.overbyteicssmtpprot": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas" + ], + "ics.fmx.overbyteicssntp": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas" + ], + "ics.fmx.overbyteicssocketutils": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas" + ], + "ics.fmx.overbyteicssslhttprest": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas" + ], + "ics.fmx.overbyteicsssljose": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas" + ], + "ics.fmx.overbyteicssslsessioncache": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas" + ], + "ics.fmx.overbyteicssslthrdlock": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas" + ], + "ics.fmx.overbyteicssslx509certs": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas" + ], + "ics.fmx.overbyteicssslx509utils": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas" + ], + "ics.fmx.overbyteicsthreadtimer": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas" + ], + "ics.fmx.overbyteicswsocket": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas" + ], + "ics.fmx.overbyteicswsockets": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas" + ], + "ics.fmx.overbyteicswhoiscli": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas" + ], + "ics.fmx.overbyteicswndcontrol": [ + "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas" + ], + "ics.posix.keventapi": [ + "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas" + ], + "ics.posix.keventtypes": [ + "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas" + ], + "ics.posix.messages": [ + "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas" + ], + "ics.posix.wintypes": [ + "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas" + ], + "ics.vcl.overbyteicsreg": [ + "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas" + ], + "overbyteicsftpsrvt": [ + "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas" + ], + "overbyteicsftpsrvwt": [ + "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas" + ], + "overbyteicswsockete": [ + "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas" + ], + "overbyteicsasn1utils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas" + ], + "overbyteicsavltrees": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas" + ], + "overbyteicsblacklist": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas" + ], + "overbyteicscrc": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas" + ], + "overbyteicscharsetcombobox": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas" + ], + "overbyteicscharsetutils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas" + ], + "overbyteicscookies": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas" + ], + "overbyteicscryptuiapi": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas" + ], + "overbyteicscsc": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas" + ], + "overbyteicsdes": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas" + ], + "overbyteicsdigestauth": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas" + ], + "overbyteicsdnsquery": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas" + ], + "overbyteicsdprupdfix": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas" + ], + "overbyteicsemulvt": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas" + ], + "overbyteicsfilecopy": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas" + ], + "overbyteicsfilecopyw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas" + ], + "overbyteicsfingcli": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas" + ], + "overbyteicsformdatadecoder": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas" + ], + "overbyteicsftpcli": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas" + ], + "overbyteicsftpcliw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas" + ], + "overbyteicsftpmulti": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas" + ], + "overbyteicsftpmultiw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas" + ], + "overbyteicsftpsrv": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas" + ], + "overbyteicsftpsrvw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas" + ], + "overbyteicshtmlpars": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas" + ], + "overbyteicshttpappserver": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas" + ], + "overbyteicshttpccodzlib": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas" + ], + "overbyteicshttpcontcod": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas" + ], + "overbyteicshttpmulti": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas" + ], + "overbyteicshttpmultiw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas" + ], + "overbyteicshttpprot": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas" + ], + "overbyteicshttpsrv": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas" + ], + "overbyteicsicmp": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas" + ], + "overbyteicsiconv": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas" + ], + "overbyteicsinifiles": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas" + ], + "overbyteicsipstreamlog": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas" + ], + "overbyteicslibeay": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas" + ], + "overbyteicslibeayex": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas" + ], + "overbyteicslogger": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas" + ], + "overbyteicsmd4": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas" + ], + "overbyteicsmd5": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas" + ], + "overbyteicsmlang": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas" + ], + "overbyteicsmailqueue": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas" + ], + "overbyteicsmimedec": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas" + ], + "overbyteicsmimeutils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas" + ], + "overbyteicsmssslutils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas" + ], + "overbyteicsmultiprogressbar": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas" + ], + "overbyteicsmultipartftpdownloader": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas" + ], + "overbyteicsmultiparthttpdownloader": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas" + ], + "overbyteicsnntpcli": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas" + ], + "overbyteicsntlmmsgs": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas" + ], + "overbyteicsntlmssp": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas" + ], + "overbyteicsonetimepw": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas" + ], + "overbyteicsping": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas" + ], + "overbyteicsproxy": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas" + ], + "overbyteicsreg": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas" + ], + "overbyteicsssleay": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas" + ], + "overbyteicssha1": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas" + ], + "overbyteicssmtpprot": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas" + ], + "overbyteicssmtpsrv": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas" + ], + "overbyteicssnmpcli": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas" + ], + "overbyteicssnmpmsgs": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas" + ], + "overbyteicssntp": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas" + ], + "overbyteicssocketutils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas" + ], + "overbyteicssslhttprest": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas" + ], + "overbyteicsssljose": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas" + ], + "overbyteicssslsessioncache": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas" + ], + "overbyteicssslthrdlock": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas" + ], + "overbyteicssslx509certs": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas" + ], + "overbyteicssslx509utils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas" + ], + "overbyteicssspi": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas" + ], + "overbyteicsstreams": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas" + ], + "overbyteicssuperobject": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas" + ], + "overbyteicssuperxmlparser": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas" + ], + "overbyteicssyslogclient": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas" + ], + "overbyteicssyslogdefs": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas" + ], + "overbyteicssyslogserver": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas" + ], + "overbyteicsthreadtimer": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas" + ], + "overbyteicsticks64": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas" + ], + "overbyteicstimelist": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas" + ], + "overbyteicstncnx": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas" + ], + "overbyteicstnemulvt": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas" + ], + "overbyteicstnoptfrm": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas" + ], + "overbyteicstnscript": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas" + ], + "overbyteicstypes": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas" + ], + "overbyteicsurl": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas" + ], + "overbyteicsutils": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas" + ], + "overbyteicswsockbuf": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas" + ], + "overbyteicswsocket": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas" + ], + "overbyteicswsockets": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas" + ], + "overbyteicswsocketts": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas" + ], + "overbyteicswebsession": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas" + ], + "overbyteicswebsockets": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas" + ], + "overbyteicswhoiscli": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas" + ], + "overbyteicswincrypt": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas" + ], + "overbyteicswinnls": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas" + ], + "overbyteicswinsock": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas" + ], + "overbyteicswmi": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas" + ], + "overbyteicswndcontrol": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas" + ], + "overbyteicszlibdll": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas" + ], + "overbyteicszlibobj": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas" + ], + "overbyteicszlibhigh": [ + "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas" + ], + "wbemscripting_tlb": [ + "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas" + ], + "polytriangulate": [ + "src/ext/PolyTriangulate.pas" + ], + "scizipfile": [ + "src/ext/SciZipFile.pas" + ], + "urlutils": [ + "src/ext/URLUtils.pas" + ], + "unit_vector": [ + "src/ext/Unit_Vector.pas" + ], + "verysimplexml": [ + "src/ext/VerySimpleXML.pas" + ], + "virtualtrees.accessibility": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas" + ], + "virtualtrees.accessibilityfactory": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas" + ], + "virtualtrees.actions": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas" + ], + "virtualtrees.classes": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas" + ], + "virtualtrees.clipboard": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas" + ], + "virtualtrees.export": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas" + ], + "virtualtrees.headerpopup": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas" + ], + "virtualtrees.stylehooks": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas" + ], + "virtualtrees.utils": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas" + ], + "virtualtrees.workerthread": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas" + ], + "virtualtrees": [ + "src/ext/Virtual-TreeView/Source/VirtualTrees.pas" + ], + "xml.verysimple": [ + "src/ext/Xml.VerySimple.pas" + ], + "zippit": [ + "src/ext/Zippit.pas" + ], + "bass": [ + "src/ext/bass.pas" + ], + "dglopengl": [ + "src/ext/dglOpenGL.pas" + ], + "iawin.namedelphithreads": [ + "src/ext/iaWin.NameDelphiThreads.pas" + ], + "libzplay": [ + "src/ext/libZPlay.pas" + ], + "openal": [ + "src/ext/openal.pas" + ], + "dataabstract_scripting": [ + "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas" + ], + "dataabstract_scripting_reg": [ + "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting_Reg.pas" + ], + "udapsscriptingprovider": [ + "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPSScriptingProvider.pas" + ], + "udapascalscript": [ + "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas" + ], + "pascalscript_ro_reg": [ + "src/ext/pascalscript_submodule/Addon/RemObjects SDK/PascalScript_RO_Reg.pas" + ], + "uropsimports": [ + "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSImports.pas" + ], + "uropsserverlink": [ + "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas" + ], + "dlgconfirmreplace": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas" + ], + "dlgreplacetext": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas" + ], + "dlgsearchtext": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas" + ], + "ide_debugoutput": [ + "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas" + ], + "ide_editor": [ + "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas" + ], + "ufrmgotoline": [ + "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas" + ], + "fdwin": [ + "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas" + ], + "fmain": [ + "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas" + ], + "pascalscript_core_ext_reg": [ + "src/ext/pascalscript_submodule/Source/PascalScript_Core_Ext_Reg.pas" + ], + "pascalscript_core_reg": [ + "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas" + ], + "pascalscript_core_reg_nodb": [ + "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg_noDB.pas" + ], + "upsi_dialogs": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas" + ], + "upsi_ibx": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas" + ], + "upsi_jvmail": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas" + ], + "upsi_mask": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas" + ], + "upsi_registry": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas" + ], + "ups_extreg": [ + "src/ext/pascalscript_submodule/Source/ThirdParty/uPS_ExtReg.pas" + ], + "pascalscript": [ + "src/ext/pascalscript_submodule/Source/pascalscript.pas" + ], + "upsc_db": [ + "src/ext/pascalscript_submodule/Source/uPSC_DB.pas" + ], + "upsc_buttons": [ + "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas" + ], + "upsc_classes": [ + "src/ext/pascalscript_submodule/Source/uPSC_classes.pas" + ], + "upsc_comobj": [ + "src/ext/pascalscript_submodule/Source/uPSC_comobj.pas" + ], + "upsc_controls": [ + "src/ext/pascalscript_submodule/Source/uPSC_controls.pas" + ], + "upsc_dateutils": [ + "src/ext/pascalscript_submodule/Source/uPSC_dateutils.pas" + ], + "upsc_dll": [ + "src/ext/pascalscript_submodule/Source/uPSC_dll.pas" + ], + "upsc_extctrls": [ + "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas" + ], + "upsc_forms": [ + "src/ext/pascalscript_submodule/Source/uPSC_forms.pas" + ], + "upsc_graphics": [ + "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas" + ], + "upsc_menus": [ + "src/ext/pascalscript_submodule/Source/uPSC_menus.pas" + ], + "upsc_std": [ + "src/ext/pascalscript_submodule/Source/uPSC_std.pas" + ], + "upsc_stdctrls": [ + "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas" + ], + "upscompiler": [ + "src/ext/pascalscript_submodule/Source/uPSCompiler.pas" + ], + "upscomponent": [ + "src/ext/pascalscript_submodule/Source/uPSComponent.pas" + ], + "upscomponentext": [ + "src/ext/pascalscript_submodule/Source/uPSComponentExt.pas" + ], + "upscomponent_com": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_COM.pas" + ], + "upscomponent_controls": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_Controls.pas" + ], + "upscomponent_db": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_DB.pas" + ], + "upscomponent_default": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_Default.pas" + ], + "upscomponent_forms": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_Forms.pas" + ], + "upscomponent_stdctrls": [ + "src/ext/pascalscript_submodule/Source/uPSComponent_StdCtrls.pas" + ], + "upsdebugger": [ + "src/ext/pascalscript_submodule/Source/uPSDebugger.pas" + ], + "upsdisassembly": [ + "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas" + ], + "upspreprocessor": [ + "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas" + ], + "upsr_db": [ + "src/ext/pascalscript_submodule/Source/uPSR_DB.pas" + ], + "upsr_buttons": [ + "src/ext/pascalscript_submodule/Source/uPSR_buttons.pas" + ], + "upsr_classes": [ + "src/ext/pascalscript_submodule/Source/uPSR_classes.pas" + ], + "upsr_comobj": [ + "src/ext/pascalscript_submodule/Source/uPSR_comobj.pas" + ], + "upsr_controls": [ + "src/ext/pascalscript_submodule/Source/uPSR_controls.pas" + ], + "upsr_dateutils": [ + "src/ext/pascalscript_submodule/Source/uPSR_dateutils.pas" + ], + "upsr_dll": [ + "src/ext/pascalscript_submodule/Source/uPSR_dll.pas" + ], + "upsr_extctrls": [ + "src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas" + ], + "upsr_forms": [ + "src/ext/pascalscript_submodule/Source/uPSR_forms.pas" + ], + "upsr_graphics": [ + "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas" + ], + "upsr_menus": [ + "src/ext/pascalscript_submodule/Source/uPSR_menus.pas" + ], + "upsr_std": [ + "src/ext/pascalscript_submodule/Source/uPSR_std.pas" + ], + "upsr_stdctrls": [ + "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas" + ], + "upsruntime": [ + "src/ext/pascalscript_submodule/Source/uPSRuntime.pas" + ], + "upsutils": [ + "src/ext/pascalscript_submodule/Source/uPSUtils.pas" + ], + "compiletestextended": [ + "src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas" + ], + "compilertestbase": [ + "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas" + ], + "compilertestfunctions": [ + "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas" + ], + "compilertestsimple": [ + "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas" + ], + "formsettings": [ + "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas" + ], + "extendedreg": [ + "src/ext/pascalscript_submodule/unit-importing/Import/Extendedreg.pas" + ], + "ifsir_dialogs.pas": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas" + ], + "ifsi_bigini": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_BigIni.pas" + ], + "ifsi_dialogs": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas" + ], + "ifsi_ibcustomdataset": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas" + ], + "ifsi_ibdatabase": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas" + ], + "ifsi_ibquery": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas" + ], + "ifsi_ibsql": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas" + ], + "ifsi_ibtable": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas" + ], + "ifsi_ibx": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas" + ], + "ifsi_ibxreg": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBXreg.pas" + ], + "ifsi_inifiles": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas" + ], + "ifsi_jvmail": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas" + ], + "ifsi_registry": [ + "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas" + ], + "main": [ + "src/ext/pascalscript_submodule/unit-importing/Main.pas" + ], + "parseru": [ + "src/ext/pascalscript_submodule/unit-importing/ParserU.pas" + ], + "parserutils": [ + "src/ext/pascalscript_submodule/unit-importing/ParserUtils.pas" + ], + "bigini": [ + "src/ext/pascalscript_submodule/unit-importing/bigini.pas" + ], + "km_formloading": [ + "src/forms/KM_FormLoading.pas" + ], + "km_formlogistics": [ + "src/forms/KM_FormLogistics.pas" + ], + "km_formmain": [ + "src/forms/KM_FormMain.pas" + ], + "km_vclmenuhint": [ + "src/forms/KM_VCLMenuHint.pas" + ], + "km_vclhelpers": [ + "src/forms/KM_VclHelpers.pas" + ], + "km_fogofwar": [ + "src/game/KM_FogOfWar.pas" + ], + "km_game": [ + "src/game/KM_Game.pas" + ], + "km_gameclasses": [ + "src/game/KM_GameClasses.pas" + ], + "km_gameinfo": [ + "src/game/KM_GameInfo.pas" + ], + "km_gameoptions": [ + "src/game/KM_GameOptions.pas" + ], + "km_gameparams": [ + "src/game/KM_GameParams.pas" + ], + "km_gamesavepoints": [ + "src/game/KM_GameSavePoints.pas" + ], + "km_gametypes": [ + "src/game/KM_GameTypes.pas" + ], + "km_gameinputprocess": [ + "src/game/gip/KM_GameInputProcess.pas" + ], + "km_gameinputprocess_multi": [ + "src/game/gip/KM_GameInputProcess_Multi.pas" + ], + "km_gameinputprocess_single": [ + "src/game/gip/KM_GameInputProcess_Single.pas" + ], + "km_gameuidtracker": [ + "src/game/misc/KM_GameUIDTracker.pas" + ], + "km_randomchecks": [ + "src/game/misc/KM_RandomChecks.pas" + ], + "km_alerts": [ + "src/game/notifications/KM_Alerts.pas" + ], + "km_messagelog": [ + "src/game/notifications/KM_MessageLog.pas" + ], + "km_messagestack": [ + "src/game/notifications/KM_MessageStack.pas" + ], + "km_cursor": [ + "src/gui/KM_Cursor.pas" + ], + "km_interfacedefaults": [ + "src/gui/KM_InterfaceDefaults.pas" + ], + "km_interfacegame": [ + "src/gui/KM_InterfaceGame.pas" + ], + "km_interfacegameplay": [ + "src/gui/KM_InterfaceGamePlay.pas" + ], + "km_interfacemainmenu": [ + "src/gui/KM_InterfaceMainMenu.pas" + ], + "km_interfacemapeditor": [ + "src/gui/KM_InterfaceMapEditor.pas" + ], + "km_interfacetypes": [ + "src/gui/KM_InterfaceTypes.pas" + ], + "km_viewport": [ + "src/gui/KM_Viewport.pas" + ], + "km_guicommongameoptions": [ + "src/gui/pages_common/KM_GUICommonGameOptions.pas" + ], + "km_guicommonkeys": [ + "src/gui/pages_common/KM_GUICommonKeys.pas" + ], + "km_guicommonoptions": [ + "src/gui/pages_common/KM_GUICommonOptions.pas" + ], + "km_guigamebuild": [ + "src/gui/pages_game/KM_GUIGameBuild.pas" + ], + "km_guigamechat": [ + "src/gui/pages_game/KM_GUIGameChat.pas" + ], + "km_guigamehouse": [ + "src/gui/pages_game/KM_GUIGameHouse.pas" + ], + "km_guigameratios": [ + "src/gui/pages_game/KM_GUIGameRatios.pas" + ], + "km_guigameresultsmp": [ + "src/gui/pages_game/KM_GUIGameResultsMP.pas" + ], + "km_guigameresultssp": [ + "src/gui/pages_game/KM_GUIGameResultsSP.pas" + ], + "km_guigamespectator": [ + "src/gui/pages_game/KM_GUIGameSpectator.pas" + ], + "km_guigamespectatoritemlines": [ + "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas" + ], + "km_guigamestats": [ + "src/gui/pages_game/KM_GUIGameStats.pas" + ], + "km_guigameunit": [ + "src/gui/pages_game/KM_GUIGameUnit.pas" + ], + "km_guimapedextras": [ + "src/gui/pages_maped/KM_GUIMapEdExtras.pas" + ], + "km_guimapedhouse": [ + "src/gui/pages_maped/KM_GUIMapEdHouse.pas" + ], + "km_guimapedmarkerdefence": [ + "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas" + ], + "km_guimapedmarkerreveal": [ + "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas" + ], + "km_guimapedmessage": [ + "src/gui/pages_maped/KM_GUIMapEdMessage.pas" + ], + "km_guimapedunit": [ + "src/gui/pages_maped/KM_GUIMapEdUnit.pas" + ], + "km_guimapedmenu": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas" + ], + "km_guimapedmenuload": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas" + ], + "km_guimapedmenuquickplay": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas" + ], + "km_guimapedmenuquit": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas" + ], + "km_guimapedmenuresize": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas" + ], + "km_guimapedmenusave": [ + "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas" + ], + "km_guimapedmission": [ + "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas" + ], + "km_guimapedmissionalliances": [ + "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas" + ], + "km_guimapedmissionmode": [ + "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas" + ], + "km_guimapedmissionplayers": [ + "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas" + ], + "km_guimapedplayer": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas" + ], + "km_guimapedplayerblockhouse": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas" + ], + "km_guimapedplayerblocktrade": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas" + ], + "km_guimapedplayerblockunit": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas" + ], + "km_guimapedplayercolors": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas" + ], + "km_guimapedplayergoalpopup": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas" + ], + "km_guimapedplayergoals": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas" + ], + "km_guimapedplayerview": [ + "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas" + ], + "km_guimapedrmg": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas" + ], + "km_guimapedterrain": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas" + ], + "km_guimapedterrainbrushes": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas" + ], + "km_guimapedterrainheights": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas" + ], + "km_guimapedterrainobjects": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas" + ], + "km_guimapedterrainoverlays": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas" + ], + "km_guimapedterrainselection": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas" + ], + "km_guimapedterraintiles": [ + "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas" + ], + "km_guimapedtown": [ + "src/gui/pages_maped/town/KM_GUIMapEdTown.pas" + ], + "km_guimapedtownattackpopup": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas" + ], + "km_guimapedtowndefence": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas" + ], + "km_guimapedtownformationspopup": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas" + ], + "km_guimapedtownhouses": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas" + ], + "km_guimapedtownoffence": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas" + ], + "km_guimapedtownscript": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas" + ], + "km_guimapedtownunits": [ + "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas" + ], + "km_guimenucampaign": [ + "src/gui/pages_menu/KM_GUIMenuCampaign.pas" + ], + "km_guimenucampaigns": [ + "src/gui/pages_menu/KM_GUIMenuCampaigns.pas" + ], + "km_guimenucredits": [ + "src/gui/pages_menu/KM_GUIMenuCredits.pas" + ], + "km_guimenuerror": [ + "src/gui/pages_menu/KM_GUIMenuError.pas" + ], + "km_guimenuload": [ + "src/gui/pages_menu/KM_GUIMenuLoad.pas" + ], + "km_guimenuloading": [ + "src/gui/pages_menu/KM_GUIMenuLoading.pas" + ], + "km_guimenulobby": [ + "src/gui/pages_menu/KM_GUIMenuLobby.pas" + ], + "km_guimenumain": [ + "src/gui/pages_menu/KM_GUIMenuMain.pas" + ], + "km_guimenumapeditor": [ + "src/gui/pages_menu/KM_GUIMenuMapEditor.pas" + ], + "km_guimenumultiplayer": [ + "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas" + ], + "km_guimenuoptions": [ + "src/gui/pages_menu/KM_GUIMenuOptions.pas" + ], + "km_guimenureplays": [ + "src/gui/pages_menu/KM_GUIMenuReplays.pas" + ], + "km_guimenusinglemap": [ + "src/gui/pages_menu/KM_GUIMenuSingleMap.pas" + ], + "km_guimenusingleplayer": [ + "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas" + ], + "km_hand": [ + "src/hands/KM_Hand.pas" + ], + "km_handconstructions": [ + "src/hands/KM_HandConstructions.pas" + ], + "km_handentity": [ + "src/hands/KM_HandEntity.pas" + ], + "km_handentityhelper": [ + "src/hands/KM_HandEntityHelper.pas" + ], + "km_handlocks": [ + "src/hands/KM_HandLocks.pas" + ], + "km_handlogistics": [ + "src/hands/KM_HandLogistics.pas" + ], + "km_handspectator": [ + "src/hands/KM_HandSpectator.pas" + ], + "km_handstats": [ + "src/hands/KM_HandStats.pas" + ], + "km_handtypes": [ + "src/hands/KM_HandTypes.pas" + ], + "km_handscollection": [ + "src/hands/KM_HandsCollection.pas" + ], + "km_waredistribution": [ + "src/hands/KM_WareDistribution.pas" + ], + "km_housearmorworkshop": [ + "src/houses/KM_HouseArmorWorkshop.pas" + ], + "km_housebarracks": [ + "src/houses/KM_HouseBarracks.pas" + ], + "km_housecollection": [ + "src/houses/KM_HouseCollection.pas" + ], + "km_houseinn": [ + "src/houses/KM_HouseInn.pas" + ], + "km_housemarket": [ + "src/houses/KM_HouseMarket.pas" + ], + "km_houseschool": [ + "src/houses/KM_HouseSchool.pas" + ], + "km_housestore": [ + "src/houses/KM_HouseStore.pas" + ], + "km_houseswinestable": [ + "src/houses/KM_HouseSwineStable.pas" + ], + "km_housetownhall": [ + "src/houses/KM_HouseTownHall.pas" + ], + "km_housewoodcutters": [ + "src/houses/KM_HouseWoodcutters.pas" + ], + "km_houses": [ + "src/houses/KM_Houses.pas" + ], + "km_mapedtypes": [ + "src/maped/KM_MapEdTypes.pas" + ], + "km_mapeditor": [ + "src/maped/KM_MapEditor.pas" + ], + "km_mapeditorhistory": [ + "src/maped/KM_MapEditorHistory.pas" + ], + "km_audio": [ + "src/media/KM_Audio.pas" + ], + "km_mediatypes": [ + "src/media/KM_MediaTypes.pas" + ], + "km_music": [ + "src/media/KM_Music.pas" + ], + "km_scriptsound": [ + "src/media/KM_ScriptSound.pas" + ], + "km_sound": [ + "src/media/KM_Sound.pas" + ], + "km_vlc": [ + "src/media/KM_VLC.pas" + ], + "km_video": [ + "src/media/KM_Video.pas" + ], + "km_minimap": [ + "src/minimap/KM_Minimap.pas" + ], + "km_minimapgame": [ + "src/minimap/KM_MinimapGame.pas" + ], + "km_minimapmission": [ + "src/minimap/KM_MinimapMission.pas" + ], + "km_campaignclasses": [ + "src/mission/KM_CampaignClasses.pas" + ], + "km_campaigntypes": [ + "src/mission/KM_CampaignTypes.pas" + ], + "km_campaignutils": [ + "src/mission/KM_CampaignUtils.pas" + ], + "km_campaigns": [ + "src/mission/KM_Campaigns.pas" + ], + "km_maptypes": [ + "src/mission/KM_MapTypes.pas" + ], + "km_maputils": [ + "src/mission/KM_MapUtils.pas" + ], + "km_maputilsext": [ + "src/mission/KM_MapUtilsExt.pas" + ], + "km_maps": [ + "src/mission/KM_Maps.pas" + ], + "km_missionscript": [ + "src/mission/KM_MissionScript.pas" + ], + "km_missionscript_info": [ + "src/mission/KM_MissionScript_Info.pas" + ], + "km_missionscript_preview": [ + "src/mission/KM_MissionScript_Preview.pas" + ], + "km_missionscript_standard": [ + "src/mission/KM_MissionScript_Standard.pas" + ], + "km_navmesh": [ + "src/navmesh/KM_NavMesh.pas" + ], + "km_navmesharmypositioning": [ + "src/navmesh/KM_NavMeshArmyPositioning.pas" + ], + "km_navmesharmyvectorfield": [ + "src/navmesh/KM_NavMeshArmyVectorField.pas" + ], + "km_navmeshdefences": [ + "src/navmesh/KM_NavMeshDefences.pas" + ], + "km_navmeshfloodfill": [ + "src/navmesh/KM_NavMeshFloodFill.pas" + ], + "km_navmeshfloodpositioning": [ + "src/navmesh/KM_NavMeshFloodPositioning.pas" + ], + "km_navmeshgenerator": [ + "src/navmesh/KM_NavMeshGenerator.pas" + ], + "km_navmeshinfluences": [ + "src/navmesh/KM_NavMeshInfluences.pas" + ], + "km_navmeshpathfinding": [ + "src/navmesh/KM_NavMeshPathFinding.pas" + ], + "km_outline": [ + "src/navmesh/KM_Outline.pas" + ], + "km_polysimplify": [ + "src/navmesh/KM_PolySimplify.pas" + ], + "km_netauthunsecure": [ + "src/net/KM_NetAuthUnsecure.pas" + ], + "km_netclient": [ + "src/net/KM_NetClient.pas" + ], + "km_netclientlnet": [ + "src/net/KM_NetClientLNet.pas" + ], + "km_netclientoverbyte": [ + "src/net/KM_NetClientOverbyte.pas" + ], + "km_netconsts": [ + "src/net/KM_NetConsts.pas" + ], + "km_netdedicatedserver": [ + "src/net/KM_NetDedicatedServer.pas" + ], + "km_netfiletransfer": [ + "src/net/KM_NetFileTransfer.pas" + ], + "km_netgameinfo": [ + "src/net/KM_NetGameInfo.pas" + ], + "km_netroom": [ + "src/net/KM_NetRoom.pas" + ], + "km_netserver": [ + "src/net/KM_NetServer.pas" + ], + "km_netserverlnet": [ + "src/net/KM_NetServerLNet.pas" + ], + "km_netserverlocator": [ + "src/net/KM_NetServerLocator.pas" + ], + "km_netserveroverbyte": [ + "src/net/KM_NetServerOverbyte.pas" + ], + "km_netserverpoller": [ + "src/net/KM_NetServerPoller.pas" + ], + "km_nettypes": [ + "src/net/KM_NetTypes.pas" + ], + "km_netudp": [ + "src/net/KM_NetUDP.pas" + ], + "km_netudplnet": [ + "src/net/KM_NetUDPLNet.pas" + ], + "km_netudpoverbyte": [ + "src/net/KM_NetUDPOverbyte.pas" + ], + "km_networkutils": [ + "src/net/KM_NetworkUtils.pas" + ], + "km_networking": [ + "src/net/KM_Networking.pas" + ], + "km_httpclient": [ + "src/net/http/KM_HTTPClient.pas" + ], + "km_httpclientlnet": [ + "src/net/http/KM_HTTPClientLNet.pas" + ], + "km_httpclientoverbyte": [ + "src/net/http/KM_HTTPClientOverbyte.pas" + ], + "km_pathfinding": [ + "src/pathfinding/KM_PathFinding.pas" + ], + "km_pathfindingastarnew": [ + "src/pathfinding/KM_PathFindingAStarNew.pas" + ], + "km_pathfindingastarold": [ + "src/pathfinding/KM_PathFindingAStarOld.pas" + ], + "km_pathfindingjps": [ + "src/pathfinding/KM_PathFindingJPS.pas" + ], + "km_pathfindingroad": [ + "src/pathfinding/KM_PathFindingRoad.pas" + ], + "km_devperflog": [ + "src/perflog/KM_DevPerfLog.pas" + ], + "km_devperflogform": [ + "src/perflog/KM_DevPerfLogForm.pas" + ], + "km_devperflogsingle": [ + "src/perflog/KM_DevPerfLogSingle.pas" + ], + "km_devperflogstack": [ + "src/perflog/KM_DevPerfLogStack.pas" + ], + "km_devperflogtypes": [ + "src/perflog/KM_DevPerfLogTypes.pas" + ], + "km_render": [ + "src/render/KM_Render.pas" + ], + "km_renderaux": [ + "src/render/KM_RenderAux.pas" + ], + "km_rendercontrol": [ + "src/render/KM_RenderControl.pas" + ], + "km_renderdebug": [ + "src/render/KM_RenderDebug.pas" + ], + "km_rendergameaux": [ + "src/render/KM_RenderGameAux.pas" + ], + "km_renderpool": [ + "src/render/KM_RenderPool.pas" + ], + "km_renderquery": [ + "src/render/KM_RenderQuery.pas" + ], + "km_renderterrain": [ + "src/render/KM_RenderTerrain.pas" + ], + "km_rendertypes": [ + "src/render/KM_RenderTypes.pas" + ], + "km_renderui": [ + "src/render/KM_RenderUI.pas" + ], + "km_pics": [ + "src/res/KM_Pics.pas" + ], + "km_rescursors": [ + "src/res/KM_ResCursors.pas" + ], + "km_resexporter": [ + "src/res/KM_ResExporter.pas" + ], + "km_resfonts": [ + "src/res/KM_ResFonts.pas" + ], + "km_resfontsedit": [ + "src/res/KM_ResFontsEdit.pas" + ], + "km_reshouses": [ + "src/res/KM_ResHouses.pas" + ], + "km_resinterpolation": [ + "src/res/KM_ResInterpolation.pas" + ], + "km_reskeyfuncs": [ + "src/res/KM_ResKeyFuncs.pas" + ], + "km_reskeys": [ + "src/res/KM_ResKeys.pas" + ], + "km_reslocales": [ + "src/res/KM_ResLocales.pas" + ], + "km_resmapelements": [ + "src/res/KM_ResMapElements.pas" + ], + "km_respalettes": [ + "src/res/KM_ResPalettes.pas" + ], + "km_ressound": [ + "src/res/KM_ResSound.pas" + ], + "km_ressprites": [ + "src/res/KM_ResSprites.pas" + ], + "km_resspritesedit": [ + "src/res/KM_ResSpritesEdit.pas" + ], + "km_restexts": [ + "src/res/KM_ResTexts.pas" + ], + "km_restileset": [ + "src/res/KM_ResTileset.pas" + ], + "km_restilesettypes": [ + "src/res/KM_ResTilesetTypes.pas" + ], + "km_restypes": [ + "src/res/KM_ResTypes.pas" + ], + "km_resunits": [ + "src/res/KM_ResUnits.pas" + ], + "km_reswares": [ + "src/res/KM_ResWares.pas" + ], + "km_resource": [ + "src/res/KM_Resource.pas" + ], + "km_saves": [ + "src/res/KM_Saves.pas" + ], + "km_scripterrorhandler": [ + "src/scripting/KM_ScriptErrorHandler.pas" + ], + "km_scriptfilescollection": [ + "src/scripting/KM_ScriptFilesCollection.pas" + ], + "km_scriptpreprocessor": [ + "src/scripting/KM_ScriptPreProcessor.pas" + ], + "km_scriptpreprocessorgame": [ + "src/scripting/KM_ScriptPreProcessorGame.pas" + ], + "km_scriptvalidatorresult": [ + "src/scripting/KM_ScriptValidatorResult.pas" + ], + "km_scripting": [ + "src/scripting/KM_Scripting.pas" + ], + "km_scriptingactions": [ + "src/scripting/KM_ScriptingActions.pas" + ], + "km_scriptingconsolecommands": [ + "src/scripting/KM_ScriptingConsoleCommands.pas" + ], + "km_scriptingevents": [ + "src/scripting/KM_ScriptingEvents.pas" + ], + "km_scriptingidcache": [ + "src/scripting/KM_ScriptingIdCache.pas" + ], + "km_scriptingstates": [ + "src/scripting/KM_ScriptingStates.pas" + ], + "km_scriptingtypes": [ + "src/scripting/KM_ScriptingTypes.pas" + ], + "km_scriptingutils": [ + "src/scripting/KM_ScriptingUtils.pas" + ], + "km_gameappsettings": [ + "src/settings/KM_GameAppSettings.pas" + ], + "km_gameappsettingspart": [ + "src/settings/KM_GameAppSettingsPart.pas" + ], + "km_gamesettings": [ + "src/settings/KM_GameSettings.pas" + ], + "km_keyssettings": [ + "src/settings/KM_KeysSettings.pas" + ], + "km_mainsettings": [ + "src/settings/KM_MainSettings.pas" + ], + "km_resolutions": [ + "src/settings/KM_Resolutions.pas" + ], + "km_serversettings": [ + "src/settings/KM_ServerSettings.pas" + ], + "km_settings": [ + "src/settings/KM_Settings.pas" + ], + "km_settingsdev": [ + "src/settings/KM_SettingsDev.pas" + ], + "km_settingsxml": [ + "src/settings/KM_SettingsXML.pas" + ], + "km_windowparams": [ + "src/settings/KM_WindowParams.pas" + ], + "km_rmgutils": [ + "src/terrain/KM_RMGUtils.pas" + ], + "km_randommapgenerator": [ + "src/terrain/KM_RandomMapGenerator.pas" + ], + "km_terrain": [ + "src/terrain/KM_Terrain.pas" + ], + "km_terraindeposits": [ + "src/terrain/KM_TerrainDeposits.pas" + ], + "km_terrainfinder": [ + "src/terrain/KM_TerrainFinder.pas" + ], + "km_terrainpainter": [ + "src/terrain/KM_TerrainPainter.pas" + ], + "km_terrainselection": [ + "src/terrain/KM_TerrainSelection.pas" + ], + "km_terraintypes": [ + "src/terrain/KM_TerrainTypes.pas" + ], + "km_terrainutils": [ + "src/terrain/KM_TerrainUtils.pas" + ], + "km_terrainwalkconnect": [ + "src/terrain/KM_TerrainWalkConnect.pas" + ], + "km_testmapgenerator": [ + "src/terrain/KM_TestMapGenerator.pas" + ], + "km_unitgroup": [ + "src/units/KM_UnitGroup.pas" + ], + "km_unitgrouptypes": [ + "src/units/KM_UnitGroupTypes.pas" + ], + "km_unitvisual": [ + "src/units/KM_UnitVisual.pas" + ], + "km_unitwarrior": [ + "src/units/KM_UnitWarrior.pas" + ], + "km_unitworkplan": [ + "src/units/KM_UnitWorkPlan.pas" + ], + "km_units": [ + "src/units/KM_Units.pas" + ], + "km_unitscollection": [ + "src/units/KM_UnitsCollection.pas" + ], + "km_unitactionabandonwalk": [ + "src/units/actions/KM_UnitActionAbandonWalk.pas" + ], + "km_unitactionfight": [ + "src/units/actions/KM_UnitActionFight.pas" + ], + "km_unitactiongoinout": [ + "src/units/actions/KM_UnitActionGoInOut.pas" + ], + "km_unitactionstay": [ + "src/units/actions/KM_UnitActionStay.pas" + ], + "km_unitactionsteer": [ + "src/units/actions/KM_UnitActionSteer.pas" + ], + "km_unitactionstormattack": [ + "src/units/actions/KM_UnitActionStormAttack.pas" + ], + "km_unitactionwalkto": [ + "src/units/actions/KM_UnitActionWalkTo.pas" + ], + "km_unittaskattackhouse": [ + "src/units/tasks/KM_UnitTaskAttackHouse.pas" + ], + "km_unittaskbuild": [ + "src/units/tasks/KM_UnitTaskBuild.pas" + ], + "km_unittaskdelivery": [ + "src/units/tasks/KM_UnitTaskDelivery.pas" + ], + "km_unittaskdie": [ + "src/units/tasks/KM_UnitTaskDie.pas" + ], + "km_unittaskdismiss": [ + "src/units/tasks/KM_UnitTaskDismiss.pas" + ], + "km_unittaskgoeat": [ + "src/units/tasks/KM_UnitTaskGoEat.pas" + ], + "km_unittaskgohome": [ + "src/units/tasks/KM_UnitTaskGoHome.pas" + ], + "km_unittaskgooutshowhungry": [ + "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas" + ], + "km_unittaskmining": [ + "src/units/tasks/KM_UnitTaskMining.pas" + ], + "km_unittaskselftrain": [ + "src/units/tasks/KM_UnitTaskSelfTrain.pas" + ], + "km_unittaskthrowrock": [ + "src/units/tasks/KM_UnitTaskThrowRock.pas" + ], + "km_achievements": [ + "src/unused/KM_Achievements.pas" + ], + "km_commonsave": [ + "src/unused/KM_CommonSave.pas" + ], + "km_perflog": [ + "src/unused/KM_PerfLog.pas" + ], + "km_commonshellutils": [ + "src/utils/KM_CommonShellUtils.pas" + ], + "km_commonutils": [ + "src/utils/KM_CommonUtils.pas" + ], + "km_consoletimer": [ + "src/utils/KM_ConsoleTimer.pas" + ], + "km_utils": [ + "src/utils/KM_Utils.pas" + ], + "km_utilsext": [ + "src/utils/KM_UtilsExt.pas" + ], + "kromoglutils": [ + "src/utils/KromOGLUtils.pas" + ], + "kromshellutils": [ + "src/utils/KromShellUtils.pas" + ], + "kromutils": [ + "src/utils/KromUtils.pas" + ], + "binaryheap": [ + "src/utils/algorithms/BinaryHeap.pas" + ], + "binaryheapgen": [ + "src/utils/algorithms/BinaryHeapGen.pas" + ], + "km_binpacking": [ + "src/utils/algorithms/KM_BinPacking.pas" + ], + "km_floodfill": [ + "src/utils/algorithms/KM_FloodFill.pas" + ], + "km_hungarian": [ + "src/utils/algorithms/KM_Hungarian.pas" + ], + "km_marchingsquares": [ + "src/utils/algorithms/KM_MarchingSquares.pas" + ], + "km_softshadows": [ + "src/utils/algorithms/KM_SoftShadows.pas" + ], + "km_sort": [ + "src/utils/algorithms/KM_Sort.pas" + ], + "km_fileio": [ + "src/utils/io/KM_FileIO.pas" + ], + "km_iographicutils": [ + "src/utils/io/KM_IoGraphicUtils.pas" + ], + "km_iojson": [ + "src/utils/io/KM_IoJSON.pas" + ], + "km_iopng": [ + "src/utils/io/KM_IoPNG.pas" + ], + "km_ioxml": [ + "src/utils/io/KM_IoXML.pas" + ], + "km_methodparser": [ + "src/utils/method_parser/KM_MethodParser.pas" + ], + "km_methodparserparams": [ + "src/utils/method_parser/KM_MethodParserParams.pas" + ] + }, + "duplicates": { + "overbyteicspop3prot": [ + "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas" + ], + "dlgconfirmreplace": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas" + ], + "dlgreplacetext": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas" + ], + "dlgsearchtext": [ + "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas" + ], + "ide_debugoutput": [ + "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas" + ], + "ide_editor": [ + "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas" + ], + "ufrmgotoline": [ + "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas" + ], + "fdwin": [ + "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas" + ], + "fmain": [ + "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas" + ] + }, + "edges": [ + { + "from": "KM_Console", + "to": "Generics.Collections" + }, + { + "from": "KM_Console", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Console", + "to": "KM_NetTypes" + }, + { + "from": "KM_Console", + "to": "Math" + }, + { + "from": "KM_Console", + "to": "SysUtils" + }, + { + "from": "KM_Console", + "to": "StrUtils" + }, + { + "from": "KM_Console", + "to": "KM_ResTexts" + }, + { + "from": "KM_Console", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Console", + "to": "KM_ScriptingConsoleCommands" + }, + { + "from": "KM_Console", + "to": "KM_Game" + }, + { + "from": "KM_Console", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_Console", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Console", + "to": "KM_Defaults" + }, + { + "from": "KM_Crashreport", + "to": "MadExcept" + }, + { + "from": "KM_Crashreport", + "to": "KM_GameTypes" + }, + { + "from": "KM_Crashreport", + "to": "KM_Defaults" + }, + { + "from": "KM_Crashreport", + "to": "SysUtils" + }, + { + "from": "KM_Crashreport", + "to": "Math" + }, + { + "from": "KM_Crashreport", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Crashreport", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_Crashreport", + "to": "KM_Log" + }, + { + "from": "KM_Crashreport", + "to": "KM_Game" + }, + { + "from": "KM_Exceptions", + "to": "MadExcept" + }, + { + "from": "KM_Exceptions", + "to": "madNVAssistant" + }, + { + "from": "KM_Exceptions", + "to": "SysUtils" + }, + { + "from": "KM_Exceptions", + "to": "KM_FileIO" + }, + { + "from": "KM_Exceptions", + "to": "KM_Cursor" + }, + { + "from": "KM_Exceptions", + "to": "KM_GameApp" + }, + { + "from": "KM_Exceptions", + "to": "KM_CrashReport" + }, + { + "from": "KM_Exceptions", + "to": "KM_Game" + }, + { + "from": "KM_Exceptions", + "to": "KM_Log" + }, + { + "from": "KM_Exceptions", + "to": "KM_ResTexts" + }, + { + "from": "KM_Exceptions", + "to": "KM_Defaults" + }, + { + "from": "KM_Exceptions", + "to": "KM_Points" + }, + { + "from": "KM_Exceptions", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_Exceptions", + "to": "KM_Settings" + }, + { + "from": "KM_Exceptions", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_Exceptions", + "to": "KM_ServerSettings" + }, + { + "from": "KM_GameApp", + "to": "UITypes" + }, + { + "from": "KM_GameApp", + "to": "Controls" + }, + { + "from": "KM_GameApp", + "to": "Classes" + }, + { + "from": "KM_GameApp", + "to": "Dialogs" + }, + { + "from": "KM_GameApp", + "to": "SysUtils" + }, + { + "from": "KM_GameApp", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameApp", + "to": "KM_Defaults" + }, + { + "from": "KM_GameApp", + "to": "KM_RenderControl" + }, + { + "from": "KM_GameApp", + "to": "KM_Video" + }, + { + "from": "KM_GameApp", + "to": "KM_Campaigns" + }, + { + "from": "KM_GameApp", + "to": "KM_Game" + }, + { + "from": "KM_GameApp", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GameApp", + "to": "KM_InterfaceMainMenu" + }, + { + "from": "KM_GameApp", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GameApp", + "to": "KM_Resource" + }, + { + "from": "KM_GameApp", + "to": "KM_Music" + }, + { + "from": "KM_GameApp", + "to": "KM_Maps" + }, + { + "from": "KM_GameApp", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameApp", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_GameApp", + "to": "KM_Networking" + }, + { + "from": "KM_GameApp", + "to": "KM_GameSettings" + }, + { + "from": "KM_GameApp", + "to": "KM_KeysSettings" + }, + { + "from": "KM_GameApp", + "to": "KM_ServerSettings" + }, + { + "from": "KM_GameApp", + "to": "KM_Render" + }, + { + "from": "KM_GameApp", + "to": "KM_GameTypes" + }, + { + "from": "KM_GameApp", + "to": "KM_Points" + }, + { + "from": "KM_GameApp", + "to": "KM_Console" + }, + { + "from": "KM_GameApp", + "to": "KM_WorkerThread" + }, + { + "from": "KM_GameApp", + "to": "Windows" + }, + { + "from": "KM_GameApp", + "to": "LCLType" + }, + { + "from": "KM_GameApp", + "to": "DateUtils" + }, + { + "from": "KM_GameApp", + "to": "Math" + }, + { + "from": "KM_GameApp", + "to": "TypInfo" + }, + { + "from": "KM_GameApp", + "to": "KromUtils" + }, + { + "from": "KM_GameApp", + "to": "KM_Exceptions" + }, + { + "from": "KM_GameApp", + "to": "KM_System" + }, + { + "from": "KM_GameApp", + "to": "KM_FormLogistics" + }, + { + "from": "KM_GameApp", + "to": "KM_Main" + }, + { + "from": "KM_GameApp", + "to": "KM_Controls" + }, + { + "from": "KM_GameApp", + "to": "KM_Log" + }, + { + "from": "KM_GameApp", + "to": "KM_Sound" + }, + { + "from": "KM_GameApp", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GameApp", + "to": "KM_GameInputProcess_Multi" + }, + { + "from": "KM_GameApp", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GameApp", + "to": "KM_GameSavePoints" + }, + { + "from": "KM_GameApp", + "to": "KM_Cursor" + }, + { + "from": "KM_GameApp", + "to": "KM_ResTexts" + }, + { + "from": "KM_GameApp", + "to": "KM_ResKeys" + }, + { + "from": "KM_GameApp", + "to": "KM_ResTypes" + }, + { + "from": "KM_GameApp", + "to": "KM_IoGraphicUtils" + }, + { + "from": "KM_GameApp", + "to": "KM_Settings" + }, + { + "from": "KM_GameApp", + "to": "KM_Saves" + }, + { + "from": "KM_GameApp", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameApp", + "to": "KM_CommonShellUtils" + }, + { + "from": "KM_GameApp", + "to": "KM_RandomChecks" + }, + { + "from": "KM_GameApp", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_GameApp", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_Log", + "to": "SyncObjs" + }, + { + "from": "KM_Log", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Log", + "to": "Generics.Collections" + }, + { + "from": "KM_Log", + "to": "IOUtils" + }, + { + "from": "KM_Log", + "to": "Classes" + }, + { + "from": "KM_Log", + "to": "SysUtils" + }, + { + "from": "KM_Log", + "to": "KM_FileIO" + }, + { + "from": "KM_Log", + "to": "KM_Defaults" + }, + { + "from": "KM_Log", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Main", + "to": "Windows" + }, + { + "from": "KM_Main", + "to": "KM_Defaults" + }, + { + "from": "KM_Main", + "to": "KM_FormMain" + }, + { + "from": "KM_Main", + "to": "KM_FormLoading" + }, + { + "from": "KM_Main", + "to": "KM_Maps" + }, + { + "from": "KM_Main", + "to": "KM_MainSettings" + }, + { + "from": "KM_Main", + "to": "KM_Resolutions" + }, + { + "from": "KM_Main", + "to": "KM_Video" + }, + { + "from": "KM_Main", + "to": "KM_WindowParams" + }, + { + "from": "KM_Main", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_Main", + "to": "Types" + }, + { + "from": "KM_Main", + "to": "Classes" + }, + { + "from": "KM_Main", + "to": "SysUtils" + }, + { + "from": "KM_Main", + "to": "SysConst" + }, + { + "from": "KM_Main", + "to": "StrUtils" + }, + { + "from": "KM_Main", + "to": "Math" + }, + { + "from": "KM_Main", + "to": "Forms" + }, + { + "from": "KM_Main", + "to": "MMSystem" + }, + { + "from": "KM_Main", + "to": "Dialogs" + }, + { + "from": "KM_Main", + "to": "LCLType" + }, + { + "from": "KM_Main", + "to": "Controls" + }, + { + "from": "KM_Main", + "to": "KM_Exceptions" + }, + { + "from": "KM_Main", + "to": "KromUtils" + }, + { + "from": "KM_Main", + "to": "KM_FileIO" + }, + { + "from": "KM_Main", + "to": "KM_GameApp" + }, + { + "from": "KM_Main", + "to": "KM_VclHelpers" + }, + { + "from": "KM_Main", + "to": "KM_System" + }, + { + "from": "KM_Main", + "to": "KM_ResTexts" + }, + { + "from": "KM_Main", + "to": "KM_KeysSettings" + }, + { + "from": "KM_Main", + "to": "KM_Music" + }, + { + "from": "KM_Main", + "to": "KM_Log" + }, + { + "from": "KM_Main", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Main", + "to": "KM_Points" + }, + { + "from": "KM_Main", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_Main", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_Main", + "to": "KromShellUtils" + }, + { + "from": "KM_Main", + "to": "KM_MapTypes" + }, + { + "from": "KM_Projectiles", + "to": "KM_Units" + }, + { + "from": "KM_Projectiles", + "to": "KM_Houses" + }, + { + "from": "KM_Projectiles", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Projectiles", + "to": "KM_CommonGameTypes" + }, + { + "from": "KM_Projectiles", + "to": "KM_Points" + }, + { + "from": "KM_Projectiles", + "to": "KM_RenderTypes" + }, + { + "from": "KM_Projectiles", + "to": "Math" + }, + { + "from": "KM_Projectiles", + "to": "KromUtils" + }, + { + "from": "KM_Projectiles", + "to": "KM_Entity" + }, + { + "from": "KM_Projectiles", + "to": "KM_Terrain" + }, + { + "from": "KM_Projectiles", + "to": "KM_RenderAux" + }, + { + "from": "KM_Projectiles", + "to": "KM_Resource" + }, + { + "from": "KM_Projectiles", + "to": "KM_ResSound" + }, + { + "from": "KM_Projectiles", + "to": "KM_ResUnits" + }, + { + "from": "KM_Projectiles", + "to": "KM_Hand" + }, + { + "from": "KM_Projectiles", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Projectiles", + "to": "KM_HandTypes" + }, + { + "from": "KM_Projectiles", + "to": "KM_HandEntity" + }, + { + "from": "KM_Projectiles", + "to": "KM_Sound" + }, + { + "from": "KM_Projectiles", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Projectiles", + "to": "KM_Defaults" + }, + { + "from": "KM_System", + "to": "Windows" + }, + { + "from": "KM_System", + "to": "LCLIntf" + }, + { + "from": "KM_System", + "to": "LCLType" + }, + { + "from": "KM_System", + "to": "KM_ResSprites" + }, + { + "from": "KM_System", + "to": "KM_ResTypes" + }, + { + "from": "KM_System", + "to": "KM_Defaults" + }, + { + "from": "KM_System", + "to": "SysUtils" + }, + { + "from": "KM_System", + "to": "Math" + }, + { + "from": "KM_System", + "to": "Forms" + }, + { + "from": "KM_System", + "to": "Graphics" + }, + { + "from": "KM_AI", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AI", + "to": "KM_CommonTypes" + }, + { + "from": "KM_AI", + "to": "KM_Defaults" + }, + { + "from": "KM_AI", + "to": "KM_Houses" + }, + { + "from": "KM_AI", + "to": "KM_Units" + }, + { + "from": "KM_AI", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_AI", + "to": "KM_Points" + }, + { + "from": "KM_AI", + "to": "KM_AISetup" + }, + { + "from": "KM_AI", + "to": "KM_AIMayor" + }, + { + "from": "KM_AI", + "to": "KM_AIGoals" + }, + { + "from": "KM_AI", + "to": "KM_AIGeneral" + }, + { + "from": "KM_AI", + "to": "KM_CityManagement" + }, + { + "from": "KM_AI", + "to": "KM_ArmyManagement" + }, + { + "from": "KM_AI", + "to": "KM_GameTypes" + }, + { + "from": "KM_AI", + "to": "SysUtils" + }, + { + "from": "KM_AI", + "to": "TypInfo" + }, + { + "from": "KM_AI", + "to": "Math" + }, + { + "from": "KM_AI", + "to": "KM_GameApp" + }, + { + "from": "KM_AI", + "to": "KM_Game" + }, + { + "from": "KM_AI", + "to": "KM_Hand" + }, + { + "from": "KM_AI", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AI", + "to": "KM_HandStats" + }, + { + "from": "KM_AI", + "to": "KM_UnitGroup" + }, + { + "from": "KM_AI", + "to": "KM_ResSound" + }, + { + "from": "KM_AI", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_AI", + "to": "KM_Alerts" + }, + { + "from": "KM_AI", + "to": "KM_AIFields" + }, + { + "from": "KM_AI", + "to": "KM_Terrain" + }, + { + "from": "KM_AI", + "to": "KM_ResMapElements" + }, + { + "from": "KM_AI", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_AI", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_AI", + "to": "KM_HandTypes" + }, + { + "from": "KM_AI", + "to": "KM_MapTypes" + }, + { + "from": "KM_AI", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_Defaults" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_Units" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_UnitGroup" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "Classes" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "Math" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_Hand" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_HandStats" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_Resource" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_ResUnits" + }, + { + "from": "KM_AIArmyEvaluation", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIAttacks", + "to": "KM_Defaults" + }, + { + "from": "KM_AIAttacks", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIAttacks", + "to": "KM_Points" + }, + { + "from": "KM_AIAttacks", + "to": "KM_AITypes" + }, + { + "from": "KM_AIAttacks", + "to": "Math" + }, + { + "from": "KM_AIAttacks", + "to": "KM_Game" + }, + { + "from": "KM_AIAttacks", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_TerrainFinder" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Defaults" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Points" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_ResTypes" + }, + { + "from": "KM_AICityPlanner", + "to": "Math" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Hand" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_HandTypes" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_AIFields" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_AIInfluences" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Terrain" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Resource" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_ResUnits" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_NavMesh" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_Houses" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_CommonUtils" + }, + { + "from": "KM_AICityPlanner", + "to": "KM_CommonTypes" + }, + { + "from": "KM_AIDefensePos", + "to": "Math" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_Entity" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_UnitGroup" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_Defaults" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_Points" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_AITypes" + }, + { + "from": "KM_AIDefensePos", + "to": "SysUtils" + }, + { + "from": "KM_AIDefensePos", + "to": "TypInfo" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_Game" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_GameParams" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_RenderAux" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_RenderPool" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_Hand" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_AIDefensePos", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_AIFields", + "to": "KM_NavMesh" + }, + { + "from": "KM_AIFields", + "to": "KM_AIInfluences" + }, + { + "from": "KM_AIFields", + "to": "KM_Eye" + }, + { + "from": "KM_AIFields", + "to": "KM_Supervisor" + }, + { + "from": "KM_AIFields", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIFields", + "to": "KM_Points" + }, + { + "from": "KM_AIFields", + "to": "KM_GameTypes" + }, + { + "from": "KM_AIFields", + "to": "SysUtils" + }, + { + "from": "KM_AIFields", + "to": "KM_Defaults" + }, + { + "from": "KM_AIFields", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_AIFields", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_AIGeneral", + "to": "Generics.Collections" + }, + { + "from": "KM_AIGeneral", + "to": "KM_AISetup" + }, + { + "from": "KM_AIGeneral", + "to": "KM_AIAttacks" + }, + { + "from": "KM_AIGeneral", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Units" + }, + { + "from": "KM_AIGeneral", + "to": "KM_UnitGroup" + }, + { + "from": "KM_AIGeneral", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_AIGeneral", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Defaults" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Points" + }, + { + "from": "KM_AIGeneral", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_AIGeneral", + "to": "KM_AITypes" + }, + { + "from": "KM_AIGeneral", + "to": "Classes" + }, + { + "from": "KM_AIGeneral", + "to": "Math" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Entity" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Game" + }, + { + "from": "KM_AIGeneral", + "to": "KM_GameParams" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Hand" + }, + { + "from": "KM_AIGeneral", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIGeneral", + "to": "KM_HandTypes" + }, + { + "from": "KM_AIGeneral", + "to": "KM_HandEntity" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Terrain" + }, + { + "from": "KM_AIGeneral", + "to": "KM_AIFields" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Houses" + }, + { + "from": "KM_AIGeneral", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_AIGeneral", + "to": "KM_ResHouses" + }, + { + "from": "KM_AIGeneral", + "to": "KM_CommonUtils" + }, + { + "from": "KM_AIGeneral", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_AIGeneral", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_AIGeneral", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_AIGeneral", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIGeneral", + "to": "KM_Sort" + }, + { + "from": "KM_AIGoals", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIGoals", + "to": "KM_Defaults" + }, + { + "from": "KM_AIGoals", + "to": "KM_MapTypes" + }, + { + "from": "KM_AIGoals", + "to": "Classes" + }, + { + "from": "KM_AIGoals", + "to": "SysUtils" + }, + { + "from": "KM_AIGoals", + "to": "Math" + }, + { + "from": "KM_AIInfluences", + "to": "Math" + }, + { + "from": "KM_AIInfluences", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIInfluences", + "to": "KM_CommonTypes" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Defaults" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Points" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Units" + }, + { + "from": "KM_AIInfluences", + "to": "KM_UnitGroup" + }, + { + "from": "KM_AIInfluences", + "to": "KM_NavMesh" + }, + { + "from": "KM_AIInfluences", + "to": "KM_NavMeshGenerator" + }, + { + "from": "KM_AIInfluences", + "to": "KM_NavMeshInfluences" + }, + { + "from": "KM_AIInfluences", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_AIInfluences", + "to": "SysUtils" + }, + { + "from": "KM_AIInfluences", + "to": "Classes" + }, + { + "from": "KM_AIInfluences", + "to": "KM_RenderAux" + }, + { + "from": "KM_AIInfluences", + "to": "KM_CommonUtils" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Terrain" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Houses" + }, + { + "from": "KM_AIInfluences", + "to": "KM_HouseCollection" + }, + { + "from": "KM_AIInfluences", + "to": "KM_Hand" + }, + { + "from": "KM_AIInfluences", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIInfluences", + "to": "KM_HandTypes" + }, + { + "from": "KM_AIInfluences", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIMayor", + "to": "KM_AIMayorBalance" + }, + { + "from": "KM_AIMayor", + "to": "KM_AICityPlanner" + }, + { + "from": "KM_AIMayor", + "to": "KM_AISetup" + }, + { + "from": "KM_AIMayor", + "to": "KM_PathfindingRoad" + }, + { + "from": "KM_AIMayor", + "to": "KM_ResHouses" + }, + { + "from": "KM_AIMayor", + "to": "KM_HouseCollection" + }, + { + "from": "KM_AIMayor", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIMayor", + "to": "KM_Defaults" + }, + { + "from": "KM_AIMayor", + "to": "KM_Points" + }, + { + "from": "KM_AIMayor", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_AIMayor", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIMayor", + "to": "Classes" + }, + { + "from": "KM_AIMayor", + "to": "Math" + }, + { + "from": "KM_AIMayor", + "to": "KM_Game" + }, + { + "from": "KM_AIMayor", + "to": "KM_Hand" + }, + { + "from": "KM_AIMayor", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIMayor", + "to": "KM_HandTypes" + }, + { + "from": "KM_AIMayor", + "to": "KM_AIFields" + }, + { + "from": "KM_AIMayor", + "to": "KM_Terrain" + }, + { + "from": "KM_AIMayor", + "to": "KM_Houses" + }, + { + "from": "KM_AIMayor", + "to": "KM_HouseSchool" + }, + { + "from": "KM_AIMayor", + "to": "KM_HouseStore" + }, + { + "from": "KM_AIMayor", + "to": "KM_Units" + }, + { + "from": "KM_AIMayor", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_AIMayor", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_AIMayor", + "to": "KM_UnitTaskGoEat" + }, + { + "from": "KM_AIMayor", + "to": "KM_UnitTaskDelivery" + }, + { + "from": "KM_AIMayor", + "to": "KM_Resource" + }, + { + "from": "KM_AIMayor", + "to": "KM_AITypes" + }, + { + "from": "KM_AIMayor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_AIMayor", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_AIMayor", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_Defaults" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_ResTypes" + }, + { + "from": "KM_AIMayorBalance", + "to": "SysUtils" + }, + { + "from": "KM_AIMayorBalance", + "to": "StrUtils" + }, + { + "from": "KM_AIMayorBalance", + "to": "Math" + }, + { + "from": "KM_AIMayorBalance", + "to": "KromUtils" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_Hand" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_HandsCollection" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_Resource" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_ResWares" + }, + { + "from": "KM_AIMayorBalance", + "to": "KM_ResHouses" + }, + { + "from": "KM_AISetup", + "to": "KM_CommonClasses" + }, + { + "from": "KM_AISetup", + "to": "KM_Defaults" + }, + { + "from": "KM_AISetup", + "to": "KM_Points" + }, + { + "from": "KM_AISetup", + "to": "KM_AITypes" + }, + { + "from": "KM_AISetup", + "to": "Math" + }, + { + "from": "KM_AIParameters", + "to": "SysUtils" + }, + { + "from": "KM_AIParameters", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ArmyAttack", + "to": "Classes" + }, + { + "from": "KM_ArmyAttack", + "to": "KromUtils" + }, + { + "from": "KM_ArmyAttack", + "to": "Math" + }, + { + "from": "KM_ArmyAttack", + "to": "SysUtils" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Units" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Defaults" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Points" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Houses" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_ResHouses" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_ResWares" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_NavMeshPathFinding" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Eye" + }, + { + "from": "KM_ArmyAttack", + "to": "Types" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_Terrain" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_AIFields" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_NavMesh" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_RenderAux" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_ArmyAttack", + "to": "KM_AIParameters" + }, + { + "from": "KM_ArmyAttackNew", + "to": "Generics.Collections" + }, + { + "from": "KM_ArmyAttackNew", + "to": "Classes" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KromUtils" + }, + { + "from": "KM_ArmyAttackNew", + "to": "Math" + }, + { + "from": "KM_ArmyAttackNew", + "to": "SysUtils" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Units" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Defaults" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Points" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Houses" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_ResHouses" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_NavMeshPathFinding" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_ResTypes" + }, + { + "from": "KM_ArmyAttackNew", + "to": "Types" + }, + { + "from": "KM_ArmyAttackNew", + "to": "TypInfo" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Entity" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Game" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_GameParams" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_HandTypes" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_HandEntity" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_Terrain" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_AIFields" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_NavMesh" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_RenderAux" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_AIParameters" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_UnitActionFight" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_ArmyAttackNew", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_ArmyDefence", + "to": "Classes" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_Defaults" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_Points" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_ArmyDefence", + "to": "Math" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_Entity" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_GameParams" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_Hand" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_RenderAux" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_AIFields" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_NavMesh" + }, + { + "from": "KM_ArmyDefence", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_ArmyManagement", + "to": "Classes" + }, + { + "from": "KM_ArmyManagement", + "to": "KromUtils" + }, + { + "from": "KM_ArmyManagement", + "to": "Math" + }, + { + "from": "KM_ArmyManagement", + "to": "SysUtils" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Defaults" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Points" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Houses" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Units" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_AISetup" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_ResTypes" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_HandStats" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_ArmyDefence" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_AIAttacks" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_ArmyAttackNew" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Game" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_GameParams" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Hand" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_HandTypes" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_HandEntity" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_Terrain" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_AITypes" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_AIFields" + }, + { + "from": "KM_ArmyManagement", + "to": "KM_MapTypes" + }, + { + "from": "KM_CityBuilder", + "to": "KromUtils" + }, + { + "from": "KM_CityBuilder", + "to": "Math" + }, + { + "from": "KM_CityBuilder", + "to": "SysUtils" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Defaults" + }, + { + "from": "KM_CityBuilder", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Points" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Sort" + }, + { + "from": "KM_CityBuilder", + "to": "KM_ResHouses" + }, + { + "from": "KM_CityBuilder", + "to": "KM_HandConstructions" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Houses" + }, + { + "from": "KM_CityBuilder", + "to": "KM_AIInfluences" + }, + { + "from": "KM_CityBuilder", + "to": "KM_CityPlanner" + }, + { + "from": "KM_CityBuilder", + "to": "KM_CityPredictor" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Eye" + }, + { + "from": "KM_CityBuilder", + "to": "KM_AIParameters" + }, + { + "from": "KM_CityBuilder", + "to": "KM_ResTypes" + }, + { + "from": "KM_CityBuilder", + "to": "Classes" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Game" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Hand" + }, + { + "from": "KM_CityBuilder", + "to": "KM_HandsCollection" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Terrain" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Resource" + }, + { + "from": "KM_CityBuilder", + "to": "KM_ResWares" + }, + { + "from": "KM_CityBuilder", + "to": "KM_AIFields" + }, + { + "from": "KM_CityBuilder", + "to": "KM_Units" + }, + { + "from": "KM_CityBuilder", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_CityBuilder", + "to": "KM_UnitTaskBuild" + }, + { + "from": "KM_CityBuilder", + "to": "KM_CommonUtils" + }, + { + "from": "KM_CityBuilder", + "to": "KM_RenderAux" + }, + { + "from": "KM_CityBuilder", + "to": "KM_ResMapElements" + }, + { + "from": "KM_CityManagement", + "to": "Math" + }, + { + "from": "KM_CityManagement", + "to": "SysUtils" + }, + { + "from": "KM_CityManagement", + "to": "KM_Defaults" + }, + { + "from": "KM_CityManagement", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CityManagement", + "to": "KM_Points" + }, + { + "from": "KM_CityManagement", + "to": "KM_AISetup" + }, + { + "from": "KM_CityManagement", + "to": "KM_ResHouses" + }, + { + "from": "KM_CityManagement", + "to": "KM_ResUnits" + }, + { + "from": "KM_CityManagement", + "to": "KM_ResTypes" + }, + { + "from": "KM_CityManagement", + "to": "KM_HandStats" + }, + { + "from": "KM_CityManagement", + "to": "KM_HouseCollection" + }, + { + "from": "KM_CityManagement", + "to": "KM_CityPredictor" + }, + { + "from": "KM_CityManagement", + "to": "KM_CityBuilder" + }, + { + "from": "KM_CityManagement", + "to": "KM_CityPlanner" + }, + { + "from": "KM_CityManagement", + "to": "KM_AIArmyEvaluation" + }, + { + "from": "KM_CityManagement", + "to": "KM_AIParameters" + }, + { + "from": "KM_CityManagement", + "to": "Classes" + }, + { + "from": "KM_CityManagement", + "to": "KM_Game" + }, + { + "from": "KM_CityManagement", + "to": "KM_Houses" + }, + { + "from": "KM_CityManagement", + "to": "KM_HouseSchool" + }, + { + "from": "KM_CityManagement", + "to": "KM_HandsCollection" + }, + { + "from": "KM_CityManagement", + "to": "KM_Hand" + }, + { + "from": "KM_CityManagement", + "to": "KM_Resource" + }, + { + "from": "KM_CityManagement", + "to": "KM_HouseStore" + }, + { + "from": "KM_CityManagement", + "to": "KM_AIFields" + }, + { + "from": "KM_CityManagement", + "to": "KM_Units" + }, + { + "from": "KM_CityManagement", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_CityManagement", + "to": "KM_HouseMarket" + }, + { + "from": "KM_CityManagement", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_CityManagement", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_CityManagement", + "to": "KM_HandTypes" + }, + { + "from": "KM_CityPlanner", + "to": "SysUtils" + }, + { + "from": "KM_CityPlanner", + "to": "Classes" + }, + { + "from": "KM_CityPlanner", + "to": "Math" + }, + { + "from": "KM_CityPlanner", + "to": "Contnrs" + }, + { + "from": "KM_CityPlanner", + "to": "KromUtils" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Defaults" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Points" + }, + { + "from": "KM_CityPlanner", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CityPlanner", + "to": "KM_CommonTypes" + }, + { + "from": "KM_CityPlanner", + "to": "KM_CommonUtils" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Houses" + }, + { + "from": "KM_CityPlanner", + "to": "KM_ResHouses" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Sort" + }, + { + "from": "KM_CityPlanner", + "to": "KM_PathFindingRoad" + }, + { + "from": "KM_CityPlanner", + "to": "KM_PathFindingAStarNew" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Eye" + }, + { + "from": "KM_CityPlanner", + "to": "KM_AIParameters" + }, + { + "from": "KM_CityPlanner", + "to": "KM_AIInfluences" + }, + { + "from": "KM_CityPlanner", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_CityPlanner", + "to": "KM_CityPredictor" + }, + { + "from": "KM_CityPlanner", + "to": "KM_ResTypes" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Entity" + }, + { + "from": "KM_CityPlanner", + "to": "KM_GameParams" + }, + { + "from": "KM_CityPlanner", + "to": "KM_HouseCollection" + }, + { + "from": "KM_CityPlanner", + "to": "KM_HandsCollection" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Hand" + }, + { + "from": "KM_CityPlanner", + "to": "KM_HandTypes" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Terrain" + }, + { + "from": "KM_CityPlanner", + "to": "KM_Resource" + }, + { + "from": "KM_CityPlanner", + "to": "KM_AIFields" + }, + { + "from": "KM_CityPlanner", + "to": "KM_PathFinding" + }, + { + "from": "KM_CityPlanner", + "to": "KM_NavMesh" + }, + { + "from": "KM_CityPlanner", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_CityPlanner", + "to": "KM_ResUnits" + }, + { + "from": "KM_CityPlanner", + "to": "KM_RenderAux" + }, + { + "from": "KM_CityPlanner", + "to": "KM_ResMapElements" + }, + { + "from": "KM_CityPredictor", + "to": "SysUtils" + }, + { + "from": "KM_CityPredictor", + "to": "Classes" + }, + { + "from": "KM_CityPredictor", + "to": "Math" + }, + { + "from": "KM_CityPredictor", + "to": "KromUtils" + }, + { + "from": "KM_CityPredictor", + "to": "KM_Defaults" + }, + { + "from": "KM_CityPredictor", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CityPredictor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_CityPredictor", + "to": "KM_AISetup" + }, + { + "from": "KM_CityPredictor", + "to": "KM_ResHouses" + }, + { + "from": "KM_CityPredictor", + "to": "KM_ResWares" + }, + { + "from": "KM_CityPredictor", + "to": "KM_HandStats" + }, + { + "from": "KM_CityPredictor", + "to": "KM_AIParameters" + }, + { + "from": "KM_CityPredictor", + "to": "KM_ResTypes" + }, + { + "from": "KM_CityPredictor", + "to": "KM_HandsCollection" + }, + { + "from": "KM_CityPredictor", + "to": "KM_Hand" + }, + { + "from": "KM_CityPredictor", + "to": "KM_Game" + }, + { + "from": "KM_CityPredictor", + "to": "KM_GameParams" + }, + { + "from": "KM_CityPredictor", + "to": "KM_CityPlanner" + }, + { + "from": "KM_Eye", + "to": "SysUtils" + }, + { + "from": "KM_Eye", + "to": "Classes" + }, + { + "from": "KM_Eye", + "to": "Math" + }, + { + "from": "KM_Eye", + "to": "Contnrs" + }, + { + "from": "KM_Eye", + "to": "KromUtils" + }, + { + "from": "KM_Eye", + "to": "KM_Defaults" + }, + { + "from": "KM_Eye", + "to": "KM_Points" + }, + { + "from": "KM_Eye", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Eye", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Eye", + "to": "KM_ResHouses" + }, + { + "from": "KM_Eye", + "to": "KM_Houses" + }, + { + "from": "KM_Eye", + "to": "KM_Units" + }, + { + "from": "KM_Eye", + "to": "KM_AIArmyEvaluation" + }, + { + "from": "KM_Eye", + "to": "KM_AIInfluences" + }, + { + "from": "KM_Eye", + "to": "KM_FloodFill" + }, + { + "from": "KM_Eye", + "to": "KM_AIParameters" + }, + { + "from": "KM_Eye", + "to": "KM_ResTypes" + }, + { + "from": "KM_Eye", + "to": "KM_GameParams" + }, + { + "from": "KM_Eye", + "to": "KM_Terrain" + }, + { + "from": "KM_Eye", + "to": "KM_Hand" + }, + { + "from": "KM_Eye", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Eye", + "to": "KM_HandTypes" + }, + { + "from": "KM_Eye", + "to": "KM_HandEntity" + }, + { + "from": "KM_Eye", + "to": "KM_Resource" + }, + { + "from": "KM_Eye", + "to": "KM_AIFields" + }, + { + "from": "KM_Eye", + "to": "KM_RenderAux" + }, + { + "from": "KM_Eye", + "to": "KM_ResMapElements" + }, + { + "from": "KM_Eye", + "to": "KM_NavMesh" + }, + { + "from": "KM_Eye", + "to": "KM_CityPlanner" + }, + { + "from": "KM_Supervisor", + "to": "Classes" + }, + { + "from": "KM_Supervisor", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Supervisor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Supervisor", + "to": "KM_Defaults" + }, + { + "from": "KM_Supervisor", + "to": "KM_Points" + }, + { + "from": "KM_Supervisor", + "to": "KM_UnitGroup" + }, + { + "from": "KM_Supervisor", + "to": "KM_Units" + }, + { + "from": "KM_Supervisor", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_Supervisor", + "to": "KM_Terrain" + }, + { + "from": "KM_Supervisor", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_Supervisor", + "to": "KM_NavMeshInfluences" + }, + { + "from": "KM_Supervisor", + "to": "KM_ArmyManagement" + }, + { + "from": "KM_Supervisor", + "to": "KM_AIArmyEvaluation" + }, + { + "from": "KM_Supervisor", + "to": "KM_ArmyAttackNew" + }, + { + "from": "KM_Supervisor", + "to": "KM_NavMeshArmyVectorField" + }, + { + "from": "KM_Supervisor", + "to": "KM_Houses" + }, + { + "from": "KM_Supervisor", + "to": "KM_Sort" + }, + { + "from": "KM_Supervisor", + "to": "SysUtils" + }, + { + "from": "KM_Supervisor", + "to": "Math" + }, + { + "from": "KM_Supervisor", + "to": "KM_Game" + }, + { + "from": "KM_Supervisor", + "to": "KM_GameParams" + }, + { + "from": "KM_Supervisor", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Supervisor", + "to": "KM_Hand" + }, + { + "from": "KM_Supervisor", + "to": "KM_HandEntity" + }, + { + "from": "KM_Supervisor", + "to": "KM_HandTypes" + }, + { + "from": "KM_Supervisor", + "to": "KM_RenderAux" + }, + { + "from": "KM_Supervisor", + "to": "KM_AIFields" + }, + { + "from": "KM_Supervisor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Supervisor", + "to": "KM_AIParameters" + }, + { + "from": "KM_Supervisor", + "to": "KM_ResTypes" + }, + { + "from": "KM_CommonClasses", + "to": "Classes" + }, + { + "from": "KM_CommonClasses", + "to": "SysUtils" + }, + { + "from": "KM_CommonClasses", + "to": "KM_Points" + }, + { + "from": "KM_CommonClasses", + "to": "KM_CommonTypes" + }, + { + "from": "KM_CommonClasses", + "to": "Math" + }, + { + "from": "KM_CommonClasses", + "to": "System.NetEncoding" + }, + { + "from": "KM_CommonClasses", + "to": "zstream" + }, + { + "from": "KM_CommonClasses", + "to": "ZLib" + }, + { + "from": "KM_CommonClasses", + "to": "KM_CommonUtils" + }, + { + "from": "KM_CommonClasses", + "to": "KM_Defaults" + }, + { + "from": "KM_CommonClassesExt", + "to": "SysUtils" + }, + { + "from": "KM_CommonClassesExt", + "to": "TypInfo" + }, + { + "from": "KM_CommonClassesExt", + "to": "Generics.Collections" + }, + { + "from": "KM_CommonClassesExt", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CommonClassesExt", + "to": "KM_CommonTypes" + }, + { + "from": "KM_CommonClassesExt", + "to": "KM_CommonUtils" + }, + { + "from": "KM_CommonExceptions", + "to": "SysUtils" + }, + { + "from": "KM_CommonExceptions", + "to": "KM_Points" + }, + { + "from": "KM_CommonTypes", + "to": "KM_Points" + }, + { + "from": "KM_CommonTypes", + "to": "Math" + }, + { + "from": "KM_CommonTypes", + "to": "SysUtils" + }, + { + "from": "KM_CommonTypes", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Defaults", + "to": "SysUtils" + }, + { + "from": "KM_Entity", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Entity", + "to": "SysUtils" + }, + { + "from": "KM_Entity", + "to": "KM_Defaults" + }, + { + "from": "KM_Lists", + "to": "Classes" + }, + { + "from": "KM_Lists", + "to": "SysUtils" + }, + { + "from": "KM_Lists", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Points", + "to": "SysUtils" + }, + { + "from": "KM_Points", + "to": "TypInfo" + }, + { + "from": "KM_Points", + "to": "Math" + }, + { + "from": "KM_Points", + "to": "KM_Defaults" + }, + { + "from": "KM_Points", + "to": "KM_CommonUtils" + }, + { + "from": "KM_WorkerThread", + "to": "Classes" + }, + { + "from": "KM_WorkerThread", + "to": "SysUtils" + }, + { + "from": "KM_WorkerThread", + "to": "Generics.Collections" + }, + { + "from": "KM_WorkerThread", + "to": "KM_Log" + }, + { + "from": "KM_WorkerThreadUtils", + "to": "Classes" + }, + { + "from": "KM_WorkerThreadUtils", + "to": "KM_CommonClasses" + }, + { + "from": "KM_WorkerThreadUtils", + "to": "KM_WorkerThread" + }, + { + "from": "KM_Controls", + "to": "Classes" + }, + { + "from": "KM_Controls", + "to": "Controls" + }, + { + "from": "KM_Controls", + "to": "Generics.Collections" + }, + { + "from": "KM_Controls", + "to": "KromOGLUtils" + }, + { + "from": "KM_Controls", + "to": "KM_RenderUI" + }, + { + "from": "KM_Controls", + "to": "KM_Pics" + }, + { + "from": "KM_Controls", + "to": "KM_ResFonts" + }, + { + "from": "KM_Controls", + "to": "KM_ResTypes" + }, + { + "from": "KM_Controls", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Controls", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Controls", + "to": "KM_Points" + }, + { + "from": "KM_Controls", + "to": "KM_Defaults" + }, + { + "from": "KM_Controls", + "to": "Windows" + }, + { + "from": "KM_Controls", + "to": "LCLIntf" + }, + { + "from": "KM_Controls", + "to": "LCLType" + }, + { + "from": "KM_Controls", + "to": "SysUtils" + }, + { + "from": "KM_Controls", + "to": "StrUtils" + }, + { + "from": "KM_Controls", + "to": "Math" + }, + { + "from": "KM_Controls", + "to": "Clipbrd" + }, + { + "from": "KM_Controls", + "to": "KromUtils" + }, + { + "from": "KM_Controls", + "to": "KM_System" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsBase" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsDragger" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_Controls", + "to": "KM_ControlsWaresRow" + }, + { + "from": "KM_Controls", + "to": "KM_Resource" + }, + { + "from": "KM_Controls", + "to": "KM_ResSprites" + }, + { + "from": "KM_Controls", + "to": "KM_ResSound" + }, + { + "from": "KM_Controls", + "to": "KM_ResTexts" + }, + { + "from": "KM_Controls", + "to": "KM_ResKeys" + }, + { + "from": "KM_Controls", + "to": "KM_Render" + }, + { + "from": "KM_Controls", + "to": "KM_RenderTypes" + }, + { + "from": "KM_Controls", + "to": "KM_Sound" + }, + { + "from": "KM_Controls", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Controls", + "to": "KM_UtilsExt" + }, + { + "from": "KM_Controls", + "to": "KM_GameSettings" + }, + { + "from": "KM_Controls", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_ControlsBase", + "to": "Classes" + }, + { + "from": "KM_ControlsBase", + "to": "Controls" + }, + { + "from": "KM_ControlsBase", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsBase", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsBase", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsBase", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsBase", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsBase", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsBase", + "to": "KM_Points" + }, + { + "from": "KM_ControlsBase", + "to": "Windows" + }, + { + "from": "KM_ControlsBase", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsBase", + "to": "LCLType" + }, + { + "from": "KM_ControlsBase", + "to": "StrUtils" + }, + { + "from": "KM_ControlsBase", + "to": "Math" + }, + { + "from": "KM_ControlsBase", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_ControlsBase", + "to": "KM_Sound" + }, + { + "from": "KM_ControlsBase", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsBase", + "to": "KM_ResSound" + }, + { + "from": "KM_ControlsBase", + "to": "KM_ResSprites" + }, + { + "from": "KM_ControlsBase", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsBase", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsBase", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ControlsChart", + "to": "Classes" + }, + { + "from": "KM_ControlsChart", + "to": "Controls" + }, + { + "from": "KM_ControlsChart", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsChart", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsChart", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsChart", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsChart", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ControlsChart", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsChart", + "to": "KM_Points" + }, + { + "from": "KM_ControlsChart", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsChart", + "to": "SysUtils" + }, + { + "from": "KM_ControlsChart", + "to": "Math" + }, + { + "from": "KM_ControlsChart", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsChart", + "to": "KM_ResTexts" + }, + { + "from": "KM_ControlsChart", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsColor", + "to": "Classes" + }, + { + "from": "KM_ControlsColor", + "to": "Controls" + }, + { + "from": "KM_ControlsColor", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsColor", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsColor", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsColor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsColor", + "to": "Math" + }, + { + "from": "KM_ControlsColor", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsColor", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsColor", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsColor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsDragger", + "to": "Classes" + }, + { + "from": "KM_ControlsDragger", + "to": "Controls" + }, + { + "from": "KM_ControlsDragger", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsDragger", + "to": "Math" + }, + { + "from": "KM_ControlsDragger", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsDragger", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsDrop", + "to": "Classes" + }, + { + "from": "KM_ControlsDrop", + "to": "Controls" + }, + { + "from": "KM_ControlsDrop", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_ControlsList" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsDrop", + "to": "Windows" + }, + { + "from": "KM_ControlsDrop", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsDrop", + "to": "LCLType" + }, + { + "from": "KM_ControlsDrop", + "to": "Math" + }, + { + "from": "KM_ControlsDrop", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsEdit", + "to": "Classes" + }, + { + "from": "KM_ControlsEdit", + "to": "Controls" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_Points" + }, + { + "from": "KM_ControlsEdit", + "to": "Windows" + }, + { + "from": "KM_ControlsEdit", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsEdit", + "to": "LCLType" + }, + { + "from": "KM_ControlsEdit", + "to": "Clipbrd" + }, + { + "from": "KM_ControlsEdit", + "to": "SysUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "StrUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "Math" + }, + { + "from": "KM_ControlsEdit", + "to": "KromUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_ControlsUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsEdit", + "to": "KM_UtilsExt" + }, + { + "from": "KM_ControlsForm", + "to": "Classes" + }, + { + "from": "KM_ControlsForm", + "to": "Controls" + }, + { + "from": "KM_ControlsForm", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsForm", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsForm", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsForm", + "to": "KM_Points" + }, + { + "from": "KM_ControlsForm", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsForm", + "to": "Math" + }, + { + "from": "KM_ControlsForm", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsForm", + "to": "KM_ResTexts" + }, + { + "from": "KM_ControlsForm", + "to": "KM_ResKeys" + }, + { + "from": "KM_ControlsForm", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsList", + "to": "Classes" + }, + { + "from": "KM_ControlsList", + "to": "Controls" + }, + { + "from": "KM_ControlsList", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsList", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsList", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_ControlsList", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsList", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsList", + "to": "KM_Pics" + }, + { + "from": "KM_ControlsList", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsList", + "to": "KM_Points" + }, + { + "from": "KM_ControlsList", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsList", + "to": "Windows" + }, + { + "from": "KM_ControlsList", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsList", + "to": "LCLType" + }, + { + "from": "KM_ControlsList", + "to": "SysUtils" + }, + { + "from": "KM_ControlsList", + "to": "StrUtils" + }, + { + "from": "KM_ControlsList", + "to": "Math" + }, + { + "from": "KM_ControlsList", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_ControlsList", + "to": "KM_ControlsUtils" + }, + { + "from": "KM_ControlsList", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsList", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsList", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsMemo", + "to": "Classes" + }, + { + "from": "KM_ControlsMemo", + "to": "Controls" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_Points" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsMemo", + "to": "Windows" + }, + { + "from": "KM_ControlsMemo", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsMemo", + "to": "LCLType" + }, + { + "from": "KM_ControlsMemo", + "to": "SysUtils" + }, + { + "from": "KM_ControlsMemo", + "to": "StrUtils" + }, + { + "from": "KM_ControlsMemo", + "to": "Math" + }, + { + "from": "KM_ControlsMemo", + "to": "Clipbrd" + }, + { + "from": "KM_ControlsMemo", + "to": "KromUtils" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_ControlsUtils" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_Render" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ControlsMemo", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsMinimapView", + "to": "Classes" + }, + { + "from": "KM_ControlsMinimapView", + "to": "Controls" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Minimap" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Viewport" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Points" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsMinimapView", + "to": "SysUtils" + }, + { + "from": "KM_ControlsMinimapView", + "to": "Math" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KromUtils" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_MinimapGame" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_Render" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_GameSettings" + }, + { + "from": "KM_ControlsMinimapView", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_ControlsPopUp", + "to": "Classes" + }, + { + "from": "KM_ControlsPopUp", + "to": "Controls" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_ControlsList" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_Points" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsPopUp", + "to": "Math" + }, + { + "from": "KM_ControlsPopUp", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsProgressBar", + "to": "Generics.Collections" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsProgressBar", + "to": "Classes" + }, + { + "from": "KM_ControlsProgressBar", + "to": "Controls" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_Points" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsProgressBar", + "to": "SysUtils" + }, + { + "from": "KM_ControlsProgressBar", + "to": "Math" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_ResTexts" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsProgressBar", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ControlsScroll", + "to": "Classes" + }, + { + "from": "KM_ControlsScroll", + "to": "Controls" + }, + { + "from": "KM_ControlsScroll", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsScroll", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsScroll", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsScroll", + "to": "KM_Points" + }, + { + "from": "KM_ControlsScroll", + "to": "Math" + }, + { + "from": "KM_ControlsScroll", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsSwitch", + "to": "Classes" + }, + { + "from": "KM_ControlsSwitch", + "to": "Controls" + }, + { + "from": "KM_ControlsSwitch", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsSwitch", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsSwitch", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsSwitch", + "to": "SysUtils" + }, + { + "from": "KM_ControlsSwitch", + "to": "Math" + }, + { + "from": "KM_ControlsSwitch", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsSwitch", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsSwitch", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsTrackBar", + "to": "Classes" + }, + { + "from": "KM_ControlsTrackBar", + "to": "Controls" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_Points" + }, + { + "from": "KM_ControlsTrackBar", + "to": "SysUtils" + }, + { + "from": "KM_ControlsTrackBar", + "to": "Math" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KromUtils" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KromOGLUtils" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_Resource" + }, + { + "from": "KM_ControlsTrackBar", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsUtils", + "to": "Classes" + }, + { + "from": "KM_ControlsUtils", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_ControlsUtils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsUtils", + "to": "Windows" + }, + { + "from": "KM_ControlsUtils", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsUtils", + "to": "LCLType" + }, + { + "from": "KM_ControlsUtils", + "to": "Math" + }, + { + "from": "KM_ControlsUtils", + "to": "KromUtils" + }, + { + "from": "KM_ControlsWaresRow", + "to": "Classes" + }, + { + "from": "KM_ControlsWaresRow", + "to": "Controls" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_Controls" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_ControlsBase" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_ResTypes" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_Defaults" + }, + { + "from": "KM_ControlsWaresRow", + "to": "Windows" + }, + { + "from": "KM_ControlsWaresRow", + "to": "LCLIntf" + }, + { + "from": "KM_ControlsWaresRow", + "to": "LCLType" + }, + { + "from": "KM_ControlsWaresRow", + "to": "SysUtils" + }, + { + "from": "KM_ControlsWaresRow", + "to": "Math" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_RenderUI" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_ResFonts" + }, + { + "from": "KM_ControlsWaresRow", + "to": "KM_UtilsExt" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAClasses" + }, + { + "from": "BGRAAnimatedGif", + "to": "SysUtils" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAGraphics" + }, + { + "from": "BGRAAnimatedGif", + "to": "FPImage" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRABitmap" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAPalette" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAGifFormat" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRABlend" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAUTF8" + }, + { + "from": "BGRAAnimatedGif", + "to": "Graphics" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAPalette" + }, + { + "from": "BGRAAnimatedGif", + "to": "BGRAColorQuantization" + }, + { + "from": "BGRAArrow", + "to": "SysUtils" + }, + { + "from": "BGRAArrow", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAArrow", + "to": "BGRAGraphics" + }, + { + "from": "BGRAArrow", + "to": "BGRAClasses" + }, + { + "from": "BGRAArrow", + "to": "BGRATransform" + }, + { + "from": "BGRAArrow", + "to": "BGRAPen" + }, + { + "from": "BGRAArrow", + "to": "BGRAPath" + }, + { + "from": "BGRABitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRABitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABitmap", + "to": "FPImage" + }, + { + "from": "BGRABitmap", + "to": "SysUtils" + }, + { + "from": "BGRABitmap", + "to": "BGRAfpGUIBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAWinBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAGtkBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAGtkBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAQtBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAMacBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAMSEguiBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRANoGuiBitmap" + }, + { + "from": "BGRABitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadBMP" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadBmpMioMap" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadGif" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadIco" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadJpeg" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadLzp" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadPCX" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadPng" + }, + { + "from": "BGRABitmap", + "to": "BGRAWritePNG" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadPSD" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadTGA" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadXPM" + }, + { + "from": "BGRABitmap", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRABitmap", + "to": "BGRAReadWebP" + }, + { + "from": "BGRABitmap", + "to": "BGRAWriteWebP" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAAnimatedGif" + }, + { + "from": "BGRABitmapPack", + "to": "BGRABitmap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABitmapPack", + "to": "BGRABlend" + }, + { + "from": "BGRABitmapPack", + "to": "BGRACanvas" + }, + { + "from": "BGRABitmapPack", + "to": "BGRACanvas2D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAColorInt" + }, + { + "from": "BGRABitmapPack", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRACoordPool3D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRADNetDeserial" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFillInfo" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFilters" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFreeType" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGradients" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALayers" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAOpenRaster" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPaintNet" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPath" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPen" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPolygon" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAResample" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAScene3D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASliceScaling" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASSE" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAStreamLayers" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAText" + }, + { + "from": "BGRABitmapPack", + "to": "BGRATextFX" + }, + { + "from": "BGRABitmapPack", + "to": "BGRATransform" + }, + { + "from": "BGRABitmapPack", + "to": "BGRATypewriter" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAVectorize" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadBMP" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadGif" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadPCX" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadPng" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadPSD" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAThumbnail" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadTGA" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadIco" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadJpeg" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadLzp" + }, + { + "from": "BGRABitmapPack", + "to": "UnzipperExt" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALzpCommon" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadXPM" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASVG" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAUnits" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASVGShapes" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASVGType" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadBmpMioMap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAArrow" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPalette" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAColorQuantization" + }, + { + "from": "BGRABitmapPack", + "to": "BGRADithering" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAUTF8" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWritePNG" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGifFormat" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGraphics" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASceneTypes" + }, + { + "from": "BGRABitmapPack", + "to": "BGRARenderer3D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWriteBmpMioMap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASpriteGL" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAOpenGL" + }, + { + "from": "BGRABitmapPack", + "to": "BGRACanvasGL" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFontGL" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAOpenGL3D" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAPhoxo" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFilterType" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAFilterBlur" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWinResource" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALazResource" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAIconCursor" + }, + { + "from": "BGRABitmapPack", + "to": "BGRABlurGL" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadTiff" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALazPaint" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAMemDirectory" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAUnicode" + }, + { + "from": "BGRABitmapPack", + "to": "BGRATextBidi" + }, + { + "from": "BGRABitmapPack", + "to": "BGRALayerOriginal" + }, + { + "from": "BGRABitmapPack", + "to": "BGRASVGOriginal" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAGradientOriginal" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAUnicodeText" + }, + { + "from": "BGRABitmapPack", + "to": "UniversalDrawer" + }, + { + "from": "BGRABitmapPack", + "to": "LinearRGBABitmap" + }, + { + "from": "BGRABitmapPack", + "to": "XYZABitmap" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWriteTiff" + }, + { + "from": "BGRABitmapPack", + "to": "WordXYZABitmap" + }, + { + "from": "BGRABitmapPack", + "to": "ExpandedBitmap" + }, + { + "from": "BGRABitmapPack", + "to": "libwebp" + }, + { + "from": "BGRABitmapPack", + "to": "linuxlib" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAReadWebP" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAWriteWebP" + }, + { + "from": "BGRABitmapPack", + "to": "BGRAClasses" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAAnimatedGif" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRABitmap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRABlend" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRACanvas" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRACanvas2D" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAColorInt" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRACoordPool3D" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRADNetDeserial" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFillInfo" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFilters" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAGradients" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRALayers" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAOpenRaster" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPaintNet" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPath" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPen" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPolygon" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAResample" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAScene3D" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASliceScaling" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASSE" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAStreamLayers" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRATransform" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadBMP" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadGif" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadPCX" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadPng" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadPSD" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAThumbnail" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadTGA" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadJpeg" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadLzp" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "UnzipperExt" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRALzpCommon" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadXPM" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAUnits" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAReadBmpMioMap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAArrow" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAGraphics" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAUTF8" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAfpGUIBitmap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRATypewriter" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASVG" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASVGShapes" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASVGType" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPalette" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAColorQuantization" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRADithering" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFreeType" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRACustomTextFX" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAWritePNG" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAGifFormat" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRASceneTypes" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRARenderer3D" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAWriteBmpMioMap" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAPhoxo" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFilterType" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAFilterBlur" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAWinResource" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAUnicode" + }, + { + "from": "BGRABitmapPack4fpGUI", + "to": "BGRAClasses" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAAnimatedGif" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRABitmap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRABlend" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACanvas" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACanvas2D" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAColorInt" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACoordPool3D" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRADNetDeserial" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFillInfo" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFilters" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAGradients" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRALayers" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAOpenRaster" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPaintNet" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPath" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPen" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPolygon" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAResample" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAScene3D" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASliceScaling" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASSE" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAStreamLayers" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRATransform" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadBMP" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadGif" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadPCX" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadPng" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadPSD" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAThumbnail" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadTGA" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadJpeg" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadLzp" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "UnzipperExt" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRALzpCommon" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadXPM" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAUnits" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAReadBmpMioMap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAArrow" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAGraphics" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAUTF8" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRATypewriter" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASVG" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASVGShapes" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASVGType" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPalette" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAColorQuantization" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRADithering" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFreeType" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACustomTextFX" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAWritePNG" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAGifFormat" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRANoGUIBitmap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASceneTypes" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRARenderer3D" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAWriteBmpMioMap" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRASpriteGL" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAOpenGL" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRACanvasGL" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAPhoxo" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFilterType" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAFilterBlur" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAWinResource" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAUnicode" + }, + { + "from": "BGRABitmapPack4NoGUI", + "to": "BGRAClasses" + }, + { + "from": "BGRABitmapTypes", + "to": "BGRAClasses" + }, + { + "from": "BGRABitmapTypes", + "to": "BGRAGraphics" + }, + { + "from": "BGRABitmapTypes", + "to": "BGRAUnicode" + }, + { + "from": "BGRABitmapTypes", + "to": "FPImage" + }, + { + "from": "BGRABitmapTypes", + "to": "FPImgCanv" + }, + { + "from": "BGRABitmapTypes", + "to": "LCLType" + }, + { + "from": "BGRABitmapTypes", + "to": "GraphType" + }, + { + "from": "BGRABitmapTypes", + "to": "LResources" + }, + { + "from": "BGRABitmapTypes", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRABitmapTypes", + "to": "Math" + }, + { + "from": "BGRABitmapTypes", + "to": "SysUtils" + }, + { + "from": "BGRABitmapTypes", + "to": "BGRAUTF8" + }, + { + "from": "BGRABitmapTypes", + "to": "FPReadXwd" + }, + { + "from": "BGRABitmapTypes", + "to": "FPReadXPM" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWriteJPEG" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWriteBMP" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWritePCX" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWriteTGA" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWriteXPM" + }, + { + "from": "BGRABitmapTypes", + "to": "FPReadPNM" + }, + { + "from": "BGRABitmapTypes", + "to": "FPWritePNM" + }, + { + "from": "BGRABlend", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABlurGL", + "to": "BGRAClasses" + }, + { + "from": "BGRABlurGL", + "to": "BGRAOpenGL3D" + }, + { + "from": "BGRABlurGL", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRABlurGL", + "to": "BGRACanvasGL" + }, + { + "from": "BGRABlurGL", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRACanvas", + "to": "BGRAClasses" + }, + { + "from": "BGRACanvas", + "to": "SysUtils" + }, + { + "from": "BGRACanvas", + "to": "BGRAGraphics" + }, + { + "from": "BGRACanvas", + "to": "FPImage" + }, + { + "from": "BGRACanvas", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACanvas", + "to": "FPCanvas" + }, + { + "from": "BGRACanvas", + "to": "BGRAPen" + }, + { + "from": "BGRACanvas", + "to": "BGRAPath" + }, + { + "from": "BGRACanvas", + "to": "BGRAPolygon" + }, + { + "from": "BGRACanvas", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRACanvas", + "to": "Math" + }, + { + "from": "BGRACanvas", + "to": "BGRABlend" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAClasses" + }, + { + "from": "BGRACanvas2D", + "to": "SysUtils" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAGraphics" + }, + { + "from": "BGRACanvas2D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACanvas2D", + "to": "BGRATransform" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAPath" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAPen" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRACanvas2D", + "to": "Math" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAFillInfo" + }, + { + "from": "BGRACanvas2D", + "to": "BGRAPolygon" + }, + { + "from": "BGRACanvas2D", + "to": "BGRABlend" + }, + { + "from": "BGRACanvas2D", + "to": "FPWriteJPEG" + }, + { + "from": "BGRACanvas2D", + "to": "FPWriteBMP" + }, + { + "from": "BGRACanvas2D", + "to": "base64" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAClasses" + }, + { + "from": "BGRACanvasGL", + "to": "SysUtils" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAGraphics" + }, + { + "from": "BGRACanvasGL", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRACanvasGL", + "to": "BGRATransform" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAPath" + }, + { + "from": "BGRACanvasGL", + "to": "BGRASSE" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRACanvasGL", + "to": "Math" + }, + { + "from": "BGRACanvasGL", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRAClasses", + "to": "Types" + }, + { + "from": "BGRAClasses", + "to": "Classes" + }, + { + "from": "BGRAClasses", + "to": "mclasses" + }, + { + "from": "BGRAClasses", + "to": "msegraphutils" + }, + { + "from": "BGRAClasses", + "to": "mseguiglob" + }, + { + "from": "BGRAClasses", + "to": "Classes" + }, + { + "from": "BGRAColorInt", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAColorQuantization", + "to": "BGRAClasses" + }, + { + "from": "BGRAColorQuantization", + "to": "SysUtils" + }, + { + "from": "BGRAColorQuantization", + "to": "BGRAPalette" + }, + { + "from": "BGRAColorQuantization", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAColorQuantization", + "to": "BGRADithering" + }, + { + "from": "BGRAColorQuantization", + "to": "FPimage" + }, + { + "from": "BGRAColorQuantization", + "to": "FPWriteBMP" + }, + { + "from": "BGRAColorQuantization", + "to": "BGRAWritePNG" + }, + { + "from": "BGRAColorQuantization", + "to": "math" + }, + { + "from": "BGRACompressableBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRACompressableBitmap", + "to": "SysUtils" + }, + { + "from": "BGRACompressableBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACompressableBitmap", + "to": "BGRABitmap" + }, + { + "from": "BGRACompressableBitmap", + "to": "zstream" + }, + { + "from": "BGRACompressableBitmap", + "to": "BGRAUTF8" + }, + { + "from": "BGRACoordPool3D", + "to": "SysUtils" + }, + { + "from": "BGRACoordPool3D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACoordPool3D", + "to": "BGRASSE" + }, + { + "from": "BGRACoordPool3D", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRACustomTextFX", + "to": "BGRAClasses" + }, + { + "from": "BGRACustomTextFX", + "to": "SysUtils" + }, + { + "from": "BGRACustomTextFX", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRACustomTextFX", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRACustomTextFX", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRACustomTextFX", + "to": "Math" + }, + { + "from": "BGRACustomTextFX", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRADefaultBitmap", + "to": "SysUtils" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPImage" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPImgCanv" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRACanvas" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRACanvas2D" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRATransform" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRATextBidi" + }, + { + "from": "BGRADefaultBitmap", + "to": "UniversalDrawer" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRADefaultBitmap", + "to": "Math" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAUTF8" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRABlend" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAFilters" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAResample" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAPolygon" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAPath" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPReadPcx" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPWritePcx" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPReadXPM" + }, + { + "from": "BGRADefaultBitmap", + "to": "FPWriteXPM" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAReadBMP" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAReadJpeg" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRADithering" + }, + { + "from": "BGRADefaultBitmap", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRADithering", + "to": "BGRAClasses" + }, + { + "from": "BGRADithering", + "to": "SysUtils" + }, + { + "from": "BGRADithering", + "to": "BGRAFilterType" + }, + { + "from": "BGRADithering", + "to": "BGRAPalette" + }, + { + "from": "BGRADithering", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRADithering", + "to": "BGRABlend" + }, + { + "from": "BGRADNetDeserial", + "to": "BGRAClasses" + }, + { + "from": "BGRADNetDeserial", + "to": "SysUtils" + }, + { + "from": "BGRADNetDeserial", + "to": "BGRAUTF8" + }, + { + "from": "BGRAFillInfo", + "to": "BGRAClasses" + }, + { + "from": "BGRAFillInfo", + "to": "SysUtils" + }, + { + "from": "BGRAFillInfo", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFillInfo", + "to": "Math" + }, + { + "from": "BGRAFilterBlur", + "to": "BGRAClasses" + }, + { + "from": "BGRAFilterBlur", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFilterBlur", + "to": "BGRAFilterType" + }, + { + "from": "BGRAFilterBlur", + "to": "Math" + }, + { + "from": "BGRAFilterBlur", + "to": "SysUtils" + }, + { + "from": "BGRAFilterBlur", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRAFilterBlur", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRAFilters", + "to": "BGRAClasses" + }, + { + "from": "BGRAFilters", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFilters", + "to": "BGRAFilterType" + }, + { + "from": "BGRAFilters", + "to": "BGRAFilterBlur" + }, + { + "from": "BGRAFilters", + "to": "Math" + }, + { + "from": "BGRAFilters", + "to": "BGRATransform" + }, + { + "from": "BGRAFilters", + "to": "SysUtils" + }, + { + "from": "BGRAFilters", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRAFilterScanner", + "to": "BGRAClasses" + }, + { + "from": "BGRAFilterScanner", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFilterScanner", + "to": "BGRAFilterType" + }, + { + "from": "BGRAFilterScanner", + "to": "BGRABlend" + }, + { + "from": "BGRAFilterScanner", + "to": "math" + }, + { + "from": "BGRAFilterScanner", + "to": "SysUtils" + }, + { + "from": "BGRAFilterType", + "to": "BGRAClasses" + }, + { + "from": "BGRAFilterType", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFilterType", + "to": "SysUtils" + }, + { + "from": "BGRAFilterType", + "to": "BGRABlend" + }, + { + "from": "BGRAFontGL", + "to": "BGRAClasses" + }, + { + "from": "BGRAFontGL", + "to": "SysUtils" + }, + { + "from": "BGRAFontGL", + "to": "BGRAGraphics" + }, + { + "from": "BGRAFontGL", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRAFontGL", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFontGL", + "to": "Avl_Tree" + }, + { + "from": "BGRAFontGL", + "to": "BGRAUTF8" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRAFreeType" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "EasyLazFreeType" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "LazFreeTypeFontCollection" + }, + { + "from": "BGRAfpGUIBitmap", + "to": "BGRACanvas" + }, + { + "from": "BGRAFreeType", + "to": "BGRAClasses" + }, + { + "from": "BGRAFreeType", + "to": "SysUtils" + }, + { + "from": "BGRAFreeType", + "to": "BGRAGraphics" + }, + { + "from": "BGRAFreeType", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAFreeType", + "to": "EasyLazFreeType" + }, + { + "from": "BGRAFreeType", + "to": "FPimage" + }, + { + "from": "BGRAFreeType", + "to": "BGRACustomTextFX" + }, + { + "from": "BGRAFreeType", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRAFreeType", + "to": "BGRATypewriter" + }, + { + "from": "BGRAFreeType", + "to": "LazVersion" + }, + { + "from": "BGRAFreeType", + "to": "BGRABlend" + }, + { + "from": "BGRAFreeType", + "to": "Math" + }, + { + "from": "BGRAFreeType", + "to": "BGRATransform" + }, + { + "from": "BGRAFreeType", + "to": "BGRAUnicode" + }, + { + "from": "BGRAFreeType", + "to": "BGRAUTF8" + }, + { + "from": "BGRAGifFormat", + "to": "BGRAClasses" + }, + { + "from": "BGRAGifFormat", + "to": "SysUtils" + }, + { + "from": "BGRAGifFormat", + "to": "BGRAGraphics" + }, + { + "from": "BGRAGifFormat", + "to": "BGRABitmap" + }, + { + "from": "BGRAGifFormat", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGifFormat", + "to": "BGRAPalette" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRAClasses" + }, + { + "from": "BGRAGradientOriginal", + "to": "SysUtils" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRALayerOriginal" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRABitmap" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRASVG" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRASVGShapes" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRASVGType" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRATransform" + }, + { + "from": "BGRAGradientOriginal", + "to": "BGRABlend" + }, + { + "from": "BGRAGradientOriginal", + "to": "math" + }, + { + "from": "BGRAGradients", + "to": "BGRAClasses" + }, + { + "from": "BGRAGradients", + "to": "BGRAGraphics" + }, + { + "from": "BGRAGradients", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGradients", + "to": "BGRABitmap" + }, + { + "from": "BGRAGradients", + "to": "BGRABlend" + }, + { + "from": "BGRAGradients", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRAGradients", + "to": "BGRASSE" + }, + { + "from": "BGRAGradients", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRAGradients", + "to": "Math" + }, + { + "from": "BGRAGradients", + "to": "SysUtils" + }, + { + "from": "BGRAGradients", + "to": "BGRATextFX" + }, + { + "from": "BGRAGradientScanner", + "to": "SysUtils" + }, + { + "from": "BGRAGradientScanner", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGradientScanner", + "to": "BGRATransform" + }, + { + "from": "BGRAGradientScanner", + "to": "BGRABlend" + }, + { + "from": "BGRAGradientScanner", + "to": "Math" + }, + { + "from": "BGRAGraphics", + "to": "Graphics" + }, + { + "from": "BGRAGraphics", + "to": "GraphType" + }, + { + "from": "BGRAGraphics", + "to": "FPImage" + }, + { + "from": "BGRAGraphics", + "to": "FPCanvas" + }, + { + "from": "BGRAGraphics", + "to": "sysutils" + }, + { + "from": "BGRAGraphics", + "to": "BGRAUTF8" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRAClasses" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRAGraphics" + }, + { + "from": "BGRAGrayscaleMask", + "to": "SysUtils" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRAResample" + }, + { + "from": "BGRAGrayscaleMask", + "to": "UniversalDrawer" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRABlend" + }, + { + "from": "BGRAGrayscaleMask", + "to": "BGRATransform" + }, + { + "from": "BGRAGtkBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAGtkBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAGtkBitmap", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRAGtkBitmap", + "to": "Graphics" + }, + { + "from": "BGRAGtkBitmap", + "to": "GraphType" + }, + { + "from": "BGRAGtkBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAGtkBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRAGtkBitmap", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRAGtkBitmap", + "to": "LCLType" + }, + { + "from": "BGRAGtkBitmap", + "to": "LCLIntf" + }, + { + "from": "BGRAGtkBitmap", + "to": "IntfGraphics" + }, + { + "from": "BGRAGtkBitmap", + "to": "gdk2" + }, + { + "from": "BGRAGtkBitmap", + "to": "gtk2def" + }, + { + "from": "BGRAGtkBitmap", + "to": "gdk2pixbuf" + }, + { + "from": "BGRAGtkBitmap", + "to": "glib2" + }, + { + "from": "BGRAGtkBitmap", + "to": "gdk" + }, + { + "from": "BGRAGtkBitmap", + "to": "gtkdef" + }, + { + "from": "BGRAGtkBitmap", + "to": "gtkProc" + }, + { + "from": "BGRAGtkBitmap", + "to": "gdkpixbuf" + }, + { + "from": "BGRAGtkBitmap", + "to": "glib" + }, + { + "from": "BGRAGtkBitmap", + "to": "FPImage" + }, + { + "from": "BGRAGtkBitmap", + "to": "Dialogs" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAClasses" + }, + { + "from": "BGRAIconCursor", + "to": "SysUtils" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRAIconCursor", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAWinResource" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAUTF8" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAReadPng" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAReadBMP" + }, + { + "from": "BGRAIconCursor", + "to": "FPWriteBMP" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAPalette" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAWritePNG" + }, + { + "from": "BGRAIconCursor", + "to": "BGRAColorQuantization" + }, + { + "from": "BGRAIconCursor", + "to": "Graphics" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAClasses" + }, + { + "from": "BGRALayerOriginal", + "to": "SysUtils" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRABitmap" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRATransform" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAMemDirectory" + }, + { + "from": "BGRALayerOriginal", + "to": "fgl" + }, + { + "from": "BGRALayerOriginal", + "to": "LCLType" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAPolygon" + }, + { + "from": "BGRALayerOriginal", + "to": "math" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAUTF8" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRAGraphics" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRASVG" + }, + { + "from": "BGRALayerOriginal", + "to": "BGRASVGShapes" + }, + { + "from": "BGRALayers", + "to": "BGRAGraphics" + }, + { + "from": "BGRALayers", + "to": "BGRAClasses" + }, + { + "from": "BGRALayers", + "to": "SysUtils" + }, + { + "from": "BGRALayers", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRALayers", + "to": "BGRABitmap" + }, + { + "from": "BGRALayers", + "to": "BGRAMemDirectory" + }, + { + "from": "BGRALayers", + "to": "BGRATransform" + }, + { + "from": "BGRALayers", + "to": "fgl" + }, + { + "from": "BGRALayers", + "to": "BGRALayerOriginal" + }, + { + "from": "BGRALayers", + "to": "BGRAUTF8" + }, + { + "from": "BGRALayers", + "to": "BGRABlend" + }, + { + "from": "BGRALayers", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRALayers", + "to": "math" + }, + { + "from": "BGRALazPaint", + "to": "BGRAClasses" + }, + { + "from": "BGRALazPaint", + "to": "SysUtils" + }, + { + "from": "BGRALazPaint", + "to": "BGRALayers" + }, + { + "from": "BGRALazPaint", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRALazPaint", + "to": "BGRAReadLzp" + }, + { + "from": "BGRALazPaint", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRALazPaint", + "to": "BGRALzpCommon" + }, + { + "from": "BGRALazPaint", + "to": "FPimage" + }, + { + "from": "BGRALazPaint", + "to": "BGRAStreamLayers" + }, + { + "from": "BGRALazPaint", + "to": "BGRABitmap" + }, + { + "from": "BGRALazPaint", + "to": "BGRAUTF8" + }, + { + "from": "BGRALazResource", + "to": "BGRAClasses" + }, + { + "from": "BGRALazResource", + "to": "SysUtils" + }, + { + "from": "BGRALazResource", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRALazResource", + "to": "LResources" + }, + { + "from": "BGRALazResource", + "to": "BGRAUTF8" + }, + { + "from": "BGRALCLBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRALCLBitmap", + "to": "SysUtils" + }, + { + "from": "BGRALCLBitmap", + "to": "Graphics" + }, + { + "from": "BGRALCLBitmap", + "to": "GraphType" + }, + { + "from": "BGRALCLBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRALCLBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRALCLBitmap", + "to": "BGRAText" + }, + { + "from": "BGRALCLBitmap", + "to": "LCLType" + }, + { + "from": "BGRALCLBitmap", + "to": "LCLIntf" + }, + { + "from": "BGRALCLBitmap", + "to": "FPimage" + }, + { + "from": "BGRALzpCommon", + "to": "BGRAClasses" + }, + { + "from": "BGRALzpCommon", + "to": "SysUtils" + }, + { + "from": "BGRAMacBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAMacBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAMacBitmap", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRAMacBitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRAMacBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAMacBitmap", + "to": "LCLType" + }, + { + "from": "BGRAMacBitmap", + "to": "GraphType" + }, + { + "from": "BGRAMacBitmap", + "to": "LCLIntf" + }, + { + "from": "BGRAMacBitmap", + "to": "FPimage" + }, + { + "from": "BGRAMatrix3D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAMatrix3D", + "to": "BGRASSE" + }, + { + "from": "BGRAMatrix3D", + "to": "BGRATransform" + }, + { + "from": "BGRAMemDirectory", + "to": "BGRAClasses" + }, + { + "from": "BGRAMemDirectory", + "to": "SysUtils" + }, + { + "from": "BGRAMemDirectory", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRAMemDirectory", + "to": "fgl" + }, + { + "from": "BGRAMemDirectory", + "to": "zstream" + }, + { + "from": "BGRAMemDirectory", + "to": "BGRAUTF8" + }, + { + "from": "BGRAMemDirectory", + "to": "strutils" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "BGRAText" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "msebitmap" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "msegraphics" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "msegraphutils" + }, + { + "from": "BGRAMSEguiBitmap", + "to": "math" + }, + { + "from": "BGRAMultiFileType", + "to": "BGRAClasses" + }, + { + "from": "BGRAMultiFileType", + "to": "SysUtils" + }, + { + "from": "BGRAMultiFileType", + "to": "fgl" + }, + { + "from": "BGRAMultiFileType", + "to": "BGRAUTF8" + }, + { + "from": "BGRAMultiFileType", + "to": "strutils" + }, + { + "from": "BGRAMultiFileType", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRANoGUIBitmap", + "to": "SysUtils" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRAGraphics" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRAFreeType" + }, + { + "from": "BGRANoGUIBitmap", + "to": "EasyLazFreeType" + }, + { + "from": "BGRANoGUIBitmap", + "to": "LazFreeTypeFontCollection" + }, + { + "from": "BGRANoGUIBitmap", + "to": "BGRACanvas" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAClasses" + }, + { + "from": "BGRAOpenGL", + "to": "SysUtils" + }, + { + "from": "BGRAOpenGL", + "to": "FPimage" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAGraphics" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRAOpenGL", + "to": "BGRASpriteGL" + }, + { + "from": "BGRAOpenGL", + "to": "BGRACanvasGL" + }, + { + "from": "BGRAOpenGL", + "to": "GL" + }, + { + "from": "BGRAOpenGL", + "to": "GLext" + }, + { + "from": "BGRAOpenGL", + "to": "GLU" + }, + { + "from": "BGRAOpenGL", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAFontGL" + }, + { + "from": "BGRAOpenGL", + "to": "BGRASSE" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRAOpenGL", + "to": "BGRABlurGL" + }, + { + "from": "BGRAOpenGL", + "to": "BGRATransform" + }, + { + "from": "BGRAOpenGL", + "to": "BGRAText" + }, + { + "from": "BGRAOpenGL", + "to": "BGRATextFX" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRASceneTypes" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRASSE" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRAClasses" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRACanvasGL" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRAScene3D" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRATransform" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRARenderer3D" + }, + { + "from": "BGRAOpenGL3D", + "to": "SysUtils" + }, + { + "from": "BGRAOpenGL3D", + "to": "BGRAColorInt" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRAGraphics" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRABitmap" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAOpenGLType", + "to": "FPimage" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRAClasses" + }, + { + "from": "BGRAOpenGLType", + "to": "SysUtils" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRATransform" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRASSE" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRAOpenGLType", + "to": "BGRAFilterScanner" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRAClasses" + }, + { + "from": "BGRAOpenRaster", + "to": "SysUtils" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRALayers" + }, + { + "from": "BGRAOpenRaster", + "to": "zipper" + }, + { + "from": "BGRAOpenRaster", + "to": "DOM" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRABitmap" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRALayerOriginal" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRASVGShapes" + }, + { + "from": "BGRAOpenRaster", + "to": "FPImage" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRASVG" + }, + { + "from": "BGRAOpenRaster", + "to": "XMLRead" + }, + { + "from": "BGRAOpenRaster", + "to": "XMLWrite" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAOpenRaster", + "to": "zstream" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRAUTF8" + }, + { + "from": "BGRAOpenRaster", + "to": "UnzipperExt" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRASVGOriginal" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRATransform" + }, + { + "from": "BGRAOpenRaster", + "to": "BGRASVGType" + }, + { + "from": "BGRAOpenRaster", + "to": "math" + }, + { + "from": "BGRAPaintNet", + "to": "BGRAClasses" + }, + { + "from": "BGRAPaintNet", + "to": "SysUtils" + }, + { + "from": "BGRAPaintNet", + "to": "BGRADNetDeserial" + }, + { + "from": "BGRAPaintNet", + "to": "FPImage" + }, + { + "from": "BGRAPaintNet", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPaintNet", + "to": "BGRABitmap" + }, + { + "from": "BGRAPaintNet", + "to": "BGRALayers" + }, + { + "from": "BGRAPaintNet", + "to": "zstream" + }, + { + "from": "BGRAPaintNet", + "to": "Math" + }, + { + "from": "BGRAPaintNet", + "to": "BGRAUTF8" + }, + { + "from": "BGRAPalette", + "to": "BGRAClasses" + }, + { + "from": "BGRAPalette", + "to": "SysUtils" + }, + { + "from": "BGRAPalette", + "to": "Avl_Tree" + }, + { + "from": "BGRAPalette", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPalette", + "to": "FPimage" + }, + { + "from": "BGRAPalette", + "to": "BGRAUTF8" + }, + { + "from": "BGRAPalette", + "to": "bufstream" + }, + { + "from": "BGRAPath", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPath", + "to": "BGRATransform" + }, + { + "from": "BGRAPath", + "to": "Math" + }, + { + "from": "BGRAPath", + "to": "BGRAClasses" + }, + { + "from": "BGRAPath", + "to": "BGRAResample" + }, + { + "from": "BGRAPath", + "to": "SysUtils" + }, + { + "from": "BGRAPen", + "to": "SysUtils" + }, + { + "from": "BGRAPen", + "to": "BGRAGraphics" + }, + { + "from": "BGRAPen", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPen", + "to": "BGRATransform" + }, + { + "from": "BGRAPen", + "to": "math" + }, + { + "from": "BGRAPen", + "to": "BGRAClasses" + }, + { + "from": "BGRAPen", + "to": "BGRAPath" + }, + { + "from": "BGRAPhongTypes", + "to": "BGRAClasses" + }, + { + "from": "BGRAPhongTypes", + "to": "SysUtils" + }, + { + "from": "BGRAPhongTypes", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPhoxo", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPhoxo", + "to": "FPImage" + }, + { + "from": "BGRAPhoxo", + "to": "BGRALayers" + }, + { + "from": "BGRAPhoxo", + "to": "BGRABitmap" + }, + { + "from": "BGRAPhoxo", + "to": "BGRAClasses" + }, + { + "from": "BGRAPhoxo", + "to": "SysUtils" + }, + { + "from": "BGRAPhoxo", + "to": "BMPcomn" + }, + { + "from": "BGRAPhoxo", + "to": "BGRAUTF8" + }, + { + "from": "BGRAPolygon", + "to": "BGRAClasses" + }, + { + "from": "BGRAPolygon", + "to": "SysUtils" + }, + { + "from": "BGRAPolygon", + "to": "BGRAGraphics" + }, + { + "from": "BGRAPolygon", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPolygon", + "to": "BGRAFillInfo" + }, + { + "from": "BGRAPolygon", + "to": "BGRAPath" + }, + { + "from": "BGRAPolygon", + "to": "Math" + }, + { + "from": "BGRAPolygon", + "to": "BGRABlend" + }, + { + "from": "BGRAPolygon", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRAPolygon", + "to": "BGRATransform" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRAClasses" + }, + { + "from": "BGRAPolygonAliased", + "to": "SysUtils" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRAFillInfo" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRASSE" + }, + { + "from": "BGRAPolygonAliased", + "to": "Math" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRABlend" + }, + { + "from": "BGRAPolygonAliased", + "to": "BGRAPolygon" + }, + { + "from": "BGRAQtBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAQtBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAQtBitmap", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRAQtBitmap", + "to": "Graphics" + }, + { + "from": "BGRAQtBitmap", + "to": "GraphType" + }, + { + "from": "BGRAQtBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAQtBitmap", + "to": "LCLType" + }, + { + "from": "BGRAQtBitmap", + "to": "LCLIntf" + }, + { + "from": "BGRAQtBitmap", + "to": "IntfGraphics" + }, + { + "from": "BGRAQtBitmap", + "to": "qtobjects" + }, + { + "from": "BGRAQtBitmap", + "to": "qt5" + }, + { + "from": "BGRAQtBitmap", + "to": "FPImage" + }, + { + "from": "BGRAReadBMP", + "to": "FPImage" + }, + { + "from": "BGRAReadBMP", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadBMP", + "to": "SysUtils" + }, + { + "from": "BGRAReadBMP", + "to": "BMPcomn" + }, + { + "from": "BGRAReadBMP", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadBMP", + "to": "math" + }, + { + "from": "BGRAReadBmpMioMap", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadBmpMioMap", + "to": "SysUtils" + }, + { + "from": "BGRAReadBmpMioMap", + "to": "FPimage" + }, + { + "from": "BGRAReadBmpMioMap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadBmpMioMap", + "to": "bufstream" + }, + { + "from": "BGRAReadGif", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadGif", + "to": "SysUtils" + }, + { + "from": "BGRAReadGif", + "to": "FPimage" + }, + { + "from": "BGRAReadGif", + "to": "FPReadGif" + }, + { + "from": "BGRAReadGif", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadIco", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadIco", + "to": "SysUtils" + }, + { + "from": "BGRAReadIco", + "to": "FPimage" + }, + { + "from": "BGRAReadIco", + "to": "Graphics" + }, + { + "from": "BGRAReadIco", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadIco", + "to": "BGRAIconCursor" + }, + { + "from": "BGRAReadJpeg", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadJpeg", + "to": "SysUtils" + }, + { + "from": "BGRAReadJpeg", + "to": "FPReadJPEG" + }, + { + "from": "BGRAReadJpeg", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadLzp", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadLzp", + "to": "SysUtils" + }, + { + "from": "BGRAReadLzp", + "to": "FPimage" + }, + { + "from": "BGRAReadLzp", + "to": "BGRALzpCommon" + }, + { + "from": "BGRAReadLzp", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadLzp", + "to": "BGRABitmap" + }, + { + "from": "BGRAReadLzp", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRAReadLzp", + "to": "BGRAReadPng" + }, + { + "from": "BGRAReadPCX", + "to": "FPImage" + }, + { + "from": "BGRAReadPCX", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadPCX", + "to": "SysUtils" + }, + { + "from": "BGRAReadPCX", + "to": "FPReadPCX" + }, + { + "from": "BGRAReadPCX", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadPng", + "to": "SysUtils" + }, + { + "from": "BGRAReadPng", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadPng", + "to": "FPImage" + }, + { + "from": "BGRAReadPng", + "to": "FPImgCmn" + }, + { + "from": "BGRAReadPng", + "to": "PNGComn" + }, + { + "from": "BGRAReadPng", + "to": "ZStream" + }, + { + "from": "BGRAReadPng", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadPng", + "to": "math" + }, + { + "from": "BGRAReadPSD", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadPSD", + "to": "SysUtils" + }, + { + "from": "BGRAReadPSD", + "to": "FPimage" + }, + { + "from": "BGRAReadPSD", + "to": "FPReadPSD" + }, + { + "from": "BGRAReadPSD", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadTGA", + "to": "FPReadTGA" + }, + { + "from": "BGRAReadTGA", + "to": "FPimage" + }, + { + "from": "BGRAReadTGA", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadTGA", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadTGA", + "to": "targacmn" + }, + { + "from": "BGRAReadTiff", + "to": "Math" + }, + { + "from": "BGRAReadTiff", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadTiff", + "to": "SysUtils" + }, + { + "from": "BGRAReadTiff", + "to": "ctypes" + }, + { + "from": "BGRAReadTiff", + "to": "zinflate" + }, + { + "from": "BGRAReadTiff", + "to": "zbase" + }, + { + "from": "BGRAReadTiff", + "to": "FPimage" + }, + { + "from": "BGRAReadTiff", + "to": "FPTiffCmn" + }, + { + "from": "BGRAReadTiff", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadWebP", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadWebP", + "to": "SysUtils" + }, + { + "from": "BGRAReadWebP", + "to": "FPImage" + }, + { + "from": "BGRAReadWebP", + "to": "libwebp" + }, + { + "from": "BGRAReadWebP", + "to": "linuxlib" + }, + { + "from": "BGRAReadWebP", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAReadXPM", + "to": "BGRAClasses" + }, + { + "from": "BGRAReadXPM", + "to": "SysUtils" + }, + { + "from": "BGRAReadXPM", + "to": "FPReadXPM" + }, + { + "from": "BGRAReadXPM", + "to": "FPimage" + }, + { + "from": "BGRAReadXPM", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRARenderer3D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRARenderer3D", + "to": "BGRASceneTypes" + }, + { + "from": "BGRARenderer3D", + "to": "BGRASSE" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAPolygon" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAColorInt" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAClasses" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAPolygonAliased" + }, + { + "from": "BGRARenderer3D", + "to": "SysUtils" + }, + { + "from": "BGRARenderer3D", + "to": "BGRAResample" + }, + { + "from": "BGRAResample", + "to": "SysUtils" + }, + { + "from": "BGRAResample", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAResample", + "to": "Math" + }, + { + "from": "BGRAResample", + "to": "BGRABlend" + }, + { + "from": "BGRAResample", + "to": "BGRAClasses" + }, + { + "from": "BGRAScene3D", + "to": "BGRAClasses" + }, + { + "from": "BGRAScene3D", + "to": "SysUtils" + }, + { + "from": "BGRAScene3D", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAScene3D", + "to": "BGRAColorInt" + }, + { + "from": "BGRAScene3D", + "to": "BGRASSE" + }, + { + "from": "BGRAScene3D", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRAScene3D", + "to": "BGRASceneTypes" + }, + { + "from": "BGRAScene3D", + "to": "BGRARenderer3D" + }, + { + "from": "BGRAScene3D", + "to": "BGRACoordPool3D" + }, + { + "from": "BGRAScene3D", + "to": "BGRAUTF8" + }, + { + "from": "BGRASceneTypes", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASceneTypes", + "to": "BGRASSE" + }, + { + "from": "BGRASceneTypes", + "to": "BGRAMatrix3D" + }, + { + "from": "BGRASceneTypes", + "to": "BGRAColorInt" + }, + { + "from": "BGRASliceScaling", + "to": "BGRAClasses" + }, + { + "from": "BGRASliceScaling", + "to": "SysUtils" + }, + { + "from": "BGRASliceScaling", + "to": "BGRAGraphics" + }, + { + "from": "BGRASliceScaling", + "to": "BGRABitmap" + }, + { + "from": "BGRASliceScaling", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASliceScaling", + "to": "IniFiles" + }, + { + "from": "BGRASliceScaling", + "to": "BGRAUTF8" + }, + { + "from": "BGRASpriteGL", + "to": "BGRAClasses" + }, + { + "from": "BGRASpriteGL", + "to": "SysUtils" + }, + { + "from": "BGRASpriteGL", + "to": "BGRAOpenGLType" + }, + { + "from": "BGRASpriteGL", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASSE", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASSE", + "to": "cpu" + }, + { + "from": "BGRASSE", + "to": "mmx" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRAClasses" + }, + { + "from": "BGRAStreamLayers", + "to": "SysUtils" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRALayers" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRABitmap" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRALzpCommon" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRAMemDirectory" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRAStreamLayers", + "to": "zstream" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRAReadLzp" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRAWriteLzp" + }, + { + "from": "BGRAStreamLayers", + "to": "BGRAUTF8" + }, + { + "from": "BGRAStreamLayers", + "to": "Math" + }, + { + "from": "BGRASVG", + "to": "BGRAClasses" + }, + { + "from": "BGRASVG", + "to": "SysUtils" + }, + { + "from": "BGRASVG", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASVG", + "to": "DOM" + }, + { + "from": "BGRASVG", + "to": "BGRAUnits" + }, + { + "from": "BGRASVG", + "to": "BGRASVGShapes" + }, + { + "from": "BGRASVG", + "to": "BGRACanvas2D" + }, + { + "from": "BGRASVG", + "to": "BGRASVGType" + }, + { + "from": "BGRASVG", + "to": "FPimage" + }, + { + "from": "BGRASVG", + "to": "XMLRead" + }, + { + "from": "BGRASVG", + "to": "XMLWrite" + }, + { + "from": "BGRASVG", + "to": "BGRAUTF8" + }, + { + "from": "BGRASVG", + "to": "math" + }, + { + "from": "BGRASVG", + "to": "xmltextreader" + }, + { + "from": "BGRASVG", + "to": "URIParser" + }, + { + "from": "BGRASVG", + "to": "BGRATransform" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRAClasses" + }, + { + "from": "BGRASVGOriginal", + "to": "SysUtils" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRABitmap" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRASVG" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRATransform" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRALayerOriginal" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRAUnits" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRALayers" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRACanvas2D" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRAMemDirectory" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRAUTF8" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRASVGShapes" + }, + { + "from": "BGRASVGOriginal", + "to": "math" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRASVGType" + }, + { + "from": "BGRASVGOriginal", + "to": "BGRAVectorize" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAClasses" + }, + { + "from": "BGRASVGShapes", + "to": "SysUtils" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAUnits" + }, + { + "from": "BGRASVGShapes", + "to": "DOM" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAPath" + }, + { + "from": "BGRASVGShapes", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASVGShapes", + "to": "BGRACanvas2D" + }, + { + "from": "BGRASVGShapes", + "to": "BGRASVGType" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAGraphics" + }, + { + "from": "BGRASVGShapes", + "to": "BGRATransform" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAUTF8" + }, + { + "from": "BGRASVGShapes", + "to": "base64" + }, + { + "from": "BGRASVGShapes", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRASVGType", + "to": "BGRAClasses" + }, + { + "from": "BGRASVGType", + "to": "SysUtils" + }, + { + "from": "BGRASVGType", + "to": "BGRATransform" + }, + { + "from": "BGRASVGType", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRASVGType", + "to": "BGRAUnits" + }, + { + "from": "BGRASVGType", + "to": "DOM" + }, + { + "from": "BGRASVGType", + "to": "BGRACanvas2D" + }, + { + "from": "BGRASVGType", + "to": "fgl" + }, + { + "from": "BGRASVGType", + "to": "BGRAGraphics" + }, + { + "from": "BGRASVGType", + "to": "BGRASVGShapes" + }, + { + "from": "BGRAText", + "to": "BGRAClasses" + }, + { + "from": "BGRAText", + "to": "SysUtils" + }, + { + "from": "BGRAText", + "to": "BGRAGraphics" + }, + { + "from": "BGRAText", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAText", + "to": "BGRAPen" + }, + { + "from": "BGRAText", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRAText", + "to": "InterfaceBase" + }, + { + "from": "BGRAText", + "to": "LCLVersion" + }, + { + "from": "BGRAText", + "to": "Math" + }, + { + "from": "BGRAText", + "to": "BGRATransform" + }, + { + "from": "BGRAText", + "to": "BGRABlend" + }, + { + "from": "BGRAText", + "to": "BGRAUTF8" + }, + { + "from": "BGRAText", + "to": "BGRAUnicode" + }, + { + "from": "BGRAText", + "to": "BGRATextBidi" + }, + { + "from": "BGRAText", + "to": "Forms" + }, + { + "from": "BGRAText", + "to": "lclplatformdef" + }, + { + "from": "BGRATextBidi", + "to": "BGRAClasses" + }, + { + "from": "BGRATextBidi", + "to": "SysUtils" + }, + { + "from": "BGRATextBidi", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRATextBidi", + "to": "BGRAUTF8" + }, + { + "from": "BGRATextBidi", + "to": "BGRAUnicode" + }, + { + "from": "BGRATextBidi", + "to": "BGRATransform" + }, + { + "from": "BGRATextBidi", + "to": "BGRAUnicodeText" + }, + { + "from": "BGRATextBidi", + "to": "math" + }, + { + "from": "BGRATextFX", + "to": "BGRAClasses" + }, + { + "from": "BGRATextFX", + "to": "SysUtils" + }, + { + "from": "BGRATextFX", + "to": "BGRAGraphics" + }, + { + "from": "BGRATextFX", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRATextFX", + "to": "BGRAPhongTypes" + }, + { + "from": "BGRATextFX", + "to": "BGRAText" + }, + { + "from": "BGRATextFX", + "to": "BGRACustomTextFX" + }, + { + "from": "BGRATextFX", + "to": "BGRAVectorize" + }, + { + "from": "BGRATextFX", + "to": "BGRAGradientScanner" + }, + { + "from": "BGRATextFX", + "to": "Math" + }, + { + "from": "BGRATextFX", + "to": "BGRAGrayscaleMask" + }, + { + "from": "BGRATextFX", + "to": "BGRAPath" + }, + { + "from": "BGRATextFX", + "to": "BGRATransform" + }, + { + "from": "BGRATextFX", + "to": "BGRAPolygon" + }, + { + "from": "BGRATextFX", + "to": "BGRAPen" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAClasses" + }, + { + "from": "BGRAThumbnail", + "to": "SysUtils" + }, + { + "from": "BGRAThumbnail", + "to": "BGRABitmap" + }, + { + "from": "BGRAThumbnail", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAThumbnail", + "to": "FPimage" + }, + { + "from": "BGRAThumbnail", + "to": "base64" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAUTF8" + }, + { + "from": "BGRAThumbnail", + "to": "DOM" + }, + { + "from": "BGRAThumbnail", + "to": "XMLRead" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadJPEG" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadPng" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadGif" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadBMP" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadPSD" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadIco" + }, + { + "from": "BGRAThumbnail", + "to": "UnzipperExt" + }, + { + "from": "BGRAThumbnail", + "to": "BGRAReadLzp" + }, + { + "from": "BGRATransform", + "to": "BGRAClasses" + }, + { + "from": "BGRATransform", + "to": "SysUtils" + }, + { + "from": "BGRATransform", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRATransform", + "to": "BGRABlend" + }, + { + "from": "BGRATransform", + "to": "Math" + }, + { + "from": "BGRATypewriter", + "to": "BGRAClasses" + }, + { + "from": "BGRATypewriter", + "to": "SysUtils" + }, + { + "from": "BGRATypewriter", + "to": "Avl_Tree" + }, + { + "from": "BGRATypewriter", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRATypewriter", + "to": "BGRACanvas2D" + }, + { + "from": "BGRATypewriter", + "to": "BGRATransform" + }, + { + "from": "BGRATypewriter", + "to": "BGRAUTF8" + }, + { + "from": "BGRATypewriter", + "to": "BGRAUnicode" + }, + { + "from": "BGRATypewriter", + "to": "math" + }, + { + "from": "BGRAUnicode", + "to": "BGRAClasses" + }, + { + "from": "BGRAUnicode", + "to": "SysUtils" + }, + { + "from": "BGRAUnicodeText", + "to": "BGRAClasses" + }, + { + "from": "BGRAUnicodeText", + "to": "SysUtils" + }, + { + "from": "BGRAUnicodeText", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAUnicodeText", + "to": "BGRAUnicode" + }, + { + "from": "BGRAUnicodeText", + "to": "BGRAUTF8" + }, + { + "from": "BGRAUnicodeText", + "to": "math" + }, + { + "from": "BGRAUnits", + "to": "SysUtils" + }, + { + "from": "BGRAUnits", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAUnits", + "to": "BGRATransform" + }, + { + "from": "BGRAUTF8", + "to": "BGRAClasses" + }, + { + "from": "BGRAUTF8", + "to": "SysUtils" + }, + { + "from": "BGRAUTF8", + "to": "math" + }, + { + "from": "BGRAUTF8", + "to": "BGRAUnicode" + }, + { + "from": "BGRAUTF8", + "to": "lazutf8classes" + }, + { + "from": "BGRAUTF8", + "to": "LazFileUtils" + }, + { + "from": "BGRAUTF8", + "to": "LazUtf8" + }, + { + "from": "BGRAVectorize", + "to": "BGRAClasses" + }, + { + "from": "BGRAVectorize", + "to": "SysUtils" + }, + { + "from": "BGRAVectorize", + "to": "BGRAGraphics" + }, + { + "from": "BGRAVectorize", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAVectorize", + "to": "BGRATypewriter" + }, + { + "from": "BGRAVectorize", + "to": "BGRATransform" + }, + { + "from": "BGRAVectorize", + "to": "BGRACanvas2D" + }, + { + "from": "BGRAVectorize", + "to": "BGRAText" + }, + { + "from": "BGRAVectorize", + "to": "BGRAUTF8" + }, + { + "from": "BGRAVectorize", + "to": "Forms" + }, + { + "from": "BGRAWinBitmap", + "to": "BGRAClasses" + }, + { + "from": "BGRAWinBitmap", + "to": "SysUtils" + }, + { + "from": "BGRAWinBitmap", + "to": "BGRALCLBitmap" + }, + { + "from": "BGRAWinBitmap", + "to": "Windows" + }, + { + "from": "BGRAWinBitmap", + "to": "Graphics" + }, + { + "from": "BGRAWinBitmap", + "to": "GraphType" + }, + { + "from": "BGRAWinBitmap", + "to": "BGRADefaultBitmap" + }, + { + "from": "BGRAWinBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWinResource", + "to": "BGRAClasses" + }, + { + "from": "BGRAWinResource", + "to": "SysUtils" + }, + { + "from": "BGRAWinResource", + "to": "BGRAMultiFileType" + }, + { + "from": "BGRAWinResource", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWinResource", + "to": "BGRAReadBMP" + }, + { + "from": "BGRAWinResource", + "to": "Math" + }, + { + "from": "BGRAWinResource", + "to": "BGRAUTF8" + }, + { + "from": "BGRAWriteBmpMioMap", + "to": "BGRAClasses" + }, + { + "from": "BGRAWriteBmpMioMap", + "to": "SysUtils" + }, + { + "from": "BGRAWriteBmpMioMap", + "to": "FPimage" + }, + { + "from": "BGRAWriteBmpMioMap", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWriteBmpMioMap", + "to": "BGRAReadBmpMioMap" + }, + { + "from": "BGRAWriteLzp", + "to": "BGRAClasses" + }, + { + "from": "BGRAWriteLzp", + "to": "SysUtils" + }, + { + "from": "BGRAWriteLzp", + "to": "FPimage" + }, + { + "from": "BGRAWriteLzp", + "to": "BGRALzpCommon" + }, + { + "from": "BGRAWriteLzp", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWriteLzp", + "to": "BGRABitmap" + }, + { + "from": "BGRAWriteLzp", + "to": "BGRACompressableBitmap" + }, + { + "from": "BGRAWritePNG", + "to": "sysutils" + }, + { + "from": "BGRAWritePNG", + "to": "BGRAClasses" + }, + { + "from": "BGRAWritePNG", + "to": "FPImage" + }, + { + "from": "BGRAWritePNG", + "to": "FPImgCmn" + }, + { + "from": "BGRAWritePNG", + "to": "PNGcomn" + }, + { + "from": "BGRAWritePNG", + "to": "ZStream" + }, + { + "from": "BGRAWritePNG", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWriteTiff", + "to": "Math" + }, + { + "from": "BGRAWriteTiff", + "to": "BGRAClasses" + }, + { + "from": "BGRAWriteTiff", + "to": "SysUtils" + }, + { + "from": "BGRAWriteTiff", + "to": "zbase" + }, + { + "from": "BGRAWriteTiff", + "to": "zdeflate" + }, + { + "from": "BGRAWriteTiff", + "to": "FPimage" + }, + { + "from": "BGRAWriteTiff", + "to": "FPTiffCmn" + }, + { + "from": "BGRAWriteTiff", + "to": "BGRABitmapTypes" + }, + { + "from": "BGRAWriteWebP", + "to": "BGRAClasses" + }, + { + "from": "BGRAWriteWebP", + "to": "SysUtils" + }, + { + "from": "BGRAWriteWebP", + "to": "FPimage" + }, + { + "from": "BGRAWriteWebP", + "to": "libwebp" + }, + { + "from": "BGRAWriteWebP", + "to": "linuxlib" + }, + { + "from": "BGRAWriteWebP", + "to": "BGRABitmapTypes" + }, + { + "from": "ExpandedBitmap", + "to": "BGRAClasses" + }, + { + "from": "ExpandedBitmap", + "to": "SysUtils" + }, + { + "from": "ExpandedBitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "ExpandedBitmap", + "to": "UniversalDrawer" + }, + { + "from": "ExpandedBitmap", + "to": "XYZABitmap" + }, + { + "from": "libwebp", + "to": "dynlibs" + }, + { + "from": "libwebp", + "to": "sysutils" + }, + { + "from": "LinearRGBABitmap", + "to": "BGRAClasses" + }, + { + "from": "LinearRGBABitmap", + "to": "SysUtils" + }, + { + "from": "LinearRGBABitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "LinearRGBABitmap", + "to": "UniversalDrawer" + }, + { + "from": "linuxlib", + "to": "BGRAClasses" + }, + { + "from": "linuxlib", + "to": "SysUtils" + }, + { + "from": "linuxlib", + "to": "process" + }, + { + "from": "UniversalDrawer", + "to": "BGRAClasses" + }, + { + "from": "UniversalDrawer", + "to": "SysUtils" + }, + { + "from": "UniversalDrawer", + "to": "FPImage" + }, + { + "from": "UniversalDrawer", + "to": "BGRABitmapTypes" + }, + { + "from": "UniversalDrawer", + "to": "BGRAGraphics" + }, + { + "from": "UniversalDrawer", + "to": "BGRAPen" + }, + { + "from": "UniversalDrawer", + "to": "BGRAArrow" + }, + { + "from": "UniversalDrawer", + "to": "BGRAPolygon" + }, + { + "from": "UniversalDrawer", + "to": "BGRAPolygonAliased" + }, + { + "from": "UniversalDrawer", + "to": "BGRAPath" + }, + { + "from": "UniversalDrawer", + "to": "BGRAFillInfo" + }, + { + "from": "UniversalDrawer", + "to": "BGRAUTF8" + }, + { + "from": "UniversalDrawer", + "to": "BGRAReadBMP" + }, + { + "from": "UniversalDrawer", + "to": "BGRAReadJpeg" + }, + { + "from": "UniversalDrawer", + "to": "BGRAWritePNG" + }, + { + "from": "UniversalDrawer", + "to": "BGRAWriteTiff" + }, + { + "from": "UniversalDrawer", + "to": "BGRAFilterBlur" + }, + { + "from": "UniversalDrawer", + "to": "Math" + }, + { + "from": "UniversalDrawer", + "to": "FPWritePNM" + }, + { + "from": "UnzipperExt", + "to": "BGRAClasses" + }, + { + "from": "UnzipperExt", + "to": "SysUtils" + }, + { + "from": "UnzipperExt", + "to": "zipper" + }, + { + "from": "UnzipperExt", + "to": "BGRAUTF8" + }, + { + "from": "UUnitTest", + "to": "BGRAClasses" + }, + { + "from": "UUnitTest", + "to": "SysUtils" + }, + { + "from": "UUnitTest", + "to": "BGRABitmapTypes" + }, + { + "from": "WordXYZABitmap", + "to": "BGRAClasses" + }, + { + "from": "WordXYZABitmap", + "to": "SysUtils" + }, + { + "from": "WordXYZABitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "WordXYZABitmap", + "to": "UniversalDrawer" + }, + { + "from": "WordXYZABitmap", + "to": "XYZABitmap" + }, + { + "from": "XYZABitmap", + "to": "BGRAClasses" + }, + { + "from": "XYZABitmap", + "to": "SysUtils" + }, + { + "from": "XYZABitmap", + "to": "BGRABitmapTypes" + }, + { + "from": "XYZABitmap", + "to": "UniversalDrawer" + }, + { + "from": "XYZABitmap", + "to": "BGRAFillInfo" + }, + { + "from": "BinaryHeapStub", + "to": "Types" + }, + { + "from": "BinaryHeapStub", + "to": "Math" + }, + { + "from": "BinaryHeapStub", + "to": "SysUtils" + }, + { + "from": "Delaunay", + "to": "KM_Points" + }, + { + "from": "FastMM4", + "to": "Windows" + }, + { + "from": "FastMM4", + "to": "ShlObj" + }, + { + "from": "FastMM4", + "to": "SHFolder" + }, + { + "from": "FastMM4", + "to": "Posix.Stdlib" + }, + { + "from": "FastMM4", + "to": "Posix.Unistd" + }, + { + "from": "FastMM4", + "to": "Posix.Fcntl" + }, + { + "from": "FastMM4", + "to": "Posix.PThread" + }, + { + "from": "FastMM4", + "to": "FastMM_OSXUtil" + }, + { + "from": "FastMM4", + "to": "BaseUnix" + }, + { + "from": "FastMM4", + "to": "Libc" + }, + { + "from": "FastMM4", + "to": "FastMM4DataCollector" + }, + { + "from": "FastMM4", + "to": "FastMM4LockFreeStack" + }, + { + "from": "FastMM4", + "to": "FastMM4Messages" + }, + { + "from": "FastMM4DataCollector", + "to": "Winapi.Windows" + }, + { + "from": "FastMM4LockFreeStack", + "to": "Windows" + }, + { + "from": "FastMM5", + "to": "Winapi.Windows" + }, + { + "from": "FastMMUsageTracker", + "to": "Windows" + }, + { + "from": "FastMMUsageTracker", + "to": "Messages" + }, + { + "from": "FastMMUsageTracker", + "to": "SysUtils" + }, + { + "from": "FastMMUsageTracker", + "to": "Variants" + }, + { + "from": "FastMMUsageTracker", + "to": "Classes" + }, + { + "from": "FastMMUsageTracker", + "to": "Graphics" + }, + { + "from": "FastMMUsageTracker", + "to": "Controls" + }, + { + "from": "FastMMUsageTracker", + "to": "Forms" + }, + { + "from": "FastMMUsageTracker", + "to": "Dialogs" + }, + { + "from": "FastMMUsageTracker", + "to": "StdCtrls" + }, + { + "from": "FastMMUsageTracker", + "to": "ExtCtrls" + }, + { + "from": "FastMMUsageTracker", + "to": "Grids" + }, + { + "from": "FastMMUsageTracker", + "to": "Buttons" + }, + { + "from": "FastMMUsageTracker", + "to": "ComCtrls" + }, + { + "from": "FastMMUsageTracker", + "to": "Menus" + }, + { + "from": "FastMMUsageTracker", + "to": "FastMM4" + }, + { + "from": "FastMMUsageTracker", + "to": "Clipbrd" + }, + { + "from": "FastMMUsageTracker", + "to": "PsAPI" + }, + { + "from": "JsonDataObjects", + "to": "System.SysUtils" + }, + { + "from": "JsonDataObjects", + "to": "System.Classes" + }, + { + "from": "JsonDataObjects", + "to": "Winapi.Windows" + }, + { + "from": "JsonDataObjects", + "to": "System.DateUtils" + }, + { + "from": "JsonDataObjects", + "to": "System.Variants" + }, + { + "from": "JsonDataObjects", + "to": "System.RTLConsts" + }, + { + "from": "JsonDataObjects", + "to": "System.TypInfo" + }, + { + "from": "JsonDataObjects", + "to": "System.Math" + }, + { + "from": "JsonDataObjects", + "to": "System.SysConst" + }, + { + "from": "KromIOUtils", + "to": "ShellAPI" + }, + { + "from": "KromIOUtils", + "to": "SysUtils" + }, + { + "from": "lCommon", + "to": "const" + }, + { + "from": "lCommon", + "to": "StrUtils" + }, + { + "from": "lCommon", + "to": "Windows" + }, + { + "from": "lCommon", + "to": "lws2tcpip" + }, + { + "from": "lEvents", + "to": "Linux" + }, + { + "from": "lEvents", + "to": "Contnrs" + }, + { + "from": "lEvents", + "to": "Errors" + }, + { + "from": "lEvents", + "to": "BSD" + }, + { + "from": "lEvents", + "to": "Errors" + }, + { + "from": "lEvents", + "to": "type" + }, + { + "from": "lEvents", + "to": "syncobjs" + }, + { + "from": "lEvents", + "to": "lCommon" + }, + { + "from": "lhttp", + "to": "classes" + }, + { + "from": "lhttp", + "to": "sysutils" + }, + { + "from": "lhttp", + "to": "lnet" + }, + { + "from": "lhttp", + "to": "lnetssl" + }, + { + "from": "lhttp", + "to": "levents" + }, + { + "from": "lhttp", + "to": "lhttputil" + }, + { + "from": "lhttp", + "to": "lstrbuffer" + }, + { + "from": "lhttp", + "to": "lCommon" + }, + { + "from": "lHTTPUtil", + "to": "sysutils" + }, + { + "from": "lHTTPUtil", + "to": "strutils" + }, + { + "from": "lHTTPUtil", + "to": "lCommon" + }, + { + "from": "lHTTPUtil", + "to": "URIParser" + }, + { + "from": "lNet", + "to": "Classes" + }, + { + "from": "lNet", + "to": "lEvents" + }, + { + "from": "lNet", + "to": "lCommon" + }, + { + "from": "lNet", + "to": "const" + }, + { + "from": "lNetSSL", + "to": "SysUtils" + }, + { + "from": "lNetSSL", + "to": "Classes" + }, + { + "from": "lNetSSL", + "to": "cTypes" + }, + { + "from": "lNetSSL", + "to": "OpenSSL" + }, + { + "from": "lNetSSL", + "to": "lNet" + }, + { + "from": "lNetSSL", + "to": "lEvents" + }, + { + "from": "lNetSSL", + "to": "lCommon" + }, + { + "from": "lws2tcpip", + "to": "WinSock2" + }, + { + "from": "lws2tcpip", + "to": "dynlibs" + }, + { + "from": "OpenSSL", + "to": "DynLibs" + }, + { + "from": "OpenSSL", + "to": "cTypes" + }, + { + "from": "GLCarbonAGLContext", + "to": "Classes" + }, + { + "from": "GLCarbonAGLContext", + "to": "SysUtils" + }, + { + "from": "GLCarbonAGLContext", + "to": "LCLProc" + }, + { + "from": "GLCarbonAGLContext", + "to": "LCLType" + }, + { + "from": "GLCarbonAGLContext", + "to": "gl" + }, + { + "from": "GLCarbonAGLContext", + "to": "Forms" + }, + { + "from": "GLCarbonAGLContext", + "to": "MacOSAll" + }, + { + "from": "GLCarbonAGLContext", + "to": "AGL" + }, + { + "from": "GLCarbonAGLContext", + "to": "CarbonProc" + }, + { + "from": "GLCarbonAGLContext", + "to": "CarbonDef" + }, + { + "from": "GLCarbonAGLContext", + "to": "CarbonPrivate" + }, + { + "from": "GLCarbonAGLContext", + "to": "WSLCLClasses" + }, + { + "from": "GLCarbonAGLContext", + "to": "CarbonWSControls" + }, + { + "from": "GLCarbonAGLContext", + "to": "CarbonUtils" + }, + { + "from": "GLCarbonAGLContext", + "to": "Controls" + }, + { + "from": "GLGtkGlxContext", + "to": "Classes" + }, + { + "from": "GLGtkGlxContext", + "to": "SysUtils" + }, + { + "from": "GLGtkGlxContext", + "to": "LCLProc" + }, + { + "from": "GLGtkGlxContext", + "to": "LCLType" + }, + { + "from": "GLGtkGlxContext", + "to": "X" + }, + { + "from": "GLGtkGlxContext", + "to": "XUtil" + }, + { + "from": "GLGtkGlxContext", + "to": "XLib" + }, + { + "from": "GLGtkGlxContext", + "to": "gl" + }, + { + "from": "GLGtkGlxContext", + "to": "InterfaceBase" + }, + { + "from": "GLGtkGlxContext", + "to": "WSLCLClasses" + }, + { + "from": "GLGtkGlxContext", + "to": "LMessages" + }, + { + "from": "GLGtkGlxContext", + "to": "Gtk2Def" + }, + { + "from": "GLGtkGlxContext", + "to": "gdk2x" + }, + { + "from": "GLGtkGlxContext", + "to": "glib2" + }, + { + "from": "GLGtkGlxContext", + "to": "gdk2" + }, + { + "from": "GLGtkGlxContext", + "to": "gtk2" + }, + { + "from": "GLGtkGlxContext", + "to": "Gtk2Int" + }, + { + "from": "GLGtkGlxContext", + "to": "glib" + }, + { + "from": "GLGtkGlxContext", + "to": "gdk" + }, + { + "from": "GLGtkGlxContext", + "to": "gtk" + }, + { + "from": "GLGtkGlxContext", + "to": "GtkInt" + }, + { + "from": "GLGtkGlxContext", + "to": "Controls" + }, + { + "from": "GLQTContext", + "to": "Classes" + }, + { + "from": "GLQTContext", + "to": "SysUtils" + }, + { + "from": "GLQTContext", + "to": "Controls" + }, + { + "from": "GLQTContext", + "to": "LCLProc" + }, + { + "from": "GLQTContext", + "to": "LCLType" + }, + { + "from": "GLQTContext", + "to": "X" + }, + { + "from": "GLQTContext", + "to": "XUtil" + }, + { + "from": "GLQTContext", + "to": "XLib" + }, + { + "from": "GLQTContext", + "to": "gl" + }, + { + "from": "GLQTContext", + "to": "InterfaceBase" + }, + { + "from": "GLQTContext", + "to": "WSLCLClasses" + }, + { + "from": "GLQTContext", + "to": "qt4" + }, + { + "from": "GLQTContext", + "to": "qtwidgets" + }, + { + "from": "GLQTContext", + "to": "qtobjects" + }, + { + "from": "GLQTContext", + "to": "qtproc" + }, + { + "from": "GLQTContext", + "to": "qtint" + }, + { + "from": "GLQTContext", + "to": "QtWSControls" + }, + { + "from": "GLWin32WGLContext", + "to": "Classes" + }, + { + "from": "GLWin32WGLContext", + "to": "SysUtils" + }, + { + "from": "GLWin32WGLContext", + "to": "LMessages" + }, + { + "from": "GLWin32WGLContext", + "to": "Windows" + }, + { + "from": "GLWin32WGLContext", + "to": "LCLProc" + }, + { + "from": "GLWin32WGLContext", + "to": "LCLType" + }, + { + "from": "GLWin32WGLContext", + "to": "gl" + }, + { + "from": "GLWin32WGLContext", + "to": "Forms" + }, + { + "from": "GLWin32WGLContext", + "to": "Controls" + }, + { + "from": "GLWin32WGLContext", + "to": "Win32Int" + }, + { + "from": "GLWin32WGLContext", + "to": "WSLCLClasses" + }, + { + "from": "GLWin32WGLContext", + "to": "WSControls" + }, + { + "from": "GLWin32WGLContext", + "to": "Win32WSControls" + }, + { + "from": "GLWin32WGLContext", + "to": "Win32Proc" + }, + { + "from": "GLWin32WGLContext", + "to": "LCLMessageGlue" + }, + { + "from": "OpenGLContext", + "to": "Classes" + }, + { + "from": "OpenGLContext", + "to": "SysUtils" + }, + { + "from": "OpenGLContext", + "to": "LCLProc" + }, + { + "from": "OpenGLContext", + "to": "Forms" + }, + { + "from": "OpenGLContext", + "to": "Controls" + }, + { + "from": "OpenGLContext", + "to": "LCLType" + }, + { + "from": "OpenGLContext", + "to": "LCLIntf" + }, + { + "from": "OpenGLContext", + "to": "LResources" + }, + { + "from": "OpenGLContext", + "to": "Graphics" + }, + { + "from": "OpenGLContext", + "to": "LMessages" + }, + { + "from": "OpenGLContext", + "to": "WSLCLClasses" + }, + { + "from": "OpenGLContext", + "to": "WSControls" + }, + { + "from": "OpenGLContext", + "to": "GLGtkGlxContext" + }, + { + "from": "OBJLoader", + "to": "dglOpenGL" + }, + { + "from": "OBJLoader", + "to": "StrUtils" + }, + { + "from": "OBJLoader", + "to": "SysUtils" + }, + { + "from": "OBJLoader", + "to": "Unit_Vector" + }, + { + "from": "OBJLoader", + "to": "Classes" + }, + { + "from": "OBJLoader", + "to": "Windows" + }, + { + "from": "Codec", + "to": "OSTypes" + }, + { + "from": "Codec", + "to": "Ogg" + }, + { + "from": "Ogg", + "to": "OSTypes" + }, + { + "from": "VorbisFile", + "to": "OSTypes" + }, + { + "from": "VorbisFile", + "to": "Ogg" + }, + { + "from": "VorbisFile", + "to": "Codec" + }, + { + "from": "VorbisFile", + "to": "Classes" + }, + { + "from": "OverbyteIcsConApp", + "to": "Windows" + }, + { + "from": "OverbyteIcsConApp", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsConApp", + "to": "Classes" + }, + { + "from": "OverbyteIcsConApp", + "to": "Messages" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Messages" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Windows" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Forms" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Classes" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "Ics.Fmx.OverbyteIcsCharsetComboBox", + "to": "System.Classes" + }, + { + "from": "Ics.Fmx.OverbyteIcsCharsetComboBox", + "to": "FMX.Types" + }, + { + "from": "Ics.Fmx.OverbyteIcsCharsetComboBox", + "to": "FMX.ListBox" + }, + { + "from": "Ics.Fmx.OverbyteIcsCharsetComboBox", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "Ics.Posix.KEventApi", + "to": "Posix.Base" + }, + { + "from": "Ics.Posix.KEventApi", + "to": "Posix.Time" + }, + { + "from": "Ics.Posix.KEventApi", + "to": "Ics.Posix.KEventTypes" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.SysUtils" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.Classes" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.SyncObjs" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.Generics.Collections" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.SysConst" + }, + { + "from": "Ics.Posix.Messages", + "to": "Posix.SysTypes" + }, + { + "from": "Ics.Posix.Messages", + "to": "Posix.PThread" + }, + { + "from": "Ics.Posix.Messages", + "to": "Posix.Errno" + }, + { + "from": "Ics.Posix.Messages", + "to": "System.Mac.CFUtils" + }, + { + "from": "Ics.Posix.Messages", + "to": "Macapi.CoreFoundation" + }, + { + "from": "Ics.Posix.Messages", + "to": "Macapi.Foundation" + }, + { + "from": "Ics.Posix.Messages", + "to": "FMX.Forms" + }, + { + "from": "Ics.Posix.Messages", + "to": "FMX.Platform" + }, + { + "from": "Ics.Posix.Messages", + "to": "Macapi.AppKit" + }, + { + "from": "Ics.Posix.Messages", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "Ics.Posix.Messages", + "to": "OverbyteIcsUtils" + }, + { + "from": "Ics.Posix.Messages", + "to": "OverbyteIcsAvlTrees" + }, + { + "from": "Ics.Posix.WinTypes", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpSrvT", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "Windows" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "Classes" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpSrvWT", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverByteIcsWSocketE", + "to": "Windows" + }, + { + "from": "OverByteIcsWSocketE", + "to": "SysUtils" + }, + { + "from": "OverByteIcsWSocketE", + "to": "Classes" + }, + { + "from": "OverByteIcsWSocketE", + "to": "AnsiStrings" + }, + { + "from": "OverByteIcsWSocketE", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverByteIcsWSocketE", + "to": "DesignIntf" + }, + { + "from": "OverByteIcsWSocketE", + "to": "DesignEditors" + }, + { + "from": "OverbyteIcsAsn1Utils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsAsn1Utils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "Posix.Pthread" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsAvlTrees", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "OverbyteIcsTicks64" + }, + { + "from": "OverbyteIcsBlacklist", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsCRC", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsCRC", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "Vcl.StdCtrls" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "Vcl.Themes" + }, + { + "from": "OverbyteIcsCharsetComboBox", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "OverbyteIcsIconv" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "Posix.Iconv" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "System.Contnrs" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "OverbyteIcsFormDataDecoder" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsCharsetUtils", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsCookies", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsCookies", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsCookies", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsCookies", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsCookies", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsCookies", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsCryptuiApi", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsCryptuiApi", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsCsc", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsCsc", + "to": "OverbyteIcsIconv" + }, + { + "from": "OverbyteIcsCsc", + "to": "OverbyteIcsMLang" + }, + { + "from": "OverbyteIcsCsc", + "to": "Posix.Base" + }, + { + "from": "OverbyteIcsCsc", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsCsc", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsCsc", + "to": "Posix.Iconv" + }, + { + "from": "OverbyteIcsCsc", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsCsc", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsCsc", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsCsc", + "to": "System.Math" + }, + { + "from": "OverbyteIcsCsc", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsCsc", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsDigestAuth", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsDnsQuery", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "Classes" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "Forms" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "IniFiles" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "TypInfo" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "PlatformAPI" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "CommonOptionStrs" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "ToolsApi" + }, + { + "from": "OverbyteIcsDprUpdFix", + "to": "DCCStrs" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "System.UITypes" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Vcl.Graphics" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Vcl.Controls" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Vcl.StdCtrls" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "Vcl.ClipBrd" + }, + { + "from": "OverbyteIcsEmulVT", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "System.Masks" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "System.IOUtils" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "Ics.Fmx.OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "ShellAPI" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsFileCopy", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "Windows" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "Messages" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "Classes" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "Masks" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "ShellAPI" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "StrUtils" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "WideStrings" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsFileCopyW", + "to": "OverbyteIcsFtpSrvWT" + }, + { + "from": "OverbyteIcsFingCli", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsFingCli", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFingCli", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsFingCli", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsFingCli", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsFingCli", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFingCli", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFormDataDecoder", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "System.IOUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Posix.Unistd" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "Ics.Fmx.OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverbyteIcsOneTimePw" + }, + { + "from": "OverbyteIcsFtpCli", + "to": "OverByteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "Messages" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "Windows" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "Classes" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "Forms" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "Controls" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsOneTimePw" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpCliW", + "to": "OverByteIcsFtpSrvWT" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "System.Masks" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsFtpcli" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsFtpcli" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsMd5" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsFtpMulti", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "Windows" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "Messages" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "Classes" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "Forms" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "StrUtils" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "WideStrings" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsFtpcliW" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsFtpSrvWT" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsFileCopyW" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsMd5" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsFtpMultiW", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.Stdio" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.Unistd" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.Fcntl" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Posix.Wintypes" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "System.IOUtils" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "System.Types" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverByteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Fmx.OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsOneTimePw" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsFtpSrv", + "to": "OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "Windows" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "Messages" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "Forms" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverByteIcsSSLEAY" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "Classes" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsSocketUtils" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsFtpSrvWT" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsOneTimePw" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsCRC" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsFtpSrvW", + "to": "OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsHtmlPars", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHtmlPars", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "FMX.Types" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "Ics.Fmx.OverbyteIcsHttpSrv" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsHttpSrv" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsWebSession" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsHttpAppServer", + "to": "OverbyteIcsFormDataDecoder" + }, + { + "from": "OverbyteIcsHttpCCodZLib", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpCCodZLib", + "to": "OverbyteIcsHttpContCod" + }, + { + "from": "OverbyteIcsHttpCCodZLib", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsHttpCCodZLib", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsHttpContCod", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpContCod", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "System.Masks" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsHtmlPars" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsURL" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsHttpMulti", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "Windows" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "Messages" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "Classes" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "Forms" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "Masks" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsHtmlPars" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsFileCopyW" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsFtpSrvWT" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "VCLZip" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "VCLUnZip" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "kpZipObj" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsHttpMultiW", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsSspi" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsNtlmSsp" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsDigestAuth" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsHttpContCod" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsHttpProt", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsSspi" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsNtlmSsp" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsDigestAuth" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsHttpSrv", + "to": "OverbyteIcsFormDataDecoder" + }, + { + "from": "OverbyteIcsIcmp", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsIcmp", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsIcmp", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsIcmp", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsIcmp", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsIcmp", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsIcmp", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsIconv", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsIconv", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsIconv", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsIniFiles", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsPing" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "Ics.Fmx.OverbyteIcsIcmp" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsPing" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsIcmp" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsIpStreamLog", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "Winapi.PsApi" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsLIBEAY", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsLibeayEx", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsLibeayEx", + "to": "Winapi.PsApi" + }, + { + "from": "OverbyteIcsLibeayEx", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsLogger", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsLogger", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsLogger", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsLogger", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsLogger", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsMD4", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMD4", + "to": "System.Text" + }, + { + "from": "OverbyteIcsMD4", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMD5", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMD5", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMD5", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsMLang", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "Ics.Fmx.OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsMailQueue", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsMimeDec", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.Win.Registry" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.Types" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.Math" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "OverbyteIcsCsc" + }, + { + "from": "OverbyteIcsMimeUtils", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "OverbyteIcsCryptUiApi" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsMsSslUtils", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsMultiProgressBar", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMultiProgressBar", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMultiProgressBar", + "to": "Vcl.Controls" + }, + { + "from": "OverbyteIcsMultiProgressBar", + "to": "Vcl.ExtCtrls" + }, + { + "from": "OverbyteIcsMultiProgressBar", + "to": "Vcl.Graphics" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Ics.Fmx.OverbyteIcsFtpCli" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "OverbyteIcsFtpCli" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsMultipartFtpDownloader", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Ics.Fmx.OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsMultipartHttpDownloader", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsNntpCli", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsSspi" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "Ics.Posix.Wintypes" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsDES" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsMD4" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsNtlmMsgs", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsNtlmSsp", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsNtlmSsp", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsNtlmSsp", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsNtlmSsp", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsNtlmSsp", + "to": "OverbyteIcsSspi" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "OverbyteIcsMD4" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "OverbyteIcsFtpSrvT" + }, + { + "from": "OverbyteIcsOneTimePw", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsPing", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsPing", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsPing", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsPing", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsPing", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsPing", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsPing", + "to": "Ics.Fmx.OverbyteIcsIcmp" + }, + { + "from": "OverbyteIcsPing", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsPing", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsPing", + "to": "OverbyteIcsIcmp" + }, + { + "from": "OverbyteIcsPing", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsPop3Prot", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsProxy", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsProxy", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsProxy", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsProxy", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsProxy", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsProxy", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsProxy", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsProxy", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsZlibHigh" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsZLibDll" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsProxy", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsFormDataDecoder" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsURL" + }, + { + "from": "OverbyteIcsProxy", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsReg", + "to": "FMX.Types" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsFtpCli" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsFtpSrv" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsMultipartFtpDownloader" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsHttpSrv" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsMultipartHttpDownloader" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsHttpAppServer" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsCharsetComboBox" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsPop3Prot" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsNntpCli" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsFingCli" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsPing" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSslThrdLock" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsProxy" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSslHttpRest" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsIpStreamLog" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsMailQueue" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsFtpMulti" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsHttpMulti" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsWSocketE" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsWhoisCli" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsSntp" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsReg", + "to": "Ics.Fmx.OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsReg", + "to": "Controls" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpCli" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpSrv" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMultipartFtpDownloader" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsHttpSrv" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMultipartHttpDownloader" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsHttpAppServer" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsCharsetComboBox" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsPop3Prot" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsNntpCli" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFingCli" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsPing" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSslThrdLock" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsProxy" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSslHttpRest" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsIpStreamLog" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMailQueue" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpMulti" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsHttpMulti" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWSocketE" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSysLogClient" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSysLogServer" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSnmpCli" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSmtpSrv" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWhoisCli" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsSntp" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsBlacklist" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFileCopy" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpCliW" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpSrvW" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFileCopyW" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsFtpMultiW" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsHttpMultiW" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMultiProgressBar" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsEmulVT" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsTnCnx" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsTnEmulVT" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsTnScript" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsWSocketTS" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMimeDec" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsTimeList" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsReg", + "to": "OverbyteIcsCookies" + }, + { + "from": "OverbyteIcsReg", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsReg", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsReg", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsReg", + "to": "ToolsApi" + }, + { + "from": "OverbyteIcsReg", + "to": "DesignIntf" + }, + { + "from": "OverbyteIcsReg", + "to": "DesignEditors" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "System.Types" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSSLEAY", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSha1", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSha1", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSha1", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Posix.Unistd" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "System.Mac.CFUtils" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Macapi.Corefoundation" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsStreams" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverByteIcsSSLEAY" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverByteIcsLIBEAY" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSmtpProt", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.Variants" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.StrUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.Types" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Posix.Unistd" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "System.Mac.CFUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Macapi.Corefoundation" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverByteIcsSSLEAY" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverByteIcsLIBEAY" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Fmx.OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "Ics.Fmx.OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsSmtpProt" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsMimeDec" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSmtpSrv", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "Vcl.ExtCtrls" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "OverbyteIcsAsn1Utils" + }, + { + "from": "OverbyteIcsSnmpCli", + "to": "OverbyteIcsSnmpMsgs" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "OverbyteIcsSHA1" + }, + { + "from": "OverbyteIcsSnmpMsgs", + "to": "OverbyteIcsAsn1Utils" + }, + { + "from": "OverbyteIcsSntp", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSntp", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSntp", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsSntp", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsSntp", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSntp", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSntp", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSntp", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsSntp", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsSntp", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSntp", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSntp", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSntp", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSntp", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Posix.Base" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Posix.NetIf" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Posix.NetinetIn" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Posix.ArpaInet" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "System.Types" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSocketUtils", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Winapi.ShellAPI" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsSslJose" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "Ics.Fmx.OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsSslSessionCache" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsSslJose" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsWinCrypt" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsHttpCCodZLib" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsHttpContCod" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsCookies" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsFormDataDecoder" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsCharsetUtils" + }, + { + "from": "OverbyteIcsSslHttpRest", + "to": "OverbyteIcsSuperObject" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSslJose", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslJose", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsSslJose", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsSslJose", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSslJose", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "System.Types" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsAvlTrees" + }, + { + "from": "OverbyteIcsSslSessionCache", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "Posix.Pthread" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsSslThrdLock", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsSsleay" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsSslJose" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsSslHttpRest" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "Ics.Fmx.OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsSslJose" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsSslHttpRest" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsMsSslUtils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsDnsQuery" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsIniFiles" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsTicks64" + }, + { + "from": "OverbyteIcsSslX509Certs", + "to": "OverbyteIcsSuperObject" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsLibeay" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverByteIcsMD5" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsSslX509Utils", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSspi", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsStreams", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsStreams", + "to": "Posix.UniStd" + }, + { + "from": "OverbyteIcsStreams", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsStreams", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsStreams", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsStreams", + "to": "System.RTLConsts" + }, + { + "from": "OverbyteIcsStreams", + "to": "System.Math" + }, + { + "from": "OverbyteIcsStreams", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsStreams", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "System.Generics.Collections" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "System.RTTI" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "baseunix" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "unix" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "DateUtils" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "sockets" + }, + { + "from": "OverbyteIcsSuperObject", + "to": "Winapi.WinSock" + }, + { + "from": "OverbyteIcsSuperXMLParser", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSuperXMLParser", + "to": "Classes" + }, + { + "from": "OverbyteIcsSuperXMLParser", + "to": "OverbyteIcsSuperObject" + }, + { + "from": "OverbyteIcsSuperXMLParser", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsSuperXMLParser", + "to": "Windows" + }, + { + "from": "OverbyteIcsSysLogClient", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSysLogClient", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSysLogClient", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSysLogClient", + "to": "OverbyteIcsSysLogDefs" + }, + { + "from": "OverbyteIcsSysLogClient", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "Winapi.Winsock" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "OverbyteIcsWinSock" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "OverbyteIcsSysLogDefs" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsSysLogServer", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Posix.Pthread" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Posix.UniStd" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "System.Types" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsThreadTimer", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsTicks64", + "to": "Windows" + }, + { + "from": "OverbyteIcsTicks64", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsTimeList", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTimeList", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsTimeList", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsTimeList", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsTnCnx", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "System.UITypes" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "Vcl.Graphics" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "Vcl.Controls" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "OverbyteIcsEmulVT" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "OverbyteIcsTnCnx" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "OverbyteIcsTnOptFrm" + }, + { + "from": "OverbyteIcsTnEmulVT", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.Graphics" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.Controls" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.Dialogs" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.StdCtrls" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "Vcl.Buttons" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsTnOptFrm", + "to": "OverbyteIcsEmulVT" + }, + { + "from": "OverbyteIcsTnScript", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTnScript", + "to": "WinTypes" + }, + { + "from": "OverbyteIcsTnScript", + "to": "WinProcs" + }, + { + "from": "OverbyteIcsTnScript", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsTnScript", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsTnScript", + "to": "OverbyteIcsTnEmulVT" + }, + { + "from": "OverbyteIcsTypes", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsTypes", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsUrl", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsUrl", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsUtils", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsUtils", + "to": "OverbyteIcsWinnls" + }, + { + "from": "OverbyteIcsUtils", + "to": "OverbyteIcsIconv" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.Iconv" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.Unistd" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.Stdio" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.SysStatvfs" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.PThread" + }, + { + "from": "OverbyteIcsUtils", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsUtils", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsUtils", + "to": "Macapi.CoreFoundation" + }, + { + "from": "OverbyteIcsUtils", + "to": "MacApi.CoreServices" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.RtlConsts" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.IOUtils" + }, + { + "from": "OverbyteIcsUtils", + "to": "System.AnsiStrings" + }, + { + "from": "OverbyteIcsUtils", + "to": "OverbyteIcsMD5" + }, + { + "from": "OverbyteIcsUtils", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "System.Contnrs" + }, + { + "from": "OverbyteIcsWSockBuf", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.Types" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.Contnrs" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.SysConst" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.Generics.Collections" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.Pthread" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.SysTypes" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.Base" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.NetinetIn" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.NetinetTCP" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.SysTime" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.ArpaInet" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.NetDB" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.UniStd" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.Fcntl" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Posix.StrOpts" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Posix.KEventTypes" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Posix.KEventApi" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsWSocket", + "to": "System.Masks" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsAvlTrees" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsDigestAuth" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Fmx.OverbyteIcsThreadTimer" + }, + { + "from": "OverbyteIcsWSocket", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsThreadTimer" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsNtlmMsgs" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsWSockBuf" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsWSocket", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.Types" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.IniFiles" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.Types" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Posix.Errno" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Posix.NetinetIn" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Posix.SysSocket" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Ics.Fmx.OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsSslX509Utils" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "Ics.Fmx.OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsWSocketS", + "to": "OverbyteIcsSslX509Certs" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsSSLEAY" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsLIBEAY" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsSslThrdLock" + }, + { + "from": "OverbyteIcsWSocketTS", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsWebSession", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWebSession", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWebSession", + "to": "System.SyncObjs" + }, + { + "from": "OverbyteIcsWebSession", + "to": "OverbyteIcsTimeList" + }, + { + "from": "OverbyteIcsWebSession", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "Classes" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "SysUtils" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "Math" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsUrl" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsSha1" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsMimeUtils" + }, + { + "from": "OverbyteIcsWebSockets", + "to": "OverbyteIcsMd5" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "OverbyteIcsWinsock" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Posix.Time" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "System.DateUtils" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Ics.Fmx.OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "Ics.Fmx.OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "OverbyteIcsWndControl" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "OverbyteIcsWSocket" + }, + { + "from": "OverbyteIcsWhoisCli", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsWinCrypt", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWinnls", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWinsock", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWinsock", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWinsock", + "to": "System.Runtime.InteropServices" + }, + { + "from": "OverbyteIcsWinsock", + "to": "System.Text" + }, + { + "from": "OverbyteIcsWinsock", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWmi", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWmi", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWmi", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWmi", + "to": "System.Sysutils" + }, + { + "from": "OverbyteIcsWmi", + "to": "System.TypInfo" + }, + { + "from": "OverbyteIcsWmi", + "to": "System.Types" + }, + { + "from": "OverbyteIcsWmi", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWmi", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsWmi", + "to": "WbemScripting_TLB" + }, + { + "from": "OverbyteIcsWmi", + "to": "ActiveX" + }, + { + "from": "OverbyteIcsWmi", + "to": "ComObj" + }, + { + "from": "OverbyteIcsWmi", + "to": "Variants" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Winapi.Messages" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Ics.Posix.WinTypes" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Ics.Posix.Messages" + }, + { + "from": "OverbyteIcsWndControl", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsWndControl", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsWndControl", + "to": "FMX.Forms" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Vcl.Forms" + }, + { + "from": "OverbyteIcsWndControl", + "to": "OverbyteIcsLogger" + }, + { + "from": "OverbyteIcsWndControl", + "to": "OverbyteIcsTypes" + }, + { + "from": "OverbyteIcsWndControl", + "to": "Ics.Fmx.OverbyteIcsThreadTimer" + }, + { + "from": "OverbyteIcsWndControl", + "to": "OverbyteIcsThreadTimer" + }, + { + "from": "OverbyteIcsWndControl", + "to": "OverbyteIcsUtils" + }, + { + "from": "OverbyteIcsZLibDll", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsZLibDll", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsZLibObj", + "to": "Winapi.Windows" + }, + { + "from": "OverbyteIcsZLibObj", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsZlibHigh", + "to": "System.SysUtils" + }, + { + "from": "OverbyteIcsZlibHigh", + "to": "System.Classes" + }, + { + "from": "OverbyteIcsZlibHigh", + "to": "OverbyteIcsZLibObj" + }, + { + "from": "WbemScripting_TLB", + "to": "Windows" + }, + { + "from": "WbemScripting_TLB", + "to": "ActiveX" + }, + { + "from": "WbemScripting_TLB", + "to": "Classes" + }, + { + "from": "WbemScripting_TLB", + "to": "Graphics" + }, + { + "from": "WbemScripting_TLB", + "to": "OleServer" + }, + { + "from": "WbemScripting_TLB", + "to": "StdVCL" + }, + { + "from": "WbemScripting_TLB", + "to": "Variants" + }, + { + "from": "WbemScripting_TLB", + "to": "ComObj" + }, + { + "from": "PolyTriangulate", + "to": "KM_Points" + }, + { + "from": "PolyTriangulate", + "to": "Math" + }, + { + "from": "SciZipFile", + "to": "SysUtils" + }, + { + "from": "SciZipFile", + "to": "Classes" + }, + { + "from": "SciZipFile", + "to": "Windows" + }, + { + "from": "SciZipFile", + "to": "zlib" + }, + { + "from": "SciZipFile", + "to": "zstream" + }, + { + "from": "URLUtils", + "to": "SysUtils" + }, + { + "from": "VerySimpleXML", + "to": "Classes" + }, + { + "from": "VerySimpleXML", + "to": "SysUtils" + }, + { + "from": "VerySimpleXML", + "to": "StrUtils" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "Winapi.ActiveX" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "System.Types" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "Winapi.oleacc" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "VirtualTrees.AccessibilityFactory" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "Vcl.Forms" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "System.Variants" + }, + { + "from": "VirtualTrees.Accessibility", + "to": "System.Math" + }, + { + "from": "VirtualTrees.AccessibilityFactory", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.AccessibilityFactory", + "to": "Winapi.oleacc" + }, + { + "from": "VirtualTrees.AccessibilityFactory", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.Actions", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.Actions", + "to": "System.Actions" + }, + { + "from": "VirtualTrees.Actions", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees.Actions", + "to": "Vcl.ActnList" + }, + { + "from": "VirtualTrees.Actions", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.Actions", + "to": "WinApi.Windows" + }, + { + "from": "VirtualTrees.Actions", + "to": "Vcl.Forms" + }, + { + "from": "VirtualTrees.Classes", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.ClipBoard", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.ClipBoard", + "to": "Winapi.ActiveX" + }, + { + "from": "VirtualTrees.ClipBoard", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.ClipBoard", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.ClipBoard", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees.Export", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.Export", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.Export", + "to": "VirtualTrees.Classes" + }, + { + "from": "VirtualTrees.Export", + "to": "Vcl.Graphics" + }, + { + "from": "VirtualTrees.Export", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees.Export", + "to": "Vcl.Forms" + }, + { + "from": "VirtualTrees.Export", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.Export", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees.Export", + "to": "System.StrUtils" + }, + { + "from": "VirtualTrees.Export", + "to": "System.Generics.Collections" + }, + { + "from": "VirtualTrees.Export", + "to": "System.UITypes" + }, + { + "from": "VirtualTrees.HeaderPopup", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.HeaderPopup", + "to": "Vcl.Menus" + }, + { + "from": "VirtualTrees.HeaderPopup", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.HeaderPopup", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.HeaderPopup", + "to": "System.Types" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Winapi.Messages" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Winapi.UxTheme" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Vcl.Themes" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Vcl.Forms" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "System.Math" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "System.Types" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "Vcl.Graphics" + }, + { + "from": "VirtualTrees.StyleHooks", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.Utils", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.Utils", + "to": "Winapi.ActiveX" + }, + { + "from": "VirtualTrees.Utils", + "to": "System.Types" + }, + { + "from": "VirtualTrees.Utils", + "to": "Vcl.Graphics" + }, + { + "from": "VirtualTrees.Utils", + "to": "Vcl.ImgList" + }, + { + "from": "VirtualTrees.Utils", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees.Utils", + "to": "Winapi.CommCtrl" + }, + { + "from": "VirtualTrees.Utils", + "to": "Winapi.ShlObj" + }, + { + "from": "VirtualTrees.Utils", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees.Utils", + "to": "System.StrUtils" + }, + { + "from": "VirtualTrees.Utils", + "to": "System.Math" + }, + { + "from": "VirtualTrees.WorkerThread", + "to": "System.Classes" + }, + { + "from": "VirtualTrees.WorkerThread", + "to": "VirtualTrees" + }, + { + "from": "VirtualTrees.WorkerThread", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees.WorkerThread", + "to": "System.Types" + }, + { + "from": "VirtualTrees.WorkerThread", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees", + "to": "Winapi.Windows" + }, + { + "from": "VirtualTrees", + "to": "Winapi.oleacc" + }, + { + "from": "VirtualTrees", + "to": "Winapi.Messages" + }, + { + "from": "VirtualTrees", + "to": "System.SysUtils" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Graphics" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Controls" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Forms" + }, + { + "from": "VirtualTrees", + "to": "Vcl.ImgList" + }, + { + "from": "VirtualTrees", + "to": "Winapi.ActiveX" + }, + { + "from": "VirtualTrees", + "to": "Vcl.StdCtrls" + }, + { + "from": "VirtualTrees", + "to": "System.Classes" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Menus" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Printers" + }, + { + "from": "VirtualTrees", + "to": "System.Types" + }, + { + "from": "VirtualTrees", + "to": "Winapi.CommCtrl" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Themes" + }, + { + "from": "VirtualTrees", + "to": "Winapi.UxTheme" + }, + { + "from": "VirtualTrees", + "to": "Winapi.ShlObj" + }, + { + "from": "VirtualTrees", + "to": "System.UITypes" + }, + { + "from": "VirtualTrees", + "to": "System.Generics.Collections" + }, + { + "from": "VirtualTrees", + "to": "Vcl.Consts" + }, + { + "from": "VirtualTrees", + "to": "System.Math" + }, + { + "from": "VirtualTrees", + "to": "Vcl.AxCtrls" + }, + { + "from": "VirtualTrees", + "to": "Winapi.MMSystem" + }, + { + "from": "VirtualTrees", + "to": "System.TypInfo" + }, + { + "from": "VirtualTrees", + "to": "System.SyncObjs" + }, + { + "from": "VirtualTrees", + "to": "Vcl.ActnList" + }, + { + "from": "VirtualTrees", + "to": "Vcl.StdActns" + }, + { + "from": "VirtualTrees", + "to": "System.StrUtils" + }, + { + "from": "VirtualTrees", + "to": "Vcl.GraphUtil" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.AccessibilityFactory" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.StyleHooks" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.Classes" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.WorkerThread" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.ClipBoard" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.Utils" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.Export" + }, + { + "from": "VirtualTrees", + "to": "VirtualTrees.HeaderPopup" + }, + { + "from": "Xml.VerySimple", + "to": "Classes" + }, + { + "from": "Xml.VerySimple", + "to": "SysUtils" + }, + { + "from": "Xml.VerySimple", + "to": "Generics.Defaults" + }, + { + "from": "Xml.VerySimple", + "to": "Generics.Collections" + }, + { + "from": "Xml.VerySimple", + "to": "Variants" + }, + { + "from": "Xml.VerySimple", + "to": "Rtti" + }, + { + "from": "Xml.VerySimple", + "to": "DateUtils" + }, + { + "from": "Xml.VerySimple", + "to": "StrUtils" + }, + { + "from": "Zippit", + "to": "Classes" + }, + { + "from": "Zippit", + "to": "SysUtils" + }, + { + "from": "Zippit", + "to": "SciZipFile" + }, + { + "from": "Bass", + "to": "Windows" + }, + { + "from": "dglOpenGL", + "to": "SysUtils" + }, + { + "from": "dglOpenGL", + "to": "Windows" + }, + { + "from": "dglOpenGL", + "to": "X" + }, + { + "from": "dglOpenGL", + "to": "XLib" + }, + { + "from": "dglOpenGL", + "to": "XUtil" + }, + { + "from": "dglOpenGL", + "to": "types" + }, + { + "from": "iaWin.NameDelphiThreads", + "to": "Windows" + }, + { + "from": "iaWin.NameDelphiThreads", + "to": "SysUtils" + }, + { + "from": "iaWin.NameDelphiThreads", + "to": "Classes" + }, + { + "from": "iaWin.NameDelphiThreads", + "to": "JwaTlHelp32" + }, + { + "from": "libZPlay", + "to": "Windows" + }, + { + "from": "libZPlay", + "to": "SysUtils" + }, + { + "from": "libZPlay", + "to": "Classes" + }, + { + "from": "libZPlay", + "to": "VCL.Graphics" + }, + { + "from": "libZPlay", + "to": "Graphics" + }, + { + "from": "openal", + "to": "Classes" + }, + { + "from": "openal", + "to": "SysUtils" + }, + { + "from": "openal", + "to": "Windows" + }, + { + "from": "openal", + "to": "mmsystem" + }, + { + "from": "DataAbstract_Scripting", + "to": "DataAbstract_Scripting_Reg" + }, + { + "from": "DataAbstract_Scripting", + "to": "uDAPascalScript" + }, + { + "from": "DataAbstract_Scripting", + "to": "uDAPSScriptingProvider" + }, + { + "from": "DataAbstract_Scripting", + "to": "LazarusPackageIntf" + }, + { + "from": "DataAbstract_Scripting_Reg", + "to": "Classes" + }, + { + "from": "DataAbstract_Scripting_Reg", + "to": "uDAPSScriptingProvider" + }, + { + "from": "DataAbstract_Scripting_Reg", + "to": "uDARes" + }, + { + "from": "uDAPSScriptingProvider", + "to": "Classes" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uPSComponent" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uPSComponent_DB" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uPSComponent_Default" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uPSUtils" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDAScriptingProvider" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDAInterfaces" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDABusinessProcessor" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDADataTable" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDAPascalScript" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uDASchemaClasses" + }, + { + "from": "uDAPSScriptingProvider", + "to": "SysUtils" + }, + { + "from": "uDAPSScriptingProvider", + "to": "uROClasses" + }, + { + "from": "uDAPascalScript", + "to": "SysUtils" + }, + { + "from": "uDAPascalScript", + "to": "Classes" + }, + { + "from": "uDAPascalScript", + "to": "DB" + }, + { + "from": "uDAPascalScript", + "to": "uPSComponent" + }, + { + "from": "uDAPascalScript", + "to": "uPSCompiler" + }, + { + "from": "uDAPascalScript", + "to": "uPSRuntime" + }, + { + "from": "uDAPascalScript", + "to": "uPSUtils" + }, + { + "from": "uDAPascalScript", + "to": "uDADataTable" + }, + { + "from": "uDAPascalScript", + "to": "Dialogs" + }, + { + "from": "uDAPascalScript", + "to": "uROClasses" + }, + { + "from": "uDAPascalScript", + "to": "uDACore" + }, + { + "from": "uDAPascalScript", + "to": "uDAScriptingProvider" + }, + { + "from": "uDAPascalScript", + "to": "uDAInterfaces" + }, + { + "from": "uDAPascalScript", + "to": "uDAFields" + }, + { + "from": "PascalScript_RO_Reg", + "to": "Classes" + }, + { + "from": "PascalScript_RO_Reg", + "to": "uROPSServerLink" + }, + { + "from": "uROPSImports", + "to": "uPSCompiler" + }, + { + "from": "uROPSImports", + "to": "uPSRuntime" + }, + { + "from": "uROPSImports", + "to": "uROBINMessage" + }, + { + "from": "uROPSImports", + "to": "uROIndyHTTPChannel" + }, + { + "from": "uROPSImports", + "to": "uROXMLSerializer" + }, + { + "from": "uROPSImports", + "to": "uROIndyTCPChannel" + }, + { + "from": "uROPSImports", + "to": "idTcpClient" + }, + { + "from": "uROPSImports", + "to": "uROPSServerLink" + }, + { + "from": "uROPSImports", + "to": "uROWinInetHttpChannel" + }, + { + "from": "uROPSServerLink", + "to": "Windows" + }, + { + "from": "uROPSServerLink", + "to": "Types" + }, + { + "from": "uROPSServerLink", + "to": "SysUtils" + }, + { + "from": "uROPSServerLink", + "to": "Classes" + }, + { + "from": "uROPSServerLink", + "to": "uPSCompiler" + }, + { + "from": "uROPSServerLink", + "to": "uPSUtils" + }, + { + "from": "uROPSServerLink", + "to": "uPSRuntime" + }, + { + "from": "uROPSServerLink", + "to": "uPSComponent" + }, + { + "from": "uROPSServerLink", + "to": "uROClient" + }, + { + "from": "uROPSServerLink", + "to": "uRODL" + }, + { + "from": "uROPSServerLink", + "to": "uROTypes" + }, + { + "from": "uROPSServerLink", + "to": "uROClientIntf" + }, + { + "from": "uROPSServerLink", + "to": "uROSerializer" + }, + { + "from": "uROPSServerLink", + "to": "uROPSImports" + }, + { + "from": "uROPSServerLink", + "to": "uRODLToXML" + }, + { + "from": "uROPSServerLink", + "to": "uXMLToRODL" + }, + { + "from": "uROPSServerLink", + "to": "uROMessage" + }, + { + "from": "uROPSServerLink", + "to": "uROTransportChannel" + }, + { + "from": "uROPSServerLink", + "to": "uROClasses" + }, + { + "from": "dlgConfirmReplace", + "to": "Windows" + }, + { + "from": "dlgConfirmReplace", + "to": "Messages" + }, + { + "from": "dlgConfirmReplace", + "to": "SysUtils" + }, + { + "from": "dlgConfirmReplace", + "to": "Classes" + }, + { + "from": "dlgConfirmReplace", + "to": "Graphics" + }, + { + "from": "dlgConfirmReplace", + "to": "Controls" + }, + { + "from": "dlgConfirmReplace", + "to": "Forms" + }, + { + "from": "dlgConfirmReplace", + "to": "Dialogs" + }, + { + "from": "dlgConfirmReplace", + "to": "StdCtrls" + }, + { + "from": "dlgConfirmReplace", + "to": "ExtCtrls" + }, + { + "from": "dlgReplaceText", + "to": "Windows" + }, + { + "from": "dlgReplaceText", + "to": "Messages" + }, + { + "from": "dlgReplaceText", + "to": "SysUtils" + }, + { + "from": "dlgReplaceText", + "to": "Classes" + }, + { + "from": "dlgReplaceText", + "to": "Graphics" + }, + { + "from": "dlgReplaceText", + "to": "Controls" + }, + { + "from": "dlgReplaceText", + "to": "Forms" + }, + { + "from": "dlgReplaceText", + "to": "Dialogs" + }, + { + "from": "dlgReplaceText", + "to": "dlgSearchText" + }, + { + "from": "dlgReplaceText", + "to": "StdCtrls" + }, + { + "from": "dlgReplaceText", + "to": "ExtCtrls" + }, + { + "from": "dlgSearchText", + "to": "Windows" + }, + { + "from": "dlgSearchText", + "to": "Messages" + }, + { + "from": "dlgSearchText", + "to": "SysUtils" + }, + { + "from": "dlgSearchText", + "to": "Classes" + }, + { + "from": "dlgSearchText", + "to": "Graphics" + }, + { + "from": "dlgSearchText", + "to": "Controls" + }, + { + "from": "dlgSearchText", + "to": "Forms" + }, + { + "from": "dlgSearchText", + "to": "Dialogs" + }, + { + "from": "dlgSearchText", + "to": "StdCtrls" + }, + { + "from": "dlgSearchText", + "to": "ExtCtrls" + }, + { + "from": "ide_debugoutput", + "to": "Windows" + }, + { + "from": "ide_debugoutput", + "to": "Messages" + }, + { + "from": "ide_debugoutput", + "to": "SysUtils" + }, + { + "from": "ide_debugoutput", + "to": "Variants" + }, + { + "from": "ide_debugoutput", + "to": "Classes" + }, + { + "from": "ide_debugoutput", + "to": "Graphics" + }, + { + "from": "ide_debugoutput", + "to": "Controls" + }, + { + "from": "ide_debugoutput", + "to": "Forms" + }, + { + "from": "ide_debugoutput", + "to": "Dialogs" + }, + { + "from": "ide_debugoutput", + "to": "StdCtrls" + }, + { + "from": "ide_editor", + "to": "Windows" + }, + { + "from": "ide_editor", + "to": "SysUtils" + }, + { + "from": "ide_editor", + "to": "Classes" + }, + { + "from": "ide_editor", + "to": "Graphics" + }, + { + "from": "ide_editor", + "to": "Controls" + }, + { + "from": "ide_editor", + "to": "Forms" + }, + { + "from": "ide_editor", + "to": "Dialogs" + }, + { + "from": "ide_editor", + "to": "Menus" + }, + { + "from": "ide_editor", + "to": "ExtCtrls" + }, + { + "from": "ide_editor", + "to": "StdCtrls" + }, + { + "from": "ide_editor", + "to": "ComCtrls" + }, + { + "from": "ide_editor", + "to": "SynEdit" + }, + { + "from": "ide_editor", + "to": "SynEditTypes" + }, + { + "from": "ide_editor", + "to": "SynHighlighterPas" + }, + { + "from": "ide_editor", + "to": "uPSComponent_COM" + }, + { + "from": "ide_editor", + "to": "uPSComponent_StdCtrls" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Forms" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Default" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Controls" + }, + { + "from": "ide_editor", + "to": "uPSRuntime" + }, + { + "from": "ide_editor", + "to": "uPSDisassembly" + }, + { + "from": "ide_editor", + "to": "uPSUtils" + }, + { + "from": "ide_editor", + "to": "uPSComponent" + }, + { + "from": "ide_editor", + "to": "uPSDebugger" + }, + { + "from": "ide_editor", + "to": "SynEditRegexSearch" + }, + { + "from": "ide_editor", + "to": "SynEditSearch" + }, + { + "from": "ide_editor", + "to": "SynEditMiscClasses" + }, + { + "from": "ide_editor", + "to": "SynEditHighlighter" + }, + { + "from": "ide_editor", + "to": "ide_debugoutput" + }, + { + "from": "ide_editor", + "to": "uFrmGotoLine" + }, + { + "from": "ide_editor", + "to": "dlgSearchText" + }, + { + "from": "ide_editor", + "to": "dlgReplaceText" + }, + { + "from": "ide_editor", + "to": "dlgConfirmReplace" + }, + { + "from": "uFrmGotoLine", + "to": "Windows" + }, + { + "from": "uFrmGotoLine", + "to": "Messages" + }, + { + "from": "uFrmGotoLine", + "to": "SysUtils" + }, + { + "from": "uFrmGotoLine", + "to": "Variants" + }, + { + "from": "uFrmGotoLine", + "to": "Classes" + }, + { + "from": "uFrmGotoLine", + "to": "Graphics" + }, + { + "from": "uFrmGotoLine", + "to": "Controls" + }, + { + "from": "uFrmGotoLine", + "to": "Forms" + }, + { + "from": "uFrmGotoLine", + "to": "Dialogs" + }, + { + "from": "uFrmGotoLine", + "to": "StdCtrls" + }, + { + "from": "uFrmGotoLine", + "to": "SynEditTypes" + }, + { + "from": "dlgConfirmReplace", + "to": "Windows" + }, + { + "from": "dlgConfirmReplace", + "to": "Messages" + }, + { + "from": "dlgConfirmReplace", + "to": "SysUtils" + }, + { + "from": "dlgConfirmReplace", + "to": "Classes" + }, + { + "from": "dlgConfirmReplace", + "to": "Graphics" + }, + { + "from": "dlgConfirmReplace", + "to": "Controls" + }, + { + "from": "dlgConfirmReplace", + "to": "Forms" + }, + { + "from": "dlgConfirmReplace", + "to": "Dialogs" + }, + { + "from": "dlgConfirmReplace", + "to": "StdCtrls" + }, + { + "from": "dlgConfirmReplace", + "to": "ExtCtrls" + }, + { + "from": "dlgReplaceText", + "to": "Windows" + }, + { + "from": "dlgReplaceText", + "to": "Messages" + }, + { + "from": "dlgReplaceText", + "to": "SysUtils" + }, + { + "from": "dlgReplaceText", + "to": "Classes" + }, + { + "from": "dlgReplaceText", + "to": "Graphics" + }, + { + "from": "dlgReplaceText", + "to": "Controls" + }, + { + "from": "dlgReplaceText", + "to": "Forms" + }, + { + "from": "dlgReplaceText", + "to": "Dialogs" + }, + { + "from": "dlgReplaceText", + "to": "dlgSearchText" + }, + { + "from": "dlgReplaceText", + "to": "StdCtrls" + }, + { + "from": "dlgReplaceText", + "to": "ExtCtrls" + }, + { + "from": "dlgSearchText", + "to": "Windows" + }, + { + "from": "dlgSearchText", + "to": "Messages" + }, + { + "from": "dlgSearchText", + "to": "SysUtils" + }, + { + "from": "dlgSearchText", + "to": "Classes" + }, + { + "from": "dlgSearchText", + "to": "Graphics" + }, + { + "from": "dlgSearchText", + "to": "Controls" + }, + { + "from": "dlgSearchText", + "to": "Forms" + }, + { + "from": "dlgSearchText", + "to": "Dialogs" + }, + { + "from": "dlgSearchText", + "to": "StdCtrls" + }, + { + "from": "dlgSearchText", + "to": "ExtCtrls" + }, + { + "from": "ide_debugoutput", + "to": "Windows" + }, + { + "from": "ide_debugoutput", + "to": "Messages" + }, + { + "from": "ide_debugoutput", + "to": "SysUtils" + }, + { + "from": "ide_debugoutput", + "to": "Variants" + }, + { + "from": "ide_debugoutput", + "to": "Classes" + }, + { + "from": "ide_debugoutput", + "to": "Graphics" + }, + { + "from": "ide_debugoutput", + "to": "Controls" + }, + { + "from": "ide_debugoutput", + "to": "Forms" + }, + { + "from": "ide_debugoutput", + "to": "Dialogs" + }, + { + "from": "ide_debugoutput", + "to": "StdCtrls" + }, + { + "from": "ide_editor", + "to": "Windows" + }, + { + "from": "ide_editor", + "to": "SysUtils" + }, + { + "from": "ide_editor", + "to": "Classes" + }, + { + "from": "ide_editor", + "to": "Graphics" + }, + { + "from": "ide_editor", + "to": "Controls" + }, + { + "from": "ide_editor", + "to": "Forms" + }, + { + "from": "ide_editor", + "to": "Dialogs" + }, + { + "from": "ide_editor", + "to": "Menus" + }, + { + "from": "ide_editor", + "to": "ExtCtrls" + }, + { + "from": "ide_editor", + "to": "StdCtrls" + }, + { + "from": "ide_editor", + "to": "ComCtrls" + }, + { + "from": "ide_editor", + "to": "SynEdit" + }, + { + "from": "ide_editor", + "to": "SynEditTypes" + }, + { + "from": "ide_editor", + "to": "SynHighlighterPas" + }, + { + "from": "ide_editor", + "to": "uPSComponent_COM" + }, + { + "from": "ide_editor", + "to": "uPSComponent_StdCtrls" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Forms" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Default" + }, + { + "from": "ide_editor", + "to": "uPSComponent_Controls" + }, + { + "from": "ide_editor", + "to": "uPSRuntime" + }, + { + "from": "ide_editor", + "to": "uPSDisassembly" + }, + { + "from": "ide_editor", + "to": "uPSUtils" + }, + { + "from": "ide_editor", + "to": "uPSComponent" + }, + { + "from": "ide_editor", + "to": "uPSDebugger" + }, + { + "from": "ide_editor", + "to": "SynEditRegexSearch" + }, + { + "from": "ide_editor", + "to": "SynEditSearch" + }, + { + "from": "ide_editor", + "to": "SynEditMiscClasses" + }, + { + "from": "ide_editor", + "to": "SynEditHighlighter" + }, + { + "from": "ide_editor", + "to": "ide_debugoutput" + }, + { + "from": "ide_editor", + "to": "uFrmGotoLine" + }, + { + "from": "ide_editor", + "to": "dlgSearchText" + }, + { + "from": "ide_editor", + "to": "dlgReplaceText" + }, + { + "from": "ide_editor", + "to": "dlgConfirmReplace" + }, + { + "from": "uFrmGotoLine", + "to": "Windows" + }, + { + "from": "uFrmGotoLine", + "to": "Messages" + }, + { + "from": "uFrmGotoLine", + "to": "SysUtils" + }, + { + "from": "uFrmGotoLine", + "to": "Variants" + }, + { + "from": "uFrmGotoLine", + "to": "Classes" + }, + { + "from": "uFrmGotoLine", + "to": "Graphics" + }, + { + "from": "uFrmGotoLine", + "to": "Controls" + }, + { + "from": "uFrmGotoLine", + "to": "Forms" + }, + { + "from": "uFrmGotoLine", + "to": "Dialogs" + }, + { + "from": "uFrmGotoLine", + "to": "StdCtrls" + }, + { + "from": "uFrmGotoLine", + "to": "SynEditTypes" + }, + { + "from": "fDwin", + "to": "Windows" + }, + { + "from": "fDwin", + "to": "Messages" + }, + { + "from": "fDwin", + "to": "SysUtils" + }, + { + "from": "fDwin", + "to": "Classes" + }, + { + "from": "fDwin", + "to": "Graphics" + }, + { + "from": "fDwin", + "to": "Controls" + }, + { + "from": "fDwin", + "to": "Forms" + }, + { + "from": "fDwin", + "to": "Dialogs" + }, + { + "from": "fDwin", + "to": "ExtCtrls" + }, + { + "from": "fDwin", + "to": "StdCtrls" + }, + { + "from": "fMain", + "to": "Windows" + }, + { + "from": "fMain", + "to": "Messages" + }, + { + "from": "fMain", + "to": "SysUtils" + }, + { + "from": "fMain", + "to": "Classes" + }, + { + "from": "fMain", + "to": "Graphics" + }, + { + "from": "fMain", + "to": "Controls" + }, + { + "from": "fMain", + "to": "Forms" + }, + { + "from": "fMain", + "to": "Dialogs" + }, + { + "from": "fMain", + "to": "ExtCtrls" + }, + { + "from": "fMain", + "to": "StdCtrls" + }, + { + "from": "fMain", + "to": "uPSCompiler" + }, + { + "from": "fMain", + "to": "uPSRuntime" + }, + { + "from": "fMain", + "to": "uPSDisassembly" + }, + { + "from": "fMain", + "to": "uPSPreprocessor" + }, + { + "from": "fMain", + "to": "uPSUtils" + }, + { + "from": "fMain", + "to": "Menus" + }, + { + "from": "fMain", + "to": "uPSC_comobj" + }, + { + "from": "fMain", + "to": "uPSR_comobj" + }, + { + "from": "fMain", + "to": "uPSC_dll" + }, + { + "from": "fMain", + "to": "uPSR_dll" + }, + { + "from": "fMain", + "to": "uPSDebugger" + }, + { + "from": "fMain", + "to": "uPSR_std" + }, + { + "from": "fMain", + "to": "uPSC_std" + }, + { + "from": "fMain", + "to": "uPSR_stdctrls" + }, + { + "from": "fMain", + "to": "uPSC_stdctrls" + }, + { + "from": "fMain", + "to": "uPSR_forms" + }, + { + "from": "fMain", + "to": "uPSC_forms" + }, + { + "from": "fMain", + "to": "uPSC_graphics" + }, + { + "from": "fMain", + "to": "uPSC_controls" + }, + { + "from": "fMain", + "to": "uPSC_classes" + }, + { + "from": "fMain", + "to": "uPSR_graphics" + }, + { + "from": "fMain", + "to": "uPSR_controls" + }, + { + "from": "fMain", + "to": "uPSR_classes" + }, + { + "from": "fMain", + "to": "fDwin" + }, + { + "from": "fDwin", + "to": "SysUtils" + }, + { + "from": "fDwin", + "to": "Classes" + }, + { + "from": "fDwin", + "to": "QGraphics" + }, + { + "from": "fDwin", + "to": "QControls" + }, + { + "from": "fDwin", + "to": "QForms" + }, + { + "from": "fDwin", + "to": "QDialogs" + }, + { + "from": "fDwin", + "to": "QStdCtrls" + }, + { + "from": "fDwin", + "to": "QExtCtrls" + }, + { + "from": "fMain", + "to": "Classes" + }, + { + "from": "fMain", + "to": "QGraphics" + }, + { + "from": "fMain", + "to": "QControls" + }, + { + "from": "fMain", + "to": "QForms" + }, + { + "from": "fMain", + "to": "QDialogs" + }, + { + "from": "fMain", + "to": "uPSCompiler" + }, + { + "from": "fMain", + "to": "uPSRuntime" + }, + { + "from": "fMain", + "to": "uPSUtils" + }, + { + "from": "fMain", + "to": "QMenus" + }, + { + "from": "fMain", + "to": "QTypes" + }, + { + "from": "fMain", + "to": "QStdCtrls" + }, + { + "from": "fMain", + "to": "QExtCtrls" + }, + { + "from": "fMain", + "to": "fDwin" + }, + { + "from": "fMain", + "to": "uPSDisassembly" + }, + { + "from": "fMain", + "to": "uPSC_dll" + }, + { + "from": "fMain", + "to": "uPSR_dll" + }, + { + "from": "fMain", + "to": "Windows" + }, + { + "from": "fMain", + "to": "Messages" + }, + { + "from": "fMain", + "to": "SysUtils" + }, + { + "from": "fMain", + "to": "Classes" + }, + { + "from": "fMain", + "to": "Graphics" + }, + { + "from": "fMain", + "to": "Controls" + }, + { + "from": "fMain", + "to": "Forms" + }, + { + "from": "fMain", + "to": "Dialogs" + }, + { + "from": "fMain", + "to": "ExtCtrls" + }, + { + "from": "fMain", + "to": "StdCtrls" + }, + { + "from": "fMain", + "to": "uPSComponent" + }, + { + "from": "fMain", + "to": "uPSCompiler" + }, + { + "from": "fMain", + "to": "Menus" + }, + { + "from": "fMain", + "to": "uPSRuntime" + }, + { + "from": "fMain", + "to": "uROPSServerLink" + }, + { + "from": "fMain", + "to": "uPSComponent_Default" + }, + { + "from": "fMain", + "to": "uPSR_std" + }, + { + "from": "fMain", + "to": "uPSC_std" + }, + { + "from": "fMain", + "to": "uPSR_stdctrls" + }, + { + "from": "fMain", + "to": "uPSC_stdctrls" + }, + { + "from": "fMain", + "to": "uPSR_forms" + }, + { + "from": "fMain", + "to": "uPSC_forms" + }, + { + "from": "fMain", + "to": "uPSC_graphics" + }, + { + "from": "fMain", + "to": "uPSC_controls" + }, + { + "from": "fMain", + "to": "uPSC_classes" + }, + { + "from": "fMain", + "to": "uPSR_graphics" + }, + { + "from": "fMain", + "to": "uPSR_controls" + }, + { + "from": "fMain", + "to": "uPSR_classes" + }, + { + "from": "fMain", + "to": "Windows" + }, + { + "from": "fMain", + "to": "Messages" + }, + { + "from": "fMain", + "to": "SysUtils" + }, + { + "from": "fMain", + "to": "Classes" + }, + { + "from": "fMain", + "to": "Graphics" + }, + { + "from": "fMain", + "to": "Controls" + }, + { + "from": "fMain", + "to": "Forms" + }, + { + "from": "fMain", + "to": "Dialogs" + }, + { + "from": "fMain", + "to": "ExtCtrls" + }, + { + "from": "fMain", + "to": "StdCtrls" + }, + { + "from": "fMain", + "to": "uPSComponent" + }, + { + "from": "fMain", + "to": "uPSCompiler" + }, + { + "from": "fMain", + "to": "Menus" + }, + { + "from": "fMain", + "to": "uPSRuntime" + }, + { + "from": "fMain", + "to": "Variants" + }, + { + "from": "fMain", + "to": "uPSR_std" + }, + { + "from": "fMain", + "to": "uPSC_std" + }, + { + "from": "fMain", + "to": "uPSR_stdctrls" + }, + { + "from": "fMain", + "to": "uPSC_stdctrls" + }, + { + "from": "fMain", + "to": "uPSR_forms" + }, + { + "from": "fMain", + "to": "uPSC_forms" + }, + { + "from": "fMain", + "to": "uPSC_graphics" + }, + { + "from": "fMain", + "to": "uPSC_controls" + }, + { + "from": "fMain", + "to": "uPSC_classes" + }, + { + "from": "fMain", + "to": "uPSR_graphics" + }, + { + "from": "fMain", + "to": "uPSR_controls" + }, + { + "from": "fMain", + "to": "uPSR_classes" + }, + { + "from": "fMain", + "to": "uPSC_comobj" + }, + { + "from": "fMain", + "to": "uPSR_comobj" + }, + { + "from": "PascalScript_Core_Ext_Reg", + "to": "Classes" + }, + { + "from": "PascalScript_Core_Ext_Reg", + "to": "uPSComponentExt" + }, + { + "from": "PascalScript_Core_Reg", + "to": "Classes" + }, + { + "from": "PascalScript_Core_Reg", + "to": "LResources" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSDebugger" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_Default" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_COM" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_DB" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_Forms" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_Controls" + }, + { + "from": "PascalScript_Core_Reg", + "to": "uPSComponent_StdCtrls" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "Classes" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponentExt" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSDebugger" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent_Default" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent_COM" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent_Forms" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent_Controls" + }, + { + "from": "PascalScript_Core_Reg_noDB", + "to": "uPSComponent_StdCtrls" + }, + { + "from": "uPSI_Dialogs", + "to": "SysUtils" + }, + { + "from": "uPSI_Dialogs", + "to": "Classes" + }, + { + "from": "uPSI_Dialogs", + "to": "uPSComponent" + }, + { + "from": "uPSI_Dialogs", + "to": "uPSCompiler" + }, + { + "from": "uPSI_Dialogs", + "to": "uPSRuntime" + }, + { + "from": "uPSI_Dialogs", + "to": "Windows" + }, + { + "from": "uPSI_Dialogs", + "to": "Messages" + }, + { + "from": "uPSI_Dialogs", + "to": "CommDlg" + }, + { + "from": "uPSI_Dialogs", + "to": "Graphics" + }, + { + "from": "uPSI_Dialogs", + "to": "Controls" + }, + { + "from": "uPSI_Dialogs", + "to": "Forms" + }, + { + "from": "uPSI_Dialogs", + "to": "StdCtrls" + }, + { + "from": "uPSI_Dialogs", + "to": "Dialogs" + }, + { + "from": "uPSI_IBX", + "to": "SysUtils" + }, + { + "from": "uPSI_IBX", + "to": "Classes" + }, + { + "from": "uPSI_IBX", + "to": "uPSComponent" + }, + { + "from": "uPSI_IBX", + "to": "uPSCompiler" + }, + { + "from": "uPSI_IBX", + "to": "uPSRuntime" + }, + { + "from": "uPSI_IBX", + "to": "WINDOWS" + }, + { + "from": "uPSI_IBX", + "to": "CONTROLS" + }, + { + "from": "uPSI_IBX", + "to": "IBEXTERNALS" + }, + { + "from": "uPSI_IBX", + "to": "IB" + }, + { + "from": "uPSI_IBX", + "to": "IBDatabase" + }, + { + "from": "uPSI_IBX", + "to": "IBHEADER" + }, + { + "from": "uPSI_IBX", + "to": "STDVCL" + }, + { + "from": "uPSI_IBX", + "to": "IBSQL" + }, + { + "from": "uPSI_IBX", + "to": "DB" + }, + { + "from": "uPSI_IBX", + "to": "IBUTILS" + }, + { + "from": "uPSI_IBX", + "to": "IBBLOB" + }, + { + "from": "uPSI_IBX", + "to": "IBCustomDataSet" + }, + { + "from": "uPSI_IBX", + "to": "IBTable" + }, + { + "from": "uPSI_IBX", + "to": "IBQuery" + }, + { + "from": "uPSI_JvMail", + "to": "SysUtils" + }, + { + "from": "uPSI_JvMail", + "to": "Classes" + }, + { + "from": "uPSI_JvMail", + "to": "uPSComponent" + }, + { + "from": "uPSI_JvMail", + "to": "uPSCompiler" + }, + { + "from": "uPSI_JvMail", + "to": "uPSRuntime" + }, + { + "from": "uPSI_JvMail", + "to": "Windows" + }, + { + "from": "uPSI_JvMail", + "to": "Controls" + }, + { + "from": "uPSI_JvMail", + "to": "Forms" + }, + { + "from": "uPSI_JvMail", + "to": "Mapi" + }, + { + "from": "uPSI_JvMail", + "to": "JclBase" + }, + { + "from": "uPSI_JvMail", + "to": "JclMapi" + }, + { + "from": "uPSI_JvMail", + "to": "JvComponent" + }, + { + "from": "uPSI_JvMail", + "to": "JvMail" + }, + { + "from": "uPSI_Mask", + "to": "SysUtils" + }, + { + "from": "uPSI_Mask", + "to": "Classes" + }, + { + "from": "uPSI_Mask", + "to": "uPSComponent" + }, + { + "from": "uPSI_Mask", + "to": "uPSCompiler" + }, + { + "from": "uPSI_Mask", + "to": "uPSRuntime" + }, + { + "from": "uPSI_Mask", + "to": "Windows" + }, + { + "from": "uPSI_Mask", + "to": "StdCtrls" + }, + { + "from": "uPSI_Mask", + "to": "Controls" + }, + { + "from": "uPSI_Mask", + "to": "Messages" + }, + { + "from": "uPSI_Mask", + "to": "Forms" + }, + { + "from": "uPSI_Mask", + "to": "Graphics" + }, + { + "from": "uPSI_Mask", + "to": "Menus" + }, + { + "from": "uPSI_Mask", + "to": "Mask" + }, + { + "from": "uPSI_Mask", + "to": "MaskUtils" + }, + { + "from": "uPSI_Registry", + "to": "SysUtils" + }, + { + "from": "uPSI_Registry", + "to": "Classes" + }, + { + "from": "uPSI_Registry", + "to": "uPSComponent" + }, + { + "from": "uPSI_Registry", + "to": "uPSCompiler" + }, + { + "from": "uPSI_Registry", + "to": "uPSRuntime" + }, + { + "from": "uPSI_Registry", + "to": "Windows" + }, + { + "from": "uPSI_Registry", + "to": "IniFiles" + }, + { + "from": "uPSI_Registry", + "to": "Registry" + }, + { + "from": "uPS_ExtReg", + "to": "classes" + }, + { + "from": "uPS_ExtReg", + "to": "uPSI_IBX" + }, + { + "from": "uPS_ExtReg", + "to": "uPSI_Mask" + }, + { + "from": "uPS_ExtReg", + "to": "upSI_JvMail" + }, + { + "from": "uPS_ExtReg", + "to": "uPSI_Dialogs" + }, + { + "from": "uPS_ExtReg", + "to": "uPSI_Registry" + }, + { + "from": "PascalScript", + "to": "uPSRuntime" + }, + { + "from": "PascalScript", + "to": "PascalScript_Core_Reg" + }, + { + "from": "PascalScript", + "to": "uPSC_buttons" + }, + { + "from": "PascalScript", + "to": "uPSC_classes" + }, + { + "from": "PascalScript", + "to": "uPSC_controls" + }, + { + "from": "PascalScript", + "to": "uPSC_dateutils" + }, + { + "from": "PascalScript", + "to": "uPSC_DB" + }, + { + "from": "PascalScript", + "to": "uPSC_dll" + }, + { + "from": "PascalScript", + "to": "uPSC_extctrls" + }, + { + "from": "PascalScript", + "to": "uPSC_forms" + }, + { + "from": "PascalScript", + "to": "uPSC_graphics" + }, + { + "from": "PascalScript", + "to": "uPSC_menus" + }, + { + "from": "PascalScript", + "to": "uPSC_std" + }, + { + "from": "PascalScript", + "to": "uPSC_stdctrls" + }, + { + "from": "PascalScript", + "to": "uPSCompiler" + }, + { + "from": "PascalScript", + "to": "uPSComponent" + }, + { + "from": "PascalScript", + "to": "uPSComponent_Controls" + }, + { + "from": "PascalScript", + "to": "uPSComponent_DB" + }, + { + "from": "PascalScript", + "to": "uPSComponent_Default" + }, + { + "from": "PascalScript", + "to": "uPSComponent_Forms" + }, + { + "from": "PascalScript", + "to": "uPSComponent_StdCtrls" + }, + { + "from": "PascalScript", + "to": "uPSComponentExt" + }, + { + "from": "PascalScript", + "to": "uPSDebugger" + }, + { + "from": "PascalScript", + "to": "uPSDisassembly" + }, + { + "from": "PascalScript", + "to": "uPSPreProcessor" + }, + { + "from": "PascalScript", + "to": "uPSR_buttons" + }, + { + "from": "PascalScript", + "to": "uPSR_classes" + }, + { + "from": "PascalScript", + "to": "uPSR_controls" + }, + { + "from": "PascalScript", + "to": "uPSR_dateutils" + }, + { + "from": "PascalScript", + "to": "uPSR_DB" + }, + { + "from": "PascalScript", + "to": "uPSR_dll" + }, + { + "from": "PascalScript", + "to": "uPSR_extctrls" + }, + { + "from": "PascalScript", + "to": "uPSR_forms" + }, + { + "from": "PascalScript", + "to": "uPSR_graphics" + }, + { + "from": "PascalScript", + "to": "uPSR_menus" + }, + { + "from": "PascalScript", + "to": "uPSR_std" + }, + { + "from": "PascalScript", + "to": "uPSR_stdctrls" + }, + { + "from": "PascalScript", + "to": "uPSUtils" + }, + { + "from": "PascalScript", + "to": "uPSComponent_COM" + }, + { + "from": "PascalScript", + "to": "uPSC_comobj" + }, + { + "from": "PascalScript", + "to": "uPSR_comobj" + }, + { + "from": "PascalScript", + "to": "LazarusPackageIntf" + }, + { + "from": "uPSC_DB", + "to": "uPSCompiler" + }, + { + "from": "uPSC_DB", + "to": "Sysutils" + }, + { + "from": "uPSC_buttons", + "to": "uPSCompiler" + }, + { + "from": "uPSC_buttons", + "to": "uPSUtils" + }, + { + "from": "uPSC_classes", + "to": "uPSCompiler" + }, + { + "from": "uPSC_classes", + "to": "uPSUtils" + }, + { + "from": "uPSC_comobj", + "to": "uPSCompiler" + }, + { + "from": "uPSC_comobj", + "to": "uPSUtils" + }, + { + "from": "uPSC_controls", + "to": "uPSCompiler" + }, + { + "from": "uPSC_controls", + "to": "uPSUtils" + }, + { + "from": "uPSC_dateutils", + "to": "SysUtils" + }, + { + "from": "uPSC_dateutils", + "to": "uPSCompiler" + }, + { + "from": "uPSC_dateutils", + "to": "uPSUtils" + }, + { + "from": "uPSC_dll", + "to": "uPSCompiler" + }, + { + "from": "uPSC_dll", + "to": "uPSUtils" + }, + { + "from": "uPSC_extctrls", + "to": "uPSCompiler" + }, + { + "from": "uPSC_extctrls", + "to": "uPSUtils" + }, + { + "from": "uPSC_forms", + "to": "uPSCompiler" + }, + { + "from": "uPSC_forms", + "to": "uPSUtils" + }, + { + "from": "uPSC_graphics", + "to": "uPSCompiler" + }, + { + "from": "uPSC_graphics", + "to": "uPSUtils" + }, + { + "from": "uPSC_graphics", + "to": "QGraphics" + }, + { + "from": "uPSC_graphics", + "to": "Windows" + }, + { + "from": "uPSC_menus", + "to": "uPSCompiler" + }, + { + "from": "uPSC_std", + "to": "uPSCompiler" + }, + { + "from": "uPSC_std", + "to": "uPSUtils" + }, + { + "from": "uPSC_stdctrls", + "to": "uPSCompiler" + }, + { + "from": "uPSC_stdctrls", + "to": "uPSUtils" + }, + { + "from": "uPSCompiler", + "to": "Windows" + }, + { + "from": "uPSCompiler", + "to": "Ole2" + }, + { + "from": "uPSCompiler", + "to": "SysUtils" + }, + { + "from": "uPSCompiler", + "to": "uPSUtils" + }, + { + "from": "uPSCompiler", + "to": "ComObj" + }, + { + "from": "uPSCompiler", + "to": "ComObj" + }, + { + "from": "uPSCompiler", + "to": "Classes" + }, + { + "from": "uPSCompiler", + "to": "typInfo" + }, + { + "from": "uPSComponent", + "to": "SysUtils" + }, + { + "from": "uPSComponent", + "to": "Classes" + }, + { + "from": "uPSComponent", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent", + "to": "uPSDebugger" + }, + { + "from": "uPSComponent", + "to": "uPSUtils" + }, + { + "from": "uPSComponent", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent", + "to": "uPSC_dll" + }, + { + "from": "uPSComponent", + "to": "uPSR_dll" + }, + { + "from": "uPSComponent", + "to": "uPSPreProcessor" + }, + { + "from": "uPSComponentExt", + "to": "Windows" + }, + { + "from": "uPSComponentExt", + "to": "SysUtils" + }, + { + "from": "uPSComponentExt", + "to": "Classes" + }, + { + "from": "uPSComponentExt", + "to": "uPSRuntime" + }, + { + "from": "uPSComponentExt", + "to": "uPSDebugger" + }, + { + "from": "uPSComponentExt", + "to": "uPSUtils" + }, + { + "from": "uPSComponentExt", + "to": "uPSComponent" + }, + { + "from": "uPSComponentExt", + "to": "contnrs" + }, + { + "from": "uPSComponentExt", + "to": "uPSCompiler" + }, + { + "from": "uPSComponentExt", + "to": "uPSC_dll" + }, + { + "from": "uPSComponentExt", + "to": "uPSR_dll" + }, + { + "from": "uPSComponentExt", + "to": "uPSPreProcessor" + }, + { + "from": "uPSComponentExt", + "to": "typInfo" + }, + { + "from": "uPSComponent_COM", + "to": "SysUtils" + }, + { + "from": "uPSComponent_COM", + "to": "Classes" + }, + { + "from": "uPSComponent_COM", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_COM", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_COM", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_COM", + "to": "uPSC_comobj" + }, + { + "from": "uPSComponent_COM", + "to": "uPSR_comobj" + }, + { + "from": "uPSComponent_Controls", + "to": "SysUtils" + }, + { + "from": "uPSComponent_Controls", + "to": "Classes" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSC_graphics" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSC_controls" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSR_graphics" + }, + { + "from": "uPSComponent_Controls", + "to": "uPSR_controls" + }, + { + "from": "uPSComponent_DB", + "to": "SysUtils" + }, + { + "from": "uPSComponent_DB", + "to": "Classes" + }, + { + "from": "uPSComponent_DB", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_DB", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_DB", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_DB", + "to": "uPSC_DB" + }, + { + "from": "uPSComponent_DB", + "to": "uPSR_DB" + }, + { + "from": "uPSComponent_Default", + "to": "SysUtils" + }, + { + "from": "uPSComponent_Default", + "to": "Classes" + }, + { + "from": "uPSComponent_Default", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_Default", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_Default", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_Default", + "to": "uPSC_std" + }, + { + "from": "uPSComponent_Default", + "to": "uPSR_std" + }, + { + "from": "uPSComponent_Default", + "to": "uPSC_classes" + }, + { + "from": "uPSComponent_Default", + "to": "uPSR_classes" + }, + { + "from": "uPSComponent_Default", + "to": "uPSC_dateutils" + }, + { + "from": "uPSComponent_Default", + "to": "uPSR_dateutils" + }, + { + "from": "uPSComponent_Forms", + "to": "SysUtils" + }, + { + "from": "uPSComponent_Forms", + "to": "Classes" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSC_forms" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSC_menus" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSR_forms" + }, + { + "from": "uPSComponent_Forms", + "to": "uPSR_menus" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "SysUtils" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "Classes" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSComponent" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSCompiler" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSRuntime" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSC_buttons" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSC_stdctrls" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSC_extctrls" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSR_buttons" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSR_stdctrls" + }, + { + "from": "uPSComponent_StdCtrls", + "to": "uPSR_extctrls" + }, + { + "from": "uPSDebugger", + "to": "SysUtils" + }, + { + "from": "uPSDebugger", + "to": "uPSRuntime" + }, + { + "from": "uPSDebugger", + "to": "uPSUtils" + }, + { + "from": "uPSDisassembly", + "to": "uPSRuntime" + }, + { + "from": "uPSDisassembly", + "to": "uPSUtils" + }, + { + "from": "uPSDisassembly", + "to": "sysutils" + }, + { + "from": "uPSPreProcessor", + "to": "Classes" + }, + { + "from": "uPSPreProcessor", + "to": "SysUtils" + }, + { + "from": "uPSPreProcessor", + "to": "uPSCompiler" + }, + { + "from": "uPSPreProcessor", + "to": "uPSUtils" + }, + { + "from": "uPSR_DB", + "to": "uPSRuntime" + }, + { + "from": "uPSR_DB", + "to": "uPSUtils" + }, + { + "from": "uPSR_DB", + "to": "SysUtils" + }, + { + "from": "uPSR_DB", + "to": "DB" + }, + { + "from": "uPSR_DB", + "to": "FMTBcd" + }, + { + "from": "uPSR_DB", + "to": "MaskUtils" + }, + { + "from": "uPSR_DB", + "to": "Classes" + }, + { + "from": "uPSR_buttons", + "to": "uPSRuntime" + }, + { + "from": "uPSR_buttons", + "to": "uPSUtils" + }, + { + "from": "uPSR_buttons", + "to": "Classes" + }, + { + "from": "uPSR_buttons", + "to": "QControls" + }, + { + "from": "uPSR_buttons", + "to": "QButtons" + }, + { + "from": "uPSR_buttons", + "to": "Controls" + }, + { + "from": "uPSR_buttons", + "to": "Buttons" + }, + { + "from": "uPSR_classes", + "to": "uPSRuntime" + }, + { + "from": "uPSR_classes", + "to": "uPSUtils" + }, + { + "from": "uPSR_classes", + "to": "Classes" + }, + { + "from": "uPSR_comobj", + "to": "uPSRuntime" + }, + { + "from": "uPSR_comobj", + "to": "uPSUtils" + }, + { + "from": "uPSR_comobj", + "to": "SysUtils" + }, + { + "from": "uPSR_comobj", + "to": "ComObj" + }, + { + "from": "uPSR_comobj", + "to": "ComObj" + }, + { + "from": "uPSR_comobj", + "to": "SysUtils" + }, + { + "from": "uPSR_comobj", + "to": "Ole2" + }, + { + "from": "uPSR_controls", + "to": "uPSRuntime" + }, + { + "from": "uPSR_controls", + "to": "uPSUtils" + }, + { + "from": "uPSR_controls", + "to": "Classes" + }, + { + "from": "uPSR_controls", + "to": "QControls" + }, + { + "from": "uPSR_controls", + "to": "QGraphics" + }, + { + "from": "uPSR_controls", + "to": "Controls" + }, + { + "from": "uPSR_controls", + "to": "Graphics" + }, + { + "from": "uPSR_controls", + "to": "Windows" + }, + { + "from": "uPSR_controls", + "to": "Classes" + }, + { + "from": "uPSR_controls", + "to": "Controls" + }, + { + "from": "uPSR_controls", + "to": "Graphics" + }, + { + "from": "uPSR_dateutils", + "to": "SysUtils" + }, + { + "from": "uPSR_dateutils", + "to": "uPSRuntime" + }, + { + "from": "uPSR_dll", + "to": "uPSRuntime" + }, + { + "from": "uPSR_dll", + "to": "uPSUtils" + }, + { + "from": "uPSR_dll", + "to": "Unix" + }, + { + "from": "uPSR_dll", + "to": "baseunix" + }, + { + "from": "uPSR_dll", + "to": "dynlibs" + }, + { + "from": "uPSR_dll", + "to": "termio" + }, + { + "from": "uPSR_dll", + "to": "sockets" + }, + { + "from": "uPSR_extctrls", + "to": "uPSRuntime" + }, + { + "from": "uPSR_extctrls", + "to": "uPSUtils" + }, + { + "from": "uPSR_extctrls", + "to": "QExtCtrls" + }, + { + "from": "uPSR_extctrls", + "to": "QGraphics" + }, + { + "from": "uPSR_forms", + "to": "uPSRuntime" + }, + { + "from": "uPSR_forms", + "to": "uPSUtils" + }, + { + "from": "uPSR_forms", + "to": "sysutils" + }, + { + "from": "uPSR_forms", + "to": "classes" + }, + { + "from": "uPSR_forms", + "to": "QControls" + }, + { + "from": "uPSR_forms", + "to": "QForms" + }, + { + "from": "uPSR_forms", + "to": "QGraphics" + }, + { + "from": "uPSR_forms", + "to": "Forms" + }, + { + "from": "uPSR_forms", + "to": "Graphics" + }, + { + "from": "uPSR_graphics", + "to": "uPSRuntime" + }, + { + "from": "uPSR_graphics", + "to": "uPSUtils" + }, + { + "from": "uPSR_graphics", + "to": "Classes" + }, + { + "from": "uPSR_graphics", + "to": "QGraphics" + }, + { + "from": "uPSR_graphics", + "to": "Windows" + }, + { + "from": "uPSR_graphics", + "to": "Graphics" + }, + { + "from": "uPSR_graphics", + "to": "UITypes" + }, + { + "from": "uPSR_graphics", + "to": "Classes" + }, + { + "from": "uPSR_graphics", + "to": "Graphics" + }, + { + "from": "uPSR_graphics", + "to": "LCLType" + }, + { + "from": "uPSR_menus", + "to": "uPSRuntime" + }, + { + "from": "uPSR_menus", + "to": "Libc" + }, + { + "from": "uPSR_menus", + "to": "SysUtils" + }, + { + "from": "uPSR_menus", + "to": "Classes" + }, + { + "from": "uPSR_menus", + "to": "QControls" + }, + { + "from": "uPSR_menus", + "to": "QMenus" + }, + { + "from": "uPSR_menus", + "to": "QGraphics" + }, + { + "from": "uPSR_menus", + "to": "SysUtils" + }, + { + "from": "uPSR_menus", + "to": "Classes" + }, + { + "from": "uPSR_menus", + "to": "Controls" + }, + { + "from": "uPSR_menus", + "to": "Menus" + }, + { + "from": "uPSR_menus", + "to": "Graphics" + }, + { + "from": "uPSR_menus", + "to": "LCLType" + }, + { + "from": "uPSR_menus", + "to": "ImgList" + }, + { + "from": "uPSR_menus", + "to": "WINDOWS" + }, + { + "from": "uPSR_menus", + "to": "LCLType" + }, + { + "from": "uPSR_menus", + "to": "SYSUTILS" + }, + { + "from": "uPSR_menus", + "to": "CLASSES" + }, + { + "from": "uPSR_menus", + "to": "CONTNRS" + }, + { + "from": "uPSR_menus", + "to": "MESSAGES" + }, + { + "from": "uPSR_menus", + "to": "GRAPHICS" + }, + { + "from": "uPSR_menus", + "to": "IMGLIST" + }, + { + "from": "uPSR_menus", + "to": "ACTNLIST" + }, + { + "from": "uPSR_menus", + "to": "Menus" + }, + { + "from": "uPSR_std", + "to": "uPSRuntime" + }, + { + "from": "uPSR_std", + "to": "uPSUtils" + }, + { + "from": "uPSR_std", + "to": "Classes" + }, + { + "from": "uPSR_stdctrls", + "to": "uPSRuntime" + }, + { + "from": "uPSR_stdctrls", + "to": "uPSUtils" + }, + { + "from": "uPSR_stdctrls", + "to": "sysutils" + }, + { + "from": "uPSR_stdctrls", + "to": "classes" + }, + { + "from": "uPSR_stdctrls", + "to": "QControls" + }, + { + "from": "uPSR_stdctrls", + "to": "QStdCtrls" + }, + { + "from": "uPSR_stdctrls", + "to": "QGraphics" + }, + { + "from": "uPSR_stdctrls", + "to": "controls" + }, + { + "from": "uPSR_stdctrls", + "to": "stdctrls" + }, + { + "from": "uPSR_stdctrls", + "to": "Graphics" + }, + { + "from": "uPSR_stdctrls", + "to": "buttons" + }, + { + "from": "uPSRuntime", + "to": "System.Rtti" + }, + { + "from": "uPSRuntime", + "to": "Rtti" + }, + { + "from": "uPSRuntime", + "to": "SysUtils" + }, + { + "from": "uPSRuntime", + "to": "uPSUtils" + }, + { + "from": "uPSRuntime", + "to": "variants" + }, + { + "from": "uPSRuntime", + "to": "ActiveX" + }, + { + "from": "uPSRuntime", + "to": "Windows" + }, + { + "from": "uPSRuntime", + "to": "Ole2" + }, + { + "from": "uPSRuntime", + "to": "TypInfo" + }, + { + "from": "uPSRuntime", + "to": "ComObj" + }, + { + "from": "uPSRuntime", + "to": "ComObj" + }, + { + "from": "uPSRuntime", + "to": "AnsiStrings" + }, + { + "from": "uPSUtils", + "to": "Classes" + }, + { + "from": "uPSUtils", + "to": "SysUtils" + }, + { + "from": "uPSUtils", + "to": "Windows" + }, + { + "from": "CompileTestExtended", + "to": "Classes" + }, + { + "from": "CompileTestExtended", + "to": "SysUtils" + }, + { + "from": "CompileTestExtended", + "to": "CompilerTestBase" + }, + { + "from": "CompileTestExtended", + "to": "uPSCompiler" + }, + { + "from": "CompileTestExtended", + "to": "uPSUtils" + }, + { + "from": "CompileTestExtended", + "to": "testregistry" + }, + { + "from": "CompilerTestBase", + "to": "Classes" + }, + { + "from": "CompilerTestBase", + "to": "uPSComponent" + }, + { + "from": "CompilerTestBase", + "to": "uPSCompiler" + }, + { + "from": "CompilerTestBase", + "to": "uPSRuntime" + }, + { + "from": "CompilerTestBase", + "to": "fpcunit" + }, + { + "from": "CompilerTestBase", + "to": "uPSC_std" + }, + { + "from": "CompilerTestBase", + "to": "uPSC_classes" + }, + { + "from": "CompilerTestBase", + "to": "uPSR_std" + }, + { + "from": "CompilerTestBase", + "to": "uPSR_classes" + }, + { + "from": "CompilerTestBase", + "to": "StrUtils" + }, + { + "from": "CompilerTestBase", + "to": "SysUtils" + }, + { + "from": "CompilerTestBase", + "to": "Math" + }, + { + "from": "CompilerTestBase", + "to": "Dialogs" + }, + { + "from": "CompilerTestFunctions", + "to": "Classes" + }, + { + "from": "CompilerTestFunctions", + "to": "CompilerTestBase" + }, + { + "from": "CompilerTestFunctions", + "to": "uPSComponent" + }, + { + "from": "CompilerTestFunctions", + "to": "testregistry" + }, + { + "from": "CompilerTestFunctions", + "to": "StrUtils" + }, + { + "from": "CompilerTestFunctions", + "to": "SysUtils" + }, + { + "from": "CompilerTestFunctions", + "to": "Math" + }, + { + "from": "CompilerTestFunctions", + "to": "Dialogs" + }, + { + "from": "CompilerTestSimple", + "to": "Classes" + }, + { + "from": "CompilerTestSimple", + "to": "CompilerTestBase" + }, + { + "from": "CompilerTestSimple", + "to": "uPSCompiler" + }, + { + "from": "CompilerTestSimple", + "to": "testregistry" + }, + { + "from": "CompilerTestSimple", + "to": "StrUtils" + }, + { + "from": "CompilerTestSimple", + "to": "SysUtils" + }, + { + "from": "CompilerTestSimple", + "to": "Math" + }, + { + "from": "CompilerTestSimple", + "to": "Dialogs" + }, + { + "from": "FormSettings", + "to": "Windows" + }, + { + "from": "FormSettings", + "to": "Messages" + }, + { + "from": "FormSettings", + "to": "SysUtils" + }, + { + "from": "FormSettings", + "to": "Classes" + }, + { + "from": "FormSettings", + "to": "Graphics" + }, + { + "from": "FormSettings", + "to": "Controls" + }, + { + "from": "FormSettings", + "to": "Forms" + }, + { + "from": "FormSettings", + "to": "Dialogs" + }, + { + "from": "FormSettings", + "to": "StdCtrls" + }, + { + "from": "FormSettings", + "to": "ExtCtrls" + }, + { + "from": "FormSettings", + "to": "FileCtrl" + }, + { + "from": "Extendedreg", + "to": "classes" + }, + { + "from": "Extendedreg", + "to": "IFSI_IBX" + }, + { + "from": "Extendedreg", + "to": "IFSI_JvMail" + }, + { + "from": "Extendedreg", + "to": "IFSI_Dialogs" + }, + { + "from": "Extendedreg", + "to": "IFSI_Registry" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "ifps3" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Windows" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Messages" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "SysUtils" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "CommDlg" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Classes" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Graphics" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Controls" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Forms" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "StdCtrls" + }, + { + "from": "IFSIR_Dialogs.pas", + "to": "Dialogs" + }, + { + "from": "IFSI_BigIni", + "to": "SysUtils" + }, + { + "from": "IFSI_BigIni", + "to": "Classes" + }, + { + "from": "IFSI_BigIni", + "to": "uPSComponent" + }, + { + "from": "IFSI_BigIni", + "to": "uPSRuntime" + }, + { + "from": "IFSI_BigIni", + "to": "uPSCompiler" + }, + { + "from": "IFSI_BigIni", + "to": "BigIni" + }, + { + "from": "IFSI_Dialogs", + "to": "SysUtils" + }, + { + "from": "IFSI_Dialogs", + "to": "Classes" + }, + { + "from": "IFSI_Dialogs", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_Dialogs", + "to": "ifpscomp" + }, + { + "from": "IFSI_Dialogs", + "to": "ifps3" + }, + { + "from": "IFSI_Dialogs", + "to": "Windows" + }, + { + "from": "IFSI_Dialogs", + "to": "Messages" + }, + { + "from": "IFSI_Dialogs", + "to": "CommDlg" + }, + { + "from": "IFSI_Dialogs", + "to": "Graphics" + }, + { + "from": "IFSI_Dialogs", + "to": "Controls" + }, + { + "from": "IFSI_Dialogs", + "to": "Forms" + }, + { + "from": "IFSI_Dialogs", + "to": "StdCtrls" + }, + { + "from": "IFSI_Dialogs", + "to": "Dialogs" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "SysUtils" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "Classes" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "ifps3" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "WINDOWS" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "CONTROLS" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBEXTERNALS" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IB" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBHEADER" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "STDVCL" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBDATABASE" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBSQL" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "DB" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBUTILS" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBBLOB" + }, + { + "from": "IFSI_IBCustomDataSet", + "to": "IBCustomDataSet" + }, + { + "from": "IFSI_IBDatabase", + "to": "SysUtils" + }, + { + "from": "IFSI_IBDatabase", + "to": "Classes" + }, + { + "from": "IFSI_IBDatabase", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBDatabase", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBDatabase", + "to": "ifps3" + }, + { + "from": "IFSI_IBDatabase", + "to": "WINDOWS" + }, + { + "from": "IFSI_IBDatabase", + "to": "DIALOGS" + }, + { + "from": "IFSI_IBDatabase", + "to": "CONTROLS" + }, + { + "from": "IFSI_IBDatabase", + "to": "STDCTRLS" + }, + { + "from": "IFSI_IBDatabase", + "to": "FORMS" + }, + { + "from": "IFSI_IBDatabase", + "to": "EXTCTRLS" + }, + { + "from": "IFSI_IBDatabase", + "to": "IBHEADER" + }, + { + "from": "IFSI_IBDatabase", + "to": "IBEXTERNALS" + }, + { + "from": "IFSI_IBDatabase", + "to": "DB" + }, + { + "from": "IFSI_IBDatabase", + "to": "IB" + }, + { + "from": "IFSI_IBDatabase", + "to": "IBDatabase" + }, + { + "from": "IFSI_IBQuery", + "to": "SysUtils" + }, + { + "from": "IFSI_IBQuery", + "to": "Classes" + }, + { + "from": "IFSI_IBQuery", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBQuery", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBQuery", + "to": "ifps3" + }, + { + "from": "IFSI_IBQuery", + "to": "DB" + }, + { + "from": "IFSI_IBQuery", + "to": "IBHeader" + }, + { + "from": "IFSI_IBQuery", + "to": "IB" + }, + { + "from": "IFSI_IBQuery", + "to": "IBDatabase" + }, + { + "from": "IFSI_IBQuery", + "to": "IBCustomDataSet" + }, + { + "from": "IFSI_IBQuery", + "to": "IBSQL" + }, + { + "from": "IFSI_IBQuery", + "to": "IBQuery" + }, + { + "from": "IFSI_IBSQL", + "to": "SysUtils" + }, + { + "from": "IFSI_IBSQL", + "to": "Classes" + }, + { + "from": "IFSI_IBSQL", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBSQL", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBSQL", + "to": "ifps3" + }, + { + "from": "IFSI_IBSQL", + "to": "WINDOWS" + }, + { + "from": "IFSI_IBSQL", + "to": "FORMS" + }, + { + "from": "IFSI_IBSQL", + "to": "CONTROLS" + }, + { + "from": "IFSI_IBSQL", + "to": "IBHEADER" + }, + { + "from": "IFSI_IBSQL", + "to": "IBERRORCODES" + }, + { + "from": "IFSI_IBSQL", + "to": "IBEXTERNALS" + }, + { + "from": "IFSI_IBSQL", + "to": "DB" + }, + { + "from": "IFSI_IBSQL", + "to": "IB" + }, + { + "from": "IFSI_IBSQL", + "to": "IBDATABASE" + }, + { + "from": "IFSI_IBSQL", + "to": "IBUTILS" + }, + { + "from": "IFSI_IBSQL", + "to": "IBXCONST" + }, + { + "from": "IFSI_IBSQL", + "to": "IBSQL" + }, + { + "from": "IFSI_IBTable", + "to": "SysUtils" + }, + { + "from": "IFSI_IBTable", + "to": "Classes" + }, + { + "from": "IFSI_IBTable", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBTable", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBTable", + "to": "ifps3" + }, + { + "from": "IFSI_IBTable", + "to": "DB" + }, + { + "from": "IFSI_IBTable", + "to": "IB" + }, + { + "from": "IFSI_IBTable", + "to": "IBDATABASE" + }, + { + "from": "IFSI_IBTable", + "to": "IBCUSTOMDATASET" + }, + { + "from": "IFSI_IBTable", + "to": "IBHEADER" + }, + { + "from": "IFSI_IBTable", + "to": "IBSQL" + }, + { + "from": "IFSI_IBTable", + "to": "IBUTILS" + }, + { + "from": "IFSI_IBTable", + "to": "IBTable" + }, + { + "from": "IFSI_IBX", + "to": "SysUtils" + }, + { + "from": "IFSI_IBX", + "to": "Classes" + }, + { + "from": "IFSI_IBX", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IBX", + "to": "ifpscomp" + }, + { + "from": "IFSI_IBX", + "to": "ifps3" + }, + { + "from": "IFSI_IBX", + "to": "WINDOWS" + }, + { + "from": "IFSI_IBX", + "to": "CONTROLS" + }, + { + "from": "IFSI_IBX", + "to": "IBEXTERNALS" + }, + { + "from": "IFSI_IBX", + "to": "IB" + }, + { + "from": "IFSI_IBX", + "to": "IBDatabase" + }, + { + "from": "IFSI_IBX", + "to": "IBHEADER" + }, + { + "from": "IFSI_IBX", + "to": "STDVCL" + }, + { + "from": "IFSI_IBX", + "to": "IBSQL" + }, + { + "from": "IFSI_IBX", + "to": "DB" + }, + { + "from": "IFSI_IBX", + "to": "IBUTILS" + }, + { + "from": "IFSI_IBX", + "to": "IBBLOB" + }, + { + "from": "IFSI_IBX", + "to": "IBCustomDataSet" + }, + { + "from": "IFSI_IBX", + "to": "IBTable" + }, + { + "from": "IFSI_IBX", + "to": "IBQuery" + }, + { + "from": "IFSI_IBXreg", + "to": "classes" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_IBX" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_lumSystem" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_ImpExpStruct" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_JvMail" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_Dialogs" + }, + { + "from": "IFSI_IBXreg", + "to": "IFSI_Registry" + }, + { + "from": "IFSI_IniFiles", + "to": "SysUtils" + }, + { + "from": "IFSI_IniFiles", + "to": "Classes" + }, + { + "from": "IFSI_IniFiles", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_IniFiles", + "to": "ifpscomp" + }, + { + "from": "IFSI_IniFiles", + "to": "ifps3" + }, + { + "from": "IFSI_IniFiles", + "to": "Windows" + }, + { + "from": "IFSI_IniFiles", + "to": "IniFiles" + }, + { + "from": "IFSI_JvMail", + "to": "SysUtils" + }, + { + "from": "IFSI_JvMail", + "to": "Classes" + }, + { + "from": "IFSI_JvMail", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_JvMail", + "to": "ifpscomp" + }, + { + "from": "IFSI_JvMail", + "to": "ifps3" + }, + { + "from": "IFSI_JvMail", + "to": "Windows" + }, + { + "from": "IFSI_JvMail", + "to": "Controls" + }, + { + "from": "IFSI_JvMail", + "to": "Forms" + }, + { + "from": "IFSI_JvMail", + "to": "Mapi" + }, + { + "from": "IFSI_JvMail", + "to": "JclBase" + }, + { + "from": "IFSI_JvMail", + "to": "JclMapi" + }, + { + "from": "IFSI_JvMail", + "to": "JvComponent" + }, + { + "from": "IFSI_JvMail", + "to": "JvMail" + }, + { + "from": "IFSI_Registry", + "to": "SysUtils" + }, + { + "from": "IFSI_Registry", + "to": "Classes" + }, + { + "from": "IFSI_Registry", + "to": "IFPS3CompExec" + }, + { + "from": "IFSI_Registry", + "to": "ifpscomp" + }, + { + "from": "IFSI_Registry", + "to": "ifps3" + }, + { + "from": "IFSI_Registry", + "to": "Windows" + }, + { + "from": "IFSI_Registry", + "to": "IniFiles" + }, + { + "from": "IFSI_Registry", + "to": "Registry" + }, + { + "from": "Main", + "to": "Windows" + }, + { + "from": "Main", + "to": "Messages" + }, + { + "from": "Main", + "to": "SysUtils" + }, + { + "from": "Main", + "to": "Classes" + }, + { + "from": "Main", + "to": "Graphics" + }, + { + "from": "Main", + "to": "Controls" + }, + { + "from": "Main", + "to": "Forms" + }, + { + "from": "Main", + "to": "Dialogs" + }, + { + "from": "Main", + "to": "SynEditHighlighter" + }, + { + "from": "Main", + "to": "SynHighlighterPas" + }, + { + "from": "Main", + "to": "SynEdit" + }, + { + "from": "Main", + "to": "Menus" + }, + { + "from": "Main", + "to": "ExtCtrls" + }, + { + "from": "Main", + "to": "StdCtrls" + }, + { + "from": "Main", + "to": "SynEditMiscClasses" + }, + { + "from": "Main", + "to": "inifiles" + }, + { + "from": "Main", + "to": "ComCtrls" + }, + { + "from": "Main", + "to": "ImgList" + }, + { + "from": "Main", + "to": "ToolWin" + }, + { + "from": "Main", + "to": "SynEditSearch" + }, + { + "from": "Main", + "to": "SynEditTypes" + }, + { + "from": "Main", + "to": "ParserU" + }, + { + "from": "Main", + "to": "FormSettings" + }, + { + "from": "Main", + "to": "StrUtils" + }, + { + "from": "Main", + "to": "UFrmGotoLine" + }, + { + "from": "ParserU", + "to": "uPSUtils" + }, + { + "from": "ParserU", + "to": "SysUtils" + }, + { + "from": "ParserU", + "to": "StrUtils" + }, + { + "from": "ParserU", + "to": "ParserUtils" + }, + { + "from": "ParserU", + "to": "BigIni" + }, + { + "from": "ParserU", + "to": "Classes" + }, + { + "from": "ParserUtils", + "to": "uPSUtils" + }, + { + "from": "ParserUtils", + "to": "SysUtils" + }, + { + "from": "ParserUtils", + "to": "Classes" + }, + { + "from": "uFrmGotoLine", + "to": "Windows" + }, + { + "from": "uFrmGotoLine", + "to": "Messages" + }, + { + "from": "uFrmGotoLine", + "to": "SysUtils" + }, + { + "from": "uFrmGotoLine", + "to": "Variants" + }, + { + "from": "uFrmGotoLine", + "to": "Classes" + }, + { + "from": "uFrmGotoLine", + "to": "Graphics" + }, + { + "from": "uFrmGotoLine", + "to": "Controls" + }, + { + "from": "uFrmGotoLine", + "to": "Forms" + }, + { + "from": "uFrmGotoLine", + "to": "Dialogs" + }, + { + "from": "uFrmGotoLine", + "to": "StdCtrls" + }, + { + "from": "uFrmGotoLine", + "to": "SynEditTypes" + }, + { + "from": "BigIni", + "to": "Classes" + }, + { + "from": "BigIni", + "to": "Windows" + }, + { + "from": "BigIni", + "to": "SysUtils" + }, + { + "from": "KM_FormLoading", + "to": "Classes" + }, + { + "from": "KM_FormLoading", + "to": "LResources" + }, + { + "from": "KM_FormLoading", + "to": "Forms" + }, + { + "from": "KM_FormLoading", + "to": "Controls" + }, + { + "from": "KM_FormLoading", + "to": "ComCtrls" + }, + { + "from": "KM_FormLoading", + "to": "ExtCtrls" + }, + { + "from": "KM_FormLoading", + "to": "StdCtrls" + }, + { + "from": "KM_FormLoading", + "to": "Graphics" + }, + { + "from": "KM_FormLogistics", + "to": "LResources" + }, + { + "from": "KM_FormLogistics", + "to": "Windows" + }, + { + "from": "KM_FormLogistics", + "to": "Messages" + }, + { + "from": "KM_FormLogistics", + "to": "LCLIntf" + }, + { + "from": "KM_FormLogistics", + "to": "LCLType" + }, + { + "from": "KM_FormLogistics", + "to": "VirtualTrees" + }, + { + "from": "KM_FormLogistics", + "to": "SysUtils" + }, + { + "from": "KM_FormLogistics", + "to": "Variants" + }, + { + "from": "KM_FormLogistics", + "to": "Classes" + }, + { + "from": "KM_FormLogistics", + "to": "Graphics" + }, + { + "from": "KM_FormLogistics", + "to": "Controls" + }, + { + "from": "KM_FormLogistics", + "to": "Forms" + }, + { + "from": "KM_FormLogistics", + "to": "Dialogs" + }, + { + "from": "KM_FormLogistics", + "to": "ComCtrls" + }, + { + "from": "KM_FormLogistics", + "to": "StdCtrls" + }, + { + "from": "KM_FormLogistics", + "to": "ExtCtrls" + }, + { + "from": "KM_FormLogistics", + "to": "CheckLst" + }, + { + "from": "KM_FormLogistics", + "to": "Spin" + }, + { + "from": "KM_FormLogistics", + "to": "Clipbrd" + }, + { + "from": "KM_FormLogistics", + "to": "Math" + }, + { + "from": "KM_FormLogistics", + "to": "TypInfo" + }, + { + "from": "KM_FormLogistics", + "to": "KM_Entity" + }, + { + "from": "KM_FormLogistics", + "to": "KM_GameApp" + }, + { + "from": "KM_FormLogistics", + "to": "KM_HandEntity" + }, + { + "from": "KM_FormLogistics", + "to": "KM_Hand" + }, + { + "from": "KM_FormLogistics", + "to": "KM_HandLogistics" + }, + { + "from": "KM_FormLogistics", + "to": "KM_HandsCollection" + }, + { + "from": "KM_FormLogistics", + "to": "KM_HandTypes" + }, + { + "from": "KM_FormLogistics", + "to": "KM_Resource" + }, + { + "from": "KM_FormLogistics", + "to": "KM_ResWares" + }, + { + "from": "KM_FormLogistics", + "to": "KM_ResUnits" + }, + { + "from": "KM_FormLogistics", + "to": "KM_ResHouses" + }, + { + "from": "KM_FormLogistics", + "to": "KM_ResTypes" + }, + { + "from": "KM_FormLogistics", + "to": "KM_Defaults" + }, + { + "from": "KM_FormMain", + "to": "Classes" + }, + { + "from": "KM_FormMain", + "to": "ComCtrls" + }, + { + "from": "KM_FormMain", + "to": "Controls" + }, + { + "from": "KM_FormMain", + "to": "Buttons" + }, + { + "from": "KM_FormMain", + "to": "Dialogs" + }, + { + "from": "KM_FormMain", + "to": "ExtCtrls" + }, + { + "from": "KM_FormMain", + "to": "Forms" + }, + { + "from": "KM_FormMain", + "to": "Graphics" + }, + { + "from": "KM_FormMain", + "to": "Menus" + }, + { + "from": "KM_FormMain", + "to": "StdCtrls" + }, + { + "from": "KM_FormMain", + "to": "KM_RenderControl" + }, + { + "from": "KM_FormMain", + "to": "KM_CommonTypes" + }, + { + "from": "KM_FormMain", + "to": "KM_WindowParams" + }, + { + "from": "KM_FormMain", + "to": "KM_SettingsDev" + }, + { + "from": "KM_FormMain", + "to": "KM_GameTypes" + }, + { + "from": "KM_FormMain", + "to": "KM_Defaults" + }, + { + "from": "KM_FormMain", + "to": "KM_ResExporter" + }, + { + "from": "KM_FormMain", + "to": "LResources" + }, + { + "from": "KM_FormMain", + "to": "Spin" + }, + { + "from": "KM_FormMain", + "to": "Vcl.Samples.Spin" + }, + { + "from": "KM_FormMain", + "to": "KM_VclMenuHint" + }, + { + "from": "KM_FormMain", + "to": "ShellAPI" + }, + { + "from": "KM_FormMain", + "to": "Windows" + }, + { + "from": "KM_FormMain", + "to": "Messages" + }, + { + "from": "KM_FormMain", + "to": "SysUtils" + }, + { + "from": "KM_FormMain", + "to": "StrUtils" + }, + { + "from": "KM_FormMain", + "to": "Math" + }, + { + "from": "KM_FormMain", + "to": "UITypes" + }, + { + "from": "KM_FormMain", + "to": "FastMM4" + }, + { + "from": "KM_FormMain", + "to": "TypInfo" + }, + { + "from": "KM_FormMain", + "to": "KromUtils" + }, + { + "from": "KM_FormMain", + "to": "KromShellUtils" + }, + { + "from": "KM_FormMain", + "to": "KM_Main" + }, + { + "from": "KM_FormMain", + "to": "KM_Resource" + }, + { + "from": "KM_FormMain", + "to": "KM_ResTexts" + }, + { + "from": "KM_FormMain", + "to": "KM_GameApp" + }, + { + "from": "KM_FormMain", + "to": "KM_GameParams" + }, + { + "from": "KM_FormMain", + "to": "KM_HandsCollection" + }, + { + "from": "KM_FormMain", + "to": "KM_ResSound" + }, + { + "from": "KM_FormMain", + "to": "KM_Pics" + }, + { + "from": "KM_FormMain", + "to": "KM_RenderPool" + }, + { + "from": "KM_FormMain", + "to": "KM_Hand" + }, + { + "from": "KM_FormMain", + "to": "KM_ResKeys" + }, + { + "from": "KM_FormMain", + "to": "KM_FormLogistics" + }, + { + "from": "KM_FormMain", + "to": "KM_Game" + }, + { + "from": "KM_FormMain", + "to": "KM_RandomChecks" + }, + { + "from": "KM_FormMain", + "to": "KM_Log" + }, + { + "from": "KM_FormMain", + "to": "KM_CommonClasses" + }, + { + "from": "KM_FormMain", + "to": "KM_VclHelpers" + }, + { + "from": "KM_FormMain", + "to": "KM_Video" + }, + { + "from": "KM_FormMain", + "to": "KM_Settings" + }, + { + "from": "KM_FormMain", + "to": "KM_MainSettings" + }, + { + "from": "KM_FormMain", + "to": "KM_GameSettings" + }, + { + "from": "KM_FormMain", + "to": "KM_ServerSettings" + }, + { + "from": "KM_FormMain", + "to": "KM_CommonShellUtils" + }, + { + "from": "KM_FormMain", + "to": "KM_IoXML" + }, + { + "from": "KM_FormMain", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_FormMain", + "to": "KM_ResTypes" + }, + { + "from": "KM_FormMain", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_VclMenuHint", + "to": "Classes" + }, + { + "from": "KM_VclMenuHint", + "to": "Windows" + }, + { + "from": "KM_VclMenuHint", + "to": "LCLIntf" + }, + { + "from": "KM_VclMenuHint", + "to": "LCLType" + }, + { + "from": "KM_VclMenuHint", + "to": "Controls" + }, + { + "from": "KM_VclMenuHint", + "to": "Menus" + }, + { + "from": "KM_VclMenuHint", + "to": "ExtCtrls" + }, + { + "from": "KM_VclMenuHint", + "to": "Forms" + }, + { + "from": "KM_VclHelpers", + "to": "StdCtrls" + }, + { + "from": "KM_VclHelpers", + "to": "Spin" + }, + { + "from": "KM_VclHelpers", + "to": "Classes" + }, + { + "from": "KM_VclHelpers", + "to": "SysUtils" + }, + { + "from": "KM_FogOfWar", + "to": "Math" + }, + { + "from": "KM_FogOfWar", + "to": "KM_CommonClasses" + }, + { + "from": "KM_FogOfWar", + "to": "KM_CommonTypes" + }, + { + "from": "KM_FogOfWar", + "to": "KM_Defaults" + }, + { + "from": "KM_FogOfWar", + "to": "KM_Points" + }, + { + "from": "KM_FogOfWar", + "to": "SysUtils" + }, + { + "from": "KM_FogOfWar", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_FogOfWar", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_Game", + "to": "Generics.Collections" + }, + { + "from": "KM_Game", + "to": "KM_WorkerThread" + }, + { + "from": "KM_Game", + "to": "KM_Networking" + }, + { + "from": "KM_Game", + "to": "KM_PathFinding" + }, + { + "from": "KM_Game", + "to": "KM_GameParams" + }, + { + "from": "KM_Game", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_Game", + "to": "KM_GameSavePoints" + }, + { + "from": "KM_Game", + "to": "KM_GameOptions" + }, + { + "from": "KM_Game", + "to": "KM_GameTypes" + }, + { + "from": "KM_Game", + "to": "KM_MapEditor" + }, + { + "from": "KM_Game", + "to": "KM_Campaigns" + }, + { + "from": "KM_Game", + "to": "KM_Maps" + }, + { + "from": "KM_Game", + "to": "KM_MapTypes" + }, + { + "from": "KM_Game", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_Game", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_Game", + "to": "KM_Render" + }, + { + "from": "KM_Game", + "to": "KM_Scripting" + }, + { + "from": "KM_Game", + "to": "KM_MediaTypes" + }, + { + "from": "KM_Game", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_Game", + "to": "KM_InterfaceGamePlay" + }, + { + "from": "KM_Game", + "to": "KM_InterfaceMapEditor" + }, + { + "from": "KM_Game", + "to": "KM_ResTypes" + }, + { + "from": "KM_Game", + "to": "KM_ResFonts" + }, + { + "from": "KM_Game", + "to": "KM_ResTexts" + }, + { + "from": "KM_Game", + "to": "KM_Hand" + }, + { + "from": "KM_Game", + "to": "KM_Defaults" + }, + { + "from": "KM_Game", + "to": "KM_Points" + }, + { + "from": "KM_Game", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Game", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Game", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_Game", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_Game", + "to": "KM_AIParameters" + }, + { + "from": "KM_Game", + "to": "Types" + }, + { + "from": "KM_Game", + "to": "LCLType" + }, + { + "from": "KM_Game", + "to": "Controls" + }, + { + "from": "KM_Game", + "to": "System.Types" + }, + { + "from": "KM_Game", + "to": "Classes" + }, + { + "from": "KM_Game", + "to": "SysUtils" + }, + { + "from": "KM_Game", + "to": "Math" + }, + { + "from": "KM_Game", + "to": "TypInfo" + }, + { + "from": "KM_Game", + "to": "Dialogs" + }, + { + "from": "KM_Game", + "to": "UITypes" + }, + { + "from": "KM_Game", + "to": "KromUtils" + }, + { + "from": "KM_Game", + "to": "KM_Sound" + }, + { + "from": "KM_Game", + "to": "KM_ScriptSound" + }, + { + "from": "KM_Game", + "to": "KM_PathFindingAStarOld" + }, + { + "from": "KM_Game", + "to": "KM_PathFindingAStarNew" + }, + { + "from": "KM_Game", + "to": "KM_PathFindingJPS" + }, + { + "from": "KM_Game", + "to": "KM_Projectiles" + }, + { + "from": "KM_Game", + "to": "KM_AIFields" + }, + { + "from": "KM_Game", + "to": "KM_NetTypes" + }, + { + "from": "KM_Game", + "to": "KM_Main" + }, + { + "from": "KM_Game", + "to": "KM_System" + }, + { + "from": "KM_Game", + "to": "KM_GameApp" + }, + { + "from": "KM_Game", + "to": "KM_RenderPool" + }, + { + "from": "KM_Game", + "to": "KM_GameInfo" + }, + { + "from": "KM_Game", + "to": "KM_GameClasses" + }, + { + "from": "KM_Game", + "to": "KM_Terrain" + }, + { + "from": "KM_Game", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_Game", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Game", + "to": "KM_HandSpectator" + }, + { + "from": "KM_Game", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_Game", + "to": "KM_MissionScript" + }, + { + "from": "KM_Game", + "to": "KM_MissionScript_Info" + }, + { + "from": "KM_Game", + "to": "KM_MissionScript_Standard" + }, + { + "from": "KM_Game", + "to": "KM_GameInputProcess_Multi" + }, + { + "from": "KM_Game", + "to": "KM_GameInputProcess_Single" + }, + { + "from": "KM_Game", + "to": "KM_Resource" + }, + { + "from": "KM_Game", + "to": "KM_ResSound" + }, + { + "from": "KM_Game", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_Game", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_Game", + "to": "KM_GameSettings" + }, + { + "from": "KM_Game", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_Game", + "to": "KM_Log" + }, + { + "from": "KM_Game", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Game", + "to": "KM_Saves" + }, + { + "from": "KM_Game", + "to": "KM_FileIO" + }, + { + "from": "KM_Game", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Game", + "to": "KM_RandomChecks" + }, + { + "from": "KM_Game", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_Game", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_Game", + "to": "KM_NetRoom" + }, + { + "from": "KM_Game", + "to": "KM_HandTypes" + }, + { + "from": "KM_Game", + "to": "KM_ResLocales" + }, + { + "from": "KM_Game", + "to": "KM_ServerSettings" + }, + { + "from": "KM_Game", + "to": "KM_CampaignTypes" + }, + { + "from": "KM_Game", + "to": "KM_MapUtils" + }, + { + "from": "KM_Game", + "to": "KM_Utils" + }, + { + "from": "KM_Game", + "to": "KM_WorkerThreadUtils" + }, + { + "from": "KM_GameClasses", + "to": "KM_Minimap" + }, + { + "from": "KM_GameClasses", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameClasses", + "to": "KM_WorkerThread" + }, + { + "from": "KM_GameClasses", + "to": "SysUtils" + }, + { + "from": "KM_GameClasses", + "to": "KM_Defaults" + }, + { + "from": "KM_GameClasses", + "to": "KM_WorkerThreadUtils" + }, + { + "from": "KM_GameInfo", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameInfo", + "to": "KM_Maps" + }, + { + "from": "KM_GameInfo", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameInfo", + "to": "KM_Defaults" + }, + { + "from": "KM_GameInfo", + "to": "KM_HandTypes" + }, + { + "from": "KM_GameInfo", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameInfo", + "to": "SysUtils" + }, + { + "from": "KM_GameInfo", + "to": "KM_Log" + }, + { + "from": "KM_GameInfo", + "to": "KM_Resource" + }, + { + "from": "KM_GameInfo", + "to": "KM_ResTexts" + }, + { + "from": "KM_GameInfo", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameOptions", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameOptions", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameOptions", + "to": "SysUtils" + }, + { + "from": "KM_GameOptions", + "to": "TypInfo" + }, + { + "from": "KM_GameOptions", + "to": "KM_Defaults" + }, + { + "from": "KM_GameParams", + "to": "KM_Defaults" + }, + { + "from": "KM_GameParams", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameParams", + "to": "KM_GameTypes" + }, + { + "from": "KM_GameParams", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameParams", + "to": "KM_MapUtils" + }, + { + "from": "KM_GameSavePoints", + "to": "SyncObjs" + }, + { + "from": "KM_GameSavePoints", + "to": "Generics.Collections" + }, + { + "from": "KM_GameSavePoints", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameSavePoints", + "to": "KM_WorkerThread" + }, + { + "from": "KM_GameSavePoints", + "to": "KM_Sort" + }, + { + "from": "KM_GameSavePoints", + "to": "SysUtils" + }, + { + "from": "KM_GameSavePoints", + "to": "Classes" + }, + { + "from": "KM_GameTypes", + "to": "KM_Defaults" + }, + { + "from": "KM_GameTypes", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameTypes", + "to": "KM_CampaignTypes" + }, + { + "from": "KM_GameTypes", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_GameTypes", + "to": "KM_Points" + }, + { + "from": "KM_GameInputProcess", + "to": "Generics.Collections" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Units" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_UnitGroup" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Houses" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Hand" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_ScriptingConsoleCommands" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Defaults" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Points" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_WorkerThread" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HandTypes" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_GameTypes" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_ResTypes" + }, + { + "from": "KM_GameInputProcess", + "to": "Classes" + }, + { + "from": "KM_GameInputProcess", + "to": "SysUtils" + }, + { + "from": "KM_GameInputProcess", + "to": "StrUtils" + }, + { + "from": "KM_GameInputProcess", + "to": "TypInfo" + }, + { + "from": "KM_GameInputProcess", + "to": "Math" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Entity" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_GameApp" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Game" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_GameParams" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_GameSettings" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HandEntity" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseMarket" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseSchool" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseStore" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_HouseArmorWorkshop" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Alerts" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_RenderUI" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_ResFonts" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Resource" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_Log" + }, + { + "from": "KM_GameInputProcess", + "to": "KM_WorkerThreadUtils" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_Hand" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_Defaults" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "TypInfo" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "SysUtils" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "Math" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KromUtils" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_Game" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_GameParams" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_NetTypes" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_ResTexts" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_ResSound" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_Sound" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_GameTypes" + }, + { + "from": "KM_GameInputProcess_Multi", + "to": "KM_Networking" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "Math" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_Game" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_GameParams" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_Defaults" + }, + { + "from": "KM_GameInputProcess_Single", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameUIDTracker", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RandomChecks", + "to": "zstream" + }, + { + "from": "KM_RandomChecks", + "to": "ZLib" + }, + { + "from": "KM_RandomChecks", + "to": "Generics.Collections" + }, + { + "from": "KM_RandomChecks", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RandomChecks", + "to": "KM_WorkerThread" + }, + { + "from": "KM_RandomChecks", + "to": "Classes" + }, + { + "from": "KM_RandomChecks", + "to": "SysUtils" + }, + { + "from": "KM_RandomChecks", + "to": "Math" + }, + { + "from": "KM_RandomChecks", + "to": "KM_GameSettings" + }, + { + "from": "KM_RandomChecks", + "to": "KM_Log" + }, + { + "from": "KM_RandomChecks", + "to": "KM_WorkerThreadUtils" + }, + { + "from": "KM_Alerts", + "to": "Classes" + }, + { + "from": "KM_Alerts", + "to": "Generics.Collections" + }, + { + "from": "KM_Alerts", + "to": "KM_Pics" + }, + { + "from": "KM_Alerts", + "to": "KM_Viewport" + }, + { + "from": "KM_Alerts", + "to": "KM_ResSound" + }, + { + "from": "KM_Alerts", + "to": "KM_Defaults" + }, + { + "from": "KM_Alerts", + "to": "KM_Points" + }, + { + "from": "KM_Alerts", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Alerts", + "to": "KM_Hand" + }, + { + "from": "KM_Alerts", + "to": "KM_RenderPool" + }, + { + "from": "KM_Alerts", + "to": "KM_Sound" + }, + { + "from": "KM_Alerts", + "to": "KM_ResTypes" + }, + { + "from": "KM_MessageLog", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MessageLog", + "to": "KM_GameTypes" + }, + { + "from": "KM_MessageLog", + "to": "KM_Points" + }, + { + "from": "KM_MessageLog", + "to": "SysUtils" + }, + { + "from": "KM_MessageLog", + "to": "Math" + }, + { + "from": "KM_MessageLog", + "to": "KM_ResTexts" + }, + { + "from": "KM_MessageLog", + "to": "KM_HandEntity" + }, + { + "from": "KM_MessageStack", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MessageStack", + "to": "KM_GameTypes" + }, + { + "from": "KM_MessageStack", + "to": "KM_Points" + }, + { + "from": "KM_MessageStack", + "to": "SysUtils" + }, + { + "from": "KM_MessageStack", + "to": "Math" + }, + { + "from": "KM_Cursor", + "to": "Classes" + }, + { + "from": "KM_Cursor", + "to": "KM_Defaults" + }, + { + "from": "KM_Cursor", + "to": "KM_Points" + }, + { + "from": "KM_Cursor", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_Cursor", + "to": "KM_AITypes" + }, + { + "from": "KM_Cursor", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_Cursor", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_InterfaceDefaults", + "to": "Windows" + }, + { + "from": "KM_InterfaceDefaults", + "to": "LCLIntF" + }, + { + "from": "KM_InterfaceDefaults", + "to": "LCLType" + }, + { + "from": "KM_InterfaceDefaults", + "to": "Classes" + }, + { + "from": "KM_InterfaceDefaults", + "to": "Controls" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Controls" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_ControlsBase" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Points" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_ResFonts" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_ResTypes" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_InterfaceDefaults", + "to": "SysUtils" + }, + { + "from": "KM_InterfaceDefaults", + "to": "Math" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Resource" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_ResKeys" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_RenderUI" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_RenderAux" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Defaults" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Cursor" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Music" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Sound" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_GameSettings" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_Main" + }, + { + "from": "KM_InterfaceDefaults", + "to": "KM_CommonTypes" + }, + { + "from": "KM_InterfaceGame", + "to": "Windows" + }, + { + "from": "KM_InterfaceGame", + "to": "LCLIntF" + }, + { + "from": "KM_InterfaceGame", + "to": "SysUtils" + }, + { + "from": "KM_InterfaceGame", + "to": "Classes" + }, + { + "from": "KM_InterfaceGame", + "to": "Math" + }, + { + "from": "KM_InterfaceGame", + "to": "Controls" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Defaults" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Controls" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_ControlsBase" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Points" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_CommonTypes" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Render" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_MinimapGame" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Viewport" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_ResFonts" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_ResTypes" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_AITypes" + }, + { + "from": "KM_InterfaceGame", + "to": "StrUtils" + }, + { + "from": "KM_InterfaceGame", + "to": "KromUtils" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Cursor" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Main" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_System" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_GameParams" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_GameSettings" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_HandsCollection" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Terrain" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_RenderPool" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_RenderUI" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Pics" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Resource" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_ResKeys" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Sound" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_ScriptSound" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_CommonUtils" + }, + { + "from": "KM_InterfaceGame", + "to": "KM_Log" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "Windows" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "LCLIntf" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "LCLType" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "Controls" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "StrUtils" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "SysUtils" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "Math" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "Classes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "TypInfo" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "Generics.Collections" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Controls" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsBase" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsList" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_CommonClasses" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_CommonTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Defaults" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Points" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Houses" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Units" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Minimap" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Viewport" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Render" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_UnitGroup" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Saves" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_MessageStack" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResHouses" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Alerts" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Networking" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HandEntity" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HandTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUICommonGameOptions" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameResultsSP" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameResultsMP" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameBuild" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameChat" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameHouse" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameUnit" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameRatios" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameStats" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GUIGameSpectator" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KromUtils" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Pics" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Terrain" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResFonts" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Main" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_System" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Entity" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameInputProcess_Multi" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_AI" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_RenderUI" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Cursor" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Maps" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HandsCollection" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Hand" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_RenderPool" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResTexts" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Game" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameApp" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_AIFields" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameSettings" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ControlsDragger" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_CommonUtils" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResLocales" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResSound" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Resource" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Log" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ResKeys" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_NetRoom" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_MessageLog" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_NetTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_InterfaceMapEditor" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_MapTypes" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_GameParams" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Video" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Music" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Sound" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_ScriptSound" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_HandEntityHelper" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_Utils" + }, + { + "from": "KM_InterfaceGamePlay", + "to": "KM_MapUtils" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "Windows" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "LCLType" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "Classes" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "Math" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "SysUtils" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "Controls" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Campaigns" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Controls" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_ControlsBase" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Points" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Pics" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_ResFonts" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_CommonTypes" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GameTypes" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuCampaign" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuCampaigns" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuCredits" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuError" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuLoad" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuLoading" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuLobby" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuMain" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuMapEditor" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuMultiplayer" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuOptions" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuReplays" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuSingleMap" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GUIMenuSinglePlayer" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KromUtils" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Defaults" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Log" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Main" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_Networking" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_GameApp" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_ResTexts" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_ResTypes" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_RenderUI" + }, + { + "from": "KM_InterfaceMainMenu", + "to": "KM_NetTypes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "Windows" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "LCLIntf" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "LCLType" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "Classes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "Math" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "StrUtils" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "SysUtils" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "Controls" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Controls" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ControlsBase" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ControlsList" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ControlsForm" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Defaults" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Pics" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Points" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Houses" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_MapEditor" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Minimap" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Viewport" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Render" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdHouse" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdPlayerGoalPopUp" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdTerrain" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdTown" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdPlayer" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMission" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdTownAttackPopUp" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdExtras" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMessage" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdTownFormationsPopUp" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMarkerDefence" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMarkerReveal" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMenu" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdMenuQuickPlay" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdUnit" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GUIMapEdRMG" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_System" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_HandsCollection" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Hand" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_HandTypes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_HandEntity" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ResTexts" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Game" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GameParams" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Cursor" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Resource" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ResHouses" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_TerrainDeposits" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ResKeys" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_GameApp" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_RenderUI" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ResFonts" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_CommonClasses" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Units" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_UnitGroup" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Terrain" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Maps" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_Utils" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_InterfaceMapEditor", + "to": "KM_ResTypes" + }, + { + "from": "KM_InterfaceTypes", + "to": "Classes" + }, + { + "from": "KM_Viewport", + "to": "Windows" + }, + { + "from": "KM_Viewport", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Viewport", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Viewport", + "to": "KM_Points" + }, + { + "from": "KM_Viewport", + "to": "Mouse" + }, + { + "from": "KM_Viewport", + "to": "Types" + }, + { + "from": "KM_Viewport", + "to": "Math" + }, + { + "from": "KM_Viewport", + "to": "SysUtils" + }, + { + "from": "KM_Viewport", + "to": "KromUtils" + }, + { + "from": "KM_Viewport", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_Viewport", + "to": "KM_Resource" + }, + { + "from": "KM_Viewport", + "to": "KM_ResTypes" + }, + { + "from": "KM_Viewport", + "to": "KM_RenderAux" + }, + { + "from": "KM_Viewport", + "to": "KM_Main" + }, + { + "from": "KM_Viewport", + "to": "KM_System" + }, + { + "from": "KM_Viewport", + "to": "KM_GameApp" + }, + { + "from": "KM_Viewport", + "to": "KM_GameSettings" + }, + { + "from": "KM_Viewport", + "to": "KM_Defaults" + }, + { + "from": "KM_Viewport", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "Classes" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "SysUtils" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_GUICommonOptions" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_Controls" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_GUICommonKeys" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_Music" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_Sound" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_Game" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_GameParams" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUICommonGameOptions", + "to": "KM_Resource" + }, + { + "from": "KM_GUICommonKeys", + "to": "Classes" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResKeys" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_Controls" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUICommonKeys", + "to": "SysUtils" + }, + { + "from": "KM_GUICommonKeys", + "to": "Math" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_Sound" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResSound" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_Pics" + }, + { + "from": "KM_GUICommonKeys", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUICommonOptions", + "to": "Classes" + }, + { + "from": "KM_GUICommonOptions", + "to": "Math" + }, + { + "from": "KM_GUICommonOptions", + "to": "SysUtils" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Controls" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUICommonOptions", + "to": "KromOGLUtils" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_MainSettings" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Pics" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Resolutions" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_GUICommonKeys" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Main" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Music" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Sound" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Resource" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResLocales" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResSound" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Video" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_Game" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_GameParams" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUICommonOptions", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_GUIGameBuild", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameBuild", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_Utils" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameBuild", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameChat", + "to": "Windows" + }, + { + "from": "KM_GUIGameChat", + "to": "LCLIntf" + }, + { + "from": "KM_GUIGameChat", + "to": "LCLType" + }, + { + "from": "KM_GUIGameChat", + "to": "Classes" + }, + { + "from": "KM_GUIGameChat", + "to": "Math" + }, + { + "from": "KM_GUIGameChat", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameChat", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Networking" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_NetTypes" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ControlsDragger" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ControlsPopUp" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Points" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Console" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_Sound" + }, + { + "from": "KM_GUIGameChat", + "to": "KM_NetRoom" + }, + { + "from": "KM_GUIGameHouse", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameHouse", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameHouse", + "to": "Math" + }, + { + "from": "KM_GUIGameHouse", + "to": "Classes" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ControlsWaresRow" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Houses" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseMarket" + }, + { + "from": "KM_GUIGameHouse", + "to": "Windows" + }, + { + "from": "KM_GUIGameHouse", + "to": "LCLIntf" + }, + { + "from": "KM_GUIGameHouse", + "to": "LCLType" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Utils" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_UtilsExt" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Points" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseSchool" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseStore" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HouseArmorWorkshop" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_HandEntity" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResKeys" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResWares" + }, + { + "from": "KM_GUIGameHouse", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIGameRatios", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "Classes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "Math" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ControlsChart" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_HandStats" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Main" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIGameResultsMP", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ControlsChart" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ResWares" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_HandStats" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameResultsSP", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIGameSpectator", + "to": "Classes" + }, + { + "from": "KM_GUIGameSpectator", + "to": "Math" + }, + { + "from": "KM_GUIGameSpectator", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameSpectator", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_Points" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_GUIGameSpectatorItemLines" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameSpectator", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "Classes" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "Math" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_GUIGameSpectator" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Points" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Houses" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Entity" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_HandEntity" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_InterfaceGamePlay" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_UnitGroup" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIGameSpectatorItemLines", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameStats", + "to": "Classes" + }, + { + "from": "KM_GUIGameStats", + "to": "Math" + }, + { + "from": "KM_GUIGameStats", + "to": "StrUtils" + }, + { + "from": "KM_GUIGameStats", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Houses" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Entity" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_Points" + }, + { + "from": "KM_GUIGameStats", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIGameUnit", + "to": "Windows" + }, + { + "from": "KM_GUIGameUnit", + "to": "LCLIntf" + }, + { + "from": "KM_GUIGameUnit", + "to": "LCLType" + }, + { + "from": "KM_GUIGameUnit", + "to": "Classes" + }, + { + "from": "KM_GUIGameUnit", + "to": "Controls" + }, + { + "from": "KM_GUIGameUnit", + "to": "SysUtils" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Controls" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Units" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_UnitGroup" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIGameUnit", + "to": "Math" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_System" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Game" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_GameInputProcess" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Hand" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_HandSpectator" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_HandEntity" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Resource" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResKeys" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Pics" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Utils" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_UtilsExt" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_Sound" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_GUIGameUnit", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdExtras", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "Math" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "Controls" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ControlsWaresRow" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Houses" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HandEntity" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_HouseStore" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdHouse", + "to": "KM_UtilsExt" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "Math" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_AITypes" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdMarkerDefence", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "Math" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMarkerReveal", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMapEdMessage", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "Math" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "Controls" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KromUtils" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Units" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_UnitGroup" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_HandEntity" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_UtilsExt" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_Terrain" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_GUIMapEdUnit", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUIMapEdMenuResize" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUIMapEdMenuQuickPlay" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUIMapEdMenuLoad" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUIMapEdMenuSave" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUIMapEdMenuQuit" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_GUICommonGameOptions" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenu", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_InterfaceMapEditor" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMapEdMenuLoad", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_GUIMapEdMenuSave" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KromUtils" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_InterfaceGamePlay" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdMenuQuickPlay", + "to": "Math" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenuQuit", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "Math" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KromUtils" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Terrain" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenuResize", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdMenuSave", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMapEdMission", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMission", + "to": "Math" + }, + { + "from": "KM_GUIMapEdMission", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_GUIMapEdMissionMode" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_GUIMapEdMissionAlliances" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_GUIMapEdMissionPlayers" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMission", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMissionAlliances", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_GameParams" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMissionMode", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdMissionPlayers", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "Math" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerBlockHouse" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerBlockTrade" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerBlockUnit" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerColors" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerGoals" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_GUIMapEdPlayerView" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayer", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_HandLocks" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdPlayerBlockHouse", + "to": "KM_HandTypes" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerBlockTrade", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdPlayerBlockUnit", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ControlsColor" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerColors", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_AIGoals" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_MapUtilsExt" + }, + { + "from": "KM_GUIMapEdPlayerGoalPopUp", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "Math" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_AIGoals" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_GUIMapEdPlayerGoalPopUp" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdPlayerGoals", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdPlayerView", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "Math" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Minimap" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_RandomMapGenerator" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_Terrain" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdRMG", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainBrushes" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainHeights" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainTiles" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainObjects" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainSelection" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_GUIMapEdTerrainOverlays" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrain", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "LCLIntF" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "TypInfo" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrainBrushes", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "LCLIntF" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_Main" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrainHeights", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Main" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ResMapElements" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ResKeys" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Terrain" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainObjects", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "TypInfo" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainOverlays", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_GUIMapEdRMG" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_TerrainSelection" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainSelection", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ResKeys" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMapEdTerrainTiles", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTown", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTown", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTown", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_GUIMapEdTownHouses" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_GUIMapEdTownUnits" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_GUIMapEdTownScript" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_GUIMapEdTownDefence" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_GUIMapEdTownOffence" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTown", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_AIAttacks" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTownAttackPopUp", + "to": "KM_AITypes" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_GUIMapEdTownFormationsPopUp" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownDefence", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownFormationsPopUp", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ResHouses" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Terrain" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTownHouses", + "to": "KM_ResMapElements" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_Points" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_AIAttacks" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_GUIMapEdTownAttackPopUp" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_AITypes" + }, + { + "from": "KM_GUIMapEdTownOffence", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "Windows" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "LCLType" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Game" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Hand" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTownScript", + "to": "KM_AITypes" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "Classes" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "Math" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "StrUtils" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "SysUtils" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_HandsCollection" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Cursor" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ResUnits" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_Utils" + }, + { + "from": "KM_GUIMapEdTownUnits", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "Classes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "Math" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Campaigns" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Audio" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Music" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Video" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuCampaign", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "Windows" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "Classes" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "Math" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_Campaigns" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuCampaigns", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_GUIMenuCredits", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuCredits", + "to": "ShellAPI" + }, + { + "from": "KM_GUIMenuCredits", + "to": "Windows" + }, + { + "from": "KM_GUIMenuCredits", + "to": "LCLIntf" + }, + { + "from": "KM_GUIMenuCredits", + "to": "Classes" + }, + { + "from": "KM_GUIMenuCredits", + "to": "Forms" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_System" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_ResLocales" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuCredits", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuError", + "to": "Math" + }, + { + "from": "KM_GUIMenuError", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuError", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuLoad", + "to": "Windows" + }, + { + "from": "KM_GUIMenuLoad", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuLoad", + "to": "Classes" + }, + { + "from": "KM_GUIMenuLoad", + "to": "Math" + }, + { + "from": "KM_GUIMenuLoad", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Saves" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_MinimapMission" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Log" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuLoad", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuLoading", + "to": "Math" + }, + { + "from": "KM_GUIMenuLoading", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuLoading", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuLobby", + "to": "Windows" + }, + { + "from": "KM_GUIMenuLobby", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuLobby", + "to": "Classes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "Math" + }, + { + "from": "KM_GUIMenuLobby", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_NetTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Console" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsPopUp" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsProgressBar" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Saves" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_MinimapMission" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_GUIMapEdRMG" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Log" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Points" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ResLocales" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_Networking" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_NetRoom" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_MapUtilsExt" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_GUIMenuLobby", + "to": "KM_ServerSettings" + }, + { + "from": "KM_GUIMenuMain", + "to": "Math" + }, + { + "from": "KM_GUIMenuMain", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_Main" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_GameApp" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuMain", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "Windows" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "Classes" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "Math" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ControlsTrackBar" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_MinimapMission" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ServerSettings" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_MapUtilsExt" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_GUIMenuMapEditor", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "Windows" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "StrUtils" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "Math" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "Classes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KromOGLUtils" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsScroll" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_NetServerPoller" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Main" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ControlsTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ServerSettings" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Networking" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_NetTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ResLocales" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_GUIMenuLobby" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuMultiplayer", + "to": "KM_Console" + }, + { + "from": "KM_GUIMenuOptions", + "to": "Classes" + }, + { + "from": "KM_GUIMenuOptions", + "to": "Math" + }, + { + "from": "KM_GUIMenuOptions", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KromOGLUtils" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_MainSettings" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_GUICommonOptions" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Resolutions" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_GUICommonKeys" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Main" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Music" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Sound" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Resource" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResLocales" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResSound" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_Video" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuOptions", + "to": "KM_GameAppSettings" + }, + { + "from": "KM_GUIMenuReplays", + "to": "Windows" + }, + { + "from": "KM_GUIMenuReplays", + "to": "LCLType" + }, + { + "from": "KM_GUIMenuReplays", + "to": "Classes" + }, + { + "from": "KM_GUIMenuReplays", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuReplays", + "to": "Math" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsEdit" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsForm" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_Saves" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_MinimapGame" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_Log" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuReplays", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "Math" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_Maps" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_MapTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsDrop" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsList" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsMemo" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsMinimapView" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ControlsSwitch" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_MinimapMission" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_RenderUI" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_GameSettings" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_MapUtils" + }, + { + "from": "KM_GUIMenuSingleMap", + "to": "KM_MapUtilsExt" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "Math" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "SysUtils" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_Defaults" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_Controls" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_ControlsBase" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_Pics" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_InterfaceDefaults" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_GameTypes" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_ResTexts" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_ResFonts" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_ResTypes" + }, + { + "from": "KM_GUIMenuSinglePlayer", + "to": "KM_RenderUI" + }, + { + "from": "KM_Hand", + "to": "Generics.Collections" + }, + { + "from": "KM_Hand", + "to": "KM_AI" + }, + { + "from": "KM_Hand", + "to": "KM_Units" + }, + { + "from": "KM_Hand", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_Hand", + "to": "KM_UnitGroup" + }, + { + "from": "KM_Hand", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_Hand", + "to": "KM_Houses" + }, + { + "from": "KM_Hand", + "to": "KM_HouseCollection" + }, + { + "from": "KM_Hand", + "to": "KM_HouseInn" + }, + { + "from": "KM_Hand", + "to": "KM_HandLogistics" + }, + { + "from": "KM_Hand", + "to": "KM_HandLocks" + }, + { + "from": "KM_Hand", + "to": "KM_HandStats" + }, + { + "from": "KM_Hand", + "to": "KM_GameTypes" + }, + { + "from": "KM_Hand", + "to": "KM_FogOfWar" + }, + { + "from": "KM_Hand", + "to": "KM_HandConstructions" + }, + { + "from": "KM_Hand", + "to": "KM_MessageLog" + }, + { + "from": "KM_Hand", + "to": "KM_ResHouses" + }, + { + "from": "KM_Hand", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Hand", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Hand", + "to": "KM_Defaults" + }, + { + "from": "KM_Hand", + "to": "KM_Points" + }, + { + "from": "KM_Hand", + "to": "KM_HandEntity" + }, + { + "from": "KM_Hand", + "to": "KM_HandTypes" + }, + { + "from": "KM_Hand", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_Hand", + "to": "KM_ResTypes" + }, + { + "from": "KM_Hand", + "to": "KM_ResFonts" + }, + { + "from": "KM_Hand", + "to": "Classes" + }, + { + "from": "KM_Hand", + "to": "SysUtils" + }, + { + "from": "KM_Hand", + "to": "KromUtils" + }, + { + "from": "KM_Hand", + "to": "Math" + }, + { + "from": "KM_Hand", + "to": "TypInfo" + }, + { + "from": "KM_Hand", + "to": "KM_Entity" + }, + { + "from": "KM_Hand", + "to": "KM_Cursor" + }, + { + "from": "KM_Hand", + "to": "KM_Game" + }, + { + "from": "KM_Hand", + "to": "KM_GameParams" + }, + { + "from": "KM_Hand", + "to": "KM_Terrain" + }, + { + "from": "KM_Hand", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Hand", + "to": "KM_Sound" + }, + { + "from": "KM_Hand", + "to": "KM_AIFields" + }, + { + "from": "KM_Hand", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_Hand", + "to": "KM_Resource" + }, + { + "from": "KM_Hand", + "to": "KM_ResSound" + }, + { + "from": "KM_Hand", + "to": "KM_ResTexts" + }, + { + "from": "KM_Hand", + "to": "KM_ResMapElements" + }, + { + "from": "KM_Hand", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Hand", + "to": "KM_ResUnits" + }, + { + "from": "KM_Hand", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Hand", + "to": "KM_GameSettings" + }, + { + "from": "KM_Hand", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_Hand", + "to": "KM_MapTypes" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Defaults" + }, + { + "from": "KM_HandConstructions", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Points" + }, + { + "from": "KM_HandConstructions", + "to": "KM_ResHouses" + }, + { + "from": "KM_HandConstructions", + "to": "KM_ResTypes" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Units" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Houses" + }, + { + "from": "KM_HandConstructions", + "to": "Math" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Entity" + }, + { + "from": "KM_HandConstructions", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_HandConstructions", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HandConstructions", + "to": "KM_Resource" + }, + { + "from": "KM_HandEntity", + "to": "KM_Defaults" + }, + { + "from": "KM_HandEntity", + "to": "KM_Points" + }, + { + "from": "KM_HandEntity", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandEntity", + "to": "KM_HandTypes" + }, + { + "from": "KM_HandEntity", + "to": "KM_Entity" + }, + { + "from": "KM_HandEntity", + "to": "KromOGLUtils" + }, + { + "from": "KM_HandEntity", + "to": "SysUtils" + }, + { + "from": "KM_HandEntity", + "to": "KM_GameParams" + }, + { + "from": "KM_HandEntity", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_HandEntityHelper", + "to": "KM_HandEntity" + }, + { + "from": "KM_HandEntityHelper", + "to": "KM_Units" + }, + { + "from": "KM_HandEntityHelper", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HandEntityHelper", + "to": "KM_UnitGroup" + }, + { + "from": "KM_HandEntityHelper", + "to": "KM_Houses" + }, + { + "from": "KM_HandLocks", + "to": "KM_ResHouses" + }, + { + "from": "KM_HandLocks", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandLocks", + "to": "KM_Defaults" + }, + { + "from": "KM_HandLocks", + "to": "KM_ResTypes" + }, + { + "from": "KM_HandLocks", + "to": "KM_HandTypes" + }, + { + "from": "KM_HandLocks", + "to": "KM_Resource" + }, + { + "from": "KM_HandLogistics", + "to": "VirtualTrees" + }, + { + "from": "KM_HandLogistics", + "to": "Generics.Collections" + }, + { + "from": "KM_HandLogistics", + "to": "Generics.Defaults" + }, + { + "from": "KM_HandLogistics", + "to": "System.Hash" + }, + { + "from": "KM_HandLogistics", + "to": "Math" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Units" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Houses" + }, + { + "from": "KM_HandLogistics", + "to": "KM_ResHouses" + }, + { + "from": "KM_HandLogistics", + "to": "KM_HandEntity" + }, + { + "from": "KM_HandLogistics", + "to": "KM_HandTypes" + }, + { + "from": "KM_HandLogistics", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Defaults" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Points" + }, + { + "from": "KM_HandLogistics", + "to": "BinaryHeapGen" + }, + { + "from": "KM_HandLogistics", + "to": "KM_ResTypes" + }, + { + "from": "KM_HandLogistics", + "to": "Classes" + }, + { + "from": "KM_HandLogistics", + "to": "SysUtils" + }, + { + "from": "KM_HandLogistics", + "to": "TypInfo" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Entity" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Terrain" + }, + { + "from": "KM_HandLogistics", + "to": "KM_FormLogistics" + }, + { + "from": "KM_HandLogistics", + "to": "KM_UnitTaskDelivery" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Main" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Game" + }, + { + "from": "KM_HandLogistics", + "to": "KM_GameParams" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Hand" + }, + { + "from": "KM_HandLogistics", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HandLogistics", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_HandLogistics", + "to": "KM_HouseStore" + }, + { + "from": "KM_HandLogistics", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Resource" + }, + { + "from": "KM_HandLogistics", + "to": "KM_ResUnits" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Log" + }, + { + "from": "KM_HandLogistics", + "to": "KM_Utils" + }, + { + "from": "KM_HandLogistics", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HandLogistics", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_HandLogistics", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Hand" + }, + { + "from": "KM_HandSpectator", + "to": "KM_FogOfWar" + }, + { + "from": "KM_HandSpectator", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Defaults" + }, + { + "from": "KM_HandSpectator", + "to": "KM_HandEntity" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Entity" + }, + { + "from": "KM_HandSpectator", + "to": "KM_HandEntityHelper" + }, + { + "from": "KM_HandSpectator", + "to": "KM_GameParams" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Cursor" + }, + { + "from": "KM_HandSpectator", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HandSpectator", + "to": "KM_HandTypes" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Units" + }, + { + "from": "KM_HandSpectator", + "to": "KM_UnitGroup" + }, + { + "from": "KM_HandSpectator", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Houses" + }, + { + "from": "KM_HandSpectator", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HandSpectator", + "to": "KM_GameTypes" + }, + { + "from": "KM_HandSpectator", + "to": "KM_Main" + }, + { + "from": "KM_HandStats", + "to": "Classes" + }, + { + "from": "KM_HandStats", + "to": "KM_WareDistribution" + }, + { + "from": "KM_HandStats", + "to": "KM_ResHouses" + }, + { + "from": "KM_HandStats", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandStats", + "to": "KM_CommonTypes" + }, + { + "from": "KM_HandStats", + "to": "KM_Defaults" + }, + { + "from": "KM_HandStats", + "to": "KM_ResTypes" + }, + { + "from": "KM_HandStats", + "to": "SysUtils" + }, + { + "from": "KM_HandStats", + "to": "KM_Resource" + }, + { + "from": "KM_HandStats", + "to": "KM_ResUnits" + }, + { + "from": "KM_HandTypes", + "to": "KM_ResFonts" + }, + { + "from": "KM_HandsCollection", + "to": "Classes" + }, + { + "from": "KM_HandsCollection", + "to": "Math" + }, + { + "from": "KM_HandsCollection", + "to": "Generics.Collections" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Hand" + }, + { + "from": "KM_HandsCollection", + "to": "KM_HandSpectator" + }, + { + "from": "KM_HandsCollection", + "to": "KM_HouseCollection" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Houses" + }, + { + "from": "KM_HandsCollection", + "to": "KM_ResHouses" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Units" + }, + { + "from": "KM_HandsCollection", + "to": "KM_UnitGroup" + }, + { + "from": "KM_HandsCollection", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HandsCollection", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HandsCollection", + "to": "KM_CommonTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Defaults" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Points" + }, + { + "from": "KM_HandsCollection", + "to": "KM_HandEntity" + }, + { + "from": "KM_HandsCollection", + "to": "KM_HandTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_GameTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_MapTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_ResTypes" + }, + { + "from": "KM_HandsCollection", + "to": "SysUtils" + }, + { + "from": "KM_HandsCollection", + "to": "KromUtils" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Game" + }, + { + "from": "KM_HandsCollection", + "to": "KM_GameParams" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Terrain" + }, + { + "from": "KM_HandsCollection", + "to": "KM_AIFields" + }, + { + "from": "KM_HandsCollection", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_HandsCollection", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Resource" + }, + { + "from": "KM_HandsCollection", + "to": "KM_ResUnits" + }, + { + "from": "KM_HandsCollection", + "to": "KM_ResTexts" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Log" + }, + { + "from": "KM_HandsCollection", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HandsCollection", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_HandsCollection", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_HandsCollection", + "to": "KM_Entity" + }, + { + "from": "KM_WareDistribution", + "to": "KM_ResTypes" + }, + { + "from": "KM_WareDistribution", + "to": "KM_CommonClasses" + }, + { + "from": "KM_WareDistribution", + "to": "SysUtils" + }, + { + "from": "KM_WareDistribution", + "to": "Math" + }, + { + "from": "KM_HouseArmorWorkshop", + "to": "KM_Houses" + }, + { + "from": "KM_HouseArmorWorkshop", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseArmorWorkshop", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseArmorWorkshop", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseBarracks", + "to": "Classes" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_Houses" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseBarracks", + "to": "Math" + }, + { + "from": "KM_HouseBarracks", + "to": "Types" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_Entity" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_Hand" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_Units" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_HouseBarracks", + "to": "KM_ResUnits" + }, + { + "from": "KM_HouseCollection", + "to": "Generics.Collections" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Houses" + }, + { + "from": "KM_HouseCollection", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Points" + }, + { + "from": "KM_HouseCollection", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseCollection", + "to": "Classes" + }, + { + "from": "KM_HouseCollection", + "to": "SysUtils" + }, + { + "from": "KM_HouseCollection", + "to": "Types" + }, + { + "from": "KM_HouseCollection", + "to": "Math" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Entity" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Game" + }, + { + "from": "KM_HouseCollection", + "to": "KM_GameParams" + }, + { + "from": "KM_HouseCollection", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Terrain" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseInn" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseMarket" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseSchool" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseStore" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseArmorWorkshop" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseSwineStable" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_HouseCollection", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_HouseCollection", + "to": "KM_Resource" + }, + { + "from": "KM_HouseCollection", + "to": "KM_ResHouses" + }, + { + "from": "KM_HouseCollection", + "to": "KM_GameTypes" + }, + { + "from": "KM_HouseInn", + "to": "KM_Houses" + }, + { + "from": "KM_HouseInn", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseInn", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseInn", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseInn", + "to": "KM_RenderPool" + }, + { + "from": "KM_HouseInn", + "to": "KM_Hand" + }, + { + "from": "KM_HouseInn", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseInn", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseInn", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseInn", + "to": "KM_Points" + }, + { + "from": "KM_HouseInn", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HouseMarket", + "to": "KM_Houses" + }, + { + "from": "KM_HouseMarket", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseMarket", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseMarket", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseMarket", + "to": "Math" + }, + { + "from": "KM_HouseMarket", + "to": "SysUtils" + }, + { + "from": "KM_HouseMarket", + "to": "TypInfo" + }, + { + "from": "KM_HouseMarket", + "to": "KM_Entity" + }, + { + "from": "KM_HouseMarket", + "to": "KM_RenderPool" + }, + { + "from": "KM_HouseMarket", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseMarket", + "to": "KM_HandLogistics" + }, + { + "from": "KM_HouseMarket", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseMarket", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseMarket", + "to": "KM_Resource" + }, + { + "from": "KM_HouseMarket", + "to": "KM_ResSound" + }, + { + "from": "KM_HouseMarket", + "to": "KM_ResWares" + }, + { + "from": "KM_HouseMarket", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_HouseMarket", + "to": "KM_Sound" + }, + { + "from": "KM_HouseMarket", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HouseSchool", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseSchool", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseSchool", + "to": "KM_Houses" + }, + { + "from": "KM_HouseSchool", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseSchool", + "to": "Math" + }, + { + "from": "KM_HouseSchool", + "to": "KM_Entity" + }, + { + "from": "KM_HouseSchool", + "to": "KM_Units" + }, + { + "from": "KM_HouseSchool", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseSchool", + "to": "KM_Hand" + }, + { + "from": "KM_HouseSchool", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseSchool", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseStore", + "to": "KM_Houses" + }, + { + "from": "KM_HouseStore", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseStore", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseStore", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseStore", + "to": "SysUtils" + }, + { + "from": "KM_HouseStore", + "to": "Math" + }, + { + "from": "KM_HouseStore", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_HouseStore", + "to": "KM_Game" + }, + { + "from": "KM_HouseStore", + "to": "KM_GameParams" + }, + { + "from": "KM_HouseStore", + "to": "KM_GameTypes" + }, + { + "from": "KM_HouseStore", + "to": "KM_Resource" + }, + { + "from": "KM_HouseStore", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseStore", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseStore", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseStore", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_Houses" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseSwineStable", + "to": "Math" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_Sound" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_ResSound" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_Hand" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_RenderPool" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseSwineStable", + "to": "KM_CommonUtils" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_Houses" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseTownHall", + "to": "Math" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_Hand" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_HandsCollection" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_HandLogistics" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_HandTypes" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_HandEntity" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_ResUnits" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_HouseTownHall", + "to": "KM_InterfaceGame" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_Houses" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_CommonClasses" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_Points" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_Defaults" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_ResTypes" + }, + { + "from": "KM_HouseWoodcutters", + "to": "SysUtils" + }, + { + "from": "KM_HouseWoodcutters", + "to": "TypInfo" + }, + { + "from": "KM_HouseWoodcutters", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Houses", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Houses", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Houses", + "to": "KM_Defaults" + }, + { + "from": "KM_Houses", + "to": "KM_Points" + }, + { + "from": "KM_Houses", + "to": "KM_HandEntity" + }, + { + "from": "KM_Houses", + "to": "KM_GameTypes" + }, + { + "from": "KM_Houses", + "to": "KM_ResTypes" + }, + { + "from": "KM_Houses", + "to": "TypInfo" + }, + { + "from": "KM_Houses", + "to": "SysUtils" + }, + { + "from": "KM_Houses", + "to": "Math" + }, + { + "from": "KM_Houses", + "to": "KromUtils" + }, + { + "from": "KM_Houses", + "to": "KM_Entity" + }, + { + "from": "KM_Houses", + "to": "KM_GameParams" + }, + { + "from": "KM_Houses", + "to": "KM_Terrain" + }, + { + "from": "KM_Houses", + "to": "KM_RenderPool" + }, + { + "from": "KM_Houses", + "to": "KM_RenderAux" + }, + { + "from": "KM_Houses", + "to": "KM_Sound" + }, + { + "from": "KM_Houses", + "to": "KM_Hand" + }, + { + "from": "KM_Houses", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Houses", + "to": "KM_HandLogistics" + }, + { + "from": "KM_Houses", + "to": "KM_HandTypes" + }, + { + "from": "KM_Houses", + "to": "KM_Units" + }, + { + "from": "KM_Houses", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_Houses", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_Houses", + "to": "KM_Resource" + }, + { + "from": "KM_Houses", + "to": "KM_ResHouses" + }, + { + "from": "KM_Houses", + "to": "KM_ResSound" + }, + { + "from": "KM_Houses", + "to": "KM_ResTexts" + }, + { + "from": "KM_Houses", + "to": "KM_ResUnits" + }, + { + "from": "KM_Houses", + "to": "KM_ResMapElements" + }, + { + "from": "KM_Houses", + "to": "KM_ResWares" + }, + { + "from": "KM_Houses", + "to": "KM_Log" + }, + { + "from": "KM_Houses", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Houses", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Houses", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_Houses", + "to": "KM_RenderDebug" + }, + { + "from": "KM_Houses", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_Houses", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_Houses", + "to": "KM_ResTileset" + }, + { + "from": "KM_MapEdTypes", + "to": "KM_Defaults" + }, + { + "from": "KM_MapEdTypes", + "to": "KM_ResTileset" + }, + { + "from": "KM_MapEdTypes", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MapEdTypes", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_MapEditor", + "to": "Classes" + }, + { + "from": "KM_MapEditor", + "to": "Controls" + }, + { + "from": "KM_MapEditor", + "to": "KM_RenderPool" + }, + { + "from": "KM_MapEditor", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_MapEditor", + "to": "KM_TerrainDeposits" + }, + { + "from": "KM_MapEditor", + "to": "KM_TerrainSelection" + }, + { + "from": "KM_MapEditor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_MapEditor", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MapEditor", + "to": "KM_Defaults" + }, + { + "from": "KM_MapEditor", + "to": "KM_Points" + }, + { + "from": "KM_MapEditor", + "to": "KM_MapEditorHistory" + }, + { + "from": "KM_MapEditor", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_MapEditor", + "to": "KM_ResTexts" + }, + { + "from": "KM_MapEditor", + "to": "KM_HandEntity" + }, + { + "from": "KM_MapEditor", + "to": "KM_AITypes" + }, + { + "from": "KM_MapEditor", + "to": "SysUtils" + }, + { + "from": "KM_MapEditor", + "to": "StrUtils" + }, + { + "from": "KM_MapEditor", + "to": "Math" + }, + { + "from": "KM_MapEditor", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MapEditor", + "to": "KM_Terrain" + }, + { + "from": "KM_MapEditor", + "to": "KM_FileIO" + }, + { + "from": "KM_MapEditor", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_MapEditor", + "to": "KM_Units" + }, + { + "from": "KM_MapEditor", + "to": "KM_UnitGroup" + }, + { + "from": "KM_MapEditor", + "to": "KM_Houses" + }, + { + "from": "KM_MapEditor", + "to": "KM_HouseCollection" + }, + { + "from": "KM_MapEditor", + "to": "KM_GameParams" + }, + { + "from": "KM_MapEditor", + "to": "KM_Cursor" + }, + { + "from": "KM_MapEditor", + "to": "KM_ResMapElements" + }, + { + "from": "KM_MapEditor", + "to": "KM_ResHouses" + }, + { + "from": "KM_MapEditor", + "to": "KM_Resource" + }, + { + "from": "KM_MapEditor", + "to": "KM_ResUnits" + }, + { + "from": "KM_MapEditor", + "to": "KM_RenderAux" + }, + { + "from": "KM_MapEditor", + "to": "KM_RenderGameAux" + }, + { + "from": "KM_MapEditor", + "to": "KM_Hand" + }, + { + "from": "KM_MapEditor", + "to": "KM_HandsCollection" + }, + { + "from": "KM_MapEditor", + "to": "KM_HandEntityHelper" + }, + { + "from": "KM_MapEditor", + "to": "KM_HandTypes" + }, + { + "from": "KM_MapEditor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_MapEditor", + "to": "KM_RenderDebug" + }, + { + "from": "KM_MapEditor", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_MapEditor", + "to": "KM_ResTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "Classes" + }, + { + "from": "KM_MapEditorHistory", + "to": "Generics.Collections" + }, + { + "from": "KM_MapEditorHistory", + "to": "SysUtils" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Defaults" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Points" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_CommonTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Houses" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_ResHouses" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_ResTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "Math" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HandsCollection" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Hand" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HandTypes" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HandEntity" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Units" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_GameParams" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_GameSettings" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Game" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_CommonUtils" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Resource" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HouseTownhall" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_HouseStore" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_UnitGroup" + }, + { + "from": "KM_MapEditorHistory", + "to": "KM_Terrain" + }, + { + "from": "KM_Audio", + "to": "SysUtils" + }, + { + "from": "KM_Audio", + "to": "KM_Sound" + }, + { + "from": "KM_Audio", + "to": "KM_Music" + }, + { + "from": "KM_Audio", + "to": "KM_GameSettings" + }, + { + "from": "KM_Music", + "to": "Types" + }, + { + "from": "KM_Music", + "to": "Bass" + }, + { + "from": "KM_Music", + "to": "libZPlay" + }, + { + "from": "KM_Music", + "to": "SysUtils" + }, + { + "from": "KM_Music", + "to": "KromUtils" + }, + { + "from": "KM_Music", + "to": "Math" + }, + { + "from": "KM_Music", + "to": "KM_Defaults" + }, + { + "from": "KM_Music", + "to": "KM_Log" + }, + { + "from": "KM_Music", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptSound", + "to": "Generics.Collections" + }, + { + "from": "KM_ScriptSound", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ScriptSound", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptSound", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptSound", + "to": "KM_Points" + }, + { + "from": "KM_ScriptSound", + "to": "KM_MediaTypes" + }, + { + "from": "KM_ScriptSound", + "to": "SysUtils" + }, + { + "from": "KM_ScriptSound", + "to": "KM_Game" + }, + { + "from": "KM_ScriptSound", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ScriptSound", + "to": "KM_HandTypes" + }, + { + "from": "KM_ScriptSound", + "to": "KM_Sound" + }, + { + "from": "KM_ScriptSound", + "to": "KM_Sort" + }, + { + "from": "KM_Sound", + "to": "Generics.Collections" + }, + { + "from": "KM_Sound", + "to": "OpenAL" + }, + { + "from": "KM_Sound", + "to": "KM_ResSound" + }, + { + "from": "KM_Sound", + "to": "KM_Defaults" + }, + { + "from": "KM_Sound", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Sound", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Sound", + "to": "KM_Points" + }, + { + "from": "KM_Sound", + "to": "SysUtils" + }, + { + "from": "KM_Sound", + "to": "Classes" + }, + { + "from": "KM_Sound", + "to": "TypInfo" + }, + { + "from": "KM_Sound", + "to": "Math" + }, + { + "from": "KM_Sound", + "to": "Dialogs" + }, + { + "from": "KM_Sound", + "to": "UITypes" + }, + { + "from": "KM_Sound", + "to": "Codec" + }, + { + "from": "KM_Sound", + "to": "VorbisFile" + }, + { + "from": "KM_Sound", + "to": "KromUtils" + }, + { + "from": "KM_Sound", + "to": "KM_Game" + }, + { + "from": "KM_Sound", + "to": "KM_Resource" + }, + { + "from": "KM_Sound", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Sound", + "to": "KM_HandTypes" + }, + { + "from": "KM_Sound", + "to": "KM_RenderAux" + }, + { + "from": "KM_Sound", + "to": "KM_Log" + }, + { + "from": "KM_Sound", + "to": "KM_CommonUtils" + }, + { + "from": "KM_VLC", + "to": "Windows" + }, + { + "from": "KM_VLC", + "to": "LCLIntf" + }, + { + "from": "KM_VLC", + "to": "LCLType" + }, + { + "from": "KM_VLC", + "to": "Classes" + }, + { + "from": "KM_VLC", + "to": "Dialogs" + }, + { + "from": "KM_Video", + "to": "SysUtils" + }, + { + "from": "KM_Video", + "to": "SyncObjs" + }, + { + "from": "KM_Video", + "to": "Types" + }, + { + "from": "KM_Video", + "to": "Classes" + }, + { + "from": "KM_Video", + "to": "Messages" + }, + { + "from": "KM_Video", + "to": "Generics.Collections" + }, + { + "from": "KM_Video", + "to": "KromOGLUtils" + }, + { + "from": "KM_Video", + "to": "UITypes" + }, + { + "from": "KM_Video", + "to": "Controls" + }, + { + "from": "KM_Video", + "to": "KM_VLC" + }, + { + "from": "KM_Video", + "to": "System.Math" + }, + { + "from": "KM_Video", + "to": "dglOpenGL" + }, + { + "from": "KM_Video", + "to": "KM_Render" + }, + { + "from": "KM_Video", + "to": "KM_RenderTypes" + }, + { + "from": "KM_Video", + "to": "KM_RenderUI" + }, + { + "from": "KM_Video", + "to": "KM_ResLocales" + }, + { + "from": "KM_Video", + "to": "KM_GameApp" + }, + { + "from": "KM_Video", + "to": "KM_GameSettings" + }, + { + "from": "KM_Video", + "to": "KM_Music" + }, + { + "from": "KM_Video", + "to": "KM_Sound" + }, + { + "from": "KM_Video", + "to": "KM_Defaults" + }, + { + "from": "KM_Minimap", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Minimap", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Minimap", + "to": "KM_Defaults" + }, + { + "from": "KM_Minimap", + "to": "KM_Points" + }, + { + "from": "KM_Minimap", + "to": "SysUtils" + }, + { + "from": "KM_Minimap", + "to": "Math" + }, + { + "from": "KM_Minimap", + "to": "KromUtils" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Alerts" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Minimap" + }, + { + "from": "KM_MinimapGame", + "to": "Math" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Terrain" + }, + { + "from": "KM_MinimapGame", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Game" + }, + { + "from": "KM_MinimapGame", + "to": "KM_GameParams" + }, + { + "from": "KM_MinimapGame", + "to": "KM_HandsCollection" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Hand" + }, + { + "from": "KM_MinimapGame", + "to": "KM_HandTypes" + }, + { + "from": "KM_MinimapGame", + "to": "KM_HandEntity" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Units" + }, + { + "from": "KM_MinimapGame", + "to": "KM_UnitGroup" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Resource" + }, + { + "from": "KM_MinimapGame", + "to": "KM_ResUnits" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Defaults" + }, + { + "from": "KM_MinimapGame", + "to": "KM_Points" + }, + { + "from": "KM_MinimapGame", + "to": "KM_CommonTypes" + }, + { + "from": "KM_MinimapGame", + "to": "KM_CommonUtils" + }, + { + "from": "KM_MinimapGame", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_MinimapGame", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_MinimapMission", + "to": "KM_Minimap" + }, + { + "from": "KM_MinimapMission", + "to": "KM_MissionScript_Preview" + }, + { + "from": "KM_MinimapMission", + "to": "KM_Defaults" + }, + { + "from": "KM_MinimapMission", + "to": "SysUtils" + }, + { + "from": "KM_MinimapMission", + "to": "Math" + }, + { + "from": "KM_MinimapMission", + "to": "KM_Resource" + }, + { + "from": "KM_MinimapMission", + "to": "KM_HandTypes" + }, + { + "from": "KM_CampaignClasses", + "to": "KM_CommonClasses" + }, + { + "from": "KM_CampaignClasses", + "to": "SysUtils" + }, + { + "from": "KM_CampaignUtils", + "to": "SysUtils" + }, + { + "from": "KM_Campaigns", + "to": "Classes" + }, + { + "from": "KM_Campaigns", + "to": "Generics.Collections" + }, + { + "from": "KM_Campaigns", + "to": "Generics.Defaults" + }, + { + "from": "KM_Campaigns", + "to": "SyncObjs" + }, + { + "from": "KM_Campaigns", + "to": "KM_ResTexts" + }, + { + "from": "KM_Campaigns", + "to": "KM_Pics" + }, + { + "from": "KM_Campaigns", + "to": "KM_Maps" + }, + { + "from": "KM_Campaigns", + "to": "KM_MapTypes" + }, + { + "from": "KM_Campaigns", + "to": "KM_CampaignClasses" + }, + { + "from": "KM_Campaigns", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Campaigns", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Campaigns", + "to": "KM_Points" + }, + { + "from": "KM_Campaigns", + "to": "SysUtils" + }, + { + "from": "KM_Campaigns", + "to": "Math" + }, + { + "from": "KM_Campaigns", + "to": "KromUtils" + }, + { + "from": "KM_Campaigns", + "to": "KM_GameParams" + }, + { + "from": "KM_Campaigns", + "to": "KM_CampaignUtils" + }, + { + "from": "KM_Campaigns", + "to": "KM_CampaignTypes" + }, + { + "from": "KM_Campaigns", + "to": "KM_Resource" + }, + { + "from": "KM_Campaigns", + "to": "KM_ResLocales" + }, + { + "from": "KM_Campaigns", + "to": "KM_ResSprites" + }, + { + "from": "KM_Campaigns", + "to": "KM_ResTypes" + }, + { + "from": "KM_Campaigns", + "to": "KM_Log" + }, + { + "from": "KM_Campaigns", + "to": "KM_Defaults" + }, + { + "from": "KM_Campaigns", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Campaigns", + "to": "KM_FileIO" + }, + { + "from": "KM_Campaigns", + "to": "KM_IoXML" + }, + { + "from": "KM_MapTypes", + "to": "KM_Defaults" + }, + { + "from": "KM_MapTypes", + "to": "KM_CommonTypes" + }, + { + "from": "KM_MapTypes", + "to": "KM_ResTypes" + }, + { + "from": "KM_MapUtils", + "to": "KM_Defaults" + }, + { + "from": "KM_MapUtils", + "to": "KM_MapTypes" + }, + { + "from": "KM_MapUtils", + "to": "SysUtils" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_Defaults" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_Maps" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_MapTypes" + }, + { + "from": "KM_MapUtilsExt", + "to": "SysUtils" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_Resource" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_ResTexts" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_ResHouses" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_ResTypes" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_CommonShellUtils" + }, + { + "from": "KM_MapUtilsExt", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Maps", + "to": "Classes" + }, + { + "from": "KM_Maps", + "to": "SyncObjs" + }, + { + "from": "KM_Maps", + "to": "KM_MapTypes" + }, + { + "from": "KM_Maps", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Maps", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Maps", + "to": "KM_Defaults" + }, + { + "from": "KM_Maps", + "to": "KM_Pics" + }, + { + "from": "KM_Maps", + "to": "KM_ResTexts" + }, + { + "from": "KM_Maps", + "to": "KM_Points" + }, + { + "from": "KM_Maps", + "to": "SysUtils" + }, + { + "from": "KM_Maps", + "to": "StrUtils" + }, + { + "from": "KM_Maps", + "to": "TypInfo" + }, + { + "from": "KM_Maps", + "to": "Math" + }, + { + "from": "KM_Maps", + "to": "KromUtils" + }, + { + "from": "KM_Maps", + "to": "KM_GameSettings" + }, + { + "from": "KM_Maps", + "to": "KM_FileIO" + }, + { + "from": "KM_Maps", + "to": "KM_MissionScript_Info" + }, + { + "from": "KM_Maps", + "to": "KM_ScriptPreProcessor" + }, + { + "from": "KM_Maps", + "to": "KM_ScriptFilesCollection" + }, + { + "from": "KM_Maps", + "to": "KM_ResLocales" + }, + { + "from": "KM_Maps", + "to": "KM_ResTypes" + }, + { + "from": "KM_Maps", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Maps", + "to": "KM_Log" + }, + { + "from": "KM_Maps", + "to": "KM_MapUtils" + }, + { + "from": "KM_Maps", + "to": "KM_Utils" + }, + { + "from": "KM_MissionScript", + "to": "KM_Defaults" + }, + { + "from": "KM_MissionScript", + "to": "Classes" + }, + { + "from": "KM_MissionScript", + "to": "SysUtils" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_MissionScript" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_Maps" + }, + { + "from": "KM_MissionScript_Info", + "to": "SysUtils" + }, + { + "from": "KM_MissionScript_Info", + "to": "Math" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_Resource" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_Defaults" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_Utils" + }, + { + "from": "KM_MissionScript_Info", + "to": "KM_MapTypes" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_MissionScript" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_Defaults" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_Points" + }, + { + "from": "KM_MissionScript_Preview", + "to": "Classes" + }, + { + "from": "KM_MissionScript_Preview", + "to": "SysUtils" + }, + { + "from": "KM_MissionScript_Preview", + "to": "Math" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_TerrainUtils" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_HandTypes" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_Resource" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_ResHouses" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_ResUnits" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_CommonUtils" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_Utils" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_ResTypes" + }, + { + "from": "KM_MissionScript_Preview", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "Generics.Collections" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_MissionScript" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_UnitGroup" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Units" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Houses" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_AIAttacks" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Points" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Defaults" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "Classes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "SysUtils" + }, + { + "from": "KM_MissionScript_Standard", + "to": "Math" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KromUtils" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Hand" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HandEntity" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Game" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_GameParams" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_GameTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HandsCollection" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HouseCollection" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HouseStore" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_AI" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Resource" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_ResHouses" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_ResUnits" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_ResWares" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_CommonTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_Terrain" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_HandTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_ResTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_MapTypes" + }, + { + "from": "KM_MissionScript_Standard", + "to": "KM_AITypes" + }, + { + "from": "KM_NavMesh", + "to": "KromUtils" + }, + { + "from": "KM_NavMesh", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NavMesh", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMesh", + "to": "KM_Points" + }, + { + "from": "KM_NavMesh", + "to": "KM_NavMeshDefences" + }, + { + "from": "KM_NavMesh", + "to": "KM_NavMeshGenerator" + }, + { + "from": "KM_NavMesh", + "to": "KM_NavMeshFloodPositioning" + }, + { + "from": "KM_NavMesh", + "to": "KM_NavMeshPathFinding" + }, + { + "from": "KM_NavMesh", + "to": "SysUtils" + }, + { + "from": "KM_NavMesh", + "to": "Math" + }, + { + "from": "KM_NavMesh", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMesh", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NavMesh", + "to": "KM_Terrain" + }, + { + "from": "KM_NavMesh", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMesh", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "Math" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_UnitGroup" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_Houses" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_ResHouses" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "SysUtils" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_Hand" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_HandsCollection" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_NavMesh" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_AIParameters" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "DateUtils" + }, + { + "from": "KM_NavMeshArmyPositioning", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "Math" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_UnitGroup" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_Houses" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_ArmyAttackNew" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "SysUtils" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_Hand" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_HandsCollection" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_HandTypes" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_HandEntity" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_Terrain" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_NavMesh" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_AIParameters" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "DateUtils" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMeshArmyVectorField", + "to": "KM_ResTypes" + }, + { + "from": "KM_NavMeshDefences", + "to": "Math" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_NavMeshDefences", + "to": "SysUtils" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_Hand" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_HandsCollection" + }, + { + "from": "KM_NavMeshDefences", + "to": "DateUtils" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_AIInfluences" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_NavMesh" + }, + { + "from": "KM_NavMeshDefences", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMeshFloodFill", + "to": "Math" + }, + { + "from": "KM_NavMeshFloodFill", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshFloodFill", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshFloodFill", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshFloodPositioning", + "to": "Math" + }, + { + "from": "KM_NavMeshFloodPositioning", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshFloodPositioning", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshFloodPositioning", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_NavMeshFloodPositioning", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshGenerator", + "to": "Windows" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KromUtils" + }, + { + "from": "KM_NavMeshGenerator", + "to": "SysUtils" + }, + { + "from": "KM_NavMeshGenerator", + "to": "Math" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMeshGenerator", + "to": "KM_Terrain" + }, + { + "from": "KM_NavMeshInfluences", + "to": "Math" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_NavMeshFloodFill" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_AIInfluences" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_NavMesh" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_Hand" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_HandsCollection" + }, + { + "from": "KM_NavMeshInfluences", + "to": "KM_ResTypes" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "Math" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_Points" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "BinaryHeap" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_Defaults" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_AIFields" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_NavMesh" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_NavMeshGenerator" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_AIParameters" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_RenderAux" + }, + { + "from": "KM_NavMeshPathFinding", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Outline", + "to": "KM_PolySimplify" + }, + { + "from": "KM_Outline", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Outline", + "to": "Math" + }, + { + "from": "KM_Outline", + "to": "KM_Points" + }, + { + "from": "KM_PolySimplify", + "to": "KM_Points" + }, + { + "from": "KM_PolySimplify", + "to": "SysUtils" + }, + { + "from": "KM_PolySimplify", + "to": "Math" + }, + { + "from": "KM_PolySimplify", + "to": "PolyTriangulate" + }, + { + "from": "KM_NetAuthUnsecure", + "to": "Classes" + }, + { + "from": "KM_NetAuthUnsecure", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetClient", + "to": "Classes" + }, + { + "from": "KM_NetClient", + "to": "SysUtils" + }, + { + "from": "KM_NetClient", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetClient", + "to": "KM_NetClientOverbyte" + }, + { + "from": "KM_NetClient", + "to": "KM_NetClientLNet" + }, + { + "from": "KM_NetClientLNet", + "to": "Classes" + }, + { + "from": "KM_NetClientLNet", + "to": "Math" + }, + { + "from": "KM_NetClientLNet", + "to": "SysUtils" + }, + { + "from": "KM_NetClientLNet", + "to": "LNet" + }, + { + "from": "KM_NetClientLNet", + "to": "dialogs" + }, + { + "from": "KM_NetClientOverbyte", + "to": "Classes" + }, + { + "from": "KM_NetClientOverbyte", + "to": "SysUtils" + }, + { + "from": "KM_NetClientOverbyte", + "to": "OverbyteIcsWSocket" + }, + { + "from": "KM_NetClientOverbyte", + "to": "OverbyteIcsWndControl" + }, + { + "from": "KM_NetClientOverbyte", + "to": "WinSock" + }, + { + "from": "KM_NetConsts", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetDedicatedServer", + "to": "SysUtils" + }, + { + "from": "KM_NetDedicatedServer", + "to": "Classes" + }, + { + "from": "KM_NetDedicatedServer", + "to": "Math" + }, + { + "from": "KM_NetDedicatedServer", + "to": "Windows" + }, + { + "from": "KM_NetDedicatedServer", + "to": "KM_NetServer" + }, + { + "from": "KM_NetDedicatedServer", + "to": "KM_NetServerLocator" + }, + { + "from": "KM_NetDedicatedServer", + "to": "KM_NetUDP" + }, + { + "from": "KM_NetDedicatedServer", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NetDedicatedServer", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NetFileTransfer", + "to": "SysUtils" + }, + { + "from": "KM_NetFileTransfer", + "to": "Math" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_Defaults" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_MapTypes" + }, + { + "from": "KM_NetFileTransfer", + "to": "zstream" + }, + { + "from": "KM_NetFileTransfer", + "to": "ZLib" + }, + { + "from": "KM_NetFileTransfer", + "to": "KromUtils" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_Maps" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_Saves" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_ScriptPreProcessor" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_ScriptFilesCollection" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_Log" + }, + { + "from": "KM_NetFileTransfer", + "to": "KM_FileIO" + }, + { + "from": "KM_NetGameInfo", + "to": "Classes" + }, + { + "from": "KM_NetGameInfo", + "to": "SysUtils" + }, + { + "from": "KM_NetGameInfo", + "to": "StrUtils" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_Defaults" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_GameOptions" + }, + { + "from": "KM_NetGameInfo", + "to": "VerySimpleXML" + }, + { + "from": "KM_NetGameInfo", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NetRoom", + "to": "Classes" + }, + { + "from": "KM_NetRoom", + "to": "KromUtils" + }, + { + "from": "KM_NetRoom", + "to": "StrUtils" + }, + { + "from": "KM_NetRoom", + "to": "Math" + }, + { + "from": "KM_NetRoom", + "to": "SysUtils" + }, + { + "from": "KM_NetRoom", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetRoom", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NetRoom", + "to": "KM_Defaults" + }, + { + "from": "KM_NetRoom", + "to": "KM_Hand" + }, + { + "from": "KM_NetRoom", + "to": "KM_ResLocales" + }, + { + "from": "KM_NetRoom", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetRoom", + "to": "KM_HandTypes" + }, + { + "from": "KM_NetRoom", + "to": "TypInfo" + }, + { + "from": "KM_NetRoom", + "to": "KM_Log" + }, + { + "from": "KM_NetRoom", + "to": "KM_ResTexts" + }, + { + "from": "KM_NetRoom", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NetRoom", + "to": "KM_HandsCollection" + }, + { + "from": "KM_NetServer", + "to": "Windows" + }, + { + "from": "KM_NetServer", + "to": "KM_NetServerOverbyte" + }, + { + "from": "KM_NetServer", + "to": "KM_NetServerLNet" + }, + { + "from": "KM_NetServer", + "to": "Classes" + }, + { + "from": "KM_NetServer", + "to": "SysUtils" + }, + { + "from": "KM_NetServer", + "to": "Math" + }, + { + "from": "KM_NetServer", + "to": "VerySimpleXML" + }, + { + "from": "KM_NetServer", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetServer", + "to": "KM_NetGameInfo" + }, + { + "from": "KM_NetServer", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetServer", + "to": "KM_Defaults" + }, + { + "from": "KM_NetServer", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NetServer", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NetServer", + "to": "KM_ConsoleTimer" + }, + { + "from": "KM_NetServer", + "to": "cthreads" + }, + { + "from": "KM_NetServerLNet", + "to": "Classes" + }, + { + "from": "KM_NetServerLNet", + "to": "SysUtils" + }, + { + "from": "KM_NetServerLNet", + "to": "lNet" + }, + { + "from": "KM_NetServerLNet", + "to": "Math" + }, + { + "from": "KM_NetServerLocator", + "to": "Classes" + }, + { + "from": "KM_NetServerLocator", + "to": "KM_HTTPClient" + }, + { + "from": "KM_NetServerLocator", + "to": "SysUtils" + }, + { + "from": "KM_NetServerLocator", + "to": "URLUtils" + }, + { + "from": "KM_NetServerLocator", + "to": "KM_Defaults" + }, + { + "from": "KM_NetServerOverbyte", + "to": "Classes" + }, + { + "from": "KM_NetServerOverbyte", + "to": "SysUtils" + }, + { + "from": "KM_NetServerOverbyte", + "to": "OverbyteIcsWSocket" + }, + { + "from": "KM_NetServerOverbyte", + "to": "OverbyteIcsWSocketS" + }, + { + "from": "KM_NetServerOverbyte", + "to": "WinSock" + }, + { + "from": "KM_NetServerOverbyte", + "to": "Math" + }, + { + "from": "KM_NetServerPoller", + "to": "Classes" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_CommonTypes" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetClient" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetServerLocator" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetUDP" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetTypes" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetGameInfo" + }, + { + "from": "KM_NetServerPoller", + "to": "SysUtils" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_Defaults" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_CommonUtils" + }, + { + "from": "KM_NetServerPoller", + "to": "KM_NetworkUtils" + }, + { + "from": "KM_NetTypes", + "to": "Math" + }, + { + "from": "KM_NetTypes", + "to": "KM_Points" + }, + { + "from": "KM_NetTypes", + "to": "KM_Lists" + }, + { + "from": "KM_NetTypes", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetTypes", + "to": "SysUtils" + }, + { + "from": "KM_NetUDP", + "to": "Classes" + }, + { + "from": "KM_NetUDP", + "to": "Math" + }, + { + "from": "KM_NetUDP", + "to": "SysUtils" + }, + { + "from": "KM_NetUDP", + "to": "KM_CommonClasses" + }, + { + "from": "KM_NetUDP", + "to": "KM_Defaults" + }, + { + "from": "KM_NetUDP", + "to": "KM_NetUDPOverbyte" + }, + { + "from": "KM_NetUDP", + "to": "KM_NetUDPLNet" + }, + { + "from": "KM_NetUDPLNet", + "to": "Classes" + }, + { + "from": "KM_NetUDPLNet", + "to": "Math" + }, + { + "from": "KM_NetUDPLNet", + "to": "SysUtils" + }, + { + "from": "KM_NetUDPLNet", + "to": "LNet" + }, + { + "from": "KM_NetUDPOverbyte", + "to": "Classes" + }, + { + "from": "KM_NetUDPOverbyte", + "to": "Math" + }, + { + "from": "KM_NetUDPOverbyte", + "to": "SysUtils" + }, + { + "from": "KM_NetUDPOverbyte", + "to": "OverbyteIcsWSocket" + }, + { + "from": "KM_NetUDPOverbyte", + "to": "OverbyteIcsWinSock" + }, + { + "from": "KM_NetworkUtils", + "to": "StrUtils" + }, + { + "from": "KM_NetworkUtils", + "to": "SysUtils" + }, + { + "from": "KM_Networking", + "to": "LCLIntf" + }, + { + "from": "KM_Networking", + "to": "Classes" + }, + { + "from": "KM_Networking", + "to": "SysUtils" + }, + { + "from": "KM_Networking", + "to": "TypInfo" + }, + { + "from": "KM_Networking", + "to": "Generics.Collections" + }, + { + "from": "KM_Networking", + "to": "KromUtils" + }, + { + "from": "KM_Networking", + "to": "KM_Console" + }, + { + "from": "KM_Networking", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Networking", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Networking", + "to": "KM_NetGameInfo" + }, + { + "from": "KM_Networking", + "to": "KM_NetTypes" + }, + { + "from": "KM_Networking", + "to": "KM_Defaults" + }, + { + "from": "KM_Networking", + "to": "KM_Points" + }, + { + "from": "KM_Networking", + "to": "KM_Saves" + }, + { + "from": "KM_Networking", + "to": "KM_GameOptions" + }, + { + "from": "KM_Networking", + "to": "KM_ResLocales" + }, + { + "from": "KM_Networking", + "to": "KM_NetFileTransfer" + }, + { + "from": "KM_Networking", + "to": "KM_Maps" + }, + { + "from": "KM_Networking", + "to": "KM_MapTypes" + }, + { + "from": "KM_Networking", + "to": "KM_NetRoom" + }, + { + "from": "KM_Networking", + "to": "KM_NetDedicatedServer" + }, + { + "from": "KM_Networking", + "to": "KM_NetClient" + }, + { + "from": "KM_Networking", + "to": "KM_NetServerPoller" + }, + { + "from": "KM_Networking", + "to": "KM_NetAuthUnsecure" + }, + { + "from": "KM_Networking", + "to": "Math" + }, + { + "from": "KM_Networking", + "to": "StrUtils" + }, + { + "from": "KM_Networking", + "to": "KM_NetConsts" + }, + { + "from": "KM_Networking", + "to": "KM_Sound" + }, + { + "from": "KM_Networking", + "to": "KM_Log" + }, + { + "from": "KM_Networking", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Networking", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Networking", + "to": "KM_Hand" + }, + { + "from": "KM_Networking", + "to": "KM_System" + }, + { + "from": "KM_Networking", + "to": "KM_GameApp" + }, + { + "from": "KM_Networking", + "to": "KM_GameSettings" + }, + { + "from": "KM_Networking", + "to": "KM_Resource" + }, + { + "from": "KM_Networking", + "to": "KM_ResSound" + }, + { + "from": "KM_Networking", + "to": "KM_ResTexts" + }, + { + "from": "KM_Networking", + "to": "KM_NetworkUtils" + }, + { + "from": "KM_HTTPClient", + "to": "Classes" + }, + { + "from": "KM_HTTPClient", + "to": "SysUtils" + }, + { + "from": "KM_HTTPClient", + "to": "KM_HTTPClientOverbyte" + }, + { + "from": "KM_HTTPClient", + "to": "KM_HTTPClientLNet" + }, + { + "from": "KM_HTTPClientLNet", + "to": "Classes" + }, + { + "from": "KM_HTTPClientLNet", + "to": "SysUtils" + }, + { + "from": "KM_HTTPClientLNet", + "to": "lNet" + }, + { + "from": "KM_HTTPClientLNet", + "to": "URLUtils" + }, + { + "from": "KM_HTTPClientLNet", + "to": "lHTTP" + }, + { + "from": "KM_HTTPClientOverbyte", + "to": "Classes" + }, + { + "from": "KM_HTTPClientOverbyte", + "to": "SysUtils" + }, + { + "from": "KM_HTTPClientOverbyte", + "to": "OverbyteIcsHttpProt" + }, + { + "from": "KM_PathFinding", + "to": "SysUtils" + }, + { + "from": "KM_PathFinding", + "to": "Math" + }, + { + "from": "KM_PathFinding", + "to": "KromUtils" + }, + { + "from": "KM_PathFinding", + "to": "KM_CommonClasses" + }, + { + "from": "KM_PathFinding", + "to": "KM_Defaults" + }, + { + "from": "KM_PathFinding", + "to": "KM_Houses" + }, + { + "from": "KM_PathFinding", + "to": "KM_Terrain" + }, + { + "from": "KM_PathFinding", + "to": "KM_Points" + }, + { + "from": "KM_PathFinding", + "to": "KM_Units" + }, + { + "from": "KM_PathFinding", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_PathFinding", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "SysUtils" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "Math" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "KM_PathFinding" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "KM_CommonClasses" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "KM_Defaults" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "KM_Terrain" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "KM_Points" + }, + { + "from": "KM_PathFindingAStarNew", + "to": "BinaryHeap" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "SysUtils" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "Math" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "KM_PathFinding" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "KM_CommonClasses" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "KM_Defaults" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "KM_Terrain" + }, + { + "from": "KM_PathFindingAStarOld", + "to": "KM_Points" + }, + { + "from": "KM_PathFindingJPS", + "to": "Types" + }, + { + "from": "KM_PathFindingJPS", + "to": "Math" + }, + { + "from": "KM_PathFindingJPS", + "to": "SysUtils" + }, + { + "from": "KM_PathFindingJPS", + "to": "KM_PathFinding" + }, + { + "from": "KM_PathFindingJPS", + "to": "BinaryHeap" + }, + { + "from": "KM_PathFindingJPS", + "to": "KM_Points" + }, + { + "from": "KM_PathFindingJPS", + "to": "KM_CommonClasses" + }, + { + "from": "KM_PathFindingJPS", + "to": "KM_Terrain" + }, + { + "from": "KM_PathFindingRoad", + "to": "SysUtils" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_CommonClasses" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_Defaults" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_PathFinding" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_PathFindingAStarNew" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_Points" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_HandsCollection" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_Terrain" + }, + { + "from": "KM_PathFindingRoad", + "to": "KM_Hand" + }, + { + "from": "KM_DevPerfLog", + "to": "Classes" + }, + { + "from": "KM_DevPerfLog", + "to": "Math" + }, + { + "from": "KM_DevPerfLog", + "to": "StrUtils" + }, + { + "from": "KM_DevPerfLog", + "to": "SysUtils" + }, + { + "from": "KM_DevPerfLog", + "to": "Forms" + }, + { + "from": "KM_DevPerfLog", + "to": "Controls" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_CommonTypes" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_DevPerfLogSingle" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_DevPerfLogStack" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_DevPerfLogForm" + }, + { + "from": "KM_DevPerfLog", + "to": "TypInfo" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_Defaults" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_RenderUI" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_RenderAux" + }, + { + "from": "KM_DevPerfLog", + "to": "KM_ResFonts" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Classes" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Graphics" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Forms" + }, + { + "from": "KM_DevPerfLogForm", + "to": "StdCtrls" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Controls" + }, + { + "from": "KM_DevPerfLogForm", + "to": "ExtCtrls" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Types" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_CommonTypes" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Spin" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_VclHelpers" + }, + { + "from": "KM_DevPerfLogForm", + "to": "System.SysUtils" + }, + { + "from": "KM_DevPerfLogForm", + "to": "System.TypInfo" + }, + { + "from": "KM_DevPerfLogForm", + "to": "System.Math" + }, + { + "from": "KM_DevPerfLogForm", + "to": "Windows" + }, + { + "from": "KM_DevPerfLogForm", + "to": "LCLIntf" + }, + { + "from": "KM_DevPerfLogForm", + "to": "LCLType" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_Defaults" + }, + { + "from": "KM_DevPerfLogForm", + "to": "KM_CommonUtils" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "Classes" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "Math" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "StrUtils" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "SysUtils" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_CommonTypes" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_CommonUtils" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_Points" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_Resource" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_ResFonts" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_RenderAux" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_Render" + }, + { + "from": "KM_DevPerfLogSingle", + "to": "KM_RenderUI" + }, + { + "from": "KM_DevPerfLogStack", + "to": "Classes" + }, + { + "from": "KM_DevPerfLogStack", + "to": "Math" + }, + { + "from": "KM_DevPerfLogStack", + "to": "StrUtils" + }, + { + "from": "KM_DevPerfLogStack", + "to": "SysUtils" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KromUtils" + }, + { + "from": "KM_DevPerfLogStack", + "to": "System.Generics.Collections" + }, + { + "from": "KM_DevPerfLogStack", + "to": "Generics.Collections" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_Render" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_RenderAux" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_RenderUI" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_Points" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_CommonUtils" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_CommonTypes" + }, + { + "from": "KM_DevPerfLogStack", + "to": "KM_ResFonts" + }, + { + "from": "KM_DevPerfLogTypes", + "to": "KM_CommonTypes" + }, + { + "from": "KM_DevPerfLogTypes", + "to": "TypInfo" + }, + { + "from": "KM_Render", + "to": "Windows" + }, + { + "from": "KM_Render", + "to": "LCLIntf" + }, + { + "from": "KM_Render", + "to": "LCLType" + }, + { + "from": "KM_Render", + "to": "OpenGLContext" + }, + { + "from": "KM_Render", + "to": "dglOpenGL" + }, + { + "from": "KM_Render", + "to": "KM_RenderControl" + }, + { + "from": "KM_Render", + "to": "KM_RenderQuery" + }, + { + "from": "KM_Render", + "to": "KM_RenderTypes" + }, + { + "from": "KM_Render", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Render", + "to": "SysUtils" + }, + { + "from": "KM_Render", + "to": "Math" + }, + { + "from": "KM_Render", + "to": "KromOGLUtils" + }, + { + "from": "KM_Render", + "to": "KromUtils" + }, + { + "from": "KM_Render", + "to": "KM_Log" + }, + { + "from": "KM_Render", + "to": "KM_Defaults" + }, + { + "from": "KM_Render", + "to": "KM_IoPNG" + }, + { + "from": "KM_Render", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RenderAux", + "to": "KromOGLUtils" + }, + { + "from": "KM_RenderAux", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RenderAux", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RenderAux", + "to": "KM_Points" + }, + { + "from": "KM_RenderAux", + "to": "SysUtils" + }, + { + "from": "KM_RenderAux", + "to": "Math" + }, + { + "from": "KM_RenderAux", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderAux", + "to": "KromUtils" + }, + { + "from": "KM_RenderAux", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderAux", + "to": "KM_GameParams" + }, + { + "from": "KM_RenderAux", + "to": "KM_Render" + }, + { + "from": "KM_RenderAux", + "to": "KM_Terrain" + }, + { + "from": "KM_RenderAux", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_RenderAux", + "to": "KM_ResTileset" + }, + { + "from": "KM_RenderAux", + "to": "KM_CommonUtils" + }, + { + "from": "KM_RenderControl", + "to": "Classes" + }, + { + "from": "KM_RenderControl", + "to": "Types" + }, + { + "from": "KM_RenderControl", + "to": "ExtCtrls" + }, + { + "from": "KM_RenderControl", + "to": "Forms" + }, + { + "from": "KM_RenderControl", + "to": "KromOGLUtils" + }, + { + "from": "KM_RenderControl", + "to": "Windows" + }, + { + "from": "KM_RenderControl", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderControl", + "to": "OpenGLContext" + }, + { + "from": "KM_RenderControl", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderControl", + "to": "Messages" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Points" + }, + { + "from": "KM_RenderDebug", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RenderDebug", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RenderDebug", + "to": "Generics.Collections" + }, + { + "from": "KM_RenderDebug", + "to": "KM_MarchingSquares" + }, + { + "from": "KM_RenderDebug", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_RenderDebug", + "to": "Math" + }, + { + "from": "KM_RenderDebug", + "to": "SysUtils" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Game" + }, + { + "from": "KM_RenderDebug", + "to": "KM_RenderAux" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Resource" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Terrain" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Houses" + }, + { + "from": "KM_RenderDebug", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_RenderDebug", + "to": "KM_ResUnits" + }, + { + "from": "KM_RenderDebug", + "to": "KM_HandsCollection" + }, + { + "from": "KM_RenderDebug", + "to": "KM_Hand" + }, + { + "from": "KM_RenderDebug", + "to": "KM_CommonUtils" + }, + { + "from": "KM_RenderDebug", + "to": "KM_ResTypes" + }, + { + "from": "KM_RenderDebug", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_RenderDebug", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Points" + }, + { + "from": "KM_RenderGameAux", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderGameAux", + "to": "SysUtils" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Entity" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_RenderAux" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Game" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_GameParams" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Units" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Terrain" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Resource" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderGameAux", + "to": "KM_CommonUtils" + }, + { + "from": "KM_RenderPool", + "to": "LCLIntf" + }, + { + "from": "KM_RenderPool", + "to": "LCLType" + }, + { + "from": "KM_RenderPool", + "to": "KromOGLUtils" + }, + { + "from": "KM_RenderPool", + "to": "KromUtils" + }, + { + "from": "KM_RenderPool", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderPool", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RenderPool", + "to": "KM_Pics" + }, + { + "from": "KM_RenderPool", + "to": "KM_Points" + }, + { + "from": "KM_RenderPool", + "to": "KM_Render" + }, + { + "from": "KM_RenderPool", + "to": "KM_Viewport" + }, + { + "from": "KM_RenderPool", + "to": "KM_RenderTerrain" + }, + { + "from": "KM_RenderPool", + "to": "KM_Units" + }, + { + "from": "KM_RenderPool", + "to": "KM_HandEntity" + }, + { + "from": "KM_RenderPool", + "to": "KM_Houses" + }, + { + "from": "KM_RenderPool", + "to": "KM_CommonGameTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_RenderDebug" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResTypes" + }, + { + "from": "KM_RenderPool", + "to": "Classes" + }, + { + "from": "KM_RenderPool", + "to": "SysUtils" + }, + { + "from": "KM_RenderPool", + "to": "Math" + }, + { + "from": "KM_RenderPool", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderPool", + "to": "KM_Entity" + }, + { + "from": "KM_RenderPool", + "to": "KM_RenderAux" + }, + { + "from": "KM_RenderPool", + "to": "KM_RenderGameAux" + }, + { + "from": "KM_RenderPool", + "to": "KM_HandsCollection" + }, + { + "from": "KM_RenderPool", + "to": "KM_Game" + }, + { + "from": "KM_RenderPool", + "to": "KM_GameSettings" + }, + { + "from": "KM_RenderPool", + "to": "KM_Sound" + }, + { + "from": "KM_RenderPool", + "to": "KM_AIFields" + }, + { + "from": "KM_RenderPool", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_RenderPool", + "to": "KM_Cursor" + }, + { + "from": "KM_RenderPool", + "to": "KM_Hand" + }, + { + "from": "KM_RenderPool", + "to": "KM_UnitGroup" + }, + { + "from": "KM_RenderPool", + "to": "KM_CommonUtils" + }, + { + "from": "KM_RenderPool", + "to": "KM_GameParams" + }, + { + "from": "KM_RenderPool", + "to": "KM_Utils" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_RenderPool", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_HandTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_Projectiles" + }, + { + "from": "KM_RenderPool", + "to": "KM_Terrain" + }, + { + "from": "KM_RenderPool", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_RenderPool", + "to": "KM_Resource" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResHouses" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResInterpolation" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResMapElements" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResSprites" + }, + { + "from": "KM_RenderPool", + "to": "KM_ResUnits" + }, + { + "from": "KM_RenderPool", + "to": "KM_AITypes" + }, + { + "from": "KM_RenderQuery", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderTerrain", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderTerrain", + "to": "SysUtils" + }, + { + "from": "KM_RenderTerrain", + "to": "Math" + }, + { + "from": "KM_RenderTerrain", + "to": "KromUtils" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_ResSprites" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Points" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_FogOfWar" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Pics" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Game" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_GameParams" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Render" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_RenderTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Resource" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_ResTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_RenderTerrain", + "to": "KM_Terrain" + }, + { + "from": "KM_RenderTypes", + "to": "KM_CommonGameTypes" + }, + { + "from": "KM_RenderTypes", + "to": "KM_Points" + }, + { + "from": "KM_RenderUI", + "to": "System.Generics.Collections" + }, + { + "from": "KM_RenderUI", + "to": "Generics.Collections" + }, + { + "from": "KM_RenderUI", + "to": "KromOGLUtils" + }, + { + "from": "KM_RenderUI", + "to": "KM_Defaults" + }, + { + "from": "KM_RenderUI", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RenderUI", + "to": "KM_Points" + }, + { + "from": "KM_RenderUI", + "to": "KM_ResTypes" + }, + { + "from": "KM_RenderUI", + "to": "KM_RenderTypes" + }, + { + "from": "KM_RenderUI", + "to": "KM_ResFonts" + }, + { + "from": "KM_RenderUI", + "to": "Math" + }, + { + "from": "KM_RenderUI", + "to": "StrUtils" + }, + { + "from": "KM_RenderUI", + "to": "SysUtils" + }, + { + "from": "KM_RenderUI", + "to": "dglOpenGL" + }, + { + "from": "KM_RenderUI", + "to": "KM_Render" + }, + { + "from": "KM_RenderUI", + "to": "KM_Resource" + }, + { + "from": "KM_RenderUI", + "to": "KM_ResSprites" + }, + { + "from": "KM_Pics", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResCursors", + "to": "Math" + }, + { + "from": "KM_ResCursors", + "to": "SysUtils" + }, + { + "from": "KM_ResCursors", + "to": "Classes" + }, + { + "from": "KM_ResCursors", + "to": "KM_Points" + }, + { + "from": "KM_ResCursors", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResCursors", + "to": "KM_Defaults" + }, + { + "from": "KM_ResExporter", + "to": "SysUtils" + }, + { + "from": "KM_ResExporter", + "to": "Classes" + }, + { + "from": "KM_ResExporter", + "to": "Generics.Collections" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResSprites" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResExporter", + "to": "KM_WorkerThread" + }, + { + "from": "KM_ResExporter", + "to": "KM_Defaults" + }, + { + "from": "KM_ResExporter", + "to": "TypInfo" + }, + { + "from": "KM_ResExporter", + "to": "KromUtils" + }, + { + "from": "KM_ResExporter", + "to": "KM_Resource" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResUnits" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResHouses" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResMapElements" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResExporter", + "to": "KM_ResInterpolation" + }, + { + "from": "KM_ResExporter", + "to": "KM_FileIO" + }, + { + "from": "KM_ResExporter", + "to": "KM_IoPNG" + }, + { + "from": "KM_ResExporter", + "to": "KM_Points" + }, + { + "from": "KM_ResExporter", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResExporter", + "to": "KM_Log" + }, + { + "from": "KM_ResFonts", + "to": "SysUtils" + }, + { + "from": "KM_ResFonts", + "to": "Graphics" + }, + { + "from": "KM_ResFonts", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResFonts", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ResFonts", + "to": "KM_Points" + }, + { + "from": "KM_ResFonts", + "to": "KM_ResPalettes" + }, + { + "from": "KM_ResFonts", + "to": "Classes" + }, + { + "from": "KM_ResFonts", + "to": "Math" + }, + { + "from": "KM_ResFonts", + "to": "StrUtils" + }, + { + "from": "KM_ResFonts", + "to": "zstream" + }, + { + "from": "KM_ResFonts", + "to": "ZLib" + }, + { + "from": "KM_ResFonts", + "to": "KM_Defaults" + }, + { + "from": "KM_ResFonts", + "to": "KM_IoPNG" + }, + { + "from": "KM_ResFonts", + "to": "KM_Render" + }, + { + "from": "KM_ResFonts", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ResFonts", + "to": "KM_Log" + }, + { + "from": "KM_ResFontsEdit", + "to": "Windows" + }, + { + "from": "KM_ResFontsEdit", + "to": "lconvencoding" + }, + { + "from": "KM_ResFontsEdit", + "to": "Classes" + }, + { + "from": "KM_ResFontsEdit", + "to": "Graphics" + }, + { + "from": "KM_ResFontsEdit", + "to": "Math" + }, + { + "from": "KM_ResFontsEdit", + "to": "SysUtils" + }, + { + "from": "KM_ResFontsEdit", + "to": "Types" + }, + { + "from": "KM_ResFontsEdit", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResFontsEdit", + "to": "KM_ResFonts" + }, + { + "from": "KM_ResFontsEdit", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResFontsEdit", + "to": "KM_IoXML" + }, + { + "from": "KM_ResFontsEdit", + "to": "zstream" + }, + { + "from": "KM_ResFontsEdit", + "to": "ZLib" + }, + { + "from": "KM_ResFontsEdit", + "to": "KM_IoPNG" + }, + { + "from": "KM_ResHouses", + "to": "Classes" + }, + { + "from": "KM_ResHouses", + "to": "Math" + }, + { + "from": "KM_ResHouses", + "to": "SysUtils" + }, + { + "from": "KM_ResHouses", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResHouses", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResHouses", + "to": "KM_Defaults" + }, + { + "from": "KM_ResHouses", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResHouses", + "to": "TypInfo" + }, + { + "from": "KM_ResHouses", + "to": "KromUtils" + }, + { + "from": "KM_ResHouses", + "to": "KM_Outline" + }, + { + "from": "KM_ResHouses", + "to": "KM_Points" + }, + { + "from": "KM_ResHouses", + "to": "KM_PolySimplify" + }, + { + "from": "KM_ResHouses", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResHouses", + "to": "KM_ResUnits" + }, + { + "from": "KM_ResInterpolation", + "to": "Classes" + }, + { + "from": "KM_ResInterpolation", + "to": "SysUtils" + }, + { + "from": "KM_ResInterpolation", + "to": "Math" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_Defaults" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_Points" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_ResMapElements" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_ResHouses" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_Resource" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_Pics" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_ResUnits" + }, + { + "from": "KM_ResInterpolation", + "to": "KM_GameSettings" + }, + { + "from": "KM_ResKeyFuncs", + "to": "Classes" + }, + { + "from": "KM_ResKeyFuncs", + "to": "SysUtils" + }, + { + "from": "KM_ResKeyFuncs", + "to": "StrUtils" + }, + { + "from": "KM_ResKeyFuncs", + "to": "Math" + }, + { + "from": "KM_ResKeyFuncs", + "to": "Generics.Collections" + }, + { + "from": "KM_ResKeyFuncs", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResKeyFuncs", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResKeyFuncs", + "to": "KM_KeysSettings" + }, + { + "from": "KM_ResKeyFuncs", + "to": "TypInfo" + }, + { + "from": "KM_ResKeys", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResKeys", + "to": "Math" + }, + { + "from": "KM_ResKeys", + "to": "KM_KeysSettings" + }, + { + "from": "KM_ResKeys", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_ResKeys", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResLocales", + "to": "Classes" + }, + { + "from": "KM_ResLocales", + "to": "Math" + }, + { + "from": "KM_ResLocales", + "to": "SysUtils" + }, + { + "from": "KM_ResLocales", + "to": "StrUtils" + }, + { + "from": "KM_ResLocales", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResLocales", + "to": "KM_Defaults" + }, + { + "from": "KM_ResLocales", + "to": "KM_FileIO" + }, + { + "from": "KM_ResMapElements", + "to": "Classes" + }, + { + "from": "KM_ResMapElements", + "to": "SysUtils" + }, + { + "from": "KM_ResMapElements", + "to": "KromUtils" + }, + { + "from": "KM_ResMapElements", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResMapElements", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResMapElements", + "to": "KM_Defaults" + }, + { + "from": "KM_ResPalettes", + "to": "Classes" + }, + { + "from": "KM_ResPalettes", + "to": "SysUtils" + }, + { + "from": "KM_ResPalettes", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResSound", + "to": "LCLIntf" + }, + { + "from": "KM_ResSound", + "to": "LCLType" + }, + { + "from": "KM_ResSound", + "to": "KM_Defaults" + }, + { + "from": "KM_ResSound", + "to": "System.Classes" + }, + { + "from": "KM_ResSound", + "to": "System.SysUtils" + }, + { + "from": "KM_ResSound", + "to": "System.TypInfo" + }, + { + "from": "KM_ResSound", + "to": "System.Math" + }, + { + "from": "KM_ResSound", + "to": "System.StrUtils" + }, + { + "from": "KM_ResSound", + "to": "KromUtils" + }, + { + "from": "KM_ResSound", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResSprites", + "to": "LCLIntf" + }, + { + "from": "KM_ResSprites", + "to": "LCLType" + }, + { + "from": "KM_ResSprites", + "to": "Classes" + }, + { + "from": "KM_ResSprites", + "to": "Math" + }, + { + "from": "KM_ResSprites", + "to": "SysUtils" + }, + { + "from": "KM_ResSprites", + "to": "Generics.Collections" + }, + { + "from": "KM_ResSprites", + "to": "Graphics" + }, + { + "from": "KM_ResSprites", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResSprites", + "to": "KM_Defaults" + }, + { + "from": "KM_ResSprites", + "to": "KM_Pics" + }, + { + "from": "KM_ResSprites", + "to": "KM_IoPNG" + }, + { + "from": "KM_ResSprites", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResTileset" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResHouses" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_ResSprites", + "to": "KM_BinPacking" + }, + { + "from": "KM_ResSprites", + "to": "zstream" + }, + { + "from": "KM_ResSprites", + "to": "ZLib" + }, + { + "from": "KM_ResSprites", + "to": "Types" + }, + { + "from": "KM_ResSprites", + "to": "IOUtils" + }, + { + "from": "KM_ResSprites", + "to": "StrUtils" + }, + { + "from": "KM_ResSprites", + "to": "KromUtils" + }, + { + "from": "KM_ResSprites", + "to": "KM_SoftShadows" + }, + { + "from": "KM_ResSprites", + "to": "KM_Resource" + }, + { + "from": "KM_ResSprites", + "to": "KM_ResUnits" + }, + { + "from": "KM_ResSprites", + "to": "KM_Render" + }, + { + "from": "KM_ResSprites", + "to": "TypInfo" + }, + { + "from": "KM_ResSprites", + "to": "KM_Log" + }, + { + "from": "KM_ResSprites", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResSprites", + "to": "KM_FileIO" + }, + { + "from": "KM_ResSprites", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ResSprites", + "to": "KM_Utils" + }, + { + "from": "KM_ResSprites", + "to": "KM_Points" + }, + { + "from": "KM_ResSprites", + "to": "KM_GameSettings" + }, + { + "from": "KM_ResSpritesEdit", + "to": "LCLIntf" + }, + { + "from": "KM_ResSpritesEdit", + "to": "LCLType" + }, + { + "from": "KM_ResSpritesEdit", + "to": "Classes" + }, + { + "from": "KM_ResSpritesEdit", + "to": "Dialogs" + }, + { + "from": "KM_ResSpritesEdit", + "to": "Graphics" + }, + { + "from": "KM_ResSpritesEdit", + "to": "Math" + }, + { + "from": "KM_ResSpritesEdit", + "to": "Types" + }, + { + "from": "KM_ResSpritesEdit", + "to": "StrUtils" + }, + { + "from": "KM_ResSpritesEdit", + "to": "SysUtils" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_Defaults" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_ResHouses" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_ResPalettes" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_ResSprites" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_ResTileset" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResSpritesEdit", + "to": "zstream" + }, + { + "from": "KM_ResSpritesEdit", + "to": "ZLib" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_SoftShadows" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_IoPNG" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_RenderTypes" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResSpritesEdit", + "to": "KM_Utils" + }, + { + "from": "KM_ResTexts", + "to": "lconvencoding" + }, + { + "from": "KM_ResTexts", + "to": "LazUTF8" + }, + { + "from": "KM_ResTexts", + "to": "Classes" + }, + { + "from": "KM_ResTexts", + "to": "SysUtils" + }, + { + "from": "KM_ResTexts", + "to": "StrUtils" + }, + { + "from": "KM_ResTexts", + "to": "KromUtils" + }, + { + "from": "KM_ResTexts", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResTexts", + "to": "KM_FileIO" + }, + { + "from": "KM_ResTexts", + "to": "KM_ResLocales" + }, + { + "from": "KM_ResTexts", + "to": "Math" + }, + { + "from": "KM_ResTileset", + "to": "Classes" + }, + { + "from": "KM_ResTileset", + "to": "SysUtils" + }, + { + "from": "KM_ResTileset", + "to": "KromUtils" + }, + { + "from": "KM_ResTileset", + "to": "KM_IoJSON" + }, + { + "from": "KM_ResTileset", + "to": "KM_Defaults" + }, + { + "from": "KM_ResTileset", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResTileset", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResTileset", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_ResTileset", + "to": "TypInfo" + }, + { + "from": "KM_ResTileset", + "to": "Math" + }, + { + "from": "KM_ResTileset", + "to": "JsonDataObjects" + }, + { + "from": "KM_ResTileset", + "to": "fpjson" + }, + { + "from": "KM_ResTileset", + "to": "jsonparser" + }, + { + "from": "KM_ResTileset", + "to": "KM_FileIO" + }, + { + "from": "KM_ResTileset", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ResTileset", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_ResTilesetTypes", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResTypes", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_ResTypes", + "to": "TypInfo" + }, + { + "from": "KM_ResUnits", + "to": "Classes" + }, + { + "from": "KM_ResUnits", + "to": "SysUtils" + }, + { + "from": "KM_ResUnits", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResUnits", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ResUnits", + "to": "KM_Defaults" + }, + { + "from": "KM_ResUnits", + "to": "KM_Points" + }, + { + "from": "KM_ResUnits", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResUnits", + "to": "TypInfo" + }, + { + "from": "KM_ResUnits", + "to": "KromUtils" + }, + { + "from": "KM_ResUnits", + "to": "KM_ResTexts" + }, + { + "from": "KM_ResWares", + "to": "Classes" + }, + { + "from": "KM_ResWares", + "to": "SysUtils" + }, + { + "from": "KM_ResWares", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ResWares", + "to": "KM_ResTypes" + }, + { + "from": "KM_ResWares", + "to": "Math" + }, + { + "from": "KM_ResWares", + "to": "KM_ResTexts" + }, + { + "from": "KM_Resource", + "to": "LCLIntf" + }, + { + "from": "KM_Resource", + "to": "LCLType" + }, + { + "from": "KM_Resource", + "to": "Classes" + }, + { + "from": "KM_Resource", + "to": "SysUtils" + }, + { + "from": "KM_Resource", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Resource", + "to": "KM_Defaults" + }, + { + "from": "KM_Resource", + "to": "KM_ResTypes" + }, + { + "from": "KM_Resource", + "to": "KM_ResCursors" + }, + { + "from": "KM_Resource", + "to": "KM_ResFonts" + }, + { + "from": "KM_Resource", + "to": "KM_ResHouses" + }, + { + "from": "KM_Resource", + "to": "KM_ResLocales" + }, + { + "from": "KM_Resource", + "to": "KM_ResMapElements" + }, + { + "from": "KM_Resource", + "to": "KM_ResPalettes" + }, + { + "from": "KM_Resource", + "to": "KM_ResSound" + }, + { + "from": "KM_Resource", + "to": "KM_ResSprites" + }, + { + "from": "KM_Resource", + "to": "KM_ResTileset" + }, + { + "from": "KM_Resource", + "to": "KM_ResUnits" + }, + { + "from": "KM_Resource", + "to": "KM_ResWares" + }, + { + "from": "KM_Resource", + "to": "KM_ResInterpolation" + }, + { + "from": "KM_Resource", + "to": "TypInfo" + }, + { + "from": "KM_Resource", + "to": "KM_System" + }, + { + "from": "KM_Resource", + "to": "KromUtils" + }, + { + "from": "KM_Resource", + "to": "KM_Log" + }, + { + "from": "KM_Resource", + "to": "KM_Points" + }, + { + "from": "KM_Resource", + "to": "KM_ResTexts" + }, + { + "from": "KM_Resource", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_Resource", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_Saves", + "to": "Classes" + }, + { + "from": "KM_Saves", + "to": "SyncObjs" + }, + { + "from": "KM_Saves", + "to": "KM_GameOptions" + }, + { + "from": "KM_Saves", + "to": "KM_GameInfo" + }, + { + "from": "KM_Saves", + "to": "KM_Minimap" + }, + { + "from": "KM_Saves", + "to": "SysUtils" + }, + { + "from": "KM_Saves", + "to": "Math" + }, + { + "from": "KM_Saves", + "to": "KromUtils" + }, + { + "from": "KM_Saves", + "to": "KM_GameClasses" + }, + { + "from": "KM_Saves", + "to": "KM_Resource" + }, + { + "from": "KM_Saves", + "to": "KM_ResTexts" + }, + { + "from": "KM_Saves", + "to": "KM_FileIO" + }, + { + "from": "KM_Saves", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Saves", + "to": "KM_Defaults" + }, + { + "from": "KM_Saves", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Saves", + "to": "KM_Log" + }, + { + "from": "KM_Saves", + "to": "KM_GameTypes" + }, + { + "from": "KM_Saves", + "to": "KM_Utils" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "SysUtils" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "Math" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KromUtils" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptErrorHandler", + "to": "KM_Log" + }, + { + "from": "KM_ScriptFilesCollection", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptFilesCollection", + "to": "SysUtils" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "uPSPreProcessor" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "uPSUtils" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ScriptFilesCollection" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ScriptErrorHandler" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ScriptValidatorResult" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "SysUtils" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "Classes" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "TypInfo" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "Math" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KromUtils" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_Resource" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ResUnits" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ResTypes" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_CampaignTypes" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_Log" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_FileIO" + }, + { + "from": "KM_ScriptPreProcessor", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "uPSPreProcessor" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_ScriptPreProcessor" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "SysUtils" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "Classes" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "TypInfo" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_Scripting" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptPreProcessorGame", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptValidatorResult", + "to": "SysUtils" + }, + { + "from": "KM_ScriptValidatorResult", + "to": "KM_IoXML" + }, + { + "from": "KM_ScriptValidatorResult", + "to": "Classes" + }, + { + "from": "KM_Scripting", + "to": "Classes" + }, + { + "from": "KM_Scripting", + "to": "SysUtils" + }, + { + "from": "KM_Scripting", + "to": "uPSCompiler" + }, + { + "from": "KM_Scripting", + "to": "uPSRuntime" + }, + { + "from": "KM_Scripting", + "to": "uPSUtils" + }, + { + "from": "KM_Scripting", + "to": "uPSDisassembly" + }, + { + "from": "KM_Scripting", + "to": "uPSDebugger" + }, + { + "from": "KM_Scripting", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Scripting", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Scripting", + "to": "KM_Defaults" + }, + { + "from": "KM_Scripting", + "to": "KM_FileIO" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingActions" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingIdCache" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingStates" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingUtils" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptFilesCollection" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptErrorHandler" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptPreProcessor" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptValidatorResult" + }, + { + "from": "KM_Scripting", + "to": "TypInfo" + }, + { + "from": "KM_Scripting", + "to": "Math" + }, + { + "from": "KM_Scripting", + "to": "Hash" + }, + { + "from": "KM_Scripting", + "to": "Generics.Defaults" + }, + { + "from": "KM_Scripting", + "to": "System.Hash" + }, + { + "from": "KM_Scripting", + "to": "KromUtils" + }, + { + "from": "KM_Scripting", + "to": "KM_GameParams" + }, + { + "from": "KM_Scripting", + "to": "KM_Resource" + }, + { + "from": "KM_Scripting", + "to": "KM_ResUnits" + }, + { + "from": "KM_Scripting", + "to": "KM_Log" + }, + { + "from": "KM_Scripting", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptingConsoleCommands" + }, + { + "from": "KM_Scripting", + "to": "KM_ScriptPreProcessorGame" + }, + { + "from": "KM_Scripting", + "to": "KM_ResTypes" + }, + { + "from": "KM_Scripting", + "to": "KM_CampaignTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "Classes" + }, + { + "from": "KM_ScriptingActions", + "to": "Math" + }, + { + "from": "KM_ScriptingActions", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingActions", + "to": "StrUtils" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_AIAttacks" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Points" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Houses" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ScriptingIdCache" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ScriptSound" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_MediaTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResFonts" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HandTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_AITypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_TerrainSelection" + }, + { + "from": "KM_ScriptingActions", + "to": "IOUtils" + }, + { + "from": "KM_ScriptingActions", + "to": "TypInfo" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Entity" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_AI" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Game" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_GameTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_FogOfWar" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HandLogistics" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HandConstructions" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HandEntity" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseSchool" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseStore" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseMarket" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Resource" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResUnits" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Hand" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResMapElements" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_PathFindingRoad" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Terrain" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_Units" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResHouses" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_HouseCollection" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_ResWares" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ScriptingActions", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "Classes" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "TypInfo" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "StrUtils" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "KM_MethodParser" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "KM_ResTexts" + }, + { + "from": "KM_ScriptingConsoleCommands", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptingEvents", + "to": "Generics.Collections" + }, + { + "from": "KM_ScriptingEvents", + "to": "Classes" + }, + { + "from": "KM_ScriptingEvents", + "to": "Math" + }, + { + "from": "KM_ScriptingEvents", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingEvents", + "to": "StrUtils" + }, + { + "from": "KM_ScriptingEvents", + "to": "uPSRuntime" + }, + { + "from": "KM_ScriptingEvents", + "to": "uPSDebugger" + }, + { + "from": "KM_ScriptingEvents", + "to": "uPSPreProcessor" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Houses" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ScriptingIdCache" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Units" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ScriptingConsoleCommands" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ResHouses" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ResWares" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ResTypes" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Points" + }, + { + "from": "KM_ScriptingEvents", + "to": "uPSUtils" + }, + { + "from": "KM_ScriptingEvents", + "to": "System.RegularExpressions" + }, + { + "from": "KM_ScriptingEvents", + "to": "RegExpr" + }, + { + "from": "KM_ScriptingEvents", + "to": "TypInfo" + }, + { + "from": "KM_ScriptingEvents", + "to": "KromUtils" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Entity" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Game" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_HandTypes" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ResTexts" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_ResUnits" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_Resource" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_ScriptingEvents", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_Houses" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_Units" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_CommonClasses" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_Entity" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_ScriptingIdCache", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingStates", + "to": "Classes" + }, + { + "from": "KM_ScriptingStates", + "to": "Math" + }, + { + "from": "KM_ScriptingStates", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingStates", + "to": "StrUtils" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Points" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HandsCollection" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Houses" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ScriptingIdCache" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Units" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_MapTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_UnitGroup" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ResHouses" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseCollection" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ResWares" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ScriptingTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ResTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HandTypes" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_AITypes" + }, + { + "from": "KM_ScriptingStates", + "to": "TypInfo" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Entity" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_AI" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ArmyDefence" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_AIDefensePos" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Game" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_GameApp" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_GameParams" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_UnitsCollection" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_UnitTaskSelfTrain" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseSchool" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseMarket" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseStore" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HouseTownHall" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Resource" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_ResUnits" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Hand" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_HandEntity" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_Terrain" + }, + { + "from": "KM_ScriptingStates", + "to": "KM_CommonUtils" + }, + { + "from": "KM_ScriptingTypes", + "to": "KM_Defaults" + }, + { + "from": "KM_ScriptingTypes", + "to": "KM_AITypes" + }, + { + "from": "KM_ScriptingTypes", + "to": "KM_Points" + }, + { + "from": "KM_ScriptingTypes", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingTypes", + "to": "TypInfo" + }, + { + "from": "KM_ScriptingUtils", + "to": "Math" + }, + { + "from": "KM_ScriptingUtils", + "to": "StrUtils" + }, + { + "from": "KM_ScriptingUtils", + "to": "SysUtils" + }, + { + "from": "KM_ScriptingUtils", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_ScriptingUtils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_ScriptingUtils", + "to": "KM_Points" + }, + { + "from": "KM_ScriptingUtils", + "to": "KM_CommonUtils" + }, + { + "from": "KM_GameAppSettings", + "to": "Generics.Collections" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_Settings" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_SettingsXML" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_GameSettings" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_MainSettings" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_KeysSettings" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_IoXML" + }, + { + "from": "KM_GameAppSettings", + "to": "SysUtils" + }, + { + "from": "KM_GameAppSettings", + "to": "INIfiles" + }, + { + "from": "KM_GameAppSettings", + "to": "Math" + }, + { + "from": "KM_GameAppSettings", + "to": "KM_Defaults" + }, + { + "from": "KM_GameAppSettingsPart", + "to": "KM_IoXML" + }, + { + "from": "KM_GameSettings", + "to": "Classes" + }, + { + "from": "KM_GameSettings", + "to": "Forms" + }, + { + "from": "KM_GameSettings", + "to": "UITypes" + }, + { + "from": "KM_GameSettings", + "to": "KM_WareDistribution" + }, + { + "from": "KM_GameSettings", + "to": "KM_MapTypes" + }, + { + "from": "KM_GameSettings", + "to": "KM_Defaults" + }, + { + "from": "KM_GameSettings", + "to": "KM_CommonTypes" + }, + { + "from": "KM_GameSettings", + "to": "KM_Lists" + }, + { + "from": "KM_GameSettings", + "to": "KM_CommonClasses" + }, + { + "from": "KM_GameSettings", + "to": "KM_IoXML" + }, + { + "from": "KM_GameSettings", + "to": "KM_InterfaceTypes" + }, + { + "from": "KM_GameSettings", + "to": "KM_GameAppSettingsPart" + }, + { + "from": "KM_GameSettings", + "to": "SysUtils" + }, + { + "from": "KM_GameSettings", + "to": "INIfiles" + }, + { + "from": "KM_GameSettings", + "to": "Math" + }, + { + "from": "KM_GameSettings", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_KeysSettings", + "to": "KM_IoXML" + }, + { + "from": "KM_KeysSettings", + "to": "KM_GameAppSettingsPart" + }, + { + "from": "KM_KeysSettings", + "to": "KM_ResTexts" + }, + { + "from": "KM_KeysSettings", + "to": "KM_ResKeys" + }, + { + "from": "KM_KeysSettings", + "to": "KM_ResKeyFuncs" + }, + { + "from": "KM_KeysSettings", + "to": "KM_ResTypes" + }, + { + "from": "KM_MainSettings", + "to": "Classes" + }, + { + "from": "KM_MainSettings", + "to": "UITypes" + }, + { + "from": "KM_MainSettings", + "to": "KM_Resolutions" + }, + { + "from": "KM_MainSettings", + "to": "KM_Defaults" + }, + { + "from": "KM_MainSettings", + "to": "KM_WindowParams" + }, + { + "from": "KM_MainSettings", + "to": "KM_IoXML" + }, + { + "from": "KM_MainSettings", + "to": "KM_GameAppSettingsPart" + }, + { + "from": "KM_MainSettings", + "to": "SysUtils" + }, + { + "from": "KM_MainSettings", + "to": "INIfiles" + }, + { + "from": "KM_MainSettings", + "to": "Math" + }, + { + "from": "KM_MainSettings", + "to": "Forms" + }, + { + "from": "KM_Resolutions", + "to": "Math" + }, + { + "from": "KM_Resolutions", + "to": "Windows" + }, + { + "from": "KM_Resolutions", + "to": "KM_Defaults" + }, + { + "from": "KM_ServerSettings", + "to": "Classes" + }, + { + "from": "KM_ServerSettings", + "to": "Forms" + }, + { + "from": "KM_ServerSettings", + "to": "UITypes" + }, + { + "from": "KM_ServerSettings", + "to": "KM_Defaults" + }, + { + "from": "KM_ServerSettings", + "to": "KM_Lists" + }, + { + "from": "KM_ServerSettings", + "to": "KM_Settings" + }, + { + "from": "KM_ServerSettings", + "to": "SysUtils" + }, + { + "from": "KM_ServerSettings", + "to": "INIfiles" + }, + { + "from": "KM_ServerSettings", + "to": "Math" + }, + { + "from": "KM_ServerSettings", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Settings", + "to": "SysUtils" + }, + { + "from": "KM_Settings", + "to": "KM_Defaults" + }, + { + "from": "KM_Settings", + "to": "KM_FileIO" + }, + { + "from": "KM_Settings", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Settings", + "to": "KM_Log" + }, + { + "from": "KM_SettingsDev", + "to": "SysUtils" + }, + { + "from": "KM_SettingsDev", + "to": "StrUtils" + }, + { + "from": "KM_SettingsDev", + "to": "Classes" + }, + { + "from": "KM_SettingsDev", + "to": "Math" + }, + { + "from": "KM_SettingsDev", + "to": "ComCtrls" + }, + { + "from": "KM_SettingsDev", + "to": "Controls" + }, + { + "from": "KM_SettingsDev", + "to": "ExtCtrls" + }, + { + "from": "KM_SettingsDev", + "to": "StdCtrls" + }, + { + "from": "KM_SettingsDev", + "to": "Forms" + }, + { + "from": "KM_SettingsDev", + "to": "Spin" + }, + { + "from": "KM_SettingsDev", + "to": "LCLIntf" + }, + { + "from": "KM_SettingsDev", + "to": "LCLType" + }, + { + "from": "KM_SettingsDev", + "to": "KM_Defaults" + }, + { + "from": "KM_SettingsDev", + "to": "KM_Log" + }, + { + "from": "KM_SettingsDev", + "to": "KM_IoXML" + }, + { + "from": "KM_SettingsXML", + "to": "KM_Settings" + }, + { + "from": "KM_SettingsXML", + "to": "KM_IoXML" + }, + { + "from": "KM_WindowParams", + "to": "UITypes" + }, + { + "from": "KM_WindowParams", + "to": "Forms" + }, + { + "from": "KM_WindowParams", + "to": "KM_Points" + }, + { + "from": "KM_WindowParams", + "to": "Math" + }, + { + "from": "KM_WindowParams", + "to": "SysUtils" + }, + { + "from": "KM_WindowParams", + "to": "TypInfo" + }, + { + "from": "KM_WindowParams", + "to": "KM_Defaults" + }, + { + "from": "KM_RMGUtils", + "to": "Classes" + }, + { + "from": "KM_RMGUtils", + "to": "SysUtils" + }, + { + "from": "KM_RMGUtils", + "to": "Math" + }, + { + "from": "KM_RMGUtils", + "to": "Contnrs" + }, + { + "from": "KM_RMGUtils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RMGUtils", + "to": "KM_Points" + }, + { + "from": "KM_RMGUtils", + "to": "KM_Terrain" + }, + { + "from": "KM_RMGUtils", + "to": "KM_FloodFill" + }, + { + "from": "KM_RMGUtils", + "to": "KM_RandomMapGenerator" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_CommonTypes" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_Terrain" + }, + { + "from": "KM_RandomMapGenerator", + "to": "Math" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_Points" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_RMGUtils" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_Defaults" + }, + { + "from": "KM_RandomMapGenerator", + "to": "SysUtils" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_HandsCollection" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_CommonClasses" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_Game" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_ResMapElements" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_Hand" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_ResTypes" + }, + { + "from": "KM_RandomMapGenerator", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_Terrain", + "to": "Classes" + }, + { + "from": "KM_Terrain", + "to": "KromUtils" + }, + { + "from": "KM_Terrain", + "to": "Math" + }, + { + "from": "KM_Terrain", + "to": "SysUtils" + }, + { + "from": "KM_Terrain", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Terrain", + "to": "KM_Defaults" + }, + { + "from": "KM_Terrain", + "to": "KM_Points" + }, + { + "from": "KM_Terrain", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Terrain", + "to": "KM_ResTileset" + }, + { + "from": "KM_Terrain", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_ResHouses" + }, + { + "from": "KM_Terrain", + "to": "KM_TerrainFinder" + }, + { + "from": "KM_Terrain", + "to": "KM_ResMapElements" + }, + { + "from": "KM_Terrain", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_ResTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_Entity" + }, + { + "from": "KM_Terrain", + "to": "KM_Log" + }, + { + "from": "KM_Terrain", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Terrain", + "to": "KM_Hand" + }, + { + "from": "KM_Terrain", + "to": "KM_HandTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_HandEntity" + }, + { + "from": "KM_Terrain", + "to": "KM_TerrainUtils" + }, + { + "from": "KM_Terrain", + "to": "KM_TerrainWalkConnect" + }, + { + "from": "KM_Terrain", + "to": "KM_Resource" + }, + { + "from": "KM_Terrain", + "to": "KM_Units" + }, + { + "from": "KM_Terrain", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_Terrain", + "to": "KM_ResSound" + }, + { + "from": "KM_Terrain", + "to": "KM_Sound" + }, + { + "from": "KM_Terrain", + "to": "KM_UnitActionStay" + }, + { + "from": "KM_Terrain", + "to": "KM_UnitActionGoInOut" + }, + { + "from": "KM_Terrain", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_Terrain", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_Terrain", + "to": "KM_Houses" + }, + { + "from": "KM_Terrain", + "to": "KM_ResUnits" + }, + { + "from": "KM_Terrain", + "to": "KM_ResSprites" + }, + { + "from": "KM_Terrain", + "to": "KM_ResWares" + }, + { + "from": "KM_Terrain", + "to": "KM_Game" + }, + { + "from": "KM_Terrain", + "to": "KM_GameParams" + }, + { + "from": "KM_Terrain", + "to": "KM_GameTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_GameSettings" + }, + { + "from": "KM_Terrain", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_Terrain", + "to": "KM_Utils" + }, + { + "from": "KM_Terrain", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_Terrain", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_TerrainDeposits", + "to": "Classes" + }, + { + "from": "KM_TerrainDeposits", + "to": "Math" + }, + { + "from": "KM_TerrainDeposits", + "to": "SysUtils" + }, + { + "from": "KM_TerrainDeposits", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainDeposits", + "to": "KM_Points" + }, + { + "from": "KM_TerrainDeposits", + "to": "KM_Terrain" + }, + { + "from": "KM_TerrainDeposits", + "to": "KM_Units" + }, + { + "from": "KM_TerrainDeposits", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_TerrainFinder", + "to": "Math" + }, + { + "from": "KM_TerrainFinder", + "to": "SysUtils" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_Points" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_ResMapElements" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_Terrain" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_TerrainFinder", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_TerrainPainter", + "to": "Classes" + }, + { + "from": "KM_TerrainPainter", + "to": "KromUtils" + }, + { + "from": "KM_TerrainPainter", + "to": "Math" + }, + { + "from": "KM_TerrainPainter", + "to": "SysUtils" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Points" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_CommonTypes" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Game" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Cursor" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Resource" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Log" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_CommonUtils" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Utils" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_GameParams" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_GameSettings" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_ResSprites" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_MapEditorHistory" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_ResTexts" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_Terrain" + }, + { + "from": "KM_TerrainPainter", + "to": "KM_ResTypes" + }, + { + "from": "KM_TerrainSelection", + "to": "System.Classes" + }, + { + "from": "KM_TerrainSelection", + "to": "System.Math" + }, + { + "from": "KM_TerrainSelection", + "to": "Vcl.Clipbrd" + }, + { + "from": "KM_TerrainSelection", + "to": "Winapi.Windows" + }, + { + "from": "KM_TerrainSelection", + "to": "KromUtils" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Points" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Terrain" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_TerrainPainter" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_RenderPool" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainSelection", + "to": "SysUtils" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Resource" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_ResTileset" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_HandsCollection" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_GameParams" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_GameSettings" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Game" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_Cursor" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_RenderAux" + }, + { + "from": "KM_TerrainSelection", + "to": "KM_CommonUtils" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_CommonTypes" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TerrainTypes", + "to": "SysUtils" + }, + { + "from": "KM_TerrainTypes", + "to": "Math" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_CommonUtils" + }, + { + "from": "KM_TerrainTypes", + "to": "KromUtils" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_GameParams" + }, + { + "from": "KM_TerrainTypes", + "to": "KM_GameSettings" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TerrainUtils", + "to": "Classes" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_Resource" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_ResSprites" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_HandTypes" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_ResTypes" + }, + { + "from": "KM_TerrainUtils", + "to": "KM_ResTilesetTypes" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_Terrain" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_Points" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_Defaults" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "Math" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_ResMapElements" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_TerrainWalkConnect", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "Windows" + }, + { + "from": "KM_TestMapGenerator", + "to": "LCLType" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_CommonTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Terrain" + }, + { + "from": "KM_TestMapGenerator", + "to": "Math" + }, + { + "from": "KM_TestMapGenerator", + "to": "SysUtils" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Controls" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Defaults" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Pics" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Minimap" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Points" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_RMGUtils" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_CommonClasses" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Game" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_GameTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_RenderUI" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_HandsCollection" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_ResTexts" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_ResFonts" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_ResTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_UnitGroup" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_Units" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_MapTypes" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_GameParams" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_AIAttacks" + }, + { + "from": "KM_TestMapGenerator", + "to": "KM_AITypes" + }, + { + "from": "KM_UnitGroup", + "to": "Generics.Collections" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitGroup", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Points" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Houses" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Units" + }, + { + "from": "KM_UnitGroup", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitGroup", + "to": "KM_UnitGroupTypes" + }, + { + "from": "KM_UnitGroup", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitGroup", + "to": "Classes" + }, + { + "from": "KM_UnitGroup", + "to": "Math" + }, + { + "from": "KM_UnitGroup", + "to": "SysUtils" + }, + { + "from": "KM_UnitGroup", + "to": "Types" + }, + { + "from": "KM_UnitGroup", + "to": "TypInfo" + }, + { + "from": "KM_UnitGroup", + "to": "KM_CommonTypes" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Entity" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Game" + }, + { + "from": "KM_UnitGroup", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitGroup", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Hand" + }, + { + "from": "KM_UnitGroup", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitGroup", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitGroup", + "to": "KM_ResTexts" + }, + { + "from": "KM_UnitGroup", + "to": "KM_RenderPool" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Hungarian" + }, + { + "from": "KM_UnitGroup", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_UnitGroup", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitGroup", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_UnitGroup", + "to": "KM_UnitActionStormAttack" + }, + { + "from": "KM_UnitGroup", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_UnitGroup", + "to": "KM_RenderAux" + }, + { + "from": "KM_UnitGroup", + "to": "KM_GameTypes" + }, + { + "from": "KM_UnitGroup", + "to": "KM_Log" + }, + { + "from": "KM_UnitGroup", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_UnitGroup", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_UnitGroup", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitGroup", + "to": "KM_UnitVisual" + }, + { + "from": "KM_UnitGroupTypes", + "to": "KM_Points" + }, + { + "from": "KM_UnitVisual", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitVisual", + "to": "KM_Points" + }, + { + "from": "KM_UnitVisual", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitVisual", + "to": "Math" + }, + { + "from": "KM_UnitVisual", + "to": "SysUtils" + }, + { + "from": "KM_UnitVisual", + "to": "KromUtils" + }, + { + "from": "KM_UnitVisual", + "to": "KM_Units" + }, + { + "from": "KM_UnitVisual", + "to": "KM_UnitActionGoInOut" + }, + { + "from": "KM_UnitVisual", + "to": "KM_Resource" + }, + { + "from": "KM_UnitVisual", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitVisual", + "to": "KM_ResHouses" + }, + { + "from": "KM_UnitWarrior", + "to": "Classes" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Points" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Houses" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Units" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_CommonGameTypes" + }, + { + "from": "KM_UnitWarrior", + "to": "SysUtils" + }, + { + "from": "KM_UnitWarrior", + "to": "KromUtils" + }, + { + "from": "KM_UnitWarrior", + "to": "Math" + }, + { + "from": "KM_UnitWarrior", + "to": "TypInfo" + }, + { + "from": "KM_UnitWarrior", + "to": "Generics.Collections" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Entity" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_ResTexts" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_RenderPool" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitTaskAttackHouse" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Hand" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_HandLogistics" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitActionFight" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitActionGoInOut" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitActionStay" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitActionStormAttack" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_Resource" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitGroup" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_RenderDebug" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_UnitVisual" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_UnitWarrior", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Points" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Units" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitWorkPlan", + "to": "SysUtils" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Houses" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_ResHouses" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_Resource" + }, + { + "from": "KM_UnitWorkPlan", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Units", + "to": "Classes" + }, + { + "from": "KM_Units", + "to": "KromUtils" + }, + { + "from": "KM_Units", + "to": "Types" + }, + { + "from": "KM_Units", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Units", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Units", + "to": "KM_Defaults" + }, + { + "from": "KM_Units", + "to": "KM_Points" + }, + { + "from": "KM_Units", + "to": "KM_UnitVisual" + }, + { + "from": "KM_Units", + "to": "KM_Houses" + }, + { + "from": "KM_Units", + "to": "KM_HouseSchool" + }, + { + "from": "KM_Units", + "to": "KM_HouseInn" + }, + { + "from": "KM_Units", + "to": "KM_HandEntity" + }, + { + "from": "KM_Units", + "to": "KM_ResTypes" + }, + { + "from": "KM_Units", + "to": "Math" + }, + { + "from": "KM_Units", + "to": "SysUtils" + }, + { + "from": "KM_Units", + "to": "TypInfo" + }, + { + "from": "KM_Units", + "to": "KM_Entity" + }, + { + "from": "KM_Units", + "to": "KM_CommonUtils" + }, + { + "from": "KM_Units", + "to": "KM_Terrain" + }, + { + "from": "KM_Units", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_Units", + "to": "KM_Game" + }, + { + "from": "KM_Units", + "to": "KM_GameParams" + }, + { + "from": "KM_Units", + "to": "KM_RenderPool" + }, + { + "from": "KM_Units", + "to": "KM_RenderAux" + }, + { + "from": "KM_Units", + "to": "KM_ResHouses" + }, + { + "from": "KM_Units", + "to": "KM_ResTexts" + }, + { + "from": "KM_Units", + "to": "KM_ResUnits" + }, + { + "from": "KM_Units", + "to": "KM_HandsCollection" + }, + { + "from": "KM_Units", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_Units", + "to": "KM_Resource" + }, + { + "from": "KM_Units", + "to": "KM_Hand" + }, + { + "from": "KM_Units", + "to": "KM_MapEdTypes" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionAbandonWalk" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionFight" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionGoInOut" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionStay" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionSteer" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionStormAttack" + }, + { + "from": "KM_Units", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskAttackHouse" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskBuild" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskDelivery" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskDie" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskGoEat" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskGoHome" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskDismiss" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskGoOutShowHungry" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskMining" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskSelfTrain" + }, + { + "from": "KM_Units", + "to": "KM_UnitTaskThrowRock" + }, + { + "from": "KM_Units", + "to": "KM_GameTypes" + }, + { + "from": "KM_Units", + "to": "KM_HandTypes" + }, + { + "from": "KM_Units", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_UnitsCollection", + "to": "Generics.Collections" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Points" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Units" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Houses" + }, + { + "from": "KM_UnitsCollection", + "to": "Classes" + }, + { + "from": "KM_UnitsCollection", + "to": "Math" + }, + { + "from": "KM_UnitsCollection", + "to": "Types" + }, + { + "from": "KM_UnitsCollection", + "to": "SysUtils" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Entity" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Game" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Log" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_Resource" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_GameUIDTracker" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_UnitsCollection", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "Math" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionAbandonWalk", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionFight", + "to": "Classes" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitActionFight", + "to": "KromUtils" + }, + { + "from": "KM_UnitActionFight", + "to": "Math" + }, + { + "from": "KM_UnitActionFight", + "to": "SysUtils" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Entity" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_ResSound" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Sound" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Projectiles" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionFight", + "to": "KM_Hand" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "Classes" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KromUtils" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "SysUtils" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_CommonTypes" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Houses" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Entity" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_UnitActionStay" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_UnitActionWalkTo" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_HouseBarracks" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_ResHouses" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitActionGoInOut", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitActionStay", + "to": "Classes" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionStay", + "to": "KromUtils" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionStay", + "to": "SysUtils" + }, + { + "from": "KM_UnitActionStay", + "to": "Math" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_Sound" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_ResSound" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionStay", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionSteer", + "to": "Classes" + }, + { + "from": "KM_UnitActionSteer", + "to": "SysUtils" + }, + { + "from": "KM_UnitActionSteer", + "to": "Math" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionSteer", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "Classes" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "Math" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionStormAttack", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "Classes" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KromUtils" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "Math" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "SysUtils" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_CommonTypes" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Points" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Houses" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Units" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "TypInfo" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Entity" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_RenderAux" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Game" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_UnitGroup" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_UnitActionGoInOut" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_UnitActionStay" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_UnitTaskBuild" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_PathFinding" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Log" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_Resource" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_CommonClassesExt" + }, + { + "from": "KM_UnitActionWalkTo", + "to": "KM_CommonExceptions" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "Classes" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "Math" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Points" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Resource" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_ResSound" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Sound" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_Projectiles" + }, + { + "from": "KM_UnitTaskAttackHouse", + "to": "KM_GameParams" + }, + { + "from": "KM_UnitTaskBuild", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Points" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_ResHouses" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_HandLogistics" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Resource" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_ResMapElements" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Game" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskBuild", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "Classes" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Points" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "Math" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "TypInfo" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_HouseInn" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_UnitTaskBuild" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_Log" + }, + { + "from": "KM_UnitTaskDelivery", + "to": "KM_RenderAux" + }, + { + "from": "KM_UnitTaskDie", + "to": "Classes" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskDie", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_ResSound" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_Sound" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_Resource" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_UnitWarrior" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_UnitTaskDie", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "Classes" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitTaskDismiss", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "Classes" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_HouseInn" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskGoEat", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitTaskGoHome", + "to": "Classes" + }, + { + "from": "KM_UnitTaskGoHome", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskGoHome", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskGoHome", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskGoOutShowHungry", + "to": "Classes" + }, + { + "from": "KM_UnitTaskGoOutShowHungry", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskGoOutShowHungry", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskGoOutShowHungry", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskGoOutShowHungry", + "to": "KM_CommonUtils" + }, + { + "from": "KM_UnitTaskMining", + "to": "Math" + }, + { + "from": "KM_UnitTaskMining", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Points" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_UnitWorkplan" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_ResTypes" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_HouseWoodcutters" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_HouseSwineStable" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Resource" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_ResMapElements" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_ResTexts" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_ResUnits" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_ScriptingEvents" + }, + { + "from": "KM_UnitTaskMining", + "to": "KM_Terrain" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "Classes" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_Houses" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_HouseSchool" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskSelfTrain", + "to": "KM_Game" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "Classes" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "SysUtils" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_CommonClasses" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_Defaults" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_Units" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_Entity" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_HandsCollection" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_Hand" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_HandTypes" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_HandEntity" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_Projectiles" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_CommonGameTypes" + }, + { + "from": "KM_UnitTaskThrowRock", + "to": "KM_ResTypes" + }, + { + "from": "KM_Achievements", + "to": "Classes" + }, + { + "from": "KM_Achievements", + "to": "KromUtils" + }, + { + "from": "KM_Achievements", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Achievements", + "to": "KM_Defaults" + }, + { + "from": "KM_Achievements", + "to": "KM_ResourceHouse" + }, + { + "from": "KM_Achievements", + "to": "KM_ResourceUnit" + }, + { + "from": "KM_Achievements", + "to": "Math" + }, + { + "from": "KM_Achievements", + "to": "KM_PlayersCollection" + }, + { + "from": "KM_Achievements", + "to": "KM_Resource" + }, + { + "from": "KM_CommonSave", + "to": "Classes" + }, + { + "from": "KM_CommonSave", + "to": "Math" + }, + { + "from": "KM_CommonSave", + "to": "SysUtils" + }, + { + "from": "KM_CommonSave", + "to": "KM_Points" + }, + { + "from": "KM_PerfLog", + "to": "Generics.Collections" + }, + { + "from": "KM_PerfLog", + "to": "KM_Sort" + }, + { + "from": "KM_PerfLog", + "to": "Classes" + }, + { + "from": "KM_PerfLog", + "to": "SysUtils" + }, + { + "from": "KM_PerfLog", + "to": "KM_CommonUtils" + }, + { + "from": "KM_CommonShellUtils", + "to": "Windows" + }, + { + "from": "KM_CommonShellUtils", + "to": "Forms" + }, + { + "from": "KM_CommonShellUtils", + "to": "ShellApi" + }, + { + "from": "KM_CommonShellUtils", + "to": "PsAPI" + }, + { + "from": "KM_CommonShellUtils", + "to": "LCLIntF" + }, + { + "from": "KM_CommonShellUtils", + "to": "JwaPsApi" + }, + { + "from": "KM_CommonUtils", + "to": "Classes" + }, + { + "from": "KM_CommonUtils", + "to": "DateUtils" + }, + { + "from": "KM_CommonUtils", + "to": "Math" + }, + { + "from": "KM_CommonUtils", + "to": "SysUtils" + }, + { + "from": "KM_CommonUtils", + "to": "KM_Defaults" + }, + { + "from": "KM_CommonUtils", + "to": "KM_Points" + }, + { + "from": "KM_CommonUtils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_CommonUtils", + "to": "Windows" + }, + { + "from": "KM_CommonUtils", + "to": "MMSystem" + }, + { + "from": "KM_CommonUtils", + "to": "unix" + }, + { + "from": "KM_CommonUtils", + "to": "baseunix" + }, + { + "from": "KM_CommonUtils", + "to": "UnixUtil" + }, + { + "from": "KM_CommonUtils", + "to": "StrUtils" + }, + { + "from": "KM_CommonUtils", + "to": "Types" + }, + { + "from": "KM_CommonUtils", + "to": "madStackTrace" + }, + { + "from": "KM_CommonUtils", + "to": "KM_RandomChecks" + }, + { + "from": "KM_CommonUtils", + "to": "KM_Log" + }, + { + "from": "KM_ConsoleTimer", + "to": "Windows" + }, + { + "from": "KM_ConsoleTimer", + "to": "Classes" + }, + { + "from": "KM_ConsoleTimer", + "to": "SyncObjs" + }, + { + "from": "KM_ConsoleTimer", + "to": "Diagnostics" + }, + { + "from": "KM_ConsoleTimer", + "to": "SysUtils" + }, + { + "from": "KM_Utils", + "to": "FileUtil" + }, + { + "from": "KM_Utils", + "to": "IOUtils" + }, + { + "from": "KM_Utils", + "to": "SysUtils" + }, + { + "from": "KM_Utils", + "to": "StrUtils" + }, + { + "from": "KM_Utils", + "to": "Classes" + }, + { + "from": "KM_Utils", + "to": "KM_TerrainTypes" + }, + { + "from": "KM_Utils", + "to": "KM_Defaults" + }, + { + "from": "KM_Utils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Utils", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Utils", + "to": "KM_Points" + }, + { + "from": "KM_Utils", + "to": "KM_ResTypes" + }, + { + "from": "KM_Utils", + "to": "Math" + }, + { + "from": "KM_Utils", + "to": "KM_ResTexts" + }, + { + "from": "KM_Utils", + "to": "KM_ResKeys" + }, + { + "from": "KM_UtilsExt", + "to": "Classes" + }, + { + "from": "KM_UtilsExt", + "to": "Controls" + }, + { + "from": "KM_UtilsExt", + "to": "Windows" + }, + { + "from": "KM_UtilsExt", + "to": "unix" + }, + { + "from": "KM_UtilsExt", + "to": "baseunix" + }, + { + "from": "KM_UtilsExt", + "to": "UnixUtil" + }, + { + "from": "KM_UtilsExt", + "to": "SysUtils" + }, + { + "from": "KM_UtilsExt", + "to": "KM_Defaults" + }, + { + "from": "KM_UtilsExt", + "to": "LCLIntF" + }, + { + "from": "KM_UtilsExt", + "to": "LCLType" + }, + { + "from": "KromOGLUtils", + "to": "dglOpenGL" + }, + { + "from": "KromOGLUtils", + "to": "GL" + }, + { + "from": "KromOGLUtils", + "to": "LCLIntf" + }, + { + "from": "KromOGLUtils", + "to": "Windows" + }, + { + "from": "KromOGLUtils", + "to": "glx" + }, + { + "from": "KromOGLUtils", + "to": "x" + }, + { + "from": "KromOGLUtils", + "to": "xlib" + }, + { + "from": "KromOGLUtils", + "to": "xutil" + }, + { + "from": "KromShellUtils", + "to": "Classes" + }, + { + "from": "KromShellUtils", + "to": "Windows" + }, + { + "from": "KromShellUtils", + "to": "MMSystem" + }, + { + "from": "KromShellUtils", + "to": "LCLType" + }, + { + "from": "KromShellUtils", + "to": "LCLIntf" + }, + { + "from": "KromShellUtils", + "to": "UTF8Process" + }, + { + "from": "KromShellUtils", + "to": "LazHelpHTML" + }, + { + "from": "KromShellUtils", + "to": "ShellApi" + }, + { + "from": "KromShellUtils", + "to": "Forms" + }, + { + "from": "KromShellUtils", + "to": "Dialogs" + }, + { + "from": "KromShellUtils", + "to": "Controls" + }, + { + "from": "KromShellUtils", + "to": "KromUtils" + }, + { + "from": "KromShellUtils", + "to": "dynlibs" + }, + { + "from": "KromUtils", + "to": "Classes" + }, + { + "from": "KromUtils", + "to": "Windows" + }, + { + "from": "KromUtils", + "to": "MMSystem" + }, + { + "from": "KromUtils", + "to": "LCLType" + }, + { + "from": "KromUtils", + "to": "LCLIntf" + }, + { + "from": "KromUtils", + "to": "UTF8Process" + }, + { + "from": "KromUtils", + "to": "LazHelpHTML" + }, + { + "from": "KromUtils", + "to": "SysUtils" + }, + { + "from": "BinaryHeapGen", + "to": "Generics.Collections" + }, + { + "from": "BinaryHeapGen", + "to": "SysUtils" + }, + { + "from": "KM_BinPacking", + "to": "Classes" + }, + { + "from": "KM_BinPacking", + "to": "Math" + }, + { + "from": "KM_BinPacking", + "to": "KromUtils" + }, + { + "from": "KM_FloodFill", + "to": "Classes" + }, + { + "from": "KM_FloodFill", + "to": "SysUtils" + }, + { + "from": "KM_FloodFill", + "to": "KM_Points" + }, + { + "from": "KM_Hungarian", + "to": "Classes" + }, + { + "from": "KM_Hungarian", + "to": "SysUtils" + }, + { + "from": "KM_Hungarian", + "to": "Math" + }, + { + "from": "KM_Hungarian", + "to": "KM_CommonClasses" + }, + { + "from": "KM_Hungarian", + "to": "KM_CommonTypes" + }, + { + "from": "KM_Hungarian", + "to": "KM_Points" + }, + { + "from": "KM_MarchingSquares", + "to": "KM_Points" + }, + { + "from": "KM_MarchingSquares", + "to": "KM_CommonClasses" + }, + { + "from": "KM_MarchingSquares", + "to": "Generics.Collections" + }, + { + "from": "KM_MarchingSquares", + "to": "Math" + }, + { + "from": "KM_MarchingSquares", + "to": "KM_DevPerfLog" + }, + { + "from": "KM_MarchingSquares", + "to": "KM_DevPerfLogTypes" + }, + { + "from": "KM_SoftShadows", + "to": "Classes" + }, + { + "from": "KM_SoftShadows", + "to": "SysUtils" + }, + { + "from": "KM_SoftShadows", + "to": "Math" + }, + { + "from": "KM_SoftShadows", + "to": "KM_ResSprites" + }, + { + "from": "KM_SoftShadows", + "to": "KM_ResTypes" + }, + { + "from": "KM_FileIO", + "to": "lconvencoding" + }, + { + "from": "KM_FileIO", + "to": "FileUtil" + }, + { + "from": "KM_FileIO", + "to": "LazUTF8" + }, + { + "from": "KM_FileIO", + "to": "LazFileUtils" + }, + { + "from": "KM_FileIO", + "to": "System.IOUtils" + }, + { + "from": "KM_FileIO", + "to": "Windows" + }, + { + "from": "KM_FileIO", + "to": "ShellAPI" + }, + { + "from": "KM_FileIO", + "to": "LCLType" + }, + { + "from": "KM_FileIO", + "to": "Classes" + }, + { + "from": "KM_FileIO", + "to": "SysUtils" + }, + { + "from": "KM_FileIO", + "to": "KM_WorkerThread" + }, + { + "from": "KM_FileIO", + "to": "KM_CommonTypes" + }, + { + "from": "KM_FileIO", + "to": "StrUtils" + }, + { + "from": "KM_FileIO", + "to": "KM_CommonUtils" + }, + { + "from": "KM_FileIO", + "to": "KM_Defaults" + }, + { + "from": "KM_IoGraphicUtils", + "to": "KM_CommonTypes" + }, + { + "from": "KM_IoGraphicUtils", + "to": "Windows" + }, + { + "from": "KM_IoGraphicUtils", + "to": "Graphics" + }, + { + "from": "KM_IoGraphicUtils", + "to": "JPEG" + }, + { + "from": "KM_IoGraphicUtils", + "to": "PNGImage" + }, + { + "from": "KM_IoGraphicUtils", + "to": "SysUtils" + }, + { + "from": "KM_IoGraphicUtils", + "to": "KM_FileIO" + }, + { + "from": "KM_IoGraphicUtils", + "to": "Dialogs" + }, + { + "from": "KM_IoGraphicUtils", + "to": "KM_Log" + }, + { + "from": "KM_IoJSON", + "to": "JsonDataObjects" + }, + { + "from": "KM_IoJSON", + "to": "fpjson" + }, + { + "from": "KM_IoJSON", + "to": "jsonparser" + }, + { + "from": "KM_IoJSON", + "to": "KM_CommonClasses" + }, + { + "from": "KM_IoJSON", + "to": "Classes" + }, + { + "from": "KM_IoJSON", + "to": "SysUtils" + }, + { + "from": "KM_IoJSON", + "to": "jsonscanner" + }, + { + "from": "KM_IoPNG", + "to": "KM_CommonTypes" + }, + { + "from": "KM_IoPNG", + "to": "PNGImage" + }, + { + "from": "KM_IoPNG", + "to": "SysUtils" + }, + { + "from": "KM_IoXML", + "to": "Classes" + }, + { + "from": "KM_IoXML", + "to": "SysUtils" + }, + { + "from": "KM_IoXML", + "to": "Xml.VerySimple" + }, + { + "from": "KM_IoXML", + "to": "laz2_DOM" + }, + { + "from": "KM_IoXML", + "to": "laz2_XMLRead" + }, + { + "from": "KM_IoXML", + "to": "laz2_XMLWrite" + }, + { + "from": "KM_IoXML", + "to": "Variants" + }, + { + "from": "KM_IoXML", + "to": "DateUtils" + }, + { + "from": "KM_IoXML", + "to": "StrUtils" + }, + { + "from": "KM_MethodParser", + "to": "Generics.Collections" + }, + { + "from": "KM_MethodParser", + "to": "Classes" + }, + { + "from": "KM_MethodParser", + "to": "VerySimpleXML" + }, + { + "from": "KM_MethodParser", + "to": "KM_MethodParserParams" + }, + { + "from": "KM_MethodParser", + "to": "SysUtils" + }, + { + "from": "KM_MethodParserParams", + "to": "Generics.Collections" + }, + { + "from": "KM_MethodParserParams", + "to": "SysUtils" + } + ], + "risks": [ + { + "path": "src/KM_Console.pas", + "line": 32, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Console.pas", + "line": 73, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/KM_Console.pas", + "line": 117, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 45, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 117, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 119, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 124, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 131, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/KM_Crashreport.pas", + "line": 136, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 73, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 74, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 75, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 76, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 77, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 78, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 81, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 82, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Exceptions.pas", + "line": 103, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_GameApp.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/KM_GameApp.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/KM_GameApp.pas", + "line": 166, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/KM_GameApp.pas", + "line": 558, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/KM_GameApp.pas", + "line": 1294, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/KM_GameApp.pas", + "line": 165, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_GameApp.pas", + "line": 258, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/KM_GameApp.pas", + "line": 1018, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_GameApp.pas", + "line": 1021, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_GameApp.pas", + "line": 1388, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/KM_Log.pas", + "line": 16, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/KM_Log.pas", + "line": 19, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Log.pas", + "line": 20, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Log.pas", + "line": 21, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Log.pas", + "line": 22, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/KM_Log.pas", + "line": 146, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/KM_Log.pas", + "line": 152, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/KM_Log.pas", + "line": 370, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_Log.pas", + "line": 436, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/KM_Main.pas", + "line": 104, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_Main.pas", + "line": 108, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/KM_Main.pas", + "line": 108, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/KM_Main.pas", + "line": 108, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/KM_Main.pas", + "line": 179, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/KM_Main.pas", + "line": 331, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/KM_Main.pas", + "line": 332, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/KM_Main.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_Main.pas", + "line": 106, + "kind": "windows_api", + "token": "MMSystem" + }, + { + "path": "src/KM_Main.pas", + "line": 261, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/KM_Main.pas", + "line": 345, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/KM_Main.pas", + "line": 391, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_Main.pas", + "line": 480, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_Main.pas", + "line": 814, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_Main.pas", + "line": 199, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/KM_Main.pas", + "line": 208, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/KM_Main.pas", + "line": 259, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/KM_Main.pas", + "line": 217, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/KM_System.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/KM_System.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/KM_System.pas", + "line": 43, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/KM_System.pas", + "line": 43, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/KM_System.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_System.pas", + "line": 160, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/KM_System.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/KM_AI.pas", + "line": 198, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ai/KM_AI.pas", + "line": 199, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ai/KM_AI.pas", + "line": 242, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ai/KM_AIAttacks.pas", + "line": 15, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ai/KM_AIDefensePos.pas", + "line": 107, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/KM_AIGoals.pas", + "line": 9, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "line": 227, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "line": 245, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "line": 272, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/newAI/KM_ArmyDefence.pas", + "line": 114, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ai/newAI/KM_ArmyManagement.pas", + "line": 361, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 75, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 95, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 132, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 168, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 188, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 223, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 250, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "line": 279, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "line": 217, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "line": 296, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "line": 300, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/common/KM_CommonTypes.pas", + "line": 72, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 88, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 160, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 161, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 166, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 167, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 249, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 172, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 401, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 182, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 204, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/common/KM_Defaults.pas", + "line": 1121, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/common/KM_Points.pas", + "line": 42, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/common/KM_Points.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/common/KM_Points.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/common/KM_Points.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 97, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 116, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 256, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 302, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 303, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 303, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 415, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_Controls.pas", + "line": 414, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "line": 235, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "line": 235, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "line": 234, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsChart.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsColor.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsDragger.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "line": 158, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "line": 158, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "line": 157, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 151, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 151, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 438, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 150, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 716, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "line": 717, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/controls/KM_ControlsForm.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsForm.pas", + "line": 185, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "line": 371, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "line": 371, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "line": 370, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "line": 102, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "line": 102, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "line": 644, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 135, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "NativeUint" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "NativeUint" + }, + { + "path": "src/controls/KM_ControlsPopUp.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsProgressBar.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsScroll.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "line": 182, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "line": 183, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "line": 418, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "line": 419, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/controls/KM_ControlsTrackBar.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "line": 21, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "line": 21, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "line": 20, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "line": 71, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "line": 71, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "line": 70, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "line": 171, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "line": 1207, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 9, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 114, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 165, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 201, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 242, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "line": 496, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "line": 23, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "line": 36, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "line": 184, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "line": 1069, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "line": 1495, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 17, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 195, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 227, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 264, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 300, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "line": 345, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "line": 574, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "line": 580, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "line": 616, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 349, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 350, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 351, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 1491, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 1496, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 1504, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 1513, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 1518, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 288, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 289, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 291, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 292, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 2661, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 2667, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 2716, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "line": 2722, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "line": 307, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "line": 308, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "line": 414, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "line": 423, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 18, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 78, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 128, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 129, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 205, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "line": 206, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "line": 1021, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 13, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 39, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 89, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 91, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 220, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "line": 236, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 230, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 259, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 647, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 648, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 651, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 653, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 972, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 1112, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "line": 4624, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 85, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 93, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 94, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 95, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 243, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "line": 316, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 107, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 124, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 538, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 542, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 828, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 1451, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "line": 1517, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 171, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 187, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 194, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 195, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 580, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 582, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 929, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "line": 1752, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 263, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 325, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 355, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 373, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 410, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 449, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 467, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "line": 479, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "line": 350, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "line": 169, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "line": 411, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "line": 415, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "line": 43, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "line": 45, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "line": 116, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "line": 117, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "line": 1363, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "line": 1399, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 31, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 39, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 44, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 49, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 59, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 67, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "line": 484, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "line": 940, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgragradients.pas", + "line": 1209, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "line": 2186, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 3, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 13, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 14, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 15, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 16, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 17, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 18, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 221, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "line": 259, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 74, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 131, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 207, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 218, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 232, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 232, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "line": 245, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 17, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 47, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 48, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 55, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 25, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 38, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 40, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 126, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 196, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 199, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "line": 216, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "line": 79, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "line": 11, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "line": 318, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "line": 367, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "line": 1490, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "line": 2246, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgralayers.pas", + "line": 3598, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 71, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 71, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 983, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 985, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 991, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 993, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 30, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 594, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 616, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 752, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "line": 758, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 22, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 22, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 16, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 25, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 28, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "line": 78, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 111, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 133, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 178, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 233, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 257, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "line": 288, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "line": 95, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 18, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 35, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 75, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 213, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "line": 224, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "line": 37, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "line": 39, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "line": 131, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "line": 137, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 200, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1062, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1082, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1084, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1112, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1118, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1124, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1130, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1157, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 60, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 99, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 185, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 191, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 417, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 668, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1002, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1754, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "line": 1990, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 14, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 438, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 440, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 453, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 458, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "line": 493, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "line": 106, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 1373, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 32, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 213, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 214, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 216, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 671, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 680, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "line": 942, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 74, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 155, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 170, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 171, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 239, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 240, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "line": 3112, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrapen.pas", + "line": 1309, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "line": 22, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "line": 32, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygon.pas", + "line": 84, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygon.pas", + "line": 667, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 38, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 41, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 71, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 74, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 106, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 110, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 151, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "line": 155, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 17, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 39, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 40, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 135, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 30, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "line": 69, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "line": 38, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "line": 45, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "line": 1107, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "line": 16, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "line": 255, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadgif.pas", + "line": 375, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadico.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgrareadico.pas", + "line": 142, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "line": 57, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "line": 371, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "line": 223, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpng.pas", + "line": 1446, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "line": 615, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtga.pas", + "line": 187, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 88, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 102, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 103, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 104, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 138, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 139, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 140, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "line": 2858, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "line": 137, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "line": 85, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrascene3d.pas", + "line": 1637, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "line": 26, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "line": 1028, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "line": 1047, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "line": 273, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "line": 17, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "line": 40, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "line": 78, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "line": 445, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 42, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 81, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 86, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 90, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 161, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 162, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 188, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "line": 606, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "line": 31, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "line": 387, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrasvg.pas", + "line": 28, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrasvg.pas", + "line": 1324, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "line": 695, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "line": 182, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "line": 22, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "line": 589, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "line": 597, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "line": 1864, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "line": 388, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "line": 574, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "line": 1488, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "line": 2266, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/BGRABitmap/bgratextfx.pas", + "line": 896, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "line": 511, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 70, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 102, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 132, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 135, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 138, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 159, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 160, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "line": 352, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicode.pas", + "line": 49, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 47, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 106, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 509, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "line": 515, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/bgraunits.pas", + "line": 565, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 788, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 348, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 359, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 365, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 89, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 573, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 575, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 592, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 593, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 798, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "line": 800, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 224, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 2223, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 166, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 168, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 1617, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "line": 1641, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 18, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 18, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 248, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 44, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "line": 177, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "line": 124, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "line": 132, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "line": 707, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "line": 194, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "line": 199, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "line": 290, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "line": 384, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "line": 425, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrawritepng.pas", + "line": 23, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/BGRABitmap/bgrawritepng.pas", + "line": 960, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 47, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 54, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 98, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 102, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 121, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 884, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 918, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "line": 1017, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "line": 105, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 47, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 96, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 200, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 214, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 214, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 219, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "line": 227, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 571, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 572, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 568, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 575, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 87, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 103, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 206, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 210, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 250, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 266, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 307, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "line": 350, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 45, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 93, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 140, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 159, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 167, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "line": 170, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/universaldrawer.pas", + "line": 1172, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/uunittest.pas", + "line": 20, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 201, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 215, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 215, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 220, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "line": 228, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 131, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 193, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 193, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 206, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "line": 209, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 7, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 12, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 18, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 19, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 20, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "line": 75, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 375, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 445, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 18, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 19, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 45, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 45, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 106, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 199, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 237, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 277, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 450, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 653, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 785, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 902, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 981, + "kind": "layout_or_assembler", + "token": "ASM" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 1059, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 1148, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 1149, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 410, + "kind": "initialization", + "token": " initialization" + }, + { + "path": "src/ext/FastMM4.pas", + "line": 12970, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 85, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 85, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 18, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 70, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 91, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 129, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 137, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "line": 244, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 50, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 11, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 12, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 16, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 23, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 30, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 31, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 56, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "line": 344, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 3, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 27, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 31, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 61, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 70, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 87, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 30, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 3630, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 66, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 87, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 138, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 147, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 147, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 713, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 753, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 784, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 184, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 320, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 321, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 323, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 324, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 325, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 338, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 339, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 568, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/FastMM5.pas", + "line": 10348, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 53, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 53, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 53, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 54, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 53, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 495, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 152, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 169, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 177, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 178, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 185, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 190, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 448, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "line": 1182, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 124, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 129, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 378, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 870, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 870, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 879, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3395, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3251, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3253, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3346, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3348, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 3504, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "ASM" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 100, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 162, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 163, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 164, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 166, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 167, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 169, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "line": 8373, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/KromIOUtils.pas", + "line": 4, + "kind": "windows_api", + "token": "ShellAPI" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 35, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 151, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 152, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 175, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 208, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 211, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 222, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 227, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "line": 287, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 461, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 69, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 75, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 155, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 381, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 386, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/levents.pp", + "line": 617, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "line": 223, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "line": 232, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "line": 654, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "line": 881, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lhttputil.pp", + "line": 132, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/LNet/lnet.pp", + "line": 27, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "line": 15, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "line": 123, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "line": 628, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/LNet/lstrbuffer.pp", + "line": 40, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lstrbuffer.pp", + "line": 52, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LNet/lws2tcpip.pp", + "line": 59, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 11, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 73, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 1263, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 1286, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 111, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 255, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 256, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 369, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 370, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 615, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LNet/openssl.pas", + "line": 623, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "line": 23, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "line": 306, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 25, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 33, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 95, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 115, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 116, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 117, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 197, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "line": 320, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "line": 25, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "line": 25, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "line": 66, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "line": 207, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 23, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 23, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 253, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 254, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 419, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 439, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 440, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 447, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 449, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 149, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 156, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 374, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 375, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 376, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 377, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "line": 379, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 64, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 64, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 64, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 64, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 65, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 22, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "line": 481, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 16, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 15, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 241, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 242, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 243, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 252, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/ext/OBJLoader.pas", + "line": 188, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 86, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 130, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 146, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "line": 158, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "line": 74, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "line": 76, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "line": 91, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 66, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 96, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 96, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 106, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 107, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 108, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 235, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "line": 245, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 54, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 54, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 232, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 267, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 269, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "line": 427, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 215, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 93, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 208, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 210, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 447, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 450, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 770, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 771, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 771, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 187, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 781, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "line": 784, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "line": 233, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 46, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 54, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 132, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 244, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 309, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 336, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "line": 350, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 73, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 5, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 34, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 35, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 35, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 39, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 57, + "kind": "windows_api", + "token": "MESSAGES" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 57, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 43, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 102, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 103, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 104, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 201, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 202, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 212, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "line": 2100, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 56, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 57, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 62, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 63, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 64, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 70, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 107, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 107, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 107, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 239, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 500, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 537, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 711, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 730, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 89, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 131, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 552, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "line": 741, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 113, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 95, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 139, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 162, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 560, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 719, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "line": 830, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "line": 78, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "line": 49, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 36, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 64, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 134, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 135, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 152, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 158, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 171, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "line": 178, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 101, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 101, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 101, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 102, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 102, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 102, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 107, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 825, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 855, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 1306, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 1313, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 1452, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 1454, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 91, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 436, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "line": 1369, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 473, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 478, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 559, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 564, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 83, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 86, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 94, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 236, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "line": 243, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 72, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 72, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 72, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 189, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 192, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "line": 63, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 11, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 74, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 105, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 131, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 131, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 151, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 151, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 203, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 235, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 241, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 276, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 478, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "line": 1855, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 56, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 87, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 87, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 87, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 603, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 666, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 3, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 27, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 45, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 45, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 45, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 63, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 86, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 149, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "line": 314, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 67, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 71, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 84, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 84, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 84, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 377, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 527, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 639, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 124, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 125, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 126, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 135, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 136, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 137, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "line": 208, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "line": 224, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "line": 488, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 126, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 126, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 126, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 102, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 287, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 296, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 366, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 396, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 405, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "line": 433, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 63, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 400, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 401, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 188, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 201, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "line": 460, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 147, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 147, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 148, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 148, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 149, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 149, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 95, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 136, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 136, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 136, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 138, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 138, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 138, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 4331, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "line": 110, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 171, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 136, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 205, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 205, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 205, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 206, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 206, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 206, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 211, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1195, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1209, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1219, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1234, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1453, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1508, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 195, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 245, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 304, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 517, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 666, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1551, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 1895, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "line": 2184, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 179, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 138, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 207, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 207, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 207, + "kind": "windows_api", + "token": "ShellAPI" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 277, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 317, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 578, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 588, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 1231, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 283, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 500, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 650, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 1396, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 1745, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "line": 2020, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 81, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 81, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 81, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 82, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 82, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 82, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 86, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 59, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 106, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "line": 186, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 48, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 1111, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 61, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 61, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 61, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 1397, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 770, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 775, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 907, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 261, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 262, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 669, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 690, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 708, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 822, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 831, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 845, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "line": 1633, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 796, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 797, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 807, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1151, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1153, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1153, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 202, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 252, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 255, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 261, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 580, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1022, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1077, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1136, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 673, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 699, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 2190, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 2563, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 2580, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 5307, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 5642, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 262, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 572, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 573, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 576, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 577, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1076, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1102, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "line": 1628, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 798, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 799, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 809, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1139, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1139, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 204, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 254, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 257, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 263, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 582, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1031, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1084, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1134, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 675, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 701, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 2508, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 264, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 574, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 575, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 578, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 579, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1083, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1106, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "line": 1610, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 275, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 150, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 295, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 349, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 349, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 349, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 350, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 350, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 350, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 2360, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 2361, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 3298, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 4722, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 339, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 547, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 549, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 1089, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "line": 1109, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 279, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 358, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 151, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 308, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 358, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 358, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 583, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 1154, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 1379, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 2150, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 2353, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 2354, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 349, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 537, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 539, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 1085, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "line": 1106, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 533, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 535, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 535, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 97, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 107, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 107, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 203, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 334, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 423, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 511, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 511, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 2583, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 4425, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 4502, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 5176, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 5307, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 5350, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 5352, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 5412, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 112, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 422, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 481, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 1946, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 1947, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 1951, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 1952, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "line": 2095, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 513, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 97, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 107, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 107, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 203, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 334, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 427, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 509, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 510, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 112, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 426, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 480, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 1912, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 1913, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 1917, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 1918, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "line": 2062, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 184, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 184, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 184, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 185, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 185, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 185, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 189, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 165, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 370, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 454, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 467, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 679, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "line": 778, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "line": 36, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "line": 109, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "line": 113, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 98, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 150, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 604, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "line": 660, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 143, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 99, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 179, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 179, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 179, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 180, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 180, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 180, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 185, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 955, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 956, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 167, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 282, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 291, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 293, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 647, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 700, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "line": 720, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 143, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 181, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 98, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 181, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 181, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 763, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 952, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 953, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 263, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 272, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 274, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 641, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 694, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "line": 715, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 623, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 625, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 625, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 512, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 538, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 611, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 611, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 611, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 612, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 612, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 612, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 511, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 592, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 720, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 999, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 1002, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 1298, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 1321, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "line": 1324, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1457, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 384, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 519, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 527, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 527, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 527, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 528, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 528, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 528, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4237, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4240, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4459, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4517, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4525, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4555, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4569, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 4576, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 383, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 487, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1730, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1765, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1766, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1770, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 1771, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "line": 2012, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 294, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 65, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 86, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 87, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 88, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 89, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 129, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 129, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 129, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 101, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 286, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 290, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 298, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 307, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 313, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 313, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "line": 330, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "line": 24, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "line": 24, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "line": 24, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "line": 37, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 97, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 97, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 97, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 259, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 586, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 589, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 58, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 138, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 228, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 228, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 228, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 229, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 229, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 229, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 105, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 805, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 806, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 1068, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 1069, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 216, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 423, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 426, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 2669, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "line": 2690, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 260, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 260, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 260, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 261, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 3263, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 3244, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 970, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 971, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 1425, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 1744, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 1745, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 1745, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "line": 1746, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 73, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 73, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 73, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 74, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 264, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 245, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 90, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 100, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 103, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 112, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 126, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "line": 131, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 88, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 88, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 88, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 186, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 186, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 126, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 266, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 268, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 270, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 278, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 339, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 342, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "line": 344, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "line": 415, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 811, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 815, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 851, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 875, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 139, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 169, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 523, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 553, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "line": 691, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "line": 31, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "line": 31, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "line": 31, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 114, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 188, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 188, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 188, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 189, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 189, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 189, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 197, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 564, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1063, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1627, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1766, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1767, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1940, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 42, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 176, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 379, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 536, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 770, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "line": 1575, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 5, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 6, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 129, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 155, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 188, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 197, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 342, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 342, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 2035, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 94, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 215, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 218, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 314, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 365, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 369, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 450, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 454, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "line": 278, + "kind": "initialization", + "token": " Initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 166, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 166, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 166, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 397, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 405, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 439, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 442, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 496, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 709, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2748, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2819, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2843, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 134, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 1728, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 1747, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 1957, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2334, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2339, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2378, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "line": 2382, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 42, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 46, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 47, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 62, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 403, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 403, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 534, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 542, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 557, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 562, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "line": 566, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "line": 74, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "line": 74, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "line": 76, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "line": 76, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 70, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 70, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 70, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 71, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 71, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 71, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 75, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 1071, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 605, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "line": 845, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 84, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 84, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 84, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 85, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 85, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 85, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 89, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 853, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 60, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 182, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "line": 666, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 155, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 157, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 157, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 144, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 144, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 144, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 145, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 145, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 145, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 149, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 268, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 605, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "line": 199, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 7, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 65, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 78, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 141, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 141, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 141, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 295, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 202, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 209, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 219, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 234, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 246, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 420, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 420, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "line": 482, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 3, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 46, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 82, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 82, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 82, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 60, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 168, + "kind": "layout_or_assembler", + "token": "NativeUint" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 500, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 503, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 503, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 43, + "kind": "initialization", + "token": " initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "line": 852, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 278, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 157, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 568, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 585, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 602, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 603, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "line": 620, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 121, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 121, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 121, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 122, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 122, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 122, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 256, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 258, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 258, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 56, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 212, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 244, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 244, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 244, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 245, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 245, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 245, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 200, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 211, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 867, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "line": 870, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 185, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 243, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 243, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 243, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 244, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 244, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 244, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 251, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 231, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 326, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 419, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 454, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 457, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 561, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 563, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "line": 563, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "line": 101, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "line": 172, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "line": 172, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "line": 172, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "line": 390, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 211, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 211, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 211, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 2222, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 2484, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 185, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 375, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 390, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 392, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 404, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 410, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 416, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "line": 422, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 172, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 469, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 471, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 471, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 419, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 461, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 461, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 461, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 462, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 462, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 462, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 479, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 207, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 361, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 3978, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 4402, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 4686, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 4792, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 195, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 197, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 418, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 432, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 672, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 678, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 827, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 838, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "line": 5855, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 197, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 199, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 199, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 145, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 185, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 185, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 185, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 186, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 186, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 186, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 207, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 144, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 157, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 943, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 981, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 1803, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "line": 3000, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 64, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 65, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 65, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 65, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 49, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 90, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 90, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 90, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 500, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 500, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 501, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 501, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "line": 505, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 43, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 98, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 150, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 150, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 150, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 151, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 151, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 151, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 140, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 246, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "line": 251, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 380, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 383, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 80, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 80, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 80, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 115, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "line": 318, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 157, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 200, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 210, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 240, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 240, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 240, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 241, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 241, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1309, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1310, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 228, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 424, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 427, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1066, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1114, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1466, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "line": 1487, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 127, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 127, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 127, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 128, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 128, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 128, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 134, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 115, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 311, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 448, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "line": 500, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 644, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 648, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 664, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 668, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 138, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 140, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 147, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 196, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "line": 198, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 92, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 92, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 92, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 71, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 227, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "line": 247, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 181, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 280, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 282, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 880, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 911, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 911, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 911, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 912, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 1969, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 1978, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2124, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2249, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2257, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2271, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2551, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 2555, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 79, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 81, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 397, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 575, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 584, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 899, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "line": 1022, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 230, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 232, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 233, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 269, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 333, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 333, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 333, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 662, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 2833, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 2859, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 2860, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 2862, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 190, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 202, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 219, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 240, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 244, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "line": 402, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 4, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 40, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 64, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 64, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 259, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 276, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 313, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 324, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 327, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 327, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "line": 336, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 117, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 117, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 117, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 58, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 188, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 1403, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2232, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2263, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2822, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2498, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2503, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2509, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2512, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "line": 2535, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 32, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 859, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 859, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 859, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 864, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 2320, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 2322, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 3674, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 3676, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 68, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 194, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 196, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 519, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 612, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 613, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 624, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "line": 6594, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "line": 191, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "line": 1491, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "line": 1492, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "line": 1296, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "line": 1298, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "line": 62, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 56, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 57, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 60, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 61, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 66, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 93, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 95, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "line": 105, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 144, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 62, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 65, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 5, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 5, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 80, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 80, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 80, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 63, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "line": 628, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 4, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 47, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 49, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 76, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 80, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 80, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 100, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 259, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "line": 448, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 66, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 66, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 66, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 75, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 81, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 106, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "line": 246, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 62, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 99, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 99, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 99, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 101, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 54, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 76, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "line": 161, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 132, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 132, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 133, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 133, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 135, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 135, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 80, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 121, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 121, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 121, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 123, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 123, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 123, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 319, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 100, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 145, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 176, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 208, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 448, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "line": 458, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 89, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 89, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 90, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 90, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 91, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 91, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 92, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 92, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 81, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 81, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 81, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 83, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 83, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 83, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 572, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "line": 65, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 142, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 142, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 142, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 116, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 182, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 357, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "line": 641, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 43, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 59, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 59, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 59, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 93, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 93, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 101, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "line": 101, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 105, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 189, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 191, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 224, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 249, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 249, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 249, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 318, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 415, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 4205, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 4292, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 4307, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 5573, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 5584, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 5635, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 6052, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 221, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 517, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 518, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 551, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 553, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 557, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 559, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "line": 7605, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 97, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 97, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 97, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 73, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 186, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "line": 186, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 282, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 287, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 301, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 417, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1265, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1266, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1461, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 11154, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 4, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 120, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 120, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 293, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 450, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 485, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 582, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 812, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 14753, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 14812, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 14817, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 14852, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 14975, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 15138, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 15211, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 15342, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 316, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 354, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 506, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 907, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1082, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1155, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1477, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 1707, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "line": 25317, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 64, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 64, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 387, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 581, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 585, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 625, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 699, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 699, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 699, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 700, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 3276, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 3312, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 3897, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 100, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 668, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 754, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 916, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 931, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "line": 2558, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 75, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 75, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 75, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 76, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 76, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 76, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 80, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 1012, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 1014, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 1069, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 1071, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "line": 1171, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "line": 582, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "line": 703, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 107, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 107, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 107, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 108, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 108, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 108, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 114, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 18, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 18, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 18, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 26, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 28, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "line": 23, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "line": 23, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "line": 23, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "line": 52, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "line": 52, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "line": 52, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "line": 68, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 73, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 73, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 73, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 74, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 74, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 74, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 1012, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 1042, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "line": 64, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 151, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 153, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 153, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 662, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 693, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 708, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 40, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 52, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 56, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 79, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 93, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 111, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 140, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 140, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 124, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 1049, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 1101, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "line": 1496, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 85, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 85, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 85, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 434, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 68, + "kind": "layout_or_assembler", + "token": "assembler" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 173, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 175, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 176, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 183, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 187, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "line": 1068, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 332, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 64, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 151, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 151, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 152, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 155, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 162, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 166, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "line": 669, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "line": 48, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "line": 136, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "line": 194, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "line": 266, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 60, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 68, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 25, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 30, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 31, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 35, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 36, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 37, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 38, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "line": 39, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 20, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 109, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 111, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 257, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 259, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 39, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 47, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/SciZipFile.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/VerySimpleXML.pas", + "line": 38, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/VerySimpleXML.pas", + "line": 155, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 3, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 12, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 102, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 370, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 11, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 11, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 11, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 11, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 49, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 54, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 54, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 212, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 212, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 375, + "kind": "layout_or_assembler", + "token": "pointeR" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "line": 789, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "line": 40, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "line": 170, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "line": 118, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "line": 117, + "kind": "windows_api", + "token": "WinApi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "line": 117, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "line": 248, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "line": 32, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "line": 32, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "line": 96, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "line": 121, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 32, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 32, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 33, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 46, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 47, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 79, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 298, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "line": 399, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 22, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 24, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 9, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 9, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 1006, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "line": 1011, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "line": 50, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "line": 110, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "line": 110, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 39, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 40, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 123, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 33, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 33, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 34, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 34, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 35, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "line": 962, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 35, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 32, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 32, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 33, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 101, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 102, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 114, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 230, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 230, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 438, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 438, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 453, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 456, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 484, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 499, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 557, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "line": 561, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "line": 41, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "line": 41, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "line": 138, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 78, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 78, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 205, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 883, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 4187, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 6137, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 8477, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 77, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 78, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 79, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 30158, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 30161, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 31687, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 31690, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 675, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 699, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 701, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 738, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 867, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 1008, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 1100, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 1764, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "line": 35127, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 508, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 510, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 765, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 767, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 1379, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "line": 1379, + "kind": "layout_or_assembler", + "token": "NativeInt" + }, + { + "path": "src/ext/Zippit.pas", + "line": 47, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Zippit.pas", + "line": 58, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Zippit.pas", + "line": 69, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/Zippit.pas", + "line": 77, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/Zippit.pas", + "line": 106, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Zippit.pas", + "line": 109, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/Zippit.pas", + "line": 111, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/Zippit.pas", + "line": 2, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/Zippit.pas", + "line": 4, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/bass.pas", + "line": 104, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/bass.pas", + "line": 19, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/bass.pas", + "line": 100, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/bass.pas", + "line": 126, + "kind": "windows_api", + "token": "MMSYSTEM" + }, + { + "path": "src/ext/bass.pas", + "line": 2, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/ext/bass.pas", + "line": 5, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/ext/bass.pas", + "line": 9, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/ext/bass.pas", + "line": 11, + "kind": "native_audio", + "token": "BASS_UNICODE" + }, + { + "path": "src/ext/bass.pas", + "line": 14, + "kind": "native_audio", + "token": "Bass" + }, + { + "path": "src/ext/bass.pas", + "line": 22, + "kind": "native_audio", + "token": "BASSVERSION" + }, + { + "path": "src/ext/bass.pas", + "line": 23, + "kind": "native_audio", + "token": "BASSVERSIONTEXT" + }, + { + "path": "src/ext/bass.pas", + "line": 29, + "kind": "native_audio", + "token": "BASS_ErrorGetCode" + }, + { + "path": "src/ext/bass.pas", + "line": 510, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 511, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 512, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 512, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 513, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 541, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/bass.pas", + "line": 633, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/bass.pas", + "line": 633, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 408, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 446, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 447, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 451, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 469, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 381, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 394, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 400, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 9935, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 9984, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 10064, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 10079, + "kind": "legacy_gl", + "token": "glOrtho" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 10205, + "kind": "legacy_gl", + "token": "glVertexPointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 111, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 112, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 114, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 475, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 492, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 527, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 592, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/dglOpenGL.pas", + "line": 17848, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "line": 7, + "kind": "windows_api", + "token": "WinAPI" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "line": 17, + "kind": "windows_api", + "token": "WinAPI" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "line": 73, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 172, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 173, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 3, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 171, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 604, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 1671, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 1673, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 672, + "kind": "native_audio", + "token": "BassToSides" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 1644, + "kind": "native_audio", + "token": "BassToSides" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 1652, + "kind": "native_audio", + "token": "BassToSides" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 558, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 570, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 619, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 620, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 621, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 710, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 725, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/libZPlay.pas", + "line": 911, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/openal.pas", + "line": 180, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/openal.pas", + "line": 1693, + "kind": "desktop_ui", + "token": "forms" + }, + { + "path": "src/ext/openal.pas", + "line": 60, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/openal.pas", + "line": 1912, + "kind": "windows_api", + "token": "mmsystem" + }, + { + "path": "src/ext/openal.pas", + "line": 16, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 41, + "kind": "native_audio", + "token": "openal" + }, + { + "path": "src/ext/openal.pas", + "line": 77, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 83, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 86, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 89, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 92, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 95, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/ext/openal.pas", + "line": 2282, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/openal.pas", + "line": 2284, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/openal.pas", + "line": 111, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/openal.pas", + "line": 164, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/openal.pas", + "line": 193, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/openal.pas", + "line": 225, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/openal.pas", + "line": 1222, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/openal.pas", + "line": 1250, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/openal.pas", + "line": 1592, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/openal.pas", + "line": 1716, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas", + "line": 20, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas", + "line": 73, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 11, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 598, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 600, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 548, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1073, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1073, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1080, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1091, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1101, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1167, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "line": 1167, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 8, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 35, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 358, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 361, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 364, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 410, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 414, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 593, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 524, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 529, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "line": 532, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "line": 44, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 8, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 35, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 358, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 361, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 364, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 410, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 414, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 593, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 524, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 529, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "line": 532, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 79, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 93, + "kind": "native_files", + "token": "Paramstr" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 95, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 111, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 112, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "line": 462, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "line": 63, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "line": 64, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "line": 65, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas", + "line": 56, + "kind": "initialization", + "token": " initialization" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 36, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "line": 1228, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 36, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 35, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 2243, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3113, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3114, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3249, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3253, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3472, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "line": 3476, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "line": 38, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "line": 36, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "line": 37, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "line": 37, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas", + "line": 37, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/pascalscript.pas", + "line": 26, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 129, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 131, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 248, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 252, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 253, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 552, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 555, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 557, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "line": 899, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas", + "line": 13, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas", + "line": 13, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_classes.pas", + "line": 191, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_classes.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "line": 1, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "line": 12, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "line": 94, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas", + "line": 14, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas", + "line": 14, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_forms.pas", + "line": 1, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "line": 1, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "line": 26, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "line": 31, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas", + "line": 14, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas", + "line": 14, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 147, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 153, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 157, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 729, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 938, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 1117, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 1963, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "line": 2185, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 233, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 235, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 240, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 251, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 361, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 501, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "line": 507, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponentExt.pas", + "line": 13, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "line": 20, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "line": 130, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "line": 38, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "line": 76, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "line": 90, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "line": 185, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "line": 92, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "line": 120, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "line": 712, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 491, + "kind": "native_files", + "token": "FINDFIRST" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 491, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 493, + "kind": "native_files", + "token": "FINDNEXT" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 493, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 905, + "kind": "native_files", + "token": "FINDFIRST" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 905, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 907, + "kind": "native_files", + "token": "FINDNEXT" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 907, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "line": 4625, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_buttons.pas", + "line": 16, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 681, + "kind": "native_files", + "token": "TFilestream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 685, + "kind": "native_files", + "token": "TFilestream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 688, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 694, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 694, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 696, + "kind": "native_files", + "token": "TFilestream" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 702, + "kind": "native_files", + "token": "TFILESTREAM" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 704, + "kind": "native_files", + "token": "TFILESTREAM" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 743, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 747, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "line": 763, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 23, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 26, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 26, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 222, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 237, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 275, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 290, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 23, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 340, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 341, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 361, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 365, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 439, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "line": 443, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "line": 22, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "line": 26, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "line": 136, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "line": 155, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas", + "line": 37, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "line": 19, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "line": 19, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "line": 19, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "line": 24, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "line": 27, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "line": 24, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 25, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 25, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 25, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 28, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 28, + "kind": "desktop_ui", + "token": "GRAPHICS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 28, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "line": 28, + "kind": "windows_api", + "token": "MESSAGES" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas", + "line": 33, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas", + "line": 33, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 15, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 41, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 70, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 80, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 120, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 125, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 202, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 252, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 300, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 322, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 340, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 354, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 355, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "line": 366, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas", + "line": 142, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas", + "line": 39, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas", + "line": 133, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "line": 55, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "line": 115, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "line": 196, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "line": 213, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas", + "line": 48, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas", + "line": 278, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "line": 27, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 69, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 70, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 71, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 73, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 66, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 67, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "line": 802, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "line": 61, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "line": 60, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "line": 486, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "line": 55, + "kind": "desktop_ui", + "token": "DIALOGS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "line": 56, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "line": 58, + "kind": "desktop_ui", + "token": "FORMS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "line": 54, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "line": 694, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas", + "line": 215, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 70, + "kind": "desktop_ui", + "token": "FORMS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 71, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 69, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 282, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 708, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 712, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "line": 1033, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas", + "line": 292, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 61, + "kind": "desktop_ui", + "token": "CONTROLS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 60, + "kind": "windows_api", + "token": "WINDOWS" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 1379, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 1781, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 1785, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "line": 2198, + "kind": "initialization", + "token": "\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas", + "line": 238, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "line": 54, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "line": 55, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "line": 414, + "kind": "initialization", + "token": " \n \ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas", + "line": 519, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "line": 316, + "kind": "native_files", + "token": "Paramstr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 141, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2154, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2191, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2324, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2464, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2467, + "kind": "desktop_ui", + "token": "Interfaces" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1318, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1411, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1596, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1600, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1600, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1602, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1605, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1605, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1086, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1152, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1233, + "kind": "layout_or_assembler", + "token": "EXTENDED" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 1430, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "line": 2374, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 331, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 357, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 359, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 678, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 501, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 667, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 1137, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 1411, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "line": 1429, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "line": 63, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 13, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 13, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 1176, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 1184, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 12, + "kind": "windows_api", + "token": "ShellAPI" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 12, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 12, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 2066, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 2123, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 2153, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 2131, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/forms/KM_FormMain.pas", + "line": 2251, + "kind": "initialization", + "token": "initialization" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/game/KM_FogOfWar.pas", + "line": 147, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/game/KM_FogOfWar.pas", + "line": 43, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/game/KM_Game.pas", + "line": 323, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/game/KM_Game.pas", + "line": 323, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/game/KM_Game.pas", + "line": 328, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/game/KM_Game.pas", + "line": 1698, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/KM_Game.pas", + "line": 3045, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/KM_Game.pas", + "line": 3199, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/KM_Game.pas", + "line": 3345, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/KM_Game.pas", + "line": 1602, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/KM_Game.pas", + "line": 2403, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/KM_Game.pas", + "line": 2671, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/KM_GameClasses.pas", + "line": 117, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/KM_GameSavePoints.pas", + "line": 423, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 133, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 1511, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 328, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 343, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 353, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "line": 2077, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "line": 353, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 299, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 345, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 19, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 40, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 128, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "line": 181, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/game/notifications/KM_Alerts.pas", + "line": 46, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/notifications/KM_Alerts.pas", + "line": 113, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/game/notifications/KM_MessageStack.pas", + "line": 134, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 90, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 176, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 239, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "line": 18, + "kind": "desktop_ui", + "token": "interfaces" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "line": 575, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 228, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 879, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 901, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 902, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 906, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 204, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 890, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 898, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 941, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 1298, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 1560, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 2202, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 449, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "line": 3006, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 390, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 394, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 412, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 416, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 931, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 953, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 1055, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 1230, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 1233, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 936, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "line": 937, + "kind": "windows_api", + "token": "windows" + }, + { + "path": "src/gui/KM_Viewport.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_Viewport.pas", + "line": 404, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_Viewport.pas", + "line": 405, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/KM_Viewport.pas", + "line": 406, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "line": 288, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "line": 389, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "line": 888, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 93, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 143, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "line": 411, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "line": 155, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "line": 155, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "line": 1237, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "line": 1320, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "line": 154, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 151, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 169, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 317, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "line": 103, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "line": 102, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "line": 61, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "line": 60, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "line": 92, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "line": 67, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "line": 66, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "line": 133, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "line": 159, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "line": 741, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "line": 20, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "line": 54, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "line": 54, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "line": 53, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "line": 48, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "line": 48, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "line": 47, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "line": 620, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "line": 226, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "line": 192, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "line": 202, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "line": 46, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "line": 45, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "line": 6, + "kind": "windows_api", + "token": "ShellAPI" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 1168, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 542, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 888, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 2717, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "line": 2734, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "line": 1046, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "line": 456, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "line": 659, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/hands/KM_Hand.pas", + "line": 1538, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandConstructions.pas", + "line": 152, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/hands/KM_HandConstructions.pas", + "line": 184, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "line": 59, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "line": 232, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "line": 242, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "line": 252, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandLogistics.pas", + "line": 74, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandLogistics.pas", + "line": 2270, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/hands/KM_HandSpectator.pas", + "line": 28, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/hands/KM_HandStats.pas", + "line": 14, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/hands/KM_HandStats.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/hands/KM_HandStats.pas", + "line": 39, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 45, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 46, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 158, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 170, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "line": 344, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseCollection.pas", + "line": 157, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "line": 14, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "line": 36, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "line": 266, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 109, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 259, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 260, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 260, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 741, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 1443, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/houses/KM_Houses.pas", + "line": 2643, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "line": 26, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "line": 34, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 975, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 232, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 249, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 258, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 264, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 362, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "line": 372, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Audio.pas", + "line": 20, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Music.pas", + "line": 681, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/media/KM_Music.pas", + "line": 6, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Music.pas", + "line": 6, + "kind": "native_audio", + "token": "bass" + }, + { + "path": "src/media/KM_Music.pas", + "line": 9, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Music.pas", + "line": 9, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Music.pas", + "line": 11, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Music.pas", + "line": 11, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Music.pas", + "line": 22, + "kind": "native_audio", + "token": "Bass" + }, + { + "path": "src/media/KM_Music.pas", + "line": 135, + "kind": "native_audio", + "token": "BASS_SetConfig" + }, + { + "path": "src/media/KM_Music.pas", + "line": 185, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Music.pas", + "line": 219, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Music.pas", + "line": 302, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/media/KM_Music.pas", + "line": 332, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/media/KM_ScriptSound.pas", + "line": 217, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 121, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 141, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 6, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 192, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 195, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 198, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 198, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 200, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 206, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 208, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 486, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 550, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 563, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 718, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 733, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_Sound.pas", + "line": 762, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 152, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 152, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 153, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 151, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 49, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 57, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 57, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_VLC.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 9, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/media/KM_Video.pas", + "line": 6, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/media/KM_Video.pas", + "line": 101, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/media/KM_Video.pas", + "line": 484, + "kind": "native_audio", + "token": "BASS" + }, + { + "path": "src/media/KM_Video.pas", + "line": 667, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/media/KM_Video.pas", + "line": 677, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/media/KM_Video.pas", + "line": 681, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/media/KM_Video.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 113, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 122, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/media/KM_Video.pas", + "line": 506, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 505, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 547, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 787, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 1061, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 1064, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 1110, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 1115, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "line": 1135, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/mission/KM_MapTypes.pas", + "line": 29, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/mission/KM_MapUtils.pas", + "line": 24, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 341, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 346, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 383, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 403, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 736, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 804, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 805, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 1079, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_Maps.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 201, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 216, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 222, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 222, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 229, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 230, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 235, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 235, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "line": 238, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/mission/KM_MissionScript_Info.pas", + "line": 133, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_MissionScript_Preview.pas", + "line": 78, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 738, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 755, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 129, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 208, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 845, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 1220, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "line": 1229, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/navmesh/KM_NavMeshGenerator.pas", + "line": 12, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/navmesh/KM_NavMeshGenerator.pas", + "line": 685, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "line": 26, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "line": 48, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "line": 108, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 22, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 249, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 71, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 191, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 207, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 208, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/net/KM_NetClient.pas", + "line": 209, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 5, + "kind": "desktop_ui", + "token": "dialogs" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 15, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 34, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 43, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 105, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 135, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "line": 127, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "line": 12, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "line": 32, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "line": 109, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "line": 174, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetDedicatedServer.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 136, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 139, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 149, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 166, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 184, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 194, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 313, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "line": 318, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 30, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 32, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 55, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 590, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 965, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 965, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 65, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 140, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 142, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 143, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 208, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 742, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServer.pas", + "line": 753, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 29, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 99, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 197, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "line": 233, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerLocator.pas", + "line": 105, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "line": 14, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "line": 33, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "line": 136, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "line": 156, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "line": 468, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "line": 469, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "line": 347, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetTypes.pas", + "line": 124, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetTypes.pas", + "line": 125, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_NetUDP.pas", + "line": 20, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDP.pas", + "line": 35, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDP.pas", + "line": 45, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDP.pas", + "line": 118, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDP.pas", + "line": 199, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "line": 9, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "line": 22, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "line": 67, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "line": 9, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "line": 22, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "line": 93, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 330, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 1128, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 1135, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 1723, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 1477, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 2047, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 2050, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 97, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/net/KM_Networking.pas", + "line": 1609, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "line": 28, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/pathfinding/KM_PathFindingJPS.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/pathfinding/KM_PathFindingJPS.pas", + "line": 64, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/perflog/KM_DevPerfLog.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/perflog/KM_DevPerfLog.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 47, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 47, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "line": 46, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_Render.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/render/KM_Render.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/render/KM_Render.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_Render.pas", + "line": 7, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_Render.pas", + "line": 203, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/render/KM_Render.pas", + "line": 209, + "kind": "legacy_gl", + "token": "glOrtho" + }, + { + "path": "src/render/KM_Render.pas", + "line": 212, + "kind": "legacy_gl", + "token": "glMatrixMode" + }, + { + "path": "src/render/KM_Render.pas", + "line": 399, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_Render.pas", + "line": 401, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_Render.pas", + "line": 49, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_Render.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_Render.pas", + "line": 246, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_Render.pas", + "line": 286, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 67, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 80, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 82, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 90, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 92, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 100, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 103, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderAux.pas", + "line": 112, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 8, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 10, + "kind": "windows_api", + "token": "Messages" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 28, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 70, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 100, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 8, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderControl.pas", + "line": 9, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderGameAux.pas", + "line": 31, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 161, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1259, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1264, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1272, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1277, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1327, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1332, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderPool.pas", + "line": 1346, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderQuery.pas", + "line": 9, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 5, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 218, + "kind": "legacy_gl", + "token": "glVertexPointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 607, + "kind": "legacy_gl", + "token": "glVertexPointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 635, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 640, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 679, + "kind": "legacy_gl", + "token": "glVertexPointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 709, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 720, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 607, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 610, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 612, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 613, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 679, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 682, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 684, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "line": 685, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 76, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 249, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 254, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 269, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 274, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 292, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 294, + "kind": "legacy_gl", + "token": "glEnd" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 301, + "kind": "legacy_gl", + "token": "glBegin" + }, + { + "path": "src/render/KM_RenderUI.pas", + "line": 1051, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/res/KM_ResCursors.pas", + "line": 11, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/res/KM_ResExporter.pas", + "line": 342, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/res/KM_ResExporter.pas", + "line": 589, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/res/KM_ResExporter.pas", + "line": 813, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 5, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 217, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 302, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 307, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 309, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResFonts.pas", + "line": 65, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "line": 589, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "line": 616, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "line": 584, + "kind": "layout_or_assembler", + "token": "extended" + }, + { + "path": "src/res/KM_ResHouses.pas", + "line": 908, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResHouses.pas", + "line": 19, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResHouses.pas", + "line": 23, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResInterpolation.pas", + "line": 51, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResKeys.pas", + "line": 54, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/res/KM_ResKeys.pas", + "line": 252, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/res/KM_ResLocales.pas", + "line": 125, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResMapElements.pas", + "line": 134, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResMapElements.pas", + "line": 13, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResPalettes.pas", + "line": 102, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 301, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 565, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 459, + "kind": "native_audio", + "token": "OpenAL" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 318, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 559, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 568, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 585, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSound.pas", + "line": 117, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 2049, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 2253, + "kind": "desktop_ui", + "token": "graphics" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 665, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 668, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 723, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 784, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 793, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 795, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 847, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSprites.pas", + "line": 852, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 657, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 724, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 734, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 789, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "line": 816, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/res/KM_ResTexts.pas", + "line": 127, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResTexts.pas", + "line": 99, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/res/KM_ResTileset.pas", + "line": 320, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResTileset.pas", + "line": 30, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResTileset.pas", + "line": 50, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_ResUnits.pas", + "line": 705, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_ResUnits.pas", + "line": 16, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/res/KM_Resource.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/res/KM_Resource.pas", + "line": 5, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 181, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 300, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 305, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 316, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 346, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 347, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 418, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/res/KM_Saves.pas", + "line": 758, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "line": 18, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "line": 108, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "line": 190, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "line": 213, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "line": 176, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "line": 470, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "line": 475, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "line": 479, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 304, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 51, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 52, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 179, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 191, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 956, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 956, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 957, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "line": 957, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingActions.pas", + "line": 3194, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/scripting/KM_ScriptingActions.pas", + "line": 5084, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/scripting/KM_ScriptingEvents.pas", + "line": 882, + "kind": "windows_api", + "token": "messages" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "line": 13, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "line": 69, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "line": 101, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "line": 133, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/scripting/KM_ScriptingTypes.pas", + "line": 86, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/scripting/KM_ScriptingTypes.pas", + "line": 98, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 58, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 59, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 59, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 60, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 60, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "line": 61, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/settings/KM_GameSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/settings/KM_MainSettings.pas", + "line": 51, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/settings/KM_Resolutions.pas", + "line": 50, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/settings/KM_ServerSettings.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/settings/KM_Settings.pas", + "line": 135, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 8, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 8, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 17, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 77, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 155, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 157, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "line": 128, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/settings/KM_WindowParams.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 490, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 19, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 35, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 178, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 186, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 188, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 189, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 261, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "line": 262, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "line": 2055, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "line": 2160, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "line": 2045, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "line": 2152, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "line": 7, + "kind": "windows_api", + "token": "Winapi" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "line": 409, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "line": 466, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "line": 35, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "line": 110, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "line": 129, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "line": 5, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "line": 237, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/units/KM_UnitGroup.pas", + "line": 1905, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 27, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 81, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 83, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 83, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 226, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 237, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "line": 251, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 472, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 572, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 579, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 586, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 595, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 838, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 1289, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_Units.pas", + "line": 2816, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 374, + "kind": "layout_or_assembler", + "token": "POINTER" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 376, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 381, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 382, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 382, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 386, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 388, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "line": 388, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/actions/KM_UnitActionFight.pas", + "line": 209, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/units/actions/KM_UnitActionWalkTo.pas", + "line": 243, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/units/tasks/KM_UnitTaskBuild.pas", + "line": 707, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 53, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 72, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 83, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 119, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 138, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 172, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 200, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "line": 209, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 16, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 19, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 15, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 17, + "kind": "windows_api", + "token": "ShellApi" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 9, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 10, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 63, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 80, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "line": 82, + "kind": "layout_or_assembler", + "token": "asm" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 104, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 8, + "kind": "windows_api", + "token": "MMSystem" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 1623, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 1633, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 1645, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 1655, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 77, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 81, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 121, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 124, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 154, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 333, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 334, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 1384, + "kind": "layout_or_assembler", + "token": "Extended" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "line": 2067, + "kind": "initialization", + "token": "\n\ninitialization" + }, + { + "path": "src/utils/KM_ConsoleTimer.pas", + "line": 54, + "kind": "desktop_ui", + "token": "controls" + }, + { + "path": "src/utils/KM_ConsoleTimer.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 8, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 313, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 287, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 292, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 297, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KM_Utils.pas", + "line": 302, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "line": 6, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "line": 30, + "kind": "desktop_ui", + "token": "LCLIntF" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "line": 30, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "line": 8, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "line": 6, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "line": 8, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "line": 7, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "line": 199, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "line": 5, + "kind": "legacy_gl", + "token": "dglOpenGL" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 8, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Forms" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 10, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 60, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 61, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 62, + "kind": "desktop_ui", + "token": "Controls" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "MMSystem" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 9, + "kind": "windows_api", + "token": "ShellApi" + }, + { + "path": "src/utils/KromShellUtils.pas", + "line": 35, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 7, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 8, + "kind": "desktop_ui", + "token": "LCLIntf" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "MMSystem" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 215, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 228, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 228, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 526, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 62, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 64, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 71, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 243, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 243, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 269, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 476, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/KromUtils.pas", + "line": 478, + "kind": "layout_or_assembler", + "token": "NativeUInt" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 9, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 14, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 23, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 24, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 25, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 55, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 65, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "line": 67, + "kind": "layout_or_assembler", + "token": "Pointer" + }, + { + "path": "src/utils/algorithms/KM_BinPacking.pas", + "line": 17, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/utils/algorithms/KM_BinPacking.pas", + "line": 19, + "kind": "layout_or_assembler", + "token": "packed record" + }, + { + "path": "src/utils/algorithms/KM_SoftShadows.pas", + "line": 11, + "kind": "layout_or_assembler", + "token": "pointer" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 10, + "kind": "desktop_ui", + "token": "LCLType" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 9, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 9, + "kind": "windows_api", + "token": "ShellAPI" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 256, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 332, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 170, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 369, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 405, + "kind": "native_files", + "token": "FindFirst" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 411, + "kind": "native_files", + "token": "FindNext" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 420, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 498, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 501, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "line": 555, + "kind": "native_files", + "token": "ParamStr" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "line": 7, + "kind": "desktop_ui", + "token": "Graphics" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "line": 15, + "kind": "desktop_ui", + "token": "Dialogs" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "line": 6, + "kind": "windows_api", + "token": "Windows" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "line": 70, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/io/KM_IoJSON.pas", + "line": 133, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/utils/io/KM_IoJSON.pas", + "line": 144, + "kind": "native_files", + "token": "TFileStream" + }, + { + "path": "src/utils/io/KM_IoXML.pas", + "line": 171, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/io/KM_IoXML.pas", + "line": 177, + "kind": "native_files", + "token": "FileExists" + }, + { + "path": "src/utils/method_parser/KM_MethodParser.pas", + "line": 337, + "kind": "native_files", + "token": "FileExists" + } + ], + "files": [ + { + "path": "src/KM_Console.pas", + "sha256": "ec2725ac36fe894e7855168747df4790828b25af9d7d5a34bfe68b5a7dd9aa6c" + }, + { + "path": "src/KM_Crashreport.pas", + "sha256": "462bb3058ebaaf2b18fd6642586e93c7c2513314ab6352c43409f3b87308299c" + }, + { + "path": "src/KM_Exceptions.pas", + "sha256": "a3cea70a34454661ecff7f101626f89d2b71825a25009bd47bd14b1610204220" + }, + { + "path": "src/KM_GameApp.pas", + "sha256": "94c683fa9f2145fd9dcc580b83b2c80217a8e4e236043d4f4539964b48d8f58c" + }, + { + "path": "src/KM_Log.pas", + "sha256": "0dd5f9e66d452c415cf59a81aaa0508efa371bd19ae50c0c90aeca2b16cc0a96" + }, + { + "path": "src/KM_Main.pas", + "sha256": "1ec45fea42418453cd6f18ebe3dc499c39f3dfc4944ff6b34679167e4a2ba97c" + }, + { + "path": "src/KM_Projectiles.pas", + "sha256": "7851dcf76ae7571334c2674c230a4a2c48f962dd379c3b15dbbadcc9e2cd449e" + }, + { + "path": "src/KM_System.pas", + "sha256": "1022cdf06a99b786043c5be41b2543115c95eae3ceccd529bcb0e960e5032f23" + }, + { + "path": "src/ai/KM_AI.pas", + "sha256": "8d58808f0b9d6e3110ad4a6688b04f94d56dacf9ff210a36b1665a47ee52c17a" + }, + { + "path": "src/ai/KM_AIArmyEvaluation.pas", + "sha256": "1cf68f6cfa91e5653a3a952c9f0bac0539e25860a0031a75543e73020a9cd24a" + }, + { + "path": "src/ai/KM_AIAttacks.pas", + "sha256": "9f449dd9e93b336af8369a3c55bec12f34e591a2a0916028c76dda467ed67706" + }, + { + "path": "src/ai/KM_AICityPlanner.pas", + "sha256": "7215b38858493b7d2effd9f89cab27c680f135d9c79af9650097ab2005ce144d" + }, + { + "path": "src/ai/KM_AIDefensePos.pas", + "sha256": "736853fc643b2c5d0351430780d4e939f2414911220551a4055175f7e5d6c0a9" + }, + { + "path": "src/ai/KM_AIFields.pas", + "sha256": "ebc541a50513e69b21abac613b07b848261130e69cb55e883e8dcb5789b4d6e5" + }, + { + "path": "src/ai/KM_AIGeneral.pas", + "sha256": "62e4b43d156f205f73de48590cc96b0d831a57ce9b6a0fdd35bb8d203d8accc5" + }, + { + "path": "src/ai/KM_AIGoals.pas", + "sha256": "df64bb01294f0a91f00ee24bf42c5879296a768dd897db8e73a019002c542fcb" + }, + { + "path": "src/ai/KM_AIInfluences.pas", + "sha256": "91d1062df9198dc2ff83aaae89321ae66afb923bbee445f62b22373c607e5a56" + }, + { + "path": "src/ai/KM_AIMayor.pas", + "sha256": "3e119af47d0cd05f70e67846cdc648865f618e56c66f84c7dd63079d65a9fd22" + }, + { + "path": "src/ai/KM_AIMayorBalance.pas", + "sha256": "46bc59345f89bb86e15a91f6ab43b4f01aa72ebe26524c02926e331ab51d1448" + }, + { + "path": "src/ai/KM_AISetup.pas", + "sha256": "5c24a388760a039d3964f8396d5798200c52a9e30f7863cab3c1768cea2d6c0d" + }, + { + "path": "src/ai/KM_AITypes.pas", + "sha256": "f80ad7fd48fed61572bb300deea7a7d08d9b7726871164d8a65cc7532b29f672" + }, + { + "path": "src/ai/newAI/KM_AIParameters.pas", + "sha256": "8b7d07fdf51944a538266fd8bbafdf3b89250f0944de97595adca272b07f070e" + }, + { + "path": "src/ai/newAI/KM_ArmyAttack.pas", + "sha256": "568dc0393caab3b8ba0233ce62ff5f639f36947107d6504f43a85685d027d78a" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "sha256": "ac1cf8d983a8f920272f0e82ff22f8cc85057dce955721a4ae79e1f0c0fd8bde" + }, + { + "path": "src/ai/newAI/KM_ArmyDefence.pas", + "sha256": "874336297ce5babbf362d67c60089a1cf6e197ad0b90782288fa7f85b49e2e19" + }, + { + "path": "src/ai/newAI/KM_ArmyManagement.pas", + "sha256": "3f93d3a749d40b4fc2ecf21ee31dad5203244bc08c5d8c4cab8183b03d43c213" + }, + { + "path": "src/ai/newAI/KM_CityBuilder.pas", + "sha256": "646f2cbbb75f529637879755e02b8ef17c0901cf8de2684a98df90d58c09ad54" + }, + { + "path": "src/ai/newAI/KM_CityManagement.pas", + "sha256": "fd07b221e052f7ba48644628bfc8ca47658802b7461287ea0bf7d22fabc9814c" + }, + { + "path": "src/ai/newAI/KM_CityPlanner.pas", + "sha256": "b2e207d0697192bbcd3a0ffdbc5dfffcd30521f7e403616ef15fa471c0aa123b" + }, + { + "path": "src/ai/newAI/KM_CityPredictor.pas", + "sha256": "c5adfc3c7f9364fee6457cab8b427fec0e2963a3af17dd773a23f0c3dd39114b" + }, + { + "path": "src/ai/newAI/KM_Eye.pas", + "sha256": "f3ed155b642866e6331f6d33373762a58785d1f02d4a97fea6f676534b6c8bed" + }, + { + "path": "src/ai/newAI/KM_Supervisor.pas", + "sha256": "faa9200436dd25fca95b5989154da0e4412f2c7ad013d6a919bc980ada1bd7b5" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "sha256": "4889af4aedf2174509fd1d0c0a6f6a2b7b64dd680a7266b8483db74b492f95a1" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "sha256": "a96e123fafb3d90a1715ddf4c249d3feec91e8df3971e5d8612846ea9fba39a1" + }, + { + "path": "src/common/KM_CommonExceptions.pas", + "sha256": "7198f3aa91b83bc925c401e24ee569db1d525c98650e3e7779f074871d5ea44a" + }, + { + "path": "src/common/KM_CommonGameTypes.pas", + "sha256": "7021fe5a4ed528a523b2a14894322967f8137543226646cbe627e17b5c036dad" + }, + { + "path": "src/common/KM_CommonTypes.pas", + "sha256": "dc0c838a0e440cb80ef89ab173402476ef10b1cd5dcb2b08ebba462e5b6ce0dc" + }, + { + "path": "src/common/KM_Defaults.pas", + "sha256": "4731fcfe204ed19c98ed2dd3e2fe479f15fc089ae3654ee43c471c7f789fed10" + }, + { + "path": "src/common/KM_Entity.pas", + "sha256": "627e02748bdc9f2e365b1e034e558fe9e55acd52982a514052f6e43c664eec37" + }, + { + "path": "src/common/KM_Lists.pas", + "sha256": "05b1535a3b7b840cd1976b7c68d0fab56668282db117cf7aa3f48229b847f4fa" + }, + { + "path": "src/common/KM_Points.pas", + "sha256": "b3ac9d1c48aedc723a56c952f771802115cca0025ef050383d5dadcbb8e26132" + }, + { + "path": "src/common/KM_WorkerThread.pas", + "sha256": "fbabc6c0a533085603b5e0588cb80ff3c0dd4a89c69cb1c072f8f449de8696c4" + }, + { + "path": "src/common/KM_WorkerThreadUtils.pas", + "sha256": "2471748f44531d1a1a21e4888b4641098b0c070b5ac21d6bd4e6609f463ec4e8" + }, + { + "path": "src/controls/KM_Controls.pas", + "sha256": "1b28806141e07039b1fb18d3d25cd432d101ab880f5e50c4a82d5bc9c79ddaf3" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "sha256": "befbe571b4fb93ebed9503ebf05604ff7fdb529bbaeba846efd146c07088eed4" + }, + { + "path": "src/controls/KM_ControlsChart.pas", + "sha256": "45eef7023b4a58f66c2a2bef6bcffb49e97a16ef6400712e52bd1b815ebe4b08" + }, + { + "path": "src/controls/KM_ControlsColor.pas", + "sha256": "6d6ced6d7d512090b2de07398c75a64ed26085a775edae4bb46be3725271a6ec" + }, + { + "path": "src/controls/KM_ControlsDragger.pas", + "sha256": "f33ce9ba9827d75bc58247acf0a4150155d47f1ed757a00081e2b23a2da87c1a" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "sha256": "044dbb810a75fdb047a91b41dc9179f8245a0e4ed21236677ee5dea243c673b7" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "sha256": "0942a45abd2f4c8cdbe0225838424e5eb409fee2517aa221c8a0e0be90fd5079" + }, + { + "path": "src/controls/KM_ControlsForm.pas", + "sha256": "98f52c23f4718e36da00222acb62d53c158961f5698668b43d0afd1a3fdedb7b" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "sha256": "7f8b22a3044272f822bcc7d038d2debb55d2a6695c51753fa6bddb35666d3598" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "sha256": "e23963c974847435ba3fb2f13dba527a92a746c75873ed4e7ab8bd39ac07e146" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "sha256": "dac705b593e547df6ea73d15bb348e89ff2e50574a553405c787a684a49bc979" + }, + { + "path": "src/controls/KM_ControlsPopUp.pas", + "sha256": "534507699f46b5a062ab440fdbdefde2f966d23b06c9a5a570bc5fe958c66fc5" + }, + { + "path": "src/controls/KM_ControlsProgressBar.pas", + "sha256": "769335ff01446bce98fb4a19dce65bb2eb62fd941f8c659cf3e276893e4a5309" + }, + { + "path": "src/controls/KM_ControlsScroll.pas", + "sha256": "aca2e9dc6da62703571ca7251a2eeab30d29279de0c273e5fbc57992757d9635" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "sha256": "a363807128a8bd01e9cae584390281ecf29c6e93592fec7a95fe598d413ec6ea" + }, + { + "path": "src/controls/KM_ControlsTrackBar.pas", + "sha256": "2183cc3a50e5a13670f9d54f3376858972d90bc194b59d270f0ddb023a71e8c1" + }, + { + "path": "src/controls/KM_ControlsTypes.pas", + "sha256": "271f13fa7867ea1b39c2d121c5fcec799ac7e137ff15768b9e9726e0150ff3b3" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "sha256": "099b1bb73a96c87eeb775fa8f7677ccdc1a12b788fcf8aab677fff702b9eddda" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "sha256": "435a8b7ae9a74b5339590bc0addf806231e58c886b3ebfb947c343842a15664a" + }, + { + "path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "sha256": "d778e2b034c3ec3e1e954cd9549e61b754a73f3f284bec84928d67c1018c3471" + }, + { + "path": "src/ext/BGRABitmap/bgraarrow.pas", + "sha256": "4c8ec6ccff690e139117a22ad754f09d80902326a21187a24a60f26fb69a2ef9" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "sha256": "491b7b30a8e8cc4b8a5d57511561b6b421434a7c4b59a9ccc6427e4e98cd2f6f" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack.pas", + "sha256": "07e51934404f81ca20a5349b074f0613bec879b78a56e62e99e35357b4419911" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas", + "sha256": "fb1a8e0a8adfd3f0238c6122c3fbeaa76d2ab1169bc46f7ff489496230d28ba7" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4nogui.pas", + "sha256": "1883384b69bb49264585972eccdfaba0f79fa36e7f1a8a80836d043a39df4c5e" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "sha256": "0f892b3508285c1929a6607abc03e479bf8e8b56eda3090f5f95c3f3a1d16a0b" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "sha256": "08a1fcb093154ed5478788adb94febc969f201de0acd9178a69fd43c37c1c076" + }, + { + "path": "src/ext/BGRABitmap/bgrablurgl.pas", + "sha256": "d0bd6e8beef1be7159cbc30ae63b57b6e05a89dc1052c52a05fd1ce0e4678b28" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "sha256": "bb1a90a3e8105054df0655f2e126746ef725667a4fbd51ca15c60ed2178d1d05" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "sha256": "c19f40a2b6e350bb95dcaad238580576441d6ce0ceb7f579b79723928c58ee9f" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "sha256": "f355f3297becbbb4707d17391fcbd4bffe65f07c5786d6a1312ab78d6093c101" + }, + { + "path": "src/ext/BGRABitmap/bgraclasses.pas", + "sha256": "20887df29bd48d7568d632529f3995c9705430a4d531c908accca0410018a103" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "sha256": "0fb44ecd453637fa299699fdb0718a10c98c97c24a284b7f99272c2d949ba47a" + }, + { + "path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "sha256": "974a090a4d585f465ae06bfe81a0224218e776995c4d5373d30f3e96135390a0" + }, + { + "path": "src/ext/BGRABitmap/bgracompressablebitmap.pas", + "sha256": "fc0c02744a09517a85fa301cedc0667cb70a977550ec8160a349081169875692" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "sha256": "8d69fe69aab7838233d386e66cf91c45c64ef2027e8788b4f87214ed4271f398" + }, + { + "path": "src/ext/BGRABitmap/bgracustomtextfx.pas", + "sha256": "039971ed9b16f5afb7b79399b520b92332357b1d024627e3a949b6c55911fa07" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "sha256": "37310135e9e19361159762883cd5aa7e004a1d424ce8e932dd60d165441d63bf" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "sha256": "d5e4b678cff117851dbf39853201b8c527a8950c802da058f01921a5bf0a1e76" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "sha256": "15a6ef3483d5f16bf136027ec2749582465fc9fc2f0d23db87e00c2628ca6996" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "sha256": "ce25fa5a46f58d74a799cf68127bebc8457475610d5b5b6809a74ceb24bac77d" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "sha256": "0c4984623455519c57ce61c0085e6fd4739e23b0d403a57e555f6ab62bd1654c" + }, + { + "path": "src/ext/BGRABitmap/bgrafilters.pas", + "sha256": "c7e13481eb76c453d986b3a2df887de87b5866af13bd2d5c9f900986eb5f7c7e" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterscanner.pas", + "sha256": "ba73a33d42b5e43a559cbf8c8ae38b14dbd7b52e7c05c14a729b0d416aa151ad" + }, + { + "path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "sha256": "7fee88debc74b6e740c34af81ba7d6d6d4c0a39fccae0db85ae36b9d3b1d2d2c" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "sha256": "77f0b6c4cb4560ce10eaac9cc3cbc71041dc2843601ccba9a0856f568a7fca94" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "sha256": "6c8a1da352186a2c62f641fa233331ce3d102943040d343cd83b7577629488bb" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "sha256": "c26e390761181051a4bef03842b2b9c84deb6fab5460bd46eff39439c8b28f6a" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "sha256": "7f78c2aa2e61a69c570ad69e6bd4d8bbf85fd95e469cc46f7604c95cfdba2a23" + }, + { + "path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "sha256": "b77183c70b20f8abfa1af8b5957f17fc8c98cd6e56b9835f330f896bb1193157" + }, + { + "path": "src/ext/BGRABitmap/bgragradients.pas", + "sha256": "5b89650b3b39ae371e7f212a912692716d0f4cd3c7c9ebd0f548ff39538de696" + }, + { + "path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "sha256": "60e0d6c7f9a512173caec70007fdeba4632fb0fe9c9e5c8f7abf958a073c2fd6" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "sha256": "92093cbf599916e98d7eb05909a42265f3067c7cf557cb45c6bf0ede96194a75" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "sha256": "ac4706df660a091787d82e5fd2ab11e199c8f98ec792841625ef9609d2899ef6" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "sha256": "cc1ee87c685a06c6e277b80f7ee7f6715d453ce1be9b291e65dabfecc0c969bb" + }, + { + "path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "sha256": "0598a1c833d60ed07c69eba58bbf6300ded2a1497d9f59d9925929807ded5e6c" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "sha256": "fa8a4f82e9d2744e27dccecf387327549412fdb528bdba6b9d99eb82e81ce6f7" + }, + { + "path": "src/ext/BGRABitmap/bgralayers.pas", + "sha256": "ff3c7f640cefba6b06f26543a41ecbd6439be1b5d165f7d3ad4340245b47368f" + }, + { + "path": "src/ext/BGRABitmap/bgralazpaint.pas", + "sha256": "b6cefad40a695141f41a9b9a023baa216db88d2b03f973f955720966f7f8fbd0" + }, + { + "path": "src/ext/BGRABitmap/bgralazresource.pas", + "sha256": "2025ef390723fee59f4c098a66e270dd8b907eb18d551fcb46c49c1f4196a184" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "sha256": "0f15d3d9f5b1d2a5c0cfb9ec9e7e90db56f10b50017a39a7400cdb988b04b701" + }, + { + "path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "sha256": "8f7f2033706b524fc1adcca5d533afcedd2d17306c81742d0e925c81c2b32628" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "sha256": "7207c8feb702bf8fc8fb7302897bd6305da199a08272c67688c6b2760c2579eb" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "sha256": "4bc5fe62d60c4b83d0cb47fa777319a095a816227e5ea9bca870b720a826a461" + }, + { + "path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "sha256": "ac258fbb77cec7922b1684c4ba78c25748519ff9a40526f55a50cb3ad6c10bcb" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "sha256": "804b1081d1ae55f0ee688ac5df888fbd39a83c3fb9a1f9243b6a3fb163cebafb" + }, + { + "path": "src/ext/BGRABitmap/bgramultifiletype.pas", + "sha256": "98d77ba1a0715ffb01ccc7a10ad4252c121bfaf45b594ac73ff12cd65ab14a8e" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "sha256": "34e4cc46903fb094747099e591933d1826c411f9dc6ce0f999da4a2fddcd7d3c" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "sha256": "129c6eaf5bd428895e6befde65c7a43c9833d61c0c977bf3d55132d5b47592e8" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl3d.pas", + "sha256": "42444c0e372d2fd50e9958610e6292c342b9b04107e29c513a939e0d78cd71bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "sha256": "9326f25c6208a1f2958ef24758a6a8d548aec3e0fccd953080ba35b4178172bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopenraster.pas", + "sha256": "af621591b5a03da46860f7ae5f897569da6f12679956f150971e4d52752094c5" + }, + { + "path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "sha256": "24a72dfded09742c76cb5a552fbb16a4406fad2b478dc79042aa1f43b96c53a3" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "sha256": "91c9a21037b7751741bd8d9368ef0c485e8af51dc5244a3180b76dd29a4e75d3" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "sha256": "b224cd235796b3fd86005a5e4b752765bbb01a87789c49ab08a01dd5d2ee011e" + }, + { + "path": "src/ext/BGRABitmap/bgrapen.pas", + "sha256": "0cb9f96417c473d4a789ad45b01d75012ecf7572439945abab418bd41b63e63f" + }, + { + "path": "src/ext/BGRABitmap/bgraphongtypes.pas", + "sha256": "78010e120172e8d7efc7b8d6601a3935daa88ca0ddb57398b91d8600e1b5bbe7" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "sha256": "8b380cb0950f0d1d341b38d9c32f8fc2bd664051dcc46dcb43a09aa2f62ec18f" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygon.pas", + "sha256": "3cf94340689494dd8f5c42c1c4b289c76619e050b8d2a8efef1a5a8c20ac8797" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "sha256": "206934c6bdb0bb6257329653d75ec99b5e7b4f3a0cabf18612699c6dcd5f081c" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "sha256": "a0978804b32333f1ab385273b5eea2284ae3f6040d1eaa3bcc166ba14a98c31c" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "sha256": "11e445c5f6c6d70e084ce985c2bc5eec59bb6c4e4de62926c2fb31c76fa395ce" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "sha256": "189e6f2c8b7d56c328c87a906b3d1025b6af829050931c5d9e45a4a8d953debf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadgif.pas", + "sha256": "ff98829eeee4883d39f957baef90c516adce360f0a69b0b905149a0d09ad4c53" + }, + { + "path": "src/ext/BGRABitmap/bgrareadico.pas", + "sha256": "a25d29c357d952fe42ab31706e5dd2317396d96c1a9aa956e7cb6d25e672417d" + }, + { + "path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "sha256": "a640eb3e41a74acd59ae9b295eadb2c5ab7c1573887331cdd22f8d64a13080a8" + }, + { + "path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "sha256": "121fe5c762326b4b4b3731141b8d7d5c8347414e20987b9031516b8fb7f849fd" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "sha256": "34dff1bd9257d040428fb61a56229d4d0860c51c87468bcf729c9dae97df6e52" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpng.pas", + "sha256": "dcd2bf8a16a8c5b18d36e3c2ad55109a4c5612c8c57f39427ff21050e8c0d0da" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "sha256": "5af0e7d5fbedb438c538483aed16b18a2186df4c5cd98938f4ad81de342e6fa2" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtga.pas", + "sha256": "538f2bf3c5ff8e49db9b8fced65f62ab8354cea759610175dbb2f66046aafadf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "sha256": "73d704e60109646566ec935a3ee16be1e813b53b0418fe08cd2fc9cfb1c20494" + }, + { + "path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "sha256": "adfcd666b623755d1530ea4b0cfd57a99b354dab9f4fa8ae69fb5fecf86be556" + }, + { + "path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "sha256": "0f63b0a79cbfbef8f444b9578f09595fb226776c83e2e676f5016f813ebe142e" + }, + { + "path": "src/ext/BGRABitmap/bgrarenderer3d.pas", + "sha256": "09dd98e68b0e69b9fb4f92d1b22ef44bc210680eaf205ee7f0efa4f2d6c83f22" + }, + { + "path": "src/ext/BGRABitmap/bgraresample.pas", + "sha256": "95dbe34e06991df81414dc2a8557ae608dd51ac4a28273f03120793dd49d8877" + }, + { + "path": "src/ext/BGRABitmap/bgrascene3d.pas", + "sha256": "a112f0be88e33f9aa1fb826e70da7c0e9c33732eb9eb66a5bd9cdb038556267e" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "sha256": "d51ddb17d5536936523c5214513379fa64c0800ad1434c74f1283fdd8662ad7d" + }, + { + "path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "sha256": "e56fd004c3bfb7598183cde3effee44997265c2164d1bc30d09c8a805ebe0309" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "sha256": "0e727cf473e6efad2379a3b1385a62abff36c283712c62f5e4e73ecd21d77396" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "sha256": "8444b817dc843a1258b665ecf1daec057b26f58f42c646cc75811f9c83ad1df9" + }, + { + "path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "sha256": "80ae6626033f3a18f77cc7685780191d1f658bca35886aa2e804e548b8f21313" + }, + { + "path": "src/ext/BGRABitmap/bgrasvg.pas", + "sha256": "e95eb0028b92a04d9a15b15faff5cf726e793e5dfadd6d635f117e22f3c9c09c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "sha256": "c1eaa0768f01913e9d24284df54e3042444ea3fdc5e9a0685692d7a33ec5d70c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgshapes.pas", + "sha256": "46b588cf74cfa086d9e408ba0f7cffecafb14fc4a9026ecb3bb7e8b512b933c6" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgtype.pas", + "sha256": "0337579797b600c8a6dd8e52abcab46ea588cc5d37fd6ce89e11ce7dcbb4b1f2" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "sha256": "1595e318a7e1d421c1b06318c108e09729774eb92530c043050ce14505511446" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "sha256": "10fa668c584faed9c50c7157a52ccfd9ab697fad1829710ec37fcd91284adf93" + }, + { + "path": "src/ext/BGRABitmap/bgratextfx.pas", + "sha256": "12213f525b0e2237eb5b0b6c0552e80f7ba8b6c09b14781d30e06b6177db8d1b" + }, + { + "path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "sha256": "1b391877196e3a667aea8f00a3b2e3c011003d9739e66950e8fdb63fb665acd7" + }, + { + "path": "src/ext/BGRABitmap/bgratransform.pas", + "sha256": "19149aa065f5b787d8b510a88d12073fe6d45ad4dc9e33731db9990201e4abd0" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "sha256": "e272de83a67af9c340a54cfe18eeef582fea954fdf333d9d787742a16b09c4cb" + }, + { + "path": "src/ext/BGRABitmap/bgraunicode.pas", + "sha256": "32553bdda3292a351aebbfd74637979060e3400578092c2cf69f96c93270afcf" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "sha256": "d8f9732a4e7a7d93085a909011702346ffbebec4a17bd85f5656162c0f6b91fa" + }, + { + "path": "src/ext/BGRABitmap/bgraunits.pas", + "sha256": "15bfb722add1f2174415a51608f43dd3f8e146f8f897819413b72e2af525d0a5" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "sha256": "cda37875ea73b304d2b88bf81379e2008541232b31e87a7b48ca37d77283efe5" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "sha256": "c41ba52c6f04ae1ce067173eb4c4500b33ee758d4384afcb322828a262b07c2d" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "sha256": "62da6d4ca3cd639b264012e38fc545898e2a2aadb6706620102987e0f585a0e4" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "sha256": "eacaac2de93b1187147f3638449ff213087c1e313b4e425bd5d09e0e1702a6da" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "sha256": "66d50f4d229e53c67d386a6adcd9bc230035765f57af9aa934bd6c6f22e07e18" + }, + { + "path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "sha256": "76a653877fd337b900809a3857c8789251b930a968397819545c66425d74caf8" + }, + { + "path": "src/ext/BGRABitmap/bgrawritepng.pas", + "sha256": "740fbcecec0191531ac601d145e14e9d62590ea182d257546e34617678ed1cd0" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "sha256": "92ab6a9a785402b0a434296616645089241497570b070956d3a596437380ee4a" + }, + { + "path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "sha256": "770d303fbced5025552494a1286cdb5a3fcb69311f464871efe7fddbc39262df" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "sha256": "ae72b8da6c2396c45cb28991ed7d50868845c58a095a979a57f930a0376f66a6" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "sha256": "4527c568f582941d92dbe58f5b81dc193cfff18ac103f56ba2978e43e3a53216" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "sha256": "555770d86b49658d316f8ad5ae5dc4078a56e27ae25770bc11a9cf4f28b30175" + }, + { + "path": "src/ext/BGRABitmap/linuxlib.pas", + "sha256": "cfe50e39c0505753d5129d71af71da286d9ed0017e09324b2c83f3b161d43ef5" + }, + { + "path": "src/ext/BGRABitmap/universaldrawer.pas", + "sha256": "605d8b74761234bc101d4e7a9dc235cc38f015e5849f8f25ef041077ab1c8d7d" + }, + { + "path": "src/ext/BGRABitmap/unzipperext.pas", + "sha256": "61c260971722e677351e149fdf57290e2188374a6a2edab0445f528ac3661a1f" + }, + { + "path": "src/ext/BGRABitmap/uunittest.pas", + "sha256": "ea08412a967e0cfbc0ead495d8e68526484bb17b2c484af6942d21ee0125dc3c" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "sha256": "b3a763eb96d6b279e65b9b950d513f3ddb72ba5bec9af117782daa0a5b10314b" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "sha256": "b4a602fc84de79f550c09eeeb7dcd799ecb6f4623bfc6a513e548c2b8aa877bd" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "sha256": "4ddfa7367023c75fd8ac5ad258ba28ddc7fac4ffde87b1d7f518aacc6d040d0d" + }, + { + "path": "src/ext/Delaunay.pas", + "sha256": "e92c10914cbee7ade58cf4859eb761322f6988f627f9885c29a4d58cb2b33637" + }, + { + "path": "src/ext/FastMM4.pas", + "sha256": "a2a8d2bc97c73db599272f0bb6e4d04226ddc543626a0ddce8e2b0591a6f7b43" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "sha256": "8deb144d5433dcee652a62f6d48030525a71a85673ca633ca31fe437ea04bac7" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "sha256": "bb106644e3640b33951ad4a816401feb0859a2860dc9ad51c594f891a7ba594e" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "sha256": "11c8b6dad6834de17c6e5aaeb29398631d434d0e58f3151543288d21c5d64d83" + }, + { + "path": "src/ext/FastMM5.pas", + "sha256": "abe54153e7fb403d2ae6fc94117df0398dc482f3faaad7318e97030199338896" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "sha256": "e0e43962bfaa95c85695c4d6868ce9c87eeaf585c460f81209e64046abe59c0f" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "sha256": "0bcbe3302d150a237d96d9bac8652b5f58b0e995fe83593e2e947ff4c654f7e6" + }, + { + "path": "src/ext/KromIOUtils.pas", + "sha256": "d9ab5b20f4915bebab9202569027d37311065b49d8e5c6429537ab85594ad9c4" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "sha256": "39eaffa0245ed2d3ca3fa0caad773f4105b8bdf1aeb4fe30bacf941e845b98ad" + }, + { + "path": "src/ext/LNet/levents.pp", + "sha256": "0d9230b9fa576d16c0b643aac951790245cbfb875d9f05a6e765e7333d39376a" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "sha256": "566d34ed27b878bca56b35f6b9208bf96b93a8186574597fac862fc00dc4d22b" + }, + { + "path": "src/ext/LNet/lhttputil.pp", + "sha256": "314f08b0fa3d0bb384a7d149966fc6c937da2ddc487b18e48c19582d766bbeb7" + }, + { + "path": "src/ext/LNet/lnet.pp", + "sha256": "fcbd9c318fd921154e4bbcfa8231c5c3d388568c06528b5d53b423f649550b05" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "sha256": "cc8564c5fa962f4dbbf35e21e07de594cb4427873d7e53d36aec69a4437d4c26" + }, + { + "path": "src/ext/LNet/lstrbuffer.pp", + "sha256": "50fd2d41729d8f3f83261ca484f28ee95557bf993502332eb189196332aa8314" + }, + { + "path": "src/ext/LNet/lws2tcpip.pp", + "sha256": "6773352b20b0e329a1b7aadd77171c413a8825dc5aaff27534dc31a826055a24" + }, + { + "path": "src/ext/LNet/openssl.pas", + "sha256": "b1c9f192e7bd7093bd45e26897577c2b2e77bb5bd08bdbcfe731a801d5d6018b" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "sha256": "b70c37bd63cb1ce0475956030c392162006f3f62cb50522106c3185cb3f9f6c0" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "sha256": "2f36ab0abb3afc0149ae7f7b28795b1d75f459553622f68f00b239784b17da10" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "sha256": "a13e951a9880ed261ebc5e4dab089c0800aed7642f6259d0e5c2c2e4381b639f" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "sha256": "798e261d85d9b082283199bbd17e92c681a21790c41f8334165a57c0ba82600f" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "sha256": "77935e6ede59b58a49f16c1216804dd00f6db55a0ede33aa65f8bd2f702d7abb" + }, + { + "path": "src/ext/OBJLoader.pas", + "sha256": "b4d7b9b69340f49ab0ff0f355e29602c698e1ec17369c437bf08d00fc287a06a" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "sha256": "7fc46937cbbf07b7eff475f628d4a332401773b31157fd6a478cb5194a1e597f" + }, + { + "path": "src/ext/OggVorbis/OSTypes.pas", + "sha256": "a4e114f76cd1cbcbfb66e9f10d4751e296297d7aed79d0ae28ed00bc905b3cb5" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "sha256": "be8ff9a75cc441c2a75ea3877b46217df64dc2584b98960a2f222f1932fe1492" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "sha256": "a39f27482017c08e601785db9b42dff85063a500edf9cab54a76494310abbbc9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "sha256": "1f72177306ea85869448d2de3a0d36d516dfc5061b8006287c1c11661b44fa33" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "sha256": "6364c4b9db088de4b479e6d7eae93d4331458702a7dae6be41369f5f3199ab2c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas", + "sha256": "dd12fb17334453e25e5eeaf06ce92b056005d22c56c139b97ea1137711e61d7c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas", + "sha256": "206b6682d0988a7e44dee0533ded27b45077b5c256d568d00f2e97aa5f5005e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "sha256": "e6055b1423384962d1a7a97f6aacf528ccac11d3f70477cc2c61630966facd97" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas", + "sha256": "343b424f7ab26f9977ee8f4fe9ba616d9235236099e3dff4491d392b943808f4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas", + "sha256": "1ed0d831429f679cfd76c89b4fd2dfb40c6cbf0d3d6e290c0e3318e77dd1972c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas", + "sha256": "03d0caf28e91274426fa9b44c61d1283bd49716c7302ab1f38512c8934da2e74" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas", + "sha256": "d693316c1dec1b61af68a3fe7e0fc1ed25d9324f86883e4dcf4bf28c4cf713d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas", + "sha256": "12855b29d577d3fcb2786a7f83b33874769cc0eca6a22f42ce5f843425b6f58b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas", + "sha256": "30ef945f38e6653f3d2bed107dd3115c1f33c2a58c41867629a00b7e2317b075" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas", + "sha256": "88e4199458d5f069657f2e342f0cb746082961ef90da46e0f43db9af06c9bfc2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas", + "sha256": "7bf4433616a679457cc2cf4fa4c36cc43e89b0ceb1cf36a3011fac6f2ebd8dd3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas", + "sha256": "57e3e9730b65a70a562e04f81abe885eb69a040f58d60491bba44750f2b848d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas", + "sha256": "4b809092149eb05201515dfe40e1f5d042dbc0bbd24eab2f74d92ffaf05adbd6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas", + "sha256": "dcef24718eca686ed66228d4601f9f676ff61ffcef2f856910f574962cac9bf2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas", + "sha256": "57e6475e2905de258ec2f09d090a024a5b832bf5818e7c8b1d7718f4cf3efcae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas", + "sha256": "c8ce985d6bbe37b66b58bec9b3bb9d968b310fbec85d75e651bfbad91e62effd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas", + "sha256": "39bbfb6e7655c3e726b59689e2dcfde794fc82414df548958a2f700b9c792072" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas", + "sha256": "3e5aad4729fad2f318a474a0c0181cb1c30d2f358ba7a2929c58e68ebb32397d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas", + "sha256": "62a32da064ee05e37f074d6396800d78af12ef95d5e4e7a34ad5f4d9ccc42a2b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas", + "sha256": "7f8842eefa5320fde9e6f4babe616dedf184ea5e412afcee4a8b73efce960ac5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas", + "sha256": "6aa1a9e3b15be8ecc3d24e907c09f564a8d5afd4ae8f22c58ba09e48ffc350ab" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas", + "sha256": "04f9fc4198c3d189351089f1940cee0feffabf5662cfb1209fe27f61b5024947" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas", + "sha256": "4eb8dc78ed64bf150a0d7d3e486cbef17695d054c02f63a6ab9314235e55c8d7" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas", + "sha256": "6a97679f6f68f34fd07a9dc7db6b08b5d890ce7562e9a5ab8675436ac60076d9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas", + "sha256": "461b5fba763c52b41900d1f7b0c9787ac2ae3ffe4afd69152e294a1b90b0c7ed" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas", + "sha256": "ce759a79460c5c120ad69198b4161d3fc2a3d4b069f75550540d7c3ed2fe1d92" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas", + "sha256": "b4062aed60e921f5f88072a41d35b768a674743079410f6cc5009130b6952c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas", + "sha256": "266962ec2909e2214b89c0f153397b2422ce36d82bb3b0bdb1fb7a4aa862e27a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas", + "sha256": "8abf5d9dd13a2c1282fe695cf729d1a2d92411611b4d2a24e0a7285131237daa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas", + "sha256": "2a0550a29fd2fc027c678fe258727d6dc5a5aa3b46937909d4d2a9893e458407" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas", + "sha256": "c7839ff2709acd77434d92c4edeb4021d451e769fdbcdc2cf890a10d452b1fca" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas", + "sha256": "25f6158eaf56945485ba465590c0a94c2658a3c1d47184a0666f5c9597d5f482" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas", + "sha256": "6dccb49302aed73c8b72d42a29adf160eb9f092c71cf3ec60ceae1036c1a4e15" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas", + "sha256": "ddbc6490da6261b0ce6b9cd33e593b99eb79a79f343456d8c23c207b11378bbb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas", + "sha256": "68fec9883bcf87413165d90f15f2c1e31d7781348f1513fef9b62ad5a8208866" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas", + "sha256": "e75def39c50a1297f2ee2522d6efe9982a09cea20ee02ab4944e62d99b463c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas", + "sha256": "13a6f65a68e2a673df42ad3d30b40e43514090f672145f872c0600b723232307" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas", + "sha256": "8330b0ceec0bf313d79e0da9ae90bb3ccb4718df645f49ad0a7642e78b6d1e19" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas", + "sha256": "b5a29564b440033938998414a79b9a2eef0d14eb2182572a817baad3166fb89b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "sha256": "9761e21d6b1a839942345e7dd139c37524426477abeaf51aa2398f40c03b3169" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "sha256": "54b444d9e07d9d68f7d9a3ac0f5845ba3409d8247edabfb0e5f169d2faea8404" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "sha256": "2c598be617a37c1add99ffeec41996fa35fcb3d6e5ae58c8f520e03dcb5ae3ec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas", + "sha256": "20031b46870090e7f957fddf0bb45a026f9ea52bfcaffe481e555eb35ef2664e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "sha256": "b4aae854cda922511c9ee40401d1da019d9bf782d75ecf74e7c070a4123f6ee9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "sha256": "1ac0904100394efb8635255b260b8bd7069f330c76255f6c992911cbde55a105" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "sha256": "663d1a2a59957c1d9b313c694a51df203efcc0b7134952fbfa057247b4057639" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "sha256": "9b6a526fd0e2c0c21a4a6493a658d237bd955e8442a199741a5d5e1569f58d4e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "sha256": "a5e0afa738faccd93c8f6cde79d3dff4d4e5ff16c763ca4f4e24222cbf2f8420" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "sha256": "9cfb9385636bccb51b07ddcfc6ab571af60595620dd09872c83d35fa26102dec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "sha256": "dcb7e1c1eb44dbcbc156ac9d66448f4984150751849efd72b54a47f5852b4d86" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "sha256": "87375aaa6a1e6ec704c961321f0344f5d502d6994fec95778a401e5e4cc7d997" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "sha256": "8c505402759e73c6950db2bd13f6ca2e743ed1f7ece18087a5d553fc95c0c80d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "sha256": "8aa0dcd2e46b5ba615050b6b05d096a3b1c1df60ca93069c673c42c0e5a1393c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "sha256": "bf3243d9ea619459e0475715d0b61522f0e26d41414c8b21283abbb2193000a4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "sha256": "790d67557de9c21ec81874395d7e29f600e125221c776c99216397625052550e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas", + "sha256": "8643607e63d0de1d91460746524f1b9ecb353f5d9cef7f28e9bd5c6501b0300b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "sha256": "acd76073ccba130040575f570480dfc0b09af328a2d5077c2e3eda10a9f64174" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "sha256": "60e0f29f471a0039ab9bda6b42fdb0a87abb182465653a49c1bc4b27d6a633d3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "sha256": "6d7b6a65379613376cd2dd6a017acf55e42c601f4669f1498ba553a61bcbfcbd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "sha256": "acba058692a6ddf1d4246a0695070124ee754b082d376fcdeba5edba0d51af6d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "sha256": "3936d4cec42ee7f27f7f397c138e9d1acabdb75329b9d25fd1bbb450134d73b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "sha256": "230b46da8dc426b33fa2c657a1354720d0ba46f81729d4d0c7978b98ba374184" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "sha256": "13d2851c095da4be09f75e97b19516756a14820ddcd5dea951ce67f2572d0116" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "sha256": "6a4674c2aaebd2159ff8ded98c0698e28c0bbc263127b763aa5296d88d3711a2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "sha256": "2fd0f08d579014a84f1a5a00a97c62524aacd8d67c7057f0cdbb01d6cec7e877" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "sha256": "f5b69fa2e2b1e239db7cd3c5815a01a2f4527d5e4eff2ce5e45466c669141504" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "sha256": "0959dadef883d7adc021d5f1d06ffa957b3f70cf9b49c91d709a29ddba6100d8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "sha256": "c62b513334484bec24cd1474dd1a58cf1e108bd9c61d2369fc64dca321e07ffa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "sha256": "cbfc639452178e3f830ed989305cfcde7d7d56443e3f027f53cc9de3aaa8f791" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "sha256": "5a831104f822951faebc32f1f8f3ab6320cf47c86ce3a0a4ec17de7eafe3e931" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas", + "sha256": "17ac97f685024dc28ed3a0300f3d21f7fa4201ddc392b747f090fbdfce17a0ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "sha256": "a14deb90138af6e5c42c5f9f96becbf2e8c693bef5430d97a045b98e306648c3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "sha256": "7ace47da9c4fe87841f9f2ddad8ef280a7306dbea8628d99b8ad48c021fc90d0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "sha256": "13aefd2775ec10f55ff09ca494232c35798f360b50e4728e23128e9bf00997e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "sha256": "03017368fc03bce13485b6a23a857f0a7caab3d8cee74fe6ec7943b82296e08f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "sha256": "be6faf61c70a51667673b5ce1c9621c17305ebcd57e2f8b753002a9062c5e041" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "sha256": "4fd72cadbc9969de17b275caf5c502e85cd2ea179a2a44a108eee080f1033bc3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "sha256": "9067c6a0343615fd5438481897f228b3523b4befb0555cf27d11ff879475b960" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "sha256": "165a14b32c8fb978fd46ddf501347fb3986233b5d627dbf7d7aac5c5fd0c749f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "sha256": "6fe74b31302a7a641f78fda0a47f304185c7d3c158918a5d558403f5f859c7e6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "sha256": "d5a0528351345640893799e202b5066e1da0573e60d2c4f7a392090ea78a982b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "sha256": "74f16cd4f578374290c4867fd95d9c92db5a8fb31b3d925316ec5c9ab304c5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "sha256": "15688901949f9582c0488b19589f67ecd80930825b4325f939e7f8b860704ffc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "sha256": "ebdf395fbda417a6ede38318cced22c8d8744dd2105ddd684932977a989f7d13" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "sha256": "db07176659770505ea8b92c6b41689f7655e970ed2e0bc26c791657d251f4c5c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "sha256": "bb337ee799e48738a0050b00451c7666e3b30d0148d10ee0ef6cecca90834531" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "sha256": "58487efd63675f3a122f023b2f25d74f43e7e290f36c8e180713f58ad881c757" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "sha256": "a3d3e2f79fe8d31b0bbd3c1ef2c908d46cc119639550acce4cda5cf551c72b90" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "sha256": "3dd9573c163f1cc64db6bdef216c89701423154e59d7d5df916c245b52c22a55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "sha256": "f9352e1cb2ed6ef15cc3573bf3d1bc5280577a3f0c357c3984198631f719f1b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "sha256": "49709b3a055b214be38ab497f451fd61aad4614dba742ac23600bb5781df37b4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "sha256": "a2d515d80e9f6a87abbe11d7b925a710d1efbff051ebf49c35b8ae7fdef3fb7b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "sha256": "bdd1d592dc0c44ed3475705d8c4381ea36ba0370c0f07c3cba5936a876c7152b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "sha256": "a6b91250dcb438290476d0e15192341555d230a8dd1f74fdfee848dd4f9a4e55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "sha256": "46a68caf1bfe2f6659380c88db391583b68861666b835af3ceb1b3652e56e5f0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "sha256": "8bc3d85087bb226b5b425fd21c08be3c760a2a2762a61c647180e0b1a39054ac" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "sha256": "4d4a5ca9433fc8c4fdfca91a76c7d5493860d79a526bf2b9d9e39b5f3ff2dd79" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "sha256": "2f89bbaa1b3af26c72840623733c8a04a90ef8b2c2902fd2155529a875ed02fc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "sha256": "5e81578f5bf5cb07b8fd007158ae4a270f8088838410038211803324f00f53ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "sha256": "3630bb13c10652ff0c67bd3ec598d793e72f8b9406274f8290ec5c8f65f1063c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "sha256": "effcbf293a5ba7b4cdc10e41a13430cb0e5e8c0453c12347cbebba472b862309" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "sha256": "41375081bbf51c3f025782c449c4814c157cd5c51697fbffad682fa1b31c0ddc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "sha256": "a45c33d1313f5af09647a3c22f10749103b1960c9095a9b66ca74bc5e7a7beb9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "sha256": "6625ec077abe4f1f85a3e056c77e5e7a543d4fcf00692b41a3fcef19178db557" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas", + "sha256": "d1cefe3477b5c36780cf07eebcff263d59ed449da25ee605d4f625be413f1ea4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "sha256": "b2de10d146d93675c3a346a0265501879fbf3fb883ddfc95a50f86a8b2e5e1f8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "sha256": "1a03c27d6e8b1b6c29087be8e7a9818304a456ca863407c9dd09cbbd9a3fe7eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "sha256": "d8ac74e074546862e6d8ee6fddf64a1b883937a723456d8bd8336c5a7a0c547d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "sha256": "5add545ac759ebe2f3a2cbbfc37467c126e34c90c44e4c518e080f83c5f92cae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "sha256": "57e1b326d8ef48e9f8159c48fc612163080145d9485080b736df864de8ea350c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "sha256": "28603f6c1127be61eca842fd4daf9a8f4095f3440ba8f77425d414ecb51717fd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "sha256": "3468e31114d94eb728a9b470f0805427dd72e2e7631f7eb8e3dba05acbd1d79f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "sha256": "05d3079526333b21bb54fdd036d0841ae0c1ff141dcb9a48f183d0d637f0200d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "sha256": "40b1fe2f3d3ae867390c32acdab66a4398f8da6d69598376199e744783c8a76e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "sha256": "486b4beab20a9d32839c9b1937fea0e5f8ac9362b8b594e5389799b75e0d851f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "sha256": "029a4121eff064feebb568d7447a46e5427521b345f859ef76d868ca82594149" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "sha256": "452e1a5b7b58885b233fd57de613e9b644a70716238be879fac884e5796f8573" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "sha256": "ba0c08245217978c754ef93900a2e61ae356b1e7ea883ef9dcdf46fde9864f84" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "sha256": "d60f5d374e23e2215359e16ae976d6ba932ce069ae8e626e9575942fba83b6e5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "sha256": "f3219c222311174df983f268964973b24a7e534b7331df12eb8decec5ce15198" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "sha256": "89315f9876432b97a9e7356f8fdacaab200cb64e681104fef39aa0db1c00194d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "sha256": "43b8fd54f9546d30a8d46da870d7ef857734c3e46ee5c1abb97797a76ef98883" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "sha256": "ac3132ccd9912d229fcddd747e40ae73e86187b64658d83761d2fdb742ac375d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "sha256": "d40fae9d684fd1af34db166a98bf4787258c929bf373523ef67f1fbeb07e2101" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "sha256": "6c6afe4f04fd1f8742a4e307484dead98346c13b3d9337e0808d78557218b6c6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "sha256": "a378177382dbc86634dd12301f80b78f9c4879dd02c34000b0b4640ae5107ef6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "sha256": "b7c7ab819390160a31853bbce4e08cd01579b442df8bb128a582794b4a3118c8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "sha256": "87ef16537df829b90443667622495a4f3e6dcd433408f54b87de524eb7afc197" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "sha256": "ff1b2d3778643be10b7cbaf5e1066af73431345d4ac3ba505418074997928653" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "sha256": "931c7144bfe8d4ae18c8b81d7e3328a3f7c62dc2d4bcf6e2f059b5d4c89a9bdf" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "sha256": "8d301cb6a919e314f98c7607b8d51c0bc27f8ceb90e0ff7f131ac9243f2bb5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "sha256": "6e46708c64121104dee351decac07d58ec5426573742965075df17ac530ea9eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "sha256": "7d248cb1292253dc0d66b0f56f6d26a645b56ca5ebd3ca09cd5216e9d8438f3c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "sha256": "2257bf867c778ada2912c774727f88999f075a24553e22b480f4c7165ba2a62c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "sha256": "f76530186c4284d6c900bddda9ca36facfc027a664adbe989b713ccf63291c1d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "sha256": "b6d725ad6c842d7b959fbe7806fdcdd574e9a275ce1a040cf8eee2e17d6aa995" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "sha256": "5f922c45ed0318bf2f8f6df4f147cc31b3a721a79aa3d5e619fa9cd0f255f36a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "sha256": "3bdc0bc3ef602f14e631fa3f489063064f859f0561c9ce4c0bee67c8a42e0631" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "sha256": "96d1d3ca97a83b354349e211011548a6c6ed94f9282c8ac359a05f50b7dfd8aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "sha256": "3a9efc509d9e37bf3f639e41881c89ef556400e6368877ccc45b0fab741f517b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "sha256": "9b886e915f8e2b1df527b4ca5631b9d1db87c8564361c9e6073cf6c32fbaf958" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "sha256": "10c68020813071d15e8e4a9e46a88cd4d272c623da9b0be4ce272cf073d5bd47" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "sha256": "a8294bddc54129f3e60fadb7226641df86f487e5d8a56a3fca1c066a004abcc4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "sha256": "bd23e45e963fcfc99b25a045ae86c2fb0d5889ce1b4b30f0f449f73d83c8904b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "sha256": "f5d91fb576059bdfc8acee81c10906dc79e66d4ab09c203a2de354ae4f86227a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "sha256": "6d9506866e043fa89ea468926f3f9f755379e105171a6dcd93ad99d4cd868574" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "sha256": "035484e15dea85575dd84bfa029b3489323813042e7d31dfe3e6f717e8e3a7aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "sha256": "7e92825530ef236fbb573f6f31a987cfe373403ffbef798afd5a3efb7ef69af1" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "sha256": "be45cf073b461d50eb48fbc60b1d431a3824f72a8e9837ef3e3ff2cb2706f466" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "sha256": "3e45ed1dc8d27c98528fc31d686b4222db2771fe9c0c14a3dafd030bed1734ec" + }, + { + "path": "src/ext/PolyTriangulate.pas", + "sha256": "380336f351e463e5607595d48b98d8916e7d14d0e94df2bd7c531c47b92f9077" + }, + { + "path": "src/ext/SciZipFile.pas", + "sha256": "e39beaecf1b7174a3774964d173ec80f25f5ef6c036c3a32a914a854cc8f263a" + }, + { + "path": "src/ext/URLUtils.pas", + "sha256": "3bce1126a2b8547aca95c366babfa9db145922e4b6576da0948bbefc5c146d9e" + }, + { + "path": "src/ext/Unit_Vector.pas", + "sha256": "b88682b36d965bdb2951c3dea1cd587fde44e7055dd05188c6c4cc4cd62cbaa9" + }, + { + "path": "src/ext/VerySimpleXML.pas", + "sha256": "3b153f03089fbb90f157528347f3cf60c0971f8df13815880189157f3abd8a4b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "sha256": "234607f0027f9c8ebbf637c256c69c818e1d1576ae96435e9396d8e183ae556b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "sha256": "43d95802b43dfa2bfb035009f80d74b824fcec5b2cd4961907120059378ee2db" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "sha256": "1b9e32c4419d5cf4fd668d13303a04a68006c42febdde601d0944f8de4714feb" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "sha256": "f07cffcd7e54d70b406f15a71456b8de6247527768e814907a5a8d4be5139e6c" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "sha256": "1030f597d856414eb4c480a2ccbdb72aac23c61ff18919e173c4c0bed95f0705" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "sha256": "8a236c433d684953743e3a4539b3c4db7d171390c6f39a918f9980c83dd79aea" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "sha256": "5098dd30ed2cc428eec6f1677eb6e07a6d85e41b0ffd651e87e95f17318343f1" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "sha256": "7b2d726107c6c18dd99b9dbe58374ee14533a0af91ffb11e01ea7cbe53fdd92e" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "sha256": "8854a85f819714f19b12d4c468d03fbf19d350d169b7948b4e6469a1d4889c47" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "sha256": "3c6ea29dd509c57505d0fd3e7c50d210adce1536f9da1f5b8c8b9f6220cfe8d7" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "sha256": "3d58b35ae7eaa827d3bc77b3a2e299bb2342e98e4444419df0e089bf8b38c095" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "sha256": "279aef72202d42e52a4c10612ef7b194f7154d8c777f5113444c3f3f550cccce" + }, + { + "path": "src/ext/Zippit.pas", + "sha256": "0386df013372cfe0e92b374167c450e7f9d0c558449739863595757f968fa45f" + }, + { + "path": "src/ext/bass.pas", + "sha256": "b740ea36fb588093af6b22b2ab33eb3e29e33c28ded1856bde4e4acc2a08fbd7" + }, + { + "path": "src/ext/dglOpenGL.pas", + "sha256": "b9b08703333fc2172389dcd956c12a595bc50cf783824233f516faf60c17def4" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "sha256": "889d02153be5dac1b9d4e5aa3e8e9161eb522a8c86c8295e291f2ffb8a55b1b1" + }, + { + "path": "src/ext/libZPlay.pas", + "sha256": "0865f4bca9fdf885585deb164fe87bf2f5252f38649dffba998863cca18ca40e" + }, + { + "path": "src/ext/openal.pas", + "sha256": "74911dc018e4b2672e983af7b45706a65ab9ca890c708cc2dfead0f74f0acd06" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas", + "sha256": "a13056931df7a40bf08a8beeef53684083199dd25234bc4bcae28c97fe84f7d6" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting_Reg.pas", + "sha256": "78e52813c56c4afaeb05628edea1a1c6a835ff84ad2cac033b1736c9400e6bcb" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPSScriptingProvider.pas", + "sha256": "818323c63a63f0f0022b064b23341ff72bbfc73b757e6a0b4d3199bc2329632d" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas", + "sha256": "c4760d042df751c1a0492ed7e7dff14a4876344723f176853986a55e752c0829" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/PascalScript_RO_Reg.pas", + "sha256": "01c18202d532e459ce8033780c056c37ee793c942beaf45e78501c03cbb13949" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSImports.pas", + "sha256": "2b80e21f5c803fc2495f5fb90126080ef50019c1f0abb7f4386481a2ff37a4a1" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "sha256": "7c5face3a6422bda459244e95ac752d1f55e6917fd1422656c8f64bb2b631f92" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "sha256": "bf5b1bb780ab705c2690a52bb78e7e99c6bfd65a9344a34fdff296d0309976fa" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "sha256": "727cceba897b887b3bab0dec1e9501c5890c759f64cae87ab8af4b7e050947a8" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "sha256": "21caf91d91756f369b7861cf6c753ed8796e8a3e4ba55f6ac88ebbfe8964f1ba" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "sha256": "91fe55b8caabdab661eae2492aa04524de0c6fcb3f539b4ab1cced353d987917" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas", + "sha256": "282c45de20124f27a3723fa2d2f3d9cfb822a68b8ecc1a8373a31beedf643981" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "sha256": "19931b61c4a7c6378955ef4bf06603c622adee746a997da141b6bed54de4721f" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "sha256": "8fdd6c1d070778c395f7c0d8cff281a7d900b23288593edae1bfe2e5263ba7c5" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "sha256": "8e47412c1f2dbaf673ea12536dc8e3c1621b24fe451abd3e4f4d4b655f9d1180" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Ext_Reg.pas", + "sha256": "2c876492e175fcc736ddcb3c36a49ba34e7219a2a458b1d7edfe270aa0158711" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas", + "sha256": "ea0267f29ed3ba249941d93c6b2eb1d27e775ef143522f4670cd89ad88486fc7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg_noDB.pas", + "sha256": "e255cf6cc721ab596555177e58db85c8d5ab31a294281ba704c04887dcf5fde8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "sha256": "07f62a8d9934cb82282422de5df54f197f14c47575dd4e79893f341ba89cfabe" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "sha256": "8431e9a2713661fcfc4857e60d06dce71f2a5da96d00edd960705ee94522e883" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "sha256": "4dfb493feaba7c2f6757f89d9fe194c5e25aaab6743637c0275937758f8e3d0e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "sha256": "e9f2bdec9005bd4cf91ae7022a199592b0df8e3723d958f506eaee92545a3ef7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas", + "sha256": "493f62590e76ab2189ba5243b21a467565f33bf9aa28ca4db5dd1ef2fb74c6c6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPS_ExtReg.pas", + "sha256": "49ddf49276f0c540fb21d21f3c84ab627298a728088e7734802958203ce5c546" + }, + { + "path": "src/ext/pascalscript_submodule/Source/pascalscript.pas", + "sha256": "b66c7764bee362ef14418bdd27999ff14eb2217d7eda394a54892594b570dc65" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "sha256": "33509c1e6ee6eabb7448fe4dfe55b89b6090d2b9bdfa423b54b189f9f9ad8e21" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas", + "sha256": "08de3cc8079d30b6d6b3e47dd2e92e2ea78e1898304b6abdb1221544f694339e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_classes.pas", + "sha256": "0ed291bab0d669e8cbdd588e9c545aea7f1ff5bbb25a55ce5eeac51da59ca024" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_comobj.pas", + "sha256": "50024e58966581d455eb7fc90240e4d7265389ed631793e63accd3152dc82ee2" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "sha256": "eb64db3fe484301bdd3a172c2c7ab78b3764a816a2376517efa99ba06783d4b8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dateutils.pas", + "sha256": "fca566d883326ee3e4ba798e81561116284feb8a697476028ae2298acb16b20c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dll.pas", + "sha256": "1ec05a25c1577fd5c73c9cce8f63ddc2acece481f61aacd077f5bc0d6bd4c00b" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas", + "sha256": "d9719e519d4d9844e18c4bc0fed3e2624c78c52f02e8cf50947de963e49abeba" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_forms.pas", + "sha256": "5bf7ca978cb50ddf528fbc5da62490f8c5a87f695e158b548a61fddba8fc2664" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "sha256": "2915aa2f9d99993998729c34bc7ea94faf0853266aacefe13ef410ce5480af63" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_menus.pas", + "sha256": "f4bc813dbe78c5a958060d4bd84878d1544ab2088ab802591b2d167ffdcf1b32" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_std.pas", + "sha256": "a95312c178d0f9f14c3defc78703d91a1027c99eccca4fff9cc6419112dbebe8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas", + "sha256": "a3111007736e18519fe35b6fc905f0cb75d1782ff36bb3204046be88cb214b49" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "sha256": "7786a321e83285a27d3450751de38b619b45b088cd0dcf6e1e7cb73572820a94" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "sha256": "aa7450573e597689fa422a96eda6b2d62b883f9dca218b8a579ff4546f591abf" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponentExt.pas", + "sha256": "62a0b0cacc48fb5c24a67cb1676e7a9fe9513c2db5e0dc70cd103c530e4c8c51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_COM.pas", + "sha256": "f5743fdcff6fbb0a792027a5cc573762686bdbdfab17867bf7ecd7d7e3752800" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Controls.pas", + "sha256": "8dc80a0cdde112b8a92bb60981163fe56134f52cc009a5a3cf7f51823520b16c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_DB.pas", + "sha256": "4ea549d91073b254858bdeb8d09903c68a84febf0dca4328215a9a31f1664f51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Default.pas", + "sha256": "ff23706e887ad8c9abd907173f530c8f11142c0885910d946796dda3b24b1120" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Forms.pas", + "sha256": "dd9956b4be17e2dd4a75da90e4f55e98c26fda3fe502089f30c7d43b354c25b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_StdCtrls.pas", + "sha256": "6eba0f55b00af6dee7ccdc7d213feb998f1a23bd7e26da4d2127f6513876c081" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "sha256": "a5086a4dbe0583d2a318d488332e0d039df25d0c6ffe0c50c85865d6fcd8a9e9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "sha256": "232d9b77b9e6d176d110f75b179b68aef69c5d15089875e997bf1c36e6b6ae2c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "sha256": "09b58f2f89831286fa0b450f31d023498130f9c38fd8a28ef7fed57af5eccaf0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "sha256": "48a81dba4ac00481f446e3e8406c4b58619097288ac184cfd5242234fc8dc29e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_buttons.pas", + "sha256": "590440b59f84732a6a17acc4d6d0a7ef6b0d4321e766427b8e12e5152c871fe4" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "sha256": "58640751e818cb8468e55fdfba029db23778e542a62f19a84714c995759b14a9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_comobj.pas", + "sha256": "e38023ddbb09e8f65c51dfc6fb21e46e0cb6792bcdbab07ac36a00767567cf39" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "sha256": "c2210644945f54f669267b1fde4b44669afbb200d9975af0de8abd402b16e1d0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dateutils.pas", + "sha256": "285e829ff13171413cc3320567078c4232908d9372a94fa92350ba403cbc05b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "sha256": "435f1e5867dc970b20a603a9f5ba0655f9af0a913e02a38aa957d0c6cf5b50eb" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas", + "sha256": "7ffaa107c07ce594bea2bc32bfe76d92947f844089c829ce70d692b50e1d94d3" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "sha256": "1583bc9529f7ccb7cb9b88a2dce6ef9a78304629be6cf2d9a8f1d2d327fbee46" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "sha256": "4c7b34c2272895713948ddddddc9e8e1b1c6ef1da5821f0d946c3ece2fcc4190" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "sha256": "731c62b6424573f5d6eebaea6d81258d1fed5ff6ba0548cb17304a07513efaf6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_std.pas", + "sha256": "5c655421e42de094ffd90fc4ee6052b6670cea9265d1f0319f96988031123c14" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas", + "sha256": "ba384ca63d1391ed42b8ba54acef2104008b28f5eb3928c7bbcd0f5c0408a8d1" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "sha256": "0f623b98e4f18b2d063b34e442da1f1b9e09ac436eab009ef69f9e651259a677" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "sha256": "35db0be37eb9c128ec9aabbd70db0637dd7cc0a67e5f0c9d2e82b4afb9d8296b" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas", + "sha256": "39b06302c6bc93c405d2735f26fce78de51a67bcc78c7b12cd1e394bb299c2d7" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas", + "sha256": "818a35c95c2ef09d388ec9195928925053277e3e66024ec05f119737f836333e" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "sha256": "28e7cb7665e525aa7be2824d18f6f358a1858c2b30d9136ec322b0789693f9fd" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas", + "sha256": "4ca492d1f66cef3a0f68c01e7e6b644bd0a916fd82ea4948eff05b3f7124fad5" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "sha256": "424f9f28fd939f95ad8034fb5dea266ecce1125b3ef7ebd2e6fb1775564461c2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/Extendedreg.pas", + "sha256": "ebd72056b98d3dfd50aa34c502012cc7ea4e2e66b8106758d53d5816428e3a61" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "sha256": "dbbace9295e187ff813b291c2d0975584d48515f5a1516fac45a7c273a166fb3" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_BigIni.pas", + "sha256": "8ec961bdff87dfb9ff232f65eef916146e7540d6de27e33db7be75f6426d0d89" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "sha256": "d23e836d2392ca42add3540c17afcd9ad1f3f94a2b28a2c66f2bb098ea4e8680" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "sha256": "1cd59a2d9e707e86f6cdf8548abc4539786dac783975bec3d6e1f1f17a33b9dc" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "sha256": "9e227b93a2c49a5f58b22b79de9dbe6927136f4e8eb3ec808a0083dc65faa897" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas", + "sha256": "87a349f01615c3ca7f572562eb0566480f33a5fdee670a1494a852353ca52de9" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "sha256": "585347e5faf73bf67be2ceb22696e7920cffc60ec690f9fc673e1befb16b953d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas", + "sha256": "80a028fb513d627e617563f7d8da62be421d24131facc3fc8200c5c9b5608a3e" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "sha256": "2969a26905d8edcef1cee639b3af3829c25c7dfa04e6effb8a6680488a6bb502" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBXreg.pas", + "sha256": "2bc9e1182b32c920fd111b3b316772edb0a6566542426acf37aac9a92daadef2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas", + "sha256": "9480168bea8d8963e3ac27a4a16439ce164d8c91582bf71008eb4d132d5d8a7c" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "sha256": "3cd63e72e7de08f3d2d2543815db3bd2077e2b36a23708a407b6406658e19070" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas", + "sha256": "483fe4522702f68746698b52be3e3f4911e1e6a85afdf2cd93367f2e63baf725" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "sha256": "d0bfe338fc0f9ba9c4d0e7171c4eec5d4277d582ddc4141efbadbaa9fb8fd139" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "sha256": "74a1569c56222c5889aff42b4f67d5ac585424b1d4ea38ea657a67d733464c0d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserUtils.pas", + "sha256": "bbe75fd3f924eb5a00eb8b27c36e5b8dec8da7e94bd9fb0bdfa146b55a8b32c8" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "sha256": "6633906da3a63033810145f6ee36628de04b1ba6c51d731310b9717c11b558eb" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "sha256": "c6a209999c15aeb27e848de10886e5012be01fb139f11961f9cefbad8fd680f7" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "sha256": "b2dcd32a7100a129268de3069545cc371ab4f1f67b647cbca945c588201d7876" + }, + { + "path": "src/forms/KM_FormMain.pas", + "sha256": "6a275a7bd4ea1de7dd55b97463be94d98c574a9c1fb400d3a47169cffcf0458a" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "sha256": "5c74b6baa98d06b64933bdd43d865a10088fc54ae7d593cc2d67221309dd6c73" + }, + { + "path": "src/forms/KM_VclHelpers.pas", + "sha256": "12bdaa38199901fa4ae7027dc435a83e9c20dbf6e989636d981da9c5375343fc" + }, + { + "path": "src/game/KM_FogOfWar.pas", + "sha256": "59306563343380fccbc86e2d2efe62bf045f02e449043cf8ee38990f8c38e1ec" + }, + { + "path": "src/game/KM_Game.pas", + "sha256": "9ef4649cb0f32143fc65c7934d62e2027bbf3c6306cc019ef0498fcccbe2b0c8" + }, + { + "path": "src/game/KM_GameClasses.pas", + "sha256": "9cc088909cd2563af531272741549c5babb23b2278c6da8425b1c4e1665cd298" + }, + { + "path": "src/game/KM_GameInfo.pas", + "sha256": "4c1f0eebd8532898f9d68f8bafcc50a5ee3b5d2c2689b47c7712a2b8de18a070" + }, + { + "path": "src/game/KM_GameOptions.pas", + "sha256": "682720d856a79f0555ab2ccf7cd48a5643bf426b109804cb27fc855682f67585" + }, + { + "path": "src/game/KM_GameParams.pas", + "sha256": "2a307759cfdd00c1298ec1a749f5ef74fd6e0b69639090155664e2cd001adb19" + }, + { + "path": "src/game/KM_GameSavePoints.pas", + "sha256": "098ec9c08b55597c44507d8f02e87af72837242c5243d9bc78184da4e78e2ce8" + }, + { + "path": "src/game/KM_GameTypes.pas", + "sha256": "f80ac2a918f00487ffea444ccc3deb1a01c808efe990f65d72ebbabc00709a88" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "sha256": "ae41b2b47d49b396f32b138a1ac87b4c5d5886a655c00ce485914dcc45e4467b" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "sha256": "c20921151077c597c5bf3db808c90d4759272dbb4744d51c69591810ef64f4f1" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Single.pas", + "sha256": "7482ce9ecb27a14558dd790b4f65d502f5ceb5417f781dd4cf880a41b082ce26" + }, + { + "path": "src/game/misc/KM_GameUIDTracker.pas", + "sha256": "adf82f90503043bfcb92c939154eea1167ddefb7886956997b7a7a4d09fce572" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "sha256": "0d0dc3da175eed8a049314b3ad9767e07968f5f4f3545c6f13c895b1639c9e2e" + }, + { + "path": "src/game/notifications/KM_Alerts.pas", + "sha256": "6fce90e0268068266db379658abd8ba9f316668e3de19aa74ccb7e5d70cc9853" + }, + { + "path": "src/game/notifications/KM_MessageLog.pas", + "sha256": "1c5b0c9ffd4fc46cb6f8a1e6317a42cf860313054c7331bc023abb0e5197da88" + }, + { + "path": "src/game/notifications/KM_MessageStack.pas", + "sha256": "aaeaffab32d810208b103c665f59237bbfc65cda10a48e7ad6b1497273088231" + }, + { + "path": "src/gui/KM_Cursor.pas", + "sha256": "12175127b5ebe8631ddad6688d5673b9c374fb581a96089344b0bf3eb16c5e2b" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "sha256": "a0d50f738f8d98edd7d4b501b5f221179ffb6461ca275c7f1018bf9c497ad33d" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "sha256": "7094c9453fe1c60c14a19284131bc8cb660b8cf6a576c919d8c7f32763e78064" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "sha256": "51f6e9d7aef0d284f371bbc432181053fb99e32cab2a57d8d558d861e3446924" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "sha256": "178b552fe5266f6e019f65d0a1e047efc8f480d9a3ab2ee760d4503a97e71868" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "sha256": "57d1b71da4913bfb98b649d82aeca898afa5f6981b14e2dfc6efddcefee52165" + }, + { + "path": "src/gui/KM_InterfaceTypes.pas", + "sha256": "69c78ebb84c9a142f7ea5ad8d61092d8f77e834b289edc0b6a36eed1aa60bd92" + }, + { + "path": "src/gui/KM_Viewport.pas", + "sha256": "1e8e86031bc48181eafe6e4c23722b9d209e72271badd440b0357ef1c22bf3f5" + }, + { + "path": "src/gui/pages_common/KM_GUICommonGameOptions.pas", + "sha256": "2a7e8ac2538ecd8a92d10fb04056d0ff6b11710afbcb820a4976e5d18bcc8213" + }, + { + "path": "src/gui/pages_common/KM_GUICommonKeys.pas", + "sha256": "b94130b28076295779c2c94eaf810c17804932a4390204d809fdf27ba708cdf7" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "sha256": "5af366cd96fad9a2ee53c40c38e89c0ebf26e88813bc3066df9ff63c386fa3aa" + }, + { + "path": "src/gui/pages_game/KM_GUIGameBuild.pas", + "sha256": "c748e58b79e26989125e7eb9f8e621bfdd74edeb197f498548b9a16914da5837" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "sha256": "9f80c1dec9aae1c3f8edebba04b94b33ad612f142f267194320c044e03dea39d" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "sha256": "cc9802cad40a9ab66a8409e3c6976053ead142c270496d143b92fb2ace22fd70" + }, + { + "path": "src/gui/pages_game/KM_GUIGameRatios.pas", + "sha256": "755d1105f530e6a6137cbb8dd8a3f5ca2667510186a21226e4b6089f227b2d28" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsMP.pas", + "sha256": "2ac186bbbc9495811c47b1a3dc43a4829ae38e599ab1305f01776c8edcb94bee" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsSP.pas", + "sha256": "6aaef193b006166341ca7f43084b2e2dd9bfb8863fe0fa2393fd140a9d18de43" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectator.pas", + "sha256": "f51229f7be9642396017d6ed4d9ac51893a865f171b956f0bbd1f040d58622e8" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas", + "sha256": "72fe56ab58a3c94326118b37fbce63366989dcdb4914ea0b4b10877777860ac0" + }, + { + "path": "src/gui/pages_game/KM_GUIGameStats.pas", + "sha256": "8b1b8300d88d417f9840e3b3ed46281cc1d52aaf73a682d5346935313c3a7e3e" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "sha256": "89a4470690c6e274332c58f55c99f7a273728f7791a58c168db324e100122843" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdExtras.pas", + "sha256": "f303b083c4063ad683d10265473a848dc04eb816925f21691509f24088e40e19" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "sha256": "92c0101084dbfa0d319878afcd27e206ab3cc430415d021904a47d23e67318f8" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas", + "sha256": "2d63150b9012ea81a554b4c245cff9242fcbeaa83b1d4bc6a6c1f902311fd6a1" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas", + "sha256": "f34df3581e9a4d533db6bdf16827611f58956a99001fea8e7b489a5420bfc211" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMessage.pas", + "sha256": "028fd25976d9284c26d820ab838a5891018f839b7af6fc1182bc7b3d21dac469" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "sha256": "62c0cfe1d1dee25553dddd85b5111d91dd35abe5d2303e49409744843761ec8b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas", + "sha256": "b8c9351b29c066aac6bcea07e9ed018f002a7e6c39cbc7925e45d8648f1dec93" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas", + "sha256": "c99774b604a5a5153f4e55367377acca762c0608f44bf9931bdeafbcf163cb9a" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "sha256": "ab9bff3d5bedb0eb816faf971f3a413e7d1d48417a27647659018fe5693af28f" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas", + "sha256": "5bb2007e017793cd7c94b8eb867257e463144aa9581aed7f9110846591498c89" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas", + "sha256": "8d7df7d0358675c3a84fbfd1dcac5535f6199a0e23c4d1fb643c4f948e83931b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "sha256": "4556bb419da69f4d923a940098aa5e077f13001490c293b68655514896c2a3ea" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas", + "sha256": "3233928be60ab53f1c7c316dc63b2debcc998f0c9501219861f1806a25eb69c3" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "sha256": "776536307fac933bbae5fb1f757b5e304085ec48a179a058183b45afd204c14b" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "sha256": "f3f4d04a08c80a2a35198083ea8b20913c43543bb5950de4609e76f152392eb8" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "sha256": "e1724d0d2f42b6a0f394619faeb5d2a31231fea3741fa7ed8e34546f3bc42313" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas", + "sha256": "c8cd68da8b42c2eb92d2804bc7d152e7a1fbab097354e3ace47525f775acdd04" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas", + "sha256": "15408970e02b07dd2d8db7a74de9bdda1faa195879fed33b576ea8ed8b08a7ed" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas", + "sha256": "c70d4e8b31e56e1711e6911b20658cb8b75dd998c12b91f6fd0855fd1d4f6bf1" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas", + "sha256": "6e9a4e9a3105946008334660d6dcff15b985e247774f9eaf6a5b943151a06df0" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas", + "sha256": "413919cf15ce31f982bcb6f808f278d3a362981b243dd75d269389d9a40e398e" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "sha256": "dc0151d1b94305b88377b8db1a47936d168afb01931e2404b42db89db33624ce" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas", + "sha256": "fa3db1a1133b269533bb2f308504b07ae50c223865a3a587ef4fa9fbdd003f99" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas", + "sha256": "ebd7f745c057d3b19f5a160cb211e56bf1aeeaebb44fd25af3f5b0f4e1fa0e24" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "sha256": "7d0276456c5349b6661ecf86338db38beb8728bfcbd00ca356457505f0bd70ef" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "sha256": "2efa1f541575d06c61dab34f263c7efe5d08fd5d5d924714e240aef10c40de75" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "sha256": "014b0fef20c98b96b121a5ec506fe8fedfc02b2f60b84ed805c20435a76a3364" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "sha256": "f0c1d851dd8110e6b7a1d25cb443bf44c5e65c621b555b8eb5baa5e7e505fb6a" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "sha256": "9f8434342a0a8217ec023a85fb758dd7327440a38a97d0214315cc65c5059ab3" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas", + "sha256": "54f06df611038063e7d6c22cd90b9f3275cf0bbc2674bdaf5f65846361ed6da9" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "sha256": "99ad7e5230b1a5b9469cde8c827d89a823e43928581828d213a9017d670bd87b" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "sha256": "1f8dce92c15c2e0f7f099d90081330ec5d07d844c80d915243fce92478975e2e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTown.pas", + "sha256": "39ed7da00173d763fa53fdba211696006c1cb3e954694fac1fdd03b85c60f8a1" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "sha256": "536d642adf2412d67f074cb3215cfc22e2c7fe8ccf87938abfd7ff85839b7b5c" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas", + "sha256": "a3f7b451022462e86dc045a687c284142aebc7689a425564f3fda903e1a22324" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "sha256": "35eb82c5b0e1c210c935c51e222b50f2bda5801f016c338516464b7a94fcc79e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas", + "sha256": "3916ec0311c56cc3b10f2de6f722f07b2764448f74da203972ee4f9823781c0e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas", + "sha256": "4564ddfdecfcd4164596c82529d9924d5c7df2adb7c41ac7bca8c3bc1d3ee068" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "sha256": "52efc32a8dd36de5e4dafbbd947f52582f5afdd473966c27fe4139da4f5e2e3e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas", + "sha256": "ac44776a45470d62c49eab237f39be25a17523cb3da8b3accd12546cf9578f11" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaign.pas", + "sha256": "366dcd0135dfd16f1f8686b2bab8609ffa970344d97c336bac4302d44d8f8f07" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "sha256": "6270892d766ba6e8203d15aa92060856cdef2cd0910ef3516385bc1b0c519305" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "sha256": "9abd8d9dae44d33dd2a77da01a49318dba73356cfb4ae7dcb6c0c5305ff97f39" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuError.pas", + "sha256": "f4bc468a574453e3c0e0a5c08c34db71be94ed9bbf315ab32c087125b815f3da" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "sha256": "59adaf68c018247d819bc13c708c99710f098739afa8db9c0d3770464c7ec93e" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoading.pas", + "sha256": "60318cfc2f22005ee7804e1f3566a683df2884f92ce55e8eb43d88180fa0cb87" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "sha256": "5be5b4305fecd19da683af525f57bbd31a01424659f599f3e6dcefb5aac4566b" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMain.pas", + "sha256": "b9c6454041fa5063d24ea3bd5ae2d06144b777ca8a7304e3305405f66098e9e3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "sha256": "aa0647978ef773ce593032912b224504f4aca2e421e3ec7e40488278b8a46ca3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "sha256": "801d9a989c7ac8a9a9376396e84fa60a6abb69fd27c0207d814058e3b3c62a66" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuOptions.pas", + "sha256": "8ed9e0e77f69879cc00f9ed9bf6fe701dd805e7b9911cca56a85074b40494d2a" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "sha256": "1c1d35f168e4420583367ef6133e0d6ca7e0700d21185472a30adbbfb396ab69" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "sha256": "bb96605eeea055936fcaaa94848d6cd2fce8919619f5eeb2a7738216b7410baf" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas", + "sha256": "b7292927d337357b4575ad92864508f0c3a7b025fdde483760892969cdb89ec9" + }, + { + "path": "src/hands/KM_Hand.pas", + "sha256": "a04c1c320aab5a06be3cca604ce23653123ded6ba4376de4f312e219da7723da" + }, + { + "path": "src/hands/KM_HandConstructions.pas", + "sha256": "8b5571c11bb2362371e216021e567046bb058b4777e5dcc32c851b8ca9ea45b7" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "sha256": "37d23ef0b0e740a7365a81ec54fc591fc4056e57f76e11fdb8138df8f46b1390" + }, + { + "path": "src/hands/KM_HandEntityHelper.pas", + "sha256": "29a0c72ff4b0e98031e662675117f2fa765509ced83b53a0f0ece79802ec3bfd" + }, + { + "path": "src/hands/KM_HandLocks.pas", + "sha256": "e9990e0a665699d6210db57c17fbf8db8b4b6c012469916b1b8dd834422273db" + }, + { + "path": "src/hands/KM_HandLogistics.pas", + "sha256": "9328dc1176a8859a3f12f5cd572c05c722abf2b1822a2e9ed7c38002a0f4afb7" + }, + { + "path": "src/hands/KM_HandSpectator.pas", + "sha256": "f91d3ebe037a273f96e58effcaf7965e4f9f7ab57b901b944e2aad85bbfda224" + }, + { + "path": "src/hands/KM_HandStats.pas", + "sha256": "0feab297648d1d1f28435aed7a84126036ca99b7da7d9ba64447ff84cc01b21d" + }, + { + "path": "src/hands/KM_HandTypes.pas", + "sha256": "4fb51c9bd81d91b602e5ee6e20fd13e83a29fff6732e7e176cecda5a2589b4d9" + }, + { + "path": "src/hands/KM_HandsCollection.pas", + "sha256": "ba479d0b0f16846c95cafb07e434a4acaff3ded01b3471a65b61cb1c62ada1bc" + }, + { + "path": "src/hands/KM_WareDistribution.pas", + "sha256": "d4b8f9e0cf787de940c9c1ed585aa382a86d928ca555990dede6c0ca06077177" + }, + { + "path": "src/houses/KM_HouseArmorWorkshop.pas", + "sha256": "3868d051906f1043ac6827873b2f66f67243a8482ecdbf36d4f1b47d7c97b5ba" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "sha256": "d9bafd4febb0f34c628ee5226b0889ced285411d6a8e55c318de3c1da3410b46" + }, + { + "path": "src/houses/KM_HouseCollection.pas", + "sha256": "b05d8b0cd0a63cf9200a599fc614ee2df6766b43404cb93a30040b87d5117291" + }, + { + "path": "src/houses/KM_HouseInn.pas", + "sha256": "e53c76a41ffb09acef4bab2519b92d15453f9decf12ebec587c0d41ac0875d6d" + }, + { + "path": "src/houses/KM_HouseMarket.pas", + "sha256": "4496f2fc2c2ed30dd37ddf6cfb45d171c0ff3f23df26fc12d272bf75daf57169" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "sha256": "59e38f62ec75b37fd04ccec2acf498dae374b116819311ccb54a624a2a3873c4" + }, + { + "path": "src/houses/KM_HouseStore.pas", + "sha256": "3e349f08c6c4288807ed0e14279b141eedb949bf856194771f9322342f62accb" + }, + { + "path": "src/houses/KM_HouseSwineStable.pas", + "sha256": "f243dac92002fc89f245f63da8972f22518229f9bf12455e8813be229998b8e2" + }, + { + "path": "src/houses/KM_HouseTownHall.pas", + "sha256": "1f196acee70375d0949f1bc74960c60050493dc990772bc1f81d0e397719c397" + }, + { + "path": "src/houses/KM_HouseWoodcutters.pas", + "sha256": "f80cecba3d96dc6418d095a8ee258d970aba9fbdd347f23d4d394c8971af9b52" + }, + { + "path": "src/houses/KM_Houses.pas", + "sha256": "d8ac9a649ebb20ad84593e487ba1411bdb4f7f45529de5b9c99be31fefbe9323" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "sha256": "496b39e7a57ba9143fd227408b68dd872181a2322cfe61c6f8db7fc4cb5f0cf4" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "sha256": "71a1a0a4adb8c95657834dac6912b12f6d8cce1e5ea32770f4073130298f8d8b" + }, + { + "path": "src/maped/KM_MapEditorHistory.pas", + "sha256": "4f70d2458d8944466b835b5003ff1354cfb3e979339d4d4742ade3a69978f23d" + }, + { + "path": "src/media/KM_Audio.pas", + "sha256": "544208dbf958f9314b999a3940498839a84f3b1714284b655db200acddab2ff7" + }, + { + "path": "src/media/KM_MediaTypes.pas", + "sha256": "1909616103514d1591daaf6f11571b3f25a26b87bb117975e024a616400b17f2" + }, + { + "path": "src/media/KM_Music.pas", + "sha256": "914fbf6503818e60e157068626b46f71b30a3dcc0580c94f31b5c9197cdac625" + }, + { + "path": "src/media/KM_ScriptSound.pas", + "sha256": "498a34055e5c90b97c876bb2efb782cdb6110e801e142f19098e36ff4c3b350c" + }, + { + "path": "src/media/KM_Sound.pas", + "sha256": "4be0863b000935e55bfee15d73b41c50ba406b30e173140ad020dc306793223c" + }, + { + "path": "src/media/KM_VLC.pas", + "sha256": "ce5c213ebbfea65c9c6085b20cb4652d8d160e8a2eeec0b0248af3b82e5338e0" + }, + { + "path": "src/media/KM_Video.pas", + "sha256": "76afefba35bdebb5cdeaeaffa85e29f7258a0a1021c2a1114878fca3a912fc44" + }, + { + "path": "src/minimap/KM_Minimap.pas", + "sha256": "cfa8f1d764f48e1cfbba5da6dfe59df29540545bdf7aefad817f2d73db3f1d71" + }, + { + "path": "src/minimap/KM_MinimapGame.pas", + "sha256": "0990cc36b8ded9c4d03844b01619c9570e7e08dd65d0aa76b151a4090381b29e" + }, + { + "path": "src/minimap/KM_MinimapMission.pas", + "sha256": "75db3e59757408b7eb01decd9e509a0090ecd3332084031d83c27f334caf562d" + }, + { + "path": "src/mission/KM_CampaignClasses.pas", + "sha256": "36d9af4f87245a5db3cd05448171297248ce3d818e6f7d6f8c9bc4807637e54d" + }, + { + "path": "src/mission/KM_CampaignTypes.pas", + "sha256": "f85436bed8696c61330cacc50549d44bf064e3cd7a012829dfc160ed624ee5ac" + }, + { + "path": "src/mission/KM_CampaignUtils.pas", + "sha256": "c9b21b45bcaf2c62cd81f6a7b70e097aa84fe4613b5368cab9e5a0d22a2addf6" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "sha256": "069c2421737c77d963ecf538c55841b9e23a60225d112bef2e9e3617c1c43b1e" + }, + { + "path": "src/mission/KM_MapTypes.pas", + "sha256": "bca25641ce6a4d957dddc0ceb242065b0d26b8723688225a5bba89f87757e13a" + }, + { + "path": "src/mission/KM_MapUtils.pas", + "sha256": "361acda0c81403ee151d0b56170663c4b69d6df24285192e7a8f13fe428b243b" + }, + { + "path": "src/mission/KM_MapUtilsExt.pas", + "sha256": "daef75e85bf99dd1e747ae6b3f6fff90d2ce49d977955f5eb3f3fba68d2d504d" + }, + { + "path": "src/mission/KM_Maps.pas", + "sha256": "bb503c62e5ce3a6f5914fb24e2e44f11f26f4c987b62af0f6f792041abfcb8d9" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "sha256": "7c6bb8d89b15f174cb490ee4b2be120832116a3b2d4cc346ba94e69dd24bdb47" + }, + { + "path": "src/mission/KM_MissionScript_Info.pas", + "sha256": "cebe991807b5cf805509af0ae5a5ab3718c520c4d51bba90198302917b107672" + }, + { + "path": "src/mission/KM_MissionScript_Preview.pas", + "sha256": "6ca28222d116f37cd78bc30dbd9c0b2a10ba8e657114a106a23449df6098631b" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "sha256": "d9379cdffca584010bda737e42b59ad2a45917d3d60ad04a1121a41f96d8ca82" + }, + { + "path": "src/navmesh/KM_NavMesh.pas", + "sha256": "6a6830f1f589ee38c76352efd60b976b661cbc99c7b2439cae96f8dd6c426a21" + }, + { + "path": "src/navmesh/KM_NavMeshArmyPositioning.pas", + "sha256": "59bf9b88d4e7adc2190c9f5c3cd1b02bcbe12e0d14d62906d1825c9668bc4207" + }, + { + "path": "src/navmesh/KM_NavMeshArmyVectorField.pas", + "sha256": "d1c93f277b18ed99f2e0a4c5e00d2fc5039320887ab9de6dbfeb2b1cb2e6c79e" + }, + { + "path": "src/navmesh/KM_NavMeshDefences.pas", + "sha256": "f62eec2c08c1b16ff7d55569e33497bc150e0a2124419756dba855106d3e3f40" + }, + { + "path": "src/navmesh/KM_NavMeshFloodFill.pas", + "sha256": "1a6c0d6fde48525b1cbbd49f43cb67fa10650f9922aee176c939f9797b47b2fe" + }, + { + "path": "src/navmesh/KM_NavMeshFloodPositioning.pas", + "sha256": "f4d431cdd1e6d6c0ed64163206c76d6e519b1e695191a975bda581eac83bf5d7" + }, + { + "path": "src/navmesh/KM_NavMeshGenerator.pas", + "sha256": "9bd4ca2c4bf3e0a00b6993d4bbca1320f287774bac9d473bf77fce88cb78cb48" + }, + { + "path": "src/navmesh/KM_NavMeshInfluences.pas", + "sha256": "94c6d7107632370d85f3e7761956995eb569808c7848ab4fbc998e29e3c3718d" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "sha256": "cccd64e1e74e18fa6c98a2970023022137d318fbc265f0b158edfcce20d8f939" + }, + { + "path": "src/navmesh/KM_Outline.pas", + "sha256": "a2d71b3418f4a1a6e756cbfe9ec7a9b92404f380a6310ba2aebeb82019da3216" + }, + { + "path": "src/navmesh/KM_PolySimplify.pas", + "sha256": "1cd1a180e935deecb1ef672fd1806602723d41112603fcaaef7afed217440298" + }, + { + "path": "src/net/KM_NetAuthUnsecure.pas", + "sha256": "ec454a30e86fd0aed8434f628fd3880bfef493df414792380b8da82fc193418b" + }, + { + "path": "src/net/KM_NetClient.pas", + "sha256": "29cd70b3dc14e095523b70be0c3bc6347fcbf7cba6f97d0bb336c864c26fdd56" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "sha256": "ec0a5dc3b8f441ef39788ce78747a2c8ba592b88f68098df76349a730724bc1e" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "sha256": "95d65593d1786b36180209ca3006d875928d25dc90707513cb746a927b6a6c5c" + }, + { + "path": "src/net/KM_NetConsts.pas", + "sha256": "cf58b7dd05c5c43784a21c785743d3c6b0126539761e35917130b586e4e2566e" + }, + { + "path": "src/net/KM_NetDedicatedServer.pas", + "sha256": "65ff46f6ed9ce18e1185270b7895888b53684cb0396fd3d577f0b983568897fa" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "sha256": "13757f9e5a98827ec5243c3038910f776dedb83cfa7a7e7e8b39ee46a5dafe9b" + }, + { + "path": "src/net/KM_NetGameInfo.pas", + "sha256": "463387916f637146410afe96e0766c109d9a9667b6e34e98d89fc8eb3b41c114" + }, + { + "path": "src/net/KM_NetRoom.pas", + "sha256": "151c3fc0b5d5336c77accbef008e233f436971d146074a42f72f062bc1732304" + }, + { + "path": "src/net/KM_NetServer.pas", + "sha256": "591a4e9d090dd7ccc4032f1fb77822f35aa0efb3b475fce6f1bfac2ec2d4cf55" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "sha256": "16bed7ccd1021738a628127961820e520a197fd6be059e0c5270407a3fbf5849" + }, + { + "path": "src/net/KM_NetServerLocator.pas", + "sha256": "2b11428bb3a67a975208b3066e596244b3ef46c8371cc98c5c9a8a2427b97af7" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "sha256": "0f70a3d197b427475c0187a0524b08e7db318e29da3c791cd75625c7895f94ed" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "sha256": "884a7de9de3a15cffea97e2f213586041b9ce00bfea8d0e8337bf63d23a4f9d5" + }, + { + "path": "src/net/KM_NetTypes.pas", + "sha256": "7af37b995cb1fdee3c0d81c1d0f8f73745b3a8f7f4aeec76d9565ddfce73c9a8" + }, + { + "path": "src/net/KM_NetUDP.pas", + "sha256": "5bdef9a22f9aabd8713283a5f21460b9b633cca40ddfc356180ceab8ce204337" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "sha256": "69235d0646eb61cec60429202ffc459cdcce87915b35fe26d2c5f621f0725841" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "sha256": "7afd6bc53e8b13ef395fd614fe735e48a9972c28699af37492d4e83112cd5225" + }, + { + "path": "src/net/KM_NetworkUtils.pas", + "sha256": "a4cfad97836f4d1c2d703e8c93db5608dc1454c30782bbdb77f9b6d9b5d1f533" + }, + { + "path": "src/net/KM_Networking.pas", + "sha256": "d52b481f5990ae00011f567b51fe992f5030e88fc91f3c1cbf0a5695873e93e8" + }, + { + "path": "src/net/http/KM_HTTPClient.pas", + "sha256": "eaa097f6be9be40bf46b8243ae7b7c8cc596ec167078926a8aaca6bd01a167eb" + }, + { + "path": "src/net/http/KM_HTTPClientLNet.pas", + "sha256": "45640ede141b4cc0f17d6af7e7d5bb75fce9661c4a0cd5e87982243244476d77" + }, + { + "path": "src/net/http/KM_HTTPClientOverbyte.pas", + "sha256": "8cb25e1097969eef0032f966657282043b9dab3b8e7da08f16cffe5597e9e61c" + }, + { + "path": "src/pathfinding/KM_PathFinding.pas", + "sha256": "d8c176c92c57da321de9a95587b19cebed37dee68a97e8cba058a28061e22e77" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "sha256": "4b96763aaee833ac81b18e591b83afbbc61f4c844804d033f27966edae00bcdc" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarOld.pas", + "sha256": "62bb930423be920979cda10a0e6d71c68e98dfa1fb9f4af5a1a793e557629cd9" + }, + { + "path": "src/pathfinding/KM_PathFindingJPS.pas", + "sha256": "cc0f25d81218dca36fadd35d4d3a904ff4157226beaefe9e4e05f968fed23568" + }, + { + "path": "src/pathfinding/KM_PathFindingRoad.pas", + "sha256": "ebd1b1584f439b99047078523eb5855f804b92c6c2f971f6071978947a0429d4" + }, + { + "path": "src/perflog/KM_DevPerfLog.pas", + "sha256": "2fd23effc87dbbab97fe8f2835f7752a22ab6f099eaf218bf9036d3464c8a209" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "sha256": "f1660d088e1eeb3de3ee4f44dad8ce9cc00b002fd7b164640c65d1ce2db6e0b9" + }, + { + "path": "src/perflog/KM_DevPerfLogSingle.pas", + "sha256": "49073b79ca5cc8f015680e9a41c3f84ea5e3a44f12363e5d5c98af1614bdb3d9" + }, + { + "path": "src/perflog/KM_DevPerfLogStack.pas", + "sha256": "30cf5f154fd7265bd61e206b881d16ebf87070ca8b8e9388a3a68aeb4079b97e" + }, + { + "path": "src/perflog/KM_DevPerfLogTypes.pas", + "sha256": "8e8102c55980babf4b1291d3646b56d1dcb10bbaa0d2e2910f354878dda54316" + }, + { + "path": "src/render/KM_Render.pas", + "sha256": "67bef2c2dbe1830d3e3a62a081f42ff3e061e3d3d9da38e1c5cc86680fab9e1b" + }, + { + "path": "src/render/KM_RenderAux.pas", + "sha256": "a2b736ad118f4f4959585f1833fdef4121bf3a7983996be2f7073326d40115b9" + }, + { + "path": "src/render/KM_RenderControl.pas", + "sha256": "a88f26232b658ed4abbe91a798cc87f439a8c4afba67687f784711221921e4ab" + }, + { + "path": "src/render/KM_RenderDebug.pas", + "sha256": "ce999e65a9107797c83335dd928c00ead83870a90085d9aa578dca6b3b8b9330" + }, + { + "path": "src/render/KM_RenderGameAux.pas", + "sha256": "a6aca175dca72c54411148e41a9a0381884f9dce22e767f558f5d3c142f3fe24" + }, + { + "path": "src/render/KM_RenderPool.pas", + "sha256": "77ec7f1eaeb4ab9fc52be9ea350d07d77b3d2d0681fe985dfa1de2bb1f13a64b" + }, + { + "path": "src/render/KM_RenderQuery.pas", + "sha256": "69343e0da66c800c0773150673b7dc5d7d9145499c3efd20dc3623ca0f210969" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "sha256": "35302690153d13403aee5495832e89c72100b6cba3a1c9cc31e155acb77e9555" + }, + { + "path": "src/render/KM_RenderTypes.pas", + "sha256": "7bc410ff890d0bf095af8203afd38dc15bbd1ce400c574a891e6c88a38c4ff81" + }, + { + "path": "src/render/KM_RenderUI.pas", + "sha256": "229ac869cbb3707321a849986675a2c8b091b9309953081ec8b9ad5611cf23c4" + }, + { + "path": "src/res/KM_Pics.pas", + "sha256": "266a9c6a4f426ad2ec5cf10ffcb8662be869b33d817ebc97fe83470dca47983c" + }, + { + "path": "src/res/KM_ResCursors.pas", + "sha256": "e52b1be9b3084ab72f19b0124bf6cfc974650e62d97df1cd7478370faaba5837" + }, + { + "path": "src/res/KM_ResExporter.pas", + "sha256": "80f7e2f22fd9e1a60669c27b48aa943702aaad2d374a5dd1f1ab443e06b3e732" + }, + { + "path": "src/res/KM_ResFonts.pas", + "sha256": "8c008f9dbb502867c177572b553db05e0be066b52ae7f32076a3dcf3ecbe34b2" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "sha256": "94438b8a0d05bbabd3b91f0b32ab35738bf3a9a0edfbc46e04af38bd26d59e26" + }, + { + "path": "src/res/KM_ResHouses.pas", + "sha256": "04635afe5565ba2d9797c3920300030810e598b0885b4fa3627d45fb27add3d9" + }, + { + "path": "src/res/KM_ResInterpolation.pas", + "sha256": "171d92c0003683fbb43e4682e9f03eb8a55ba22d68ee9f1f2bcd7b052ddb682d" + }, + { + "path": "src/res/KM_ResKeyFuncs.pas", + "sha256": "0c3b4f114a470af098d6558b3437a1363ddad14a6fb326f9eebb9eb9ebd464d5" + }, + { + "path": "src/res/KM_ResKeys.pas", + "sha256": "24e4f89638c91fdbe6a26935f4b69432f2adefeeb232f3ad75451f699df1a13f" + }, + { + "path": "src/res/KM_ResLocales.pas", + "sha256": "ae36d32f959af0122af8763e2c9c187152434db612bfb8afda2b2bb8406df314" + }, + { + "path": "src/res/KM_ResMapElements.pas", + "sha256": "1ccfcef61c56b1bd36d10af67fcb223adddd1b1178b408ff949126b8969c573d" + }, + { + "path": "src/res/KM_ResPalettes.pas", + "sha256": "d86b57d19d6f6491bd5084a33a96647309b149b13bc3910e9bf405af49c41f52" + }, + { + "path": "src/res/KM_ResSound.pas", + "sha256": "01714778b742c576daf87bd978c620a5f8209aee29cad6b00f68afd4de2eb7e1" + }, + { + "path": "src/res/KM_ResSprites.pas", + "sha256": "71c41037967133876085160d0a183748458f70be3777e97a9944efe4a50f57e6" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "sha256": "959b955b5eeb288090274b23abcf6f0b8fedc88df06a84cd65f91885949f33d5" + }, + { + "path": "src/res/KM_ResTexts.pas", + "sha256": "fc85f9101cbf59b0750a1972eef947aa2cea7f0ac9cdb8a1392d57dcd689fad6" + }, + { + "path": "src/res/KM_ResTileset.pas", + "sha256": "e12b1ab7abdc15d37da892a41acd03c13712ae13dd22803b3040642640c36374" + }, + { + "path": "src/res/KM_ResTilesetTypes.pas", + "sha256": "8ed4e76c80ef292d1c691bad4398531a2e398b750ae715091f99757fc8f1958d" + }, + { + "path": "src/res/KM_ResTypes.pas", + "sha256": "da87e96d5c0dd726dd7ca0a9fd9d7b7814370d29fce442a4e4288d396b1b1dea" + }, + { + "path": "src/res/KM_ResUnits.pas", + "sha256": "b616a69e9cd44df5a06bacdd218dc609540d679c5229e92a34d3ace82d10df04" + }, + { + "path": "src/res/KM_ResWares.pas", + "sha256": "cbcc2f76dc628b7c60313937ccbccb20cc1c539fdf2781af5e7810ed1d8d2dd7" + }, + { + "path": "src/res/KM_Resource.pas", + "sha256": "1ff94e5ceee7ee6056e6ee16c1e34d74fdeb8d858f9841564ef405e1b62dac51" + }, + { + "path": "src/res/KM_Saves.pas", + "sha256": "efb3956500f51850493f8f1020084f7351a7739a811ead01728bc507a7a6a34f" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "sha256": "5ed32a173e820a6e5dbc3fb45d18b22a9c71dd3c513fb85bc5c8111db2d9b54f" + }, + { + "path": "src/scripting/KM_ScriptFilesCollection.pas", + "sha256": "516bd3ee7d69f8d41597b62788f10eccedc93b489d32d46591ccace416cf56c7" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "sha256": "db63347b5f2cf280760fe21e0c3e174f9e9eb06320906e8196536af83a0c75ec" + }, + { + "path": "src/scripting/KM_ScriptPreProcessorGame.pas", + "sha256": "ea78ac6664360b87ce17af52c4d745deda25e5297d06ce153449f0fbc24c9a0f" + }, + { + "path": "src/scripting/KM_ScriptValidatorResult.pas", + "sha256": "80736f212cea53ea0844af0ce393e65d389e2cdcf3dcb54d7666e52cd998f062" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "sha256": "bd6a6a261aee500c6842ca17081b257e1763e7496e6af8292a3da34ec9fecf43" + }, + { + "path": "src/scripting/KM_ScriptingActions.pas", + "sha256": "8f9d644a13bf76bed881c06c30442d963f01a393cb66c8c92400fca986b33fc8" + }, + { + "path": "src/scripting/KM_ScriptingConsoleCommands.pas", + "sha256": "fbf7eb215640c840c399c9e1c98bc0d480c536f3947a4f4969b51f6799a25061" + }, + { + "path": "src/scripting/KM_ScriptingEvents.pas", + "sha256": "5e6557eb26a45ec2a5e5538a3df58374312f759fac6934339e20432e654d3477" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "sha256": "50637b64c86334ee72be847218d79e2c4fb8657e89c62a017a322ce639346ada" + }, + { + "path": "src/scripting/KM_ScriptingStates.pas", + "sha256": "abbf037947e17e33cf8a6c0e5cd0e308195782f26d66f0897430661217feb738" + }, + { + "path": "src/scripting/KM_ScriptingTypes.pas", + "sha256": "642d715cfa26bb95ac8c6d50f4f12d9374b849a3b17ea60c88aec77d88f2766d" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "sha256": "cf4640f508295691542bc15f1fef033a09b4f9a7e98b0b5bc085d956ed16b7da" + }, + { + "path": "src/settings/KM_GameAppSettings.pas", + "sha256": "bdc0a64e58f58da116984a61ef9a12db5dde2cec902ead3d611a01ba7991ac3d" + }, + { + "path": "src/settings/KM_GameAppSettingsPart.pas", + "sha256": "be90b49726b86ddabb80aafd98779125605b5004111a7766cafa690e82923cb6" + }, + { + "path": "src/settings/KM_GameSettings.pas", + "sha256": "2626ba448a0a3fa6536d4eb2f552fcbb6e758cd7947bcab5ea20fa936d4fc075" + }, + { + "path": "src/settings/KM_KeysSettings.pas", + "sha256": "711261664fdbfb4db69ff595b292c1646b0d25c96650944e40f8fb98e2c7a433" + }, + { + "path": "src/settings/KM_MainSettings.pas", + "sha256": "371c85064c459620164c324d8424b8ee7e093c8af2337ad3023f205a0c2ff8a9" + }, + { + "path": "src/settings/KM_Resolutions.pas", + "sha256": "1ba1cddaea0913e6983324f28fce369a03d871cf7632117cb9f2c3cc151e08dc" + }, + { + "path": "src/settings/KM_ServerSettings.pas", + "sha256": "1478600343b2aa65da764b9b6d452dfb86a24223fec2f50d38064c685e60445b" + }, + { + "path": "src/settings/KM_Settings.pas", + "sha256": "2c89a7d558980bedda717be243a04036d83da9455ca3c78ae1d6bc134ba0bea0" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "sha256": "483317c77ca65406283be86ac4f2886dfe8bf8104147d120c29c37f429723659" + }, + { + "path": "src/settings/KM_SettingsXML.pas", + "sha256": "67957fc140bb6231a77fdb7a05a5a3223f4c59b5d569d109c519d1d0b00641d4" + }, + { + "path": "src/settings/KM_WindowParams.pas", + "sha256": "50ec7777724152822610576b411199ff222ccca8c6fcd789962c0012c0ac9099" + }, + { + "path": "src/terrain/KM_RMGUtils.pas", + "sha256": "219cd38f8c10e8ceff1700f9cc391e675e1530e40d9faf70b8ceff694d032b7d" + }, + { + "path": "src/terrain/KM_RandomMapGenerator.pas", + "sha256": "06e77ddf00c571ca960cb46a06821bb61b076e77e46c207d6f9cd642708315c9" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "sha256": "1d48ec7beff93eee4285f73c33241fac8bc2f264bfb2506feebb93d851810c16" + }, + { + "path": "src/terrain/KM_TerrainDeposits.pas", + "sha256": "b65863930f7c3ed6d117f3d88b55d164a0fee42b33e3cd461089c58f770f1194" + }, + { + "path": "src/terrain/KM_TerrainFinder.pas", + "sha256": "5ce044de41bc804f6f269adc33f9307e2b9812af3da18c8da96a6d09cee91cdc" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "sha256": "2b6dee391d9c67ecbdc5ae4a82c8d2cb8c96a8773ed289d34332a289ee75d2b1" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "sha256": "ae2d9d50f1a776130836fdcd4d77723d3992d1457dddb2d3c1cecdd83058eb24" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "sha256": "af3771efe6e35ae3ad725f0f198b1031ae5e10a0a32bf7a89873c1b7c6af32fe" + }, + { + "path": "src/terrain/KM_TerrainUtils.pas", + "sha256": "81b5eedcebd2cdddd04df8d71d3b218b6bcaee6a692a0e5bd014a9802571a1a1" + }, + { + "path": "src/terrain/KM_TerrainWalkConnect.pas", + "sha256": "a05f7a8bcc9179b5a170cc70e8c3b82800db8935e06dfb24c455567a156f6f28" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "sha256": "9e6699463002e9dad2187836de56d55836feac29e36020af2c31c66b881f25c0" + }, + { + "path": "src/units/KM_UnitGroup.pas", + "sha256": "5391a982fe5113e8b25a80064faf82af41c992e07e68e754bdd5759dd3af9ef7" + }, + { + "path": "src/units/KM_UnitGroupTypes.pas", + "sha256": "2a9bc0ee03b13698ec708664c45509bf13187d92d5bb5165ebd07fa5c8203220" + }, + { + "path": "src/units/KM_UnitVisual.pas", + "sha256": "5674a2ce24f0bc8c2544417d05763be2a766cb6d16cfd6fcec4af51164c15019" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "sha256": "d8919c585648d50969407067a12061140946d6132e755f3ce9bb04e52df2b824" + }, + { + "path": "src/units/KM_UnitWorkPlan.pas", + "sha256": "067ba9e63c9ec1de59e2cfe787691dc2e91225415f56e522a4491ea3f9181e03" + }, + { + "path": "src/units/KM_Units.pas", + "sha256": "2038fc1f99da72cc36db21ce8117a018c12a24d40272928d1a0e942512dbac40" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "sha256": "327bca7972ffc179fd70cc8a9c821719b457321e3a5ea23c5d3b2411eff2db22" + }, + { + "path": "src/units/actions/KM_UnitActionAbandonWalk.pas", + "sha256": "0893fe66654e22226aa840817d9b62f7541acd325c12e97577b7e6f4847dcda4" + }, + { + "path": "src/units/actions/KM_UnitActionFight.pas", + "sha256": "15e0e9c75bcaf9a1191ec6c727f432893a2f4f9af018f7a38f61a15181f29db7" + }, + { + "path": "src/units/actions/KM_UnitActionGoInOut.pas", + "sha256": "77d7dd54ed7858f73df5fddb9ed1cd91fa9907c9af4fbc1fdda659b2da6a7468" + }, + { + "path": "src/units/actions/KM_UnitActionStay.pas", + "sha256": "d174e902214ea40077637830a7d676679b2b2a69f597e16254910b08de8106ba" + }, + { + "path": "src/units/actions/KM_UnitActionSteer.pas", + "sha256": "18d60e0c25be704cbb866faa208794234fb4b4e8502c7907ac6da33d99b46f8b" + }, + { + "path": "src/units/actions/KM_UnitActionStormAttack.pas", + "sha256": "99cb80496c322d14b014bc78bb30ac5fe33ff413a6fd83078e5f7784bded56bf" + }, + { + "path": "src/units/actions/KM_UnitActionWalkTo.pas", + "sha256": "7c4be01ec4c11665d510f98d447f1657b4679779a8bb10a3a3eddf49bd8f7aee" + }, + { + "path": "src/units/tasks/KM_UnitTaskAttackHouse.pas", + "sha256": "83d099ff4e799693f6d76b19b8bda361d031b39975e482ad628939aabbbdd062" + }, + { + "path": "src/units/tasks/KM_UnitTaskBuild.pas", + "sha256": "33c4a2ef02899af16f73534afd5d7b891e2fcd6e811c8d9d3eceddadee82114c" + }, + { + "path": "src/units/tasks/KM_UnitTaskDelivery.pas", + "sha256": "6d6b1e35870847999c7c5448769cc4474220a9a2b02f23ea560978c6a2c304bf" + }, + { + "path": "src/units/tasks/KM_UnitTaskDie.pas", + "sha256": "47fecc16018295ec14bd1b7cb26efa0ba2a997758228b19fde83ff987a26bcb5" + }, + { + "path": "src/units/tasks/KM_UnitTaskDismiss.pas", + "sha256": "041b6127ad18500f54be33eb46d0a12c57a79593efc6ace4d907581665fa41d3" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoEat.pas", + "sha256": "a54e0d001354e821aec77be2193a055ecd968d3db8f03fb8e5fbf4626aa3e4f5" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoHome.pas", + "sha256": "e719c0811ee01015ceb32ce0199e67b2ead56848bed23f0041e9c1100b39c2f7" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas", + "sha256": "8a28939c56ad2465c09c13770746815a647b88b18575b6b0221d79543dc94954" + }, + { + "path": "src/units/tasks/KM_UnitTaskMining.pas", + "sha256": "c8598d7e34ec553457d2cd45e6bcbebf921ca1df29a1078ff946956cf82bfd20" + }, + { + "path": "src/units/tasks/KM_UnitTaskSelfTrain.pas", + "sha256": "346cf727bcac2f35238a56b276dee58e693918abf3a8d20060f97aa7b0fd12f4" + }, + { + "path": "src/units/tasks/KM_UnitTaskThrowRock.pas", + "sha256": "a0db11548e238d08eba8902a9a99abdee53bf30f925af30c0881f83023c76daf" + }, + { + "path": "src/unused/KM_Achievements.pas", + "sha256": "a4aa63abedd1fae979ea47623e2a00c0b663dfa2920df0d68883384e316ee3a2" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "sha256": "a744f680b1f2f46025689ecd0be438aad7c020437c46e45713494d7548c81bbb" + }, + { + "path": "src/unused/KM_PerfLog.pas", + "sha256": "b5f74a52c7618c80f3d3326d9b01b733c429ddc24666e1d5d10dcb0ef9c0267d" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "sha256": "3564ae767371f014b36dcc9d80f3cc676b2c3d8bf8830b7b63b34c31cdd607b1" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "sha256": "10fe873247e96c7cce22964698e2ce8bed3cbf5649c544671f0373af6fa1a473" + }, + { + "path": "src/utils/KM_ConsoleTimer.pas", + "sha256": "9b61e7dc93e717ac4f642e647315a3808a129b5f2753dbc9756e3ca717e1c3ec" + }, + { + "path": "src/utils/KM_Utils.pas", + "sha256": "575fd9debc927c22d5f5141117ecb1d523c0206ef7229fc36e9e975885231d10" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "sha256": "f7a6b8032163af15e0a49e59b7d9049be38719965630bbbbad0b22aca62d6de8" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "sha256": "c0c37cb2e0711263dd204eb2f009264f2746fe80f3bf9bf6c0a3f9e050d3171f" + }, + { + "path": "src/utils/KromShellUtils.pas", + "sha256": "b12109f7f24c1964e1c6bca0c27964eb17c582c65b1bcb3f92f398cc858532cc" + }, + { + "path": "src/utils/KromUtils.pas", + "sha256": "5c566985c7c38e11445bd50956e25cd46fe0eb10ffec392d3b6f9094a51b2bf7" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "sha256": "d69cc2d09fa0457ae307ab1400dce6a34bafc0f5c9acb90b3402a2bce74d1407" + }, + { + "path": "src/utils/algorithms/BinaryHeapGen.pas", + "sha256": "2350457d3eabffce6e18c4ecbd6c3e76b063f0be4fc257b74c5b6fe8a082e53a" + }, + { + "path": "src/utils/algorithms/KM_BinPacking.pas", + "sha256": "dbc4d31c8e1563c9023753d6cd21f3cd1ef9d6d6d71495ab3443aaf38df66e00" + }, + { + "path": "src/utils/algorithms/KM_FloodFill.pas", + "sha256": "360d93af8c9985b408b6c285a2ad1b2cc334bbcebfc1d57d86cd77fc97e9d9df" + }, + { + "path": "src/utils/algorithms/KM_Hungarian.pas", + "sha256": "246539dc70df75c3a0b056eee2248d55e50a21ffe16e993befed5e09c11639ee" + }, + { + "path": "src/utils/algorithms/KM_MarchingSquares.pas", + "sha256": "2139602886e7fc2f7c7cc38dedcce660d06e85c0333aab0fec8eef20fd0102fb" + }, + { + "path": "src/utils/algorithms/KM_SoftShadows.pas", + "sha256": "de6979e4ae6c3f5ee78bf2516d7f023ee7e19ab0d01bddef62206d92c0d60fa0" + }, + { + "path": "src/utils/algorithms/KM_Sort.pas", + "sha256": "38fefe4e3d2254fc0ca580870e893c1b64d42bf1c1fa13d2a8eb2e6b2151d687" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "sha256": "fdccdbcab177e47764e49bca8dd33f91a4d10c0fae9b2494ccdd93491af05ebf" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "sha256": "f2cded9bc28bc3cc5effdb4174fb3161d7d2744d0a4400edd5c7a1fd8a0b5fb0" + }, + { + "path": "src/utils/io/KM_IoJSON.pas", + "sha256": "c6d5167b15589d9348019f886d64b9644372a8a5016076b3ef4dec388b7a6dc8" + }, + { + "path": "src/utils/io/KM_IoPNG.pas", + "sha256": "f332f78b011f6ea5f762699f742d11af12e888cd570f9499453c4dd074087abd" + }, + { + "path": "src/utils/io/KM_IoXML.pas", + "sha256": "870a2d11608c3aa9f8cd1f06c796db570d9ef26f5545d689a0ab58cf3bd2742e" + }, + { + "path": "src/utils/method_parser/KM_MethodParser.pas", + "sha256": "f9073edd89534e7e2385021d2dae17f3f5f2d087c1730e65014a2722b3d31c08" + }, + { + "path": "src/utils/method_parser/KM_MethodParserParams.pas", + "sha256": "f5afe1d508977258c11f005cfa8b6755ac7d9f678a110ca0f03ccb954380c4a8" + } + ] +} diff --git a/reports/runs/20260908T164542Z-0843e132/source-receipt.json b/reports/runs/20260908T164542Z-0843e132/source-receipt.json new file mode 100644 index 0000000..988a0b8 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/source-receipt.json @@ -0,0 +1,8089 @@ +{ + "schema": "kam-source-receipt/1", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "repository": "reyandme/kam_remake", + "downloaded_at": "20260908T162129Z", + "source_only": true, + "submodules": [ + { + "path": "src/ext/pascalscript_submodule", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51" + } + ], + "files": [ + { + "path": "Installer/License.bel.txt", + "remote_path": "Installer/License.bel.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44a3c22ebf3f2fabaeb5f9509affbb441bce394f", + "size": 558, + "sha256": "ae271d77c4dabbafc1dd9203156b6450fd1f178d18ef1c2ce7a8e6288877f239" + }, + { + "path": "Installer/License.bul.txt", + "remote_path": "Installer/License.bul.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b5e1d67460928513665afc3db697e08bab799d6", + "size": 503, + "sha256": "3f661c838cf0b5cfe18e52d48c89afac399cde1b05997a3a7b2139c87428afa2" + }, + { + "path": "Installer/License.chn.txt", + "remote_path": "Installer/License.chn.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d36b9668f5a9df102e7aeb37e0adf4719b475fa", + "size": 268, + "sha256": "710184fb4e9c8a07b47d1ace1ada66ce1d64cf06ee0c6619d707e4769f12d8a5" + }, + { + "path": "Installer/License.cze.txt", + "remote_path": "Installer/License.cze.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ea22db8e1ac9718a2091b8f8680307ce3ffabc14", + "size": 471, + "sha256": "07ab75bd7be1c1a587829abf981a6dc7fb105f0208616ecc9ff84822543180ee" + }, + { + "path": "Installer/License.dut.txt", + "remote_path": "Installer/License.dut.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5ab58918e9bc053a74d0e5e33a0df3ee6505170", + "size": 526, + "sha256": "2023bec0883a8f919a1d385d91ff8e99d227d444aa585deaca4b918dcff56e4f" + }, + { + "path": "Installer/License.eng.txt", + "remote_path": "Installer/License.eng.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "457eb626eae64241ab39b34c150d1bd72a1d94d7", + "size": 456, + "sha256": "daeee1666b1f9c33993136ec6c351aea462c460e410a114626299c8497afc025" + }, + { + "path": "Installer/License.est.txt", + "remote_path": "Installer/License.est.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02d82e07b3b9165eac744fb4366babd9bd546deb", + "size": 476, + "sha256": "042a9974c613f07d76678d24c8dc67b6997b62944ffe34d9181b4a6a3d750b78" + }, + { + "path": "Installer/License.fin.txt", + "remote_path": "Installer/License.fin.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d24ffab458df82e0783e2b0317a1824869afe96c", + "size": 517, + "sha256": "3ea0ddd6290534731af82cd7140739e695396fd421aaaa383f05fd19fe95443d" + }, + { + "path": "Installer/License.fre.txt", + "remote_path": "Installer/License.fre.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "597c293409f5eba309364261a31ad9320f9a0a48", + "size": 581, + "sha256": "b8df6d84bf1f137c776c498c2a589e95cf5fc39c3727dfcc0d4236f7180eae41" + }, + { + "path": "Installer/License.ger.txt", + "remote_path": "Installer/License.ger.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db9e1962601a4fd29f5b672ddc9aa5e11c90c234", + "size": 532, + "sha256": "4673126fe61ffe41c4e301ec0336d31326cc83b665c4026e35acb828f269e8c2" + }, + { + "path": "Installer/License.hun.txt", + "remote_path": "Installer/License.hun.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fe13b8fb644cc70ebe8e059740b9a4d39ac9f518", + "size": 533, + "sha256": "e3dea959e9ab714662364cdec44f00fcf3968afd0d1de41f16599ea49929d4c2" + }, + { + "path": "Installer/License.ita.txt", + "remote_path": "Installer/License.ita.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9bc59bfe6b16c4ea409283a87e7b69cbc1136b5b", + "size": 548, + "sha256": "4a19692ac4070a1ff49c594956706410d5791e2e8115a6a9aafd0714761a993d" + }, + { + "path": "Installer/License.jpn.txt", + "remote_path": "Installer/License.jpn.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "81e476a652e0ee5a83e95f23dc501fe5caf09064", + "size": 429, + "sha256": "505f6ec4ceb826efe823d3dd3f98db76a5c3d3ff0890855d445538d9b8a36a2b" + }, + { + "path": "Installer/License.kor.txt", + "remote_path": "Installer/License.kor.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5042a14e7c9099e189a43fb4d46163b5b0c4acad", + "size": 443, + "sha256": "7361bae995fa33e935fad3e20c475a4e662ef1ea1956ff7278b181c838a3bc73" + }, + { + "path": "Installer/License.nor.txt", + "remote_path": "Installer/License.nor.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d789737463892cb341a1e5eeb77446e854f7f6ab", + "size": 488, + "sha256": "acaea1a261ba40424c6a6d5e18d7b405e1ee77cb7c6bad959e2a8500f3e27aa8" + }, + { + "path": "Installer/License.pol.txt", + "remote_path": "Installer/License.pol.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5a0078efdd9b8b6545a15be6953d847d74e5f001", + "size": 505, + "sha256": "ff67159febb99976e098d1ad7861aa7fcfbb8cd97df34e23be5ac118e0370b0f" + }, + { + "path": "Installer/License.ptb.txt", + "remote_path": "Installer/License.ptb.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0ab96021ef5b9b97de82ed469b60d4e126f37de0", + "size": 442, + "sha256": "f7090a45306a649bf812052238256da6dcb1014a147c5aa2495ad0a1fe24d5b1" + }, + { + "path": "Installer/License.rom.txt", + "remote_path": "Installer/License.rom.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "038f018074e983b3b0a39efc28ae0cfb55b82a87", + "size": 462, + "sha256": "48d3b2e8aa602f3914004e7b46872ec60eaaaf0568bab1df828aae4b6b205f21" + }, + { + "path": "Installer/License.rus.txt", + "remote_path": "Installer/License.rus.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a73a8be680e0e555a4e1619aeeb52c69dfb664b0", + "size": 608, + "sha256": "0e4b9ef436b766df4fbf6e91f7707790a437d08c142ec65d9949d13474461c6b" + }, + { + "path": "Installer/License.slv.txt", + "remote_path": "Installer/License.slv.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57b653fe83b34d98dae0dbe1f149754d41b39759", + "size": 495, + "sha256": "4ca20b3833ce9054a50037a18a068310f5a2c071e7f84bc3fdfc1559c91c85e0" + }, + { + "path": "Installer/License.spa.txt", + "remote_path": "Installer/License.spa.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4144100d4ecb9fdead077523f25c18ee778758f", + "size": 519, + "sha256": "8e74a96ac8b1f0edf5f59b525dfc38c3fe49cf4b7f7e24a1c1f5fd563d9acad1" + }, + { + "path": "Installer/License.srb.txt", + "remote_path": "Installer/License.srb.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d9d3fe9692300552be26cf733cc10dcd72f8ab59", + "size": 870, + "sha256": "66288fd5c65ea29fc1e05b2194b0476c00a94ba7359de37065525db2c7e555af" + }, + { + "path": "Installer/License.svk.txt", + "remote_path": "Installer/License.svk.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f3380ae63baf654180036af016f1f5acf3b4b9c", + "size": 432, + "sha256": "496670ad130b70cf430ea18d6e5404a01abb37c3d50931ba611849b14c973ace" + }, + { + "path": "Installer/License.swe.txt", + "remote_path": "Installer/License.swe.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f19212d1df157d2a0b4436a504e7216e70d7fe16", + "size": 482, + "sha256": "a625d38f6c649c77afc3149a4d552dad40c3f046ad4c6df165a22d116f80d79b" + }, + { + "path": "Installer/License.tur.txt", + "remote_path": "Installer/License.tur.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60535edb657c94365e0141f33b55b7c12d166a3a", + "size": 373, + "sha256": "cec4743807ea80c86e37eb4b028dc33e58e432c6c4ca84a87cf07235fe8da625" + }, + { + "path": "Installer/License.ukr.txt", + "remote_path": "Installer/License.ukr.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cdc42a8a12ecf4bd6c3076ad04a11e533af8d35d", + "size": 506, + "sha256": "324f951a3586fe82f6523993305e64b6d5136ac66d4fb879c97b95aa93f6806c" + }, + { + "path": "KM_NetProtocolRevision.inc", + "remote_path": "KM_NetProtocolRevision.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d4b059e8b607955db671208223321da4f68b0ae", + "size": 34, + "sha256": "1d0a478bb69bb3f9c8a80042908820136f3c10a07546a73870f32a1dd5f8544a" + }, + { + "path": "KM_Revision.inc", + "remote_path": "KM_Revision.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "454daef11e42ef83255fa3fc65a3307ecd75a277", + "size": 25, + "sha256": "e797bcda891c62f8875b4b7e63fbc85d5287a2d2819b9ce772b6779d05051400" + }, + { + "path": "KM_TextIDs.inc", + "remote_path": "KM_TextIDs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d300775764dec61fef8c0502cf28bc200cc3d9b5", + "size": 90061, + "sha256": "0dc7eaa2f724c642bdf9ebd738146322c3d711f6c46654ae47d1882c00ce602b" + }, + { + "path": "KaM_Remake.inc", + "remote_path": "KaM_Remake.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3142bf7f466a37466b99fe8a933d171373d27a54", + "size": 4512, + "sha256": "45a8fbf3af6f38515318e52c1c149f341068e038e21270ebcd3b2f89bc4cb7f6" + }, + { + "path": "LICENSE.txt", + "remote_path": "LICENSE.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dba13ed2ddf783ee8118c6a581dbf75305f816a3", + "size": 34520, + "sha256": "57c8ff33c9c0cfc3ef00e650a1cc910d7ee479a8bc509f6c9209a7c2a11399d6" + }, + { + "path": "Utils/RVO2/LICENSE.txt", + "remote_path": "Utils/RVO2/LICENSE.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "77f83a2d93eefc476bd733605f28f3f81becea78", + "size": 2025, + "sha256": "cd6848a33104313fd9dfcdcea88b53bb15bd5a9bd25a782cffd100b0c211f4d1" + }, + { + "path": "src/KM_Console.pas", + "remote_path": "src/KM_Console.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "269c82c88200f988d85c0ebd14a47c02ff3f1f93", + "size": 7942, + "sha256": "ec2725ac36fe894e7855168747df4790828b25af9d7d5a34bfe68b5a7dd9aa6c" + }, + { + "path": "src/KM_Crashreport.pas", + "remote_path": "src/KM_Crashreport.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dda51aa72c5dbf83ba71c21714f7c13264fc38fb", + "size": 6011, + "sha256": "462bb3058ebaaf2b18fd6642586e93c7c2513314ab6352c43409f3b87308299c" + }, + { + "path": "src/KM_Exceptions.pas", + "remote_path": "src/KM_Exceptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b947c9910cd87e87c1ce39def6acc80bf4a0675", + "size": 8030, + "sha256": "a3cea70a34454661ecff7f101626f89d2b71825a25009bd47bd14b1610204220" + }, + { + "path": "src/KM_GameApp.pas", + "remote_path": "src/KM_GameApp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92825162a850428e4756d6bf278ea60e7eef80ab", + "size": 50418, + "sha256": "94c683fa9f2145fd9dcc580b83b2c80217a8e4e236043d4f4539964b48d8f58c" + }, + { + "path": "src/KM_Log.pas", + "remote_path": "src/KM_Log.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04fac6f2955c2a2792c6ce9c1073f3beec7878d3", + "size": 15469, + "sha256": "0dd5f9e66d452c415cf59a81aaa0508efa371bd19ae50c0c90aeca2b16cc0a96" + }, + { + "path": "src/KM_Main.pas", + "remote_path": "src/KM_Main.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e3acf7191293f5b27db863f9300984608adafd18", + "size": 29884, + "sha256": "1ec45fea42418453cd6f18ebe3dc499c39f3dfc4944ff6b34679167e4a2ba97c" + }, + { + "path": "src/KM_Projectiles.pas", + "remote_path": "src/KM_Projectiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1d20f5c888bc522abd5e69fbe28ec9f62967510f", + "size": 20327, + "sha256": "7851dcf76ae7571334c2674c230a4a2c48f962dd379c3b15dbbadcc9e2cd449e" + }, + { + "path": "src/KM_System.pas", + "remote_path": "src/KM_System.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "253cad07f032b5cc87a73dd2a56cc2023a9ed971", + "size": 6839, + "sha256": "1022cdf06a99b786043c5be41b2543115c95eae3ceccd529bcb0e960e5032f23" + }, + { + "path": "src/ai/KM_AI.pas", + "remote_path": "src/ai/KM_AI.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1f3370fabc619bd4e338e356947d687f593f5aa2", + "size": 22590, + "sha256": "8d58808f0b9d6e3110ad4a6688b04f94d56dacf9ff210a36b1665a47ee52c17a" + }, + { + "path": "src/ai/KM_AIArmyEvaluation.pas", + "remote_path": "src/ai/KM_AIArmyEvaluation.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c7318ba81855dfe63e40a9584a2e04fdb8ebaec", + "size": 11385, + "sha256": "1cf68f6cfa91e5653a3a952c9f0bac0539e25860a0031a75543e73020a9cd24a" + }, + { + "path": "src/ai/KM_AIAttacks.pas", + "remote_path": "src/ai/KM_AIAttacks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "00e558b214577afef77559980685c4fb08412822", + "size": 7197, + "sha256": "9f449dd9e93b336af8369a3c55bec12f34e591a2a0916028c76dda467ed67706" + }, + { + "path": "src/ai/KM_AICityPlanner.pas", + "remote_path": "src/ai/KM_AICityPlanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2d4adf4a2f33d8d6ea8e46ef77a27c90a978ffe7", + "size": 20673, + "sha256": "7215b38858493b7d2effd9f89cab27c680f135d9c79af9650097ab2005ce144d" + }, + { + "path": "src/ai/KM_AIDefensePos.pas", + "remote_path": "src/ai/KM_AIDefensePos.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "680457557bdf6470eead77a2ca0771af180e645b", + "size": 16062, + "sha256": "736853fc643b2c5d0351430780d4e939f2414911220551a4055175f7e5d6c0a9" + }, + { + "path": "src/ai/KM_AIFields.pas", + "remote_path": "src/ai/KM_AIFields.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd952507aebe9711ca9298695ddeca9d7e23953a", + "size": 3392, + "sha256": "ebc541a50513e69b21abac613b07b848261130e69cb55e883e8dcb5789b4d6e5" + }, + { + "path": "src/ai/KM_AIGeneral.pas", + "remote_path": "src/ai/KM_AIGeneral.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd1e2a37499b16d4686f74417bea6a26553b4db6", + "size": 28183, + "sha256": "62e4b43d156f205f73de48590cc96b0d831a57ce9b6a0fdd35bb8d203d8accc5" + }, + { + "path": "src/ai/KM_AIGoals.pas", + "remote_path": "src/ai/KM_AIGoals.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c098492d212bf2c1d3e4f6f1efe69cfd34ef314b", + "size": 7296, + "sha256": "df64bb01294f0a91f00ee24bf42c5879296a768dd897db8e73a019002c542fcb" + }, + { + "path": "src/ai/KM_AIInfluences.pas", + "remote_path": "src/ai/KM_AIInfluences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85f3f7dd66aa475641b306d59bba98c3b2ede35f", + "size": 28511, + "sha256": "91d1062df9198dc2ff83aaae89321ae66afb923bbee445f62b22373c607e5a56" + }, + { + "path": "src/ai/KM_AIMayor.pas", + "remote_path": "src/ai/KM_AIMayor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "215ab7931416885073e81b8b0b306a11f7d57d01", + "size": 37545, + "sha256": "3e119af47d0cd05f70e67846cdc648865f618e56c66f84c7dd63079d65a9fd22" + }, + { + "path": "src/ai/KM_AIMayorBalance.pas", + "remote_path": "src/ai/KM_AIMayorBalance.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6f32dbc060a4dee42ee2c004adae0745b40643b2", + "size": 38721, + "sha256": "46bc59345f89bb86e15a91f6ab43b4f01aa72ebe26524c02926e331ab51d1448" + }, + { + "path": "src/ai/KM_AISetup.pas", + "remote_path": "src/ai/KM_AISetup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f8798fd723b3c22c661c286347a57483a76aff6e", + "size": 6762, + "sha256": "5c24a388760a039d3964f8396d5798200c52a9e30f7863cab3c1768cea2d6c0d" + }, + { + "path": "src/ai/KM_AITypes.pas", + "remote_path": "src/ai/KM_AITypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3eb9f6e5c015d81dae484b3e1058316b132af194", + "size": 1641, + "sha256": "f80ad7fd48fed61572bb300deea7a7d08d9b7726871164d8a65cc7532b29f672" + }, + { + "path": "src/ai/newAI/KM_AIParameters.pas", + "remote_path": "src/ai/newAI/KM_AIParameters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3fde31e4b8229927e60f17c096acd284bd96dd3", + "size": 31297, + "sha256": "8b7d07fdf51944a538266fd8bbafdf3b89250f0944de97595adca272b07f070e" + }, + { + "path": "src/ai/newAI/KM_ArmyAttack.pas", + "remote_path": "src/ai/newAI/KM_ArmyAttack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "25468ba7eb96b23aa06aa25692d89f290cdd83cc", + "size": 59834, + "sha256": "568dc0393caab3b8ba0233ce62ff5f639f36947107d6504f43a85685d027d78a" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "remote_path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9134831774789bf0e0feb26a4480f57d1719c9ac", + "size": 30342, + "sha256": "ac1cf8d983a8f920272f0e82ff22f8cc85057dce955721a4ae79e1f0c0fd8bde" + }, + { + "path": "src/ai/newAI/KM_ArmyDefence.pas", + "remote_path": "src/ai/newAI/KM_ArmyDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4c75b1e1056cd7c8fa198649ea35b479e845832", + "size": 16370, + "sha256": "874336297ce5babbf362d67c60089a1cf6e197ad0b90782288fa7f85b49e2e19" + }, + { + "path": "src/ai/newAI/KM_ArmyManagement.pas", + "remote_path": "src/ai/newAI/KM_ArmyManagement.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "56e55bb659c70386d16ad87bdcc7bf944ac2d5c7", + "size": 18822, + "sha256": "3f93d3a749d40b4fc2ecf21ee31dad5203244bc08c5d8c4cab8183b03d43c213" + }, + { + "path": "src/ai/newAI/KM_CityBuilder.pas", + "remote_path": "src/ai/newAI/KM_CityBuilder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d1b737802463ed3aea7cc92527951a1a845c50f4", + "size": 89133, + "sha256": "646f2cbbb75f529637879755e02b8ef17c0901cf8de2684a98df90d58c09ad54" + }, + { + "path": "src/ai/newAI/KM_CityManagement.pas", + "remote_path": "src/ai/newAI/KM_CityManagement.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "867c1ea3c0b373cc312886076ed7f58ec2a8c25b", + "size": 41466, + "sha256": "fd07b221e052f7ba48644628bfc8ca47658802b7461287ea0bf7d22fabc9814c" + }, + { + "path": "src/ai/newAI/KM_CityPlanner.pas", + "remote_path": "src/ai/newAI/KM_CityPlanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "edc1387cd4199dca8350e35a4a22675c0a01e3f1", + "size": 134397, + "sha256": "b2e207d0697192bbcd3a0ffdbc5dfffcd30521f7e403616ef15fa471c0aa123b" + }, + { + "path": "src/ai/newAI/KM_CityPredictor.pas", + "remote_path": "src/ai/newAI/KM_CityPredictor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8dd77f7010328346323d6aee8583207fdb3f751c", + "size": 40996, + "sha256": "c5adfc3c7f9364fee6457cab8b427fec0e2963a3af17dd773a23f0c3dd39114b" + }, + { + "path": "src/ai/newAI/KM_Eye.pas", + "remote_path": "src/ai/newAI/KM_Eye.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d281748a2a34e05197b41788e41c31f42326792", + "size": 62912, + "sha256": "f3ed155b642866e6331f6d33373762a58785d1f02d4a97fea6f676534b6c8bed" + }, + { + "path": "src/ai/newAI/KM_Supervisor.pas", + "remote_path": "src/ai/newAI/KM_Supervisor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0289664258caf3333753a26e955b5ed6709a0f5c", + "size": 55276, + "sha256": "faa9200436dd25fca95b5989154da0e4412f2c7ad013d6a919bc980ada1bd7b5" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "remote_path": "src/common/KM_CommonClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e967a306be87647d5e010d204d4f564cd272359a", + "size": 54489, + "sha256": "4889af4aedf2174509fd1d0c0a6f6a2b7b64dd680a7266b8483db74b492f95a1" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "remote_path": "src/common/KM_CommonClassesExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6880d9dafecb675ee6164505825b301fc1ca596d", + "size": 10750, + "sha256": "a96e123fafb3d90a1715ddf4c249d3feec91e8df3971e5d8612846ea9fba39a1" + }, + { + "path": "src/common/KM_CommonExceptions.pas", + "remote_path": "src/common/KM_CommonExceptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2474182adba01fb8018636259d1d461f4024f35f", + "size": 588, + "sha256": "7198f3aa91b83bc925c401e24ee569db1d525c98650e3e7779f074871d5ea44a" + }, + { + "path": "src/common/KM_CommonGameTypes.pas", + "remote_path": "src/common/KM_CommonGameTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e95215e9287fe608ff504f9aeb6e05e72bb76c9f", + "size": 171, + "sha256": "7021fe5a4ed528a523b2a14894322967f8137543226646cbe627e17b5c036dad" + }, + { + "path": "src/common/KM_CommonTypes.pas", + "remote_path": "src/common/KM_CommonTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "38b92c292502c64fd03abff9a16d38f7dbb73091", + "size": 9433, + "sha256": "dc0c838a0e440cb80ef89ab173402476ef10b1cd5dcb2b08ebba462e5b6ce0dc" + }, + { + "path": "src/common/KM_Defaults.pas", + "remote_path": "src/common/KM_Defaults.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5f48d4de474a655cc64bc3d3cb2b1bcb529d6bd2", + "size": 50409, + "sha256": "4731fcfe204ed19c98ed2dd3e2fe479f15fc089ae3654ee43c471c7f789fed10" + }, + { + "path": "src/common/KM_Entity.pas", + "remote_path": "src/common/KM_Entity.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9099191c3a99c9d0a205dc3fea31beeb215ef89", + "size": 1761, + "sha256": "627e02748bdc9f2e365b1e034e558fe9e55acd52982a514052f6e43c664eec37" + }, + { + "path": "src/common/KM_Lists.pas", + "remote_path": "src/common/KM_Lists.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ea98101f4c5c5ab186ab6080c95f1558f753827f", + "size": 3989, + "sha256": "05b1535a3b7b840cd1976b7c68d0fab56668282db117cf7aa3f48229b847f4fa" + }, + { + "path": "src/common/KM_Points.pas", + "remote_path": "src/common/KM_Points.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87cdb0642a21d023f48616edab3128796af1ce3c", + "size": 35587, + "sha256": "b3ac9d1c48aedc723a56c952f771802115cca0025ef050383d5dadcbb8e26132" + }, + { + "path": "src/common/KM_WorkerThread.pas", + "remote_path": "src/common/KM_WorkerThread.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4058ba7421c097406572cd4d34982be13975910", + "size": 7145, + "sha256": "fbabc6c0a533085603b5e0588cb80ff3c0dd4a89c69cb1c072f8f449de8696c4" + }, + { + "path": "src/common/KM_WorkerThreadUtils.pas", + "remote_path": "src/common/KM_WorkerThreadUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ced4191abe5b413d59eb9be2968cd9e71fcc3ee4", + "size": 3408, + "sha256": "2471748f44531d1a1a21e4888b4641098b0c070b5ac21d6bd4e6609f463ec4e8" + }, + { + "path": "src/controls/KM_Controls.pas", + "remote_path": "src/controls/KM_Controls.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "09a23b5a63a49b58be8f3f70c5fd817a968b437b", + "size": 61807, + "sha256": "1b28806141e07039b1fb18d3d25cd432d101ab880f5e50c4a82d5bc9c79ddaf3" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "remote_path": "src/controls/KM_ControlsBase.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8241482ac9cfea60306b638676571abc0567b0b6", + "size": 23671, + "sha256": "befbe571b4fb93ebed9503ebf05604ff7fdb529bbaeba846efd146c07088eed4" + }, + { + "path": "src/controls/KM_ControlsChart.pas", + "remote_path": "src/controls/KM_ControlsChart.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b7df1cb4a85c2876d5663c69cc403f6480c54914", + "size": 16288, + "sha256": "45eef7023b4a58f66c2a2bef6bcffb49e97a16ef6400712e52bd1b815ebe4b08" + }, + { + "path": "src/controls/KM_ControlsColor.pas", + "remote_path": "src/controls/KM_ControlsColor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "558278d51746726660d2d304de9d10b976044b66", + "size": 4187, + "sha256": "6d6ced6d7d512090b2de07398c75a64ed26085a775edae4bb46be3725271a6ec" + }, + { + "path": "src/controls/KM_ControlsDragger.pas", + "remote_path": "src/controls/KM_ControlsDragger.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3f1ebfadef48c4b1fa2456dbf2e3f7020f730458", + "size": 2495, + "sha256": "f33ce9ba9827d75bc58247acf0a4150155d47f1ed757a00081e2b23a2da87c1a" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "remote_path": "src/controls/KM_ControlsDrop.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d99d78bfa344462df6add473712f5cb64c0bbada", + "size": 19698, + "sha256": "044dbb810a75fdb047a91b41dc9179f8245a0e4ed21236677ee5dea243c673b7" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "remote_path": "src/controls/KM_ControlsEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "760c0ec8fc96b24788d26d084f52d21de9bc453e", + "size": 30711, + "sha256": "0942a45abd2f4c8cdbe0225838424e5eb409fee2517aa221c8a0e0be90fd5079" + }, + { + "path": "src/controls/KM_ControlsForm.pas", + "remote_path": "src/controls/KM_ControlsForm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "088be5588cc4a948023fa7c03f5d7b601a562f02", + "size": 9331, + "sha256": "98f52c23f4718e36da00222acb62d53c158961f5698668b43d0afd1a3fdedb7b" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "remote_path": "src/controls/KM_ControlsList.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b99e059ec62a95dcd1c8d064171c0982be6e9189", + "size": 61949, + "sha256": "7f8b22a3044272f822bcc7d038d2debb55d2a6695c51753fa6bddb35666d3598" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "remote_path": "src/controls/KM_ControlsMemo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "79a8d78861522ea732553dd5131bacda660d5b47", + "size": 22635, + "sha256": "e23963c974847435ba3fb2f13dba527a92a746c75873ed4e7ab8bd39ac07e146" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "remote_path": "src/controls/KM_ControlsMinimapView.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e0aeff4ebd143b51e9695d134a50a1a59064a6e", + "size": 10855, + "sha256": "dac705b593e547df6ea73d15bb348e89ff2e50574a553405c787a684a49bc979" + }, + { + "path": "src/controls/KM_ControlsPopUp.pas", + "remote_path": "src/controls/KM_ControlsPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6e50f766b27dc98e31c033abcaa57455e1c218b", + "size": 4355, + "sha256": "534507699f46b5a062ab440fdbdefde2f966d23b06c9a5a570bc5fe958c66fc5" + }, + { + "path": "src/controls/KM_ControlsProgressBar.pas", + "remote_path": "src/controls/KM_ControlsProgressBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "55ff2bb6c4d409176aac24b3a5f29230403a248e", + "size": 9320, + "sha256": "769335ff01446bce98fb4a19dce65bb2eb62fd941f8c659cf3e276893e4a5309" + }, + { + "path": "src/controls/KM_ControlsScroll.pas", + "remote_path": "src/controls/KM_ControlsScroll.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "091c5376f6dcc738285a508ed5b2c76836f21a1b", + "size": 21691, + "sha256": "aca2e9dc6da62703571ca7251a2eeab30d29279de0c273e5fbc57992757d9635" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "remote_path": "src/controls/KM_ControlsSwitch.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "778e7519100c57e3a146fe8f552eb1107b788714", + "size": 12115, + "sha256": "a363807128a8bd01e9cae584390281ecf29c6e93592fec7a95fe598d413ec6ea" + }, + { + "path": "src/controls/KM_ControlsTrackBar.pas", + "remote_path": "src/controls/KM_ControlsTrackBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e5a741b931de17c1b0d74237b6a3d27d371f177", + "size": 7338, + "sha256": "2183cc3a50e5a13670f9d54f3376858972d90bc194b59d270f0ddb023a71e8c1" + }, + { + "path": "src/controls/KM_ControlsTypes.pas", + "remote_path": "src/controls/KM_ControlsTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "285f9f36aa9f6fb7dbdf597e37bd4cc8f9bf6b58", + "size": 550, + "sha256": "271f13fa7867ea1b39c2d121c5fcec799ac7e137ff15768b9e9726e0150ff3b3" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "remote_path": "src/controls/KM_ControlsUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a60b553e154f1e6364583964892e14cd007c9e3", + "size": 2040, + "sha256": "099b1bb73a96c87eeb775fa8f7677ccdc1a12b788fcf8aab677fff702b9eddda" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "remote_path": "src/controls/KM_ControlsWaresRow.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19878f7bc1b04dad27d68b8c012579b7682fbe98", + "size": 8053, + "sha256": "435a8b7ae9a74b5339590bc0addf806231e58c886b3ebfb947c343842a15664a" + }, + { + "path": "src/ext/BGRABitmap/basiccolorspace.inc", + "remote_path": "src/ext/BGRABitmap/basiccolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e9ce01675103b1c61b7d6633be131d9ec0b56f2", + "size": 46319, + "sha256": "4c65d3525e81a6efdc7ebc6bcf37de9af33725de7ca0f01df72a574a3abb39cb" + }, + { + "path": "src/ext/BGRABitmap/bezier.inc", + "remote_path": "src/ext/BGRABitmap/bezier.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c4a0e1c9e49f9f631d6c594bceec0192e7a10c43", + "size": 44009, + "sha256": "b602df17c94f327cdacbe4e9f62737f7d95f91f54db88d29388f5760d4b382cd" + }, + { + "path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "remote_path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "16c17a49347780668408c206dbe71ad15fccc273", + "size": 36280, + "sha256": "d778e2b034c3ec3e1e954cd9549e61b754a73f3f284bec84928d67c1018c3471" + }, + { + "path": "src/ext/BGRABitmap/bgraarrow.pas", + "remote_path": "src/ext/BGRABitmap/bgraarrow.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4173e37a6b37ee331b328ec9622cd5aa61e71373", + "size": 16298, + "sha256": "4c8ec6ccff690e139117a22ad754f09d80902326a21187a24a60f26fb69a2ef9" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.inc", + "remote_path": "src/ext/BGRABitmap/bgrabitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "955d85ab29673e7deb7f4c9f1f628b95e6fa6883", + "size": 1144, + "sha256": "f9bf0fbf76db6a995900b9112056efb93a4b6c563326814cc7c0da0662b67931" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "39293609a641c445d8031d35cac1a4612f6dbeaa", + "size": 17464, + "sha256": "491b7b30a8e8cc4b8a5d57511561b6b421434a7c4b59a9ccc6427e4e98cd2f6f" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8c46a1fec29b936816de95ec72eb019cba38d0f9", + "size": 1804, + "sha256": "07e51934404f81ca20a5349b074f0613bec879b78a56e62e99e35357b4419911" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "596f3782f03a1bc26b10bf0df4ca4721a3733473", + "size": 1358, + "sha256": "fb1a8e0a8adfd3f0238c6122c3fbeaa76d2ab1169bc46f7ff489496230d28ba7" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4nogui.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack4nogui.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f2d0ccea6a6b64a7a1511de9a8b006283a2b381", + "size": 1417, + "sha256": "1883384b69bb49264585972eccdfaba0f79fa36e7f1a8a80836d043a39df4c5e" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4a416bc04d8d771727a8f4614e1437cd67019a12", + "size": 53776, + "sha256": "0f892b3508285c1929a6607abc03e479bf8e8b56eda3090f5f95c3f3a1d16a0b" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "remote_path": "src/ext/BGRABitmap/bgrablend.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4cb0e2917a41c3edde47d16f78e28c0bf98ffeb5", + "size": 62361, + "sha256": "08a1fcb093154ed5478788adb94febc969f201de0acd9178a69fd43c37c1c076" + }, + { + "path": "src/ext/BGRABitmap/bgrablurgl.pas", + "remote_path": "src/ext/BGRABitmap/bgrablurgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa3357b56bbbc6d96d294a20ee3ec9098a7d60db", + "size": 5469, + "sha256": "d0bd6e8beef1be7159cbc30ae63b57b6e05a89dc1052c52a05fd1ce0e4678b28" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvas.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44dbc28e40423cf20362a39aa5432ce26579af76", + "size": 55095, + "sha256": "bb1a90a3e8105054df0655f2e126746ef725667a4fbd51ca15c60ed2178d1d05" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2e0bad66dbf6437683e4b1488721c29ecf8506dd", + "size": 89527, + "sha256": "c19f40a2b6e350bb95dcaad238580576441d6ce0ceb7f579b79723928c58ee9f" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6ecd285237bdfad789c226192576b258c80b3d7", + "size": 66726, + "sha256": "f355f3297becbbb4707d17391fcbd4bffe65f07c5786d6a1312ab78d6093c101" + }, + { + "path": "src/ext/BGRABitmap/bgraclasses.pas", + "remote_path": "src/ext/BGRABitmap/bgraclasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ba3343e2a6d468afcf8708956e1c07314799464", + "size": 6186, + "sha256": "20887df29bd48d7568d632529f3995c9705430a4d531c908accca0410018a103" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "remote_path": "src/ext/BGRABitmap/bgracolorint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6551c686311897552f5550ab09b53e75f1c2cc66", + "size": 9077, + "sha256": "0fb44ecd453637fa299699fdb0718a10c98c97c24a284b7f99272c2d949ba47a" + }, + { + "path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "remote_path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e130e0e3935dcffa7541954a9d06cfce9df99ad", + "size": 64797, + "sha256": "974a090a4d585f465ae06bfe81a0224218e776995c4d5373d30f3e96135390a0" + }, + { + "path": "src/ext/BGRABitmap/bgracompressablebitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgracompressablebitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "65a54137ddc62c36c89bf7016e9b4837057e87ea", + "size": 9724, + "sha256": "fc0c02744a09517a85fa301cedc0667cb70a977550ec8160a349081169875692" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "remote_path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef79c7de50641fa310bcff012060b9227d60897b", + "size": 11344, + "sha256": "8d69fe69aab7838233d386e66cf91c45c64ef2027e8788b4f87214ed4271f398" + }, + { + "path": "src/ext/BGRABitmap/bgracustombitmap.inc", + "remote_path": "src/ext/BGRABitmap/bgracustombitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ee8550235e4a7d91619dc82a1ca960b7bc6263e", + "size": 95565, + "sha256": "e2d7db550d3ce662d637406616aab3d3e483845d288237c64b04c94854e3efd6" + }, + { + "path": "src/ext/BGRABitmap/bgracustomtextfx.pas", + "remote_path": "src/ext/BGRABitmap/bgracustomtextfx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6c4c0885395027e6c5b0280fee0a95b5c13ce3e", + "size": 20205, + "sha256": "039971ed9b16f5afb7b79399b520b92332357b1d024627e3a949b6c55911fa07" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d015a412d13df0df08e6ffedbd697d3e7e6bbd8", + "size": 166581, + "sha256": "37310135e9e19361159762883cd5aa7e004a1d424ce8e932dd60d165441d63bf" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "remote_path": "src/ext/BGRABitmap/bgradithering.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "91b532f6d5020703d09495358b9c0fef6f5b3138", + "size": 26509, + "sha256": "d5e4b678cff117851dbf39853201b8c527a8950c802da058f01921a5bf0a1e76" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "remote_path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afd79c72d55221202aed332ec35457d8f1a9950e", + "size": 45114, + "sha256": "15a6ef3483d5f16bf136027ec2749582465fc9fc2f0d23db87e00c2628ca6996" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "remote_path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f45d32cb37b7194f7de5f4f2b9b147c08e8e6ea", + "size": 47031, + "sha256": "ce25fa5a46f58d74a799cf68127bebc8457475610d5b5b6809a74ceb24bac77d" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ecd712b1295c27191ff79d6feda6b7372cd1038f", + "size": 38171, + "sha256": "0c4984623455519c57ce61c0085e6fd4739e23b0d403a57e555f6ab62bd1654c" + }, + { + "path": "src/ext/BGRABitmap/bgrafilters.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5531fec0dadf0a9979d8b0e4168153b1c7241ef", + "size": 34024, + "sha256": "c7e13481eb76c453d986b3a2df887de87b5866af13bd2d5c9f900986eb5f7c7e" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterscanner.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilterscanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62d251ed75aa4405a9d68f44ef52e5093b821e95", + "size": 25719, + "sha256": "ba73a33d42b5e43a559cbf8c8ae38b14dbd7b52e7c05c14a729b0d416aa151ad" + }, + { + "path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "remote_path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9eed018968e96a7d5d3404cb732f1630c7d143b5", + "size": 14187, + "sha256": "7fee88debc74b6e740c34af81ba7d6d6d4c0a39fccae0db85ae36b9d3b1d2d2c" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "remote_path": "src/ext/BGRABitmap/bgrafontgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e21f0f9a0389c3793e6dbc84f37d5d4dd3c5aa4", + "size": 19891, + "sha256": "77f0b6c4cb4560ce10eaac9cc3cbc71041dc2843601ccba9a0856f568a7fca94" + }, + { + "path": "src/ext/BGRABitmap/bgrafpcanvas.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpcanvas.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c6e5edfc7979855908a7bd8fd6744cdeb0b8b719", + "size": 7755, + "sha256": "b771650a941f4c4cdd6f6134239308a0131dd4edccba80eee2b4c4f22c328466" + }, + { + "path": "src/ext/BGRABitmap/bgrafpgui.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpgui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d6ec56018d7cf4d0c5caed4cc707cf83178fa5e5", + "size": 1804, + "sha256": "6ceb78469b3e27d5ab9c411f829b501540fa45bc7ab38be2363f12d4908ed97c" + }, + { + "path": "src/ext/BGRABitmap/bgrafpgui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpgui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "54b33a7582f5b7b1ac3c031d389b3411dad64b9a", + "size": 57, + "sha256": "5f0e507357811ed96939d4f964dca84798da54b32c38c6c8ec95b3a4ccbf7248" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c6f0c9022f4796447b69e5244e6eee181b9d57fc", + "size": 7782, + "sha256": "6c8a1da352186a2c62f641fa233331ce3d102943040d343cd83b7577629488bb" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "remote_path": "src/ext/BGRABitmap/bgrafreetype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c95ecc7a41815ad34949dbb9272de84573f44907", + "size": 51833, + "sha256": "c26e390761181051a4bef03842b2b9c84deb6fab5460bd46eff39439c8b28f6a" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "remote_path": "src/ext/BGRABitmap/bgragifformat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd32eed73e5840543ef854c670650d137773024e", + "size": 34813, + "sha256": "7f78c2aa2e61a69c570ad69e6bd4d8bbf85fd95e469cc46f7604c95cfdba2a23" + }, + { + "path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "246b8bb3f3e4e68ff43f1c236e0c030c792fb9d6", + "size": 30269, + "sha256": "b77183c70b20f8abfa1af8b5957f17fc8c98cd6e56b9835f330f896bb1193157" + }, + { + "path": "src/ext/BGRABitmap/bgragradients.pas", + "remote_path": "src/ext/BGRABitmap/bgragradients.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6d5fb7ebe6e1cdcf2275cf83f3c9a78e47b1a78", + "size": 44894, + "sha256": "5b89650b3b39ae371e7f212a912692716d0f4cd3c7c9ebd0f548ff39538de696" + }, + { + "path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "remote_path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "31bbdd469f5e661532a2f5726fe3b701b3d852a3", + "size": 69462, + "sha256": "60e0d6c7f9a512173caec70007fdeba4632fb0fe9c9e5c8f7abf958a073c2fd6" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "remote_path": "src/ext/BGRABitmap/bgragraphics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8628bf0b1b811900c4d632fca7575ed2cbdea2f6", + "size": 19435, + "sha256": "92093cbf599916e98d7eb05909a42265f3067c7cf557cb45c6bf0ede96194a75" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "remote_path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "15ce7568431800ed5b48767490a72ed4e81c1392", + "size": 45320, + "sha256": "ac4706df660a091787d82e5fd2ab11e199c8f98ec792841625ef9609d2899ef6" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8f8750d90c27604df7169edc7f2607ce6e78177", + "size": 9648, + "sha256": "cc1ee87c685a06c6e277b80f7ee7f6715d453ce1be9b291e65dabfecc0c969bb" + }, + { + "path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "remote_path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1976a859e9363a8cd8c92e12a6568de7788654e3", + "size": 26102, + "sha256": "0598a1c833d60ed07c69eba58bbf6300ded2a1497d9f59d9925929807ded5e6c" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7402128fdc08af3b66fdba597ca3c4df3693144e", + "size": 72915, + "sha256": "fa8a4f82e9d2744e27dccecf387327549412fdb528bdba6b9d99eb82e81ce6f7" + }, + { + "path": "src/ext/BGRABitmap/bgralayers.pas", + "remote_path": "src/ext/BGRABitmap/bgralayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "51a2def6bff12f8b5ce1af4e7a1bcccde0e57cd4", + "size": 123396, + "sha256": "ff3c7f640cefba6b06f26543a41ecbd6439be1b5d165f7d3ad4340245b47368f" + }, + { + "path": "src/ext/BGRABitmap/bgralazpaint.pas", + "remote_path": "src/ext/BGRABitmap/bgralazpaint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac99c45b4ef5c66ee142c15c78a3a9ff4fa900bf", + "size": 7070, + "sha256": "b6cefad40a695141f41a9b9a023baa216db88d2b03f973f955720966f7f8fbd0" + }, + { + "path": "src/ext/BGRABitmap/bgralazresource.pas", + "remote_path": "src/ext/BGRABitmap/bgralazresource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c552b33c4bd6e9edb759e0cf0b02589a8de5f8b2", + "size": 10981, + "sha256": "2025ef390723fee59f4c098a66e270dd8b907eb18d551fcb46c49c1f4196a184" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f8b9094400082e1a7f323036a321cfb53a92b5c", + "size": 33969, + "sha256": "0f15d3d9f5b1d2a5c0cfb9ec9e7e90db56f10b50017a39a7400cdb988b04b701" + }, + { + "path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "remote_path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4d991de15a55de02d61e49614a97f7e339393486", + "size": 19376, + "sha256": "8f7f2033706b524fc1adcca5d533afcedd2d17306c81742d0e925c81c2b32628" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0a90f398c8724721eed6eff81c455a5e15ceebe", + "size": 2102, + "sha256": "7207c8feb702bf8fc8fb7302897bd6305da199a08272c67688c6b2760c2579eb" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "remote_path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f0ddc70b3bd7270b86dea660576138ba9f914937", + "size": 19621, + "sha256": "4bc5fe62d60c4b83d0cb47fa777319a095a816227e5ea9bca870b720a826a461" + }, + { + "path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "remote_path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "045b1e378df0d2f16d7feeda1a2334030904f196", + "size": 21192, + "sha256": "ac258fbb77cec7922b1684c4ba78c25748519ff9a40526f55a50cb3ad6c10bcb" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ad59c8e7e0cf3e02b995435484eac0c16404a84d", + "size": 9920, + "sha256": "ae0694b2660afc59a9d56ca96e31cb82eeb86f77d6d810ae1dd2c2331602f4c1" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui_text.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui_text.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d39fde769d7cc24c395d2ed3568da29ee40aadb3", + "size": 2760, + "sha256": "7d8404e0d37d8db84ef7444c9a25c37303e2472ac7f6c5df6e1494f9eea3a6fe" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c54e7afc0ba3124afbe24560f96b63b6ba2a29fd", + "size": 66, + "sha256": "aa7001f8f9ef8f209c262e5ba4230d9668d4fc21331621f560fc48451b266d86" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "06394f0578e4af1caae07deedd81bbb10ae09924", + "size": 6788, + "sha256": "804b1081d1ae55f0ee688ac5df888fbd39a83c3fb9a1f9243b6a3fb163cebafb" + }, + { + "path": "src/ext/BGRABitmap/bgramultifiletype.pas", + "remote_path": "src/ext/BGRABitmap/bgramultifiletype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "faa5cb2f431fc4cd838a897b5f0f99aa46f741d0", + "size": 13926, + "sha256": "98d77ba1a0715ffb01ccc7a10ad4252c121bfaf45b594ac73ff12cd65ab14a8e" + }, + { + "path": "src/ext/BGRABitmap/bgranogui.inc", + "remote_path": "src/ext/BGRABitmap/bgranogui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "eb1ef969597263bb3f0c0769e7f75898e8a78b29", + "size": 1886, + "sha256": "31b4fb1fc480d517aa595c0be9bcf26c12fe40cdbaec35e40a454410f8971c5f" + }, + { + "path": "src/ext/BGRABitmap/bgranogui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgranogui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9c4e4fd5e76f28b84b036f44ca6854e1dfcba086", + "size": 48, + "sha256": "256b452e3bfb5e6cb506fea8f6b861c6f1c3a0dfd24404aa0c54e16897c15dbd" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7b921814cd8c028a7eca5c3443b74ca34309c54", + "size": 4738, + "sha256": "34e4cc46903fb094747099e591933d1826c411f9dc6ce0f999da4a2fddcd7d3c" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fc16c76a868ef4e0384d47224ad12c3afc4848e2", + "size": 61403, + "sha256": "129c6eaf5bd428895e6befde65c7a43c9833d61c0c977bf3d55132d5b47592e8" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl3d.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengl3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b25e5dab0af440c79206247b669844f171fe4756", + "size": 30664, + "sha256": "42444c0e372d2fd50e9958610e6292c342b9b04107e29c513a939e0d78cd71bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengltype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "668b0b206af285217d0f941ff7dfca164e068204", + "size": 68513, + "sha256": "9326f25c6208a1f2958ef24758a6a8d548aec3e0fccd953080ba35b4178172bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopenraster.pas", + "remote_path": "src/ext/BGRABitmap/bgraopenraster.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0a2522118a99b29de4214f0df7f85ec30ff336a5", + "size": 36935, + "sha256": "af621591b5a03da46860f7ae5f897569da6f12679956f150971e4d52752094c5" + }, + { + "path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "remote_path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f20568908d48c4dce4159f126e33e224750fd15d", + "size": 18047, + "sha256": "24a72dfded09742c76cb5a552fbb16a4406fad2b478dc79042aa1f43b96c53a3" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "remote_path": "src/ext/BGRABitmap/bgrapalette.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0836270fe8f9dffd6aaee36a9d6971273000115", + "size": 39386, + "sha256": "91c9a21037b7751741bd8d9368ef0c485e8af51dc5244a3180b76dd29a4e75d3" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "remote_path": "src/ext/BGRABitmap/bgrapath.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07bd6872ba4ed9b11e4454a52516d0ba83186c81", + "size": 97593, + "sha256": "b224cd235796b3fd86005a5e4b752765bbb01a87789c49ab08a01dd5d2ee011e" + }, + { + "path": "src/ext/BGRABitmap/bgrapen.pas", + "remote_path": "src/ext/BGRABitmap/bgrapen.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2d07d84b044394af6a79de2132a460a771fb67d2", + "size": 42219, + "sha256": "0cb9f96417c473d4a789ad45b01d75012ecf7572439945abab418bd41b63e63f" + }, + { + "path": "src/ext/BGRABitmap/bgraphongtypes.pas", + "remote_path": "src/ext/BGRABitmap/bgraphongtypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5e86ea6e5d3a7711358027f818fbaa647f44a16", + "size": 2602, + "sha256": "78010e120172e8d7efc7b8d6601a3935daa88ca0ddb57398b91d8600e1b5bbe7" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "remote_path": "src/ext/BGRABitmap/bgraphoxo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b9a51f76c54abfcdcc1657e38e1c48bbd1a8dc3d", + "size": 17642, + "sha256": "8b380cb0950f0d1d341b38d9c32f8fc2bd664051dcc46dcb43a09aa2f62ec18f" + }, + { + "path": "src/ext/BGRABitmap/bgrapixel.inc", + "remote_path": "src/ext/BGRABitmap/bgrapixel.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "82a48f6f4f2b3a9285e364910bf229663209c016", + "size": 25785, + "sha256": "cb19e11a998dce956f5d3d66a62b6ad337a9306235426cbdda779752141577b6" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygon.pas", + "remote_path": "src/ext/BGRABitmap/bgrapolygon.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78334656daf0dd4692613e572bd8ab602eedb78a", + "size": 57077, + "sha256": "3cf94340689494dd8f5c42c1c4b289c76619e050b8d2a8efef1a5a8c20ac8797" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "remote_path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "350b0134f920bd409a2669c3d261858617931272", + "size": 33482, + "sha256": "206934c6bdb0bb6257329653d75ec99b5e7b4f3a0cabf18612699c6dcd5f081c" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "91d569d022ebf8642c6f0023d7786c2880b884a3", + "size": 4445, + "sha256": "a0978804b32333f1ab385273b5eea2284ae3f6040d1eaa3bcc166ba14a98c31c" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "49d04354d6024606c3e1ed39213d972f99e036d5", + "size": 34412, + "sha256": "11e445c5f6c6d70e084ce985c2bc5eec59bb6c4e4de62926c2fb31c76fa395ce" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4978cc141addc11e35963a563aeafb7a9757df2", + "size": 6722, + "sha256": "189e6f2c8b7d56c328c87a906b3d1025b6af829050931c5d9e45a4a8d953debf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadgif.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadgif.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e14a03e7bac8360bbbf95e0138eda4feb8907dfd", + "size": 9515, + "sha256": "ff98829eeee4883d39f957baef90c516adce360f0a69b0b905149a0d09ad4c53" + }, + { + "path": "src/ext/BGRABitmap/bgrareadico.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadico.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aaacce9d54ec38710c5f771d175468d36981de4e", + "size": 4059, + "sha256": "a25d29c357d952fe42ab31706e5dd2317396d96c1a9aa956e7cb6d25e672417d" + }, + { + "path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "40d899637d8d977325e5adaffcb5df8ae21885a9", + "size": 1336, + "sha256": "a640eb3e41a74acd59ae9b295eadb2c5ab7c1573887331cdd22f8d64a13080a8" + }, + { + "path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cc0eb804db1b65ffc4d8da1ef35f09dad0a79b12", + "size": 11700, + "sha256": "121fe5c762326b4b4b3731141b8d7d5c8347414e20987b9031516b8fb7f849fd" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1f8493322f310e075a5d55f045fef8b6074288ac", + "size": 5747, + "sha256": "34dff1bd9257d040428fb61a56229d4d0860c51c87468bcf729c9dae97df6e52" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpng.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpng.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a65c61f771e9c0c2c211bf72046269c4171aee35", + "size": 42682, + "sha256": "dcd2bf8a16a8c5b18d36e3c2ad55109a4c5612c8c57f39427ff21050e8c0d0da" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97c237105c41eed0e67eb8e2beab3176a4556c4c", + "size": 17611, + "sha256": "5af0e7d5fbedb438c538483aed16b18a2186df4c5cd98938f4ad81de342e6fa2" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtga.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadtga.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "303b750d1f5f367b6e07dfb520a7a99e6a4ed42f", + "size": 4948, + "sha256": "538f2bf3c5ff8e49db9b8fced65f62ab8354cea759610175dbb2f66046aafadf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "99903644256cd7b210c6204ca95037c862e04259", + "size": 88027, + "sha256": "73d704e60109646566ec935a3ee16be1e813b53b0418fe08cd2fc9cfb1c20494" + }, + { + "path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a921f98db75ef644e4aca469c4683d16b683f5d7", + "size": 3683, + "sha256": "adfcd666b623755d1530ea4b0cfd57a99b354dab9f4fa8ae69fb5fecf86be556" + }, + { + "path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9b23abfa58e4aa2375673b86dec03b14fb33424", + "size": 1980, + "sha256": "0f63b0a79cbfbef8f444b9578f09595fb226776c83e2e676f5016f813ebe142e" + }, + { + "path": "src/ext/BGRABitmap/bgrarenderer3d.pas", + "remote_path": "src/ext/BGRABitmap/bgrarenderer3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d31f34ad041058aabc6459ed51faf6e9abadfbd7", + "size": 28247, + "sha256": "09dd98e68b0e69b9fb4f92d1b22ef44bc210680eaf205ee7f0efa4f2d6c83f22" + }, + { + "path": "src/ext/BGRABitmap/bgraresample.pas", + "remote_path": "src/ext/BGRABitmap/bgraresample.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c435b5d4ed1fca66dfabbc43db4fdc0c2979206", + "size": 50177, + "sha256": "95dbe34e06991df81414dc2a8557ae608dd51ac4a28273f03120793dd49d8877" + }, + { + "path": "src/ext/BGRABitmap/bgrascanner.inc", + "remote_path": "src/ext/BGRABitmap/bgrascanner.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5af3648c086bb67bab6f1ea96ba5de169d209ca2", + "size": 9784, + "sha256": "e93415954b1e354e3e5cd962af9a754ebd5d3ffcc0a4b5acf70cd0fc521513a9" + }, + { + "path": "src/ext/BGRABitmap/bgrascene3d.pas", + "remote_path": "src/ext/BGRABitmap/bgrascene3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3ca41b84dfa2e5a6e163d2e06449256182fc76dc", + "size": 47272, + "sha256": "a112f0be88e33f9aa1fb826e70da7c0e9c33732eb9eb66a5bd9cdb038556267e" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "remote_path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b06e33bb74c6534278546e79685c10505521349d", + "size": 43543, + "sha256": "d51ddb17d5536936523c5214513379fa64c0800ad1434c74f1283fdd8662ad7d" + }, + { + "path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "remote_path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3884b0c1eff8550874587ead4c365061743369a8", + "size": 26153, + "sha256": "e56fd004c3bfb7598183cde3effee44997265c2164d1bc30d09c8a805ebe0309" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "remote_path": "src/ext/BGRABitmap/bgraspritegl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b97068e93096208579fd1e4b58229614006570fe", + "size": 15856, + "sha256": "0e727cf473e6efad2379a3b1385a62abff36c283712c62f5e4e73ecd21d77396" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.inc", + "remote_path": "src/ext/BGRABitmap/bgrasse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a52c86bb4fc7661ab1a96943ba32ef70cc47350f", + "size": 487, + "sha256": "8e551dd5dcc6844bb1e354cc6cac40843c23fd9cd00eb4c7f6a0d988a4882185" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "remote_path": "src/ext/BGRABitmap/bgrasse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "274229f587cd11e94db6b7d37a8f61ad5b0dd6cf", + "size": 13872, + "sha256": "8444b817dc843a1258b665ecf1daec057b26f58f42c646cc75811f9c83ad1df9" + }, + { + "path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "remote_path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75f8e3c9250ccc92c5e6367d6c444eaa2aa69e5a", + "size": 12915, + "sha256": "80ae6626033f3a18f77cc7685780191d1f658bca35886aa2e804e548b8f21313" + }, + { + "path": "src/ext/BGRABitmap/bgrasvg.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b427138ae73965064b57eb33c3a0ef6c1cfcefce", + "size": 44129, + "sha256": "e95eb0028b92a04d9a15b15faff5cf726e793e5dfadd6d635f117e22f3c9c09c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7774e3572fb262ff7734307522c4bb66ce3c569", + "size": 21465, + "sha256": "c1eaa0768f01913e9d24284df54e3042444ea3fdc5e9a0685692d7a33ec5d70c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgshapes.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgshapes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e048ec9e078d494bac9bce599e8b21549505f3f2", + "size": 140870, + "sha256": "46b588cf74cfa086d9e408ba0f7cffecafb14fc4a9026ecb3bb7e8b512b933c6" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgtype.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgtype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57ed4ee27cf2067ceca236513c64c8858e85138a", + "size": 76681, + "sha256": "0337579797b600c8a6dd8e52abcab46ea588cc5d37fd6ce89e11ce7dcbb4b1f2" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "remote_path": "src/ext/BGRABitmap/bgratext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "385b7829f8a24c0fe207584645c5fbe0132814b9", + "size": 66461, + "sha256": "1595e318a7e1d421c1b06318c108e09729774eb92530c043050ce14505511446" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "remote_path": "src/ext/BGRABitmap/bgratextbidi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "774d5066c6760fc47e45b4fce4fe0ed5973a442d", + "size": 121744, + "sha256": "10fa668c584faed9c50c7157a52ccfd9ab697fad1829710ec37fcd91284adf93" + }, + { + "path": "src/ext/BGRABitmap/bgratextfx.pas", + "remote_path": "src/ext/BGRABitmap/bgratextfx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8766deb1308ceec14e616b3052788530bad0c65e", + "size": 31347, + "sha256": "12213f525b0e2237eb5b0b6c0552e80f7ba8b6c09b14781d30e06b6177db8d1b" + }, + { + "path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "remote_path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ce1d7ec33a91831d85e6bd7d267d2d9a31d5eed5", + "size": 20446, + "sha256": "1b391877196e3a667aea8f00a3b2e3c011003d9739e66950e8fdb63fb665acd7" + }, + { + "path": "src/ext/BGRABitmap/bgratransform.pas", + "remote_path": "src/ext/BGRABitmap/bgratransform.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87b5e6c92e3105deceabeffb16c93cbfac68d98c", + "size": 59017, + "sha256": "19149aa065f5b787d8b510a88d12073fe6d45ad4dc9e33731db9990201e4abd0" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "remote_path": "src/ext/BGRABitmap/bgratypewriter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f99437c7ca70ad5f62eec1daf79742f6b06b9177", + "size": 40626, + "sha256": "e272de83a67af9c340a54cfe18eeef582fea954fdf333d9d787742a16b09c4cb" + }, + { + "path": "src/ext/BGRABitmap/bgraunicode.pas", + "remote_path": "src/ext/BGRABitmap/bgraunicode.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5962e71e403ad905d30bc7b44785753bf58b9c0b", + "size": 47822, + "sha256": "32553bdda3292a351aebbfd74637979060e3400578092c2cf69f96c93270afcf" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "remote_path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3686c1aab41392e776e8273268900d972e9e58bb", + "size": 36190, + "sha256": "d8f9732a4e7a7d93085a909011702346ffbebec4a17bd85f5656162c0f6b91fa" + }, + { + "path": "src/ext/BGRABitmap/bgraunits.pas", + "remote_path": "src/ext/BGRABitmap/bgraunits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27d469d9a51c25c2379cdcce728cb6cbaff7329b", + "size": 18400, + "sha256": "15bfb722add1f2174415a51608f43dd3f8e146f8f897819413b72e2af525d0a5" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "remote_path": "src/ext/BGRABitmap/bgrautf8.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8415793f10e2612bbeb9006acf1d27070b1dfbac", + "size": 43347, + "sha256": "cda37875ea73b304d2b88bf81379e2008541232b31e87a7b48ca37d77283efe5" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "remote_path": "src/ext/BGRABitmap/bgravectorize.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "300d5d2c3f2fac9fab725d371fdf88dcc5931308", + "size": 84171, + "sha256": "c41ba52c6f04ae1ce067173eb4c4500b33ee758d4384afcb322828a262b07c2d" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "10bc5fb04d035709bd605de8eb7046a7a915d1fe", + "size": 6682, + "sha256": "62da6d4ca3cd639b264012e38fc545898e2a2aadb6706620102987e0f585a0e4" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "remote_path": "src/ext/BGRABitmap/bgrawinresource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "478588dffe1f6eb93390fb9c8eb212eb1787cd57", + "size": 35365, + "sha256": "eacaac2de93b1187147f3638449ff213087c1e313b4e425bd5d09e0e1702a6da" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "42053aca74b6776aea38fc7febf5ac15e84a3968", + "size": 10268, + "sha256": "66d50f4d229e53c67d386a6adcd9bc230035765f57af9aa934bd6c6f22e07e18" + }, + { + "path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cff2638573af23ecc384eaba045437a3b34e8620", + "size": 12892, + "sha256": "76a653877fd337b900809a3857c8789251b930a968397819545c66425d74caf8" + }, + { + "path": "src/ext/BGRABitmap/bgrawritepng.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritepng.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4613e0912dd56745ecc34cf957199d43bdc9f00a", + "size": 25890, + "sha256": "740fbcecec0191531ac601d145e14e9d62590ea182d257546e34617678ed1cd0" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "060e1e3cb29a048c2a98e9fd41520ae1fb8ace29", + "size": 31044, + "sha256": "92ab6a9a785402b0a434296616645089241497570b070956d3a596437380ee4a" + }, + { + "path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05ece31d7daabce8f28631c5194524db468010c5", + "size": 2912, + "sha256": "770d303fbced5025552494a1286cdb5a3fcb69311f464871efe7fddbc39262df" + }, + { + "path": "src/ext/BGRABitmap/blendpixelinline.inc", + "remote_path": "src/ext/BGRABitmap/blendpixelinline.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "015ffcf0927151051e41a955fd0abc082b30e25e", + "size": 36495, + "sha256": "fbe549da3171fcdbca2f0215fd4762613c985e3cf8139001b79b5981ad3c3e24" + }, + { + "path": "src/ext/BGRABitmap/blendpixels.inc", + "remote_path": "src/ext/BGRABitmap/blendpixels.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba55e70235aa8ad013379a054d6f61d7d5576045", + "size": 12795, + "sha256": "af40c44ab9a07804cb1bb3040441b5d94b822c8d0a1481081bd59548a9a5c496" + }, + { + "path": "src/ext/BGRABitmap/blendpixelsover.inc", + "remote_path": "src/ext/BGRABitmap/blendpixelsover.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd9cc22d037ad2cdd88f96173022e9669f8c056d", + "size": 34331, + "sha256": "aca875536ebff11e627fcc9f11209b5a2f98d6213260e3476b253cb1daa7a1e2" + }, + { + "path": "src/ext/BGRABitmap/blurbox.inc", + "remote_path": "src/ext/BGRABitmap/blurbox.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5afbf6000a317bac9f061491a5fe77f9c3511898", + "size": 14225, + "sha256": "5dc9225b625ab0ae4dfd58565a98fc858fc7cbddd9956282a8fb07196095e7d7" + }, + { + "path": "src/ext/BGRABitmap/blurfast.inc", + "remote_path": "src/ext/BGRABitmap/blurfast.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f703facba323429614068f99386ab1bf79d27cfb", + "size": 7041, + "sha256": "5a318068a29041b76d44164388d5c16ba07fda338774f19b13fc3193e1230da4" + }, + { + "path": "src/ext/BGRABitmap/blurnormal.inc", + "remote_path": "src/ext/BGRABitmap/blurnormal.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0d7cc76a3a03f1a525b9ce427baae468ecf6987c", + "size": 7341, + "sha256": "9dbf42e5f87f63d71a1eda29852a5ff087a15eadeed1624c5cca91989fb6f43f" + }, + { + "path": "src/ext/BGRABitmap/csscolorconst.inc", + "remote_path": "src/ext/BGRABitmap/csscolorconst.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d5a6c39551a15f71d9822bf259ae532dcbcef297", + "size": 33221, + "sha256": "0412552b4677a5bd01cb7bf14178076b1cb95b9f4dac63a795f14a7dfecad0d9" + }, + { + "path": "src/ext/BGRABitmap/density256.inc", + "remote_path": "src/ext/BGRABitmap/density256.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd132a490dd5302d2160ed537187647172b6d376", + "size": 2787, + "sha256": "ee79f55f17a31c270cf0ae3b6c6bf0be141a107aa063ed424cbe2a5dcd0e084f" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "remote_path": "src/ext/BGRABitmap/expandedbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1c233685a0ae0b3278ff6774768eb361dea7a3c9", + "size": 24998, + "sha256": "ae72b8da6c2396c45cb28991ed7d50868845c58a095a979a57f930a0376f66a6" + }, + { + "path": "src/ext/BGRABitmap/extendedcolorspace.inc", + "remote_path": "src/ext/BGRABitmap/extendedcolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7bbd22a2421b6ea6c8a42f1a98b342d7ce2fff15", + "size": 46110, + "sha256": "5d1784ce5afb1546e139a71174bb5392c64db07067db6d21a77dc057490ca03f" + }, + { + "path": "src/ext/BGRABitmap/face3d.inc", + "remote_path": "src/ext/BGRABitmap/face3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bdfc208dacacc32730647fe4ce2c16abc716a40", + "size": 14735, + "sha256": "65ea855da052f1ac8d640b9276e4ceafb8c257b4601d17f33e4da718755bccf8" + }, + { + "path": "src/ext/BGRABitmap/generatedcolorspace.inc", + "remote_path": "src/ext/BGRABitmap/generatedcolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "feab5f4814ca9988fac99939381cb63ffc10e053", + "size": 302323, + "sha256": "e49bea00166d0318530b30e7cc6e08d3121c12c43a5b2d687cecc13c03db760b" + }, + { + "path": "src/ext/BGRABitmap/generatedunicode.inc", + "remote_path": "src/ext/BGRABitmap/generatedunicode.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a9845ecd6595b9e51fbb27600257cd4f47ac46a", + "size": 83613, + "sha256": "9a9ba635cc38fc3b3a94455339043a0a0b159b695724447acdfc3fd3608839e5" + }, + { + "path": "src/ext/BGRABitmap/generatedutf8.inc", + "remote_path": "src/ext/BGRABitmap/generatedutf8.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3db4178dc2e079a58bde0093fc55a2ead450591", + "size": 46513, + "sha256": "3c136e5e5096968905a7a29980fb53216df73dffa005f46b88337a8f5aaf6df9" + }, + { + "path": "src/ext/BGRABitmap/geometrytypes.inc", + "remote_path": "src/ext/BGRABitmap/geometrytypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e2d04b2f071810b5bf9eff981f6ecd9949f094d0", + "size": 57359, + "sha256": "ff86ae0ffc7885d4acf9161804837ce43d983db15917380320599409282800f0" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "remote_path": "src/ext/BGRABitmap/libwebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c673cd1a44a04a09eec2e6e370cfdb1cd4c01039", + "size": 30285, + "sha256": "4527c568f582941d92dbe58f5b81dc193cfff18ac103f56ba2978e43e3a53216" + }, + { + "path": "src/ext/BGRABitmap/lightingclasses3d.inc", + "remote_path": "src/ext/BGRABitmap/lightingclasses3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "409f22304530fc65f2b07c536b19c4740c385695", + "size": 5574, + "sha256": "d76d3245761857272fd9ca21bc84478933124831195196e06d3cadad3a64e058" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "remote_path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ce76e3f00bcace8ea18e6ea588cd08ab41ff8b0", + "size": 19460, + "sha256": "555770d86b49658d316f8ad5ae5dc4078a56e27ae25770bc11a9cf4f28b30175" + }, + { + "path": "src/ext/BGRABitmap/lineartexscan.inc", + "remote_path": "src/ext/BGRABitmap/lineartexscan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1724212890c3fbc2048565ab350b1f87bb63b14b", + "size": 2853, + "sha256": "46dd5af8ea12e1784fee7d31187f425703d3316b43e9762ad9acad1d207d7e48" + }, + { + "path": "src/ext/BGRABitmap/lineartexscan2.inc", + "remote_path": "src/ext/BGRABitmap/lineartexscan2.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0bb7c2331784bd1db6c1f50317950802f9d593ce", + "size": 1508, + "sha256": "cd2f14ad1f8854b856e183970ec5933066c06884c3c5853121d70e71f461dbd3" + }, + { + "path": "src/ext/BGRABitmap/linuxlib.pas", + "remote_path": "src/ext/BGRABitmap/linuxlib.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "623e4736cbe471d1bf5ac77c7459ba85d05e8203", + "size": 3605, + "sha256": "cfe50e39c0505753d5129d71af71da286d9ed0017e09324b2c83f3b161d43ef5" + }, + { + "path": "src/ext/BGRABitmap/multishapeline.inc", + "remote_path": "src/ext/BGRABitmap/multishapeline.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19ac4ef4f8870f63d51fa806d47aece0592754c4", + "size": 2126, + "sha256": "bb1f38a9671fa0c43216f70cbce72fc1c977fe705747369001d7dfa031695a18" + }, + { + "path": "src/ext/BGRABitmap/object3d.inc", + "remote_path": "src/ext/BGRABitmap/object3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "59ed8add0e6e3cc8d6aa8e559644481bff986571", + "size": 6911, + "sha256": "003a0ee32fbcfc2d7bac8f23352ef7a21729bf7546432d9771e9db59f2fc030f" + }, + { + "path": "src/ext/BGRABitmap/paletteformats.inc", + "remote_path": "src/ext/BGRABitmap/paletteformats.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5687200d3a2e2f316dd5938bc1db860503a6953e", + "size": 17848, + "sha256": "b342ccb4da609cf347240478e7c7114e7cb91efe4c77e3f70602a68a30d58104" + }, + { + "path": "src/ext/BGRABitmap/part3d.inc", + "remote_path": "src/ext/BGRABitmap/part3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "755d435398e4823e10a94a10f290145cd2163b17", + "size": 16528, + "sha256": "6edd44b457743c08743cdbb9c105025361145d3d8e44a6f83f51c48445d9ca69" + }, + { + "path": "src/ext/BGRABitmap/perspectivecolorscan.inc", + "remote_path": "src/ext/BGRABitmap/perspectivecolorscan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "135562691b4a3ffc5b55ea35393b10eb25e2c459", + "size": 3075, + "sha256": "4f21155f801a0a3344b7c862decaa7b005689d6150488ef19aca325272a09139" + }, + { + "path": "src/ext/BGRABitmap/perspectivescan.inc", + "remote_path": "src/ext/BGRABitmap/perspectivescan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac9686fc49a065d2950d1e761587b3be9b6c7921", + "size": 4322, + "sha256": "2c26ccfb9a5d064a2cbad71ae97940ba761720ce2adc4d68d1994bb0991eb9de" + }, + { + "path": "src/ext/BGRABitmap/perspectivescan2.inc", + "remote_path": "src/ext/BGRABitmap/perspectivescan2.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87d80f95d295858dfb394abe721efcf74be1bc30", + "size": 5945, + "sha256": "4953e2f64c4d823df9ed1929196dcd962ea273d46ef3b18753644dfbb2889659" + }, + { + "path": "src/ext/BGRABitmap/phongdraw.inc", + "remote_path": "src/ext/BGRABitmap/phongdraw.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4d771a2b594a8eafaf9715af370d00195421685", + "size": 8517, + "sha256": "9739b9bae83df5ceeef2cfa0262749eeebab5aaa536e8abeab8459225c4c0ced" + }, + { + "path": "src/ext/BGRABitmap/phongdrawsse.inc", + "remote_path": "src/ext/BGRABitmap/phongdrawsse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "50ffc255a7511614fce1c5b8cafe59c2005fb161", + "size": 3470, + "sha256": "2e34afbe1828b5ce2a1bbe62622e7c3ba756f82d7b8647ed50b19161c17f50f6" + }, + { + "path": "src/ext/BGRABitmap/phonglight.inc", + "remote_path": "src/ext/BGRABitmap/phonglight.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fcbb655e54dbc00e5fcceb986b0e64cdd4dd665", + "size": 1683, + "sha256": "08481c351d3d5c56ec8786647a60784d90959598af8f3752f130ccad974147d3" + }, + { + "path": "src/ext/BGRABitmap/phonglightsse.inc", + "remote_path": "src/ext/BGRABitmap/phonglightsse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e2bc7a4c357c6e219ee18cf9404fd99bc167069", + "size": 2412, + "sha256": "4457e442a15f8baeb77ef526d328560583c521303a6e900cd58e12bc639cc4a0" + }, + { + "path": "src/ext/BGRABitmap/polyaliaspersp.inc", + "remote_path": "src/ext/BGRABitmap/polyaliaspersp.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d20daec524c1c8599aa2841e95e91c8976a07585", + "size": 23271, + "sha256": "5dc7ed2e61f5b8b8b69c0f786b2f5062e2f79d7ad6d1692cd3cdc106b817ec1f" + }, + { + "path": "src/ext/BGRABitmap/shapes3d.inc", + "remote_path": "src/ext/BGRABitmap/shapes3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04bdd0d31f9bd0365dde1f1682abf6cc38b257b6", + "size": 2312, + "sha256": "9c706cda8f002d9baf738852bb7f558e31bb7a578143d1b83cfa2985f0766013" + }, + { + "path": "src/ext/BGRABitmap/spectraldata.inc", + "remote_path": "src/ext/BGRABitmap/spectraldata.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d464275083871dc396966bfe6d7f834a70abfa7d", + "size": 6413, + "sha256": "54793bbcf8b5f1d46065c475a69b9f23ecc3c411532156b405d0bf54bd5921fc" + }, + { + "path": "src/ext/BGRABitmap/unibitmap.inc", + "remote_path": "src/ext/BGRABitmap/unibitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbdc23bee0fb33caff0440f9b7803c6f9e99ed17", + "size": 153955, + "sha256": "5d381886a4c3f9cd32e4d9fcdab18586505e986cddb3a5fc845ad75d4eacd603" + }, + { + "path": "src/ext/BGRABitmap/unibitmapgeneric.inc", + "remote_path": "src/ext/BGRABitmap/unibitmapgeneric.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04fc32b6e9f84ae8ab71766a68437ba5f45e7255", + "size": 42303, + "sha256": "08b779d110da2b71422329c527a8845f0906923c5830988705fcfa47f223e53c" + }, + { + "path": "src/ext/BGRABitmap/universaldrawer.pas", + "remote_path": "src/ext/BGRABitmap/universaldrawer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e6e70239404ea0a86eaa4fd3416cb42bad1fe0e", + "size": 43452, + "sha256": "605d8b74761234bc101d4e7a9dc235cc38f015e5849f8f25ef041077ab1c8d7d" + }, + { + "path": "src/ext/BGRABitmap/unzipperext.pas", + "remote_path": "src/ext/BGRABitmap/unzipperext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b1e67d37f76203136c9b8fd5ae7f11080aa3cd4", + "size": 3416, + "sha256": "61c260971722e677351e149fdf57290e2188374a6a2edab0445f528ac3661a1f" + }, + { + "path": "src/ext/BGRABitmap/uunittest.pas", + "remote_path": "src/ext/BGRABitmap/uunittest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df2c3a89967ccb2125123ebf09f69945ac4ec910", + "size": 2101, + "sha256": "ea08412a967e0cfbc0ead495d8e68526484bb17b2c484af6942d21ee0125dc3c" + }, + { + "path": "src/ext/BGRABitmap/vertex3d.inc", + "remote_path": "src/ext/BGRABitmap/vertex3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bff9fdf2b9d02b141d3887b317009f2143d7dad2", + "size": 14808, + "sha256": "47256f31e0d2fa62b411ab576b86efba0b12fa1d431b87d1e63024102415900f" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "remote_path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74aae80da6f2fa727d77aad39ac3de0a0a424497", + "size": 24614, + "sha256": "b3a763eb96d6b279e65b9b950d513f3ddb72ba5bec9af117782daa0a5b10314b" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "remote_path": "src/ext/BGRABitmap/xyzabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8dc2a4f0d46c7469652259588d1354147b21a179", + "size": 19867, + "sha256": "b4a602fc84de79f550c09eeeb7dcd799ecb6f4623bfc6a513e548c2b8aa877bd" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "remote_path": "src/ext/BinaryHeapStub.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8746ed987779b2e9c72567d67bb422750ca4bdf2", + "size": 1279, + "sha256": "4ddfa7367023c75fd8ac5ad258ba28ddc7fac4ffde87b1d7f518aacc6d040d0d" + }, + { + "path": "src/ext/Delaunay.pas", + "remote_path": "src/ext/Delaunay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "10039e7417376892082ac5f40e5235f9a9c51b4f", + "size": 11171, + "sha256": "e92c10914cbee7ade58cf4859eb761322f6988f627f9885c29a4d58cb2b33637" + }, + { + "path": "src/ext/FastMM4.pas", + "remote_path": "src/ext/FastMM4.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebfda7eb94b8f6806a30497bd935159f5b1a05a0", + "size": 462243, + "sha256": "a2a8d2bc97c73db599272f0bb6e4d04226ddc543626a0ddce8e2b0591a6f7b43" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "remote_path": "src/ext/FastMM4DataCollector.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "00f06114140ce13de95e3c2be30ce5c48d676da8", + "size": 11281, + "sha256": "8deb144d5433dcee652a62f6d48030525a71a85673ca633ca31fe437ea04bac7" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "remote_path": "src/ext/FastMM4LockFreeStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60d5395eaec04f2a4edfca30dcdcae3d7329490d", + "size": 9943, + "sha256": "bb106644e3640b33951ad4a816401feb0859a2860dc9ad51c594f891a7ba594e" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "remote_path": "src/ext/FastMM4Messages.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8df7cf9e39e5a96d6b3d2e8c5f902bfc75d33a28", + "size": 7900, + "sha256": "11c8b6dad6834de17c6e5aaeb29398631d434d0e58f3151543288d21c5d64d83" + }, + { + "path": "src/ext/FastMM4Options.inc", + "remote_path": "src/ext/FastMM4Options.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f12e4c10a3a8afd63bb07d6f91e1a587503c2945", + "size": 20705, + "sha256": "621e2072c1222576f763b5b5453b1cf0fd66702af13f9bfd379a30599cac8787" + }, + { + "path": "src/ext/FastMM5.pas", + "remote_path": "src/ext/FastMM5.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1acf609e8c6bb69e4d6117eda09a6245322041bc", + "size": 397224, + "sha256": "abe54153e7fb403d2ae6fc94117df0398dc482f3faaad7318e97030199338896" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "remote_path": "src/ext/FastMMUsageTracker.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c5ec6d8ce65e24cf9b38d5a6d02b196456d5e244", + "size": 37720, + "sha256": "e0e43962bfaa95c85695c4d6868ce9c87eeaf585c460f81209e64046abe59c0f" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "remote_path": "src/ext/JsonDataObjects.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "111fdf438ddb774b595f1f656fa1bfb4598ff9e5", + "size": 234002, + "sha256": "0bcbe3302d150a237d96d9bac8652b5f58b0e995fe83593e2e947ff4c654f7e6" + }, + { + "path": "src/ext/KromIOUtils.pas", + "remote_path": "src/ext/KromIOUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de1bd455f8973e4afc588d70d6407cb89c64332e", + "size": 1114, + "sha256": "d9ab5b20f4915bebab9202569027d37311065b49d8e5c6429537ab85594ad9c4" + }, + { + "path": "src/ext/LNet/LICENSE", + "remote_path": "src/ext/LNet/LICENSE", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92b8903ff3fea7f49ef5c041b67a087bca21c5ec", + "size": 25275, + "sha256": "7a4436f9ec37603356791c87de3bc444989befd2682d29efb3d97604e04c1852" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "remote_path": "src/ext/LNet/lcommon.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8f9e38e85df420be7f71b7f84586777a7f58854", + "size": 13639, + "sha256": "39eaffa0245ed2d3ca3fa0caad773f4105b8bdf1aeb4fe30bacf941e845b98ad" + }, + { + "path": "src/ext/LNet/levents.pp", + "remote_path": "src/ext/LNet/levents.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8c072b0cc30ffdde7e1f3dda497121588edf797", + "size": 15489, + "sha256": "0d9230b9fa576d16c0b643aac951790245cbfb875d9f05a6e765e7333d39376a" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "remote_path": "src/ext/LNet/lhttp.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fcaa89dc05cde2b411f50c76810e04d7571b2c8c", + "size": 62386, + "sha256": "566d34ed27b878bca56b35f6b9208bf96b93a8186574597fac862fc00dc4d22b" + }, + { + "path": "src/ext/LNet/lhttputil.pp", + "remote_path": "src/ext/LNet/lhttputil.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64c629e5958cbbaebd14b2cfb768649459ad1d1e", + "size": 6896, + "sha256": "314f08b0fa3d0bb384a7d149966fc6c937da2ddc487b18e48c19582d766bbeb7" + }, + { + "path": "src/ext/LNet/lnet.pp", + "remote_path": "src/ext/LNet/lnet.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b3c2669e75aa36e5448a58a1c12b99e0ef4d8001", + "size": 48551, + "sha256": "fcbd9c318fd921154e4bbcfa8231c5c3d388568c06528b5d53b423f649550b05" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "remote_path": "src/ext/LNet/lnetssl.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78fcbc12438820deb842ace6df125bb2222a7ff7", + "size": 17587, + "sha256": "cc8564c5fa962f4dbbf35e21e07de594cb4427873d7e53d36aec69a4437d4c26" + }, + { + "path": "src/ext/LNet/lstrbuffer.pp", + "remote_path": "src/ext/LNet/lstrbuffer.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "47d6e9520534f373aa7220bdafbc124618156b90", + "size": 2857, + "sha256": "50fd2d41729d8f3f83261ca484f28ee95557bf993502332eb189196332aa8314" + }, + { + "path": "src/ext/LNet/lws2tcpip.pp", + "remote_path": "src/ext/LNet/lws2tcpip.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebe7f942e478b3f59e28974d7006b4f2306962fc", + "size": 1376, + "sha256": "6773352b20b0e329a1b7aadd77171c413a8825dc5aaff27534dc31a826055a24" + }, + { + "path": "src/ext/LNet/openssl.pas", + "remote_path": "src/ext/LNet/openssl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bf05c0df75f97aebb9c4ce701a6bcc24ec70d4bb", + "size": 54424, + "sha256": "b1c9f192e7bd7093bd45e26897577c2b2e77bb5bd08bdbcfe731a801d5d6018b" + }, + { + "path": "src/ext/LNet/sys/lepolleventer.inc", + "remote_path": "src/ext/LNet/sys/lepolleventer.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "71dc98081c011e71a27be1c69a98fdf413722dda", + "size": 6406, + "sha256": "c5222172a5d7728fdc025b93ae45e7031affee1e3db0850eafb65e1aa00fa174" + }, + { + "path": "src/ext/LNet/sys/lepolleventerh.inc", + "remote_path": "src/ext/LNet/sys/lepolleventerh.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "284d52044d3d066e33f4aa6d1b840ea4a319b97e", + "size": 976, + "sha256": "1128a092ae08be866eeeb7acf971aee78dcee1a53c9b8804e7bdf7d325a207b7" + }, + { + "path": "src/ext/LNet/sys/lkqueueeventer.inc", + "remote_path": "src/ext/LNet/sys/lkqueueeventer.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c75a1d24c8915c87af45cf965a2e38549f4d0f2", + "size": 3535, + "sha256": "180c19492bf08b523b399e903ea23d221bb86fd2b22d41591bc57a7555bc49df" + }, + { + "path": "src/ext/LNet/sys/lkqueueeventerh.inc", + "remote_path": "src/ext/LNet/sys/lkqueueeventerh.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44b2d3e1572a3e29947635ff1e02f980179edcee", + "size": 666, + "sha256": "b3dcb8158ed10d195a721becad766de5e3fd5b02dfe5d8e3cefb56b25c8f8701" + }, + { + "path": "src/ext/LNet/sys/lspawnfcgiunix.inc", + "remote_path": "src/ext/LNet/sys/lspawnfcgiunix.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "202623ea2a51a4055fb9d1a140af8ea8f3817e49", + "size": 1096, + "sha256": "f0464ca123d4069825e55d4c3212aaa8b670759a353d5abb837b0db21e2d5244" + }, + { + "path": "src/ext/LNet/sys/lspawnfcgiwin.inc", + "remote_path": "src/ext/LNet/sys/lspawnfcgiwin.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d18c166afb41b67cce6854f19a2f3521d75d904c", + "size": 122, + "sha256": "1dd9465557c47af1e5274ccd86de5c36cae99c7553940756a28176a1343270ec" + }, + { + "path": "src/ext/LNet/sys/osunits.inc", + "remote_path": "src/ext/LNet/sys/osunits.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "899b36d830d1c7c502d01269b0c631efec8560a6", + "size": 176, + "sha256": "597fc709c6a09008216e3e5a17271d901f6f7d3eed20b4a57867701fba5f60c4" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92026d2796a719828dc2620660cc938e33c4225c", + "size": 9395, + "sha256": "b70c37bd63cb1ce0475956030c392162006f3f62cb50522106c3185cb3f9f6c0" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "33a59a19dfe6e45b15864479275000d4e9f1cba6", + "size": 24982, + "sha256": "2f36ab0abb3afc0149ae7f7b28795b1d75f459553622f68f00b239784b17da10" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4dbc44f1043b6b902d62cc3ba5beef777f16cf9b", + "size": 7874, + "sha256": "a13e951a9880ed261ebc5e4dab089c0800aed7642f6259d0e5c2c2e4381b639f" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4968c442c4c093b3abd5241ea13a6d6060ef1277", + "size": 18802, + "sha256": "798e261d85d9b082283199bbd17e92c681a21790c41f8334165a57c0ba82600f" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/openglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d997f3e44abbaea15e7449800a5ca34e826d1a3e", + "size": 14521, + "sha256": "77935e6ede59b58a49f16c1216804dd00f6db55a0ede33aa65f8bd2f702d7abb" + }, + { + "path": "src/ext/OBJLoader.pas", + "remote_path": "src/ext/OBJLoader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "258b39a5d2e162b502bb3bf1e6e6a3bac154f60d", + "size": 7105, + "sha256": "b4d7b9b69340f49ab0ff0f355e29602c698e1ec17369c437bf08d00fc287a06a" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "remote_path": "src/ext/OggVorbis/Codec.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4026068ac2e1751df4b6c6b7e32cd4b4281e9fc", + "size": 10105, + "sha256": "7fc46937cbbf07b7eff475f628d4a332401773b31157fd6a478cb5194a1e597f" + }, + { + "path": "src/ext/OggVorbis/OSTypes.pas", + "remote_path": "src/ext/OggVorbis/OSTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "48ca4a7e749f86cb6779fd9a9984d6b8e0717c41", + "size": 4001, + "sha256": "a4e114f76cd1cbcbfb66e9f10d4751e296297d7aed79d0ae28ed00bc905b3cb5" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "remote_path": "src/ext/OggVorbis/Ogg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f52baa39c8aaebc6bc54c0f06c76f79a9bea6e1a", + "size": 10090, + "sha256": "be8ff9a75cc441c2a75ea3877b46217df64dc2584b98960a2f222f1932fe1492" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "remote_path": "src/ext/OggVorbis/VorbisFile.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba6fbff8c177e97ebc24738d9e876426333f8c71", + "size": 10397, + "sha256": "a39f27482017c08e601785db9b42dff85063a500edf9cab54a76494310abbbc9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21fa614dc29a9409b5dbe9cf18f6fce1f94f8040", + "size": 15311, + "sha256": "1f72177306ea85869448d2de3a0d36d516dfc5061b8006287c1c11661b44fa33" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsLibrary.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsLibrary.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4c2195536c96a2f453932940fd69d1bd301f726", + "size": 38672, + "sha256": "d92d4d52d8029edf4eb2819c30cdf21213acb1edad64c46d422fd3951f3a2b5f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "98f10375c25fcd4045f9549b693d521b73945618", + "size": 95390, + "sha256": "6364c4b9db088de4b479e6d7eae93d4331458702a7dae6be41369f5f3199ab2c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsWinsock2.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsWinsock2.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89442a7308faa51713610baf73f8ec424332bfb7", + "size": 12675, + "sha256": "1166499b69357cfd6c6264b358835da62a5b2d8260477ddbef120e15798bc5cd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b08b93513a0531e440509f5de6d6c2795c5ce13c", + "size": 78, + "sha256": "dd12fb17334453e25e5eeaf06ce92b056005d22c56c139b97ea1137711e61d7c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "01fc868491149f02c36bd7e2f978f1f209ab8040", + "size": 106, + "sha256": "206b6682d0988a7e44dee0533ded27b45077b5c256d568d00f2e97aa5f5005e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "29ee35ae72d3831d76885122cf81a9ddb507b140", + "size": 6384, + "sha256": "e6055b1423384962d1a7a97f6aacf528ccac11d3f70477cc2c61630966facd97" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef3369e46ff8b1e99a4043fa3bf960049a814242", + "size": 105, + "sha256": "343b424f7ab26f9977ee8f4fe9ba616d9235236099e3dff4491d392b943808f4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ada05b6cd240bf8ad8622f9323f8e3ff92998d39", + "size": 105, + "sha256": "1ed0d831429f679cfd76c89b4fd2dfb40c6cbf0d3d6e290c0e3318e77dd1972c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f2ac52e3ca4b24b4ade5e7fca386e63e3deff9f", + "size": 103, + "sha256": "03d0caf28e91274426fa9b44c61d1283bd49716c7302ab1f38512c8934da2e74" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21f895006f3a3c818c2f1a802587588c9b55fad1", + "size": 101, + "sha256": "d693316c1dec1b61af68a3fe7e0fc1ed25d9324f86883e4dcf4bf28c4cf713d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78bd0b0890f4e1a063137cece93bb6728f791e76", + "size": 105, + "sha256": "12855b29d577d3fcb2786a7f83b33874769cc0eca6a22f42ce5f843425b6f58b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "806de59645c909b34fe851933c2c800f6cb52351", + "size": 101, + "sha256": "30ef945f38e6653f3d2bed107dd3115c1f33c2a58c41867629a00b7e2317b075" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3ce5303fedef9fbd3fedb53b278713fd8beaa72", + "size": 115, + "sha256": "88e4199458d5f069657f2e342f0cb746082961ef90da46e0f43db9af06c9bfc2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3315480647560ba616d50dfe543c9ae2a4ded4b3", + "size": 107, + "sha256": "7bf4433616a679457cc2cf4fa4c36cc43e89b0ceb1cf36a3011fac6f2ebd8dd3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9a6ec9bad6e4a7cb6a0368a15d8a3b6a40277ed0", + "size": 105, + "sha256": "57e3e9730b65a70a562e04f81abe885eb69a040f58d60491bba44750f2b848d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ef352bbea18208bb424a299ca89c94788b0577f", + "size": 103, + "sha256": "4b809092149eb05201515dfe40e1f5d042dbc0bbd24eab2f74d92ffaf05adbd6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "090e84ff9617f3bfdcc024be92b794c988ed4b94", + "size": 97, + "sha256": "dcef24718eca686ed66228d4601f9f676ff61ffcef2f856910f574962cac9bf2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "15065767730cca91b9ab00d9c0748d0095ef013f", + "size": 110, + "sha256": "57e6475e2905de258ec2f09d090a024a5b832bf5818e7c8b1d7718f4cf3efcae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5ce41c075d03a69d1017864c979afb97766ad24c", + "size": 106, + "sha256": "c8ce985d6bbe37b66b58bec9b3bb9d968b310fbec85d75e651bfbad91e62effd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0073bcd727e2868f6ca51b5873ac3c385f9b17cc", + "size": 109, + "sha256": "39bbfb6e7655c3e726b59689e2dcfde794fc82414df548958a2f700b9c792072" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5f41fbe168c02b9c057ae5bc50c593020a0f9899", + "size": 133, + "sha256": "3e5aad4729fad2f318a474a0c0181cb1c30d2f358ba7a2929c58e68ebb32397d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4a008667dd34943437af5a829deecb4358d61348", + "size": 135, + "sha256": "62a32da064ee05e37f074d6396800d78af12ef95d5e4e7a34ad5f4d9ccc42a2b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70f4bbca0222d1fdbadb82234a4fdab83ad1fe02", + "size": 103, + "sha256": "7f8842eefa5320fde9e6f4babe616dedf184ea5e412afcee4a8b73efce960ac5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c185ef0902ddb8c10b59d547ad0c7e05fa9ff2d4", + "size": 97, + "sha256": "6aa1a9e3b15be8ecc3d24e907c09f564a8d5afd4ae8f22c58ba09e48ffc350ab" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e0d387683ab5d3109b3be58386f782d36ef4b917", + "size": 105, + "sha256": "04f9fc4198c3d189351089f1940cee0feffabf5662cfb1209fe27f61b5024947" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "40dbd443d79bb27c591526bc3383b039b1dfdadd", + "size": 99, + "sha256": "4eb8dc78ed64bf150a0d7d3e486cbef17695d054c02f63a6ab9314235e55c8d7" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89c634c62fa331afb5467b7734ef9d023f79d55d", + "size": 95, + "sha256": "6a97679f6f68f34fd07a9dc7db6b08b5d890ce7562e9a5ab8675436ac60076d9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab168ec7a4924a06e6edc785d7408d5a67ba7c1e", + "size": 105, + "sha256": "461b5fba763c52b41900d1f7b0c9787ac2ae3ffe4afd69152e294a1b90b0c7ed" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dce5d10cd5f276eeaf47c28dd225ece609020b02", + "size": 96, + "sha256": "ce759a79460c5c120ad69198b4161d3fc2a3d4b069f75550540d7c3ed2fe1d92" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3aff4c795302a7e9340690c909a27dcad3a3ae46", + "size": 111, + "sha256": "b4062aed60e921f5f88072a41d35b768a674743079410f6cc5009130b6952c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4717920855f15348105eb05e0c32cb08ec1c6c20", + "size": 110, + "sha256": "266962ec2909e2214b89c0f153397b2422ce36d82bb3b0bdb1fb7a4aa862e27a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74500590489e53ce41aa7559244a15f214f2a95f", + "size": 102, + "sha256": "8abf5d9dd13a2c1282fe695cf729d1a2d92411611b4d2a24e0a7285131237daa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6f209a0d2fea5f3632472ac7c8c7addadc7028ff", + "size": 119, + "sha256": "2a0550a29fd2fc027c678fe258727d6dc5a5aa3b46937909d4d2a9893e458407" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e46b0e4a168adc07521d187fc24df1aa9c05b2b6", + "size": 111, + "sha256": "c7839ff2709acd77434d92c4edeb4021d451e769fdbcdc2cf890a10d452b1fca" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2847133f17bf056798fb512207e6a2c6649f5672", + "size": 113, + "sha256": "25f6158eaf56945485ba465590c0a94c2658a3c1d47184a0666f5c9597d5f482" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8feda41cb818f3075a38674a6bc00f98c727388f", + "size": 113, + "sha256": "6dccb49302aed73c8b72d42a29adf160eb9f092c71cf3ec60ceae1036c1a4e15" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5db099002f83996c7a7e385f50b69e2b4ff6bb10", + "size": 111, + "sha256": "ddbc6490da6261b0ce6b9cd33e593b99eb79a79f343456d8c23c207b11378bbb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3c72df89c9004623193f150d55a3661e4b3a450", + "size": 103, + "sha256": "68fec9883bcf87413165d90f15f2c1e31d7781348f1513fef9b62ad5a8208866" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c2c5de77c2624fd045943d109704f30f1e178326", + "size": 105, + "sha256": "e75def39c50a1297f2ee2522d6efe9982a09cea20ee02ab4944e62d99b463c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a8be7b2f1ae323ec09f684023e60c02e95fe4fa9", + "size": 104, + "sha256": "13a6f65a68e2a673df42ad3d30b40e43514090f672145f872c0600b723232307" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "483384cad75eeac76af1de3549c88cc56accf95c", + "size": 109, + "sha256": "8330b0ceec0bf313d79e0da9ae90bb3ccb4718df645f49ad0a7642e78b6d1e19" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19da15355c94dfebef7b3502486933b4b8253e1a", + "size": 2154, + "sha256": "b5a29564b440033938998414a79b9a2eef0d14eb2182572a817baad3166fb89b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2ccbe202c451c5a2bab6e4ca9b04deb270ccc7f6", + "size": 13625, + "sha256": "9761e21d6b1a839942345e7dd139c37524426477abeaf51aa2398f40c03b3169" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02a4a0d4879098422f0f870a695f1f886049d11a", + "size": 61812, + "sha256": "54b444d9e07d9d68f7d9a3ac0f5845ba3409d8247edabfb0e5f169d2faea8404" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d8a1fc1a5eb32e16a7fa14c4568388241ce0570", + "size": 2772, + "sha256": "2c598be617a37c1add99ffeec41996fa35fcb3d6e5ae58c8f520e03dcb5ae3ec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "587e6d5691c238bffb2d06ced288098729d931c8", + "size": 95, + "sha256": "20031b46870090e7f957fddf0bb45a026f9ea52bfcaffe481e555eb35ef2664e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/Ics.InterlockedApi.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/Ics.InterlockedApi.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e852d978d1bb3813e475bfea130978908be095e0", + "size": 1024, + "sha256": "c6357750de6f20581cf2cd8b23d7d9899d6b5b462e3c867b2ef4df45e3eb3802" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDefs.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDefs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d7bde881e13ef54deeb2f2bfa2e0176b6a4e0d8", + "size": 44239, + "sha256": "3d330ca9013f9181919c6cd4c59322b95cd23c9fbe1c3ba4db1c6760211a8680" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockImpl.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockImpl.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "306ef49afd6c02c2eea783cf80a10dc97eb74782", + "size": 4549, + "sha256": "fcc0e71a0545f69ffa84577793c7702bf8b1ad3b01a1ca1341c58a6b7c226531" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockTypes.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockTypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbc3d820a0c76c0bd175f4f8f4feba4697605cce", + "size": 17095, + "sha256": "11731c2902e1bf9e2571494caea2f70241222c30b54a8f17079ba9a2f397835d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsSslDefs.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsSslDefs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d88074d08917f887d7ba468d9dbb5c0dcfcb21d6", + "size": 2568, + "sha256": "3189696f3f54746eb2b27aa8f3a689bd2a6e13429ee5fad818c318a0f525ac2b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockImpl.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockImpl.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "abe7885b7b71f00397c0c8f84958293f71b7de42", + "size": 60393, + "sha256": "7c56dc22fde946b3937f446a3a3167c18a366c95748bbf1d4a0fb07c33326f6d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockTypes.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockTypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6462fcdb320a24731d9cfe1a7b5beaa7194720ce", + "size": 64808, + "sha256": "7ee9adcf09c3f8b7b8c96cc1860a7215a36da185b25a2b05baa8301d2046b790" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsZlib.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsZlib.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3cad555c3b100ba0f9a326b2870eaf63dd0fcd37", + "size": 120, + "sha256": "a170a6f6a60f1a800723fda3edcbb35732b65ead1e35d059a75b3dbdb00db83a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteVclZip.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteVclZip.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da296926b0f155068e9abf8c5bf8ed621716f5c5", + "size": 142, + "sha256": "ed445dad561b225619d3cf65364d9a0b6ab58de0c1eecea872ff121b98d2e90a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57bc81993ed75ec508c591ef681a50637d20ba64", + "size": 27796, + "sha256": "b4aae854cda922511c9ee40401d1da019d9bf782d75ecf74e7c070a4123f6ee9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3eb40efb769cfe00c8a5c28745f45e83d9c29bec", + "size": 31566, + "sha256": "1ac0904100394efb8635255b260b8bd7069f330c76255f6c992911cbde55a105" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de81771a8495bb856300919d80613bfced65a6c4", + "size": 6058, + "sha256": "663d1a2a59957c1d9b313c694a51df203efcc0b7134952fbfa057247b4057639" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75fae4a7c12ace41646bdda6fb9fa316a454ec73", + "size": 16913, + "sha256": "9b6a526fd0e2c0c21a4a6493a658d237bd955e8442a199741a5d5e1569f58d4e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c8517a4938a713b4eba5982a042b73468d046a1", + "size": 62319, + "sha256": "a5e0afa738faccd93c8f6cde79d3dff4d4e5ff16c763ca4f4e24222cbf2f8420" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb232d92feac65eb114d3ba36dd2ef7d098b79f1", + "size": 49267, + "sha256": "9cfb9385636bccb51b07ddcfc6ab571af60595620dd09872c83d35fa26102dec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e313e721a1f6f8b91e2df02773df8d007d819004", + "size": 20638, + "sha256": "dcb7e1c1eb44dbcbc156ac9d66448f4984150751849efd72b54a47f5852b4d86" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1cccb1beee43cd354766d70e7f01b68f434d3f97", + "size": 11911, + "sha256": "87375aaa6a1e6ec704c961321f0344f5d502d6994fec95778a401e5e4cc7d997" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bf73e102c7d1419da763814439aaf2f7ff7f5d3a", + "size": 78509, + "sha256": "8c505402759e73c6950db2bd13f6ca2e743ed1f7ece18087a5d553fc95c0c80d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b78c3609bd69371903e792b92d7c80c41b9cd30", + "size": 24978, + "sha256": "8aa0dcd2e46b5ba615050b6b05d096a3b1c1df60ca93069c673c42c0e5a1393c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0dfe224bd4557119b27d4065e5432d60a0e42563", + "size": 60260, + "sha256": "bf3243d9ea619459e0475715d0b61522f0e26d41414c8b21283abbb2193000a4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9e0d60240615cf396d8ec16d01ea50ad8fe12d0", + "size": 62829, + "sha256": "790d67557de9c21ec81874395d7e29f600e125221c776c99216397625052550e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3cf1a9b48d6440bd4fe83548d3c1ae68673e7459", + "size": 13751, + "sha256": "8643607e63d0de1d91460746524f1b9ecb353f5d9cef7f28e9bd5c6501b0300b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "344cd190beddb4d0f13e28e578f21ba86134a6ba", + "size": 27835, + "sha256": "acd76073ccba130040575f570480dfc0b09af328a2d5077c2e3eda10a9f64174" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "433eac4ea0f703f36f3068cca373eb772c6b2432", + "size": 61995, + "sha256": "60e0f29f471a0039ab9bda6b42fdb0a87abb182465653a49c1bc4b27d6a633d3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "eb528b0fee49a5ad5c156f8c17ca78493fe94a83", + "size": 20131, + "sha256": "6d7b6a65379613376cd2dd6a017acf55e42c601f4669f1498ba553a61bcbfcbd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb288eae0f3a75b66fd7740e8ccda57cc57cd228", + "size": 168473, + "sha256": "acba058692a6ddf1d4246a0695070124ee754b082d376fcdeba5edba0d51af6d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5f7f35ec71a45b292e04ad19652cce68fe50025", + "size": 132455, + "sha256": "3936d4cec42ee7f27f7f397c138e9d1acabdb75329b9d25fd1bbb450134d73b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c7589daf92a727ad1186f7f837160a77e1ee22f0", + "size": 126472, + "sha256": "230b46da8dc426b33fa2c657a1354720d0ba46f81729d4d0c7978b98ba374184" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ef33bc63b57e1559b87a0333cda0801454f51c7", + "size": 8908, + "sha256": "13d2851c095da4be09f75e97b19516756a14820ddcd5dea951ce67f2572d0116" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3fc505286b3e8dbcc2a080c526b02b044809f06b", + "size": 73723, + "sha256": "6a4674c2aaebd2159ff8ded98c0698e28c0bbc263127b763aa5296d88d3711a2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa153c27f9e3d51198dd4d5aa3d0b280b44720d6", + "size": 295204, + "sha256": "2fd0f08d579014a84f1a5a00a97c62524aacd8d67c7057f0cdbb01d6cec7e877" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d7f4be83e9e6d775370b98bf8f68c2a100349f3", + "size": 291023, + "sha256": "f5b69fa2e2b1e239db7cd3c5815a01a2f4527d5e4eff2ce5e45466c669141504" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4c9afa860b1519a9d5b53b629dc56aac9563aa81", + "size": 266425, + "sha256": "0959dadef883d7adc021d5f1d06ffa957b3f70cf9b49c91d709a29ddba6100d8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14467800c418784148e0bc894a878ba7078b3ea0", + "size": 271022, + "sha256": "c62b513334484bec24cd1474dd1a58cf1e108bd9c61d2369fc64dca321e07ffa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6dbbefc17a7dbb11814dd2dfb0d2c28171a207b", + "size": 405131, + "sha256": "cbfc639452178e3f830ed989305cfcde7d7d56443e3f027f53cc9de3aaa8f791" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e3c39592b0beb4c400797a5f3be55a84e976044e", + "size": 399437, + "sha256": "5a831104f822951faebc32f1f8f3ab6320cf47c86ce3a0a4ec17de7eafe3e931" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e4a18b5feef04ec934906ccfbaf3893a1c75b3f6", + "size": 19123, + "sha256": "17ac97f685024dc28ed3a0300f3d21f7fa4201ddc392b747f090fbdfce17a0ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "35e54af2f33f0d1048b9ad3816f66b2114bf1ed3", + "size": 76830, + "sha256": "a14deb90138af6e5c42c5f9f96becbf2e8c693bef5430d97a045b98e306648c3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2992b31c839e33cb32976b9aa5bfa47b64af81f8", + "size": 3442, + "sha256": "7ace47da9c4fe87841f9f2ddad8ef280a7306dbea8628d99b8ad48c021fc90d0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5500f0a91a54e9a2ea9e1fa473aca61e85532fae", + "size": 22119, + "sha256": "13aefd2775ec10f55ff09ca494232c35798f360b50e4728e23128e9bf00997e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62922a463482cb97927df7f7fdc022814cee5737", + "size": 66202, + "sha256": "03017368fc03bce13485b6a23a857f0a7caab3d8cee74fe6ec7943b82296e08f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e2085d0ec258ac70aa079588c7c53b64a42b5445", + "size": 66671, + "sha256": "be6faf61c70a51667673b5ce1c9621c17305ebcd57e2f8b753002a9062c5e041" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07b24a7faac734b5535a56723d6f3021f2424a27", + "size": 231930, + "sha256": "4fd72cadbc9969de17b275caf5c502e85cd2ea179a2a44a108eee080f1033bc3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f9ccbb7977e70cad05936480f76fdedaafd13516", + "size": 304775, + "sha256": "9067c6a0343615fd5438481897f228b3523b4befb0555cf27d11ff879475b960" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "36e960afcac51116fab75c4706b12426ba4fced3", + "size": 44732, + "sha256": "165a14b32c8fb978fd46ddf501347fb3986233b5d627dbf7d7aac5c5fd0c749f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be70dc40b7124070305405f75b016fdc00fd8c16", + "size": 4700, + "sha256": "6fe74b31302a7a641f78fda0a47f304185c7d3c158918a5d558403f5f859c7e6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afbabb6f78053d22bcab32d2d3a4cdb6d86b28ca", + "size": 19225, + "sha256": "d5a0528351345640893799e202b5066e1da0573e60d2c4f7a392090ea78a982b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80b1323946fc759ceea7922fe7f2a2ffad9ee616", + "size": 130903, + "sha256": "74f16cd4f578374290c4867fd95d9c92db5a8fb31b3d925316ec5c9ab304c5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsJwaWinCrypt.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsJwaWinCrypt.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d7fe6b7998052596240a619e04c89cd240b1adf", + "size": 759982, + "sha256": "5c0853d44eca11697d13377106a264a8639a8713a332821ebe39ddba72e0a683" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7021eb7501ffba8a7e0cad5418d8f2d6fe0351d2", + "size": 286507, + "sha256": "15688901949f9582c0488b19589f67ecd80930825b4325f939e7f8b860704ffc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e3de0110e8203ee2d88ef35f849372e73209f3b", + "size": 24138, + "sha256": "ebdf395fbda417a6ede38318cced22c8d8744dd2105ddd684932977a989f7d13" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cefeca803355d42f84b87846f5d2259731b9327d", + "size": 16286, + "sha256": "db07176659770505ea8b92c6b41689f7655e970ed2e0bc26c791657d251f4c5c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9094ad6f0791fdfed24cd0a8502209a8d11a0f9", + "size": 16143, + "sha256": "bb337ee799e48738a0050b00451c7666e3b30d0148d10ee0ef6cecca90834531" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "29da8be299d5ff4160e41b1627fdb15cd32a79f6", + "size": 36854, + "sha256": "58487efd63675f3a122f023b2f25d74f43e7e290f36c8e180713f58ad881c757" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9127e9bfa4d195c7ef6a3aab2fd8d7653af2afb7", + "size": 7267, + "sha256": "a3d3e2f79fe8d31b0bbd3c1ef2c908d46cc119639550acce4cda5cf551c72b90" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a16c2695762cbb5c929e9b9481bfa71f6aa690c6", + "size": 100197, + "sha256": "3dd9573c163f1cc64db6bdef216c89701423154e59d7d5df916c245b52c22a55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "595f93d9c0de5ab42d21ce881e6b7da4d75bcf56", + "size": 104014, + "sha256": "f9352e1cb2ed6ef15cc3573bf3d1bc5280577a3f0c357c3984198631f719f1b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "af0539ff24c367c34b206e3e52cc5f40cf56c779", + "size": 112184, + "sha256": "49709b3a055b214be38ab497f451fd61aad4614dba742ac23600bb5781df37b4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e11564bd2e45e95d211b7ad59b8b64fb9c0369e8", + "size": 26145, + "sha256": "a2d515d80e9f6a87abbe11d7b925a710d1efbff051ebf49c35b8ae7fdef3fb7b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e4b54eb2e0a7fb5924f01fe92f1b053b05d2d8e", + "size": 6977, + "sha256": "bdd1d592dc0c44ed3475705d8c4381ea36ba0370c0f07c3cba5936a876c7152b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4b670370dec06891bfba7db705b60d47700d8e2a", + "size": 40309, + "sha256": "a6b91250dcb438290476d0e15192341555d230a8dd1f74fdfee848dd4f9a4e55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab202e0927681a028584015c26c1394598b8581a", + "size": 33184, + "sha256": "46a68caf1bfe2f6659380c88db391583b68861666b835af3ceb1b3652e56e5f0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "998d540a4b57af022dd8e83c9aa9275dbc61f45c", + "size": 72059, + "sha256": "8bc3d85087bb226b5b425fd21c08be3c760a2a2762a61c647180e0b1a39054ac" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f5bb8f7264f25c648b325ece6a5f57b971f28cc", + "size": 42187, + "sha256": "4d4a5ca9433fc8c4fdfca91a76c7d5493860d79a526bf2b9d9e39b5f3ff2dd79" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ed74c46af05cfcaa2b3b6b71c8ec52717183a235", + "size": 31775, + "sha256": "2f89bbaa1b3af26c72840623733c8a04a90ef8b2c2902fd2155529a875ed02fc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e4072bb8d8ea5bc70c7ff111c5d132521b61f87", + "size": 37714, + "sha256": "5e81578f5bf5cb07b8fd007158ae4a270f8088838410038211803324f00f53ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5e691011a9a76bfbd3721edc678840f2b42655a", + "size": 26753, + "sha256": "3630bb13c10652ff0c67bd3ec598d793e72f8b9406274f8290ec5c8f65f1063c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d10499fbdfcfa02809932e4fec9b1cdb1d9c0f9", + "size": 105942, + "sha256": "effcbf293a5ba7b4cdc10e41a13430cb0e5e8c0453c12347cbebba472b862309" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1587a6056400334c0864874fe1107136ccb160a5", + "size": 200278, + "sha256": "41375081bbf51c3f025782c449c4814c157cd5c51697fbffad682fa1b31c0ddc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d8b2fb3ed16e8dc46d1c997f084b36ee07f8d5c", + "size": 11275, + "sha256": "a45c33d1313f5af09647a3c22f10749103b1960c9095a9b66ca74bc5e7a7beb9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0c16d41b2db0be31810ed106bff464b55e40c04b", + "size": 160309, + "sha256": "6625ec077abe4f1f85a3e056c77e5e7a543d4fcf00692b41a3fcef19178db557" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84c506b0c23682a0498a2d730ee94356474f1a17", + "size": 21639, + "sha256": "d1cefe3477b5c36780cf07eebcff263d59ed449da25ee605d4f625be413f1ea4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f94b43d702b13a1b4cc18980b9e6b7cf18ec03b8", + "size": 235024, + "sha256": "b2de10d146d93675c3a346a0265501879fbf3fb883ddfc95a50f86a8b2e5e1f8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3c64b94966319546623f854cbe8c9c4694fc65d0", + "size": 126409, + "sha256": "1a03c27d6e8b1b6c29087be8e7a9818304a456ca863407c9dd09cbbd9a3fe7eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28a53d56b7dc8b7a0aaf56bd6d2d29d4972e9739", + "size": 19332, + "sha256": "d8ac74e074546862e6d8ee6fddf64a1b883937a723456d8bd8336c5a7a0c547d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "237f1b30ac95a54ce4c487edfbaeb7cc73ae4b1e", + "size": 35052, + "sha256": "5add545ac759ebe2f3a2cbbfc37467c126e34c90c44e4c518e080f83c5f92cae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75cba21f0ce3f84c83fd51634bc131debc403405", + "size": 37048, + "sha256": "57e1b326d8ef48e9f8159c48fc612163080145d9485080b736df864de8ea350c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7022ae0dbe50e6ec8fb77794c4ff943c34b253aa", + "size": 20770, + "sha256": "28603f6c1127be61eca842fd4daf9a8f4095f3440ba8f77425d414ecb51717fd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "071d8a42a9c841c6411b6c98961df87ae847458c", + "size": 131387, + "sha256": "3468e31114d94eb728a9b470f0805427dd72e2e7631f7eb8e3dba05acbd1d79f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "904b7156db8079e87a189dac9ed06896e2b997d6", + "size": 42353, + "sha256": "05d3079526333b21bb54fdd036d0841ae0c1ff141dcb9a48f183d0d637f0200d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb195e93074d64549419cab051cef65ab6bc1b00", + "size": 26726, + "sha256": "40b1fe2f3d3ae867390c32acdab66a4398f8da6d69598376199e744783c8a76e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1c1adf04503dac847c1a7d79675d85a8ab65b7e6", + "size": 11955, + "sha256": "486b4beab20a9d32839c9b1937fea0e5f8ac9362b8b594e5389799b75e0d851f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "220e82e89e51b74d387b99eb97623ab858c783e2", + "size": 358321, + "sha256": "029a4121eff064feebb568d7447a46e5427521b345f859ef76d868ca82594149" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "846063a451cb6c664eb199afe22589b2ff0ca94d", + "size": 208485, + "sha256": "452e1a5b7b58885b233fd57de613e9b644a70716238be879fac884e5796f8573" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5a281d9203228065da7b2dc8e686ba24c1e9272", + "size": 29553, + "sha256": "ba0c08245217978c754ef93900a2e61ae356b1e7ea883ef9dcdf46fde9864f84" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df2c7acd2891c94844b4f628c40ce73dfbdd814d", + "size": 98741, + "sha256": "d60f5d374e23e2215359e16ae976d6ba932ce069ae8e626e9575942fba83b6e5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ecb68649aa16c689eb0eb59936943a617ce5dab", + "size": 178996, + "sha256": "f3219c222311174df983f268964973b24a7e534b7331df12eb8decec5ce15198" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ae36a4454957d604ad64ba7e50b38987034a1ab4", + "size": 47192, + "sha256": "89315f9876432b97a9e7356f8fdacaab200cb64e681104fef39aa0db1c00194d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "45242ac99c11f996be49c5568604c18597449328", + "size": 9736, + "sha256": "43b8fd54f9546d30a8d46da870d7ef857734c3e46ee5c1abb97797a76ef98883" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "caf0f861dbe5a5116dfa8224742b6af68edcbe78", + "size": 6054, + "sha256": "ac3132ccd9912d229fcddd747e40ae73e86187b64658d83761d2fdb742ac375d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fdb41f313a48af2454130eb58263b7e0394a50d9", + "size": 30575, + "sha256": "d40fae9d684fd1af34db166a98bf4787258c929bf373523ef67f1fbeb07e2101" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a1a94be57583cec0d9f6bebe6f8feeaefb2dacc6", + "size": 19769, + "sha256": "6c6afe4f04fd1f8742a4e307484dead98346c13b3d9337e0808d78557218b6c6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64b9016bca2ac47f18fe9f92e60ea01243820e3f", + "size": 16311, + "sha256": "a378177382dbc86634dd12301f80b78f9c4879dd02c34000b0b4640ae5107ef6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3fe29f0e1467454a299c7b4c588d38b9fa6a5d06", + "size": 12918, + "sha256": "b7c7ab819390160a31853bbce4e08cd01579b442df8bb128a582794b4a3118c8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef8d73396ab51a60dbc57f886c54d305fc87878c", + "size": 27884, + "sha256": "87ef16537df829b90443667622495a4f3e6dcd433408f54b87de524eb7afc197" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd78ffebc578e5fc330ba409377662838d25a7f9", + "size": 32997, + "sha256": "ff1b2d3778643be10b7cbaf5e1066af73431345d4ac3ba505418074997928653" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "839184ebc9e2ba3bcfb213f009254a67ab6079a3", + "size": 19298, + "sha256": "931c7144bfe8d4ae18c8b81d7e3328a3f7c62dc2d4bcf6e2f059b5d4c89a9bdf" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab38fcd7ff44775d1d3d1352e6fa2b58490a93bd", + "size": 22627, + "sha256": "8d301cb6a919e314f98c7607b8d51c0bc27f8ceb90e0ff7f131ac9243f2bb5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "274777d4a87b1c0502023ae6e0f592385e7badc4", + "size": 4866, + "sha256": "6e46708c64121104dee351decac07d58ec5426573742965075df17ac530ea9eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "26bf0b6df02b171af06a7738656697dc70b02fca", + "size": 15956, + "sha256": "7d248cb1292253dc0d66b0f56f6d26a645b56ca5ebd3ca09cd5216e9d8438f3c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3dc05b5787e17389cdec211e367dceb371973432", + "size": 273868, + "sha256": "2257bf867c778ada2912c774727f88999f075a24553e22b480f4c7165ba2a62c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "11c5e187d0f7a7f6fc5a18cab40be2098ac2f287", + "size": 19014, + "sha256": "f76530186c4284d6c900bddda9ca36facfc027a664adbe989b713ccf63291c1d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e947c721434131e1f99c3dfdd62be1bdfc813ebe", + "size": 998558, + "sha256": "b6d725ad6c842d7b959fbe7806fdcdd574e9a275ce1a040cf8eee2e17d6aa995" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "41fdeab1932702b68f0d30a694251dce432db88b", + "size": 182216, + "sha256": "5f922c45ed0318bf2f8f6df4f147cc31b3a721a79aa3d5e619fa9cd0f255f36a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3946a6818e9b9d2a5d3908a66aa811fc75f0e962", + "size": 33791, + "sha256": "3bdc0bc3ef602f14e631fa3f489063064f859f0561c9ce4c0bee67c8a42e0631" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "178c6ad1ace955169962240c5a4788b53c4894a3", + "size": 38197, + "sha256": "96d1d3ca97a83b354349e211011548a6c6ed94f9282c8ac359a05f50b7dfd8aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4bdf7ce39b88edcde1fd22e99bfdfe3aada104e1", + "size": 43367, + "sha256": "3a9efc509d9e37bf3f639e41881c89ef556400e6368877ccc45b0fab741f517b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "321d735a8bbb2e4c0c0d2127c9495cd900f846b4", + "size": 24982, + "sha256": "9b886e915f8e2b1df527b4ca5631b9d1db87c8564361c9e6073cf6c32fbaf958" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6acfc4060332803221c6bcfb5465fd025c287d4d", + "size": 1875, + "sha256": "10c68020813071d15e8e4a9e46a88cd4d272c623da9b0be4ce272cf073d5bd47" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6c8ce0770e3361ffa2e5976394aa0222a40ac5a", + "size": 2887, + "sha256": "a8294bddc54129f3e60fadb7226641df86f487e5d8a56a3fca1c066a004abcc4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9af2485bc0008cc1e40ab282ad45ebfd82751c54", + "size": 3105, + "sha256": "bd23e45e963fcfc99b25a045ae86c2fb0d5889ce1b4b30f0f449f73d83c8904b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e1a17dfc9af1854a191bbaf982691305c5542a5", + "size": 52766, + "sha256": "f5d91fb576059bdfc8acee81c10906dc79e66d4ab09c203a2de354ae4f86227a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a553a161c4c5fdfc7931cf5d9482cb6d45a686f8", + "size": 54415, + "sha256": "6d9506866e043fa89ea468926f3f9f755379e105171a6dcd93ad99d4cd868574" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e14801f62fe4a5d33c032284b303274250c68b9", + "size": 49350, + "sha256": "035484e15dea85575dd84bfa029b3489323813042e7d31dfe3e6f717e8e3a7aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9f0e67f8c0e56745d03d9311dda98324a79fbc0c", + "size": 24535, + "sha256": "7e92825530ef236fbb573f6f31a987cfe373403ffbef798afd5a3efb7ef69af1" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7a8c062e98ab3b1ed55719fe9c48497fb50d28d6", + "size": 16261, + "sha256": "be45cf073b461d50eb48fbc60b1d431a3824f72a8e9837ef3e3ff2cb2706f466" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3502d630c0101104f78ccbad71020b1a1da8690b", + "size": 197378, + "sha256": "3e45ed1dc8d27c98528fc31d686b4222db2771fe9c0c14a3dafd030bed1734ec" + }, + { + "path": "src/ext/PolyTriangulate.pas", + "remote_path": "src/ext/PolyTriangulate.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0eb9c182eddc5e6395ab9f589630a5d0fe9a39de", + "size": 6729, + "sha256": "380336f351e463e5607595d48b98d8916e7d14d0e94df2bd7c531c47b92f9077" + }, + { + "path": "src/ext/SciZipFile.pas", + "remote_path": "src/ext/SciZipFile.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7414f90611e3326507b9b0f05709b1009525b745", + "size": 18445, + "sha256": "e39beaecf1b7174a3774964d173ec80f25f5ef6c036c3a32a914a854cc8f263a" + }, + { + "path": "src/ext/URLUtils.pas", + "remote_path": "src/ext/URLUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fd2830ea4aa35a2914e155e9b2f601a78594ecf", + "size": 6732, + "sha256": "3bce1126a2b8547aca95c366babfa9db145922e4b6576da0948bbefc5c146d9e" + }, + { + "path": "src/ext/Unit_Vector.pas", + "remote_path": "src/ext/Unit_Vector.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be148b7895831909886ee03ba14f3371dbf81f94", + "size": 4308, + "sha256": "b88682b36d965bdb2951c3dea1cd587fde44e7055dd05188c6c4cc4cd62cbaa9" + }, + { + "path": "src/ext/VerySimpleXML.pas", + "remote_path": "src/ext/VerySimpleXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7c20b95c2f271cb2ce8d1c1ee3c5a4cce9541513", + "size": 16766, + "sha256": "3b153f03089fbb90f157528347f3cf60c0971f8df13815880189157f3abd8a4b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2e7b403a690bcef3c3b501352e28c8b0b0a41b3b", + "size": 30775, + "sha256": "234607f0027f9c8ebbf637c256c69c818e1d1576ae96435e9396d8e183ae556b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "308fcb61a57e0880f970abb4887ea90b3921b519", + "size": 6324, + "sha256": "43d95802b43dfa2bfb035009f80d74b824fcec5b2cd4961907120059378ee2db" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "03f06576ea653e0e507e0851c72b5b2aad333c1a", + "size": 9061, + "sha256": "1b9e32c4419d5cf4fd668d13303a04a68006c42febdde601d0944f8de4714feb" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d73b1585f8d3c372d16c9688f969ffd689ef8d3e", + "size": 6336, + "sha256": "f07cffcd7e54d70b406f15a71456b8de6247527768e814907a5a8d4be5139e6c" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c337e9ce37e67e29bdd123bb374163eba4046f3b", + "size": 13891, + "sha256": "1030f597d856414eb4c480a2ccbdb72aac23c61ff18919e173c4c0bed95f0705" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7b8edf297c2711c8fa1a12df503ff0dfed4a6c37", + "size": 36746, + "sha256": "8a236c433d684953743e3a4539b3c4db7d171390c6f39a918f9980c83dd79aea" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9905ef6d3b1a25c7de353d2320f8efcd2212c06b", + "size": 10231, + "sha256": "5098dd30ed2cc428eec6f1677eb6e07a6d85e41b0ffd651e87e95f17318343f1" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14f5c872a3b50683b337dd5ee56ad99548a061d8", + "size": 29376, + "sha256": "7b2d726107c6c18dd99b9dbe58374ee14533a0af91ffb11e01ea7cbe53fdd92e" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8b1a88e39eb30be51621746cf884a448ee351999", + "size": 53581, + "sha256": "8854a85f819714f19b12d4c468d03fbf19d350d169b7948b4e6469a1d4889c47" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8516390f5704a53d03ef583387c2c83221cadf11", + "size": 6877, + "sha256": "3c6ea29dd509c57505d0fd3e7c50d210adce1536f9da1f5b8c8b9f6220cfe8d7" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9094cf731d5e78b41ab6da94f4b4db852a36db65", + "size": 1305421, + "sha256": "3d58b35ae7eaa827d3bc77b3a2e299bb2342e98e4444419df0e089bf8b38c095" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "remote_path": "src/ext/Xml.VerySimple.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fffcc36024452b1d58d75b6734005fc277729833", + "size": 53569, + "sha256": "279aef72202d42e52a4c10612ef7b194f7154d8c777f5113444c3f3f550cccce" + }, + { + "path": "src/ext/Zippit.pas", + "remote_path": "src/ext/Zippit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "453a71a415ac8486a8003619b2d08469ab89ef8b", + "size": 2936, + "sha256": "0386df013372cfe0e92b374167c450e7f9d0c558449739863595757f968fa45f" + }, + { + "path": "src/ext/bass.pas", + "remote_path": "src/ext/bass.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "edf4683c292a1a286cf42395b2452da516c682f7", + "size": 41826, + "sha256": "b740ea36fb588093af6b22b2ab33eb3e29e33c28ded1856bde4e4acc2a08fbd7" + }, + { + "path": "src/ext/dglOpenGL.pas", + "remote_path": "src/ext/dglOpenGL.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd73e5561ad288dc4433031546814c505a845e1b", + "size": 951621, + "sha256": "b9b08703333fc2172389dcd956c12a595bc50cf783824233f516faf60c17def4" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "remote_path": "src/ext/iaWin.NameDelphiThreads.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb1593700f70efeaf94e1e242721709472a3fc30", + "size": 2190, + "sha256": "889d02153be5dac1b9d4e5aa3e8e9161eb522a8c86c8295e291f2ffb8a55b1b1" + }, + { + "path": "src/ext/libZPlay.pas", + "remote_path": "src/ext/libZPlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d57ed839767df0535e711722cc172b7d18c00d6", + "size": 65704, + "sha256": "0865f4bca9fdf885585deb164fe87bf2f5252f38649dffba998863cca18ca40e" + }, + { + "path": "src/ext/openal.pas", + "remote_path": "src/ext/openal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9765cad44380dda71b7351b992aee59395251492", + "size": 90857, + "sha256": "74911dc018e4b2672e983af7b45706a65ab9ca890c708cc2dfead0f74f0acd06" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas", + "remote_path": "Addon/DataAbstract/DataAbstract_Scripting.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "00e57197bc916e0102ef012a1e3840c7cf5093a1", + "size": 507, + "sha256": "a13056931df7a40bf08a8beeef53684083199dd25234bc4bcae28c97fe84f7d6" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting_Reg.pas", + "remote_path": "Addon/DataAbstract/DataAbstract_Scripting_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "229cdae58d6b3edafb52a0ffa88ca5625f1243ff", + "size": 978, + "sha256": "78e52813c56c4afaeb05628edea1a1c6a835ff84ad2cac033b1736c9400e6bcb" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPSScriptingProvider.pas", + "remote_path": "Addon/DataAbstract/uDAPSScriptingProvider.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "51035c7738a4a519e523a57226e02d7c3cababae", + "size": 8153, + "sha256": "818323c63a63f0f0022b064b23341ff72bbfc73b757e6a0b4d3199bc2329632d" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas", + "remote_path": "Addon/DataAbstract/uDAPascalScript.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9c39c40c35f269c633ffe0b54fb0ac8079c5144b", + "size": 70025, + "sha256": "c4760d042df751c1a0492ed7e7dff14a4876344723f176853986a55e752c0829" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/PascalScript_RO_Reg.pas", + "remote_path": "Addon/RemObjects SDK/PascalScript_RO_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5cbd63aac19c9636e47040d11d22b6fbb38565c8", + "size": 709, + "sha256": "01c18202d532e459ce8033780c056c37ee793c942beaf45e78501c03cbb13949" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSImports.pas", + "remote_path": "Addon/RemObjects SDK/uROPSImports.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "adbf14de4e76c4902b4be510feb74fdf5a0fff7b", + "size": 16323, + "sha256": "2b80e21f5c803fc2495f5fb90126080ef50019c1f0abb7f4386481a2ff37a4a1" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "remote_path": "Addon/RemObjects SDK/uROPSServerLink.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "78913f32a1fad15227b400a11d9f3db521ef7318", + "size": 43778, + "sha256": "7c5face3a6422bda459244e95ac752d1f55e6917fd1422656c8f64bb2b631f92" + }, + { + "path": "src/ext/pascalscript_submodule/LICENSE.md", + "remote_path": "LICENSE.md", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3d899f86ead380c10eef85710794e2ad2a5adeab", + "size": 1098, + "sha256": "a08799bb2385a3af99a9bbb7c746d0ad9ac7dd07be0fb1473f2f4d1dc3e11bd1" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "remote_path": "Samples/Debug/dlgConfirmReplace.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cbbc6ca645346bda63b70ae713ce83a43c6ab8b8", + "size": 3417, + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "remote_path": "Samples/Debug/dlgReplaceText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5b3942614bf41414fd87d8ba8ca3b81c74f7e906", + "size": 3731, + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "remote_path": "Samples/Debug/dlgSearchText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c55ecb92222c583115a2c83756b944103dd7f871", + "size": 6673, + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "remote_path": "Samples/Debug/ide_debugoutput.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c25a91b8ec93382847142a40797aa19979abe0cf", + "size": 580, + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "remote_path": "Samples/Debug/ide_editor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0179a3daeab6d9a6c0316068a18831941ad89c07", + "size": 17361, + "sha256": "bf5b1bb780ab705c2690a52bb78e7e99c6bfd65a9344a34fdff296d0309976fa" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "remote_path": "Samples/Debug/uFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "remote_path": "Samples/IDE/dlgConfirmReplace.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cbbc6ca645346bda63b70ae713ce83a43c6ab8b8", + "size": 3417, + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "remote_path": "Samples/IDE/dlgReplaceText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5b3942614bf41414fd87d8ba8ca3b81c74f7e906", + "size": 3731, + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "remote_path": "Samples/IDE/dlgSearchText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c55ecb92222c583115a2c83756b944103dd7f871", + "size": 6673, + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "remote_path": "Samples/IDE/ide_debugoutput.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c25a91b8ec93382847142a40797aa19979abe0cf", + "size": 580, + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "remote_path": "Samples/IDE/ide_editor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fe212090ec67578068aef26405cc5c2324c2d6a2", + "size": 17321, + "sha256": "727cceba897b887b3bab0dec1e9501c5890c759f64cae87ab8af4b7e050947a8" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "remote_path": "Samples/IDE/uFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "remote_path": "Samples/Import/fDwin.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1f205391059c289ebeb424a6efb3558698205b82", + "size": 380, + "sha256": "21caf91d91756f369b7861cf6c753ed8796e8a3e4ba55f6ac88ebbfe8964f1ba" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "remote_path": "Samples/Import/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "36792202efbc409188745823d084326180da63b5", + "size": 12195, + "sha256": "91fe55b8caabdab661eae2492aa04524de0c6fcb3f539b4ab1cced353d987917" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas", + "remote_path": "Samples/Kylix/fDwin.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "12138dc92e541f5c58b665969b6d08cca3c5338e", + "size": 367, + "sha256": "282c45de20124f27a3723fa2d2f3d9cfb822a68b8ecc1a8373a31beedf643981" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "remote_path": "Samples/Kylix/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "49e8e3e2a66a933a6d2944d6acb0d57d665803f0", + "size": 8061, + "sha256": "19931b61c4a7c6378955ef4bf06603c622adee746a997da141b6bed54de4721f" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "remote_path": "Samples/RemObjects SDK Client/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c1aad1e91267ec802c508a59b131f7be3f9b8c00", + "size": 4816, + "sha256": "8fdd6c1d070778c395f7c0d8cff281a7d900b23288593edae1bfe2e5263ba7c5" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "remote_path": "Samples/TestApp/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5c5c82c8c6f19c1d06695cd648cee44adde8445a", + "size": 4297, + "sha256": "8e47412c1f2dbaf673ea12536dc8e3c1621b24fe451abd3e4f4d4b655f9d1180" + }, + { + "path": "src/ext/pascalscript_submodule/Source/InvokeCall.inc", + "remote_path": "Source/InvokeCall.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0c0c93109b4d8c0ced74663411a8780ff11660be", + "size": 9834, + "sha256": "d0c77e571263347235b52c3633ff6f72fb699196ed8a6ab5da0690f004c31fe6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PS_KMR.inc", + "remote_path": "Source/PS_KMR.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8f2a6a61809718b7a6b8d9c190fe24a9f0abe55a", + "size": 163, + "sha256": "39d393953e2df902b9f91ff8b78f2cd93e62fbd0b742380ac0c30b526cfbe54d" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript.inc", + "remote_path": "Source/PascalScript.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "53ec0f0dbcfc16cd94ad782ccb57a1edd9ca744b", + "size": 1848, + "sha256": "30cdd3f35d84ca117cfe287c18f2b394be8612dffa943929cfb844f20be7a5fa" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScriptFPC.inc", + "remote_path": "Source/PascalScriptFPC.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a6d19974211701d72ef4aa852769c916ddd86559", + "size": 835, + "sha256": "cde62d7e524f6c6b3f3e93255ee4004bad66b02fed241a348306ebbe4f550c22" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Ext_Reg.pas", + "remote_path": "Source/PascalScript_Core_Ext_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1a9de6eb7f947b9aa788b83677ebb8467d442167", + "size": 991, + "sha256": "2c876492e175fcc736ddcb3c36a49ba34e7219a2a458b1d7edfe270aa0158711" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas", + "remote_path": "Source/PascalScript_Core_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cd8742876113beee691b9f77f5cd75f46ca9c201", + "size": 1481, + "sha256": "ea0267f29ed3ba249941d93c6b2eb1d27e775ef143522f4670cd89ad88486fc7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg_noDB.pas", + "remote_path": "Source/PascalScript_Core_Reg_noDB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d7565127069853a807931da177d1637a19a45fe1", + "size": 1296, + "sha256": "e255cf6cc721ab596555177e58db85c8d5ab31a294281ba704c04887dcf5fde8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "remote_path": "Source/ThirdParty/uPSI_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "13ef81fe2c27ba15480112aa765fa8c9643f31f7", + "size": 54013, + "sha256": "07f62a8d9934cb82282422de5df54f197f14c47575dd4e79893f341ba89cfabe" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "remote_path": "Source/ThirdParty/uPSI_IBX.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6447534a4d14eccbfb2f49cc057cac8cb66f2084", + "size": 165927, + "sha256": "8431e9a2713661fcfc4857e60d06dce71f2a5da96d00edd960705ee94522e883" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "remote_path": "Source/ThirdParty/uPSI_JvMail.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "832e0b5a5d18301453401931d5d7944e78403e04", + "size": 25983, + "sha256": "4dfb493feaba7c2f6757f89d9fe194c5e25aaab6743637c0275937758f8e3d0e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "remote_path": "Source/ThirdParty/uPSI_Mask.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f9a60241b61701ca1aa42b759d13ed7d0a174cf2", + "size": 9871, + "sha256": "e9f2bdec9005bd4cf91ae7022a199592b0df8e3723d958f506eaee92545a3ef7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas", + "remote_path": "Source/ThirdParty/uPSI_Registry.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6763366598f92cf1c1f1e0731d1ca4afbf192592", + "size": 33715, + "sha256": "493f62590e76ab2189ba5243b21a467565f33bf9aa28ca4db5dd1ef2fb74c6c6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPS_ExtReg.pas", + "remote_path": "Source/ThirdParty/uPS_ExtReg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b0dec7a8e85eed46e975f66009a90f24d737a585", + "size": 376, + "sha256": "49ddf49276f0c540fb21d21f3c84ab627298a728088e7734802958203ce5c546" + }, + { + "path": "src/ext/pascalscript_submodule/Source/arm.inc", + "remote_path": "Source/arm.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e08b97d17e855b93dbf02a019cfcbd9c10c1c8a9", + "size": 13410, + "sha256": "3218a93d05f1d3c83b1d752239ec583e755bb6d6d66b65fe60e34dd3836ed6f8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/eDefines.inc", + "remote_path": "Source/eDefines.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c719c5cc25a046fd6e94d49927f7065c54de00ba", + "size": 21717, + "sha256": "d4e2a5775f85b743b66aebaaedc3e9a10c6e497f9ffe222e190781195c3741ea" + }, + { + "path": "src/ext/pascalscript_submodule/Source/pascalscript.pas", + "remote_path": "Source/pascalscript.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fa37a2bc141e6b980288727bd90cda6d3e58f8a9", + "size": 1047, + "sha256": "b66c7764bee362ef14418bdd27999ff14eb2217d7eda394a54892594b570dc65" + }, + { + "path": "src/ext/pascalscript_submodule/Source/powerpc.inc", + "remote_path": "Source/powerpc.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "aa864467c939a8848326c52aee01ba901d060a1b", + "size": 13038, + "sha256": "921935fa58417334257c964da67e82c678b7e69fd1cdbebb3e12657e61915954" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "remote_path": "Source/uPSC_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9aedadd9e4a0971d037fa951fb0948f9a1064f45", + "size": 36797, + "sha256": "33509c1e6ee6eabb7448fe4dfe55b89b6090d2b9bdfa423b54b189f9f9ad8e21" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas", + "remote_path": "Source/uPSC_buttons.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8b6f81066124bddcbb911931ba5e4a08765e0742", + "size": 3131, + "sha256": "08de3cc8079d30b6d6b3e47dd2e92e2ea78e1898304b6abdb1221544f694339e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_classes.pas", + "remote_path": "Source/uPSC_classes.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9cde59803064c3394636508e2070e14a013cfc14", + "size": 13760, + "sha256": "0ed291bab0d669e8cbdd588e9c545aea7f1ff5bbb25a55ce5eeac51da59ca024" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_comobj.pas", + "remote_path": "Source/uPSC_comobj.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c5385797385a4d7e8360599d2f2d2a0179873815", + "size": 1820, + "sha256": "50024e58966581d455eb7fc90240e4d7265389ed631793e63accd3152dc82ee2" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "remote_path": "Source/uPSC_controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c615cc968015541806f568f94e3f62df85dc62fd", + "size": 10717, + "sha256": "eb64db3fe484301bdd3a172c2c7ab78b3764a816a2376517efa99ba06783d4b8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dateutils.pas", + "remote_path": "Source/uPSC_dateutils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1b95673ff927fc849740e1696ae6cc5ad54e66b7", + "size": 1553, + "sha256": "fca566d883326ee3e4ba798e81561116284feb8a697476028ae2298acb16b20c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dll.pas", + "remote_path": "Source/uPSC_dll.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a8e2c0365d8454a8687acca1060c06d6441dc713", + "size": 4417, + "sha256": "1ec05a25c1577fd5c73c9cce8f63ddc2acece481f61aacd077f5bc0d6bd4c00b" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas", + "remote_path": "Source/uPSC_extctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "7b221df85fa0eb3b74028c1da0c880df9eda7d55", + "size": 15715, + "sha256": "d9719e519d4d9844e18c4bc0fed3e2624c78c52f02e8cf50947de963e49abeba" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_forms.pas", + "remote_path": "Source/uPSC_forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d928ac45da66bacdac75fdce8413a828cf386295", + "size": 12782, + "sha256": "5bf7ca978cb50ddf528fbc5da62490f8c5a87f695e158b548a61fddba8fc2664" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "remote_path": "Source/uPSC_graphics.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "969baf3e1410a1946b283b166b6106afb1cbac0d", + "size": 13449, + "sha256": "2915aa2f9d99993998729c34bc7ea94faf0853266aacefe13ef410ce5480af63" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_menus.pas", + "remote_path": "Source/uPSC_menus.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "85b42fca198ced5602d300b970e340af207e8c7c", + "size": 9688, + "sha256": "f4bc813dbe78c5a958060d4bd84878d1544ab2088ab802591b2d167ffdcf1b32" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_std.pas", + "remote_path": "Source/uPSC_std.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c8c297d20b5a4b95c969c14612ec1cc1157fe2e0", + "size": 2685, + "sha256": "a95312c178d0f9f14c3defc78703d91a1027c99eccca4fff9cc6419112dbebe8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas", + "remote_path": "Source/uPSC_stdctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b065a0acf1751891f42854d40f182d44c54ff5a4", + "size": 26746, + "sha256": "a3111007736e18519fe35b6fc905f0cb75d1782ff36bb3204046be88cb214b49" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "remote_path": "Source/uPSCompiler.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4d0dde2e9cb94dc512fe49766ca5156b8cb4bbf2", + "size": 486675, + "sha256": "7786a321e83285a27d3450751de38b619b45b088cd0dcf6e1e7cb73572820a94" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "remote_path": "Source/uPSComponent.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6b906c967e0ef5414e4226628aeb84eb30955832", + "size": 44086, + "sha256": "aa7450573e597689fa422a96eda6b2d62b883f9dca218b8a579ff4546f591abf" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponentExt.pas", + "remote_path": "Source/uPSComponentExt.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "76ce9fd1df6fe33b9f769521c18622b0a43cb52a", + "size": 30731, + "sha256": "62a0b0cacc48fb5c24a67cb1676e7a9fe9513c2db5e0dc70cd103c530e4c8c51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_COM.pas", + "remote_path": "Source/uPSComponent_COM.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1ae3533e7cd9bbd61e7c335e3c58082675e0d2bf", + "size": 752, + "sha256": "f5743fdcff6fbb0a792027a5cc573762686bdbdfab17867bf7ecd7d7e3752800" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Controls.pas", + "remote_path": "Source/uPSComponent_Controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fce7b2982355a582ab4138dd33605ef243302f5a", + "size": 1633, + "sha256": "8dc80a0cdde112b8a92bb60981163fe56134f52cc009a5a3cf7f51823520b16c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_DB.pas", + "remote_path": "Source/uPSComponent_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c60d06e635299ea104f21a7f4cf45ca10a9a91a3", + "size": 712, + "sha256": "4ea549d91073b254858bdeb8d09903c68a84febf0dca4328215a9a31f1664f51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Default.pas", + "remote_path": "Source/uPSComponent_Default.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e7508cf836e88340c4cdd237c95419e063570f75", + "size": 1939, + "sha256": "ff23706e887ad8c9abd907173f530c8f11142c0885910d946796dda3b24b1120" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Forms.pas", + "remote_path": "Source/uPSComponent_Forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "418fbb22ecc9a8e84944a40d4950eebee14881ed", + "size": 1435, + "sha256": "dd9956b4be17e2dd4a75da90e4f55e98c26fda3fe502089f30c7d43b354c25b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_StdCtrls.pas", + "remote_path": "Source/uPSComponent_StdCtrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9f92923452d1a4c267f092c1384ee0863f0b765b", + "size": 1555, + "sha256": "6eba0f55b00af6dee7ccdc7d213feb998f1a23bd7e26da4d2127f6513876c081" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "remote_path": "Source/uPSDebugger.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3f9f975ce3b4381101bb8cb8e1f8b30d67833948", + "size": 18062, + "sha256": "a5086a4dbe0583d2a318d488332e0d039df25d0c6ffe0c50c85865d6fcd8a9e9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "remote_path": "Source/uPSDisassembly.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8c5505577e32fd7de04213cf779e6ca927f70dbf", + "size": 16483, + "sha256": "232d9b77b9e6d176d110f75b179b68aef69c5d15089875e997bf1c36e6b6ae2c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "remote_path": "Source/uPSPreProcessor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "21c500a9439c1ac817ba17275a1e2fa5fa5e1385", + "size": 23453, + "sha256": "09b58f2f89831286fa0b450f31d023498130f9c38fd8a28ef7fed57af5eccaf0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "remote_path": "Source/uPSR_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a9d12414cb39f69aa745f354d93144e1db9cde58", + "size": 171962, + "sha256": "48a81dba4ac00481f446e3e8406c4b58619097288ac184cfd5242234fc8dc29e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_buttons.pas", + "remote_path": "Source/uPSR_buttons.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a2970beb6f2f82bf2f27cea874361185fcb7e2dd", + "size": 762, + "sha256": "590440b59f84732a6a17acc4d6d0a7ef6b0d4321e766427b8e12e5152c871fe4" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "remote_path": "Source/uPSR_classes.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f46f070fbb4ed046bb1a5df66f9ea8589acb9e3c", + "size": 38439, + "sha256": "58640751e818cb8468e55fdfba029db23778e542a62f19a84714c995759b14a9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_comobj.pas", + "remote_path": "Source/uPSR_comobj.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0e7856f3dc93af99c86379c7b3cbbf652d2da4bd", + "size": 3018, + "sha256": "e38023ddbb09e8f65c51dfc6fb21e46e0cb6792bcdbab07ac36a00767567cf39" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "remote_path": "Source/uPSR_controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "58cd497a13cd6a88d946d6e7b007cf12226ca240", + "size": 23211, + "sha256": "c2210644945f54f669267b1fde4b44669afbb200d9975af0de8abd402b16e1d0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dateutils.pas", + "remote_path": "Source/uPSR_dateutils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ce33f03adc5aecae425bac1180644aacad5cc126", + "size": 1863, + "sha256": "285e829ff13171413cc3320567078c4232908d9372a94fa92350ba403cbc05b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "remote_path": "Source/uPSR_dll.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "95c894a806765a6e1afa9345a5df5c3641852dd5", + "size": 8347, + "sha256": "435f1e5867dc970b20a603a9f5ba0655f9af0a913e02a38aa957d0c6cf5b50eb" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas", + "remote_path": "Source/uPSR_extctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4b7e5176d5e4724310c712565c54e8ccb2713e66", + "size": 8301, + "sha256": "7ffaa107c07ce594bea2bc32bfe76d92947f844089c829ce70d692b50e1d94d3" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "remote_path": "Source/uPSR_forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e94073952f8d6486baec56cb05bfed5c103033c9", + "size": 29741, + "sha256": "1583bc9529f7ccb7cb9b88a2dce6ef9a78304629be6cf2d9a8f1d2d327fbee46" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "remote_path": "Source/uPSR_graphics.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "05740c70f1bd181322aaf78e867a926e9e79ad65", + "size": 22328, + "sha256": "4c7b34c2272895713948ddddddc9e8e1b1c6ef1da5821f0d946c3ece2fcc4190" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "remote_path": "Source/uPSR_menus.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "823c1873c3fab23369ce3aeebe6628bbebdc9d6c", + "size": 37323, + "sha256": "731c62b6424573f5d6eebaea6d81258d1fed5ff6ba0548cb17304a07513efaf6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_std.pas", + "remote_path": "Source/uPSR_std.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "71fa54fcee371efc67c088df7741a97dbaf890fd", + "size": 5105, + "sha256": "5c655421e42de094ffd90fc4ee6052b6670cea9265d1f0319f96988031123c14" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas", + "remote_path": "Source/uPSR_stdctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0a89d5be1fcae4affd43e38773800c73011d4c7f", + "size": 21734, + "sha256": "ba384ca63d1391ed42b8ba54acef2104008b28f5eb3928c7bbcd0f5c0408a8d1" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "remote_path": "Source/uPSRuntime.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b961d1541073bf8e32063eac297be9e68e746806", + "size": 443956, + "sha256": "0f623b98e4f18b2d063b34e442da1f1b9e09ac436eab009ef69f9e651259a677" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "remote_path": "Source/uPSUtils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f36b0544c3b5500cf52b24decfd74c5405350b78", + "size": 39989, + "sha256": "35db0be37eb9c128ec9aabbd70db0637dd7cc0a67e5f0c9d2e82b4afb9d8296b" + }, + { + "path": "src/ext/pascalscript_submodule/Source/x64.inc", + "remote_path": "Source/x64.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f5f1f63af91544de0f853b3da3417d3cbe817fc8", + "size": 21662, + "sha256": "ec99655d32e44c692305f9c828dad5d779b9aba1300707a47fd3c52bfcf50068" + }, + { + "path": "src/ext/pascalscript_submodule/Source/x86.inc", + "remote_path": "Source/x86.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "957524de4d8c2c48f6f8747c100562370030917b", + "size": 28000, + "sha256": "2e21c9a06e59d0c069ed7552ad83ace222757f672d6987974359fef803c4efce" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas", + "remote_path": "dunit/CompileTestExtended.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e6ee3db2ec77c6dca027f7db98092aaf198aab16", + "size": 4752, + "sha256": "39b06302c6bc93c405d2735f26fce78de51a67bcc78c7b12cd1e394bb299c2d7" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas", + "remote_path": "dunit/CompilerTestBase.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "07f2077b41dffb70c5659b308122b2712e967dcb", + "size": 3595, + "sha256": "818a35c95c2ef09d388ec9195928925053277e3e66024ec05f119737f836333e" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "remote_path": "dunit/CompilerTestFunctions.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d8240bc0f55033635e9e5dcf892ae90ce8b6c227", + "size": 6374, + "sha256": "28e7cb7665e525aa7be2824d18f6f358a1858c2b30d9136ec322b0789693f9fd" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas", + "remote_path": "dunit/CompilerTestSimple.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dd28aca4fd057973f9e0b16306c4db743239d8bf", + "size": 10079, + "sha256": "4ca492d1f66cef3a0f68c01e7e6b644bd0a916fd82ea4948eff05b3f7124fad5" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "remote_path": "unit-importing/FormSettings.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ffdd820d2ca9e5a99f8d68b49d087c32ae05f4d0", + "size": 957, + "sha256": "424f9f28fd939f95ad8034fb5dea266ecce1125b3ef7ebd2e6fb1775564461c2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/Extendedreg.pas", + "remote_path": "unit-importing/Import/Extendedreg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "df1bacce56d78a64b3d94d352248d7af1260c50d", + "size": 422, + "sha256": "ebd72056b98d3dfd50aa34c502012cc7ea4e2e66b8106758d53d5816428e3a61" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "remote_path": "unit-importing/Import/IFSIR_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3c3bfe3ca1acc50ce9aba07907b0f13b8f74f03a", + "size": 16715, + "sha256": "dbbace9295e187ff813b291c2d0975584d48515f5a1516fac45a7c273a166fb3" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_BigIni.pas", + "remote_path": "unit-importing/Import/IFSI_BigIni.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d82716515d11212dc7a76320a3435269ea61495c", + "size": 24049, + "sha256": "8ec961bdff87dfb9ff232f65eef916146e7540d6de27e33db7be75f6426d0d89" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "remote_path": "unit-importing/Import/IFSI_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5bb4355ced4ea9aa20670b895324315306acc1f6", + "size": 37616, + "sha256": "d23e836d2392ca42add3540c17afcd9ad1f3f94a2b28a2c66f2bb098ea4e8680" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "remote_path": "unit-importing/Import/IFSI_IBCustomDataSet.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "45f858688da1d100facd797f7576db49de2bd32e", + "size": 21959, + "sha256": "1cd59a2d9e707e86f6cdf8548abc4539786dac783975bec3d6e1f1f17a33b9dc" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "remote_path": "unit-importing/Import/IFSI_IBDatabase.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "195509b7f807f0d03b352471cf8c4e96ddf2f7f3", + "size": 35181, + "sha256": "9e227b93a2c49a5f58b22b79de9dbe6927136f4e8eb3ec808a0083dc65faa897" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas", + "remote_path": "unit-importing/Import/IFSI_IBQuery.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dc9ba2ad305942ce2f5b44c6ad706a8e69f306f4", + "size": 8517, + "sha256": "87a349f01615c3ca7f572562eb0566480f33a5fdee670a1494a852353ca52de9" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "remote_path": "unit-importing/Import/IFSI_IBSQL.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fffcf246d72e8fd15fc6d92fd882442da47f77f8", + "size": 47419, + "sha256": "585347e5faf73bf67be2ceb22696e7920cffc60ec690f9fc673e1befb16b953d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas", + "remote_path": "unit-importing/Import/IFSI_IBTable.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4bc93659988da21433cc89f3ca60b92cb15063bc", + "size": 12675, + "sha256": "80a028fb513d627e617563f7d8da62be421d24131facc3fc8200c5c9b5608a3e" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "remote_path": "unit-importing/Import/IFSI_IBX.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "42c817df7e76c1354e9a16ed1a1e315a87968107", + "size": 106865, + "sha256": "2969a26905d8edcef1cee639b3af3829c25c7dfa04e6effb8a6680488a6bb502" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBXreg.pas", + "remote_path": "unit-importing/Import/IFSI_IBXreg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "742aab2b06925d74b70c6e64489f64041b759c67", + "size": 405, + "sha256": "2bc9e1182b32c920fd111b3b316772edb0a6566542426acf37aac9a92daadef2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas", + "remote_path": "unit-importing/Import/IFSI_IniFiles.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "567a7fb457810720833a65d7b22ecb5ff45ab8c9", + "size": 10667, + "sha256": "9480168bea8d8963e3ac27a4a16439ce164d8c91582bf71008eb4d132d5d8a7c" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "remote_path": "unit-importing/Import/IFSI_JvMail.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "74eb93d30eb7a6c90ab9758a96febd67e999e891", + "size": 18571, + "sha256": "3cd63e72e7de08f3d2d2543815db3bd2077e2b36a23708a407b6406658e19070" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas", + "remote_path": "unit-importing/Import/IFSI_Registry.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3b3965f36913fe86da520d429daf685245530571", + "size": 26321, + "sha256": "483fe4522702f68746698b52be3e3f4911e1e6a85afdf2cd93367f2e63baf725" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "remote_path": "unit-importing/Main.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8474813fa601a5700ead4e88f5e05e2e13f5b9df", + "size": 21708, + "sha256": "d0bfe338fc0f9ba9c4d0e7171c4eec5d4277d582ddc4141efbadbaa9fb8fd139" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "remote_path": "unit-importing/ParserU.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "968cbe7a1b4a3d11cca394b94c83d62c75faeeb6", + "size": 91575, + "sha256": "74a1569c56222c5889aff42b4f67d5ac585424b1d4ea38ea657a67d733464c0d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserUtils.pas", + "remote_path": "unit-importing/ParserUtils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dc98e3812a34f25fe0d357d8696982a5f08aaac9", + "size": 5532, + "sha256": "bbe75fd3f924eb5a00eb8b27c36e5b8dec8da7e94bd9fb0bdfa146b55a8b32c8" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "remote_path": "unit-importing/UFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "remote_path": "unit-importing/bigini.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ec1927dd0c1c10f6f999955cffc92c7b76d9d792", + "size": 61843, + "sha256": "6633906da3a63033810145f6ee36628de04b1ba6c51d731310b9717c11b558eb" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "remote_path": "src/forms/KM_FormLoading.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "276261221925d28180c54c0811e7de27a15374f5", + "size": 1285, + "sha256": "c6a209999c15aeb27e848de10886e5012be01fb139f11961f9cefbad8fd680f7" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "remote_path": "src/forms/KM_FormLogistics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db76bc33044a79c30e6be19b2543845126be5723", + "size": 28024, + "sha256": "b2dcd32a7100a129268de3069545cc371ab4f1f67b647cbca945c588201d7876" + }, + { + "path": "src/forms/KM_FormMain.pas", + "remote_path": "src/forms/KM_FormMain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d8443d377bb18a05836680ef086865f555d5004", + "size": 69722, + "sha256": "6a275a7bd4ea1de7dd55b97463be94d98c574a9c1fb400d3a47169cffcf0458a" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "remote_path": "src/forms/KM_VCLMenuHint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b9b7f375d33c6facb6480045b66378e0d06f2a3", + "size": 2063, + "sha256": "5c74b6baa98d06b64933bdd43d865a10088fc54ae7d593cc2d67221309dd6c73" + }, + { + "path": "src/forms/KM_VclHelpers.pas", + "remote_path": "src/forms/KM_VclHelpers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cc158f4a8ba6fdb0c8dba1b3458f8ebb390becbc", + "size": 1501, + "sha256": "12bdaa38199901fa4ae7027dc435a83e9c20dbf6e989636d981da9c5375343fc" + }, + { + "path": "src/game/KM_FogOfWar.pas", + "remote_path": "src/game/KM_FogOfWar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0cfc28cbcd6aaadefb16ad64a04fb97e0fbcf6dc", + "size": 17989, + "sha256": "59306563343380fccbc86e2d2efe62bf045f02e449043cf8ee38990f8c38e1ec" + }, + { + "path": "src/game/KM_Game.pas", + "remote_path": "src/game/KM_Game.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a271d05244e9c64b86b03288a4446826722b5fbd", + "size": 118471, + "sha256": "9ef4649cb0f32143fc65c7934d62e2027bbf3c6306cc019ef0498fcccbe2b0c8" + }, + { + "path": "src/game/KM_GameClasses.pas", + "remote_path": "src/game/KM_GameClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "beec800ddb59cdefa6da45b5018e5b949899e3e2", + "size": 3729, + "sha256": "9cc088909cd2563af531272741549c5babb23b2278c6da8425b1c4e1665cd298" + }, + { + "path": "src/game/KM_GameInfo.pas", + "remote_path": "src/game/KM_GameInfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5136bf0d919a3cfcaf096c52f868ac5dd8750deb", + "size": 8828, + "sha256": "4c1f0eebd8532898f9d68f8bafcc50a5ee3b5d2c2689b47c7712a2b8de18a070" + }, + { + "path": "src/game/KM_GameOptions.pas", + "remote_path": "src/game/KM_GameOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f27eb736b1dcdfb19536740fb11259a296ce8278", + "size": 1971, + "sha256": "682720d856a79f0555ab2ccf7cd48a5643bf426b109804cb27fc855682f67585" + }, + { + "path": "src/game/KM_GameParams.pas", + "remote_path": "src/game/KM_GameParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e91cd143f8316568ea61a0ca12ed12eff7e3ff4", + "size": 9289, + "sha256": "2a307759cfdd00c1298ec1a749f5ef74fd6e0b69639090155664e2cd001adb19" + }, + { + "path": "src/game/KM_GameSavePoints.pas", + "remote_path": "src/game/KM_GameSavePoints.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab337acee2fd4d19346d386e2b7ddeff6e6894e4", + "size": 10399, + "sha256": "098ec9c08b55597c44507d8f02e87af72837242c5243d9bc78184da4e78e2ce8" + }, + { + "path": "src/game/KM_GameTypes.pas", + "remote_path": "src/game/KM_GameTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "054e90557f83f4a9c16bffa21338a7bb3e8008ca", + "size": 2106, + "sha256": "f80ac2a918f00487ffea444ccc3deb1a01c808efe990f65d72ebbabc00709a88" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "remote_path": "src/game/gip/KM_GameInputProcess.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89e15ea844b4a313a20fe29b319ab7ca1791b375", + "size": 87058, + "sha256": "ae41b2b47d49b396f32b138a1ac87b4c5d5886a655c00ce485914dcc45e4467b" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "remote_path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a632d3c3bafcaacc53973f6c75da1e5ef1c0d9c1", + "size": 18232, + "sha256": "c20921151077c597c5bf3db808c90d4759272dbb4744d51c69591810ef64f4f1" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Single.pas", + "remote_path": "src/game/gip/KM_GameInputProcess_Single.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2938422075102d631f1a845b00b9f75f99836b2a", + "size": 3500, + "sha256": "7482ce9ecb27a14558dd790b4f65d502f5ceb5417f781dd4cf880a41b082ce26" + }, + { + "path": "src/game/misc/KM_GameUIDTracker.pas", + "remote_path": "src/game/misc/KM_GameUIDTracker.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f60f965bbdd61e9e57b3c57ae4bc96101e4612da", + "size": 1409, + "sha256": "adf82f90503043bfcb92c939154eea1167ddefb7886956997b7a7a4d09fce572" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "remote_path": "src/game/misc/KM_RandomChecks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f2587c6cb1631ac6560e7fd76e299fd8e775fda", + "size": 15180, + "sha256": "0d0dc3da175eed8a049314b3ad9767e07968f5f4f3545c6f13c895b1639c9e2e" + }, + { + "path": "src/game/notifications/KM_Alerts.pas", + "remote_path": "src/game/notifications/KM_Alerts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c65ca1a2c30401092972de9d0237e52a05ddd341", + "size": 11503, + "sha256": "6fce90e0268068266db379658abd8ba9f316668e3de19aa74ccb7e5d70cc9853" + }, + { + "path": "src/game/notifications/KM_MessageLog.pas", + "remote_path": "src/game/notifications/KM_MessageLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "23273982f81c3216f52dced0b3728cd7841a2b19", + "size": 4511, + "sha256": "1c5b0c9ffd4fc46cb6f8a1e6317a42cf860313054c7331bc023abb0e5197da88" + }, + { + "path": "src/game/notifications/KM_MessageStack.pas", + "remote_path": "src/game/notifications/KM_MessageStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd0785726b60b7fc397bc0e5eb7a5593424ecb0a", + "size": 4047, + "sha256": "aaeaffab32d810208b103c665f59237bbfc65cda10a48e7ad6b1497273088231" + }, + { + "path": "src/gui/KM_Cursor.pas", + "remote_path": "src/gui/KM_Cursor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84474ff7f365a8b8796069fa7c587fbf063143c1", + "size": 3015, + "sha256": "12175127b5ebe8631ddad6688d5673b9c374fb581a96089344b0bf3eb16c5e2b" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "remote_path": "src/gui/KM_InterfaceDefaults.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "58af0572d2c50448bc3f0fe1636b204afb866968", + "size": 22260, + "sha256": "a0d50f738f8d98edd7d4b501b5f221179ffb6461ca275c7f1018bf9c497ad33d" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "remote_path": "src/gui/KM_InterfaceGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb3d52ff882406616410eb88442b15bb47a1f1e8", + "size": 22193, + "sha256": "7094c9453fe1c60c14a19284131bc8cb660b8cf6a576c919d8c7f32763e78064" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "remote_path": "src/gui/KM_InterfaceGamePlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7f5655288dd0e212d7cb346eb6b93838aeff26c6", + "size": 173507, + "sha256": "51f6e9d7aef0d284f371bbc432181053fb99e32cab2a57d8d558d861e3446924" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "remote_path": "src/gui/KM_InterfaceMainMenu.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5cb910895289d94a82c06448c50ece4c831f647f", + "size": 14935, + "sha256": "178b552fe5266f6e019f65d0a1e047efc8f480d9a3ab2ee760d4503a97e71868" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "remote_path": "src/gui/KM_InterfaceMapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "43511fdbb9b98e5331581dd5715618d68ac84fc3", + "size": 55209, + "sha256": "57d1b71da4913bfb98b649d82aeca898afa5f6981b14e2dfc6efddcefee52165" + }, + { + "path": "src/gui/KM_InterfaceTypes.pas", + "remote_path": "src/gui/KM_InterfaceTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "52919c3f07f7701f374288ff5ea886d3c94985ec", + "size": 1394, + "sha256": "69c78ebb84c9a142f7ea5ad8d61092d8f77e834b289edc0b6a36eed1aa60bd92" + }, + { + "path": "src/gui/KM_Viewport.pas", + "remote_path": "src/gui/KM_Viewport.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5b4c6808b5d6b569bd6237e1c64d0918f45f1d06", + "size": 18386, + "sha256": "1e8e86031bc48181eafe6e4c23722b9d209e72271badd440b0357ef1c22bf3f5" + }, + { + "path": "src/gui/pages_common/KM_GUICommonGameOptions.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonGameOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afd4bb0a30a7a9beebe5f5e6f753f913aa3b5916", + "size": 2411, + "sha256": "2a7e8ac2538ecd8a92d10fb04056d0ff6b11710afbcb820a4976e5d18bcc8213" + }, + { + "path": "src/gui/pages_common/KM_GUICommonKeys.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonKeys.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "650864e8e972ada0164bc03480f79e72804d796c", + "size": 8081, + "sha256": "b94130b28076295779c2c94eaf810c17804932a4390204d809fdf27ba708cdf7" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da90a2e4f66898a4f174812d75bd87d754ff932c", + "size": 35725, + "sha256": "5af366cd96fad9a2ee53c40c38e89c0ebf26e88813bc3066df9ff63c386fa3aa" + }, + { + "path": "src/gui/pages_game/KM_GUIGameBuild.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameBuild.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e749cadf6c58fff4e8dc9744775c6371db3b13c", + "size": 6498, + "sha256": "c748e58b79e26989125e7eb9f8e621bfdd74edeb197f498548b9a16914da5837" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameChat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "72ee6b694e25f9ae099e8e63af7302a85522977d", + "size": 14382, + "sha256": "9f80c1dec9aae1c3f8edebba04b94b33ad612f142f267194320c044e03dea39d" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb4209f258adf06472807d903ddb3e15f5c2ac24", + "size": 67198, + "sha256": "cc9802cad40a9ab66a8409e3c6976053ead142c270496d143b92fb2ace22fd70" + }, + { + "path": "src/gui/pages_game/KM_GUIGameRatios.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameRatios.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5c694376558536751c08404cb072d878f45c772", + "size": 6872, + "sha256": "755d1105f530e6a6137cbb8dd8a3f5ca2667510186a21226e4b6089f227b2d28" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsMP.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameResultsMP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a1500b9713b3c89b1176b6bfd5fda3e268828204", + "size": 70625, + "sha256": "2ac186bbbc9495811c47b1a3dc43a4829ae38e599ab1305f01776c8edcb94bee" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsSP.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameResultsSP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5df636a6fdc74b69c1fbef06be43817e84c7298e", + "size": 19314, + "sha256": "6aaef193b006166341ca7f43084b2e2dd9bfb8863fe0fa2393fd140a9d18de43" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectator.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameSpectator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f17eacb8c71669c56844a79f529996ab5c7c6a77", + "size": 20298, + "sha256": "f51229f7be9642396017d6ed4d9ac51893a865f171b956f0bbd1f040d58622e8" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "51cbb3b0bfade3c9154edfe4674eed228df371f8", + "size": 21738, + "sha256": "72fe56ab58a3c94326118b37fbce63366989dcdb4914ea0b4b10877777860ac0" + }, + { + "path": "src/gui/pages_game/KM_GUIGameStats.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameStats.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07db9e1eb00639159695460641be7cd6378ab256", + "size": 9005, + "sha256": "8b1b8300d88d417f9840e3b3ed46281cc1d52aaf73a682d5346935313c3a7e3e" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b06b3fe603b6623ad235464a85662dfcc0e75da8", + "size": 23631, + "sha256": "89a4470690c6e274332c58f55c99f7a273728f7791a58c168db324e100122843" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdExtras.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdExtras.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3cc205a980842d88a32ec99b22bb08b01adcc92", + "size": 8714, + "sha256": "f303b083c4063ad683d10265473a848dc04eb816925f21691509f24088e40e19" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2516a3e8087632e221fe62c5148303f7cae20ade", + "size": 28002, + "sha256": "92c0101084dbfa0d319878afcd27e206ab3cc430415d021904a47d23e67318f8" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3425f99ed4a4965d65b4f00aa0589d9da19f37ec", + "size": 6670, + "sha256": "2d63150b9012ea81a554b4c245cff9242fcbeaa83b1d4bc6a6c1f902311fd6a1" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e7bb8a8bad514c51b171f8ccc60612621795228", + "size": 3185, + "sha256": "f34df3581e9a4d533db6bdf16827611f58956a99001fea8e7b489a5420bfc211" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMessage.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMessage.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f85c67e2158504379a1ea1d936fa9a9f9a0c822", + "size": 1931, + "sha256": "028fd25976d9284c26d820ab838a5891018f839b7af6fc1182bc7b3d21dac469" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c3a1ec7042180563164b18ef44159d9fd7ed1bd7", + "size": 15470, + "sha256": "62c0cfe1d1dee25553dddd85b5111d91dd35abe5d2303e49409744843761ec8b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7efc2a861a7f8dd25ea7e1a4ee574384a6e718e8", + "size": 6206, + "sha256": "b8c9351b29c066aac6bcea07e9ed018f002a7e6c39cbc7925e45d8648f1dec93" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f669863981d3726e373b160adeeb76e24ff4b18", + "size": 5537, + "sha256": "c99774b604a5a5153f4e55367377acca762c0608f44bf9931bdeafbcf163cb9a" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87f62e9afe0d9203d07627512f01ab30bec9212d", + "size": 10912, + "sha256": "ab9bff3d5bedb0eb816faf971f3a413e7d1d48417a27647659018fe5693af28f" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "748c848b406b23abb223404de25fa8d33d7d268a", + "size": 1992, + "sha256": "5bb2007e017793cd7c94b8eb867257e463144aa9581aed7f9110846591498c89" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ec1068e3d0bd6777865f326c4ef5c550216ae2af", + "size": 11122, + "sha256": "8d7df7d0358675c3a84fbfd1dcac5535f6199a0e23c4d1fb643c4f948e83931b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "317616aae370c7bf57698f25ef163c0b5e55b961", + "size": 4832, + "sha256": "4556bb419da69f4d923a940098aa5e077f13001490c293b68655514896c2a3ea" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e96c74d9353950bc0600535f903230b2cf10a780", + "size": 4488, + "sha256": "3233928be60ab53f1c7c316dc63b2debcc998f0c9501219861f1806a25eb69c3" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "091d6b8c04d30e51cdf6e5919f8452f22b099efa", + "size": 5592, + "sha256": "776536307fac933bbae5fb1f757b5e304085ec48a179a058183b45afd204c14b" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b9d2650951f57ea06460a461fa2e80499eab061", + "size": 17932, + "sha256": "f3f4d04a08c80a2a35198083ea8b20913c43543bb5950de4609e76f152392eb8" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f1c333d00c99c24c3b69db8788a1f399ff59d94", + "size": 17204, + "sha256": "e1724d0d2f42b6a0f394619faeb5d2a31231fea3741fa7ed8e34546f3bc42313" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fade1a898b028bd5c14d69e8a75872e672393578", + "size": 6320, + "sha256": "c8cd68da8b42c2eb92d2804bc7d152e7a1fbab097354e3ace47525f775acdd04" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a09ccfee0c421797f1c3adbf2e9a2700575e1d1", + "size": 3185, + "sha256": "15408970e02b07dd2d8db7a74de9bdda1faa195879fed33b576ea8ed8b08a7ed" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a07559f01b4465df832cb8e106c074a86666e165", + "size": 2726, + "sha256": "c70d4e8b31e56e1711e6911b20658cb8b75dd998c12b91f6fd0855fd1d4f6bf1" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a10d7e2460331706b236850e4b4f523ecb662b51", + "size": 7218, + "sha256": "6e9a4e9a3105946008334660d6dcff15b985e247774f9eaf6a5b943151a06df0" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0dccc56e1bbb780a6217550728bbb9fdc6df31f6", + "size": 7946, + "sha256": "413919cf15ce31f982bcb6f808f278d3a362981b243dd75d269389d9a40e398e" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a89455297a0d507b52270a8737f026b3f69f1472", + "size": 6666, + "sha256": "dc0151d1b94305b88377b8db1a47936d168afb01931e2404b42db89db33624ce" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0606c6ebe88520f26ab7f3eab11916c3b8362c47", + "size": 5562, + "sha256": "fa3db1a1133b269533bb2f308504b07ae50c223865a3a587ef4fa9fbdd003f99" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0edb9365bea62ad047e9c0161ca04f817a9e6fdd", + "size": 4527, + "sha256": "ebd7f745c057d3b19f5a160cb211e56bf1aeeaebb44fd25af3f5b0f4e1fa0e24" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "644009e1c88eacf7c29555a8cb65536a34027e16", + "size": 39446, + "sha256": "7d0276456c5349b6661ecf86338db38beb8728bfcbd00ca356457505f0bd70ef" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74b3a5704280ce1fbd6535304346e1fc6cabeca4", + "size": 7978, + "sha256": "2efa1f541575d06c61dab34f263c7efe5d08fd5d5d924714e240aef10c40de75" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a49fc3c03f2c515c6f66e1e6082a98a81180a0a0", + "size": 16572, + "sha256": "014b0fef20c98b96b121a5ec506fe8fedfc02b2f60b84ed805c20435a76a3364" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5e5c8490dbf6a536065d31d15a42151de9eded67", + "size": 9616, + "sha256": "f0c1d851dd8110e6b7a1d25cb443bf44c5e65c621b555b8eb5baa5e7e505fb6a" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e1939b36172116499a9cad502b683cf8f3a79737", + "size": 34296, + "sha256": "9f8434342a0a8217ec023a85fb758dd7327440a38a97d0214315cc65c5059ab3" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3c76e34ca206e392c305d05a3a4680773d5ae6ec", + "size": 3820, + "sha256": "54f06df611038063e7d6c22cd90b9f3275cf0bbc2674bdaf5f65846361ed6da9" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "079b1e11fb411ccf7a9f77e544e9935058fd6988", + "size": 10285, + "sha256": "99ad7e5230b1a5b9469cde8c827d89a823e43928581828d213a9017d670bd87b" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8c17261df287d098d9005cd5287dd155ada54f8a", + "size": 20618, + "sha256": "1f8dce92c15c2e0f7f099d90081330ec5d07d844c80d915243fce92478975e2e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTown.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTown.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "03cfec0b551b582908e43d012756896091fbdb1c", + "size": 6764, + "sha256": "39ed7da00173d763fa53fdba211696006c1cb3e954694fac1fdd03b85c60f8a1" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ddb00cb8380231c13b0c99296e07e90128efb0e8", + "size": 9768, + "sha256": "536d642adf2412d67f074cb3215cfc22e2c7fe8ccf87938abfd7ff85839b7b5c" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f4ff4fb54f6774f31c5720b4100b6515becf1742", + "size": 11587, + "sha256": "a3f7b451022462e86dc045a687c284142aebc7689a425564f3fda903e1a22324" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d59f262633c280ed8d7aaf57c264243ad9cb75dc", + "size": 5257, + "sha256": "35eb82c5b0e1c210c935c51e222b50f2bda5801f016c338516464b7a94fcc79e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "307fbc85ccaec51cd7055dc55bee6b1826a87944", + "size": 9090, + "sha256": "3916ec0311c56cc3b10f2de6f722f07b2764448f74da203972ee4f9823781c0e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "94627f28f07b4ff39d26eedd3bd60f98fe6e7253", + "size": 8046, + "sha256": "4564ddfdecfcd4164596c82529d9924d5c7df2adb7c41ac7bca8c3bc1d3ee068" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "760edbd3d2b4d1cc36ac94054faf5f505d3b7389", + "size": 10772, + "sha256": "52efc32a8dd36de5e4dafbbd947f52582f5afdd473966c27fe4139da4f5e2e3e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f15ed4b1aed8d14d77583e0bb3a3287d4b51d6a5", + "size": 7618, + "sha256": "ac44776a45470d62c49eab237f39be25a17523cb3da8b3accd12546cf9578f11" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaign.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCampaign.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a967146103871006f8de021d591ce703fd180097", + "size": 15801, + "sha256": "366dcd0135dfd16f1f8686b2bab8609ffa970344d97c336bac4302d44d8f8f07" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "39ea965601350d64f25ff4a14ad14a250a2c5d90", + "size": 7274, + "sha256": "6270892d766ba6e8203d15aa92060856cdef2cd0910ef3516385bc1b0c519305" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a0f16e735250defcd64c05b9e90f7655412a76a5", + "size": 4931, + "sha256": "9abd8d9dae44d33dd2a77da01a49318dba73356cfb4ae7dcb6c0c5305ff97f39" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuError.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuError.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e91203406655a35b0511b47df074cb6597ceba6", + "size": 1667, + "sha256": "f4bc468a574453e3c0e0a5c08c34db71be94ed9bbf315ab32c087125b815f3da" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70cb624d3662eabf224b50261294ceab7ac09fe6", + "size": 14848, + "sha256": "59adaf68c018247d819bc13c708c99710f098739afa8db9c0d3770464c7ec93e" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoading.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLoading.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1aefb53fa71e13be8bbd8545c3c5ae8fc7a07f5d", + "size": 1491, + "sha256": "60318cfc2f22005ee7804e1f3566a683df2884f92ce55e8eb43d88180fa0cb87" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "79938f0f9df1e3feec7c07bcb81f6001c5a15e10", + "size": 109280, + "sha256": "5be5b4305fecd19da683af525f57bbd31a01424659f599f3e6dcefb5aac4566b" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMain.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b5565089c1e4c66ee25269e6206c9c116435d622", + "size": 3778, + "sha256": "b9c6454041fa5063d24ea3bd5ae2d06144b777ca8a7304e3305405f66098e9e3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7d8b5a386e8fb5c5555cbbc69bd261c2b830181", + "size": 41809, + "sha256": "aa0647978ef773ce593032912b224504f4aca2e421e3ec7e40488278b8a46ca3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ad398693fba5f1ff5c5f94fb67f885f3a5035901", + "size": 40320, + "sha256": "801d9a989c7ac8a9a9376396e84fa60a6abb69fd27c0207d814058e3b3c62a66" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuOptions.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1a0947df094bbea8b77367c0d88a6b7cf063dff2", + "size": 2153, + "sha256": "8ed9e0e77f69879cc00f9ed9bf6fe701dd805e7b9911cca56a85074b40494d2a" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df72bce34ccc1628abd2f27bd8da965eebb5f85c", + "size": 19917, + "sha256": "1c1d35f168e4420583367ef6133e0d6ca7e0700d21185472a30adbbfb396ab69" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e36e2cf1799ee119528c08722173c4cee15d357d", + "size": 30925, + "sha256": "bb96605eeea055936fcaaa94848d6cd2fce8919619f5eeb2a7738216b7410baf" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "acf287285339383e6ee0ae959211e01ce3715821", + "size": 3642, + "sha256": "b7292927d337357b4575ad92864508f0c3a7b025fdde483760892969cdb89ec9" + }, + { + "path": "src/hands/KM_Hand.pas", + "remote_path": "src/hands/KM_Hand.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8d474829da644370be01b387d430df1e43540d6", + "size": 73528, + "sha256": "a04c1c320aab5a06be3cca604ce23653123ded6ba4376de4f312e219da7723da" + }, + { + "path": "src/hands/KM_HandConstructions.pas", + "remote_path": "src/hands/KM_HandConstructions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e7a560604c25e93213f29a603b83d48038ab65f", + "size": 39959, + "sha256": "8b5571c11bb2362371e216021e567046bb058b4777e5dcc32c851b8ca9ea45b7" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "remote_path": "src/hands/KM_HandEntity.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "56c044f28ab2cf046fd12bd5ed426d6d81943eeb", + "size": 7617, + "sha256": "37d23ef0b0e740a7365a81ec54fc591fc4056e57f76e11fdb8138df8f46b1390" + }, + { + "path": "src/hands/KM_HandEntityHelper.pas", + "remote_path": "src/hands/KM_HandEntityHelper.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1bb1e0027f93e3b6c5f9164903e8072245ea4d69", + "size": 1113, + "sha256": "29a0c72ff4b0e98031e662675117f2fa765509ced83b53a0f0ece79802ec3bfd" + }, + { + "path": "src/hands/KM_HandLocks.pas", + "remote_path": "src/hands/KM_HandLocks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba2d979886100e42c882914de0dd77694a4ecf5d", + "size": 4764, + "sha256": "e9990e0a665699d6210db57c17fbf8db8b4b6c012469916b1b8dd834422273db" + }, + { + "path": "src/hands/KM_HandLogistics.pas", + "remote_path": "src/hands/KM_HandLogistics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4b6e080492b08c5bbbd68d91c00fb8119f1ef9b3", + "size": 101325, + "sha256": "9328dc1176a8859a3f12f5cd572c05c722abf2b1822a2e9ed7c38002a0f4afb7" + }, + { + "path": "src/hands/KM_HandSpectator.pas", + "remote_path": "src/hands/KM_HandSpectator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0aba52b9927b4a1746c550a8a014420bd5a2ddd9", + "size": 12887, + "sha256": "f91d3ebe037a273f96e58effcaf7965e4f9f7ab57b901b944e2aad85bbfda224" + }, + { + "path": "src/hands/KM_HandStats.pas", + "remote_path": "src/hands/KM_HandStats.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "34b0e9d163c63bd2da01c32bd4bc57b8edc7cc84", + "size": 31162, + "sha256": "0feab297648d1d1f28435aed7a84126036ca99b7da7d9ba64447ff84cc01b21d" + }, + { + "path": "src/hands/KM_HandTypes.pas", + "remote_path": "src/hands/KM_HandTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28fe818b19930449ac88aeef304b09e4ae6eb1fe", + "size": 513, + "sha256": "4fb51c9bd81d91b602e5ee6e20fd13e83a29fff6732e7e176cecda5a2589b4d9" + }, + { + "path": "src/hands/KM_HandsCollection.pas", + "remote_path": "src/hands/KM_HandsCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97dc47ae0145156f70e1dc21b9082f058bd82876", + "size": 40434, + "sha256": "ba479d0b0f16846c95cafb07e434a4acaff3ded01b3471a65b61cb1c62ada1bc" + }, + { + "path": "src/hands/KM_WareDistribution.pas", + "remote_path": "src/hands/KM_WareDistribution.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "134e1765465f3664468a12de34dc56c133406d83", + "size": 5163, + "sha256": "d4b8f9e0cf787de940c9c1ed585aa382a86d928ca555990dede6c0ca06077177" + }, + { + "path": "src/houses/KM_HouseArmorWorkshop.pas", + "remote_path": "src/houses/KM_HouseArmorWorkshop.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "acc4c081be61d9364d454fdac3d4dbd8e19958c5", + "size": 2166, + "sha256": "3868d051906f1043ac6827873b2f66f67243a8482ecdbf36d4f1b47d7c97b5ba" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "remote_path": "src/houses/KM_HouseBarracks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3795bb335aeab7e2a26e93a76a8793af7930ae76", + "size": 12907, + "sha256": "d9bafd4febb0f34c628ee5226b0889ced285411d6a8e55c318de3c1da3410b46" + }, + { + "path": "src/houses/KM_HouseCollection.pas", + "remote_path": "src/houses/KM_HouseCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "332337b4e87f99aadb77314779261ff4c954539a", + "size": 14085, + "sha256": "b05d8b0cd0a63cf9200a599fc614ee2df6766b43404cb93a30040b87d5117291" + }, + { + "path": "src/houses/KM_HouseInn.pas", + "remote_path": "src/houses/KM_HouseInn.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4d58df87498827e39539016a20889de0fc7f70b", + "size": 4872, + "sha256": "e53c76a41ffb09acef4bab2519b92d15453f9decf12ebec587c0d41ac0875d6d" + }, + { + "path": "src/houses/KM_HouseMarket.pas", + "remote_path": "src/houses/KM_HouseMarket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "903a56ae2cacde87346093bcab3d86c632a1b12a", + "size": 21991, + "sha256": "4496f2fc2c2ed30dd37ddf6cfb45d171c0ff3f23df26fc12d272bf75daf57169" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "remote_path": "src/houses/KM_HouseSchool.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e9f9c30f312d74f74ebddc766a49edaee648f71", + "size": 10532, + "sha256": "59e38f62ec75b37fd04ccec2acf498dae374b116819311ccb54a624a2a3873c4" + }, + { + "path": "src/houses/KM_HouseStore.pas", + "remote_path": "src/houses/KM_HouseStore.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac95908f2e163210374a50cca3c3f1236ad8a73f", + "size": 9047, + "sha256": "3e349f08c6c4288807ed0e14279b141eedb949bf856194771f9322342f62accb" + }, + { + "path": "src/houses/KM_HouseSwineStable.pas", + "remote_path": "src/houses/KM_HouseSwineStable.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ab61e999da0f9a080b7afd7cdc5631fb3642198", + "size": 3168, + "sha256": "f243dac92002fc89f245f63da8972f22518229f9bf12455e8813be229998b8e2" + }, + { + "path": "src/houses/KM_HouseTownHall.pas", + "remote_path": "src/houses/KM_HouseTownHall.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0c4e1b3000dd3158d4defe518d49349f2a6447f3", + "size": 5640, + "sha256": "1f196acee70375d0949f1bc74960c60050493dc990772bc1f81d0e397719c397" + }, + { + "path": "src/houses/KM_HouseWoodcutters.pas", + "remote_path": "src/houses/KM_HouseWoodcutters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9f6d87c68f0d4cd5bb6f40ce0a173c33c811b97", + "size": 2964, + "sha256": "f80cecba3d96dc6418d095a8ee258d970aba9fbdd347f23d4d394c8971af9b52" + }, + { + "path": "src/houses/KM_Houses.pas", + "remote_path": "src/houses/KM_Houses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e1bc849d0c20e9e22b72ae3505ecec7aad5ede22", + "size": 88358, + "sha256": "d8ac9a649ebb20ad84593e487ba1411bdb4f7f45529de5b9c99be31fefbe9323" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "remote_path": "src/maped/KM_MapEdTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a12fb0b3b5a4641c4eb22f8109b3ac0ed626d0d8", + "size": 2880, + "sha256": "496b39e7a57ba9143fd227408b68dd872181a2322cfe61c6f8db7fc4cb5f0cf4" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "remote_path": "src/maped/KM_MapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05e629ee4bad5bad082a7440164c5dfb6a5095f5", + "size": 43120, + "sha256": "71a1a0a4adb8c95657834dac6912b12f6d8cce1e5ea32770f4073130298f8d8b" + }, + { + "path": "src/maped/KM_MapEditorHistory.pas", + "remote_path": "src/maped/KM_MapEditorHistory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80594c6b425cd6d0efd1288a8e5751bad7f524aa", + "size": 25347, + "sha256": "4f70d2458d8944466b835b5003ff1354cfb3e979339d4d4742ade3a69978f23d" + }, + { + "path": "src/media/KM_Audio.pas", + "remote_path": "src/media/KM_Audio.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d2008d415a835f24a7891a8152a0356fa0ccebb7", + "size": 641, + "sha256": "544208dbf958f9314b999a3940498839a84f3b1714284b655db200acddab2ff7" + }, + { + "path": "src/media/KM_MediaTypes.pas", + "remote_path": "src/media/KM_MediaTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c835b6cf437d24c14c0b1789de9a64092dba31d5", + "size": 136, + "sha256": "1909616103514d1591daaf6f11571b3f25a26b87bb117975e024a616400b17f2" + }, + { + "path": "src/media/KM_Music.pas", + "remote_path": "src/media/KM_Music.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a2536383398e7a9d1e8422b95fbb6a0a041ced99", + "size": 20386, + "sha256": "914fbf6503818e60e157068626b46f71b30a3dcc0580c94f31b5c9197cdac625" + }, + { + "path": "src/media/KM_ScriptSound.pas", + "remote_path": "src/media/KM_ScriptSound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d1a5f6ff9f97cac3bafcc4fc98ee46fdf6799cdc", + "size": 12039, + "sha256": "498a34055e5c90b97c876bb2efb782cdb6110e801e142f19098e36ff4c3b350c" + }, + { + "path": "src/media/KM_Sound.pas", + "remote_path": "src/media/KM_Sound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebc8e6388f5c80938ac7927a7de095e583ba0e22", + "size": 30849, + "sha256": "4be0863b000935e55bfee15d73b41c50ba406b30e173140ad020dc306793223c" + }, + { + "path": "src/media/KM_VLC.pas", + "remote_path": "src/media/KM_VLC.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14a02c1cbaf76c71360a8fff46393506fe802b80", + "size": 8513, + "sha256": "ce5c213ebbfea65c9c6085b20cb4652d8d160e8a2eeec0b0248af3b82e5338e0" + }, + { + "path": "src/media/KM_Video.pas", + "remote_path": "src/media/KM_Video.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85dc4a4995ce1b0846c4ee0a787b29440fb9c1c1", + "size": 17313, + "sha256": "76afefba35bdebb5cdeaeaffa85e29f7258a0a1021c2a1114878fca3a912fc44" + }, + { + "path": "src/minimap/KM_Minimap.pas", + "remote_path": "src/minimap/KM_Minimap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e304461835e3869c9f2ebb050033eb54387ba8b6", + "size": 4972, + "sha256": "cfa8f1d764f48e1cfbba5da6dfe59df29540545bdf7aefad817f2d73db3f1d71" + }, + { + "path": "src/minimap/KM_MinimapGame.pas", + "remote_path": "src/minimap/KM_MinimapGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27499dfed588c287ceb046f6dfd29652d8b5f7e8", + "size": 5488, + "sha256": "0990cc36b8ded9c4d03844b01619c9570e7e08dd65d0aa76b151a4090381b29e" + }, + { + "path": "src/minimap/KM_MinimapMission.pas", + "remote_path": "src/minimap/KM_MinimapMission.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64021d5e12aed9aab7ee2209cc2938e69ee483c9", + "size": 2468, + "sha256": "75db3e59757408b7eb01decd9e509a0090ecd3332084031d83c27f334caf562d" + }, + { + "path": "src/mission/KM_CampaignClasses.pas", + "remote_path": "src/mission/KM_CampaignClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f801971a5ad2ffbf938407c37bd9cc26c61a464", + "size": 1537, + "sha256": "36d9af4f87245a5db3cd05448171297248ce3d818e6f7d6f8c9bc4807637e54d" + }, + { + "path": "src/mission/KM_CampaignTypes.pas", + "remote_path": "src/mission/KM_CampaignTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8b4a23f498a874627248358c96089ae1f80807f", + "size": 220, + "sha256": "f85436bed8696c61330cacc50549d44bf064e3cd7a012829dfc160ed624ee5ac" + }, + { + "path": "src/mission/KM_CampaignUtils.pas", + "remote_path": "src/mission/KM_CampaignUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fbd32e669b69630e208c3a2f8c9f33bf249624f3", + "size": 819, + "sha256": "c9b21b45bcaf2c62cd81f6a7b70e097aa84fe4613b5368cab9e5a0d22a2addf6" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "remote_path": "src/mission/KM_Campaigns.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "30758586d7c06d79e092a74f536bd139f12d9195", + "size": 30792, + "sha256": "069c2421737c77d963ecf538c55841b9e23a60225d112bef2e9e3617c1c43b1e" + }, + { + "path": "src/mission/KM_MapTypes.pas", + "remote_path": "src/mission/KM_MapTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75304efd00050552e4e83dfdf410e1e4f4ce9124", + "size": 4248, + "sha256": "bca25641ce6a4d957dddc0ceb242065b0d26b8723688225a5bba89f87757e13a" + }, + { + "path": "src/mission/KM_MapUtils.pas", + "remote_path": "src/mission/KM_MapUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d10f31925d29738238905ac56c981e8e1e94b57a", + "size": 1799, + "sha256": "361acda0c81403ee151d0b56170663c4b69d6df24285192e7a8f13fe428b243b" + }, + { + "path": "src/mission/KM_MapUtilsExt.pas", + "remote_path": "src/mission/KM_MapUtilsExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "67497659a1b67805a3ec9c7a47927f1f21d9c41b", + "size": 3176, + "sha256": "daef75e85bf99dd1e747ae6b3f6fff90d2ce49d977955f5eb3f3fba68d2d504d" + }, + { + "path": "src/mission/KM_Maps.pas", + "remote_path": "src/mission/KM_Maps.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b22f5fbbaf65754891d30ede9235b9c5e15b12f0", + "size": 55522, + "sha256": "bb503c62e5ce3a6f5914fb24e2e44f11f26f4c987b62af0f6f792041abfcb8d9" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "remote_path": "src/mission/KM_MissionScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "71ee6abe27eed12e95bafa420a7a41ad74e62092", + "size": 8901, + "sha256": "7c6bb8d89b15f174cb490ee4b2be120832116a3b2d4cc346ba94e69dd24bdb47" + }, + { + "path": "src/mission/KM_MissionScript_Info.pas", + "remote_path": "src/mission/KM_MissionScript_Info.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0992d68228d5dfe41d967e93fa1763242e57e71", + "size": 5619, + "sha256": "cebe991807b5cf805509af0ae5a5ab3718c520c4d51bba90198302917b107672" + }, + { + "path": "src/mission/KM_MissionScript_Preview.pas", + "remote_path": "src/mission/KM_MissionScript_Preview.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9773daf9d966a12a524546277474c4d61f0fa388", + "size": 9069, + "sha256": "6ca28222d116f37cd78bc30dbd9c0b2a10ba8e657114a106a23449df6098631b" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "remote_path": "src/mission/KM_MissionScript_Standard.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "521a2f67dba5e247a58e35b3fb52c17c61bae11a", + "size": 59584, + "sha256": "d9379cdffca584010bda737e42b59ad2a45917d3d60ad04a1121a41f96d8ca82" + }, + { + "path": "src/navmesh/KM_NavMesh.pas", + "remote_path": "src/navmesh/KM_NavMesh.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d288690737b577303317dd4a104fc5548aa85b4", + "size": 18570, + "sha256": "6a6830f1f589ee38c76352efd60b976b661cbc99c7b2439cae96f8dd6c426a21" + }, + { + "path": "src/navmesh/KM_NavMeshArmyPositioning.pas", + "remote_path": "src/navmesh/KM_NavMeshArmyPositioning.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd60d0e8b78a833795a8bbdc6f61bd9ff2ea9df3", + "size": 38359, + "sha256": "59bf9b88d4e7adc2190c9f5c3cd1b02bcbe12e0d14d62906d1825c9668bc4207" + }, + { + "path": "src/navmesh/KM_NavMeshArmyVectorField.pas", + "remote_path": "src/navmesh/KM_NavMeshArmyVectorField.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ffd9a2cd5b957d09d1df6bf329df5a26b19660eb", + "size": 58979, + "sha256": "d1c93f277b18ed99f2e0a4c5e00d2fc5039320887ab9de6dbfeb2b1cb2e6c79e" + }, + { + "path": "src/navmesh/KM_NavMeshDefences.pas", + "remote_path": "src/navmesh/KM_NavMeshDefences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b60b4d750b700b87f9f1f24d72b9593dcef673cd", + "size": 38759, + "sha256": "f62eec2c08c1b16ff7d55569e33497bc150e0a2124419756dba855106d3e3f40" + }, + { + "path": "src/navmesh/KM_NavMeshFloodFill.pas", + "remote_path": "src/navmesh/KM_NavMeshFloodFill.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "544fedc4e7963eedc7556915b71d98abc4dd260c", + "size": 6045, + "sha256": "1a6c0d6fde48525b1cbbd49f43cb67fa10650f9922aee176c939f9797b47b2fe" + }, + { + "path": "src/navmesh/KM_NavMeshFloodPositioning.pas", + "remote_path": "src/navmesh/KM_NavMeshFloodPositioning.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d7a3b5ac309e3cc8859f4257ac9edb1f18231078", + "size": 2460, + "sha256": "f4d431cdd1e6d6c0ed64163206c76d6e519b1e695191a975bda581eac83bf5d7" + }, + { + "path": "src/navmesh/KM_NavMeshGenerator.pas", + "remote_path": "src/navmesh/KM_NavMeshGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "374e304aae32e40230ef18c8d8d4bf6aba8aa9fa", + "size": 43007, + "sha256": "9bd4ca2c4bf3e0a00b6993d4bbca1320f287774bac9d473bf77fce88cb78cb48" + }, + { + "path": "src/navmesh/KM_NavMeshInfluences.pas", + "remote_path": "src/navmesh/KM_NavMeshInfluences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "796da6f297ee9bf14874584a176d25f7083ba6b5", + "size": 8121, + "sha256": "94c6d7107632370d85f3e7761956995eb569808c7848ab4fbc998e29e3c3718d" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "remote_path": "src/navmesh/KM_NavMeshPathFinding.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6836f4ec3817b86cd8f10f6f754ae180e209ad1e", + "size": 14002, + "sha256": "cccd64e1e74e18fa6c98a2970023022137d318fbc265f0b158edfcce20d8f939" + }, + { + "path": "src/navmesh/KM_Outline.pas", + "remote_path": "src/navmesh/KM_Outline.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb38c0a0628a16cc4a61e5f6d5a8cef5fd4939d0", + "size": 3745, + "sha256": "a2d71b3418f4a1a6e756cbfe9ec7a9b92404f380a6310ba2aebeb82019da3216" + }, + { + "path": "src/navmesh/KM_PolySimplify.pas", + "remote_path": "src/navmesh/KM_PolySimplify.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d74168c30bef5c16c74b48cf3f9baf5aeb29353f", + "size": 26023, + "sha256": "1cd1a180e935deecb1ef672fd1806602723d41112603fcaaef7afed217440298" + }, + { + "path": "src/net/KM_NetAuthUnsecure.pas", + "remote_path": "src/net/KM_NetAuthUnsecure.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aaa599d715b86319eff32edab05e78b916490e79", + "size": 976, + "sha256": "ec454a30e86fd0aed8434f628fd3880bfef493df414792380b8da82fc193418b" + }, + { + "path": "src/net/KM_NetClient.pas", + "remote_path": "src/net/KM_NetClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "516cf6de93a942e939c5e899dc030f57648ec9d8", + "size": 8552, + "sha256": "29cd70b3dc14e095523b70be0c3bc6347fcbf7cba6f97d0bb336c864c26fdd56" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "remote_path": "src/net/KM_NetClientLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8b760ebb984b1fbd79562f9df91d12dad03b3a97", + "size": 4837, + "sha256": "ec0a5dc3b8f441ef39788ce78747a2c8ba592b88f68098df76349a730724bc1e" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "remote_path": "src/net/KM_NetClientOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f11f6f001ee5dfcb9848e4755a5da5c4886fbb4", + "size": 5987, + "sha256": "95d65593d1786b36180209ca3006d875928d25dc90707513cb746a927b6a6c5c" + }, + { + "path": "src/net/KM_NetConsts.pas", + "remote_path": "src/net/KM_NetConsts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d60c3429b7ec9be27d02cb09d448642f4e9c8da", + "size": 2031, + "sha256": "cf58b7dd05c5c43784a21c785743d3c6b0126539761e35917130b586e4e2566e" + }, + { + "path": "src/net/KM_NetDedicatedServer.pas", + "remote_path": "src/net/KM_NetDedicatedServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be0e3d0811bcd87382fe4aa27c4b5f0adae875fd", + "size": 5915, + "sha256": "65ff46f6ed9ce18e1185270b7895888b53684cb0396fd3d577f0b983568897fa" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "remote_path": "src/net/KM_NetFileTransfer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da789618df0d358a5a24a17c49842b65849f09ed", + "size": 18721, + "sha256": "13757f9e5a98827ec5243c3038910f776dedb83cfa7a7e7e8b39ee46a5dafe9b" + }, + { + "path": "src/net/KM_NetGameInfo.pas", + "remote_path": "src/net/KM_NetGameInfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "93359538a32569700cc720fe916794ed0f361b7c", + "size": 4330, + "sha256": "463387916f637146410afe96e0766c109d9a9667b6e34e98d89fc8eb3b41c114" + }, + { + "path": "src/net/KM_NetRoom.pas", + "remote_path": "src/net/KM_NetRoom.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1ef11e704fe459d951b7bf8f6ac710f6d1330d4d", + "size": 48372, + "sha256": "151c3fc0b5d5336c77accbef008e233f436971d146074a42f72f062bc1732304" + }, + { + "path": "src/net/KM_NetServer.pas", + "remote_path": "src/net/KM_NetServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "33a3a3bea61eefbff9256a1f0f07e2e2cb59b4f2", + "size": 42793, + "sha256": "591a4e9d090dd7ccc4032f1fb77822f35aa0efb3b475fce6f1bfac2ec2d4cf55" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "remote_path": "src/net/KM_NetServerLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "459461cb9e46173cb6342aa4da077eea2a425040", + "size": 9701, + "sha256": "16bed7ccd1021738a628127961820e520a197fd6be059e0c5270407a3fbf5849" + }, + { + "path": "src/net/KM_NetServerLocator.pas", + "remote_path": "src/net/KM_NetServerLocator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ce81a7aa12eec02cce996860b2090c9869aa588c", + "size": 5359, + "sha256": "2b11428bb3a67a975208b3066e596244b3ef46c8371cc98c5c9a8a2427b97af7" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "remote_path": "src/net/KM_NetServerOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da3bdff66cd6bbffce6d0dfa916c0bdd1bd9697d", + "size": 6517, + "sha256": "0f70a3d197b427475c0187a0524b08e7db318e29da3c791cd75625c7895f94ed" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "remote_path": "src/net/KM_NetServerPoller.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "306b8d4d771faafec2ed5b1a903344a2c8e3fb67", + "size": 18679, + "sha256": "884a7de9de3a15cffea97e2f213586041b9ce00bfea8d0e8337bf63d23a4f9d5" + }, + { + "path": "src/net/KM_NetTypes.pas", + "remote_path": "src/net/KM_NetTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02dc0eb624ed554ca60f688cf457d7fcdc177bfc", + "size": 15164, + "sha256": "7af37b995cb1fdee3c0d81c1d0f8f73745b3a8f7f4aeec76d9565ddfce73c9a8" + }, + { + "path": "src/net/KM_NetUDP.pas", + "remote_path": "src/net/KM_NetUDP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bcc979d2a1c60b6bd6bd46b55f3e50d223141cc", + "size": 5425, + "sha256": "5bdef9a22f9aabd8713283a5f21460b9b633cca40ddfc356180ceab8ce204337" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "remote_path": "src/net/KM_NetUDPLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a2bca4aa510e9e3d8a681b6bdec8f94ead06feac", + "size": 2164, + "sha256": "69235d0646eb61cec60429202ffc459cdcce87915b35fe26d2c5f621f0725841" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "remote_path": "src/net/KM_NetUDPOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05b6fe9b7c0ddcb6e73f3cc66901c7c1858fe053", + "size": 2836, + "sha256": "7afd6bc53e8b13ef395fd614fe735e48a9972c28699af37492d4e83112cd5225" + }, + { + "path": "src/net/KM_NetworkUtils.pas", + "remote_path": "src/net/KM_NetworkUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c67f66afcddcd3c5179fd0f1b75952613f450835", + "size": 724, + "sha256": "a4cfad97836f4d1c2d703e8c93db5608dc1454c30782bbdb77f9b6d9b5d1f533" + }, + { + "path": "src/net/KM_Networking.pas", + "remote_path": "src/net/KM_Networking.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "81b06de41e5c087c879a34e01ee3abb9069f4490", + "size": 104664, + "sha256": "d52b481f5990ae00011f567b51fe992f5030e88fc91f3c1cbf0a5695873e93e8" + }, + { + "path": "src/net/http/KM_HTTPClient.pas", + "remote_path": "src/net/http/KM_HTTPClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "94d4e9e01f1cdfd586f69e70538d378c4601f3be", + "size": 1586, + "sha256": "eaa097f6be9be40bf46b8243ae7b7c8cc596ec167078926a8aaca6bd01a167eb" + }, + { + "path": "src/net/http/KM_HTTPClientLNet.pas", + "remote_path": "src/net/http/KM_HTTPClientLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7560faa1f1afc3eacd5740544064b25c242cfa31", + "size": 2610, + "sha256": "45640ede141b4cc0f17d6af7e7d5bb75fce9661c4a0cd5e87982243244476d77" + }, + { + "path": "src/net/http/KM_HTTPClientOverbyte.pas", + "remote_path": "src/net/http/KM_HTTPClientOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbb028d8ccba0e9325956c73fa8574e397b73fe8", + "size": 2141, + "sha256": "8cb25e1097969eef0032f966657282043b9dab3b8e7da08f16cffe5597e9e61c" + }, + { + "path": "src/pathfinding/KM_PathFinding.pas", + "remote_path": "src/pathfinding/KM_PathFinding.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7b61fadf8c769c2a0e4d54c997bc562fb3e1df51", + "size": 17422, + "sha256": "d8c176c92c57da321de9a95587b19cebed37dee68a97e8cba058a28061e22e77" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "remote_path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "36310728268c5675a51b74c3bf2700c9c8ec7582", + "size": 4975, + "sha256": "4b96763aaee833ac81b18e591b83afbbc61f4c844804d033f27966edae00bcdc" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarOld.pas", + "remote_path": "src/pathfinding/KM_PathFindingAStarOld.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a8bd784a75a291064ccc0a66bf352743d9d012c6", + "size": 4468, + "sha256": "62bb930423be920979cda10a0e6d71c68e98dfa1fb9f4af5a1a793e557629cd9" + }, + { + "path": "src/pathfinding/KM_PathFindingJPS.pas", + "remote_path": "src/pathfinding/KM_PathFindingJPS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27e075d979f94ca3dd9837e3393b0dd57fab34eb", + "size": 10174, + "sha256": "cc0f25d81218dca36fadd35d4d3a904ff4157226beaefe9e4e05f968fed23568" + }, + { + "path": "src/pathfinding/KM_PathFindingRoad.pas", + "remote_path": "src/pathfinding/KM_PathFindingRoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d48485d6423389bbcc70e6a316a8bb9c5f4d6aba", + "size": 6151, + "sha256": "ebd1b1584f439b99047078523eb5855f804b92c6c2f971f6071978947a0429d4" + }, + { + "path": "src/perflog/KM_DevPerfLog.pas", + "remote_path": "src/perflog/KM_DevPerfLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3b0d6ea1b18297ea15a449c39f5142005403f44", + "size": 10086, + "sha256": "2fd23effc87dbbab97fe8f2835f7752a22ab6f099eaf218bf9036d3464c8a209" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "remote_path": "src/perflog/KM_DevPerfLogForm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dc4370ed064da3c1ab8e387c0fce24b64f54ea5e", + "size": 12080, + "sha256": "f1660d088e1eeb3de3ee4f44dad8ce9cc00b002fd7b164640c65d1ce2db6e0b9" + }, + { + "path": "src/perflog/KM_DevPerfLogSingle.pas", + "remote_path": "src/perflog/KM_DevPerfLogSingle.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bb1211910d8d7fa8463b77d14dfcacc2418e8c3", + "size": 8644, + "sha256": "49073b79ca5cc8f015680e9a41c3f84ea5e3a44f12363e5d5c98af1614bdb3d9" + }, + { + "path": "src/perflog/KM_DevPerfLogStack.pas", + "remote_path": "src/perflog/KM_DevPerfLogStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1d0bd4cbff736f73a6bb06c38b4b1d9e5a7645ca", + "size": 15405, + "sha256": "30cf5f154fd7265bd61e206b881d16ebf87070ca8b8e9388a3a68aeb4079b97e" + }, + { + "path": "src/perflog/KM_DevPerfLogTypes.pas", + "remote_path": "src/perflog/KM_DevPerfLogTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84e987e51fe7408009290d43b457ea079408e825", + "size": 6488, + "sha256": "8e8102c55980babf4b1291d3646b56d1dcb10bbaa0d2e2910f354878dda54316" + }, + { + "path": "src/render/KM_Render.pas", + "remote_path": "src/render/KM_Render.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4cc7916342b31105d8802c4c14752a4cf12ee3c2", + "size": 13076, + "sha256": "67bef2c2dbe1830d3e3a62a081f42ff3e061e3d3d9da38e1c5cc86680fab9e1b" + }, + { + "path": "src/render/KM_RenderAux.pas", + "remote_path": "src/render/KM_RenderAux.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e731dbafd77e0a251d533e28954c9c763c27bc14", + "size": 22813, + "sha256": "a2b736ad118f4f4959585f1833fdef4121bf3a7983996be2f7073326d40115b9" + }, + { + "path": "src/render/KM_RenderControl.pas", + "remote_path": "src/render/KM_RenderControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "30a37c01c3129dc5c573e1efd057e493bd496e7c", + "size": 3294, + "sha256": "a88f26232b658ed4abbe91a798cc87f439a8c4afba67687f784711221921e4ab" + }, + { + "path": "src/render/KM_RenderDebug.pas", + "remote_path": "src/render/KM_RenderDebug.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "440f58dda3e356211d23f2ca31a80e10caf8944b", + "size": 16403, + "sha256": "ce999e65a9107797c83335dd928c00ead83870a90085d9aa578dca6b3b8b9330" + }, + { + "path": "src/render/KM_RenderGameAux.pas", + "remote_path": "src/render/KM_RenderGameAux.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ee6cf4b7f40d9185ef8711d36a928d2e8a3ec83b", + "size": 8652, + "sha256": "a6aca175dca72c54411148e41a9a0381884f9dce22e767f558f5d3c142f3fe24" + }, + { + "path": "src/render/KM_RenderPool.pas", + "remote_path": "src/render/KM_RenderPool.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "538ffdef6f553381e0a506efb4fc5e2c935a53fa", + "size": 82914, + "sha256": "77ec7f1eaeb4ab9fc52be9ea350d07d77b3d2d0681fe985dfa1de2bb1f13a64b" + }, + { + "path": "src/render/KM_RenderQuery.pas", + "remote_path": "src/render/KM_RenderQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "23fc7c6d9b65aebf317f030b6315caa95bb8dbbc", + "size": 3386, + "sha256": "69343e0da66c800c0773150673b7dc5d7d9145499c3efd20dc3623ca0f210969" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "remote_path": "src/render/KM_RenderTerrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "72e08c48d4b24258b954352fbe9f5a097e31818d", + "size": 55026, + "sha256": "35302690153d13403aee5495832e89c72100b6cba3a1c9cc31e155acb77e9555" + }, + { + "path": "src/render/KM_RenderTypes.pas", + "remote_path": "src/render/KM_RenderTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8efd9752bf7dca6c58db4f9f32d90d891af1ccf1", + "size": 532, + "sha256": "7bc410ff890d0bf095af8203afd38dc15bbd1ce400c574a891e6c88a38c4ff81" + }, + { + "path": "src/render/KM_RenderUI.pas", + "remote_path": "src/render/KM_RenderUI.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "766c4c5ac0506ae703eac7903a8afe5605b009cc", + "size": 33336, + "sha256": "229ac869cbb3707321a849986675a2c8b091b9309953081ec8b9ad5611cf23c4" + }, + { + "path": "src/res/KM_Pics.pas", + "remote_path": "src/res/KM_Pics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1564bda14de6287eea0f8f4e2b210db8252f5c43", + "size": 489, + "sha256": "266a9c6a4f426ad2ec5cf10ffcb8662be869b33d817ebc97fe83470dca47983c" + }, + { + "path": "src/res/KM_ResCursors.pas", + "remote_path": "src/res/KM_ResCursors.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cdd5d054634aa0331e95bffe2b213865ad8571c9", + "size": 1234, + "sha256": "e52b1be9b3084ab72f19b0124bf6cfc974650e62d97df1cd7478370faaba5837" + }, + { + "path": "src/res/KM_ResExporter.pas", + "remote_path": "src/res/KM_ResExporter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b0f2c0e2d7145feccaf7d6ad1de27ac2570a29f", + "size": 30477, + "sha256": "80f7e2f22fd9e1a60669c27b48aa943702aaad2d374a5dd1f1ab443e06b3e732" + }, + { + "path": "src/res/KM_ResFonts.pas", + "remote_path": "src/res/KM_ResFonts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db62b4d0dae51850c3c29f3c60b31022a844de10", + "size": 25040, + "sha256": "8c008f9dbb502867c177572b553db05e0be066b52ae7f32076a3dcf3ecbe34b2" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "remote_path": "src/res/KM_ResFontsEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "022c4d036080a72e2104ece0edf25b4b33396aed", + "size": 20393, + "sha256": "94438b8a0d05bbabd3b91f0b32ab35738bf3a9a0edfbc46e04af38bd26d59e26" + }, + { + "path": "src/res/KM_ResHouses.pas", + "remote_path": "src/res/KM_ResHouses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bbc37456bfafe2aa9e6e586f552a9777bccdfe59", + "size": 36076, + "sha256": "04635afe5565ba2d9797c3920300030810e598b0885b4fa3627d45fb27add3d9" + }, + { + "path": "src/res/KM_ResInterpolation.pas", + "remote_path": "src/res/KM_ResInterpolation.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b1247ef5a97944435cc3a28c14e9d845d3a4dc83", + "size": 7497, + "sha256": "171d92c0003683fbb43e4682e9f03eb8a55ba22d68ee9f1f2bcd7b052ddb682d" + }, + { + "path": "src/res/KM_ResKeyFuncs.pas", + "remote_path": "src/res/KM_ResKeyFuncs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4af692a94797e91f9e38c082d12c0eac3efa578c", + "size": 8558, + "sha256": "0c3b4f114a470af098d6558b3437a1363ddad14a6fb326f9eebb9eb9ebd464d5" + }, + { + "path": "src/res/KM_ResKeys.pas", + "remote_path": "src/res/KM_ResKeys.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "13c043c92f0d4a1650954b06c05eec887019f383", + "size": 11813, + "sha256": "24e4f89638c91fdbe6a26935f4b69432f2adefeeb232f3ad75451f699df1a13f" + }, + { + "path": "src/res/KM_ResLocales.pas", + "remote_path": "src/res/KM_ResLocales.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd1eaccee7f96d2b1dd04831be9ddef2b4575d65", + "size": 5640, + "sha256": "ae36d32f959af0122af8763e2c9c187152434db612bfb8afda2b2bb8406df314" + }, + { + "path": "src/res/KM_ResMapElements.pas", + "remote_path": "src/res/KM_ResMapElements.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "96b57734ec9e17287fdc7b442d320942d4b334f2", + "size": 9929, + "sha256": "1ccfcef61c56b1bd36d10af67fcb223adddd1b1178b408ff949126b8969c573d" + }, + { + "path": "src/res/KM_ResPalettes.pas", + "remote_path": "src/res/KM_ResPalettes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1aec924b514d0d283331d0dfcc956ee9a1998e1e", + "size": 3652, + "sha256": "d86b57d19d6f6491bd5084a33a96647309b149b13bc3910e9bf405af49c41f52" + }, + { + "path": "src/res/KM_ResSound.pas", + "remote_path": "src/res/KM_ResSound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3847dbb6d239bea0e459a4f4b8700f5e870a1e2c", + "size": 19980, + "sha256": "01714778b742c576daf87bd978c620a5f8209aee29cad6b00f68afd4de2eb7e1" + }, + { + "path": "src/res/KM_ResSprites.pas", + "remote_path": "src/res/KM_ResSprites.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "231b24bae05ac6c728ee6e1d32a32ed849193e9d", + "size": 76890, + "sha256": "71c41037967133876085160d0a183748458f70be3777e97a9944efe4a50f57e6" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "remote_path": "src/res/KM_ResSpritesEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f3dbd251414a6ffd46d3adffff7d40ad1a78ad4", + "size": 27158, + "sha256": "959b955b5eeb288090274b23abcf6f0b8fedc88df06a84cd65f91885949f33d5" + }, + { + "path": "src/res/KM_ResTexts.pas", + "remote_path": "src/res/KM_ResTexts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2855e98bab2226fbee1893e7ae7129bea16e851c", + "size": 13144, + "sha256": "fc85f9101cbf59b0750a1972eef947aa2cea7f0ac9cdb8a1392d57dcd689fad6" + }, + { + "path": "src/res/KM_ResTileset.pas", + "remote_path": "src/res/KM_ResTileset.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "06d7da92724ab3eaef9d02ff98bc04ea3278a6d0", + "size": 26137, + "sha256": "e12b1ab7abdc15d37da892a41acd03c13712ae13dd22803b3040642640c36374" + }, + { + "path": "src/res/KM_ResTilesetTypes.pas", + "remote_path": "src/res/KM_ResTilesetTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a123337985413687b8c6ce54ffe2e3c037bb5d47", + "size": 8301, + "sha256": "8ed4e76c80ef292d1c691bad4398531a2e398b750ae715091f99757fc8f1958d" + }, + { + "path": "src/res/KM_ResTypes.pas", + "remote_path": "src/res/KM_ResTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21523793c27858811b07ba072e0fa11f53126516", + "size": 11168, + "sha256": "da87e96d5c0dd726dd7ca0a9fd9d7b7814370d29fce442a4e4288d396b1b1dea" + }, + { + "path": "src/res/KM_ResUnits.pas", + "remote_path": "src/res/KM_ResUnits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df06a17d70b2e3c00db8afac5461f6358a3df025", + "size": 23141, + "sha256": "b616a69e9cd44df5a06bacdd218dc609540d679c5229e92a34d3ace82d10df04" + }, + { + "path": "src/res/KM_ResWares.pas", + "remote_path": "src/res/KM_ResWares.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c422946b9039bbbc270a5100027d9246708a9761", + "size": 10802, + "sha256": "cbcc2f76dc628b7c60313937ccbccb20cc1c539fdf2781af5e7810ed1d8d2dd7" + }, + { + "path": "src/res/KM_Resource.pas", + "remote_path": "src/res/KM_Resource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "11a8f376ee7b8f06d696b001757b4f61c34a474f", + "size": 7900, + "sha256": "1ff94e5ceee7ee6056e6ee16c1e34d74fdeb8d858f9841564ef405e1b62dac51" + }, + { + "path": "src/res/KM_Saves.pas", + "remote_path": "src/res/KM_Saves.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4154b5829f480a404aed71256119b82c164b5acf", + "size": 22393, + "sha256": "efb3956500f51850493f8f1020084f7351a7739a811ead01728bc507a7a6a34f" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "remote_path": "src/scripting/KM_ScriptErrorHandler.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6129ccd35d4c8cab8e406fc2f03cd3b8dc86b1eb", + "size": 9462, + "sha256": "5ed32a173e820a6e5dbc3fb45d18b22a9c71dd3c513fb85bc5c8111db2d9b54f" + }, + { + "path": "src/scripting/KM_ScriptFilesCollection.pas", + "remote_path": "src/scripting/KM_ScriptFilesCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e12809cab95dcf3af8afa13df077a3031d7a9f7", + "size": 3857, + "sha256": "516bd3ee7d69f8d41597b62788f10eccedc93b489d32d46591ccace416cf56c7" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "remote_path": "src/scripting/KM_ScriptPreProcessor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "385ee001b22f2ac46055468244b0e1d993d61fbe", + "size": 20198, + "sha256": "db63347b5f2cf280760fe21e0c3e174f9e9eb06320906e8196536af83a0c75ec" + }, + { + "path": "src/scripting/KM_ScriptPreProcessorGame.pas", + "remote_path": "src/scripting/KM_ScriptPreProcessorGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5e681f2af338df12a5c5f50b45452ab38ef49881", + "size": 4159, + "sha256": "ea78ac6664360b87ce17af52c4d745deda25e5297d06ce153449f0fbc24c9a0f" + }, + { + "path": "src/scripting/KM_ScriptValidatorResult.pas", + "remote_path": "src/scripting/KM_ScriptValidatorResult.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac9c2ff1c6d92ab7f4062807ce63248eb7f4ea55", + "size": 4530, + "sha256": "80736f212cea53ea0844af0ce393e65d389e2cdcf3dcb54d7666e52cd998f062" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "remote_path": "src/scripting/KM_Scripting.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62a8da0e302d51b6e2e7955a51213dcd5a1a138e", + "size": 134475, + "sha256": "bd6a6a261aee500c6842ca17081b257e1763e7496e6af8292a3da34ec9fecf43" + }, + { + "path": "src/scripting/KM_ScriptingActions.pas", + "remote_path": "src/scripting/KM_ScriptingActions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ec51212f06faca7c322d6acd71a3c2920c3af661", + "size": 193496, + "sha256": "8f9d644a13bf76bed881c06c30442d963f01a393cb66c8c92400fca986b33fc8" + }, + { + "path": "src/scripting/KM_ScriptingConsoleCommands.pas", + "remote_path": "src/scripting/KM_ScriptingConsoleCommands.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa14c1cc55857878f0379399131019cf3b111e0d", + "size": 106968, + "sha256": "fbf7eb215640c840c399c9e1c98bc0d480c536f3947a4f4969b51f6799a25061" + }, + { + "path": "src/scripting/KM_ScriptingEvents.pas", + "remote_path": "src/scripting/KM_ScriptingEvents.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de883730330ab08c1e99ee6cbfdd6432e3f97026", + "size": 48639, + "sha256": "5e6557eb26a45ec2a5e5538a3df58374312f759fac6934339e20432e654d3477" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "remote_path": "src/scripting/KM_ScriptingIdCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0505593bbafb300e58e614574328a1e1116f712b", + "size": 9728, + "sha256": "50637b64c86334ee72be847218d79e2c4fb8657e89c62a017a322ce639346ada" + }, + { + "path": "src/scripting/KM_ScriptingStates.pas", + "remote_path": "src/scripting/KM_ScriptingStates.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7d182144d7b8f0f2873f690eaad5a8e60717a87f", + "size": 181334, + "sha256": "abbf037947e17e33cf8a6c0e5cd0e308195782f26d66f0897430661217feb738" + }, + { + "path": "src/scripting/KM_ScriptingTypes.pas", + "remote_path": "src/scripting/KM_ScriptingTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9c774a1c96d0f757e5edc7a7516eceb69ce8db02", + "size": 4092, + "sha256": "642d715cfa26bb95ac8c6d50f4f12d9374b849a3b17ea60c88aec77d88f2766d" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "remote_path": "src/scripting/KM_ScriptingUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "989940c4314a99c3fa654ea0b55a9585ca0d7030", + "size": 30470, + "sha256": "cf4640f508295691542bc15f1fef033a09b4f9a7e98b0b5bc085d956ed16b7da" + }, + { + "path": "src/settings/KM_GameAppSettings.pas", + "remote_path": "src/settings/KM_GameAppSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0094894050747abca6e94ea6adf76339cebcb8cb", + "size": 3177, + "sha256": "bdc0a64e58f58da116984a61ef9a12db5dde2cec902ead3d611a01ba7991ac3d" + }, + { + "path": "src/settings/KM_GameAppSettingsPart.pas", + "remote_path": "src/settings/KM_GameAppSettingsPart.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fbbd2c3d9dd7efc93f7b4fe4fa40a772c1f9bca", + "size": 403, + "sha256": "be90b49726b86ddabb80aafd98779125605b5004111a7766cafa690e82923cb6" + }, + { + "path": "src/settings/KM_GameSettings.pas", + "remote_path": "src/settings/KM_GameSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d26450d288708d82e8edd9b29381ff0a72b78e08", + "size": 31983, + "sha256": "2626ba448a0a3fa6536d4eb2f552fcbb6e758cd7947bcab5ea20fa936d4fc075" + }, + { + "path": "src/settings/KM_KeysSettings.pas", + "remote_path": "src/settings/KM_KeysSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5d95b6bce3190b61e00273e71dc1d8477b5caae1", + "size": 1961, + "sha256": "711261664fdbfb4db69ff595b292c1646b0d25c96650944e40f8fb98e2c7a433" + }, + { + "path": "src/settings/KM_MainSettings.pas", + "remote_path": "src/settings/KM_MainSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7da3718637222d42434982b83c9483f2c64e62a2", + "size": 5716, + "sha256": "371c85064c459620164c324d8424b8ee7e093c8af2337ad3023f205a0c2ff8a9" + }, + { + "path": "src/settings/KM_Resolutions.pas", + "remote_path": "src/settings/KM_Resolutions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70fd26960f886002c2f7e883c1ca955c4991b337", + "size": 7776, + "sha256": "1ba1cddaea0913e6983324f28fce369a03d871cf7632117cb9f2c3cc151e08dc" + }, + { + "path": "src/settings/KM_ServerSettings.pas", + "remote_path": "src/settings/KM_ServerSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c5bdf0c26ed93a1cce2da98ea82373f64c88b8ef", + "size": 11967, + "sha256": "1478600343b2aa65da764b9b6d452dfb86a24223fec2f50d38064c685e60445b" + }, + { + "path": "src/settings/KM_Settings.pas", + "remote_path": "src/settings/KM_Settings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b09a47ae4a0658dea40411051832f89f47900e5e", + "size": 3410, + "sha256": "2c89a7d558980bedda717be243a04036d83da9455ca3c78ae1d6bc134ba0bea0" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "remote_path": "src/settings/KM_SettingsDev.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c2e68825becf9469e7dfa4c096760392447f612a", + "size": 8129, + "sha256": "483317c77ca65406283be86ac4f2886dfe8bf8104147d120c29c37f429723659" + }, + { + "path": "src/settings/KM_SettingsXML.pas", + "remote_path": "src/settings/KM_SettingsXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d232b326492d87f4262ac786c743ad6773246787", + "size": 1003, + "sha256": "67957fc140bb6231a77fdb7a05a5a3223f4c59b5d569d109c519d1d0b00641d4" + }, + { + "path": "src/settings/KM_WindowParams.pas", + "remote_path": "src/settings/KM_WindowParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d9b85225bc76508608221c812675c2005cfa548a", + "size": 4875, + "sha256": "50ec7777724152822610576b411199ff222ccca8c6fcd789962c0012c0ac9099" + }, + { + "path": "src/terrain/KM_RMGUtils.pas", + "remote_path": "src/terrain/KM_RMGUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2b226c28a266f713c47acc107408e6f75abb88c9", + "size": 36528, + "sha256": "219cd38f8c10e8ceff1700f9cc391e675e1530e40d9faf70b8ceff694d032b7d" + }, + { + "path": "src/terrain/KM_RandomMapGenerator.pas", + "remote_path": "src/terrain/KM_RandomMapGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9dc37b7cdef2f528995bb0da6f4d0b4ed5995d42", + "size": 233583, + "sha256": "06e77ddf00c571ca960cb46a06821bb61b076e77e46c207d6f9cd642708315c9" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "remote_path": "src/terrain/KM_Terrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1cdd7695273acd13efa6b880e5d816231bb3c58c", + "size": 197541, + "sha256": "1d48ec7beff93eee4285f73c33241fac8bc2f264bfb2506feebb93d851810c16" + }, + { + "path": "src/terrain/KM_TerrainDeposits.pas", + "remote_path": "src/terrain/KM_TerrainDeposits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80bcb8bb30843e7617a89914bb3a0da95ea12874", + "size": 6275, + "sha256": "b65863930f7c3ed6d117f3d88b55d164a0fee42b33e3cd461089c58f770f1194" + }, + { + "path": "src/terrain/KM_TerrainFinder.pas", + "remote_path": "src/terrain/KM_TerrainFinder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85f5e19a0a31d022dfc44fac9469763bebeeaa5c", + "size": 9136, + "sha256": "5ce044de41bc804f6f269adc33f9307e2b9812af3da18c8da96a6d09cee91cdc" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "remote_path": "src/terrain/KM_TerrainPainter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87026ece3b1a51ca44bc7474095610510b7a514b", + "size": 99997, + "sha256": "2b6dee391d9c67ecbdc5ae4a82c8d2cb8c96a8773ed289d34332a289ee75d2b1" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "remote_path": "src/terrain/KM_TerrainSelection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04ba4c97b6b0f88a147e836f42d0451ddc2e35c1", + "size": 34297, + "sha256": "ae2d9d50f1a776130836fdcd4d77723d3992d1457dddb2d3c1cecdd83058eb24" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "remote_path": "src/terrain/KM_TerrainTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4fa297745430088bd6cae6fad71fac7481b88b5", + "size": 8940, + "sha256": "af3771efe6e35ae3ad725f0f198b1031ae5e10a0a32bf7a89873c1b7c6af32fe" + }, + { + "path": "src/terrain/KM_TerrainUtils.pas", + "remote_path": "src/terrain/KM_TerrainUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97cf4c2fe531871226fccbae8e343b201403c36e", + "size": 8845, + "sha256": "81b5eedcebd2cdddd04df8d71d3b218b6bcaee6a692a0e5bd014a9802571a1a1" + }, + { + "path": "src/terrain/KM_TerrainWalkConnect.pas", + "remote_path": "src/terrain/KM_TerrainWalkConnect.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5cba21da2a57ddb8b241db508d918af57846a67", + "size": 16916, + "sha256": "a05f7a8bcc9179b5a170cc70e8c3b82800db8935e06dfb24c455567a156f6f28" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "remote_path": "src/terrain/KM_TestMapGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd9431212a4bc4ccf2b58d3dad3653179abbecb4", + "size": 26939, + "sha256": "9e6699463002e9dad2187836de56d55836feac29e36020af2c31c66b881f25c0" + }, + { + "path": "src/units/KM_UnitGroup.pas", + "remote_path": "src/units/KM_UnitGroup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d7ac195146d6e5de5feae858abe02b498e006149", + "size": 82640, + "sha256": "5391a982fe5113e8b25a80064faf82af41c992e07e68e754bdd5759dd3af9ef7" + }, + { + "path": "src/units/KM_UnitGroupTypes.pas", + "remote_path": "src/units/KM_UnitGroupTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "93dbff0ab2245363a4f728f7b395ac3b1631882b", + "size": 1085, + "sha256": "2a9bc0ee03b13698ec708664c45509bf13187d92d5bb5165ebd07fa5c8203220" + }, + { + "path": "src/units/KM_UnitVisual.pas", + "remote_path": "src/units/KM_UnitVisual.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b66b9950fc3781f534224b952dcba330a0bb7598", + "size": 4812, + "sha256": "5674a2ce24f0bc8c2544417d05763be2a766cb6d16cfd6fcec4af51164c15019" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "remote_path": "src/units/KM_UnitWarrior.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60a100538218696b6e6ec63c0ebb6b25b37564a1", + "size": 39063, + "sha256": "d8919c585648d50969407067a12061140946d6132e755f3ce9bb04e52df2b824" + }, + { + "path": "src/units/KM_UnitWorkPlan.pas", + "remote_path": "src/units/KM_UnitWorkPlan.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fce775b799ee8456c7f56db90971692898d9f6cb", + "size": 28794, + "sha256": "067ba9e63c9ec1de59e2cfe787691dc2e91225415f56e522a4491ea3f9181e03" + }, + { + "path": "src/units/KM_Units.pas", + "remote_path": "src/units/KM_Units.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de4da08c29d964df7daa19e2ac1b0b98824ef510", + "size": 95355, + "sha256": "2038fc1f99da72cc36db21ce8117a018c12a24d40272928d1a0e942512dbac40" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "remote_path": "src/units/KM_UnitsCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b51d1028a7af516f780ff1fd3c48950f1ddb506d", + "size": 12192, + "sha256": "327bca7972ffc179fd70cc8a9c821719b457321e3a5ea23c5d3b2411eff2db22" + }, + { + "path": "src/units/actions/KM_UnitActionAbandonWalk.pas", + "remote_path": "src/units/actions/KM_UnitActionAbandonWalk.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e03688b0aaf82514fe9929fb09dfa2c9aa96df91", + "size": 3613, + "sha256": "0893fe66654e22226aa840817d9b62f7541acd325c12e97577b7e6f4847dcda4" + }, + { + "path": "src/units/actions/KM_UnitActionFight.pas", + "remote_path": "src/units/actions/KM_UnitActionFight.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "45106d696204c67e633fde0d89303ceade578977", + "size": 14268, + "sha256": "15e0e9c75bcaf9a1191ec6c727f432893a2f4f9af018f7a38f61a15181f29db7" + }, + { + "path": "src/units/actions/KM_UnitActionGoInOut.pas", + "remote_path": "src/units/actions/KM_UnitActionGoInOut.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28abbda0bb7c1b20aa315fc24ec2401cccdfb5af", + "size": 17414, + "sha256": "77d7dd54ed7858f73df5fddb9ed1cd91fa9907c9af4fbc1fdda659b2da6a7468" + }, + { + "path": "src/units/actions/KM_UnitActionStay.pas", + "remote_path": "src/units/actions/KM_UnitActionStay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d613428353b3a1254037b61a84c7477adebe306f", + "size": 4700, + "sha256": "d174e902214ea40077637830a7d676679b2b2a69f597e16254910b08de8106ba" + }, + { + "path": "src/units/actions/KM_UnitActionSteer.pas", + "remote_path": "src/units/actions/KM_UnitActionSteer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b061abf73677bf5295b19105c87e7f944bbdcc33", + "size": 6252, + "sha256": "18d60e0c25be704cbb866faa208794234fb4b4e8502c7907ac6da33d99b46f8b" + }, + { + "path": "src/units/actions/KM_UnitActionStormAttack.pas", + "remote_path": "src/units/actions/KM_UnitActionStormAttack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8e43e9129cdebf46c7fa31c67f2f5c9388f95d74", + "size": 7433, + "sha256": "99cb80496c322d14b014bc78bb30ac5fe33ff413a6fd83078e5f7784bded56bf" + }, + { + "path": "src/units/actions/KM_UnitActionWalkTo.pas", + "remote_path": "src/units/actions/KM_UnitActionWalkTo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "489cd2637ecd36f5b03765b51a32208b90b7eed8", + "size": 59462, + "sha256": "7c4be01ec4c11665d510f98d447f1657b4679779a8bb10a3a3eddf49bd8f7aee" + }, + { + "path": "src/units/tasks/KM_UnitTaskAttackHouse.pas", + "remote_path": "src/units/tasks/KM_UnitTaskAttackHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "49fa6d4e7b44107a1ef522e6a24bdad0e2087915", + "size": 7235, + "sha256": "83d099ff4e799693f6d76b19b8bda361d031b39975e482ad628939aabbbdd062" + }, + { + "path": "src/units/tasks/KM_UnitTaskBuild.pas", + "remote_path": "src/units/tasks/KM_UnitTaskBuild.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3421e8fca8c4c355c3f04f7123f8a8e6f3a0a3d9", + "size": 30925, + "sha256": "33c4a2ef02899af16f73534afd5d7b891e2fcd6e811c8d9d3eceddadee82114c" + }, + { + "path": "src/units/tasks/KM_UnitTaskDelivery.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDelivery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c98bf400e175e2ab21067485ef4252d56c21870d", + "size": 21469, + "sha256": "6d6b1e35870847999c7c5448769cc4474220a9a2b02f23ea560978c6a2c304bf" + }, + { + "path": "src/units/tasks/KM_UnitTaskDie.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDie.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6a690f32d25d7c7748cc212c7d4c6a08badabb4", + "size": 3814, + "sha256": "47fecc16018295ec14bd1b7cb26efa0ba2a997758228b19fde83ff987a26bcb5" + }, + { + "path": "src/units/tasks/KM_UnitTaskDismiss.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDismiss.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fef1e21d5466df968d3108dc1949a6267d962327", + "size": 3988, + "sha256": "041b6127ad18500f54be33eb46d0a12c57a79593efc6ace4d907581665fa41d3" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoEat.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoEat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6af67bda43417d91caa7d29916c51a65bfc34dd8", + "size": 5955, + "sha256": "a54e0d001354e821aec77be2193a055ecd968d3db8f03fb8e5fbf4626aa3e4f5" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoHome.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoHome.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97dae133263bed1b1e071da47b218887e0d2ab83", + "size": 1266, + "sha256": "e719c0811ee01015ceb32ce0199e67b2ead56848bed23f0041e9c1100b39c2f7" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f86aded43040a3461ec9f59151f93feef418407", + "size": 1291, + "sha256": "8a28939c56ad2465c09c13770746815a647b88b18575b6b0221d79543dc94954" + }, + { + "path": "src/units/tasks/KM_UnitTaskMining.pas", + "remote_path": "src/units/tasks/KM_UnitTaskMining.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62fde07a8344a44db3e61d419d8b5b619236d39a", + "size": 17971, + "sha256": "c8598d7e34ec553457d2cd45e6bcbebf921ca1df29a1078ff946956cf82bfd20" + }, + { + "path": "src/units/tasks/KM_UnitTaskSelfTrain.pas", + "remote_path": "src/units/tasks/KM_UnitTaskSelfTrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4af4cc71503cc7761ad602c4b468948167c60f90", + "size": 3468, + "sha256": "346cf727bcac2f35238a56b276dee58e693918abf3a8d20060f97aa7b0fd12f4" + }, + { + "path": "src/units/tasks/KM_UnitTaskThrowRock.pas", + "remote_path": "src/units/tasks/KM_UnitTaskThrowRock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e379e4a0dc2900f543092f2b2f2001a2dde355a", + "size": 3072, + "sha256": "a0db11548e238d08eba8902a9a99abdee53bf30f925af30c0881f83023c76daf" + }, + { + "path": "src/unused/KM_Achievements.pas", + "remote_path": "src/unused/KM_Achievements.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1627369a8bb7e2798f9b9118fdc9a134e875905c", + "size": 5264, + "sha256": "a4aa63abedd1fae979ea47623e2a00c0b663dfa2920df0d68883384e316ee3a2" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "remote_path": "src/unused/KM_CommonSave.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac544cb2b373cc96dcaa0e5c3ebd85e9e981f138", + "size": 19606, + "sha256": "a744f680b1f2f46025689ecd0be438aad7c020437c46e45713494d7548c81bbb" + }, + { + "path": "src/unused/KM_PerfLog.pas", + "remote_path": "src/unused/KM_PerfLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c7ba870ef4fafdaf83a1eb96bb77239247027863", + "size": 8684, + "sha256": "b5f74a52c7618c80f3d3326d9b01b733c429ddc24666e1d5d10dcb0ef9c0267d" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "remote_path": "src/utils/KM_CommonShellUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "98a993db503e41d3d725bfcdbc251ef6d4ac3daf", + "size": 2096, + "sha256": "3564ae767371f014b36dcc9d80f3cc676b2c3d8bf8830b7b63b34c31cdd607b1" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "remote_path": "src/utils/KM_CommonUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5bc5f80ca081d496c8e8fa0100f8de9f8aa7b77d", + "size": 56821, + "sha256": "10fe873247e96c7cce22964698e2ce8bed3cbf5649c544671f0373af6fa1a473" + }, + { + "path": "src/utils/KM_ConsoleTimer.pas", + "remote_path": "src/utils/KM_ConsoleTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "888d08da9cb6c54fcf555a8c5a64ade4639b58bf", + "size": 3429, + "sha256": "9b61e7dc93e717ac4f642e647315a3808a129b5f2753dbc9756e3ca717e1c3ec" + }, + { + "path": "src/utils/KM_Utils.pas", + "remote_path": "src/utils/KM_Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3105f99be8f41e67774f7672e3baa2d1cf375ef2", + "size": 9907, + "sha256": "575fd9debc927c22d5f5141117ecb1d523c0206ef7229fc36e9e975885231d10" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "remote_path": "src/utils/KM_UtilsExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5dd2e212a45e992a32c41f9cd441ee25b0fd4156", + "size": 2410, + "sha256": "f7a6b8032163af15e0a49e59b7d9049be38719965630bbbbad0b22aca62d6de8" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "remote_path": "src/utils/KromOGLUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7b61f7d43155fe489a82587227fd48d76537f8e", + "size": 8986, + "sha256": "c0c37cb2e0711263dd204eb2f009264f2746fe80f3bf9bf6c0a3f9e050d3171f" + }, + { + "path": "src/utils/KromShellUtils.pas", + "remote_path": "src/utils/KromShellUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "96e9a289e105876378a16d3b67fdcc879b00085d", + "size": 3719, + "sha256": "b12109f7f24c1964e1c6bca0c27964eb17c582c65b1bcb3f92f398cc858532cc" + }, + { + "path": "src/utils/KromUtils.pas", + "remote_path": "src/utils/KromUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9f0ede949d7d6ecc8e18e4ead628e7c06bf1087", + "size": 13594, + "sha256": "5c566985c7c38e11445bd50956e25cd46fe0eb10ffec392d3b6f9094a51b2bf7" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "remote_path": "src/utils/algorithms/BinaryHeap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "136e36b21905898384ecba6295a8485fd519d8f0", + "size": 2790, + "sha256": "d69cc2d09fa0457ae307ab1400dce6a34bafc0f5c9acb90b3402a2bce74d1407" + }, + { + "path": "src/utils/algorithms/BinaryHeapGen.pas", + "remote_path": "src/utils/algorithms/BinaryHeapGen.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa043116c055bfeea4abdf85221ab3f92f3444e4", + "size": 3558, + "sha256": "2350457d3eabffce6e18c4ecbd6c3e76b063f0be4fc257b74c5b6fe8a082e53a" + }, + { + "path": "src/utils/algorithms/KM_BinPacking.pas", + "remote_path": "src/utils/algorithms/KM_BinPacking.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cf94cac6151b0fd92fd8dfd610500fe8d332fef9", + "size": 7312, + "sha256": "dbc4d31c8e1563c9023753d6cd21f3cd1ef9d6d6d71495ab3443aaf38df66e00" + }, + { + "path": "src/utils/algorithms/KM_FloodFill.pas", + "remote_path": "src/utils/algorithms/KM_FloodFill.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "65bbbd20e77d1b252c8df7ea3982cd4c1bd8a23b", + "size": 4378, + "sha256": "360d93af8c9985b408b6c285a2ad1b2cc334bbcebfc1d57d86cd77fc97e9d9df" + }, + { + "path": "src/utils/algorithms/KM_Hungarian.pas", + "remote_path": "src/utils/algorithms/KM_Hungarian.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bcef2a016599c1ed3ba621e9c1c3e847bc0e8325", + "size": 12257, + "sha256": "246539dc70df75c3a0b056eee2248d55e50a21ffe16e993befed5e09c11639ee" + }, + { + "path": "src/utils/algorithms/KM_MarchingSquares.pas", + "remote_path": "src/utils/algorithms/KM_MarchingSquares.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "256488306ada37d83444f9b27e712bbc0951af89", + "size": 6734, + "sha256": "2139602886e7fc2f7c7cc38dedcce660d06e85c0333aab0fec8eef20fd0102fb" + }, + { + "path": "src/utils/algorithms/KM_SoftShadows.pas", + "remote_path": "src/utils/algorithms/KM_SoftShadows.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44421d7c415742eed9ecf7d563cef688f55b39c4", + "size": 11868, + "sha256": "de6979e4ae6c3f5ee78bf2516d7f023ee7e19ab0d01bddef62206d92c0d60fa0" + }, + { + "path": "src/utils/algorithms/KM_Sort.pas", + "remote_path": "src/utils/algorithms/KM_Sort.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f7daf2e9a3861aaf5cd67abbb636196f6cf6a7d6", + "size": 1688, + "sha256": "38fefe4e3d2254fc0ca580870e893c1b64d42bf1c1fa13d2a8eb2e6b2151d687" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "remote_path": "src/utils/io/KM_FileIO.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fca15e86b77e2d0b0498fafffe1cdb415e9b7302", + "size": 19584, + "sha256": "fdccdbcab177e47764e49bca8dd33f91a4d10c0fae9b2494ccdd93491af05ebf" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "remote_path": "src/utils/io/KM_IoGraphicUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d77c0c2699e159dad35b3af995984ed8c59feb33", + "size": 2255, + "sha256": "f2cded9bc28bc3cc5effdb4174fb3161d7d2744d0a4400edd5c7a1fd8a0b5fb0" + }, + { + "path": "src/utils/io/KM_IoJSON.pas", + "remote_path": "src/utils/io/KM_IoJSON.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "363a5803927ea347aa9cc19d879593e95d4d9e8a", + "size": 10490, + "sha256": "c6d5167b15589d9348019f886d64b9644372a8a5016076b3ef4dec388b7a6dc8" + }, + { + "path": "src/utils/io/KM_IoPNG.pas", + "remote_path": "src/utils/io/KM_IoPNG.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b9e6f3ee52edd520fb3f9fd29d4bb759a28bbd20", + "size": 3761, + "sha256": "f332f78b011f6ea5f762699f742d11af12e888cd570f9499453c4dd074087abd" + }, + { + "path": "src/utils/io/KM_IoXML.pas", + "remote_path": "src/utils/io/KM_IoXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "786ed35b5d0c1136113da08fe9c0de1abcc1c6cf", + "size": 11159, + "sha256": "870a2d11608c3aa9f8cd1f06c796db570d9ef26f5545d689a0ab58cf3bd2742e" + }, + { + "path": "src/utils/method_parser/KM_MethodParser.pas", + "remote_path": "src/utils/method_parser/KM_MethodParser.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "243ee9492a3bab9dd262dcde4bb3859d7332bfe7", + "size": 13417, + "sha256": "f9073edd89534e7e2385021d2dae17f3f5f2d087c1730e65014a2722b3d31c08" + }, + { + "path": "src/utils/method_parser/KM_MethodParserParams.pas", + "remote_path": "src/utils/method_parser/KM_MethodParserParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "546c8871f88f5c0337595404b1f45f99df883740", + "size": 1734, + "sha256": "f5afe1d508977258c11f005cfa8b6755ac7d9f678a110ca0f03ccb954380c4a8" + } + ] +} diff --git a/reports/runs/20260908T164542Z-0843e132/sprite_loader/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/sprite_loader/CastleEngineManifest.xml new file mode 100644 index 0000000..5917343 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/sprite_loader/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/sprite_loader/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/sprite_loader/ProbeImports.pas new file mode 100644 index 0000000..92ce94d --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/sprite_loader/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_ResSprites; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_ResSprites; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log b/reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log new file mode 100644 index 0000000..1e9f53e --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/sprite_loader/compile-link.log @@ -0,0 +1,12 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_sprite_loader" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/sprite_loader/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/sprite_loader/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/res/KM_ResSprites.pas(5,17) Fatal: Can't find unit LCLIntf used by KM_ResSprites +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/sprite_loader/target.json b/reports/runs/20260908T164542Z-0843e132/sprite_loader/target.json new file mode 100644 index 0000000..a81c78a --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/sprite_loader/target.json @@ -0,0 +1,91 @@ +{ + "profile": "sprite_loader", + "name": "kam_probe_sprite_loader", + "package": "org.kammobile.archprobe.spriteloader", + "cpu": "aarch64", + "units": [ + "KM_ResSprites" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_io/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/terrain_io/CastleEngineManifest.xml new file mode 100644 index 0000000..ddaea0c --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_io/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_io/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/terrain_io/ProbeImports.pas new file mode 100644 index 0000000..f0a48a0 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_io/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_TerrainUtils; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_TerrainUtils; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log b/reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log new file mode 100644 index 0000000..aa06670 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_io/compile-link.log @@ -0,0 +1,19 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_terrain_io" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/terrain_io/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/terrain_io/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonTypes.pas(79,57) Note: Values in enumeration types have to be ascending +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(586,3) Note: Local variable "Encoding" not used +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1504,22) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1513,42) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1639,49) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1665,33) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/common/KM_CommonClasses.pas(1675,18) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/io/KM_FileIO.pas(5,16) Fatal: Can't find unit lconvencoding used by KM_FileIO +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_io/target.json b/reports/runs/20260908T164542Z-0843e132/terrain_io/target.json new file mode 100644 index 0000000..d38e4e6 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_io/target.json @@ -0,0 +1,91 @@ +{ + "profile": "terrain_io", + "name": "kam_probe_terrain_io", + "package": "org.kammobile.archprobe.terrainio", + "cpu": "aarch64", + "units": [ + "KM_TerrainUtils" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/CastleEngineManifest.xml b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/CastleEngineManifest.xml new file mode 100644 index 0000000..4f2914e --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/CastleEngineManifest.xml @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + DBG_SKIP_SECURE_AUTH + + + + + + + + + + + \ No newline at end of file diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/ProbeImports.pas b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/ProbeImports.pas new file mode 100644 index 0000000..43fd5be --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/ProbeImports.pas @@ -0,0 +1,12 @@ +unit ProbeImports; +{$mode delphi}{$H+} +interface +uses ProbeReport; +procedure RunUpstreamChecks(R:TProbeReport); +implementation +uses SysUtils ,KM_Terrain; +procedure RunUpstreamChecks(R:TProbeReport); +begin + R.Add('upstream.imports','PASS','Real imported units initialized: KM_Terrain; this does not execute a game world'); +end; +end. diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log new file mode 100644 index 0000000..5d19ed3 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/compile-link.log @@ -0,0 +1,12 @@ +$ castle-engine --os=android --cpu=aarch64 --compiler=fpc --mode=debug compile +Compiling project "kam_probe_terrain_pathfinding" for OS / CPU "android / aarch64" in mode "debug". +FPC executing... +Free Pascal Compiler version 3.2.2 [2026/08/04] for aarch64 +Copyright (c) 1993-2021 by Florian Klaempfl and others +/work/build/20260908T164542Z-0843e132/terrain_pathfinding/./code/ProbePlatform.pas(52,13) Warning: Implicit string type conversion from "AnsiString" to "UnicodeString" +/work/build/20260908T164542Z-0843e132/terrain_pathfinding/./code/ProbePlatform.pas(52,21) Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString" +/work/vendor/kam_remake/src/utils/KromUtils.pas(7,18) Fatal: Can't find unit LCLType used by KromUtils +Fatal: Compilation aborted +Error: /usr/local/fpclazarus/3.2.2/fpc/bin/ppcrossa64 returned an error exitcode +Exception "Exception": +Failed to compile diff --git a/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/target.json b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/target.json new file mode 100644 index 0000000..b17a83b --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/terrain_pathfinding/target.json @@ -0,0 +1,91 @@ +{ + "profile": "terrain_pathfinding", + "name": "kam_probe_terrain_pathfinding", + "package": "org.kammobile.archprobe.terrainpathfinding", + "cpu": "aarch64", + "units": [ + "KM_Terrain" + ], + "source_paths": [ + "/work/vendor/kam_remake", + "/work/vendor/kam_remake/src", + "/work/vendor/kam_remake/src/ai", + "/work/vendor/kam_remake/src/common", + "/work/vendor/kam_remake/src/controls", + "/work/vendor/kam_remake/src/forms", + "/work/vendor/kam_remake/src/game", + "/work/vendor/kam_remake/src/gui", + "/work/vendor/kam_remake/src/hands", + "/work/vendor/kam_remake/src/houses", + "/work/vendor/kam_remake/src/maped", + "/work/vendor/kam_remake/src/media", + "/work/vendor/kam_remake/src/minimap", + "/work/vendor/kam_remake/src/mission", + "/work/vendor/kam_remake/src/navmesh", + "/work/vendor/kam_remake/src/net", + "/work/vendor/kam_remake/src/pathfinding", + "/work/vendor/kam_remake/src/perflog", + "/work/vendor/kam_remake/src/render", + "/work/vendor/kam_remake/src/res", + "/work/vendor/kam_remake/src/scripting", + "/work/vendor/kam_remake/src/settings", + "/work/vendor/kam_remake/src/terrain", + "/work/vendor/kam_remake/src/units", + "/work/vendor/kam_remake/src/unused", + "/work/vendor/kam_remake/src/utils", + "/work/vendor/kam_remake/src/ai/newAI", + "/work/vendor/kam_remake/src/game/gip", + "/work/vendor/kam_remake/src/game/misc", + "/work/vendor/kam_remake/src/game/notifications", + "/work/vendor/kam_remake/src/gui/pages_common", + "/work/vendor/kam_remake/src/gui/pages_game", + "/work/vendor/kam_remake/src/gui/pages_maped", + "/work/vendor/kam_remake/src/gui/pages_menu", + "/work/vendor/kam_remake/src/net/http", + "/work/vendor/kam_remake/src/units/actions", + "/work/vendor/kam_remake/src/units/tasks", + "/work/vendor/kam_remake/src/utils/algorithms", + "/work/vendor/kam_remake/src/utils/io", + "/work/vendor/kam_remake/src/utils/method_parser", + "/work/vendor/kam_remake/src/gui/pages_maped/menu", + "/work/vendor/kam_remake/src/gui/pages_maped/mission", + "/work/vendor/kam_remake/src/gui/pages_maped/player", + "/work/vendor/kam_remake/src/gui/pages_maped/terrain", + "/work/vendor/kam_remake/src/gui/pages_maped/town", + "/work/vendor/kam_remake/src/ext", + "/work/vendor/kam_remake/src/ext/BGRABitmap", + "/work/vendor/kam_remake/src/ext/LNet", + "/work/vendor/kam_remake/src/ext/LazarusOpenGL", + "/work/vendor/kam_remake/src/ext/OggVorbis", + "/work/vendor/kam_remake/src/ext/LNet/sys", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source", + "/work/vendor/kam_remake/src/ext/Virtual-TreeView/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/dunit", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Extras", + "/work/vendor/kam_remake/src/ext/Overbyte ICS 8/Source/Include", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/DataAbstract", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Addon/RemObjects SDK", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Debug", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/IDE", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Import", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/Kylix", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/RemObjects SDK Client", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Samples/TestApp", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/Source/ThirdParty", + "/work/vendor/kam_remake/src/ext/pascalscript_submodule/unit-importing/Import" + ], + "compiler_options": [ + "-B", + "-CX-", + "-XX-", + "-k--no-undefined", + "-k--no-gc-sections" + ], + "upstream_defines": [ + "DBG_SKIP_SECURE_AUTH" + ], + "assets": [], + "shims": false +} diff --git a/reports/runs/20260908T164542Z-0843e132/toolchain.json b/reports/runs/20260908T164542Z-0843e132/toolchain.json new file mode 100644 index 0000000..00dc0e4 --- /dev/null +++ b/reports/runs/20260908T164542Z-0843e132/toolchain.json @@ -0,0 +1,59 @@ +{ + "castle": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.008, + "command": [ + "castle-engine", + "--version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/castle-version.log", + "output": "$ castle-engine --version\ncastle-engine 7.0-alpha.3.snapshot\n" + }, + "fpc": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "fpc", + "-iV" + ], + "log": "reports/runs/20260908T164542Z-0843e132/fpc-version.log", + "output": "$ fpc -iV\n3.2.2\n" + }, + "java": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.067, + "command": [ + "java", + "-version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/java-version.log", + "output": "$ java -version\nopenjdk version \"17.0.20\" 2026-07-21\nOpenJDK Runtime Environment (build 17.0.20+8-1-deb12u1-Debian)\nOpenJDK 64-Bit Server VM (build 17.0.20+8-1-deb12u1-Debian, mixed mode, sharing)\n" + }, + "adb": { + "status": "PASS", + "exit_code": 0, + "seconds": 0.004, + "command": [ + "adb", + "version" + ], + "log": "reports/runs/20260908T164542Z-0843e132/adb-version.log", + "output": "$ adb version\nAndroid Debug Bridge version 1.0.41\nVersion 37.0.1-15733141\nInstalled as /usr/local/android/android-sdk/platform-tools/adb\nRunning on Linux 6.8.0-139-generic (x86_64)\n" + }, + "paths": { + "CASTLE_ENGINE_PATH": "/usr/local/castle-engine/", + "ANDROID_HOME": "/usr/local/android/android-sdk/", + "JAVA_HOME": "/usr/lib/jvm/java-17-openjdk-amd64/", + "FPCDIR": "/usr/local/fpclazarus/3.2.2/fpc/lib/fpc/3.2.2/" + }, + "docker_image_lock": { + "image": "kambi/castle-engine-cloud-builds-tools@sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "image_id": "sha256:1a67fad233fe7a2e81ed5f750b548c9ef136ed7d36ec061ff96b2e5eb6eaa218", + "resolved_from": "kambi/castle-engine-cloud-builds-tools:cge-unstable", + "locked_at": "20260908T161942Z", + "note": "Subsequent runs use this digest, never silently advance the tag." + } +} diff --git a/vendor/README.md b/vendor/README.md new file mode 100644 index 0000000..7110487 --- /dev/null +++ b/vendor/README.md @@ -0,0 +1,17 @@ +# Закреплённые иÑходники + +При запуÑке Ñервер Ñоздаёт `kam_remake/` и получает только иÑходный текÑÑ‚ r16020 +Ð¿Ð»ÑŽÑ PascalScript по закреплённому gitlink. Полный upstream в иÑходный ZIP не вложен. +Игровые реÑурÑÑ‹, бинарные библиотеки и release ZIP не ÑкачиваютÑÑ. + +Команда только Ð´Ð»Ñ Ð¿Ð¾Ð´Ð³Ð¾Ñ‚Ð¾Ð²ÐºÐ¸ кода: + +```bash +python3 tools/source_fetch.py +python3 tools/source_fetch.py --verify +``` + +Команды запуÑкать из ÐºÐ¾Ñ€Ð½Ñ Ð¿Ñ€Ð¾ÐµÐºÑ‚Ð°. Обычно отдельный вызов не нужен: +`build-android.sh` делает Ñто автоматичеÑки. `SOURCE_RECEIPT.json` фикÑирует каждый +файл; лицензии иÑходных проектов загружаютÑÑ Ð¸ ÑохранÑÑŽÑ‚ÑÑ Ð²Ð¼ÐµÑте Ñ Ð¸Ñходниками. +Ðе подменÑÑ‚ÑŒ baseline заглушками и не клаÑÑ‚ÑŒ Ñюда игровые бинарные данные. diff --git a/vendor/kam_remake/Installer/License.bel.txt b/vendor/kam_remake/Installer/License.bel.txt new file mode 100644 index 0000000..44a3c22 --- /dev/null +++ b/vendor/kam_remake/Installer/License.bel.txt @@ -0,0 +1,8 @@ +Êàìýðöûéíàå âûêàðûñòàííå ñòðîãà çàáàðîíåíà! + +¡ñå âûêàðûñòàíû ³ì¸íû, ñ³ìâàëû àáî ³íøûÿ àáàðîíåíûÿ à¢òàðñê³ì³ ïðàâàì³ ìàòýðûÿëû, ç'ÿ¢ëÿþööà ¢ëàñíàñöþ ³õ óëàäàëüí³êà¢. + +Ìû íå íÿñåì àäêàçíàñö³, êàë³ äàäçåíû ìîä (KaM Remake) íàíÿñå ¢ðîí ïðàãðàìíàìó àáî àïàðàòíàìó çàáåñïÿ÷ýííþ Âàøàãà êàìïóòàðà. + +Ìû ìÿðêóåì, øòî Âû âàëîäàåöå ¢ëàñíàé ë³öýíç³éíàé êîï³ÿé iãðû "Knights and Merchants: The Peasants Rebellion", ó àäâàðîòíûì ðàçå Âàì íåàáõîäíà +êóï³öü ÿå, ïåðàä òûì ÿê Âû ïà÷íåöå iãðàöü ¢ KaM Remake. Íåâûêàíàííå ãýòàãà ïàòðàáàâàííÿ áóäçå ïàðóøýííåì ë³öýíç³éíàé äàìîâû. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.bul.txt b/vendor/kam_remake/Installer/License.bul.txt new file mode 100644 index 0000000..9b5e1d6 --- /dev/null +++ b/vendor/kam_remake/Installer/License.bul.txt @@ -0,0 +1,7 @@ +Êîìåðñèàëíàòà öåë å ñòðèêòíî çàáðàíåíà! + +Âñÿêàêâè èçïîëçâàíè èìåíà, ñèìâîëè èëè äðóãè ìàòåðèàëè ñ àâòîðñêî ïðàâî å ñîáñòâåíîñò íà ñúîòâåòíèòå ñîáñòâåíèöè. + +Íèå íå ïîåìàìå íèêàêâè îòãîâîðíîñòè, àêî òîçè ìîä ïîâðåäè âàøèÿ ñîôòóåð èëè õàðäóåð. + +Èçèñêâà ñå Âèå (ñúîòâåòíèÿò ïîòðåáèòåë/èãðà÷) äà ïðèòåæàâàòå ëèöåíçèðàíî êîïèå íà èãðàòà Knights and Merchants: The Peasants Rebellion, â ïðîòèâåí ñëó÷àé òðÿáâà äà ñè êóïèòå èãðàòà ïðåäè äà èãðàåòå íà òîçè ìîä. Àêî íå íàïðàâèòå òîâà, ùå íàðóøèòå ñïîðàçóìåíèåòî. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.chn.txt b/vendor/kam_remake/Installer/License.chn.txt new file mode 100644 index 0000000..3d36b96 --- /dev/null +++ b/vendor/kam_remake/Installer/License.chn.txt @@ -0,0 +1,7 @@ +ÉÌÒµÓÃ;ÊÇÑϸñ½ûÖ¹µÄ£¡ + +ÈκÎʹÓõÄÃû×Ö£¬·ûºÅ£¬»òÆäËûÊÜ°æȨ±£»¤µÄ²ÄÁÏ£¬¶¼ÊÇÆä¸÷×ÔËùÓÐÕߵIJƲú¡£ + +Èç¹ûÕâ¸öÓÎÏ·³ÌÐòΣº¦ÄãµÄÈí¼þ»òÓ²¼þ£¬ÎÒÃDz»³Ðµ£ÈκÎÔðÈΡ£ + +Äã±ØÐë»ñÈ¡¡¶ÆïÊ¿ÓëÉÌÈË֮ũÃñÆðÒå¡·µÄÐí¿É¸±±¾£¬·ñÔòÄãÔÚÔËÐÐÓÎϷ֮ǰӦ¸Ã¹ºÂò´ËÓÎÏ·¡£Èç¹û²»Õâô×ö£¬½«ÊÇÎ¥·´Ðí¿ÉЭÒé¡£ \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.cze.txt b/vendor/kam_remake/Installer/License.cze.txt new file mode 100644 index 0000000..ea22db8 --- /dev/null +++ b/vendor/kam_remake/Installer/License.cze.txt @@ -0,0 +1,8 @@ +Použití pro komerÄní úÄely přísnÄ› zakázáno! + +Použité názvy, symboly a ostatní materiály náleží jejich právoplatným vlastníkům. + +Neneseme žádnou zodpovÄ›dnost za případné poÅ¡kození vaÅ¡eho softwaru nebo hardwaru. + +Je vyžadováno vlastnictví oficiální kopie hry Knights and Merchants: The Peasant Rebellion, v jiném případÄ› si hru, prosím zakupte pÅ™ed použitím tohoto módu. +Pokud tak neuÄiníte, porušíte licenÄní smlouvu. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.dut.txt b/vendor/kam_remake/Installer/License.dut.txt new file mode 100644 index 0000000..e5ab589 --- /dev/null +++ b/vendor/kam_remake/Installer/License.dut.txt @@ -0,0 +1,8 @@ +Commercieel gebruik van deze software is niet toegestaan! + +Gebruik van namen, symbolen of andere beschermde material is eigendom van de respectievelijke eigenaren. + +Wij nemen geen verantwoordelijkheid als deze mod enige schade aanricht aan software en hardware. + +Het is nodig dat jij (speler) een licentie heb op het spel Knights and Merchants: The Peasants Rebellion, anders moet je het spel kopen voor het spelen van deze mod. +Als dit niet wordt gedaan is dit een rechtstreekse breuk op de gebruikers licentie overeenkomst. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.eng.txt b/vendor/kam_remake/Installer/License.eng.txt new file mode 100644 index 0000000..457eb62 --- /dev/null +++ b/vendor/kam_remake/Installer/License.eng.txt @@ -0,0 +1,7 @@ +Commercial use is strictly prohibited! + +Any used names, symbols or other copyrighted material is the property of the respective owners. + +We do not take any responsibility if this mod harms your software or hardware. + +It is required that you (the end user/player) own a licensed copy of the game Knights and Merchants: The Peasants Rebellion, otherwise you should buy the game before using this mod. Failing to do so will be breaching the License Agreement. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.est.txt b/vendor/kam_remake/Installer/License.est.txt new file mode 100644 index 0000000..02d82e0 --- /dev/null +++ b/vendor/kam_remake/Installer/License.est.txt @@ -0,0 +1,7 @@ +Kaubanduslik kasuamine on rangelt keelatud! + +Iga kasutatud nimi, sümbol või muu autoriõigustega kaitstud materjal kuulub nende omanikele. + +Me ei võta vastutust, kui see modifikatsioon kahjustab teie tarkvara või riistvara. + +On nõutud, et Te (lõppkasutaja/mängija) omate lintsentseeritud koopiat mängust Knights and Merchants: The Peasants Rebellion, vastasel juhul Te peaksite ostma mängu enne selle modifikatsiooni kasutamist. Seda mitte tehes rikute Te litsendsi kokkulepet. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.fin.txt b/vendor/kam_remake/Installer/License.fin.txt new file mode 100644 index 0000000..d24ffab --- /dev/null +++ b/vendor/kam_remake/Installer/License.fin.txt @@ -0,0 +1,7 @@ +Kaupallinen käyttö on ehdottomasti kielletty! + +Kaikki käytetyt nimet, symbolit tai muu tekijänoikeudella suojattu materiaali ovat vastaavien omistajien omaisuutta. + +Emme ole vastuussa mistään, jos tämä modifikaatio pelistä vahingoittaa ohjelmistojasi tai laitteistojasi. + +Sinun (Loppukäyttäjän/Pelaajan) tulee omistaa Knights and Merchants: The Peasants Rebellion -pelin lisensoitu kopio, muuten sinun tulee ostaa peli ennen tämän modin käyttöä. Jos näin ei tehdä, se rikkoo lisenssisopimusta. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.fre.txt b/vendor/kam_remake/Installer/License.fre.txt new file mode 100644 index 0000000..597c293 --- /dev/null +++ b/vendor/kam_remake/Installer/License.fre.txt @@ -0,0 +1,8 @@ +L'utilisation commerciale de ce logiciel est strictement interdite ! + +Tous les noms, symboles ou autres matériaux sous copyright utilisés sont de la propriété de leurs auteurs respectifs. + +Nous ne prendrons aucune responsabilité si cette modification entraîne l'endommagement de votre logiciel ou de votre matériel. + +Il est nécessaire que vous (utilisateur final) ayez une copie du jeu Knights and Merchants : The Peasants Rebellion sous licence, autrement il vous faudra l'acheter avant de pouvoir utiliser cette modification. +Ne pas le faire serait briser le Contrat de licence. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.ger.txt b/vendor/kam_remake/Installer/License.ger.txt new file mode 100644 index 0000000..db9e196 --- /dev/null +++ b/vendor/kam_remake/Installer/License.ger.txt @@ -0,0 +1,8 @@ +Kommerzielle Benutzung ist strengstens untersagt! + +Sämtliche Namen, Symbole oder anderes urheberrechtlich geschütztes Material ist das Eigentum des jeweiligen Besitzers. + +Wir übernehmen keinerlei Verantwortung, wenn diese Mod Ihrer Software oder Hardware schadet. + +Es wird vorausgesetzt, dass eine lizenzierte Kopie von Knights and Merchants: The Peasants Rebellion vorhanden ist, andererseits muss das Spiel erst vor dem Einsatz der Mod gekauft werden. +Sollte versucht werden, dies zu umgehen, wird die Lizenzvereinbarung verletzt. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.hun.txt b/vendor/kam_remake/Installer/License.hun.txt new file mode 100644 index 0000000..fe13b8f --- /dev/null +++ b/vendor/kam_remake/Installer/License.hun.txt @@ -0,0 +1,10 @@ +Kereskedelmi forgalomba hozni tilos! + +Minden használt név, szimbólum vagy egyéb jogvédett tartalom a megfelelÅ‘ tulajdonosok tulajdonát képezik. +. + +Nem vállalunk semmilyen felelÅ‘sséget, ha ez a módosítás kárt okoz a szoftverben vagy hardverben. + +Szükséges, hogy a felhasználó/játékos birtokában legyen egy legális példány a Knights and Merchants: A Parasztfelkelés játékból, különben a mod használata elÅ‘tt ezt meg kell vásárolni. +. +Ennek elmulasztása a licencszerzÅ‘dés megszegését jelenti. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.ita.txt b/vendor/kam_remake/Installer/License.ita.txt new file mode 100644 index 0000000..9bc59bf --- /dev/null +++ b/vendor/kam_remake/Installer/License.ita.txt @@ -0,0 +1,7 @@ +L'uso commerciale è severamente vietato! + +Tutti i nomi, i simboli o altro materiale coperto da copyright che siano stati utilizzati appartengono ai rispettivi proprietari. + +Non ci assumiamo alcuna responsabilità per eventuali danni software o hardware causati da questa mod. + +È necessario che voi (l'utente finale/giocatore) possediate una copia autorizzata del gioco "Knights and Merchants: The Peasants Rebellion"; in caso contrario, dovete acquistarne una prima di utilizzare questa mod. Non farlo costituisce violazione del Contrato di Licenza. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.jpn.txt b/vendor/kam_remake/Installer/License.jpn.txt new file mode 100644 index 0000000..81e476a --- /dev/null +++ b/vendor/kam_remake/Installer/License.jpn.txt @@ -0,0 +1,7 @@ +¤‹Æ‚ÌŽg—p‚ªŒµŠi‚É‹ÖŽ~‚³‚ê‚Ü‚µ‚Ä‚¢‚é‚æB + +‰½‚ç‚©‚ÌŽg‚Á‚Ä‚¢‚é–¼‘O‚â‹L†‚⑼‚Ì’˜ìŒ ‚ŕی삳‚ê‚éÞ—¿‚Í ‚»‚ꂼ‚ê‚ÌŠ—LŽÒ‚ÉàŽY‚Å‚·B + +‚±‚ÌMOD‚̓Aƒiƒ^‚̃n[ƒhƒEƒFƒA‚Ü‚½‚̓\ƒtƒgƒEƒFƒA‚𑹂ȂÁ‚½‚çC‰äX‚ªˆøÓ‚³‚ê‚È‚¢B + +Š—L‚³‚ê‚é"Knights and Merchants: The Peasants Rebellion"ƒQ[ƒ€‚̃‰ƒCƒZƒ“ƒXƒRƒs[‚Í•K—v‚Å‚·B‚³‚à‚È‚¯‚ê‚ÎA‚±‚Ìmod‚ðŽg—p‚·‚é‘O‚ɃIƒŠƒWƒiƒ‹‚̃Q[ƒ€‚ðw“ü‚·‚é•K—v‚ª‚ ‚è‚Ü‚·B‚»‚¤‚µ‚È‚¢‚ƃ‰ƒCƒZƒ“ƒXŒ_–ñ‚ª“Ë”j‚³‚ê‚Ü‚·B diff --git a/vendor/kam_remake/Installer/License.kor.txt b/vendor/kam_remake/Installer/License.kor.txt new file mode 100644 index 0000000..5042a14 --- /dev/null +++ b/vendor/kam_remake/Installer/License.kor.txt @@ -0,0 +1,7 @@ +»ó¾÷ÀûÀÎ ¸ñÀûÀ¸·Î »ç¿ëµÇ´Â°ÍÀ» ¾ö°ÝÇÏ°Ô ±ÝÁöÇÕ´Ï´Ù.! + +ÀÌ °ÔÀÓ¿¡ »ç¿ëµÇ´Â ¸ðµç À̸§, ±âÈ£ ¶Ç´Â ±×¿Ü ÀúÀÛ±ÇÀÌ ÀÖ´Â ÀÚ·áµéÀº ÇØ´ç ¼ÒÀ¯ÀÚÀÇ Àç»êÀÔ´Ï´Ù. + +ÀÌ ¸ðµå(MOD)´Â ¼ÒÇÁÆ®¿þ¾î ¶Ç´Â Çϵå¿þ¾î¸¦ ¼Õ»ó½Ãų°æ¿ì ¾î¶² ¹ýÀû Ã¥ÀÓÀ» ÁöÁö ¾Ê½À´Ï´Ù. + +±ÍÇÏ(ÃÖÁ¾ »ç¿ëÀÚ/Ç÷¹À̾î)´Â '±â»ç¿Í »óÀÎ: ³ó¹ÎÀÇ ¹Ý¶õ' °ÔÀÓÀÇ Á¤Ç°À» ¼ÒÀ¯ÇØ¾ß ÇÕ´Ï´Ù, ±×·¸Áö ¾ÊÀ¸¸é ±ÍÇÏ´Â ÀÌ ¸ðµå¸¦ »ç¿ëÇϱâ Àü¿¡ °ÔÀÓÀ» ±¸¸ÅÇØ¾ß ÇÕ´Ï´Ù. ±×·¸°ÔÇÏÁö ¾ÊÀ¸¸é »ç¿ë±Ç °è¾àÀ» À§¹ÝÇÏ´Â °ÍÀÔ´Ï´Ù. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.nor.txt b/vendor/kam_remake/Installer/License.nor.txt new file mode 100644 index 0000000..d789737 --- /dev/null +++ b/vendor/kam_remake/Installer/License.nor.txt @@ -0,0 +1,7 @@ +Kommersiell bruk er strengt forbudt! + +Alle brukte navn, symboler eller annet opphavsrettsbeskyttet materiale eies av deres juridiske eiere. + +Vi tar intet ansvar dersom denne modifikasjonen skader din programvare eller maskinvare. + +Det kreves at du (sluttbrukeren/-spilleren) eier en lisensert kopi av spillet Knights and Merchants: The Peasants Rebellion, ellers burde du kjøpe spillet før du bruker denne modifikasjonen. Dersom dette ikke følges, er det et brudd pÃ¥ lisensavtalen. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.pol.txt b/vendor/kam_remake/Installer/License.pol.txt new file mode 100644 index 0000000..5a0078e --- /dev/null +++ b/vendor/kam_remake/Installer/License.pol.txt @@ -0,0 +1,8 @@ +Komercyjne użycie jest surowo zabronione! + +Wszelkie użyte nazwy, symbole i inne materiaÅ‚y chronione prawem autorskim sÄ… wÅ‚asnoÅ›ciÄ… poszczególnych wÅ‚aÅ›cicieli. + +Nie bierzemy żadnej odpowiedzialnoÅ›ci, jeÅ›li ten mod uszkodzi twoje oprogramowanie lub sprzÄ™t. + +Wymagane jest posiadanie wÅ‚asnej licencjonowanej kopii gry Knights and Merchants: The Peasants Rebellion, w przeciwnym razie należy kupić grÄ™ przed użyciem tego moda. +W przeciwnym razie bÄ™dzie to naruszeniem umowy licencyjnej. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.ptb.txt b/vendor/kam_remake/Installer/License.ptb.txt new file mode 100644 index 0000000..0ab9602 --- /dev/null +++ b/vendor/kam_remake/Installer/License.ptb.txt @@ -0,0 +1,8 @@ +O uso comercial é estritamente proibido! + +Qualquer nome, símbolo ou outros materiais usados, com direitos autorais são de propriedade de seus respectivos proprietários. + +Nós não nos responsabilizamos caso esse mod cause danos ao seu software ou hardware. + +É necessário que você (usuário final/jogador) tenha uma cópia licenciada do jogo Knights and Merchants: The Peasants Rebellion +Caso não tenha, você estará violando o Contrato de Licença. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.rom.txt b/vendor/kam_remake/Installer/License.rom.txt new file mode 100644 index 0000000..038f018 --- /dev/null +++ b/vendor/kam_remake/Installer/License.rom.txt @@ -0,0 +1,7 @@ +Folosirea în scop comercial este interzisã + +Nume, simboluri si alte material cu drepturi de autor este proprietatea detinãtorilor. + +Nu ne asumãm nicio rãspundere dacã acest program vã dãuneazã sistemului dumneavoastrã. + +Este necesar ca din partea ta(utilizator final/jucãtor)sã detii o copie originalã a jocului Knights and Merchants: The Peasants Rebellion, altfel va trebui sã cumperi jocul inainte de a folosi acest mod. Dacã nu faci asta vei încãlca Licenta. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.rus.txt b/vendor/kam_remake/Installer/License.rus.txt new file mode 100644 index 0000000..a73a8be --- /dev/null +++ b/vendor/kam_remake/Installer/License.rus.txt @@ -0,0 +1,7 @@ +Êîììåð÷åñêîå èñïîëüçîâàíèå ñòðîãî çàïðåùåíî! + +Âñå èñïîëüçîâàííûå èìåíà, ñèìâîëû èëè äðóãèå çàùèùåííûå àâòîðñêèìè ïðàâàìè ìàòåðèàëû, ÿâëÿþòñÿ ñîáñòâåííîñòüþ èõ âëàäåëüöåâ. + +Ìû íå íåñåì îòâåòñòâåííîñòè, åñëè äàííûé ìîä (ÊàÌ Ðåìåéê) íàíåñåò óùåðá ïðîãðàììíîìó èëè àïïàðàòíîìó îáåñïå÷åíèþ Âàøåãî êîìïüþòåðà. + +Ìû ïðåäïîëàãàåì, ÷òî Âû (ïîëüçîâàòåëü/èãðîê) ðàñïîëàãàéòå ñîáñòâåííîé ëèöåíçèîííîé êîïèåé èãðû "Knights and Merchants: The Peasants Rebellion", â ïðîòèâíîì ñëó÷àå Âàì ñëåäóåò êóïèòü èãðó, ïðåæäå ÷åì Âû íà÷íåòå èãðàòü â ÊàÌ Ðåìåéê. Íåâûïîëíåíèå ýòîãî òðåáîâàíèÿ áóäåò íàðóøåíèåì ëèöåíçèîííîãî ñîãëàøåíèÿ. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.slv.txt b/vendor/kam_remake/Installer/License.slv.txt new file mode 100644 index 0000000..57b653f --- /dev/null +++ b/vendor/kam_remake/Installer/License.slv.txt @@ -0,0 +1,7 @@ +Komercialna uporaba je strogo prepovedana! + +Katerakoli imena, simboli ali drugi materiali ki so zaÅ¡Äiteni s pravicam so last uglednih lastnikov. + +Mi ne jemljemo kakrÅ¡nekoli odgovornosti Äe ta predelava Å¡koduje vaÅ¡emu raÄunalniku + +potrebno je da imate vi (konÄni uporabnik/igralec) svojo licenÄno kopijo igre Knights and Merchants: The Peasants Rebellion, Äe je nimate morate kupiti igro preden uporabljate to predelavo. ÄŒe tega ne boste storili boste prekrÅ¡ili licenÄne pravila. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.spa.txt b/vendor/kam_remake/Installer/License.spa.txt new file mode 100644 index 0000000..b414410 --- /dev/null +++ b/vendor/kam_remake/Installer/License.spa.txt @@ -0,0 +1,7 @@ +¡El uso comercial está estrictamente prohibido! + +Cualquier nombre utilizado, símbolos o cualquier otro material sujeto a copyright es propiedad de sus respectivos propietarios. + +No nos hacemos resposables si este mod daña su software o hardware. + +Es imprescindible que usted (el usuario final / jugador) debe tener una copia con licencia de juego de Knights and Merchants: The Peasants Rebellion, de lo contrario usted debe comprar el juego antes de usar este mod. De no hacerlo, estará violando el Acuerdo de Licencia. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.srb.txt b/vendor/kam_remake/Installer/License.srb.txt new file mode 100644 index 0000000..d9d3fe9 --- /dev/null +++ b/vendor/kam_remake/Installer/License.srb.txt @@ -0,0 +1,7 @@ +Комерцијална употреба је Ñтриктно забрањена! + +Било која коришћена имена, Ñимболи или материјали под ауторÑким правом Ñу влаÑништвом Ñвојим влаÑницима. + +Ми не узимамо одговорноÑÑ‚ ако вам ова модификација науди ÑиÑтему,харедверу или Ñофтверу. + +Потребно је да ви као (играч/кориÑник) имате оригиналну копију игре Knights and Merchants: The Peasants Rebellion, у Ñупротном требате да купите игру пре коришћења модификације. Ðко не иÑпуните потребне Ñтвари,нећете Ñе придржавати оригиналне лиценÑе. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.svk.txt b/vendor/kam_remake/Installer/License.svk.txt new file mode 100644 index 0000000..8f3380a --- /dev/null +++ b/vendor/kam_remake/Installer/License.svk.txt @@ -0,0 +1,7 @@ +Komerèné použitie je prísne zakázané! + +Všetky použité názvy, symboly alebo iný autorsky chránený materiál je majetkom príslušných vlastníkov. + +Nemáme žiadnu zodpovednos, ak tento mód poškodí softvér alebo hardvér. + +Je nutné, aby ste (koncový užívate¾ / hráè) vlastnili alebo si zakúpili licencovanú kópiu hry Knights and Merchants: The Peasants Rebellion pred použitím tohto módu. Ak tak neurobíte, budú porušované licenèné zmluvy. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.swe.txt b/vendor/kam_remake/Installer/License.swe.txt new file mode 100644 index 0000000..f19212d --- /dev/null +++ b/vendor/kam_remake/Installer/License.swe.txt @@ -0,0 +1,8 @@ +Kommersiell användning är strängt förbjudet! + +Alla använda namn, symboler och annat upphovsrättsskyddat material tillhör dess respektive ägare. + +Vi tar inte något ansvar för eventuella skador på mjukvara eller hårdvara som en följd av att använda KaM Remake. + +Det krävs att du (slutanvändaren/spelaren) äger ett äkta exemplar av spelet Knights och +Merchants: The Peasants Rebellion, annars ska du köpa spelet innan du använder KaM Remake. Att inte göra det bryter mot licensavtalet. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.tur.txt b/vendor/kam_remake/Installer/License.tur.txt new file mode 100644 index 0000000..60535ed --- /dev/null +++ b/vendor/kam_remake/Installer/License.tur.txt @@ -0,0 +1,5 @@ +Ticari kullaným kesinlikle yasaktýr! + +Kullanýlan her bir isim, sembol veya diðer kayýtlý metaryellerin telif hakký oyun sahiplerine aittir. + +Orijinal bir Knights and Merchants: The Peasants Rebellion ürününe sahip olmanýz gerekmektedir, aksi takdirde bu modu kullanmadan önce oyunu satýn almanýz gerekmektedir. Eðer orijinal oyuna sahip deðilseniz kurulum yapýlmayacaktýr. \ No newline at end of file diff --git a/vendor/kam_remake/Installer/License.ukr.txt b/vendor/kam_remake/Installer/License.ukr.txt new file mode 100644 index 0000000..cdc42a8 --- /dev/null +++ b/vendor/kam_remake/Installer/License.ukr.txt @@ -0,0 +1,7 @@ +Êîìåðö³éíå âèêîðèñòàííÿ ñóâîðî çàáîðîíåíå! + +Áóäü-ÿê³ âèêîðèñòàí³ ³ìåíà, ñèìâîëè àáî ³íøèé çàõèùåíèé àâòîðñüêèì ïðàâîì ìàòåð³àë - ìàéíî â³äïîâ³äíèõ âëàñíèê³â. + +Ìè íå áåðåìî í³ÿêî¿ â³äïîâ³äàëüíîñò³, ÿêùî öåé ìîä çàøêîäèòü âàøîìó ïðîãðàìíîìó àáî òåõí³÷íîìó çàáåçïå÷åííþ. + +Íåîáõ³äíî, ùîá âè( êîðèñòóâà÷à/ãðàâåöü ) âîëîä³ëè ë³öåíç³éíîþ êîﳺþ ³ãðîâèõ Knights and Merchants : The Peasants Rebellion, ³íàêøå âè ïîâèíí³ êóïèòè ãðó ïåðåä êîðèñòóâàííÿì öèì ìîäîì. ßêùî âè òàê íå çðîáèòå öå ïîðóøèòü ˳öåíç³éíó Óãîäó. \ No newline at end of file diff --git a/vendor/kam_remake/KM_NetProtocolRevision.inc b/vendor/kam_remake/KM_NetProtocolRevision.inc new file mode 100644 index 0000000..9d4b059 --- /dev/null +++ b/vendor/kam_remake/KM_NetProtocolRevision.inc @@ -0,0 +1 @@ +NET_PROTOCOL_REVISION_NUM = 16000 diff --git a/vendor/kam_remake/KM_Revision.inc b/vendor/kam_remake/KM_Revision.inc new file mode 100644 index 0000000..454daef --- /dev/null +++ b/vendor/kam_remake/KM_Revision.inc @@ -0,0 +1 @@ +GAME_REVISION_NUM=16020 diff --git a/vendor/kam_remake/KM_TextIDs.inc b/vendor/kam_remake/KM_TextIDs.inc new file mode 100644 index 0000000..d300775 --- /dev/null +++ b/vendor/kam_remake/KM_TextIDs.inc @@ -0,0 +1,1677 @@ +TX_HOUSES_NAMES__29 = 0; //Sawmill +TX_HOUSES_NAMES_IRONSMITHY = 1; //Iron smithy +TX_HOUSES_NAMES_WEAPONSMITHY = 2; //Weapon smithy +TX_HOUSES_NAMES_COALMINE = 3; //Coal mine +TX_HOUSES_NAMES_IRONMINE = 4; //Iron mine +TX_HOUSES_NAMES_GOLDMINE = 5; //Gold mine +TX_HOUSES_NAMES_FISHERMANS = 6; //Fisherman's +TX_HOUSES_NAMES_BAKERY = 7; //Bakery +TX_HOUSES_NAMES_FARM = 8; //Farm +TX_HOUSES_NAMES_WOODCUTTERS = 9; //Woodcutter's +TX_HOUSES_NAMES_ARMORSMITHY = 10; //Armor smithy +TX_HOUSES_NAMES_STOREHOUSE = 11; //Storehouse +TX_HOUSES_NAMES_STABLES = 12; //Stables +TX_HOUSES_NAMES_SCHOOLHOUSE = 13; //Schoolhouse +TX_HOUSES_NAMES_QUARRY = 14; //Quarry +TX_HOUSES_NAMES_METALLURGISTS = 15; //Metallurgist's +TX_HOUSES_NAMES_SWINEFARM = 16; //Swine farm +TX_HOUSES_NAMES_WATCHTOWER = 17; //Watchtower +TX_HOUSES_NAMES_TOWNHALL = 18; //Town hall +TX_HOUSES_NAMES_WEAPONSWORKSHOP = 19; //Weapons workshop +TX_HOUSES_NAMES_ARMORYWORKSHOP = 20; //Armory workshop +TX_HOUSES_NAMES_BARRACKS = 21; //Barracks +TX_HOUSES_NAMES_MILL = 22; //Mill +TX_HOUSES_NAMES_SIEGEWORKSHOP = 23; //Siege workshop +TX_HOUSES_NAMES_BUTCHERS = 24; //Butcher's +TX_HOUSES_NAMES_TANNERY = 25; //Tannery +TX_HOUSES_NAMES_TRAININGHALL = 26; //Training hall +TX_HOUSES_NAMES_INN = 27; //Inn +TX_HOUSES_NAMES_VINEYARD = 28; //Vineyard +TX_HOUSES_NAMES_MARKETPLACE = 29; //Marketplace + +TX_RESOURCES_NAMES__27 = 30; //Tree trunks +TX_RESOURCES_STONES = 31; //Stones +TX_RESOURCES_TIMBER = 32; //Timber +TX_RESOURCES_IRONORE = 33; //Iron ore +TX_RESOURCES_GOLDORE = 34; //Gold ore +TX_RESOURCES_COAL = 35; //Coal +TX_RESOURCES_IRON = 36; //Iron +TX_RESOURCES_GOLD = 37; //Gold +TX_RESOURCES_WINEBARRELS = 38; //Wine barrels +TX_RESOURCES_CORN = 39; //Corn +TX_RESOURCES_LOAVES = 40; //Loaves +TX_RESOURCES_FLOUR = 41; //Flour +TX_RESOURCES_LEATHER = 42; //Leather +TX_RESOURCES_SAUSAGES = 43; //Sausages +TX_RESOURCES_PIGS = 44; //Pigs +TX_RESOURCES_SKINS = 45; //Skins +TX_RESOURCES_WOODENSHIELDS = 46; //Wooden shields +TX_RESOURCES_IRONSHIELDS = 47; //Iron shields +TX_RESOURCES_LEATHERARMOR = 48; //Leather armor +TX_RESOURCES_IRONARMOR = 49; //Iron armor +TX_RESOURCES_HANDAXES = 50; //Hand axes +TX_RESOURCES_SWORDS = 51; //Swords +TX_RESOURCES_LANCES = 52; //Lances +TX_RESOURCES_PIKES = 53; //Pikes +TX_RESOURCES_LONGBOWS = 54; //Longbows +TX_RESOURCES_CROSSBOWS = 55; //Crossbows +TX_RESOURCES_HORSES = 56; //Horses +TX_RESOURCES_FISH = 57; //Fish + +TX_UNITS_NAMES__29 = 58; //Serf +TX_UNITS_WOODCUTTER = 59; //Woodcutter +TX_UNITS_MINER = 60; //Miner +TX_UNITS_ANIMALBREEDER = 61; //Animal breeder +TX_UNITS_FARMER = 62; //Farmer +TX_UNITS_CARPENTER = 63; //Carpenter +TX_UNITS_BAKER = 64; //Baker +TX_UNITS_BUTCHER = 65; //Butcher +TX_UNITS_FISHERMAN = 66; //Fisherman +TX_UNITS_LABORER = 67; //Laborer +TX_UNITS_STONEMASON = 68; //Stonemason +TX_UNITS_BLACKSMITH = 69; //Blacksmith +TX_UNITS_METALLURGIST = 70; //Metallurgist +TX_UNITS_RECRUIT = 71; //Recruit +TX_UNITS_MILITIA = 72; //Militia +TX_UNITS_AXEFIGHTER = 73; //Axe fighter +TX_UNITS_SWORDFIGHTER = 74; //Sword fighter +TX_UNITS_BOWMAN = 75; //Bowman +TX_UNITS_CROSSBOWMAN = 76; //Crossbowman +TX_UNITS_LANCECARRIER = 77; //Lance carrier +TX_UNITS_PIKEMAN = 78; //Pikeman +TX_UNITS_SCOUT = 79; //Scout +TX_UNITS_KNIGHT = 80; //Knight +TX_UNITS_BARBARIAN = 81; //Barbarian +TX_UNITS_REBEL = 82; //Rebel +TX_UNITS_ROGUE = 83; //Rogue +TX_UNITS_WARRIOR = 84; //Warrior +TX_UNITS_VAGABOND = 85; //Vagabond +TX_UNITS_CATAPULT = 86; //Catapult +TX_UNITS_BALLISTA = 87; //Ballista +TX_UNITS_WOLF = 698; //Wolf +TX_UNITS_FISH = 699; //Fish +TX_UNITS_WATERSNAKE = 700; //Watersnake +TX_UNITS_SEASTAR = 701; //Seastar +TX_UNITS_CRAB = 702; //Crab +TX_UNITS_WATERFLOWER = 703; //Waterflower +TX_UNITS_WATERLEAF = 704; //Waterleaf +TX_UNITS_DUCK = 705; //Duck + +TX_UNITS_DESCRIPTIONS__13 = 88; //The serf supplies your buildings with the necessary raw materials.||Note that a connecting road must exist between the buildings. +TX_UNITS_DESCRIPTIONS_WOODCUTTER = 89; //To produce tree trunks for the sawmill, you need the woodcutter.||The woodcutter carries out reforesting independently. +TX_UNITS_DESCRIPTIONS_MINER = 90; //The miner mines ore from the coal, iron and gold mines. +TX_UNITS_DESCRIPTIONS_ANIMALBREEDER = 91; //The animal breeder uses corn to raise pigs in the swine farm and horses in the stables. +TX_UNITS_DESCRIPTIONS_FARMER = 92; //The farmer plants and harvests corn on the farm.||He also produces wine in the vineyard. +TX_UNITS_DESCRIPTIONS_CARPENTER = 93; //The carpenter works in the sawmill, the weapons workshop and in the armory workshop.||He also builds catapults and ballistae in the siege workshop. +TX_UNITS_DESCRIPTIONS_BAKER = 94; //The baker grinds corn into flour in the mill.||He also bakes bread in the bakery. +TX_UNITS_DESCRIPTIONS_BUTCHER = 95; //The butcher makes sausages in the butchery and leather in the tannery. +TX_UNITS_DESCRIPTIONS_FISHERMAN = 96; //The fisherman catches fish in nearby water bodies. +TX_UNITS_DESCRIPTIONS_LABORER = 97; //The laborer constructs buildings and roads. Simply highlight your preferred location and he will carry out your commands automatically.||He also repairs damaged buildings. +TX_UNITS_DESCRIPTIONS_STONEMASON = 98; //To supply your laborers with enough material to construct roads and buildings, the stonemason will hew and cut stones. +TX_UNITS_DESCRIPTIONS_BLACKSMITH = 99; //The blacksmith forges iron weapons and armor in the weapons and armor smithies. +TX_UNITS_DESCRIPTIONS_METALLURGIST = 100; //The metallurgist uses coal to refine gold and iron ore. +TX_UNITS_DESCRIPTIONS_RECRUIT = 101; //The recruit can be equipped as a soldier in the barracks.||He also occupies the watchtower. + +TX_MENU_TAB_HINT_BUILD = 102; //To selection of buildings +TX_MENU_TAB_HINT_DISTRIBUTE = 103; //To distribution of wares +TX_MENU_TAB_HINT_STATISTICS = 104; //To statistics +TX_MENU_TAB_HINT_OPTIONS = 105; //To options +TX_MENU_TAB_HINT_GO_BACK = 106; //Go back +TX_MENU_TAB_BUILD = 107; //Building|Selection +TX_MENU_TAB_DISTRIBUTE = 108; //Distribution|of Wares +TX_MENU_TAB_STATISTICS = 109; //Statistics +TX_MENU_TAB_OPTIONS = 110; //Options +TX_MENU_LOAD_GAME = 111; //Load Game +TX_MENU_SAVE_GAME = 112; //Save Game +TX_MENU_QUIT_QUESTION = 113; //Are you sure you|want to quit|this mission? +TX_MENU_QUIT_MISSION = 114; //Quit Mission +TX_MENU_DONT_QUIT_MISSION = 115; //Go Back +TX_MENU_SETTINGS = 116; //Settings +TX_MENU_QUIT_MAPED = 117; //Quit Editor +TX_MENU_SFX_VOLUME = 118; //SFX +TX_MENU_SFX_VOLUME_HINT = 119; //Change volume + +TX_MENU_MUSIC_VOLUME_HINT = 120; //Change volume +TX_MENU_MUSIC_VOLUME = 121; //Music +TX_MENU_OPTIONS_MUSIC_DISABLE_HINT = 122; //Music on/off +TX_MENU_OPTIONS_MUSIC_SHUFFLE_HINT = 1121; //Shuffle tracks on/off +TX_MENU_OPTIONS_AUTOSAVE = 123; //Autosave +TX_MUSIC_PLAYER = 124; //Music Player +TX_MUSIC_PREV_HINT = 125; //Previous track +TX_MUSIC_NEXT_HINT = 126; //Next track +TX_BUILD_DEMOLISH = 127; //Demolish +TX_BUILD_CANCEL_HINT = 128; //Remove buildings/plans|Hold Shift and Ctrl to delete buildings without confirmation +TX_BUILD_ROAD = 129; //Construct road +TX_BUILD_ROAD_HINT = 130; //Construct roads +TX_BUILD_FIELD = 131; //Plough field +TX_BUILD_FIELD_HINT = 132; //Plough fields +TX_BUILD_WINE = 133; //Lay out wine field +TX_BUILD_WINE_HINT = 134; //Lay out wine fields +TX_HOUSE_DEMOLISH_NO = 135; //Cancel +TX_HOUSE_SCHOOL_WIP_HINT = 136; //Cancel current training +TX_HOUSE_NEEDS = 137; //Needs: +TX_HOUSE_DELIVERS = 140; //Delivers +TX_HOUSE_UNDER_CONSTRUCTION = 141; //House under|construction +TX_HOUSE_DEMOLISH_YES = 142; //Destroy +TX_HOUSE_DEMOLISH = 143; //Do you really want to|demolish this building? +TX_HOUSE_DEMOLISH_YES_HINT = 144; //Destroy selected building +TX_HOUSE_ORDER_DEC_HINT = 145; //Decrease order amount +TX_HOUSE_ORDER_INC_HINT = 146; //Increase order amount +TX_HOUSE_BARRACKS_PREV_HINT = 147; //Previous soldier type. Use RMB or Alt to get to the first soldier type +TX_HOUSE_BARRACKS_NEXT_HINT = 148; //Next soldier type. Use RMB or Alt to get to the last soldier type +TX_HOUSE_BARRACKS_TRAIN_HINT = 149; //Equip current soldier type. Use RMB or Alt to equip 10 soldiers +TX_HOUSE_SCHOOL_NEXT_HINT = 150; //Next profession. Use RMB or Alt to get to the last profession +TX_HOUSE_SCHOOL_PREV_HINT = 151; //Previous profession. Use RMB or Alt to get to the first profession +TX_HOUSE_SCHOOL_TRAIN_HINT = 152; //Add to queue.|Use Shift or Ctrl to modify the queue and RMB or Alt to fill it +TX_HOUSE_TOGGLE_DELIVERS_HINT = 153; //Switch between delivery modes of wares: demand / closed / offer|Use LMB / RMB to switch forward / backward + +TX_HOUSE_WARE_COSTS = 154; //Cost: +TX_HOUSE_TOGGLE_REPAIR_HINT = 155; //Switch on/off house repair +TX_HOUSE_NOT_AVAILABLE = 156; //Building not available at this time +TX_UNIT_CONDITION = 157; //Condition +TX_ARMY_ROTATE_CCW_HINT = 158; //Turn troop left|Click RMB or press Alt to turn 90 degrees, press Shift to turn 180 degrees +TX_ARMY_ROTATE_CW_HINT = 159; //Turn troop right|Click RMB or press Alt to turn 90 degrees, press Shift to turn 180 degrees +TX_ARMY_ATTACK_HINT = 160; //Attack +TX_ARMY_GOTO_HINT = 161; //Dispatch troop +TX_ARMY_FEED_HINT = 162; //Supply troop with food +TX_ARMY_STORM_HINT = 163; //Start storm attack +TX_ARMY_LINE_ADD_HINT = 164; //Add line|Click RMB or press Shift to add 5 lines +TX_ARMY_LINE_REM_HINT = 165; //Withdraw line|Click RMB or press Shift to withdraw 5 lines +TX_ARMY_JOIN_SELECT = 166; //Select|group +TX_ARMY_JOIN_CANCEL = 167; //Cancel +TX_MSG_DELETE = 168; //Delete +TX_MSG_DELETE_HINT = 169; //Deletes current message +TX_MSG_GOTO = 170; //Go to +TX_MSG_GOTO_HINT = 171; //Jumps to current message position +TX_MSG_CLOSE = 172; //Close +TX_MSG_CLOSE_HINT = 173; //Closes window +TX_MSG_STONE_DEPLETED = 174; //Your stonemason cannot reach any further deposits of stone. +TX_MSG_COAL_DEPLETED = 175; //Your coal mine seams are exhausted. +TX_MSG_IRON_DEPLETED = 176; //Your iron mine veins are exhausted. +TX_MSG_GOLD_DEPLETED = 177; //Your gold mine veins are exhausted. +TX_MSG_WOODCUTTER_DEPLETED = 178; //Your woodcutter cannot find any further trees to fell +TX_MSG_HOUSE_UNOCCUPIED = 179; //This house is not occupied. +TX_MSG_ORDER_COMPLETED = 829; //The order has been completed +TX_MSG_TROOP_HUNGRY = 180; //This troop is really hungry, they better get something to eat soon! +TX_POPUP_PAUSE = 181; //PAUSE + +TX_UNIT_TASK_DELVERING = 182; //Delivering +TX_UNIT_TASK_ROAD = 183; //Constructing road +TX_UNIT_TASK_FIELD = 184; //Digging field +TX_UNIT_TASK_WINEFIELD = 185; //Constructing winefield +TX_UNIT_TASK_HOUSE_SITE = 186; //Flattening house site +TX_UNIT_TASK_HOUSE = 187; //Constructing house +TX_UNIT_TASK_REPAIRING = 188; //Repairing house +TX_UNIT_TASK_HOME = 189; //Going home +TX_UNIT_TASK_INN = 190; //Going to the inn +TX_UNIT_TASK_ATTACKING_HOUSE = 191; //Attacking house +TX_UNIT_TASK_FIRING = 192; //Firing +TX_UNIT_TASK_FIGHTING = 193; //Fighting +TX_UNIT_TASK_STORM_ATTACK = 194; //Storm attack +TX_UNIT_TASK_ATTACKING = 195; //Attacking +TX_UNIT_TASK_MOVING = 196; //Moving +TX_UNIT_TASK_IDLE = 197; //Idle +TX_UNIT_TASK_STONE = 198; //Mining stone +TX_UNIT_TASK_SOW_CORN = 199; //Sowing corn +TX_UNIT_TASK_CUTTING_CORN = 200; //Harvesting corn +TX_UNIT_TASK_GRAPES = 201; //Harvesting grapes +TX_UNIT_TASK_FISHING = 202; //Fishing +TX_UNIT_TASK_CUT_TREE = 203; //Cutting tree +TX_UNIT_TASK_PLANT_TREE = 204; //Planting tree + +TX_MUSIC__29 = 205; //Spirit +TX_MUSIC_BUSY = 206; //Busy +TX_MUSIC_MIDDLE_AGES_HORN = 207; //Middle Ages Horn +TX_MUSIC_SPRING = 208; //Spring +TX_MUSIC_LUTE = 209; //Lute +TX_MUSIC_MERCENARY = 210; //Mercenary +TX_MUSIC_THE_PRINCESS = 211; //The Princess +TX_MUSIC_THEQUEEN = 212; //The Queen +TX_MUSIC_IN_THE_MARKET_PLACE = 213; //In the Marketplace +TX_MUSIC_ON_THE_BATTLEFIELD = 214; //On the Battlefield +TX_MUSIC_COURT_DANCE = 215; //Court Dance +TX_MUSIC_THE_ARMY = 216; //The Army +TX_MUSIC_IN_THE_CASTLE = 217; //In the Castle +TX_MUSIC_FANFARES = 218; //Fanfares +TX_MUSIC_AT_COURT = 219; //At Court +TX_MUSIC_ENTREE = 220; //Entree +TX_MUSIC_DEEP_BLUE = 221; //Deep Blue +TX_MUSIC_STRUGGLE = 222; //Struggle +TX_MUSIC_ROYAL_QUARTERS = 223; //Royal Quarters +TX_MUSIC_ARISTOCRACY = 224; //Aristocracy +TX_MUSIC_AT_THE_HARBOR = 225; //At the Harbor +TX_MUSIC_JOURNEY = 226; //Journey + +TX_MENU_CAMPAIGNS = 227; //Campaigns +TX_MENU_CAMPAIGNS_LOADING = 1601; //Campaigns... loading +TX_MENU_CAMP_HEADER = 228; //Campaigns +TX_MENU_CAMP_START = 229; //Start Campaign! +TX_MENU_SINGLE_MAP = 230; //Play Single Map +TX_MENU_SINGLE_START_MAP = 231; //Start Map +TX_MENU_BACK = 232; //Back to Menu +TX_MENU_LOAD_SAVEGAME = 233; //Load Saved Game +TX_MENU_MULTIPLAYER = 234; //Multiplayer +TX_MENU_OPTIONS = 235; //Options +TX_MENU_CREDITS = 236; //Credits +TX_MENU_QUIT = 237; //Exit Game +TX_MENU_MISSION_NEXT = 238; //Continue +TX_MENU_MISSION_REPEAT = 239; //Restart Mission +TX_MENU_OPTIONS_RESOLUTION = 240; //Resolution: +TX_MENU_OPTIONS_RESOLUTION_NOT_SUPPORTED = 241; //Not supported +TX_MENU_OPTIONS_REFRESH_RATE_NOT_SUPPORTED = 242; //Not supported +TX_MENU_MISSION_VICTORY = 243; //VICTORY! +TX_MENU_MISSION_DEFEAT = 244; //DEFEAT! + +TX_RESULTS_UNITS_LOST = 245; //Units lost: +TX_RESULTS_CITIZENS_DISMISSED = 1604; //Citizens dismissed: +TX_RESULTS_UNITS_DEFEATED = 246; //Units defeated: +TX_RESULTS_HOUSES_LOST = 247; //Buildings lost: +TX_RESULTS_HOUSES_DESTROYED = 248; //Buildings destroyed: +TX_RESULTS_HOUSES_BUILT = 249; //Buildings constructed: +TX_RESULTS_UNITS_TRAINED = 250; //Units trained: +TX_RESULTS_WEAPONS_MADE = 251; //Weapons produced: +TX_RESULTS_SOLDIERS_TRAINED = 252; //Soldiers equipped: +TX_RESULTS_MISSION_COMPLETED_IN = 253; //Mission completed in: +TX_RESULTS_STATISTICS = 254; //Statistics +TX_RESULTS_ECONOMY = 255; //Economy + +TX_RESULTS_MP_CITIZENS_TRAINED = 256; //Citizens|trained +TX_RESULTS_MP_CITIZENS_LOST = 257; //Citizens|lost +TX_RESULTS_MP_CITIZENS_DISMISSED = 1603; //Citizens|dismissed +TX_RESULTS_MP_SOLDIERS_EQUIPPED = 258; //Soldiers|equipped +TX_RESULTS_MP_SOLDIERS_LOST = 259; //Soldiers|lost +TX_RESULTS_MP_SOLDIERS_DEFEATED = 260; //Soldiers|defeated +TX_RESULTS_MP_BUILDINGS_CONSTRUCTED = 261; //Buildings|constructed +TX_RESULTS_MP_BUILDINGS_LOST = 262; //Buildings|lost +TX_RESULTS_MP_BUILDINGS_DESTROYED = 263; //Buildings|destroyed +TX_RESULTS_MP_WARES_PRODUCED = 264; //Wares|produced +TX_RESULTS_MP_WEAPONS_PRODUCED = 265; //Weapons|produced + +TX_GRAPH_ARMY = 266; //Army +TX_GRAPH_CITIZENS = 267; //Citizens +TX_GRAPH_HOUSES = 268; //Houses +TX_GRAPH_RESOURCES = 269; //Resources +TX_GRAPH_TITLE_RESOURCES = 270; //Produced quantity +TX_GRAPH_NO_DATA = 271; //No data +TX_PLAYER_YOU = 272; //You +TX_RESULTS_BACK_MP = 274; //Back to Multiplayer +TX_RESULTS_BACK_REPLAYS = 275; //Back to Replays +TX_RESOURCES_ALL = 276; //All wares +TX_RESOURCES_WARFARE = 277; //Warfare +TX_RESOURCES_FOOD = 278; //Food + +TX_CREDITS_TEXT = 279; //JOYMANIA ENTERTAINMENT||PROGRAMMING:|Peter Ohlmann||GAME GRAPHICS:|Adam Sprys||LEVEL DESIGN:|Adam Sprys|Andre Qua?||SOUND EDITING AND MIXING:|Tonstudio Mannheim||MUSIC:|Gerd Hofmann|Joachim Schafer|Jurgen Rebhann|Klaus Staendike|Steffen Schungel||ILLUSTRATIONS:|Boleslaw Kasza|Christoph Werner||TRANSLATION:|Ronnie Shankland|Patricia Bellantuono|Andrea Rumpelt|||ZUXXEZ ENTERTAINMENT AG||PRODUCER:|Uwe Schafer||MANUAL:|Peter Ohlmann|Uwe Schafer||BETA TESTING:|Peter Ohlmann|Adam Sprys|Alexandra Constandache|Dirk P. Hassinger|Achim Heidelauf|Uwe Schafer|Ingrid Schafer|Dirk U. Jantz|Ion Constandache|Yaman Egeli|Roman Eich|Iris Mocsnek|Anke Jantz|Paul Hassinger|Liza Hassinger||GAMES DIRECTOR:|Achim Heidelauf||PUBLISHED BY:|TopWare Interactive||CUTSCENES:||DIRECTION:|Slawomir Jedrzejewski||Kajetan Czarnecki|Wojciech Drazek|Daniel Duplaga|Rafal Januszkiewicz|Andrzej Rams|Piotr Rulka|Krzysztof Rybczynski|Grzegorz Wisniewski||VOICES:|Claus Boyen (Storyteller)||Tim Timmermann|Peter Houska|Dirk Muhlbach|Ralf Ditze|Gerhard Piske|Gernot Wassmann||ARTWORK:|Boleslaw Kasza|Adam Sprys||OPENING ANIMATION:|Uwe Schafer|Christian Bigalk|Additional 3D-Modelling:|Niels Horstmann||SPECIAL THANKS TO:|Tadeusz Zuber|Dieter Ohlmann|Alexandra Constandache|Ingrid Schafer + +TX_MENU_MISSION_CANCELED = 280; //Mission canceled +TX_MENU_REPLAY_ENDED = 281; //Replay ended +TX_MENU_TUTORIAL_TOWN = 282; //Town Tutorial +TX_MENU_TUTORIAL_BATTLE = 283; //Battle Tutorial +TX_MENU_SINGLEPLAYER = 284; //Single Player +TX_MENU_MAP_EDITOR = 285; //Map Editor +TX_MENU_START_MISSION = 286; //Start Mission +TX_MENU_MAP_TITLE = 287; //Title +TX_MENU_MAP_SIZE = 288; //Size +TX_MENU_WIN_CONDITION = 289; //Win condition: +TX_MENU_DEFEAT_CONDITION = 290; //Defeat condition: +TX_MENU_ALLIES = 291; //Allies: +TX_MENU_ENEMIES = 292; //Enemies: +TX_MENU_SAVE_TIME = 293; //Time + +TX_MENU_NEW_MAP_SIZE = 294; //New map size +TX_MENU_MAP_WIDTH = 295; //Width +TX_MENU_MAP_HEIGHT = 296; //Height +TX_MENU_MAP_CREATE_NEW_MAP = 297; //Create New Map +TX_MENU_MAP_AVAILABLE = 298; //Available maps +TX_MENU_MAP_LOAD_EXISTING = 299; //Load Existing Map +TX_MENU_MAP_DELETE = 805; //Delete Map +TX_MENU_MAP_DELETE_CONFIRM = 806; //Are you sure you want to delete this map? +TX_MENU_MAP_MOVE_DOWNLOAD = 831; //Move out of downloads +TX_MENU_MAP_MOVE_CONFIRM = 824; //Move +TX_MENU_MAP_LOCATION = 300; //Location +TX_MENU_OPTIONS_CONTROLS = 301; //Controls: +TX_MENU_OPTIONS_GAMEPLAY = 302; //Gameplay: +TX_MENU_OPTIONS_SOUND = 303; //Sound: +TX_MENU_OPTIONS_MUSIC_DISABLE_SHORT = 1119; //Disable music +TX_MENU_OPTIONS_MUSIC_DISABLE = 304; //Disable music +TX_MENU_OPTIONS_GRAPHICS = 305; //Graphics: +TX_MENU_OPTIONS_BRIGHTNESS = 306; //Brightness +TX_MENU_OPTIONS_VSYNC = 307; //Vertical Sync +TX_MENU_OPTIONS_FONTS = 830; //Load Asian fonts +TX_MENU_OPTIONS_FULLSCREEN = 308; //Fullscreen +TX_MENU_OPTIONS_APPLY = 309; //Apply +TX_MENU_OPTIONS_LANGUAGE = 310; //Language: +TX_MENU_OPTIONS_SHADOW_QUALITY = 311; //High shadow quality +TX_MENU_OPTIONS_EDIT_KEYS = 837; // +TX_MENU_OPTIONS_KEYBIND = 838; //Key-bindings +TX_MENU_OPTIONS_OK = 839; //OK +TX_MENU_OPTIONS_FUNCTION = 840; //Function +TX_MENU_OPTIONS_KEY = 841; //Key +TX_MENU_OPTIONS_SPECIAL_KEYBIND = 842; // +TX_MENU_OPTIONS_SPECIAL_KEYS = 843; // +TX_MENU_OPTIONS_RESET = 844; //Reset key-bindings +TX_MENU_OPTIONS_CANCEL = 991; //Cancel +TX_MENU_OPTIONS_CLEAR = 992; //Clear key +TX_MENU_LOADING = 314; //Loading... Please wait +TX_MENU_ERROR = 315; //An Error Has Occurred! +TX_MENU_NEW_LOCALE = 316; //Loading new locale +TX_MENU_LOAD_LIST = 317; //List of savegames +TX_MENU_LOAD_FILE = 318; //File name +TX_MENU_LOAD_DATE = 770; //Date +TX_MENU_LOAD_DESCRIPTION = 319; //Description +TX_MENU_LOAD_LOAD = 320; //Load +TX_MENU_LOAD_DELETE = 321; //Delete +TX_MENU_LOAD_DELETE_CONFIRM = 322; //Are you sure you want to delete this save? +TX_MENU_LOAD_DELETE_DELETE = 323; //Delete +TX_MENU_LOAD_DELETE_CANCEL = 324; //Cancel +TX_MENU_LOAD_MAP_NAME = 1382; //Map name +TX_MENU_LOAD_TIME = 1383; //Time +TX_MENU_LOAD_GAME_VERSION = 1384; //Version +TX_MENU_REPLAY_DELETE_TITLE = 834; //Delete this Replay +TX_MENU_REPLAY_DELETE_CONFIRM = 801; //Deleting a replay also deletes the associated save. Are you sure you want to delete this save? +TX_MENU_REPLAY_DELETE = 804; //Delete Replay +TX_MENU_REPLAY_RENAME_TITLE = 832; //Rename this Replay +TX_MENU_REPLAY_RENAME_NAME = 835; //Name: +TX_MENU_REPLAY_RENAME_CONFIRM = 836; //Confirm +TX_MENU_REPLAY_RENAME = 833; //Rename Replay +TX_MENU_CAMPAIGNS_TITLE = 325; //Title +TX_MENU_CAMPAIGNS_MAPS_COUNT = 326; //Maps +TX_MENU_CAMPAIGNS_MAPS_UNLOCKED = 327; //Unlocked + +TX_GAMEPLAY_WON = 328; //You've won! +TX_GAMEPLAY_CONTINUE_PLAYING = 329; //Continue playing +TX_GAMEPLAY_VICTORY = 330; //Victory! +TX_GAMEPLAY_LOST = 331; //You've lost! +TX_GAMEPLAY_DEFEAT_CONTINUEWATCHING = 332; //Continue watching +TX_GAMEPLAY_DEFEAT = 333; //Defeat +TX_GAMEPLAY_REPLAY_ENDED = 334; //Replay has ended +TX_GAMEPLAY_REPLAY_CONTINUEWATCHING = 335; //Continue Watching +TX_GAMEPLAY_QUIT_TO_MENU = 336; //Quit to Menu +TX_GAMEPLAY_NOT_AVAILABLE = 337; //Not available +TX_GAMEPLAY_PAUSE_INFO = 338; //Press %s to resume the game +TX_GAMEPLAY_PLAYERS_HINT = 339; //Players info +TX_GAMEPLAY_CHAT_HINT = 340; //Chat +TX_GAMEPLAY_SAVE_EXISTS = 341; //Save already exists +TX_GAMEPLAY_SAVE_OVERWRITE = 342; //Overwrite +TX_GAMEPLAY_SAVE_SAVE = 343; //Save +TX_GAMEPLAY_LOAD = 344; //Load +TX_GAME_ERROR_OLD_OPENGL = 345; //Old OpenGL version detected, game may run slowly and/or with graphic flaws +TX_GAME_ERROR_OLD_OPENGL_2 = 346; //Please update your graphic drivers to get better performance +TX_GAME_ERROR_NETWORK = 347; //Network error: +TX_GAME_ERROR_BLANK_PLAYERNAME = 348; //Error: Player name must not be blank +TX_GAME_ERROR_LONG_PLAYERNAME = 349; //Error: Player name must be no more than %d characters long +TX_GAME_ERROR_ILLEGAL_PLAYERNAME = 350; //Error: Player name contains illegal characters +TX_GAME_ERROR_RESERVER_PLAYERNAME = 1255; //Error: Player name '%s' is reserved +TX_GAME_ERROR_CONNECTION_FAILED = 351; //Connection failed: %s +TX_GAME_ERROR_DISCONNECT = 352; //You have disconnected +TX_GAME_MISSION = 353; //Mission %d +TX_GAME_MESSAGE_LOG = 354; //Message log +TX_MSG_FISHERMAN_TOO_FAR = 355; //Your fisherman's hut is too far away from the water. +TX_MSG_FISHERMAN_CANNOT_CATCH = 356; //Your fisherman cannot catch any further fish in nearby water. + +TX_REPLAY_RESTART = 357; //Restart replay +TX_REPLAY_PAUSE = 358; //Pause replay +TX_REPLAY_STEP = 359; //Step 1 tick forward +TX_REPLAY_RESUME = 360; //Resume paused replay +TX_REPLAY_QUIT = 361; //Quit replay +TX_REPLAY_PLAYER_PERSPECTIVE = 362; //Toggle individual player perspective +TX_REPLAY_SHOW_FOG = 771; //Show fog +TX_REPLAY_SAVE_AT = 1246; //Save replay state to be able to load while watching this replay +TX_REPLAY_LOAD_AT_HINT = 1247; //Load replay at %s + +TX_HOUSES_MARKET_SELECT_LEFT = 364; //Use the left mouse button to select the ware to trade +TX_HOUSES_MARKET_SELECT_RIGHT = 365; //Use the right mouse button to select the ware to trade +TX_HOUSES_MARKET_FROM = 366; //From x%d +TX_HOUSES_MARKET_TO = 367; //To x%d + +TX_MAPED_TERRAIN = 368; //Terrain editing +TX_MAPED_TERRAIN_HINTS_BRUSHES = 369; //Brushes +TX_MAPED_TERRAIN_HINTS_HEIGHTS = 370; //Heights +TX_MAPED_TERRAIN_HINTS_TILES = 371; //Tiles +TX_MAPED_TERRAIN_HINTS_OBJECTS = 372; //Objects +TX_MAPED_TERRAIN_HEIGHTS = 373; //Elevations +TX_MAPED_TERRAIN_HEIGHTS_SHAPE = 374; //Brush shape +TX_MAPED_TERRAIN_HEIGHTS_SIZE = 375; //Size +TX_MAPED_TERRAIN_HEIGHTS_SIZE_HINT = 376; //Slide to change brush size +TX_MAPED_TERRAIN_HEIGHTS_SLOPE = 377; //Slope +TX_MAPED_TERRAIN_HEIGHTS_SLOPE_HINT = 378; //Slide to change elevation slope: 1 = plateau ... 15 = peak +TX_MAPED_TERRAIN_HEIGHTS_SPEED = 379; //Speed +TX_MAPED_TERRAIN_HEIGHTS_SPEED_HINT = 380; //Slide to change elevation speed: 1 = slow ... 15 = very fast +TX_MAPED_TERRAIN_HEIGHTS_CIRCLE = 381; //Circle-shaped brush +TX_MAPED_TERRAIN_HEIGHTS_SQUARE = 382; //Square-shaped brush +TX_MAPED_TERRAIN_HEIGHTS_ELEVATE = 383; //Elevate / Lower +TX_MAPED_TERRAIN_HEIGHTS_UNEQUALIZE = 384; //Unequalize / Flatten +TX_MAPED_TERRAIN_HEIGHTS_ELEVATE_HINT = 385; //Elevate (left click) / Lower (right click) +TX_MAPED_TERRAIN_HEIGHTS_UNEQUALIZE_HINT = 386; //Unequalize (left click) / Flatten (right click) +TX_MAPED_TERRAIN_BRUSH = 387; //Brush & Masks + +TX_MAPED_OBJECTS_BRUSH = 1468; //Object Brushes +TX_MAPED_OBJECTS_BRUSH_TREES = 1469; //Trees +TX_MAPED_OBJECTS_BRUSH_ALL = 1470; //All objects except trees +TX_MAPED_OBJECTS_BRUSH_STONES = 1471; //Stones +TX_MAPED_OBJECTS_BRUSH_FLOWERS = 1472; //Flowers +TX_MAPED_OBJECTS_BRUSH_MUSHROOMS = 1473; //Mushrooms +TX_MAPED_OBJECTS_BRUSH_STUMPS = 1474; //Stumps +TX_MAPED_OBJECTS_BRUSH_DEAD = 1475; //Dead trees +TX_MAPED_OBJECTS_BRUSH_CACTUS = 1476; //Cactus +TX_MAPED_OBJECTS_BRUSH_BUSH = 1477; //Desert bushes +TX_MAPED_OBJECTS_BRUSH_RUINS = 1478; //Ruins +TX_MAPED_TERRAIN_BRUSH_USE_OBJECTS = 1479; //Terrain objects +TX_MAPED_TERRAIN_BRUSH_USE_OBJECTS_HINT = 1480; //When painting, place objects matching the selected terrain brush +TX_MAPED_OBJECTS_BRUSH_DENSITY = 1481; //Density +TX_MAPED_OBJECTS_BRUSH_DENSITY_HINT = 1482; //Objects / forest density +TX_MAPED_OBJECTS_BRUSH_AGE = 1483; //Forest age +TX_MAPED_OBJECTS_BRUSH_CLEAN = 1484; //Cleaning brush, removes all objects +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_ALL = 1485; //All +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_YOUNG = 1486; //Young +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_MEDIUM = 1487; //Medium +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_BIG = 1506; //Big +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_STOMP = 1508; //Stomps +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_ALL_BUT_STOMP = 1510; //All- +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_RDY_2CHOP = 1488; //Chop +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_ALL_HINT = 1489; //All ages +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_YOUNG_HINT = 1490; //Young trees +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_MEDIUM_HINT = 1491; //Medium trees +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_BIG_HINT = 1507; //Big trees +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_STOMP_HINT = 1509; //Stomps +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_ALL_BUT_STOMP_HINT = 1511; //All ages, except stomps +TX_MAPED_OBJECTS_BRUSH_TREES_AGE_RDY_2CHOP_HINT = 1492; //Trees ready to chop +TX_MAPED_OBJECTS_BRUSH_OVERRIDE_OBJECTS = 1503; //Override Objects +TX_MAPED_OBJECTS_BRUSH_OVERRIDE_OBJECTS_HINT = 1504; //Objects will be replaced by other objects or deleted + +TX_MAPED_TERRAIN_BRUSH_RANDOM = 388; //Random elements +TX_MAPED_TERRAIN_TILES_RANDOM = 389; //Random Direction +TX_MAPED_TERRAIN_TILES_RANDOM_HINT = 390; //Tick for randomized tile direction or use right click to rotate the selected tile +TX_MAPED_TERRAIN_OBJECTS_BLOCK = 392; //Block walking +TX_MAPED_TERRAIN_OBJECTS_REMOVE = 393; //Remove object +TX_MAPED_TERRAIN_MAGIC_WATER = 672; //Magic water +TX_MAPED_TERRAIN_MAGIC_WATER_HINT = 671; //Magic water: Sets the direction for all tiles in a body of water +TX_MAPED_TERRAIN_EYEDROPPER_HINT = 965; //Eyedropper: Select the type of tile under the cursor +TX_MAPED_TERRAIN_OVERRIDE_CUSTOM_TILES = 1197; //Override manually|set tiles +TX_MAPED_TERRAIN_OVERRIDE_CUSTOM_TILES_HINT = 1198; //Force to override manually set tiles from tiles table while painting with brushes (if possible) +TX_MAPED_TERRAIN_MAGIC_BRUSH_HINT = 1199; //Magic brush: Using chosen mask, fixes tile transitions, for tiles that don't have transition graphics from one to the other type of terrain +TX_MAPED_TERRAIN_NO_MASK_HINT = 1200; //No mask - use exiting tiles for transitions +TX_MAPED_TERRAIN_MASK_1_HINT = 1201; //Soft1 mask - use automatically created transitions +TX_MAPED_TERRAIN_MASK_2_HINT = 1202; //Soft2 mask - use automatically created transitions +TX_MAPED_TERRAIN_MASK_3_HINT = 1203; //Soft3 mask - use automatically created transitions +TX_MAPED_TERRAIN_MASK_4_HINT = 1388; //Hard mask - use automatically created transitions +TX_MAPED_TERRAIN_MASK_5_HINT = 1505; //Gradient mask - use automatically created transitions +TX_MAPED_TERRAIN_GRASS = 1550; //Grass +TX_MAPED_TERRAIN_MOSS = 1551; //Moss +TX_MAPED_TERRAIN_PALE_GRASS = 1552; //Pale grass +TX_MAPED_TERRAIN_GRASS_DIRT = 1553; //Grass on dirt +TX_MAPED_TERRAIN_DIRT = 1554; //Dirt +TX_MAPED_TERRAIN_COAST_SAND = 1555; //Coast sand +TX_MAPED_TERRAIN_GRASS_SAND1 = 1556; //Grass sand 1 +TX_MAPED_TERRAIN_GRASS_SAND2 = 1557; //Grass sand 2 +TX_MAPED_TERRAIN_GRASS_SAND3 = 1558; //Grass sand 3 +TX_MAPED_TERRAIN_SAND = 1559; //Sand +TX_MAPED_TERRAIN_SWAMP = 1560; //Swamp +TX_MAPED_TERRAIN_GRASSY_WATER = 1561; //Grassy water +TX_MAPED_TERRAIN_WATER = 1562; //Water +TX_MAPED_TERRAIN_FAST_WATER = 1563; //Fast water +TX_MAPED_TERRAIN_CUSTOM = 1564; //Custom +TX_MAPED_TERRAIN_SNOW_ON_GRASS = 1565; //Snow on grass +TX_MAPED_TERRAIN_SNOW_ON_DIRT = 1566; //Snow on dirt +TX_MAPED_TERRAIN_SNOW = 1567; //Snow +TX_MAPED_TERRAIN_DEEP_SNOW = 1568; //Deep snow +TX_MAPED_TERRAIN_ICE = 1569; //Ice +TX_MAPED_TERRAIN_STONE = 1570; //Stone +TX_MAPED_TERRAIN_GOLD_MOUNT = 1571; //Gold mountain +TX_MAPED_TERRAIN_IRON_MOUNT = 1572; //Iron mountain +TX_MAPED_TERRAIN_COBBLE_STONE = 1573; //Cobble stone +TX_MAPED_TERRAIN_GRAVEL = 1574; //Gravel +TX_MAPED_TERRAIN_COAL = 1575; //Coal +TX_MAPED_TERRAIN_GOLD = 1576; //Gold +TX_MAPED_TERRAIN_IRON = 1577; //Iron +TX_MAPED_TERRAIN_LAVA = 1578; //Lava +TX_MAPED_TERRAIN_ABYSS = 1579; //Abyss +TX_MAPED_VILLAGE = 394; //Village planning +TX_MAPED_SCRIPTS_VISUAL = 395; //Visual scripts +TX_MAPED_SCRIPTS_GLOBAL = 396; //Global scripting +TX_MAPED_MENU = 397; //Menu +TX_MAPED_UNITS = 697; //Units & Animals +TX_MAPED_OBJECTS = 398; //Objects +TX_MAPED_VIEW_DEPOSISTS = 399; //Show deposits +TX_MAPED_VIEW_OVERLAYS = 1128; //Show roads/fields/winefields +TX_MAPED_VIEW_MINING_RADIUS = 1160; //Show mining radius +TX_MAPED_VIEW_TOWERS_ATTACK_RADIUS = 1161; //Show towers attack radius +TX_MAPED_VIEW_UNITS_ATTACK_RADIUS = 1162; //Show units attack radius +TX_MAPED_VIEW_UNITS = 400; //Show units +TX_MAPED_VIEW_HOUSES = 401; //Show houses +TX_MAPED_VIEW_OBJECTS = 402; //Show objects +TX_MAPED_VIEW_PASSABILITY = 403; //View passability +TX_MAPED_LOAD_UNSAVED = 404; //Any unsaved|changes will be lost +TX_MAPED_LOAD_CANCEL = 405; //Cancel +TX_MAPED_LOAD = 406; //Load +TX_MAPED_LOAD_TITLE = 407; //Load Map +TX_MAPED_SAVE_CANCEL = 408; //Cancel +TX_MAPED_SAVE = 409; //Save +TX_MAPED_SAVE_TITLE = 668; //Save Map +TX_MAPED_SAVE_OVERWRITE = 410; //Overwrite +TX_MAPED_SAVE_EXISTS = 411; //Map already exists +TX_MAPED_PLAYERS = 412; //Players: +TX_MAPED_PLAYERS_DEFAULT = 413; //Default human player +TX_MAPED_PLAYERS_TYPE = 414; //Player types +TX_MAPED_ALLIANCE_SYMMETRIC = 415; //Symmetrical +TX_MAPED_ALLIANCE_SYMMETRIC_LBL = 1525; //Only symmetrical alliances are allowed +TX_MAPED_ALLIANCE = 416; //Alliances +TX_MAPED_MISSION_TACTIC = 417; //Tactic +TX_MAPED_MISSION_NORMAL = 418; //Normal +TX_MAPED_MISSION_MODE = 419; //Mission mode +TX_MAPED_GROUP_ORDER = 686; //Group order +TX_MAPED_GROUP_ORDER_NONE = 687; //None +TX_MAPED_GROUP_ORDER_WALK = 689; //Walk to +TX_MAPED_GROUP_ORDER_ATTACK = 688; //Attack position +TX_MAPED_GROUP_ORDER_DIRECTION = 690; //Direction +TX_MAPED_FOG_CENTER_JUMP = 420; //Jump to location +TX_MAPED_FOG_CENTER_HINT = 421; //Center screen on mission start +TX_MAPED_FOG_CENTER = 422; //Center screen +TX_MAPED_FOG_ALL = 423; //Reveal all +TX_MAPED_FOG_HINT = 424; //Reveal a portion of the map +TX_MAPED_FOG = 425; //Reveal fog +TX_MAPED_FOG_RADIUS = 682; //Radius +TX_MAPED_DELETE_REVEALER_HINT = 683; //Delete current revealer +TX_MAPED_CLOSE = 685; //Close +TX_MAPED_CLOSE_REVEALER_HINT = 684; //Return to the reveal fog page +TX_MAPED_BLOCK_TRADE = 426; //Block trade +TX_MAPED_BLOCK_HOUSES = 427; //Block/Enable houses +TX_MAPED_BLOCK_UNITS = 708; //Block units +TX_MAPED_PLAYER_COLORS = 428; //Colors +TX_MAPED_GOALS_TITLE = 429; //Goal +TX_MAPED_GOALS_PLAYER = 432; //Player +TX_MAPED_GOALS_CONDITION_ECONOMY = 433; //Economy buildings +TX_MAPED_GOALS_CONDITION_SERFS = 434; //Serfs and schools +TX_MAPED_GOALS_CONDITION_ASSETS = 435; //Military assets +TX_MAPED_GOALS_CONDITION_UNKNOWN = 436; //Unknown +TX_MAPED_GOALS_CONDITION_TROOPS = 437; //Troops +TX_MAPED_GOALS_CONDITION_BUILDS = 438; //Buildings +TX_MAPED_GOALS_CONDITION_TIME = 439; //Time +TX_MAPED_GOALS_CONDITION_TUTORIAL = 440; //Build Tutorial +TX_MAPED_GOALS_CONDITION_NONE = 441; //None +TX_MAPED_GOALS_CONDITION = 442; //Condition +TX_MAPED_GOALS_TYPE_SURVIVE = 443; //Survive +TX_MAPED_GOALS_TYPE_VICTORY = 444; //Victory +TX_MAPED_GOALS_TYPE_NONE = 445; //None +TX_MAPED_GOALS_TYPE = 446; //Type +TX_MAPED_GOALS = 447; //Goals +TX_MAPED_OK = 448; //OK +TX_MAPED_CANCEL = 449; //Cancel +TX_MAPED_AI_FORMATIONS_COLUMNS = 450; //Columns +TX_MAPED_AI_FORMATIONS_COUNT = 451; //Count +TX_MAPED_AI_FORMATIONS_TITLE = 452; //Troop Formations +TX_MAPED_AI_FORMATIONS = 453; //Edit formations +TX_MAPED_AI_FORMATIONS_AAI_INFO = 1534; //Notice: Advanced AI use its own formation parameters and will ignore these settings +TX_MAPED_AI_MAX_SOLDIERS_ENABLE_HINT = 454; //Set a limit on how many soldiers the AI can have +TX_MAPED_AI_MAX_SOLDIERS_HINT = 455; //How many soldiers AI can have at once + +TX_MAPED_AI_GROUP_LVL_WEAK = 1537; //Weak +TX_MAPED_AI_GROUP_LVL_HINT = 1538; //Soldiers withour armor, leather armored units or iron armored units +TX_MAPED_AI_ADD_GROUP = 1539; //Add group +TX_MAPED_AI_ADD_GROUP_HINT = 1540; //Add group after placing defence position. Group depends on AI formations + +TX_MAPED_UNITS_FORMATION_NUMBER = 1541; //Count +TX_MAPED_UNITS_FORMATION_NUMBER_HINT = 1542; //Number of units in group. At 0 it takes the AI formations +TX_MAPED_UNITS_FORMATION_COLUMNS = 1543; //Columns +TX_MAPED_UNITS_FORMATION_COLUMNS_HINT = 1544; //Number of columns in group. If number of units is 0 it takes the AI formations columns count + +TX_MAPED_SELECTION_SMOOTH_COAL = 1545; //Make coal smooth +TX_MAPED_SELECTION_SMOOTH_COAL_HINT = 1546; //Coal deposits in the selection will be automatically set from the tiles with lowest coal count at the edges to the highest in the center + +TX_UNIT_TASK_DISMISS = 1139; //Retiring +TX_UNIT_TASK_DISMISS_BTN = 1140; //Dismiss +TX_UNIT_TASK_DISMISS_CONFIRMATION = 1141; //Do you really want to dismiss this unit?|He will go to school and leave your town forever +TX_UNIT_TASK_DISMISS_HINT = 1142; //Dismiss unit +TX_UNIT_TASK_DISMISS_CANCEL_HINT = 1143; //Cancel unit dismiss +TX_UNIT_TASK_DISMISS_NOSCHOOLS_HINT = 1144; //Dismiss is not available because of lack of schools in your town + +TX_MAPED_AI_MAX_SOLDIERS = 456; //Set max. soldiers +TX_MAPED_AI_RECRUITS_HINT = 457; //Classic AI: How many recruits AI should have in barracks|Advanced AI: Parameter not used +TX_MAPED_AI_RECRUITS = 458; //Recruits per Barracks +TX_MAPED_AI_RECRUIT_DELAY = 670; //Recruit delay (mins) +TX_MAPED_AI_RECRUIT_DELAY_HINT = 669; //Delay in minutes before the AI starts training recruits. Recruits for Towers are not affected +TX_MAPED_AI_AUTO_ATTACK = 774; //Auto attack range +TX_MAPED_AI_AUTO_ATTACK_HINT = 775; //AI groups will automatically attack if you are closer than this many tiles +TX_MAPED_AI_DEFEND_ALLIES = 776; //Defend allies +TX_MAPED_AI_DEFEND_ALLIES_HINT = 777; //If enabled the AI will defend units and houses of allies as if they were its own +TX_MAPED_AI_ARMY_TYPE = 817; //Army type +TX_MAPED_AI_ARMY_TYPE_MIXED = 821; //Mixed +TX_MAPED_AI_ARMY_TYPE_LEATHER = 820; //Leather +TX_MAPED_AI_ARMY_TYPE_IRON = 819; //Iron +TX_MAPED_AI_ARMY_TYPE_IRON_THEN_LEATHER = 818; //Iron then leather +TX_MAPED_AI_TARGET_CUSTOM = 460; //Custom position +TX_MAPED_AI_TARGET_HOUSE_START = 791; //Closest house from start position +TX_MAPED_AI_TARGET_HOUSE_ARMY = 790; //Closest house from army +TX_MAPED_AI_TARGET_CLOSEST = 463; //Closest unit +TX_MAPED_AI_ATTACK_TAKE_ALL = 802; //Take all +TX_MAPED_AI_ATTACK_TAKE_ANY = 1536; //Take any group type +TX_MAPED_AI_ATTACK_TAKE_ANY_HINT = 1232; //Take any group type +TX_MAPED_AI_ATTACK_COUNT = 465; //Group count +TX_MAPED_AI_ATTACK_INFO = 466; //Attack info +TX_MAPED_AI_ATTACK_DELAY = 788; //Initial delay (seconds) +TX_MAPED_AI_ATTACK_SOLDIERS = 803; //Minimum number of units to attack +TX_MAPED_AI_ATTACK_TYPE_REP = 468; //Repeating +TX_MAPED_AI_ATTACK_TYPE_ONCE = 469; //Single attack +TX_MAPED_AI_ATTACK_TYPE_MOUNTED = 470; //Mounted +TX_MAPED_AI_ATTACK_TYPE_RANGED = 471; //Ranged +TX_MAPED_AI_ATTACK_TYPE_ANTIHORSE = 472; //Antihorse +TX_MAPED_AI_ATTACK_TYPE_MELEE = 473; //Melee +TX_MAPED_AI_ATTACK_COL_LOC = 474; //Loc. +TX_MAPED_AI_ATTACK_COL_TARGET = 475; //Target +TX_MAPED_AI_ATTACK_COL_MEN = 476; //Men +TX_MAPED_AI_ATTACK_COL_DELAY = 477; //Delay +TX_MAPED_AI_ATTACK_COL_TYPE = 478; //Type +TX_MAPED_AI_ATTACK_AUTO = 479; //Autoattack +TX_MAPED_AI_ATTACK_AUTO_HINT = 810; //AI creates and manages attacks automatically. Ignores manually set attacks +TX_MAPED_AI_ATTACK_HELP = 823; //Notice: the first "Repeating" attack will send all the troops that AI player has at the attacking outposts. However, for every next "Repeating" attack (as well as for "Single Attack"), it sends enough groups to exceed the "Minimum number of units to attack" +TX_MAPED_AI_ATTACK = 480; //AI attacks +TX_MAPED_AI_ATTACK_ADD = 1137; //Add AI attack +TX_MAPED_AI_ATTACK_DEL = 1138; //Remove AI attack +TX_MAPED_AI_DEFENSE_EQUIP_LEATHER = 481; //Equip rate leather +TX_MAPED_AI_DEFENSE_EQUIP_IRON = 482; //Equip rate iron +TX_MAPED_AI_DEFENSE_EQUIP_LEATHER_HINT = 1389; //Delay in game ticks before AI equips a leather troops +TX_MAPED_AI_DEFENSE_EQUIP_IRON_HINT = 1390; //Delay in game ticks before AI equips an iron troops +TX_MAPED_AI_DEFENSE_AUTO = 483; //Autodefence +TX_MAPED_AI_DEFENSE_AUTO_HINT = 484; //AI creates and manages defense positions automatically. Ignores all manually set defense positions +TX_MAPED_AI_DEFENSE_HINT = 485; //Place defence position for AI.|To change defence position parameters use:|RMB - direction, Ctrl + RMB - group type, Alt + RMB - defensive / attacking +TX_MAPED_AI_DEFENSE = 486; //AI defence positions +TX_MAPED_AI_DEFENSE_OPTIONS = 680; //AI defence options +TX_MAPED_AI_DEFENCE_ATTACKERS = 792; //Attackers +TX_MAPED_AI_DEFENCE_DEFENDERS = 793; //Defenders +TX_MAPED_AI_DEFENCE_RADIUS = 693; //Defence radius +TX_MAPED_AI_DEFENCE_PRIORITY_ORDER = 786; //Order +TX_MAPED_AI_DEFENCE_DELETE_HINT = 694; //Delete current defence position +TX_MAPED_AI_DEFENCE_CLOSE_HINT = 695; //Return to the defence page +TX_MAPED_AI_DEFENCE_POSITION = 696; //Defence position +TX_MAPED_AI_WORKERS = 487; //Laborers +TX_MAPED_AI_SERFS_PER_10_HOUSES = 488; //Serfs per 10 houses +TX_MAPED_AI_SERFS_PER_10_HOUSES_HINT = 827; //Sets serfs count per 10 houses for specified AI player. Selected AI has %d houses +TX_MAPED_AI_WORKERS_COUNT_HINT = 1391; //Sets the number of AI workers +TX_MAPED_AI_AUTOREPAIR = 489; //Autorepair +TX_MAPED_AI_AUTOBUILD = 490; //Autobuild +TX_MAPED_AI_FASTEQUIP = 811; //Unlimited equip +TX_MAPED_AI_FASTEQUIP_HINT = 812; //Classic AI: Soldiers are equipped as fast as possible. Equip rates still affect village planning|Advanced AI: No equip limit +TX_MAPED_AI_START = 785; //AI start position +TX_MAPED_AI_START_HINT = 784; //Sets the AI start position which is used for targeting AI attacks +TX_MAPED_AI_TITLE = 491; //AI settings +TX_MAPED_AI_CLASSIC_AI_PARAMS = 1229; //Classic AI|Parameters +TX_MAPED_AI_CLASSIC_AI_PARAMS_HINT = 1230; //Setup AI Parameters used only by Classic AI +TX_MAPED_AI_CLASSIC_AI_PARAMS_TITLE = 1231; //Classic AI Parameters +TX_MAPED_HOUSES_TITLE = 492; //Houses +TX_MAPED_ROAD_TITLE = 493; //Roadworks +TX_MAPED_COPY_SELECT_HINT = 679; //Drag to select an area on the map +TX_MAPED_COPY_PASTE_VFLIP = 677; //Flip vertically +TX_MAPED_COPY_PASTE_VFLIP_HINT = 494; //Vertically flip selection +TX_MAPED_COPY_PASTE_HFLIP = 678; //Flip horizontally +TX_MAPED_COPY_PASTE_HFLIP_HINT = 495; //Horizontally flip selection +TX_MAPED_COPY_PASTE_HINT = 496; //Paste terrain +TX_MAPED_COPY_COPY_HINT = 497; //Copy terrain +TX_MAPED_COPY_TITLE = 498; //Copy/paste +TX_MAPED_TERRAIN_OVERLAYS = 1396; //Tile overlays +TX_MAPED_TERRAIN_HINTS_OVERLAYS = 1397; //Set tile overlays.|Use LMB for safe mode and LMB+Shift to overwrite roads +TX_MAPED_TERRAIN_OVERLAY_TO_NONE = 1582; //No overlay +TX_MAPED_TERRAIN_OVERLAY_TO_DIG1 = 1583; //Dig overlay stage 1 +TX_MAPED_TERRAIN_OVERLAY_TO_DIG2 = 1584; //Dig overlay stage 2 +TX_MAPED_TERRAIN_OVERLAY_TO_DIG3 = 1585; //Dig overlay stage 3 +TX_MAPED_TERRAIN_OVERLAY_TO_DIG4 = 1586; //Dig overlay stage 4 +TX_MAPED_TERRAIN_OVERLAY_TO_ROAD = 1587; //Road overlay +TX_MAPED_COPY = 673; //Copy +TX_MAPED_PASTE = 674; //Paste +TX_MAPED_PASTE_APPLY = 675; //Paste apply +TX_MAPED_PASTE_CANCEL = 676; //Paste cancel +TX_MAPED_PASSABILITY_OFF = 681; //Off +TX_MAPED_NEW_MISSION = 499; //New Mission +TX_MAPED_UNDO = 1548; //Undo +TX_MAPED_UNDO_HINT = 783; //Undo +TX_MAPED_REDO = 1549; //Redo +TX_MAPED_REDO_HINT = 782; //Redo + +TX_MAPED_COPY_PASTE_TERRAIN_HINT = 1493; //Apply terrain from copied area +TX_MAPED_COPY_PASTE_HEIGHTS_HINT = 1494; //Apply heights from copied area +TX_MAPED_COPY_PASTE_OBJECTS_HINT = 1495; //Apply objects from copied area +TX_MAPED_COPY_PASTE_OVERLAYS_HINT = 1496; //Apply terrain overlays from copied area + +TX_MAPED_AI_DEFAULTS_HEADING = 813; //Apply AI defaults +TX_MAPED_AI_DEFAULTS_MP_BUILDER = 814; //Multiplayer builder +TX_MAPED_AI_DEFAULTS_MP_BUILDER_HINT = 815; //Applies aggressive AI builder settings to all players (for multiplayer building maps) +TX_MAPED_AI_DEFAULTS_CONFIRM = 816; //Warning: This will override all existing AI settings for all players. Continue? +TX_MAPED_PLAYER_AI_MP_SETUP_HINT = 1589; //Apply multiplayer AI builder settings to player %d +TX_MAPED_PLAYER_AI_MP_SETUP_CONFIRM_TITLE = 1590; //Multiplayer setup for AI player %d +TX_MAPED_PLAYER_AI_MP_SETUP_CONFIRM = 1591; //Warning: This will override all existing AI settings for player %d. Continue? + +TX_MP_MENU_PLAYERNAME = 500; //Player name +TX_MP_MENU_STATUS = 501; //Status: +TX_MP_MENU_CREATE_SERVER = 502; //Create Server +TX_MP_MENU_CREATE_SERVER_HEADER = 503; //CREATE SERVER +TX_MP_MENU_CREATE_SERVER_NAME = 504; //Name +TX_MP_MENU_CREATE_SERVER_PORT = 505; //Port +TX_MP_MENU_CREATE_SERVER_LOCAL = 506; //Create Local Server +TX_MP_MENU_CREATE_SERVER_INTERNET = 507; //Create Internet Server +TX_MP_MENU_CREATE_SERVER_CANCEL = 508; //Cancel +TX_MP_MENU_FIND_SERVER = 509; //Find Server by IP +TX_MP_MENU_FIND_SERVER_HEADER = 510; //FIND SERVER +TX_MP_MENU_FIND_SERVER_ADDRESS = 511; //Address +TX_MP_MENU_FIND_SERVER_PORT = 512; //Port +TX_MP_MENU_FIND_SERVER_ROOM = 513; //Room +TX_MP_MENU_FIND_SERVER_FIND = 514; //Connect +TX_MP_MENU_FIND_SERVER_CANCEL = 515; //Cancel +TX_MP_MENU_PASSWORD_HEADER = 516; //Password protected room +TX_MP_MENU_PASSWORD = 517; //Password +TX_MP_MENU_SERVERLIST_NAME = 518; //Server name +TX_MP_MENU_SERVERLIST_STATE = 519; //State +TX_MP_MENU_SERVERLIST_PLAYERS = 520; //Players +TX_MP_MENU_SERVERLIST_PING = 521; //Ping +TX_MP_MENU_REFRESH_SERVER_LIST = 522; //Refresh Server List +TX_MP_MENU_HEADER_SERVER_DETAILS = 523; //SERVER DETAILS +TX_MP_MENU_PLAYER_LIST = 524; //Player list: +TX_MP_MENU_SERVER_JOIN = 525; //Join +TX_MP_MENU_STATUS_CONNECTING = 526; //Connecting, please wait ... +TX_MP_MENU_LOADING_ANNOUNCEMENTS = 527; //Loading announcements... +TX_MP_MENU_REFRESHING = 528; //Refreshing... + +TX_LOBBY_HEADER_PLAYERS = 529; //Players list +TX_LOBBY_HEADER_STARTLOCATION = 530; //Start location +TX_LOBBY_HEADER_TEAM = 531; //Team +TX_LOBBY_HEADER_FLAGCOLOR = 532; //Color +TX_LOBBY_HEADER_READY = 533; //Ready +TX_LOBBY_HEADER_PING = 534; //Ping +TX_LOBBY_HEADER_PINGFPS = 535; //Ping / FPS +TX_LOBBY_HEADER_SPECTATORS = 780; //Spectators +TX_LOBBY_ALLOW_SPECTATORS = 778; //Allow spectators +TX_LOBBY_SLOT_OPEN = 536; //Open +TX_LOBBY_SELECT = 538; //Select... +TX_LOBBY_RANDOM = 539; //Random +TX_LOBBY_MAP_NONE = 540; //None +TX_LOBBY_MAP_SAVED = 541; //Saved Game +TX_LOBBY_MAP_RANDOM = 1369; //Random map +TX_LOBBY_MAP_RANDOM_HINT = 1370; //Map was generated automatically with random map generator +TX_LOBBY_MAP_SELECT = 542; //Select a map... +TX_LOBBY_MAP_SELECT_SAVED = 543; //Select a save... +TX_LOBBY_QUIT = 544; //Quit lobby +TX_LOBBY_READY = 545; //Ready +TX_LOBBY_NOT_READY = 546; //Not ready +TX_LOBBY_START = 547; //Start! +TX_LOBBY_GAMESPEED_PEACETIME = 548; //Game speed (PT) [real] +TX_LOBBY_GAMESPEED = 549; //Game speed [real] +TX_LOBBY_ROOM_OK = 550; //OK +TX_LOBBY_ROOM_CANCEL = 551; //Cancel +TX_LOBBY_ROOM_DESCRIPTION = 552; //Description +TX_LOBBY_ROOM_PASSWORD = 553; //Password +TX_LOBBY_ROOMSETTINGS = 554; //Room settings +TX_LOBBY_PLAYER_BAN = 556; //Ban from this lobby +TX_LOBBY_PLAYER_KICK = 557; //Kick +TX_LOBBY_PLAYER_SET_HOST = 779; //Promote to host +TX_LOBBY_RANDOMIZE_LOCATIONS = 558; //Randomize locations within teams +TX_LOBBY_MAP_DESCRIPTION = 559; //Description +TX_LOBBY_OPTIONS = 560; //Options +TX_LOBBY_LOCATION_X = 561; //Location %d +TX_LOBBY_SPECTATE = 772; //Spectate +TX_LOBBY_SPECTATOR = 773; //Spectator +TX_LOBBY_ERROR_SELECT_PLAYER = 562; //Error: Please select a player from the save to control +TX_LOBBY_ERROR_NO_MAP = 563; //Error: Map failed to load or no map selected +TX_LOBBY_CANNOT_START = 564; //Cannot start: %s +TX_LOBBY_EVERYONE_NOT_READY = 565; //Not everyone is ready to start +TX_LOBBY_UNABLE_RANDOM_LOCS = 566; //Unable to assign random locations +TX_LOBBY_CANNOT_DISABLE_SPECTATORS = 781; //Cannot disable spectators: Spectators list must be empty +TX_LOBBY_HOST_RIGHTS = 567; //Server has assigned hosting rights to you +TX_LOBBY_GAME_STARTED = 568; //Game started +TX_LOBBY_MAP_BUILD = 569; //Building map +TX_LOBBY_MAP_FIGHT = 570; //Fighting map +TX_LOBBY_MAP_COOP = 571; //Co-operative map +TX_LOBBY_MAP_SPECIAL = 572; //Special map +TX_LOBBY_GAME_OPTIONS = 573; //Game options: +TX_LOBBY_PEACETIME = 574; //Peacetime (minutes) +TX_LOBBY_SLOT_CLOSED = 575; //Closed +TX_LOBBY_HOST_DOES_SETUP = 576; //Host does player setup +TX_LOBBY_DOWNLOAD = 736; //Download +TX_LOBBY_DOWNLOADING = 737; //downloading... +TX_LOBBY_DOWNLOAD_OVERWRITE = 738; //Overwrite existing files +TX_LOBBY_RESET_BANS = 768; //Reset all bans +TX_LOBBY_VIEW_README = 825; //View Readme PDF +TX_LOBBY_PDF_ERROR = 826; //Failed to launch PDF viewer +TX_LOBBY_SETTINGS_SAVE_PWD = 1592; //Stores the current password for future use + +TX_MENU_CAMP_HINT = 795; //To play a previously unlocked campaign mission, select the mission flag on the campaign briefing map + +TX_MULTIPLAYER_WAITING = 577; //Waiting for players: +TX_CHAT_ALL = 578; //All +TX_CHAT_TEAM = 579; //Team +TX_CHAT_SPECTATORS = 794; //Spectators +TX_CHAT_WHISPER_TO = 765; //Whisper to %s +TX_MENU_VOTE_RETURN_LOBBY = 798; //Vote Go to Lobby +TX_MENU_VOTE_RETURN_LOBBY_HINT = 797; //Vote to return this room to the lobby. The game can then be resumed or changed +TX_NET_LOST_CONNECTION = 739; //%s lost connection +TX_NET_HAS_QUIT = 740; //%s has quit +TX_NET_HAS_QUIT_AND_DEFEATED = 989; //%s has quit and is defeated +TX_NET_HAS_RECONNECTED = 741; //%s has reconnected +TX_NET_GAME_IN_PROGRESS = 742; //Cannot join while the game is in progress +TX_NET_ROOM_FULL = 743; //Room is full. No more players can join the game +TX_NET_SAME_NAME = 744; //Player with the same name has already joined the room +TX_NET_JOIN_DATA_FILES = 746; //Error: %s has different data files to the host and so cannot join this game +TX_NET_YOUR_DATA_FILES = 747; //Your data files do not match the host +TX_NET_HOSTING_RIGHTS = 748; //Hosting rights reassigned to %s +TX_NET_DIFFERENT_VERSION = 749; //%s has a different version of %s +TX_NET_MISSING_FILES = 750; //%s does not have %s +TX_NET_QUERY_TIMED_OUT = 751; //Query timed out +TX_NET_DROPPED = 752; //The host dropped %s from the game +TX_NET_KICKED = 753; //%s was kicked by the host +TX_NET_BANNED = 766; //%s was banned from this lobby by the host +TX_NET_RECONNECTING = 754; //Attempting to reconnect to the game... +TX_NET_HAS_JOINED = 755; //%s has joined +TX_NET_RECONNECTION_FAILED = 756; //Reconnection failed: %s +TX_NET_RECONNECTION_DROPPED = 757; //The host decided to continue playing without you :( +TX_NET_KICK_TIMEOUT = 758; //Disconnected by the server: Timeout detected +TX_NET_KICK_BY_HOST = 759; //You were kicked by the host +TX_NET_BANNED_BY_HOST = 767; //You were banned by the host +TX_NET_SERVER_STOPPED = 760; //Server stopped responding +TX_NET_INVALID_ROOM = 761; //Invalid room number +TX_NET_BANS_RESET = 769; //The host reset all bans for this lobby +TX_NET_VOTED = 796; //%s voted to return to the lobby (need %s more votes) +TX_NET_VOTE_PASSED = 799; //%s voted to return to the lobby (vote passed) +TX_NET_VOTE_FAILED = 800; //The vote to return to the lobby failed +TX_NET_PROMOTE_LOCAL_SERVER = 809; //You cannot change host when the server is running in your client +TX_NET_MUTED = 1019; //%s has muted you. You can no longer send messages or beacons to him +TX_NET_HOST_GAME_VERSION_DONT_MATCH = 1362; //Host's game version doesn't match your game version + +TX_CREDITS = 580; //KaM Remake Credits +TX_CREDITS_ORIGINAL = 581; //Original Knights & Merchants Credits +TX_CREDITS_PROGRAMMING = 582; //PROGRAMMING: +TX_CREDITS_ADDITIONAL_PROGRAMMING = 583; //ADDITIONAL PROGRAMMING: +TX_CREDITS_ADDITIONAL_GRAPHICS = 584; //ADDITIONAL GRAPHICS: +TX_CREDITS_ADDITIONAL_SOUNDS = 585; //ADDITIONAL SOUNDS: +TX_CREDITS_ADDITIONAL_MUSIC = 586; //ADDITIONAL MUSIC: +TX_CREDITS_ADDITIONAL_TRANSLATIONS = 587; //ADDITIONAL TRANSLATIONS: +TX_CREDITS_SPECIAL = 588; //SPECIAL THANKS TO: + +TX_MENU_MAPED_MPMAPS = 589; //Multiplayer maps +TX_MENU_MAPED_MPMAPS_SHORT = 1118; //Multiplayer maps +TX_MENU_MAPED_SPMAPS = 590; //Singleplayer maps +TX_MENU_MAPED_DLMAPS = 822; //Downloaded maps +TX_MENU_OPTIONS_SCROLL_SPEED = 591; //Scroll speed +TX_MP_MENU_NO_SERVERS = 592; //No servers found +TX_MENU_OPTIONS_MUSIC_SHUFFLE_SHORT = 1120; //Shuffle tracks +TX_MENU_OPTIONS_MUSIC_SHUFFLE = 593; //Shuffle tracks +TX_MP_MENU_GAME_INFORMATION = 594; //Game information: +TX_MP_STATE_NONE = 595; //- +TX_MP_STATE_LOBBY = 596; //Lobby +TX_MP_STATE_LOADING = 597; //Loading +TX_MP_STATE_GAME = 598; //Game +TX_MODE_BUILD_FIGHT = 599; //Building and Fighting +TX_MODE_FIGHTING = 600; //Fighting +TX_MP_MENU_STATUS_READY = 601; //Ready +TX_MP_MENU_WRONG_VERSION = 602; //Wrong protocol version: %s. Server uses: %s +TX_HOUSES_MARKET_HINT_ADD = 603; //Increase trade amount +TX_HOUSES_MARKET_HINT_REM = 604; //Decrease trade amount +TX_MULTIPLAYER_SAVING_GAME = 605; //Saving game... +TX_MULTIPLAYER_PLAYER_DEFEATED = 606; //%s was defeated! +TX_GAMEPLAY_DROP_PLAYERS = 607; //Drop Players +TX_GAMEPLAY_DROP_PLAYERS_DELAY = 608; //The host will be allowed to drop these players after %d seconds +TX_GAMEPLAY_DROP_PLAYERS_ALLOWED = 609; //The host is now allowed to drop these players +TX_MULTIPLAYER_HOST_DISCONNECTED = 610; //The host (%s) has quit +TX_MULTIPLAYER_HOST_DISCONNECTED_DEFEATED = 990; //The host (%s) has quit and is defeated +TX_MULTIPLAYER_ATTEMPT_RECONNECTING = 611; //The connection to the server was lost. Attempting to reconnect... +TX_GAMEPLAY_CONFIRM_QUIT = 612; //Are you sure you want to quit? +TX_GAMEPLAY_CONFIRM_DROP = 613; //Are you sure you want to permanently drop these players? +TX_GAMEPLAY_CONFIRM_CANCEL = 614; //Cancel +TX_GAMEPLAY_OVERLAY_HIDE = 807; //Hide scripted overlay +TX_GAMEPLAY_OVERLAY_SHOW = 808; //Show scripted overlay + +TX_HOUSES_MARKET_HINT_BLOCKED = 615; //Trading this resource is not available in this mission +TX_HOUSES_WOODCUTTER_PLANT_CHOP = 616; //Plant and fell +TX_HOUSES_WOODCUTTER_CHOP_ONLY = 617; //Fell only +TX_MP_BLOCKED_BY_PEACETIME = 618; //You are not allowed to do that during peacetime +TX_MP_PEACETIME_REMAINING = 619; //Peacetime remaining: %s +TX_MP_PEACETIME_OVER = 620; //Peacetime is over. To thy weapons! +TX_GAME_TIME = 621; //Game time:|%s +TX_TROOP_HALT_HINT = 622; //Halt troop +TX_TROOP_LINK_HINT = 623; //Link up troop|Hold Shift to link several groups +TX_TROOP_SPLIT_HINT = 624; //Separate troop (%s). Separate one unit from troop (Ctrl + %s) +TX_MENU_REPLAYS = 625; //Replay Viewer +TX_MENU_VIEW_REPLAY = 626; //View Replay +TX_SAVE_UNSUPPORTED_FORMAT = 627; //Unsupported format %s +TX_SAVE_UNSUPPORTED_VERSION = 628; //Unsupported version %s +TX_SAVE_UNSUPPORTED_VERSION_SHORT = 1386; //Unsupported version +TX_SAVE_UNSUPPORTED_MODS = 629; //Unsupported modifications +TX_SAVE_SAVE_FILE_NOT_EXISTS = 1599; //Save file does not exist +TX_MENU_PARSE_ERROR = 630; //An error has occurred while parsing the file %s +TX_MENU_LOADING_INITIALIZING = 631; //initializing +TX_MENU_LOADING_SCRIPT = 632; //script +TX_MENU_LOADING_UNITS = 633; //units +TX_MENU_LOADING_HOUSES = 634; //houses +TX_MENU_LOADING_TREES = 635; //trees +TX_MENU_LOADING_DEFINITIONS = 636; //definitions +TX_MENU_LOADING_TILESET = 637; //tileset +TX_MAP_DOESNT_EXIST = 638; //Map not found: %s +TX_SAVE_DOESNT_EXIST = 639; //Save not found: %s +TX_MAP_WRONG_VERSION = 640; //Map files do not match the host for the map: %s +TX_SAVE_WRONG_VERSION = 641; //Save file does not match the host for the save: %s + +TX_REPLAY_FAILED = 642; //The replay failed a consistency check. This is a known bug which affects playback of some replays.\nIf you continue watching the replay will no longer be accurate and the game may crash.\nDo you want to continue watching? Choose 'Yes to All' to ignore future consistency check failures. +TX_PAUSED_FILE_MISMATCH = 828; //Error: Host's paused file does not match local paused file. An error has occurred or the host might be attempting to cheat. +TX_MULTIPLE_INSTANCES = 643; //You may only have one instance of the game in multiplayer mode at once +TX_ERROR_MODS = 644; //Modifications to the game are not allowed in multiplayer.|Please reinstall to restore the original files. +TX_ERROR_MESSAGE = 645; //An error occurred in the application. Please click Send Bug Report so we can investigate this issue. Thanks for your help! +TX_ERROR_SEND = 646; //Send Bug Report +TX_ERROR_SHOW_DATA = 647; //Show Raw Data +TX_ERROR_RESUME = 648; //Resume Application +TX_ERROR_TERMINATE = 649; //Terminate Application +TX_ERROR_SEND_NEXT = 650; //Next +TX_ERROR_SEND_CONTACT = 651; //Contact Details +TX_ERROR_SEND_NAME = 652; //Your name: (optional) +TX_ERROR_SEND_EMAIL = 653; //Your email: (optional) +TX_ERROR_SEND_REMEMBER = 654; //Remember me +TX_ERROR_SEND_DETAILS = 655; //Error Details +TX_ERROR_SEND_DETAILS_MESSAGE = 656; //In what situation did the error occur? Can you provide any additional information? (English preferred) +TX_ERROR_SEND_SCREENSHOT = 657; //Screenshot +TX_ERROR_SEND_SCREENSHOT_MESSAGE = 658; //Attach a screenshot to the bug report +TX_ERROR_SEND_SCREENSHOT_EDIT = 659; //(click to edit image) +TX_ERROR_SEND_SEND = 660; //Send Report +TX_ERROR_SEND_CANCEL = 661; //Cancel +TX_ERROR_SENDING_TITLE = 662; //Sending bug report... +TX_ERROR_SENDING_CONNECTING = 663; //Connecting to server... +TX_ERROR_SENDING_DATA = 664; //Sending data... +TX_ERROR_SENDING_FAILED = 665; //Sending the crash report failed! Our server might be busy, please try sending it again. +TX_ERROR_WAIT_TITLEBAR = 666; //Information +TX_ERROR_WAIT_MESSAGE = 667; //Please wait a moment... + +TX_KEY_FUNC_SCROLL_LEFT = 845; //Scroll Left +TX_KEY_FUNC_SCROLL_RIGHT = 846; //Scroll Right +TX_KEY_FUNC_SCROLL_UP = 847; //Scroll Up +TX_KEY_FUNC_SCROLL_DOWN = 848; //Scroll Down +TX_KEY_FUNC_MENU_BUILD = 849; //Build Menu +TX_KEY_FUNC_MENU_RATIO = 850; //Ratio Menu +TX_KEY_FUNC_MENU_STATS = 851; //Statistics Menu +TX_KEY_FUNC_MENU_MAIN = 852; //Options Menu +TX_KEY_FUNC_HALT = 853; //Halt Command +TX_KEY_FUNC_SPLIT = 854; //Splitup Command +TX_KEY_FUNC_LINKUP = 855; //Linkup Command +TX_KEY_FUNC_FOOD = 856; //Food Command +TX_KEY_FUNC_STORM = 857; //Storm Command +TX_KEY_FUNC_FORM_INCREASE = 858; //Increase Formation +TX_KEY_FUNC_FORM_DECREASE = 859; //Decrease Formation +TX_KEY_FUNC_TURN_CW = 860; //Turn Clockwise +TX_KEY_FUNC_TURN_CCW = 861; //Turn Counterclockwise +TX_KEY_FUNC_TRAIN_PREV = 1430; //Go to previous unit +TX_KEY_FUNC_TRAIN_EQUIP = 1431; //Train or Equip unit +TX_KEY_FUNC_TRAIN_NEXT = 1432; //Go to next unit +TX_KEY_FUNC_GAME_SPEED_1 = 862; //Normal Game Speed (x1) +TX_KEY_FUNC_GAME_SPEED_2 = 863; //Game Speed x%s +TX_KEY_FUNC_GAME_SPEED_3 = 864; //Game Speed x%s +TX_KEY_FUNC_GAME_SPEED_4 = 865; //Game Speed x%s +TX_KEY_FUNC_BEACON = 866; //Beacon +TX_KEY_FUNC_PAUSE = 867; //Pause +TX_KEY_FUNC_SHOW_TEAMS = 868; //Show Teams (MP) +TX_KEY_FUNC_MAP_DRAG_SCROLL = 1017; //Map drag scroll +TX_KEY_FUNC_ZOOM_IN = 869; //Zoom In +TX_KEY_FUNC_ZOOM_OUT = 870; //Zoom Out +TX_KEY_FUNC_ZOOM_RESET = 871; //Reset Zoom +TX_KEY_FUNC_SELECT_1 = 872; //Select Group 1 +TX_KEY_FUNC_SELECT_2 = 873; //Select Group 2 +TX_KEY_FUNC_SELECT_3 = 874; //Select Group 3 +TX_KEY_FUNC_SELECT_4 = 875; //Select Group 4 +TX_KEY_FUNC_SELECT_5 = 876; //Select Group 5 +TX_KEY_FUNC_SELECT_6 = 877; //Select Group 6 +TX_KEY_FUNC_SELECT_7 = 878; //Select Group 7 +TX_KEY_FUNC_SELECT_8 = 879; //Select Group 8 +TX_KEY_FUNC_SELECT_9 = 880; //Select Group 9 +TX_KEY_FUNC_SELECT_10 = 881; //Select Group 10 +TX_KEY_FUNC_SELECT_11 = 993; //Select Group 11 +TX_KEY_FUNC_SELECT_12 = 994; //Select Group 12 +TX_KEY_FUNC_SELECT_13 = 995; //Select Group 13 +TX_KEY_FUNC_SELECT_14 = 996; //Select Group 14 +TX_KEY_FUNC_SELECT_15 = 997; //Select Group 15 +TX_KEY_FUNC_SELECT_16 = 998; //Select Group 16 +TX_KEY_FUNC_SELECT_17 = 999; //Select Group 17 +TX_KEY_FUNC_SELECT_18 = 1000; //Select Group 18 +TX_KEY_FUNC_SELECT_19 = 1001; //Select Group 19 +TX_KEY_FUNC_SELECT_20 = 1002; //Select Group 20 +TX_KEY_FUNC_PLAN_ROAD = 1003; //Construct road +TX_KEY_FUNC_PLAN_FIELD = 1004; //Plough field +TX_KEY_FUNC_PLAN_WINE = 1005; //Lay out wine field +TX_KEY_FUNC_ERASE_PLAN = 1006; //Remove building/highlights +TX_KEY_FUNC_SEL_NXT_BLD_UNIT_SAME_TYPE = 1007; //Select next house/unit with same type +TX_KEY_FUNC_DBG_WINDOW = 1008; //Debug window +TX_KEY_FUNC_SPECPANEL_DROPBOX_OPEN_CLOSE = 1258; //Open/Close spectator stats panel +TX_KEY_FUNC_REPLAY_PLAY_NEXT_TICK = 1357; //Play next tick in replay +TX_KEY_FUNC_SPECTATE_PLAYER_1 = 1009; //Spectate player 1 +TX_KEY_FUNC_SPECTATE_PLAYER_2 = 1010; //Spectate player 2 +TX_KEY_FUNC_SPECTATE_PLAYER_3 = 1011; //Spectate player 3 +TX_KEY_FUNC_SPECTATE_PLAYER_4 = 1012; //Spectate player 4 +TX_KEY_FUNC_SPECTATE_PLAYER_5 = 1013; //Spectate player 5 +TX_KEY_FUNC_SPECTATE_PLAYER_6 = 1014; //Spectate player 6 +TX_KEY_FUNC_SPECTATE_PLAYER_7 = 1015; //Spectate player 7 +TX_KEY_FUNC_SPECTATE_PLAYER_8 = 1016; //Spectate player 8 +TX_KEY_FUNC_SPECTATE_PLAYER_9 = 1106; //Spectate player 9 +TX_KEY_FUNC_SPECTATE_PLAYER_10 = 1107; //Spectate player 10 +TX_KEY_FUNC_SPECTATE_PLAYER_11 = 1108; //Spectate player 11 +TX_KEY_FUNC_SPECTATE_PLAYER_12 = 1109; //Spectate player 12 +TX_KEY_FUNC_CENTER_ALERT = 882; //Center to Alert +TX_KEY_FUNC_DELETE_MSG = 883; //Delete Message +TX_KEY_FUNC_SHOW_GAME_CHAT = 884; //Show Game Chat (MP) +TX_KEY_FUNC_CLOSE_MENU = 885; //Close Menu's +TX_KEY_FUNC_DBG_MAP = 886; //Debug Show Map +TX_KEY_FUNC_DBG_VICTORY = 887; //Debug Victory +TX_KEY_FUNC_DBG_DEFEAT = 888; //Debug Defeat +TX_KEY_FUNC_DBG_SCOUT = 889; //Debug Add Scout +TX_KEY_FUNC_MAPEDIT_EXTRA = 890; //Extra's Menu +TX_KEY_FUNC_MAPEDIT_SAVE = 1594; //Save map +TX_KEY_FUNC_MAPEDIT_TERAIN_EDIT = 891; //Terrain Editor +TX_KEY_FUNC_MAPEDIT_VILLAGE_PLAN = 892; //Village Planning +TX_KEY_FUNC_MAPEDIT_VISUAL_SCRIPT = 893; //Visual Scripting +TX_KEY_FUNC_MAPEDIT_GLOBAL_SCRIPT = 894; //Global Scripting +TX_KEY_FUNC_MAPEDIT_MENU_MAIN = 895; //Main Menu +TX_KEY_FUNC_MAPEDIT_SUBMENU_1 = 896; //Sub-menu 1 +TX_KEY_FUNC_MAPEDIT_SUBMENU_2 = 897; //Sub-menu 2 +TX_KEY_FUNC_MAPEDIT_SUBMENU_3 = 898; //Sub-menu 3 +TX_KEY_FUNC_MAPEDIT_SUBMENU_4 = 899; //Sub-menu 4 +TX_KEY_FUNC_MAPEDIT_SUBMENU_5 = 900; //Sub-menu 5 +TX_KEY_FUNC_MAPEDIT_SUBMENU_6 = 901; //Sub-menu 6 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_1 = 1129; //Sub-menu action 1 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_2 = 1130; //Sub-menu action 2 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_3 = 1131; //Sub-menu action 3 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_4 = 1132; //Sub-menu action 4 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_5 = 1133; //Sub-menu action 5 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_6 = 1134; //Sub-menu action 6 +TX_KEY_FUNC_MAPEDIT_SUBMENU_ACTION_7 = 1135; //Sub-menu action 7 +TX_KEY_FUNC_MAPEDIT_OBJ_PALETTE = 1020; //Objects palette +TX_KEY_FUNC_MAPEDIT_TILES_PALETTE = 1425; //Tiles palette +TX_KEY_FUNC_MAPEDIT_UNIV_ERASOR = 1021; //Universal eraser +TX_KEY_FUNC_MAPEDIT_PAINT_BUCKET = 1136; //Paint bucket (change owner) +TX_KEY_FUNC_MAPEDIT_HISTORY = 1408; //History +TX_KEY_FUNC_MAPEDIT_FLAT_TERRAIN = 1597; //Flat terrain +TX_KEY_FUNC_MAPEDIT_TILES_GRID = 1598; //Tiles grid +TX_KEY_FUNC_MUSIC_PREV_TRACK = 1457; //Music previous track +TX_KEY_FUNC_MUSIC_NEXT_TRACK = 1458; //Music next track +TX_KEY_FUNC_MUSIC_DISABLE = 1459; //Disable music +TX_KEY_FUNC_MUSIC_SHUFFLE = 1460; //Shuffle music +TX_KEY_FUNC_MUSIC_VOLUME_UP = 1461; //Music volume up +TX_KEY_FUNC_MUSIC_VOLUME_DOWN = 1462; //Music volume down +TX_KEY_FUNC_MUSIC_MUTE = 1463; //Mute music +TX_KEY_FUNC_SOUND_VOLUME_UP = 1464; //Sound volume up +TX_KEY_FUNC_SOUND_VOLUME_DOWN = 1465; //Sound volume down +TX_KEY_FUNC_SOUND_MUTE = 1466; //Mute sounds +TX_KEY_FUNC_MUTE_ALL = 1467; //Mute all (music and sounds) +TX_KEY_FUNC_UNKNOWN = 903; //~~~ Unknown value +TX_KEY_UNASSIGNABLE = 902; //Ctrl and Shift are unassignable +TX_KEY_LMB = 904; //Left Mouse Button +TX_KEY_MMB = 905; //Middle Mouse Button +TX_KEY_RMB = 906; //Right Mouse Button +TX_KEY_BREAK = 907; //Break +TX_KEY_BACKSPACE = 908; //Backspace +TX_KEY_TAB = 909; //TAB +TX_KEY_CLEAR = 910; //Clear +TX_KEY_ENTER = 911; //Return +TX_KEY_SHIFT = 912; //Shift +TX_KEY_CTRL = 913; //Control +TX_KEY_ALT = 914; //Alt +TX_KEY_PAUSE = 915; //Pause +TX_KEY_CAPS = 916; //Caps Lock +TX_KEY_ESC = 917; //Escape +TX_KEY_SPACE = 918; //Space Bar +TX_KEY_PG_UP = 919; //Page Up +TX_KEY_PG_DOWN = 920; //Page Down +TX_KEY_END = 921; //End +TX_KEY_HOME = 922; //Home +TX_KEY_ARROW_LEFT = 923; //Left Arrow Key +TX_KEY_ARROW_UP = 924; //Up Arrow Key +TX_KEY_ARROW_RIGHT = 925; //Right Arrow Key +TX_KEY_ARROW_DOWN = 926; //Down Arrow Key +TX_KEY_SELECT = 927; //Select +TX_KEY_PRINT = 928; //Print +TX_KEY_EXECUTE = 929; //Execute +TX_KEY_PRINT_SCREEN = 930; //Print Screen +TX_KEY_INSERT = 931; //Insert +TX_KEY_DELETE = 932; //Delete +TX_KEY_HELP = 933; //Help +TX_KEY_NUM_0 = 934; //Num Pad 0 +TX_KEY_NUM_1 = 935; //Num Pad 1 +TX_KEY_NUM_2 = 936; //Num Pad 2 +TX_KEY_NUM_3 = 937; //Num Pad 3 +TX_KEY_NUM_4 = 938; //Num Pad 4 +TX_KEY_NUM_5 = 939; //Num Pad 5 +TX_KEY_NUM_6 = 940; //Num Pad 6 +TX_KEY_NUM_7 = 941; //Num Pad 7 +TX_KEY_NUM_8 = 942; //Num Pad 8 +TX_KEY_NUM_9 = 943; //Num Pad 9 +TX_KEY_NUM_MULTIPLY = 944; //Num Pad * +TX_KEY_NUM_PLUS = 960; //Num Pad + +TX_KEY_SEPARATOR = 945; //Separator +TX_KEY_NUM_MINUS = 946; //Num Pad - +TX_KEY_NUM_DOT = 947; //Num Pad . +TX_KEY_NUM_DIVIDE = 948; //Num Pad / +TX_KEY_NUM_LOCK = 949; //Num Lock +TX_KEY_SCROLL_LOCK = 950; //Scroll Lock +TX_KEY_LEFT_SHIFT = 951; //Left Shift +TX_KEY_RIGHT_SHIFT = 952; //Right Shift +TX_KEY_LEFT_CTRL = 953; //Left Control +TX_KEY_RIGHT_CTRL = 954; //Right Control +TX_KEY_LEFT_ALT = 955; //Left Alt +TX_KEY_RIGHT_ALT = 956; //Right Alt +TX_KEY_PLAY = 957; //Play +TX_KEY_ZOOM = 958; //Zoom +TX_KEY_COMMON = 961; //Common Keys +TX_KEY_GAME = 962; //Game Keys +TX_KEY_MAPEDIT = 963; //Map Editor Keys +TX_KEY_SPECTATE_REPLAY = 1018; //Spectate/Replay view Keys +TX_KEY_UNIT = 1433; //Unit orders Keys +TX_KEY_HOUSE = 1434; //House Keys +TX_KEY_CTRL_MOUSEWHEEL = 1194; //Ctrl + Mouse wheel +TX_KEY_ALT_MOUSEWHEEL = 1195; //Alt + Mouse wheel +TX_KEY_SHIFT_MOUSEWHEEL = 1196; //Shift + Mouse wheel +TX_KEY_BROWSER_BACK = 1439; //Browser back +TX_KEY_BROWSER_FORWARD = 1440; //Browser forward +TX_KEY_BROWSER_REFRESH = 1441; //Browser refresh +TX_KEY_BROWSER_STOP = 1442; //Browser stop +TX_KEY_BROWSER_SEARCH = 1443; //Browser search +TX_KEY_BROWSER_FAVORITES = 1444; //Browser favorites +TX_KEY_BROWSER_HOME = 1445; //Browser home +TX_KEY_VOLUME_MUTE = 1446; //Volume mute +TX_KEY_VOLUME_DOWN = 1447; //Volume down +TX_KEY_VOLUME_UP = 1448; //Volume up +TX_KEY_MEDIA_NEXT_TRACK = 1449; //Media next track +TX_KEY_MEDIA_PREV_TRACK = 1450; //Media previous track +TX_KEY_MEDIA_STOP = 1451; //Media stop +TX_KEY_MEDIA_PLAY_PAUSE = 1452; //Media play/pause +TX_KEY_LAUNCH_MAIL = 1453; //Launch mail +TX_KEY_LAUNCH_MEDIA_SELECT = 1454; //Launch media select +TX_KEY_LAUNCH_APP1 = 1455; //Launch application 1 +TX_KEY_LAUNCH_APP2 = 1456; //Launch application 2 + +TX_MSG_WOODCUTTER_PLANT_DEPLETED = 1022; //Your woodcutter cannot find any free place to plant a tree + +TX_MSG_HOUSE_UNOCCUPIED__22 = 966; //This armor smithy is not occupied +TX_MSG_HOUSE_UNOCCUPIED_ARMORYWORKSHOP = 967; //This armory workshop is not occupied +TX_MSG_HOUSE_UNOCCUPIED_BAKERY = 968; //This bakery is not occupied +TX_MSG_HOUSE_UNOCCUPIED_BUTCHERS = 969; //This butcher's is not occupied +TX_MSG_HOUSE_UNOCCUPIED_COALMINE = 970; //This coal mine is not occupied +TX_MSG_HOUSE_UNOCCUPIED_FARM = 971; //This farm is not occupied +TX_MSG_HOUSE_UNOCCUPIED_FISHERMANS = 972; //This fisherman's is not occupied +TX_MSG_HOUSE_UNOCCUPIED_GOLDMINE = 973; //This gold mine is not occupied +TX_MSG_HOUSE_UNOCCUPIED_IRONMINE = 974; //This iron mine is not occupied +TX_MSG_HOUSE_UNOCCUPIED_IRONSMITHY = 975; //This iron smithy is not occupied +TX_MSG_HOUSE_UNOCCUPIED_METALLURGISTS = 976; //This metallurgist's is not occupied +TX_MSG_HOUSE_UNOCCUPIED_MILL = 977; //This mill is not occupied +TX_MSG_HOUSE_UNOCCUPIED_QUARRY = 978; //This quarry is not occupied +TX_MSG_HOUSE_UNOCCUPIED_SAWMILL = 979; //This sawmill is not occupied +TX_MSG_HOUSE_UNOCCUPIED_SIEGEWORKSHOP = 980; //This siege workshop is not occupied +TX_MSG_HOUSE_UNOCCUPIED_STABLES = 981; //These stables are not occupied +TX_MSG_HOUSE_UNOCCUPIED_SWINEFARM = 982; //This swine farm is not occupied +TX_MSG_HOUSE_UNOCCUPIED_TANNERY = 983; //This tannery is not occupied +TX_MSG_HOUSE_UNOCCUPIED_WATCHTOWER = 984; //This watchtower is not occupied +TX_MSG_HOUSE_UNOCCUPIED_WEAPONSMITHY = 985; //This weapon smithy is not occupied +TX_MSG_HOUSE_UNOCCUPIED_WEAPONSWORKSHOP = 986; //This weapons workshop is not occupied +TX_MSG_HOUSE_UNOCCUPIED_VINEYARD = 987; //This vineyard is not occupied +TX_MSG_HOUSE_UNOCCUPIED_WOODCUTTERS = 988; //This woodcutter's is not occupied + +TX_CHART_PT_END = 1023; //PT- +TX_MULTIPLAYER_PLAYER_WON = 1024; //%s has won! +TX_MULTIPLAYER_CHAT_PLAYER_NOT_CONNECTED_ANYMORE = 1025; //%s is not connected to game anymore + +TX_HOUSES_TOWNHALL_MAX_GOLD = 1026; //Max Gold +TX_HOUSES_TOWNHALL_MAX_GOLD_HINT = 1027; //Maximum amount of gold to deliver into townhall +TX_HOUSES_WOODCUTTER_PLANT_ONLY = 1028; //Plant only +TX_HOUSES_CLOSED_FOR_WORKER_HINT = 1029; //Open / Close house for %s + +TX_LOBBY_SLOT_OPEN_ALL = 1030; //All +TX_LOBBY_SLOT_CLOSED_ALL = 1031; //All +TX_LOBBY_SLOT_AI_ALL = 1032; //All + +TX_MENU_MAP_RENAME = 1033; //Rename Map +TX_SETTINGS_PAUSE_AT_PT_END = 1034; //Pause at peacetime end +TX_GAMEPLAY_GAME_TIME = 1035; //Game time +TX_MENU_MAP_MOVE_NAME_TITLE = 1036; //Name + +TX_RESULTS_ARMY_POWER = 1037; //Army power +TX_RESULTS_ALL_SOLDIERS = 1038; //All soldiers +TX_RESULTS_CHART_TYPE = 1039; //Chart type +TX_RESULTS_WARES_QUANTITY = 1040; //Quantity +TX_RESULTS_WARES_GDP = 1041; //GDP +TX_RESULTS_ARMY_INSTANTANEOUS = 1042; //Instantaneous +TX_RESULTS_ARMY_TOTAL_EQUIPPED = 1043; //Total equipped +TX_RESULTS_ARMY_DEFEATED = 1044; //Defeated +TX_RESULTS_ARMY_LOST = 1045; //Lost +TX_RESULTS_BACK_TO_RESULTS = 1046; //Back to game results +TX_RESULTS_BY_PLAYERS = 1047; //by Players +TX_RESULTS_BY_TEAMS = 1048; //by Teams +TX_RESULTS_MORE_STATS = 1049; //More|statistics + +TX_MENU_RETURN_TO_MAPED = 1050; //Return to MapEd +TX_MENU_RETURN_TO_MAPED_HINT = 1051; //Return to Map Editor +TX_REPLAY_QUIT_CONFIRMATION = 1052; //Are you sure you|want to quit|this replay? + +TX_NET_ERR_MAP_INVALID = 1053; //Map is invalid +TX_NET_ERR_MAP_INVALID_MSG = 1054; //Selected map is invalid. Please select another map +TX_NET_ERR_DL_MAP_FILE_CHANGED = 1055; //Downloaded map files have changed +TX_NET_ERR_DL_MAP_FILE_CHANGED_MSG = 1056; //Selected DL map, which files have changed. Please move it out of downloads first +TX_NET_ERR_MAP_FILE_CHANGED = 1057; //Map files have changed. Please reselect the map + +TX_KEY_MOUSE_FORWARD = 1058; //Forward mouse button +TX_KEY_MOUSE_BACKWARD = 1059; //Backward mouse button + +TX_UNITS_ALL = 1060; //All +TX_MAPED_UNIVERSAL_ERASER = 1061; //Universal eraser +TX_MAPED_SHOW_TILE_OWNERS = 1062; //Show tile owners +TX_MAPED_SHOW_TILES_GRID = 1063; //Show tiles grid + +TX_HOUSES_WOODCUTTER_CUTTING_POINT = 1064; //Cutting point +TX_MAPED_WOODCUTTER_CUTTING_POINT_HINT = 1065; //Set woodcutters cutting point. Alternatively you can set it via Shift + Right mouse button +TX_HOUSES_RALLY_POINT = 1066; //Rally point +TX_MAPED_RALLY_POINT_HINT = 1067; //Set %s rally point. Alternatively you can set it via Shift + Right mouse button + +TX_MAPED_MAP_RESIZE = 1068; //Resize Map +TX_MAPED_MAP_RESIZE_MOVE_BORDERS = 1069; //Move borders: +TX_MAPED_MAP_RESIZE_AND_SAVE = 1070; //Resize and Save +TX_MAPED_MAP_RESIZE_AND_SAVE_HINT = 1071; //Resize map and then save it +TX_MAPED_MAP_RESIZE_CONFIRM_TITLE = 1072; //Map resize +TX_MAPED_MAP_RESIZE_CONFIRM = 1073; //Are you sure want to resize the map?||It will automatically override current map +TX_MAPED_MAP_RESIZE_NOT_AVAIL = 1074; //Resize is not available||You need to save new map first +TX_MAPED_MAP_RESIZE_CURR_MAP_SIZE = 1110; //Current map size:|[ %d : %d ] +TX_MAPED_MAP_RESIZE_NEW_MAP_SIZE = 1111; //New map size:|[ %d : %d ] +TX_MAPED_MAP_RESIZE_TITLE = 1112; //Resize Map + +TX_MAPED_PAINT_BUCKET_CH_OWNER = 1075; //Change owner for object +TX_PLAYER_FLAG_HINT = 1113; //Owner: %s + +TX_MAPED_MAP_QUICK_PLAY = 1076; //Quick Play +TX_MAPED_MAP_QUICK_PLAY_HINT = 1077; //Start singleplayer game on current map +TX_MAPED_MAP_QUICK_PLAY_SEL_PLAYER = 1078; //Select player: +TX_MAPED_MAP_QUICK_PLAY_SEL_PLAYER_TO_START = 1079; //Select player to start map as +TX_MAPED_MAP_QUICK_PLAY_START_NO_SAVE = 1080; //Start without save +TX_MAPED_MAP_QUICK_PLAY_START_NO_SAVE_HINT = 1081; //Discard changes and start game as selected player +TX_MAPED_MAP_QUICK_PLAY_SAVE_AND_START = 1082; //Save and start +TX_MAPED_MAP_QUICK_PLAY_SAVE_AND_START_HINT = 1083; //Save map and start game as selected player + +TX_MAPED_BLOCK_UNITS_IN_BARRACKS = 1084; //In Barracks: +TX_MAPED_BLOCK_UNITS_IN_TOWNHALL = 1085; //In TownHall: + +TX_MAPED_TERRAIN_ROTATE_TILE = 1086; //Rotate tile on map +TX_MAPED_TERRAIN_OBJECTS_PALETTE = 1087; //Objects palette +TX_MAPED_TERRAIN_CLOSE_PALETTE = 1088; //Close palette +TX_MAPED_UNITS_REMOVE_HINT = 1089; //Remove units/groups +TX_MAPED_TERRAIN_TILE_ID_EDIT_HINT = 1262; //Search tile by ID +TX_UNIT_CONDITION_DEFAULT = 1588; //Default + +TX_GAME_SETTINGS_REPLAY_AUTOPAUSE = 1090; //Replay autopause +TX_GAME_SETTINGS_REPLAY_AUTOPAUSE_HINT = 1091; //Automatically pause replay when peacetime ends +TX_GAME_SETTINGS_SHOW_BEACONS = 1092; //Show beacons +TX_GAME_SETTINGS_SHOW_BEACONS_HINT = 1093; //Show players beacons + +TX_MUTE_PLAYER = 1094; //Mute player +TX_UNMUTE_PLAYER = 1095; //Unmute player +TX_LOBBY_REMEMBER_PASSWORD = 1096; //Remember this password +TX_LOBBY_USE_LAST_PASSWORD = 1097; //Use last known password +TX_GO_PREV_MENU = 1098; //Go previous menu + +TX_WORD_OK = 312; //Ok +TX_WORD_YES = 1099; //Yes +TX_WORD_NO = 1100; //No +TX_WORD_CANCEL = 1101; //Cancel +TX_WORD_MAP = 1102; //Map +TX_WORD_REPLAY = 1103; //Replay +TX_WORD_PLAYERS = 1104; //Players +TX_WORD_TEAMS = 1105; //Teams +TX_WORD_CLOSE = 1117; //Close +TX_WORD_TEXT = 1159; //Text + +TX_MAPED_PLAYER_DELETE_HINT = 1114; //Delete Player %d +TX_MAPED_PLAYER_TYPE_ALLOW_ALL = 1363; //All +TX_MAPED_PLAYER_TYPE_ALLOW_ALL_HINT = 1364; //Allow '%s' for all available locs +TX_MAPED_PLAYER_TYPE_DISALLOW_ALL_HINT = 1365; //Prohibit '%s' for all available locs + +TX_MAPED_PLAYER_DELETE_TITLE = 1115; //Delete Player %d +TX_MAPED_PLAYER_DELETE_CONFIRM = 1116; //Are you sure you want to clear the player?|All his data will be erased! + +TX_MENU_MAP_TYPE = 1122; //Map type +TX_MENU_SP_MAP_SCENARIO = 1123; //Scenario map +TX_MENU_MAP_PLAYABLE_AS_SP = 1124; //Playable as SP + +TX_MAPED_OBJ_CHOPPABLE_HINT = 1125; //Choppable tree +TX_MAPED_OBJ_BLOCK_WALK_DIAG_HINT = 1126; //Blocks diagonal walking +TX_MAPED_OBJ_BLOCK_ALL_HINT = 1127; //Blocks everything except building +TX_MAPED_OBJ_BLOCK_BUILD_HINT = 1394; //Blocks building +TX_MAPED_OBJ_BLOCK_WALK_BUILD_HINT = 1395; //Blocks walking and building + +TX_MAPED_MISSION_PARAMETERS_BTN = 1145; //Mission|parameters +TX_MAPED_MISSION_PARAMETERS_BTN_HINT = 1146; //Modify mission parameters +TX_MAPED_MISSION_PARAMETERS_TITLE = 1147; //Mission parameters +TX_MAPED_MISSION_AUTHOR = 1148; //Author +TX_MAPED_MISSION_VERSION = 1427; //Version +TX_MAPED_MISSION_SMALL_DESC = 1149; //Small description +TX_MAPED_MISSION_BIG_DESC = 1150; //Long description +TX_MAPED_MISSION_LIBX_TEXT_ID = 1151; //Libx text ID +TX_MAPED_MISSION_PLAYABLE_AS_SP_HINT = 1152; //This map will be always visible in singleplayer maps list +TX_MAPED_MISSION_BLOCK_TEAM_SEL = 1153; //Block team selection +TX_MAPED_MISSION_BLOCK_TEAM_SEL_HINT = 1154; //Blocks team selection in lobby +TX_MAPED_MISSION_BLOCK_PT = 1155; //Block peacetime +TX_MAPED_MISSION_BLOCK_PT_HINT = 1156; //Blocks peacetime change in lobby +TX_MAPED_MISSION_BLOCK_FULL_MAP_PREVIEW = 1157; //Block full map preview +TX_MAPED_MISSION_BLOCK_FULL_MAP_PREVIEW_HINT = 1158; //Blocks full map preview in lobby +TX_MAPED_MISSION_BLOCK_COLOR_SEL = 1406; //Block player color selection +TX_MAPED_MISSION_BLOCK_COLOR_SEL_HINT = 1407; //Blocks player color selection + +TX_MAPED_PLAYER_COLOR_CODE = 1163; //Color code: +TX_MAPED_PLAYER_COLOR_BGR_HINT = 1164; //Blue / Green / Red +TX_MAPED_PLAYER_COLOR_RGB_HINT = 1165; //Red / Green / Blue +TX_MAPED_PLAYER_COLOR_TEXT_COLOR = 1166; //Text color: +TX_MAPED_PLAYER_COLOR_TEXT_COLOR_HINT = 1167; //Desaturated color, that could be used for texts (f.e. in scripts overlay) [readonly] + +TX_MENU_MAP_FILTER = 1168; //Maps filter +TX_MENU_MAP_FILTER_RESET = 1169; //Reset filter +TX_MENU_MAP_FILTER_BY_PLAYERS_NUMBER = 1170; //Number of players + +TX_RESULTS_BACK_TO_GAME = 1171; //Back to game +TX_GAME_MENU_SHOW_STATS_HINT = 1172; //Show detailed game statistics + +TX_MISSION_DIFFICULTY = 1173; //Difficulty level +TX_MISSION_DIFFICULTY_CAMPAIGN = 1233; //Difficulty +TX_MISSION_DIFFICULTY_EASY1 = 1174; //Easy +TX_MISSION_DIFFICULTY_EASY2 = 1358; //Easier +TX_MISSION_DIFFICULTY_EASY3 = 1359; //Very easy +TX_MISSION_DIFFICULTY_NORMAL = 1175; //Normal +TX_MISSION_DIFFICULTY_HARD1 = 1176; //Hard +TX_MISSION_DIFFICULTY_HARD2 = 1360; //Harder +TX_MISSION_DIFFICULTY_HARD3 = 1361; //Very hard + +TX_MAPED_MISSION_DIFFICULTY_LEVELS = 1177; //Difficulty levels +TX_MAPED_MISSION_DIFFICULTY_LEVELS_HINT = 1178; //Setup different difficulty levels, which could be used in the script to modify mission logic and difficulty + +TX_PLAYER_WON = 1182; //Winner +TX_PLAYER_LOST = 1183; //Defeated + +TX_PLAYER_HOST = 1184; //Host + +TX_HOUSE_LOGO_HINT = 1185; //Go to selected house + +TX_UNIT_SCROLL_HINT = 1186; //Go to selected unit + +TX_GAME_SETTINGS_COLOR_MODE = 1187; //Ally / Enemy color mode +TX_GAME_SETTINGS_COLOR_MODE_HINT = 1188; //Self / Ally / Enemy colors for players instead of initial player colors +TX_PLAYERS_COLOR_MODE_CAPTION = 1248; //Players colors: +TX_PLAYERS_COLOR_MODE_DEFAULT = 1249; //Default +TX_PLAYERS_COLOR_MODE_ALLY_ENEMY = 1250; //Ally / Enemy +TX_PLAYERS_COLOR_MODE_TEAMS = 1251; //Teams +TX_PLAYERS_COLOR_MODE_DEFAULT_HINT = 1252; //Show player colors according to their choice in lobby +TX_PLAYERS_COLOR_MODE_ALLY_ENEMY_HINT = 1253; //Show 3 different colors (yours, allied, hostile) for citizens and buildings +TX_PLAYERS_COLOR_MODE_TEAMS_HINT = 1254; //Show colors according to team membership + +TX_LOBBY_ALERT_NOT_READY = 1189; //[$404040]Host is ready to start. Please press '[][$0707FF]%s[][$404040]'[] +TX_LOBBY_ALERT_READY_BTN = 1190; //Ask to press Ready +TX_LOBBY_ALERT_GET_READY_SENT = 1191; //Alert to get ready was sent to %s players + +TX_KEY_FUNC_PLAYER_COLOR_MODE = 1192; //Switch players color mode + +TX_UNIT_TASK_DISMISS_NOT_AVAIL_HINT = 1193; //Dismiss is not available during current unit action + +TX_MAP_CUSTOM_PARAM_TH_TROOP_COST = 1204; //Custom TownHall units cost +TX_MAP_CUSTOM_PARAM_MARKET_PRICE = 1205; //Custom gold market prices + +TX_MAPED_TERRAIN_BRUSH_OPTIONS = 1206; // +TX_MAPED_TERRAIN_BRUSH_OPTIONS_HINT = 1207; // +TX_MAPED_TERRAIN_BRUSH_OPTIONS_TITLE = 1208; // + +TX_MAPED_TERRAIN_BRUSH_BLENDING = 1392; //Blending level +TX_MAPED_TERRAIN_BRUSH_BLENDING_HINT = 1393; //Blending level of terrain transitions via masks + +TX_MAPED_TERRAIN_BRUSH_FIX_TERRAIN = 1209; //Fix terrain brushes +TX_MAPED_TERRAIN_BRUSH_FIX_TERRAIN_SHORT = 1428; //Fix terrain brushes +TX_MAPED_TERRAIN_BRUSH_FIX_TERRAIN_HINT = 1210; //Try to repair internal terrain information to make brushes work +TX_MAPED_TERRAIN_BRUSH_FIX_TERRAIN_TITLE = 1211; //Fix terrain brushes +TX_MAPED_TERRAIN_BRUSH_FIX_TERRAIN_CONFIRM = 1212; //Are you sure want to repair|all terrain brushes internal info?||That will allow to use brushes|in spots where manual tiles were used + +TX_MAPED_PLAYERS_DEFAULT_SHORT = 1213; //Def. + +TX_AI_PLAYER = 537; //AI Player +TX_PLAYER_HUMAN = 1214; //Human player +TX_AI_PLAYER_CLASSIC = 1219; //Classic AI Player +TX_AI_PLAYER_ADVANCED = 1179; //Advanced AI Player +TX_AI_PLAYER_ADVANCED_SHORT = 1180; //Advanced AI +TX_AI_PLAYER_CLASSIC_SHORT = 1181; //Classic AI +TX_PLAYER_X = 273; //Player %d +TX_CLASSIC_AI_PLAYER_X = 1215; //Classic AI Player %d +TX_ADVANCED_AI_PLAYER_X = 1216; //Advanced AI Player %d +TX_CLASSIC_AI_PLAYER_SHORT_X = 1217; //Classic AI %d +TX_ADVANCED_AI_PLAYER_SHORT_X = 1218; //Advanced AI %d + +TX_AI_PLAYER_TYPE = 1220; //AI Player Type + +TX_MENU_OPTIONS_AUTOSAVE_AT_GAME_END = 1221; //Autosave at game end + +TX_WORD_NONE = 1222; //None +TX_WORD_RESOURCES = 1223; //Resources +TX_WORD_HOUSES = 1224; //Houses +TX_WORD_CONSTRUCTING = 1225; //Constructing +TX_WORD_CITIZENS = 1226; //Citizens +TX_WORD_ARMY = 1227; //Army + +TX_UNIT_TASK_DISMISS_HUNGRY_HINT = 1228; //Dismiss is not available for hungry units + +TX_PLAYER_AFK_MESSAGE = 1234; //%s is away from keyboard for last %s [$00B0FF]minutes[] + +TX_SCRIPT_CONSOLE_CMD_PROC_NOT_FOUND = 1236; //The procedure [ %s ] declared for the script console command /%s was not found +TX_SCRIPT_CONSOLE_CMD_WRONG_PARAM_TYPE = 1237; //Wrong parameter type for script console command /%s: [%s] +TX_SCRIPT_CONSOLE_CMD_WRONG_1ST_PARAM_TYPE = 1238; //Wrong first parameter type for script command /%s. Expected: [ %s ], actual: [ %s ] +TX_SCRIPT_CONSOLE_CMD_TOO_MANY_PROC_PARAMS = 1239; //Too many parameters for script command /%s: [ %s ]. Max number of parameters is [ %s ] (including mandatory HandID parameter) + +TX_SCRIPT_CONSOLE_CMD_PARAMS_NOT_VALID = 1240; //Wrong parameters for script command /%s. Expected parameters types are: [ %s ] +TX_SCRIPT_CONSOLE_CMD_TOO_MANY_PARAMS = 1241; //Too many parameters passed to script command /%s: Expected parameters count [ %s ], actual: [ %s ] +TX_SCRIPT_CONSOLE_CMD_CALLED = 1242; //Command called: /%s(%s) +TX_SCRIPT_CONSOLE_CMD_PARSING_ERROR = 1243; //Error while calling script command /%s(%s)| +TX_SCRIPT_CONSOLE_CMD_NOT_FOUND = 1244; //Script console command /%s not found + +TX_CHAT_ACTIONS_ALLOWED_HINT = 1245; //Enable/disable chat history and copy from chat window + +TX_FORM_EXPORT_CONFIRM_MSG = 1235; //Data export could take up to several minutes.\nExported data will be stored in '%s' folder.\nDo you wish to proceed? + +TX_SPECTATOR_PANEL_CITIZENS_SLR = 1256; //Citizens (S/L/R) +TX_SPECTATOR_PANEL_CITIZENS_HOUSE_WORKERS = 1257; //Citizens (Others) + +TX_MULTIPLAYER_WAITING_DC_PLAYERS_DATA = 964; //Waiting for disconnected players data: + +TX_HOUSE_DELIVERY_PROHIBITED_HINT = 1259; //Delivery of %s is prohibited +TX_HOUSE_TAKEOUT_PROHIBITED_HINT = 1260; //Supply of %s is prohibited +TX_HOUSE_BARRACKS_NOT_ACCEPT_RECRUIT_HINT = 1261; //Recruit is not allowed to enter Barracks +TX_HOUSE_STORE_BARRACKS_WARE_HINT = 1602; //%s|use LMB to block delivery / RMB to block take out in 'take out' mode and Shift to apply it to all wares + +TX_MAPED_RMG_SETTINGS_TITLE = 1263; //Random Map Generator - Settings +TX_MAPED_RMG_BUTTON_HINT = 1264; //Random map generator settings +TX_MAPED_RMG_BUTTON_TITLE = 1265; //RMG Settings +TX_MAPED_RMG_SETTINGS_MAP_SIZE = 1266; //Map size: +TX_MAPED_RMG_SETTINGS_LOCATIONS = 1267; //Locations +TX_MAPED_RMG_SETTINGS_LOCATIONS_HINT = 1268; //Enable locations with resources +TX_MAPED_RMG_SETTINGS_NUMBER_OF_LOCATIONS = 1269; //Number of locations +TX_MAPED_RMG_SETTINGS_NUMBER_OF_LOCATIONS_HINT = 1270; //Set number of locations +TX_MAPED_RMG_SETTINGS_PROTECTED_RADIUS = 1271; //Protected radius +TX_MAPED_RMG_SETTINGS_PROTECTED_RADIUS_HINT = 1272; //Specify the size of the protected area. It secures the buildable area around each location. +TX_MAPED_RMG_SETTINGS_CONNECT_LOCATIONS = 1273; //Connect locations +TX_MAPED_RMG_SETTINGS_CONNECT_LOCATIONS_HINT = 1274; //Create walking paths between locations +TX_MAPED_RMG_SETTINGS_LAYOUT = 1275; //Layout +TX_MAPED_RMG_SETTINGS_LAYOUT_HINT = 1276; //The layout of the locations +TX_MAPED_RMG_SETTINGS_RECTANGLE = 1277; //Rectangle +TX_MAPED_RMG_SETTINGS_VERTICAL = 1278; //Vertical +TX_MAPED_RMG_SETTINGS_HORIZONTAL = 1279; //Horizontal +TX_MAPED_RMG_SETTINGS_RANDOM = 1280; //Random +TX_MAPED_RMG_SETTINGS_CENTER_SCREEN = 1281; //Center Screen +TX_MAPED_RMG_SETTINGS_RESOURCES = 1282; //Resources +TX_MAPED_RMG_SETTINGS_RESOURCES_HINT = 1283; //Enable resources in each location (coal is computed automatically) +TX_MAPED_RMG_SETTINGS_MINE_FIX = 1284; //Mine fix +TX_MAPED_RMG_SETTINGS_MINE_FIX_HINT = 1285; //Secure that resources are mineable (gold mine and iron mine) +TX_MAPED_RMG_SETTINGS_STONE_HINT = 1286; //Resource quantity: stones +TX_MAPED_RMG_SETTINGS_GOLD_HINT = 1287; //Resource quantity: gold +TX_MAPED_RMG_SETTINGS_IRON_HINT = 1288; //Resource quantity: iron +TX_MAPED_RMG_SETTINGS_OBSTACLES = 1289; //Obstacles +TX_MAPED_RMG_SETTINGS_OBSTACLES_HINT = 1290; //Enable obstacles (mountains, rivers, swamps, etc.) +TX_MAPED_RMG_SETTINGS_SIZE = 1291; //Size +TX_MAPED_RMG_SETTINGS_SIZE_HINT = 1292; //The average size of generated obstacles +TX_MAPED_RMG_SETTINGS_DENSITY = 1293; //Density +TX_MAPED_RMG_SETTINGS_DENSITY_HINT = 1294; //The density of generated obstacles +TX_MAPED_RMG_SETTINGS_VARIANCE = 1295; //Variance +TX_MAPED_RMG_SETTINGS_VARIANCE_HINT = 1296; //The variance in size of generated obstacles +TX_MAPED_RMG_SETTINGS_RATIO = 1297; //Ratio +TX_MAPED_RMG_SETTINGS_RATIO_HINT = 1298; //Type and ratio of generated obstacles +TX_MAPED_RMG_SETTINGS_EMPTY_GOLD = 1299; //Empty gold +TX_MAPED_RMG_SETTINGS_EMPTY_GOLD_HINT = 1300; //Empty gold ratio +TX_MAPED_RMG_SETTINGS_EMPTY_IRON = 1301; //Empty iron +TX_MAPED_RMG_SETTINGS_EMPTY_IRON_HINT = 1302; //Empty iron ratio +TX_MAPED_RMG_SETTINGS_SWAMP = 1303; //Swamp +TX_MAPED_RMG_SETTINGS_SWAMP_HINT = 1304; //Swamp ratio +TX_MAPED_RMG_SETTINGS_WETLAND = 1305; //Wetland +TX_MAPED_RMG_SETTINGS_WETLAND_HINT = 1306; //Wetland ratio +TX_MAPED_RMG_SETTINGS_WATER = 1307; //Water +TX_MAPED_RMG_SETTINGS_WATER_HINT = 1308; //Water ratio +TX_MAPED_RMG_SETTINGS_BIOMES = 1309; //Biomes +TX_MAPED_RMG_SETTINGS_BIOMES_HINT = 1310; //Enable biomes +TX_MAPED_RMG_SETTINGS_TYPE_OF_BIOME = 1311; //Type of biome +TX_MAPED_RMG_SETTINGS_TYPE_OF_BIOME_HINT = 1312; //Select required biomes +TX_MAPED_RMG_SETTINGS_GRASS = 1313; //Grass +TX_MAPED_RMG_SETTINGS_GRASS_HINT = 1314; //The grass is default biome and cannot be removed +TX_MAPED_RMG_SETTINGS_GROUND = 1315; //Ground +TX_MAPED_RMG_SETTINGS_GROUND_HINT = 1316; //Enable ground +TX_MAPED_RMG_SETTINGS_SNOW = 1317; //Snow +TX_MAPED_RMG_SETTINGS_SNOW_HINT = 1318; //Enable snow +TX_MAPED_RMG_SETTINGS_SAND = 1319; //Sand +TX_MAPED_RMG_SETTINGS_SAND_HINT = 1320; //Enable sand +TX_MAPED_RMG_SETTINGS_FIRST_LAYER = 1321; //First layer +TX_MAPED_RMG_SETTINGS_FIRST_LAYER_HINT = 1322; //The first layer of biome (properties of the primary texture) +TX_MAPED_RMG_SETTINGS_SECOND_LAYER = 1323; //Second layer +TX_MAPED_RMG_SETTINGS_SECOND_LAYER_HINT = 1324; //The second layer of biome (properties of secondary textures) +TX_MAPED_RMG_SETTINGS_STEP = 1325; //Step +TX_MAPED_RMG_SETTINGS_STEP_PRIM_HINT = 1326; //Step of the primary texture (higher value = larger biome) +TX_MAPED_RMG_SETTINGS_STEP_SEC_HINT = 1327; //Step of secondary textures (higher value = larger biome) +TX_MAPED_RMG_SETTINGS_LIMIT = 1328; //Limit +TX_MAPED_RMG_SETTINGS_LIMIT_HINT = 1329; //Limitation of biome borders (higher value = larger biome) +TX_MAPED_RMG_SETTINGS_HEIGHT = 1330; //Height +TX_MAPED_RMG_SETTINGS_HEIGHT_HINT = 1331; //Enable height +TX_MAPED_RMG_SETTINGS_HIDE_ROUGHT_TRANSITIONS = 1332; //Hide jagged edges +TX_MAPED_RMG_SETTINGS_HIDE_ROUGHT_TRANSITIONS_HINT = 1333; //Adjust terrain height so rough texture transitions are hidden +TX_MAPED_RMG_SETTINGS_INACCESIBLE_PLACES = 1334; //Inaccesible places +TX_MAPED_RMG_SETTINGS_INACCESIBLE_PLACES_HINT = 1335; //Treatment of inaccessible places +TX_MAPED_RMG_SETTINGS_BLOCK_WALKING = 1336; //Block walking +TX_MAPED_RMG_SETTINGS_BLOCK_WALKING_HINT = 1337; //Block walking (improves game pathfinding and generation of the navigation mesh) +TX_MAPED_RMG_SETTINGS_CHANGE_TEXTURE = 1338; //Change texture +TX_MAPED_RMG_SETTINGS_CHANGE_TEXTURE_HINT = 1339; //Replace terrain with special biomes +TX_MAPED_RMG_SETTINGS_OBJECTS = 1340; //Objects +TX_MAPED_RMG_SETTINGS_OBJECTS_HINT = 1341; //Enable objects +TX_MAPED_RMG_SETTINGS_ANIMALS = 1342; //Animals +TX_MAPED_RMG_SETTINGS_ANIMALS_HINT = 1343; //Enable animals +TX_MAPED_RMG_SETTINGS_OBJECTS_DENSITY_HINT = 1344; //Object density +TX_MAPED_RMG_SETTINGS_FORESTS_DENSITY = 1345; //Forests density +TX_MAPED_RMG_SETTINGS_FORESTS_DENSITY_HINT = 1346; //Forests density +TX_MAPED_RMG_SETTINGS_TREES = 1347; //Trees +TX_MAPED_RMG_SETTINGS_TREES_HINT = 1348; //Number of trees in the forest +TX_MAPED_RMG_SETTINGS_SEED = 1349; //Seed +TX_MAPED_RMG_SETTINGS_SEED_HINT = 1350; //A number that is used as an identifier to generate a map with a specific configuration +TX_MAPED_RMG_SETTINGS_NEW_RANDOM_SEED = 1351; //Randomize Seed +TX_MAPED_RMG_SETTINGS_NEW_RANDOM_SEED_HINT = 1352; //Generate map with new Seed +TX_MAPED_RMG_SETTINGS_GENERATE_MAP = 1353; //Generate map +TX_MAPED_RMG_SETTINGS_GENERATE_MAP_HINT = 1354; //Generate map with current Seed +TX_MAPED_RMG_SETTINGS_CLOSE_RMG_HINT = 1355; //Close Random Map Generator +TX_MAPED_RMG_SETTINGS_HEIGHT_STEP_HINT = 1366; //Step of the height algorithm +TX_MAPED_RMG_SETTINGS_HEIGHT_SLOPE_HINT = 1367; //Slope of the height evaluation (0 = plateau, 100 = peak) +TX_MAPED_RMG_SETTINGS_HEIGHT_HEIGHTS_HINT = 1368; //Maximum height of walkable tiles +TX_MAPED_RMG_SETTINGS_HEIGHT_SMOOTH_PEAKS = 1529; //Smooth peaks +TX_MAPED_RMG_SETTINGS_HEIGHT_SMOOTH_PEAKS_HINT = 1530; //Make mountains peaks smoother +TX_MAPED_RMG_SETTINGS_INITIAL_RESOURCES = 1371; //Initial resources +TX_MAPED_RMG_SETTINGS_INITIAL_RESOURCES_HINT = 1372; //Amount of initial resources in the storehouse +TX_MAPED_RMG_SETTINGS_LOW = 1373; //Low +TX_MAPED_RMG_SETTINGS_MEDIUM = 1374; //Medium +TX_MAPED_RMG_SETTINGS_HIGH = 1375; //High +TX_MAPED_RMG_SETTINGS_MAP_SIZE_HINT = 1376; //Select size of the map + +TX_MAPED_HEIGHTS_CONST = 1497; //Constant Height +TX_MAPED_HEIGHTS_CONST_HINT = 1498; //Brush constant height level +TX_MAPED_HEIGHTS_LEVEL_SET = 1499; //Height level +TX_MAPED_HEIGHTS_LEVEL_SET_HINT = 1500; //Height level is used in 'Constant Height' +TX_MAPED_HEIGHTS_ELEVATE_ALL = 1501; //Elevate all +TX_MAPED_HEIGHTS_ELEVATE_ALL_HINT = 1502; //Elevate (left click) / Lower (right click) all tiles on map with terrain kind at game cursor + +TX_MENU_LOBBY_TRY_TO_START = 1377; //Try to start +TX_MENU_SAVE_TRY_TO_LOAD = 1378; //Try to load save +TX_MENU_REPLAY_TRY_TO_VIEW = 1379; //Try to view replay +TX_UNSUPPORTED_SAVE_LOAD_ERROR_MSG = 1380; //Error loading unsupported version %s save from %s +TX_UNSUPPORTED_REPLAY_LOAD_ERROR_MSG = 1381; //Error loading unsupported version %s replay from %s +TX_UNSUPPORTED_SAVE_LOAD_WARNING_TXT = 1385; //Loading unsupported version could cause game not being properly loaded or even cause game crash + +TX_MENU_DEBUG_UNLOCK_CAMPAIGNS_CONFIRM = 1387; //Are you sure want to unlock all campaigns?\nThis can't be undone.\n\nIf you want to save your campaigns progress be sure you backed up your 'Campaigns.dat' file located at\n'%s'\n\nDo you confirm this operation? + +TX_MENU_OPTIONS_VIDEOS = 1398; //Video clips: +TX_MENU_OPTIONS_VIDEOS_ENABLE = 1399; //Enable +TX_MENU_OPTIONS_VIDEOS_STRETCH = 1400; //Stretch +TX_MENU_OPTIONS_VIDEOS_STARTUP = 1401; //Show at startup +TX_MENU_OPTIONS_VIDEOS_VOLUME = 1402; //Volume +TX_MENU_OPTIONS_VIDEOS_TEST = 1403; //Test video + +TX_MENU_OPTIONS_MODS = 1404; //Mods +TX_MENU_OPTIONS_MODS_SNOW_HOUSES = 1405; //Snow houses + +TX_MAPED_HISTORY_HINT = 1409; //History of changes on the map +TX_MAPED_HISTORY_TITLE = 1410; //History +TX_MAPED_HISTORY_JUMP_TO = 1411; //Jump to +TX_MAPED_HISTORY_JUMP_TO_HINT = 1412; //Go to the selected point in history +TX_MAPED_HISTORY_CHPOINT_INITIAL = 1413; //Initial +TX_MAPED_HISTORY_CHPOINT_ADD_SMTH = 1414; //Add %s %s +TX_MAPED_HISTORY_CHPOINT_REMOVE_SMTH = 1415; //Remove %s %s +TX_MAPED_HISTORY_CHPOINT_UPDATE_SMTH = 1416; //Update %s %s +TX_MAPED_HISTORY_CHPOINT_MOVE_SMTH = 1417; //Move %s %s +TX_MAPED_HISTORY_CHPOINT_CHOWNER_SMTH = 1418; //Change owner: %s %s + +TX_WORD_ROAD = 1419; //road +TX_WORD_CORN_FIELD = 1420; //corn field +TX_WORD_WINE_FIELD = 1421; //wine field +TX_WORD_OVERLAY = 1422; //overlay +TX_WORD_OBJECT = 1423; //object + +TX_GAME_FOLDER_PERMISSIONS_ERROR = 1424; //You do not have enough permissions on the KaM Remake installation directory:\n'%s'\n\nTry to run it with administrative rights, reinstall the game into another directory or exclude KaM_Remake.exe from antivirus check +TX_MAPED_TERRAIN_TILES_PALETTE = 1426; //Tiles palette + +TX_MENU_OPTIONS_MAKE_SAVEPOINTS = 1429; //Make replay savepoints +TX_MENU_OPTIONS_SAVE_WARE_DISTRIBUTION = 1600; //Save ware distribution|between games + +TX_BUILD_HOUSE_POSTFIX = 313; //|Hold Shift to place several houses +TX_MENU_MAP_HUMAN_TITLE = 1356; //H + +TX_MAPED_VIEW_DEFENCES = 1435; //Show defence positions +TX_MAPED_VIEW_FLAT_TERRAIN = 1436; //Show flat terrain + +TX_GAME_CHANGE_IS_NOT_ALLOWED_MSG = 1437; //Game speed could be changed by host only if there are no active player on the map +TX_RESOURCE_EXPORT_DONE_MSG = 1438; //Resource export complete: [ %s ] + +TX_RESULTS_MISSION_TIME = 1512; //Mission time: + +TX_GAME_UI_GAME_SPEED_ACTUAL = 1513; //Current game speed +TX_GAME_UI_REPLAY_SPEED_ACTUAL = 1514; //Current replay speed +TX_GAME_UI_SPEED_RECORDED = 1515; //Recorded game speed + +TX_MENU_OPTIONS_LERP_RENDER = 1516; //HD movements +TX_GAME_SETTINGS_LERP_RENDER = 1517; //HD movements +TX_SETTINGS_LERP_RENDER_HINT = 1518; //Increase units and projectiles movement resolution + +TX_GOAL_CONDITION_DESC_PATTERN = 1519; //For player %0:s to %1:s player's %2:s %3:s must be %4:s +TX_GOAL_CONDITION_DESC_WIN_WORD = 1520; //win +TX_GOAL_CONDITION_DESC_SURVIVE_WORD = 1521; //survive +TX_GOAL_CONDITION_DESC_DESTROYED_WORD = 1522; //destroyed +TX_GOAL_CONDITION_DESC_SAVED_WORD = 1523; //saved +TX_GOAL_CONDITION_COND_DESC_BUILDINGS = 1524; //main buildings ( %s ) + +TX_MENU_OPTIONS_LERP_ANIMS = 1526; //HD animations +TX_GAME_SETTINGS_LERP_ANIMS = 1527; //HD animations +TX_SETTINGS_LERP_ANIMS_HINT = 1528; //Increase number of frames used in animations + +TX_MENU_SETTINGS_GAME = 1531; //Game Settings +TX_MENU_SETTINGS_REPLAY = 1532; //Replay Settings +TX_MENU_SETTINGS_MAPED = 1533; //Map Editor Settings + +TX_MENU_MISSION_TO_CAMPAIGN_MAP = 1535; //To Campaign Map + +TX_ERROR_ASK_TO_SEND_RNGCHECK_REPORT = 1547; //Other player got desync error. Please send us this crashreport, it will help us to fix it.%sOther player error message is:%s + +TX_EXIT_WARN_MESSAGE = 1580; //Any unsaved changes will be lost. Exit? +TX_EXIT_WARN_HEADER = 1581; //Warning + +TX_HOUSE_BARRACKS_TRAIN_DISABLED_HINT = 706; //This soldier type is not available +TX_HOUSE_SCHOOL_TRAIN_DISABLED_HINT = 707; //This unit type is not available + +TX_MAPED_FISH_COUNT = 1593; //Fish count + +TX_MAPED_MAP_SAVED = 1595; //Map saved +TX_MAPED_MAP_SAVING = 1596; //Saving map... + +//TX_ diff --git a/vendor/kam_remake/KaM_Remake.inc b/vendor/kam_remake/KaM_Remake.inc new file mode 100644 index 0000000..3142bf7 --- /dev/null +++ b/vendor/kam_remake/KaM_Remake.inc @@ -0,0 +1,87 @@ +// WDC/FPC defines used for RTL-specific cases +// If you use any Delphi compiler that is not listed here - you need to add it +{$IFDEF VER140} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 6 compiler +{$IFDEF VER150} {.$DEFINE WDC} {$ENDIF} //Define Windows Delphi 7 compiler //FPC >= 3.2.0 has defined VER150, so just disable it here +{$IFDEF VER220} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE compiler +{$IFDEF VER230} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE2 compiler +{$IFDEF VER240} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE3 compiler +{$IFDEF VER250} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE4 compiler +{$IFDEF VER260} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE5 compiler +{$IFDEF VER270} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE6 compiler +{$IFDEF VER280} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE7 compiler +{$IFDEF VER290} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE8 compiler +{$IFDEF VER300} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10 Seattle compiler +{$IFDEF VER310} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.1 Berlin compiler +{$IFDEF VER320} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.2 Tokyo compiler +{$IFDEF VER330} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.3 Rio compiler +{$IFDEF VER340} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.4 Sydney compiler +{$IFDEF VER350} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 11 Alexandria +{$IFDEF VER360} {$DEFINE WDC} {$DEFINE WDC12PLUS} {$ENDIF} //Define Windows Delphi 12 Yukon +{.$DEFINE FPC} //Define Free Pascal compiler (defined automatically by Lazarus) + + +// Lazarus compiler specific settings +{$IFDEF FPC} + // Set FPC to work in Delphi mode + {$MODE Delphi} + // Allow advanced records in Lazarus + {$modeSwitch advancedRecords} + + // Currently FPC does not define UNICODE define because in Delphi it means more than just a + // default string type but a full RTL implementation : using Windows 'W' functions instead of 'A', + // another class declarations(TStringStream for example). + {$IFDEF FPC_UNICODESTRINGS} + {$DEFINE UNICODE} + {$ENDIF} +{$ENDIF} + + +// Delphi compiler specific settings +{$IFDEF WDC} + {$IFNDEF WDC64} // Not available on Win64 + // Project can be compiled without madExcept features (if you dont have madExcept installed) + {$DEFINE USE_MAD_EXCEPT} + // Delphi compiler video play + {$DEFINE VIDEOS} + + {.$DEFINE FASTMM} + {$ENDIF} + + {$DEFINE USE_VIRTUAL_TREEVIEW} +{$ENDIF} + + +// Promote some warnings to errors for safety (for all our tools) +//---------------------------------------------------------------------------------------------------- +{$IFDEF WDC} + {$WARN HIDING_MEMBER ERROR} // W1009 Redeclaration of '%s' hides a member in the base class + {$WARN HIDDEN_VIRTUAL ERROR} // W1010 Method '%s' hides virtual method of base type '%s' + {$WARN GARBAGE ERROR} // W1011 Text after final 'END.' - ignored by compiler + {$WARN BOUNDS_ERROR ERROR} // W1012 Constant expression violates subrange bounds (Delphi) + {$WARN FOR_VARIABLE ERROR} // W1019 For loop control variable must be simple local variable (Delphi) + {$WARN CONSTRUCTING_ABSTRACT ERROR} // W1020 Constructing instance of '%s' containing abstract method '%s.%s' (Delphi) + {$WARN COMPARISON_FALSE ERROR} // W1021 Comparison always evaluates to False + {$WARN COMPARISON_TRUE ERROR} // W1022 Comparison always evaluates to True + {$WARN DUPLICATE_CTOR_DTOR ERROR} // W1029 Duplicate %s '%s' with identical parameters will be inacessible from C++ (Delphi) + {$WARN NO_RETVAL ERROR} // W1035 Return value of function '%s' might be undefined + {$WARN USE_BEFORE_DEF ERROR} // W1036 Variable '%s' might not have been initialized + {$WARN FOR_LOOP_VAR_UNDEF ERROR} // W1037 FOR-Loop variable '%s' may be undefined after loop + {$WARN UNIT_NAME_MISMATCH ERROR} // W1038 Unit identifier '%s' does not match file name (Delphi) + {$WARN DUPLICATES_IGNORED ERROR} // W1051 Duplicate symbol names in namespace. Using '%s.%s' found in %s. Ignoring duplicate in %s +{$ENDIF} + +// Allows to skip secure authentication unit (KM_NetAuthSecure) if you dont have it +{.$DEFINE DBG_SKIP_SECURE_AUTH} + +// Enable perflog (should be disabled for release / release candidate versions) +{$DEFINE DBG_PERFLOG} + +// Enable asynchronous game resource loading +{$IFNDEF NO_ASYNC_LOAD} + {$DEFINE LOAD_GAME_RES_ASYNC} +{$ENDIF} + +{$DEFINE DBG_RNG_SPY} + +// Enable some debug features +{.$DEFINE DEBUG} diff --git a/vendor/kam_remake/LICENSE.txt b/vendor/kam_remake/LICENSE.txt new file mode 100644 index 0000000..dba13ed --- /dev/null +++ b/vendor/kam_remake/LICENSE.txt @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/vendor/kam_remake/SOURCE_RECEIPT.json b/vendor/kam_remake/SOURCE_RECEIPT.json new file mode 100644 index 0000000..988a0b8 --- /dev/null +++ b/vendor/kam_remake/SOURCE_RECEIPT.json @@ -0,0 +1,8089 @@ +{ + "schema": "kam-source-receipt/1", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "repository": "reyandme/kam_remake", + "downloaded_at": "20260908T162129Z", + "source_only": true, + "submodules": [ + { + "path": "src/ext/pascalscript_submodule", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51" + } + ], + "files": [ + { + "path": "Installer/License.bel.txt", + "remote_path": "Installer/License.bel.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44a3c22ebf3f2fabaeb5f9509affbb441bce394f", + "size": 558, + "sha256": "ae271d77c4dabbafc1dd9203156b6450fd1f178d18ef1c2ce7a8e6288877f239" + }, + { + "path": "Installer/License.bul.txt", + "remote_path": "Installer/License.bul.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b5e1d67460928513665afc3db697e08bab799d6", + "size": 503, + "sha256": "3f661c838cf0b5cfe18e52d48c89afac399cde1b05997a3a7b2139c87428afa2" + }, + { + "path": "Installer/License.chn.txt", + "remote_path": "Installer/License.chn.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d36b9668f5a9df102e7aeb37e0adf4719b475fa", + "size": 268, + "sha256": "710184fb4e9c8a07b47d1ace1ada66ce1d64cf06ee0c6619d707e4769f12d8a5" + }, + { + "path": "Installer/License.cze.txt", + "remote_path": "Installer/License.cze.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ea22db8e1ac9718a2091b8f8680307ce3ffabc14", + "size": 471, + "sha256": "07ab75bd7be1c1a587829abf981a6dc7fb105f0208616ecc9ff84822543180ee" + }, + { + "path": "Installer/License.dut.txt", + "remote_path": "Installer/License.dut.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5ab58918e9bc053a74d0e5e33a0df3ee6505170", + "size": 526, + "sha256": "2023bec0883a8f919a1d385d91ff8e99d227d444aa585deaca4b918dcff56e4f" + }, + { + "path": "Installer/License.eng.txt", + "remote_path": "Installer/License.eng.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "457eb626eae64241ab39b34c150d1bd72a1d94d7", + "size": 456, + "sha256": "daeee1666b1f9c33993136ec6c351aea462c460e410a114626299c8497afc025" + }, + { + "path": "Installer/License.est.txt", + "remote_path": "Installer/License.est.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02d82e07b3b9165eac744fb4366babd9bd546deb", + "size": 476, + "sha256": "042a9974c613f07d76678d24c8dc67b6997b62944ffe34d9181b4a6a3d750b78" + }, + { + "path": "Installer/License.fin.txt", + "remote_path": "Installer/License.fin.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d24ffab458df82e0783e2b0317a1824869afe96c", + "size": 517, + "sha256": "3ea0ddd6290534731af82cd7140739e695396fd421aaaa383f05fd19fe95443d" + }, + { + "path": "Installer/License.fre.txt", + "remote_path": "Installer/License.fre.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "597c293409f5eba309364261a31ad9320f9a0a48", + "size": 581, + "sha256": "b8df6d84bf1f137c776c498c2a589e95cf5fc39c3727dfcc0d4236f7180eae41" + }, + { + "path": "Installer/License.ger.txt", + "remote_path": "Installer/License.ger.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db9e1962601a4fd29f5b672ddc9aa5e11c90c234", + "size": 532, + "sha256": "4673126fe61ffe41c4e301ec0336d31326cc83b665c4026e35acb828f269e8c2" + }, + { + "path": "Installer/License.hun.txt", + "remote_path": "Installer/License.hun.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fe13b8fb644cc70ebe8e059740b9a4d39ac9f518", + "size": 533, + "sha256": "e3dea959e9ab714662364cdec44f00fcf3968afd0d1de41f16599ea49929d4c2" + }, + { + "path": "Installer/License.ita.txt", + "remote_path": "Installer/License.ita.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9bc59bfe6b16c4ea409283a87e7b69cbc1136b5b", + "size": 548, + "sha256": "4a19692ac4070a1ff49c594956706410d5791e2e8115a6a9aafd0714761a993d" + }, + { + "path": "Installer/License.jpn.txt", + "remote_path": "Installer/License.jpn.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "81e476a652e0ee5a83e95f23dc501fe5caf09064", + "size": 429, + "sha256": "505f6ec4ceb826efe823d3dd3f98db76a5c3d3ff0890855d445538d9b8a36a2b" + }, + { + "path": "Installer/License.kor.txt", + "remote_path": "Installer/License.kor.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5042a14e7c9099e189a43fb4d46163b5b0c4acad", + "size": 443, + "sha256": "7361bae995fa33e935fad3e20c475a4e662ef1ea1956ff7278b181c838a3bc73" + }, + { + "path": "Installer/License.nor.txt", + "remote_path": "Installer/License.nor.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d789737463892cb341a1e5eeb77446e854f7f6ab", + "size": 488, + "sha256": "acaea1a261ba40424c6a6d5e18d7b405e1ee77cb7c6bad959e2a8500f3e27aa8" + }, + { + "path": "Installer/License.pol.txt", + "remote_path": "Installer/License.pol.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5a0078efdd9b8b6545a15be6953d847d74e5f001", + "size": 505, + "sha256": "ff67159febb99976e098d1ad7861aa7fcfbb8cd97df34e23be5ac118e0370b0f" + }, + { + "path": "Installer/License.ptb.txt", + "remote_path": "Installer/License.ptb.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0ab96021ef5b9b97de82ed469b60d4e126f37de0", + "size": 442, + "sha256": "f7090a45306a649bf812052238256da6dcb1014a147c5aa2495ad0a1fe24d5b1" + }, + { + "path": "Installer/License.rom.txt", + "remote_path": "Installer/License.rom.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "038f018074e983b3b0a39efc28ae0cfb55b82a87", + "size": 462, + "sha256": "48d3b2e8aa602f3914004e7b46872ec60eaaaf0568bab1df828aae4b6b205f21" + }, + { + "path": "Installer/License.rus.txt", + "remote_path": "Installer/License.rus.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a73a8be680e0e555a4e1619aeeb52c69dfb664b0", + "size": 608, + "sha256": "0e4b9ef436b766df4fbf6e91f7707790a437d08c142ec65d9949d13474461c6b" + }, + { + "path": "Installer/License.slv.txt", + "remote_path": "Installer/License.slv.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57b653fe83b34d98dae0dbe1f149754d41b39759", + "size": 495, + "sha256": "4ca20b3833ce9054a50037a18a068310f5a2c071e7f84bc3fdfc1559c91c85e0" + }, + { + "path": "Installer/License.spa.txt", + "remote_path": "Installer/License.spa.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4144100d4ecb9fdead077523f25c18ee778758f", + "size": 519, + "sha256": "8e74a96ac8b1f0edf5f59b525dfc38c3fe49cf4b7f7e24a1c1f5fd563d9acad1" + }, + { + "path": "Installer/License.srb.txt", + "remote_path": "Installer/License.srb.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d9d3fe9692300552be26cf733cc10dcd72f8ab59", + "size": 870, + "sha256": "66288fd5c65ea29fc1e05b2194b0476c00a94ba7359de37065525db2c7e555af" + }, + { + "path": "Installer/License.svk.txt", + "remote_path": "Installer/License.svk.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f3380ae63baf654180036af016f1f5acf3b4b9c", + "size": 432, + "sha256": "496670ad130b70cf430ea18d6e5404a01abb37c3d50931ba611849b14c973ace" + }, + { + "path": "Installer/License.swe.txt", + "remote_path": "Installer/License.swe.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f19212d1df157d2a0b4436a504e7216e70d7fe16", + "size": 482, + "sha256": "a625d38f6c649c77afc3149a4d552dad40c3f046ad4c6df165a22d116f80d79b" + }, + { + "path": "Installer/License.tur.txt", + "remote_path": "Installer/License.tur.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60535edb657c94365e0141f33b55b7c12d166a3a", + "size": 373, + "sha256": "cec4743807ea80c86e37eb4b028dc33e58e432c6c4ca84a87cf07235fe8da625" + }, + { + "path": "Installer/License.ukr.txt", + "remote_path": "Installer/License.ukr.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cdc42a8a12ecf4bd6c3076ad04a11e533af8d35d", + "size": 506, + "sha256": "324f951a3586fe82f6523993305e64b6d5136ac66d4fb879c97b95aa93f6806c" + }, + { + "path": "KM_NetProtocolRevision.inc", + "remote_path": "KM_NetProtocolRevision.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d4b059e8b607955db671208223321da4f68b0ae", + "size": 34, + "sha256": "1d0a478bb69bb3f9c8a80042908820136f3c10a07546a73870f32a1dd5f8544a" + }, + { + "path": "KM_Revision.inc", + "remote_path": "KM_Revision.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "454daef11e42ef83255fa3fc65a3307ecd75a277", + "size": 25, + "sha256": "e797bcda891c62f8875b4b7e63fbc85d5287a2d2819b9ce772b6779d05051400" + }, + { + "path": "KM_TextIDs.inc", + "remote_path": "KM_TextIDs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d300775764dec61fef8c0502cf28bc200cc3d9b5", + "size": 90061, + "sha256": "0dc7eaa2f724c642bdf9ebd738146322c3d711f6c46654ae47d1882c00ce602b" + }, + { + "path": "KaM_Remake.inc", + "remote_path": "KaM_Remake.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3142bf7f466a37466b99fe8a933d171373d27a54", + "size": 4512, + "sha256": "45a8fbf3af6f38515318e52c1c149f341068e038e21270ebcd3b2f89bc4cb7f6" + }, + { + "path": "LICENSE.txt", + "remote_path": "LICENSE.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dba13ed2ddf783ee8118c6a581dbf75305f816a3", + "size": 34520, + "sha256": "57c8ff33c9c0cfc3ef00e650a1cc910d7ee479a8bc509f6c9209a7c2a11399d6" + }, + { + "path": "Utils/RVO2/LICENSE.txt", + "remote_path": "Utils/RVO2/LICENSE.txt", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "77f83a2d93eefc476bd733605f28f3f81becea78", + "size": 2025, + "sha256": "cd6848a33104313fd9dfcdcea88b53bb15bd5a9bd25a782cffd100b0c211f4d1" + }, + { + "path": "src/KM_Console.pas", + "remote_path": "src/KM_Console.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "269c82c88200f988d85c0ebd14a47c02ff3f1f93", + "size": 7942, + "sha256": "ec2725ac36fe894e7855168747df4790828b25af9d7d5a34bfe68b5a7dd9aa6c" + }, + { + "path": "src/KM_Crashreport.pas", + "remote_path": "src/KM_Crashreport.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dda51aa72c5dbf83ba71c21714f7c13264fc38fb", + "size": 6011, + "sha256": "462bb3058ebaaf2b18fd6642586e93c7c2513314ab6352c43409f3b87308299c" + }, + { + "path": "src/KM_Exceptions.pas", + "remote_path": "src/KM_Exceptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b947c9910cd87e87c1ce39def6acc80bf4a0675", + "size": 8030, + "sha256": "a3cea70a34454661ecff7f101626f89d2b71825a25009bd47bd14b1610204220" + }, + { + "path": "src/KM_GameApp.pas", + "remote_path": "src/KM_GameApp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92825162a850428e4756d6bf278ea60e7eef80ab", + "size": 50418, + "sha256": "94c683fa9f2145fd9dcc580b83b2c80217a8e4e236043d4f4539964b48d8f58c" + }, + { + "path": "src/KM_Log.pas", + "remote_path": "src/KM_Log.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04fac6f2955c2a2792c6ce9c1073f3beec7878d3", + "size": 15469, + "sha256": "0dd5f9e66d452c415cf59a81aaa0508efa371bd19ae50c0c90aeca2b16cc0a96" + }, + { + "path": "src/KM_Main.pas", + "remote_path": "src/KM_Main.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e3acf7191293f5b27db863f9300984608adafd18", + "size": 29884, + "sha256": "1ec45fea42418453cd6f18ebe3dc499c39f3dfc4944ff6b34679167e4a2ba97c" + }, + { + "path": "src/KM_Projectiles.pas", + "remote_path": "src/KM_Projectiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1d20f5c888bc522abd5e69fbe28ec9f62967510f", + "size": 20327, + "sha256": "7851dcf76ae7571334c2674c230a4a2c48f962dd379c3b15dbbadcc9e2cd449e" + }, + { + "path": "src/KM_System.pas", + "remote_path": "src/KM_System.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "253cad07f032b5cc87a73dd2a56cc2023a9ed971", + "size": 6839, + "sha256": "1022cdf06a99b786043c5be41b2543115c95eae3ceccd529bcb0e960e5032f23" + }, + { + "path": "src/ai/KM_AI.pas", + "remote_path": "src/ai/KM_AI.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1f3370fabc619bd4e338e356947d687f593f5aa2", + "size": 22590, + "sha256": "8d58808f0b9d6e3110ad4a6688b04f94d56dacf9ff210a36b1665a47ee52c17a" + }, + { + "path": "src/ai/KM_AIArmyEvaluation.pas", + "remote_path": "src/ai/KM_AIArmyEvaluation.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c7318ba81855dfe63e40a9584a2e04fdb8ebaec", + "size": 11385, + "sha256": "1cf68f6cfa91e5653a3a952c9f0bac0539e25860a0031a75543e73020a9cd24a" + }, + { + "path": "src/ai/KM_AIAttacks.pas", + "remote_path": "src/ai/KM_AIAttacks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "00e558b214577afef77559980685c4fb08412822", + "size": 7197, + "sha256": "9f449dd9e93b336af8369a3c55bec12f34e591a2a0916028c76dda467ed67706" + }, + { + "path": "src/ai/KM_AICityPlanner.pas", + "remote_path": "src/ai/KM_AICityPlanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2d4adf4a2f33d8d6ea8e46ef77a27c90a978ffe7", + "size": 20673, + "sha256": "7215b38858493b7d2effd9f89cab27c680f135d9c79af9650097ab2005ce144d" + }, + { + "path": "src/ai/KM_AIDefensePos.pas", + "remote_path": "src/ai/KM_AIDefensePos.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "680457557bdf6470eead77a2ca0771af180e645b", + "size": 16062, + "sha256": "736853fc643b2c5d0351430780d4e939f2414911220551a4055175f7e5d6c0a9" + }, + { + "path": "src/ai/KM_AIFields.pas", + "remote_path": "src/ai/KM_AIFields.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd952507aebe9711ca9298695ddeca9d7e23953a", + "size": 3392, + "sha256": "ebc541a50513e69b21abac613b07b848261130e69cb55e883e8dcb5789b4d6e5" + }, + { + "path": "src/ai/KM_AIGeneral.pas", + "remote_path": "src/ai/KM_AIGeneral.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd1e2a37499b16d4686f74417bea6a26553b4db6", + "size": 28183, + "sha256": "62e4b43d156f205f73de48590cc96b0d831a57ce9b6a0fdd35bb8d203d8accc5" + }, + { + "path": "src/ai/KM_AIGoals.pas", + "remote_path": "src/ai/KM_AIGoals.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c098492d212bf2c1d3e4f6f1efe69cfd34ef314b", + "size": 7296, + "sha256": "df64bb01294f0a91f00ee24bf42c5879296a768dd897db8e73a019002c542fcb" + }, + { + "path": "src/ai/KM_AIInfluences.pas", + "remote_path": "src/ai/KM_AIInfluences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85f3f7dd66aa475641b306d59bba98c3b2ede35f", + "size": 28511, + "sha256": "91d1062df9198dc2ff83aaae89321ae66afb923bbee445f62b22373c607e5a56" + }, + { + "path": "src/ai/KM_AIMayor.pas", + "remote_path": "src/ai/KM_AIMayor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "215ab7931416885073e81b8b0b306a11f7d57d01", + "size": 37545, + "sha256": "3e119af47d0cd05f70e67846cdc648865f618e56c66f84c7dd63079d65a9fd22" + }, + { + "path": "src/ai/KM_AIMayorBalance.pas", + "remote_path": "src/ai/KM_AIMayorBalance.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6f32dbc060a4dee42ee2c004adae0745b40643b2", + "size": 38721, + "sha256": "46bc59345f89bb86e15a91f6ab43b4f01aa72ebe26524c02926e331ab51d1448" + }, + { + "path": "src/ai/KM_AISetup.pas", + "remote_path": "src/ai/KM_AISetup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f8798fd723b3c22c661c286347a57483a76aff6e", + "size": 6762, + "sha256": "5c24a388760a039d3964f8396d5798200c52a9e30f7863cab3c1768cea2d6c0d" + }, + { + "path": "src/ai/KM_AITypes.pas", + "remote_path": "src/ai/KM_AITypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3eb9f6e5c015d81dae484b3e1058316b132af194", + "size": 1641, + "sha256": "f80ad7fd48fed61572bb300deea7a7d08d9b7726871164d8a65cc7532b29f672" + }, + { + "path": "src/ai/newAI/KM_AIParameters.pas", + "remote_path": "src/ai/newAI/KM_AIParameters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3fde31e4b8229927e60f17c096acd284bd96dd3", + "size": 31297, + "sha256": "8b7d07fdf51944a538266fd8bbafdf3b89250f0944de97595adca272b07f070e" + }, + { + "path": "src/ai/newAI/KM_ArmyAttack.pas", + "remote_path": "src/ai/newAI/KM_ArmyAttack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "25468ba7eb96b23aa06aa25692d89f290cdd83cc", + "size": 59834, + "sha256": "568dc0393caab3b8ba0233ce62ff5f639f36947107d6504f43a85685d027d78a" + }, + { + "path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "remote_path": "src/ai/newAI/KM_ArmyAttackNew.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9134831774789bf0e0feb26a4480f57d1719c9ac", + "size": 30342, + "sha256": "ac1cf8d983a8f920272f0e82ff22f8cc85057dce955721a4ae79e1f0c0fd8bde" + }, + { + "path": "src/ai/newAI/KM_ArmyDefence.pas", + "remote_path": "src/ai/newAI/KM_ArmyDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4c75b1e1056cd7c8fa198649ea35b479e845832", + "size": 16370, + "sha256": "874336297ce5babbf362d67c60089a1cf6e197ad0b90782288fa7f85b49e2e19" + }, + { + "path": "src/ai/newAI/KM_ArmyManagement.pas", + "remote_path": "src/ai/newAI/KM_ArmyManagement.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "56e55bb659c70386d16ad87bdcc7bf944ac2d5c7", + "size": 18822, + "sha256": "3f93d3a749d40b4fc2ecf21ee31dad5203244bc08c5d8c4cab8183b03d43c213" + }, + { + "path": "src/ai/newAI/KM_CityBuilder.pas", + "remote_path": "src/ai/newAI/KM_CityBuilder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d1b737802463ed3aea7cc92527951a1a845c50f4", + "size": 89133, + "sha256": "646f2cbbb75f529637879755e02b8ef17c0901cf8de2684a98df90d58c09ad54" + }, + { + "path": "src/ai/newAI/KM_CityManagement.pas", + "remote_path": "src/ai/newAI/KM_CityManagement.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "867c1ea3c0b373cc312886076ed7f58ec2a8c25b", + "size": 41466, + "sha256": "fd07b221e052f7ba48644628bfc8ca47658802b7461287ea0bf7d22fabc9814c" + }, + { + "path": "src/ai/newAI/KM_CityPlanner.pas", + "remote_path": "src/ai/newAI/KM_CityPlanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "edc1387cd4199dca8350e35a4a22675c0a01e3f1", + "size": 134397, + "sha256": "b2e207d0697192bbcd3a0ffdbc5dfffcd30521f7e403616ef15fa471c0aa123b" + }, + { + "path": "src/ai/newAI/KM_CityPredictor.pas", + "remote_path": "src/ai/newAI/KM_CityPredictor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8dd77f7010328346323d6aee8583207fdb3f751c", + "size": 40996, + "sha256": "c5adfc3c7f9364fee6457cab8b427fec0e2963a3af17dd773a23f0c3dd39114b" + }, + { + "path": "src/ai/newAI/KM_Eye.pas", + "remote_path": "src/ai/newAI/KM_Eye.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d281748a2a34e05197b41788e41c31f42326792", + "size": 62912, + "sha256": "f3ed155b642866e6331f6d33373762a58785d1f02d4a97fea6f676534b6c8bed" + }, + { + "path": "src/ai/newAI/KM_Supervisor.pas", + "remote_path": "src/ai/newAI/KM_Supervisor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0289664258caf3333753a26e955b5ed6709a0f5c", + "size": 55276, + "sha256": "faa9200436dd25fca95b5989154da0e4412f2c7ad013d6a919bc980ada1bd7b5" + }, + { + "path": "src/common/KM_CommonClasses.pas", + "remote_path": "src/common/KM_CommonClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e967a306be87647d5e010d204d4f564cd272359a", + "size": 54489, + "sha256": "4889af4aedf2174509fd1d0c0a6f6a2b7b64dd680a7266b8483db74b492f95a1" + }, + { + "path": "src/common/KM_CommonClassesExt.pas", + "remote_path": "src/common/KM_CommonClassesExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6880d9dafecb675ee6164505825b301fc1ca596d", + "size": 10750, + "sha256": "a96e123fafb3d90a1715ddf4c249d3feec91e8df3971e5d8612846ea9fba39a1" + }, + { + "path": "src/common/KM_CommonExceptions.pas", + "remote_path": "src/common/KM_CommonExceptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2474182adba01fb8018636259d1d461f4024f35f", + "size": 588, + "sha256": "7198f3aa91b83bc925c401e24ee569db1d525c98650e3e7779f074871d5ea44a" + }, + { + "path": "src/common/KM_CommonGameTypes.pas", + "remote_path": "src/common/KM_CommonGameTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e95215e9287fe608ff504f9aeb6e05e72bb76c9f", + "size": 171, + "sha256": "7021fe5a4ed528a523b2a14894322967f8137543226646cbe627e17b5c036dad" + }, + { + "path": "src/common/KM_CommonTypes.pas", + "remote_path": "src/common/KM_CommonTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "38b92c292502c64fd03abff9a16d38f7dbb73091", + "size": 9433, + "sha256": "dc0c838a0e440cb80ef89ab173402476ef10b1cd5dcb2b08ebba462e5b6ce0dc" + }, + { + "path": "src/common/KM_Defaults.pas", + "remote_path": "src/common/KM_Defaults.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5f48d4de474a655cc64bc3d3cb2b1bcb529d6bd2", + "size": 50409, + "sha256": "4731fcfe204ed19c98ed2dd3e2fe479f15fc089ae3654ee43c471c7f789fed10" + }, + { + "path": "src/common/KM_Entity.pas", + "remote_path": "src/common/KM_Entity.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9099191c3a99c9d0a205dc3fea31beeb215ef89", + "size": 1761, + "sha256": "627e02748bdc9f2e365b1e034e558fe9e55acd52982a514052f6e43c664eec37" + }, + { + "path": "src/common/KM_Lists.pas", + "remote_path": "src/common/KM_Lists.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ea98101f4c5c5ab186ab6080c95f1558f753827f", + "size": 3989, + "sha256": "05b1535a3b7b840cd1976b7c68d0fab56668282db117cf7aa3f48229b847f4fa" + }, + { + "path": "src/common/KM_Points.pas", + "remote_path": "src/common/KM_Points.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87cdb0642a21d023f48616edab3128796af1ce3c", + "size": 35587, + "sha256": "b3ac9d1c48aedc723a56c952f771802115cca0025ef050383d5dadcbb8e26132" + }, + { + "path": "src/common/KM_WorkerThread.pas", + "remote_path": "src/common/KM_WorkerThread.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4058ba7421c097406572cd4d34982be13975910", + "size": 7145, + "sha256": "fbabc6c0a533085603b5e0588cb80ff3c0dd4a89c69cb1c072f8f449de8696c4" + }, + { + "path": "src/common/KM_WorkerThreadUtils.pas", + "remote_path": "src/common/KM_WorkerThreadUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ced4191abe5b413d59eb9be2968cd9e71fcc3ee4", + "size": 3408, + "sha256": "2471748f44531d1a1a21e4888b4641098b0c070b5ac21d6bd4e6609f463ec4e8" + }, + { + "path": "src/controls/KM_Controls.pas", + "remote_path": "src/controls/KM_Controls.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "09a23b5a63a49b58be8f3f70c5fd817a968b437b", + "size": 61807, + "sha256": "1b28806141e07039b1fb18d3d25cd432d101ab880f5e50c4a82d5bc9c79ddaf3" + }, + { + "path": "src/controls/KM_ControlsBase.pas", + "remote_path": "src/controls/KM_ControlsBase.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8241482ac9cfea60306b638676571abc0567b0b6", + "size": 23671, + "sha256": "befbe571b4fb93ebed9503ebf05604ff7fdb529bbaeba846efd146c07088eed4" + }, + { + "path": "src/controls/KM_ControlsChart.pas", + "remote_path": "src/controls/KM_ControlsChart.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b7df1cb4a85c2876d5663c69cc403f6480c54914", + "size": 16288, + "sha256": "45eef7023b4a58f66c2a2bef6bcffb49e97a16ef6400712e52bd1b815ebe4b08" + }, + { + "path": "src/controls/KM_ControlsColor.pas", + "remote_path": "src/controls/KM_ControlsColor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "558278d51746726660d2d304de9d10b976044b66", + "size": 4187, + "sha256": "6d6ced6d7d512090b2de07398c75a64ed26085a775edae4bb46be3725271a6ec" + }, + { + "path": "src/controls/KM_ControlsDragger.pas", + "remote_path": "src/controls/KM_ControlsDragger.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3f1ebfadef48c4b1fa2456dbf2e3f7020f730458", + "size": 2495, + "sha256": "f33ce9ba9827d75bc58247acf0a4150155d47f1ed757a00081e2b23a2da87c1a" + }, + { + "path": "src/controls/KM_ControlsDrop.pas", + "remote_path": "src/controls/KM_ControlsDrop.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d99d78bfa344462df6add473712f5cb64c0bbada", + "size": 19698, + "sha256": "044dbb810a75fdb047a91b41dc9179f8245a0e4ed21236677ee5dea243c673b7" + }, + { + "path": "src/controls/KM_ControlsEdit.pas", + "remote_path": "src/controls/KM_ControlsEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "760c0ec8fc96b24788d26d084f52d21de9bc453e", + "size": 30711, + "sha256": "0942a45abd2f4c8cdbe0225838424e5eb409fee2517aa221c8a0e0be90fd5079" + }, + { + "path": "src/controls/KM_ControlsForm.pas", + "remote_path": "src/controls/KM_ControlsForm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "088be5588cc4a948023fa7c03f5d7b601a562f02", + "size": 9331, + "sha256": "98f52c23f4718e36da00222acb62d53c158961f5698668b43d0afd1a3fdedb7b" + }, + { + "path": "src/controls/KM_ControlsList.pas", + "remote_path": "src/controls/KM_ControlsList.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b99e059ec62a95dcd1c8d064171c0982be6e9189", + "size": 61949, + "sha256": "7f8b22a3044272f822bcc7d038d2debb55d2a6695c51753fa6bddb35666d3598" + }, + { + "path": "src/controls/KM_ControlsMemo.pas", + "remote_path": "src/controls/KM_ControlsMemo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "79a8d78861522ea732553dd5131bacda660d5b47", + "size": 22635, + "sha256": "e23963c974847435ba3fb2f13dba527a92a746c75873ed4e7ab8bd39ac07e146" + }, + { + "path": "src/controls/KM_ControlsMinimapView.pas", + "remote_path": "src/controls/KM_ControlsMinimapView.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e0aeff4ebd143b51e9695d134a50a1a59064a6e", + "size": 10855, + "sha256": "dac705b593e547df6ea73d15bb348e89ff2e50574a553405c787a684a49bc979" + }, + { + "path": "src/controls/KM_ControlsPopUp.pas", + "remote_path": "src/controls/KM_ControlsPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6e50f766b27dc98e31c033abcaa57455e1c218b", + "size": 4355, + "sha256": "534507699f46b5a062ab440fdbdefde2f966d23b06c9a5a570bc5fe958c66fc5" + }, + { + "path": "src/controls/KM_ControlsProgressBar.pas", + "remote_path": "src/controls/KM_ControlsProgressBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "55ff2bb6c4d409176aac24b3a5f29230403a248e", + "size": 9320, + "sha256": "769335ff01446bce98fb4a19dce65bb2eb62fd941f8c659cf3e276893e4a5309" + }, + { + "path": "src/controls/KM_ControlsScroll.pas", + "remote_path": "src/controls/KM_ControlsScroll.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "091c5376f6dcc738285a508ed5b2c76836f21a1b", + "size": 21691, + "sha256": "aca2e9dc6da62703571ca7251a2eeab30d29279de0c273e5fbc57992757d9635" + }, + { + "path": "src/controls/KM_ControlsSwitch.pas", + "remote_path": "src/controls/KM_ControlsSwitch.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "778e7519100c57e3a146fe8f552eb1107b788714", + "size": 12115, + "sha256": "a363807128a8bd01e9cae584390281ecf29c6e93592fec7a95fe598d413ec6ea" + }, + { + "path": "src/controls/KM_ControlsTrackBar.pas", + "remote_path": "src/controls/KM_ControlsTrackBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e5a741b931de17c1b0d74237b6a3d27d371f177", + "size": 7338, + "sha256": "2183cc3a50e5a13670f9d54f3376858972d90bc194b59d270f0ddb023a71e8c1" + }, + { + "path": "src/controls/KM_ControlsTypes.pas", + "remote_path": "src/controls/KM_ControlsTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "285f9f36aa9f6fb7dbdf597e37bd4cc8f9bf6b58", + "size": 550, + "sha256": "271f13fa7867ea1b39c2d121c5fcec799ac7e137ff15768b9e9726e0150ff3b3" + }, + { + "path": "src/controls/KM_ControlsUtils.pas", + "remote_path": "src/controls/KM_ControlsUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a60b553e154f1e6364583964892e14cd007c9e3", + "size": 2040, + "sha256": "099b1bb73a96c87eeb775fa8f7677ccdc1a12b788fcf8aab677fff702b9eddda" + }, + { + "path": "src/controls/KM_ControlsWaresRow.pas", + "remote_path": "src/controls/KM_ControlsWaresRow.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19878f7bc1b04dad27d68b8c012579b7682fbe98", + "size": 8053, + "sha256": "435a8b7ae9a74b5339590bc0addf806231e58c886b3ebfb947c343842a15664a" + }, + { + "path": "src/ext/BGRABitmap/basiccolorspace.inc", + "remote_path": "src/ext/BGRABitmap/basiccolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e9ce01675103b1c61b7d6633be131d9ec0b56f2", + "size": 46319, + "sha256": "4c65d3525e81a6efdc7ebc6bcf37de9af33725de7ca0f01df72a574a3abb39cb" + }, + { + "path": "src/ext/BGRABitmap/bezier.inc", + "remote_path": "src/ext/BGRABitmap/bezier.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c4a0e1c9e49f9f631d6c594bceec0192e7a10c43", + "size": 44009, + "sha256": "b602df17c94f327cdacbe4e9f62737f7d95f91f54db88d29388f5760d4b382cd" + }, + { + "path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "remote_path": "src/ext/BGRABitmap/bgraanimatedgif.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "16c17a49347780668408c206dbe71ad15fccc273", + "size": 36280, + "sha256": "d778e2b034c3ec3e1e954cd9549e61b754a73f3f284bec84928d67c1018c3471" + }, + { + "path": "src/ext/BGRABitmap/bgraarrow.pas", + "remote_path": "src/ext/BGRABitmap/bgraarrow.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4173e37a6b37ee331b328ec9622cd5aa61e71373", + "size": 16298, + "sha256": "4c8ec6ccff690e139117a22ad754f09d80902326a21187a24a60f26fb69a2ef9" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.inc", + "remote_path": "src/ext/BGRABitmap/bgrabitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "955d85ab29673e7deb7f4c9f1f628b95e6fa6883", + "size": 1144, + "sha256": "f9bf0fbf76db6a995900b9112056efb93a4b6c563326814cc7c0da0662b67931" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "39293609a641c445d8031d35cac1a4612f6dbeaa", + "size": 17464, + "sha256": "491b7b30a8e8cc4b8a5d57511561b6b421434a7c4b59a9ccc6427e4e98cd2f6f" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8c46a1fec29b936816de95ec72eb019cba38d0f9", + "size": 1804, + "sha256": "07e51934404f81ca20a5349b074f0613bec879b78a56e62e99e35357b4419911" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack4fpgui.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "596f3782f03a1bc26b10bf0df4ca4721a3733473", + "size": 1358, + "sha256": "fb1a8e0a8adfd3f0238c6122c3fbeaa76d2ab1169bc46f7ff489496230d28ba7" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmappack4nogui.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmappack4nogui.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f2d0ccea6a6b64a7a1511de9a8b006283a2b381", + "size": 1417, + "sha256": "1883384b69bb49264585972eccdfaba0f79fa36e7f1a8a80836d043a39df4c5e" + }, + { + "path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "remote_path": "src/ext/BGRABitmap/bgrabitmaptypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4a416bc04d8d771727a8f4614e1437cd67019a12", + "size": 53776, + "sha256": "0f892b3508285c1929a6607abc03e479bf8e8b56eda3090f5f95c3f3a1d16a0b" + }, + { + "path": "src/ext/BGRABitmap/bgrablend.pas", + "remote_path": "src/ext/BGRABitmap/bgrablend.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4cb0e2917a41c3edde47d16f78e28c0bf98ffeb5", + "size": 62361, + "sha256": "08a1fcb093154ed5478788adb94febc969f201de0acd9178a69fd43c37c1c076" + }, + { + "path": "src/ext/BGRABitmap/bgrablurgl.pas", + "remote_path": "src/ext/BGRABitmap/bgrablurgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa3357b56bbbc6d96d294a20ee3ec9098a7d60db", + "size": 5469, + "sha256": "d0bd6e8beef1be7159cbc30ae63b57b6e05a89dc1052c52a05fd1ce0e4678b28" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvas.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44dbc28e40423cf20362a39aa5432ce26579af76", + "size": 55095, + "sha256": "bb1a90a3e8105054df0655f2e126746ef725667a4fbd51ca15c60ed2178d1d05" + }, + { + "path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvas2d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2e0bad66dbf6437683e4b1488721c29ecf8506dd", + "size": 89527, + "sha256": "c19f40a2b6e350bb95dcaad238580576441d6ce0ceb7f579b79723928c58ee9f" + }, + { + "path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "remote_path": "src/ext/BGRABitmap/bgracanvasgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6ecd285237bdfad789c226192576b258c80b3d7", + "size": 66726, + "sha256": "f355f3297becbbb4707d17391fcbd4bffe65f07c5786d6a1312ab78d6093c101" + }, + { + "path": "src/ext/BGRABitmap/bgraclasses.pas", + "remote_path": "src/ext/BGRABitmap/bgraclasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ba3343e2a6d468afcf8708956e1c07314799464", + "size": 6186, + "sha256": "20887df29bd48d7568d632529f3995c9705430a4d531c908accca0410018a103" + }, + { + "path": "src/ext/BGRABitmap/bgracolorint.pas", + "remote_path": "src/ext/BGRABitmap/bgracolorint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6551c686311897552f5550ab09b53e75f1c2cc66", + "size": 9077, + "sha256": "0fb44ecd453637fa299699fdb0718a10c98c97c24a284b7f99272c2d949ba47a" + }, + { + "path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "remote_path": "src/ext/BGRABitmap/bgracolorquantization.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e130e0e3935dcffa7541954a9d06cfce9df99ad", + "size": 64797, + "sha256": "974a090a4d585f465ae06bfe81a0224218e776995c4d5373d30f3e96135390a0" + }, + { + "path": "src/ext/BGRABitmap/bgracompressablebitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgracompressablebitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "65a54137ddc62c36c89bf7016e9b4837057e87ea", + "size": 9724, + "sha256": "fc0c02744a09517a85fa301cedc0667cb70a977550ec8160a349081169875692" + }, + { + "path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "remote_path": "src/ext/BGRABitmap/bgracoordpool3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef79c7de50641fa310bcff012060b9227d60897b", + "size": 11344, + "sha256": "8d69fe69aab7838233d386e66cf91c45c64ef2027e8788b4f87214ed4271f398" + }, + { + "path": "src/ext/BGRABitmap/bgracustombitmap.inc", + "remote_path": "src/ext/BGRABitmap/bgracustombitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ee8550235e4a7d91619dc82a1ca960b7bc6263e", + "size": 95565, + "sha256": "e2d7db550d3ce662d637406616aab3d3e483845d288237c64b04c94854e3efd6" + }, + { + "path": "src/ext/BGRABitmap/bgracustomtextfx.pas", + "remote_path": "src/ext/BGRABitmap/bgracustomtextfx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6c4c0885395027e6c5b0280fee0a95b5c13ce3e", + "size": 20205, + "sha256": "039971ed9b16f5afb7b79399b520b92332357b1d024627e3a949b6c55911fa07" + }, + { + "path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgradefaultbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d015a412d13df0df08e6ffedbd697d3e7e6bbd8", + "size": 166581, + "sha256": "37310135e9e19361159762883cd5aa7e004a1d424ce8e932dd60d165441d63bf" + }, + { + "path": "src/ext/BGRABitmap/bgradithering.pas", + "remote_path": "src/ext/BGRABitmap/bgradithering.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "91b532f6d5020703d09495358b9c0fef6f5b3138", + "size": 26509, + "sha256": "d5e4b678cff117851dbf39853201b8c527a8950c802da058f01921a5bf0a1e76" + }, + { + "path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "remote_path": "src/ext/BGRABitmap/bgradnetdeserial.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afd79c72d55221202aed332ec35457d8f1a9950e", + "size": 45114, + "sha256": "15a6ef3483d5f16bf136027ec2749582465fc9fc2f0d23db87e00c2628ca6996" + }, + { + "path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "remote_path": "src/ext/BGRABitmap/bgrafillinfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f45d32cb37b7194f7de5f4f2b9b147c08e8e6ea", + "size": 47031, + "sha256": "ce25fa5a46f58d74a799cf68127bebc8457475610d5b5b6809a74ceb24bac77d" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilterblur.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ecd712b1295c27191ff79d6feda6b7372cd1038f", + "size": 38171, + "sha256": "0c4984623455519c57ce61c0085e6fd4739e23b0d403a57e555f6ab62bd1654c" + }, + { + "path": "src/ext/BGRABitmap/bgrafilters.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5531fec0dadf0a9979d8b0e4168153b1c7241ef", + "size": 34024, + "sha256": "c7e13481eb76c453d986b3a2df887de87b5866af13bd2d5c9f900986eb5f7c7e" + }, + { + "path": "src/ext/BGRABitmap/bgrafilterscanner.pas", + "remote_path": "src/ext/BGRABitmap/bgrafilterscanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62d251ed75aa4405a9d68f44ef52e5093b821e95", + "size": 25719, + "sha256": "ba73a33d42b5e43a559cbf8c8ae38b14dbd7b52e7c05c14a729b0d416aa151ad" + }, + { + "path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "remote_path": "src/ext/BGRABitmap/bgrafiltertype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9eed018968e96a7d5d3404cb732f1630c7d143b5", + "size": 14187, + "sha256": "7fee88debc74b6e740c34af81ba7d6d6d4c0a39fccae0db85ae36b9d3b1d2d2c" + }, + { + "path": "src/ext/BGRABitmap/bgrafontgl.pas", + "remote_path": "src/ext/BGRABitmap/bgrafontgl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e21f0f9a0389c3793e6dbc84f37d5d4dd3c5aa4", + "size": 19891, + "sha256": "77f0b6c4cb4560ce10eaac9cc3cbc71041dc2843601ccba9a0856f568a7fca94" + }, + { + "path": "src/ext/BGRABitmap/bgrafpcanvas.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpcanvas.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c6e5edfc7979855908a7bd8fd6744cdeb0b8b719", + "size": 7755, + "sha256": "b771650a941f4c4cdd6f6134239308a0131dd4edccba80eee2b4c4f22c328466" + }, + { + "path": "src/ext/BGRABitmap/bgrafpgui.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpgui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d6ec56018d7cf4d0c5caed4cc707cf83178fa5e5", + "size": 1804, + "sha256": "6ceb78469b3e27d5ab9c411f829b501540fa45bc7ab38be2363f12d4908ed97c" + }, + { + "path": "src/ext/BGRABitmap/bgrafpgui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgrafpgui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "54b33a7582f5b7b1ac3c031d389b3411dad64b9a", + "size": 57, + "sha256": "5f0e507357811ed96939d4f964dca84798da54b32c38c6c8ec95b3a4ccbf7248" + }, + { + "path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrafpguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c6f0c9022f4796447b69e5244e6eee181b9d57fc", + "size": 7782, + "sha256": "6c8a1da352186a2c62f641fa233331ce3d102943040d343cd83b7577629488bb" + }, + { + "path": "src/ext/BGRABitmap/bgrafreetype.pas", + "remote_path": "src/ext/BGRABitmap/bgrafreetype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c95ecc7a41815ad34949dbb9272de84573f44907", + "size": 51833, + "sha256": "c26e390761181051a4bef03842b2b9c84deb6fab5460bd46eff39439c8b28f6a" + }, + { + "path": "src/ext/BGRABitmap/bgragifformat.pas", + "remote_path": "src/ext/BGRABitmap/bgragifformat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd32eed73e5840543ef854c670650d137773024e", + "size": 34813, + "sha256": "7f78c2aa2e61a69c570ad69e6bd4d8bbf85fd95e469cc46f7604c95cfdba2a23" + }, + { + "path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgragradientoriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "246b8bb3f3e4e68ff43f1c236e0c030c792fb9d6", + "size": 30269, + "sha256": "b77183c70b20f8abfa1af8b5957f17fc8c98cd6e56b9835f330f896bb1193157" + }, + { + "path": "src/ext/BGRABitmap/bgragradients.pas", + "remote_path": "src/ext/BGRABitmap/bgragradients.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6d5fb7ebe6e1cdcf2275cf83f3c9a78e47b1a78", + "size": 44894, + "sha256": "5b89650b3b39ae371e7f212a912692716d0f4cd3c7c9ebd0f548ff39538de696" + }, + { + "path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "remote_path": "src/ext/BGRABitmap/bgragradientscanner.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "31bbdd469f5e661532a2f5726fe3b701b3d852a3", + "size": 69462, + "sha256": "60e0d6c7f9a512173caec70007fdeba4632fb0fe9c9e5c8f7abf958a073c2fd6" + }, + { + "path": "src/ext/BGRABitmap/bgragraphics.pas", + "remote_path": "src/ext/BGRABitmap/bgragraphics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8628bf0b1b811900c4d632fca7575ed2cbdea2f6", + "size": 19435, + "sha256": "92093cbf599916e98d7eb05909a42265f3067c7cf557cb45c6bf0ede96194a75" + }, + { + "path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "remote_path": "src/ext/BGRABitmap/bgragrayscalemask.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "15ce7568431800ed5b48767490a72ed4e81c1392", + "size": 45320, + "sha256": "ac4706df660a091787d82e5fd2ab11e199c8f98ec792841625ef9609d2899ef6" + }, + { + "path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgragtkbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8f8750d90c27604df7169edc7f2607ce6e78177", + "size": 9648, + "sha256": "cc1ee87c685a06c6e277b80f7ee7f6715d453ce1be9b291e65dabfecc0c969bb" + }, + { + "path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "remote_path": "src/ext/BGRABitmap/bgraiconcursor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1976a859e9363a8cd8c92e12a6568de7788654e3", + "size": 26102, + "sha256": "0598a1c833d60ed07c69eba58bbf6300ded2a1497d9f59d9925929807ded5e6c" + }, + { + "path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgralayeroriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7402128fdc08af3b66fdba597ca3c4df3693144e", + "size": 72915, + "sha256": "fa8a4f82e9d2744e27dccecf387327549412fdb528bdba6b9d99eb82e81ce6f7" + }, + { + "path": "src/ext/BGRABitmap/bgralayers.pas", + "remote_path": "src/ext/BGRABitmap/bgralayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "51a2def6bff12f8b5ce1af4e7a1bcccde0e57cd4", + "size": 123396, + "sha256": "ff3c7f640cefba6b06f26543a41ecbd6439be1b5d165f7d3ad4340245b47368f" + }, + { + "path": "src/ext/BGRABitmap/bgralazpaint.pas", + "remote_path": "src/ext/BGRABitmap/bgralazpaint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac99c45b4ef5c66ee142c15c78a3a9ff4fa900bf", + "size": 7070, + "sha256": "b6cefad40a695141f41a9b9a023baa216db88d2b03f973f955720966f7f8fbd0" + }, + { + "path": "src/ext/BGRABitmap/bgralazresource.pas", + "remote_path": "src/ext/BGRABitmap/bgralazresource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c552b33c4bd6e9edb759e0cf0b02589a8de5f8b2", + "size": 10981, + "sha256": "2025ef390723fee59f4c098a66e270dd8b907eb18d551fcb46c49c1f4196a184" + }, + { + "path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgralclbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f8b9094400082e1a7f323036a321cfb53a92b5c", + "size": 33969, + "sha256": "0f15d3d9f5b1d2a5c0cfb9ec9e7e90db56f10b50017a39a7400cdb988b04b701" + }, + { + "path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "remote_path": "src/ext/BGRABitmap/bgralzpcommon.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4d991de15a55de02d61e49614a97f7e339393486", + "size": 19376, + "sha256": "8f7f2033706b524fc1adcca5d533afcedd2d17306c81742d0e925c81c2b32628" + }, + { + "path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgramacbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0a90f398c8724721eed6eff81c455a5e15ceebe", + "size": 2102, + "sha256": "7207c8feb702bf8fc8fb7302897bd6305da199a08272c67688c6b2760c2579eb" + }, + { + "path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "remote_path": "src/ext/BGRABitmap/bgramatrix3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f0ddc70b3bd7270b86dea660576138ba9f914937", + "size": 19621, + "sha256": "4bc5fe62d60c4b83d0cb47fa777319a095a816227e5ea9bca870b720a826a461" + }, + { + "path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "remote_path": "src/ext/BGRABitmap/bgramemdirectory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "045b1e378df0d2f16d7feeda1a2334030904f196", + "size": 21192, + "sha256": "ac258fbb77cec7922b1684c4ba78c25748519ff9a40526f55a50cb3ad6c10bcb" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ad59c8e7e0cf3e02b995435484eac0c16404a84d", + "size": 9920, + "sha256": "ae0694b2660afc59a9d56ca96e31cb82eeb86f77d6d810ae1dd2c2331602f4c1" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui_text.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui_text.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d39fde769d7cc24c395d2ed3568da29ee40aadb3", + "size": 2760, + "sha256": "7d8404e0d37d8db84ef7444c9a25c37303e2472ac7f6c5df6e1494f9eea3a6fe" + }, + { + "path": "src/ext/BGRABitmap/bgramsegui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgramsegui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c54e7afc0ba3124afbe24560f96b63b6ba2a29fd", + "size": 66, + "sha256": "aa7001f8f9ef8f209c262e5ba4230d9668d4fc21331621f560fc48451b266d86" + }, + { + "path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgramseguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "06394f0578e4af1caae07deedd81bbb10ae09924", + "size": 6788, + "sha256": "804b1081d1ae55f0ee688ac5df888fbd39a83c3fb9a1f9243b6a3fb163cebafb" + }, + { + "path": "src/ext/BGRABitmap/bgramultifiletype.pas", + "remote_path": "src/ext/BGRABitmap/bgramultifiletype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "faa5cb2f431fc4cd838a897b5f0f99aa46f741d0", + "size": 13926, + "sha256": "98d77ba1a0715ffb01ccc7a10ad4252c121bfaf45b594ac73ff12cd65ab14a8e" + }, + { + "path": "src/ext/BGRABitmap/bgranogui.inc", + "remote_path": "src/ext/BGRABitmap/bgranogui.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "eb1ef969597263bb3f0c0769e7f75898e8a78b29", + "size": 1886, + "sha256": "31b4fb1fc480d517aa595c0be9bcf26c12fe40cdbaec35e40a454410f8971c5f" + }, + { + "path": "src/ext/BGRABitmap/bgranogui_uses.inc", + "remote_path": "src/ext/BGRABitmap/bgranogui_uses.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9c4e4fd5e76f28b84b036f44ca6854e1dfcba086", + "size": 48, + "sha256": "256b452e3bfb5e6cb506fea8f6b861c6f1c3a0dfd24404aa0c54e16897c15dbd" + }, + { + "path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgranoguibitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7b921814cd8c028a7eca5c3443b74ca34309c54", + "size": 4738, + "sha256": "34e4cc46903fb094747099e591933d1826c411f9dc6ce0f999da4a2fddcd7d3c" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fc16c76a868ef4e0384d47224ad12c3afc4848e2", + "size": 61403, + "sha256": "129c6eaf5bd428895e6befde65c7a43c9833d61c0c977bf3d55132d5b47592e8" + }, + { + "path": "src/ext/BGRABitmap/bgraopengl3d.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengl3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b25e5dab0af440c79206247b669844f171fe4756", + "size": 30664, + "sha256": "42444c0e372d2fd50e9958610e6292c342b9b04107e29c513a939e0d78cd71bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopengltype.pas", + "remote_path": "src/ext/BGRABitmap/bgraopengltype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "668b0b206af285217d0f941ff7dfca164e068204", + "size": 68513, + "sha256": "9326f25c6208a1f2958ef24758a6a8d548aec3e0fccd953080ba35b4178172bf" + }, + { + "path": "src/ext/BGRABitmap/bgraopenraster.pas", + "remote_path": "src/ext/BGRABitmap/bgraopenraster.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0a2522118a99b29de4214f0df7f85ec30ff336a5", + "size": 36935, + "sha256": "af621591b5a03da46860f7ae5f897569da6f12679956f150971e4d52752094c5" + }, + { + "path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "remote_path": "src/ext/BGRABitmap/bgrapaintnet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f20568908d48c4dce4159f126e33e224750fd15d", + "size": 18047, + "sha256": "24a72dfded09742c76cb5a552fbb16a4406fad2b478dc79042aa1f43b96c53a3" + }, + { + "path": "src/ext/BGRABitmap/bgrapalette.pas", + "remote_path": "src/ext/BGRABitmap/bgrapalette.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0836270fe8f9dffd6aaee36a9d6971273000115", + "size": 39386, + "sha256": "91c9a21037b7751741bd8d9368ef0c485e8af51dc5244a3180b76dd29a4e75d3" + }, + { + "path": "src/ext/BGRABitmap/bgrapath.pas", + "remote_path": "src/ext/BGRABitmap/bgrapath.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07bd6872ba4ed9b11e4454a52516d0ba83186c81", + "size": 97593, + "sha256": "b224cd235796b3fd86005a5e4b752765bbb01a87789c49ab08a01dd5d2ee011e" + }, + { + "path": "src/ext/BGRABitmap/bgrapen.pas", + "remote_path": "src/ext/BGRABitmap/bgrapen.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2d07d84b044394af6a79de2132a460a771fb67d2", + "size": 42219, + "sha256": "0cb9f96417c473d4a789ad45b01d75012ecf7572439945abab418bd41b63e63f" + }, + { + "path": "src/ext/BGRABitmap/bgraphongtypes.pas", + "remote_path": "src/ext/BGRABitmap/bgraphongtypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e5e86ea6e5d3a7711358027f818fbaa647f44a16", + "size": 2602, + "sha256": "78010e120172e8d7efc7b8d6601a3935daa88ca0ddb57398b91d8600e1b5bbe7" + }, + { + "path": "src/ext/BGRABitmap/bgraphoxo.pas", + "remote_path": "src/ext/BGRABitmap/bgraphoxo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b9a51f76c54abfcdcc1657e38e1c48bbd1a8dc3d", + "size": 17642, + "sha256": "8b380cb0950f0d1d341b38d9c32f8fc2bd664051dcc46dcb43a09aa2f62ec18f" + }, + { + "path": "src/ext/BGRABitmap/bgrapixel.inc", + "remote_path": "src/ext/BGRABitmap/bgrapixel.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "82a48f6f4f2b3a9285e364910bf229663209c016", + "size": 25785, + "sha256": "cb19e11a998dce956f5d3d66a62b6ad337a9306235426cbdda779752141577b6" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygon.pas", + "remote_path": "src/ext/BGRABitmap/bgrapolygon.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78334656daf0dd4692613e572bd8ab602eedb78a", + "size": 57077, + "sha256": "3cf94340689494dd8f5c42c1c4b289c76619e050b8d2a8efef1a5a8c20ac8797" + }, + { + "path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "remote_path": "src/ext/BGRABitmap/bgrapolygonaliased.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "350b0134f920bd409a2669c3d261858617931272", + "size": 33482, + "sha256": "206934c6bdb0bb6257329653d75ec99b5e7b4f3a0cabf18612699c6dcd5f081c" + }, + { + "path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgraqtbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "91d569d022ebf8642c6f0023d7786c2880b884a3", + "size": 4445, + "sha256": "a0978804b32333f1ab385273b5eea2284ae3f6040d1eaa3bcc166ba14a98c31c" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadbmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "49d04354d6024606c3e1ed39213d972f99e036d5", + "size": 34412, + "sha256": "11e445c5f6c6d70e084ce985c2bc5eec59bb6c4e4de62926c2fb31c76fa395ce" + }, + { + "path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadbmpmiomap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4978cc141addc11e35963a563aeafb7a9757df2", + "size": 6722, + "sha256": "189e6f2c8b7d56c328c87a906b3d1025b6af829050931c5d9e45a4a8d953debf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadgif.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadgif.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e14a03e7bac8360bbbf95e0138eda4feb8907dfd", + "size": 9515, + "sha256": "ff98829eeee4883d39f957baef90c516adce360f0a69b0b905149a0d09ad4c53" + }, + { + "path": "src/ext/BGRABitmap/bgrareadico.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadico.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aaacce9d54ec38710c5f771d175468d36981de4e", + "size": 4059, + "sha256": "a25d29c357d952fe42ab31706e5dd2317396d96c1a9aa956e7cb6d25e672417d" + }, + { + "path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadjpeg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "40d899637d8d977325e5adaffcb5df8ae21885a9", + "size": 1336, + "sha256": "a640eb3e41a74acd59ae9b295eadb2c5ab7c1573887331cdd22f8d64a13080a8" + }, + { + "path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadlzp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cc0eb804db1b65ffc4d8da1ef35f09dad0a79b12", + "size": 11700, + "sha256": "121fe5c762326b4b4b3731141b8d7d5c8347414e20987b9031516b8fb7f849fd" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpcx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1f8493322f310e075a5d55f045fef8b6074288ac", + "size": 5747, + "sha256": "34dff1bd9257d040428fb61a56229d4d0860c51c87468bcf729c9dae97df6e52" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpng.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpng.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a65c61f771e9c0c2c211bf72046269c4171aee35", + "size": 42682, + "sha256": "dcd2bf8a16a8c5b18d36e3c2ad55109a4c5612c8c57f39427ff21050e8c0d0da" + }, + { + "path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadpsd.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97c237105c41eed0e67eb8e2beab3176a4556c4c", + "size": 17611, + "sha256": "5af0e7d5fbedb438c538483aed16b18a2186df4c5cd98938f4ad81de342e6fa2" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtga.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadtga.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "303b750d1f5f367b6e07dfb520a7a99e6a4ed42f", + "size": 4948, + "sha256": "538f2bf3c5ff8e49db9b8fced65f62ab8354cea759610175dbb2f66046aafadf" + }, + { + "path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadtiff.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "99903644256cd7b210c6204ca95037c862e04259", + "size": 88027, + "sha256": "73d704e60109646566ec935a3ee16be1e813b53b0418fe08cd2fc9cfb1c20494" + }, + { + "path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadwebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a921f98db75ef644e4aca469c4683d16b683f5d7", + "size": 3683, + "sha256": "adfcd666b623755d1530ea4b0cfd57a99b354dab9f4fa8ae69fb5fecf86be556" + }, + { + "path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "remote_path": "src/ext/BGRABitmap/bgrareadxpm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9b23abfa58e4aa2375673b86dec03b14fb33424", + "size": 1980, + "sha256": "0f63b0a79cbfbef8f444b9578f09595fb226776c83e2e676f5016f813ebe142e" + }, + { + "path": "src/ext/BGRABitmap/bgrarenderer3d.pas", + "remote_path": "src/ext/BGRABitmap/bgrarenderer3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d31f34ad041058aabc6459ed51faf6e9abadfbd7", + "size": 28247, + "sha256": "09dd98e68b0e69b9fb4f92d1b22ef44bc210680eaf205ee7f0efa4f2d6c83f22" + }, + { + "path": "src/ext/BGRABitmap/bgraresample.pas", + "remote_path": "src/ext/BGRABitmap/bgraresample.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c435b5d4ed1fca66dfabbc43db4fdc0c2979206", + "size": 50177, + "sha256": "95dbe34e06991df81414dc2a8557ae608dd51ac4a28273f03120793dd49d8877" + }, + { + "path": "src/ext/BGRABitmap/bgrascanner.inc", + "remote_path": "src/ext/BGRABitmap/bgrascanner.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5af3648c086bb67bab6f1ea96ba5de169d209ca2", + "size": 9784, + "sha256": "e93415954b1e354e3e5cd962af9a754ebd5d3ffcc0a4b5acf70cd0fc521513a9" + }, + { + "path": "src/ext/BGRABitmap/bgrascene3d.pas", + "remote_path": "src/ext/BGRABitmap/bgrascene3d.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3ca41b84dfa2e5a6e163d2e06449256182fc76dc", + "size": 47272, + "sha256": "a112f0be88e33f9aa1fb826e70da7c0e9c33732eb9eb66a5bd9cdb038556267e" + }, + { + "path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "remote_path": "src/ext/BGRABitmap/bgrascenetypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b06e33bb74c6534278546e79685c10505521349d", + "size": 43543, + "sha256": "d51ddb17d5536936523c5214513379fa64c0800ad1434c74f1283fdd8662ad7d" + }, + { + "path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "remote_path": "src/ext/BGRABitmap/bgraslicescaling.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3884b0c1eff8550874587ead4c365061743369a8", + "size": 26153, + "sha256": "e56fd004c3bfb7598183cde3effee44997265c2164d1bc30d09c8a805ebe0309" + }, + { + "path": "src/ext/BGRABitmap/bgraspritegl.pas", + "remote_path": "src/ext/BGRABitmap/bgraspritegl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b97068e93096208579fd1e4b58229614006570fe", + "size": 15856, + "sha256": "0e727cf473e6efad2379a3b1385a62abff36c283712c62f5e4e73ecd21d77396" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.inc", + "remote_path": "src/ext/BGRABitmap/bgrasse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a52c86bb4fc7661ab1a96943ba32ef70cc47350f", + "size": 487, + "sha256": "8e551dd5dcc6844bb1e354cc6cac40843c23fd9cd00eb4c7f6a0d988a4882185" + }, + { + "path": "src/ext/BGRABitmap/bgrasse.pas", + "remote_path": "src/ext/BGRABitmap/bgrasse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "274229f587cd11e94db6b7d37a8f61ad5b0dd6cf", + "size": 13872, + "sha256": "8444b817dc843a1258b665ecf1daec057b26f58f42c646cc75811f9c83ad1df9" + }, + { + "path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "remote_path": "src/ext/BGRABitmap/bgrastreamlayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75f8e3c9250ccc92c5e6367d6c444eaa2aa69e5a", + "size": 12915, + "sha256": "80ae6626033f3a18f77cc7685780191d1f658bca35886aa2e804e548b8f21313" + }, + { + "path": "src/ext/BGRABitmap/bgrasvg.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b427138ae73965064b57eb33c3a0ef6c1cfcefce", + "size": 44129, + "sha256": "e95eb0028b92a04d9a15b15faff5cf726e793e5dfadd6d635f117e22f3c9c09c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgoriginal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7774e3572fb262ff7734307522c4bb66ce3c569", + "size": 21465, + "sha256": "c1eaa0768f01913e9d24284df54e3042444ea3fdc5e9a0685692d7a33ec5d70c" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgshapes.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgshapes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e048ec9e078d494bac9bce599e8b21549505f3f2", + "size": 140870, + "sha256": "46b588cf74cfa086d9e408ba0f7cffecafb14fc4a9026ecb3bb7e8b512b933c6" + }, + { + "path": "src/ext/BGRABitmap/bgrasvgtype.pas", + "remote_path": "src/ext/BGRABitmap/bgrasvgtype.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57ed4ee27cf2067ceca236513c64c8858e85138a", + "size": 76681, + "sha256": "0337579797b600c8a6dd8e52abcab46ea588cc5d37fd6ce89e11ce7dcbb4b1f2" + }, + { + "path": "src/ext/BGRABitmap/bgratext.pas", + "remote_path": "src/ext/BGRABitmap/bgratext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "385b7829f8a24c0fe207584645c5fbe0132814b9", + "size": 66461, + "sha256": "1595e318a7e1d421c1b06318c108e09729774eb92530c043050ce14505511446" + }, + { + "path": "src/ext/BGRABitmap/bgratextbidi.pas", + "remote_path": "src/ext/BGRABitmap/bgratextbidi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "774d5066c6760fc47e45b4fce4fe0ed5973a442d", + "size": 121744, + "sha256": "10fa668c584faed9c50c7157a52ccfd9ab697fad1829710ec37fcd91284adf93" + }, + { + "path": "src/ext/BGRABitmap/bgratextfx.pas", + "remote_path": "src/ext/BGRABitmap/bgratextfx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8766deb1308ceec14e616b3052788530bad0c65e", + "size": 31347, + "sha256": "12213f525b0e2237eb5b0b6c0552e80f7ba8b6c09b14781d30e06b6177db8d1b" + }, + { + "path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "remote_path": "src/ext/BGRABitmap/bgrathumbnail.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ce1d7ec33a91831d85e6bd7d267d2d9a31d5eed5", + "size": 20446, + "sha256": "1b391877196e3a667aea8f00a3b2e3c011003d9739e66950e8fdb63fb665acd7" + }, + { + "path": "src/ext/BGRABitmap/bgratransform.pas", + "remote_path": "src/ext/BGRABitmap/bgratransform.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87b5e6c92e3105deceabeffb16c93cbfac68d98c", + "size": 59017, + "sha256": "19149aa065f5b787d8b510a88d12073fe6d45ad4dc9e33731db9990201e4abd0" + }, + { + "path": "src/ext/BGRABitmap/bgratypewriter.pas", + "remote_path": "src/ext/BGRABitmap/bgratypewriter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f99437c7ca70ad5f62eec1daf79742f6b06b9177", + "size": 40626, + "sha256": "e272de83a67af9c340a54cfe18eeef582fea954fdf333d9d787742a16b09c4cb" + }, + { + "path": "src/ext/BGRABitmap/bgraunicode.pas", + "remote_path": "src/ext/BGRABitmap/bgraunicode.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5962e71e403ad905d30bc7b44785753bf58b9c0b", + "size": 47822, + "sha256": "32553bdda3292a351aebbfd74637979060e3400578092c2cf69f96c93270afcf" + }, + { + "path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "remote_path": "src/ext/BGRABitmap/bgraunicodetext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3686c1aab41392e776e8273268900d972e9e58bb", + "size": 36190, + "sha256": "d8f9732a4e7a7d93085a909011702346ffbebec4a17bd85f5656162c0f6b91fa" + }, + { + "path": "src/ext/BGRABitmap/bgraunits.pas", + "remote_path": "src/ext/BGRABitmap/bgraunits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27d469d9a51c25c2379cdcce728cb6cbaff7329b", + "size": 18400, + "sha256": "15bfb722add1f2174415a51608f43dd3f8e146f8f897819413b72e2af525d0a5" + }, + { + "path": "src/ext/BGRABitmap/bgrautf8.pas", + "remote_path": "src/ext/BGRABitmap/bgrautf8.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8415793f10e2612bbeb9006acf1d27070b1dfbac", + "size": 43347, + "sha256": "cda37875ea73b304d2b88bf81379e2008541232b31e87a7b48ca37d77283efe5" + }, + { + "path": "src/ext/BGRABitmap/bgravectorize.pas", + "remote_path": "src/ext/BGRABitmap/bgravectorize.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "300d5d2c3f2fac9fab725d371fdf88dcc5931308", + "size": 84171, + "sha256": "c41ba52c6f04ae1ce067173eb4c4500b33ee758d4384afcb322828a262b07c2d" + }, + { + "path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "remote_path": "src/ext/BGRABitmap/bgrawinbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "10bc5fb04d035709bd605de8eb7046a7a915d1fe", + "size": 6682, + "sha256": "62da6d4ca3cd639b264012e38fc545898e2a2aadb6706620102987e0f585a0e4" + }, + { + "path": "src/ext/BGRABitmap/bgrawinresource.pas", + "remote_path": "src/ext/BGRABitmap/bgrawinresource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "478588dffe1f6eb93390fb9c8eb212eb1787cd57", + "size": 35365, + "sha256": "eacaac2de93b1187147f3638449ff213087c1e313b4e425bd5d09e0e1702a6da" + }, + { + "path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritebmpmiomap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "42053aca74b6776aea38fc7febf5ac15e84a3968", + "size": 10268, + "sha256": "66d50f4d229e53c67d386a6adcd9bc230035765f57af9aa934bd6c6f22e07e18" + }, + { + "path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritelzp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cff2638573af23ecc384eaba045437a3b34e8620", + "size": 12892, + "sha256": "76a653877fd337b900809a3857c8789251b930a968397819545c66425d74caf8" + }, + { + "path": "src/ext/BGRABitmap/bgrawritepng.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritepng.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4613e0912dd56745ecc34cf957199d43bdc9f00a", + "size": 25890, + "sha256": "740fbcecec0191531ac601d145e14e9d62590ea182d257546e34617678ed1cd0" + }, + { + "path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritetiff.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "060e1e3cb29a048c2a98e9fd41520ae1fb8ace29", + "size": 31044, + "sha256": "92ab6a9a785402b0a434296616645089241497570b070956d3a596437380ee4a" + }, + { + "path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "remote_path": "src/ext/BGRABitmap/bgrawritewebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05ece31d7daabce8f28631c5194524db468010c5", + "size": 2912, + "sha256": "770d303fbced5025552494a1286cdb5a3fcb69311f464871efe7fddbc39262df" + }, + { + "path": "src/ext/BGRABitmap/blendpixelinline.inc", + "remote_path": "src/ext/BGRABitmap/blendpixelinline.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "015ffcf0927151051e41a955fd0abc082b30e25e", + "size": 36495, + "sha256": "fbe549da3171fcdbca2f0215fd4762613c985e3cf8139001b79b5981ad3c3e24" + }, + { + "path": "src/ext/BGRABitmap/blendpixels.inc", + "remote_path": "src/ext/BGRABitmap/blendpixels.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba55e70235aa8ad013379a054d6f61d7d5576045", + "size": 12795, + "sha256": "af40c44ab9a07804cb1bb3040441b5d94b822c8d0a1481081bd59548a9a5c496" + }, + { + "path": "src/ext/BGRABitmap/blendpixelsover.inc", + "remote_path": "src/ext/BGRABitmap/blendpixelsover.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dd9cc22d037ad2cdd88f96173022e9669f8c056d", + "size": 34331, + "sha256": "aca875536ebff11e627fcc9f11209b5a2f98d6213260e3476b253cb1daa7a1e2" + }, + { + "path": "src/ext/BGRABitmap/blurbox.inc", + "remote_path": "src/ext/BGRABitmap/blurbox.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5afbf6000a317bac9f061491a5fe77f9c3511898", + "size": 14225, + "sha256": "5dc9225b625ab0ae4dfd58565a98fc858fc7cbddd9956282a8fb07196095e7d7" + }, + { + "path": "src/ext/BGRABitmap/blurfast.inc", + "remote_path": "src/ext/BGRABitmap/blurfast.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f703facba323429614068f99386ab1bf79d27cfb", + "size": 7041, + "sha256": "5a318068a29041b76d44164388d5c16ba07fda338774f19b13fc3193e1230da4" + }, + { + "path": "src/ext/BGRABitmap/blurnormal.inc", + "remote_path": "src/ext/BGRABitmap/blurnormal.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0d7cc76a3a03f1a525b9ce427baae468ecf6987c", + "size": 7341, + "sha256": "9dbf42e5f87f63d71a1eda29852a5ff087a15eadeed1624c5cca91989fb6f43f" + }, + { + "path": "src/ext/BGRABitmap/csscolorconst.inc", + "remote_path": "src/ext/BGRABitmap/csscolorconst.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d5a6c39551a15f71d9822bf259ae532dcbcef297", + "size": 33221, + "sha256": "0412552b4677a5bd01cb7bf14178076b1cb95b9f4dac63a795f14a7dfecad0d9" + }, + { + "path": "src/ext/BGRABitmap/density256.inc", + "remote_path": "src/ext/BGRABitmap/density256.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd132a490dd5302d2160ed537187647172b6d376", + "size": 2787, + "sha256": "ee79f55f17a31c270cf0ae3b6c6bf0be141a107aa063ed424cbe2a5dcd0e084f" + }, + { + "path": "src/ext/BGRABitmap/expandedbitmap.pas", + "remote_path": "src/ext/BGRABitmap/expandedbitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1c233685a0ae0b3278ff6774768eb361dea7a3c9", + "size": 24998, + "sha256": "ae72b8da6c2396c45cb28991ed7d50868845c58a095a979a57f930a0376f66a6" + }, + { + "path": "src/ext/BGRABitmap/extendedcolorspace.inc", + "remote_path": "src/ext/BGRABitmap/extendedcolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7bbd22a2421b6ea6c8a42f1a98b342d7ce2fff15", + "size": 46110, + "sha256": "5d1784ce5afb1546e139a71174bb5392c64db07067db6d21a77dc057490ca03f" + }, + { + "path": "src/ext/BGRABitmap/face3d.inc", + "remote_path": "src/ext/BGRABitmap/face3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bdfc208dacacc32730647fe4ce2c16abc716a40", + "size": 14735, + "sha256": "65ea855da052f1ac8d640b9276e4ceafb8c257b4601d17f33e4da718755bccf8" + }, + { + "path": "src/ext/BGRABitmap/generatedcolorspace.inc", + "remote_path": "src/ext/BGRABitmap/generatedcolorspace.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "feab5f4814ca9988fac99939381cb63ffc10e053", + "size": 302323, + "sha256": "e49bea00166d0318530b30e7cc6e08d3121c12c43a5b2d687cecc13c03db760b" + }, + { + "path": "src/ext/BGRABitmap/generatedunicode.inc", + "remote_path": "src/ext/BGRABitmap/generatedunicode.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a9845ecd6595b9e51fbb27600257cd4f47ac46a", + "size": 83613, + "sha256": "9a9ba635cc38fc3b3a94455339043a0a0b159b695724447acdfc3fd3608839e5" + }, + { + "path": "src/ext/BGRABitmap/generatedutf8.inc", + "remote_path": "src/ext/BGRABitmap/generatedutf8.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3db4178dc2e079a58bde0093fc55a2ead450591", + "size": 46513, + "sha256": "3c136e5e5096968905a7a29980fb53216df73dffa005f46b88337a8f5aaf6df9" + }, + { + "path": "src/ext/BGRABitmap/geometrytypes.inc", + "remote_path": "src/ext/BGRABitmap/geometrytypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e2d04b2f071810b5bf9eff981f6ecd9949f094d0", + "size": 57359, + "sha256": "ff86ae0ffc7885d4acf9161804837ce43d983db15917380320599409282800f0" + }, + { + "path": "src/ext/BGRABitmap/libwebp.pas", + "remote_path": "src/ext/BGRABitmap/libwebp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c673cd1a44a04a09eec2e6e370cfdb1cd4c01039", + "size": 30285, + "sha256": "4527c568f582941d92dbe58f5b81dc193cfff18ac103f56ba2978e43e3a53216" + }, + { + "path": "src/ext/BGRABitmap/lightingclasses3d.inc", + "remote_path": "src/ext/BGRABitmap/lightingclasses3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "409f22304530fc65f2b07c536b19c4740c385695", + "size": 5574, + "sha256": "d76d3245761857272fd9ca21bc84478933124831195196e06d3cadad3a64e058" + }, + { + "path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "remote_path": "src/ext/BGRABitmap/linearrgbabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ce76e3f00bcace8ea18e6ea588cd08ab41ff8b0", + "size": 19460, + "sha256": "555770d86b49658d316f8ad5ae5dc4078a56e27ae25770bc11a9cf4f28b30175" + }, + { + "path": "src/ext/BGRABitmap/lineartexscan.inc", + "remote_path": "src/ext/BGRABitmap/lineartexscan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1724212890c3fbc2048565ab350b1f87bb63b14b", + "size": 2853, + "sha256": "46dd5af8ea12e1784fee7d31187f425703d3316b43e9762ad9acad1d207d7e48" + }, + { + "path": "src/ext/BGRABitmap/lineartexscan2.inc", + "remote_path": "src/ext/BGRABitmap/lineartexscan2.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0bb7c2331784bd1db6c1f50317950802f9d593ce", + "size": 1508, + "sha256": "cd2f14ad1f8854b856e183970ec5933066c06884c3c5853121d70e71f461dbd3" + }, + { + "path": "src/ext/BGRABitmap/linuxlib.pas", + "remote_path": "src/ext/BGRABitmap/linuxlib.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "623e4736cbe471d1bf5ac77c7459ba85d05e8203", + "size": 3605, + "sha256": "cfe50e39c0505753d5129d71af71da286d9ed0017e09324b2c83f3b161d43ef5" + }, + { + "path": "src/ext/BGRABitmap/multishapeline.inc", + "remote_path": "src/ext/BGRABitmap/multishapeline.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19ac4ef4f8870f63d51fa806d47aece0592754c4", + "size": 2126, + "sha256": "bb1f38a9671fa0c43216f70cbce72fc1c977fe705747369001d7dfa031695a18" + }, + { + "path": "src/ext/BGRABitmap/object3d.inc", + "remote_path": "src/ext/BGRABitmap/object3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "59ed8add0e6e3cc8d6aa8e559644481bff986571", + "size": 6911, + "sha256": "003a0ee32fbcfc2d7bac8f23352ef7a21729bf7546432d9771e9db59f2fc030f" + }, + { + "path": "src/ext/BGRABitmap/paletteformats.inc", + "remote_path": "src/ext/BGRABitmap/paletteformats.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5687200d3a2e2f316dd5938bc1db860503a6953e", + "size": 17848, + "sha256": "b342ccb4da609cf347240478e7c7114e7cb91efe4c77e3f70602a68a30d58104" + }, + { + "path": "src/ext/BGRABitmap/part3d.inc", + "remote_path": "src/ext/BGRABitmap/part3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "755d435398e4823e10a94a10f290145cd2163b17", + "size": 16528, + "sha256": "6edd44b457743c08743cdbb9c105025361145d3d8e44a6f83f51c48445d9ca69" + }, + { + "path": "src/ext/BGRABitmap/perspectivecolorscan.inc", + "remote_path": "src/ext/BGRABitmap/perspectivecolorscan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "135562691b4a3ffc5b55ea35393b10eb25e2c459", + "size": 3075, + "sha256": "4f21155f801a0a3344b7c862decaa7b005689d6150488ef19aca325272a09139" + }, + { + "path": "src/ext/BGRABitmap/perspectivescan.inc", + "remote_path": "src/ext/BGRABitmap/perspectivescan.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac9686fc49a065d2950d1e761587b3be9b6c7921", + "size": 4322, + "sha256": "2c26ccfb9a5d064a2cbad71ae97940ba761720ce2adc4d68d1994bb0991eb9de" + }, + { + "path": "src/ext/BGRABitmap/perspectivescan2.inc", + "remote_path": "src/ext/BGRABitmap/perspectivescan2.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87d80f95d295858dfb394abe721efcf74be1bc30", + "size": 5945, + "sha256": "4953e2f64c4d823df9ed1929196dcd962ea273d46ef3b18753644dfbb2889659" + }, + { + "path": "src/ext/BGRABitmap/phongdraw.inc", + "remote_path": "src/ext/BGRABitmap/phongdraw.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4d771a2b594a8eafaf9715af370d00195421685", + "size": 8517, + "sha256": "9739b9bae83df5ceeef2cfa0262749eeebab5aaa536e8abeab8459225c4c0ced" + }, + { + "path": "src/ext/BGRABitmap/phongdrawsse.inc", + "remote_path": "src/ext/BGRABitmap/phongdrawsse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "50ffc255a7511614fce1c5b8cafe59c2005fb161", + "size": 3470, + "sha256": "2e34afbe1828b5ce2a1bbe62622e7c3ba756f82d7b8647ed50b19161c17f50f6" + }, + { + "path": "src/ext/BGRABitmap/phonglight.inc", + "remote_path": "src/ext/BGRABitmap/phonglight.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fcbb655e54dbc00e5fcceb986b0e64cdd4dd665", + "size": 1683, + "sha256": "08481c351d3d5c56ec8786647a60784d90959598af8f3752f130ccad974147d3" + }, + { + "path": "src/ext/BGRABitmap/phonglightsse.inc", + "remote_path": "src/ext/BGRABitmap/phonglightsse.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e2bc7a4c357c6e219ee18cf9404fd99bc167069", + "size": 2412, + "sha256": "4457e442a15f8baeb77ef526d328560583c521303a6e900cd58e12bc639cc4a0" + }, + { + "path": "src/ext/BGRABitmap/polyaliaspersp.inc", + "remote_path": "src/ext/BGRABitmap/polyaliaspersp.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d20daec524c1c8599aa2841e95e91c8976a07585", + "size": 23271, + "sha256": "5dc7ed2e61f5b8b8b69c0f786b2f5062e2f79d7ad6d1692cd3cdc106b817ec1f" + }, + { + "path": "src/ext/BGRABitmap/shapes3d.inc", + "remote_path": "src/ext/BGRABitmap/shapes3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04bdd0d31f9bd0365dde1f1682abf6cc38b257b6", + "size": 2312, + "sha256": "9c706cda8f002d9baf738852bb7f558e31bb7a578143d1b83cfa2985f0766013" + }, + { + "path": "src/ext/BGRABitmap/spectraldata.inc", + "remote_path": "src/ext/BGRABitmap/spectraldata.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d464275083871dc396966bfe6d7f834a70abfa7d", + "size": 6413, + "sha256": "54793bbcf8b5f1d46065c475a69b9f23ecc3c411532156b405d0bf54bd5921fc" + }, + { + "path": "src/ext/BGRABitmap/unibitmap.inc", + "remote_path": "src/ext/BGRABitmap/unibitmap.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbdc23bee0fb33caff0440f9b7803c6f9e99ed17", + "size": 153955, + "sha256": "5d381886a4c3f9cd32e4d9fcdab18586505e986cddb3a5fc845ad75d4eacd603" + }, + { + "path": "src/ext/BGRABitmap/unibitmapgeneric.inc", + "remote_path": "src/ext/BGRABitmap/unibitmapgeneric.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04fc32b6e9f84ae8ab71766a68437ba5f45e7255", + "size": 42303, + "sha256": "08b779d110da2b71422329c527a8845f0906923c5830988705fcfa47f223e53c" + }, + { + "path": "src/ext/BGRABitmap/universaldrawer.pas", + "remote_path": "src/ext/BGRABitmap/universaldrawer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e6e70239404ea0a86eaa4fd3416cb42bad1fe0e", + "size": 43452, + "sha256": "605d8b74761234bc101d4e7a9dc235cc38f015e5849f8f25ef041077ab1c8d7d" + }, + { + "path": "src/ext/BGRABitmap/unzipperext.pas", + "remote_path": "src/ext/BGRABitmap/unzipperext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b1e67d37f76203136c9b8fd5ae7f11080aa3cd4", + "size": 3416, + "sha256": "61c260971722e677351e149fdf57290e2188374a6a2edab0445f528ac3661a1f" + }, + { + "path": "src/ext/BGRABitmap/uunittest.pas", + "remote_path": "src/ext/BGRABitmap/uunittest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df2c3a89967ccb2125123ebf09f69945ac4ec910", + "size": 2101, + "sha256": "ea08412a967e0cfbc0ead495d8e68526484bb17b2c484af6942d21ee0125dc3c" + }, + { + "path": "src/ext/BGRABitmap/vertex3d.inc", + "remote_path": "src/ext/BGRABitmap/vertex3d.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bff9fdf2b9d02b141d3887b317009f2143d7dad2", + "size": 14808, + "sha256": "47256f31e0d2fa62b411ab576b86efba0b12fa1d431b87d1e63024102415900f" + }, + { + "path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "remote_path": "src/ext/BGRABitmap/wordxyzabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74aae80da6f2fa727d77aad39ac3de0a0a424497", + "size": 24614, + "sha256": "b3a763eb96d6b279e65b9b950d513f3ddb72ba5bec9af117782daa0a5b10314b" + }, + { + "path": "src/ext/BGRABitmap/xyzabitmap.pas", + "remote_path": "src/ext/BGRABitmap/xyzabitmap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8dc2a4f0d46c7469652259588d1354147b21a179", + "size": 19867, + "sha256": "b4a602fc84de79f550c09eeeb7dcd799ecb6f4623bfc6a513e548c2b8aa877bd" + }, + { + "path": "src/ext/BinaryHeapStub.pas", + "remote_path": "src/ext/BinaryHeapStub.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8746ed987779b2e9c72567d67bb422750ca4bdf2", + "size": 1279, + "sha256": "4ddfa7367023c75fd8ac5ad258ba28ddc7fac4ffde87b1d7f518aacc6d040d0d" + }, + { + "path": "src/ext/Delaunay.pas", + "remote_path": "src/ext/Delaunay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "10039e7417376892082ac5f40e5235f9a9c51b4f", + "size": 11171, + "sha256": "e92c10914cbee7ade58cf4859eb761322f6988f627f9885c29a4d58cb2b33637" + }, + { + "path": "src/ext/FastMM4.pas", + "remote_path": "src/ext/FastMM4.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebfda7eb94b8f6806a30497bd935159f5b1a05a0", + "size": 462243, + "sha256": "a2a8d2bc97c73db599272f0bb6e4d04226ddc543626a0ddce8e2b0591a6f7b43" + }, + { + "path": "src/ext/FastMM4DataCollector.pas", + "remote_path": "src/ext/FastMM4DataCollector.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "00f06114140ce13de95e3c2be30ce5c48d676da8", + "size": 11281, + "sha256": "8deb144d5433dcee652a62f6d48030525a71a85673ca633ca31fe437ea04bac7" + }, + { + "path": "src/ext/FastMM4LockFreeStack.pas", + "remote_path": "src/ext/FastMM4LockFreeStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60d5395eaec04f2a4edfca30dcdcae3d7329490d", + "size": 9943, + "sha256": "bb106644e3640b33951ad4a816401feb0859a2860dc9ad51c594f891a7ba594e" + }, + { + "path": "src/ext/FastMM4Messages.pas", + "remote_path": "src/ext/FastMM4Messages.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8df7cf9e39e5a96d6b3d2e8c5f902bfc75d33a28", + "size": 7900, + "sha256": "11c8b6dad6834de17c6e5aaeb29398631d434d0e58f3151543288d21c5d64d83" + }, + { + "path": "src/ext/FastMM4Options.inc", + "remote_path": "src/ext/FastMM4Options.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f12e4c10a3a8afd63bb07d6f91e1a587503c2945", + "size": 20705, + "sha256": "621e2072c1222576f763b5b5453b1cf0fd66702af13f9bfd379a30599cac8787" + }, + { + "path": "src/ext/FastMM5.pas", + "remote_path": "src/ext/FastMM5.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1acf609e8c6bb69e4d6117eda09a6245322041bc", + "size": 397224, + "sha256": "abe54153e7fb403d2ae6fc94117df0398dc482f3faaad7318e97030199338896" + }, + { + "path": "src/ext/FastMMUsageTracker.pas", + "remote_path": "src/ext/FastMMUsageTracker.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c5ec6d8ce65e24cf9b38d5a6d02b196456d5e244", + "size": 37720, + "sha256": "e0e43962bfaa95c85695c4d6868ce9c87eeaf585c460f81209e64046abe59c0f" + }, + { + "path": "src/ext/JsonDataObjects.pas", + "remote_path": "src/ext/JsonDataObjects.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "111fdf438ddb774b595f1f656fa1bfb4598ff9e5", + "size": 234002, + "sha256": "0bcbe3302d150a237d96d9bac8652b5f58b0e995fe83593e2e947ff4c654f7e6" + }, + { + "path": "src/ext/KromIOUtils.pas", + "remote_path": "src/ext/KromIOUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de1bd455f8973e4afc588d70d6407cb89c64332e", + "size": 1114, + "sha256": "d9ab5b20f4915bebab9202569027d37311065b49d8e5c6429537ab85594ad9c4" + }, + { + "path": "src/ext/LNet/LICENSE", + "remote_path": "src/ext/LNet/LICENSE", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92b8903ff3fea7f49ef5c041b67a087bca21c5ec", + "size": 25275, + "sha256": "7a4436f9ec37603356791c87de3bc444989befd2682d29efb3d97604e04c1852" + }, + { + "path": "src/ext/LNet/lcommon.pp", + "remote_path": "src/ext/LNet/lcommon.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8f9e38e85df420be7f71b7f84586777a7f58854", + "size": 13639, + "sha256": "39eaffa0245ed2d3ca3fa0caad773f4105b8bdf1aeb4fe30bacf941e845b98ad" + }, + { + "path": "src/ext/LNet/levents.pp", + "remote_path": "src/ext/LNet/levents.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8c072b0cc30ffdde7e1f3dda497121588edf797", + "size": 15489, + "sha256": "0d9230b9fa576d16c0b643aac951790245cbfb875d9f05a6e765e7333d39376a" + }, + { + "path": "src/ext/LNet/lhttp.pp", + "remote_path": "src/ext/LNet/lhttp.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fcaa89dc05cde2b411f50c76810e04d7571b2c8c", + "size": 62386, + "sha256": "566d34ed27b878bca56b35f6b9208bf96b93a8186574597fac862fc00dc4d22b" + }, + { + "path": "src/ext/LNet/lhttputil.pp", + "remote_path": "src/ext/LNet/lhttputil.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64c629e5958cbbaebd14b2cfb768649459ad1d1e", + "size": 6896, + "sha256": "314f08b0fa3d0bb384a7d149966fc6c937da2ddc487b18e48c19582d766bbeb7" + }, + { + "path": "src/ext/LNet/lnet.pp", + "remote_path": "src/ext/LNet/lnet.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b3c2669e75aa36e5448a58a1c12b99e0ef4d8001", + "size": 48551, + "sha256": "fcbd9c318fd921154e4bbcfa8231c5c3d388568c06528b5d53b423f649550b05" + }, + { + "path": "src/ext/LNet/lnetssl.pp", + "remote_path": "src/ext/LNet/lnetssl.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78fcbc12438820deb842ace6df125bb2222a7ff7", + "size": 17587, + "sha256": "cc8564c5fa962f4dbbf35e21e07de594cb4427873d7e53d36aec69a4437d4c26" + }, + { + "path": "src/ext/LNet/lstrbuffer.pp", + "remote_path": "src/ext/LNet/lstrbuffer.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "47d6e9520534f373aa7220bdafbc124618156b90", + "size": 2857, + "sha256": "50fd2d41729d8f3f83261ca484f28ee95557bf993502332eb189196332aa8314" + }, + { + "path": "src/ext/LNet/lws2tcpip.pp", + "remote_path": "src/ext/LNet/lws2tcpip.pp", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebe7f942e478b3f59e28974d7006b4f2306962fc", + "size": 1376, + "sha256": "6773352b20b0e329a1b7aadd77171c413a8825dc5aaff27534dc31a826055a24" + }, + { + "path": "src/ext/LNet/openssl.pas", + "remote_path": "src/ext/LNet/openssl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bf05c0df75f97aebb9c4ce701a6bcc24ec70d4bb", + "size": 54424, + "sha256": "b1c9f192e7bd7093bd45e26897577c2b2e77bb5bd08bdbcfe731a801d5d6018b" + }, + { + "path": "src/ext/LNet/sys/lepolleventer.inc", + "remote_path": "src/ext/LNet/sys/lepolleventer.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "71dc98081c011e71a27be1c69a98fdf413722dda", + "size": 6406, + "sha256": "c5222172a5d7728fdc025b93ae45e7031affee1e3db0850eafb65e1aa00fa174" + }, + { + "path": "src/ext/LNet/sys/lepolleventerh.inc", + "remote_path": "src/ext/LNet/sys/lepolleventerh.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "284d52044d3d066e33f4aa6d1b840ea4a319b97e", + "size": 976, + "sha256": "1128a092ae08be866eeeb7acf971aee78dcee1a53c9b8804e7bdf7d325a207b7" + }, + { + "path": "src/ext/LNet/sys/lkqueueeventer.inc", + "remote_path": "src/ext/LNet/sys/lkqueueeventer.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c75a1d24c8915c87af45cf965a2e38549f4d0f2", + "size": 3535, + "sha256": "180c19492bf08b523b399e903ea23d221bb86fd2b22d41591bc57a7555bc49df" + }, + { + "path": "src/ext/LNet/sys/lkqueueeventerh.inc", + "remote_path": "src/ext/LNet/sys/lkqueueeventerh.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44b2d3e1572a3e29947635ff1e02f980179edcee", + "size": 666, + "sha256": "b3dcb8158ed10d195a721becad766de5e3fd5b02dfe5d8e3cefb56b25c8f8701" + }, + { + "path": "src/ext/LNet/sys/lspawnfcgiunix.inc", + "remote_path": "src/ext/LNet/sys/lspawnfcgiunix.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "202623ea2a51a4055fb9d1a140af8ea8f3817e49", + "size": 1096, + "sha256": "f0464ca123d4069825e55d4c3212aaa8b670759a353d5abb837b0db21e2d5244" + }, + { + "path": "src/ext/LNet/sys/lspawnfcgiwin.inc", + "remote_path": "src/ext/LNet/sys/lspawnfcgiwin.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d18c166afb41b67cce6854f19a2f3521d75d904c", + "size": 122, + "sha256": "1dd9465557c47af1e5274ccd86de5c36cae99c7553940756a28176a1343270ec" + }, + { + "path": "src/ext/LNet/sys/osunits.inc", + "remote_path": "src/ext/LNet/sys/osunits.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "899b36d830d1c7c502d01269b0c631efec8560a6", + "size": 176, + "sha256": "597fc709c6a09008216e3e5a17271d901f6f7d3eed20b4a57867701fba5f60c4" + }, + { + "path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glcarbonaglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "92026d2796a719828dc2620660cc938e33c4225c", + "size": 9395, + "sha256": "b70c37bd63cb1ce0475956030c392162006f3f62cb50522106c3185cb3f9f6c0" + }, + { + "path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glgtkglxcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "33a59a19dfe6e45b15864479275000d4e9f1cba6", + "size": 24982, + "sha256": "2f36ab0abb3afc0149ae7f7b28795b1d75f459553622f68f00b239784b17da10" + }, + { + "path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glqtcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4dbc44f1043b6b902d62cc3ba5beef777f16cf9b", + "size": 7874, + "sha256": "a13e951a9880ed261ebc5e4dab089c0800aed7642f6259d0e5c2c2e4381b639f" + }, + { + "path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/glwin32wglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4968c442c4c093b3abd5241ea13a6d6060ef1277", + "size": 18802, + "sha256": "798e261d85d9b082283199bbd17e92c681a21790c41f8334165a57c0ba82600f" + }, + { + "path": "src/ext/LazarusOpenGL/openglcontext.pas", + "remote_path": "src/ext/LazarusOpenGL/openglcontext.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d997f3e44abbaea15e7449800a5ca34e826d1a3e", + "size": 14521, + "sha256": "77935e6ede59b58a49f16c1216804dd00f6db55a0ede33aa65f8bd2f702d7abb" + }, + { + "path": "src/ext/OBJLoader.pas", + "remote_path": "src/ext/OBJLoader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "258b39a5d2e162b502bb3bf1e6e6a3bac154f60d", + "size": 7105, + "sha256": "b4d7b9b69340f49ab0ff0f355e29602c698e1ec17369c437bf08d00fc287a06a" + }, + { + "path": "src/ext/OggVorbis/Codec.pas", + "remote_path": "src/ext/OggVorbis/Codec.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4026068ac2e1751df4b6c6b7e32cd4b4281e9fc", + "size": 10105, + "sha256": "7fc46937cbbf07b7eff475f628d4a332401773b31157fd6a478cb5194a1e597f" + }, + { + "path": "src/ext/OggVorbis/OSTypes.pas", + "remote_path": "src/ext/OggVorbis/OSTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "48ca4a7e749f86cb6779fd9a9984d6b8e0717c41", + "size": 4001, + "sha256": "a4e114f76cd1cbcbfb66e9f10d4751e296297d7aed79d0ae28ed00bc905b3cb5" + }, + { + "path": "src/ext/OggVorbis/Ogg.pas", + "remote_path": "src/ext/OggVorbis/Ogg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f52baa39c8aaebc6bc54c0f06c76f79a9bea6e1a", + "size": 10090, + "sha256": "be8ff9a75cc441c2a75ea3877b46217df64dc2584b98960a2f222f1932fe1492" + }, + { + "path": "src/ext/OggVorbis/VorbisFile.pas", + "remote_path": "src/ext/OggVorbis/VorbisFile.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba6fbff8c177e97ebc24738d9e876426333f8c71", + "size": 10397, + "sha256": "a39f27482017c08e601785db9b42dff85063a500edf9cab54a76494310abbbc9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsConApp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21fa614dc29a9409b5dbe9cf18f6fce1f94f8040", + "size": 15311, + "sha256": "1f72177306ea85869448d2de3a0d36d516dfc5061b8006287c1c11661b44fa33" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsLibrary.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsLibrary.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b4c2195536c96a2f453932940fd69d1bd301f726", + "size": 38672, + "sha256": "d92d4d52d8029edf4eb2819c30cdf21213acb1edad64c46d422fd3951f3a2b5f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsPop3ProtOld.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "98f10375c25fcd4045f9549b693d521b73945618", + "size": 95390, + "sha256": "6364c4b9db088de4b479e6d7eae93d4331458702a7dae6be41369f5f3199ab2c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsWinsock2.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Extras/OverbyteIcsWinsock2.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89442a7308faa51713610baf73f8ec424332bfb7", + "size": 12675, + "sha256": "1166499b69357cfd6c6264b358835da62a5b2d8260477ddbef120e15798bc5cd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverByteIcsWSocketE.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b08b93513a0531e440509f5de6d6c2795c5ce13c", + "size": 78, + "sha256": "dd12fb17334453e25e5eeaf06ce92b056005d22c56c139b97ea1137711e61d7c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsBlacklist.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "01fc868491149f02c36bd7e2f978f1f209ab8040", + "size": 106, + "sha256": "206b6682d0988a7e44dee0533ded27b45077b5c256d568d00f2e97aa5f5005e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsCharsetComboBox.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "29ee35ae72d3831d76885122cf81a9ddb507b140", + "size": 6384, + "sha256": "e6055b1423384962d1a7a97f6aacf528ccac11d3f70477cc2c61630966facd97" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsDnsQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef3369e46ff8b1e99a4043fa3bf960049a814242", + "size": 105, + "sha256": "343b424f7ab26f9977ee8f4fe9ba616d9235236099e3dff4491d392b943808f4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFileCopy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ada05b6cd240bf8ad8622f9323f8e3ff92998d39", + "size": 105, + "sha256": "1ed0d831429f679cfd76c89b4fd2dfb40c6cbf0d3d6e290c0e3318e77dd1972c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFingCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f2ac52e3ca4b24b4ade5e7fca386e63e3deff9f", + "size": 103, + "sha256": "03d0caf28e91274426fa9b44c61d1283bd49716c7302ab1f38512c8934da2e74" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21f895006f3a3c818c2f1a802587588c9b55fad1", + "size": 101, + "sha256": "d693316c1dec1b61af68a3fe7e0fc1ed25d9324f86883e4dcf4bf28c4cf713d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "78bd0b0890f4e1a063137cece93bb6728f791e76", + "size": 105, + "sha256": "12855b29d577d3fcb2786a7f83b33874769cc0eca6a22f42ce5f843425b6f58b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsFtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "806de59645c909b34fe851933c2c800f6cb52351", + "size": 101, + "sha256": "30ef945f38e6653f3d2bed107dd3115c1f33c2a58c41867629a00b7e2317b075" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpAppServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3ce5303fedef9fbd3fedb53b278713fd8beaa72", + "size": 115, + "sha256": "88e4199458d5f069657f2e342f0cb746082961ef90da46e0f43db9af06c9bfc2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3315480647560ba616d50dfe543c9ae2a4ded4b3", + "size": 107, + "sha256": "7bf4433616a679457cc2cf4fa4c36cc43e89b0ceb1cf36a3011fac6f2ebd8dd3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9a6ec9bad6e4a7cb6a0368a15d8a3b6a40277ed0", + "size": 105, + "sha256": "57e3e9730b65a70a562e04f81abe885eb69a040f58d60491bba44750f2b848d4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsHttpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8ef352bbea18208bb424a299ca89c94788b0577f", + "size": 103, + "sha256": "4b809092149eb05201515dfe40e1f5d042dbc0bbd24eab2f74d92ffaf05adbd6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIcmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "090e84ff9617f3bfdcc024be92b794c988ed4b94", + "size": 97, + "sha256": "dcef24718eca686ed66228d4601f9f676ff61ffcef2f856910f574962cac9bf2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsIpStreamLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "15065767730cca91b9ab00d9c0748d0095ef013f", + "size": 110, + "sha256": "57e6475e2905de258ec2f09d090a024a5b832bf5818e7c8b1d7718f4cf3efcae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMailQueue.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5ce41c075d03a69d1017864c979afb97766ad24c", + "size": 106, + "sha256": "c8ce985d6bbe37b66b58bec9b3bb9d968b310fbec85d75e651bfbad91e62effd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMsSslUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0073bcd727e2868f6ca51b5873ac3c385f9b17cc", + "size": 109, + "sha256": "39bbfb6e7655c3e726b59689e2dcfde794fc82414df548958a2f700b9c792072" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartFtpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5f41fbe168c02b9c057ae5bc50c593020a0f9899", + "size": 133, + "sha256": "3e5aad4729fad2f318a474a0c0181cb1c30d2f358ba7a2929c58e68ebb32397d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsMultipartHttpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4a008667dd34943437af5a829deecb4358d61348", + "size": 135, + "sha256": "62a32da064ee05e37f074d6396800d78af12ef95d5e4e7a34ad5f4d9ccc42a2b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsNntpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70f4bbca0222d1fdbadb82234a4fdab83ad1fe02", + "size": 103, + "sha256": "7f8842eefa5320fde9e6f4babe616dedf184ea5e412afcee4a8b73efce960ac5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPing.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c185ef0902ddb8c10b59d547ad0c7e05fa9ff2d4", + "size": 97, + "sha256": "6aa1a9e3b15be8ecc3d24e907c09f564a8d5afd4ae8f22c58ba09e48ffc350ab" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsPop3Prot.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e0d387683ab5d3109b3be58386f782d36ef4b917", + "size": 105, + "sha256": "04f9fc4198c3d189351089f1940cee0feffabf5662cfb1209fe27f61b5024947" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsProxy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "40dbd443d79bb27c591526bc3383b039b1dfdadd", + "size": 99, + "sha256": "4eb8dc78ed64bf150a0d7d3e486cbef17695d054c02f63a6ab9314235e55c8d7" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89c634c62fa331afb5467b7734ef9d023f79d55d", + "size": 95, + "sha256": "6a97679f6f68f34fd07a9dc7db6b08b5d890ce7562e9a5ab8675436ac60076d9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSmtpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab168ec7a4924a06e6edc785d7408d5a67ba7c1e", + "size": 105, + "sha256": "461b5fba763c52b41900d1f7b0c9787ac2ae3ffe4afd69152e294a1b90b0c7ed" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSntp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dce5d10cd5f276eeaf47c28dd225ece609020b02", + "size": 96, + "sha256": "ce759a79460c5c120ad69198b4161d3fc2a3d4b069f75550540d7c3ed2fe1d92" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSocketUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3aff4c795302a7e9340690c909a27dcad3a3ae46", + "size": 111, + "sha256": "b4062aed60e921f5f88072a41d35b768a674743079410f6cc5009130b6952c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslHttpRest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4717920855f15348105eb05e0c32cb08ec1c6c20", + "size": 110, + "sha256": "266962ec2909e2214b89c0f153397b2422ce36d82bb3b0bdb1fb7a4aa862e27a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslJose.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74500590489e53ce41aa7559244a15f214f2a95f", + "size": 102, + "sha256": "8abf5d9dd13a2c1282fe695cf729d1a2d92411611b4d2a24e0a7285131237daa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslSessionCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6f209a0d2fea5f3632472ac7c8c7addadc7028ff", + "size": 119, + "sha256": "2a0550a29fd2fc027c678fe258727d6dc5a5aa3b46937909d4d2a9893e458407" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslThrdLock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e46b0e4a168adc07521d187fc24df1aa9c05b2b6", + "size": 111, + "sha256": "c7839ff2709acd77434d92c4edeb4021d451e769fdbcdc2cf890a10d452b1fca" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Certs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2847133f17bf056798fb512207e6a2c6649f5672", + "size": 113, + "sha256": "25f6158eaf56945485ba465590c0a94c2658a3c1d47184a0666f5c9597d5f482" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsSslX509Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8feda41cb818f3075a38674a6bc00f98c727388f", + "size": 113, + "sha256": "6dccb49302aed73c8b72d42a29adf160eb9f092c71cf3ec60ceae1036c1a4e15" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsThreadTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5db099002f83996c7a7e385f50b69e2b4ff6bb10", + "size": 111, + "sha256": "ddbc6490da6261b0ce6b9cd33e593b99eb79a79f343456d8c23c207b11378bbb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f3c72df89c9004623193f150d55a3661e4b3a450", + "size": 103, + "sha256": "68fec9883bcf87413165d90f15f2c1e31d7781348f1513fef9b62ad5a8208866" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWSocketS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c2c5de77c2624fd045943d109704f30f1e178326", + "size": 105, + "sha256": "e75def39c50a1297f2ee2522d6efe9982a09cea20ee02ab4944e62d99b463c9b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWhoisCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a8be7b2f1ae323ec09f684023e60c02e95fe4fa9", + "size": 104, + "sha256": "13a6f65a68e2a673df42ad3d30b40e43514090f672145f872c0600b723232307" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Fmx.OverbyteIcsWndControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "483384cad75eeac76af1de3549c88cc56accf95c", + "size": 109, + "sha256": "8330b0ceec0bf313d79e0da9ae90bb3ccb4718df645f49ad0a7642e78b6d1e19" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventApi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "19da15355c94dfebef7b3502486933b4b8253e1a", + "size": 2154, + "sha256": "b5a29564b440033938998414a79b9a2eef0d14eb2182572a817baad3166fb89b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.KEventTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2ccbe202c451c5a2bab6e4ca9b04deb270ccc7f6", + "size": 13625, + "sha256": "9761e21d6b1a839942345e7dd139c37524426477abeaf51aa2398f40c03b3169" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.Messages.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02a4a0d4879098422f0f870a695f1f886049d11a", + "size": 61812, + "sha256": "54b444d9e07d9d68f7d9a3ac0f5845ba3409d8247edabfb0e5f169d2faea8404" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Posix.WinTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d8a1fc1a5eb32e16a7fa14c4568388241ce0570", + "size": 2772, + "sha256": "2c598be617a37c1add99ffeec41996fa35fcb3d6e5ae58c8f520e03dcb5ae3ec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/Ics.Vcl.OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "587e6d5691c238bffb2d06ced288098729d931c8", + "size": 95, + "sha256": "20031b46870090e7f957fddf0bb45a026f9ea52bfcaffe481e555eb35ef2664e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/Ics.InterlockedApi.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/Ics.InterlockedApi.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e852d978d1bb3813e475bfea130978908be095e0", + "size": 1024, + "sha256": "c6357750de6f20581cf2cd8b23d7d9899d6b5b462e3c867b2ef4df45e3eb3802" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDefs.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDefs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3d7bde881e13ef54deeb2f2bfa2e0176b6a4e0d8", + "size": 44239, + "sha256": "3d330ca9013f9181919c6cd4c59322b95cd23c9fbe1c3ba4db1c6760211a8680" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockImpl.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockImpl.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "306ef49afd6c02c2eea783cf80a10dc97eb74782", + "size": 4549, + "sha256": "fcc0e71a0545f69ffa84577793c7702bf8b1ad3b01a1ca1341c58a6b7c226531" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockTypes.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsDotNetSockTypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbc3d820a0c76c0bd175f4f8f4feba4697605cce", + "size": 17095, + "sha256": "11731c2902e1bf9e2571494caea2f70241222c30b54a8f17079ba9a2f397835d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsSslDefs.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsSslDefs.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d88074d08917f887d7ba468d9dbb5c0dcfcb21d6", + "size": 2568, + "sha256": "3189696f3f54746eb2b27aa8f3a689bd2a6e13429ee5fad818c318a0f525ac2b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockImpl.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockImpl.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "abe7885b7b71f00397c0c8f84958293f71b7de42", + "size": 60393, + "sha256": "7c56dc22fde946b3937f446a3a3167c18a366c95748bbf1d4a0fb07c33326f6d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockTypes.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsWinsockTypes.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6462fcdb320a24731d9cfe1a7b5beaa7194720ce", + "size": 64808, + "sha256": "7ee9adcf09c3f8b7b8c96cc1860a7215a36da185b25a2b05baa8301d2046b790" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsZlib.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteIcsZlib.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3cad555c3b100ba0f9a326b2870eaf63dd0fcd37", + "size": 120, + "sha256": "a170a6f6a60f1a800723fda3edcbb35732b65ead1e35d059a75b3dbdb00db83a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteVclZip.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/Include/OverbyteVclZip.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da296926b0f155068e9abf8c5bf8ed621716f5c5", + "size": 142, + "sha256": "ed445dad561b225619d3cf65364d9a0b6ab58de0c1eecea872ff121b98d2e90a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "57bc81993ed75ec508c591ef681a50637d20ba64", + "size": 27796, + "sha256": "b4aae854cda922511c9ee40401d1da019d9bf782d75ecf74e7c070a4123f6ee9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsFtpSrvWT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3eb40efb769cfe00c8a5c28745f45e83d9c29bec", + "size": 31566, + "sha256": "1ac0904100394efb8635255b260b8bd7069f330c76255f6c992911cbde55a105" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverByteIcsWSocketE.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de81771a8495bb856300919d80613bfced65a6c4", + "size": 6058, + "sha256": "663d1a2a59957c1d9b313c694a51df203efcc0b7134952fbfa057247b4057639" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAsn1Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75fae4a7c12ace41646bdda6fb9fa316a454ec73", + "size": 16913, + "sha256": "9b6a526fd0e2c0c21a4a6493a658d237bd955e8442a199741a5d5e1569f58d4e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsAvlTrees.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6c8517a4938a713b4eba5982a042b73468d046a1", + "size": 62319, + "sha256": "a5e0afa738faccd93c8f6cde79d3dff4d4e5ff16c763ca4f4e24222cbf2f8420" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsBlacklist.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb232d92feac65eb114d3ba36dd2ef7d098b79f1", + "size": 49267, + "sha256": "9cfb9385636bccb51b07ddcfc6ab571af60595620dd09872c83d35fa26102dec" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCRC.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e313e721a1f6f8b91e2df02773df8d007d819004", + "size": 20638, + "sha256": "dcb7e1c1eb44dbcbc156ac9d66448f4984150751849efd72b54a47f5852b4d86" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetComboBox.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1cccb1beee43cd354766d70e7f01b68f434d3f97", + "size": 11911, + "sha256": "87375aaa6a1e6ec704c961321f0344f5d502d6994fec95778a401e5e4cc7d997" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCharsetUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bf73e102c7d1419da763814439aaf2f7ff7f5d3a", + "size": 78509, + "sha256": "8c505402759e73c6950db2bd13f6ca2e743ed1f7ece18087a5d553fc95c0c80d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCookies.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b78c3609bd69371903e792b92d7c80c41b9cd30", + "size": 24978, + "sha256": "8aa0dcd2e46b5ba615050b6b05d096a3b1c1df60ca93069c673c42c0e5a1393c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCryptUiApi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0dfe224bd4557119b27d4065e5432d60a0e42563", + "size": 60260, + "sha256": "bf3243d9ea619459e0475715d0b61522f0e26d41414c8b21283abbb2193000a4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsCsc.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9e0d60240615cf396d8ec16d01ea50ad8fe12d0", + "size": 62829, + "sha256": "790d67557de9c21ec81874395d7e29f600e125221c776c99216397625052550e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDES.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3cf1a9b48d6440bd4fe83548d3c1ae68673e7459", + "size": 13751, + "sha256": "8643607e63d0de1d91460746524f1b9ecb353f5d9cef7f28e9bd5c6501b0300b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDigestAuth.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "344cd190beddb4d0f13e28e578f21ba86134a6ba", + "size": 27835, + "sha256": "acd76073ccba130040575f570480dfc0b09af328a2d5077c2e3eda10a9f64174" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDnsQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "433eac4ea0f703f36f3068cca373eb772c6b2432", + "size": 61995, + "sha256": "60e0f29f471a0039ab9bda6b42fdb0a87abb182465653a49c1bc4b27d6a633d3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsDprUpdFix.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "eb528b0fee49a5ad5c156f8c17ca78493fe94a83", + "size": 20131, + "sha256": "6d7b6a65379613376cd2dd6a017acf55e42c601f4669f1498ba553a61bcbfcbd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsEmulVT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb288eae0f3a75b66fd7740e8ccda57cc57cd228", + "size": 168473, + "sha256": "acba058692a6ddf1d4246a0695070124ee754b082d376fcdeba5edba0d51af6d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5f7f35ec71a45b292e04ad19652cce68fe50025", + "size": 132455, + "sha256": "3936d4cec42ee7f27f7f397c138e9d1acabdb75329b9d25fd1bbb450134d73b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFileCopyW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c7589daf92a727ad1186f7f837160a77e1ee22f0", + "size": 126472, + "sha256": "230b46da8dc426b33fa2c657a1354720d0ba46f81729d4d0c7978b98ba374184" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFingCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ef33bc63b57e1559b87a0333cda0801454f51c7", + "size": 8908, + "sha256": "13d2851c095da4be09f75e97b19516756a14820ddcd5dea951ce67f2572d0116" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFormDataDecoder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3fc505286b3e8dbcc2a080c526b02b044809f06b", + "size": 73723, + "sha256": "6a4674c2aaebd2159ff8ded98c0698e28c0bbc263127b763aa5296d88d3711a2" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa153c27f9e3d51198dd4d5aa3d0b280b44720d6", + "size": 295204, + "sha256": "2fd0f08d579014a84f1a5a00a97c62524aacd8d67c7057f0cdbb01d6cec7e877" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpCliW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d7f4be83e9e6d775370b98bf8f68c2a100349f3", + "size": 291023, + "sha256": "f5b69fa2e2b1e239db7cd3c5815a01a2f4527d5e4eff2ce5e45466c669141504" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4c9afa860b1519a9d5b53b629dc56aac9563aa81", + "size": 266425, + "sha256": "0959dadef883d7adc021d5f1d06ffa957b3f70cf9b49c91d709a29ddba6100d8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpMultiW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14467800c418784148e0bc894a878ba7078b3ea0", + "size": 271022, + "sha256": "c62b513334484bec24cd1474dd1a58cf1e108bd9c61d2369fc64dca321e07ffa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b6dbbefc17a7dbb11814dd2dfb0d2c28171a207b", + "size": 405131, + "sha256": "cbfc639452178e3f830ed989305cfcde7d7d56443e3f027f53cc9de3aaa8f791" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsFtpSrvW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e3c39592b0beb4c400797a5f3be55a84e976044e", + "size": 399437, + "sha256": "5a831104f822951faebc32f1f8f3ab6320cf47c86ce3a0a4ec17de7eafe3e931" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHtmlPars.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e4a18b5feef04ec934906ccfbaf3893a1c75b3f6", + "size": 19123, + "sha256": "17ac97f685024dc28ed3a0300f3d21f7fa4201ddc392b747f090fbdfce17a0ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpAppServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "35e54af2f33f0d1048b9ad3816f66b2114bf1ed3", + "size": 76830, + "sha256": "a14deb90138af6e5c42c5f9f96becbf2e8c693bef5430d97a045b98e306648c3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpCCodZLib.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2992b31c839e33cb32976b9aa5bfa47b64af81f8", + "size": 3442, + "sha256": "7ace47da9c4fe87841f9f2ddad8ef280a7306dbea8628d99b8ad48c021fc90d0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpContCod.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5500f0a91a54e9a2ea9e1fa473aca61e85532fae", + "size": 22119, + "sha256": "13aefd2775ec10f55ff09ca494232c35798f360b50e4728e23128e9bf00997e3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMulti.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62922a463482cb97927df7f7fdc022814cee5737", + "size": 66202, + "sha256": "03017368fc03bce13485b6a23a857f0a7caab3d8cee74fe6ec7943b82296e08f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpMultiW.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e2085d0ec258ac70aa079588c7c53b64a42b5445", + "size": 66671, + "sha256": "be6faf61c70a51667673b5ce1c9621c17305ebcd57e2f8b753002a9062c5e041" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07b24a7faac734b5535a56723d6f3021f2424a27", + "size": 231930, + "sha256": "4fd72cadbc9969de17b275caf5c502e85cd2ea179a2a44a108eee080f1033bc3" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsHttpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f9ccbb7977e70cad05936480f76fdedaafd13516", + "size": 304775, + "sha256": "9067c6a0343615fd5438481897f228b3523b4befb0555cf27d11ff879475b960" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIcmp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "36e960afcac51116fab75c4706b12426ba4fced3", + "size": 44732, + "sha256": "165a14b32c8fb978fd46ddf501347fb3986233b5d627dbf7d7aac5c5fd0c749f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIconv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be70dc40b7124070305405f75b016fdc00fd8c16", + "size": 4700, + "sha256": "6fe74b31302a7a641f78fda0a47f304185c7d3c158918a5d558403f5f859c7e6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIniFiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afbabb6f78053d22bcab32d2d3a4cdb6d86b28ca", + "size": 19225, + "sha256": "d5a0528351345640893799e202b5066e1da0573e60d2c4f7a392090ea78a982b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsIpStreamLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80b1323946fc759ceea7922fe7f2a2ffad9ee616", + "size": 130903, + "sha256": "74f16cd4f578374290c4867fd95d9c92db5a8fb31b3d925316ec5c9ab304c5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsJwaWinCrypt.inc", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsJwaWinCrypt.inc", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d7fe6b7998052596240a619e04c89cd240b1adf", + "size": 759982, + "sha256": "5c0853d44eca11697d13377106a264a8639a8713a332821ebe39ddba72e0a683" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLIBEAY.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7021eb7501ffba8a7e0cad5418d8f2d6fe0351d2", + "size": 286507, + "sha256": "15688901949f9582c0488b19589f67ecd80930825b4325f939e7f8b860704ffc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLibeayEx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e3de0110e8203ee2d88ef35f849372e73209f3b", + "size": 24138, + "sha256": "ebdf395fbda417a6ede38318cced22c8d8744dd2105ddd684932977a989f7d13" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsLogger.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cefeca803355d42f84b87846f5d2259731b9327d", + "size": 16286, + "sha256": "db07176659770505ea8b92c6b41689f7655e970ed2e0bc26c791657d251f4c5c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD4.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9094ad6f0791fdfed24cd0a8502209a8d11a0f9", + "size": 16143, + "sha256": "bb337ee799e48738a0050b00451c7666e3b30d0148d10ee0ef6cecca90834531" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMD5.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "29da8be299d5ff4160e41b1627fdb15cd32a79f6", + "size": 36854, + "sha256": "58487efd63675f3a122f023b2f25d74f43e7e290f36c8e180713f58ad881c757" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMLang.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9127e9bfa4d195c7ef6a3aab2fd8d7653af2afb7", + "size": 7267, + "sha256": "a3d3e2f79fe8d31b0bbd3c1ef2c908d46cc119639550acce4cda5cf551c72b90" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMailQueue.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a16c2695762cbb5c929e9b9481bfa71f6aa690c6", + "size": 100197, + "sha256": "3dd9573c163f1cc64db6bdef216c89701423154e59d7d5df916c245b52c22a55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeDec.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "595f93d9c0de5ab42d21ce881e6b7da4d75bcf56", + "size": 104014, + "sha256": "f9352e1cb2ed6ef15cc3573bf3d1bc5280577a3f0c357c3984198631f719f1b9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMimeUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "af0539ff24c367c34b206e3e52cc5f40cf56c779", + "size": 112184, + "sha256": "49709b3a055b214be38ab497f451fd61aad4614dba742ac23600bb5781df37b4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMsSslUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e11564bd2e45e95d211b7ad59b8b64fb9c0369e8", + "size": 26145, + "sha256": "a2d515d80e9f6a87abbe11d7b925a710d1efbff051ebf49c35b8ae7fdef3fb7b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultiProgressBar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e4b54eb2e0a7fb5924f01fe92f1b053b05d2d8e", + "size": 6977, + "sha256": "bdd1d592dc0c44ed3475705d8c4381ea36ba0370c0f07c3cba5936a876c7152b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartFtpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4b670370dec06891bfba7db705b60d47700d8e2a", + "size": 40309, + "sha256": "a6b91250dcb438290476d0e15192341555d230a8dd1f74fdfee848dd4f9a4e55" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsMultipartHttpDownloader.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab202e0927681a028584015c26c1394598b8581a", + "size": 33184, + "sha256": "46a68caf1bfe2f6659380c88db391583b68861666b835af3ceb1b3652e56e5f0" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNntpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "998d540a4b57af022dd8e83c9aa9275dbc61f45c", + "size": 72059, + "sha256": "8bc3d85087bb226b5b425fd21c08be3c760a2a2762a61c647180e0b1a39054ac" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmMsgs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f5bb8f7264f25c648b325ece6a5f57b971f28cc", + "size": 42187, + "sha256": "4d4a5ca9433fc8c4fdfca91a76c7d5493860d79a526bf2b9d9e39b5f3ff2dd79" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsNtlmSsp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ed74c46af05cfcaa2b3b6b71c8ec52717183a235", + "size": 31775, + "sha256": "2f89bbaa1b3af26c72840623733c8a04a90ef8b2c2902fd2155529a875ed02fc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsOneTimePw.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e4072bb8d8ea5bc70c7ff111c5d132521b61f87", + "size": 37714, + "sha256": "5e81578f5bf5cb07b8fd007158ae4a270f8088838410038211803324f00f53ff" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPing.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5e691011a9a76bfbd3721edc678840f2b42655a", + "size": 26753, + "sha256": "3630bb13c10652ff0c67bd3ec598d793e72f8b9406274f8290ec5c8f65f1063c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsPop3Prot.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d10499fbdfcfa02809932e4fec9b1cdb1d9c0f9", + "size": 105942, + "sha256": "effcbf293a5ba7b4cdc10e41a13430cb0e5e8c0453c12347cbebba472b862309" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsProxy.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1587a6056400334c0864874fe1107136ccb160a5", + "size": 200278, + "sha256": "41375081bbf51c3f025782c449c4814c157cd5c51697fbffad682fa1b31c0ddc" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsReg.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8d8b2fb3ed16e8dc46d1c997f084b36ee07f8d5c", + "size": 11275, + "sha256": "a45c33d1313f5af09647a3c22f10749103b1960c9095a9b66ca74bc5e7a7beb9" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSSLEAY.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0c16d41b2db0be31810ed106bff464b55e40c04b", + "size": 160309, + "sha256": "6625ec077abe4f1f85a3e056c77e5e7a543d4fcf00692b41a3fcef19178db557" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSha1.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84c506b0c23682a0498a2d730ee94356474f1a17", + "size": 21639, + "sha256": "d1cefe3477b5c36780cf07eebcff263d59ed449da25ee605d4f625be413f1ea4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpProt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f94b43d702b13a1b4cc18980b9e6b7cf18ec03b8", + "size": 235024, + "sha256": "b2de10d146d93675c3a346a0265501879fbf3fb883ddfc95a50f86a8b2e5e1f8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSmtpSrv.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3c64b94966319546623f854cbe8c9c4694fc65d0", + "size": 126409, + "sha256": "1a03c27d6e8b1b6c29087be8e7a9818304a456ca863407c9dd09cbbd9a3fe7eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28a53d56b7dc8b7a0aaf56bd6d2d29d4972e9739", + "size": 19332, + "sha256": "d8ac74e074546862e6d8ee6fddf64a1b883937a723456d8bd8336c5a7a0c547d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSnmpMsgs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "237f1b30ac95a54ce4c487edfbaeb7cc73ae4b1e", + "size": 35052, + "sha256": "5add545ac759ebe2f3a2cbbfc37467c126e34c90c44e4c518e080f83c5f92cae" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSntp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75cba21f0ce3f84c83fd51634bc131debc403405", + "size": 37048, + "sha256": "57e1b326d8ef48e9f8159c48fc612163080145d9485080b736df864de8ea350c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSocketUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7022ae0dbe50e6ec8fb77794c4ff943c34b253aa", + "size": 20770, + "sha256": "28603f6c1127be61eca842fd4daf9a8f4095f3440ba8f77425d414ecb51717fd" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslHttpRest.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "071d8a42a9c841c6411b6c98961df87ae847458c", + "size": 131387, + "sha256": "3468e31114d94eb728a9b470f0805427dd72e2e7631f7eb8e3dba05acbd1d79f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslJose.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "904b7156db8079e87a189dac9ed06896e2b997d6", + "size": 42353, + "sha256": "05d3079526333b21bb54fdd036d0841ae0c1ff141dcb9a48f183d0d637f0200d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslSessionCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb195e93074d64549419cab051cef65ab6bc1b00", + "size": 26726, + "sha256": "40b1fe2f3d3ae867390c32acdab66a4398f8da6d69598376199e744783c8a76e" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslThrdLock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1c1adf04503dac847c1a7d79675d85a8ab65b7e6", + "size": 11955, + "sha256": "486b4beab20a9d32839c9b1937fea0e5f8ac9362b8b594e5389799b75e0d851f" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Certs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "220e82e89e51b74d387b99eb97623ab858c783e2", + "size": 358321, + "sha256": "029a4121eff064feebb568d7447a46e5427521b345f859ef76d868ca82594149" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSslX509Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "846063a451cb6c664eb199afe22589b2ff0ca94d", + "size": 208485, + "sha256": "452e1a5b7b58885b233fd57de613e9b644a70716238be879fac884e5796f8573" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSspi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5a281d9203228065da7b2dc8e686ba24c1e9272", + "size": 29553, + "sha256": "ba0c08245217978c754ef93900a2e61ae356b1e7ea883ef9dcdf46fde9864f84" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsStreams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df2c7acd2891c94844b4f628c40ce73dfbdd814d", + "size": 98741, + "sha256": "d60f5d374e23e2215359e16ae976d6ba932ce069ae8e626e9575942fba83b6e5" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperObject.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ecb68649aa16c689eb0eb59936943a617ce5dab", + "size": 178996, + "sha256": "f3219c222311174df983f268964973b24a7e534b7331df12eb8decec5ce15198" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSuperXMLParser.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ae36a4454957d604ad64ba7e50b38987034a1ab4", + "size": 47192, + "sha256": "89315f9876432b97a9e7356f8fdacaab200cb64e681104fef39aa0db1c00194d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "45242ac99c11f996be49c5568604c18597449328", + "size": 9736, + "sha256": "43b8fd54f9546d30a8d46da870d7ef857734c3e46ee5c1abb97797a76ef98883" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogDefs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "caf0f861dbe5a5116dfa8224742b6af68edcbe78", + "size": 6054, + "sha256": "ac3132ccd9912d229fcddd747e40ae73e86187b64658d83761d2fdb742ac375d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsSysLogServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fdb41f313a48af2454130eb58263b7e0394a50d9", + "size": 30575, + "sha256": "d40fae9d684fd1af34db166a98bf4787258c929bf373523ef67f1fbeb07e2101" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsThreadTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a1a94be57583cec0d9f6bebe6f8feeaefb2dacc6", + "size": 19769, + "sha256": "6c6afe4f04fd1f8742a4e307484dead98346c13b3d9337e0808d78557218b6c6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTicks64.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64b9016bca2ac47f18fe9f92e60ea01243820e3f", + "size": 16311, + "sha256": "a378177382dbc86634dd12301f80b78f9c4879dd02c34000b0b4640ae5107ef6" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTimeList.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3fe29f0e1467454a299c7b4c588d38b9fa6a5d06", + "size": 12918, + "sha256": "b7c7ab819390160a31853bbce4e08cd01579b442df8bb128a582794b4a3118c8" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnCnx.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ef8d73396ab51a60dbc57f886c54d305fc87878c", + "size": 27884, + "sha256": "87ef16537df829b90443667622495a4f3e6dcd433408f54b87de524eb7afc197" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnEmulVT.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd78ffebc578e5fc330ba409377662838d25a7f9", + "size": 32997, + "sha256": "ff1b2d3778643be10b7cbaf5e1066af73431345d4ac3ba505418074997928653" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnOptFrm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "839184ebc9e2ba3bcfb213f009254a67ab6079a3", + "size": 19298, + "sha256": "931c7144bfe8d4ae18c8b81d7e3328a3f7c62dc2d4bcf6e2f059b5d4c89a9bdf" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTnScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab38fcd7ff44775d1d3d1352e6fa2b58490a93bd", + "size": 22627, + "sha256": "8d301cb6a919e314f98c7607b8d51c0bc27f8ceb90e0ff7f131ac9243f2bb5aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "274777d4a87b1c0502023ae6e0f592385e7badc4", + "size": 4866, + "sha256": "6e46708c64121104dee351decac07d58ec5426573742965075df17ac530ea9eb" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUrl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "26bf0b6df02b171af06a7738656697dc70b02fca", + "size": 15956, + "sha256": "7d248cb1292253dc0d66b0f56f6d26a645b56ca5ebd3ca09cd5216e9d8438f3c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3dc05b5787e17389cdec211e367dceb371973432", + "size": 273868, + "sha256": "2257bf867c778ada2912c774727f88999f075a24553e22b480f4c7165ba2a62c" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSockBuf.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "11c5e187d0f7a7f6fc5a18cab40be2098ac2f287", + "size": 19014, + "sha256": "f76530186c4284d6c900bddda9ca36facfc027a664adbe989b713ccf63291c1d" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e947c721434131e1f99c3dfdd62be1bdfc813ebe", + "size": 998558, + "sha256": "b6d725ad6c842d7b959fbe7806fdcdd574e9a275ce1a040cf8eee2e17d6aa995" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "41fdeab1932702b68f0d30a694251dce432db88b", + "size": 182216, + "sha256": "5f922c45ed0318bf2f8f6df4f147cc31b3a721a79aa3d5e619fa9cd0f255f36a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWSocketTS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3946a6818e9b9d2a5d3908a66aa811fc75f0e962", + "size": 33791, + "sha256": "3bdc0bc3ef602f14e631fa3f489063064f859f0561c9ce4c0bee67c8a42e0631" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSession.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "178c6ad1ace955169962240c5a4788b53c4894a3", + "size": 38197, + "sha256": "96d1d3ca97a83b354349e211011548a6c6ed94f9282c8ac359a05f50b7dfd8aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWebSockets.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4bdf7ce39b88edcde1fd22e99bfdfe3aada104e1", + "size": 43367, + "sha256": "3a9efc509d9e37bf3f639e41881c89ef556400e6368877ccc45b0fab741f517b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWhoisCli.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "321d735a8bbb2e4c0c0d2127c9495cd900f846b4", + "size": 24982, + "sha256": "9b886e915f8e2b1df527b4ca5631b9d1db87c8564361c9e6073cf6c32fbaf958" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinCrypt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6acfc4060332803221c6bcfb5465fd025c287d4d", + "size": 1875, + "sha256": "10c68020813071d15e8e4a9e46a88cd4d272c623da9b0be4ce272cf073d5bd47" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinnls.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6c8ce0770e3361ffa2e5976394aa0222a40ac5a", + "size": 2887, + "sha256": "a8294bddc54129f3e60fadb7226641df86f487e5d8a56a3fca1c066a004abcc4" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWinsock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9af2485bc0008cc1e40ab282ad45ebfd82751c54", + "size": 3105, + "sha256": "bd23e45e963fcfc99b25a045ae86c2fb0d5889ce1b4b30f0f449f73d83c8904b" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWmi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e1a17dfc9af1854a191bbaf982691305c5542a5", + "size": 52766, + "sha256": "f5d91fb576059bdfc8acee81c10906dc79e66d4ab09c203a2de354ae4f86227a" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsWndControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a553a161c4c5fdfc7931cf5d9482cb6d45a686f8", + "size": 54415, + "sha256": "6d9506866e043fa89ea468926f3f9f755379e105171a6dcd93ad99d4cd868574" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibDll.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e14801f62fe4a5d33c032284b303274250c68b9", + "size": 49350, + "sha256": "035484e15dea85575dd84bfa029b3489323813042e7d31dfe3e6f717e8e3a7aa" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZLibObj.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9f0e67f8c0e56745d03d9311dda98324a79fbc0c", + "size": 24535, + "sha256": "7e92825530ef236fbb573f6f31a987cfe373403ffbef798afd5a3efb7ef69af1" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/OverbyteIcsZlibHigh.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7a8c062e98ab3b1ed55719fe9c48497fb50d28d6", + "size": 16261, + "sha256": "be45cf073b461d50eb48fbc60b1d431a3824f72a8e9837ef3e3ff2cb2706f466" + }, + { + "path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "remote_path": "src/ext/Overbyte ICS 8/Source/WbemScripting_TLB.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3502d630c0101104f78ccbad71020b1a1da8690b", + "size": 197378, + "sha256": "3e45ed1dc8d27c98528fc31d686b4222db2771fe9c0c14a3dafd030bed1734ec" + }, + { + "path": "src/ext/PolyTriangulate.pas", + "remote_path": "src/ext/PolyTriangulate.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0eb9c182eddc5e6395ab9f589630a5d0fe9a39de", + "size": 6729, + "sha256": "380336f351e463e5607595d48b98d8916e7d14d0e94df2bd7c531c47b92f9077" + }, + { + "path": "src/ext/SciZipFile.pas", + "remote_path": "src/ext/SciZipFile.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7414f90611e3326507b9b0f05709b1009525b745", + "size": 18445, + "sha256": "e39beaecf1b7174a3774964d173ec80f25f5ef6c036c3a32a914a854cc8f263a" + }, + { + "path": "src/ext/URLUtils.pas", + "remote_path": "src/ext/URLUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fd2830ea4aa35a2914e155e9b2f601a78594ecf", + "size": 6732, + "sha256": "3bce1126a2b8547aca95c366babfa9db145922e4b6576da0948bbefc5c146d9e" + }, + { + "path": "src/ext/Unit_Vector.pas", + "remote_path": "src/ext/Unit_Vector.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be148b7895831909886ee03ba14f3371dbf81f94", + "size": 4308, + "sha256": "b88682b36d965bdb2951c3dea1cd587fde44e7055dd05188c6c4cc4cd62cbaa9" + }, + { + "path": "src/ext/VerySimpleXML.pas", + "remote_path": "src/ext/VerySimpleXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7c20b95c2f271cb2ce8d1c1ee3c5a4cce9541513", + "size": 16766, + "sha256": "3b153f03089fbb90f157528347f3cf60c0971f8df13815880189157f3abd8a4b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Accessibility.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2e7b403a690bcef3c3b501352e28c8b0b0a41b3b", + "size": 30775, + "sha256": "234607f0027f9c8ebbf637c256c69c818e1d1576ae96435e9396d8e183ae556b" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.AccessibilityFactory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "308fcb61a57e0880f970abb4887ea90b3921b519", + "size": 6324, + "sha256": "43d95802b43dfa2bfb035009f80d74b824fcec5b2cd4961907120059378ee2db" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Actions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "03f06576ea653e0e507e0851c72b5b2aad333c1a", + "size": 9061, + "sha256": "1b9e32c4419d5cf4fd668d13303a04a68006c42febdde601d0944f8de4714feb" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Classes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d73b1585f8d3c372d16c9688f969ffd689ef8d3e", + "size": 6336, + "sha256": "f07cffcd7e54d70b406f15a71456b8de6247527768e814907a5a8d4be5139e6c" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.ClipBoard.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c337e9ce37e67e29bdd123bb374163eba4046f3b", + "size": 13891, + "sha256": "1030f597d856414eb4c480a2ccbdb72aac23c61ff18919e173c4c0bed95f0705" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Export.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7b8edf297c2711c8fa1a12df503ff0dfed4a6c37", + "size": 36746, + "sha256": "8a236c433d684953743e3a4539b3c4db7d171390c6f39a918f9980c83dd79aea" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.HeaderPopup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9905ef6d3b1a25c7de353d2320f8efcd2212c06b", + "size": 10231, + "sha256": "5098dd30ed2cc428eec6f1677eb6e07a6d85e41b0ffd651e87e95f17318343f1" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.StyleHooks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14f5c872a3b50683b337dd5ee56ad99548a061d8", + "size": 29376, + "sha256": "7b2d726107c6c18dd99b9dbe58374ee14533a0af91ffb11e01ea7cbe53fdd92e" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8b1a88e39eb30be51621746cf884a448ee351999", + "size": 53581, + "sha256": "8854a85f819714f19b12d4c468d03fbf19d350d169b7948b4e6469a1d4889c47" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.WorkerThread.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8516390f5704a53d03ef583387c2c83221cadf11", + "size": 6877, + "sha256": "3c6ea29dd509c57505d0fd3e7c50d210adce1536f9da1f5b8c8b9f6220cfe8d7" + }, + { + "path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "remote_path": "src/ext/Virtual-TreeView/Source/VirtualTrees.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9094cf731d5e78b41ab6da94f4b4db852a36db65", + "size": 1305421, + "sha256": "3d58b35ae7eaa827d3bc77b3a2e299bb2342e98e4444419df0e089bf8b38c095" + }, + { + "path": "src/ext/Xml.VerySimple.pas", + "remote_path": "src/ext/Xml.VerySimple.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fffcc36024452b1d58d75b6734005fc277729833", + "size": 53569, + "sha256": "279aef72202d42e52a4c10612ef7b194f7154d8c777f5113444c3f3f550cccce" + }, + { + "path": "src/ext/Zippit.pas", + "remote_path": "src/ext/Zippit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "453a71a415ac8486a8003619b2d08469ab89ef8b", + "size": 2936, + "sha256": "0386df013372cfe0e92b374167c450e7f9d0c558449739863595757f968fa45f" + }, + { + "path": "src/ext/bass.pas", + "remote_path": "src/ext/bass.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "edf4683c292a1a286cf42395b2452da516c682f7", + "size": 41826, + "sha256": "b740ea36fb588093af6b22b2ab33eb3e29e33c28ded1856bde4e4acc2a08fbd7" + }, + { + "path": "src/ext/dglOpenGL.pas", + "remote_path": "src/ext/dglOpenGL.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fd73e5561ad288dc4433031546814c505a845e1b", + "size": 951621, + "sha256": "b9b08703333fc2172389dcd956c12a595bc50cf783824233f516faf60c17def4" + }, + { + "path": "src/ext/iaWin.NameDelphiThreads.pas", + "remote_path": "src/ext/iaWin.NameDelphiThreads.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb1593700f70efeaf94e1e242721709472a3fc30", + "size": 2190, + "sha256": "889d02153be5dac1b9d4e5aa3e8e9161eb522a8c86c8295e291f2ffb8a55b1b1" + }, + { + "path": "src/ext/libZPlay.pas", + "remote_path": "src/ext/libZPlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d57ed839767df0535e711722cc172b7d18c00d6", + "size": 65704, + "sha256": "0865f4bca9fdf885585deb164fe87bf2f5252f38649dffba998863cca18ca40e" + }, + { + "path": "src/ext/openal.pas", + "remote_path": "src/ext/openal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9765cad44380dda71b7351b992aee59395251492", + "size": 90857, + "sha256": "74911dc018e4b2672e983af7b45706a65ab9ca890c708cc2dfead0f74f0acd06" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting.pas", + "remote_path": "Addon/DataAbstract/DataAbstract_Scripting.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "00e57197bc916e0102ef012a1e3840c7cf5093a1", + "size": 507, + "sha256": "a13056931df7a40bf08a8beeef53684083199dd25234bc4bcae28c97fe84f7d6" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/DataAbstract_Scripting_Reg.pas", + "remote_path": "Addon/DataAbstract/DataAbstract_Scripting_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "229cdae58d6b3edafb52a0ffa88ca5625f1243ff", + "size": 978, + "sha256": "78e52813c56c4afaeb05628edea1a1c6a835ff84ad2cac033b1736c9400e6bcb" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPSScriptingProvider.pas", + "remote_path": "Addon/DataAbstract/uDAPSScriptingProvider.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "51035c7738a4a519e523a57226e02d7c3cababae", + "size": 8153, + "sha256": "818323c63a63f0f0022b064b23341ff72bbfc73b757e6a0b4d3199bc2329632d" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/DataAbstract/uDAPascalScript.pas", + "remote_path": "Addon/DataAbstract/uDAPascalScript.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9c39c40c35f269c633ffe0b54fb0ac8079c5144b", + "size": 70025, + "sha256": "c4760d042df751c1a0492ed7e7dff14a4876344723f176853986a55e752c0829" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/PascalScript_RO_Reg.pas", + "remote_path": "Addon/RemObjects SDK/PascalScript_RO_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5cbd63aac19c9636e47040d11d22b6fbb38565c8", + "size": 709, + "sha256": "01c18202d532e459ce8033780c056c37ee793c942beaf45e78501c03cbb13949" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSImports.pas", + "remote_path": "Addon/RemObjects SDK/uROPSImports.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "adbf14de4e76c4902b4be510feb74fdf5a0fff7b", + "size": 16323, + "sha256": "2b80e21f5c803fc2495f5fb90126080ef50019c1f0abb7f4386481a2ff37a4a1" + }, + { + "path": "src/ext/pascalscript_submodule/Addon/RemObjects SDK/uROPSServerLink.pas", + "remote_path": "Addon/RemObjects SDK/uROPSServerLink.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "78913f32a1fad15227b400a11d9f3db521ef7318", + "size": 43778, + "sha256": "7c5face3a6422bda459244e95ac752d1f55e6917fd1422656c8f64bb2b631f92" + }, + { + "path": "src/ext/pascalscript_submodule/LICENSE.md", + "remote_path": "LICENSE.md", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3d899f86ead380c10eef85710794e2ad2a5adeab", + "size": 1098, + "sha256": "a08799bb2385a3af99a9bbb7c746d0ad9ac7dd07be0fb1473f2f4d1dc3e11bd1" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgConfirmReplace.pas", + "remote_path": "Samples/Debug/dlgConfirmReplace.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cbbc6ca645346bda63b70ae713ce83a43c6ab8b8", + "size": 3417, + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgReplaceText.pas", + "remote_path": "Samples/Debug/dlgReplaceText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5b3942614bf41414fd87d8ba8ca3b81c74f7e906", + "size": 3731, + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/dlgSearchText.pas", + "remote_path": "Samples/Debug/dlgSearchText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c55ecb92222c583115a2c83756b944103dd7f871", + "size": 6673, + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_debugoutput.pas", + "remote_path": "Samples/Debug/ide_debugoutput.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c25a91b8ec93382847142a40797aa19979abe0cf", + "size": 580, + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/ide_editor.pas", + "remote_path": "Samples/Debug/ide_editor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0179a3daeab6d9a6c0316068a18831941ad89c07", + "size": 17361, + "sha256": "bf5b1bb780ab705c2690a52bb78e7e99c6bfd65a9344a34fdff296d0309976fa" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Debug/uFrmGotoLine.pas", + "remote_path": "Samples/Debug/uFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgConfirmReplace.pas", + "remote_path": "Samples/IDE/dlgConfirmReplace.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cbbc6ca645346bda63b70ae713ce83a43c6ab8b8", + "size": 3417, + "sha256": "55353485401bc9a7a28e27815670c35b6abdc09cf07ae2d4c5baa18ca9abb665" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgReplaceText.pas", + "remote_path": "Samples/IDE/dlgReplaceText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5b3942614bf41414fd87d8ba8ca3b81c74f7e906", + "size": 3731, + "sha256": "0b6fdf4d138a5fc864866d5bee6aaf97070bf04ead75320981563e34ed7c9810" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/dlgSearchText.pas", + "remote_path": "Samples/IDE/dlgSearchText.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c55ecb92222c583115a2c83756b944103dd7f871", + "size": 6673, + "sha256": "13add49e7d08dc9302fe04c978720a10d2d6ca35400eeb3906df13a826e51ca6" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_debugoutput.pas", + "remote_path": "Samples/IDE/ide_debugoutput.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c25a91b8ec93382847142a40797aa19979abe0cf", + "size": 580, + "sha256": "64746004fde686c4fbfcdad63c75ec4d6a5b51f7db980349693ae0a2149bdaef" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/ide_editor.pas", + "remote_path": "Samples/IDE/ide_editor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fe212090ec67578068aef26405cc5c2324c2d6a2", + "size": 17321, + "sha256": "727cceba897b887b3bab0dec1e9501c5890c759f64cae87ab8af4b7e050947a8" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/IDE/uFrmGotoLine.pas", + "remote_path": "Samples/IDE/uFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fDwin.pas", + "remote_path": "Samples/Import/fDwin.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1f205391059c289ebeb424a6efb3558698205b82", + "size": 380, + "sha256": "21caf91d91756f369b7861cf6c753ed8796e8a3e4ba55f6ac88ebbfe8964f1ba" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Import/fMain.pas", + "remote_path": "Samples/Import/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "36792202efbc409188745823d084326180da63b5", + "size": 12195, + "sha256": "91fe55b8caabdab661eae2492aa04524de0c6fcb3f539b4ab1cced353d987917" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fDwin.pas", + "remote_path": "Samples/Kylix/fDwin.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "12138dc92e541f5c58b665969b6d08cca3c5338e", + "size": 367, + "sha256": "282c45de20124f27a3723fa2d2f3d9cfb822a68b8ecc1a8373a31beedf643981" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/Kylix/fMain.pas", + "remote_path": "Samples/Kylix/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "49e8e3e2a66a933a6d2944d6acb0d57d665803f0", + "size": 8061, + "sha256": "19931b61c4a7c6378955ef4bf06603c622adee746a997da141b6bed54de4721f" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/RemObjects SDK Client/fMain.pas", + "remote_path": "Samples/RemObjects SDK Client/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c1aad1e91267ec802c508a59b131f7be3f9b8c00", + "size": 4816, + "sha256": "8fdd6c1d070778c395f7c0d8cff281a7d900b23288593edae1bfe2e5263ba7c5" + }, + { + "path": "src/ext/pascalscript_submodule/Samples/TestApp/fMain.pas", + "remote_path": "Samples/TestApp/fMain.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5c5c82c8c6f19c1d06695cd648cee44adde8445a", + "size": 4297, + "sha256": "8e47412c1f2dbaf673ea12536dc8e3c1621b24fe451abd3e4f4d4b655f9d1180" + }, + { + "path": "src/ext/pascalscript_submodule/Source/InvokeCall.inc", + "remote_path": "Source/InvokeCall.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0c0c93109b4d8c0ced74663411a8780ff11660be", + "size": 9834, + "sha256": "d0c77e571263347235b52c3633ff6f72fb699196ed8a6ab5da0690f004c31fe6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PS_KMR.inc", + "remote_path": "Source/PS_KMR.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8f2a6a61809718b7a6b8d9c190fe24a9f0abe55a", + "size": 163, + "sha256": "39d393953e2df902b9f91ff8b78f2cd93e62fbd0b742380ac0c30b526cfbe54d" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript.inc", + "remote_path": "Source/PascalScript.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "53ec0f0dbcfc16cd94ad782ccb57a1edd9ca744b", + "size": 1848, + "sha256": "30cdd3f35d84ca117cfe287c18f2b394be8612dffa943929cfb844f20be7a5fa" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScriptFPC.inc", + "remote_path": "Source/PascalScriptFPC.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a6d19974211701d72ef4aa852769c916ddd86559", + "size": 835, + "sha256": "cde62d7e524f6c6b3f3e93255ee4004bad66b02fed241a348306ebbe4f550c22" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Ext_Reg.pas", + "remote_path": "Source/PascalScript_Core_Ext_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1a9de6eb7f947b9aa788b83677ebb8467d442167", + "size": 991, + "sha256": "2c876492e175fcc736ddcb3c36a49ba34e7219a2a458b1d7edfe270aa0158711" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg.pas", + "remote_path": "Source/PascalScript_Core_Reg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "cd8742876113beee691b9f77f5cd75f46ca9c201", + "size": 1481, + "sha256": "ea0267f29ed3ba249941d93c6b2eb1d27e775ef143522f4670cd89ad88486fc7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/PascalScript_Core_Reg_noDB.pas", + "remote_path": "Source/PascalScript_Core_Reg_noDB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d7565127069853a807931da177d1637a19a45fe1", + "size": 1296, + "sha256": "e255cf6cc721ab596555177e58db85c8d5ab31a294281ba704c04887dcf5fde8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Dialogs.pas", + "remote_path": "Source/ThirdParty/uPSI_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "13ef81fe2c27ba15480112aa765fa8c9643f31f7", + "size": 54013, + "sha256": "07f62a8d9934cb82282422de5df54f197f14c47575dd4e79893f341ba89cfabe" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_IBX.pas", + "remote_path": "Source/ThirdParty/uPSI_IBX.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6447534a4d14eccbfb2f49cc057cac8cb66f2084", + "size": 165927, + "sha256": "8431e9a2713661fcfc4857e60d06dce71f2a5da96d00edd960705ee94522e883" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_JvMail.pas", + "remote_path": "Source/ThirdParty/uPSI_JvMail.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "832e0b5a5d18301453401931d5d7944e78403e04", + "size": 25983, + "sha256": "4dfb493feaba7c2f6757f89d9fe194c5e25aaab6743637c0275937758f8e3d0e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Mask.pas", + "remote_path": "Source/ThirdParty/uPSI_Mask.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f9a60241b61701ca1aa42b759d13ed7d0a174cf2", + "size": 9871, + "sha256": "e9f2bdec9005bd4cf91ae7022a199592b0df8e3723d958f506eaee92545a3ef7" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPSI_Registry.pas", + "remote_path": "Source/ThirdParty/uPSI_Registry.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6763366598f92cf1c1f1e0731d1ca4afbf192592", + "size": 33715, + "sha256": "493f62590e76ab2189ba5243b21a467565f33bf9aa28ca4db5dd1ef2fb74c6c6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/ThirdParty/uPS_ExtReg.pas", + "remote_path": "Source/ThirdParty/uPS_ExtReg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b0dec7a8e85eed46e975f66009a90f24d737a585", + "size": 376, + "sha256": "49ddf49276f0c540fb21d21f3c84ab627298a728088e7734802958203ce5c546" + }, + { + "path": "src/ext/pascalscript_submodule/Source/arm.inc", + "remote_path": "Source/arm.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e08b97d17e855b93dbf02a019cfcbd9c10c1c8a9", + "size": 13410, + "sha256": "3218a93d05f1d3c83b1d752239ec583e755bb6d6d66b65fe60e34dd3836ed6f8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/eDefines.inc", + "remote_path": "Source/eDefines.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c719c5cc25a046fd6e94d49927f7065c54de00ba", + "size": 21717, + "sha256": "d4e2a5775f85b743b66aebaaedc3e9a10c6e497f9ffe222e190781195c3741ea" + }, + { + "path": "src/ext/pascalscript_submodule/Source/pascalscript.pas", + "remote_path": "Source/pascalscript.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fa37a2bc141e6b980288727bd90cda6d3e58f8a9", + "size": 1047, + "sha256": "b66c7764bee362ef14418bdd27999ff14eb2217d7eda394a54892594b570dc65" + }, + { + "path": "src/ext/pascalscript_submodule/Source/powerpc.inc", + "remote_path": "Source/powerpc.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "aa864467c939a8848326c52aee01ba901d060a1b", + "size": 13038, + "sha256": "921935fa58417334257c964da67e82c678b7e69fd1cdbebb3e12657e61915954" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_DB.pas", + "remote_path": "Source/uPSC_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9aedadd9e4a0971d037fa951fb0948f9a1064f45", + "size": 36797, + "sha256": "33509c1e6ee6eabb7448fe4dfe55b89b6090d2b9bdfa423b54b189f9f9ad8e21" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_buttons.pas", + "remote_path": "Source/uPSC_buttons.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8b6f81066124bddcbb911931ba5e4a08765e0742", + "size": 3131, + "sha256": "08de3cc8079d30b6d6b3e47dd2e92e2ea78e1898304b6abdb1221544f694339e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_classes.pas", + "remote_path": "Source/uPSC_classes.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9cde59803064c3394636508e2070e14a013cfc14", + "size": 13760, + "sha256": "0ed291bab0d669e8cbdd588e9c545aea7f1ff5bbb25a55ce5eeac51da59ca024" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_comobj.pas", + "remote_path": "Source/uPSC_comobj.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c5385797385a4d7e8360599d2f2d2a0179873815", + "size": 1820, + "sha256": "50024e58966581d455eb7fc90240e4d7265389ed631793e63accd3152dc82ee2" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_controls.pas", + "remote_path": "Source/uPSC_controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c615cc968015541806f568f94e3f62df85dc62fd", + "size": 10717, + "sha256": "eb64db3fe484301bdd3a172c2c7ab78b3764a816a2376517efa99ba06783d4b8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dateutils.pas", + "remote_path": "Source/uPSC_dateutils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1b95673ff927fc849740e1696ae6cc5ad54e66b7", + "size": 1553, + "sha256": "fca566d883326ee3e4ba798e81561116284feb8a697476028ae2298acb16b20c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_dll.pas", + "remote_path": "Source/uPSC_dll.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a8e2c0365d8454a8687acca1060c06d6441dc713", + "size": 4417, + "sha256": "1ec05a25c1577fd5c73c9cce8f63ddc2acece481f61aacd077f5bc0d6bd4c00b" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_extctrls.pas", + "remote_path": "Source/uPSC_extctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "7b221df85fa0eb3b74028c1da0c880df9eda7d55", + "size": 15715, + "sha256": "d9719e519d4d9844e18c4bc0fed3e2624c78c52f02e8cf50947de963e49abeba" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_forms.pas", + "remote_path": "Source/uPSC_forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d928ac45da66bacdac75fdce8413a828cf386295", + "size": 12782, + "sha256": "5bf7ca978cb50ddf528fbc5da62490f8c5a87f695e158b548a61fddba8fc2664" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_graphics.pas", + "remote_path": "Source/uPSC_graphics.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "969baf3e1410a1946b283b166b6106afb1cbac0d", + "size": 13449, + "sha256": "2915aa2f9d99993998729c34bc7ea94faf0853266aacefe13ef410ce5480af63" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_menus.pas", + "remote_path": "Source/uPSC_menus.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "85b42fca198ced5602d300b970e340af207e8c7c", + "size": 9688, + "sha256": "f4bc813dbe78c5a958060d4bd84878d1544ab2088ab802591b2d167ffdcf1b32" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_std.pas", + "remote_path": "Source/uPSC_std.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c8c297d20b5a4b95c969c14612ec1cc1157fe2e0", + "size": 2685, + "sha256": "a95312c178d0f9f14c3defc78703d91a1027c99eccca4fff9cc6419112dbebe8" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSC_stdctrls.pas", + "remote_path": "Source/uPSC_stdctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b065a0acf1751891f42854d40f182d44c54ff5a4", + "size": 26746, + "sha256": "a3111007736e18519fe35b6fc905f0cb75d1782ff36bb3204046be88cb214b49" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSCompiler.pas", + "remote_path": "Source/uPSCompiler.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4d0dde2e9cb94dc512fe49766ca5156b8cb4bbf2", + "size": 486675, + "sha256": "7786a321e83285a27d3450751de38b619b45b088cd0dcf6e1e7cb73572820a94" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent.pas", + "remote_path": "Source/uPSComponent.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "6b906c967e0ef5414e4226628aeb84eb30955832", + "size": 44086, + "sha256": "aa7450573e597689fa422a96eda6b2d62b883f9dca218b8a579ff4546f591abf" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponentExt.pas", + "remote_path": "Source/uPSComponentExt.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "76ce9fd1df6fe33b9f769521c18622b0a43cb52a", + "size": 30731, + "sha256": "62a0b0cacc48fb5c24a67cb1676e7a9fe9513c2db5e0dc70cd103c530e4c8c51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_COM.pas", + "remote_path": "Source/uPSComponent_COM.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "1ae3533e7cd9bbd61e7c335e3c58082675e0d2bf", + "size": 752, + "sha256": "f5743fdcff6fbb0a792027a5cc573762686bdbdfab17867bf7ecd7d7e3752800" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Controls.pas", + "remote_path": "Source/uPSComponent_Controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fce7b2982355a582ab4138dd33605ef243302f5a", + "size": 1633, + "sha256": "8dc80a0cdde112b8a92bb60981163fe56134f52cc009a5a3cf7f51823520b16c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_DB.pas", + "remote_path": "Source/uPSComponent_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "c60d06e635299ea104f21a7f4cf45ca10a9a91a3", + "size": 712, + "sha256": "4ea549d91073b254858bdeb8d09903c68a84febf0dca4328215a9a31f1664f51" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Default.pas", + "remote_path": "Source/uPSComponent_Default.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e7508cf836e88340c4cdd237c95419e063570f75", + "size": 1939, + "sha256": "ff23706e887ad8c9abd907173f530c8f11142c0885910d946796dda3b24b1120" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_Forms.pas", + "remote_path": "Source/uPSComponent_Forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "418fbb22ecc9a8e84944a40d4950eebee14881ed", + "size": 1435, + "sha256": "dd9956b4be17e2dd4a75da90e4f55e98c26fda3fe502089f30c7d43b354c25b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSComponent_StdCtrls.pas", + "remote_path": "Source/uPSComponent_StdCtrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "9f92923452d1a4c267f092c1384ee0863f0b765b", + "size": 1555, + "sha256": "6eba0f55b00af6dee7ccdc7d213feb998f1a23bd7e26da4d2127f6513876c081" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDebugger.pas", + "remote_path": "Source/uPSDebugger.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3f9f975ce3b4381101bb8cb8e1f8b30d67833948", + "size": 18062, + "sha256": "a5086a4dbe0583d2a318d488332e0d039df25d0c6ffe0c50c85865d6fcd8a9e9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSDisassembly.pas", + "remote_path": "Source/uPSDisassembly.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8c5505577e32fd7de04213cf779e6ca927f70dbf", + "size": 16483, + "sha256": "232d9b77b9e6d176d110f75b179b68aef69c5d15089875e997bf1c36e6b6ae2c" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSPreProcessor.pas", + "remote_path": "Source/uPSPreProcessor.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "21c500a9439c1ac817ba17275a1e2fa5fa5e1385", + "size": 23453, + "sha256": "09b58f2f89831286fa0b450f31d023498130f9c38fd8a28ef7fed57af5eccaf0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_DB.pas", + "remote_path": "Source/uPSR_DB.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a9d12414cb39f69aa745f354d93144e1db9cde58", + "size": 171962, + "sha256": "48a81dba4ac00481f446e3e8406c4b58619097288ac184cfd5242234fc8dc29e" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_buttons.pas", + "remote_path": "Source/uPSR_buttons.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "a2970beb6f2f82bf2f27cea874361185fcb7e2dd", + "size": 762, + "sha256": "590440b59f84732a6a17acc4d6d0a7ef6b0d4321e766427b8e12e5152c871fe4" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_classes.pas", + "remote_path": "Source/uPSR_classes.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f46f070fbb4ed046bb1a5df66f9ea8589acb9e3c", + "size": 38439, + "sha256": "58640751e818cb8468e55fdfba029db23778e542a62f19a84714c995759b14a9" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_comobj.pas", + "remote_path": "Source/uPSR_comobj.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0e7856f3dc93af99c86379c7b3cbbf652d2da4bd", + "size": 3018, + "sha256": "e38023ddbb09e8f65c51dfc6fb21e46e0cb6792bcdbab07ac36a00767567cf39" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_controls.pas", + "remote_path": "Source/uPSR_controls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "58cd497a13cd6a88d946d6e7b007cf12226ca240", + "size": 23211, + "sha256": "c2210644945f54f669267b1fde4b44669afbb200d9975af0de8abd402b16e1d0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dateutils.pas", + "remote_path": "Source/uPSR_dateutils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ce33f03adc5aecae425bac1180644aacad5cc126", + "size": 1863, + "sha256": "285e829ff13171413cc3320567078c4232908d9372a94fa92350ba403cbc05b0" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_dll.pas", + "remote_path": "Source/uPSR_dll.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "95c894a806765a6e1afa9345a5df5c3641852dd5", + "size": 8347, + "sha256": "435f1e5867dc970b20a603a9f5ba0655f9af0a913e02a38aa957d0c6cf5b50eb" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_extctrls.pas", + "remote_path": "Source/uPSR_extctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4b7e5176d5e4724310c712565c54e8ccb2713e66", + "size": 8301, + "sha256": "7ffaa107c07ce594bea2bc32bfe76d92947f844089c829ce70d692b50e1d94d3" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_forms.pas", + "remote_path": "Source/uPSR_forms.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e94073952f8d6486baec56cb05bfed5c103033c9", + "size": 29741, + "sha256": "1583bc9529f7ccb7cb9b88a2dce6ef9a78304629be6cf2d9a8f1d2d327fbee46" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_graphics.pas", + "remote_path": "Source/uPSR_graphics.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "05740c70f1bd181322aaf78e867a926e9e79ad65", + "size": 22328, + "sha256": "4c7b34c2272895713948ddddddc9e8e1b1c6ef1da5821f0d946c3ece2fcc4190" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_menus.pas", + "remote_path": "Source/uPSR_menus.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "823c1873c3fab23369ce3aeebe6628bbebdc9d6c", + "size": 37323, + "sha256": "731c62b6424573f5d6eebaea6d81258d1fed5ff6ba0548cb17304a07513efaf6" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_std.pas", + "remote_path": "Source/uPSR_std.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "71fa54fcee371efc67c088df7741a97dbaf890fd", + "size": 5105, + "sha256": "5c655421e42de094ffd90fc4ee6052b6670cea9265d1f0319f96988031123c14" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSR_stdctrls.pas", + "remote_path": "Source/uPSR_stdctrls.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "0a89d5be1fcae4affd43e38773800c73011d4c7f", + "size": 21734, + "sha256": "ba384ca63d1391ed42b8ba54acef2104008b28f5eb3928c7bbcd0f5c0408a8d1" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSRuntime.pas", + "remote_path": "Source/uPSRuntime.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "b961d1541073bf8e32063eac297be9e68e746806", + "size": 443956, + "sha256": "0f623b98e4f18b2d063b34e442da1f1b9e09ac436eab009ef69f9e651259a677" + }, + { + "path": "src/ext/pascalscript_submodule/Source/uPSUtils.pas", + "remote_path": "Source/uPSUtils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f36b0544c3b5500cf52b24decfd74c5405350b78", + "size": 39989, + "sha256": "35db0be37eb9c128ec9aabbd70db0637dd7cc0a67e5f0c9d2e82b4afb9d8296b" + }, + { + "path": "src/ext/pascalscript_submodule/Source/x64.inc", + "remote_path": "Source/x64.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "f5f1f63af91544de0f853b3da3417d3cbe817fc8", + "size": 21662, + "sha256": "ec99655d32e44c692305f9c828dad5d779b9aba1300707a47fd3c52bfcf50068" + }, + { + "path": "src/ext/pascalscript_submodule/Source/x86.inc", + "remote_path": "Source/x86.inc", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "957524de4d8c2c48f6f8747c100562370030917b", + "size": 28000, + "sha256": "2e21c9a06e59d0c069ed7552ad83ace222757f672d6987974359fef803c4efce" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompileTestExtended.pas", + "remote_path": "dunit/CompileTestExtended.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "e6ee3db2ec77c6dca027f7db98092aaf198aab16", + "size": 4752, + "sha256": "39b06302c6bc93c405d2735f26fce78de51a67bcc78c7b12cd1e394bb299c2d7" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestBase.pas", + "remote_path": "dunit/CompilerTestBase.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "07f2077b41dffb70c5659b308122b2712e967dcb", + "size": 3595, + "sha256": "818a35c95c2ef09d388ec9195928925053277e3e66024ec05f119737f836333e" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestFunctions.pas", + "remote_path": "dunit/CompilerTestFunctions.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d8240bc0f55033635e9e5dcf892ae90ce8b6c227", + "size": 6374, + "sha256": "28e7cb7665e525aa7be2824d18f6f358a1858c2b30d9136ec322b0789693f9fd" + }, + { + "path": "src/ext/pascalscript_submodule/dunit/CompilerTestSimple.pas", + "remote_path": "dunit/CompilerTestSimple.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dd28aca4fd057973f9e0b16306c4db743239d8bf", + "size": 10079, + "sha256": "4ca492d1f66cef3a0f68c01e7e6b644bd0a916fd82ea4948eff05b3f7124fad5" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/FormSettings.pas", + "remote_path": "unit-importing/FormSettings.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ffdd820d2ca9e5a99f8d68b49d087c32ae05f4d0", + "size": 957, + "sha256": "424f9f28fd939f95ad8034fb5dea266ecce1125b3ef7ebd2e6fb1775564461c2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/Extendedreg.pas", + "remote_path": "unit-importing/Import/Extendedreg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "df1bacce56d78a64b3d94d352248d7af1260c50d", + "size": 422, + "sha256": "ebd72056b98d3dfd50aa34c502012cc7ea4e2e66b8106758d53d5816428e3a61" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSIR_Dialogs.pas", + "remote_path": "unit-importing/Import/IFSIR_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3c3bfe3ca1acc50ce9aba07907b0f13b8f74f03a", + "size": 16715, + "sha256": "dbbace9295e187ff813b291c2d0975584d48515f5a1516fac45a7c273a166fb3" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_BigIni.pas", + "remote_path": "unit-importing/Import/IFSI_BigIni.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "d82716515d11212dc7a76320a3435269ea61495c", + "size": 24049, + "sha256": "8ec961bdff87dfb9ff232f65eef916146e7540d6de27e33db7be75f6426d0d89" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Dialogs.pas", + "remote_path": "unit-importing/Import/IFSI_Dialogs.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "5bb4355ced4ea9aa20670b895324315306acc1f6", + "size": 37616, + "sha256": "d23e836d2392ca42add3540c17afcd9ad1f3f94a2b28a2c66f2bb098ea4e8680" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBCustomDataSet.pas", + "remote_path": "unit-importing/Import/IFSI_IBCustomDataSet.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "45f858688da1d100facd797f7576db49de2bd32e", + "size": 21959, + "sha256": "1cd59a2d9e707e86f6cdf8548abc4539786dac783975bec3d6e1f1f17a33b9dc" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBDatabase.pas", + "remote_path": "unit-importing/Import/IFSI_IBDatabase.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "195509b7f807f0d03b352471cf8c4e96ddf2f7f3", + "size": 35181, + "sha256": "9e227b93a2c49a5f58b22b79de9dbe6927136f4e8eb3ec808a0083dc65faa897" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBQuery.pas", + "remote_path": "unit-importing/Import/IFSI_IBQuery.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dc9ba2ad305942ce2f5b44c6ad706a8e69f306f4", + "size": 8517, + "sha256": "87a349f01615c3ca7f572562eb0566480f33a5fdee670a1494a852353ca52de9" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBSQL.pas", + "remote_path": "unit-importing/Import/IFSI_IBSQL.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "fffcf246d72e8fd15fc6d92fd882442da47f77f8", + "size": 47419, + "sha256": "585347e5faf73bf67be2ceb22696e7920cffc60ec690f9fc673e1befb16b953d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBTable.pas", + "remote_path": "unit-importing/Import/IFSI_IBTable.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "4bc93659988da21433cc89f3ca60b92cb15063bc", + "size": 12675, + "sha256": "80a028fb513d627e617563f7d8da62be421d24131facc3fc8200c5c9b5608a3e" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBX.pas", + "remote_path": "unit-importing/Import/IFSI_IBX.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "42c817df7e76c1354e9a16ed1a1e315a87968107", + "size": 106865, + "sha256": "2969a26905d8edcef1cee639b3af3829c25c7dfa04e6effb8a6680488a6bb502" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IBXreg.pas", + "remote_path": "unit-importing/Import/IFSI_IBXreg.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "742aab2b06925d74b70c6e64489f64041b759c67", + "size": 405, + "sha256": "2bc9e1182b32c920fd111b3b316772edb0a6566542426acf37aac9a92daadef2" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_IniFiles.pas", + "remote_path": "unit-importing/Import/IFSI_IniFiles.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "567a7fb457810720833a65d7b22ecb5ff45ab8c9", + "size": 10667, + "sha256": "9480168bea8d8963e3ac27a4a16439ce164d8c91582bf71008eb4d132d5d8a7c" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_JvMail.pas", + "remote_path": "unit-importing/Import/IFSI_JvMail.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "74eb93d30eb7a6c90ab9758a96febd67e999e891", + "size": 18571, + "sha256": "3cd63e72e7de08f3d2d2543815db3bd2077e2b36a23708a407b6406658e19070" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Import/IFSI_Registry.pas", + "remote_path": "unit-importing/Import/IFSI_Registry.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "3b3965f36913fe86da520d429daf685245530571", + "size": 26321, + "sha256": "483fe4522702f68746698b52be3e3f4911e1e6a85afdf2cd93367f2e63baf725" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/Main.pas", + "remote_path": "unit-importing/Main.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "8474813fa601a5700ead4e88f5e05e2e13f5b9df", + "size": 21708, + "sha256": "d0bfe338fc0f9ba9c4d0e7171c4eec5d4277d582ddc4141efbadbaa9fb8fd139" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserU.pas", + "remote_path": "unit-importing/ParserU.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "968cbe7a1b4a3d11cca394b94c83d62c75faeeb6", + "size": 91575, + "sha256": "74a1569c56222c5889aff42b4f67d5ac585424b1d4ea38ea657a67d733464c0d" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/ParserUtils.pas", + "remote_path": "unit-importing/ParserUtils.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "dc98e3812a34f25fe0d357d8696982a5f08aaac9", + "size": 5532, + "sha256": "bbe75fd3f924eb5a00eb8b27c36e5b8dec8da7e94bd9fb0bdfa146b55a8b32c8" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/UFrmGotoLine.pas", + "remote_path": "unit-importing/UFrmGotoLine.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "eace1e00df40d4f7279f3942a60257ca36991226", + "size": 1843, + "sha256": "0492b60cda9370ce5911fa94f97f3f4a057713d98d0cb552d24aa325ecf2893a" + }, + { + "path": "src/ext/pascalscript_submodule/unit-importing/bigini.pas", + "remote_path": "unit-importing/bigini.pas", + "repository": "reyandme/pascalscript", + "commit": "e40e5c4bdd93ae3c4eb670f1c775198021851f51", + "git_blob_sha1": "ec1927dd0c1c10f6f999955cffc92c7b76d9d792", + "size": 61843, + "sha256": "6633906da3a63033810145f6ee36628de04b1ba6c51d731310b9717c11b558eb" + }, + { + "path": "src/forms/KM_FormLoading.pas", + "remote_path": "src/forms/KM_FormLoading.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "276261221925d28180c54c0811e7de27a15374f5", + "size": 1285, + "sha256": "c6a209999c15aeb27e848de10886e5012be01fb139f11961f9cefbad8fd680f7" + }, + { + "path": "src/forms/KM_FormLogistics.pas", + "remote_path": "src/forms/KM_FormLogistics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db76bc33044a79c30e6be19b2543845126be5723", + "size": 28024, + "sha256": "b2dcd32a7100a129268de3069545cc371ab4f1f67b647cbca945c588201d7876" + }, + { + "path": "src/forms/KM_FormMain.pas", + "remote_path": "src/forms/KM_FormMain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d8443d377bb18a05836680ef086865f555d5004", + "size": 69722, + "sha256": "6a275a7bd4ea1de7dd55b97463be94d98c574a9c1fb400d3a47169cffcf0458a" + }, + { + "path": "src/forms/KM_VCLMenuHint.pas", + "remote_path": "src/forms/KM_VCLMenuHint.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1b9b7f375d33c6facb6480045b66378e0d06f2a3", + "size": 2063, + "sha256": "5c74b6baa98d06b64933bdd43d865a10088fc54ae7d593cc2d67221309dd6c73" + }, + { + "path": "src/forms/KM_VclHelpers.pas", + "remote_path": "src/forms/KM_VclHelpers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cc158f4a8ba6fdb0c8dba1b3458f8ebb390becbc", + "size": 1501, + "sha256": "12bdaa38199901fa4ae7027dc435a83e9c20dbf6e989636d981da9c5375343fc" + }, + { + "path": "src/game/KM_FogOfWar.pas", + "remote_path": "src/game/KM_FogOfWar.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0cfc28cbcd6aaadefb16ad64a04fb97e0fbcf6dc", + "size": 17989, + "sha256": "59306563343380fccbc86e2d2efe62bf045f02e449043cf8ee38990f8c38e1ec" + }, + { + "path": "src/game/KM_Game.pas", + "remote_path": "src/game/KM_Game.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a271d05244e9c64b86b03288a4446826722b5fbd", + "size": 118471, + "sha256": "9ef4649cb0f32143fc65c7934d62e2027bbf3c6306cc019ef0498fcccbe2b0c8" + }, + { + "path": "src/game/KM_GameClasses.pas", + "remote_path": "src/game/KM_GameClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "beec800ddb59cdefa6da45b5018e5b949899e3e2", + "size": 3729, + "sha256": "9cc088909cd2563af531272741549c5babb23b2278c6da8425b1c4e1665cd298" + }, + { + "path": "src/game/KM_GameInfo.pas", + "remote_path": "src/game/KM_GameInfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5136bf0d919a3cfcaf096c52f868ac5dd8750deb", + "size": 8828, + "sha256": "4c1f0eebd8532898f9d68f8bafcc50a5ee3b5d2c2689b47c7712a2b8de18a070" + }, + { + "path": "src/game/KM_GameOptions.pas", + "remote_path": "src/game/KM_GameOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f27eb736b1dcdfb19536740fb11259a296ce8278", + "size": 1971, + "sha256": "682720d856a79f0555ab2ccf7cd48a5643bf426b109804cb27fc855682f67585" + }, + { + "path": "src/game/KM_GameParams.pas", + "remote_path": "src/game/KM_GameParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1e91cd143f8316568ea61a0ca12ed12eff7e3ff4", + "size": 9289, + "sha256": "2a307759cfdd00c1298ec1a749f5ef74fd6e0b69639090155664e2cd001adb19" + }, + { + "path": "src/game/KM_GameSavePoints.pas", + "remote_path": "src/game/KM_GameSavePoints.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ab337acee2fd4d19346d386e2b7ddeff6e6894e4", + "size": 10399, + "sha256": "098ec9c08b55597c44507d8f02e87af72837242c5243d9bc78184da4e78e2ce8" + }, + { + "path": "src/game/KM_GameTypes.pas", + "remote_path": "src/game/KM_GameTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "054e90557f83f4a9c16bffa21338a7bb3e8008ca", + "size": 2106, + "sha256": "f80ac2a918f00487ffea444ccc3deb1a01c808efe990f65d72ebbabc00709a88" + }, + { + "path": "src/game/gip/KM_GameInputProcess.pas", + "remote_path": "src/game/gip/KM_GameInputProcess.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "89e15ea844b4a313a20fe29b319ab7ca1791b375", + "size": 87058, + "sha256": "ae41b2b47d49b396f32b138a1ac87b4c5d5886a655c00ce485914dcc45e4467b" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "remote_path": "src/game/gip/KM_GameInputProcess_Multi.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a632d3c3bafcaacc53973f6c75da1e5ef1c0d9c1", + "size": 18232, + "sha256": "c20921151077c597c5bf3db808c90d4759272dbb4744d51c69591810ef64f4f1" + }, + { + "path": "src/game/gip/KM_GameInputProcess_Single.pas", + "remote_path": "src/game/gip/KM_GameInputProcess_Single.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2938422075102d631f1a845b00b9f75f99836b2a", + "size": 3500, + "sha256": "7482ce9ecb27a14558dd790b4f65d502f5ceb5417f781dd4cf880a41b082ce26" + }, + { + "path": "src/game/misc/KM_GameUIDTracker.pas", + "remote_path": "src/game/misc/KM_GameUIDTracker.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f60f965bbdd61e9e57b3c57ae4bc96101e4612da", + "size": 1409, + "sha256": "adf82f90503043bfcb92c939154eea1167ddefb7886956997b7a7a4d09fce572" + }, + { + "path": "src/game/misc/KM_RandomChecks.pas", + "remote_path": "src/game/misc/KM_RandomChecks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f2587c6cb1631ac6560e7fd76e299fd8e775fda", + "size": 15180, + "sha256": "0d0dc3da175eed8a049314b3ad9767e07968f5f4f3545c6f13c895b1639c9e2e" + }, + { + "path": "src/game/notifications/KM_Alerts.pas", + "remote_path": "src/game/notifications/KM_Alerts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c65ca1a2c30401092972de9d0237e52a05ddd341", + "size": 11503, + "sha256": "6fce90e0268068266db379658abd8ba9f316668e3de19aa74ccb7e5d70cc9853" + }, + { + "path": "src/game/notifications/KM_MessageLog.pas", + "remote_path": "src/game/notifications/KM_MessageLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "23273982f81c3216f52dced0b3728cd7841a2b19", + "size": 4511, + "sha256": "1c5b0c9ffd4fc46cb6f8a1e6317a42cf860313054c7331bc023abb0e5197da88" + }, + { + "path": "src/game/notifications/KM_MessageStack.pas", + "remote_path": "src/game/notifications/KM_MessageStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd0785726b60b7fc397bc0e5eb7a5593424ecb0a", + "size": 4047, + "sha256": "aaeaffab32d810208b103c665f59237bbfc65cda10a48e7ad6b1497273088231" + }, + { + "path": "src/gui/KM_Cursor.pas", + "remote_path": "src/gui/KM_Cursor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84474ff7f365a8b8796069fa7c587fbf063143c1", + "size": 3015, + "sha256": "12175127b5ebe8631ddad6688d5673b9c374fb581a96089344b0bf3eb16c5e2b" + }, + { + "path": "src/gui/KM_InterfaceDefaults.pas", + "remote_path": "src/gui/KM_InterfaceDefaults.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "58af0572d2c50448bc3f0fe1636b204afb866968", + "size": 22260, + "sha256": "a0d50f738f8d98edd7d4b501b5f221179ffb6461ca275c7f1018bf9c497ad33d" + }, + { + "path": "src/gui/KM_InterfaceGame.pas", + "remote_path": "src/gui/KM_InterfaceGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb3d52ff882406616410eb88442b15bb47a1f1e8", + "size": 22193, + "sha256": "7094c9453fe1c60c14a19284131bc8cb660b8cf6a576c919d8c7f32763e78064" + }, + { + "path": "src/gui/KM_InterfaceGamePlay.pas", + "remote_path": "src/gui/KM_InterfaceGamePlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7f5655288dd0e212d7cb346eb6b93838aeff26c6", + "size": 173507, + "sha256": "51f6e9d7aef0d284f371bbc432181053fb99e32cab2a57d8d558d861e3446924" + }, + { + "path": "src/gui/KM_InterfaceMainMenu.pas", + "remote_path": "src/gui/KM_InterfaceMainMenu.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5cb910895289d94a82c06448c50ece4c831f647f", + "size": 14935, + "sha256": "178b552fe5266f6e019f65d0a1e047efc8f480d9a3ab2ee760d4503a97e71868" + }, + { + "path": "src/gui/KM_InterfaceMapEditor.pas", + "remote_path": "src/gui/KM_InterfaceMapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "43511fdbb9b98e5331581dd5715618d68ac84fc3", + "size": 55209, + "sha256": "57d1b71da4913bfb98b649d82aeca898afa5f6981b14e2dfc6efddcefee52165" + }, + { + "path": "src/gui/KM_InterfaceTypes.pas", + "remote_path": "src/gui/KM_InterfaceTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "52919c3f07f7701f374288ff5ea886d3c94985ec", + "size": 1394, + "sha256": "69c78ebb84c9a142f7ea5ad8d61092d8f77e834b289edc0b6a36eed1aa60bd92" + }, + { + "path": "src/gui/KM_Viewport.pas", + "remote_path": "src/gui/KM_Viewport.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5b4c6808b5d6b569bd6237e1c64d0918f45f1d06", + "size": 18386, + "sha256": "1e8e86031bc48181eafe6e4c23722b9d209e72271badd440b0357ef1c22bf3f5" + }, + { + "path": "src/gui/pages_common/KM_GUICommonGameOptions.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonGameOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "afd4bb0a30a7a9beebe5f5e6f753f913aa3b5916", + "size": 2411, + "sha256": "2a7e8ac2538ecd8a92d10fb04056d0ff6b11710afbcb820a4976e5d18bcc8213" + }, + { + "path": "src/gui/pages_common/KM_GUICommonKeys.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonKeys.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "650864e8e972ada0164bc03480f79e72804d796c", + "size": 8081, + "sha256": "b94130b28076295779c2c94eaf810c17804932a4390204d809fdf27ba708cdf7" + }, + { + "path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "remote_path": "src/gui/pages_common/KM_GUICommonOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da90a2e4f66898a4f174812d75bd87d754ff932c", + "size": 35725, + "sha256": "5af366cd96fad9a2ee53c40c38e89c0ebf26e88813bc3066df9ff63c386fa3aa" + }, + { + "path": "src/gui/pages_game/KM_GUIGameBuild.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameBuild.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e749cadf6c58fff4e8dc9744775c6371db3b13c", + "size": 6498, + "sha256": "c748e58b79e26989125e7eb9f8e621bfdd74edeb197f498548b9a16914da5837" + }, + { + "path": "src/gui/pages_game/KM_GUIGameChat.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameChat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "72ee6b694e25f9ae099e8e63af7302a85522977d", + "size": 14382, + "sha256": "9f80c1dec9aae1c3f8edebba04b94b33ad612f142f267194320c044e03dea39d" + }, + { + "path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fb4209f258adf06472807d903ddb3e15f5c2ac24", + "size": 67198, + "sha256": "cc9802cad40a9ab66a8409e3c6976053ead142c270496d143b92fb2ace22fd70" + }, + { + "path": "src/gui/pages_game/KM_GUIGameRatios.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameRatios.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5c694376558536751c08404cb072d878f45c772", + "size": 6872, + "sha256": "755d1105f530e6a6137cbb8dd8a3f5ca2667510186a21226e4b6089f227b2d28" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsMP.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameResultsMP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a1500b9713b3c89b1176b6bfd5fda3e268828204", + "size": 70625, + "sha256": "2ac186bbbc9495811c47b1a3dc43a4829ae38e599ab1305f01776c8edcb94bee" + }, + { + "path": "src/gui/pages_game/KM_GUIGameResultsSP.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameResultsSP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5df636a6fdc74b69c1fbef06be43817e84c7298e", + "size": 19314, + "sha256": "6aaef193b006166341ca7f43084b2e2dd9bfb8863fe0fa2393fd140a9d18de43" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectator.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameSpectator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f17eacb8c71669c56844a79f529996ab5c7c6a77", + "size": 20298, + "sha256": "f51229f7be9642396017d6ed4d9ac51893a865f171b956f0bbd1f040d58622e8" + }, + { + "path": "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameSpectatorItemLines.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "51cbb3b0bfade3c9154edfe4674eed228df371f8", + "size": 21738, + "sha256": "72fe56ab58a3c94326118b37fbce63366989dcdb4914ea0b4b10877777860ac0" + }, + { + "path": "src/gui/pages_game/KM_GUIGameStats.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameStats.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "07db9e1eb00639159695460641be7cd6378ab256", + "size": 9005, + "sha256": "8b1b8300d88d417f9840e3b3ed46281cc1d52aaf73a682d5346935313c3a7e3e" + }, + { + "path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "remote_path": "src/gui/pages_game/KM_GUIGameUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b06b3fe603b6623ad235464a85662dfcc0e75da8", + "size": 23631, + "sha256": "89a4470690c6e274332c58f55c99f7a273728f7791a58c168db324e100122843" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdExtras.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdExtras.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3cc205a980842d88a32ec99b22bb08b01adcc92", + "size": 8714, + "sha256": "f303b083c4063ad683d10265473a848dc04eb816925f21691509f24088e40e19" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2516a3e8087632e221fe62c5148303f7cae20ade", + "size": 28002, + "sha256": "92c0101084dbfa0d319878afcd27e206ab3cc430415d021904a47d23e67318f8" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMarkerDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3425f99ed4a4965d65b4f00aa0589d9da19f37ec", + "size": 6670, + "sha256": "2d63150b9012ea81a554b4c245cff9242fcbeaa83b1d4bc6a6c1f902311fd6a1" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMarkerReveal.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e7bb8a8bad514c51b171f8ccc60612621795228", + "size": 3185, + "sha256": "f34df3581e9a4d533db6bdf16827611f58956a99001fea8e7b489a5420bfc211" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdMessage.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdMessage.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f85c67e2158504379a1ea1d936fa9a9f9a0c822", + "size": 1931, + "sha256": "028fd25976d9284c26d820ab838a5891018f839b7af6fc1182bc7b3d21dac469" + }, + { + "path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "remote_path": "src/gui/pages_maped/KM_GUIMapEdUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c3a1ec7042180563164b18ef44159d9fd7ed1bd7", + "size": 15470, + "sha256": "62c0cfe1d1dee25553dddd85b5111d91dd35abe5d2303e49409744843761ec8b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenu.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7efc2a861a7f8dd25ea7e1a4ee574384a6e718e8", + "size": 6206, + "sha256": "b8c9351b29c066aac6bcea07e9ed018f002a7e6c39cbc7925e45d8648f1dec93" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuLoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8f669863981d3726e373b160adeeb76e24ff4b18", + "size": 5537, + "sha256": "c99774b604a5a5153f4e55367377acca762c0608f44bf9931bdeafbcf163cb9a" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuickPlay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87f62e9afe0d9203d07627512f01ab30bec9212d", + "size": 10912, + "sha256": "ab9bff3d5bedb0eb816faf971f3a413e7d1d48417a27647659018fe5693af28f" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuQuit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "748c848b406b23abb223404de25fa8d33d7d268a", + "size": 1992, + "sha256": "5bb2007e017793cd7c94b8eb867257e463144aa9581aed7f9110846591498c89" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuResize.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ec1068e3d0bd6777865f326c4ef5c550216ae2af", + "size": 11122, + "sha256": "8d7df7d0358675c3a84fbfd1dcac5535f6199a0e23c4d1fb643c4f948e83931b" + }, + { + "path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "remote_path": "src/gui/pages_maped/menu/KM_GUIMapEdMenuSave.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "317616aae370c7bf57698f25ef163c0b5e55b961", + "size": 4832, + "sha256": "4556bb419da69f4d923a940098aa5e077f13001490c293b68655514896c2a3ea" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMission.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e96c74d9353950bc0600535f903230b2cf10a780", + "size": 4488, + "sha256": "3233928be60ab53f1c7c316dc63b2debcc998f0c9501219861f1806a25eb69c3" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionAlliances.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "091d6b8c04d30e51cdf6e5919f8452f22b099efa", + "size": 5592, + "sha256": "776536307fac933bbae5fb1f757b5e304085ec48a179a058183b45afd204c14b" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionMode.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b9d2650951f57ea06460a461fa2e80499eab061", + "size": 17932, + "sha256": "f3f4d04a08c80a2a35198083ea8b20913c43543bb5950de4609e76f152392eb8" + }, + { + "path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "remote_path": "src/gui/pages_maped/mission/KM_GUIMapEdMissionPlayers.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f1c333d00c99c24c3b69db8788a1f399ff59d94", + "size": 17204, + "sha256": "e1724d0d2f42b6a0f394619faeb5d2a31231fea3741fa7ed8e34546f3bc42313" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fade1a898b028bd5c14d69e8a75872e672393578", + "size": 6320, + "sha256": "c8cd68da8b42c2eb92d2804bc7d152e7a1fbab097354e3ace47525f775acdd04" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3a09ccfee0c421797f1c3adbf2e9a2700575e1d1", + "size": 3185, + "sha256": "15408970e02b07dd2d8db7a74de9bdda1faa195879fed33b576ea8ed8b08a7ed" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockTrade.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a07559f01b4465df832cb8e106c074a86666e165", + "size": 2726, + "sha256": "c70d4e8b31e56e1711e6911b20658cb8b75dd998c12b91f6fd0855fd1d4f6bf1" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerBlockUnit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a10d7e2460331706b236850e4b4f523ecb662b51", + "size": 7218, + "sha256": "6e9a4e9a3105946008334660d6dcff15b985e247774f9eaf6a5b943151a06df0" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerColors.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0dccc56e1bbb780a6217550728bbb9fdc6df31f6", + "size": 7946, + "sha256": "413919cf15ce31f982bcb6f808f278d3a362981b243dd75d269389d9a40e398e" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoalPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a89455297a0d507b52270a8737f026b3f69f1472", + "size": 6666, + "sha256": "dc0151d1b94305b88377b8db1a47936d168afb01931e2404b42db89db33624ce" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerGoals.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0606c6ebe88520f26ab7f3eab11916c3b8362c47", + "size": 5562, + "sha256": "fa3db1a1133b269533bb2f308504b07ae50c223865a3a587ef4fa9fbdd003f99" + }, + { + "path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas", + "remote_path": "src/gui/pages_maped/player/KM_GUIMapEdPlayerView.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0edb9365bea62ad047e9c0161ca04f817a9e6fdd", + "size": 4527, + "sha256": "ebd7f745c057d3b19f5a160cb211e56bf1aeeaebb44fd25af3f5b0f4e1fa0e24" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdRMG.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "644009e1c88eacf7c29555a8cb65536a34027e16", + "size": 39446, + "sha256": "7d0276456c5349b6661ecf86338db38beb8728bfcbd00ca356457505f0bd70ef" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "74b3a5704280ce1fbd6535304346e1fc6cabeca4", + "size": 7978, + "sha256": "2efa1f541575d06c61dab34f263c7efe5d08fd5d5d924714e240aef10c40de75" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainBrushes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a49fc3c03f2c515c6f66e1e6082a98a81180a0a0", + "size": 16572, + "sha256": "014b0fef20c98b96b121a5ec506fe8fedfc02b2f60b84ed805c20435a76a3364" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainHeights.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5e5c8490dbf6a536065d31d15a42151de9eded67", + "size": 9616, + "sha256": "f0c1d851dd8110e6b7a1d25cb443bf44c5e65c621b555b8eb5baa5e7e505fb6a" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainObjects.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e1939b36172116499a9cad502b683cf8f3a79737", + "size": 34296, + "sha256": "9f8434342a0a8217ec023a85fb758dd7327440a38a97d0214315cc65c5059ab3" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainOverlays.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3c76e34ca206e392c305d05a3a4680773d5ae6ec", + "size": 3820, + "sha256": "54f06df611038063e7d6c22cd90b9f3275cf0bbc2674bdaf5f65846361ed6da9" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainSelection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "079b1e11fb411ccf7a9f77e544e9935058fd6988", + "size": 10285, + "sha256": "99ad7e5230b1a5b9469cde8c827d89a823e43928581828d213a9017d670bd87b" + }, + { + "path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "remote_path": "src/gui/pages_maped/terrain/KM_GUIMapEdTerrainTiles.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8c17261df287d098d9005cd5287dd155ada54f8a", + "size": 20618, + "sha256": "1f8dce92c15c2e0f7f099d90081330ec5d07d844c80d915243fce92478975e2e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTown.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTown.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "03cfec0b551b582908e43d012756896091fbdb1c", + "size": 6764, + "sha256": "39ed7da00173d763fa53fdba211696006c1cb3e954694fac1fdd03b85c60f8a1" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownAttackPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ddb00cb8380231c13b0c99296e07e90128efb0e8", + "size": 9768, + "sha256": "536d642adf2412d67f074cb3215cfc22e2c7fe8ccf87938abfd7ff85839b7b5c" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownDefence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f4ff4fb54f6774f31c5720b4100b6515becf1742", + "size": 11587, + "sha256": "a3f7b451022462e86dc045a687c284142aebc7689a425564f3fda903e1a22324" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownFormationsPopUp.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d59f262633c280ed8d7aaf57c264243ad9cb75dc", + "size": 5257, + "sha256": "35eb82c5b0e1c210c935c51e222b50f2bda5801f016c338516464b7a94fcc79e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownHouses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "307fbc85ccaec51cd7055dc55bee6b1826a87944", + "size": 9090, + "sha256": "3916ec0311c56cc3b10f2de6f722f07b2764448f74da203972ee4f9823781c0e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownOffence.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "94627f28f07b4ff39d26eedd3bd60f98fe6e7253", + "size": 8046, + "sha256": "4564ddfdecfcd4164596c82529d9924d5c7df2adb7c41ac7bca8c3bc1d3ee068" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "760edbd3d2b4d1cc36ac94054faf5f505d3b7389", + "size": 10772, + "sha256": "52efc32a8dd36de5e4dafbbd947f52582f5afdd473966c27fe4139da4f5e2e3e" + }, + { + "path": "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas", + "remote_path": "src/gui/pages_maped/town/KM_GUIMapEdTownUnits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f15ed4b1aed8d14d77583e0bb3a3287d4b51d6a5", + "size": 7618, + "sha256": "ac44776a45470d62c49eab237f39be25a17523cb3da8b3accd12546cf9578f11" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaign.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCampaign.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a967146103871006f8de021d591ce703fd180097", + "size": 15801, + "sha256": "366dcd0135dfd16f1f8686b2bab8609ffa970344d97c336bac4302d44d8f8f07" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCampaigns.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "39ea965601350d64f25ff4a14ad14a250a2c5d90", + "size": 7274, + "sha256": "6270892d766ba6e8203d15aa92060856cdef2cd0910ef3516385bc1b0c519305" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuCredits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a0f16e735250defcd64c05b9e90f7655412a76a5", + "size": 4931, + "sha256": "9abd8d9dae44d33dd2a77da01a49318dba73356cfb4ae7dcb6c0c5305ff97f39" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuError.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuError.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9e91203406655a35b0511b47df074cb6597ceba6", + "size": 1667, + "sha256": "f4bc468a574453e3c0e0a5c08c34db71be94ed9bbf315ab32c087125b815f3da" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70cb624d3662eabf224b50261294ceab7ac09fe6", + "size": 14848, + "sha256": "59adaf68c018247d819bc13c708c99710f098739afa8db9c0d3770464c7ec93e" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLoading.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLoading.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1aefb53fa71e13be8bbd8545c3c5ae8fc7a07f5d", + "size": 1491, + "sha256": "60318cfc2f22005ee7804e1f3566a683df2884f92ce55e8eb43d88180fa0cb87" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuLobby.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "79938f0f9df1e3feec7c07bcb81f6001c5a15e10", + "size": 109280, + "sha256": "5be5b4305fecd19da683af525f57bbd31a01424659f599f3e6dcefb5aac4566b" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMain.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b5565089c1e4c66ee25269e6206c9c116435d622", + "size": 3778, + "sha256": "b9c6454041fa5063d24ea3bd5ae2d06144b777ca8a7304e3305405f66098e9e3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7d8b5a386e8fb5c5555cbbc69bd261c2b830181", + "size": 41809, + "sha256": "aa0647978ef773ce593032912b224504f4aca2e421e3ec7e40488278b8a46ca3" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuMultiplayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ad398693fba5f1ff5c5f94fb67f885f3a5035901", + "size": 40320, + "sha256": "801d9a989c7ac8a9a9376396e84fa60a6abb69fd27c0207d814058e3b3c62a66" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuOptions.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuOptions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1a0947df094bbea8b77367c0d88a6b7cf063dff2", + "size": 2153, + "sha256": "8ed9e0e77f69879cc00f9ed9bf6fe701dd805e7b9911cca56a85074b40494d2a" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuReplays.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df72bce34ccc1628abd2f27bd8da965eebb5f85c", + "size": 19917, + "sha256": "1c1d35f168e4420583367ef6133e0d6ca7e0700d21185472a30adbbfb396ab69" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuSingleMap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e36e2cf1799ee119528c08722173c4cee15d357d", + "size": 30925, + "sha256": "bb96605eeea055936fcaaa94848d6cd2fce8919619f5eeb2a7738216b7410baf" + }, + { + "path": "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas", + "remote_path": "src/gui/pages_menu/KM_GUIMenuSinglePlayer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "acf287285339383e6ee0ae959211e01ce3715821", + "size": 3642, + "sha256": "b7292927d337357b4575ad92864508f0c3a7b025fdde483760892969cdb89ec9" + }, + { + "path": "src/hands/KM_Hand.pas", + "remote_path": "src/hands/KM_Hand.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8d474829da644370be01b387d430df1e43540d6", + "size": 73528, + "sha256": "a04c1c320aab5a06be3cca604ce23653123ded6ba4376de4f312e219da7723da" + }, + { + "path": "src/hands/KM_HandConstructions.pas", + "remote_path": "src/hands/KM_HandConstructions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6e7a560604c25e93213f29a603b83d48038ab65f", + "size": 39959, + "sha256": "8b5571c11bb2362371e216021e567046bb058b4777e5dcc32c851b8ca9ea45b7" + }, + { + "path": "src/hands/KM_HandEntity.pas", + "remote_path": "src/hands/KM_HandEntity.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "56c044f28ab2cf046fd12bd5ed426d6d81943eeb", + "size": 7617, + "sha256": "37d23ef0b0e740a7365a81ec54fc591fc4056e57f76e11fdb8138df8f46b1390" + }, + { + "path": "src/hands/KM_HandEntityHelper.pas", + "remote_path": "src/hands/KM_HandEntityHelper.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1bb1e0027f93e3b6c5f9164903e8072245ea4d69", + "size": 1113, + "sha256": "29a0c72ff4b0e98031e662675117f2fa765509ced83b53a0f0ece79802ec3bfd" + }, + { + "path": "src/hands/KM_HandLocks.pas", + "remote_path": "src/hands/KM_HandLocks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ba2d979886100e42c882914de0dd77694a4ecf5d", + "size": 4764, + "sha256": "e9990e0a665699d6210db57c17fbf8db8b4b6c012469916b1b8dd834422273db" + }, + { + "path": "src/hands/KM_HandLogistics.pas", + "remote_path": "src/hands/KM_HandLogistics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4b6e080492b08c5bbbd68d91c00fb8119f1ef9b3", + "size": 101325, + "sha256": "9328dc1176a8859a3f12f5cd572c05c722abf2b1822a2e9ed7c38002a0f4afb7" + }, + { + "path": "src/hands/KM_HandSpectator.pas", + "remote_path": "src/hands/KM_HandSpectator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0aba52b9927b4a1746c550a8a014420bd5a2ddd9", + "size": 12887, + "sha256": "f91d3ebe037a273f96e58effcaf7965e4f9f7ab57b901b944e2aad85bbfda224" + }, + { + "path": "src/hands/KM_HandStats.pas", + "remote_path": "src/hands/KM_HandStats.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "34b0e9d163c63bd2da01c32bd4bc57b8edc7cc84", + "size": 31162, + "sha256": "0feab297648d1d1f28435aed7a84126036ca99b7da7d9ba64447ff84cc01b21d" + }, + { + "path": "src/hands/KM_HandTypes.pas", + "remote_path": "src/hands/KM_HandTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28fe818b19930449ac88aeef304b09e4ae6eb1fe", + "size": 513, + "sha256": "4fb51c9bd81d91b602e5ee6e20fd13e83a29fff6732e7e176cecda5a2589b4d9" + }, + { + "path": "src/hands/KM_HandsCollection.pas", + "remote_path": "src/hands/KM_HandsCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97dc47ae0145156f70e1dc21b9082f058bd82876", + "size": 40434, + "sha256": "ba479d0b0f16846c95cafb07e434a4acaff3ded01b3471a65b61cb1c62ada1bc" + }, + { + "path": "src/hands/KM_WareDistribution.pas", + "remote_path": "src/hands/KM_WareDistribution.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "134e1765465f3664468a12de34dc56c133406d83", + "size": 5163, + "sha256": "d4b8f9e0cf787de940c9c1ed585aa382a86d928ca555990dede6c0ca06077177" + }, + { + "path": "src/houses/KM_HouseArmorWorkshop.pas", + "remote_path": "src/houses/KM_HouseArmorWorkshop.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "acc4c081be61d9364d454fdac3d4dbd8e19958c5", + "size": 2166, + "sha256": "3868d051906f1043ac6827873b2f66f67243a8482ecdbf36d4f1b47d7c97b5ba" + }, + { + "path": "src/houses/KM_HouseBarracks.pas", + "remote_path": "src/houses/KM_HouseBarracks.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3795bb335aeab7e2a26e93a76a8793af7930ae76", + "size": 12907, + "sha256": "d9bafd4febb0f34c628ee5226b0889ced285411d6a8e55c318de3c1da3410b46" + }, + { + "path": "src/houses/KM_HouseCollection.pas", + "remote_path": "src/houses/KM_HouseCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "332337b4e87f99aadb77314779261ff4c954539a", + "size": 14085, + "sha256": "b05d8b0cd0a63cf9200a599fc614ee2df6766b43404cb93a30040b87d5117291" + }, + { + "path": "src/houses/KM_HouseInn.pas", + "remote_path": "src/houses/KM_HouseInn.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4d58df87498827e39539016a20889de0fc7f70b", + "size": 4872, + "sha256": "e53c76a41ffb09acef4bab2519b92d15453f9decf12ebec587c0d41ac0875d6d" + }, + { + "path": "src/houses/KM_HouseMarket.pas", + "remote_path": "src/houses/KM_HouseMarket.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "903a56ae2cacde87346093bcab3d86c632a1b12a", + "size": 21991, + "sha256": "4496f2fc2c2ed30dd37ddf6cfb45d171c0ff3f23df26fc12d272bf75daf57169" + }, + { + "path": "src/houses/KM_HouseSchool.pas", + "remote_path": "src/houses/KM_HouseSchool.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e9f9c30f312d74f74ebddc766a49edaee648f71", + "size": 10532, + "sha256": "59e38f62ec75b37fd04ccec2acf498dae374b116819311ccb54a624a2a3873c4" + }, + { + "path": "src/houses/KM_HouseStore.pas", + "remote_path": "src/houses/KM_HouseStore.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac95908f2e163210374a50cca3c3f1236ad8a73f", + "size": 9047, + "sha256": "3e349f08c6c4288807ed0e14279b141eedb949bf856194771f9322342f62accb" + }, + { + "path": "src/houses/KM_HouseSwineStable.pas", + "remote_path": "src/houses/KM_HouseSwineStable.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6ab61e999da0f9a080b7afd7cdc5631fb3642198", + "size": 3168, + "sha256": "f243dac92002fc89f245f63da8972f22518229f9bf12455e8813be229998b8e2" + }, + { + "path": "src/houses/KM_HouseTownHall.pas", + "remote_path": "src/houses/KM_HouseTownHall.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0c4e1b3000dd3158d4defe518d49349f2a6447f3", + "size": 5640, + "sha256": "1f196acee70375d0949f1bc74960c60050493dc990772bc1f81d0e397719c397" + }, + { + "path": "src/houses/KM_HouseWoodcutters.pas", + "remote_path": "src/houses/KM_HouseWoodcutters.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a9f6d87c68f0d4cd5bb6f40ce0a173c33c811b97", + "size": 2964, + "sha256": "f80cecba3d96dc6418d095a8ee258d970aba9fbdd347f23d4d394c8971af9b52" + }, + { + "path": "src/houses/KM_Houses.pas", + "remote_path": "src/houses/KM_Houses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e1bc849d0c20e9e22b72ae3505ecec7aad5ede22", + "size": 88358, + "sha256": "d8ac9a649ebb20ad84593e487ba1411bdb4f7f45529de5b9c99be31fefbe9323" + }, + { + "path": "src/maped/KM_MapEdTypes.pas", + "remote_path": "src/maped/KM_MapEdTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a12fb0b3b5a4641c4eb22f8109b3ac0ed626d0d8", + "size": 2880, + "sha256": "496b39e7a57ba9143fd227408b68dd872181a2322cfe61c6f8db7fc4cb5f0cf4" + }, + { + "path": "src/maped/KM_MapEditor.pas", + "remote_path": "src/maped/KM_MapEditor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05e629ee4bad5bad082a7440164c5dfb6a5095f5", + "size": 43120, + "sha256": "71a1a0a4adb8c95657834dac6912b12f6d8cce1e5ea32770f4073130298f8d8b" + }, + { + "path": "src/maped/KM_MapEditorHistory.pas", + "remote_path": "src/maped/KM_MapEditorHistory.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80594c6b425cd6d0efd1288a8e5751bad7f524aa", + "size": 25347, + "sha256": "4f70d2458d8944466b835b5003ff1354cfb3e979339d4d4742ade3a69978f23d" + }, + { + "path": "src/media/KM_Audio.pas", + "remote_path": "src/media/KM_Audio.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d2008d415a835f24a7891a8152a0356fa0ccebb7", + "size": 641, + "sha256": "544208dbf958f9314b999a3940498839a84f3b1714284b655db200acddab2ff7" + }, + { + "path": "src/media/KM_MediaTypes.pas", + "remote_path": "src/media/KM_MediaTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c835b6cf437d24c14c0b1789de9a64092dba31d5", + "size": 136, + "sha256": "1909616103514d1591daaf6f11571b3f25a26b87bb117975e024a616400b17f2" + }, + { + "path": "src/media/KM_Music.pas", + "remote_path": "src/media/KM_Music.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a2536383398e7a9d1e8422b95fbb6a0a041ced99", + "size": 20386, + "sha256": "914fbf6503818e60e157068626b46f71b30a3dcc0580c94f31b5c9197cdac625" + }, + { + "path": "src/media/KM_ScriptSound.pas", + "remote_path": "src/media/KM_ScriptSound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d1a5f6ff9f97cac3bafcc4fc98ee46fdf6799cdc", + "size": 12039, + "sha256": "498a34055e5c90b97c876bb2efb782cdb6110e801e142f19098e36ff4c3b350c" + }, + { + "path": "src/media/KM_Sound.pas", + "remote_path": "src/media/KM_Sound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ebc8e6388f5c80938ac7927a7de095e583ba0e22", + "size": 30849, + "sha256": "4be0863b000935e55bfee15d73b41c50ba406b30e173140ad020dc306793223c" + }, + { + "path": "src/media/KM_VLC.pas", + "remote_path": "src/media/KM_VLC.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "14a02c1cbaf76c71360a8fff46393506fe802b80", + "size": 8513, + "sha256": "ce5c213ebbfea65c9c6085b20cb4652d8d160e8a2eeec0b0248af3b82e5338e0" + }, + { + "path": "src/media/KM_Video.pas", + "remote_path": "src/media/KM_Video.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85dc4a4995ce1b0846c4ee0a787b29440fb9c1c1", + "size": 17313, + "sha256": "76afefba35bdebb5cdeaeaffa85e29f7258a0a1021c2a1114878fca3a912fc44" + }, + { + "path": "src/minimap/KM_Minimap.pas", + "remote_path": "src/minimap/KM_Minimap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e304461835e3869c9f2ebb050033eb54387ba8b6", + "size": 4972, + "sha256": "cfa8f1d764f48e1cfbba5da6dfe59df29540545bdf7aefad817f2d73db3f1d71" + }, + { + "path": "src/minimap/KM_MinimapGame.pas", + "remote_path": "src/minimap/KM_MinimapGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27499dfed588c287ceb046f6dfd29652d8b5f7e8", + "size": 5488, + "sha256": "0990cc36b8ded9c4d03844b01619c9570e7e08dd65d0aa76b151a4090381b29e" + }, + { + "path": "src/minimap/KM_MinimapMission.pas", + "remote_path": "src/minimap/KM_MinimapMission.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "64021d5e12aed9aab7ee2209cc2938e69ee483c9", + "size": 2468, + "sha256": "75db3e59757408b7eb01decd9e509a0090ecd3332084031d83c27f334caf562d" + }, + { + "path": "src/mission/KM_CampaignClasses.pas", + "remote_path": "src/mission/KM_CampaignClasses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f801971a5ad2ffbf938407c37bd9cc26c61a464", + "size": 1537, + "sha256": "36d9af4f87245a5db3cd05448171297248ce3d818e6f7d6f8c9bc4807637e54d" + }, + { + "path": "src/mission/KM_CampaignTypes.pas", + "remote_path": "src/mission/KM_CampaignTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d8b4a23f498a874627248358c96089ae1f80807f", + "size": 220, + "sha256": "f85436bed8696c61330cacc50549d44bf064e3cd7a012829dfc160ed624ee5ac" + }, + { + "path": "src/mission/KM_CampaignUtils.pas", + "remote_path": "src/mission/KM_CampaignUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fbd32e669b69630e208c3a2f8c9f33bf249624f3", + "size": 819, + "sha256": "c9b21b45bcaf2c62cd81f6a7b70e097aa84fe4613b5368cab9e5a0d22a2addf6" + }, + { + "path": "src/mission/KM_Campaigns.pas", + "remote_path": "src/mission/KM_Campaigns.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "30758586d7c06d79e092a74f536bd139f12d9195", + "size": 30792, + "sha256": "069c2421737c77d963ecf538c55841b9e23a60225d112bef2e9e3617c1c43b1e" + }, + { + "path": "src/mission/KM_MapTypes.pas", + "remote_path": "src/mission/KM_MapTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "75304efd00050552e4e83dfdf410e1e4f4ce9124", + "size": 4248, + "sha256": "bca25641ce6a4d957dddc0ceb242065b0d26b8723688225a5bba89f87757e13a" + }, + { + "path": "src/mission/KM_MapUtils.pas", + "remote_path": "src/mission/KM_MapUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d10f31925d29738238905ac56c981e8e1e94b57a", + "size": 1799, + "sha256": "361acda0c81403ee151d0b56170663c4b69d6df24285192e7a8f13fe428b243b" + }, + { + "path": "src/mission/KM_MapUtilsExt.pas", + "remote_path": "src/mission/KM_MapUtilsExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "67497659a1b67805a3ec9c7a47927f1f21d9c41b", + "size": 3176, + "sha256": "daef75e85bf99dd1e747ae6b3f6fff90d2ce49d977955f5eb3f3fba68d2d504d" + }, + { + "path": "src/mission/KM_Maps.pas", + "remote_path": "src/mission/KM_Maps.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b22f5fbbaf65754891d30ede9235b9c5e15b12f0", + "size": 55522, + "sha256": "bb503c62e5ce3a6f5914fb24e2e44f11f26f4c987b62af0f6f792041abfcb8d9" + }, + { + "path": "src/mission/KM_MissionScript.pas", + "remote_path": "src/mission/KM_MissionScript.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "71ee6abe27eed12e95bafa420a7a41ad74e62092", + "size": 8901, + "sha256": "7c6bb8d89b15f174cb490ee4b2be120832116a3b2d4cc346ba94e69dd24bdb47" + }, + { + "path": "src/mission/KM_MissionScript_Info.pas", + "remote_path": "src/mission/KM_MissionScript_Info.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d0992d68228d5dfe41d967e93fa1763242e57e71", + "size": 5619, + "sha256": "cebe991807b5cf805509af0ae5a5ab3718c520c4d51bba90198302917b107672" + }, + { + "path": "src/mission/KM_MissionScript_Preview.pas", + "remote_path": "src/mission/KM_MissionScript_Preview.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9773daf9d966a12a524546277474c4d61f0fa388", + "size": 9069, + "sha256": "6ca28222d116f37cd78bc30dbd9c0b2a10ba8e657114a106a23449df6098631b" + }, + { + "path": "src/mission/KM_MissionScript_Standard.pas", + "remote_path": "src/mission/KM_MissionScript_Standard.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "521a2f67dba5e247a58e35b3fb52c17c61bae11a", + "size": 59584, + "sha256": "d9379cdffca584010bda737e42b59ad2a45917d3d60ad04a1121a41f96d8ca82" + }, + { + "path": "src/navmesh/KM_NavMesh.pas", + "remote_path": "src/navmesh/KM_NavMesh.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6d288690737b577303317dd4a104fc5548aa85b4", + "size": 18570, + "sha256": "6a6830f1f589ee38c76352efd60b976b661cbc99c7b2439cae96f8dd6c426a21" + }, + { + "path": "src/navmesh/KM_NavMeshArmyPositioning.pas", + "remote_path": "src/navmesh/KM_NavMeshArmyPositioning.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd60d0e8b78a833795a8bbdc6f61bd9ff2ea9df3", + "size": 38359, + "sha256": "59bf9b88d4e7adc2190c9f5c3cd1b02bcbe12e0d14d62906d1825c9668bc4207" + }, + { + "path": "src/navmesh/KM_NavMeshArmyVectorField.pas", + "remote_path": "src/navmesh/KM_NavMeshArmyVectorField.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ffd9a2cd5b957d09d1df6bf329df5a26b19660eb", + "size": 58979, + "sha256": "d1c93f277b18ed99f2e0a4c5e00d2fc5039320887ab9de6dbfeb2b1cb2e6c79e" + }, + { + "path": "src/navmesh/KM_NavMeshDefences.pas", + "remote_path": "src/navmesh/KM_NavMeshDefences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b60b4d750b700b87f9f1f24d72b9593dcef673cd", + "size": 38759, + "sha256": "f62eec2c08c1b16ff7d55569e33497bc150e0a2124419756dba855106d3e3f40" + }, + { + "path": "src/navmesh/KM_NavMeshFloodFill.pas", + "remote_path": "src/navmesh/KM_NavMeshFloodFill.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "544fedc4e7963eedc7556915b71d98abc4dd260c", + "size": 6045, + "sha256": "1a6c0d6fde48525b1cbbd49f43cb67fa10650f9922aee176c939f9797b47b2fe" + }, + { + "path": "src/navmesh/KM_NavMeshFloodPositioning.pas", + "remote_path": "src/navmesh/KM_NavMeshFloodPositioning.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d7a3b5ac309e3cc8859f4257ac9edb1f18231078", + "size": 2460, + "sha256": "f4d431cdd1e6d6c0ed64163206c76d6e519b1e695191a975bda581eac83bf5d7" + }, + { + "path": "src/navmesh/KM_NavMeshGenerator.pas", + "remote_path": "src/navmesh/KM_NavMeshGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "374e304aae32e40230ef18c8d8d4bf6aba8aa9fa", + "size": 43007, + "sha256": "9bd4ca2c4bf3e0a00b6993d4bbca1320f287774bac9d473bf77fce88cb78cb48" + }, + { + "path": "src/navmesh/KM_NavMeshInfluences.pas", + "remote_path": "src/navmesh/KM_NavMeshInfluences.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "796da6f297ee9bf14874584a176d25f7083ba6b5", + "size": 8121, + "sha256": "94c6d7107632370d85f3e7761956995eb569808c7848ab4fbc998e29e3c3718d" + }, + { + "path": "src/navmesh/KM_NavMeshPathFinding.pas", + "remote_path": "src/navmesh/KM_NavMeshPathFinding.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6836f4ec3817b86cd8f10f6f754ae180e209ad1e", + "size": 14002, + "sha256": "cccd64e1e74e18fa6c98a2970023022137d318fbc265f0b158edfcce20d8f939" + }, + { + "path": "src/navmesh/KM_Outline.pas", + "remote_path": "src/navmesh/KM_Outline.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bb38c0a0628a16cc4a61e5f6d5a8cef5fd4939d0", + "size": 3745, + "sha256": "a2d71b3418f4a1a6e756cbfe9ec7a9b92404f380a6310ba2aebeb82019da3216" + }, + { + "path": "src/navmesh/KM_PolySimplify.pas", + "remote_path": "src/navmesh/KM_PolySimplify.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d74168c30bef5c16c74b48cf3f9baf5aeb29353f", + "size": 26023, + "sha256": "1cd1a180e935deecb1ef672fd1806602723d41112603fcaaef7afed217440298" + }, + { + "path": "src/net/KM_NetAuthUnsecure.pas", + "remote_path": "src/net/KM_NetAuthUnsecure.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aaa599d715b86319eff32edab05e78b916490e79", + "size": 976, + "sha256": "ec454a30e86fd0aed8434f628fd3880bfef493df414792380b8da82fc193418b" + }, + { + "path": "src/net/KM_NetClient.pas", + "remote_path": "src/net/KM_NetClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "516cf6de93a942e939c5e899dc030f57648ec9d8", + "size": 8552, + "sha256": "29cd70b3dc14e095523b70be0c3bc6347fcbf7cba6f97d0bb336c864c26fdd56" + }, + { + "path": "src/net/KM_NetClientLNet.pas", + "remote_path": "src/net/KM_NetClientLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8b760ebb984b1fbd79562f9df91d12dad03b3a97", + "size": 4837, + "sha256": "ec0a5dc3b8f441ef39788ce78747a2c8ba592b88f68098df76349a730724bc1e" + }, + { + "path": "src/net/KM_NetClientOverbyte.pas", + "remote_path": "src/net/KM_NetClientOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2f11f6f001ee5dfcb9848e4755a5da5c4886fbb4", + "size": 5987, + "sha256": "95d65593d1786b36180209ca3006d875928d25dc90707513cb746a927b6a6c5c" + }, + { + "path": "src/net/KM_NetConsts.pas", + "remote_path": "src/net/KM_NetConsts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9d60c3429b7ec9be27d02cb09d448642f4e9c8da", + "size": 2031, + "sha256": "cf58b7dd05c5c43784a21c785743d3c6b0126539761e35917130b586e4e2566e" + }, + { + "path": "src/net/KM_NetDedicatedServer.pas", + "remote_path": "src/net/KM_NetDedicatedServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "be0e3d0811bcd87382fe4aa27c4b5f0adae875fd", + "size": 5915, + "sha256": "65ff46f6ed9ce18e1185270b7895888b53684cb0396fd3d577f0b983568897fa" + }, + { + "path": "src/net/KM_NetFileTransfer.pas", + "remote_path": "src/net/KM_NetFileTransfer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da789618df0d358a5a24a17c49842b65849f09ed", + "size": 18721, + "sha256": "13757f9e5a98827ec5243c3038910f776dedb83cfa7a7e7e8b39ee46a5dafe9b" + }, + { + "path": "src/net/KM_NetGameInfo.pas", + "remote_path": "src/net/KM_NetGameInfo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "93359538a32569700cc720fe916794ed0f361b7c", + "size": 4330, + "sha256": "463387916f637146410afe96e0766c109d9a9667b6e34e98d89fc8eb3b41c114" + }, + { + "path": "src/net/KM_NetRoom.pas", + "remote_path": "src/net/KM_NetRoom.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1ef11e704fe459d951b7bf8f6ac710f6d1330d4d", + "size": 48372, + "sha256": "151c3fc0b5d5336c77accbef008e233f436971d146074a42f72f062bc1732304" + }, + { + "path": "src/net/KM_NetServer.pas", + "remote_path": "src/net/KM_NetServer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "33a3a3bea61eefbff9256a1f0f07e2e2cb59b4f2", + "size": 42793, + "sha256": "591a4e9d090dd7ccc4032f1fb77822f35aa0efb3b475fce6f1bfac2ec2d4cf55" + }, + { + "path": "src/net/KM_NetServerLNet.pas", + "remote_path": "src/net/KM_NetServerLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "459461cb9e46173cb6342aa4da077eea2a425040", + "size": 9701, + "sha256": "16bed7ccd1021738a628127961820e520a197fd6be059e0c5270407a3fbf5849" + }, + { + "path": "src/net/KM_NetServerLocator.pas", + "remote_path": "src/net/KM_NetServerLocator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ce81a7aa12eec02cce996860b2090c9869aa588c", + "size": 5359, + "sha256": "2b11428bb3a67a975208b3066e596244b3ef46c8371cc98c5c9a8a2427b97af7" + }, + { + "path": "src/net/KM_NetServerOverbyte.pas", + "remote_path": "src/net/KM_NetServerOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "da3bdff66cd6bbffce6d0dfa916c0bdd1bd9697d", + "size": 6517, + "sha256": "0f70a3d197b427475c0187a0524b08e7db318e29da3c791cd75625c7895f94ed" + }, + { + "path": "src/net/KM_NetServerPoller.pas", + "remote_path": "src/net/KM_NetServerPoller.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "306b8d4d771faafec2ed5b1a903344a2c8e3fb67", + "size": 18679, + "sha256": "884a7de9de3a15cffea97e2f213586041b9ce00bfea8d0e8337bf63d23a4f9d5" + }, + { + "path": "src/net/KM_NetTypes.pas", + "remote_path": "src/net/KM_NetTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "02dc0eb624ed554ca60f688cf457d7fcdc177bfc", + "size": 15164, + "sha256": "7af37b995cb1fdee3c0d81c1d0f8f73745b3a8f7f4aeec76d9565ddfce73c9a8" + }, + { + "path": "src/net/KM_NetUDP.pas", + "remote_path": "src/net/KM_NetUDP.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bcc979d2a1c60b6bd6bd46b55f3e50d223141cc", + "size": 5425, + "sha256": "5bdef9a22f9aabd8713283a5f21460b9b633cca40ddfc356180ceab8ce204337" + }, + { + "path": "src/net/KM_NetUDPLNet.pas", + "remote_path": "src/net/KM_NetUDPLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a2bca4aa510e9e3d8a681b6bdec8f94ead06feac", + "size": 2164, + "sha256": "69235d0646eb61cec60429202ffc459cdcce87915b35fe26d2c5f621f0725841" + }, + { + "path": "src/net/KM_NetUDPOverbyte.pas", + "remote_path": "src/net/KM_NetUDPOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "05b6fe9b7c0ddcb6e73f3cc66901c7c1858fe053", + "size": 2836, + "sha256": "7afd6bc53e8b13ef395fd614fe735e48a9972c28699af37492d4e83112cd5225" + }, + { + "path": "src/net/KM_NetworkUtils.pas", + "remote_path": "src/net/KM_NetworkUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c67f66afcddcd3c5179fd0f1b75952613f450835", + "size": 724, + "sha256": "a4cfad97836f4d1c2d703e8c93db5608dc1454c30782bbdb77f9b6d9b5d1f533" + }, + { + "path": "src/net/KM_Networking.pas", + "remote_path": "src/net/KM_Networking.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "81b06de41e5c087c879a34e01ee3abb9069f4490", + "size": 104664, + "sha256": "d52b481f5990ae00011f567b51fe992f5030e88fc91f3c1cbf0a5695873e93e8" + }, + { + "path": "src/net/http/KM_HTTPClient.pas", + "remote_path": "src/net/http/KM_HTTPClient.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "94d4e9e01f1cdfd586f69e70538d378c4601f3be", + "size": 1586, + "sha256": "eaa097f6be9be40bf46b8243ae7b7c8cc596ec167078926a8aaca6bd01a167eb" + }, + { + "path": "src/net/http/KM_HTTPClientLNet.pas", + "remote_path": "src/net/http/KM_HTTPClientLNet.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7560faa1f1afc3eacd5740544064b25c242cfa31", + "size": 2610, + "sha256": "45640ede141b4cc0f17d6af7e7d5bb75fce9661c4a0cd5e87982243244476d77" + }, + { + "path": "src/net/http/KM_HTTPClientOverbyte.pas", + "remote_path": "src/net/http/KM_HTTPClientOverbyte.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dbb028d8ccba0e9325956c73fa8574e397b73fe8", + "size": 2141, + "sha256": "8cb25e1097969eef0032f966657282043b9dab3b8e7da08f16cffe5597e9e61c" + }, + { + "path": "src/pathfinding/KM_PathFinding.pas", + "remote_path": "src/pathfinding/KM_PathFinding.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7b61fadf8c769c2a0e4d54c997bc562fb3e1df51", + "size": 17422, + "sha256": "d8c176c92c57da321de9a95587b19cebed37dee68a97e8cba058a28061e22e77" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "remote_path": "src/pathfinding/KM_PathFindingAStarNew.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "36310728268c5675a51b74c3bf2700c9c8ec7582", + "size": 4975, + "sha256": "4b96763aaee833ac81b18e591b83afbbc61f4c844804d033f27966edae00bcdc" + }, + { + "path": "src/pathfinding/KM_PathFindingAStarOld.pas", + "remote_path": "src/pathfinding/KM_PathFindingAStarOld.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a8bd784a75a291064ccc0a66bf352743d9d012c6", + "size": 4468, + "sha256": "62bb930423be920979cda10a0e6d71c68e98dfa1fb9f4af5a1a793e557629cd9" + }, + { + "path": "src/pathfinding/KM_PathFindingJPS.pas", + "remote_path": "src/pathfinding/KM_PathFindingJPS.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "27e075d979f94ca3dd9837e3393b0dd57fab34eb", + "size": 10174, + "sha256": "cc0f25d81218dca36fadd35d4d3a904ff4157226beaefe9e4e05f968fed23568" + }, + { + "path": "src/pathfinding/KM_PathFindingRoad.pas", + "remote_path": "src/pathfinding/KM_PathFindingRoad.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d48485d6423389bbcc70e6a316a8bb9c5f4d6aba", + "size": 6151, + "sha256": "ebd1b1584f439b99047078523eb5855f804b92c6c2f971f6071978947a0429d4" + }, + { + "path": "src/perflog/KM_DevPerfLog.pas", + "remote_path": "src/perflog/KM_DevPerfLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d3b0d6ea1b18297ea15a449c39f5142005403f44", + "size": 10086, + "sha256": "2fd23effc87dbbab97fe8f2835f7752a22ab6f099eaf218bf9036d3464c8a209" + }, + { + "path": "src/perflog/KM_DevPerfLogForm.pas", + "remote_path": "src/perflog/KM_DevPerfLogForm.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "dc4370ed064da3c1ab8e387c0fce24b64f54ea5e", + "size": 12080, + "sha256": "f1660d088e1eeb3de3ee4f44dad8ce9cc00b002fd7b164640c65d1ce2db6e0b9" + }, + { + "path": "src/perflog/KM_DevPerfLogSingle.pas", + "remote_path": "src/perflog/KM_DevPerfLogSingle.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6bb1211910d8d7fa8463b77d14dfcacc2418e8c3", + "size": 8644, + "sha256": "49073b79ca5cc8f015680e9a41c3f84ea5e3a44f12363e5d5c98af1614bdb3d9" + }, + { + "path": "src/perflog/KM_DevPerfLogStack.pas", + "remote_path": "src/perflog/KM_DevPerfLogStack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1d0bd4cbff736f73a6bb06c38b4b1d9e5a7645ca", + "size": 15405, + "sha256": "30cf5f154fd7265bd61e206b881d16ebf87070ca8b8e9388a3a68aeb4079b97e" + }, + { + "path": "src/perflog/KM_DevPerfLogTypes.pas", + "remote_path": "src/perflog/KM_DevPerfLogTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "84e987e51fe7408009290d43b457ea079408e825", + "size": 6488, + "sha256": "8e8102c55980babf4b1291d3646b56d1dcb10bbaa0d2e2910f354878dda54316" + }, + { + "path": "src/render/KM_Render.pas", + "remote_path": "src/render/KM_Render.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4cc7916342b31105d8802c4c14752a4cf12ee3c2", + "size": 13076, + "sha256": "67bef2c2dbe1830d3e3a62a081f42ff3e061e3d3d9da38e1c5cc86680fab9e1b" + }, + { + "path": "src/render/KM_RenderAux.pas", + "remote_path": "src/render/KM_RenderAux.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e731dbafd77e0a251d533e28954c9c763c27bc14", + "size": 22813, + "sha256": "a2b736ad118f4f4959585f1833fdef4121bf3a7983996be2f7073326d40115b9" + }, + { + "path": "src/render/KM_RenderControl.pas", + "remote_path": "src/render/KM_RenderControl.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "30a37c01c3129dc5c573e1efd057e493bd496e7c", + "size": 3294, + "sha256": "a88f26232b658ed4abbe91a798cc87f439a8c4afba67687f784711221921e4ab" + }, + { + "path": "src/render/KM_RenderDebug.pas", + "remote_path": "src/render/KM_RenderDebug.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "440f58dda3e356211d23f2ca31a80e10caf8944b", + "size": 16403, + "sha256": "ce999e65a9107797c83335dd928c00ead83870a90085d9aa578dca6b3b8b9330" + }, + { + "path": "src/render/KM_RenderGameAux.pas", + "remote_path": "src/render/KM_RenderGameAux.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ee6cf4b7f40d9185ef8711d36a928d2e8a3ec83b", + "size": 8652, + "sha256": "a6aca175dca72c54411148e41a9a0381884f9dce22e767f558f5d3c142f3fe24" + }, + { + "path": "src/render/KM_RenderPool.pas", + "remote_path": "src/render/KM_RenderPool.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "538ffdef6f553381e0a506efb4fc5e2c935a53fa", + "size": 82914, + "sha256": "77ec7f1eaeb4ab9fc52be9ea350d07d77b3d2d0681fe985dfa1de2bb1f13a64b" + }, + { + "path": "src/render/KM_RenderQuery.pas", + "remote_path": "src/render/KM_RenderQuery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "23fc7c6d9b65aebf317f030b6315caa95bb8dbbc", + "size": 3386, + "sha256": "69343e0da66c800c0773150673b7dc5d7d9145499c3efd20dc3623ca0f210969" + }, + { + "path": "src/render/KM_RenderTerrain.pas", + "remote_path": "src/render/KM_RenderTerrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "72e08c48d4b24258b954352fbe9f5a097e31818d", + "size": 55026, + "sha256": "35302690153d13403aee5495832e89c72100b6cba3a1c9cc31e155acb77e9555" + }, + { + "path": "src/render/KM_RenderTypes.pas", + "remote_path": "src/render/KM_RenderTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8efd9752bf7dca6c58db4f9f32d90d891af1ccf1", + "size": 532, + "sha256": "7bc410ff890d0bf095af8203afd38dc15bbd1ce400c574a891e6c88a38c4ff81" + }, + { + "path": "src/render/KM_RenderUI.pas", + "remote_path": "src/render/KM_RenderUI.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "766c4c5ac0506ae703eac7903a8afe5605b009cc", + "size": 33336, + "sha256": "229ac869cbb3707321a849986675a2c8b091b9309953081ec8b9ad5611cf23c4" + }, + { + "path": "src/res/KM_Pics.pas", + "remote_path": "src/res/KM_Pics.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1564bda14de6287eea0f8f4e2b210db8252f5c43", + "size": 489, + "sha256": "266a9c6a4f426ad2ec5cf10ffcb8662be869b33d817ebc97fe83470dca47983c" + }, + { + "path": "src/res/KM_ResCursors.pas", + "remote_path": "src/res/KM_ResCursors.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cdd5d054634aa0331e95bffe2b213865ad8571c9", + "size": 1234, + "sha256": "e52b1be9b3084ab72f19b0124bf6cfc974650e62d97df1cd7478370faaba5837" + }, + { + "path": "src/res/KM_ResExporter.pas", + "remote_path": "src/res/KM_ResExporter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9b0f2c0e2d7145feccaf7d6ad1de27ac2570a29f", + "size": 30477, + "sha256": "80f7e2f22fd9e1a60669c27b48aa943702aaad2d374a5dd1f1ab443e06b3e732" + }, + { + "path": "src/res/KM_ResFonts.pas", + "remote_path": "src/res/KM_ResFonts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "db62b4d0dae51850c3c29f3c60b31022a844de10", + "size": 25040, + "sha256": "8c008f9dbb502867c177572b553db05e0be066b52ae7f32076a3dcf3ecbe34b2" + }, + { + "path": "src/res/KM_ResFontsEdit.pas", + "remote_path": "src/res/KM_ResFontsEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "022c4d036080a72e2104ece0edf25b4b33396aed", + "size": 20393, + "sha256": "94438b8a0d05bbabd3b91f0b32ab35738bf3a9a0edfbc46e04af38bd26d59e26" + }, + { + "path": "src/res/KM_ResHouses.pas", + "remote_path": "src/res/KM_ResHouses.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bbc37456bfafe2aa9e6e586f552a9777bccdfe59", + "size": 36076, + "sha256": "04635afe5565ba2d9797c3920300030810e598b0885b4fa3627d45fb27add3d9" + }, + { + "path": "src/res/KM_ResInterpolation.pas", + "remote_path": "src/res/KM_ResInterpolation.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b1247ef5a97944435cc3a28c14e9d845d3a4dc83", + "size": 7497, + "sha256": "171d92c0003683fbb43e4682e9f03eb8a55ba22d68ee9f1f2bcd7b052ddb682d" + }, + { + "path": "src/res/KM_ResKeyFuncs.pas", + "remote_path": "src/res/KM_ResKeyFuncs.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4af692a94797e91f9e38c082d12c0eac3efa578c", + "size": 8558, + "sha256": "0c3b4f114a470af098d6558b3437a1363ddad14a6fb326f9eebb9eb9ebd464d5" + }, + { + "path": "src/res/KM_ResKeys.pas", + "remote_path": "src/res/KM_ResKeys.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "13c043c92f0d4a1650954b06c05eec887019f383", + "size": 11813, + "sha256": "24e4f89638c91fdbe6a26935f4b69432f2adefeeb232f3ad75451f699df1a13f" + }, + { + "path": "src/res/KM_ResLocales.pas", + "remote_path": "src/res/KM_ResLocales.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd1eaccee7f96d2b1dd04831be9ddef2b4575d65", + "size": 5640, + "sha256": "ae36d32f959af0122af8763e2c9c187152434db612bfb8afda2b2bb8406df314" + }, + { + "path": "src/res/KM_ResMapElements.pas", + "remote_path": "src/res/KM_ResMapElements.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "96b57734ec9e17287fdc7b442d320942d4b334f2", + "size": 9929, + "sha256": "1ccfcef61c56b1bd36d10af67fcb223adddd1b1178b408ff949126b8969c573d" + }, + { + "path": "src/res/KM_ResPalettes.pas", + "remote_path": "src/res/KM_ResPalettes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1aec924b514d0d283331d0dfcc956ee9a1998e1e", + "size": 3652, + "sha256": "d86b57d19d6f6491bd5084a33a96647309b149b13bc3910e9bf405af49c41f52" + }, + { + "path": "src/res/KM_ResSound.pas", + "remote_path": "src/res/KM_ResSound.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3847dbb6d239bea0e459a4f4b8700f5e870a1e2c", + "size": 19980, + "sha256": "01714778b742c576daf87bd978c620a5f8209aee29cad6b00f68afd4de2eb7e1" + }, + { + "path": "src/res/KM_ResSprites.pas", + "remote_path": "src/res/KM_ResSprites.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "231b24bae05ac6c728ee6e1d32a32ed849193e9d", + "size": 76890, + "sha256": "71c41037967133876085160d0a183748458f70be3777e97a9944efe4a50f57e6" + }, + { + "path": "src/res/KM_ResSpritesEdit.pas", + "remote_path": "src/res/KM_ResSpritesEdit.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0f3dbd251414a6ffd46d3adffff7d40ad1a78ad4", + "size": 27158, + "sha256": "959b955b5eeb288090274b23abcf6f0b8fedc88df06a84cd65f91885949f33d5" + }, + { + "path": "src/res/KM_ResTexts.pas", + "remote_path": "src/res/KM_ResTexts.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2855e98bab2226fbee1893e7ae7129bea16e851c", + "size": 13144, + "sha256": "fc85f9101cbf59b0750a1972eef947aa2cea7f0ac9cdb8a1392d57dcd689fad6" + }, + { + "path": "src/res/KM_ResTileset.pas", + "remote_path": "src/res/KM_ResTileset.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "06d7da92724ab3eaef9d02ff98bc04ea3278a6d0", + "size": 26137, + "sha256": "e12b1ab7abdc15d37da892a41acd03c13712ae13dd22803b3040642640c36374" + }, + { + "path": "src/res/KM_ResTilesetTypes.pas", + "remote_path": "src/res/KM_ResTilesetTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a123337985413687b8c6ce54ffe2e3c037bb5d47", + "size": 8301, + "sha256": "8ed4e76c80ef292d1c691bad4398531a2e398b750ae715091f99757fc8f1958d" + }, + { + "path": "src/res/KM_ResTypes.pas", + "remote_path": "src/res/KM_ResTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "21523793c27858811b07ba072e0fa11f53126516", + "size": 11168, + "sha256": "da87e96d5c0dd726dd7ca0a9fd9d7b7814370d29fce442a4e4288d396b1b1dea" + }, + { + "path": "src/res/KM_ResUnits.pas", + "remote_path": "src/res/KM_ResUnits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "df06a17d70b2e3c00db8afac5461f6358a3df025", + "size": 23141, + "sha256": "b616a69e9cd44df5a06bacdd218dc609540d679c5229e92a34d3ace82d10df04" + }, + { + "path": "src/res/KM_ResWares.pas", + "remote_path": "src/res/KM_ResWares.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c422946b9039bbbc270a5100027d9246708a9761", + "size": 10802, + "sha256": "cbcc2f76dc628b7c60313937ccbccb20cc1c539fdf2781af5e7810ed1d8d2dd7" + }, + { + "path": "src/res/KM_Resource.pas", + "remote_path": "src/res/KM_Resource.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "11a8f376ee7b8f06d696b001757b4f61c34a474f", + "size": 7900, + "sha256": "1ff94e5ceee7ee6056e6ee16c1e34d74fdeb8d858f9841564ef405e1b62dac51" + }, + { + "path": "src/res/KM_Saves.pas", + "remote_path": "src/res/KM_Saves.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4154b5829f480a404aed71256119b82c164b5acf", + "size": 22393, + "sha256": "efb3956500f51850493f8f1020084f7351a7739a811ead01728bc507a7a6a34f" + }, + { + "path": "src/scripting/KM_ScriptErrorHandler.pas", + "remote_path": "src/scripting/KM_ScriptErrorHandler.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6129ccd35d4c8cab8e406fc2f03cd3b8dc86b1eb", + "size": 9462, + "sha256": "5ed32a173e820a6e5dbc3fb45d18b22a9c71dd3c513fb85bc5c8111db2d9b54f" + }, + { + "path": "src/scripting/KM_ScriptFilesCollection.pas", + "remote_path": "src/scripting/KM_ScriptFilesCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4e12809cab95dcf3af8afa13df077a3031d7a9f7", + "size": 3857, + "sha256": "516bd3ee7d69f8d41597b62788f10eccedc93b489d32d46591ccace416cf56c7" + }, + { + "path": "src/scripting/KM_ScriptPreProcessor.pas", + "remote_path": "src/scripting/KM_ScriptPreProcessor.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "385ee001b22f2ac46055468244b0e1d993d61fbe", + "size": 20198, + "sha256": "db63347b5f2cf280760fe21e0c3e174f9e9eb06320906e8196536af83a0c75ec" + }, + { + "path": "src/scripting/KM_ScriptPreProcessorGame.pas", + "remote_path": "src/scripting/KM_ScriptPreProcessorGame.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5e681f2af338df12a5c5f50b45452ab38ef49881", + "size": 4159, + "sha256": "ea78ac6664360b87ce17af52c4d745deda25e5297d06ce153449f0fbc24c9a0f" + }, + { + "path": "src/scripting/KM_ScriptValidatorResult.pas", + "remote_path": "src/scripting/KM_ScriptValidatorResult.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac9c2ff1c6d92ab7f4062807ce63248eb7f4ea55", + "size": 4530, + "sha256": "80736f212cea53ea0844af0ce393e65d389e2cdcf3dcb54d7666e52cd998f062" + }, + { + "path": "src/scripting/KM_Scripting.pas", + "remote_path": "src/scripting/KM_Scripting.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62a8da0e302d51b6e2e7955a51213dcd5a1a138e", + "size": 134475, + "sha256": "bd6a6a261aee500c6842ca17081b257e1763e7496e6af8292a3da34ec9fecf43" + }, + { + "path": "src/scripting/KM_ScriptingActions.pas", + "remote_path": "src/scripting/KM_ScriptingActions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ec51212f06faca7c322d6acd71a3c2920c3af661", + "size": 193496, + "sha256": "8f9d644a13bf76bed881c06c30442d963f01a393cb66c8c92400fca986b33fc8" + }, + { + "path": "src/scripting/KM_ScriptingConsoleCommands.pas", + "remote_path": "src/scripting/KM_ScriptingConsoleCommands.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa14c1cc55857878f0379399131019cf3b111e0d", + "size": 106968, + "sha256": "fbf7eb215640c840c399c9e1c98bc0d480c536f3947a4f4969b51f6799a25061" + }, + { + "path": "src/scripting/KM_ScriptingEvents.pas", + "remote_path": "src/scripting/KM_ScriptingEvents.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de883730330ab08c1e99ee6cbfdd6432e3f97026", + "size": 48639, + "sha256": "5e6557eb26a45ec2a5e5538a3df58374312f759fac6934339e20432e654d3477" + }, + { + "path": "src/scripting/KM_ScriptingIdCache.pas", + "remote_path": "src/scripting/KM_ScriptingIdCache.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0505593bbafb300e58e614574328a1e1116f712b", + "size": 9728, + "sha256": "50637b64c86334ee72be847218d79e2c4fb8657e89c62a017a322ce639346ada" + }, + { + "path": "src/scripting/KM_ScriptingStates.pas", + "remote_path": "src/scripting/KM_ScriptingStates.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7d182144d7b8f0f2873f690eaad5a8e60717a87f", + "size": 181334, + "sha256": "abbf037947e17e33cf8a6c0e5cd0e308195782f26d66f0897430661217feb738" + }, + { + "path": "src/scripting/KM_ScriptingTypes.pas", + "remote_path": "src/scripting/KM_ScriptingTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9c774a1c96d0f757e5edc7a7516eceb69ce8db02", + "size": 4092, + "sha256": "642d715cfa26bb95ac8c6d50f4f12d9374b849a3b17ea60c88aec77d88f2766d" + }, + { + "path": "src/scripting/KM_ScriptingUtils.pas", + "remote_path": "src/scripting/KM_ScriptingUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "989940c4314a99c3fa654ea0b55a9585ca0d7030", + "size": 30470, + "sha256": "cf4640f508295691542bc15f1fef033a09b4f9a7e98b0b5bc085d956ed16b7da" + }, + { + "path": "src/settings/KM_GameAppSettings.pas", + "remote_path": "src/settings/KM_GameAppSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0094894050747abca6e94ea6adf76339cebcb8cb", + "size": 3177, + "sha256": "bdc0a64e58f58da116984a61ef9a12db5dde2cec902ead3d611a01ba7991ac3d" + }, + { + "path": "src/settings/KM_GameAppSettingsPart.pas", + "remote_path": "src/settings/KM_GameAppSettingsPart.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5fbbd2c3d9dd7efc93f7b4fe4fa40a772c1f9bca", + "size": 403, + "sha256": "be90b49726b86ddabb80aafd98779125605b5004111a7766cafa690e82923cb6" + }, + { + "path": "src/settings/KM_GameSettings.pas", + "remote_path": "src/settings/KM_GameSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d26450d288708d82e8edd9b29381ff0a72b78e08", + "size": 31983, + "sha256": "2626ba448a0a3fa6536d4eb2f552fcbb6e758cd7947bcab5ea20fa936d4fc075" + }, + { + "path": "src/settings/KM_KeysSettings.pas", + "remote_path": "src/settings/KM_KeysSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5d95b6bce3190b61e00273e71dc1d8477b5caae1", + "size": 1961, + "sha256": "711261664fdbfb4db69ff595b292c1646b0d25c96650944e40f8fb98e2c7a433" + }, + { + "path": "src/settings/KM_MainSettings.pas", + "remote_path": "src/settings/KM_MainSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "7da3718637222d42434982b83c9483f2c64e62a2", + "size": 5716, + "sha256": "371c85064c459620164c324d8424b8ee7e093c8af2337ad3023f205a0c2ff8a9" + }, + { + "path": "src/settings/KM_Resolutions.pas", + "remote_path": "src/settings/KM_Resolutions.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "70fd26960f886002c2f7e883c1ca955c4991b337", + "size": 7776, + "sha256": "1ba1cddaea0913e6983324f28fce369a03d871cf7632117cb9f2c3cc151e08dc" + }, + { + "path": "src/settings/KM_ServerSettings.pas", + "remote_path": "src/settings/KM_ServerSettings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c5bdf0c26ed93a1cce2da98ea82373f64c88b8ef", + "size": 11967, + "sha256": "1478600343b2aa65da764b9b6d452dfb86a24223fec2f50d38064c685e60445b" + }, + { + "path": "src/settings/KM_Settings.pas", + "remote_path": "src/settings/KM_Settings.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b09a47ae4a0658dea40411051832f89f47900e5e", + "size": 3410, + "sha256": "2c89a7d558980bedda717be243a04036d83da9455ca3c78ae1d6bc134ba0bea0" + }, + { + "path": "src/settings/KM_SettingsDev.pas", + "remote_path": "src/settings/KM_SettingsDev.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c2e68825becf9469e7dfa4c096760392447f612a", + "size": 8129, + "sha256": "483317c77ca65406283be86ac4f2886dfe8bf8104147d120c29c37f429723659" + }, + { + "path": "src/settings/KM_SettingsXML.pas", + "remote_path": "src/settings/KM_SettingsXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d232b326492d87f4262ac786c743ad6773246787", + "size": 1003, + "sha256": "67957fc140bb6231a77fdb7a05a5a3223f4c59b5d569d109c519d1d0b00641d4" + }, + { + "path": "src/settings/KM_WindowParams.pas", + "remote_path": "src/settings/KM_WindowParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d9b85225bc76508608221c812675c2005cfa548a", + "size": 4875, + "sha256": "50ec7777724152822610576b411199ff222ccca8c6fcd789962c0012c0ac9099" + }, + { + "path": "src/terrain/KM_RMGUtils.pas", + "remote_path": "src/terrain/KM_RMGUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "2b226c28a266f713c47acc107408e6f75abb88c9", + "size": 36528, + "sha256": "219cd38f8c10e8ceff1700f9cc391e675e1530e40d9faf70b8ceff694d032b7d" + }, + { + "path": "src/terrain/KM_RandomMapGenerator.pas", + "remote_path": "src/terrain/KM_RandomMapGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "9dc37b7cdef2f528995bb0da6f4d0b4ed5995d42", + "size": 233583, + "sha256": "06e77ddf00c571ca960cb46a06821bb61b076e77e46c207d6f9cd642708315c9" + }, + { + "path": "src/terrain/KM_Terrain.pas", + "remote_path": "src/terrain/KM_Terrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1cdd7695273acd13efa6b880e5d816231bb3c58c", + "size": 197541, + "sha256": "1d48ec7beff93eee4285f73c33241fac8bc2f264bfb2506feebb93d851810c16" + }, + { + "path": "src/terrain/KM_TerrainDeposits.pas", + "remote_path": "src/terrain/KM_TerrainDeposits.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "80bcb8bb30843e7617a89914bb3a0da95ea12874", + "size": 6275, + "sha256": "b65863930f7c3ed6d117f3d88b55d164a0fee42b33e3cd461089c58f770f1194" + }, + { + "path": "src/terrain/KM_TerrainFinder.pas", + "remote_path": "src/terrain/KM_TerrainFinder.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "85f5e19a0a31d022dfc44fac9469763bebeeaa5c", + "size": 9136, + "sha256": "5ce044de41bc804f6f269adc33f9307e2b9812af3da18c8da96a6d09cee91cdc" + }, + { + "path": "src/terrain/KM_TerrainPainter.pas", + "remote_path": "src/terrain/KM_TerrainPainter.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "87026ece3b1a51ca44bc7474095610510b7a514b", + "size": 99997, + "sha256": "2b6dee391d9c67ecbdc5ae4a82c8d2cb8c96a8773ed289d34332a289ee75d2b1" + }, + { + "path": "src/terrain/KM_TerrainSelection.pas", + "remote_path": "src/terrain/KM_TerrainSelection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "04ba4c97b6b0f88a147e836f42d0451ddc2e35c1", + "size": 34297, + "sha256": "ae2d9d50f1a776130836fdcd4d77723d3992d1457dddb2d3c1cecdd83058eb24" + }, + { + "path": "src/terrain/KM_TerrainTypes.pas", + "remote_path": "src/terrain/KM_TerrainTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "a4fa297745430088bd6cae6fad71fac7481b88b5", + "size": 8940, + "sha256": "af3771efe6e35ae3ad725f0f198b1031ae5e10a0a32bf7a89873c1b7c6af32fe" + }, + { + "path": "src/terrain/KM_TerrainUtils.pas", + "remote_path": "src/terrain/KM_TerrainUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97cf4c2fe531871226fccbae8e343b201403c36e", + "size": 8845, + "sha256": "81b5eedcebd2cdddd04df8d71d3b218b6bcaee6a692a0e5bd014a9802571a1a1" + }, + { + "path": "src/terrain/KM_TerrainWalkConnect.pas", + "remote_path": "src/terrain/KM_TerrainWalkConnect.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f5cba21da2a57ddb8b241db508d918af57846a67", + "size": 16916, + "sha256": "a05f7a8bcc9179b5a170cc70e8c3b82800db8935e06dfb24c455567a156f6f28" + }, + { + "path": "src/terrain/KM_TestMapGenerator.pas", + "remote_path": "src/terrain/KM_TestMapGenerator.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cd9431212a4bc4ccf2b58d3dad3653179abbecb4", + "size": 26939, + "sha256": "9e6699463002e9dad2187836de56d55836feac29e36020af2c31c66b881f25c0" + }, + { + "path": "src/units/KM_UnitGroup.pas", + "remote_path": "src/units/KM_UnitGroup.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d7ac195146d6e5de5feae858abe02b498e006149", + "size": 82640, + "sha256": "5391a982fe5113e8b25a80064faf82af41c992e07e68e754bdd5759dd3af9ef7" + }, + { + "path": "src/units/KM_UnitGroupTypes.pas", + "remote_path": "src/units/KM_UnitGroupTypes.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "93dbff0ab2245363a4f728f7b395ac3b1631882b", + "size": 1085, + "sha256": "2a9bc0ee03b13698ec708664c45509bf13187d92d5bb5165ebd07fa5c8203220" + }, + { + "path": "src/units/KM_UnitVisual.pas", + "remote_path": "src/units/KM_UnitVisual.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b66b9950fc3781f534224b952dcba330a0bb7598", + "size": 4812, + "sha256": "5674a2ce24f0bc8c2544417d05763be2a766cb6d16cfd6fcec4af51164c15019" + }, + { + "path": "src/units/KM_UnitWarrior.pas", + "remote_path": "src/units/KM_UnitWarrior.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "60a100538218696b6e6ec63c0ebb6b25b37564a1", + "size": 39063, + "sha256": "d8919c585648d50969407067a12061140946d6132e755f3ce9bb04e52df2b824" + }, + { + "path": "src/units/KM_UnitWorkPlan.pas", + "remote_path": "src/units/KM_UnitWorkPlan.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fce775b799ee8456c7f56db90971692898d9f6cb", + "size": 28794, + "sha256": "067ba9e63c9ec1de59e2cfe787691dc2e91225415f56e522a4491ea3f9181e03" + }, + { + "path": "src/units/KM_Units.pas", + "remote_path": "src/units/KM_Units.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "de4da08c29d964df7daa19e2ac1b0b98824ef510", + "size": 95355, + "sha256": "2038fc1f99da72cc36db21ce8117a018c12a24d40272928d1a0e942512dbac40" + }, + { + "path": "src/units/KM_UnitsCollection.pas", + "remote_path": "src/units/KM_UnitsCollection.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b51d1028a7af516f780ff1fd3c48950f1ddb506d", + "size": 12192, + "sha256": "327bca7972ffc179fd70cc8a9c821719b457321e3a5ea23c5d3b2411eff2db22" + }, + { + "path": "src/units/actions/KM_UnitActionAbandonWalk.pas", + "remote_path": "src/units/actions/KM_UnitActionAbandonWalk.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e03688b0aaf82514fe9929fb09dfa2c9aa96df91", + "size": 3613, + "sha256": "0893fe66654e22226aa840817d9b62f7541acd325c12e97577b7e6f4847dcda4" + }, + { + "path": "src/units/actions/KM_UnitActionFight.pas", + "remote_path": "src/units/actions/KM_UnitActionFight.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "45106d696204c67e633fde0d89303ceade578977", + "size": 14268, + "sha256": "15e0e9c75bcaf9a1191ec6c727f432893a2f4f9af018f7a38f61a15181f29db7" + }, + { + "path": "src/units/actions/KM_UnitActionGoInOut.pas", + "remote_path": "src/units/actions/KM_UnitActionGoInOut.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "28abbda0bb7c1b20aa315fc24ec2401cccdfb5af", + "size": 17414, + "sha256": "77d7dd54ed7858f73df5fddb9ed1cd91fa9907c9af4fbc1fdda659b2da6a7468" + }, + { + "path": "src/units/actions/KM_UnitActionStay.pas", + "remote_path": "src/units/actions/KM_UnitActionStay.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d613428353b3a1254037b61a84c7477adebe306f", + "size": 4700, + "sha256": "d174e902214ea40077637830a7d676679b2b2a69f597e16254910b08de8106ba" + }, + { + "path": "src/units/actions/KM_UnitActionSteer.pas", + "remote_path": "src/units/actions/KM_UnitActionSteer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b061abf73677bf5295b19105c87e7f944bbdcc33", + "size": 6252, + "sha256": "18d60e0c25be704cbb866faa208794234fb4b4e8502c7907ac6da33d99b46f8b" + }, + { + "path": "src/units/actions/KM_UnitActionStormAttack.pas", + "remote_path": "src/units/actions/KM_UnitActionStormAttack.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "8e43e9129cdebf46c7fa31c67f2f5c9388f95d74", + "size": 7433, + "sha256": "99cb80496c322d14b014bc78bb30ac5fe33ff413a6fd83078e5f7784bded56bf" + }, + { + "path": "src/units/actions/KM_UnitActionWalkTo.pas", + "remote_path": "src/units/actions/KM_UnitActionWalkTo.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "489cd2637ecd36f5b03765b51a32208b90b7eed8", + "size": 59462, + "sha256": "7c4be01ec4c11665d510f98d447f1657b4679779a8bb10a3a3eddf49bd8f7aee" + }, + { + "path": "src/units/tasks/KM_UnitTaskAttackHouse.pas", + "remote_path": "src/units/tasks/KM_UnitTaskAttackHouse.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "49fa6d4e7b44107a1ef522e6a24bdad0e2087915", + "size": 7235, + "sha256": "83d099ff4e799693f6d76b19b8bda361d031b39975e482ad628939aabbbdd062" + }, + { + "path": "src/units/tasks/KM_UnitTaskBuild.pas", + "remote_path": "src/units/tasks/KM_UnitTaskBuild.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3421e8fca8c4c355c3f04f7123f8a8e6f3a0a3d9", + "size": 30925, + "sha256": "33c4a2ef02899af16f73534afd5d7b891e2fcd6e811c8d9d3eceddadee82114c" + }, + { + "path": "src/units/tasks/KM_UnitTaskDelivery.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDelivery.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c98bf400e175e2ab21067485ef4252d56c21870d", + "size": 21469, + "sha256": "6d6b1e35870847999c7c5448769cc4474220a9a2b02f23ea560978c6a2c304bf" + }, + { + "path": "src/units/tasks/KM_UnitTaskDie.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDie.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f6a690f32d25d7c7748cc212c7d4c6a08badabb4", + "size": 3814, + "sha256": "47fecc16018295ec14bd1b7cb26efa0ba2a997758228b19fde83ff987a26bcb5" + }, + { + "path": "src/units/tasks/KM_UnitTaskDismiss.pas", + "remote_path": "src/units/tasks/KM_UnitTaskDismiss.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fef1e21d5466df968d3108dc1949a6267d962327", + "size": 3988, + "sha256": "041b6127ad18500f54be33eb46d0a12c57a79593efc6ace4d907581665fa41d3" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoEat.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoEat.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "6af67bda43417d91caa7d29916c51a65bfc34dd8", + "size": 5955, + "sha256": "a54e0d001354e821aec77be2193a055ecd968d3db8f03fb8e5fbf4626aa3e4f5" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoHome.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoHome.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "97dae133263bed1b1e071da47b218887e0d2ab83", + "size": 1266, + "sha256": "e719c0811ee01015ceb32ce0199e67b2ead56848bed23f0041e9c1100b39c2f7" + }, + { + "path": "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas", + "remote_path": "src/units/tasks/KM_UnitTaskGoOutShowHungry.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4f86aded43040a3461ec9f59151f93feef418407", + "size": 1291, + "sha256": "8a28939c56ad2465c09c13770746815a647b88b18575b6b0221d79543dc94954" + }, + { + "path": "src/units/tasks/KM_UnitTaskMining.pas", + "remote_path": "src/units/tasks/KM_UnitTaskMining.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "62fde07a8344a44db3e61d419d8b5b619236d39a", + "size": 17971, + "sha256": "c8598d7e34ec553457d2cd45e6bcbebf921ca1df29a1078ff946956cf82bfd20" + }, + { + "path": "src/units/tasks/KM_UnitTaskSelfTrain.pas", + "remote_path": "src/units/tasks/KM_UnitTaskSelfTrain.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "4af4cc71503cc7761ad602c4b468948167c60f90", + "size": 3468, + "sha256": "346cf727bcac2f35238a56b276dee58e693918abf3a8d20060f97aa7b0fd12f4" + }, + { + "path": "src/units/tasks/KM_UnitTaskThrowRock.pas", + "remote_path": "src/units/tasks/KM_UnitTaskThrowRock.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "0e379e4a0dc2900f543092f2b2f2001a2dde355a", + "size": 3072, + "sha256": "a0db11548e238d08eba8902a9a99abdee53bf30f925af30c0881f83023c76daf" + }, + { + "path": "src/unused/KM_Achievements.pas", + "remote_path": "src/unused/KM_Achievements.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "1627369a8bb7e2798f9b9118fdc9a134e875905c", + "size": 5264, + "sha256": "a4aa63abedd1fae979ea47623e2a00c0b663dfa2920df0d68883384e316ee3a2" + }, + { + "path": "src/unused/KM_CommonSave.pas", + "remote_path": "src/unused/KM_CommonSave.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "ac544cb2b373cc96dcaa0e5c3ebd85e9e981f138", + "size": 19606, + "sha256": "a744f680b1f2f46025689ecd0be438aad7c020437c46e45713494d7548c81bbb" + }, + { + "path": "src/unused/KM_PerfLog.pas", + "remote_path": "src/unused/KM_PerfLog.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c7ba870ef4fafdaf83a1eb96bb77239247027863", + "size": 8684, + "sha256": "b5f74a52c7618c80f3d3326d9b01b733c429ddc24666e1d5d10dcb0ef9c0267d" + }, + { + "path": "src/utils/KM_CommonShellUtils.pas", + "remote_path": "src/utils/KM_CommonShellUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "98a993db503e41d3d725bfcdbc251ef6d4ac3daf", + "size": 2096, + "sha256": "3564ae767371f014b36dcc9d80f3cc676b2c3d8bf8830b7b63b34c31cdd607b1" + }, + { + "path": "src/utils/KM_CommonUtils.pas", + "remote_path": "src/utils/KM_CommonUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5bc5f80ca081d496c8e8fa0100f8de9f8aa7b77d", + "size": 56821, + "sha256": "10fe873247e96c7cce22964698e2ce8bed3cbf5649c544671f0373af6fa1a473" + }, + { + "path": "src/utils/KM_ConsoleTimer.pas", + "remote_path": "src/utils/KM_ConsoleTimer.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "888d08da9cb6c54fcf555a8c5a64ade4639b58bf", + "size": 3429, + "sha256": "9b61e7dc93e717ac4f642e647315a3808a129b5f2753dbc9756e3ca717e1c3ec" + }, + { + "path": "src/utils/KM_Utils.pas", + "remote_path": "src/utils/KM_Utils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "3105f99be8f41e67774f7672e3baa2d1cf375ef2", + "size": 9907, + "sha256": "575fd9debc927c22d5f5141117ecb1d523c0206ef7229fc36e9e975885231d10" + }, + { + "path": "src/utils/KM_UtilsExt.pas", + "remote_path": "src/utils/KM_UtilsExt.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "5dd2e212a45e992a32c41f9cd441ee25b0fd4156", + "size": 2410, + "sha256": "f7a6b8032163af15e0a49e59b7d9049be38719965630bbbbad0b22aca62d6de8" + }, + { + "path": "src/utils/KromOGLUtils.pas", + "remote_path": "src/utils/KromOGLUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "e7b61f7d43155fe489a82587227fd48d76537f8e", + "size": 8986, + "sha256": "c0c37cb2e0711263dd204eb2f009264f2746fe80f3bf9bf6c0a3f9e050d3171f" + }, + { + "path": "src/utils/KromShellUtils.pas", + "remote_path": "src/utils/KromShellUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "96e9a289e105876378a16d3b67fdcc879b00085d", + "size": 3719, + "sha256": "b12109f7f24c1964e1c6bca0c27964eb17c582c65b1bcb3f92f398cc858532cc" + }, + { + "path": "src/utils/KromUtils.pas", + "remote_path": "src/utils/KromUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "c9f0ede949d7d6ecc8e18e4ead628e7c06bf1087", + "size": 13594, + "sha256": "5c566985c7c38e11445bd50956e25cd46fe0eb10ffec392d3b6f9094a51b2bf7" + }, + { + "path": "src/utils/algorithms/BinaryHeap.pas", + "remote_path": "src/utils/algorithms/BinaryHeap.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "136e36b21905898384ecba6295a8485fd519d8f0", + "size": 2790, + "sha256": "d69cc2d09fa0457ae307ab1400dce6a34bafc0f5c9acb90b3402a2bce74d1407" + }, + { + "path": "src/utils/algorithms/BinaryHeapGen.pas", + "remote_path": "src/utils/algorithms/BinaryHeapGen.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "aa043116c055bfeea4abdf85221ab3f92f3444e4", + "size": 3558, + "sha256": "2350457d3eabffce6e18c4ecbd6c3e76b063f0be4fc257b74c5b6fe8a082e53a" + }, + { + "path": "src/utils/algorithms/KM_BinPacking.pas", + "remote_path": "src/utils/algorithms/KM_BinPacking.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "cf94cac6151b0fd92fd8dfd610500fe8d332fef9", + "size": 7312, + "sha256": "dbc4d31c8e1563c9023753d6cd21f3cd1ef9d6d6d71495ab3443aaf38df66e00" + }, + { + "path": "src/utils/algorithms/KM_FloodFill.pas", + "remote_path": "src/utils/algorithms/KM_FloodFill.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "65bbbd20e77d1b252c8df7ea3982cd4c1bd8a23b", + "size": 4378, + "sha256": "360d93af8c9985b408b6c285a2ad1b2cc334bbcebfc1d57d86cd77fc97e9d9df" + }, + { + "path": "src/utils/algorithms/KM_Hungarian.pas", + "remote_path": "src/utils/algorithms/KM_Hungarian.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "bcef2a016599c1ed3ba621e9c1c3e847bc0e8325", + "size": 12257, + "sha256": "246539dc70df75c3a0b056eee2248d55e50a21ffe16e993befed5e09c11639ee" + }, + { + "path": "src/utils/algorithms/KM_MarchingSquares.pas", + "remote_path": "src/utils/algorithms/KM_MarchingSquares.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "256488306ada37d83444f9b27e712bbc0951af89", + "size": 6734, + "sha256": "2139602886e7fc2f7c7cc38dedcce660d06e85c0333aab0fec8eef20fd0102fb" + }, + { + "path": "src/utils/algorithms/KM_SoftShadows.pas", + "remote_path": "src/utils/algorithms/KM_SoftShadows.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "44421d7c415742eed9ecf7d563cef688f55b39c4", + "size": 11868, + "sha256": "de6979e4ae6c3f5ee78bf2516d7f023ee7e19ab0d01bddef62206d92c0d60fa0" + }, + { + "path": "src/utils/algorithms/KM_Sort.pas", + "remote_path": "src/utils/algorithms/KM_Sort.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "f7daf2e9a3861aaf5cd67abbb636196f6cf6a7d6", + "size": 1688, + "sha256": "38fefe4e3d2254fc0ca580870e893c1b64d42bf1c1fa13d2a8eb2e6b2151d687" + }, + { + "path": "src/utils/io/KM_FileIO.pas", + "remote_path": "src/utils/io/KM_FileIO.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "fca15e86b77e2d0b0498fafffe1cdb415e9b7302", + "size": 19584, + "sha256": "fdccdbcab177e47764e49bca8dd33f91a4d10c0fae9b2494ccdd93491af05ebf" + }, + { + "path": "src/utils/io/KM_IoGraphicUtils.pas", + "remote_path": "src/utils/io/KM_IoGraphicUtils.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "d77c0c2699e159dad35b3af995984ed8c59feb33", + "size": 2255, + "sha256": "f2cded9bc28bc3cc5effdb4174fb3161d7d2744d0a4400edd5c7a1fd8a0b5fb0" + }, + { + "path": "src/utils/io/KM_IoJSON.pas", + "remote_path": "src/utils/io/KM_IoJSON.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "363a5803927ea347aa9cc19d879593e95d4d9e8a", + "size": 10490, + "sha256": "c6d5167b15589d9348019f886d64b9644372a8a5016076b3ef4dec388b7a6dc8" + }, + { + "path": "src/utils/io/KM_IoPNG.pas", + "remote_path": "src/utils/io/KM_IoPNG.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "b9e6f3ee52edd520fb3f9fd29d4bb759a28bbd20", + "size": 3761, + "sha256": "f332f78b011f6ea5f762699f742d11af12e888cd570f9499453c4dd074087abd" + }, + { + "path": "src/utils/io/KM_IoXML.pas", + "remote_path": "src/utils/io/KM_IoXML.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "786ed35b5d0c1136113da08fe9c0de1abcc1c6cf", + "size": 11159, + "sha256": "870a2d11608c3aa9f8cd1f06c796db570d9ef26f5545d689a0ab58cf3bd2742e" + }, + { + "path": "src/utils/method_parser/KM_MethodParser.pas", + "remote_path": "src/utils/method_parser/KM_MethodParser.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "243ee9492a3bab9dd262dcde4bb3859d7332bfe7", + "size": 13417, + "sha256": "f9073edd89534e7e2385021d2dae17f3f5f2d087c1730e65014a2722b3d31c08" + }, + { + "path": "src/utils/method_parser/KM_MethodParserParams.pas", + "remote_path": "src/utils/method_parser/KM_MethodParserParams.pas", + "repository": "reyandme/kam_remake", + "commit": "962fb850324b79bbe5480e1c2087d98f83a60917", + "git_blob_sha1": "546c8871f88f5c0337595404b1f45f99df883740", + "size": 1734, + "sha256": "f5afe1d508977258c11f005cfa8b6755ac7d9f678a110ca0f03ccb954380c4a8" + } + ] +} diff --git a/vendor/kam_remake/Utils/RVO2/LICENSE.txt b/vendor/kam_remake/Utils/RVO2/LICENSE.txt new file mode 100644 index 0000000..77f83a2 --- /dev/null +++ b/vendor/kam_remake/Utils/RVO2/LICENSE.txt @@ -0,0 +1,13 @@ +RVO Library / RVO2 Library + +Copyright © 2008-10 University of North Carolina at Chapel Hill. All rights reserved. + +Permission to use, copy, modify, and distribute this software and its documentation for educational, research, and non-profit purposes, without fee, and without a written agreement is hereby granted, provided that the above copyright notice, this paragraph, and the following four paragraphs appear in all copies. + +Permission to incorporate this software into commercial products may be obtained by contacting the University of North Carolina at Chapel Hill. + +This software program and documentation are copyrighted by the University of North Carolina at Chapel Hill. The software program and documentation are supplied "as is", without any accompanying services from the University of North Carolina at Chapel Hill or the authors. The University of North Carolina at Chapel Hill and the authors do not warrant that the operation of the program will be uninterrupted or error-free. The end-user understands that the program was developed for research purposes and is advised not to rely exclusively on the program for any reason. + +IN NO EVENT SHALL THE UNIVERSITY OF NORTH CAROLINA AT CHAPEL HILL OR ITS EMPLOYEES OR THE AUTHORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF NORTH CAROLINA AT CHAPEL HILL OR THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +THE UNIVERSITY OF NORTH CAROLINA AT CHAPEL HILL AND THE AUTHORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE AND ANY STATUTORY WARRANTY OF NON-INFRINGEMENT. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE UNIVERSITY OF NORTH CAROLINA AT CHAPEL HILL AND THE AUTHORS HAVE NO OBLIGATIONS TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. \ No newline at end of file diff --git a/vendor/kam_remake/src/KM_Console.pas b/vendor/kam_remake/src/KM_Console.pas new file mode 100644 index 0000000..269c82c --- /dev/null +++ b/vendor/kam_remake/src/KM_Console.pas @@ -0,0 +1,351 @@ +unit KM_Console; +{$I KaM_Remake.inc} +interface +uses + Generics.Collections, + KM_CommonTypes, KM_NetTypes; + + +type + TKMChatMode = (cmAll, cmTeam, cmSpectators, cmWhisper); + + TKMConsole = class + private + fLastConsoleTime: Cardinal; + fHistory: TList; + fCurrConsoleHistoryId: Integer; + fOnChange: TKMEvent; + fOnPost: TUnicodeStringEvent; + fOnPostLocal: TUnicodeStringEvent; + fOnError: TUnicodeStringEvent; + fMessages: UnicodeString; + + procedure SetMessages(const aMessages: UnicodeString); + + function TryDoCallConsoleCommand: Boolean; + public + Text: UnicodeString; + + constructor Create; + destructor Destroy; override; + + property Messages: UnicodeString read fMessages write SetMessages; + + property OnPost: TUnicodeStringEvent read fOnPost write fOnPost; + property OnPostLocal: TUnicodeStringEvent read fOnPostLocal write fOnPostLocal; + property OnError: TUnicodeStringEvent read fOnError write fOnError; + property OnChange: TKMEvent read fOnChange write fOnChange; + + procedure Post(aPropagate: Boolean = True); + function IsPostAllowed: Boolean; + function TryCallConsoleCommand: Boolean; + + function GetNextHistoryMsg: UnicodeString; + function GetPrevHistoryMsg: UnicodeString; + + procedure Add(const aMessage: UnicodeString); + procedure AddLine(const aMessage: UnicodeString); + + procedure Clear; virtual; + end; + + + TKMChat = class(TKMConsole) + private + fMode: TKMChatMode; + procedure SetMode(aMode: TKMChatMode); + public + WhisperRecipient: TKMNetHandleIndex; + + constructor Create; + destructor Destroy; override; + + property Mode: TKMChatMode read fMode write SetMode; + + procedure Clear; override; + end; + + +var + gChat: TKMChat; + +const + CHAT_COOLDOWN = 500; //Minimum time in milliseconds between chat messages + CHAT_TAG: array[TKMChatMode] of Integer = ( + -1, //cmAll + -2, //cmTeam + -3, //cmSpectators + -1); //cmWhisper + + +implementation +uses + Math, SysUtils, StrUtils, + KM_ResTexts, + KM_ScriptingEvents, KM_ScriptingConsoleCommands, + KM_Game, KM_GameInputProcess, + KM_CommonUtils, KM_Defaults; + +const + DEF_CURR_CONSOLE_HISTORY_ID = -1; + + +{ TKMConsole } +constructor TKMConsole.Create; +begin + inherited; + + fHistory := TList.Create; + + Clear; +end; + + +destructor TKMConsole.Destroy; +begin + FreeAndNil(fHistory); + + inherited; +end; + + +procedure TKMConsole.Clear; +begin + fLastConsoleTime := 0; + fHistory.Clear; + fCurrConsoleHistoryId := DEF_CURR_CONSOLE_HISTORY_ID; + Messages := ''; + Text := ''; +end; + + +procedure TKMConsole.SetMessages(const aMessages: UnicodeString); +begin + fMessages := aMessages; +end; + + +function TKMConsole.GetNextHistoryMsg: UnicodeString; +begin + if fHistory.Count = 0 then + begin + Result := ''; + Exit; + end; + + fCurrConsoleHistoryId := Min(fCurrConsoleHistoryId + 1, fHistory.Count - 1); + Result := fHistory[fCurrConsoleHistoryId]; +end; + + +function TKMConsole.GetPrevHistoryMsg: UnicodeString; +begin + if fHistory.Count = 0 then Exit(''); + + fCurrConsoleHistoryId := Max(0, fCurrConsoleHistoryId - 1); + Result := fHistory[fCurrConsoleHistoryId]; +end; + + +procedure TKMConsole.Add(const aMessage: UnicodeString); +begin + fMessages := fMessages + aMessage; + + if Assigned(fOnChange) then + fOnChange; +end; + + +procedure TKMConsole.AddLine(const aMessage: UnicodeString); +begin + if fMessages <> '' then + begin + //if not fMessages.EndsWith('[]') then + if not EndsText('[]', fMessages) then + fMessages := fMessages + '[]'; + fMessages := fMessages + '|'; + end; + + Add(aMessage); +end; + + +function TKMConsole.IsPostAllowed : Boolean; +begin + Result := (Trim(Text) <> '') and (TimeSince(fLastConsoleTime) >= CHAT_COOLDOWN) +end; + + +function TKMConsole.TryCallConsoleCommand: Boolean; +begin + Result := False; + if gGame = nil then //Can't manage console commands while not in the game + Exit; + + // Text starts with / and its long enough to have some script command in there + if (Length(Text) > 1) and (Text[1] = '/') then + begin + if (Text[2] = '/') then + Delete(Text, 1, 1) //Remove one of the /'s + else + begin + TryDoCallConsoleCommand; + //Add command to history, but do not propagate post to others + Post(False); + Result := True; + end; + end; +end; + + +function TKMConsole.TryDoCallConsoleCommand: Boolean; +var + I, paramsI, procParamsCnt, spacePos: Integer; + cmdName: AnsiString; + paramsStr, param, parsingErrorStr: String; + params: TKMScriptCommandParamsArray; + quoteStart, parsingError: Boolean; + + procedure AddParam(const aParam: String); + begin + if aParam <> '' then + begin + if paramsI < Length(params) then + params[paramsI] := aParam; + Inc(paramsI); + end; + end; + +begin + Result := False; + spacePos := Pos(' ', Text); + if spacePos = 0 then + spacePos := Length(Text) + 1; + + cmdName := AnsiString(Copy(Text, 2, spacePos - 2)); + + if not gScriptEvents.HasConsoleCommand(cmdName) + and Assigned(fOnError) then + begin + fOnError(Format(gResTexts[TX_SCRIPT_CONSOLE_CMD_NOT_FOUND], [WrapColorA(cmdName, clScriptCmdName)])); + Exit; + end; + + procParamsCnt := gScriptEvents.ConsoleCommand[cmdName].ProcParamsCnt; + + paramsStr := RightStr(Text, Length(Text) - (spacePos - 1)); + + paramsI := 0; + param := ''; + quoteStart := False; + paramsStr := StringReplace(paramsStr, '\''', #1, [rfReplaceAll]); + + for I := 1 to Length(paramsStr) do + begin + if (paramsStr[I] = ' ') and not quoteStart then + begin + AddParam(param); + param := ''; + end + else + if paramsStr[I] = '''' then + quoteStart := not quoteStart + else + param := param + paramsStr[I]; + end; + + AddParam(param); + + parsingError := False; + parsingErrorStr := Format(gResTexts[TX_SCRIPT_CONSOLE_CMD_PARSING_ERROR] + '|', + [WrapColorA(cmdName, clScriptCmdName), + gScriptEvents.ConsoleCommand[cmdName].Params2String(params)]); + + if (paramsI > procParamsCnt) + and Assigned(fOnError) then + begin + fOnError(parsingErrorStr + + Format(gResTexts[TX_SCRIPT_CONSOLE_CMD_TOO_MANY_PARAMS], + [WrapColorA(cmdName, clScriptCmdName), + WrapColor(IntToStr(procParamsCnt), clScriptCmdParam), + WrapColor(IntToStr(paramsI), clScriptCmdParam)])); //We Inc ParamsI at the end + parsingError := True; + end; + + for I := 0 to paramsI - 1 do + params[I] := StringReplace(params[I], #1, '''', [rfReplaceAll]); + + for I := paramsI to MAX_SCRIPT_CONSOLE_COMMAND_PARAMS - 1 do + params[I] := ''; + + if not gScriptEvents.ConsoleCommand[cmdName].ValidateParams(params) + and Assigned(fOnError) then + begin + fOnError(parsingErrorStr + + Format(gResTexts[TX_SCRIPT_CONSOLE_CMD_PARAMS_NOT_VALID], + [WrapColorA(cmdName, clScriptCmdName), + gScriptEvents.ConsoleCommand[cmdName].ParamsTypes2String])); + parsingError := True; + end; + + if not parsingError then + begin + gGame.GameInputProcess.CmdConsoleCommand(gicScriptConsoleCommand, cmdName, params); + if Assigned(fOnPostLocal) then + fOnPostLocal(Format(gResTexts[TX_SCRIPT_CONSOLE_CMD_CALLED], + [WrapColorA(cmdName, clScriptCmdName), + gScriptEvents.ConsoleCommand[cmdName].Params2String(params)])); + Result := True; + end; +end; + + +procedure TKMConsole.Post(aPropagate: Boolean = True); +begin + fLastConsoleTime := TimeGet; + + fHistory.Insert(0, Text); + fCurrConsoleHistoryId := -1; + + if aPropagate and Assigned(fOnPost) then + fOnPost(Text); + + Text := ''; +end; + + +{ TKMChat } +constructor TKMChat.Create; +begin + inherited; + + Clear; + + gChat := Self; +end; + + +destructor TKMChat.Destroy; +begin + gChat := nil; + + inherited; +end; + + +procedure TKMChat.Clear; +begin + inherited; + + WhisperRecipient := -1000; + fMode := cmAll; +end; + + +procedure TKMChat.SetMode(aMode: TKMChatMode); +begin + fMode := aMode; +end; + + +end. diff --git a/vendor/kam_remake/src/KM_Crashreport.pas b/vendor/kam_remake/src/KM_Crashreport.pas new file mode 100644 index 0000000..dda51aa --- /dev/null +++ b/vendor/kam_remake/src/KM_Crashreport.pas @@ -0,0 +1,189 @@ +unit KM_Crashreport; +{$I KaM_Remake.inc} +interface +uses + MadExcept, + KM_GameTypes, + KM_Defaults; + +type + // Intention of this class is to encapsulate the crash report generation, + // since it is already quite complex task and spans several methods, + // which are not quite related to the Game's SRP + TKMCrashReport = class + private + fExceptIntf: IMEException; + fZipFile: UnicodeString; + + fAttachedFilesStr: UnicodeString; + procedure AttachFile(const aFile: UnicodeString); + procedure AttachEverything; + procedure AttachSaveFiles(const aFile: UnicodeString; aAttachRNG: Boolean = True); + procedure AttachLoadedFiles(aAttachRNG: Boolean); + public + constructor Create(const aExceptIntf: IMEException; const aZipFile: UnicodeString); + class procedure Generate(const aExceptIntf: IMEException; const aZipFile: UnicodeString); + end; + +implementation +uses + SysUtils, Math, + KM_CommonUtils, KM_InterfaceTypes, KM_Log, KM_Game; + + +constructor TKMCrashReport.Create(const aExceptIntf: IMEException; const aZipFile: UnicodeString); +begin + inherited Create; + + fExceptIntf := aExceptIntf; + fZipFile := aZipFile; +end; + + +procedure TKMCrashReport.AttachFile(const aFile: UnicodeString); +begin + if (aFile <> '') and FileExists(aFile) then + begin + if Pos(aFile, fAttachedFilesStr) = 0 then + begin + fAttachedFilesStr := fAttachedFilesStr + aFile + '; '; + fExceptIntf.AdditionalAttachments.Add(aFile, '', fZipFile); + gLog.AddTime('Attached file: ' + aFile); + end + else + gLog.AddTime('File already attached: ' + aFile); + end; +end; + + +procedure TKMCrashReport.AttachSaveFiles(const aFile: UnicodeString; aAttachRNG: Boolean = True); +begin + AttachFile(ChangeFileExt(aFile, EXT_SAVE_MAIN_DOT)); + AttachFile(ChangeFileExt(aFile, EXT_SAVE_BASE_DOT)); + AttachFile(ChangeFileExt(aFile, EXT_SAVE_REPLAY_DOT)); + AttachFile(ChangeFileExt(aFile, EXT_SAVE_MP_LOCAL_DOT)); + if aAttachRNG then + AttachFile(ChangeFileExt(aFile, EXT_SAVE_RNG_LOG_DOT)); +end; + + +procedure TKMCrashReport.AttachLoadedFiles(aAttachRNG: Boolean); +begin + if gGame.SaveFile = '' then Exit; + + gLog.AddTime('Attaching game loaded file: ' + ExeDir + gGame.SaveFile); + AttachSaveFiles(ExeDir + gGame.SaveFile, aAttachRNG); +end; + + +procedure TKMCrashReport.AttachEverything; +var + index: Byte; + missionFile, path: UnicodeString; + searchRec: TSearchRec; + indexesSet: set of Byte; +begin + gLog.AddTime('Creating crash report...'); + + // Attempt to save the game, but if the state is too messed up it might fail + gGame.SaveWorkerThreadHolder.Worker.fSynchronousExceptionMode := True; //Do saving synchronously in main thread + try + try + if (gGame.Params.Mode in [gmSingle, gmCampaign, gmMulti, gmMultiSpectate]) + and not (gGame.GamePlayInterface.UIMode = umReplay) then //In case game mode was altered or loaded with logical error + begin + gGame.Save(CRASHREPORT_SAVE_NAME, UTCNow, gGame.SaveWorkerThreadHolder.Worker); + gGame.SaveWorkerThreadHolder.Worker.WaitForAllWorkToComplete; //Wait till save is made + AttachSaveFiles(gGame.SaveName(CRASHREPORT_SAVE_NAME, EXT_SAVE_MAIN, gGame.Params.IsMultiPlayerOrSpec)); + end; + except + on E : Exception do + gLog.AddTime('Exception while trying to save game for crash report: ' + E.ClassName + ': ' + E.Message + {$IFDEF WDC}+ sLineBreak + E.StackTrace{$ENDIF}); + end; + finally + gGame.SaveWorkerThreadHolder.Worker.fSynchronousExceptionMode := False; + end; + + missionFile := gGame.Params.MissionFileRel; + path := ExtractFilePath(ExeDir + missionFile); + + // Try to attach the dat+map + AttachFile(ExeDir + missionFile); + AttachFile(ExeDir + ChangeFileExt(missionFile, '.map')); + AttachFile(ExeDir + ChangeFileExt(missionFile, '.txt')); + + // Try to add main script file and all other scripts, because they could be included + if FileExists(ExeDir + ChangeFileExt(missionFile, '.script')) then + begin + FindFirst(path + '*.script', faAnyFile - faDirectory, searchRec); + try + repeat + if (searchRec.Name <> '.') and (searchRec.Name <> '..') then + AttachFile(path + searchRec.Name); + until (FindNext(searchRec) <> 0); + finally + FindClose(searchRec); + end; + end; + + // Try to add libx files + FindFirst(path + '*.libx', faAnyFile - faDirectory, searchRec); + try + repeat + if (searchRec.Name <> '.') and (searchRec.Name <> '..') then + AttachFile(path + searchRec.Name); + until (FindNext(searchRec) <> 0); + finally + FindClose(searchRec); + end; + + if gGame.Params.IsReplay + or ((gGame.GamePlayInterface <> nil) and (gGame.GamePlayInterface.UIMode = umReplay)) then //In case game mode was altered or loaded with logical error + // For replays attach only replay save files + AttachLoadedFiles(False) + else + if not gGame.Params.IsMapEditor then // no need autosaves for MapEd error... + begin + // For other game modes attach last saves + + // We want to attach up to 3 saves, lets determine what are best indexes of last saves to attach + indexesSet := []; + // 0 is the oldest save + case gGame.LastSaves.Count of + 0: ; + 1,2,3: indexesSet := [0,1,2]; + 4: indexesSet := [0,2,3]; + else + indexesSet := [0, gGame.LastSaves.Count div 2, gGame.LastSaves.Count - 1]; + end; + + for index in indexesSet do + begin + if index >= gGame.LastSaves.Count then Break; + + AttachSaveFiles(gGame.SaveName(gGame.LastSaves[index], EXT_SAVE_MAIN, gGame.Params.IsMultiPlayerOrSpec)); + end; + + // It could be usefull to attach loaded file, to check what was wrong there + AttachLoadedFiles(True); // Also attach RNG file + end; + + gLog.AddTime('Crash report created'); +end; + + +class procedure TKMCrashReport.Generate(const aExceptIntf: IMEException; const aZipFile: UnicodeString); +var + cr: TKMCrashReport; +begin + cr := TKMCrashReport.Create(aExceptIntf, aZipFile); + try + cr.AttachEverything; + finally + cr.Free; + end; +end; + + +end. diff --git a/vendor/kam_remake/src/KM_Exceptions.pas b/vendor/kam_remake/src/KM_Exceptions.pas new file mode 100644 index 0000000..9b947c9 --- /dev/null +++ b/vendor/kam_remake/src/KM_Exceptions.pas @@ -0,0 +1,189 @@ +unit KM_Exceptions; +{$I KaM_Remake.inc} +interface +uses + MadExcept, madNVAssistant; + + +type + TKMExceptions = class + private + procedure DoException(const ExceptIntf: IMEException; var Handled: boolean); + public + constructor Create; + procedure LoadTranslation; + end; + + //MadExcept requires this to not be within an object for some reason + procedure DoCreateAssistant(const assistant: INVAssistant; const exception: IUnknown); + +var + gExceptions: TKMExceptions; + + +implementation +uses + SysUtils, + KM_FileIO, KM_Cursor, + KM_GameApp, KM_CrashReport, KM_Game, + KM_Log, KM_ResTexts, KM_Defaults, KM_Points, + KM_CommonExceptions, KM_Settings, KM_GameAppSettings, KM_ServerSettings; + + +{ TKMExceptions } +constructor TKMExceptions.Create; +begin + inherited; + OnAssistantCreate := DoCreateAssistant; + RegisterExceptionHandler(DoException, stTrySyncCallAlways); + MESettings.HttpServer := 'http://master.kamremake.com/crashupload.php?rev=' + GAME_REVISION; +end; + + +procedure TKMExceptions.LoadTranslation; +begin + if gResTexts = nil then Exit; // If the exception happens before translations are loaded + + MESettings.ExceptMsg := gResTexts[TX_ERROR_MESSAGE]; + MESettings.SendBtnCaption := gResTexts[TX_ERROR_SEND]; + MESettings.ShowBtnCaption := gResTexts[TX_ERROR_SHOW_DATA]; + MESettings.CloseBtnCaption := gResTexts[TX_ERROR_TERMINATE]; + MESettings.ContinueBtnCaption := gResTexts[TX_ERROR_RESUME]; + MESettings.SendBoxTitle := gResTexts[TX_ERROR_SENDING_TITLE]; + MESettings.SendMailMsg := gResTexts[TX_ERROR_SENDING_DATA]; + MESettings.SendAttachMsg := gResTexts[TX_ERROR_SENDING_DATA]; + MESettings.SendFinalizeMsg := gResTexts[TX_ERROR_SENDING_DATA]; + MESettings.PrepareAttachMsg := gResTexts[TX_ERROR_SENDING_CONNECTING]; + MESettings.ConnectMsg := gResTexts[TX_ERROR_SENDING_CONNECTING]; + MESettings.SendFailureMsg := gResTexts[TX_ERROR_SENDING_FAILED]; + MESettings.PleaseWaitTitle := gResTexts[TX_ERROR_WAIT_TITLEBAR]; + MESettings.PleaseWaitText := gResTexts[TX_ERROR_WAIT_MESSAGE]; +end; + + +// We have to load the translations for the send assistant when it is created, that's the only way +procedure DoCreateAssistant(const assistant: INVAssistant; const exception: IUnknown); +begin + if gResTexts = nil then Exit; // If the exception happens before translations are loaded + + if assistant.FormCount = 3 then //That's how we know it's the send assistant, not one of the others (which we currently don't use) + begin + assistant.Title := gResTexts[TX_ERROR_SEND]; + //Contact details form + assistant.Forms[0].Message := gResTexts[TX_ERROR_SEND_CONTACT]; + assistant.Forms[0].nvLabel('Label1').Caption := gResTexts[TX_ERROR_SEND_NAME]; + assistant.Forms[0].nvLabel('Label2').Caption := gResTexts[TX_ERROR_SEND_EMAIL]; + assistant.Forms[0].nvCheckBox('MemCheck').Caption := gResTexts[TX_ERROR_SEND_REMEMBER]; + assistant.Forms[0].ContinueButton.Caption := gResTexts[TX_ERROR_SEND_NEXT]; + assistant.Forms[0].CancelButton.Caption := gResTexts[TX_ERROR_SEND_CANCEL]; + + //Error details form + assistant.Forms[1].Message := gResTexts[TX_ERROR_SEND_DETAILS]; + assistant.Forms[1].nvLabel('Label1').Caption := gResTexts[TX_ERROR_SEND_DETAILS_MESSAGE]; + assistant.Forms[1].ContinueButton.Caption := gResTexts[TX_ERROR_SEND_NEXT]; + assistant.Forms[1].CancelButton.Caption := gResTexts[TX_ERROR_SEND_CANCEL]; + + //Screenshot form + assistant.Forms[2].Message := gResTexts[TX_ERROR_SEND_SCREENSHOT]; + assistant.Forms[2].nvCheckBox('AttachCheck').Caption := gResTexts[TX_ERROR_SEND_SCREENSHOT_MESSAGE]; + assistant.Forms[2].nvLabel('Label1').Caption := gResTexts[TX_ERROR_SEND_SCREENSHOT_EDIT]; + assistant.Forms[2].ContinueButton.Caption := gResTexts[TX_ERROR_SEND_SEND]; + assistant.Forms[2].CancelButton.Caption := gResTexts[TX_ERROR_SEND_CANCEL]; + end; +end; + + +procedure TKMExceptions.DoException(const ExceptIntf: IMEException; var Handled: boolean); + +var + crashFile: string; + + procedure AttachFile(const aFile: UnicodeString); + begin + if (aFile <> '') and FileExists(aFile) then + begin + ExceptIntf.AdditionalAttachments.Add(aFile, '', crashFile); + gLog.AddTime('Attached file: ' + aFile); + end; + end; + +var + logMessage, viewportStr: string; + sharedSettingsPath: string; +begin + if gLog = nil then Exit; //Could crash very early before even the log file is created + + //It's nice to know when the exception happened in our log if the user decides to play on and sends the report later + logMessage := 'Exception occurred [' + ExceptIntf.ExceptClass + ']: ' + ExceptIntf.ExceptMessage; + if ExceptIntf.ExceptObject is ELocError then + logMessage := logMessage + ' at location ' + TypeToString(ELocError(ExceptIntf.ExceptObject).Loc); + gLog.AddTime(logMessage); + gLog.AddNoTime('================================================================================'); + gLog.AddNoTime(' START BUG REPORT '); + gLog.AddNoTime('================================================================================'); + gLog.AddNoTime(ExceptIntf.BugReport); + gLog.AddNoTime('================================================================================'); + gLog.AddNoTime(' END BUG REPORT '); + gLog.AddNoTime('================================================================================'); + + //Append the exception message on a new paragraph of the dialog. It might be useful to the user (e.g. file permissions wrong) + //and sometimes people send us a screenshot of the crash report window, it would be nice to know what the error was from that. + if gResTexts <> nil then + ExceptIntf.ExceptMsg := gResTexts[TX_ERROR_MESSAGE]+#13#10+#13#10+logMessage + else + //Still need a sensible message if gResTexts failed to load for some reason. ENG is default + ExceptIntf.ExceptMsg := 'An error occurred in the application. Please click Send Bug Report so we can investigate this issue. Thanks for your help!'+#13#10+#13#10+logMessage; + + //We want to add some of our own files to the report + crashFile := 'KaM_Crash_' + UnicodeString(GAME_REVISION) + '_' + FormatDateTime('yyyy-mm-dd_hh-nn-ss', Now) + '.zip'; + MESettings.BugReportZip := crashFile; //Exception info also goes in the zip + MESettings.ScreenShotZip := crashFile; //Screenshot also goes in the zip + + if gGame <> nil then + begin + TKMCrashReport.Generate(ExceptIntf, crashFile); + viewportStr := gGame.ActiveInterface.Viewport.ToStr(); + end + else + viewportStr := 'nil'; + + // Do the log after gGame because gGame adds stuff to the log + if gLog <> nil then + begin + if gGameApp <> nil then + gLog.AddTime('UI at crash time: MainPanel sizes: %s, cursor pos: %s, viewport: %s,' + sLineBreak + + 'CtrlDown = %s' + sLineBreak + + 'CtrlOver = %s' + sLineBreak + + 'CtrlUp = %s' + sLineBreak + + 'CtrlFocus = %s', + [gGameApp.ActiveInterface.GetMainPanelSize.ToString, viewportStr, gCursor.Pixel.ToString, + gGameApp.ActiveInterface.MyControls.CtrlDown.ToStr, + gGameApp.ActiveInterface.MyControls.CtrlOver.ToStr, + gGameApp.ActiveInterface.MyControls.CtrlUp.ToStr, + gGameApp.ActiveInterface.MyControls.CtrlFocus.ToStr]); + + AttachFile(gLog.LogPath); + end; + + sharedSettingsPath := TKMSettings.GetDir; + + // Do settings here not in gGame because we could crash before gGame is created + if gGameAppSettings <> nil then + AttachFile(gGameAppSettings.Path) + else + begin + AttachFile(sharedSettingsPath + SETTINGS_FILE); + AttachFile(ExeDir + SETTINGS_FILE); + end; + + if gServerSettings <> nil then + ExceptIntf.AdditionalAttachments.Add(gServerSettings.Path, '', crashFile) + else + begin + AttachFile(sharedSettingsPath + SERVER_SETTINGS_FILE); + AttachFile(ExeDir + SERVER_SETTINGS_FILE); + end; +end; + + +end. diff --git a/vendor/kam_remake/src/KM_GameApp.pas b/vendor/kam_remake/src/KM_GameApp.pas new file mode 100644 index 0000000..9282516 --- /dev/null +++ b/vendor/kam_remake/src/KM_GameApp.pas @@ -0,0 +1,1462 @@ +unit KM_GameApp; +{$I KaM_Remake.inc} +interface +uses + {$IFDEF WDC} UITypes, {$ENDIF} + {$IFDEF FPC} Controls, {$ENDIF} + Classes, + Dialogs, SysUtils, + KM_CommonTypes, KM_Defaults, KM_RenderControl, KM_Video, + KM_Campaigns, KM_Game, KM_InterfaceDefaults, KM_InterfaceMainMenu, KM_InterfaceTypes, KM_Resource, + KM_Music, KM_Maps, KM_MapTypes, KM_CampaignClasses, KM_Networking, + KM_GameSettings, + KM_KeysSettings, + KM_ServerSettings, + KM_Render, + KM_GameTypes, KM_Points, KM_Console, + KM_WorkerThread; + +type + //Methods relevant to gameplay + TKMGameApp = class + private + fGlobalTickCount: Cardinal; + fIsExiting: Boolean; + fIsLoading: Boolean; + + fCampaigns: TKMCampaignsCollection; + fServerSettings: TKMServerSettings; + fNetworking: TKMNetworking; + + fMainMenuInterface: TKMMainMenuInterface; + + fChat: TKMChat; + + fOnStatusBarUpdate: TProc; + fOnGameSpeedChange: TSingleEvent; + fOnGameStart: TKMGameModeChangeEvent; + fOnGameEnd: TKMGameModeChangeEvent; + + fOnOptionsChange: TKMEvent; + + // Worker threads + fSaveWorkerThreadHolder: TKMWorkerThreadHolder; // Worker thread for normal saves and save at the end of PT + fBaseSaveWorkerThreadHolder: TKMWorkerThreadHolder; // Worker thread for base save only + fAutoSaveWorkerThreadHolder: TKMWorkerThreadHolder; // Worker thread for autosaves only + fSavePointWorkerThreadHolder: TKMWorkerThreadHolder; // Worker thread for savepoints only + + procedure CreateGame(aGameMode: TKMGameMode); + + procedure GameLoadingStep(const aText: UnicodeString); + procedure LoadGameAssets; + procedure LoadGameFromSave(const aFilePath: String; aGameMode: TKMGameMode; const aGIPPath: String = ''); + procedure LoadGameFromScript(const aMissionFullFilePath, aGameName: String; aFullCRC, aSimpleCRC: Cardinal; aCampaign: TKMCampaign; + aMap: Byte; aGameMode: TKMGameMode; aDesiredLoc: ShortInt; aDesiredColor: Cardinal; + aDifficulty: TKMMissionDifficulty = mdNone; aAIType: TKMAIType = aitNone); + procedure LoadGameSavePoint(aTick: Cardinal); + procedure LoadGameFromScratch(aSizeX, aSizeY: Integer; aGameMode: TKMGameMode); + function SaveName(const aName, aExt: UnicodeString; aIsMultiplayer: Boolean): UnicodeString; + + procedure GameStarted(aGameMode: TKMGameMode); + procedure GameEnded(aGameMode: TKMGameMode); + procedure GameDestroyed; + procedure GameFinished; + function GetGameSettings: TKMGameSettings; + procedure SetOnOptionsChange(const aEvent: TKMEvent); + + procedure InitMainMenu(aScreenX, aScreenY: Word); + function GetActiveInterface: TKMUserInterfaceCommon; + + procedure UpdatePerflog; + public + constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent; + aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc; NoMusic: Boolean = False); + destructor Destroy; override; + procedure AfterConstruction(aReturnToOptions: Boolean); reintroduce; + + procedure PrepageStopGame(aMsg: TKMGameResultMsg); + procedure StopGame(aMsg: TKMGameResultMsg; const aTextMsg: UnicodeString = ''); + procedure AnnounceReturnToLobby; + procedure PrepareReturnToLobby(aTimestamp: TDateTime); + procedure StopGameReturnToLobby; + function CanClose: Boolean; + procedure Resize(X,Y: Integer); + procedure ToggleLocale(const aLocale: AnsiString; aReturnToMenuPage: TKMMenuPageType); + procedure NetworkInit; + procedure SendMPGameInfo; + function CheckDATConsistency: Boolean; + + function RenderVersion: UnicodeString; + procedure PrintScreen(const aFilename: UnicodeString = ''; aImageType: TKMImageType = itJpeg); + procedure SaveGameWholeMapToImage(aImageType: TKMImageType; aMaxImageSize: Integer = 0); + + procedure PreloadGameResources; + + //These are all different game kinds we can start + procedure NewCampaignMap(aCampaignIdStr: UnicodeString; aMap: Word; aDifficulty: TKMMissionDifficulty = mdNone); + procedure NewSingleMap(const aMissionFullPath, aGameName: UnicodeString; aDesiredLoc: ShortInt = -1; + aDesiredColor: Cardinal = NO_OVERWRITE_COLOR; aDifficulty: TKMMissionDifficulty = mdNone; + aAIType: TKMAIType = aitNone); + procedure NewSingleSave(const aSaveName: UnicodeString); + procedure NewMultiplayerMap(const aFileName: UnicodeString; aMapKind: TKMMapKind; aCRC: Cardinal; aSpectating: Boolean; + aDifficulty: TKMMissionDifficulty); + procedure NewMultiplayerSave(const aSaveName: UnicodeString; Spectating: Boolean); + + procedure NewRestartLastSPGame; + procedure NewRestartLast(const aGameName, aMissionFileRel, aSave: UnicodeString; aGameMode: TKMGameMode; aCampName: TKMCampaignId; + aCampMap: Byte; aLocation: Byte; aColor: Cardinal; aDifficulty: TKMMissionDifficulty = mdNone; + aAIType: TKMAIType = aitNone); + + procedure NewEmptyMap(aSizeX, aSizeY: Integer); + procedure NewMapEditor(const aFullFilePath: UnicodeString; aMultiplayerLoadMode: Boolean); overload; + procedure NewMapEditor(const aFullFilePath: UnicodeString; aSizeX: Integer = 0; aSizeY: Integer = 0; + aMapFullCRC: Cardinal = 0; aMapSimpleCRC: Cardinal = 0; aMultiplayerLoadMode: Boolean = False); overload; + + procedure NewReplay(const aFilePath: UnicodeString); + procedure NewSaveAndReplay(const aSavPath, aRplPath: UnicodeString); + + function TryLoadSavePoint(aTick: Integer): Boolean; + procedure LoadPrevSavePoint; + + procedure SaveMapEditor(const aPathName: UnicodeString); + + property Campaigns: TKMCampaignsCollection read fCampaigns; + function Game: TKMGame; + property GameSettings: TKMGameSettings read GetGameSettings; + + property ActiveInterface: TKMUserInterfaceCommon read GetActiveInterface; + property MainMenuInterface: TKMMainMenuInterface read fMainMenuInterface; + + property Networking: TKMNetworking read fNetworking; + property GlobalTickCount: Cardinal read fGlobalTickCount; + property Chat: TKMChat read fChat; + + procedure KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean); + procedure KeyPress(Key: Char); + procedure KeyUp(Key: Word; Shift: TShiftState); + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); + procedure MouseMove(Shift: TShiftState; X,Y: Integer); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); + procedure MouseWheel(Shift: TShiftState; WheelSteps: Integer; X,Y: Integer; var aHandled: Boolean); + procedure SendFPSMeasurement(aFPS: Integer); + + procedure UnlockAllCampaigns; + + procedure DebugControlsUpdated(Sender: TObject; aSenderTag: Integer); + + property OnGameSpeedActualChange: TSingleEvent read fOnGameSpeedChange write fOnGameSpeedChange; + property OnGameStart: TKMGameModeChangeEvent read fOnGameStart write fOnGameStart; + property OnGameEnd: TKMGameModeChangeEvent read fOnGameEnd write fOnGameEnd; + property OnOptionsChange: TKMEvent read fOnOptionsChange write SetOnOptionsChange; + + procedure Render(aForPrintScreen: Boolean = False); + procedure UpdateState; + procedure UpdateStateIdle(aFrameTime: Cardinal); + procedure DoGameTick; + end; + + +var + gGameApp: TKMGameApp; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLType, {$ENDIF} + DateUtils, Math, TypInfo, KromUtils, + {$IFDEF USE_MAD_EXCEPT} KM_Exceptions, {$ENDIF} + KM_System, + KM_FormLogistics, + KM_Main, KM_Controls, KM_Log, KM_Sound, KM_GameInputProcess, KM_GameInputProcess_Multi, + KM_HandsCollection, + KM_GameSavePoints, + KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes, + KM_IoGraphicUtils, KM_Settings, + KM_Saves, KM_CommonUtils, KM_CommonShellUtils, + {$IFDEF DBG_RNG_SPY}KM_RandomChecks,{$ENDIF} + KM_DevPerfLog, KM_DevPerfLogTypes; + + +{ TKMGameApp } +// Creating everything needed for MainMenu, game stuff is created on StartGame +constructor TKMGameApp.Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent; + aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc; NoMusic: Boolean = False); +begin + inherited Create; + + fCampaigns := TKMCampaignsCollection.Create; + + fOnStatusBarUpdate := aOnStatusBarUpdate; + + gResKeys := TKMResKeys.Create; + + gKeySettings.UpdateResKeys; + + // When creating local server from inside the game, + // it makes sense to store its settings along with the game's in the shared folder + fServerSettings := TKMServerSettings.Create(slShared); + + gRender := TKMRender.Create(aRenderControl, aScreenX, aScreenY, aVSync); + + fChat := TKMChat.Create; + + gCursor := TKMCursor.Create; + + {$IFDEF DBG_RNG_SPY} + if gGameSettings.DebugSaveRandomChecks and not DBG_DISALLOW_TO_SAVE_RANDOM_CHECKS then + gRandomCheckLogger := TKMRandomCheckLogger.Create; + {$ENDIF} + + gRes := TKMResource.Create(aOnLoadingStep, aOnLoadingText); + gRes.LoadMainResources(gGameSettings.Locale, gGameSettings.GFX.LoadFullFonts); + + {$IFDEF USE_MAD_EXCEPT}gExceptions.LoadTranslation;{$ENDIF} + + //Show the message if user has old OpenGL drivers (pre-1.4) + if gRender.IsOldGLVersion then + //MessageDlg works better than Application.MessageBox or others, it stays on top and + //pauses here until the user clicks ok. + MessageDlg(gResTexts[TX_GAME_ERROR_OLD_OPENGL] + EolW + EolW + gResTexts[TX_GAME_ERROR_OLD_OPENGL_2], mtWarning, [mbOk], 0); + + gSoundPlayer := TKMSoundPlayer.Create(gGameSettings.SFX.SoundFXVolume); + gMusic := TKMMusicLib.Create(gGameSettings.SFX.MusicVolume); + gSoundPlayer.OnRequestFade := gMusic.Fade; + gSoundPlayer.OnRequestUnfade := gMusic.Unfade; + + //If game was reinitialized from options menu then we should return there + InitMainMenu(aScreenX, aScreenY); + + // Start the Music playback as soon as loading is complete + if not NoMusic and gGameSettings.SFX.MusicEnabled then + gMusic.PlayMenuTrack; + + gMusic.ToggleShuffle(gGameSettings.SFX.ShuffleOn); //Determine track order + + fSaveWorkerThreadHolder := TKMWorkerThreadHolder.Create('SaveWorker'); + fAutoSaveWorkerThreadHolder := TKMWorkerThreadHolder.Create('AutoSaveWorker'); + fBaseSaveWorkerThreadHolder := TKMWorkerThreadHolder.Create('BaseSaveWorker'); + fSavePointWorkerThreadHolder := TKMWorkerThreadHolder.Create('SavePointsWorker'); + + fOnGameStart := GameStarted; + fOnGameEnd := GameEnded; +end; + + +procedure TKMGameApp.AfterConstruction(aReturnToOptions: Boolean); +begin + if aReturnToOptions then + fMainMenuInterface.PageChange(gpOptions) + else + fMainMenuInterface.PageChange(gpMainMenu); +end; + + +{ Destroy what was created } +destructor TKMGameApp.Destroy; +begin + //Freeing network sockets and OpenAL can result in events like Resize/Paint occuring (seen in crash reports) + //Set fIsExiting so we know to skip them + fIsExiting := True; + + //We might have crashed part way through .Create, so we can't assume ANYTHING exists here. + //Doing so causes a 2nd exception which overrides 1st. Hence check <> nil on everything except Free (TObject.Free does that already) + + // Stop music immediately, so it doesn't keep playing and jerk while things get destroyed + if gMusic <> nil then gMusic.Stop; + + StopGame(grSilent); + + //This will ensure all queued work is completed before destruction + FreeAndNil(fSaveWorkerThreadHolder); + FreeAndNil(fAutoSaveWorkerThreadHolder); + FreeAndNil(fBaseSaveWorkerThreadHolder); + FreeAndNil(fSavePointWorkerThreadHolder); + + FreeAndNil(fChat); + FreeThenNil(fCampaigns); + FreeThenNil(fServerSettings); + FreeThenNil(fMainMenuInterface); + FreeThenNil(gRes); + FreeThenNil(gSoundPlayer); + FreeThenNil(gMusic); + FreeAndNil(fNetworking); + {$IFDEF DBG_RNG_SPY} FreeAndNil(gRandomCheckLogger); {$ENDIF} + FreeAndNil(gCursor); + + FreeThenNil(gRender); + + FreeThenNil(gResKeys); + + inherited; +end; + + +procedure TKMGameApp.InitMainMenu(aScreenX, aScreenY: Word); +begin + fMainMenuInterface := TKMMainMenuInterface.Create(aScreenX, aScreenY, fCampaigns, + NewSingleMap, NewCampaignMap, NewMapEditor, NewReplay, NewSingleSave, + ToggleLocale, PreloadGameResources, NetworkInit); +end; + + +procedure TKMGameApp.DebugControlsUpdated(Sender: TObject; aSenderTag: Integer); +begin + if gGame = nil then + fMainMenuInterface.DebugControlsUpdated(aSenderTag) + else + gGame.DebugControlsUpdated(Sender, aSenderTag); +end; + + +//Determine if the game can be closed without loosing any important progress +function TKMGameApp.CanClose: Boolean; +begin + //There are no unsaved changes in MainMenu and in Replays + //In all other cases (maybe except gsOnHold?) there are potentially unsaved changes + Result := (gGame = nil) or gGame.Params.IsReplay; +end; + + +procedure TKMGameApp.ToggleLocale(const aLocale: AnsiString; aReturnToMenuPage: TKMMenuPageType); +begin + Assert(gGame = nil, 'We don''t want to recreate whole fGame for that. Let''s limit it only to MainMenu'); + + // Stop campaign scanning, since we will rescan them on Campaigns menu creation + fCampaigns.TerminateScan; + + gLog.AddTime('Toggle to locale ' + UnicodeString(aLocale)); + fMainMenuInterface.PageChange(gpLoading, gResTexts[TX_MENU_NEW_LOCALE]); + Render; //Force to repaint information screen + + fIsLoading := True; + gGameSettings.Locale := aLocale; //Wrong Locale will be ignored + + //Release resources that use Locale info + FreeAndNil(fNetworking); + FreeAndNil(fMainMenuInterface); + + //Recreate resources that use Locale info + gRes.LoadLocaleResources(gGameSettings.Locale); + //Fonts might need reloading too + gRes.LoadLocaleFonts(gGameSettings.Locale, gGameSettings.GFX.LoadFullFonts); + + //Force reload game resources, if they during loading process, + //as that could cause an error in the loading thread + //(did not figure it out why. Its easier just to reload game resources in that rare case) + {$IFDEF LOAD_GAME_RES_ASYNC} + if gGameSettings.AsyncGameResLoader and not gRes.Sprites.GameResLoadCompleted then + gRes.LoadGameResources(gGameSettings.GFX.AlphaShadows, True); + {$ENDIF} + + {$IFDEF USE_MAD_EXCEPT}gExceptions.LoadTranslation;{$ENDIF} + + InitMainMenu(gRender.ScreenX, gRender.ScreenY); + fMainMenuInterface.PageChange(aReturnToMenuPage); + Resize(gRender.ScreenX, gRender.ScreenY); //Force the recreated main menu to resize to the user's screen + fIsLoading := False; +end; + + +//Preload game resources while in menu +procedure TKMGameApp.PreloadGameResources; +begin + {$IFDEF LOAD_GAME_RES_ASYNC} + //Load game resources asychronously (by other thread) + if gGameSettings.AsyncGameResLoader then + gRes.LoadGameResources(gGameSettings.GFX.AlphaShadows, True); + {$ENDIF} +end; + + +procedure TKMGameApp.Resize(X,Y: Integer); +begin + if Self = nil then Exit; + if fIsExiting then Exit; + + gRender.Resize(X, Y); + gVideoPlayer.Resize(X, Y); + + //Main menu is invisible while in game, but it still exists and when we return to it + //it must be properly sized (player could resize the screen while playing) + fMainMenuInterface.Resize(X, Y); + + if gGame <> nil then + gGame.ActiveInterface.Resize(X, Y); +end; + + +// This event happens every ~33ms if the Key is Down and holded +procedure TKMGameApp.KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean); +var + keyHandled: Boolean; +begin + if gVideoPlayer.IsActive then + begin + gVideoPlayer.KeyDown(Key, Shift); + Exit; + end; + + if gGame <> nil then + gGame.ActiveInterface.KeyDown(Key, Shift, aIsFirst, keyHandled) + else + fMainMenuInterface.KeyDown(Key, Shift, aIsFirst, keyHandled); +end; + + +procedure TKMGameApp.KeyPress(Key: Char); +begin + if gGame <> nil then + gGame.ActiveInterface.KeyPress(Key) + else + fMainMenuInterface.KeyPress(Key); +end; + + +procedure TKMGameApp.KeyUp(Key: Word; Shift: TShiftState); +var + keyHandled: Boolean; +begin + //List of conflicting keys that we should try to avoid using in debug/game: + // F12 Pauses Execution and switches to debug + // F10 sets focus on MainMenu1 + // F9 is the default key in Fraps for video capture + // F4 and F9 are used in debug to control run-flow + // others.. unknown + + keyHandled := False; + + if gGame <> nil then + gGame.ActiveInterface.KeyUp(Key, Shift, keyHandled) + else + fMainMenuInterface.KeyUp(Key, Shift, keyHandled); +end; + + +procedure TKMGameApp.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if gVideoPlayer.IsActive then + begin + gVideoPlayer.MouseDown(Button, Shift, X, Y); + Exit; + end; + + if gGame <> nil then + gGame.ActiveInterface.MouseDown(Button,Shift,X,Y) + else + fMainMenuInterface.MouseDown(Button,Shift,X,Y); +end; + + +procedure TKMGameApp.MouseMove(Shift: TShiftState; X,Y: Integer); +var + ctrl: TKMControl; + ctrlID: Integer; +begin + if not InRange(X, 1, gRender.ScreenX - 1) + or not InRange(Y, 1, gRender.ScreenY - 1) then + Exit; // Exit if Cursor is outside of frame + + if gGame <> nil then + gGame.ActiveInterface.MouseMove(Shift,X,Y) + else + //fMainMenuInterface = nil while loading a new locale + if fMainMenuInterface <> nil then + fMainMenuInterface.MouseMove(Shift, X,Y); + + if Assigned(fOnStatusBarUpdate) then + begin + fOnStatusBarUpdate(spCursorCoord, Format('Cursor: %d:%d', [X, Y])); + fOnStatusBarUpdate(spTile, Format('Tile: %.1f:%.1f [%d:%d]', [gCursor.Float.X, gCursor.Float.Y, gCursor.Cell.X, gCursor.Cell.Y])); + if SHOW_CONTROLS_ID then + begin + if gGame <> nil then + ctrl := gGame.ActiveInterface.MyControls.HitControl(X,Y, True) + else + ctrl := fMainMenuInterface.MyControls.HitControl(X,Y, True); + ctrlID := -1; + if ctrl <> nil then + ctrlID := ctrl.ID; + fOnStatusBarUpdate(spControlId, Format('Control ID: %d', [ctrlID])); + end; + end; +end; + + +procedure TKMGameApp.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if gGame <> nil then + gGame.ActiveInterface.MouseUp(Button,Shift,X,Y) + else + fMainMenuInterface.MouseUp(Button, Shift, X,Y); +end; + + +procedure TKMGameApp.MouseWheel(Shift: TShiftState; WheelSteps: Integer; X, Y: Integer; var aHandled: Boolean); +begin + aHandled := False; + if Self = nil then Exit; + + if gGame <> nil then + gGame.ActiveInterface.MouseWheel(Shift, WheelSteps, X, Y, aHandled) + else + fMainMenuInterface.MouseWheel(Shift, WheelSteps, X, Y, aHandled); +end; + + +procedure TKMGameApp.SendFPSMeasurement(aFPS: Integer); +begin + fNetworking.SendFPSMeasurement(aFPS); +end; + + +function TKMGameApp.Game: TKMGame; +begin + if Self = nil then Exit(nil); + + Result := gGame; +end; + + +procedure TKMGameApp.GameLoadingStep(const aText: UnicodeString); +begin + fMainMenuInterface.AppendLoadingText(aText); + Render; +end; + + +procedure TKMGameApp.LoadGameAssets; +begin + //Load the resources if necessary + fMainMenuInterface.PageChange(gpLoading); + Render; + + GameLoadingStep(gResTexts[TX_MENU_LOADING_DEFINITIONS]); + gRes.OnLoadingText := GameLoadingStep; + gRes.LoadGameResources(gGameSettings.GFX.AlphaShadows); + + GameLoadingStep(gResTexts[TX_MENU_LOADING_INITIALIZING]); + + GameLoadingStep(gResTexts[TX_MENU_LOADING_SCRIPT]); +end; + + +procedure TKMGameApp.UnlockAllCampaigns; +begin + if fCampaigns <> nil then + begin + fCampaigns.UnlockAllCampaignsMissions; + fCampaigns.SaveProgress; + + fMainMenuInterface.RefreshCampaigns; + end; +end; + + +procedure TKMGameApp.CreateGame(aGameMode: TKMGameMode); +begin + //Reset controls if MainForm exists (KMR could be run without main form) + if gMain <> nil then + gMain.FormMain.ControlsReset; + + gGame := TKMGame.Create(aGameMode, gRender, GameDestroyed, + fSaveWorkerThreadHolder, + fBaseSaveWorkerThreadHolder, + fAutoSaveWorkerThreadHolder, + fSavePointWorkerThreadHolder); +end; + + +procedure TKMGameApp.PrepageStopGame(aMsg: TKMGameResultMsg); +var + lastSentCmdsTick: Integer; +begin + if (gGame = nil) or gGame.ReadyToStop then Exit; + + gSoundPlayer.AbortAllLongSounds; //SFX with a long duration should be stopped when quitting + gSoundPlayer.AbortAllScriptSounds; // Looped sounds should be stopped as well + + if aMsg in [grWin, grDefeat, grCancel, grSilent] then + begin + //If the game was a part of a campaign, select that campaign, + //so we know which menu to show next and unlock next map + fCampaigns.SetActive(fCampaigns.CampaignById(gGame.CampaignName)); + + if fCampaigns.ActiveCampaign <> nil then + begin + //Always save campaign data, even if the player lost (scripter can choose when to modify it) + fCampaigns.ActiveCampaign.SavedData.ScriptDataStream.Clear; + gGame.SaveCampaignScriptData(fCampaigns.ActiveCampaign.SavedData.ScriptDataStream); + + if aMsg = grWin then + fCampaigns.ActiveCampaign.UnlockNextMission(gGame.CampaignMap); //Unlock next map before save campaign progress + + //Always save Campaigns progress after mission + //We always save script data with SaveCampaignScriptData + //then campaign progress should be saved always as well on any outcome (win or lose) + //otherwise we will get inconsistency + fCampaigns.ActiveCampaign.SavedData.SaveProgress; + end; + end; + + if gGame.Params.IsMultiPlayerOrSpec then + begin + if fNetworking.Connected then + begin + if TKMGameInputProcess_Multi(gGame.GameInputProcess) <> nil then + lastSentCmdsTick := TKMGameInputProcess_Multi(gGame.GameInputProcess).LastSentCmdsTick + else + lastSentCmdsTick := LAST_SENT_COMMANDS_TICK_NONE; + fNetworking.AnnounceDisconnect(lastSentCmdsTick); + end; + fNetworking.Disconnect; + end; + + gGame.ReadyToStop := True; + + if (gGame.GamePlayInterface <> nil) and (gGame.GamePlayInterface.GuiGameSpectator <> nil) then + gGame.GamePlayInterface.GuiGameSpectator.CloseDropBox; + + if (gGame.GameResult in [grWin, grDefeat]) and not gGame.Params.IsReplay then + begin + GameFinished; + if gGameSettings.AutosaveAtGameEnd then + // We have to use local time for local save name (Now) and UTC time inside the save (UTCNow, it will be converted back to local on read) + gGame.Save(Format('%s %s #%d', [gGame.Params.Name, FormatDateTime('yyyy-mm-dd', Now), gGameSettings.DayGamesCount]), UTCNow); + end; + + if Assigned(fOnGameEnd) then + fOnGameEnd(gGame.Params.Mode); +end; + + +//Game needs to be stopped +//1. Disconnect from network +//2. Save games replay +//3. Fill in game results +//4. Fill in menu message if needed +//5. Free the game object +//6. Switch to MainMenu +procedure TKMGameApp.StopGame(aMsg: TKMGameResultMsg; const aTextMsg: UnicodeString = ''); +begin + if gGame = nil then Exit; + + PrepageStopGame(aMsg); + + case aMsg of + grWin, + grDefeat, + grCancel: case gGame.Params.Mode of + gmSingle: fMainMenuInterface.PageChange(gpSinglePlayer); + gmCampaign: if aTextMsg = '' then //Rely on text message (for campaign it should contain CampaignID) + fMainMenuInterface.PageChange(gpMainMenu) //Goto main menu in case we fail campaing mission + else + fMainMenuInterface.PageChange(gpCampaign, aTextMsg); //Goto Campaign menu in case we win campaing mission + gmMulti, + gmMultiSpectate: fMainMenuInterface.PageChange(gpMultiplayer); + end; + grReplayEnd: fMainMenuInterface.PageChange(gpReplays); + grError, + grDisconnect: begin + if gGame.Params.IsMultiPlayerOrSpec then + //After Error page User will go to the main menu, but Mutex will be still locked. + //We will need to unlock it on gGame destroy, so mark it with GameLockedMutex + gGame.LockedMutex := True; + fMainMenuInterface.PageChange(gpError, aTextMsg); + end; + grSilent: ;//Used when loading new savegame from gameplay UI + grMapEdEnd: fMainMenuInterface.PageChange(gpMapEditor); + end; + + FreeThenNil(gGame); + gLog.AddTime('Gameplay ended - ' + GetEnumName(TypeInfo(TKMGameResultMsg), Integer(aMsg)) + ' /' + aTextMsg); +end; + + +procedure TKMGameApp.AnnounceReturnToLobby; +begin + //When this GIC command is executed, it will run PrepareReturnToLobby + gGame.GameInputProcess.CmdGame(gicGameSaveReturnLobby, UTCNow); +end; + + +procedure TKMGameApp.PrepareReturnToLobby(aTimestamp: TDateTime); +begin + if gGame = nil then Exit; + gGame.Save(RETURN_TO_LOBBY_SAVE, aTimestamp); + gGame.IsPaused := True; //Freeze the game + fNetworking.AnnounceReadyToReturnToLobby; + //Now we wait for other clients to reach this step, then fNetworking triggers StopGameReturnToLobby +end; + + +procedure TKMGameApp.StopGameReturnToLobby; +begin + if gGame = nil then Exit; + + // Wait till 'paused' save will be made. We want to show it properly in the Lobby UI + gSystem.Cursor := kmcAnimatedDirSelector; + try + gGame.WaitForSaveToBeDone; + finally + gSystem.Cursor := kmcDefault; + end; + + if Assigned(fOnGameEnd) then + fOnGameEnd(gGame.Params.Mode); + + FreeThenNil(gGame); + + fNetworking.ReturnToLobby; //Clears gGame event pointers from Networking + fMainMenuInterface.ReturnToLobby(RETURN_TO_LOBBY_SAVE); //Assigns Lobby event pointers to Networking and selects map + if fNetworking.IsHost then + fNetworking.SendPlayerListAndRefreshPlayersSetup; //Call now that events are attached to lobby + + gLog.AddTime('Gameplay ended - Return to lobby'); +end; + + +procedure TKMGameApp.LoadGameFromSave(const aFilePath: String; aGameMode: TKMGameMode; const aGIPPath: String = ''); +const + SAVE_SUFFIX_DEBUG = '_dbg'; +var + loadError, filePath: String; +begin + //Save const aFilePath locally, since it could be destroyed as some Game Object instance in StopGame + //!!!!! DO NOT USE aMissionFile or aGameName further in this method + filePath := aFilePath; + //---------------------------------------------------------------------- + StopGame(grSilent); //Stop everything silently + LoadGameAssets; + + CreateGame(aGameMode); + try + gGame.LoadFromFile(filePath, aGIPPath); + except + on E: Exception do + begin + //Trap the exception and show it to the user in nicer form. + //Note: While debugging, Delphi will still stop execution for the exception, + //unless Tools > Debugger > Exception > "Stop on Delphi Exceptions" is unchecked. + //But to normal player the dialog won't show. + loadError := Format(gResTexts[TX_MENU_PARSE_ERROR], [filePath]) + '||' + E.ClassName + ': ' + E.Message; + // Log the error first, because we can crash while stopping the game + gLog.AddTime('Game creation Exception: ' + loadError + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF} + ); + StopGame(grError, loadError); + Exit; + end; + end; + + gGame.AfterLoad; //Call after load separately, so errors in it could be sended in crashreport + + if SAVE_GAME_AFTER_LOAD then + gGame.Save(gGame.Params.Name + SAVE_SUFFIX_DEBUG); + + if Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spMapSize, gGame.MapSizeInfo); +end; + + +//Do not use _const_ aMissionFile, aGameName: UnicodeString, as for some unknown reason sometimes aGameName is not accessed after StopGame(grSilent) (pointing to a wrong value) +procedure TKMGameApp.LoadGameFromScript(const aMissionFullFilePath, aGameName: String; aFullCRC, aSimpleCRC: Cardinal; aCampaign: TKMCampaign; + aMap: Byte; aGameMode: TKMGameMode; aDesiredLoc: ShortInt; aDesiredColor: Cardinal; + aDifficulty: TKMMissionDifficulty = mdNone; aAIType: TKMAIType = aitNone); +var + loadError, missionFullFilePath, gameName: String; +begin + //Save const parameters locally, since it could be destroyed as some Game Object instance in StopGame + //!!!!! DO NOT USE aMissionFile or aGameName further in this method + missionFullFilePath := aMissionFullFilePath; + gameName := aGameName; + //!!!!! ------------------------------------------------------------ + StopGame(grSilent); //Stop everything silently + LoadGameAssets; + + CreateGame(aGameMode); + try + gGame.Start(missionFullFilePath, gameName, aFullCRC, aSimpleCRC, aCampaign, aMap, aDesiredLoc, aDesiredColor, aDifficulty, aAIType); + except + on E : Exception do + begin + //Trap the exception and show it to the user in nicer form. + //Note: While debugging, Delphi will still stop execution for the exception, + //unless Tools > Debugger > Exception > "Stop on Delphi Exceptions" is unchecked. + //But to normal player the dialog won't show. + loadError := Format(gResTexts[TX_MENU_PARSE_ERROR], [missionFullFilePath]) + '||' + E.ClassName + ': ' + E.Message; + StopGame(grError, loadError); + gLog.AddTime('Game creation Exception: ' + loadError + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF} + ); + Exit; + end; + end; + + //Clear chat for SP game, as it useddthere only for console commands + if gGame.Params.IsSingleplayerGame then + fChat.Clear; + + gGame.AfterStart; //Call after start separately, so errors in it could be sended in crashreport + + if Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spMapSize, gGame.MapSizeInfo); +end; + + +procedure TKMGameApp.LoadGameSavePoint(aTick: Cardinal); +var + loadError: string; + savedReplays: TKMSavePointCollection; + gameMode: TKMGameMode; + saveFile: UnicodeString; + gameInputProcess: TKMGameInputProcess; +begin + if (gGame = nil) then Exit; + + // Get existing configuration + savedReplays := gGame.SavePoints; + gGame.SavePoints := nil; + gameMode := gGame.Params.Mode; + saveFile := gGame.SaveFile; + // Store GIP locally, to restore it later + // GIP is the same for every checkpoint, that is why its not stored in the saved replay checkpoint, so we can reuse it + gameInputProcess := gGame.GameInputProcess; + gGame.GameInputProcess := nil; + + StopGame(grSilent); //Stop everything silently + LoadGameAssets; + + CreateGame(gameMode); + try + // SavedReplays have been just created, and we will reassign them in the next line. + // Then Free the newly created save replays object first + gGame.SavePoints.Free; + gGame.SavePoints := savedReplays; + gGame.LoadSavePoint(aTick, saveFile); + gGame.LastReplayTickLocal := Max(gGame.LastReplayTickLocal, savedReplays.LastTick); + // Free GIP, which was created on game creation + gGame.GameInputProcess.Free; + // Restore GIP + gGame.GameInputProcess := gameInputProcess; + // Move GIP cursor to the actual position + gGame.GameInputProcess.MoveCursorTo(aTick); + except + on E: Exception do + begin + //Trap the exception and show it to the user in nicer form. + //Note: While debugging, Delphi will still stop execution for the exception, + //unless Tools > Debugger > Exception > "Stop on Delphi Exceptions" is unchecked. + //But to normal player the dialog won't show. + loadError := '||' + E.ClassName + ': ' + E.Message; + StopGame(grError, loadError); + gLog.AddTime('Game creation Exception: ' + loadError + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF} + ); + Exit; + end; + end; + + gGame.AfterLoad; //Call after load separately, so errors in it could be sended in crashreport + + if Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spMapSize, gGame.MapSizeInfo); +end; + + +procedure TKMGameApp.LoadGameFromScratch(aSizeX, aSizeY: Integer; aGameMode: TKMGameMode); +var + loadError: string; +begin + StopGame(grSilent); //Stop everything silently + LoadGameAssets; + + CreateGame(aGameMode); + gGame.SetSeed(4); //Every time the game will be the same as previous. Good for debug. + try + gGame.MapEdStartEmptyMap(aSizeX, aSizeY); + except + on E : Exception do + begin + //Trap the exception and show it to the user in nicer form. + //Note: While debugging, Delphi will still stop execution for the exception, + //unless Tools > Debugger > Exception > "Stop on Delphi Exceptions" is unchecked. + //But to normal player the dialog won't show. + loadError := Format(gResTexts[TX_MENU_PARSE_ERROR], ['-']) + '||' + E.ClassName + ': ' + E.Message; + StopGame(grError, loadError); + gLog.AddTime('Game creation Exception: ' + loadError + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF} + ); + Exit; + end; + end; + + if Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spMapSize, gGame.MapSizeInfo); +end; + + +procedure TKMGameApp.NewCampaignMap(aCampaignIdStr: UnicodeString; aMap: Word; aDifficulty: TKMMissionDifficulty = mdNone); +var + camp: TKMCampaign; +begin + camp := fCampaigns.CampaignByIdU(aCampaignIdStr); + LoadGameFromScript(camp.GetMissionFile(aMap), camp.GetMissionTitle(aMap), 0, 0, camp, aMap, gmCampaign, -1, NO_OVERWRITE_COLOR, aDifficulty); + + fCampaigns.SetActive(camp); + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewSingleMap(const aMissionFullPath, aGameName: UnicodeString; aDesiredLoc: ShortInt = -1; + aDesiredColor: Cardinal = NO_OVERWRITE_COLOR; aDifficulty: TKMMissionDifficulty = mdNone; + aAIType: TKMAIType = aitNone); +begin + LoadGameFromScript(aMissionFullPath, aGameName, 0, 0, nil, 0, gmSingle, aDesiredLoc, aDesiredColor, aDifficulty, aAIType); + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewSingleSave(const aSaveName: UnicodeString); +begin + //Convert SaveName to local FilePath + LoadGameFromSave(SaveName(aSaveName, EXT_SAVE_MAIN, False), gmSingle); + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewMultiplayerMap(const aFileName: UnicodeString; aMapKind: TKMMapKind; aCRC: Cardinal; aSpectating: Boolean; + aDifficulty: TKMMissionDifficulty); +var + gameMode: TKMGameMode; +begin + if aSpectating then + gameMode := gmMultiSpectate + else + gameMode := gmMulti; + + LoadGameFromScript(TKMapsCollection.FullPath(aFileName, '.dat', aMapKind, aCRC), aFileName, + aCRC, 0, nil, 0, gameMode, 0, NO_OVERWRITE_COLOR, aDifficulty); + + //Starting the game might have failed (e.g. fatal script error) + if gGame <> nil then + begin + gGame.GamePlayInterface.GameStarted; + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); + end; +end; + + +procedure TKMGameApp.NewMultiplayerSave(const aSaveName: UnicodeString; Spectating: Boolean); +var + gameMode: TKMGameMode; +begin + if Spectating then + gameMode := gmMultiSpectate + else + gameMode := gmMulti; + //Convert SaveName to local FilePath + //aFileName is the same for all players, but Path to it is different + LoadGameFromSave(SaveName(aSaveName, EXT_SAVE_MAIN, True), gameMode); + + //Copy the chat and typed lobby message to the in-game chat + gGame.GamePlayInterface.GameStarted; + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewRestartLastSPGame; +var + gameMode: TKMGameMode; + repeatGameName: UnicodeString; + repeatMissionFileRel: UnicodeString; + repeatSave: UnicodeString; + repeatCampName: TKMCampaignId; + repeatCampMap: Byte; + repeatLocation: Byte; + repeatColor: Cardinal; + repeatDifficulty: TKMMissionDifficulty; + repeatAIType: TKMAIType; +begin + if gGame = nil then Exit; + + if not gGame.Params.IsSingleplayerGame then Exit; + + //Remember which map we played so we could restart it + gameMode := gGame.Params.Mode; + repeatGameName := gGame.Params.Name; + repeatMissionFileRel := gGame.Params.MissionFileRel; + repeatSave := gGame.SaveFile; + repeatCampName := gGame.CampaignName; + repeatCampMap := gGame.CampaignMap; + repeatLocation := gGame.PlayerLoc; + repeatColor := gGame.PlayerColor; + repeatDifficulty := gGame.Params.MissionDifficulty; + repeatAIType := gGame.AIType; + + StopGame(grSilent); + + gGameApp.NewRestartLast(repeatGameName, repeatMissionFileRel, repeatSave, gameMode, repeatCampName, repeatCampMap, + repeatLocation, repeatColor, repeatDifficulty, repeatAIType); +end; + + +procedure TKMGameApp.NewRestartLast(const aGameName, aMissionFileRel, aSave: UnicodeString; aGameMode: TKMGameMode; + aCampName: TKMCampaignId; aCampMap: Byte; aLocation: Byte; aColor: Cardinal; + aDifficulty: TKMMissionDifficulty = mdNone; aAIType: TKMAIType = aitNone); +begin + if FileExists(ExeDir + aMissionFileRel) then + LoadGameFromScript(ExeDir + aMissionFileRel, aGameName, 0, 0, fCampaigns.CampaignById(aCampName), aCampMap, aGameMode, aLocation, aColor, aDifficulty, aAIType) + else + if FileExists(ChangeFileExt(ExeDir + aSave, EXT_SAVE_BASE_DOT)) then + LoadGameFromSave(ChangeFileExt(ExeDir + aSave, EXT_SAVE_BASE_DOT), aGameMode) + else + fMainMenuInterface.PageChange(gpError, 'Can not repeat last mission'); + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); + +end; + + +//Used by Runner util +procedure TKMGameApp.NewEmptyMap(aSizeX, aSizeY: Integer); +begin + LoadGameFromScratch(aSizeX, aSizeY, gmSingle); + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewMapEditor(const aFullFilePath: UnicodeString; aMultiplayerLoadMode: Boolean); +begin + NewMapEditor(aFullFilePath, 0, 0, 0, 0, aMultiplayerLoadMode); +end; + + +procedure TKMGameApp.NewMapEditor(const aFullFilePath: UnicodeString; aSizeX: Integer = 0; aSizeY: Integer = 0; + aMapFullCRC: Cardinal = 0; aMapSimpleCRC: Cardinal = 0; aMultiplayerLoadMode: Boolean = False); +begin + if aFullFilePath <> '' then + LoadGameFromScript(aFullFilePath, TruncateExt(ExtractFileName(aFullFilePath)), aMapFullCRC, aMapSimpleCRC, nil, 0, gmMapEd, 0, NO_OVERWRITE_COLOR) + else + begin + aSizeX := EnsureRange(aSizeX, MIN_MAP_SIZE, MAX_MAP_SIZE); + aSizeY := EnsureRange(aSizeY, MIN_MAP_SIZE, MAX_MAP_SIZE); + LoadGameFromScratch(aSizeX, aSizeY, gmMapEd); + end; + + // gGame could be nil if we failed to load map + if gGame = nil then Exit; + + gGame.MapEditorInterface.SetLoadMode(aMultiplayerLoadMode); + + if Assigned(fOnGameStart) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.SaveMapEditor(const aPathName: UnicodeString); +begin + if aPathName <> '' then + gGame.SaveMapEditor(aPathName); +end; + + +procedure TKMGameApp.NewReplay(const aFilePath: UnicodeString); +begin + Assert(ExtractFileExt(aFilePath) = EXT_SAVE_BASE_DOT); + LoadGameFromSave(aFilePath, gmReplaySingle); //Will be changed to gmReplayMulti depending on save contents + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.NewSaveAndReplay(const aSavPath, aRplPath: UnicodeString); +begin + LoadGameFromSave(aSavPath, gmReplaySingle, aRplPath); //Will be changed to gmReplayMulti depending on save contents + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +// Good for debug, when need to load savepoint from debugger before known crash during debugging tick +procedure TKMGameApp.LoadPrevSavePoint; +begin + if (gGame = nil) or (gGame.SavePoints = nil) then Exit; + + TryLoadSavePoint(gGame.SavePoints.LatestPointTickBefore(gGame.Params.Tick)); +end; + + +function TKMGameApp.TryLoadSavePoint(aTick: Integer): Boolean; +begin + Result := False; + + if (gGame = nil) or (gGame.SavePoints = nil) then Exit; + + if not gGame.SavePoints.Contains(aTick) then Exit; + + LoadGameSavePoint(aTick); + Result := True; + + if Assigned(fOnGameStart) and (gGame <> nil) then + fOnGameStart(gGame.Params.Mode); +end; + + +procedure TKMGameApp.GameStarted(aGameMode: TKMGameMode); +begin + Assert(gGame <> nil); + + if gMain <> nil then + begin + gMain.FormMain.SetExportGameStats(aGameMode in [gmMultiSpectate, gmReplaySingle, gmReplayMulti]); + gMain.FormMain.GameStarted(aGameMode); + gMain.FormMain.SetMySpecHandIndex(gMySpectator.HandID); + end; + + if Assigned(FormLogistics) then + FormLogistics.UpdateView(gGame.GetHandsCount, True); +end; + + +function TKMGameApp.GetActiveInterface: TKMUserInterfaceCommon; +begin + if gGame = nil then + Result := fMainMenuInterface + else + Result := gGame.ActiveInterface; +end; + + +function TKMGameApp.GetGameSettings: TKMGameSettings; +begin + if Self = nil then Exit(nil); + + Result := gGameSettings; +end; + + +procedure TKMGameApp.GameEnded(aGameMode: TKMGameMode); +begin + if gMain <> nil then + begin + gMain.FormMain.SetExportGameStats((aGameMode in [gmMultiSpectate, gmReplaySingle, gmReplayMulti]) + or (gGame.GameResult in [grWin, grDefeat])); + gMain.FormMain.GameEnded(aGameMode); + end; + + if Assigned(FormLogistics) then + FormLogistics.Clear; +end; + + +procedure TKMGameApp.GameDestroyed; +begin + if gMain <> nil then + gMain.FormMain.SetExportGameStats(False); +end; + + +//Happens when game was won or lost +procedure TKMGameApp.GameFinished; +begin + if CompareDate(gGameSettings.LastDayGamePlayed, Today) < 0 then + gGameSettings.DayGamesCount := 0; + + gGameSettings.LastDayGamePlayed := Today; + gGameSettings.DayGamesCount := gGameSettings.DayGamesCount + 1; +end; + + +function TKMGameApp.SaveName(const aName, aExt: UnicodeString; aIsMultiplayer: Boolean): UnicodeString; +begin + Result := TKMSavesCollection.FullPath(aName, aExt, aIsMultiplayer); +end; + + +procedure TKMGameApp.NetworkInit; +begin + if fNetworking = nil then + fNetworking := TKMNetworking.Create(fServerSettings.MasterServerAddress, + fServerSettings.AutoKickTimeout, + fServerSettings.PingInterval, + fServerSettings.MasterAnnounceInterval, + fServerSettings.ServerUDPScanPort, + fServerSettings.ServerPacketsAccumulatingDelay, + fServerSettings.ServerDynamicFOW, + fServerSettings.ServerMapsRosterEnabled, + fServerSettings.ServerMapsRosterStr, + KMRange(fServerSettings.ServerLimitPTFrom, fServerSettings.ServerLimitPTTo), + KMRange(fServerSettings.ServerLimitSpeedFrom, fServerSettings.ServerLimitSpeedTo), + KMRange(fServerSettings.ServerLimitSpeedAfterPTFrom, fServerSettings.ServerLimitSpeedAfterPTTo)); + + // Set event handlers anyway. Those could be reset by someone + fNetworking.OnMPGameInfoChanged := SendMPGameInfo; + fNetworking.OnStartMap := NewMultiplayerMap; + fNetworking.OnStartSave := NewMultiplayerSave; + fNetworking.OnAnnounceReturnToLobby := AnnounceReturnToLobby; + fNetworking.OnDoReturnToLobby := StopGameReturnToLobby; +end; + + +//Called by fNetworking to access MissionTime/GameName if they are valid +//fNetworking knows nothing about fGame +procedure TKMGameApp.SendMPGameInfo; +begin + if gGame <> nil then + fNetworking.AnnounceGameInfo(gGame.MissionTime, gGame.Params.Name) + else + fNetworking.AnnounceGameInfo(-1, ''); //fNetworking will fill the details from lobby +end; + + +procedure TKMGameApp.SetOnOptionsChange(const aEvent: TKMEvent); +begin + fOnOptionsChange := aEvent; + + fMainMenuInterface.SetOnOptionsChange(aEvent); +end; + + +procedure TKMGameApp.Render(aForPrintScreen: Boolean = False); +begin + if Self = nil then Exit; + if SKIP_RENDER then Exit; + if fIsExiting then Exit; + if gRender.Blind then Exit; + if fIsLoading then Exit; //Don't render while toggling locale + + gRender.BeginFrame; + + {$IFDEF DBG_PERFLOG} + gPerfLogs.StackGFX.FrameBegin; + gPerfLogs.SectionEnter(psFrameFullG); + + try + {$ENDIF} + if gVideoPlayer.IsActive then + gVideoPlayer.Paint + else + if gGame <> nil then + gGame.Render(gRender) + else + fMainMenuInterface.Paint; + + gRender.RenderBrightness(gGameSettings.GFX.Brightness); + {$IFDEF DBG_PERFLOG} + finally + gPerfLogs.SectionLeave(psFrameFullG); + gPerfLogs.StackGFX.FrameEnd; + end; + + if gMain <> nil then + gPerfLogs.Render(TOOLBAR_WIDTH + 10, gMain.FormMain.RenderArea.Width - 10, gMain.FormMain.RenderArea.Height - 10); + {$ENDIF} + + gRender.EndFrame; + gRender.Query.QueriesSwapBuffers; + + if not aForPrintScreen + and (gGame <> nil) + and Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spObjectUID, 'Obj: ' + IntToStr(gCursor.ObjectUID)); +end; + + +function TKMGameApp.RenderVersion: UnicodeString; +begin + Result := 'OpenGL ' + gRender.RendererVersion; +end; + + +procedure TKMGameApp.PrintScreen(const aFilename: UnicodeString = ''; aImageType: TKMImageType = itJpeg); +var + strDate, fileName: string; + w, h: Integer; + pixelData: TKMCardinalArray; +begin + // Looks like we need two frames to flush the render-ahead queue? + // Otherwise game controls are rendered too, f.e. + Render(True); + Render(True); + if aFilename = '' then + begin + DateTimeToString(strDate, 'yyyy-mm-dd hh-nn-ss', Now); //2007-12-23 15-24-33 + fileName := ExeDir + 'screenshots\KaM Remake ' + strDate + '.jpeg'; + end + else + fileName := aFilename; + + gRender.ReadRenderedToScreenPixels(w, h, pixelData); + + SavePixelDataToFile(fileName, aImageType, w, h, pixelData); +end; + + +procedure TKMGameApp.SaveGameWholeMapToImage(aImageType: TKMImageType; aMaxImageSize: Integer = 0); +var + dateStr, fileName: string; + screenX, screenY, w, h: Integer; + zoom, mapSizeX, mapSizeY, mapSizeMax, saveSizeMax: Single; + pos: TKMPointF; + zoomBehaviour: TKMZoomBehaviour; + pixelData: TKMCardinalArray; +begin + if gGame = nil then Exit; + + SAVE_MAP_TO_FBO_RENDER := True; + try + // Save viewport params + screenX := gRender.ScreenX; + screenY := gRender.ScreenY; + zoom := gGame.ActiveInterface.Viewport.Zoom; + pos := gGame.ActiveInterface.Viewport.Position; + zoomBehaviour := gGameSettings.ZoomBehaviour; + + // calc resize dimensions + // We show MapX - 1 tiles + mapSizeX := gGame.MapSize.X - 1; + // We show MapY - 1 + top padding for elevated tiles on the map top rows + mapSizeY := gGame.MapSize.Y - 1 + gGame.ActiveInterface.Viewport.TopPad; + mapSizeMax := Max(mapSizeX, mapSizeY); + + saveSizeMax := Min(mapSizeMax * CELL_SIZE_PX, gRender.MaxFBOSize); + + if aMaxImageSize > 0 then + saveSizeMax := Min(saveSizeMax, aMaxImageSize); + + // zbLoose could lead to bad positioned map image + gGameSettings.ZoomBehaviour := zbRestricted; + Resize(Round(saveSizeMax * mapSizeX / mapSizeMax), Round(saveSizeMax * mapSizeY / mapSizeMax)); + + // Zoom out as max as possible + gGame.ActiveInterface.Viewport.Zoom := 0.01; + + // Render once is enough, since we render to an off-screen buffer (FBO) + Render(True); + + DateTimeToString(dateStr, 'yyyy-mm-dd hh-nn-ss', Now); //2007-12-23 15-24-33 + fileName := ExeDir + 'screenshots\' + gGame.Params.Name + ' ' + dateStr + IMAGE_TYPE_EXT[aImageType]; + + gRender.ReadRenderedToFBOPixels(w, h, pixelData); + + SavePixelDataToFile(fileName, aImageType, w, h, pixelData); + finally + SAVE_MAP_TO_FBO_RENDER := False; + end; + + // Restore viewport params + gGameSettings.ZoomBehaviour := zoomBehaviour; // before Resize + Resize(screenX, screenY); + gGame.ActiveInterface.Viewport.Zoom := zoom; + gGame.ActiveInterface.Viewport.Position := pos; +end; + + +function TKMGameApp.CheckDATConsistency: Boolean; +const + // That's the magic CRC of official .dat files and our .json specifications + // Please write down a reason for when you change it: + // - $28810991 - restored + DEFINES_CRC: Cardinal = $28810991; +begin + Result := ALLOW_MP_MODS or (gRes.GetDATCRC = DEFINES_CRC); +end; + + +procedure TKMGameApp.UpdatePerflog; +{$IFNDEF Unix} +{$IFDEF DBG_PERFLOG} +var + memUsed, stackUsed: NativeUInt; +{$ENDIF} +{$ENDIF} +begin + {$IFNDEF Unix} + {$IFDEF DBG_PERFLOG} + memUsed := GetMemUsed; + stackUsed := GetCommittedStackSize; + + gPerfLogs.SectionAddValue(psMemUsed, memUsed div (10*1024), fGlobalTickCount, IntToStr(memUsed div (1024*1024)) + 'Mb'); + gPerfLogs.SectionAddValue(psStackUsed, stackUsed div 128, fGlobalTickCount, IntToStr(stackUsed div 1024) + 'Kb'); + {$ENDIF} + {$ENDIF} +end; + + +procedure TKMGameApp.UpdateState; +begin + if fIsLoading then Exit; //Don't update while toggling locale + + //Some PCs seem to change 8087CW randomly between events like Timers and OnMouse*, + //so we need to set it right before we do game logic processing + Set8087CW($133F); + + Inc(fGlobalTickCount); + //Always update networking for auto reconnection and query timeouts + if fNetworking <> nil then + fNetworking.UpdateState(fGlobalTickCount); + + gVideoPlayer.UpdateState; + + if gGame <> nil then + begin + gGame.UpdateState(fGlobalTickCount); + if gGame.Params.IsMultiPlayerOrSpec and (fGlobalTickCount mod 100 = 0) then + SendMPGameInfo; //Send status to the server every 10 seconds + end + else + fMainMenuInterface.UpdateState(fGlobalTickCount); + + //Every 1000ms + if fGlobalTickCount mod 10 = 0 then + begin + // Music + if gGameSettings.SFX.MusicEnabled and gMusic.IsEnded then + gMusic.PlayNextTrack; //Feed new music track + + //StatusBar + if (gGame <> nil) and not (gGame.IsPaused and BLOCK_GAME_ON_PAUSE) and Assigned(fOnStatusBarUpdate) then + fOnStatusBarUpdate(spTime, 'Time: ' + TimeToString(gGame.MissionTime)); + end; + + UpdatePerflog; +end; + + +// This is our real-time "thread", use it wisely +procedure TKMGameApp.UpdateStateIdle(aFrameTime: Cardinal); +begin + if gGame <> nil then gGame.UpdateStateIdle(aFrameTime); + if gMusic <> nil then gMusic.UpdateStateIdle; + if gSoundPlayer <> nil then gSoundPlayer.UpdateStateIdle; + if fNetworking <> nil then fNetworking.UpdateStateIdle; + if gRes <> nil then gRes.UpdateStateIdle; +end; + + +procedure TKMGameApp.DoGameTick; +begin + if gGame <> nil then + gGame.UpdateGame; +end; + + +end. diff --git a/vendor/kam_remake/src/KM_Log.pas b/vendor/kam_remake/src/KM_Log.pas new file mode 100644 index 0000000..04fac6f --- /dev/null +++ b/vendor/kam_remake/src/KM_Log.pas @@ -0,0 +1,614 @@ +unit KM_Log; +{$I KaM_Remake.inc} +interface +uses + SyncObjs, KM_CommonTypes + {$IFDEF KMR_GAME} // Not needed for server and other tools + , Generics.Collections + {$ENDIF} + ; + + +type + // Log message type + TKMLogMessageType = ( + lmtDefault, // Default type + lmtDelivery, // Delivery messages + lmtCommands, // All GIC commands + lmtRandomChecks, // Random checks + lmtNetConnection, // Messages about net connection/disconnection/reconnection + lmtNetPacketOther, // Messages about net packets (all packets, except GIP commands/ping/fps) + lmtNetPacketCommand, // Messages about GIP commands net packets + lmtNetPacketPingFps, // Messages about ping/fps net packets + lmtDebug // Debug + ); + + TKMLogMessageTypeSet = set of TKMLogMessageType; + + // Logging system + TKMLog = class + private + CS: TCriticalSection; + fLogFile: TextFile; + fLogPath: UnicodeString; + fWriteErrCnt: Integer; + fFirstTick: cardinal; + fPreviousTick: cardinal; + fPreviousDate: TDateTime; + + {$IFDEF KMR_GAME} + fOnLogMessageList: TList; + {$ENDIF} + + procedure Lock; + procedure Unlock; + + procedure InitLog; + + procedure AppendText(aTxt: String); + function IsFileAssignedAndAppend: Boolean; + + procedure NotifyLogSubs(aText: UnicodeString); + + procedure AddLineTime(const aText: UnicodeString; aLogType: TKMLogMessageType); overload; + procedure AddLineTime(const aText: UnicodeString); overload; + procedure AddLineNoTime(const aText: UnicodeString; aWithPrefix: Boolean = True); overload; + procedure AddLineNoTime(const aText: UnicodeString; aLogType: TKMLogMessageType; aWithPrefix: Boolean = True); overload; + public + MessageTypes: TKMLogMessageTypeSet; + constructor Create(const aPath: UnicodeString); + destructor Destroy; override; + + // AppendLog adds the line to Log along with time passed since previous line added + procedure AddTime(const aText: UnicodeString); overload; + procedure AddTime(const aText: UnicodeString; aArgs: array of const); overload; + function IsDegubLogEnabled: Boolean; + procedure LogDebug(const aText: UnicodeString); + procedure LogDelivery(const aText: UnicodeString); + procedure LogCommands(const aText: UnicodeString); + procedure LogRandomChecks(const aText: UnicodeString); + procedure LogNetConnection(const aText: UnicodeString); + procedure LogNetPacketOther(const aText: UnicodeString); + procedure LogNetPacketCommand(const aText: UnicodeString); + procedure LogNetPacketPingFps(const aText: UnicodeString); + function CanLogDelivery: Boolean; + function CanLogCommands: Boolean; + function CanLogRandomChecks: Boolean; + function CanLogNetConnection: Boolean; + function CanLogNetPacketOther: Boolean; + function CanLogNetPacketCommand: Boolean; + function CanLogNetPacketPingFps: Boolean; + + procedure SetDefaultMessageTypes; + + // Add line if TestValue=False + procedure AddAssert(const aMessageText: UnicodeString); + // AddToLog simply adds the text + procedure AddNoTime(const aText: UnicodeString; aWithPrefix: Boolean = True); + procedure DeleteOldLogs(aDeleteWhenOlderThanDays: Integer); + property LogPath: UnicodeString read fLogPath; //Used by dedicated server +// property OnLogMessage: TUnicodeStringEvent read fOnLogMessage write fOnLogMessage; + procedure AddOnLogEventSub(const aOnLogMessage: TUnicodeStringEvent); + procedure RemoveOnLogEventSub(const aOnLogMessage: TUnicodeStringEvent); + end; + +var + gLog: TKMLog; + + +implementation +uses + {$IFDEF WDC}IOUtils,{$ENDIF} + Classes, SysUtils, + KM_FileIO, + KM_Defaults, KM_CommonUtils; + +const + DEFAULT_LOG_TYPES_TO_WRITE: TKMLogMessageTypeSet = [lmtDefault, lmtNetConnection]; + + +type + // New thread, in which old logs are deleted (used internally) + TKMOldLogsDeleter = class(TThread) + private + fPathToLogs: UnicodeString; + fDeleteWhenOlderThanDays: Integer; + public + constructor Create(const aPathToLogs: UnicodeString; aDeleteWhenOlderThanDays: Integer); + procedure Execute; override; + end; + + +{ TKMOldLogsDeleter } +constructor TKMOldLogsDeleter.Create(const aPathToLogs: UnicodeString; aDeleteWhenOlderThanDays: Integer); +begin + //Thread isn't started until all constructors have run to completion + //so Create(False) may be put in front as well + inherited Create(False); + + {$IFDEF DEBUG} + TThread.NameThreadForDebugging('OldLogsDeleter', ThreadID); + {$ENDIF} + + //Must set these values BEFORE starting the thread + FreeOnTerminate := True; //object can be automatically removed after its termination + fPathToLogs := aPathToLogs; +end; + + +procedure TKMOldLogsDeleter.Execute; +var + SearchRec: TSearchRec; + fileDateTime: TDateTime; +begin + if not DirectoryExists(fPathToLogs) then Exit; + try + if FindFirst(fPathToLogs + 'KaM*.log', faAnyFile - faDirectory, SearchRec) = 0 then + repeat + Assert(FileAge(fPathToLogs + SearchRec.Name, fileDateTime), 'How is that it does not exists any more?'); + + if (Abs(Now - fileDateTime) > fDeleteWhenOlderThanDays) then + KMDeleteFile(fPathToLogs + SearchRec.Name); + until (FindNext(SearchRec) <> 0); + finally + FindClose(SearchRec); + end; +end; + + +{ TKMLog } +constructor TKMLog.Create(const aPath: UnicodeString); +begin + inherited Create; + + fLogPath := aPath; + fFirstTick := TimeGet; + fPreviousTick := TimeGet; + SetDefaultMessageTypes; + + if DEBUG_LOGS then + Include(MessageTypes, lmtDebug); + + CS := TCriticalSection.Create; + {$IFDEF KMR_GAME} + fOnLogMessageList := TList.Create; + {$ENDIF} + + InitLog; +end; + + +destructor TKMLog.Destroy; +begin + CS.Free; + {$IFDEF KMR_GAME} + fOnLogMessageList.Free; + {$ENDIF} + + inherited; +end; + + +procedure TKMLog.SetDefaultMessageTypes; +begin + MessageTypes := DEFAULT_LOG_TYPES_TO_WRITE; +end; + + +procedure TKMLog.Lock; +begin + CS.Enter; +end; + + +procedure TKMLog.Unlock; +begin + CS.Leave; +end; + + +// Check if the log file is assigned +// File will be appended in case the file is assigned to the file variable +function TKMLog.IsFileAssignedAndAppend: Boolean; +begin + Result := True; + try + Append(fLogFile); + except + Result := False; + end; +end; + + +procedure TKMLog.AppendText(aTxt: String); +const + MAX_LOG_ERROR_CNT = 5; + + procedure doAppend(aE: Exception = nil); + begin + if not IsFileAssignedAndAppend then + begin + AssignFile(fLogFile, fLogPath); + Append(fLogFile); + end; + + // Only show few log errors, don't overspam it + if fWriteErrCnt <= MAX_LOG_ERROR_CNT then + begin + if aE <> nil then + WriteLn(fLogFile, 'Error appending to the log file using TFile.AppendAllText: ' + aE.Message); + end + else + Inc(fWriteErrCnt); + + WriteLn(fLogFile, aTxt); + CloseFile(fLogFile); + end; + + +begin + {$IFDEF WDC} + try + // Try to use TFile.AppendAllText for few times + // Then use oldschool Writeln instead + if fWriteErrCnt < MAX_LOG_ERROR_CNT then + TFile.AppendAllText(fLogPath, aTxt + sLineBreak, TEncoding.UTF8) + else + doAppend(); + except + on E: Exception do + doAppend(E); + end; + {$ENDIF} +end; + + +procedure TKMLog.InitLog; +const + INIT_STR = ' Timestamp Elapsed Delta Thread Description'; +begin + if BLOCK_FILE_WRITE then Exit; + + try + ForceDirectories(ExtractFilePath(fLogPath)); + + // hh:nn:ss.zzz 12345.678s 1234567ms text-text-text + {$IFDEF WDC} + try + TFile.WriteAllText(fLogPath, INIT_STR + sLineBreak, TEncoding.UTF8); + except + on E: Exception do + begin + // Write to log anyway, even if we can't do it using TFile.WriteAllText + if not IsFileAssignedAndAppend then + begin + AssignFile(fLogFile, fLogPath); + Rewrite(fLogFile); + end; + WriteLn(fLogFile, INIT_STR); + WriteLn(fLogFile, 'Error creating file using TFile.WriteAllText: ' + E.Message); + CloseFile(fLogFile); + end; + end; + + {$ENDIF} + {$IFDEF FPC} + AssignFile(fLogFile, fLogPath); + Rewrite(fLogFile); + // hh:nn:ss.zzz 12345.678s 1234567ms text-text-text + WriteLn(fLogFile, ' Timestamp Elapsed Delta Thread Description'); + CloseFile(fLogFile); + {$ENDIF} + except + on E: Exception do + begin + E.Message := E.Message + '. Tried to init Log on path ''' + fLogPath + ''''; + raise E; + end; + end; + AddLineTime('Log is up and running. Game version: ' + UnicodeString(GAME_VERSION)); +end; + + +// Run thread to delete old logs +procedure TKMLog.DeleteOldLogs(aDeleteWhenOlderThanDays: Integer); +begin + if Self = nil then Exit; + if not DELETE_OLD_LOGS then Exit; + + // No need to remember the instance, it's set to FreeOnTerminate + TKMOldLogsDeleter.Create(ExtractFilePath(fLogPath), aDeleteWhenOlderThanDays); +end; + + +procedure TKMLog.AddOnLogEventSub(const aOnLogMessage: TUnicodeStringEvent); +begin + {$IFDEF KMR_GAME} + fOnLogMessageList.Add(aOnLogMessage); + {$ENDIF} +end; + + +procedure TKMLog.RemoveOnLogEventSub(const aOnLogMessage: TUnicodeStringEvent); +begin + {$IFDEF KMR_GAME} + fOnLogMessageList.Remove(aOnLogMessage); + {$ENDIF} +end; + + +procedure TKMLog.NotifyLogSubs(aText: UnicodeString); +{$IFDEF KMR_GAME} +var + I: Integer; +{$ENDIF} +begin + {$IFDEF KMR_GAME} + for I := 0 to fOnLogMessageList.Count - 1 do + if Assigned(fOnLogMessageList[I]) then + fOnLogMessageList[I](aText); + {$ENDIF} +end; + + +// Lines are timestamped, each line invokes file open/close for writing, +// meaning that no lines will be lost if Remake crashes +procedure TKMLog.AddLineTime(const aText: UnicodeString; aLogType: TKMLogMessageType); +var + txt, txt2: String; +begin + if Self = nil then Exit; + + if BLOCK_FILE_WRITE then Exit; + + if not (aLogType in MessageTypes) then // write into log only for allowed types + Exit; + + // Do not allow multiple threads write into the same file + Lock; + try + if not FileExists(fLogPath) then + InitLog; // Recreate log file, if it was deleted + + txt := ''; + + {$IFDEF FPC} Append(fLogFile); {$ENDIF} + + //Write a line when the day changed since last time (useful for dedicated server logs that could be over months) + if Abs(Trunc(fPreviousDate) - Trunc(Now)) >= 1 then + begin + {$IFDEF WDC} + txt := txt + '========================' + sLineBreak + + ' Date: ' + FormatDateTime('yyyy/mm/dd', Now) + sLineBreak + + '========================' + sLineBreak; + {$ENDIF} + {$IFDEF FPC} + WriteLn(fLogFile, '========================'); + WriteLn(fLogFile, ' Date: ' + FormatDateTime('yyyy/mm/dd', Now)); + WriteLn(fLogFile, '========================'); + {$ENDIF} + end; + + txt2 := Format('%12s %9.3fs %7dms %6d %s', [ + FormatDateTime('hh:nn:ss.zzz', Now), + TimeSince(fFirstTick) / 1000, + TimeSince(fPreviousTick), + TThread.CurrentThread.ThreadID, + aText]); + {$IFDEF WDC} + AppendText(txt + txt2); + {$ENDIF} + {$IFDEF FPC} + WriteLn(fLogFile, txt2); + CloseFile(fLogFile); + {$ENDIF} + + fPreviousTick := TimeGet; + fPreviousDate := Now; + finally + UnLock; + end; + + NotifyLogSubs(aText); +end; + + +// Add line with timestamp +procedure TKMLog.AddLineTime(const aText: UnicodeString); +begin + AddLineTime(aText, lmtDefault); +end; + + +// Add line but without timestamp +procedure TKMLog.AddLineNoTime(const aText: UnicodeString; aLogType: TKMLogMessageType; aWithPrefix: Boolean = True); +begin + if Self = nil then Exit; + + if BLOCK_FILE_WRITE then Exit; + + if not (aLogType in MessageTypes) then // write into log only for allowed types + Exit; + + // Do not allow multiple threads write into the same file + Lock; + try + if not FileExists(fLogPath) then + InitLog; // Recreate log file, if it was deleted + + {$IFDEF FPC} Append(fLogFile); {$ENDIF} + + if aWithPrefix then + begin + {$IFDEF WDC} + AppendText(' ' + aText); + {$ENDIF} + {$IFDEF FPC} + WriteLn(fLogFile, ' ' + aText); + {$ENDIF} + end + else + begin + {$IFDEF WDC} AppendText(aText); {$ENDIF} + {$IFDEF FPC} WriteLn(fLogFile, aText); {$ENDIF} + end; + {$IFDEF FPC} CloseFile(fLogFile); {$ENDIF} + finally + // Do not allow multiple threads write into the same file + UnLock; + end; + + NotifyLogSubs(aText); +end; + + +//Add line without timestamp +procedure TKMLog.AddLineNoTime(const aText: UnicodeString; aWithPrefix: Boolean = True); +begin + AddLineNoTime(aText, lmtDefault, aWithPrefix); +end; + + +procedure TKMLog.AddTime(const aText: UnicodeString); +begin + AddLineTime(aText); +end; + + +procedure TKMLog.AddTime(const aText: UnicodeString; aArgs: array of const); +begin + AddLineTime(Format(aText, aArgs)); +end; + + +function TKMLog.IsDegubLogEnabled: Boolean; +begin + Result := lmtDebug in MessageTypes; +end; + + +procedure TKMLog.LogDebug(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtDebug); +end; + + +procedure TKMLog.LogDelivery(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtDelivery); +end; + + +procedure TKMLog.LogCommands(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtCommands); +end; + + +procedure TKMLog.LogRandomChecks(const aText: UnicodeString); +begin + if Self = nil then Exit; + if not CanLogRandomChecks then Exit; + + AddLineNoTime(aText, lmtRandomChecks); +end; + + +procedure TKMLog.LogNetConnection(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtNetConnection); +end; + + +procedure TKMLog.LogNetPacketOther(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtNetPacketOther); +end; + + +procedure TKMLog.LogNetPacketCommand(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtNetPacketCommand); +end; + + +procedure TKMLog.LogNetPacketPingFps(const aText: UnicodeString); +begin + if Self = nil then Exit; + AddLineTime(aText, lmtNetPacketPingFps); +end; + + +function TKMLog.CanLogDelivery: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtDelivery in MessageTypes; +end; + + +function TKMLog.CanLogCommands: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtCommands in MessageTypes; +end; + + +function TKMLog.CanLogRandomChecks: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtRandomChecks in MessageTypes; +end; + + +function TKMLog.CanLogNetConnection: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtNetConnection in MessageTypes; +end; + + +function TKMLog.CanLogNetPacketOther: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtNetPacketOther in MessageTypes; +end; + + +function TKMLog.CanLogNetPacketCommand: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtNetPacketCommand in MessageTypes; +end; + + +function TKMLog.CanLogNetPacketPingFps: Boolean; +begin + if Self = nil then Exit(False); + Result := lmtNetPacketPingFps in MessageTypes; +end; + + +procedure TKMLog.AddAssert(const aMessageText: UnicodeString); +begin + if Self = nil then Exit; + + AddLineNoTime('ASSERTION FAILED! Msg: ' + aMessageText); + raise Exception.Create('ASSERTION FAILED! Msg: ' + aMessageText); +end; + + +procedure TKMLog.AddNoTime(const aText: UnicodeString; aWithPrefix: Boolean = True); +begin + if Self = nil then Exit; + + AddLineNoTime(aText, aWithPrefix); +end; + + +end. diff --git a/vendor/kam_remake/src/KM_Main.pas b/vendor/kam_remake/src/KM_Main.pas new file mode 100644 index 0000000..e3acf71 --- /dev/null +++ b/vendor/kam_remake/src/KM_Main.pas @@ -0,0 +1,959 @@ +unit KM_Main; +{$I KaM_Remake.inc} +interface +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + KM_Defaults, KM_FormMain, KM_FormLoading, KM_Maps, + KM_MainSettings, KM_Resolutions, KM_Video, + KM_WindowParams, + KM_GameAppSettings + {$IFDEF FPC} + , Types + {$ENDIF} + ; + + +type + // Provides basement for the Game App + // Should be abstract enough, so that the Game could be a race-sim or a quest or any other + TKMMain = class + private + fFormMain: TFormMain; + fFormLoading: TFormLoading; + + fGameTickInterval: Cardinal; + + fRenderSchedule, fTickSchedule, fUpdateStateSchedule: Cardinal; + fLastRenderTime, fOldFrameTimes, fFrameCount: Cardinal; + {$IFDEF MSWindows} + fMutex: THandle; + {$ENDIF} + +// fMainSettings: TKMainSettings; + fResolutions: TKMResolutions; + fMapCacheUpdater: TTMapsCacheUpdater; + + fFPS: Single; + fFPSString: String; + + procedure DoRestore(Sender: TObject); + procedure DoActivate(Sender: TObject); + procedure DoDeactivate(Sender: TObject); + procedure DoIdle(Sender: TObject; var Done: Boolean); + + function GetRenderInterval: Cardinal; + function ForcedRenderRequired: Boolean; + + procedure DoRender; + procedure SleepUntilNextSchedule; + + procedure MapCacheUpdate; + procedure UpdateFPS(latestFrameTime: Cardinal); + + procedure GameSpeedChange(aSpeed: Single); + function DoHaveGenericPermission: Boolean; + + procedure TryWriteIntoGameFolder(); + public + constructor Create; + destructor Destroy; override; + + function Start: Boolean; + procedure CloseQuery(var aCanClose: Boolean); + procedure Stop(Sender: TObject); + + procedure UpdateWindowParams(const aWindowParams: TKMWindowParamsRecord); + procedure Move(const aWindowParams: TKMWindowParamsRecord); + procedure ForceResize; + procedure Resize(aWidth, aHeight: Integer); overload; + procedure Resize(aWidth, aHeight: Integer; const aWindowParams: TKMWindowParamsRecord); overload; + procedure Render; + procedure ShowAbout; + property FormMain: TFormMain read fFormMain; + + procedure ApplyCursorRestriction; + function GetScreenBounds(out aBounds: TRect): Boolean; + function IsFormActive: Boolean; + function ClientRect(aPixelsCntToReduce: Integer = 0): TRect; + function ClientToScreen(aPoint: TPoint): TPoint; + function ReinitRender(aReturnToOptions: Boolean): Boolean; + + property FPSString: String read fFPSString; + + function IsDebugChangeAllowed: Boolean; + + function LockMutex: Boolean; + procedure UnlockMutex; + + procedure HandleStatusBarText(aPanelIndex: TKMStatusBarPanel; aText: string); + + procedure SetGameTickInterval(aInterval: Cardinal); + property GameTickInterval: Cardinal read fGameTickInterval; + + property Resolutions: TKMResolutions read fResolutions; + end; + + +var + gMain: TKMMain; + + +implementation +uses + Classes, SysUtils, SysConst, StrUtils, Math, + Forms, + {$IF DEFINED(MSWindows)} + MMSystem, + {$ELSEIF DEFINED(Unix)} + Dialogs, LCLType, Controls, + {$ENDIF} + {$IFDEF USE_MAD_EXCEPT} KM_Exceptions, {$ENDIF} + KromUtils, KM_FileIO, + KM_GameApp, KM_VclHelpers, + KM_System, + KM_ResTexts, + KM_KeysSettings, + KM_Music, + KM_Log, KM_CommonUtils, KM_Points, KM_DevPerfLog, + KM_CommonExceptions, + KromShellUtils, KM_MapTypes; + + +const + // Mutex is used to block duplicate app launch on the same PC + // Random GUID generated in Delphi by Ctrl+Shift+G + // Generated for versions r13651+ + // We can allow to have beta and r6720 versions to be opened at the same time + KAM_MUTEX = 'AAF80942-EC97-4D02-9339-07AB8FEFA187'; + + +{$OVERFLOWCHECKS OFF} +function AddWithOverflow(A, B: Cardinal): Cardinal; inline; +begin + Result := A + B; +end; +{$OVERFLOWCHECKS ON} + + +{ TKMMain } +constructor TKMMain.Create; +var + collapsed: Boolean; +begin + inherited; + + + // Try to write a file into the game folder and raise an error in case we can not + tryWriteIntoGameFolder(); + + fGameTickInterval := 100; + + // Create exception handler as soon as possible in case it crashes early on + {$IFDEF USE_MAD_EXCEPT}gExceptions := TKMExceptions.Create;{$ENDIF} + + //Form created first will be on taskbar + Application.CreateForm(TFormMain, fFormMain); + Application.CreateForm(TFormLoading, fFormLoading); + + {$IFDEF DBG_PERFLOG} + gPerfLogs := TKMPerfLogs.Create([], True); + gPerfLogs.ShowForm(fFormMain.cpPerfLogs); + gPerfLogs.OnFormChanged := fFormMain.OtherFormChanged; + + collapsed := fFormMain.cpPerfLogs.Collapsed; //Save collapsed flag + fFormMain.DevSettings.SkipSave := True; // SKip save + fFormMain.cpPerfLogs.Collapsed := False; //We can set TCategoryPanel height only when collapsed set to False + fFormMain.cpPerfLogs.Height := gPerfLogs.FormHeight; + fFormMain.cpPerfLogs.Collapsed := collapsed; //Restore collapsed flag + fFormMain.DevSettings.SkipSave := False; + {$ELSE} + fFormMain.cpPerfLogs.Hide; + {$ENDIF} +end; + + +destructor TKMMain.Destroy; +begin + // FormLoading is owned by the Application + // If exception occurs and gMain is freed, make sure to remove fsStayOnTop from FormLoading, + // so that madExcept dialogs (main and its child SendBugReport) are not overlapped by it + fFormLoading.FormStyle := fsNormal; + + {$IFDEF DBG_PERFLOG}gPerfLogs.Free;{$ENDIF} + + {$IFDEF USE_MAD_EXCEPT}FreeAndNil(gExceptions);{$ENDIF} + + inherited; +end; + + +// Try to write a file into the game folder and raise an error in case we can not +procedure TKMMain.TryWriteIntoGameFolder(); +var + filename: String; + sList: TStringList; +begin + try + sList := TStringList.Create; + try + filename := ExtractFilePath(ParamStr(0)) + PathDelim + 'test.txt'; + sList.SaveToFile(filename); + KMDeleteFile(filename); + finally + sList.Free; + end; + except + on E: Exception do + begin + raise EGameInitError.Create('Can''t write into the game folder ''' + ExtractFilePath(ParamStr(0)) + '''' + sLineBreak + sLineBreak + + 'Error:' + sLineBreak + E.Message + sLineBreak + sLineBreak + + 'Please move the game folder to a writable location or change the game folder permissions'); + end; + end; +end; + + +// Assertion error handler +procedure CustomAssertErrorHandler(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer); +var + fileNameOnly: string; +begin + // Show only filename in the error message + fileNameOnly := ExtractFileName(Filename); + + if Message <> '' then + raise EAssertionFailed.CreateFmt(SAssertError, + [Message, fileNameOnly, LineNumber]) at ErrorAddr + else + raise EAssertionFailed.CreateFmt(SAssertError, + [SAssertionFailed, fileNameOnly, LineNumber]) at ErrorAddr; +end; + + +// Return False in case we had difficulties on the start +function TKMMain.Start: Boolean; + + function GetScreenMonitorsInfo: TKMPointArray; + var + I: Integer; + begin + SetLength(Result, Screen.MonitorCount); + for I := 0 to Screen.MonitorCount-1 do + begin + Result[I].X := Screen.Monitors[I].Width; + Result[I].Y := Screen.Monitors[I].Height; + end; + end; + +const + LOG_CREATE_TRY_CNT = 3; +var + tryInd: Integer; + logsPath: UnicodeString; + time: Cardinal; +begin + Result := True; + + time := TimeGet; + + ExeDir := ExtractFilePath(ParamStr(0)); + + // Set custom AssertErrorhandler to avoid dev paths in the error messages, which could be seen by players + AssertErrorProc := @CustomAssertErrorHandler; + + //Random is only used for cases where order does not matter, e.g. shuffle tracks + Randomize; + + fFormLoading.Label5.Caption := UnicodeString(GAME_VERSION); + fFormLoading.Show; //This is our splash screen + fFormLoading.Refresh; + + {$IFDEF MSWindows} + TimeBeginPeriod(1); //initialize timer precision + {$ENDIF} + + if not BLOCK_FILE_WRITE then + begin + tryInd := 0; + logsPath := ExeDir + 'Logs' + PathDelim + 'KaM_' + FormatDateTime('yyyy-mm-dd_hh-nn-ss-zzz', Now) + '.log'; + // Try to create log several times + while (gLog = nil) and (tryInd < LOG_CREATE_TRY_CNT) do + begin + try + Inc(tryInd); + CreateDir(ExeDir + 'Logs' + PathDelim); + gLog := TKMLog.Create(logsPath); //First thing - create a log + except + on E: Exception do + if tryInd < LOG_CREATE_TRY_CNT then + Sleep(200) // Just wait a bit + else + raise EGameInitError.Create('Error initializing logging into file: ''' + logsPath + ''':' + sLineBreak + E.Message + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF}); + end; + end; + gLog.DeleteOldLogs(LOGS_DELETE_WHEN_OLDER_THAN); + end; + + gLog.AddTime('Game Load started'); + + //Resolutions are created first so that we could check Settings against them + fResolutions := TKMResolutions.Create; + + //Only after we read settings (fullscreen property and resolutions) + //we can decide whenever we want to create Game fullscreen or not (OpenGL init depends on that) + gGameAppSettings := TKMGameAppSettings.Create(Screen.Width, Screen.Height); + + //We need to verify INI values, as they can be from another display + if not fResolutions.IsValid(gMainSettings.Resolution) then + begin + gMainSettings.Resolution := fResolutions.FindCorrect(gMainSettings.Resolution); + if not fResolutions.IsValid(gMainSettings.Resolution) then + gMainSettings.FullScreen := False; + end; + + gVideoPlayer := TKMVideoPlayer.Create(FEAT_VIDEOS_UNDER_WINE or not IsUnderWine); + + fFormMain.Caption := 'KaM Remake - ' + UnicodeString(GAME_VERSION); + //Will make the form slightly higher, so do it before ReinitRender so it is reset + fFormMain.UpdateFormState; + + // Check INI window params, if not valid - set NeedResetToDefaults flag for future update + if not gMainSettings.WindowParams.IsValid(GetScreenMonitorsInfo) then + gMainSettings.WindowParams.NeedResetToDefaults := True; + + // Stop app if we did not ReinitRender properly (didn't pass game folder permissions test) + //todo -cComplicated: refactor. Separate folder permissions check and render initialization + // Locale and texts could be loaded separetely to show proper translated error message + if not ReinitRender(False) then + Exit(False); + + fFormMain.ControlsReset; // Reset controls will update Defaults.pas settings after loaded DevSettings + fFormMain.ControlsRefill; // Refill some of the debug controls from game settings + + // Create gSystem before Application.OnActivate (it uses FlashingStop) + gSystem := TKMSystem.Create(fFormMain.Handle); + + Application.OnIdle := DoIdle; + Application.OnActivate := DoActivate; + Application.OnDeactivate := DoDeactivate; + Application.OnRestore := DoRestore; //OnActivate seems to happen at the wrong times, OnRestore happens when alt-tabbing back in full screen mode + + //Update map cache files (*.mi) in the background so map lists load faster + MapCacheUpdate; + + //Process messages in queue before hiding Loading, so that they all land on Loading form, not main one + Application.ProcessMessages; + fFormLoading.Hide; + + fFormMain.AfterFormCreated; + + gLog.AddTime('Game Load Done in ' + IntToStr(TimeSince(time))); +end; + + +procedure TKMMain.HandleStatusBarText(aPanelIndex: TKMStatusBarPanel; aText: string); +begin + fFormMain.StatusBar1.Panels[Ord(aPanelIndex)].Text := aText; +end; + + +procedure TKMMain.GameSpeedChange(aSpeed: Single); +begin + // Set check state without trigger OnClick event handler for the CheckBox + fFormMain.chkSuperSpeed.SetCheckedWithoutClick(aSpeed = DEBUG_SPEEDUP_SPEED); +end; + + +procedure TKMMain.CloseQuery(var aCanClose: Boolean); +var + wasRunning: Boolean; +begin + //MessageDlg works better than Application.MessageBox or others, it stays on top and + //pauses here until the user clicks ok. However for some reason we chose MessageBox + //thus we need to pause the game manually + + aCanClose := (gGameApp = nil) or (gGameApp.Game = nil) or gGameApp.Game.Params.IsReplay; + + if not aCanClose then + begin + //We want to pause the game for the time user verifies he really wants to close + wasRunning := not gGameApp.Game.Params.IsMultiPlayerOrSpec + and not gGameApp.Game.Params.IsMapEditor + and not gGameApp.Game.IsPaused; + + //Pause the game + if wasRunning then + gGameApp.Game.IsPaused := True; + + //Ask the Player + {$IF DEFINED(MSWindows)} + //MessageBox works best in Windows (gets stuck under main form less) + aCanClose := MessageBox( fFormMain.Handle, + PChar(gResTexts[TX_EXIT_WARN_MESSAGE]), + PChar(gResTexts[TX_EXIT_WARN_HEADER]), + MB_YESNO or MB_ICONWARNING or MB_SETFOREGROUND or MB_TASKMODAL + ) = IDYES; + {$ELSEIF DEFINED(Unix)} + aCanClose := MessageDlg(gResTexts[TX_EXIT_WARN_MESSAGE], mtWarning, [mbYes, mbNo], 0) = mrYes; + {$ELSE} + {$ERROR Unsupported case. Please, implement the function} + {$ENDIF} + + //Resume the game + if not aCanClose and wasRunning then + gGameApp.Game.IsPaused := False; + end; +end; + + +procedure TKMMain.Stop(Sender: TObject); +begin + try + gLog.AddTime('Stopping game application...'); + FreeThenNil(gSystem); + //Reset the resolution + FreeThenNil(fResolutions); + + if fMapCacheUpdater <> nil then + fMapCacheUpdater.Stop; + + // Save Keys settings before destruction of gGameApp, since gResKeys, gResTexts, gResKeyFuncs are used when save to xml + gKeySettings.SaveToXML; + + FreeThenNil(gGameApp); + // Destroy gGameAppSettings after GameApp is destroyed, since gGameSettings could be used during destruction + FreeThenNil(gGameAppSettings); + + FreeThenNil(gLog); + + {$IFDEF MSWindows} + TimeEndPeriod(1); + ClipCursor(nil); //Release the cursor restriction + {$ENDIF} + + // We could have been asked to close by MainForm or from other place (e.g. MainMenu Exit button) + // In first case Form will take care about closing itself + + // Do not call gMain.Stop from FormClose handler again + fFormMain.OnClose := nil; + + if Assigned(gVideoPlayer) then + gVideoPlayer.Free; + + // fFormMain.DevSettingsSave; Moved into MainForm itself, since it's purely MainForms business. Rest of the app should know nothing about it + + if Sender <> fFormMain then + fFormMain.Close; + except + on E: Exception do + gLog.AddTime('Exception while closing game app: ' + E.Message + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF}); + end; +end; + + +//Apply the cursor restriction when alt-tabbing back +procedure TKMMain.DoRestore(Sender: TObject); +begin + if Application.Active and (gMainSettings <> nil) then + ApplyCursorRestriction; //Cursor restriction is lost when alt-tabbing out, so we need to apply it again +end; + + +procedure TKMMain.DoActivate(Sender: TObject); +begin + if Application.Active then + gSystem.FlashingStop; +end; + + +procedure TKMMain.DoDeactivate(Sender: TObject); +begin + //Occurs during Toggle to fullscreen, should be ignored + if Application.Active then Exit; + + //Prevent the game window from being in the way by minimizing when alt-tabbing + if (gMainSettings <> nil) and gMainSettings.FullScreen then + begin + {$IFDEF MSWindows} + ClipCursor(nil); //Remove all cursor clipping just in case Windows doesn't automatically + {$ENDIF} + Application.Minimize; + end; +end; + + +procedure TKMMain.UpdateFPS(latestFrameTime: Cardinal); +var + fpsLag: Integer; +begin + if gMainSettings <> nil then //gMainSettings could be nil on Game Exit ?? Just check if its not nil + begin + Inc(fOldFrameTimes, latestFrameTime); + Inc(fFrameCount); + if fOldFrameTimes >= FPS_INTERVAL then + begin + fFPS := 1000 / (fOldFrameTimes / fFrameCount); + if gGameApp <> nil then + gGameApp.SendFPSMeasurement(Round(fFPS)); + + fpsLag := 1000 div gMainSettings.FPSCap; + fFPSString := Format('%.1f FPS', [fFPS]) + IfThen(CAP_MAX_FPS, ' (cap ' + IntToStr(fpsLag) + 'ms)'); + HandleStatusBarText(spFPS, fFPSString); + fOldFrameTimes := 0; + fFrameCount := 0; + end; + end; +end; + + +function TKMMain.GetRenderInterval: Cardinal; +begin + Result := 0; + if CAP_MAX_FPS and (gMainSettings <> nil) then + Result := 1000 div gMainSettings.FPSCap; +end; + + +procedure TKMMain.DoRender; +var renderDelta: Cardinal; +begin + renderDelta := TimeSince(fLastRenderTime); + fLastRenderTime := TimeGet; + UpdateFPS(renderDelta); + + gGameApp.UpdateStateIdle(renderDelta); + gGameApp.Render; +end; + + +procedure TKMMain.SleepUntilNextSchedule; +var + nextTime, nextRender, nextTick, timeNow, sleepTime, renderInterval: Cardinal; +begin + renderInterval := GetRenderInterval; + + nextRender := AddWithOverflow(fRenderSchedule, renderInterval); + nextTick := AddWithOverflow(fTickSchedule, fGameTickInterval); + + if nextRender > nextTick then + nextTime := nextRender + else + nextTime := nextTick; + + timeNow := TimeGet; + if nextTime > timeNow then + begin + sleepTime := nextTime - timeNow; + //Check for TimeGet overflow (never sleep longer than the render interval) + if sleepTime < renderInterval then + Sleep(sleepTime); + end; +end; + + +function TKMMain.ForcedRenderRequired: Boolean; +begin + Result := (gMainSettings <> nil) + and gMainSettings.IsNoRenderMaxTimeSet + and (TimeSince(fLastRenderTime) > gMainSettings.NoRenderMaxTime); +end; + + +procedure TKMMain.DoIdle(Sender: TObject; var Done: Boolean); + + function CalculateSchedule(aLastTime, aTimeSince, aInterval: Cardinal): Cardinal; + var + ticksBehind: Cardinal; + begin + ticksBehind := (aTimeSince div aInterval); + Result := AddWithOverflow(aLastTime, ticksBehind*aInterval); + end; + +const + MAX_TIME_BETWEEN_RENDERS = 1000; //Render at least 1 FPS + UI_UPDATE_INTERVAL = 100; +var + renderInterval, timeSinceRender, timeSinceTick, timeSinceUpdateUI: Cardinal; +begin + Done := False; //Repeats OnIdle asap without performing Form-specific idle code + + if gGameApp = nil then + begin + Sleep(10); + Exit; + end; + + if CHECK_8087CW then + //$1F3F is used to mask out reserved/undefined bits + Assert((Get8087CW and $1F3F = $133F), '8087CW is wrong'); + + //Some PCs seem to change 8087CW randomly between events like Timers and OnMouse*, + //so we need to set it right before we do game logic processing + Set8087CW($133F); + + //Priority 1. Do we need to tick? + timeSinceTick := TimeSince(fTickSchedule); + if (timeSinceTick >= fGameTickInterval) and not ForcedRenderRequired then + begin + gGameApp.DoGameTick; + fTickSchedule := CalculateSchedule(fTickSchedule, timeSinceTick, fGameTickInterval); + end + else + begin + //Priority 2. UI update and render + timeSinceUpdateUI := TimeSince(fUpdateStateSchedule); + if timeSinceUpdateUI >= UI_UPDATE_INTERVAL then + begin + gGameApp.UpdateState; + fUpdateStateSchedule := CalculateSchedule(fUpdateStateSchedule, timeSinceUpdateUI, UI_UPDATE_INTERVAL); + end; + + renderInterval := GetRenderInterval; + if renderInterval > 0 then + begin + timeSinceRender := TimeSince(fRenderSchedule); + if timeSinceRender >= renderInterval then + begin + DoRender; + fRenderSchedule := CalculateSchedule(fRenderSchedule, timeSinceRender, renderInterval); + end + else + SleepUntilNextSchedule; + end + else + DoRender; //No FPS cap so always render + end; +end; + + +// Check game execution dir generic permissions +function TKMMain.DoHaveGenericPermission: Boolean; +const + GRANTED: array[Boolean] of string = ('blocked', 'granted'); +var + readAcc, writeAcc, execAcc, dirWritable: Boolean; +begin + CheckFolderPermission(ExeDir, readAcc, writeAcc, execAcc); + + dirWritable := IsDirectoryWriteable(ExeDir); + + gLog.AddTime('Checking game folder "%s" generic permissions: READ: %s; WRITE: %s; EXECUTE: %s; folder is writable: %s', + [ExeDir, GRANTED[readAcc], GRANTED[writeAcc], GRANTED[execAcc], BoolToStr(dirWritable, True)]); + + Result := dirWritable and readAcc and writeAcc and execAcc; +end; + + +function TKMMain.ReinitRender(aReturnToOptions: Boolean): Boolean; + + procedure ShowPermissionsError; + begin + SKIP_RENDER := True; // Skip render, since gGameApp will show panels on FullScreen mode + fFormLoading.Hide; //Will close the form on Full Screen mode + fFormMain.Hide; + gMusic.Stop; + fFormMain.ShowFolderPermissionError; // Show localized error message + Stop(nil); // Stop the app + end; + +begin + Result := True; + if gMainSettings.FullScreen then + begin + // Lock window params while we are in FullScreen mode + gMainSettings.WindowParams.LockParams; + if fResolutions.IsValid(gMainSettings.Resolution) then + fResolutions.SetResolution(gMainSettings.Resolution) + else + gMainSettings.FullScreen := False; + end else + fResolutions.Restore; + + fFormLoading.Position := poScreenCenter; + + // Will show windowed form and play videos + // Should be made before GameApp creation, otherwise window position will not be set correctly + // (its prbably because it will be overwritten, on gGameApp creation) + if not gMainSettings.FullScreen then + fFormMain.ShowInWindow; + + //It's required to re-init whole OpenGL related things when RC gets toggled fullscreen + FreeThenNil(gGameApp); //Saves all settings into ini file in midst + gGameApp := TKMGameApp.Create(fFormMain.RenderArea, + fFormMain.RenderArea.Width, + fFormMain.RenderArea.Height, + gMainSettings.VSync, + fFormLoading.LoadingStep, + fFormLoading.LoadingText, + HandleStatusBarText); + + // Will show fullscreen form and play videos + // We need to start it after GameApp creation, since we need gResLocales to load proper video file by loaded locale + if gMainSettings.FullScreen then + fFormMain.ShowFullscreen; + + // Check if player has all permissions on game folder. Close the app if not + // Check is done after gGameApp creating because we want to load texts first to show traslated error message + //todo -cComplicated: refactor. Separate folder permissions check and render initialization + // Locale and texts could be loaded separetely to show proper translated error message + try + if (gLog = nil) + or (not aReturnToOptions and not DoHaveGenericPermission) then + begin + ShowPermissionsError; + Exit(False); // Stop the app + end; + except + // but it seems like Exit alone doesn't work - try-except block does + ShowPermissionsError; + Exit(False); // Stop the app + end; + + gGameApp.OnGameSpeedActualChange := GameSpeedChange; + gGameApp.AfterConstruction(aReturnToOptions); + + //Preload game resources while in menu to make 1st game start faster + gGameApp.PreloadGameResources; + + gGameApp.OnOptionsChange := fFormMain.ControlsRefill; + fFormMain.OnControlsUpdated := gGameApp.DebugControlsUpdated; + + gLog.AddTime('ToggleFullscreen'); + gLog.AddTime('Form Width/Height: %dx%d', [fFormMain.Width, fFormMain.Height]); + gLog.AddTime('Panel Width/Height: %dx%d', [fFormMain.RenderArea.Width, fFormMain.RenderArea.Height]); + + //Hide'n'show will make form go ontop of taskbar + fFormMain.Hide; + fFormMain.Show; + + ForceResize; //Force everything to resize + + // Unlock window params if are no longer in FullScreen mode + if not gMainSettings.FullScreen then + gMainSettings.WindowParams.UnlockParams; + + ApplyCursorRestriction; +end; + + +function TKMMain.LockMutex: Boolean; +begin + Result := True; + {$IFDEF MSWindows} + if not BLOCK_DUPLICATE_APP then Exit; + + fMutex := CreateMutex(nil, True, PChar(KAM_MUTEX)); + + if fMutex = 0 then + RaiseLastOSError; + + Result := (GetLastError <> ERROR_ALREADY_EXISTS); + + if not Result then + // Close our own handle on the mutex because someone else already made the mutex + UnlockMutex; + {$ENDIF} +end; + + +procedure TKMMain.UnlockMutex; +begin + {$IFDEF MSWindows} + if not BLOCK_DUPLICATE_APP then Exit; + if fMutex = 0 then Exit; //Didn't have a mutex lock + CloseHandle(fMutex); + fMutex := 0; + {$ENDIF} +end; + + +procedure TKMMain.MapCacheUpdate; +begin + // Thread frees itself automatically + fMapCacheUpdater := TTMapsCacheUpdater.Create([mkSP, mkMP, mkDL]); +end; + + +function TKMMain.IsDebugChangeAllowed: Boolean; +begin + Result := (gGameApp.Game = nil) + or not gGameApp.Game.Params.IsMultiPlayerOrSpec + or MULTIPLAYER_CHEATS; +end; + + +function TKMMain.ClientRect(aPixelsCntToReduce: Integer = 0): TRect; +begin + Result := fFormMain.RenderArea.ClientRect; + Result.TopLeft := ClientToScreen(Result.TopLeft); + Result.TopLeft.X := Result.TopLeft.X + aPixelsCntToReduce; + Result.TopLeft.Y := Result.TopLeft.Y + aPixelsCntToReduce; + Result.BottomRight := ClientToScreen(Result.BottomRight); + Result.BottomRight.X := Result.BottomRight.X - aPixelsCntToReduce; + Result.BottomRight.Y := Result.BottomRight.Y - aPixelsCntToReduce; +end; + + +function TKMMain.ClientToScreen(aPoint: TPoint): TPoint; +begin + Result := fFormMain.RenderArea.ClientToScreen(aPoint); +end; + + +//Can be invalid very breifly if you change resolutions (this is possible in Windowed mode) +function TKMMain.GetScreenBounds(out aBounds: TRect): Boolean; +var + I: Integer; +begin + Result := False; + try + aBounds := Classes.Rect(-1,-1,-1,-1); + fFormMain.Monitor; //This forces Delphi to reload Screen.Monitors (only if necessary) and so fixes crashes when using multiple monitors + //Maximized is a special case, it can only be on one monitor. This is required because when maximized form.left = -9 (on Windows 7 anyway) + if fFormMain.WindowState = wsMaximized then + begin + for I := 0 to Screen.MonitorCount-1 do + //Find the monitor with the left closest to the left of the form + if (I = 0) + or ((Abs(fFormMain.Left - Screen.Monitors[I].Left) <= Abs(fFormMain.Left - aBounds.Left)) and + (Abs(fFormMain.Top - Screen.Monitors[I].Top ) <= Abs(fFormMain.Top - aBounds.Top))) then + begin + Result := True; + aBounds.Left := Screen.Monitors[I].Left; + aBounds.Right := Screen.Monitors[I].Width+Screen.Monitors[I].Left; + aBounds.Top := Screen.Monitors[I].Top; + aBounds.Bottom:= Screen.Monitors[I].Height+Screen.Monitors[I].Top; + end; + end + else + for I:=0 to Screen.MonitorCount-1 do + //See if our form is within the boundaries of this monitor (I.e. when it is not outside the boundaries) + if not ((fFormMain.Left >= Screen.Monitors[I].Width + Screen.Monitors[I].Left) or + (fFormMain.Width + fFormMain.Left <= Screen.Monitors[I].Left) or + (fFormMain.Top >= Screen.Monitors[I].Height + Screen.Monitors[I].Top) or + (fFormMain.Height + fFormMain.Top <= Screen.Monitors[I].Top)) then + begin + if not Result then + begin + //First time we have to initialise the result + Result := True; + aBounds.Left := Screen.Monitors[I].Left; + aBounds.Right := Screen.Monitors[I].Width+Screen.Monitors[I].Left; + aBounds.Top := Screen.Monitors[I].Top; + aBounds.Bottom:= Screen.Monitors[I].Height+Screen.Monitors[I].Top; + end + else + begin + //After the first time we compare it with the previous result and take the largest possible area + aBounds.Left := Math.Min(aBounds.Left, Screen.Monitors[I].Left); + aBounds.Right := Math.Max(aBounds.Right, Screen.Monitors[I].Width+Screen.Monitors[I].Left); + aBounds.Top := Math.Min(aBounds.Top, Screen.Monitors[I].Top); + aBounds.Bottom:= Math.Max(aBounds.Bottom,Screen.Monitors[I].Height+Screen.Monitors[I].Top); + end; + end; + except + on E: Exception do + gLog.AddTime('Exception in TKMMain.GetScreenBounds: ' + E.Message + {$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF}); + end; +end; + + +function TKMMain.IsFormActive: Boolean; +begin + Result := fFormMain.Active; +end; + + +procedure TKMMain.Render; +begin + if Self = nil then Exit; + + gGameApp.Render; +end; + + +//Force everything to resize +procedure TKMMain.ForceResize; +begin + Resize(fFormMain.RenderArea.Width, fFormMain.RenderArea.Height); +end; + + +procedure TKMMain.Resize(aWidth, aHeight: Integer); +begin + if Self = nil then Exit; + + gGameApp.Resize(aWidth, aHeight); +end; + + +procedure TKMMain.Resize(aWidth, aHeight: Integer; const aWindowParams: TKMWindowParamsRecord); +begin + if gGameApp = nil then Exit; + + gGameApp.Resize(aWidth, aHeight); + UpdateWindowParams(aWindowParams); +end; + + +procedure TKMMain.Move(const aWindowParams: TKMWindowParamsRecord); +begin + if Self = nil then Exit; + + UpdateWindowParams(aWindowParams); +end; + + +procedure TKMMain.UpdateWindowParams(const aWindowParams: TKMWindowParamsRecord); +begin + if gGameApp = nil then Exit; + if gMainSettings.WindowParams = nil then Exit; //just in case... + + gMainSettings.WindowParams.ApplyWindowParams(aWindowParams); +end; + + +procedure TKMMain.SetGameTickInterval(aInterval: Cardinal); +begin + if Self = nil then Exit; // Could be nil in Runner + + fGameTickInterval := aInterval; +end; + + +procedure TKMMain.ShowAbout; +begin + if Self = nil then Exit; + + fFormLoading.Position := poScreenCenter; + fFormLoading.Bar1.Position := 0; + fFormLoading.Label1.Caption := ''; + fFormLoading.FormStyle := fsStayOnTop; + fFormLoading.Show; +end; + + +//Restrict cursor movement in fullscreen mode +//For multiple monitors, it's very annoying if you play a fullscreen game and your cursor slides +//onto second monitor instead of stopping at the edge as expected. +procedure TKMMain.ApplyCursorRestriction; +var + rect: TRect; +begin + //This restriction is removed when alt-tabbing out, and added again when alt-tabbing back + {$IFDEF MSWindows} + if gMainSettings.FullScreen then + begin + rect := fFormMain.BoundsRect; + ClipCursor(@rect); + end + else + ClipCursor(nil); //Otherwise have no restriction + {$ENDIF} +end; + + +end. diff --git a/vendor/kam_remake/src/KM_Projectiles.pas b/vendor/kam_remake/src/KM_Projectiles.pas new file mode 100644 index 0000000..1d20f5c --- /dev/null +++ b/vendor/kam_remake/src/KM_Projectiles.pas @@ -0,0 +1,489 @@ +unit KM_Projectiles; +{$I KaM_Remake.inc} +interface +uses + KM_Units, KM_Houses, + KM_CommonClasses, KM_CommonGameTypes, KM_Points, KM_RenderTypes; + + +type + // Projectiles in-game: arrows, bolts, rocks, etc.. + // Once launched they are on their own + TKMProjectiles = class + private + fItems: array of record //1..n + fScreenStart: TKMPointF; //Screen-space trajectory start + fScreenEnd: TKMPointF; //Screen-space trajectory end + + fAim: TKMPointF; //Where we were aiming to hit + fTarget: TKMPointF; //Where projectile will hit + fShotFrom: TKMPointF; //Where the projectile was launched from + + fType: TKMProjectileType; //type of projectile (arrow, bolt, rocks, etc..) + fOwner: TKMUnit; //The projectiles owner, used for kill statistics and script events + fSpeed: Single; //Each projectile speed may vary a little bit + fArc: Single; //Thats how high projectile will go along parabola (varies a little more) + fPosition: Single; //Projectiles position along the route Start>>End + fLength: Single; //Route length to look-up for hit + fMaxLength: Single; //Maximum length the archer could have shot + end; + + fOnAddProjectileToRenderPool: TKMRenderPoolAddProjectileEvent; + + function AddItem(const aStart,aAim,aEnd: TKMPointF; aSpeed, aArc, aMaxLength: Single; aProjType: TKMProjectileType; aOwner: TKMUnit): Word; + procedure RemItem(aIndex: Integer); + function ProjectileVisible(aIndex: Integer): Boolean; + procedure AddProjectileToRenderPool(aProj: TKMProjectileType; const aRenderPos, aTilePos: TKMPointF; aDir: TKMDirection; aFlight: Single); inline; + public + constructor Create(aOnAddProjectileToRenderPool: TKMRenderPoolAddProjectileEvent); + + function AimTargetUnit(const aStart: TKMPointF; aTarget: TKMUnit; aProjType: TKMProjectileType; aOwner: TKMUnit; aMaxRange, aMinRange: Single): Word; + function AimTargetHouse(const aStart: TKMPointF; aTarget: TKMHouse; aProjType: TKMProjectileType; aOwner: TKMUnit; aMaxRange, aMinRange: Single): Word; + + procedure UpdateState; + procedure Paint(aTickLag: Single); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad; + end; + + +var + gProjectiles: TKMProjectiles; + + +implementation +uses + Math, KromUtils, + KM_Entity, + KM_Terrain, KM_RenderAux, + KM_Resource, KM_ResSound, KM_ResUnits, + KM_Hand, KM_HandsCollection, KM_HandTypes, KM_HandEntity, + KM_Sound, + KM_CommonUtils, KM_Defaults; + + +const + PROJECTILE_LAUNCH_SOUND: array[TKMProjectileType] of TKMSoundEffectOriginal = (sfxBowShoot, sfxCrossbowShoot, sfxNone, sfxRockThrow); + PROJECTILE_HIT_SOUND: array[TKMProjectileType] of TKMSoundEffectOriginal = (sfxArrowHit, sfxArrowHit, sfxArrowHit, sfxNone); + PROJECTILE_SPEED: array[TKMProjectileType] of Single = (0.75, 0.75, 0.6, 0.8); + PROJECTILE_ARC: array[TKMProjectileType,1..2] of Single = ((1.6, 0.5), (1.4, 0.4), (2.5, 1), (1.2, 0.2)); //Arc curve and random fraction + PROJECTILE_JITTER: array[TKMProjectileType] of Single = (0.26, 0.29, 0.26, 0.2); //Fixed Jitter added every time + PROJECTILE_JITTER_HOUSE: array[TKMProjectileType] of Single = (0.6, 0.6, 0.6, 0); //Fixed Jitter added every time + // Jitter added according to target's speed (moving target harder to hit) Note: Walking = 0.1, so the added jitter is 0.1*X + PROJECTILE_PREDICT_JITTER: array[TKMProjectileType] of Single = (2, 2, 2, 3); + + +{ TKMProjectiles } +constructor TKMProjectiles.Create(aOnAddProjectileToRenderPool: TKMRenderPoolAddProjectileEvent); +begin + inherited Create; + + fOnAddProjectileToRenderPool := aOnAddProjectileToRenderPool; +end; + + +procedure TKMProjectiles.RemItem(aIndex: Integer); +begin + gHands.CleanUpUnitPointer(fItems[aIndex].fOwner); + fItems[aIndex].fSpeed := 0; +end; + + +function TKMProjectiles.AimTargetUnit(const aStart: TKMPointF; aTarget: TKMUnit; aProjType: TKMProjectileType; aOwner: TKMUnit; aMaxRange, aMinRange: Single): Word; +var + targetVector, target, targetPosition: TKMPointF; + A,B,C,D: Single; + timeToHit, time1, time2, distanceToHit, distanceInRange: Single; + jitter, speed, arc: Single; + U: TKMUnit; +begin + //Now we know projectiles speed and aim, we can predict where target will be at the time projectile hits it + + //I wonder if medieval archers knew about vectors and quadratic equations + + targetPosition.X := (aTarget.PositionF.X - aStart.X); + targetPosition.Y := (aTarget.PositionF.Y - aStart.Y); + targetVector := aTarget.GetMovementVector; + + { This comment explains how we came to final ABC equation + + Target = TargetPosition + TargetVector * Time; + FlightDistance := ArrowSpeed * Time; + + sqr(Target) = sqr(FlightDistance); + + sqr(TargetPosition + TargetVector * Time) = sqr(ArrowSpeed * Time) + + sqr(TargetPosition.X) + 2 * Time * TargetPosition.X * TargetVector.X + sqr(Time) * sqr(TargetVector.X) + + sqr(ArrowSpeed) * sqr(Time) + + sqr(Time) * (sqr(TargetVector.X) + sqr(TargetVector.Y) - sqr(ArrowSpeed)) + + 2 * Time * (TargetPosition.X * TargetVector.X + TargetPosition.Y * TargetVector.Y) + + sqr(TargetPosition.X) + sqr(TargetPosition.Y) = 0 + + //Lets try to solve this quadratic equation + //ATT + BT + C = 0 + //by using formulae X = (-B +- sqrt(B*B - 4*A*C)) / 2*A + A = sqr(TargetVector.X) + sqr(TargetVector.Y) - sqr(ArrowSpeed) + B = 2 * (TargetPosition.X * TargetVector.X + TargetPosition.Y * TargetVector.Y) + C = sqr(TargetPosition.X) + sqr(TargetPosition.Y) } + + speed := PROJECTILE_SPEED[aProjType] + KaMRandomS2(0.05{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget'{$ENDIF}); + + A := sqr(targetVector.X) + sqr(targetVector.Y) - sqr(speed); + B := 2 * (targetPosition.X * targetVector.X + targetPosition.Y * targetVector.Y); + C := sqr(targetPosition.X) + sqr(targetPosition.Y); + + D := sqr(B) - 4 * A * C; + + if (D >= 0) and (A <> 0) then + begin + time1 := (-B + sqrt(D)) / (2 * A); + time2 := (-B - sqrt(D)) / (2 * A); + + //Choose smallest positive time + if (time1 > 0) and (time2 > 0) then + timeToHit := Math.min(time1, time2) + else + if (time1 < 0) and (time2 < 0) then + timeToHit := 0 + else + timeToHit := Math.max(time1, time2); + end + else + timeToHit := 0; + + if timeToHit <> 0 then + begin + jitter := PROJECTILE_JITTER[aProjType] + + KMLength(KMPOINTF_ZERO, targetVector) * PROJECTILE_PREDICT_JITTER[aProjType]; + + //Calculate the target position relative to start position (the 0;0) + target.X := targetPosition.X + targetVector.X*timeToHit + KaMRandomS2(jitter{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 2'{$ENDIF}); + target.Y := targetPosition.Y + targetVector.Y*timeToHit + KaMRandomS2(jitter{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 3'{$ENDIF}); + + //We can try and shoot at a target that is moving away, + //but the arrows can't flight any further than their max_range + distanceToHit := GetLength(target.X, target.Y); + distanceInRange := EnsureRange(distanceToHit, aMinRange, aMaxRange); + target.X := aStart.X + target.X / distanceToHit * distanceInRange; + target.Y := aStart.Y + target.Y / distanceToHit * distanceInRange; + + //Calculate the arc, less for shorter flights + arc := ((distanceInRange-aMinRange)/(aMaxRange-aMinRange))*(PROJECTILE_ARC[aProjType, 1] + KaMRandomS2(PROJECTILE_ARC[aProjType, 2]{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 4'{$ENDIF})); + + //Check whether this predicted target will hit a friendly unit + if gTerrain.TileInMapCoords(Round(target.X), Round(target.Y)) then //Arrows may fly off map, UnitsHitTest doesn't like negative coordinates + begin + U := gTerrain.UnitsHitTest(Round(target.X), Round(target.Y)); + if (U <> nil) and (gHands.CheckAlliance(aOwner.Owner, U.Owner) = atAlly) then + target := aTarget.PositionF; //Shoot at the target's current position instead + end; + + Result := AddItem(aStart, aTarget.PositionF, target, speed, arc, aMaxRange, aProjType, aOwner); + + //Tell the Opponent that he is under attack (when arrows are in the air) + gHands[aTarget.Owner].AI.UnitAttackNotification(aTarget, aOwner); + end else + Result := 0; +end; + + +function TKMProjectiles.AimTargetHouse(const aStart: TKMPointF; aTarget: TKMHouse; aProjType: TKMProjectileType; aOwner: TKMUnit; aMaxRange, aMinRange: Single): Word; +var + speed, arc: Single; + distanceToHit, distanceInRange: Single; + aim, target: TKMPointF; +begin + speed := PROJECTILE_SPEED[aProjType] + KaMRandomS2(0.05{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 5'{$ENDIF}); + + aim := KMPointF(aTarget.GetRandomCellWithin); + target.X := aim.X + KaMRandomS2(PROJECTILE_JITTER_HOUSE[aProjType]{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 6'{$ENDIF}); //So that arrows were within house area, without attitude to tile corners + target.Y := aim.Y + KaMRandomS2(PROJECTILE_JITTER_HOUSE[aProjType]{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 7'{$ENDIF}); + + //Calculate the arc, less for shorter flights + distanceToHit := GetLength(aStart.X - target.X, aStart.Y - target.Y); + distanceInRange := EnsureRange(distanceToHit, aMinRange, aMaxRange); + + var arcRandom := KaMRandomS2(PROJECTILE_ARC[aProjType, 2]{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.AimTarget 8'{$ENDIF}); + arc := Math.Max((distanceInRange - aMinRange) / (aMaxRange - aMinRange) * PROJECTILE_ARC[aProjType, 1] + arcRandom, 0); + + Result := AddItem(aStart, aim, target, speed, arc, aMaxRange, aProjType, aOwner); +end; + + +// Return flight time (archers like to know when they hit target before firing again) +function TKMProjectiles.AddItem(const aStart, aAim, aEnd: TKMPointF; aSpeed, aArc, aMaxLength: Single; aProjType: TKMProjectileType; aOwner: TKMUnit): Word; +const + // TowerRock position is a bit different for reasons said below + // Recruit stands in entrance, Tower middleline is X-0.75 + OFFSET_X: array [TKMDirection] of array [TKMProjectileType] of Single = + ((0.5, 0.5, 0.5, -0.25), // dirNA + (0.5, 0.5, 0.7, -0.25), // dirN + (1.0, 0.5, 0.7, -0.25), // dirNE + (0.7, 0.5, 0.7, -0.25), // dirE + (0.7, 0.5, 0.7, -0.25), // dirSE + (0.4, 0.4, 0.3, -0.25), // dirS + (0.4, 0.4, 0.5, -0.25), // dirSW + (0.4, 0.4, 0.5, -0.25), // dirW + (0.3, 0.5, 0.5, -0.25)); // dirNW + // Add towers height + OFFSET_Y: array [TKMDirection] of array [TKMProjectileType] of Single = + ((0.2, 0.2, 0.2, -0.2), // dirNA + (0.2, 0.2, 0.2, -0.2), // dirN + (0.0, 0.6, 0.5, -0.2), // dirNE + (0.3, 0.35,0.3, -0.2), // dirE + (0.5, 0.4, 0.5, -0.2), // dirSE + (0.3, 0.2, 0.4, -0.2), // dirS + (0.4, 0.4, 0.2, -0.2), // dirSW + (0.2, 0.3, 0.3, -0.2), // dirW + (0.1, 0.3, 0.3, -0.2)); // dirNW +var + I: Integer; +begin + I := -1; + repeat + Inc(I); + if I >= Length(fItems) then + SetLength(fItems, I+8); //Add new + until(fItems[I].fSpeed = 0); + + //Fill in basic info + fItems[I].fType := aProjType; + fItems[I].fSpeed := aSpeed; + fItems[I].fArc := aArc; + fItems[I].fOwner := aOwner.GetPointer; + fItems[I].fAim := aAim; + //Don't allow projectile to land off map, (we use fTaret for hit tests, FOW, etc.) but on borders is fine + fItems[I].fTarget.X := EnsureRange(aEnd.X, 0, gTerrain.MapX-0.01); + fItems[I].fTarget.Y := EnsureRange(aEnd.Y, 0, gTerrain.MapY-0.01); + fItems[I].fShotFrom := aStart; + + fItems[I].fScreenStart.X := aStart.X + OFFSET_X[aOwner.Direction, aProjType]; + fItems[I].fScreenStart.Y := gTerrain.FlatToHeight(aStart).Y + OFFSET_Y[aOwner.Direction, aProjType]; + fItems[I].fScreenEnd.X := fItems[I].fTarget.X + 0.5; //projectile hits on Unit's chest height + fItems[I].fScreenEnd.Y := gTerrain.FlatToHeight(fItems[I].fTarget).Y + 0.5; + + fItems[I].fPosition := 0; //projectile position on its route + fItems[I].fLength := KMLength(fItems[I].fScreenStart, fItems[I].fScreenEnd); //route length + fItems[I].fMaxLength:= aMaxLength; + + if (gMySpectator.FogOfWar.CheckTileRevelation(KMPointRound(aStart).X, KMPointRound(aStart).Y) >= 255) then + gSoundPlayer.Play(PROJECTILE_LAUNCH_SOUND[aProjType], aStart); + + Result := Round(fItems[I].fLength / fItems[I].fSpeed); +end; + + +//Update all items positions and kill some targets +procedure TKMProjectiles.UpdateState; +const + H_TICKS = 6; //The number of ticks before hitting that an arrow will make the hit noise +var + I: Integer; + U: TKMUnit; + H: TKMHouse; + Damage: Smallint; +begin + for I := 0 to Length(fItems) - 1 do + with fItems[I] do + if fSpeed <> 0 then + begin + fPosition := fPosition + fSpeed; + + //Will hit the target in X..X-1 ticks (this ensures it only happens once) + //Can't use InRange cos it might get called twice due to <= X <= comparison + if gMySpectator.FogOfWar.CheckRevelation(fTarget) >= 255 then + if (fLength - H_TICKS*fSpeed <= fPosition) and (fPosition < fLength - (H_TICKS - 1) * fSpeed) then + gSoundPlayer.Play(PROJECTILE_HIT_SOUND[fType], fTarget); + + if fPosition >= fLength then + begin + U := gTerrain.UnitsHitTestF(fTarget); + //Projectile can miss depending on the distance to the unit + if (U = nil) or ((1 - Math.Min(KMLength(U.PositionF, fTarget), 1)) > KaMRandom({$IFDEF DBG_RNG_SPY}'TKMProjectiles.UpdateState'{$ENDIF})) then + begin + case fType of + ptArrow, + ptSlingRock, + ptBolt: if (U <> nil) and not U.IsDeadOrDying and U.Visible and not (U is TKMUnitAnimal) + //Can't hit units past max range because that's unintuitive/confusing to player + and (KMLengthSqr(fShotFrom, U.PositionF) <= Sqr(fMaxLength)) then + begin + Damage := 0; + if fType = ptArrow then Damage := gRes.Units[utBowman].Attack; + if fType = ptBolt then Damage := gRes.Units[utCrossbowman].Attack; + if fType = ptSlingRock then Damage := gRes.Units[utRogue].Attack; + Damage := Round(Damage / Math.max(gRes.Units[U.UnitType].GetDefenceVsProjectiles(fType = ptBolt), 1)); //Max is not needed, but animals have 0 defence + if (FRIENDLY_FIRE or (gHands.CheckAlliance(fOwner.Owner, U.Owner)= atEnemy)) + and (Damage >= KaMRandom(101{$IFDEF DBG_RNG_SPY}, 'TKMProjectiles.UpdateState'{$ENDIF})) then + U.HitPointsDecrease(1, fOwner); + end + else + begin + H := gHands.HousesHitTest(Round(fTarget.X), Round(fTarget.Y)); + if (H <> nil) + and (FRIENDLY_FIRE or (gHands.CheckAlliance(fOwner.Owner, H.Owner)= atEnemy)) + then + H.AddDamage(1, fOwner); + end; + ptTowerRock: if (U <> nil) and not U.IsDeadOrDying and U.Visible + and not (U is TKMUnitAnimal) + and (FRIENDLY_FIRE or (gHands.CheckAlliance(fOwner.Owner, U.Owner)= atEnemy)) then + U.HitPointsDecrease(U.HitPointsMax, fOwner); //Instant death + end; + end; + RemItem(I); + end; + end; +end; + + +procedure TKMProjectiles.AddProjectileToRenderPool(aProj: TKMProjectileType; const aRenderPos, aTilePos: TKMPointF; aDir: TKMDirection; aFlight: Single); +begin + if Assigned(fOnAddProjectileToRenderPool) then + fOnAddProjectileToRenderPool(aProj, aRenderPos, aTilePos, aDir, aFlight); +end; + + +//Test wherever projectile is visible (used by rocks thrown from Towers) +function TKMProjectiles.ProjectileVisible(aIndex: Integer): Boolean; +begin + if (fItems[aIndex].fType = ptTowerRock) + and ((fItems[aIndex].fScreenEnd.Y - fItems[aIndex].fScreenStart.Y) < 0) then + Result := fItems[aIndex].fPosition >= 0.2 //fly behind a Tower + else + Result := True; +end; + + +procedure TKMProjectiles.Paint(aTickLag: Single); +var + I: Integer; + mixValue, mixValueMax, tickLagOffset, laggedPosition: Single; + mixArc: Single; //mix Arc shape + P: TKMPointF; //Arrows and bolts send 2 points for head and tail + pTileBased: TKMPointF; + dir: TKMDirection; +begin + for I := 0 to Length(fItems) - 1 do + if (fItems[I].fSpeed <> 0) and ProjectileVisible(I) then + begin + tickLagOffset := aTickLag*fItems[I].fSpeed; + laggedPosition := fItems[I].fPosition - tickLagOffset; + //If the projectile hasn't appeared yet in lagged time + if laggedPosition < 0 then Continue; + + mixValue := EnsureRange(laggedPosition / fItems[I].fLength, 0.0, 1.0); // 0 >> 1 + mixValueMax := EnsureRange(laggedPosition / fItems[I].fMaxLength, 0.0, 1.0); // 0 >> 1 + P := KMLerp(fItems[I].fScreenStart, fItems[I].fScreenEnd, mixValue); + pTileBased := KMLerp(fItems[I].fShotFrom, fItems[I].fTarget, mixValue); + case fItems[I].fType of + ptArrow, ptSlingRock, ptBolt: + begin + mixArc := sin(mixValue*pi); // 0 >> 1 >> 0 Parabola + //Looks better moved up, launches from the bow not feet and lands in target's body + P.Y := P.Y - fItems[I].fArc * mixArc - 0.4; + dir := KMGetDirection(fItems[I].fScreenStart, fItems[I].fScreenEnd); + AddProjectileToRenderPool(fItems[I].fType, P, pTileBased, dir, mixValueMax); + end; + + ptTowerRock: + begin + mixArc := cos(mixValue*pi/2); // 1 >> 0 Half-parabola + //Looks better moved up, lands on the target's body not at his feet + P.Y := P.Y - fItems[I].fArc * mixArc - 0.4; + AddProjectileToRenderPool(fItems[I].fType, P, pTileBased, dirN, mixValue); //Direction will be ignored + end; + end; + + if SHOW_PROJECTILES then + begin + gRenderAux.Projectile(fItems[I].fScreenStart.X, + fItems[I].fScreenStart.Y, + fItems[I].fScreenEnd.X, + fItems[I].fScreenEnd.Y); + + gRenderAux.Projectile(fItems[I].fAim.X, + fItems[I].fAim.Y, + fItems[I].fTarget.X, + fItems[I].fTarget.Y); + end; + end; +end; + + +procedure TKMProjectiles.Save(SaveStream: TKMemoryStream); +var + I, liveCount: Integer; +begin + SaveStream.PlaceMarker('Projectiles'); + + //Strip dead projectiles + liveCount := 0; + for I := 0 to Length(fItems) - 1 do + //if fItems[I].fSpeed <> 0 then // This causes desynchronization in replay + Inc(liveCount); + + SaveStream.Write(liveCount); + + for I := 0 to Length(fItems) - 1 do + //if fItems[I].fSpeed <> 0 then // This causes desynchronization in replay + begin + SaveStream.Write(fItems[I].fScreenStart); + SaveStream.Write(fItems[I].fScreenEnd); + SaveStream.Write(fItems[I].fAim); + SaveStream.Write(fItems[I].fTarget); + SaveStream.Write(fItems[I].fShotFrom); + SaveStream.Write(fItems[I].fType, SizeOf(TKMProjectileType)); + SaveStream.Write(fItems[I].fOwner.UID); //Store ID + SaveStream.Write(fItems[I].fSpeed); + SaveStream.Write(fItems[I].fArc); + SaveStream.Write(fItems[I].fPosition); + SaveStream.Write(fItems[I].fLength); + SaveStream.Write(fItems[I].fMaxLength); + end; +end; + + +procedure TKMProjectiles.Load(LoadStream: TKMemoryStream); +var + I, newCount: Integer; +begin + LoadStream.CheckMarker('Projectiles'); + + LoadStream.Read(newCount); + SetLength(fItems, newCount); + + for I := 0 to newCount - 1 do + begin + LoadStream.Read(fItems[I].fScreenStart); + LoadStream.Read(fItems[I].fScreenEnd); + LoadStream.Read(fItems[I].fAim); + LoadStream.Read(fItems[I].fTarget); + LoadStream.Read(fItems[I].fShotFrom); + LoadStream.Read(fItems[I].fType, SizeOf(TKMProjectileType)); + LoadStream.Read(fItems[I].fOwner, 4); + LoadStream.Read(fItems[I].fSpeed); + LoadStream.Read(fItems[I].fArc); + LoadStream.Read(fItems[I].fPosition); + LoadStream.Read(fItems[I].fLength); + LoadStream.Read(fItems[I].fMaxLength); + end; +end; + + +procedure TKMProjectiles.SyncLoad; +var + I: Integer; +begin + inherited; + + for I := 0 to Length(fItems) - 1 do + fItems[I].fOwner := gHands.GetUnitByUID(Integer(fItems[I].fOwner)); +end; + + +end. diff --git a/vendor/kam_remake/src/KM_System.pas b/vendor/kam_remake/src/KM_System.pas new file mode 100644 index 0000000..253cad0 --- /dev/null +++ b/vendor/kam_remake/src/KM_System.pas @@ -0,0 +1,244 @@ +unit KM_System; +{$I KaM_Remake.inc} +interface +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + KM_ResSprites, KM_ResTypes, + KM_Defaults; + + +type + // System related features are encapsulated in this class + TKMSystem = class + private + {$IFNDEF FPC} + {$IFDEF MSWindows} + fFormMainHandle: HWND; + fFlashing: Boolean; + {$ENDIF} + {$ENDIF} + + function GetCursor: TKMCursorImageType; + procedure SetCursor(Value: TKMCursorImageType); + public + constructor Create(aFormMainHandle: HWND); + + property Cursor: TKMCursorImageType read GetCursor write SetCursor; + + procedure MakeCursors(aSprites: TKMSpritePack); + + procedure FlashingStart; + procedure FlashingStop; + end; + + +var + gSystem: TKMSystem; + + +implementation +uses + SysUtils, Math, + Forms, Graphics; + +const + // Screen.Cursors[0] is used by System default cursor + CURSOR_CNT_OFFSET = 1; + + // New custom cursors count + CUSTOM_CUR_CNT = 1; + + CUSTOM_CURSORS: array [0..CUSTOM_CUR_CNT-1] of TKMCursorImageType = (kmcAnimatedDirSelector); + + +{ TKMSystem } +constructor TKMSystem.Create(aFormMainHandle: HWND); +begin + inherited Create; + + {$IFNDEF FPC} + {$IFDEF MSWindows} + fFormMainHandle := aFormMainHandle; + {$ENDIF} + {$ENDIF} +end; + + +function TKMSystem.GetCursor: TKMCursorImageType; +begin + if InRange(Screen.Cursor - CURSOR_CNT_OFFSET, Ord(Low(TKMCursorImageType)), Ord(High(TKMCursorImageType))) then + Result := TKMCursorImageType(Screen.Cursor - CURSOR_CNT_OFFSET) + else + Result := kmcDefault; +end; + + +procedure TKMSystem.SetCursor(Value: TKMCursorImageType); +begin + if SKIP_LOADING_CURSOR then Exit; + Screen.Cursor := Ord(Value) + CURSOR_CNT_OFFSET; +end; + + +procedure TKMSystem.MakeCursors(aSprites: TKMSpritePack); +const + SF = 17; //Full width/height of a scroll cursor + SH = 8; //Half width/height of a scroll cursor + // Measured manually + CURSOR_OFFSET_X: array [TKMCursorImageType] of Integer = (0,0,20, 0, 0,-8, 9,0, 1,1,1,0,-1,-1,-1,0, SH,SF,SF,SF,SH, 0, 0,0, 0,0,0,27,0); + CURSOR_OFFSET_Y: array [TKMCursorImageType] of Integer = (0,9,10,18,20,44,13,0,-1,0,1,1, 1, 0,-1,0, 0 ,0 ,SH,SF,SF,SF,SH,0,28,0,0,28,0); + + CUSTOM_CUR_FILENAME: array[0..CUSTOM_CUR_CNT-1] of UnicodeString = ('cur1.ani'); +var + C: TKMCursorImageType; + I, sx, sy, x, y: Integer; + bm, bm2: TBitmap; + iconInfo: TIconInfo; + Px: PRGBQuad; + h : THandle; + path: PChar; + rxData: PRXData; +begin + if SKIP_RENDER then Exit; + + rxData := @aSprites.RXData; // Store pointer to record instead of duplicating it + + bm := TBitmap.Create; bm.HandleType := bmDIB; bm.PixelFormat := pf32bit; + bm2 := TBitmap.Create; bm2.HandleType := bmDIB; bm2.PixelFormat := pf32bit; + + for C := Low(TKMCursorImageType) to kmcPaintBucket do + begin + // Special case for invisible cursor + if C = kmcInvisible then + begin + bm.Width := 1; bm.Height := 1; + bm2.Width := 1; bm2.Height := 1; + bm2.Canvas.Pixels[0,0] := clWhite; //Invisible mask, we don't care for Image color + iconInfo.xHotspot := 0; + iconInfo.yHotspot := 0; + end + else + begin + // Just skip missing cursor, do not crash the game + if CURSOR_SPRITE_INDEX[C] >= Length(rxData.Size) then + Continue; + + sx := rxData.Size[CURSOR_SPRITE_INDEX[C]].X; + sy := rxData.Size[CURSOR_SPRITE_INDEX[C]].Y; + bm.Width := sx; bm.Height := sy; + bm2.Width := sx; bm2.Height := sy; + + for y := 0 to sy - 1 do + begin + Px := bm.ScanLine[y]; + for x := 0 to sx - 1 do + begin + if rxData.RGBA[CURSOR_SPRITE_INDEX[C],y*sx+x] and $FF000000 = 0 then + Px.rgbReserved := $00 + else + Px.rgbReserved := $FF; + // Here we have BGR, not RGB + Px.rgbBlue := (rxData.RGBA[CURSOR_SPRITE_INDEX[C],y*sx+x] and $FF0000) shr 16; + Px.rgbGreen := (rxData.RGBA[CURSOR_SPRITE_INDEX[C],y*sx+x] and $FF00) shr 8; + Px.rgbRed := rxData.RGBA[CURSOR_SPRITE_INDEX[C],y*sx+x] and $FF; + Inc(Px); + end; + end; + //Load hotspot offsets from RX file, adding the manual offsets (normally 0) + iconInfo.xHotspot := Max(-rxData.Pivot[CURSOR_SPRITE_INDEX[C]].x + CURSOR_OFFSET_X[C], 0); + iconInfo.yHotspot := Max(-rxData.Pivot[CURSOR_SPRITE_INDEX[C]].y + CURSOR_OFFSET_Y[C], 0); + end; + + //Release the Mask, otherwise there is black rect in Lazarus + //it works only from within the loop, means mask is recreated when we access canvas or something like that + bm2.ReleaseMaskHandle; + + iconInfo.fIcon := False; //True=Icon, False=Cursor + iconInfo.hbmColor := bm.Handle; + + //I have a suspicion that maybe Windows could create icon delayed, at a time when bitmap data is + //no longer valid (replaced by other bitmap or freed). Hence issues with transparency. + {$IFDEF MSWindows} + iconInfo.hbmMask := bm2.Handle; + Screen.Cursors[Byte(C) + CURSOR_CNT_OFFSET] := CreateIconIndirect(iconInfo); + {$ENDIF} + {$IFDEF Unix} + bm2.Mask(clWhite); + IconInfo.hbmMask := bm2.MaskHandle; + Screen.Cursors[Byte(C) + CURSOR_CNT_OFFSET] := CreateIconIndirect(@IconInfo); + {$ENDIF} + end; + + bm.Free; + bm2.Free; + + {$IFDEF WDC} + for I := Low(CUSTOM_CURSORS) to High(CUSTOM_CURSORS) do + begin + path := PChar(ExeDir + 'data' + PathDelim + 'cursors' + PathDelim + CUSTOM_CUR_FILENAME[I]); + h := LoadImage(0, + path, + IMAGE_CURSOR, + 35, + 36, + LR_DEFAULTSIZE or + LR_LOADFROMFILE); + + if h <> 0 then + Screen.Cursors[Byte(CUSTOM_CURSORS[I]) + CURSOR_CNT_OFFSET] := h + else + // Use default cursor, in case of missing cursor file + Screen.Cursors[Byte(CUSTOM_CURSORS[I]) + CURSOR_CNT_OFFSET] := Screen.Cursors[Byte(kmcDefault) + CURSOR_CNT_OFFSET]; + end; + {$ENDIF} +end; + + +procedure TKMSystem.FlashingStart; +{$IFNDEF FPC}{$IFDEF MSWindows} +var + flashInfo: TFlashWInfo; +{$ENDIF}{$ENDIF} +begin + if Self = nil then Exit; + + {$IFNDEF FPC}{$IFDEF MSWindows} + if (GetForegroundWindow <> fFormMainHandle) then + begin + flashInfo.cbSize := 20; + flashInfo.hwnd := Application.Handle; + flashInfo.dwflags := FLASHW_ALL; + flashInfo.ucount := 5; // Flash 5 times + flashInfo.dwtimeout := 0; // Use default cursor blink rate + fFlashing := True; + FlashWindowEx(flashInfo); + end + {$ENDIF}{$ENDIF} +end; + + +procedure TKMSystem.FlashingStop; +{$IFNDEF FPC}{$IFDEF MSWindows} +var + flashInfo: TFlashWInfo; +{$ENDIF}{$ENDIF} +begin + if Self = nil then Exit; + + {$IFNDEF FPC}{$IFDEF MSWindows} + if fFlashing then + begin + flashInfo.cbSize := 20; + flashInfo.hwnd := Application.Handle; + flashInfo.dwflags := FLASHW_STOP; + flashInfo.ucount := 0; + flashInfo.dwtimeout := 0; + fFlashing := False; + FlashWindowEx(flashInfo); + end + {$ENDIF}{$ENDIF} +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AI.pas b/vendor/kam_remake/src/ai/KM_AI.pas new file mode 100644 index 0000000..1f3370f --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AI.pas @@ -0,0 +1,702 @@ +unit KM_AI; +{$I KaM_Remake.inc} +interface +uses + KM_CommonClasses, KM_CommonTypes, KM_Defaults, + KM_Houses, KM_Units, KM_UnitWarrior, KM_Points, + KM_AISetup, KM_AIMayor, KM_AIGoals, KM_AIGeneral, + KM_CityManagement, KM_ArmyManagement, KM_GameTypes; + +type + //Things that player does automatically + //Player AI exists both for AI and Human players, but for AI it does significantly more + TKMHandAI = class + private + fOwner: TKMHandID; + + fGeneral: TKMGeneral; + fGoals: TKMGoals; + fMayor: TKMayor; + fSetup: TKMHandAISetup; + + fCityManagement: TKMCityManagement; + fArmyManagement: TKMArmyManagement; + + fWonOrLost: TWonOrLost; //Has this player won/lost? If so, do not check goals + + fCanBeAITypes: TKMAITypeSet; + + procedure CheckGoals(aAllowResetGoals: Boolean = False); + function GetHasWon: Boolean; + function GetHasLost: Boolean; + function GetIsNotWinnerNotLoser: Boolean; + function GetGoals: TKMGoals; + function GetSetup: TKMHandAISetup; + public + constructor Create(aHandIndex: TKMHandID); + destructor Destroy; override; + + property General: TKMGeneral read fGeneral; + property Goals: TKMGoals read GetGoals; + property Mayor: TKMayor read fMayor; + property Setup: TKMHandAISetup read GetSetup; + + property CityManagement: TKMCityManagement read fCityManagement; + property ArmyManagement: TKMArmyManagement read fArmyManagement; + + property CanBeAITypes: TKMAITypeSet read fCanBeAITypes write fCanBeAITypes; + + procedure ResetWonOrLost; + procedure Defeat(aShowDefeatMessage: Boolean = True); //Defeat the player, this is not reversible + procedure Victory; //Set this player as victorious, this is not reversible + procedure AddDefaultGoals(aBuildings: Boolean); + property WonOrLost: TWonOrLost read fWonOrLost; + property HasWon: Boolean read GetHasWon; + property HasLost: Boolean read GetHasLost; + procedure RecheckGoals; + property IsNotWinnerNotLoser: Boolean read GetIsNotWinnerNotLoser; + function GetWonOrLostString: UnicodeString; //Get string represantation of Hand WonOrLost + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure HouseAttackNotification(aHouse: TKMHouse; aAttacker: TKMUnitWarrior); + procedure UnitHPDecreaseNotification(aUnit: TKMUnit; aAttacker: TKMUnit; aNotifyScript: Boolean = True); + procedure UnitAttackNotification(aUnit: TKMUnit; aAttacker: TKMUnit; aNotifyScript: Boolean = True); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + procedure UpdateState(aTick: Cardinal; aCheckGoals: Boolean); + procedure AfterMissionInit(aCanBeAITypes: TKMAITypeSet); + procedure PlaceFirstStorehouse(aLoc: TKMPoint); //RMG + + function ObjToString: String; + end; + + +implementation +uses + SysUtils, TypInfo, Math, + KM_GameApp, KM_Game, KM_Hand, KM_HandsCollection, KM_HandStats, KM_UnitGroup, + KM_ResSound, KM_ScriptingEvents, KM_Alerts, + KM_AIFields, KM_Terrain, KM_ResMapElements, KM_DevPerfLog, KM_DevPerfLogTypes, + KM_HandTypes, + KM_MapTypes, + KM_ResTypes; + + +{ TKMHandAI } +constructor TKMHandAI.Create(aHandIndex: TKMHandID); +begin + inherited Create; + + fOwner := aHandIndex; + fSetup := TKMHandAISetup.Create; + fMayor := TKMayor.Create(fOwner, fSetup); + fGeneral := TKMGeneral.Create(fOwner, fSetup); + fGoals := TKMGoals.Create; + fWonOrLost := wolNone; + + fCityManagement := TKMCityManagement.Create(fOwner, fSetup); + fArmyManagement := TKMArmyManagement.Create(fOwner, fSetup); +end; + + +destructor TKMHandAI.Destroy; +begin + fGoals.Free; + fGeneral.Free; + fMayor.Free; + fSetup.Free; + + fCityManagement.Free; + fArmyManagement.Free; + + inherited; +end; + + +procedure TKMHandAI.ResetWonOrLost; +begin + fWonOrLost := wolNone; +end; + + +//Defeat Player (from scripting?), this is not reversible. +//Defeated player remains in place, but does no actions +procedure TKMHandAI.Defeat(aShowDefeatMessage: Boolean = True); +begin + if fWonOrLost <> wolNone then Exit; + + fWonOrLost := wolLost; + + //Let the game know + gGame.PlayerDefeat(fOwner, aShowDefeatMessage); + + //Script may have additional event processors + gScriptEvents.ProcPlayerDefeated(fOwner); +end; + + +//Set player to victorious (from scripting), this is not reversible. +//You probably need to make sure all other players are defeated or victorious too +//otherwise it will look odd. +procedure TKMHandAI.Victory; +begin + if fWonOrLost <> wolNone then Exit; + + fWonOrLost := wolWon; + + //Replays/spectators don't see victory screen + if not gGame.Params.IsReplay + and (gGame.Params.IsMultiPlayerOrSpec or (gMySpectator.HandID = fOwner)) then //Let everyone know in MP mode + gGame.PlayerVictory(fOwner); + + //Script may have additional event processors + gScriptEvents.ProcPlayerVictory(fOwner); +end; + + +procedure TKMHandAI.AddDefaultGoals(aBuildings: Boolean); +var + I: Integer; + enemies: array of TKMHandID; +begin + SetLength(enemies, 0); + for I := 0 to gHands.Count - 1 do + if gHands[I].Enabled and (gHands[fOwner].Alliances[I] = atEnemy) then + begin + SetLength(enemies, Length(enemies)+1); + enemies[High(enemies)] := I; + end; + Goals.AddDefaultGoals(aBuildings, fOwner, enemies); +end; + + +procedure TKMHandAI.RecheckGoals; +begin + CheckGoals(True); +end; + + +procedure TKMHandAI.CheckGoals(aAllowResetGoals: Boolean = False); + + function GoalConditionSatisfied(const aGoal: TKMGoal): Boolean; + var + stats: TKMHandStats; + begin + Assert((aGoal.GoalCondition = gcTime) or (aGoal.HandIndex <> HAND_NONE), 'Only gcTime can have nil Player'); + + if aGoal.Disabled then + Exit(True); + + if aGoal.HandIndex <> HAND_NONE then + stats := gHands[aGoal.HandIndex].Stats + else + stats := nil; + + case aGoal.GoalCondition of + gcBuildTutorial: Result := True; //Deprecated + //gcTime is disabled as we process messages in Event system now. Return True so players + //do not have to wait for all messages to show before they are allowed to win (same in TPR) + gcTime: Result := True; //Deprecated + gcBuildings: Result := (stats.GetHouseQty(GOAL_BUILDINGS_HOUSES) > 0); + gcTroops: Result := (stats.GetArmyCount > 0); + gcMilitaryAssets: Result := (stats.GetArmyCount > 0) or + (stats.GetHouseQty([htBarracks, htCoalMine, htWeaponWorkshop, htArmorWorkshop, htStables, + htIronMine, htIronSmithy ,htWeaponSmithy, htArmorSmithy, htTownHall, + htSiegeWorkshop]) > 0); + gcSerfsAndSchools: Result := (stats.GetHouseQty([htSchool]) > 0) or (stats.GetUnitQty(utSerf) > 0); + gcEconomyBuildings: Result := (stats.GetHouseQty([htStore, htSchool, htInn]) > 0); + else raise Exception.Create('Unknown goal'); + end; + if aGoal.GoalStatus = gsFalse then + Result := not Result; //Reverse condition + end; + +var + I: Integer; + hasVictoryGoal: Boolean; + victorySatisfied, survivalSatisfied: Boolean; +begin + //If player has elected to play on past victory or defeat + //then do not check for any further goals + if not aAllowResetGoals and (fWonOrLost <> wolNone) then Exit; + + //Assume they will win/survive, then prove it with goals + hasVictoryGoal := False; + victorySatisfied := True; + survivalSatisfied := True; + + with gHands[fOwner] do + for I := 0 to Goals.Count - 1 do + case Goals[I].GoalType of + gltVictory: begin + //In a sandbox or script-ruled mission there may be no victory conditions in Goals + //so we make sure player wins by Goals only if he has such goals + hasVictoryGoal := True; + victorySatisfied := victorySatisfied and + (gHands[Goals[I].HandIndex].AI.HasLost //if player is Lost then no need to check other Goal conditions + or GoalConditionSatisfied(Goals[I])); + end; + gltSurvive: survivalSatisfied := survivalSatisfied and GoalConditionSatisfied(Goals[I]); + end; + //Messages in goals have been replaced by SCRIPT files, so this code is disabled now, + //but kept in case we need it for something later. (conversion process?) + + //Display message if set and not already shown and not a blank text + {if (Goals[I].MessageToShow <> 0) + and not Goals[I].MessageHasShown + and (fTextLibrary[Goals[I].MessageToShow] <> '') then + begin + if MyPlayer = fPlayers[fHandIndex] then + fGameG.ShowMessage(mkText, fTextLibrary[Goals[I].MessageToShow], KMPOINT_ZERO); + Goals.SetMessageHasShown(I); + end;} + + //You can't win and lose at the same time. In KaM defeats override victories, except + //when there are no goals defined, in which case you win for some weird reason... + //But given that having no goals is pretty pointless we'll make defeat override so you can't + //win battle missions by waiting for your troops to simultainiously starve to death. + + //Now we know if player has been defeated or won + if not survivalSatisfied then + Defeat + else + if hasVictoryGoal and victorySatisfied then + Victory + else + if aAllowResetGoals then + ResetWonOrLost; +end; + + +function TKMHandAI.GetHasWon: Boolean; +begin + if Self = nil then Exit(False); + + Result := fWonOrLost = wolWon; +end; + + +function TKMHandAI.GetGoals: TKMGoals; +begin + if Self = nil then Exit(nil); + + Result := fGoals; +end; + + +function TKMHandAI.GetHasLost: Boolean; +begin + if Self = nil then Exit(False); + + Result := fWonOrLost = wolLost; +end; + + +function TKMHandAI.GetIsNotWinnerNotLoser: Boolean; +begin + if Self = nil then Exit(False); + + Result := fWonOrLost = wolNone; +end; + + +function TKMHandAI.GetSetup: TKMHandAISetup; +begin + if Self = nil then Exit(nil); + + Result := fSetup; +end; + + +function TKMHandAI.GetWonOrLostString: UnicodeString; +begin + Result := ''; + case fWonOrLost of + wolNone: Result := 'Undefined'; + wolWon: Result := 'Won'; + wolLost: Result := 'Lost'; + end; +end; + + +procedure TKMHandAI.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fMayor.OwnerUpdate(fOwner); + fGeneral.OwnerUpdate(fOwner); + + fCityManagement.OwnerUpdate(fOwner); + fArmyManagement.OwnerUpdate(fOwner); +end; + + +// aHouse is our house that was attacked +procedure TKMHandAI.HouseAttackNotification(aHouse: TKMHouse; aAttacker: TKMUnitWarrior); +var + I: Integer; +begin + case gHands[fOwner].HandType of + hndHuman: + begin + // Our allies might like to help us too + for I := 0 to gHands.Count-1 do + if gHands[I].Enabled and gHands[I].IsComputer + and (gHands.CheckAlliance(I, fOwner) = atAlly) and gHands[I].AI.Setup.DefendAllies then + gHands[I].AI.General.RetaliateAgainstThreat(aAttacker); + + // No fight alerts in replays/spectating, and only show alerts for ourselves + if not gGame.Params.IsReplayOrSpectate + and (fOwner = gMySpectator.HandID) + and (aAttacker <> nil) then //Don't show alerts for annonymous attacks (e.g. script) + gGame.GamePlayInterface.Alerts.AddFight(KMPointF(aHouse.Position), fOwner, anTown, + gGameApp.GlobalTickCount + ALERT_DURATION[atFight]); + end; + hndComputer: + begin + if not (WonOrLost <> wolNone) then + begin + if fSetup.NewAI then + begin + // Do nothing (too CPU demanding) + end + else + begin + fGeneral.RetaliateAgainstThreat(aAttacker); + // Our allies might like to help us too + for I := 0 to gHands.Count-1 do + if gHands[I].Enabled and gHands[I].IsComputer + and (gHands.CheckAlliance(I, fOwner) = atAlly) and gHands[I].AI.Setup.DefendAllies then + gHands[I].AI.General.RetaliateAgainstThreat(aAttacker); + end; + end; + end; + end; + + gScriptEvents.ProcHouseDamaged(aHouse, aAttacker); //At the end since it could destroy the house +end; + + +procedure TKMHandAI.UnitHPDecreaseNotification(aUnit: TKMUnit; aAttacker: TKMUnit; aNotifyScript: Boolean = True); +begin + { + if not (WonOrLost <> wolNone) then + begin + if fSetup.NewAI AND (gHands[fOwner].HandType <> hndHuman) then // Make sure that it is not player + begin + // Do nothing (too CPU demanding) + end; + end; + //} + if aNotifyScript then + gScriptEvents.ProcUnitWounded(aUnit, aAttacker); //At the end since it could kill the unit +end; + + +// aUnit is our unit that was attacked +procedure TKMHandAI.UnitAttackNotification(aUnit: TKMUnit; aAttacker: TKMUnit; aNotifyScript: Boolean = True); +const + NOTIFY_KIND: array [Boolean] of TKMAttackNotification = (anCitizens, anTroops); +var + I: Integer; + group: TKMUnitGroup; +begin + case gHands[fOwner].HandType of + hndHuman: + begin + // If we are attacked, then our allies might like to help us too + if aAttacker is TKMUnitWarrior then + begin + // Our allies might like to help us too + for I := 0 to gHands.Count-1 do + if gHands[I].Enabled and gHands[I].IsComputer + and (gHands.CheckAlliance(I, fOwner) = atAlly) and gHands[I].AI.Setup.DefendAllies then + gHands[I].AI.General.RetaliateAgainstThreat(aAttacker); + end; + + // No fight alerts in replays, and only show alerts for ourselves + if not gGame.Params.IsReplayOrSpectate + and (fOwner = gMySpectator.HandID) then + gGame.GamePlayInterface.Alerts.AddFight(aUnit.PositionF, fOwner, NOTIFY_KIND[aUnit is TKMUnitWarrior], + gGameApp.GlobalTickCount + ALERT_DURATION[atFight]); + end; + hndComputer: + begin + if not (WonOrLost <> wolNone) then + begin + if fSetup.NewAI then + begin + // Do nothing (too CPU demanding) + end + else + begin + //If we are attacked, then we should counter attack the attacker (except if he is a recruit in tower) + if aAttacker is TKMUnitWarrior then + begin + fGeneral.RetaliateAgainstThreat(aAttacker); //Nearby soldiers should come to assist + + //Our allies might like to help us too + for I := 0 to gHands.Count-1 do + if gHands[I].Enabled and gHands[I].IsComputer + and (gHands.CheckAlliance(I, fOwner) = atAlly) and gHands[I].AI.Setup.DefendAllies then + gHands[I].AI.General.RetaliateAgainstThreat(aAttacker); + + //If we are a warrior we can also attack that unit ourselves + if aUnit is TKMUnitWarrior then + begin + group := gHands[fOwner].UnitGroups.GetGroupByMember(TKMUnitWarrior(aUnit)); + //It's ok for the group to be nil, the warrior could still be walking out of the barracks + if (group <> nil) and not group.IsDead then + //If we are already in the process of attacking something, don't change our minds, + //otherwise you can make a unit walk backwards and forwards forever between two groups of archers + if not group.InFight then + //Make sure the group could possibly reach the offenders + if group.CanWalkTo(aAttacker.Position, group.FightMaxRange) then + group.OrderAttackUnit(aAttacker, True); + end; + end; + end; + end; + end; + end; + + if aNotifyScript then + gScriptEvents.ProcUnitAttacked(aUnit, aAttacker); //At the end since it could kill the unit +end; + + +procedure TKMHandAI.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('HandAI'); + SaveStream.Write(fOwner); + SaveStream.Write(fWonOrLost, SizeOf(fWonOrLost)); + SaveStream.Write(fCanBeAITypes, SizeOf(fCanBeAITypes)); + + fSetup.Save(SaveStream); + fGoals.Save(SaveStream); + + if aitClassic in fCanBeAITypes then + begin + fGeneral.Save(SaveStream); + fMayor.Save(SaveStream); + end; + + if aitAdvanced in fCanBeAITypes then + begin + fCityManagement.Save(SaveStream); + fArmyManagement.Save(SaveStream); + end; +end; + + +procedure TKMHandAI.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('HandAI'); + LoadStream.Read(fOwner); + LoadStream.Read(fWonOrLost, SizeOf(fWonOrLost)); + LoadStream.Read(fCanBeAITypes, SizeOf(fCanBeAITypes)); + + fSetup.Load(LoadStream); + fGoals.Load(LoadStream); + + if aitClassic in fCanBeAITypes then + begin + fGeneral.Load(LoadStream); + fMayor.Load(LoadStream); + end; + + if aitAdvanced in fCanBeAITypes then + begin + fCityManagement.Load(LoadStream); + fArmyManagement.Load(LoadStream); + end; +end; + + +procedure TKMHandAI.SyncLoad(); +begin + if aitClassic in fCanBeAITypes then + fGeneral.SyncLoad(); + + if aitAdvanced in fCanBeAITypes then + begin + fArmyManagement.SyncLoad(); + fCityManagement.SyncLoad(); + end; +end; + + +procedure TKMHandAI.AfterMissionInit(aCanBeAITypes: TKMAITypeSet); +begin + fCanBeAITypes := aCanBeAITypes; + + // Do AI initialization only if there could be any AI of a certain type + // We should do it at the game start, in case player will be swapped to AI player + // Also we have to do it only at the game start for Advanced AI, because it considers teams and divide mines according to the teams + if aitClassic in fCanBeAITypes then + fMayor.AfterMissionInit(); + + if aitAdvanced in fCanBeAITypes then + begin + gAIFields.Eye.OwnerUpdate(fOwner); + fCityManagement.AfterMissionInit(); + fArmyManagement.AfterMissionInit(); + end; +end; + + +procedure TKMHandAI.UpdateState(aTick: Cardinal; aCheckGoals: Boolean); +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAI); + {$ENDIF} + try + if (WonOrLost <> wolNone) then + Exit; + + //Check goals for all players to maintain multiplayer consistency + //AI victory/defeat is used in scripts (e.g. OnPlayerDefeated in battle tutorial) + if aCheckGoals and (((aTick + Byte(fOwner)) mod MAX_HANDS) = 0) then + CheckGoals; //This procedure manages victory and loss + + case gHands[fOwner].HandType of + hndHuman: begin + //Humans dont need AI management + end; + hndComputer: begin + if fSetup.NewAI then + begin + gAIFields.Eye.OwnerUpdate(fOwner); + fArmyManagement.UpdateState(aTick); + fCityManagement.UpdateState(aTick); + end + else + begin + fMayor.UpdateState(aTick); + fGeneral.UpdateState(aTick); + end; + end; + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAI); + {$ENDIF} + end; +end; + + +function TKMHandAI.ObjToString: String; +begin + Result := 'WOL = ' + GetEnumName(TypeInfo(TWonOrLost), Integer(fWonOrLost)); +end; + + +// RMG +procedure TKMHandAI.PlaceFirstStorehouse(aLoc: TKMPoint); + + // Get closest resource to location + function GetClosestResource(var aRes: TKMPoint; aList: TKMPointList): Boolean; + const + SQR_MAX_DISTANCE = 20*20; + var + K: Integer; + distance, bestDistance: Single; + begin + aRes := KMPOINT_ZERO; // Set default point to zero so there is not integer overflow during evaluation if resource does not exist + bestDistance := 1e10; + for K := 0 to aList.Count - 1 do + begin + distance := KMDistanceSqr(aLoc, aList[K]); + if (distance < bestDistance) then + begin + bestDistance := distance; + aRes := aList[K]; + end; + end; + Result := bestDistance < SQR_MAX_DISTANCE; + end; + + // Place road and return True if it is possible + function AddRoad(aPoint: TKMPoint): Boolean; + begin + Result := gHands[fOwner].CanAddFieldPlan(KMPoint(aPoint.X, aPoint.Y), ftRoad); + if Result then + begin + gTerrain.SetRoad(aPoint, fOwner); + //Terrain under roads is flattened (fields are not) + gTerrain.FlattenTerrain(aPoint); + if gMapElements[gTerrain.Land^[aPoint.Y,aPoint.X].Obj].WineOrCorn then + gTerrain.RemoveObject(aPoint); + end; + end; + + // Find place for store + procedure FindPlaceForStore(bStone, bGold, bIron: Boolean; aInitP, Stone, Gold, Iron: TKMPoint); + const + RAD = 15; + var + X, Y: Integer; + price, bestPrice: Single; + loc, bestLoc: TKMPoint; + begin + bestPrice := 1e10; + for X := Max(1,aInitP.X-RAD) to Min(gTerrain.MapX-1,aInitP.X+RAD) do + for Y := Max(1,aInitP.Y-RAD) to Min(gTerrain.MapY-1,aInitP.Y+RAD) do + if gHands[fOwner].CanAddFieldPlan(KMPoint(X,Y+1), ftRoad) AND gHands[fOwner].CanAddHousePlanAI(X,Y,htStore,False) then + begin + //gTerrain.ScriptTrySetTileObject(X, Y, 0); // Debug (visualization) + loc := KMPoint(X,Y); + price := + + 6 * Byte(bStone) * KMDistanceSqr(loc, Stone) + + 50 * (Byte(gTerrain.TileIsCoal(X, Y) > 1) + Byte(gTerrain.TileIsCoal(X, Y-1) > 1) + Byte(gTerrain.TileIsCoal(X, Y-2) > 1)) + + 2 * Byte(bGold) * KMDistanceSqr(loc, Gold) + + 1 * Byte(bIron) * KMDistanceSqr(loc, Iron) + - 20 * ( Byte(gHands[fOwner].CanAddFieldPlan(KMPoint(X,Y+2), ftRoad)) + Byte(gHands[fOwner].CanAddFieldPlan(KMPoint(X+1,Y+1), ftRoad)) + Byte(gHands[fOwner].CanAddFieldPlan(KMPoint(X-1,Y+1), ftRoad)) ); + + if (price < bestPrice) then + begin + bestPrice := price; + bestLoc := loc; + end; + end; + // Place storehouse + if (bestPrice < 1E10) then + gHands[fOwner].AddFirstStorehouse(bestLoc); + end; + +const + MAX_DIST_FROM_STONES = 10; +var + bGold, bIron, bStone: Boolean; + gold, iron, stone, initPoint: TKMPoint; +begin + // Find the closest resource + bGold := GetClosestResource(gold, gAIFields.Eye.GoldLocs); + bIron := GetClosestResource(iron, gAIFields.Eye.IronLocs); + bStone := GetClosestResource(stone, gAIFields.Eye.StoneMiningTiles); + // Apply logic + if bStone then + begin + if bGold then + initPoint := KMPoint( Round((stone.X*4+gold.X*2+aLoc.X)/7), Round((stone.Y*4+gold.Y*2+aLoc.Y)/7) ) + else if bIron then + initPoint := KMPoint( Round((stone.X*4+iron.X+aLoc.X)/6), Round((stone.Y*4+iron.Y+aLoc.Y)/6) ) + else + initPoint := stone; + end + else + begin + if bGold then + initPoint := gold + else if bIron then + initPoint := iron + else + Exit; + end; + // Find place for store + FindPlaceForStore(bStone, bGold, bIron, initPoint, stone, gold, iron); +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/KM_AIArmyEvaluation.pas b/vendor/kam_remake/src/ai/KM_AIArmyEvaluation.pas new file mode 100644 index 0000000..6c7318b --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIArmyEvaluation.pas @@ -0,0 +1,351 @@ +unit KM_AIArmyEvaluation; +{$I KaM_Remake.inc} +interface +uses + KM_Defaults, KM_CommonClasses, + KM_Units, KM_UnitGroup; + +type + TKMGroupEval = record + Count: Integer; + HitPoints, Attack, AttackHorse, Defence, DefenceProjectiles: Single; + end; + TKMFoodState = record + Full, Middle, Low: Integer; + end; + TKMArmyEval = record + FoodState: TKMFoodState; + Groups: array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of TKMGroupEval; + end; + TKMGameEval = array[0 .. MAX_HANDS - 1] of TKMArmyEval; + + TKMGroupStrengthArray = array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Single; + + //This class evaluate self army relatively enemy armies + TKMArmyEvaluation = class + private + fEvals: TKMGameEval; //Results of evaluation + + function CompareStrength(A, E: TKMArmyEval): Single; + function GetAllianceStrength(const aAlliance: TKMHandIDArray): TKMArmyEval; + procedure EvaluatePower(aPlayer: TKMHandID; aConsiderHitChance: Boolean = False); + public + constructor Create(); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + function UnitEvaluation(aUT: TKMUnitType; aConsiderHitChance: Boolean = False): TKMGroupEval; + function GroupEvaluation(aGroup: TKMUnitGroup; aConsiderHitChance: Boolean): TKMGroupEval; + function PlayerEvaluation(aPlayer: TKMHandID): TKMArmyEval; + function AllianceEvaluation(aPlayer: TKMHandID; aAlliance: TKMAllianceType): TKMArmyEval; + + function CompareAllianceStrength(const aAlly, aEnemy: TKMHandIDArray): Single; + function CheckFoodProblems(const aAlly: TKMHandIDArray): Boolean; + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + end; + + +const + HIT_CHANCE_MODIFIER = 0.5; + + +implementation +uses + Classes, Math, + KM_Hand, KM_HandsCollection, KM_HandStats, + KM_UnitsCollection, + KM_Resource, KM_ResUnits, KM_ResTypes; + + +{ TKMArmyEvaluation } +constructor TKMArmyEvaluation.Create(); +begin + inherited Create; + FillChar(fEvals, SizeOf(fEvals), #0); +end; + + +destructor TKMArmyEvaluation.Destroy; +begin + inherited; +end; + + +procedure TKMArmyEvaluation.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('ArmyEvaluation'); + SaveStream.Write(fEvals, SizeOf(fEvals)); +end; + + +procedure TKMArmyEvaluation.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('ArmyEvaluation'); + LoadStream.Read(fEvals, SizeOf(fEvals)); +end; + + +function TKMArmyEvaluation.UnitEvaluation(aUT: TKMUnitType; aConsiderHitChance: Boolean = False): TKMGroupEval; +var + unitSpec: TKMUnitSpec; +begin + // Fill array with reference values + unitSpec := gRes.Units[aUT]; + Result.Count := 1; + Result.HitPoints := unitSpec.HitPoints; + Result.Attack := unitSpec.Attack; + Result.AttackHorse := unitSpec.AttackHorse; + Result.Defence := unitSpec.Defence; + Result.DefenceProjectiles := unitSpec.GetDefenceVsProjectiles(False); + if aConsiderHitChance and (UNIT_TO_GROUP_TYPE[aUT] = gtRanged) then + Result.Attack := Result.Attack * HIT_CHANCE_MODIFIER; +end; + + +function TKMArmyEvaluation.GroupEvaluation(aGroup: TKMUnitGroup; aConsiderHitChance: Boolean): TKMGroupEval; +var + K: Integer; + GE: TKMGroupEval; +begin + FillChar(Result, SizeOf(Result), #0); + Result.Count := aGroup.Count; + for K := 0 to aGroup.Count-1 do + begin + GE := UnitEvaluation(TKMUnit(aGroup.Members[K]).UnitType, aConsiderHitChance); + with Result do + begin + HitPoints := HitPoints + GE.HitPoints; + Attack := Attack + GE.Attack; + AttackHorse := AttackHorse + GE.AttackHorse; + Defence := Defence + GE.Defence; + DefenceProjectiles := DefenceProjectiles + GE.DefenceProjectiles; + end; + end; +end; + + +function TKMArmyEvaluation.PlayerEvaluation(aPlayer: TKMHandID): TKMArmyEval; +begin + Move(fEvals[aPlayer], Result, SizeOf(fEvals[aPlayer])); +end; + + +function TKMArmyEvaluation.AllianceEvaluation(aPlayer: TKMHandID; aAlliance: TKMAllianceType): TKMArmyEval; +var + Cnt: Integer; + PL: TKMHandID; + Alliance: TKMHandIDArray; +begin + Cnt := 0; + SetLength(Alliance, gHands.Count); + for PL := 0 to gHands.Count - 1 do + begin + Alliance[Cnt] := PL; + Inc(Cnt, Byte( gHands[PL].Enabled AND (gHands[aPlayer].Alliances[PL] = aAlliance) )); + end; + SetLength(Alliance,Cnt); + Result := GetAllianceStrength(Alliance); +end; + + +function TKMArmyEvaluation.CompareStrength(A, E: TKMArmyEval): Single; + // Sum power of all types of groups + procedure SumPower(var aEval: TKMGroupEval; var Army: TKMArmyEval); + var + GT: TKMGroupType; + begin + FillChar(aEval, SizeOf(aEval), #0); + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + aEval.Count := aEval.Count + Army.Groups[GT].Count ; + aEval.HitPoints := aEval.HitPoints + Army.Groups[GT].HitPoints ; + aEval.Attack := aEval.Attack + Army.Groups[GT].Attack ; + aEval.AttackHorse := aEval.AttackHorse + Army.Groups[GT].AttackHorse ; + aEval.Defence := aEval.Defence + Army.Groups[GT].Defence ; + aEval.DefenceProjectiles := aEval.DefenceProjectiles + Army.Groups[GT].DefenceProjectiles; + end; + end; +var + AEval, EEval: TKMGroupEval; +begin + // Sum power of groups in alliance + SumPower(AEval,A); + SumPower(EEval,E); + // Get weighted power with consideration of hostile groups + AEval.AttackHorse := AEval.AttackHorse * E.Groups[gtMounted].Count / Max(1, EEval.Count); + EEval.AttackHorse := EEval.AttackHorse * A.Groups[gtMounted].Count / Max(1, AEval.Count); + AEval.DefenceProjectiles := AEval.DefenceProjectiles * E.Groups[gtRanged].Count / Max(1, EEval.Count); + EEval.DefenceProjectiles := EEval.DefenceProjectiles * A.Groups[gtRanged].Count / Max(1, AEval.Count); + // Get balance of power + Result := ( + + 1 - Min(2,(EEval.Attack + EEval.AttackHorse ) / Max(1,(AEval.Attack + AEval.AttackHorse ))) + + 1 - Min(2,(EEval.HitPoints ) / Max(1,(AEval.HitPoints ))) + + 1 - Min(2,(EEval.Defence + EEval.DefenceProjectiles) / Max(1,(AEval.Defence + AEval.DefenceProjectiles))) + ) / 3; +end; + + +function TKMArmyEvaluation.GetAllianceStrength(const aAlliance: TKMHandIDArray): TKMArmyEval; +var + PL: Integer; + GT: TKMGroupType; +begin + FillChar(Result, SizeOf(Result), #0); + for PL in aAlliance do + begin + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + with Result.Groups[GT] do + begin + Count := Count + fEvals[PL].Groups[GT].Count; + HitPoints := HitPoints + fEvals[PL].Groups[GT].HitPoints; + Attack := Attack + fEvals[PL].Groups[GT].Attack; + AttackHorse := AttackHorse + fEvals[PL].Groups[GT].AttackHorse; + Defence := Defence + fEvals[PL].Groups[GT].Defence; + DefenceProjectiles := DefenceProjectiles + fEvals[PL].Groups[GT].DefenceProjectiles; + end; + with Result.FoodState do + begin + Inc(Full,fEvals[PL].FoodState.Full); + Inc(Middle,fEvals[PL].FoodState.Middle); + Inc(Low,fEvals[PL].FoodState.Low); + end; + end; +end; + + +// Approximate way how to compute strength of 2 alliances +function TKMArmyEvaluation.CompareAllianceStrength(const aAlly, aEnemy: TKMHandIDArray): Single; +var + AllyEval, EnemyEval: TKMArmyEval; +begin + AllyEval := GetAllianceStrength(aAlly); + EnemyEval := GetAllianceStrength(aEnemy); + Result := CompareStrength(AllyEval, EnemyEval); // => number in <-1,1> ... positive = we have advantage and vice versa +end; + + +function TKMArmyEvaluation.CheckFoodProblems(const aAlly: TKMHandIDArray): Boolean; +const + FOOD_THRESHOLD = 0.75; +var + Full, Middle, Low, Food: Integer; + PL: TKMHandID; +begin + Result := False; + Full := 0; + Middle := 0; + Low := 0; + for PL in aAlly do + begin + Food := 0; + Inc(Food ,gHands[PL].Stats.GetWareBalance(wtBread)); + Inc(Food ,gHands[PL].Stats.GetWareBalance(wtWine)); + Inc(Food ,gHands[PL].Stats.GetWareBalance(wtSausage)); + Inc(Food ,gHands[PL].Stats.GetWareBalance(wtFish)); + Inc(Full ,fEvals[PL].FoodState.Full); + Inc(Middle,fEvals[PL].FoodState.Middle); + Inc(Low ,max(0, fEvals[PL].FoodState.Low - Food)); + end; + if ((Full + Middle + Low) > 0) then + Result := ((Full + Middle) / Max(1, (Full + Middle + Low))) < FOOD_THRESHOLD; +end; + + +// Actualize power of specific player +// +// Equation of combat: +// +// Close combat +// Attack (+ AttackHorse) (+ DirModifier) -> DirModifier is not considered in ArmyEvaluation +// Probability = --------------------------------------- +// Defence +// +// Ranged units +// HitProbability = 1 - Distance; Distance in <0,1> -> Hit probability is considered as a decreasing of attack by HIT_CHANCE_MODIFIER +// Attack +// Probability = -------------------- +// DefenceProjectiles +// +// Probability > random number => decrease hitpoint; 0 hitpoints = unit is dead +procedure TKMArmyEvaluation.EvaluatePower(aPlayer: TKMHandID; aConsiderHitChance: Boolean = False); + procedure EvaluateFoodLevel(); + const + FULL_LIMIT = Round(UNIT_MAX_CONDITION * 0.75); + LOW_LIMIT = Round(UNIT_MAX_CONDITION * 0.3); + var + K, Condition, LowCnt, FullCnt: Integer; + begin + LowCnt := 0; + FullCnt := 0; + for K := 0 to gHands[aPlayer].Units.Count - 1 do + begin + Condition := gHands[aPlayer].Units[K].Condition; + Inc(LowCnt, Byte(Condition < LOW_LIMIT)); + Inc(FullCnt,Byte(Condition > FULL_LIMIT)); + end; + fEvals[aPlayer].FoodState.Low := LowCnt; + fEvals[aPlayer].FoodState.Middle := gHands[aPlayer].Units.Count - LowCnt - FullCnt; + fEvals[aPlayer].FoodState.Full := FullCnt; + end; +var + Stats: TKMHandStats; + Qty: Integer; + US: TKMUnitSpec; + UT: TKMUnitType; + GT: TKMGroupType; +begin + Stats := gHands[aPlayer].Stats; + + // Clear array + FillChar(fEvals[aPlayer], SizeOf(fEvals[aPlayer]), #0); + + // Fill array with reference values + for UT := WARRIOR_MIN to WARRIOR_MAX do + begin + Qty := Stats.GetUnitQty(UT); + US := gRes.Units[UT]; + GT := UNIT_TO_GROUP_TYPE[UT]; + with fEvals[aPlayer].Groups[GT] do + begin + Count := Count + Qty; + HitPoints := HitPoints + Qty * US.HitPoints; + Attack := Attack + Qty * US.Attack; + AttackHorse := AttackHorse + Qty * US.AttackHorse; + Defence := Defence + Qty * US.Defence; + DefenceProjectiles := DefenceProjectiles + Qty * US.GetDefenceVsProjectiles(False); // True = IsBolt -> calculation without bolts + end; + end; + if aConsiderHitChance then + with fEvals[aPlayer].Groups[gtRanged] do + Attack := Attack * HIT_CHANCE_MODIFIER; + + // Check if army is hungry + EvaluateFoodLevel(); +end; + + +procedure TKMArmyEvaluation.AfterMissionInit(); +var + PL: TKMHandID; +begin + for PL := 0 to gHands.Count - 1 do + if gHands[PL].Enabled then + EvaluatePower(PL, True); +end; + + +procedure TKMArmyEvaluation.UpdateState(aTick: Cardinal); +const + PERF_SUM = MAX_HANDS * 10; +var + PL: Integer; +begin + PL := aTick mod PERF_SUM; + if (PL < gHands.Count) AND gHands[PL].Enabled then + EvaluatePower(PL, True); +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIAttacks.pas b/vendor/kam_remake/src/ai/KM_AIAttacks.pas new file mode 100644 index 0000000..00e558b --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIAttacks.pas @@ -0,0 +1,210 @@ +unit KM_AIAttacks; +{$I KaM_Remake.inc} +interface +uses + KM_Defaults, KM_CommonClasses, KM_Points, KM_AITypes; + + +const + //KaM uses 0 for repeating attack in TSK (disused and replaced with later by Remake), 1 for once and 2 for repeating in TPR + RemakeAttackType: array [0..2] of TKMAIAttackType = (aatRepeating, aatOnce, aatRepeating); + KaMAttackType: array [TKMAIAttackType] of Byte = (1, 0); + +type + //Records must be packed so they are stored identically in MP saves (? padding bytes are unknown values) + TKMAIAttack = packed record + UID: Integer; //Attack UID, used to remove attack from script + AttackType: TKMAIAttackType; //Once or repeating + HasOccured: Boolean; //Has this attack happened already? + Delay: Cardinal; //The attack will not occur before this time has passed + TotalMen: Integer; //Number of idle (i.e. back line) warriors required in the AI army before the attack will launch + GroupAmounts: TKMGroupTypeArray; //How many squads of each group type will be taken + RandomGroups: Boolean; //Used instead of GroupAmounts, chooses groups randomly taking at most TotalMen warriors + Target: TKMAIAttackTarget; + Range: Integer; //Will only occur when target is within this tile range (not properly tested yet) + CustomPosition: TKMPoint; //Used when Target = attCustomPosition + end; + + + TKMAIAttacks = class + private + fCount: Integer; + fAttacks: array of TKMAIAttack; + function GetAttack(aIndex: Integer): TKMAIAttack; + procedure SetAttack(aIndex: Integer; const aValue: TKMAIAttack); + public + property Count: Integer read fCount; + property Items[aIndex: Integer]: TKMAIAttack read GetAttack write SetAttack; default; + + function AddAttack(aAttack: TKMAIAttack): Integer; overload; + function AddAttack(aAttackType: TKMAIAttackType; aDelay: Cardinal; aTotalMen: Integer; const aGroupAmounts: TKMGroupTypeArray; + aRandomGroups: Boolean; aTarget: TKMAIAttackTarget; aRange: Integer; aCustomPosition: TKMPoint): Integer; overload; + function AddAttack(aAttackType: TKMAIAttackType; aDelay: Cardinal; aTotalMen: Integer; + aMeleeGroupCount, aAntiHorseGroupCount, aRangedGroupCount, aMountedGroupCount: Word; + aRandomGroups: Boolean; aTarget: TKMAIAttackTarget; aRange: Integer; aCustomPosition: TKMPoint): Integer; overload; + function Remove(aAttackUID: Integer): Boolean; + procedure Delete(aIndex: Integer); + function CanOccur(aIndex: Integer; const aMenAvailable: TKMGroupTypeArray; const aGroupsAvailable: TKMGroupTypeArray; aTick: Cardinal): Boolean; + procedure HasOccured(aIndex: Integer); + procedure Clear; + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +implementation +uses + Math, KM_Game, KM_GameUIDTracker; + + +{ TKMAIAttacks } +function TKMAIAttacks.CanOccur(aIndex: Integer; const aMenAvailable: TKMGroupTypeArray; const aGroupsAvailable: TKMGroupTypeArray; aTick: Cardinal): Boolean; +var + GT: TKMGroupType; + totalMenAvailable: Word; +begin + totalMenAvailable := 0; + //Must have enough men available out of the types of groups that will attack + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if fAttacks[aIndex].RandomGroups or (fAttacks[aIndex].GroupAmounts[GT] > 0) then + Inc(totalMenAvailable, aMenAvailable[GT]); + + Result := ((fAttacks[aIndex].AttackType = aatRepeating) or not fAttacks[aIndex].HasOccured) + and (aTick >= fAttacks[aIndex].Delay) + and (totalMenAvailable >= fAttacks[aIndex].TotalMen) + and (totalMenAvailable > 0); + + //Must have enough groups of each type + if not fAttacks[aIndex].RandomGroups then + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + Result := Result and (aGroupsAvailable[GT] >= fAttacks[aIndex].GroupAmounts[GT]); + + //todo -cComplicated: Add support for the AI attack feature Range +end; + + +procedure TKMAIAttacks.HasOccured(aIndex: Integer); +begin + fAttacks[aIndex].HasOccured := True; +end; + + +procedure TKMAIAttacks.Clear; +begin + SetLength(fAttacks, 0); + fCount := 0; +end; + + +function TKMAIAttacks.AddAttack(aAttack: TKMAIAttack): Integer; +begin + if fCount >= Length(fAttacks) then + SetLength(fAttacks, fCount + 16); + + aAttack.UID := gUIDTracker.GetNewUID; + fAttacks[fCount] := aAttack; + Inc(fCount); + Result := aAttack.UID; +end; + + +function TKMAIAttacks.AddAttack(aAttackType: TKMAIAttackType; aDelay: Cardinal; aTotalMen: Integer; const aGroupAmounts: TKMGroupTypeArray; + aRandomGroups: Boolean; aTarget: TKMAIAttackTarget; aRange: Integer; aCustomPosition: TKMPoint): Integer; +var + attack: TKMAIAttack; +begin + attack.AttackType := aAttackType; + attack.HasOccured := False; + attack.Delay := aDelay; + attack.TotalMen := aTotalMen; + attack.GroupAmounts := aGroupAmounts; + attack.RandomGroups := aRandomGroups; + attack.Target := aTarget; + attack.Range := aRange; + attack.CustomPosition := aCustomPosition; + Result := AddAttack(attack); +end; + + +function TKMAIAttacks.AddAttack(aAttackType: TKMAIAttackType; aDelay: Cardinal; aTotalMen: Integer; + aMeleeGroupCount, aAntiHorseGroupCount, aRangedGroupCount, aMountedGroupCount: Word; + aRandomGroups: Boolean; aTarget: TKMAIAttackTarget; aRange: Integer; aCustomPosition: TKMPoint): Integer; +var + groupAmounts: TKMGroupTypeArray; +begin + groupAmounts[gtMelee] := aMeleeGroupCount; + groupAmounts[gtAntiHorse] := aAntiHorseGroupCount; + groupAmounts[gtRanged] := aRangedGroupCount; + groupAmounts[gtMounted] := aMountedGroupCount; + Result := AddAttack(aAttackType, aDelay, aTotalMen, groupAmounts, aRandomGroups, aTarget, aRange, aCustomPosition); +end; + + +//Remove AIAttack by its ID +//Result - True, if delete was succesfull, False, if no AIAttack was found +function TKMAIAttacks.Remove(aAttackUID: Integer): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to fCount - 1 do + if fAttacks[I].UID = aAttackUID then + begin + Delete(I); + Result := True; + Exit; + end; +end; + + +procedure TKMAIAttacks.Delete(aIndex: Integer); +begin + Assert(InRange(aIndex, 0, Count - 1)); + + if (aIndex <> Count - 1) then + Move(fAttacks[aIndex + 1], fAttacks[aIndex], (Count - 1 - aIndex) * SizeOf(fAttacks[0])); + + Dec(fCount); +end; + + +function TKMAIAttacks.GetAttack(aIndex: Integer): TKMAIAttack; +begin + Assert(InRange(aIndex, 0, fCount - 1)); + Result := fAttacks[aIndex]; +end; + + +procedure TKMAIAttacks.SetAttack(aIndex: Integer; const aValue: TKMAIAttack); +begin + Assert(InRange(aIndex, 0, fCount - 1)); + fAttacks[aIndex] := aValue; +end; + + +procedure TKMAIAttacks.Save(SaveStream: TKMemoryStream); +var + I: Integer; +begin + SaveStream.PlaceMarker('AIAttacks'); + SaveStream.Write(fCount); + for I := 0 to fCount - 1 do + SaveStream.Write(fAttacks[I], SizeOf(fAttacks[I])); +end; + + +procedure TKMAIAttacks.Load(LoadStream: TKMemoryStream); +var + I: Integer; +begin + LoadStream.CheckMarker('AIAttacks'); + LoadStream.Read(fCount); + SetLength(fAttacks, fCount); + for I := 0 to fCount - 1 do + LoadStream.Read(fAttacks[I], SizeOf(fAttacks[I])); +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/KM_AICityPlanner.pas b/vendor/kam_remake/src/ai/KM_AICityPlanner.pas new file mode 100644 index 0000000..2d4adf4 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AICityPlanner.pas @@ -0,0 +1,606 @@ +unit KM_AICityPlanner; +{$I KaM_Remake.inc} +interface +uses + KM_TerrainFinder, + + KM_CommonClasses, KM_Defaults, KM_Points, + KM_ResTypes; + + +type + TFindNearest = (fnHouse, fnStone, fnTrees, fnSoil, fnWater, fnCoal, fnIron, fnGold); + + // Terrain finder optimized for CityPlanner demands of finding resources and houses + TKMTerrainFinderCity = class(TKMTerrainFinderCommon) + protected + fOwner: TKMHandID; + function CanWalkHere(const X,Y: Word): Boolean; override; + function CanUse(const X,Y: Word): Boolean; override; + public + FindType: TFindNearest; + HouseType: TKMHouseType; + constructor Create(aOwner: TKMHandID); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure Save(SaveStream: TKMemoryStream); override; + procedure Load(LoadStream: TKMemoryStream); override; + end; + + TKMCityPlanner = class + private + fOwner: TKMHandID; + fListGold: TKMPointList; // List of possible goldmine locations + fFinder: TKMTerrainFinderCity; + + function GetSeeds(aHouseType: array of TKMHouseType): TKMPointArray; + + function NextToOre(aHouse: TKMHouseType; aOreType: TKMWareType; out aLoc: TKMPoint; aNearAnyHouse: Boolean = False): Boolean; + function NextToHouse(aHouse: TKMHouseType; aSeed, aAvoid: array of TKMHouseType; out aLoc: TKMPoint): Boolean; + function NextToStone(aHouse: TKMHouseType; out aLoc: TKMPoint): Boolean; + function NextToTrees(aHouse: TKMHouseType; aSeed: array of TKMHouseType; out aLoc: TKMPoint): Boolean; + function NextToGrass(aHouse: TKMHouseType; aSeed: array of TKMHouseType; out aLoc: TKMPoint): Boolean; + public + constructor Create(aPlayer: TKMHandID); + destructor Destroy; override; + + procedure AfterMissionInit; + + function FindNearest(const aStart: TKMPoint; aRadius: Byte; aType: TFindNearest; out aResultLoc: TKMPoint): Boolean; overload; + procedure FindNearest(const aStart: TKMPointArray; aRadius: Byte; aType: TFindNearest; aPass: TKMTerrainPassabilitySet; aMaxCount: Word; aLocs: TKMPointTagList); overload; + procedure FindNearest(const aStart: TKMPointArray; aRadius: Byte; aHouse: TKMHouseType; aMaxCount: Word; aLocs: TKMPointTagList); overload; + function FindPlaceForHouse(aHouse: TKMHouseType; out aLoc: TKMPoint): Boolean; + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +const + AI_FIELD_HEIGHT = 3; + AI_FIELD_WIDTH = 4; + AI_FIELD_MAX_AREA = (AI_FIELD_WIDTH * 2 + 1) * AI_FIELD_HEIGHT; + + +implementation +uses + Math, + KM_HandsCollection, KM_Hand, KM_HandTypes, + KM_AIFields, KM_AIInfluences, + KM_Terrain, + KM_Resource, KM_ResUnits, KM_NavMesh, + KM_Houses, KM_CommonUtils, KM_CommonTypes; + + +{ TKMCityPlanner } +constructor TKMCityPlanner.Create(aPlayer: TKMHandID); +begin + inherited Create; + fOwner := aPlayer; + fFinder := TKMTerrainFinderCity.Create(fOwner); + + fListGold := TKMPointList.Create; +end; + + +destructor TKMCityPlanner.Destroy; +begin + fListGold.Free; + fFinder.Free; + + inherited; +end; + + +function TKMCityPlanner.FindPlaceForHouse(aHouse: TKMHouseType; out aLoc: TKMPoint): Boolean; +begin + Result := False; + + case aHouse of + htStore: Result := NextToHouse(aHouse, [htAny], [htStore], aLoc); + htArmorSmithy: Result := NextToHouse(aHouse, [htIronSmithy, htCoalMine, htBarracks], [], aLoc); + htArmorWorkshop: Result := NextToHouse(aHouse, [htTannery, htBarracks], [], aLoc); + htBakery: Result := NextToHouse(aHouse, [htMill], [], aLoc); + htBarracks: Result := NextToHouse(aHouse, [htAny], [], aLoc); + htWatchTower: Result := NextToHouse(aHouse, [htBarracks], [], aLoc); + htButchers: Result := NextToHouse(aHouse, [htSwine], [], aLoc); + htInn: Result := NextToHouse(aHouse, [htAny], [htInn], aLoc); + htIronSmithy: Result := NextToHouse(aHouse, [htIronMine, htCoalMine], [], aLoc); + htMetallurgists: Result := NextToHouse(aHouse, [htGoldMine], [], aLoc); + htMill: Result := NextToHouse(aHouse, [htFarm], [], aLoc); + htSawmill: Result := NextToHouse(aHouse, [htWoodcutters], [], aLoc); + htSchool: Result := NextToHouse(aHouse, [htStore, htBarracks], [], aLoc); + htStables: Result := NextToHouse(aHouse, [htFarm], [], aLoc); + htSwine: Result := NextToHouse(aHouse, [htFarm], [], aLoc); + htTannery: Result := NextToHouse(aHouse, [htSwine], [], aLoc); + htWeaponSmithy: Result := NextToHouse(aHouse, [htIronSmithy, htCoalMine, htBarracks], [], aLoc); + htWeaponWorkshop: Result := NextToHouse(aHouse, [htSawmill, htBarracks], [], aLoc); + + htCoalMine: Result := NextToOre(aHouse, wtCoal, aLoc); + htGoldMine: Result := NextToOre(aHouse, wtGoldOre, aLoc); + htIronMine: Result := NextToOre(aHouse, wtIronOre, aLoc); + + htQuarry: Result := NextToStone(aHouse, aLoc); + htWoodcutters: Result := NextToTrees(aHouse, [htStore, htWoodcutters, htSawmill], aLoc); + htFarm: Result := NextToGrass(aHouse, [htAny], aLoc); + htVineyard: Result := NextToGrass(aHouse, [htAny], aLoc); + htFishermans: {Result := NextToWater(aHouse, aLoc)}; + + //htMarketplace:; + //htSiegeWorkshop:; + //htTownHall:; + //htWatchTower:; + end; + + //If we failed to find something, try to place the house anywhere (better than ignoring it) + if not Result and not (aHouse in [htCoalMine, htGoldMine, htIronMine, htQuarry, htFarm, htVineyard, htFishermans]) then + Result := NextToHouse(aHouse, [htAny], [], aLoc); +end; + + +//Receive list of desired house types +//Output list of locations below these houses +function TKMCityPlanner.GetSeeds(aHouseType: array of TKMHouseType): TKMPointArray; +var + I, K: Integer; + H: TKMHouseType; + Count, HQty: Integer; + House: TKMHouse; +begin + Count := 0; + SetLength(Result, Count); + + for I := Low(aHouseType) to High(aHouseType) do + begin + H := aHouseType[I]; + HQty := gHands[fOwner].Stats.GetHouseQty(H); + //htAny picks three random houses for greater variety + for K := 0 to 1 + Byte(H = htAny) * 2 do + begin + House := gHands[fOwner].Houses.FindHouse(H, 0, 0, KaMRandom(HQty{$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.GetSeeds'{$ENDIF}) + 1); + if House <> nil then + begin + SetLength(Result, Count + 1); + //Position is as good as Entrance for city planning + Result[Count] := KMPointBelow(House.Position); + Inc(Count); + end; + end; + end; +end; + + +procedure TKMCityPlanner.AfterMissionInit; +var + I,K: Integer; +begin + //Mark all spots where we could possibly place a goldmine + //some smarter logic can clip left/right edges later on? + for I := 1 to gTerrain.MapY - 2 do + for K := 1 to gTerrain.MapX - 2 do + if gTerrain.TileGoodForGoldmine(K,I) then + fListGold.Add(KMPoint(K,I)); +end; + + +function TKMCityPlanner.NextToGrass(aHouse: TKMHouseType; aSeed: array of TKMHouseType; out aLoc: TKMPoint): Boolean; + function CanPlaceHouse(aHouse: TKMHouseType; aX, aY: Word): Boolean; + var + I, K: Integer; + FieldCount: Integer; + begin + Result := False; + if gHands[fOwner].CanAddHousePlanAI(aX, aY, aHouse, True) then + begin + FieldCount := 0; + for I := Min(aY - 2, gTerrain.MapY - 1) to Max(aY + 2 + AI_FIELD_HEIGHT - 1, 1) do + for K := Max(aX - AI_FIELD_WIDTH, 1) to Min(aX + AI_FIELD_WIDTH, gTerrain.MapX - 1) do + if gHands[fOwner].CanAddFieldPlan(KMPoint(K,I), ftCorn) + //Skip fields within actual house areas + and ((aHouse <> htFarm) or not InRange(I, aY-2, aY) or not InRange(K, aX-1, aX+2)) + and ((aHouse <> htVineyard) or not InRange(I, aY-1, aY) or not InRange(K, aX-2, aX)) then + begin + Inc(FieldCount); + //Request slightly more than we need to have a good choice + if FieldCount >= Min(AI_FIELD_MAX_AREA, IfThen(aHouse = htFarm, 16, 10)) then + begin + Result := True; + Exit; + end; + end; + end; + end; +var + I, K, J: Integer; + Bid, BestBid: Single; + SeedLocs: TKMPointArray; + S: TKMPoint; +begin + Result := False; + Assert(aHouse in [htFarm, htVineyard]); + + SeedLocs := GetSeeds(aSeed); + + BestBid := MaxSingle; + for J := Low(SeedLocs) to High(SeedLocs) do + begin + S := SeedLocs[J]; + for I := Max(S.Y - 7, 1) to Min(S.Y + 6, gTerrain.MapY - 1) do + for K := Max(S.X - 7, 1) to Min(S.X + 7, gTerrain.MapX - 1) do + if CanPlaceHouse(aHouse, K, I) then + begin + Bid := KMLength(KMPoint(K,I), S) + - gAIFields.Influences.Ownership[fOwner, I, K] / 5 + + KaMRandom({$IFDEF DBG_RNG_SPY}'TKMCityPlanner.NextToGrass'{$ENDIF}) * 4; + if Bid < BestBid then + begin + aLoc := KMPoint(K,I); + BestBid := Bid; + Result := True; + end; + end; + end; +end; + + +function TKMCityPlanner.NextToHouse(aHouse: TKMHouseType; aSeed, aAvoid: array of TKMHouseType; out aLoc: TKMPoint): Boolean; +var + I: Integer; + Bid, BestBid: Single; + SeedLocs: TKMPointArray; + Locs: TKMPointTagList; +begin + Result := False; + + SeedLocs := GetSeeds(aSeed); + + Locs := TKMPointTagList.Create; + try + FindNearest(SeedLocs, 32, aHouse, 12, Locs); + + BestBid := MaxSingle; + for I := 0 to Locs.Count - 1 do + begin + Bid := Locs.Tag[I] + - gAIFields.Influences.Ownership[fOwner,Locs[I].Y,Locs[I].X] / 5; + if (Bid < BestBid) then + begin + aLoc := Locs[I]; + BestBid := Bid; + Result := True; + end; + end; + finally + Locs.Free; + end; +end; + + +//Called when AI needs to find a good spot for a new Quary +function TKMCityPlanner.NextToStone(aHouse: TKMHouseType; out aLoc: TKMPoint): Boolean; +const + SEARCH_RAD = 8; +var + I, K: Integer; + Bid, BestBid: Single; + StoneLoc: TKMPoint; + Locs: TKMPointTagList; + SeedLocs: TKMPointArray; + J, M: Integer; + tmp: TKMPointDir; +begin + Result := False; + + SeedLocs := GetSeeds([htAny]); + + Locs := TKMPointTagList.Create; + try + //Find all tiles from which stone can be mined, by walking to them + FindNearest(SeedLocs, 32, fnStone, [tpWalk], 12, Locs); + if Locs.Count = 0 then Exit; + + //Check few random tiles if we can build Quary nearby + BestBid := MaxSingle; + for J := 0 to 2 do + begin + M := KaMRandom(Locs.Count{$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.NextToStone'{$ENDIF}); + StoneLoc := Locs[M]; + for I := Max(StoneLoc.Y - SEARCH_RAD, 1) to Min(StoneLoc.Y + SEARCH_RAD, gTerrain.MapY - 1) do + for K := Max(StoneLoc.X - SEARCH_RAD, 1) to Min(StoneLoc.X + SEARCH_RAD, gTerrain.MapX - 1) do + if gHands[fOwner].CanAddHousePlanAI(K, I, aHouse, True) then + begin + Bid := Locs.Tag[M] + - gAIFields.Influences.Ownership[fOwner,I,K] / 10 + + KaMRandom({$IFDEF DBG_RNG_SPY}'TKMCityPlanner.NextToStone_2'{$ENDIF}) * 3 + + KMLengthDiag(K, I, StoneLoc); //Distance to stone is important + if (Bid < BestBid) then + begin + aLoc := KMPoint(K,I); + BestBid := Bid; + Result := True; + end; + end; + end; + finally + Locs.Free; + end; + + //Make sure stonemason actually can reach some stone (avoid build-destroy loop) + if Result then + if not gTerrain.FindStone(aLoc, gRes.Units[utStonemason].MiningRange, KMPOINT_ZERO, True, tmp) then + Result := False; +end; + + +function TKMCityPlanner.FindNearest(const aStart: TKMPoint; aRadius: Byte; aType: TFindNearest; out aResultLoc: TKMPoint): Boolean; +begin + fFinder.FindType := aType; + fFinder.HouseType := htNone; + Result := fFinder.FindNearest(aStart, aRadius, [tpWalkRoad, tpMakeRoads], aResultLoc); +end; + + +procedure TKMCityPlanner.FindNearest(const aStart: TKMPointArray; aRadius: Byte; aType: TFindNearest; aPass: TKMTerrainPassabilitySet; aMaxCount: Word; aLocs: TKMPointTagList); +begin + fFinder.FindType := aType; + fFinder.HouseType := htNone; + fFinder.FindNearest(aStart, aRadius, aPass, aMaxCount, aLocs); +end; + + +procedure TKMCityPlanner.FindNearest(const aStart: TKMPointArray; aRadius: Byte; aHouse: TKMHouseType; aMaxCount: Word; aLocs: TKMPointTagList); +begin + fFinder.FindType := fnHouse; + fFinder.HouseType := aHouse; + fFinder.FindNearest(aStart, aRadius, [tpWalkRoad, tpMakeRoads], aMaxCount, aLocs); +end; + + +function TKMCityPlanner.NextToOre(aHouse: TKMHouseType; aOreType: TKMWareType; out aLoc: TKMPoint; aNearAnyHouse: Boolean = False): Boolean; +var + P: TKMPoint; + SeedLocs: TKMPointArray; +begin + Result := False; + + + //Look for nearest Ore + case aOreType of + wtCoal: begin + if aNearAnyHouse then + SeedLocs := GetSeeds([htAny]) + else + if gHands[fOwner].Stats.GetHouseTotal(htCoalMine) > 0 then + SeedLocs := GetSeeds([htCoalMine]) + else + SeedLocs := GetSeeds([htStore]); + if Length(SeedLocs) = 0 then Exit; + if not FindNearest(SeedLocs[KaMRandom(Length(SeedLocs){$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.NextToOre'{$ENDIF})], 45, fnCoal, P) then + if aNearAnyHouse or not NextToOre(aHouse, aOreType, P, True) then + Exit; + end; + wtIronOre: begin + if aNearAnyHouse then + SeedLocs := GetSeeds([htAny]) + else + if gHands[fOwner].Stats.GetHouseTotal(htIronMine) > 0 then + SeedLocs := GetSeeds([htIronMine, htCoalMine]) + else + SeedLocs := GetSeeds([htCoalMine, htStore]); + if Length(SeedLocs) = 0 then Exit; + if not FindNearest(SeedLocs[KaMRandom(Length(SeedLocs){$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.NextToOre_2'{$ENDIF})], 45, fnIron, P) then + if aNearAnyHouse or not NextToOre(aHouse, aOreType, P, True) then + Exit; + end; + wtGoldOre: begin + if aNearAnyHouse then + SeedLocs := GetSeeds([htAny]) + else + if gHands[fOwner].Stats.GetHouseTotal(htGoldMine) > 0 then + SeedLocs := GetSeeds([htGoldMine, htCoalMine]) + else + SeedLocs := GetSeeds([htCoalMine, htStore]); + if Length(SeedLocs) = 0 then Exit; + if not FindNearest(SeedLocs[KaMRandom(Length(SeedLocs){$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.NextToOre_3'{$ENDIF})], 45, fnGold, P) then + if aNearAnyHouse or not NextToOre(aHouse, aOreType, P, True) then + Exit; + end; + end; + + //todo -cComplicated: If there's no ore AI should not keep calling this over and over again + // Maybe AI can cache search results for such non-replenishing resources + + aLoc := P; + Result := True; +end; + + +function TKMCityPlanner.NextToTrees(aHouse: TKMHouseType; aSeed: array of TKMHouseType; out aLoc: TKMPoint): Boolean; +const + SEARCH_RES = 7; + SEARCH_RAD = 20; //Search for forests within this radius + SEARCH_DIV = (SEARCH_RAD * 2) div SEARCH_RES + 1; + HUT_RAD = 6; //Search for the best place for a hut in this radius +var + I, K: Integer; + Bid, BestBid: Single; + SeedLocs: TKMPointArray; + seedLoc, TreeLoc: TKMPoint; + Mx, My: SmallInt; + MyForest: array [0..SEARCH_RES-1, 0..SEARCH_RES-1] of ShortInt; +begin + Result := False; + + SeedLocs := GetSeeds(aSeed); + if Length(SeedLocs) = 0 then Exit; + + // Pick one random seed loc from given + seedLoc := SeedLocs[KaMRandom(Length(SeedLocs){$IFDEF DBG_RNG_SPY}, 'TKMCityPlanner.NextToTrees'{$ENDIF})]; + + //todo -cComplicated: Rework through FindNearest to avoid roundabouts + //Fill in MyForest map + FillChar(MyForest[0,0], SizeOf(MyForest), #0); + for I := Max(seedLoc.Y - SEARCH_RAD, 1) to Min(seedLoc.Y + SEARCH_RAD, gTerrain.MapY - 1) do + for K := Max(seedLoc.X - SEARCH_RAD, 1) to Min(seedLoc.X + SEARCH_RAD, gTerrain.MapX - 1) do + if gTerrain.ObjectIsChopableTree(K, I) then + begin + Mx := (K - seedLoc.X + SEARCH_RAD) div SEARCH_DIV; + My := (I - seedLoc.Y + SEARCH_RAD) div SEARCH_DIV; + + Inc(MyForest[My, Mx]); + end; + + //Find cell with most trees + BestBid := -MaxSingle; + TreeLoc := seedLoc; //Init incase we cant find a spot at all + for I := Low(MyForest) to High(MyForest) do + for K := Low(MyForest[I]) to High(MyForest[I]) do + begin + Mx := Round(seedLoc.X - SEARCH_RAD + (K + 0.5) * SEARCH_DIV); + My := Round(seedLoc.Y - SEARCH_RAD + (I + 0.5) * SEARCH_DIV); + if InRange(Mx, 1, gTerrain.MapX - 1) and InRange(My, 1, gTerrain.MapY - 1) + and (gAIFields.Influences.AvoidBuilding[My, Mx] = 0) then + begin + Bid := MyForest[I, K] + KaMRandom({$IFDEF DBG_RNG_SPY}'TKMCityPlanner.NextToTrees_2'{$ENDIF}) * 2; //Add some noise for varied results + if Bid > BestBid then + begin + TreeLoc := KMPoint(Mx, My); + BestBid := Bid; + end; + end; + end; + + BestBid := MaxSingle; + for I := Max(TreeLoc.Y - HUT_RAD, 1) to Min(TreeLoc.Y + HUT_RAD, gTerrain.MapY - 1) do + for K := Max(TreeLoc.X - HUT_RAD, 1) to Min(TreeLoc.X + HUT_RAD, gTerrain.MapX - 1) do + if gHands[fOwner].CanAddHousePlanAI(K, I, aHouse, True) then + begin + Bid := KMLength(KMPoint(K,I), seedLoc) + KaMRandom({$IFDEF DBG_RNG_SPY}'TKMCityPlanner.NextToTrees_3'{$ENDIF}) * 5; + if (Bid < BestBid) then + begin + aLoc := KMPoint(K,I); + BestBid := Bid; + Result := True; + end; + end; +end; + + +procedure TKMCityPlanner.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fFinder.OwnerUpdate(fOwner); +end; + + +procedure TKMCityPlanner.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('AICityPlanner'); + SaveStream.Write(fOwner); + fFinder.Save(SaveStream); + fListGold.SaveToStream(SaveStream); +end; + + +procedure TKMCityPlanner.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('AICityPlanner'); + LoadStream.Read(fOwner); + fFinder.Load(LoadStream); + fListGold.LoadFromStream(LoadStream); +end; + + +{ TKMTerrainFinderCity } +constructor TKMTerrainFinderCity.Create(aOwner: TKMHandID); +begin + inherited Create; + + fOwner := aOwner; +end; + + +procedure TKMTerrainFinderCity.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + + +function TKMTerrainFinderCity.CanUse(const X, Y: Word): Boolean; +var + I, K: Integer; +begin + case FindType of + fnHouse: Result := gHands[fOwner].CanAddHousePlanAI(X, Y, HouseType, True); + + fnStone: Result := (gTerrain.TileIsStone(X, Max(Y-1, 1)) > 1); + + fnCoal: Result := (gTerrain.TileIsCoal(X, Y) > 1) + and gHands[fOwner].CanAddHousePlanAI(X, Y, htCoalMine, False); + + fnIron: begin + Result := gHands[fOwner].CanAddHousePlanAI(X, Y, htIronMine, False); + //If we can build a mine here then search for ore + if Result then + for I:=Max(X-4, 1) to Min(X+3, gTerrain.MapX) do + for K:=Max(Y-8, 1) to Y do + if gTerrain.TileHasIron(I, K) then + Exit; + Result := False; //Didn't find any ore + end; + + fnGold: begin + Result := gHands[fOwner].CanAddHousePlanAI(X, Y, htGoldMine, False); + //If we can build a mine here then search for ore + if Result then + for I:=Max(X-4, 1) to Min(X+4, gTerrain.MapX) do + for K:=Max(Y-8, 1) to Y do + if gTerrain.TileHasGold(I, K) then + Exit; + Result := False; //Didn't find any ore + end; + + else Result := False; + end; +end; + + +function TKMTerrainFinderCity.CanWalkHere(const X,Y: Word): Boolean; +var + TerOwner: TKMHandID; +begin + //Check for specific passabilities + case FindType of + fnIron: Result := (fPassability * gTerrain.Land^[Y,X].Passability <> []) + or gTerrain.CanPlaceIronMine(X, Y); + + fnGold: Result := (fPassability * gTerrain.Land^[Y,X].Passability <> []) + or gTerrain.TileGoodForGoldmine(X, Y); + + else Result := (fPassability * gTerrain.Land^[Y,X].Passability <> []); + end; + + if not Result then Exit; + + //Don't build on allies and/or enemies territory + TerOwner := gAIFields.Influences.GetBestOwner(X,Y); + Result := ((TerOwner = fOwner) or (TerOwner = HAND_NONE)); +end; + + +procedure TKMTerrainFinderCity.Save(SaveStream: TKMemoryStream); +begin + inherited; + SaveStream.PlaceMarker('TerrainFinderCity'); + SaveStream.Write(fOwner); +end; + + +procedure TKMTerrainFinderCity.Load(LoadStream: TKMemoryStream); +begin + inherited; + LoadStream.CheckMarker('TerrainFinderCity'); + LoadStream.Read(fOwner); +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIDefensePos.pas b/vendor/kam_remake/src/ai/KM_AIDefensePos.pas new file mode 100644 index 0000000..6804575 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIDefensePos.pas @@ -0,0 +1,525 @@ +unit KM_AIDefensePos; +{$I KaM_Remake.inc} +interface +uses + Math, + KM_Entity, KM_UnitGroup, + KM_CommonClasses, KM_Defaults, KM_Points, + KM_AITypes; + + +type + TAIDefencePosition = class(TKMEntity) + private + fDefenceType: TKMAIDefencePosType; //Whether this is a front or back line defence position. See comments on TAIDefencePosType above + fGroupType: TKMGroupType; //Type of group to defend this position (e.g. melee) + fPosition: TKMPointDir; //Position and direction the group defending will stand + fRadius: Integer; //If fighting (or houses being attacked) occurs within this radius from this defence position, this group will get involved + + fCurrentGroup: TKMUnitGroup; //Commander of group currently occupying position + procedure SetCurrentGroup(aGroup: TKMUnitGroup); + procedure SetGroupType(const Value: TKMGroupType); + procedure SetDefenceType(const Value: TKMAIDefencePosType); + procedure SetPosition(const Value: TKMPointDir); + public + constructor Create(aUID: Integer; const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType); + constructor Load(LoadStream: TKMemoryStream); override; + destructor Destroy; override; + + property DefenceType: TKMAIDefencePosType read fDefenceType write SetDefenceType; + property GroupType: TKMGroupType read fGroupType write SetGroupType; //Type of group to defend this position (e.g. melee) + property Position: TKMPointDir read fPosition write SetPosition; //Position and direction the group defending will stand + property Radius: Integer read fRadius write fRadius; //If fighting (or houses being attacked) occurs within this radius from this defence position, this group will get involved + + property CurrentGroup: TKMUnitGroup read fCurrentGroup write SetCurrentGroup; + function CanAccept(aGroup: TKMUnitGroup; aMaxUnits: Integer): Boolean; + procedure Save(SaveStream: TKMemoryStream); override; + procedure SyncLoad; + procedure UpdateState; + end; + + + TAIDefencePositions = class + private + fOwner: TKMHandID; + fPositions: TKMList; + function GetPosition(aIndex: Integer): TAIDefencePosition; inline; + function GetCount: Integer; inline; + function CreateDefPosition(const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): TAIDefencePosition; + public + //Defines how defending troops will be formatted. 0 means leave unchanged. + TroopFormations: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of TKMFormation; + + constructor Create(aPlayer: TKMHandID); + destructor Destroy; override; + + function Add(const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): Integer; + function Insert(aIndex: Integer; const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): Integer; + procedure Clear; + property Count: Integer read GetCount; + procedure Delete(aIndex: Integer); + property Positions[aIndex: Integer]: TAIDefencePosition read GetPosition; default; + function GetBacklineCount: Integer; + function AverageUnitsPerGroup: Integer; + + function FindPlaceForGroup(aGroup: TKMUnitGroup; aTakeClosest: Boolean): Boolean; + + function FindPositionAtLoc(aPos: TKMPoint ): TAIDefencePosition; + + procedure RestockPositionWith(aDefenceGroup, aGroup: TKMUnitGroup); + function FindPositionOf(aGroup: TKMUnitGroup): TAIDefencePosition; + procedure GetArmyDemand(out aFootmen: Integer; out aPikemen: Integer; out aHorsemen: Integer; out aArchers: Integer); + + procedure MoveUp(aIndex: Integer); + procedure MoveDown(aIndex: Integer); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad; + procedure UpdateState; + procedure Paint; + end; + + +implementation +uses + SysUtils, TypInfo, + KM_Game, KM_GameUIDTracker, KM_GameParams, KM_HandsCollection, KM_RenderAux, KM_RenderPool, KM_Hand, + KM_UnitGroupTypes, KM_InterfaceGame; + + +{ TAIDefencePosition } +constructor TAIDefencePosition.Create(aUID: Integer; const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType); +begin + inherited Create(aUID); + + Assert(aGroupType in GROUP_TYPES_VALID, 'Invalid group type: ' + GetEnumName(TypeInfo(TKMGroupType), Integer(aGroupType))); + fPosition := aPos; + fGroupType := aGroupType; + fRadius := aRadius; + fDefenceType := aDefenceType; + CurrentGroup := nil; //Unoccupied +end; + + +destructor TAIDefencePosition.Destroy; +begin + CurrentGroup := nil; //Ensure pointer is removed + inherited; +end; + + +procedure TAIDefencePosition.SetCurrentGroup(aGroup: TKMUnitGroup); +begin + //Release previous group + gHands.CleanUpGroupPointer(fCurrentGroup); + + //Take new one + if aGroup <> nil then + fCurrentGroup := aGroup.GetPointer; +end; + + +procedure TAIDefencePosition.SetDefenceType(const Value: TKMAIDefencePosType); +begin + Assert(gGameParams.IsMapEditor); + fDefenceType := Value; +end; + + +procedure TAIDefencePosition.SetGroupType(const Value: TKMGroupType); +begin + Assert(gGameParams.IsMapEditor); + Assert(Value in GROUP_TYPES_VALID, 'Invalid group type: ' + GetEnumName(TypeInfo(TKMGroupType), Integer(Value))); + fGroupType := Value; +end; + + +procedure TAIDefencePosition.SetPosition(const Value: TKMPointDir); +begin + Assert(gGameParams.IsMapEditor); + fPosition := Value; +end; + + +procedure TAIDefencePosition.Save(SaveStream: TKMemoryStream); +begin + inherited; + + SaveStream.PlaceMarker('ClsDefencePos'); + SaveStream.Write(fPosition); + SaveStream.Write(fGroupType, SizeOf(fGroupType)); + SaveStream.Write(fRadius); + SaveStream.Write(fDefenceType, SizeOf(fDefenceType)); + SaveStream.Write(fCurrentGroup.UID); //Store ID +end; + + +constructor TAIDefencePosition.Load(LoadStream: TKMemoryStream); +begin + inherited; + + LoadStream.CheckMarker('ClsDefencePos'); + LoadStream.Read(fPosition); + LoadStream.Read(fGroupType, SizeOf(fGroupType)); + LoadStream.Read(fRadius); + LoadStream.Read(fDefenceType, SizeOf(fDefenceType)); + LoadStream.Read(fCurrentGroup, 4); //subst on syncload +end; + + +procedure TAIDefencePosition.SyncLoad; +begin + fCurrentGroup := gHands.GetGroupByUID(Integer(fCurrentGroup)); +end; + + +function TAIDefencePosition.CanAccept(aGroup: TKMUnitGroup; aMaxUnits: Integer): Boolean; +begin + Result := (fGroupType = UNIT_TO_GROUP_TYPE[aGroup.UnitType]); + + if not Result then Exit; + + // Empty position accepts anything (e.g. happens at mission start) + // As checked in KaM - it did not link big groups to filled Positions + Result := (CurrentGroup = nil) or + (aGroup.Count = 1); + + Result := Result and ((CurrentGroup = nil) or (CurrentGroup.Count < aMaxUnits)); +end; + + +procedure TAIDefencePosition.UpdateState; +begin + //If the group is Dead or too far away we should disassociate + //them from the defence position so new warriors can take up the defence if needs be + if (CurrentGroup = nil) + or CurrentGroup.IsDead + or ((CurrentGroup.InFight or (CurrentGroup.Order in [goAttackHouse, goAttackUnit])) + and (KMLengthDiag(Position.Loc, CurrentGroup.Position) > Radius)) then + CurrentGroup := nil; + + //Tell group to walk to its position + //It's easier to repeat the order than check that all members are in place + if (CurrentGroup <> nil) + and CurrentGroup.IsIdleToAI([wtokFlagPoint, wtokHaltOrder]) + and CurrentGroup.CanWalkTo(Position.Loc, 0) then + CurrentGroup.OrderWalk(Position.Loc, True, wtokAIGotoDefencePos, Position.Dir); +end; + + +{ TAIDefencePositions } +constructor TAIDefencePositions.Create(aPlayer: TKMHandID); +var + GT: TKMGroupType; +begin + inherited Create; + + fOwner := aPlayer; + fPositions := TKMList.Create; + + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + TroopFormations[GT].NumUnits := 9; //These are the defaults in KaM + TroopFormations[GT].UnitsPerRow := 3; + end; +end; + + +destructor TAIDefencePositions.Destroy; +begin + fPositions.Free; + + inherited; +end; + + +function TAIDefencePositions.GetCount: Integer; +begin + Result := fPositions.Count; +end; + + +//Find DefencePosition at location +function TAIDefencePositions.FindPositionAtLoc(aPos: TKMPoint): TAIDefencePosition; +var + I: Integer; +begin + Result := nil; + + for I := 0 to Count - 1 do + if Positions[I].Position.Loc = aPos then + Exit(Positions[I]); +end; + + +function TAIDefencePositions.GetPosition(aIndex: Integer): TAIDefencePosition; +begin + if not InRange(aIndex, 0, Count - 1) then Exit(nil); + + Result := fPositions[aIndex]; +end; + + +function TAIDefencePositions.CreateDefPosition(const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): TAIDefencePosition; +begin + Assert(aGroupType in GROUP_TYPES_VALID, 'Invalid group type: ' + GetEnumName(TypeInfo(TKMGroupType), Integer(aGroupType))); + + Result := TAIDefencePosition.Create(gUIDTracker.GetNewUID, aPos, aGroupType, aRadius, aDefenceType); +end; + + +function TAIDefencePositions.Add(const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): Integer; +var + defPos: TAIDefencePosition; +begin + defPos := CreateDefPosition(aPos, aGroupType, aRadius, aDefenceType); + fPositions.Add(defPos); + Result := defPos.UID; +end; + + +function TAIDefencePositions.Insert(aIndex: Integer; const aPos: TKMPointDir; aGroupType: TKMGroupType; aRadius: Integer; aDefenceType: TKMAIDefencePosType): Integer; +var + defPos: TAIDefencePosition; +begin + Assert(InRange(aIndex, 0, Count), 'Can''t insert defence position at position ' + IntToStr(aIndex)); + defPos := CreateDefPosition(aPos, aGroupType, aRadius, aDefenceType); + + fPositions.Insert(aIndex, defPos); + + Result := defPos.UID; +end; + + +procedure TAIDefencePositions.Clear; +begin + fPositions.Clear; +end; + + +procedure TAIDefencePositions.Delete(aIndex: Integer); +begin + //Note: Order of positions is important (AI fills them with troops from 0 to N) + fPositions.Delete(aIndex); +end; + + +function TAIDefencePositions.GetBacklineCount: Integer; +var I: Integer; +begin + Result := 0; + for I := 0 to Count - 1 do + if Positions[I].fDefenceType = dtBackLine then + Inc(Result); +end; + + +function TAIDefencePositions.AverageUnitsPerGroup: Integer; +var + GT: TKMGroupType; + TypeCount: Integer; +begin + Result := 0; + TypeCount := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + Result := Result + TroopFormations[GT].NumUnits; + Inc(TypeCount); + end; + Result := Result div TypeCount; +end; + + +function TAIDefencePositions.FindPlaceForGroup(aGroup: TKMUnitGroup; aTakeClosest: Boolean): Boolean; +var + I, Matched: Integer; + Distance, Best: Single; +begin + Result := False; + Matched := -1; + Best := MaxSingle; + + //Try to link to existing group + for I := 0 to Count - 1 do + if Positions[I].CanAccept(aGroup, TroopFormations[aGroup.GroupType].NumUnits) then + begin + //Take closest position that is empty or requries restocking + Distance := KMLengthSqr(aGroup.Position, Positions[I].Position.Loc); + if Distance < Best then + begin + Matched := I; + Best := Distance; + //KaM fills defence positions by their order of creation + //Take first one we find - that's what KaM does + if not aTakeClosest then Break; + end; + end; + + if Matched <> -1 then + begin + Result := True; + if Positions[Matched].CurrentGroup = nil then + begin + //New position + Positions[Matched].CurrentGroup := aGroup; + if aGroup.UnitsPerRow < TroopFormations[aGroup.GroupType].UnitsPerRow then + aGroup.UnitsPerRow := TroopFormations[aGroup.GroupType].UnitsPerRow; + aGroup.OrderWalk(Positions[Matched].Position.Loc, True, wtokAIGotoDefencePos); + end + else + //Append to existing position + RestockPositionWith(Positions[Matched].CurrentGroup, aGroup); + end; +end; + + +procedure TAIDefencePositions.RestockPositionWith(aDefenceGroup, aGroup: TKMUnitGroup); +var + Needed: integer; +begin + Needed := TroopFormations[aDefenceGroup.GroupType].NumUnits - aDefenceGroup.Count; + if Needed <= 0 then exit; + if aGroup.Count <= Needed then + aGroup.OrderLinkTo(aDefenceGroup, True) //Link entire group + else + aGroup.OrderSplitLinkTo(aDefenceGroup, Needed, True); //Link only as many units as are needed + + if aDefenceGroup.UnitsPerRow < TroopFormations[aDefenceGroup.GroupType].UnitsPerRow then + aDefenceGroup.UnitsPerRow := TroopFormations[aDefenceGroup.GroupType].UnitsPerRow; +end; + + +//Find DefencePosition to which this Commander belongs +//(Result could be nil if CommanderCount > PositionsCount +function TAIDefencePositions.FindPositionOf(aGroup: TKMUnitGroup): TAIDefencePosition; +var + I: Integer; +begin + Result := nil; + + for I := 0 to Count - 1 do + if Positions[I].CurrentGroup = aGroup then + begin + Result := Positions[I]; + Break; + end; +end; + + +procedure TAIDefencePositions.GetArmyDemand(out aFootmen: Integer; out aPikemen: Integer; out aHorsemen: Integer; out aArchers: Integer); +var I, Required: Integer; +begin + aFootmen := 0; + aPikemen := 0; + aHorsemen := 0; + aArchers := 0; + for I := 0 to Count - 1 do + begin + Required := TroopFormations[Positions[I].GroupType].NumUnits; + case Positions[I].GroupType of + gtMelee: Inc(aFootmen, Required); + gtAntiHorse: Inc(aPikemen, Required); + gtRanged: Inc(aArchers, Required); + gtMounted: Inc(aHorsemen, Required); + end; + end; +end; + + +procedure TAIDefencePositions.MoveUp(aIndex: Integer); +begin + if aIndex < Count-1 then + fPositions.Exchange(aIndex, aIndex+1); +end; + + +procedure TAIDefencePositions.MoveDown(aIndex: Integer); +begin + if aIndex > 0 then + fPositions.Exchange(aIndex, aIndex-1); +end; + + +procedure TAIDefencePositions.Save(SaveStream: TKMemoryStream); +var I: Integer; +begin + SaveStream.PlaceMarker('ClsDefencePositions'); + SaveStream.Write(fOwner); + SaveStream.Write(TroopFormations, SizeOf(TroopFormations)); + SaveStream.Write(Count); + + for I := 0 to Count - 1 do + Positions[I].Save(SaveStream); +end; + + +procedure TAIDefencePositions.Load(LoadStream: TKMemoryStream); +var I, NewCount: Integer; +begin + LoadStream.CheckMarker('ClsDefencePositions'); + LoadStream.Read(fOwner); + LoadStream.Read(TroopFormations, SizeOf(TroopFormations)); + LoadStream.Read(NewCount); + + for I := 0 to NewCount - 1 do + fPositions.Add(TAIDefencePosition.Load(LoadStream)); +end; + + +procedure TAIDefencePositions.SyncLoad; +var I: Integer; +begin + for I := 0 to Count - 1 do + Positions[I].SyncLoad; +end; + + +procedure TAIDefencePositions.UpdateState; +var I,K: Integer; +begin + //Make sure no defence position Group is dead + for I := 0 to Count - 1 do + Positions[I].UpdateState; + + //In KaM the order of defence positions is the priority: The first defined is higher priority + for I := 0 to Count - 1 do + if (Positions[I].CurrentGroup = nil) then + for K := I + 1 to Count - 1 do + if Positions[I].GroupType = Positions[K].GroupType then + begin + Positions[I].CurrentGroup := Positions[K].CurrentGroup; //Take new position + Positions[K].CurrentGroup := nil; //Leave current position + Break; + end; +end; + + +procedure TAIDefencePositions.Paint; +var + I: Integer; + str: string; +begin + for I := 0 to Count - 1 do + begin + gRenderAux.Quad(Positions[I].Position.Loc.X, Positions[I].fPosition.Loc.Y, DEFENCE_LINE_TYPE_COL[Positions[I].fDefenceType]); + + gRenderPool.RenderSpriteOnTile(Positions[I].Position.Loc, 510 + Byte(Positions[I].Position.Dir), gHands[fOwner].FlagColor); + gRenderAux.CircleOnTerrain(Positions[I].Position.Loc.X-0.5, Positions[I].Position.Loc.Y-0.5, Positions[I].Radius, + gHands[fOwner].FlagColor AND $08FFFFFF, + gHands[fOwner].FlagColor); + //group type and position number will be painted by InterfaceMapEditor + + if not gGameParams.IsMapEditor then + begin + str := 'nil'; + if Positions[I].CurrentGroup <> nil then + str := IntToStr(Positions[I].CurrentGroup.UID); + + gRenderAux.Text(Positions[I].fPosition.Loc.X, Positions[I].fPosition.Loc.Y, str, icRed); + end; + end; +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIFields.pas b/vendor/kam_remake/src/ai/KM_AIFields.pas new file mode 100644 index 0000000..dd95250 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIFields.pas @@ -0,0 +1,162 @@ +unit KM_AIFields; +{$I KaM_Remake.inc} +interface +uses + KM_NavMesh, KM_AIInfluences, KM_Eye, KM_Supervisor, + KM_CommonClasses, KM_Points, KM_GameTypes; + + +type + //Master class for Influence maps, NavMeshe and other terrain representations + //that are helpful in decision making by Mayour/General + TKMAIFields = class + private + fNavMesh: TKMNavMesh; + fInfluences: TKMInfluences; + fEye: TKMEye; + fSupervisor: TKMSupervisor; + + fCanHaveAAI: Boolean; // Flag, if game can have AdvancedAI + public + constructor Create(); + destructor Destroy(); override; + + property NavMesh: TKMNavMesh read fNavMesh; + property Influences: TKMInfluences read fInfluences; + property Eye: TKMEye read fEye write fEye; + property Supervisor: TKMSupervisor read fSupervisor write fSupervisor; + + procedure AfterMissionInit(aCanHaveAAI: Boolean); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure UpdateState(aTick: Cardinal); + procedure Paint(const aRect: TKMRect); + end; + + +var + gAIFields: TKMAIFields; + + +implementation +uses + SysUtils, + KM_Defaults, + KM_DevPerfLog, KM_DevPerfLogTypes; + +const + AIFIELDS_MARKER = 'AIFields'; + + +{ TKMAIFields } +constructor TKMAIFields.Create(); +begin + inherited; + + fNavMesh := TKMNavMesh.Create(); + fInfluences := TKMInfluences.Create(fNavMesh); + fEye := TKMEye.Create(); + fSupervisor := TKMSupervisor.Create(); +end; + + +destructor TKMAIFields.Destroy(); +begin + FreeAndNil(fNavMesh); + FreeAndNil(fInfluences); + FreeAndNil(fEye); + FreeAndNil(fSupervisor); + inherited; +end; + + +procedure TKMAIFields.AfterMissionInit(aCanHaveAAI: Boolean); +begin + fCanHaveAAI := aCanHaveAAI; + + if not FEAT_AI_GENERATE_NAVMESH then + Exit; + + fNavMesh.AfterMissionInit(); + fInfluences.AfterMissionInit(); + if fCanHaveAAI then + begin + fSupervisor.AfterMissionInit(); + // fEye.AfterMissionInit(); Eye is updated from HandsCollection (so mines are already visible for game with random map and automatic selection of storehouse) + end; +end; + + +procedure TKMAIFields.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker(AIFIELDS_MARKER); + + SaveStream.Write(fCanHaveAAI); + fNavMesh.Save(SaveStream); + fInfluences.Save(SaveStream); + + if fCanHaveAAI then + begin + fEye.Save(SaveStream); + fSupervisor.Save(SaveStream); + end; +end; + + +procedure TKMAIFields.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker(AIFIELDS_MARKER); + + LoadStream.Read(fCanHaveAAI); + fNavMesh.Load(LoadStream); + fInfluences.Load(LoadStream); + + if fCanHaveAAI then + begin + fEye.Load(LoadStream); + fSupervisor.Load(LoadStream); + end; +end; + + +procedure TKMAIFields.UpdateState(aTick: Cardinal); +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAIFields); + {$ENDIF} + try + fNavMesh.UpdateState(aTick); + fInfluences.UpdateState(aTick); + + if fCanHaveAAI then + begin + fEye.UpdateState(aTick); + fSupervisor.UpdateState(aTick); + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAIFields); + {$ENDIF} + end; +end; + + +//Render debug symbols +procedure TKMAIFields.Paint(const aRect: TKMRect); +begin + if FEAT_AI_GENERATE_INFLUENCE then + fInfluences.Paint(aRect); + + if FEAT_AI_GENERATE_NAVMESH then + fNavMesh.Paint(aRect); + + if fCanHaveAAI then + begin + fEye.Paint(aRect); + fSupervisor.Paint(aRect); + end; +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIGeneral.pas b/vendor/kam_remake/src/ai/KM_AIGeneral.pas new file mode 100644 index 0000000..fd1e2a3 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIGeneral.pas @@ -0,0 +1,813 @@ +unit KM_AIGeneral; +{$I KaM_Remake.inc} +interface +uses + Generics.Collections, + KM_AISetup, KM_AIAttacks, KM_AIDefensePos, + KM_Units, KM_UnitGroup, KM_UnitWarrior, + KM_CommonClasses, KM_Defaults, KM_Points, + KM_NavMeshDefences, + KM_AITypes; + + +type + TKMGeneral = class + private + fLastEquippedTimeIron, fLastEquippedTimeLeather: Cardinal; + fUnitsEquipOrdered: TDictionary; //Units for which AIGeneral ordered to equip, but who did not exits the barracks yet + + fOwner: TKMHandID; + fSetup: TKMHandAISetup; + fAttacks: TKMAIAttacks; + fDefencePositions: TAIDefencePositions; + + procedure CheckArmy; + procedure CheckArmyCount; + procedure CheckAttacks; + procedure CheckAutoAttack; + procedure CheckAutoDefend; + procedure OrderAttack(aGroup: TKMUnitGroup; aTarget: TKMAIAttackTarget; const aCustomPos: TKMPoint); + + procedure RemoveEquipOrderedWarrior(aWarrior: TKMUnitWarrior); + public + constructor Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); + destructor Destroy; override; + + procedure AfterMissionInit; + procedure OwnerUpdate(aPlayer: TKMHandID); + property Attacks: TKMAIAttacks read fAttacks; + property DefencePositions: TAIDefencePositions read fDefencePositions; + procedure RetaliateAgainstThreat(aAttacker: TKMUnit); + procedure WarriorEquipped(aWarrior: TKMUnitWarrior); + procedure WarriorDied(aWarrior: TKMUnitWarrior); + + procedure UpdateState(aTick: Cardinal); + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad; + end; + + +implementation +uses + Classes, Math, + KM_Entity, + KM_Game, KM_GameParams, + KM_Hand, KM_HandsCollection, KM_HandTypes, KM_HandEntity, + KM_Terrain, KM_AIFields, + KM_Houses, KM_HouseBarracks, + KM_ResHouses, KM_CommonUtils, KM_DevPerfLog, KM_DevPerfLogTypes, + KM_UnitGroupTypes, + KM_ResTypes + {$IFDEF FPC} + , KM_Sort + {$ENDIF} + ; + + +const + //For compatibility with KaM these must be False. We can add a !REMAKE_AI command later + //to make them more "intelligent", but for now these are required for the campaigns to be playable. + + //On the other hand, no need to reproduce KaM's flaws, so fill closest defence + //positions for idle groups to avoid swapping on mission start. This shouldn't + //cause incorrect behaviour in campaigns since either way the priority order + //of positions will be respected. + + AI_FILL_CLOSEST_IDLE = True; + AI_FILL_CLOSEST_EQUIPPED = False; + AI_LINK_IDLE = False; + + +{ TKMGeneral } +constructor TKMGeneral.Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); +begin + inherited Create; + + fOwner := aPlayer; + fSetup := aSetup; + + fAttacks := TKMAIAttacks.Create; + fDefencePositions := TAIDefencePositions.Create(aPlayer); + + fUnitsEquipOrdered := TDictionary.Create; +end; + + +destructor TKMGeneral.Destroy; +var + U, U2: TKMUnit; +begin + for U in fUnitsEquipOrdered.Values do + begin + U2 := U; + gHands.CleanUpUnitPointer(U2); + end; + + fUnitsEquipOrdered.Free; + fDefencePositions.Free; + fAttacks.Free; + + inherited; +end; + + +procedure TKMGeneral.AfterMissionInit; +begin + +end; + + +procedure TKMGeneral.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + +function CompareKeys(const aKey1, aKey2): Integer; +var + k1: Integer absolute aKey1; + k2: Integer absolute aKey2; +begin + if k1 < k2 then Result := -1 + else if k1 > k2 then Result := +1 + else Result := 0; +end; + +procedure TKMGeneral.Save(SaveStream: TKMemoryStream); +var + uid: Integer; + keyArray: TArray; +begin + SaveStream.PlaceMarker('AIGeneral'); + SaveStream.Write(fOwner); + SaveStream.Write(fLastEquippedTimeIron); + SaveStream.Write(fLastEquippedTimeLeather); + fAttacks.Save(SaveStream); + fDefencePositions.Save(SaveStream); + + SaveStream.PlaceMarker('AIGeneral_unitsEquipOrdered'); + SaveStream.Write(fUnitsEquipOrdered.Count); + keyArray := fUnitsEquipOrdered.Keys.ToArray; + {$IFNDEF FPC} + TArray.Sort(keyArray); + {$ELSE} + SortCustom(keyArray, Low(keyArray), High(keyArray), SizeOf(keyArray[0]), CompareKeys); + {$ENDIF} + + for uid in keyArray do + SaveStream.Write(uid); +end; + + +procedure TKMGeneral.Load(LoadStream: TKMemoryStream); +var + I, count, uid: Integer; +begin + LoadStream.CheckMarker('AIGeneral'); + LoadStream.Read(fOwner); + LoadStream.Read(fLastEquippedTimeIron); + LoadStream.Read(fLastEquippedTimeLeather); + fAttacks.Load(LoadStream); + fDefencePositions.Load(LoadStream); + + LoadStream.CheckMarker('AIGeneral_unitsEquipOrdered'); + fUnitsEquipOrdered.Clear; + LoadStream.Read(count); + for I := 0 to Count - 1 do + begin + LoadStream.Read(uid); + fUnitsEquipOrdered.Add(uid, nil); + end; +end; + + +procedure TKMGeneral.SyncLoad; +var + uid: Integer; +begin + fDefencePositions.SyncLoad; + + for uid in fUnitsEquipOrdered.Keys do + fUnitsEquipOrdered[uid] := TKMUnitWarrior(gHands.GetUnitByUID(Integer(uid))); +end; + + +procedure TKMGeneral.CheckArmyCount; + + function CanEquipIron: Boolean; + begin + Result := not (fSetup.ArmyType = atLeather) + AND (fSetup.UnlimitedEquip or gGame.CheckTime(fLastEquippedTimeIron + fSetup.EquipRateIron)); + end; + + function CanEquipLeather: Boolean; + begin + Result := not (fSetup.ArmyType = atIron) + AND (fSetup.UnlimitedEquip or gGame.CheckTime(fLastEquippedTimeLeather + fSetup.EquipRateLeather)); + end; + +var + Barracks: array of TKMHouseBarracks; + HB: TKMHouseBarracks; + GT: TKMGroupType; + I,K: Integer; + UT: TKMUnitType; + GroupReq: TKMGroupTypeArray; + warrior: TKMUnitWarrior; +begin + if gGame.IsPeaceTime then Exit; //Do not train soldiers during peacetime + + //Don't train if we have reached our limit + if (fSetup.MaxSoldiers <> -1) and (gHands[fOwner].Stats.GetArmyCount >= fSetup.MaxSoldiers) then + Exit; + + if not CanEquipIron and not CanEquipLeather then Exit; + + //Create a list of troops that need to be trained based on defence position requirements + FillChar(GroupReq, SizeOf(GroupReq), #0); //Clear up + for I := 0 to fDefencePositions.Count - 1 do + with fDefencePositions[I] do + if CurrentGroup = nil then + Inc(GroupReq[GroupType], fDefencePositions.TroopFormations[GroupType].NumUnits) + else + Inc(GroupReq[GroupType], Max(fDefencePositions.TroopFormations[GroupType].NumUnits - CurrentGroup.Count, 0)); + + //If we don't need anyone - Exit + I := 0; + for GT := Low(GroupReq) to High(GroupReq) do + Inc(I, GroupReq[GT]); + if I = 0 then Exit; + + //Find barracks + SetLength(Barracks, gHands[fOwner].Stats.GetHouseQty(htBarracks)); + I := 0; + HB := TKMHouseBarracks(gHands[fOwner].FindHouse(htBarracks, I+1)); + while HB <> nil do + begin + Barracks[I] := HB; + Inc(I); + HB := TKMHouseBarracks(gHands[fOwner].FindHouse(htBarracks, I+1)); + end; + + // Decrease group requirements on number of soldiers that are not walked out of barracks yet + for warrior in fUnitsEquipOrdered.Values do + if not warrior.IsDeadOrDying then + // Group req could change while warrior was walking out of barracks, so we could get negative value here + GroupReq[UNIT_TO_GROUP_TYPE[warrior.UnitType]] := Max(0, GroupReq[UNIT_TO_GROUP_TYPE[warrior.UnitType]] - 1); + + //Train troops where possible in each barracks + for I := 0 to High(Barracks) do + begin + HB := Barracks[I]; + + //Chose a random group type that we are going to attempt to train (so we don't always train certain group types first) + K := 0; + repeat + GT := TKMGroupType(GROUP_TYPE_MIN_OFF + KaMRandom(4{$IFDEF DBG_RNG_SPY}, 'TKMGeneral.CheckArmyCount'{$ENDIF})); //Pick random from overall count + Inc(K); + until (GroupReq[GT] > 0) or (K > 9); //Limit number of attempts to guarantee it doesn't loop forever + + if GroupReq[GT] = 0 then + Break; // Don't train + + for K := Low(AI_TROOP_TRAIN_ORDER[GT]) to High(AI_TROOP_TRAIN_ORDER[GT]) do + begin + UT := AI_TROOP_TRAIN_ORDER[GT, K]; + + if (UT <> utNone) then + while ((CanEquipIron and (UT in WARRIORS_IRON)) or (CanEquipLeather and not (UT in WARRIORS_IRON))) + and (GroupReq[GT] > 0) + and ((fSetup.MaxSoldiers = -1) or (gHands[fOwner].Stats.GetArmyCount < fSetup.MaxSoldiers)) do + begin + warrior := TKMUnitWarrior(HB.EquipWarrior(UT)); + if warrior = nil then //We cant make unit of this type + Break; //Continue with next UnitType + + //Save unit we just equipped in the list of units, that has to be equipped + //Problem is that we could make several orders before all equipped units will exit the barracks + //and register in the defence position groups + //So we will order more units in that case, who will eventually exit the barracks and chill around, + //because all defence groups are filled already + fUnitsEquipOrdered.Add(warrior.UID, TKMUnitWarrior(warrior.GetPointer)); + + Dec(GroupReq[GT]); + //Only reset it when we actually trained something (in IronThenLeather mode we don't count them separately) + if (UT in WARRIORS_IRON) or (fSetup.ArmyType = atIronThenLeather) then + fLastEquippedTimeIron := gGameParams.Tick; + if not (UT in WARRIORS_IRON) or (fSetup.ArmyType = atIronThenLeather) then + fLastEquippedTimeLeather := gGameParams.Tick; + end; + end; + end; +end; + + +//Check army food level and positioning +procedure TKMGeneral.CheckArmy; +var + I: Integer; + GroupType: TKMGroupType; + Group: TKMUnitGroup; + NeedsLinkingTo: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of TKMUnitGroup; +begin + for GroupType := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + NeedsLinkingTo[GroupType] := nil; + + //Check: Hunger, (feed) formation, (units per row) position (from defence positions) + for I := 0 to gHands[fOwner].UnitGroups.Count - 1 do + begin + Group := gHands[fOwner].UnitGroups[I]; + + if not Group.IsDead + and not Group.InFight(True) + and (Group.Condition < UNIT_MIN_CONDITION) then + //Check hunger and order food + //Cheat for autobuild AI: Only feed hungry group members (food consumption lower and more predictable) + //Do not clear offenders here, since we could follow attacker + Group.OrderFood(False, fSetup.AutoBuild); + + if not Group.IsDead + and Group.IsIdleToAI([wtokFlagPoint, wtokHaltOrder]) + and not gGame.IsPeaceTime then //Do not process attack or defence during peacetime + begin + //We already have a position, finished with this group + if fDefencePositions.FindPositionOf(Group) <> nil then Continue; + + //Look for a new position to defend + //In this case we choose the closest group, then move to a higher priority one later (see above) + //This means at the start of the mission troops will take the position they are placed at rather than swapping around + //With auto defence we reset defence positions regularly, so take closest rather than reshuffling all the time (newly equipped warriors still take highest priority) + if fDefencePositions.FindPlaceForGroup(Group, AI_FILL_CLOSEST_IDLE or fSetup.AutoDefend) then Continue; + + //Just chill and link with other idle groups + if AI_LINK_IDLE then + begin + GroupType := Group.GroupType; //Remember it because Group might get emptied + if NeedsLinkingTo[GroupType] = nil then + begin + //If this group doesn't have enough members + if (Group.Count < fDefencePositions.TroopFormations[GroupType].NumUnits) then + NeedsLinkingTo[GroupType] := Group //Flag us as needing to be added to + end + else + begin + //Look for group that needs additional members + fDefencePositions.RestockPositionWith(NeedsLinkingTo[GroupType], Group); + if NeedsLinkingTo[GroupType].Count >= fDefencePositions.TroopFormations[GroupType].NumUnits then + NeedsLinkingTo[GroupType] := nil; //Group is now full + end; + end; + end; + end; +end; + + +procedure TKMGeneral.CheckAttacks; +var + MenAvailable: TKMGroupTypeArray; //Total number of warriors available to attack the enemy + GroupsAvailable: TKMGroupTypeArray; + MaxGroupsAvailable: Integer; + AttackGroups: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of array of TKMUnitGroup; + + procedure AddAvailable(aGroup: TKMUnitGroup); + var + GT: TKMGroupType; + begin + GT := UNIT_TO_GROUP_TYPE[aGroup.UnitType]; + if Length(AttackGroups[GT]) <= GroupsAvailable[GT] then + SetLength(AttackGroups[GT], GroupsAvailable[GT] + 10); + AttackGroups[GT, GroupsAvailable[GT]] := aGroup; + Inc(GroupsAvailable[GT]); + MaxGroupsAvailable := Max(MaxGroupsAvailable, GroupsAvailable[GT]); + Inc(MenAvailable[GT], aGroup.Count); + end; + +var + I, K, J: Integer; + G: TKMGroupType; + Group: TKMUnitGroup; + DP: TAIDefencePosition; + UnitsSent: Integer; + AttackLaunched: Boolean; + Looped: Integer; +begin + //Do not process attack or defence during peacetime + if gGame.IsPeaceTime then Exit; + + Looped := 0; + repeat + AttackLaunched := False; + MaxGroupsAvailable := 0; + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + GroupsAvailable[G] := 0; + MenAvailable[G] := 0; + end; + + //Order of units is prioritized: + //1. Take all idling Groups that are not linked to any Defence positions + for I := 0 to gHands[fOwner].UnitGroups.Count - 1 do + begin + Group := gHands[fOwner].UnitGroups[I]; + if not Group.IsDead + and Group.IsIdleToAI([wtokFlagPoint, wtokHaltOrder]) then + begin + DP := fDefencePositions.FindPositionOf(Group); + if DP = nil then + AddAvailable(Group); + end; + end; + //2. Take back line defence positions, lowest priority first + for I := fDefencePositions.Count-1 downto 0 do + if (fDefencePositions[I].DefenceType = dtBackLine) + and (fDefencePositions[I].CurrentGroup <> nil) + and not fDefencePositions[I].CurrentGroup.IsDead + and fDefencePositions[I].CurrentGroup.IsIdleToAI([wtokFlagPoint, wtokHaltOrder, wtokAIGotoDefencePos]) then + AddAvailable(fDefencePositions[I].CurrentGroup); + + //Now process AI attacks (we have compiled a list of warriors available to attack) + for I := 0 to Attacks.Count - 1 do + if Attacks.CanOccur(I, MenAvailable, GroupsAvailable, gGameParams.Tick) then //Check conditions are right + begin + AttackLaunched := True; + //Order groups to attack + UnitsSent := 0; + if Attacks[I].RandomGroups then + begin + //Repeatedly send one of each group type until we have sent the required amount (mixed army) + for K := 0 to MaxGroupsAvailable - 1 do + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (UnitsSent < Attacks[I].TotalMen) and (K < GroupsAvailable[G]) then + begin + OrderAttack(AttackGroups[G, K], Attacks[I].Target, Attacks[I].CustomPosition); + Inc(UnitsSent, AttackGroups[G, K].Count); + end; + end + else + begin + //First send the number of each group as requested by the attack + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for K := 0 to Attacks[I].GroupAmounts[G] - 1 do + begin + OrderAttack(AttackGroups[G, K], Attacks[I].Target, Attacks[I].CustomPosition); + Inc(UnitsSent, AttackGroups[G, K].Count); + end; + + //If we still haven't sent enough men, send more groups out of the types allowed until we have + if UnitsSent < Attacks[I].TotalMen then + for K := 0 to MaxGroupsAvailable - 1 do + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + //Start index after the ones we've already sent above (ones required by attack) + J := K + Attacks[I].GroupAmounts[G]; + if (Attacks[I].GroupAmounts[G] > 0) and (UnitsSent < Attacks[I].TotalMen) + and (J < GroupsAvailable[G]) then + begin + OrderAttack(AttackGroups[G, J], Attacks[I].Target, Attacks[I].CustomPosition); + Inc(UnitsSent, AttackGroups[G, J].Count); + end; + end; + end; + Attacks.HasOccured(I); //We can't set the flag to property record directly + Break; //Only order 1 attack per update, since all the numbers of groups available need recalculating + end; + Inc(Looped); + //if there's no target available we could loop forever ordering the same attack, so limit it + until (not AttackLaunched) or (Looped > 10); +end; + + +procedure TKMGeneral.CheckAutoAttack; +var + SimpleAttack: TKMAIAttack; + H: TKMHouse; +begin + //Simple test for now + FillChar(SimpleAttack, SizeOf(SimpleAttack), #0); + + SimpleAttack.AttackType := aatRepeating; + SimpleAttack.Target := attClosestBuildingFromStartPos; + SimpleAttack.TotalMen := fDefencePositions.AverageUnitsPerGroup * + fDefencePositions.GetBacklineCount div 2; + SimpleAttack.RandomGroups := True; + + Attacks.Clear; + Attacks.AddAttack(SimpleAttack); + + //If start position isn't set, set it to first storehouse (used for targeting attacks) + if (fSetup.StartPosition.X <= 1) and (fSetup.StartPosition.Y <= 1) then + begin + H := gHands[fOwner].Houses.FindHouse(htStore, 0, 0, 1); + if H <> nil then + fSetup.StartPosition := H.Entrance; + end; + + //See how many soldiers we need to launch an attack + + //Check if we have enough troops we can take into attack (Backline formations) + + //Check if we can train more soldiers (ignoring EquipRate?) + + //Make decision about attack + + //Choose place to attack +end; + + +procedure TKMGeneral.CheckAutoDefend; + + //function EnsureWalkable(var Loc: TKMPoint): Boolean; + //var + // IX, IY, BestDistSqr: Integer; + // Best: TKMPoint; + //begin + // if gTerrain.CheckPassability(Loc, tpWalk) then + // begin + // Result := True; + // Exit; + // end; + // Result := False; + // BestDistSqr := High(Integer); + // for IY := Max(1, Loc.Y-2) to Min(gTerrain.MapY, Loc.Y+2) do + // for IX := Max(1, Loc.X-2) to Min(gTerrain.MapX, Loc.X+2) do + // if gTerrain.CheckPassability(KMPoint(IX, IY), tpWalk) + // and (KMLengthSqr(Loc, KMPoint(IX, IY)) < BestDistSqr) then + // begin + // BestDistSqr := KMLengthSqr(Loc, KMPoint(IX, IY)); + // Best := KMPoint(IX, IY); + // Result := True; + // end; + // if Result then + // Loc := Best; + //end; + +const + MIN_DEF_POS = 6; +var + DefPosArr: TKMDefencePosArr; + I: Integer; + BestOwner: TKMHandID; + Loc: TKMPoint; + GT: TKMGroupType; + DPT: TKMAIDefencePosType; + //Outline1, Outline2: TKMWeightSegments; + //Locs: TKMPointDirTagList; + //LocI: TKMPoint; + //FaceDir: TKMDirection; + //SegLength, Ratio: Single; + //DefCount: Byte; + //Weight: Cardinal; + //FirstLineCount,BacklineCount: Integer; +begin + //Get defence Outline with weights representing how important each segment is + if not gAIFields.NavMesh.Defences.FindDefensivePolygons(fOwner, DefPosArr) then + Exit; + + fDefencePositions.Clear; + for I := Low(DefPosArr) to High(DefPosArr) do + begin + BestOwner := gAIFields.Influences.GetBestOwner(DefPosArr[I].Polygon); + if (BestOwner = fOwner) OR (BestOwner = HAND_NONE) OR (fDefencePositions.Count + Length(DefPosArr) <= MIN_DEF_POS) then + begin + if (DefPosArr[I].Line = 0) then + DPT := dtFrontLine + else + DPT := dtBackLine; + Loc := DefPosArr[I].DirPoint.Loc; + case (Loc.X*2 + Loc.Y*2) mod 3 of + 0: GT := gtAntiHorse; + 1: GT := gtRanged; + else GT := gtMelee; + end; + fDefencePositions.Add(DefPosArr[I].DirPoint, GT, 25, DPT); + end; + end; + + //BacklineCount := 0; + //FirstLineCount := 0; + + //Locs := TKMPointDirTagList.Create; + //try + //Make list of defence positions + + //for I := 0 to High(Outline2) do + //begin + // FaceDir := KMGetDirection(KMPointF(Outline2[I].A), KMPerpendecular(Outline2[I].A, Outline2[I].B)); + // + // //Longer segments will get several DefencePositions + // SegLength := KMLength(Outline2[I].A, Outline2[I].B); + // DefCount := Max(Trunc(SegLength / 5), 1); //At least 1, otherwise we might leave a bridge undefended + // + // for K := 0 to DefCount - 1 do + // begin + // Ratio := (K + 1) / (DefCount + 1); + // Loc := KMPointRound(KMLerp(Outline2[I].A, Outline2[I].B, Ratio)); + // Weight := Round(Outline2[I].Weight * 100); + // //Make sure each segment gets 1 defence position before filling others (in the middle of the segment line) + // if K = ((DefCount - 1) div 2) then + // Weight := Weight + 10000; + // + // Locs.Add(KMPointDir(Loc, FaceDir), Weight); + // end; + //end; + + //Sort according to positions weight + //Locs.SortByTag; + + //Add defence positions + //for I := Locs.Count - 1 downto 0 do + //begin + // LocI := KMGetPointInDir(Locs.Items[I].Loc, Locs.Items[I].Dir, 1); + // Loc := gTerrain.EnsureTileInMapCoords(LocI.X, LocI.Y, 3); + // if not EnsureWalkable(Loc) then + // Continue; + // + // //Mix group types deterministicly based on Loc, so they don't change for a given position + // case (Loc.X*2 + Loc.Y*2) mod 3 of + // 0: GT := gtAntiHorse; + // else GT := gtMelee; + // end; + // //Low weight positions are set to backline (when one segment has more than one position) + // if Locs.Tag[I] < 10000 then + // DPT := adtBackLine + // else + // DPT := adtFrontLine; + // + // fDefencePositions.Add(KMPointDir(Loc, Locs[I].Dir), GT, 25, DPT); + // if DPT = adtBackLine then Inc(BacklineCount); + // + // LocI := KMGetPointInDir(Locs[I].Loc, KMAddDirection(Locs[I].Dir, 4), 4); + // Loc := gTerrain.EnsureTileInMapCoords(LocI.X, LocI.Y, 3); + // if not EnsureWalkable(Loc) then + // Continue; + // + // fDefencePositions.Add(KMPointDir(Loc, Locs[I].Dir), gtRanged, 25, DPT); + // if DPT = adtBackLine then Inc(BacklineCount); + //end; + + //Add extra backline defence positions after adding all the front line ones so they are lower priority + //for I := Locs.Count - 1 downto 0 do + //if BacklineCount < 12 then + //begin + // //Try to add backline defence positions behind front line, if there's space + // Loc := KMGetPointInDir(Locs[I].Loc, KMAddDirection(Locs[I].Dir, 4), 7); + // if gTerrain.TileInMapCoords(Loc.X, Loc.Y, 3) then + // begin + // if not EnsureWalkable(Loc) then + // Continue; + // + // //Mix group types deterministicly based on Loc, so they don't change for a given position + // case (Loc.X*2 + Loc.Y*2) mod 3 of + // 0: GT := gtAntiHorse; + // 1: GT := gtRanged; + // else GT := gtMelee; + // end; + // fDefencePositions.Add(KMPointDir(Loc, Locs[I].Dir), GT, 35, adtBackLine); + // Inc(BacklineCount); + // end; + //end; + //finally + // Locs.Free; + //end; + + //Compare existing defence positions with the sample + //Get the ratio between sample and existing troops + //Check all segments to have proportional troops count + //Add or remove defence positions +end; + + +//See if we can attack our enemies +procedure TKMGeneral.OrderAttack(aGroup: TKMUnitGroup; aTarget: TKMAIAttackTarget; const aCustomPos: TKMPoint); +const + TARGET_HOUSES: TKMHouseTypeSet = HOUSES_VALID; +var + TargetHouse: TKMHouse; + TargetUnit: TKMUnit; +begin + TargetHouse := nil; + TargetUnit := nil; + + //Find target + case aTarget of + attClosestUnit: TargetUnit := gHands.GetClosestUnit(aGroup.Position, fOwner, atEnemy); + attClosestBuildingFromArmy: TargetHouse := gHands.GetClosestHouse(aGroup.Position, fOwner, atEnemy, TARGET_HOUSES, False); + attClosestBuildingFromStartPos: TargetHouse := gHands.GetClosestHouse(fSetup.StartPosition, fOwner, atEnemy, TARGET_HOUSES, False); + attCustomPosition: begin + TargetHouse := gHands.HousesHitTest(aCustomPos.X, aCustomPos.Y); + if (TargetHouse <> nil) and + (gHands.CheckAlliance(fOwner, TargetHouse.Owner) = atAlly) then + TargetHouse := nil; + + TargetUnit := gTerrain.UnitsHitTest(aCustomPos.X, aCustomPos.Y); + if (TargetUnit <> nil) + and ((gHands.CheckAlliance(fOwner, TargetUnit.Owner) = atAlly) + or TargetUnit.IsDeadOrDying) then + TargetUnit := nil; + end; + end; + + //Choose best option + if TargetHouse <> nil then + aGroup.OrderAttackHouse(TargetHouse, True) + else if TargetUnit <> nil then + aGroup.OrderAttackUnit(TargetUnit, True) + else if aTarget = attCustomPosition then + aGroup.OrderWalk(aCustomPos, True, wtokAIAttackCustomPos); +end; + + +procedure TKMGeneral.RetaliateAgainstThreat(aAttacker: TKMUnit); +var + I: Integer; + Group: TKMUnitGroup; +begin + if gHands[fOwner].IsHuman then Exit; + + //Attacker may be already dying (e.g. killed by script) + //We could retaliate against his whole group however + if (aAttacker = nil) or aAttacker.IsDeadOrDying or (aAttacker is TKMUnitRecruit) then Exit; + + //todo -cComplicated: Right now "idle" troops (without an assigned defence position) will do nothing (no attacking, defending, etc.) + //Any defence position that is within their defence radius of this threat will retaliate against it + for I := 0 to fDefencePositions.Count - 1 do + begin + Group := fDefencePositions[I].CurrentGroup; + if (Group <> nil) + and not Group.IsDead + and Group.IsIdleToAI([wtokFlagPoint, wtokHaltOrder, wtokAIGotoDefencePos]) + //Units walking to their defence position can retaliate (but not if pursuing an enemy) + //@Lewin: Is it right that Group defends against attackers within the Rad + //rather than defending property within the Rad? + //Think of archer, he attacks property in AI defense radius, but stands utself outside of the radius + //should AI retaliate against him or not? + //@Krom: Yes it's right the way it is now. It should be the attacker not the victim. + //Otherwise the AI sends much more groups when you shoot them with 1 bowmen in the campaigns. + //Right now it seems to be working almost the same as in the original game. + and (KMLengthDiag(Group.Position, aAttacker.Position) <= fDefencePositions[I].Radius) then + Group.OrderAttackUnit(aAttacker, True); + end; +end; + + +procedure TKMGeneral.RemoveEquipOrderedWarrior(aWarrior: TKMUnitWarrior); +begin + if fUnitsEquipOrdered.ContainsKey(aWarrior.UID) then + begin + fUnitsEquipOrdered[aWarrior.UID].ReleasePointer; + fUnitsEquipOrdered.Remove(aWarrior.UID); + end; +end; + + +//Trained warrior reports for duty +procedure TKMGeneral.WarriorEquipped(aWarrior: TKMUnitWarrior); +begin + RemoveEquipOrderedWarrior(aWarrior); + fDefencePositions.FindPlaceForGroup(TKMUnitGroup(aWarrior.Group), AI_FILL_CLOSEST_EQUIPPED); +end; + + +procedure TKMGeneral.WarriorDied(aWarrior: TKMUnitWarrior); +begin + RemoveEquipOrderedWarrior(aWarrior); +end; + + +procedure TKMGeneral.UpdateState(aTick: Cardinal); +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAIArmyCls); + {$ENDIF} + try + //Update defence positions locations + if fSetup.AutoDefend then + //Checking mod result against MAX_HANDS causes first update to happen ASAP + if (aTick + Byte(fOwner)) mod (MAX_HANDS * 50) = MAX_HANDS then + CheckAutoDefend; + + //See if we can launch an attack + if fSetup.AutoAttack then + if (aTick + Byte(fOwner)) mod (MAX_HANDS * 50) = 1 then + CheckAutoAttack; + + if (aTick + Byte(fOwner)) mod MAX_HANDS = 0 then + begin + fDefencePositions.UpdateState; + CheckArmy; //Feed army, position defence, arrange/organise groups + CheckAttacks; + CheckArmyCount; //Train new soldiers if needed + + //CheckEnemyPresence; //Check enemy threat in close range and issue defensive attacks (or flee?) + //CheckAndIssueAttack; //Attack enemy + //Anything Else? + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAIArmyCls); + {$ENDIF} + end; +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIGoals.pas b/vendor/kam_remake/src/ai/KM_AIGoals.pas new file mode 100644 index 0000000..c098492 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIGoals.pas @@ -0,0 +1,252 @@ +unit KM_AIGoals; +{$I KaM_Remake.inc} +interface +uses + KM_CommonClasses, KM_Defaults, KM_MapTypes; + + +type + TKMGoal = packed record + GoalType: TKMGoalType; //Victory, survive, neither + GoalCondition: TKMGoalCondition; //Buildings, troops, time passing + GoalStatus: TKMGoalStatus; //Must this condition be True or False (same as alive or dead) for victory/surival to occur? + GoalTime: Cardinal; //Only used with gaTime. Amount of time (in game ticks) that must pass before this goal is complete + MessageToShow: Integer; //Message to be shown when the goal is completed + MessageHasShown: Boolean; //Whether we have shown this message yet + HandIndex: TKMHandID; //Player whose buildings or troops must be destroyed + Disabled: Boolean; + end; + //Because the goal system is hard to understand, here are some examples: + {Destroy troops of player 2 in order to win + Script command: !ADD_GOAL 4 1 0 2 + GoalType=gltVictory + GoalCondition=gcTroops + GoalStatus=gsFalse //Troops must be dead, non-existant. i.e. the condition that player 2 has troops must be FALSE. + Player=play_2 + } + + {Save (protect) troops of player 1 or else you will lose the game + Script command: !ADD_LOST_GOAL 4 0 0 1 + GoalType=gltSurvive + GoalCondition=gcTroops + GoalStatus=gsTrue //Troops must be alive. i.e. the condition that player 1 has troops must be TRUE otherwise you lose. + Player=play_1 + } + + {Display message 500 after 10 minutes (no goal, just message) + Script command: !ADD_GOAL 2 0 500 600 + GoalType=gltNone + GoalCondition=gcTime + GoalStatus=gsTrue //Time must have passed + GoalTime=600 + MessageToShow=500 + } + + {Display message 510 upon buildings of player 4 being destroyed + Script command: !ADD_GOAL 3 1 510 4 (in this case the script command would also require the buildings to be destroyed for a victory condition, as mentioned bellow) + GoalType=gltNone //If this was set to victory or survive not only would the message be displayed, but it would also be a condition for winning/losing + GoalCondition=gcBuildings + GoalStatus=gsFalse //Buildings must be destroyed + MessageToShow=500 + } + + +type + TKMGoals = class + private + fCount: Integer; + fGoals: array of TKMGoal; + function GetGoal(aIndex: Integer): TKMGoal; + procedure SetGoal(aIndex: Integer; const Value: TKMGoal); + public + procedure Clear; + property Count: Integer read fCount; + property Item[aIndex: Integer]: TKMGoal read GetGoal write SetGoal; default; + procedure AddGoal(aType: TKMGoalType; aCondition: TKMGoalCondition; aStatus: TKMGoalStatus; aTime: Cardinal; + aMessageToShow: Integer; aHandIndex: TKMHandID); overload; // Deprecated + procedure AddGoal(aType: TKMGoalType; aCondition: TKMGoalCondition; aHandIndex: TKMHandID); overload; + procedure AddGoal(const aGoal: TKMGoal); overload; + procedure Delete(aIndex: Integer); + procedure RemoveReference(aHandIndex: TKMHandID); + procedure UpdateGoalsForHand(aHandIndex: TKMHandID; aEnable: Boolean); + procedure SetMessageHasShown(aIndex: Integer); + procedure AddDefaultGoals(aBuildings: Boolean; aOurPlayerIndex: TKMHandID; const aEnemyIndexes: array of TKMHandID); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + procedure ExportMessages(const aPath: UnicodeString); + end; + + +implementation +uses + Classes, SysUtils, Math; + + +{ TKMGoals } +function TKMGoals.GetGoal(aIndex: Integer): TKMGoal; +begin + Result := fGoals[aIndex]; +end; + + +procedure TKMGoals.SetGoal(aIndex: Integer; const Value: TKMGoal); +begin + fGoals[aIndex] := Value; +end; + + +procedure TKMGoals.AddGoal(aType: TKMGoalType; aCondition: TKMGoalCondition; aHandIndex: TKMHandID); +var + status: TKMGoalStatus; +begin + if aType = gltVictory then + status := gsFalse + else + status := gsTrue; + + AddGoal(aType, aCondition, status, 0, 0, aHandIndex); +end; + + +procedure TKMGoals.AddGoal(aType: TKMGoalType; aCondition: TKMGoalCondition; aStatus: TKMGoalStatus; aTime: Cardinal; + aMessageToShow: Integer; aHandIndex: TKMHandID); +begin + SetLength(fGoals, fCount + 1); + fGoals[fCount].GoalType := aType; + fGoals[fCount].GoalCondition := aCondition; + fGoals[fCount].GoalStatus := aStatus; + fGoals[fCount].GoalTime := aTime; + fGoals[fCount].MessageToShow := aMessageToShow; + fGoals[fCount].HandIndex := aHandIndex; + fGoals[fCount].MessageHasShown := False; + fGoals[fCount].Disabled := False; + Inc(fCount); +end; + + +procedure TKMGoals.AddGoal(const aGoal: TKMGoal); +begin + if fCount >= Length(fGoals) then + SetLength(fGoals, fCount + 16); + + fGoals[fCount] := aGoal; + Inc(fCount); +end; + + +procedure TKMGoals.Clear; +begin + if Self = nil then Exit; + + fCount := 0; + SetLength(fGoals, 0); +end; + + +procedure TKMGoals.Delete(aIndex: Integer); +begin + Assert(InRange(aIndex, 0, Count - 1)); + + if (aIndex <> Count - 1) then + Move(fGoals[aIndex + 1], fGoals[aIndex], (fCount - 1 - aIndex) * SizeOf(TKMGoal)); + + Dec(fCount); +end; + + +procedure TKMGoals.UpdateGoalsForHand(aHandIndex: TKMHandID; aEnable: Boolean); +var + I: Integer; +begin + for I := 0 to fCount - 1 do + if fGoals[I].HandIndex = aHandIndex then + fGoals[I].Disabled := not aEnable; +end; + + +// We don't want anyones goal to use deleted player +// Used when we delete certain player from MapEd +procedure TKMGoals.RemoveReference(aHandIndex: TKMHandID); +var + I: Integer; +begin + for I := fCount - 1 downto 0 do + if fGoals[I].HandIndex > aHandIndex then + fGoals[I].HandIndex := pred(fGoals[I].HandIndex) + else if fGoals[I].HandIndex = aHandIndex then + Delete(I); +end; + + +procedure TKMGoals.SetMessageHasShown(aIndex: Integer); +begin + fGoals[aIndex].MessageHasShown := True; +end; + + +procedure TKMGoals.AddDefaultGoals(aBuildings: Boolean; aOurPlayerIndex: TKMHandID; const aEnemyIndexes: array of TKMHandID); +var + I: Integer; + gc: TKMGoalCondition; +begin + if aBuildings then + gc := gcBuildings + else + gc := gcTroops; + + // Default Defeat condition is to lose army/town + AddGoal(gltSurvive, gc, aOurPlayerIndex); + + // Default Victory conditions is to kill armies / destroy towns of all other players + for I := 0 to Length(aEnemyIndexes) - 1 do + AddGoal(gltVictory, gc, aEnemyIndexes[I]); +end; + + +procedure TKMGoals.Save(SaveStream: TKMemoryStream); +var + I: Integer; +begin + SaveStream.PlaceMarker('Goals'); + SaveStream.Write(fCount); + for I := 0 to fCount - 1 do + SaveStream.Write(fGoals[I], SizeOf(fGoals[I])); +end; + + +procedure TKMGoals.Load(LoadStream: TKMemoryStream); +var + I: Integer; +begin + LoadStream.CheckMarker('Goals'); + LoadStream.Read(fCount); + SetLength(fGoals, fCount); + for I := 0 to fCount - 1 do + LoadStream.Read(fGoals[I], SizeOf(fGoals[I])); +end; + + +//In-house method to convert KaM 'show_message' goals into EVT scripts +procedure TKMGoals.ExportMessages(const aPath: UnicodeString); +var + I: Integer; + SL: TStringList; +begin + SL := TStringList.Create; + + for I := 0 to fCount - 1 do + if Item[I].MessageToShow > 0 then + SL.Add('TIME -1 ' + + IntToStr(Item[I].GoalTime) + + ' SHOW_MESSAGE 0 ' + + IntToStr(Item[I].MessageToShow)); //-529 for TSK, -549 for TPR + + if SL.Count > 0 then + SL.SaveToFile(aPath); + SL.Free; +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIInfluences.pas b/vendor/kam_remake/src/ai/KM_AIInfluences.pas new file mode 100644 index 0000000..85f3f7d --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIInfluences.pas @@ -0,0 +1,860 @@ +unit KM_AIInfluences; +{$I KaM_Remake.inc} +interface +uses + Math, + KM_CommonClasses, KM_CommonTypes, KM_Defaults, KM_Points, + KM_Units, KM_UnitGroup, + KM_NavMesh, KM_NavMeshGenerator, KM_NavMeshInfluences, + KM_NavMeshFloodFill; + + +const + // Avoid bulding values of specific actions (tile lock by specific action) + AVOID_BUILDING_UNLOCK = 0; + AVOID_BUILDING_HOUSE_OUTSIDE_LOCK = 10; + AVOID_BUILDING_HOUSE_INSIDE_LOCK = 15; + AVOID_BUILDING_HOUSE_ENTRANCE = 20; + AVOID_BUILDING_COAL_TILE = 25; + AVOID_BUILDING_NODE_LOCK_FIELD = 30; + AVOID_BUILDING_NODE_LOCK_ROAD = 35; + AVOID_BUILDING_MINE_TILE = 40; + AVOID_BUILDING_FOREST_RANGE = 200; // Value: 255 <-> AVOID_BUILDING_FOREST_VARIANCE which may forest tiles have + AVOID_BUILDING_FOREST_MINIMUM = 254 - AVOID_BUILDING_FOREST_RANGE; // Minimum value of forest reservation tiles + + +type + // Collection of influence maps + TKMInfluences = class + private + fMapX, fMapY, fPolyCnt: Word; // Limits of arrays + + fAlli2PL: TKMHandID2Array; + + fAvoidBuilding: TKMByteArray; //Common map of areas where building is undesired (around Store, Mines, Woodcutters) + fUpdateCityIdx, fUpdateArmyIdx: TKMHandID; // Update index + fPresence: TKMWordArray; // Military presence + fOwnership: TKMByteArray; // City mark the space around itself + + fInfluenceFloodFill: TKMInfluenceFloodFill; + fInfluenceSearch: TNavMeshInfluenceSearch; + fNavMesh: TKMNavMesh; + + {$IFDEF DEBUG_AIInfluences} + fTimeAvrgOwnership, fTimeAvrgPresence: Int64; + fTimePeakOwnership, fTimePeakPresence: Int64; + {$ENDIF} + + // Avoid building + procedure InitAvoidBuilding(); + function GetAvoidBuilding(const aY,aX: Word): Byte; + procedure SetAvoidBuilding(const aY,aX: Word; const aValue: Byte); + // Army presence + function GetPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType): Word; + procedure SetPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType; const aPresence: Word); inline; + procedure SetIncPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType; const aPresence: Word); inline; + procedure UpdateMilitaryPresence(aAllianceIdx: Integer); + procedure SetLengthOfPresence(); + // City influence + function GetOwnership(const aPL: TKMHandID; const aIdx: Word): Byte; inline; + procedure SetOwnership(const aPL: TKMHandID; const aIdx: Word; const aOwnership: Byte); inline; + function GetOwnershipFromCoords(const aPL: TKMHandID; const aY, aX: Word): Byte; inline; // For property -> aY, aX are switched! + procedure SetOwnershipFromCoords(const aPL: TKMHandID; const aY, aX: Word; const aOwnership: Byte); inline; // For property -> aY, aX are switched! + function GetOwnershipFromPoint(const aPL: TKMHandID; const aPoint: TKMPoint): Byte; inline; + procedure SetOwnershipFromPoint(const aPL: TKMHandID; const aPoint: TKMPoint; const aOwnership: Byte); inline; + procedure UpdateOwnership(const aPL: TKMHandID); + public + constructor Create(aNavMesh: TKMNavMesh); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + // Avoid building + property AvoidBuilding[const aY,aX: Word]: Byte read GetAvoidBuilding write SetAvoidBuilding; + // Army presence + property Presence[const aAlliance, aIdx: Word; const aGT: TKMGroupType]: Word read GetPresence write SetPresence; + property IncPresence[const aAlliance, aIdx: Word; const aGT: TKMGroupType]: Word write SetIncPresence; + // City influence + property Ownership[const aPL: TKMHandID; const aY,aX: Word]: Byte read GetOwnershipFromCoords write SetOwnershipFromCoords; // To secure compatibility with old AI + property OwnPoint[const aPL: TKMHandID; const aPoint: TKMPoint]: Byte read GetOwnershipFromPoint write SetOwnershipFromPoint; + property OwnPoly[const aPL: TKMHandID; const aIdx: Word]: Byte read GetOwnership write SetOwnership; + // Common + property InfluenceSearch: TNavMeshInfluenceSearch read fInfluenceSearch write fInfluenceSearch; + + // Avoid building + procedure AddAvoidBuilding(aX,aY: Word; aRad: Single); + procedure RemAvoidBuilding(aArea: TKMRect); + procedure MarkForest(aPoint: TKMPoint; aRad, aDecreaseCoef: Single; aOnlyUnmarkedArea: Boolean = False); + // Army presence + function GetAllianceIdx(const aPL: TKMHandID; var aIdx: Integer): Boolean; + function GetArmyTraffic(const aAlliance, aIdx: Word): Word; + // City influence + function GetBestOwner(const aX,aY: Word): TKMHandID; overload; + function GetBestOwner(const aIdx: Word): TKMHandID; overload; + function GetBestAllianceOwner(const aPL: TKMHandID; const aPoint: TKMPoint; const aAllianceType: TKMAllianceType): TKMHandID; + //function GetAllAllianceOwnership(const aPL: TKMHandIndex; const aX,aY: Word; const aAllianceType: TKMAllianceType): TKMHandIndexArray; + function GetBestAllianceOwnership(const aPL: TKMHandID; const aX,aY: Word; const aAllianceType: TKMAllianceType): Byte; overload; + function GetBestAllianceOwnership(const aPL: TKMHandID; const aIdx: Word; const aAllianceType: TKMAllianceType): Byte; overload; + function GetOtherOwnerships(const aPL: TKMHandID; const aX, aY: Word): Word; overload; + function GetOtherOwnerships(const aPL: TKMHandID; const aIdx: Word): Word; overload; + function CanPlaceHouseByInfluence(const aPL: TKMHandID; const aX,aY: Word; const aIgnoreAllies: Boolean = False): Boolean; overload; + function CanPlaceHouseByInfluence(const aPL: TKMHandID; const aIdx: Word; const aIgnoreAllies: Boolean = False): Boolean; overload; + // Common + procedure InitInfluences(); + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure UpdateAlliances(const aAlli2PL: TKMHandID2Array); + procedure Paint(const aRect: TKMRect); + end; + +const + AVOID_TRAFFIC_IDX = 4; // Index of avoid traffic in the fOwnership array (0-3 are group types) + +implementation +uses + SysUtils, Classes, + KM_RenderAux, + {$IFDEF DEBUG_AIInfluences} + KM_CommonUtils, + {$ENDIF} + KM_Terrain, KM_Houses, KM_HouseCollection, + KM_Hand, KM_HandsCollection, KM_HandTypes, + KM_ResTypes; + +const + PRESENCE_X = (GROUP_TYPES_CNT + 1); // number of group types (4) and 1 for traffic + + +{ TKMInfluenceMaps } +constructor TKMInfluences.Create(aNavMesh: TKMNavMesh); +begin + inherited Create(); + + fNavMesh := aNavMesh; + fPolyCnt := 0; + fUpdateCityIdx := 0; + fUpdateArmyIdx := 0; + fInfluenceFloodFill := TKMInfluenceFloodFill.Create(False); // Check if True is better + fInfluenceSearch := TNavMeshInfluenceSearch.Create(False); + {$IFDEF DEBUG_AIInfluences} + fTimeAvrgOwnership := 0; + fTimeAvrgPresence := 0; + fTimePeakOwnership := 0; + fTimePeakPresence := 0; + {$ENDIF} +end; + + +destructor TKMInfluences.Destroy(); +begin + fInfluenceFloodFill.Free; + fInfluenceSearch.Free; + inherited; +end; + + +procedure TKMInfluences.Save(SaveStream: TKMemoryStream); +var + K, Len: Integer; +begin + + SaveStream.PlaceMarker('Influences'); + SaveStream.Write(fMapX); + SaveStream.Write(fMapY); + SaveStream.Write(fPolyCnt); + SaveStream.Write(fUpdateCityIdx,SizeOf(fUpdateCityIdx)); + SaveStream.Write(fUpdateArmyIdx,SizeOf(fUpdateArmyIdx)); + + SaveStream.PlaceMarker('Alliances'); + SaveStream.Write( Integer(Length(fAlli2PL)) ); + for K := Low(fAlli2PL) to High(fAlli2PL) do + begin + SaveStream.Write( Integer(Length(fAlli2PL[K])) ); + SaveStream.Write(fAlli2PL[K,0], SizeOf(fAlli2PL[K,0])*Length(fAlli2PL[K])); + end; + + SaveStream.PlaceMarker('AvoidBuilding'); + SaveStream.Write(fAvoidBuilding[0], SizeOf(fAvoidBuilding[0]) * Length(fAvoidBuilding)); + + SaveStream.PlaceMarker('Ownership'); + Len := Length(fOwnership); + SaveStream.Write(Len); + if Len > 0 then + SaveStream.Write(fOwnership[0], SizeOf(fOwnership[0]) * Len); + + SaveStream.PlaceMarker('ArmyPresence'); + Len := Length(fPresence); + SaveStream.Write(Len); + if Len > 0 then + SaveStream.Write(fPresence[0], SizeOf(fPresence[0]) * Len); +end; + + +procedure TKMInfluences.Load(LoadStream: TKMemoryStream); +var + K, Len: Integer; +begin + LoadStream.CheckMarker('Influences'); + LoadStream.Read(fMapX); + LoadStream.Read(fMapY); + LoadStream.Read(fPolyCnt); + LoadStream.Read(fUpdateCityIdx,SizeOf(fUpdateCityIdx)); + LoadStream.Read(fUpdateArmyIdx,SizeOf(fUpdateArmyIdx)); + + LoadStream.CheckMarker('Alliances'); + LoadStream.Read(Len); + SetLength(fAlli2PL, Len); + for K := Low(fAlli2PL) to High(fAlli2PL) do + begin + LoadStream.Read(Len); + SetLength(fAlli2PL[K],Len); + LoadStream.Read(fAlli2PL[K,0], SizeOf(fAlli2PL[K,0])*Length(fAlli2PL[K])); + end; + + LoadStream.CheckMarker('AvoidBuilding'); + SetLength(fAvoidBuilding, fMapY * fMapX); + LoadStream.Read(fAvoidBuilding[0], SizeOf(fAvoidBuilding[0]) * fMapY * fMapX); + + LoadStream.CheckMarker('Ownership'); + LoadStream.Read(Len); + SetLength(fOwnership, Len); + if Len > 0 then + LoadStream.Read(fOwnership[0], SizeOf(fOwnership[0]) * Len); + + LoadStream.CheckMarker('ArmyPresence'); + LoadStream.Read(Len); + SetLength(fPresence, Len); + if Len > 0 then + LoadStream.Read(fPresence[0], SizeOf(fPresence[0]) * Len); +end; + + +//Make the area around to be avoided by common houses +procedure TKMInfluences.AddAvoidBuilding(aX,aY: Word; aRad: Single); +var + X,Y,Rad: Integer; +begin + if (aRad = 0) then + Exit; + Rad := Ceil(aRad); + for Y := Max(aY - Rad, 1) to Min(aY + Rad, fMapY - 1) do + for X := Max(aX - Rad, 1) to Min(aX + Rad, fMapX - 1) do + if (AvoidBuilding[Y,X] = 0) OR (AvoidBuilding[Y,X] >= AVOID_BUILDING_FOREST_MINIMUM) // Protect reservation tiles + AND (Sqr(aX-X) + Sqr(aY-Y) <= Sqr(aRad)) then + AvoidBuilding[Y,X] := 255; +end; + + +procedure TKMInfluences.RemAvoidBuilding(aArea: TKMRect); +var + X,Y: Integer; +begin + for Y := Max(aArea.Top , 1) to Min(aArea.Bottom, fMapY - 1) do + for X := Max(aArea.Left, 1) to Min(aArea.Right , fMapX - 1) do + if (AvoidBuilding[Y,X] = AVOID_BUILDING_COAL_TILE) then // It is not used otherwise anyway + AvoidBuilding[Y,X] := 0; +end; + + +procedure TKMInfluences.MarkForest(aPoint: TKMPoint; aRad, aDecreaseCoef: Single; aOnlyUnmarkedArea: Boolean = False); +var + X,Y, Rad: Integer; + SqrDist, SqrMaxDist: Single; +begin + if (aRad = 0) then + Exit; + SqrMaxDist := Sqr(aRad); + Rad := Ceil(aRad); + for Y := Max(aPoint.Y - Rad, 1) to Min(aPoint.Y + Rad, fMapY - 1) do + for X := Max(aPoint.X - Rad, 1) to Min(aPoint.X + Rad, fMapX - 1) do + if (AvoidBuilding[Y,X] = 0) OR (AvoidBuilding[Y,X] >= AVOID_BUILDING_FOREST_MINIMUM) then // Protect reservation tiles + begin + SqrDist := Sqr(aPoint.X-X) + Sqr(aPoint.Y-Y); + if (SqrDist <= SqrMaxDist) then + begin + if not aOnlyUnmarkedArea then + AvoidBuilding[Y,X] := Min( 254, // Forest does not reach full 255 + Max( AVOID_BUILDING_FOREST_MINIMUM, // Forest start at this value + AvoidBuilding[Y,X] + 254 - Round(SqrDist * aDecreaseCoef) + ) + ) + else if (AvoidBuilding[Y,X] = 0) then + AvoidBuilding[Y,X] := Min( 254, // Forest does not reach full 255 + Max( AVOID_BUILDING_FOREST_MINIMUM, // Forest start at this value + 254 - Round(SqrDist * aDecreaseCoef) + ) + ); + end; + end; +end; + + +//AI should avoid certain areas, keeping them for special houses +procedure TKMInfluences.InitAvoidBuilding(); + procedure CheckAndMarkMine(aX,aY: Integer; aHT: TKMHouseType); + var + X,Y,X2,Y2: Integer; + begin + for Y := Max(1,aY-3) to Min(fMapY-1,aY-1) do + for X := Max(1,aX-1) to Min(fMapX-1,aX+1) do + if ((aHT = htIronMine) AND (gTerrain.TileIsIron(X,Y) > 1)) + OR ((aHT = htGoldMine) AND (gTerrain.TileIsGold(X,Y) > 1)) then + begin + for Y2 := aY to Min(fMapY-1,aY+1) do + for X2 := Max(1,aX-2) to Min(fMapX-1,aX+1+Byte(aHT = htIronMine)) do + AvoidBuilding[Y2, X2] := AVOID_BUILDING_MINE_TILE; + Exit; + end; + end; +var + H: TKMHouse; + I,X,Y: Integer; +begin + FillChar(fAvoidBuilding[0], SizeOf(fAvoidBuilding[0]) * Length(fAvoidBuilding), #0); + + //Avoid Coal fields (must be BEFORE Gold/Iron mines) + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + if (gTerrain.TileIsCoal(X, Y) > 1) then + AvoidBuilding[Y,X] := AVOID_BUILDING_COAL_TILE; + + //Avoid areas where Gold/Iron mines should be + for Y := 3 to fMapY - 2 do + for X := 2 to fMapX - 2 do + if gTerrain.CanPlaceHouse(KMPoint(X,Y), htIronMine) then + CheckAndMarkMine(X,Y, htIronMine) + else if gTerrain.CanPlaceHouse(KMPoint(X,Y), htGoldMine) then + CheckAndMarkMine(X,Y, htGoldMine); + + //Leave free space BELOW all Stores + for I := 0 to gHands.Count - 1 do + begin + H := gHands[I].FindHouse(htStore); + if (H <> nil) then + for Y := Max(H.Entrance.Y + 1, 1) to Min(H.Entrance.Y + 2, fMapY - 1) do + for X := Max(H.Entrance.X - 1, 1) to Min(H.Entrance.X + 1, fMapX - 1) do + AvoidBuilding[Y,X] := AVOID_BUILDING_HOUSE_ENTRANCE; + end; +end; + + +function TKMInfluences.GetAvoidBuilding(const aY,aX: Word): Byte; +begin + Result := fAvoidBuilding[aY*fMapX + aX]; +end; + + +procedure TKMInfluences.SetAvoidBuilding(const aY,aX: Word; const aValue: Byte); +begin + fAvoidBuilding[aY*fMapX + aX] := aValue; +end; + + +function TKMInfluences.GetArmyTraffic(const aAlliance, aIdx: Word): Word; +const + MAX_SOLDIERS_IN_POLYGON = 20; // Maximal count of soldiers in 1 triangle of NavMesh - it depends on NavMesh size!!! +begin + Result := Min(MAX_SOLDIERS_IN_POLYGON, fPresence[PRESENCE_X*(aAlliance*fPolyCnt + aIdx) + AVOID_TRAFFIC_IDX]); +end; + + +function TKMInfluences.GetPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType): Word; +begin + Result := fPresence[PRESENCE_X*(aAlliance*fPolyCnt + aIdx) + Ord(aGT) - GROUP_TYPE_MIN_OFF]; +end; + + +procedure TKMInfluences.SetPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType; const aPresence: Word); +begin + fPresence[PRESENCE_X*(aAlliance*fPolyCnt + aIdx) + Ord(aGT) - GROUP_TYPE_MIN_OFF] := aPresence; +end; + + +procedure TKMInfluences.SetIncPresence(const aAlliance, aIdx: Word; const aGT: TKMGroupType; const aPresence: Word); +begin + Inc(fPresence[PRESENCE_X*(aAlliance*fPolyCnt + aIdx) + Ord(aGT) - GROUP_TYPE_MIN_OFF], aPresence); +end; + + +procedure TKMInfluences.UpdateMilitaryPresence(aAllianceIdx: Integer); +const + EACH_X_MEMBER_COEF = 5; + PENALIZATION_ARR: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX, GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Single = ( + // gtMelee, gtAntiHorse, gtRanged, gtMounted + ( 1.0, 0.3, 0.0, 0.5), // gtMelee + ( 1.0, 1.0, 0.0, 0.0), // gtAntiHorse + ( 1.0, 1.0, 1.0, 2.0), // gtRanged + ( 1.0, 2.0, 0.0, 1.0) // gtMounted + ); + procedure EvaluatePolygon(aIdx: Cardinal; aEval: Word; aGT: TKMGroupType); + begin + Inc(fPresence[aIdx+0], Round(aEval*PENALIZATION_ARR[aGT,gtMelee])); + Inc(fPresence[aIdx+1], Round(aEval*PENALIZATION_ARR[aGT,gtAntiHorse])); + Inc(fPresence[aIdx+2], Round(aEval*PENALIZATION_ARR[aGT,gtRanged])); + Inc(fPresence[aIdx+3], Round(aEval*PENALIZATION_ARR[aGT,gtMounted])); + end; +var + Increment: Word; + K, L, M, PolyIdx: Integer; + G: TKMUnitGroup; + GT: TKMGroupType; + U: TKMUnit; + PL: TKMHandID; +begin + if (Length(fPresence) <= 0) then + Exit; + // Length of fPresence = alliances * polygons * 5 (= 4 types of groups + traffic) + FillChar(fPresence[aAllianceIdx*fPolyCnt*PRESENCE_X], SizeOf(fPresence[0]) * fPolyCnt * PRESENCE_X, #0); + + // Mark avoid traffic + for PL in fAlli2PL[aAllianceIdx] do + if gHands[PL].Enabled then + for K := 0 to gHands[PL].UnitGroups.Count - 1 do + begin + G := gHands[PL].UnitGroups.Groups[K]; + if (G = nil) or G.IsDead then + Continue; + Increment := Min(G.Count, EACH_X_MEMBER_COEF); + L := 0; + while (L < G.Count) do + begin + U := G.Members[L]; + if (U <> nil) and not U.IsDeadOrDying then + begin + PolyIdx := fNavMesh.KMPoint2Polygon[U.Position]; + Inc(fPresence[PRESENCE_X*(aAllianceIdx*fPolyCnt + PolyIdx) + AVOID_TRAFFIC_IDX],Increment); + end; + L := L + EACH_X_MEMBER_COEF; + end; + end; + + // Mark enemy groups + for PL := 0 to gHands.Count - 1 do + if gHands[PL].Enabled and (gHands[fAlli2PL[aAllianceIdx,0]].Alliances[PL] = atEnemy) then + for K := 0 to gHands[PL].UnitGroups.Count - 1 do + begin + G := gHands[PL].UnitGroups.Groups[K]; + if (G = nil) or G.IsDead then + Continue; + Increment := Min(G.Count, EACH_X_MEMBER_COEF); + GT := G.GroupType; + L := 0; + while (L < G.Count) do + begin + U := G.Members[L]; + if (U <> nil) and not U.IsDeadOrDying then + begin + PolyIdx := fNavMesh.KMPoint2Polygon[U.Position]; + EvaluatePolygon(PRESENCE_X*(aAllianceIdx*fPolyCnt + PolyIdx), Increment, GT); + with fNavMesh.Polygons[PolyIdx] do + for M := 0 to NearbyCount - 1 do + EvaluatePolygon(PRESENCE_X*(aAllianceIdx*fPolyCnt + Nearby[M]), Increment, GT); + end; + L := L + EACH_X_MEMBER_COEF; + end; + end; +end; + + +function TKMInfluences.GetOwnership(const aPL: TKMHandID; const aIdx: Word): Byte; +begin + Result := fOwnership[aPL * fPolyCnt + aIdx]; +end; + + +procedure TKMInfluences.SetOwnership(const aPL: TKMHandID; const aIdx: Word; const aOwnership: Byte); +begin + fOwnership[aPL * fPolyCnt + aIdx] := aOwnership; +end; + + +function TKMInfluences.GetOwnershipFromCoords(const aPL: TKMHandID; const aY, aX: Word): Byte; +begin + Result := GetOwnership(aPL, fNavMesh.Point2Polygon[aY,aX]); +end; + + +procedure TKMInfluences.SetOwnershipFromCoords(const aPL: TKMHandID; const aY, aX: Word; const aOwnership: Byte); +begin + SetOwnership(aPL, fNavMesh.Point2Polygon[aY,aX], aOwnership); +end; + + +function TKMInfluences.GetOwnershipFromPoint(const aPL: TKMHandID; const aPoint: TKMPoint): Byte; +begin + Result := GetOwnership(aPL, fNavMesh.KMPoint2Polygon[aPoint]); +end; + + +procedure TKMInfluences.SetOwnershipFromPoint(const aPL: TKMHandID; const aPoint: TKMPoint; const aOwnership: Byte); +begin + SetOwnership(aPL, fNavMesh.KMPoint2Polygon[aPoint], aOwnership); +end; + + +function TKMInfluences.GetBestOwner(const aX,aY: Word): TKMHandID; +begin + Result := GetBestOwner( fNavMesh.Point2Polygon[aY,aX] ); +end; + + +function TKMInfluences.GetBestOwner(const aIdx: Word): TKMHandID; +var + PL: TKMHandID; + Best: Integer; +begin + Result := HAND_NONE; + if not FEAT_AI_GENERATE_INFLUENCE OR (aIdx = High(Word)) then + Exit; + + Best := 0; + for PL := 0 to gHands.Count - 1 do + if (OwnPoly[PL,aIdx] > Best) then + begin + Best := OwnPoly[PL,aIdx]; + Result := PL; + end; +end; + + +function TKMInfluences.GetBestAllianceOwner(const aPL: TKMHandID; const aPoint: TKMPoint; const aAllianceType: TKMAllianceType): TKMHandID; +var + PL: TKMHandID; + Idx: Word; + Best: Integer; +begin + Result := HAND_NONE; + Idx := fNavMesh.Point2Polygon[aPoint.Y,aPoint.X]; + if not FEAT_AI_GENERATE_INFLUENCE OR (Idx = High(Word)) then + Exit; + + Best := 0; + for PL := 0 to gHands.Count - 1 do + if (gHands[aPL].Alliances[PL] = aAllianceType) AND (OwnPoly[PL,Idx] > Best) then + begin + Best := OwnPoly[PL,Idx]; + Result := PL; + end; +end; + + +//function TKMInfluences.GetAllAllianceOwnership(const aPL: TKMHandIndex; const aX,aY: Word; const aAllianceType: TKMAllianceType): TKMHandIndexArray; +//var +// PL: TKMHandIndex; +// I,K,Idx, Cnt: Integer; +// Output: TKMHandIndexArray; +//begin +// SetLength(Result,0); +// if not FEAT_AI_GENERATE_INFLUENCE OR (aIdx = High(Word)) then +// Exit; +// +// SetLength(Output, MAX_HANDS); +// Cnt := 0; +// Idx := fNavMesh.Point2Polygon[aY,aX]; +// for PL := 0 to gHands.Count - 1 do +// if (aPL <> PL) AND (gHands[aPL].Alliances[PL] = aAllianceType) AND (OwnPoly[PL,Idx] > 0) then +// begin +// Output[Cnt] := OwnPoly[PL,Idx]; +// Cnt := Cnt + 1; +// end; +// SetLength(Output, MAX_HANDS); +// // Sort results by influence (in real game 1 <-> 3 elements) +// for I := Cnt - 1 downto 0 do +// for K := 0 to I - 1 do +// if (OwnPoly[ Output[K],Idx ] < OwnPoly[ Output[K+1],Idx ]) then +// begin +// PL := Output[K]; +// Output[K] := Output[K+1]; +// Output[K+1] := K; +// end; +// Result := Output; +//end; + + +function TKMInfluences.GetBestAllianceOwnership(const aPL: TKMHandID; const aX,aY: Word; const aAllianceType: TKMAllianceType): Byte; +begin + Result := GetBestAllianceOwnership(aPL, fNavMesh.Point2Polygon[aY,aX], aAllianceType); +end; + + +function TKMInfluences.GetBestAllianceOwnership(const aPL: TKMHandID; const aIdx: Word; const aAllianceType: TKMAllianceType): Byte; +var + PL: TKMHandID; +begin + Result := 0; + if not FEAT_AI_GENERATE_INFLUENCE OR (aIdx = High(Word)) then + Exit; + + for PL := 0 to gHands.Count - 1 do + if (aPL <> PL) AND (gHands[aPL].Alliances[PL] = aAllianceType) AND (OwnPoly[PL,aIdx] > Result) then + Result := OwnPoly[PL,aIdx]; +end; + + +function TKMInfluences.GetOtherOwnerships(const aPL: TKMHandID; const aX, aY: Word): Word; +begin + Result := GetOtherOwnerships(aPL, fNavMesh.Point2Polygon[aY,aX]); +end; + + +function TKMInfluences.GetOtherOwnerships(const aPL: TKMHandID; const aIdx: Word): Word; +const + ENEMY_COEF = 2; +var + PL: TKMHandID; + Ownership: Byte; +begin + Result := 0; + if not FEAT_AI_GENERATE_INFLUENCE OR (aIdx = High(Word)) then + Exit; + + Result := 0; + for PL := 0 to gHands.Count - 1 do + if (PL <> aPL) then + begin + Ownership := OwnPoly[PL,aIdx]; + Inc(Result, IfThen(gHands[aPL].Alliances[PL] = atAlly, Ownership, Ownership*ENEMY_COEF)); + end; +end; + + +function TKMInfluences.CanPlaceHouseByInfluence(const aPL: TKMHandID; const aX,aY: Word; const aIgnoreAllies: Boolean = False): Boolean; +begin + Result := CanPlaceHouseByInfluence(aPL, fNavMesh.Point2Polygon[aY,aX], aIgnoreAllies); +end; + + +function TKMInfluences.CanPlaceHouseByInfluence(const aPL: TKMHandID; const aIdx: Word; const aIgnoreAllies: Boolean = False): Boolean; +var + bestOwner: TKMHandID; +begin + bestOwner := GetBestOwner(aIdx); + Result := (bestOwner >= 0) AND (OwnPoly[aPL, aIdx] > 0) AND ((bestOwner = aPL) OR (not aIgnoreAllies AND (gHands[aPL].Alliances[bestOwner] = atAlly))); +end; + + +// Here is the main reason for reworking influences: only 1 flood fill for city per a update + ~25x less elements in array +procedure TKMInfluences.UpdateOwnership(const aPL: TKMHandID); +const + INIT_HOUSE_INFLUENCE = 255; + MAX_INFLUENCE_DISTANCE = 150; +var + isAI: Boolean; + I, cnt: Integer; + H: TKMHouse; + idxArray: TKMWordArray; +begin + //Clear array (it is better to clear ~3000 polygons instead of 255*255 tiles) + FillChar(fOwnership[aPL*fPolyCnt], SizeOf(fOwnership[0]) * fPolyCnt, #0); + + // Create array of polygon indexes + SetLength(idxArray, gHands[aPL].Houses.Count); + cnt := 0; + isAI := gHands[aPL].IsComputer; + for I := 0 to gHands[aPL].Houses.Count - 1 do + begin + H := gHands[aPL].Houses[I]; + if not H.IsDestroyed + and not (H.HouseType in [htWatchTower, htWoodcutters]) + and (isAI or H.IsComplete) then // Player must finish the house to update influence so he cannot troll the AI + begin + // Use point below entrance to match NavMeshDefence algorithm and city center detection in Eye + idxArray[cnt] := fNavMesh.KMPoint2Polygon[H.PointBelowEntrance]; + Inc(cnt); + end; + end; + + if cnt > 0 then + fInfluenceFloodFill.HouseInfluence(aPL, INIT_HOUSE_INFLUENCE, MAX_INFLUENCE_DISTANCE, cnt - 1, idxArray); +end; + + +function TKMInfluences.GetAllianceIdx(const aPL: TKMHandID; var aIdx: Integer): Boolean; +var + K, PL: TKMHandID; +begin + Result := False; + for K := Low(fAlli2PL) to High(fAlli2PL) do + for PL in fAlli2PL[K] do + if (PL = aPL) then + begin + aIdx := K; + Exit(True); + end +end; + + +procedure TKMInfluences.InitInfluences(); +var + Idx: Integer; + PL: TKMHandID; +begin + fPolyCnt := fNavMesh.PolygonsCnt; + if (Length(fOwnership) < gHands.Count * fPolyCnt) then + SetLength(fOwnership, gHands.Count * fPolyCnt); + FillChar(fOwnership[0], SizeOf(fOwnership[0]) * Length(fOwnership), #0); + for PL := 0 to gHands.Count - 1 do + UpdateOwnership(PL); + SetLengthOfPresence(); + for Idx := 0 to Length(fAlli2PL) - 1 do + UpdateMilitaryPresence(Idx); +end; + + +procedure TKMInfluences.AfterMissionInit(); +begin + fMapX := gTerrain.MapX; + fMapY := gTerrain.MapY; + SetLength(fAvoidBuilding, fMapY * fMapX); + InitAvoidBuilding(); +end; + + +procedure TKMInfluences.UpdateState(aTick: Cardinal); + {$IFDEF DEBUG_AIInfluences} + var + tStart,tStop: Int64; + procedure UpdateTimer(var aTimeAvrg, aTimePeak: Int64); + begin + tStop := TimeGetUsec() - tStart; + aTimePeak := Max(aTimePeak, tStop); + aTimeAvrg := Round((aTimeAvrg * 5 + tStop)/6); + tStart := TimeGetUsec(); + end; + {$ENDIF} +begin + {$IFDEF DEBUG_AIInfluences} + tStart := TimeGetUsec(); + {$ENDIF} + // City: + if (aTick mod 150 = 15) then // Update every 15 sec 1 player + begin + fUpdateCityIdx := (fUpdateCityIdx + 1) mod gHands.Count; + UpdateOwnership(fUpdateCityIdx); + {$IFDEF DEBUG_AIInfluences} + UpdateTimer(fTimeAvrgOwnership, fTimePeakOwnership); + {$ENDIF} + end; + // Army: + if (aTick mod 5 = 0) AND (Length(fAlli2PL) > 0) then // Update every 0.5 sec 1 player + begin + fUpdateArmyIdx := (fUpdateArmyIdx + 1) mod Length(fAlli2PL); + UpdateMilitaryPresence(fUpdateArmyIdx); + {$IFDEF DEBUG_AIInfluences} + UpdateTimer(fTimeAvrgPresence, fTimePeakPresence); + {$ENDIF} + end; +end; + + +procedure TKMInfluences.UpdateAlliances(const aAlli2PL: TKMHandID2Array); +var + K: Integer; +begin + SetLength(fAlli2PL, Length(aAlli2PL)); + for K := Low(aAlli2PL) to High(aAlli2PL) do + begin + SetLength(fAlli2PL[K], Length(aAlli2PL[K])); + Move(aAlli2PL[K,0], fAlli2PL[K,0], SizeOf(aAlli2PL[K,0]) * Length(aAlli2PL[K])); + end; + SetLengthOfPresence(); +end; + + +procedure TKMInfluences.SetLengthOfPresence(); +begin + if (Length(fAlli2PL) * fPolyCnt * PRESENCE_X <> Length(fPresence)) then + begin + SetLength(fPresence, Length(fAlli2PL) * fPolyCnt * PRESENCE_X); + FillChar(fPresence[0], SizeOf(fPresence[0]) * Length(fPresence), #0); + end; +end; + + +//Render debug symbols +procedure TKMInfluences.Paint(const aRect: TKMRect); +var + PL, WatchedPL: TKMHandID; + K, X,Y, TeamIdx, Cnt: Integer; + GT: TKMGroupType; + Col: Cardinal; +begin + + if not FEAT_AI_GENERATE_NAVMESH OR not FEAT_AI_GENERATE_INFLUENCE then + Exit; + + if OVERLAY_AVOID then + for Y := aRect.Top to aRect.Bottom do + for X := aRect.Left to aRect.Right do + begin + Col := AvoidBuilding[Y,X] * 65793 OR $80000000; + gRenderAux.Quad(X, Y, Col); + end; + + if (OVERLAY_INFLUENCE OR OVERLAY_OWNERSHIP) AND not OVERLAY_AI_COMBAT then + begin + for K := 0 to fPolyCnt - 1 do + begin + PL := GetBestOwner(K); + if (PL = HAND_NONE) then + Continue + else + fNavMesh.DrawPolygon(K, OwnPoly[PL,K], gHands[PL].FlagColor AND tcWhite); + end; + end; + + if (OVERLAY_INFLUENCE OR OVERLAY_OWNERSHIP) AND OVERLAY_AI_COMBAT then + begin + WatchedPL := gMySpectator.HandID; + if (WatchedPL = HAND_NONE) then + Exit; + + if not GetAllianceIdx(WatchedPL,TeamIdx) then + Exit; + + for K := 0 to fPolyCnt - 1 do + begin + Cnt := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + Cnt := Cnt + Presence[TeamIdx, K, GT]; + //NavMesh polys coverage + if (Cnt > 0) then + fNavMesh.DrawPolygon(K, Byte(Min(Max(Cnt,$1F),$F0)), tcRed); + Cnt := GetArmyTraffic(TeamIdx, K); + //NavMesh polys coverage + if (Cnt > 0) then + fNavMesh.DrawPolygon(K, Byte(Min(Max(Cnt,$3F),$F0)), tcYellow); + end; + { + for I := 0 to fPolyCnt - 1 do + begin + BestCnt := 0; + for PL := 0 to gHands.Count - 1 do + begin + Cnt := PresenceAllGroups[PL,I]; + if (Cnt > BestCnt) then + begin + BestCnt := Cnt; + if (WatchedPL = PL) then + Col := tcGreen + else if (gHands[WatchedPL].Alliances[PL] = atAlly) then + Col := tcBlue + else + Col := tcRed; + end; + end; + if (BestCnt > 0) then + begin + BestCnt := Min(BestCnt,$9F); + //NavMesh polys coverage + fNavMesh.DrawPolygon(I, BestCnt, Col); + end; + end; + //} + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/KM_AIMayor.pas b/vendor/kam_remake/src/ai/KM_AIMayor.pas new file mode 100644 index 0000000..215ab79 --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIMayor.pas @@ -0,0 +1,1053 @@ +unit KM_AIMayor; +{$I KaM_Remake.inc} +interface +uses + KM_AIMayorBalance, KM_AICityPlanner, KM_AISetup, + KM_PathfindingRoad, + KM_ResHouses, KM_HouseCollection, + KM_CommonClasses, KM_Defaults, KM_Points, + KM_NavMeshDefences, + KM_ResTypes; + + +type + // Mayor is the one who manages the town + TKMayor = class + private + fOwner: TKMHandID; + fSetup: TKMHandAISetup; + fBalance: TKMayorBalance; + fCityPlanner: TKMCityPlanner; + fPathFindingRoad: TKMPathFindingRoad; + fPathFindingRoadShortcuts: TKMPathFindingRoadShortcuts; + + fRoadBelowStore: Boolean; + fDefenceTowersPlanned: Boolean; + fDefenceTowers: TKMPointTagList; + + WarfareRatios: TWarfareDemands; + + procedure SetArmyDemand(aFootmen, aPikemen, aHorsemen, aArchers: Single); + + function TryBuildHouse(aHouse: TKMHouseType): Boolean; + function TryConnectToRoad(const aLoc: TKMPoint): Boolean; + function GetMaxPlans: Byte; + + procedure CheckAutoRepair; + procedure CheckUnitCount; + procedure CheckWareFlow; + procedure CheckHouseCount; + procedure CheckHousePlans; + procedure CheckRoadsCount; + procedure CheckExhaustedMines; + procedure CheckWeaponOrderCount; + procedure CheckArmyDemand; + procedure PlanDefenceTowers; + procedure TryBuildDefenceTower; + public + constructor Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); + destructor Destroy; override; + + property CityPlanner: TKMCityPlanner read fCityPlanner; + + procedure AfterMissionInit; + procedure OwnerUpdate(aPlayer: TKMHandID); + function BalanceText: UnicodeString; + + procedure UpdateState(aTick: Cardinal); + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +implementation +uses + Classes, Math, + KM_Game, + KM_Hand, KM_HandsCollection, KM_HandTypes, + KM_AIFields, KM_Terrain, + KM_Houses, KM_HouseSchool, KM_HouseStore, + KM_Units, KM_UnitsCollection, KM_UnitActionWalkTo, KM_UnitTaskGoEat, KM_UnitTaskDelivery, + KM_Resource, KM_AITypes, + KM_CommonUtils, KM_DevPerfLog, KM_DevPerfLogTypes; + + +const // Sample list made by AntonP + WarriorHouses: array [0..44] of TKMHouseType = ( + htSchool, htInn, htQuarry, htQuarry, htQuarry, + htWoodcutters, htWoodcutters, htWoodcutters, htWoodcutters, htWoodcutters, + htSawmill, htSawmill, htWoodcutters, htGoldMine, htCoalMine, + htGoldMine, htCoalMine, htMetallurgists, htCoalMine, htCoalMine, + htIronMine, htIronMine, htCoalMine, htIronMine, htWeaponSmithy, + htWeaponSmithy, htVineyard, htVineyard, htVineyard, htStore, + htBarracks, htFarm, htFarm, htFarm, htMill, + htMill, htBakery, htBakery, htSchool, htIronSmithy, + htIronSmithy, htFarm, htSwine, htWeaponSmithy, htArmorSmithy + ); + + //Vital (Store, School, Inn) + //Mining_Core (Quary x3, Woodcutters x3, Sawmill) + //Mining_Gold (CoalMine x2, GoldMine, Metallurgists) + //Food_Basic (Farm, Mill, Bakery, Wineyard) + + //Food + + //Warfare_Leather (Woodcutters x2, Sawmill, Swine x4, Tannery x2, Armor x2, Weapon x3) + //Warfare_Iron (Coal x4, Iron x2, IronSmithy x2, Armor, Weapon x2) + + //Hiring_Army (Barracks) + //Hiring_Army2 (School, CoalMine x2, GoldMine) + + WOOD_BLOCK_RAD = 5.8; + + +{ TKMayor } +constructor TKMayor.Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); +begin + inherited Create; + + fOwner := aPlayer; + fSetup := aSetup; + + fBalance := TKMayorBalance.Create(fOwner); + fCityPlanner := TKMCityPlanner.Create(fOwner); + fPathFindingRoad := TKMPathFindingRoad.Create(fOwner); + fPathFindingRoadShortcuts := TKMPathFindingRoadShortcuts.Create(fOwner); + fDefenceTowers := TKMPointTagList.Create; +end; + + +destructor TKMayor.Destroy; +begin + fBalance.Free; + fCityPlanner.Free; + fPathFindingRoad.Free; + fPathFindingRoadShortcuts.Free; + fDefenceTowers.Free; + + inherited; +end; + + +procedure TKMayor.AfterMissionInit; +begin + fCityPlanner.AfterMissionInit; + CheckArmyDemand; + CheckAutoRepair; + fBalance.StoneNeed := GetMaxPlans * 2.5; +end; + + +// Check existing unit count vs house count and train missing citizens +procedure TKMayor.CheckUnitCount; +var + P: TKMHand; + UnitReq: array [CITIZEN_MIN..CITIZEN_MAX] of Integer; + + // Check that AI has enough Gold to train serfs/workers + function HasEnoughGoldForAux: Boolean; + begin + //Producing gold or (Gold > 10) + Result := (P.Stats.GetWaresProduced(wtGold) > 1) + or (P.Stats.GetWareBalance(wtGold) > 20); + end; + + function TryToTrain(aSchool: TKMHouseSchool; aUnitType: TKMUnitType; aRequiredCount: Integer): Boolean; + begin + // We summ up requirements for e.g. Recruits required at Towers and Barracks + if P.Stats.GetUnitQty(aUnitType) < (aRequiredCount + UnitReq[aUnitType]) then + begin + Dec(UnitReq[aUnitType]); //So other schools don't order same unit + aSchool.AddUnitToQueue(aUnitType, 1); + Result := True; + end + else + Result := False; + end; + + function RecruitsNeeded: Integer; + var AxesLeft: Integer; + begin + if P.Stats.GetHouseQty(htBarracks) = 0 then + Result := 0 + else + if gGame.IsPeaceTime then + begin + //Keep enough recruits to equip using all weapons once PT ends + //Iron soldiers + Result := Min(P.Stats.GetWareBalance(wtIronArmor), + P.Stats.GetWareBalance(wtCrossbow) + P.Stats.GetWareBalance(wtPike) + + Min(P.Stats.GetWareBalance(wtSword), P.Stats.GetWareBalance(wtIronShield))); + //Leather soldiers we can make + Inc(Result, Min(P.Stats.GetWareBalance(wtLeatherArmor), + P.Stats.GetWareBalance(wtBow) + P.Stats.GetWareBalance(wtLance) + + Min(P.Stats.GetWareBalance(wtAxe), P.Stats.GetWareBalance(wtWoodenShield)))); + //Militia with leftover axes + AxesLeft := P.Stats.GetWareBalance(wtAxe) - Min(P.Stats.GetWareBalance(wtLeatherArmor), P.Stats.GetWareBalance(wtWoodenShield)); + if AxesLeft > 0 then + Inc(Result, AxesLeft); + end + else + Result := fSetup.RecruitCount * P.Stats.GetHouseQty(htBarracks); + end; + +var + I,K: Integer; + H: TKMHouseType; + UT: TKMUnitType; + Schools: array of TKMHouseSchool; + HS: TKMHouseSchool; + serfCount: Integer; +begin + //todo -cComplicated: When training new units make sure we have enough gold left to train + //stonemason-woodcutter-carpenter-2miners-metallurgist. In other words - + //dont waste gold if it's not producing yet + + P := gHands[fOwner]; + + //Citizens + //Count overall unit requirement (excluding Barracks and ownerless houses) + FillChar(UnitReq, SizeOf(UnitReq), #0); //Clear up + for H := HOUSE_MIN to HOUSE_MAX do + if gRes.Houses[H].CanHasWorker and (H <> htBarracks) then + Inc(UnitReq[gRes.Houses[H].WorkerType], P.Stats.GetHouseQty(H)); + + //Schools + //Count overall schools count and exclude already training units from UnitReq + SetLength(Schools, P.Stats.GetHouseQty(htSchool)); + K := 1; + HS := TKMHouseSchool(P.FindHouse(htSchool, K)); + while HS <> nil do + begin + Schools[K-1] := HS; + for I := 0 to HS.QueueLength - 1 do //Decrease requirement for each unit in training + if HS.Queue[I] <> utNone then + Dec(UnitReq[HS.Queue[I]]); //Can be negative and compensated by e.g. ReqRecruits + Inc(K); + HS := TKMHouseSchool(P.FindHouse(htSchool, K)); + end; + + //Order the training. Keep up to 2 units in the queue so the school doesn't have to wait + for K := 0 to High(Schools) do + begin + HS := Schools[K]; + if (HS <> nil) and (HS.QueueCount < 2) then + begin + //Order citizen training + for UT := Low(UnitReq) to High(UnitReq) do + if (UnitReq[UT] > 0) //Skip units that houses dont need (Serfs/Workers) + and (UnitReq[UT] > P.Stats.GetUnitQty(UT)) then + begin + Dec(UnitReq[UT]); //So other schools don't order same unit + HS.AddUnitToQueue(UT, 1); + Break; //Don't need more UnitTypes yet + end; + + // If we are here then a citizen to train wasn't found, so try other unit types (citizens get top priority) + // Serf factor is like this: Serfs = (10/FACTOR)*Total_Building_Count) (from: http://atfreeforum.com/knights/viewtopic.php?t=465) + + // While still haven't found a match... + while (HS.QueueCount < 2) do + begin + // If we are low on Gold don't hire more ppl (next school will fail this too, so we can exit) + if not HasEnoughGoldForAux then Exit; + + serfCount := Round(fSetup.SerfsPerHouse * (P.Stats.GetHouseQty(htAny) + P.Stats.GetUnitQty(utBuilder)/2)); + + if not TryToTrain(HS, utSerf, serfCount) then + if not TryToTrain(HS, utBuilder, fSetup.WorkerCount) then + if not gGame.CheckTime(fSetup.RecruitDelay) then //Recruits can only be trained after this time + Break + else + if not TryToTrain(HS, utRecruit, RecruitsNeeded) then + Break; //There's no unit demand at all + end; + end; + end; +end; + + +procedure TKMayor.CheckArmyDemand; +var Footmen, Pikemen, Horsemen, Archers: Integer; +begin + gHands[fOwner].AI.General.DefencePositions.GetArmyDemand(Footmen, Pikemen, Horsemen, Archers); + SetArmyDemand(Footmen, Pikemen, Horsemen, Archers); +end; + + +//Check that we have weapons ordered for production +procedure TKMayor.CheckWeaponOrderCount; +const + //Order weapons in portions to avoid overproduction of one ware over another + //(e.g. Shields in armory until Leather is available) + PORTIONS = 8; +var + I,K: Integer; + H: TKMHouse; + WareOrder: Integer; +begin + for I := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[I]; + + WareOrder := H.WareOrder[1] + H.WareOrder[2] + H.WareOrder[3] + H.WareOrder[4]; + + if not H.IsDestroyed and (WareOrder = 0) then + case H.HouseType of + htArmorSmithy: for K := 1 to 4 do + if gRes.Houses[H.HouseType].WareOutput[K] = wtIronShield then + H.WareOrder[K] := Round(WarfareRatios[wtIronShield] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtIronArmor then + H.WareOrder[K] := Round(WarfareRatios[wtIronArmor] * PORTIONS); + htArmorWorkshop: for K := 1 to 4 do + if gRes.Houses[H.HouseType].WareOutput[K] = wtWoodenShield then + H.WareOrder[K] := Round(WarfareRatios[wtWoodenShield] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtLeatherArmor then + H.WareOrder[K] := Round(WarfareRatios[wtLeatherArmor] * PORTIONS); + htWeaponSmithy: for K := 1 to 4 do + if gRes.Houses[H.HouseType].WareOutput[K] = wtSword then + H.WareOrder[K] := Round(WarfareRatios[wtSword] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtPike then + H.WareOrder[K] := Round(WarfareRatios[wtPike] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtCrossbow then + H.WareOrder[K] := Round(WarfareRatios[wtCrossbow] * PORTIONS); + htWeaponWorkshop: for K := 1 to 4 do + if gRes.Houses[H.HouseType].WareOutput[K] = wtAxe then + H.WareOrder[K] := Round(WarfareRatios[wtAxe] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtLance then + H.WareOrder[K] := Round(WarfareRatios[wtLance] * PORTIONS) + else + if gRes.Houses[H.HouseType].WareOutput[K] = wtBow then + H.WareOrder[K] := Round(WarfareRatios[wtBow] * PORTIONS); + end; + end; +end; + + +procedure TKMayor.PlanDefenceTowers; +const + DISTANCE_BETWEEN_TOWERS = 7; +var + P: TKMHand; + PL1, PL2: TKMHandID; + pom: boolean; + //Outline1, Outline2: TKMWeightSegments; + I, K, DefCount: Integer; + // DefCount: Integer; + Point1, Point2: TKMPoint; + //Loc: TKMPoint; + Ratio: Single; + //SegLength: Single; + DefLines: TKMDefenceLines; +begin + if fDefenceTowersPlanned then + Exit; + fDefenceTowersPlanned := True; + P := gHands[fOwner]; + if not P.Locks.HouseCanBuild(htWatchTower) then + Exit; + pom := not gAIFields.NavMesh.Defences.FindDefenceLines(fOwner, DefLines) OR (DefLines.Count < 1); + if pom then + Exit; + + for I := 0 to DefLines.Count - 1 do + with DefLines.Lines[I] do + begin + Point1 := gAIFields.NavMesh.Nodes[DefLines.Lines[I].Nodes[0]]; + Point2 := gAIFields.NavMesh.Nodes[DefLines.Lines[I].Nodes[1]]; + PL1 := gAIFields.Influences.GetBestAllianceOwner(fOwner, Point1, atAlly); + PL2 := gAIFields.Influences.GetBestAllianceOwner(fOwner, Point2, atAlly); + if (PL1 <> fOwner) AND (PL2 <> fOwner) AND (PL1 <> HAND_NONE) AND (PL2 <> HAND_NONE) then + Continue; + DefCount := Ceil( KMLength(Point1, Point2) / DISTANCE_BETWEEN_TOWERS ); + for K := 0 to DefCount - 1 do + begin + Ratio := (K + 1) / (DefCount + 1); + fDefenceTowers.Add( KMPointRound(KMLerp(Point1, Point2, Ratio)), gAIFields.Influences.GetBestAllianceOwnership(fOwner, Polygon, atEnemy)); + end; + end; + + //Get defence Outline with weights representing how important each segment is + //gAIFields.NavMesh.GetDefenceOutline(fOwner, Outline1, Outline2); + + //Make list of defence positions + //for I := 0 to High(Outline2) do + //begin + // //Longer segments will get several towers + // SegLength := KMLength(Outline2[I].A, Outline2[I].B); + // DefCount := Max(Trunc(SegLength / DISTANCE_BETWEEN_TOWERS), 1); + // for K := 0 to DefCount - 1 do + // begin + // Ratio := (K + 1) / (DefCount + 1); + // Loc := KMPointRound(KMLerp(Outline2[I].A, Outline2[I].B, Ratio)); + // fDefenceTowers.Add(Loc, Trunc(1000*Outline2[I].Weight)); + // end; + //end; + fDefenceTowers.SortByTag; + fDefenceTowers.Inverse; //So highest weight is first +end; + + +procedure TKMayor.TryBuildDefenceTower; +const + SEARCH_RAD = 6; + MAX_ROAD_DISTANCE = 50; +var + P: TKMHand; + IY, IX: Integer; + Loc: TKMPoint; + DistSqr, BestDistSqr: Integer; + BestLoc: TKMPoint; + + NodeList: TKMPointList; + H: TKMHouse; + LocTo: TKMPoint; + RoadConnectID: Byte; + RoadExists: Boolean; +begin + P := gHands[fOwner]; + //Take the first tower from the list + Loc := fDefenceTowers[0]; + fDefenceTowers.Delete(0); + //Look for a place for the tower + BestDistSqr := High(BestDistSqr); + BestLoc := KMPOINT_ZERO; + for IY := Max(1, Loc.Y-SEARCH_RAD) to Min(gTerrain.MapY, Loc.Y+SEARCH_RAD) do + for IX := Max(1, Loc.X-SEARCH_RAD) to Min(gTerrain.MapX, Loc.X+SEARCH_RAD) do + begin + DistSqr := KMLengthSqr(Loc, KMPoint(IX, IY)); + if (DistSqr < BestDistSqr) and P.CanAddHousePlanAI(IX, IY, htWatchTower, False) then + begin + BestLoc := KMPoint(IX, IY); + BestDistSqr := DistSqr; + end; + end; + if (BestLoc.X > 0) then + begin + //See if the road required is too long (tower might be across unwalkable terrain) + H := P.Houses.FindHouse(htAny, BestLoc.X, BestLoc.Y, 1, False); + if H = nil then Exit; //We are screwed, no houses left + LocTo := H.PointBelowEntrance; + + //Find nearest complete house to get the road connect ID + H := P.Houses.FindHouse(htAny, BestLoc.X, BestLoc.Y, 1, True); + if H = nil then Exit; //We are screwed, no houses left + RoadConnectID := gTerrain.GetRoadConnectID(H.PointBelowEntrance); + + NodeList := TKMPointList.Create; + RoadExists := fPathFindingRoad.Route_ReturnToWalkable(BestLoc, LocTo, RoadConnectID, NodeList); + //If length of road is short enough, build the tower + if RoadExists and (NodeList.Count <= MAX_ROAD_DISTANCE) then + begin + gHands[fOwner].AddHousePlan(htWatchTower, BestLoc); + TryConnectToRoad(KMPointBelow(BestLoc)); + end; + NodeList.Free; + end; +end; + + +function TKMayor.GetMaxPlans: Byte; +begin + Result := Ceil(fSetup.WorkerCount / 4); +end; + + +//We want to connect to nearest road piece (not necessarily built yet) +function TKMayor.TryConnectToRoad(const aLoc: TKMPoint): Boolean; +const + MAX_DISTANCE = 150; +var + I: Integer; + P: TKMHand; + H: TKMHouse; + LocTo: TKMPoint; + RoadConnectID: Byte; + NodeList: TKMPointList; + RoadExists: Boolean; +begin + Result := False; + P := gHands[fOwner]; + + //Find nearest wip or ready house + H := P.Houses.FindHouse(htAny, aLoc.X, aLoc.Y, 1, False); + if H = nil then Exit; //We are screwed, no houses left + LocTo := H.PointBelowEntrance; + + //Find nearest complete house to get the road connect ID + H := P.Houses.FindHouse(htAny, aLoc.X, aLoc.Y, 1, True); + if H = nil then Exit; //We are screwed, no houses left + RoadConnectID := gTerrain.GetRoadConnectID(H.PointBelowEntrance); + + NodeList := TKMPointList.Create; + try + RoadExists := fPathFindingRoad.Route_ReturnToWalkable(aLoc, LocTo, RoadConnectID, NodeList); + + if not RoadExists OR (NodeList.Count > MAX_DISTANCE) then + Exit; + + for I := 0 to NodeList.Count - 1 do + //We must check if we can add the plan ontop of plans placed earlier in this turn + if P.CanAddFieldPlan(NodeList[I], ftRoad) then + P.Constructions.FieldworksList.AddField(NodeList[I], ftRoad); + Result := True; + finally + NodeList.Free; + end; +end; + + +//Try to place a building plan for requested house +//Report back if failed to do so (that will allow requester to choose different action) +function TKMayor.TryBuildHouse(aHouse: TKMHouseType): Boolean; +var + I, K: Integer; + Loc: TKMPoint; + P: TKMHand; + NodeTagList: TKMPointTagList; + Weight: Cardinal; +begin + Result := False; + P := gHands[fOwner]; + + //Skip disabled houses + if not P.Locks.HouseCanBuild(aHouse) then Exit; + + //Number of simultaneous WIP houses is limited + if (P.Stats.GetHouseWip(htAny) > GetMaxPlans) then Exit; + + //Maybe we get more lucky next tick + //todo -cComplicated: That only works if FindPlaceForHouse is quick, right now it takes ~11ms for iron/gold/coal mines (to decide that they can't be placed). + // If there's no place for the house we try again and again and again every update, so it's very inefficient + // I think the best solution would be to make FindPlaceForHouse only take a long time if we succeed in finding a place for the house, if we + // fail it should be quick. Doing a flood fill with radius=40 should really be avoided anyway, 11ms is a long time for placing 1 house. + // We could also make it not try to place houses again each update if it failed the first time, if we can't make FindPlaceForHouse quick when it fails. + if not fCityPlanner.FindPlaceForHouse(aHouse, Loc) then Exit; + + //Place house before road, so that road is made around it + P.AddHousePlan(aHouse, Loc); + + // Script could delete house plan we placed, so check if we actually added it + if not P.HasHousePlan(Loc) then + Exit(False); + + //Try to connect newly planned house to road network + //if it is not possible - scrap the plan + if not TryConnectToRoad(KMPointBelow(Loc)) then + begin + P.RemHousePlan(Loc); + Exit; + end; + + //I tried to use this when the bug occured but it didn't always work because AI places multiple house/field plans at once (if P.CanAddFieldPlan(KMPointBelow(Loc), ftRoad) then) + //Fixes Classical AI bug related to houses never being finished/connected to road network + P.Constructions.FieldworksList.RemFieldPlan(KMPointBelow(Loc)); //Make sure our entrance to the house has no plan (vine/corn) in front of it + P.Constructions.FieldworksList.AddField(KMPointBelow(Loc), ftRoad); //Place a road below house entrance to make sure it is connected to our city! + + //Build fields for Farm + if aHouse = htFarm then + begin + NodeTagList := TKMPointTagList.Create; + try + for I := Min(Loc.Y - 2, gTerrain.MapY - 1) to Min(Loc.Y + 2 + AI_FIELD_HEIGHT - 1, gTerrain.MapY - 1) do + for K := Max(Loc.X - AI_FIELD_WIDTH, 1) to Min(Loc.X + AI_FIELD_WIDTH, gTerrain.MapX - 1) do + if P.CanAddFieldPlan(KMPoint(K,I), ftCorn) then + begin + //Base weight is distance from door (weight X higher so nice rectangle is formed) + Weight := Abs(K - Loc.X)*3 + Abs(I - 2 - Loc.Y); + //Prefer fields below the farm + if (I < Loc.Y + 2) then + Inc(Weight, 100); + //Avoid building on row with roads (so we can expand from this house) + if I = Loc.Y + 1 then + Inc(Weight, 1000); + NodeTagList.Add(KMPoint(K, I), Weight); + end; + + NodeTagList.SortByTag; + for I := 0 to Min(NodeTagList.Count, 16) - 1 do + P.Constructions.FieldworksList.AddField(NodeTagList[I], ftCorn); + finally + NodeTagList.Free; + end; + end; + + //Build fields for Wineyard + if aHouse = htVineyard then + begin + NodeTagList := TKMPointTagList.Create; + try + for I := Min(Loc.Y - 2, gTerrain.MapY - 1) to Min(Loc.Y + 2 + AI_FIELD_HEIGHT - 1, gTerrain.MapY - 1) do + for K := Max(Loc.X - AI_FIELD_WIDTH, 1) to Min(Loc.X + AI_FIELD_WIDTH, gTerrain.MapX - 1) do + if P.CanAddFieldPlan(KMPoint(K,I), ftWine) then + begin + //Base weight is distance from door (weight X higher so nice rectangle is formed) + Weight := Abs(K - Loc.X)*3 + Abs(I - 2 - Loc.Y); + //Prefer fields below the farm + if (I < Loc.Y + 2) then + Inc(Weight, 100); + //Avoid building on row with roads (so we can expand from this house) + if I = Loc.Y + 1 then + Inc(Weight, 1000); + NodeTagList.Add(KMPoint(K, I), Weight); + end; + + NodeTagList.SortByTag; + for I := 0 to Min(NodeTagList.Count, 10) - 1 do + P.Constructions.FieldworksList.AddField(NodeTagList[I], ftWine); + finally + NodeTagList.Free; + end; + end; + + //Block any buildings nearby + if aHouse = htWoodcutters then + gAIFields.Influences.AddAvoidBuilding(Loc.X-1, Loc.Y, WOOD_BLOCK_RAD); //X-1 because entrance is on right + + //Build more roads around 2nd Store + if aHouse = htStore then + for I := Max(Loc.Y - 3, 1) to Min(Loc.Y + 2, gTerrain.MapY - 1) do + for K := Max(Loc.X - 2, 1) to Min(Loc.X + 2, gTerrain.MapY - 1) do + if P.CanAddFieldPlan(KMPoint(K, I), ftRoad) then + P.Constructions.FieldworksList.AddField(KMPoint(K, I), ftRoad); + + Result := True; +end; + + +//todo -cPractical: Check if planned houses are being connected with roads +//(worker could die while digging a road piece or elevation changed to impassable) +procedure TKMayor.CheckHousePlans; +begin + // +end; + + +//Manage ware distribution +procedure TKMayor.CheckWareFlow; +var + I: Integer; + S: TKMHouseStore; + Houses: TKMHousesCollection; +begin + Houses := gHands[fOwner].Houses; + + //Iterate through all Stores and block certain wares to reduce serf usage + for I := 0 to Houses.Count - 1 do + if (Houses[I].HouseType = htStore) + and Houses[I].IsComplete + and not Houses[I].IsDestroyed then + begin + S := TKMHouseStore(Houses[I]); + + //We like to always keep a supply of these + S.NotAcceptFlag[wtTimber] := S.CheckWareIn(wtTimber) > 50; + S.NotAcceptFlag[wtStone] := S.CheckWareIn(wtStone) > 50; + S.NotAcceptFlag[wtGold] := S.CheckWareIn(wtGold) > 50; + + //Storing these causes lots of congestion with very little gain + //Auto build AI aims for perfectly balanced village where these goods don't need storing + //Keep them only until we have the house which consumes them. + S.NotAcceptFlag[wtTrunk] := gHands[fOwner].Stats.GetHouseQty(htSawmill) > 0; + S.NotAcceptFlag[wtGoldOre] := gHands[fOwner].Stats.GetHouseQty(htMetallurgists) > 0; + S.NotAcceptFlag[wtIronOre] := gHands[fOwner].Stats.GetHouseQty(htIronSmithy) > 0; + S.NotAcceptFlag[wtCoal] := gHands[fOwner].Stats.GetHouseQty(htMetallurgists) + + gHands[fOwner].Stats.GetHouseQty(htIronSmithy) > 0; + S.NotAcceptFlag[wtIron] := gHands[fOwner].Stats.GetHouseQty(htWeaponSmithy) + + gHands[fOwner].Stats.GetHouseQty(htArmorSmithy) > 0; + S.NotAcceptFlag[wtCorn] := gHands[fOwner].Stats.GetHouseQty(htMill) + + gHands[fOwner].Stats.GetHouseQty(htSwine) + + gHands[fOwner].Stats.GetHouseQty(htStables) > 0; + S.NotAcceptFlag[wtLeather] := gHands[fOwner].Stats.GetHouseQty(htArmorWorkshop) > 0; + S.NotAcceptFlag[wtFlour] := gHands[fOwner].Stats.GetHouseQty(htBakery) > 0; + //Pigs and skin cannot be blocked since if swinefarm is full of one it stops working (blocks other) + //S.NotAcceptFlag[wtSkin] := gHands[fOwner].Stats.GetHouseQty(htTannery) > 0; + //S.NotAcceptFlag[wtPig] := gHands[fOwner].Stats.GetHouseQty(htButchers) > 0; + end; +end; + + +//Demolish any exhausted mines, they will be rebuilt if needed +procedure TKMayor.CheckExhaustedMines; +var + I: Integer; + Houses: TKMHousesCollection; + Loc: TKMPoint; +begin + Houses := gHands[fOwner].Houses; + + //Wait until resource is depleted and output is empty + for I := 0 to Houses.Count - 1 do + if not Houses[I].IsDestroyed + and Houses[I].ResourceDepleted + and (Houses[I].CheckWareOut(wtAll) = 0) then + begin + //Set it so we can build over coal that was removed + if Houses[I].HouseType = htCoalMine then + begin + Loc := Houses[I].Entrance; + gAIFields.Influences.RemAvoidBuilding(KMRect(Loc.X-2, Loc.Y-2, Loc.X+3, Loc.Y+1)); + end; + Houses[I].Demolish(fOwner); + end; +end; + + +procedure TKMayor.CheckHouseCount; +var + P: TKMHand; + + function MaxPlansForTowers: Integer; + begin + Result := GetMaxPlans; + //Once there are 2 towers wip then allow balance to build something + if (fBalance.Peek <> htNone) and (P.Stats.GetHouseWip(htWatchTower) >= 2) then + Result := Result - 1; + Result := Max(1, Result); + end; + +var + H: TKMHouseType; +begin + P := gHands[fOwner]; + + //Try to express needs in terms of Balance = Production - Demand + fBalance.Refresh; + + //Peek - see if we can build this house + //Take - take this house into building + //Reject - we can't build this house (that could affect other houses in queue) + + //Build towers if village is done, or peacetime is nearly over + if P.Locks.HouseCanBuild(htWatchTower) then + if ((fBalance.Peek = htNone) and (P.Stats.GetHouseWip(htAny) = 0)) //Finished building + or ((gGame.Options.Peacetime <> 0) and gGame.CheckTime(600 * Max(0, gGame.Options.Peacetime - 15))) then + PlanDefenceTowers; + + if fDefenceTowersPlanned then + while (fDefenceTowers.Count > 0) and (P.Stats.GetHouseWip(htAny) < MaxPlansForTowers) do + TryBuildDefenceTower; + + while P.Stats.GetHouseWip(htAny) < GetMaxPlans do + begin + H := fBalance.Peek; + + //There are no more suggestions + if H = htNone then + Break; + + //See if we can build that + if TryBuildHouse(H) then + begin + fBalance.Take; + fBalance.Refresh; //Balance will be changed by the construction of this house + end + else + fBalance.Reject; + end; + + //Check if we need to demolish depleted mining houses + CheckExhaustedMines; + + //Verify all plans are being connected with roads + CheckHousePlans; +end; + + +procedure TKMayor.CheckRoadsCount; +const + SHORTCUT_CHECKS_PER_UPDATE = 10; +var + P: TKMHand; + Store: TKMHouse; + StoreLoc: TKMPoint; + I, K: Integer; + FromLoc, ToLoc: TKMPoint; + NodeList: TKMPointList; + RoadExists: Boolean; +begin + P := gHands[fOwner]; + + //This is one time task to build roads around Store + //When town becomes larger add road around Store to make traffic smoother + if not fRoadBelowStore and (P.Stats.GetHouseQty(htAny) > 14) then + begin + fRoadBelowStore := True; + + Store := P.Houses.FindHouse(htStore, 0, 0, 1); + if Store = nil then Exit; + StoreLoc := Store.Entrance; + + for I := Max(StoreLoc.Y - 3, 1) to Min(StoreLoc.Y + 2, gTerrain.MapY - 1) do + for K := StoreLoc.X - 2 to StoreLoc.X + 2 do + if P.CanAddFieldPlan(KMPoint(K, I), ftRoad) then + P.Constructions.FieldworksList.AddField(KMPoint(K, I), ftRoad); + end; + + //Check if we need to connect separate branches of road network + //Town has no plan and usually roadnetwork looks like a tree, + //where we can improve it by connecting near branches with shortcuts. + NodeList := TKMPointList.Create; + try + //See where our citizens are walking and build shortcuts where possible + for I := 0 to gHands[fOwner].Units.Count - 1 do + begin + //Checking for shortcuts is slow, so skip some units randomly each update + if KaMRandom(gHands[fOwner].Stats.GetUnitQty(utSerf){$IFDEF DBG_RNG_SPY}, 'TKMayor.CheckRoadsCount'{$ENDIF}) >= SHORTCUT_CHECKS_PER_UPDATE then + Continue; + if not gHands[fOwner].Units[I].IsDeadOrDying + and (gHands[fOwner].Units[I].Action is TKMUnitActionWalkTo) then + if ((gHands[fOwner].Units[I] is TKMUnitSerf) and (gHands[fOwner].Units[I].Task is TKMTaskDeliver) + and (TKMTaskDeliver(gHands[fOwner].Units[I].Task).DeliverKind <> dkToUnit)) + or ((gHands[fOwner].Units[I] is TKMUnitCitizen) and (gHands[fOwner].Units[I].Task is TKMTaskGoEat)) then + begin + FromLoc := TKMUnitActionWalkTo(gHands[fOwner].Units[I].Action).WalkFrom; + ToLoc := TKMUnitActionWalkTo(gHands[fOwner].Units[I].Action).WalkTo; + //Unit's route must be using road network, not f.e. delivering to soldiers + if gTerrain.RouteCanBeMade(FromLoc, ToLoc, tpWalkRoad) then + begin + //Check for shortcuts we could build + NodeList.Clear; + RoadExists := fPathFindingRoadShortcuts.Route_Make(FromLoc, ToLoc, NodeList); + + if not RoadExists then + Break; + + for K := 0 to NodeList.Count - 1 do + //We must check if we can add the plan ontop of plans placed earlier in this turn + if P.CanAddFieldPlan(NodeList[K], ftRoad) then + P.Constructions.FieldworksList.AddField(NodeList[K], ftRoad); + end; + end; + end; + finally + NodeList.Free; + end; +end; + + +procedure TKMayor.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fBalance.OwnerUpdate(aPlayer); + fCityPlanner.OwnerUpdate(aPlayer); + fPathFindingRoad.OwnerUpdate(aPlayer); + fPathFindingRoadShortcuts.OwnerUpdate(aPlayer); +end; + + +//Tell Mayor what proportions of army is needed +//Input values are normalized +procedure TKMayor.SetArmyDemand(aFootmen, aPikemen, aHorsemen, aArchers: Single); + + function IsIronProduced: Boolean; + begin + Result := ( gHands[fOwner].Stats.GetHouseQty(htIronMine) + + gHands[fOwner].Stats.GetHouseWip(htIronMine) + + gHands[fOwner].Stats.GetHousePlans(htIronMine)) > 0; + end; + + function GroupBlocked(aGT: TKMGroupType; aIron: Boolean): Boolean; + begin + if aIron then + case aGT of + gtMelee: Result := gHands[fOwner].Locks.GetUnitBlocked(utSwordFighter); + gtAntiHorse: Result := gHands[fOwner].Locks.GetUnitBlocked(utPikeman); + gtRanged: Result := gHands[fOwner].Locks.GetUnitBlocked(utCrossbowman); + gtMounted: Result := gHands[fOwner].Locks.GetUnitBlocked(utKnight); + else Result := True; + end + else + case aGT of + gtMelee: Result := gHands[fOwner].Locks.GetUnitBlocked(utMilitia) and + gHands[fOwner].Locks.GetUnitBlocked(utAxeFighter); + gtAntiHorse: Result := gHands[fOwner].Locks.GetUnitBlocked(utLanceCarrier); + gtRanged: Result := gHands[fOwner].Locks.GetUnitBlocked(utBowman); + gtMounted: Result := gHands[fOwner].Locks.GetUnitBlocked(utScout); + else Result := True; + end; + end; + + function GetUnitRatio(aUT: TKMUnitType): Byte; + begin + if gHands[fOwner].Locks.GetUnitBlocked(aUT) then + Result := 0 //This warrior is blocked + else + if (fSetup.ArmyType = atIronAndLeather) + and GroupBlocked(UNIT_TO_GROUP_TYPE[aUT], not (aUT in WARRIORS_IRON)) then + Result := 2 //In mixed army type, if our compliment is blocked we need to make double + else + Result := 1; + end; + +var + Summ: Single; + Footmen, Pikemen, Horsemen, Archers: Single; + IronPerMin, LeatherPerMin: Single; + WT: TKMWareType; + WarfarePerMinute: TWarfareDemands; +begin + Summ := aFootmen + aPikemen + aHorsemen + aArchers; + if Summ = 0 then + begin + Footmen := 0; + Pikemen := 0; + Horsemen := 0; + Archers := 0; + end + else + begin + Footmen := aFootmen / Summ; + Pikemen := aPikemen / Summ; + Horsemen := aHorsemen / Summ; + Archers := aArchers / Summ; + end; + + //Store ratios localy in Mayor to place weapon orders + //Leather + WarfareRatios[wtLeatherArmor] := Footmen * GetUnitRatio(utAxeFighter) + + Horsemen * GetUnitRatio(utScout) + + Pikemen * GetUnitRatio(utLanceCarrier) + + Archers * GetUnitRatio(utBowman); + WarfareRatios[wtWoodenShield] := Footmen * GetUnitRatio(utAxeFighter) + + Horsemen * GetUnitRatio(utScout); + WarfareRatios[wtAxe] := Footmen * Max(GetUnitRatio(utAxeFighter), GetUnitRatio(utMilitia)) + + Horsemen * GetUnitRatio(utScout); + WarfareRatios[wtLance] := Pikemen * GetUnitRatio(utLanceCarrier); + WarfareRatios[wtBow] := Archers * GetUnitRatio(utBowman); + //Iron + WarfareRatios[wtIronArmor] := Footmen * GetUnitRatio(utSwordFighter) + + Horsemen * GetUnitRatio(utKnight) + + Pikemen * GetUnitRatio(utPikeman) + + Archers * GetUnitRatio(utCrossbowman); + WarfareRatios[wtIronShield] :=Footmen * GetUnitRatio(utSwordFighter) + + Horsemen * GetUnitRatio(utKnight); + WarfareRatios[wtSword] := Footmen * GetUnitRatio(utSwordFighter) + + Horsemen * GetUnitRatio(utKnight); + WarfareRatios[wtPike] := Pikemen * GetUnitRatio(utPikeman); + WarfareRatios[wtCrossbow] := Archers * GetUnitRatio(utCrossbowman); + + WarfareRatios[wtHorse] := Horsemen * (GetUnitRatio(utKnight) + GetUnitRatio(utScout)); + + //How many warriors we would need to equip per-minute + IronPerMin := fSetup.WarriorsPerMinute(atIron); + LeatherPerMin := fSetup.WarriorsPerMinute(atLeather); + + //If the AI is meant to make both but runs out, we must make it up with leather + if (fSetup.ArmyType = atIronAndLeather) and not IsIronProduced then + LeatherPerMin := LeatherPerMin + IronPerMin; //Once iron runs out start making leather to replace it + + //Make only iron first then if it runs out make leather + if (fSetup.ArmyType = atIronThenLeather) and IsIronProduced then + LeatherPerMin := 0; //Don't make leather until the iron runs out + + for WT := WEAPON_MIN to WEAPON_MAX do + if WT in WARFARE_IRON then + WarfarePerMinute[WT] := WarfareRatios[WT] * IronPerMin + else + WarfarePerMinute[WT] := WarfareRatios[WT] * LeatherPerMin; + + //Horses require separate calculation + WarfarePerMinute[wtHorse] := Horsemen * ( GetUnitRatio(utKnight) * IronPerMin + + GetUnitRatio(utScout) * LeatherPerMin); + + //Update warfare needs accordingly + fBalance.SetArmyDemand(WarfarePerMinute); +end; + + +procedure TKMayor.CheckAutoRepair; +var + I: Integer; +begin + with gHands[fOwner] do + begin + // Change repair mode for all houses only for rmRepairNever and rmRepairAlways + if IsComputer and (fSetup.RepairMode in [rmRepairNever, rmRepairAlways]) then + for I := 0 to Houses.Count - 1 do + Houses[I].BuildingRepair := fSetup.IsRepairAlways; + end; +end; + + +function TKMayor.BalanceText: UnicodeString; +begin + Result := fBalance.BalanceText; +end; + + +procedure TKMayor.UpdateState(aTick: Cardinal); +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAICityCls); + {$ENDIF} + try + //Checking mod result against MAX_HANDS causes first update to happen ASAP + if (aTick + Byte(fOwner)) mod (MAX_HANDS * 4) <> MAX_HANDS then Exit; + + CheckAutoRepair; + + //Train new units (citizens, serfs, workers and recruits) if needed + CheckUnitCount; + + CheckArmyDemand; + CheckWeaponOrderCount; + + if fSetup.AutoBuild then + begin + CheckHouseCount; + + //Manage wares ratios and block stone to Store + CheckWareFlow; + + //Build more roads if necessary + CheckRoadsCount; + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAICityCls); + {$ENDIF} + end; +end; + + +procedure TKMayor.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('AIMayor'); + SaveStream.Write(fOwner); + SaveStream.Write(fRoadBelowStore); + SaveStream.Write(fDefenceTowersPlanned); + fDefenceTowers.SaveToStream(SaveStream); + + SaveStream.Write(WarfareRatios, SizeOf(WarfareRatios)); + + fBalance.Save(SaveStream); + fCityPlanner.Save(SaveStream); + fPathFindingRoad.Save(SaveStream); + fPathFindingRoadShortcuts.Save(SaveStream); +end; + + +procedure TKMayor.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('AIMayor'); + LoadStream.Read(fOwner); + LoadStream.Read(fRoadBelowStore); + LoadStream.Read(fDefenceTowersPlanned); + fDefenceTowers.LoadFromStream(LoadStream); + + LoadStream.Read(WarfareRatios, SizeOf(WarfareRatios)); + + fBalance.Load(LoadStream); + fCityPlanner.Load(LoadStream); + fPathFindingRoad.Load(LoadStream); + fPathFindingRoadShortcuts.Load(LoadStream); +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AIMayorBalance.pas b/vendor/kam_remake/src/ai/KM_AIMayorBalance.pas new file mode 100644 index 0000000..6f32dbc --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AIMayorBalance.pas @@ -0,0 +1,1077 @@ +unit KM_AIMayorBalance; +{$I KaM_Remake.inc} +interface +uses + KM_CommonClasses, KM_Defaults, + KM_ResTypes; + +type + //MayorBalance is a cluster of functions that choose optimal houses to build + + // Calculate various demands and save intermediate numbers in case we need them + // in determing what exactly to build to satisfy demand the best + // Production is how much of this resource gets made each minute + // - we evaluate each links theoretical production of end resource (f.e. 1 Corn = 3/5 Sausages) + // - in chain production the speed is limited by slowest link + //todo -cComplicated: - resource in reserve adds to each production rate a fraction + // Consumption is how much gets consumed + // Balance = Production - Consumption; + + TKMCoreBalance = record + StoreBalance, SchoolBalance, InnBalance, BarracksBalance, TowerBalance: Single; + Balance: Single; //Resulting balance + end; + TKMMaterialsBalance = record + WoodcutTheory, SawmillTheory: Single; + WoodcutReserve, SawmillReserve: Single; + StoneReserve: Single; + StoneProduction, WoodProduction: Single; + StoneBalance, WoodBalance: Single; + Balance: Single; //Resulting balance + end; + TKMWareBalanceGold = record + CoalTheory, GoldOreTheory, GoldTheory: Single; + Production: Single; //How much do we produce + Consumption: Single; //How much is used + Reserve: Single; // + Balance: Single; //Resulting balance + end; + TKMWareBalanceFood = record + Bread: record + FarmTheory, MillTheory, BakeryTheory: Single; + end; + Sausages: record + FarmTheory, SwineTheory, ButchersTheory: Single; + end; + BreadProduction, SausagesProduction, WineProduction, FishProduction: Single; + Production: Single; //How much food do we produce + Consumption: Single; //How much food do we use + Reserve: Single; + Balance: Single; //Resulting balance + end; + TKMWareBalanceWarfare = record + SteelWeapon: record + CoalTheory, IronTheory, SteelTheory, SmithyTheory: Single; + end; + SteelArmor: record + CoalTheory, IronTheory, SteelTheory, SmithyTheory: Single; + end; + WoodWeapon: record + TrunkTheory, WoodTheory, WorkshopTheory: Single; + end; + LeatherArmor: record + TrunkTheory, WoodTheory: Single; //Shields + FarmTheory, SwineTheory, TanneryTheory: Single; //Armor + WorkshopTheory: Single; + end; + Horse: record + FarmTheory, StablesTheory: Single; + end; + + //Ratios at which warfare should be produced in workshops/smithies + OrderRatio: array[WEAPON_MIN..WEAPON_MAX] of Single; + + Warfare: array [WARFARE_MIN..WARFARE_MAX] of record + Production, Demand, Balance: Single; + end; + + Balance: Single; //Resulting balance + end; + + TWarfareDemands = array[WARFARE_MIN..WARFARE_MAX] of Single; + +type + TKMayorBalance = class + private + fOwner: TKMHandID; + + fAdvice: array of TKMHouseType; + + //The following are recalculated before each use, so they don't need saving + fCore: TKMCoreBalance; + fMaterials: TKMMaterialsBalance; + fGold: TKMWareBalanceGold; + fFood: TKMWareBalanceFood; + fWarfare: TKMWareBalanceWarfare; + + //For debugging (doesn't need saving) + fCoreText: UnicodeString; + fMaterialsText: UnicodeString; + fGoldText: UnicodeString; + fFoodText: UnicodeString; + fWarfareText: UnicodeString; + fAdviceText: UnicodeString; + + function WeaponUsed(aWare: TKMWareType): Boolean; + function AdviceContains(aHouse: TKMHouseType): Boolean; + + procedure AppendCore; + procedure AppendMaterials; + procedure AppendGold; + procedure AppendFood; + procedure AppendWeaponry; + + procedure Append(aHouse: TKMHouseType; aCount: Byte = 1); + function HouseCount(aHouse: TKMHouseType): Integer; + + procedure DistributeCorn; + procedure DistributeCoal; + procedure DistributeSteel; + procedure DistributeWood; + + procedure UpdateBalanceGold; + procedure UpdateBalanceCore; + procedure UpdateBalanceMaterials; + procedure UpdateBalanceFood; + procedure UpdateBalanceLeather; + procedure UpdateBalanceIron; + procedure UpdateBalanceWarfare; + public + GoldNeed: Single; //How much gold the town needs per minute (may change over time) + StoneNeed: Single; //How much building materials do we need for city development + WoodNeed: Single; //How much building materials do we need for city development + constructor Create(aPlayer: TKMHandID); + + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure Refresh; + function Peek: TKMHouseType; + procedure Take; + procedure Reject; + procedure SetArmyDemand(aNeeds: TWarfareDemands); + function BalanceText: UnicodeString; + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +implementation +uses + SysUtils, StrUtils, Math, KromUtils, + KM_Hand, KM_HandsCollection, KM_Resource, KM_ResWares, KM_ResHouses; + + +{ TKMayorBalance } +constructor TKMayorBalance.Create(aPlayer: TKMHandID); +begin + inherited Create; + fOwner := aPlayer; + + GoldNeed := 1; + StoneNeed := 10; + WoodNeed := 3.5; +end; + + +//How many houses of certain type we have (assume all wip houses will be finished) +function TKMayorBalance.HouseCount(aHouse: TKMHouseType): Integer; +begin + Result := gHands[fOwner].Stats.GetHouseTotal(aHouse); +end; + + +function TKMayorBalance.WeaponUsed(aWare: TKMWareType): Boolean; +begin + case gHands[fOwner].AI.Setup.ArmyType of + atLeather: Result := aWare in [wtWoodenShield, wtLeatherArmor, wtAxe, wtLance, wtBow, wtHorse]; + atIron: Result := aWare in [wtIronShield, wtIronArmor, wtSword, wtPike, wtCrossbow, wtHorse]; + atIronAndLeather: Result := True; + atIronThenLeather: Result := True; + else Result := False; + end; +end; + + +function TKMayorBalance.AdviceContains(aHouse: TKMHouseType): Boolean; +var I: Integer; +begin + Result := False; + for I := 0 to Length(fAdvice) - 1 do + if fAdvice[I] = aHouse then + begin + Result := True; + Exit; + end; +end; + + +procedure TKMayorBalance.Append(aHouse: TKMHouseType; aCount: Byte = 1); +var + I: Integer; +begin + //ArmorWorkshop is needed to produce Shields before Tannery is made + //Handle in generic way since in custom missions it might apply to other houses + if not gHands[fOwner].Locks.HouseCanBuild(aHouse) + and (gRes.Houses[aHouse].ReleasedBy <> htNone) //Storehouse might be blocked + and (gHands[fOwner].Stats.GetHouseTotal(gRes.Houses[aHouse].ReleasedBy) = 0) then + Append(gRes.Houses[aHouse].ReleasedBy); + + //If the same house is asked for independently then don't add it again, since f.e. gold and iron + //might both ask for a coal mine, when only 1 extra is needed. + for I := 0 to Length(fAdvice) - 1 do + if fAdvice[I] = aHouse then + begin + Dec(aCount); + if aCount = 0 then Exit; + end; + + SetLength(fAdvice, Length(fAdvice) + aCount); + for I := Length(fAdvice) - aCount to Length(fAdvice) - 1 do + fAdvice[I] := aHouse; +end; + + +//These houses are core for town development +procedure TKMayorBalance.AppendCore; +begin + with fCore do + case PickMin([0, StoreBalance, SchoolBalance, InnBalance, BarracksBalance, TowerBalance]) of + 0: ; + 1: Append(htStore); + 2: Append(htSchool); + 3: Append(htInn); + 4: Append(htBarracks); + 5: Append(htWatchTower); + end; +end; + + +procedure TKMayorBalance.AppendMaterials; +var + List: array [0..2] of Single; +begin + List[0] := fMaterials.StoneBalance; + List[1] := fMaterials.WoodcutTheory - WoodNeed; + List[2] := fMaterials.SawmillTheory - WoodNeed; + + repeat + //Do not build extra houses if we are low on building materials + if (gHands[fOwner].Stats.GetHouseQty(htQuarry) = 0) + and(gHands[fOwner].Stats.GetWareBalance(wtStone) + - gHands[fOwner].Constructions.FieldworksList.FieldCount(ftRoad) < 40) + and (AdviceContains(htQuarry) or (gHands[fOwner].Stats.GetHouseWip(htQuarry) > 1)) then + Break; + + case PickMin([0, List[0], List[1], List[2]]) of + 0: Break; + 1: begin + Append(htQuarry); + List[0] := List[0] + PRODUCTION_RATE[wtStone]; + end; + 2: begin + Append(htWoodcutters); + List[1] := List[1] + PRODUCTION_RATE[wtTrunk] * 2; //Each trunk brings 2 wood + end; + 3: begin + Append(htSawmill); + List[2] := List[2] + PRODUCTION_RATE[wtTimber]; + end; + end; + +{ if (fPlayers[fOwner].Stats.GetHouseQty(htQuary) = 0) + and (fPlayers[fOwner].Stats.GetWareBalance(wtStone) < 40) then + while not (Result in [htNone, htSchool, htQuary]) do + begin + Take; + Result := Peek; + end;} + + until False; +end; + + +//Increase Gold production +procedure TKMayorBalance.AppendGold; +begin + //If all 3 shares 0 we whould pick in that order Gold > Coal > Metallurgists + with fGold do + if Balance < 0 then + case PickMin([GoldOreTheory, CoalTheory, GoldTheory]) of + 0: Append(htGoldMine); + 1: Append(htCoalMine, 2); + 2: Append(htMetallurgists); + end; +end; + + +procedure TKMayorBalance.AppendFood; +var SkipSausage: Boolean; +begin + //When making iron only don't make sausages, they're inefficient if you don't use skins + SkipSausage := gHands[fOwner].AI.Setup.ArmyType = atIron; + + //Pick smallest production and increase it + //If all 3 shares 0 we whould pick Sausages first to ensure Leather supply + with fFood do + if Balance < 0 then + case PickMin([SausagesProduction + 10000*Byte(SkipSausage), BreadProduction, WineProduction]) of + 0: with Sausages do + case PickMin([FarmTheory, SwineTheory, ButchersTheory]) of + 0: Append(htFarm, 2); + 1: Append(htSwine); + 2: Append(htButchers); + end; + 1: with Bread do + case PickMin([FarmTheory, MillTheory, BakeryTheory]) of + 0: Append(htFarm, 2); + 1: Append(htMill); + 2: Append(htBakery); + end; + 2: Append(htVineyard); + end; +end; + + +procedure TKMayorBalance.AppendWeaponry; +const + MAX_WEAPON_TYPES = Byte(WARFARE_MAX) - Byte(WARFARE_MIN) + 1; +var + I, TmpWare: TKMWareType; + Tmp: Single; + WeaponsCount, J, K: Integer; + Weapons: array[0..MAX_WEAPON_TYPES-1] of TKMWareType; + WeaponSatisfactions: array[0..MAX_WEAPON_TYPES-1] of Single; +begin + //List all the required weapons + J := 0; + for I := WARFARE_MIN to WARFARE_MAX do + if WeaponUsed(I) and (fWarfare.Warfare[I].Demand > 0) + and (fWarfare.Warfare[I].Production < fWarfare.Warfare[I].Demand) then + begin + Weapons[J] := I; + //Calculate weapon production satisfaction rate (0..1) + WeaponSatisfactions[J] := fWarfare.Warfare[I].Production / Max(0.01,fWarfare.Warfare[I].Demand); + Inc(J); + end; + WeaponsCount := J; + + //Sort (since there's not many items bubble sort is okay for now) + for J := WeaponsCount-1 downto 0 do + for K := WeaponsCount-1 downto 0 do + if WeaponSatisfactions[J] > WeaponSatisfactions[K] then + begin + Tmp := WeaponSatisfactions[J]; + WeaponSatisfactions[J] := WeaponSatisfactions[K]; + WeaponSatisfactions[K] := Tmp; + + TmpWare := Weapons[J]; + Weapons[J] := Weapons[K]; + Weapons[K] := TmpWare; + end; + + for J := 0 to WeaponsCount-1 do + case Weapons[J] of + wtIronShield, + wtIronArmor: with fWarfare.SteelArmor do + case PickMin([CoalTheory, IronTheory, SteelTheory, SmithyTheory]) of + 0: Append(htCoalMine); + 1: Append(htIronMine); + 2: Append(htIronSmithy); + 3: Append(htArmorSmithy); + end; + wtSword, + wtPike, + wtCrossbow: with fWarfare.SteelWeapon do + case PickMin([CoalTheory, IronTheory, SteelTheory, SmithyTheory]) of + 0: Append(htCoalMine); + 1: Append(htIronMine); + 2: Append(htIronSmithy); + 3: Append(htWeaponSmithy); + end; + wtWoodenShield: with fWarfare.LeatherArmor do + case PickMin([TrunkTheory, WoodTheory, WorkshopTheory*fWarfare.OrderRatio[wtWoodenShield]]) of + 0: Append(htWoodcutters); + 1: Append(htSawmill); + 2: Append(htArmorWorkshop); + end; + wtLeatherArmor: with fWarfare.LeatherArmor do + case PickMin([FarmTheory, SwineTheory, TanneryTheory, WorkshopTheory*fWarfare.OrderRatio[wtLeatherArmor]]) of + 0: Append(htFarm); + 1: Append(htSwine); + 2: Append(htTannery); + 3: Append(htArmorWorkshop); + end; + wtAxe, + wtLance, + wtBow: with fWarfare.WoodWeapon do + case PickMin([TrunkTheory, WoodTheory, WorkshopTheory]) of + 0: Append(htWoodcutters); + 1: Append(htSawmill); + 2: Append(htWeaponWorkshop); + end; + wtHorse: with fWarfare.Horse do + case PickMin([FarmTheory, StablesTheory]) of + 0: Append(htFarm); + 1: Append(htStables); + end; + end; +end; + + +procedure TKMayorBalance.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + + +procedure TKMayorBalance.DistributeCoal; +var + CoalProductionRate, CoalConsumptionRate, CoalReserve: Single; + GoldPerMin, SteelPerMin, WeaponsPerMin, ArmorPerMin: Single; + ExtraCoal, DeficitCoal: Single; +begin + with fWarfare do + begin + //Theoretical gold production + GoldPerMin := Min(HouseCount(htGoldMine) * PRODUCTION_RATE[wtGoldOre] * 2, + HouseCount(htMetallurgists) * PRODUCTION_RATE[wtGold]); + + //Theoretical steel production + SteelPerMin := Min(HouseCount(htIronMine) * PRODUCTION_RATE[wtIronOre], + HouseCount(htIronSmithy) * PRODUCTION_RATE[wtIron]); + + //Theoretical weapon production + WeaponsPerMin := Min(HouseCount(htWeaponSmithy) * PRODUCTION_RATE[wtSword], + Warfare[wtSword].Demand + + Warfare[wtPike].Demand + + Warfare[wtCrossbow].Demand); + + //Theoretical armor production + ArmorPerMin := Min(HouseCount(htArmorSmithy) * PRODUCTION_RATE[wtIronArmor], + Warfare[wtIronShield].Demand + Warfare[wtIronArmor].Demand); + + //Current coal consumption + CoalConsumptionRate := GoldPerMin/2 + SteelPerMin + WeaponsPerMin + ArmorPerMin; + end; + CoalReserve := gHands[fOwner].Stats.GetWareBalance(wtCoal) / Max(1,CoalConsumptionRate); + CoalProductionRate := HouseCount(htCoalMine) * PRODUCTION_RATE[wtCoal] + Max(CoalReserve - 30, 0); + + if CoalProductionRate >= CoalConsumptionRate then + begin + //Let every industry think the extra belongs to it + ExtraCoal := CoalProductionRate - CoalConsumptionRate; + fGold.CoalTheory := GoldPerMin + ExtraCoal * 2; + fWarfare.SteelWeapon.CoalTheory := WeaponsPerMin + ExtraCoal / 2; //Takes 2 coal to make each weapon + fWarfare.SteelArmor.CoalTheory := ArmorPerMin + ExtraCoal / 2; //Takes 2 coal to make each armor + end + else + begin + //Sharing proportionaly doesn't work since closer houses get more. + //Let every industry think the deficit belongs to it + DeficitCoal := CoalConsumptionRate - CoalProductionRate; + fGold.CoalTheory := Max(0, GoldPerMin - DeficitCoal * 2); //Each coal makes 2 gold + fWarfare.SteelWeapon.CoalTheory := Max(0, WeaponsPerMin - DeficitCoal); + fWarfare.SteelArmor.CoalTheory := Max(0, ArmorPerMin - DeficitCoal); + end; +end; + + +procedure TKMayorBalance.DistributeSteel; +var + WeaponsPerMin, ArmorPerMin: Single; + + SteelPerMin, SteelConsumptionRate: Single; + ExtraSteel, DeficitSteel: Single; + + IronPerMin, IronProduction, IronConsumption, IronReserve: Single; + ExtraIron, RateIron: Single; +begin + SteelPerMin := HouseCount(htIronSmithy) * PRODUCTION_RATE[wtIron]; + IronPerMin := HouseCount(htIronMine) * PRODUCTION_RATE[wtIronOre]; + + with fWarfare do + begin + //Theoretical weapon production + WeaponsPerMin := Min(HouseCount(htWeaponSmithy) * PRODUCTION_RATE[wtSword], + Warfare[wtSword].Demand + + Warfare[wtPike].Demand + + Warfare[wtCrossbow].Demand); + + //Theoretical armor production + ArmorPerMin := Min(HouseCount(htArmorSmithy) * PRODUCTION_RATE[wtIronArmor], + Warfare[wtIronArmor].Demand + + Warfare[wtIronShield].Demand); + end; + + //Current steel consumption + SteelConsumptionRate := WeaponsPerMin + ArmorPerMin; + + if SteelPerMin >= SteelConsumptionRate then + begin + //Let every industry think the extra belongs to it + ExtraSteel := SteelPerMin - SteelConsumptionRate; + fWarfare.SteelWeapon.SteelTheory := WeaponsPerMin + ExtraSteel; + fWarfare.SteelArmor.SteelTheory := ArmorPerMin + ExtraSteel; + end + else + begin + //Sharing proportionaly doesn't work since closer houses get more. + //Let every industry think the deficit belongs to it + DeficitSteel := SteelConsumptionRate - SteelPerMin; + fWarfare.SteelWeapon.SteelTheory := Max(0, WeaponsPerMin - DeficitSteel); + fWarfare.SteelArmor.SteelTheory := Max(0, ArmorPerMin - DeficitSteel); + end; + + IronConsumption := SteelConsumptionRate; //Any not being used for steel is excess + IronReserve := gHands[fOwner].Stats.GetWareBalance(wtIronOre) / Max(1,IronConsumption); + IronProduction := IronPerMin + Max(IronReserve - 30, 0); + + if IronProduction >= IronConsumption then + begin + //Let every industry think the extra belongs to it + ExtraIron := IronProduction - IronConsumption; + fWarfare.SteelWeapon.IronTheory := WeaponsPerMin + ExtraIron; + fWarfare.SteelArmor.IronTheory := ArmorPerMin + ExtraIron; + end + else + begin + //Share proportionaly + RateIron := IronProduction / Max(1,IronConsumption); + fWarfare.SteelWeapon.IronTheory := RateIron * IronPerMin; + fWarfare.SteelArmor.IronTheory := RateIron * IronPerMin; + end; +end; + + +procedure TKMayorBalance.DistributeWood; +const + WEAP_COST = 2; + WT = 2; //Wood from Trunk ratio +var + TrunkPerMin, WoodPerMin: Single; + WeaponsPerMin, ShieldsPerMin: Single; + WoodProduction, WoodConsumption, WoodReserve: Single; + TrunkProduction, TrunkConsumption, TrunkReserve: Single; + ExtraWood, DeficitWood: Single; + ExtraTrunk, DeficitTrunk: Single; +begin + //Theoretical limit on Wood production + TrunkPerMin := HouseCount(htWoodcutters) * PRODUCTION_RATE[wtTrunk]; + WoodPerMin := HouseCount(htSawmill) * PRODUCTION_RATE[wtTimber]; + + with fWarfare do + begin + //Theoretical weapon production + WeaponsPerMin := Min(HouseCount(htWeaponWorkshop) * PRODUCTION_RATE[wtAxe], + Warfare[wtAxe].Demand + + Warfare[wtLance].Demand + + Warfare[wtBow].Demand); + + //Min from available production (shields are only part of workshops orders) and demand + ShieldsPerMin := Min(HouseCount(htArmorWorkshop) * OrderRatio[wtWoodenShield] * PRODUCTION_RATE[wtWoodenShield], + Warfare[wtWoodenShield].Demand); + + //Current wood consumption + WoodConsumption := WoodNeed + ShieldsPerMin + WeaponsPerMin * WEAP_COST; + WoodReserve := gHands[fOwner].Stats.GetWareBalance(wtTimber) / Max(1,WoodConsumption); + WoodProduction := WoodPerMin + Max(WoodReserve - 30, 0); + + //Wood shares + if WoodProduction >= WoodConsumption then + begin + //Let every industry think the extra belongs to it + ExtraWood := WoodProduction - WoodConsumption; + WoodWeapon.WoodTheory := WeaponsPerMin + ExtraWood / Max(1,WEAP_COST); + LeatherArmor.WoodTheory := ShieldsPerMin + ExtraWood; + end + else + begin + //Sharing proportionaly doesn't work since closer houses get more. + //Let every industry think the deficit belongs to it + if (WoodConsumption > 0) and (WoodProduction > WoodNeed) then + begin + DeficitWood := WoodConsumption - WoodProduction; + WoodWeapon.WoodTheory := Max(0, WeaponsPerMin - DeficitWood / Max(1,WEAP_COST)); + LeatherArmor.WoodTheory := Max(0, ShieldsPerMin - DeficitWood); + end + else + begin + WoodWeapon.WoodTheory := 0; + LeatherArmor.WoodTheory := 0; + end; + end; + + TrunkConsumption := WoodPerMin / Max(1,WT); + TrunkReserve := gHands[fOwner].Stats.GetWareBalance(wtTrunk) / Max(1,TrunkConsumption); + TrunkProduction := TrunkPerMin + Max(TrunkReserve - 30, 0); + + //Trunk shares + if TrunkProduction >= TrunkConsumption then + begin + //Let every industry think the extra belongs to it + ExtraTrunk := TrunkProduction - TrunkConsumption; + WoodWeapon.TrunkTheory := WeaponsPerMin + ExtraTrunk * WT / Max(1,WEAP_COST); + LeatherArmor.TrunkTheory := ShieldsPerMin + ExtraTrunk * WT; + end + else + begin + //Sharing proportionaly doesn't work since closer houses get more. + //Let every industry think the deficit belongs to it + if TrunkConsumption <> 0 then + begin + DeficitTrunk := TrunkConsumption - TrunkProduction; + WoodWeapon.TrunkTheory := Max(0, WeaponsPerMin - DeficitTrunk * WT / Max(1,WEAP_COST)); + LeatherArmor.TrunkTheory := Max(0, ShieldsPerMin - DeficitTrunk * WT); + end + else + begin + WoodWeapon.TrunkTheory := 0; + LeatherArmor.TrunkTheory := 0; + end; + end; + end; +end; + + +procedure TKMayorBalance.UpdateBalanceGold; +var GoldOreReserve: Single; +begin + with fGold do + begin + //How much Gold do we need + Consumption := GoldNeed + Byte(HouseCount(htBarracks) > 0) * gHands[fOwner].AI.Setup.WarriorsPerMinute; + + GoldOreReserve := gHands[fOwner].Stats.GetWareBalance(wtGoldOre) / Max(1,(2 * Consumption)); + + //How much gold in theory we could get + //CoalTheory - coal calculated separately + GoldOreTheory := HouseCount(htGoldMine) * PRODUCTION_RATE[wtGoldOre] * 2; //*2 since every Ore becomes 2 Gold + GoldOreTheory := GoldOreTheory + Max(0, GoldOreReserve - 30); + GoldTheory := HouseCount(htMetallurgists) * PRODUCTION_RATE[wtGold]; + + //Actual production is minimum of the above + Production := Min(CoalTheory, GoldOreTheory, GoldTheory); + + //How much reserve do we have + Reserve := gHands[fOwner].Stats.GetWareBalance(wtGold) / Max(1,Consumption); + + Balance := Production - Consumption + Max(Reserve - 30, 0); + + fGoldText := Format('%.2f Gold (%.2f - %.2f + %.2f)', [Balance, Production, Consumption, Reserve]); + end; +end; + + +procedure TKMayorBalance.UpdateBalanceLeather; +begin + with fWarfare do + begin + with WoodWeapon do + begin + //Trunk + //Wood + //All 3 produced at the same speed + WorkshopTheory := HouseCount(htWeaponWorkshop) * PRODUCTION_RATE[wtLance]; + + Warfare[wtAxe].Production := Min(TrunkTheory, WoodTheory, WorkshopTheory) * OrderRatio[wtAxe]; + Warfare[wtLance].Production := Min(TrunkTheory, WoodTheory, WorkshopTheory) * OrderRatio[wtLance]; + Warfare[wtBow].Production := Min(TrunkTheory, WoodTheory, WorkshopTheory) * OrderRatio[wtBow]; + end; + + with LeatherArmor do + begin + //Trunk + //Wood + //FarmTheory calculated above + SwineTheory := HouseCount(htSwine) * PRODUCTION_RATE[wtSkin] * 2; + TanneryTheory := HouseCount(htTannery) * PRODUCTION_RATE[wtLeather]; + WorkshopTheory := HouseCount(htArmorWorkshop) * PRODUCTION_RATE[wtLeatherArmor]; + + Warfare[wtWoodenShield].Production := Min(TrunkTheory, WoodTheory, WorkshopTheory * OrderRatio[wtWoodenShield]); + Warfare[wtLeatherArmor].Production := Min(Min(FarmTheory, SwineTheory), Min(TanneryTheory, WorkshopTheory * OrderRatio[wtLeatherArmor])); + end; + end; +end; + + +procedure TKMayorBalance.UpdateBalanceIron; +begin + with fWarfare do + begin + //Weapon + //Calculate how much Weapon each link could possibly produce + with SteelWeapon do + begin + //Coal/steel/iron calculated above + SmithyTheory := HouseCount(htWeaponSmithy) * PRODUCTION_RATE[wtPike]; + + //All 3 weapons are the same for now + Warfare[wtSword].Production := Min(Min(CoalTheory, IronTheory), Min(SteelTheory, SmithyTheory)) * OrderRatio[wtSword]; + Warfare[wtPike].Production := Min(Min(CoalTheory, IronTheory), Min(SteelTheory, SmithyTheory)) * OrderRatio[wtPike]; + Warfare[wtCrossbow].Production := Min(Min(CoalTheory, IronTheory), Min(SteelTheory, SmithyTheory)) * OrderRatio[wtCrossbow]; + end; + + //Armor + //Calculate how many Armor each link could possibly produce + with SteelArmor do + begin + //Coal/steel/iron calculated above + SmithyTheory := HouseCount(htArmorSmithy) * PRODUCTION_RATE[wtIronArmor]; + + Warfare[wtIronShield].Production := Min(Min(CoalTheory, IronTheory), Min(SteelTheory, SmithyTheory)) * OrderRatio[wtIronShield]; + Warfare[wtIronArmor].Production := Min(Min(CoalTheory, IronTheory), Min(SteelTheory, SmithyTheory)) * OrderRatio[wtIronArmor]; + end; + end; +end; + + +procedure TKMayorBalance.UpdateBalanceWarfare; +var + I: TKMWareType; + S: UnicodeString; +begin + UpdateBalanceLeather; + UpdateBalanceIron; + + with fWarfare do + begin + //Horse.FarmTheory calculated above + Horse.StablesTheory := HouseCount(htStables) * PRODUCTION_RATE[wtHorse]; + Warfare[wtHorse].Production := Min(Horse.FarmTheory, Horse.StablesTheory); + + for I := WARFARE_MIN to WARFARE_MAX do + Warfare[I].Balance := Warfare[I].Production - Warfare[I].Demand; + + //Set Weaponry balance to the most required warfare kind + Balance := MaxSingle; + for I := WARFARE_MIN to WARFARE_MAX do + if WeaponUsed(I) and (Warfare[I].Balance < Balance) then + Balance := Warfare[I].Balance; + + S := Format('%.2f Weaponry: |', [Balance]); + with fWarfare.LeatherArmor do + begin + S := S + Format('WoodShields: T%.1f : W%.1f : W%.1f|', [TrunkTheory, WoodTheory, WorkshopTheory*OrderRatio[wtWoodenShield]]); + S := S + Format('LeatherArm: F%.1f : S%.1f : T%.1f : W%.1f|', [FarmTheory, SwineTheory, TanneryTheory, WorkshopTheory*OrderRatio[wtLeatherArmor]]); + end; + + with fWarfare.WoodWeapon do + S := S + Format('WoodWeap: T%.1f W%.1f W%.1f|', [TrunkTheory, WoodTheory, WorkshopTheory]); + + with fWarfare.SteelArmor do + S := S + Format('SteelArmor: C%.1f : I%.1f : S%.1f : S%.1f|', [CoalTheory, IronTheory, SteelTheory, SmithyTheory]); + + with fWarfare.SteelWeapon do + S := S + Format('SteelWeapon: C%.1f : I%.1f : S%.1f : S%.1f|', [CoalTheory, IronTheory, SteelTheory, SmithyTheory]); + + for I := WARFARE_MIN to WARFARE_MAX do + if WeaponUsed(I) then + S := S + Format('%s: %.2f - %.2f|', [gRes.Wares[I].Title, Warfare[I].Production, Warfare[I].Demand]); + + fWarfareText := S; + end; +end; + + +procedure TKMayorBalance.UpdateBalanceCore; +var + P: TKMHand; +begin + P := gHands[fOwner]; + + with fCore do + begin + //Balance = Available - Required + Reserve + StoreBalance := HouseCount(htStore) - 1; //HouseCount(htAny) / 35; + //Build 2 schools if we need to equip a lot of warriors per minute + SchoolBalance := HouseCount(htSchool) - 1 - Byte((gHands[fOwner].Stats.GetHouseQty(htBarracks) > 0) and (gHands[fOwner].AI.Setup.WarriorsPerMinute > 2)); + InnBalance := HouseCount(htInn) - P.Stats.GetCitizensCount / 80; + BarracksBalance := HouseCount(htBarracks) - Byte(P.Stats.GetWarfareProduced > 0); + TowerBalance := HouseCount(htWatchTower) - 1 * gHands[fOwner].Stats.GetHouseQty(htBarracks); + + Balance := Min([StoreBalance, SchoolBalance, InnBalance, BarracksBalance, TowerBalance]); + fCoreText := Format + ('%.2f Core: (Store %.2f, School %.2f, Inn %.2f, Barracks %.2f, Tower %.2f)', + [Balance, StoreBalance, SchoolBalance, InnBalance, BarracksBalance, TowerBalance]); + end; +end; + + +procedure TKMayorBalance.UpdateBalanceMaterials; +begin + with fMaterials do + begin + //In some maps there is no stone so quarry is blocked + if gHands[fOwner].Locks.HouseBlocked[htQuarry] then + StoneProduction := 99999 + else + begin + StoneReserve := gHands[fOwner].Stats.GetWareBalance(wtStone) / Max(0.001,StoneNeed); + StoneProduction := HouseCount(htQuarry) * PRODUCTION_RATE[wtStone] + Max(StoneReserve - 30, 0); + end; + + WoodcutReserve := gHands[fOwner].Stats.GetWareBalance(wtTrunk) * 2 / Max(0.001,WoodNeed); + WoodcutTheory := HouseCount(htWoodcutters) * PRODUCTION_RATE[wtTrunk] * 2 + Max(WoodcutReserve - 30, 0); + + SawmillReserve := gHands[fOwner].Stats.GetWareBalance(wtTimber) / Max(0.001,WoodNeed); + SawmillTheory := HouseCount(htSawmill) * PRODUCTION_RATE[wtTimber] + Max(SawmillReserve - 30, 0); + WoodProduction := Min(WoodcutTheory, SawmillTheory); + + StoneBalance := StoneProduction - StoneNeed; + WoodBalance := WoodProduction - WoodNeed; + + Balance := Min(StoneBalance, WoodBalance); + fMaterialsText := Format('%.2f Materials: (Stone %.1f-%.1f, Wood (%.1f:%.1f)-%.1f)', + [Balance, StoneProduction, StoneNeed, WoodcutTheory, SawmillTheory, WoodNeed]); + end; +end; + + +procedure TKMayorBalance.DistributeCorn; +const + BEAST_COST = 4; +var + CornProduction, CornConsumption, CornReserve: Single; + FlourPerMin, PigPerMin, HorsePerMin: Single; + CornExtra, CornDeficit: Single; +begin + + //With stable production rate we can assume consumption rate that would be required + FlourPerMin := HouseCount(htMill) * PRODUCTION_RATE[wtFlour]; + PigPerMin := HouseCount(htSwine) * PRODUCTION_RATE[wtPig] * BEAST_COST; + HorsePerMin := HouseCount(htStables) * PRODUCTION_RATE[wtHorse] * BEAST_COST; + CornConsumption := FlourPerMin + PigPerMin + HorsePerMin; + CornReserve := gHands[fOwner].Stats.GetWareBalance(wtCorn) / Max(CornConsumption,0.001); + CornProduction := HouseCount(htFarm) * PRODUCTION_RATE[wtCorn] + Max(CornReserve - 30, 0); + + if CornProduction >= CornConsumption then + begin + //Let every industry think the extra belongs to it + CornExtra := CornProduction - CornConsumption; + fFood.Bread.FarmTheory := (FlourPerMin + CornExtra) * 2; + fFood.Sausages.FarmTheory := (PigPerMin + CornExtra) / BEAST_COST * 3; + fWarfare.LeatherArmor.FarmTheory := (PigPerMin + CornExtra) / BEAST_COST * 2; + fWarfare.Horse.FarmTheory := (HorsePerMin + CornExtra) / BEAST_COST; + end + else + begin + //Sharing proportionaly doesn't work since closer houses get more. + //Let every industry think the deficit belongs to it + CornDeficit := CornConsumption - CornProduction; + fFood.Bread.FarmTheory := Max(0, (FlourPerMin - CornDeficit) * 2); + fFood.Sausages.FarmTheory := Max(0, (PigPerMin - CornDeficit) / BEAST_COST * 3); + fWarfare.LeatherArmor.FarmTheory := Max(0, (PigPerMin - CornDeficit) / BEAST_COST * 2); + fWarfare.Horse.FarmTheory := Max(0, (HorsePerMin - CornDeficit) / BEAST_COST); + end; +end; + + +procedure TKMayorBalance.UpdateBalanceFood; +var + P: TKMHand; + UT: TKMUnitType; +begin + P := gHands[fOwner]; + + with fFood do + begin + //Bread + //Calculate how much bread each link could possibly produce + //Bread.FarmTheory calculated above + Bread.MillTheory := HouseCount(htMill) * PRODUCTION_RATE[wtFlour] * 2; + Bread.BakeryTheory := HouseCount(htBakery) * PRODUCTION_RATE[wtBread]; + BreadProduction := Min(Bread.FarmTheory, Bread.MillTheory, Bread.BakeryTheory); + + //Sausages + //Calculate how many sausages each link could possibly produce + //Sausages.FarmTheory calculated above + Sausages.SwineTheory := HouseCount(htSwine) * PRODUCTION_RATE[wtPig] * 3; + Sausages.ButchersTheory := HouseCount(htButchers) * PRODUCTION_RATE[wtSausage]; + SausagesProduction := Min(Sausages.FarmTheory, Sausages.SwineTheory, Sausages.ButchersTheory); + + //Wine, Fish + WineProduction := HouseCount(htVineyard) * PRODUCTION_RATE[wtWine]; + FishProduction := HouseCount(htFishermans) * PRODUCTION_RATE[wtFish]; + + //Count in "food units per minute" + Production := BreadProduction * BREAD_RESTORE + + SausagesProduction * SAUSAGE_RESTORE + + WineProduction * WINE_RESTORE + + FishProduction * FISH_RESTORE; + + Consumption := 0; + + for UT := CITIZEN_MIN to CITIZEN_MAX do + Consumption := Consumption + P.Stats.GetUnitQty(UT) / 40; //On average unit needs to eat each 40min + + Consumption := Consumption * 1.2; //Otherwise not enough food is made for citizens + + //Warriors eat on average half as much as citizens + for UT := WARRIOR_MIN to WARRIOR_MAX do + Consumption := Consumption + P.Stats.GetUnitQty(UT) / 2 / 40; //On average unit needs to eat each 40min + + Reserve := gHands[fOwner].Stats.GetWareBalance(wtBread) * BREAD_RESTORE + + gHands[fOwner].Stats.GetWareBalance(wtSausage) * SAUSAGE_RESTORE + + gHands[fOwner].Stats.GetWareBalance(wtWine) * WINE_RESTORE + + gHands[fOwner].Stats.GetWareBalance(wtFish) * FISH_RESTORE; + Reserve := Reserve / Max(1,Consumption); + + Balance := Production - Consumption + Max(Reserve - 30, 0); + fFoodText := Format('%.2f Food: %.2f - %.2f + %.2f|', [Balance, Production, Consumption, Reserve]) + + Format(' Bread: min(F%.2f, M%.2f, B%.2f)|', [Bread.FarmTheory, Bread.MillTheory, Bread.BakeryTheory]) + + Format(' Sausages: min(F%.2f, S%.2f, B%.2f)|', [Sausages.FarmTheory, Sausages.SwineTheory, Sausages.ButchersTheory]) + + Format(' Wine: W%.2f)|', [WineProduction]) + + Format(' Fish: F%.2f)|', [FishProduction]) + + Format(' Food value: %.2f + %.2f + %.2f + %.2f|', [BreadProduction * BREAD_RESTORE, SausagesProduction * SAUSAGE_RESTORE, WineProduction * WINE_RESTORE, FishProduction * FISH_RESTORE]); + end; +end; + + +//Tell Mayor what proportions of army is needed +procedure TKMayorBalance.SetArmyDemand(aNeeds: TWarfareDemands); +var + WT: TKMWareType; +begin + //Convert army request into how many weapons are needed + with fWarfare do + begin + for WT := WARFARE_MIN to WARFARE_MAX do + Warfare[WT].Demand := aNeeds[WT]; + + //Calculate ratios at which warfare should be produced in workshops + OrderRatio[wtWoodenShield] := aNeeds[wtWoodenShield] / Max(0.001,(aNeeds[wtWoodenShield] + aNeeds[wtLeatherArmor])); + OrderRatio[wtLeatherArmor] := aNeeds[wtLeatherArmor] / Max(0.001,(aNeeds[wtWoodenShield] + aNeeds[wtLeatherArmor])); + OrderRatio[wtAxe] := aNeeds[wtAxe] / Max(0.001,(aNeeds[wtAxe] + aNeeds[wtLance] + aNeeds[wtBow])); + OrderRatio[wtLance] := aNeeds[wtLance] / Max(0.001,(aNeeds[wtAxe] + aNeeds[wtLance] + aNeeds[wtBow])); + OrderRatio[wtBow] := aNeeds[wtBow] / Max(0.001,(aNeeds[wtAxe] + aNeeds[wtLance] + aNeeds[wtBow])); + + OrderRatio[wtIronShield] := aNeeds[wtIronShield] / Max(0.001,(aNeeds[wtIronShield] + aNeeds[wtIronArmor])); + OrderRatio[wtIronArmor] := aNeeds[wtIronArmor] / Max(0.001,(aNeeds[wtIronShield] + aNeeds[wtIronArmor])); + OrderRatio[wtSword] := aNeeds[wtSword] / Max(0.001,(aNeeds[wtSword] + aNeeds[wtPike] + aNeeds[wtCrossbow])); + OrderRatio[wtPike] := aNeeds[wtPike] / Max(0.001,(aNeeds[wtSword] + aNeeds[wtPike] + aNeeds[wtCrossbow])); + OrderRatio[wtCrossbow] := aNeeds[wtCrossbow] / Max(0.001,(aNeeds[wtSword] + aNeeds[wtPike] + aNeeds[wtCrossbow])); + end; +end; + + +function TKMayorBalance.BalanceText: UnicodeString; +begin + Result := fCoreText + '|' + + fMaterialsText + '|' + + fGoldText + '|' + + fFoodText + '|' + + fWarfareText + '|' + + fAdviceText; +end; + + +procedure TKMayorBalance.Refresh; +var + I: Integer; +begin + SetLength(fAdvice, 0); + try + //Refresh balance of each industry + //Try to express needs in terms of Balance = Production - Demand + UpdateBalanceCore; + AppendCore; + + //Don't build anything if we don't have a working School + if gHands[fOwner].Stats.GetHouseQty(htSchool) = 0 then Exit; + + UpdateBalanceMaterials; + AppendMaterials; + + //Don't build anything if we are short on materials + if (fMaterials.StoneProduction < 0.5) + or (fMaterials.WoodProduction < 0.5) then Exit; + + DistributeCorn; + DistributeCoal; + DistributeSteel; + DistributeWood; + + UpdateBalanceGold; + AppendGold; + + UpdateBalanceFood; + AppendFood; + + UpdateBalanceWarfare; + AppendWeaponry; + + finally + fAdviceText := 'Advice: '; + for I := 0 to High(fAdvice) do + fAdviceText := fAdviceText + gRes.Houses[fAdvice[I]].HouseName + IfThen(I < High(fAdvice), ', ', '.'); + end; +end; + + +//Look at next item in advice queue +function TKMayorBalance.Peek: TKMHouseType; +begin + //Take element from fAdvice queue + if Length(fAdvice) > 0 then + Result := fAdvice[0] + else + Result := htNone; +end; + + +//Reject the item because it could not be built +procedure TKMayorBalance.Reject; +begin + Take; + + //Some logic that would not build anything and waste resources on that + //if we dont have e.g. gold supply +end; + + +//Advised item was taken and most certainly will be finished +procedure TKMayorBalance.Take; +begin + if Length(fAdvice) > 1 then + Move(fAdvice[1], fAdvice[0], Length(fAdvice) - 1); + + //Trim last element + SetLength(fAdvice, Length(fAdvice) - 1); +end; + + +procedure TKMayorBalance.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('AIMayorBalance'); + SaveStream.Write(fOwner); + + SaveStream.Write(GoldNeed); + SaveStream.Write(StoneNeed); + SaveStream.Write(WoodNeed); + + //Save because there are demands for weaponry (set by General) + SaveStream.Write(fWarfare.Warfare, SizeOf(fWarfare.Warfare)); + SaveStream.Write(fWarfare.OrderRatio, SizeOf(fWarfare.OrderRatio)); + + //These are not saved because they are recalculated before each use + {LoadStream.Read(fDemandCore, SizeOf(fDemandCore)); + LoadStream.Read(fDemandMaterials, SizeOf(fDemandMaterials)); + LoadStream.Read(fDemandGold, SizeOf(fDemandGold)); + LoadStream.Read(fDemandFood, SizeOf(fDemandFood)); + LoadStream.Read(fDemandWeaponry, SizeOf(fDemandWeaponry));} +end; + + +procedure TKMayorBalance.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('AIMayorBalance'); + LoadStream.Read(fOwner); + + LoadStream.Read(GoldNeed); + LoadStream.Read(StoneNeed); + LoadStream.Read(WoodNeed); + + //Load demands for weaponry set by General + LoadStream.Read(fWarfare.Warfare, SizeOf(fWarfare.Warfare)); + LoadStream.Read(fWarfare.OrderRatio, SizeOf(fWarfare.OrderRatio)); + + //These are not saved because they are recalculated before each use + {LoadStream.Read(fDemandCore, SizeOf(fDemandCore)); + LoadStream.Read(fDemandMaterials, SizeOf(fDemandMaterials)); + LoadStream.Read(fDemandGold, SizeOf(fDemandGold)); + LoadStream.Read(fDemandFood, SizeOf(fDemandFood)); + LoadStream.Read(fDemandWeaponry, SizeOf(fDemandWeaponry));} +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AISetup.pas b/vendor/kam_remake/src/ai/KM_AISetup.pas new file mode 100644 index 0000000..f8798fd --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AISetup.pas @@ -0,0 +1,214 @@ +unit KM_AISetup; +{$I KaM_Remake.inc} +interface +uses + KM_CommonClasses, KM_Defaults, KM_Points, KM_AITypes; + + +type + // Common AI settings + // Could be a record, but we want to have default values initialization in constructor + TKMHandAISetup = class + private + fNewAI: Boolean; // Enable advanced AI + fRepairMode: TKMAIRepairMode; + function GetNewAI: Boolean; + function GetIsRepairAlways: Boolean; + public + Aggressiveness: Integer; //-1 means not used or default + AutoAttack: Boolean; + + AutoBuild: Boolean; // Enable build + AutoDefend: Boolean; + DefendAllies: Boolean; + UnlimitedEquip: Boolean; + ArmyType: TKMArmyType; + EquipRateLeather, EquipRateIron: Word; //Number of ticks between soldiers being equipped. Separated into Leather/Iron to keep KaM compatibility. + MaxSoldiers: Integer; //-1 means not used or default + RecruitDelay: Cardinal; //Recruits (for barracks) can only be trained after this many ticks + RecruitCount: Byte; + SerfsPerHouse: Single; + StartPosition: TKMPoint; //Defines roughly where to defend and build around + TownDefence: Integer; //-1 means not used or default + WorkerCount: Byte; + AutoAttackRange: Byte; // Auto attack range for close combat warriors (used in KM_UnitWarrior) + + constructor Create; + + property NewAI: Boolean read GetNewAI write fNewAI; + property RepairMode: TKMAIRepairMode read fRepairMode write fRepairMode; + property IsRepairAlways: Boolean read GetIsRepairAlways; + + function GetEquipRate(aUnit: TKMUnitType): Word; + function WarriorsPerMinute(aArmy: TKMArmyType): Single; overload; + function WarriorsPerMinute: Single; overload; + + procedure ApplyMultiplayerSetup(aNewAI: Boolean); + procedure EnableAdvancedAI(aNewAI: Boolean = True); + + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +implementation +uses + Math; + + +{ TKMHandAISetup } +constructor TKMHandAISetup.Create; +begin + inherited; + + //TSK/TPR properties + Aggressiveness := 100; //No idea what the default for this is, it's barely used + AutoAttack := False; //It did not exist in KaM, we add it, Off by default + AutoBuild := True; //In KaM it is On by default, and most missions turn it off + AutoDefend := False; //It did not exist in KaM, we add it, Off by default + RepairMode := rmRepairNever; + DefendAllies := False; //It did not exist in KaM, we add it, Off by default (tested by Lewin, AI doesn't defend allies in TPR) + + ArmyType := atIronThenLeather; //By default make iron soldiers, and if that fails make leather (same as TPR) + EquipRateIron := 500; //Measured in KaM: AI equips 1 iron soldier every ~50 seconds + EquipRateLeather := 1000; //Measured in KaM: AI equips 1 leather soldier every ~100 seconds (if no iron one was already equipped) + MaxSoldiers := -1; //No limit by default + WorkerCount := 6; + RecruitCount := 5; //This means the number in the barracks, watchtowers are counted separately + RecruitDelay := 0; //Can train at start + SerfsPerHouse := 1; + StartPosition := TKMPoint.New(1,1); + TownDefence := 100; //In KaM 100 is standard, although we don't completely understand this command + AutoAttackRange := 4; //Measured in TPR +end; + + +function TKMHandAISetup.GetEquipRate(aUnit: TKMUnitType): Word; +begin + if aUnit in WARRIORS_IRON then + Result := EquipRateIron + else + Result := EquipRateLeather; +end; + + +function TKMHandAISetup.GetIsRepairAlways: Boolean; +begin + Result := fRepairMode = rmRepairAlways; +end; + + +function TKMHandAISetup.GetNewAI: Boolean; +begin + if Self = nil then Exit(False); + + Result := fNewAI; +end; + + +function TKMHandAISetup.WarriorsPerMinute(aArmy: TKMArmyType): Single; + + function EquipRateToPerMin(EquipRate: Cardinal): Single; + begin + Result := EnsureRange(600 / Max(EquipRate, 1), 0.1, 6); + end; + +begin + case aArmy of + atIronThenLeather: Result := Max(EquipRateToPerMin(EquipRateLeather), EquipRateToPerMin(EquipRateIron)); + atLeather: Result := EquipRateToPerMin(EquipRateLeather); + atIron: Result := EquipRateToPerMin(EquipRateIron); + atIronAndLeather: Result := EquipRateToPerMin(EquipRateLeather) + EquipRateToPerMin(EquipRateIron); + else Result := 0; + end; +end; + + +function TKMHandAISetup.WarriorsPerMinute: Single; +begin + Result := WarriorsPerMinute(ArmyType); +end; + + +//Used from MapEd to give multiplayer building maps an AI builder config +procedure TKMHandAISetup.ApplyMultiplayerSetup(aNewAI: Boolean); +begin + SerfsPerHouse := 1; + WorkerCount := 20; + ArmyType := atIronAndLeather; //Mixed army + EquipRateLeather := 500; + EquipRateIron := 500; + AutoBuild := True; + RepairMode := rmRepairAlways; + AutoAttack := True; + AutoDefend := True; + DefendAllies := True; + UnlimitedEquip := True; + StartPosition := TKMPoint.New(1,1); //So it is overridden by auto attack + MaxSoldiers := -1; + RecruitDelay := 0; + RecruitCount := 10; + AutoAttackRange := 6; + EnableAdvancedAI(aNewAI); +end; + + +procedure TKMHandAISetup.EnableAdvancedAI(aNewAI: Boolean = True); +begin + NewAI := aNewAI; + if NewAI then + AutoAttackRange := 0; // It force units to attack the closest enemy (it should decide AI not command) +end; + + +procedure TKMHandAISetup.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('AISetup'); + SaveStream.Write(fNewAI); + SaveStream.Write(Aggressiveness); + SaveStream.Write(AutoAttack); + SaveStream.Write(AutoBuild); + SaveStream.Write(fRepairMode, SizeOf(fRepairMode)); + SaveStream.Write(AutoDefend); + SaveStream.Write(DefendAllies); + SaveStream.Write(UnlimitedEquip); + SaveStream.Write(ArmyType, SizeOf(ArmyType)); + SaveStream.Write(EquipRateLeather); + SaveStream.Write(EquipRateIron); + SaveStream.Write(MaxSoldiers); + SaveStream.Write(RecruitDelay); + SaveStream.Write(RecruitCount); + SaveStream.Write(SerfsPerHouse); + SaveStream.Write(StartPosition); + SaveStream.Write(TownDefence); + SaveStream.Write(WorkerCount); + SaveStream.Write(AutoAttackRange); +end; + + +procedure TKMHandAISetup.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('AISetup'); + LoadStream.Read(fNewAI); + LoadStream.Read(Aggressiveness); + LoadStream.Read(AutoAttack); + LoadStream.Read(AutoBuild); + LoadStream.Read(fRepairMode, SizeOf(fRepairMode)); + LoadStream.Read(AutoDefend); + LoadStream.Read(DefendAllies); + LoadStream.Read(UnlimitedEquip); + LoadStream.Read(ArmyType, SizeOf(ArmyType)); + LoadStream.Read(EquipRateLeather); + LoadStream.Read(EquipRateIron); + LoadStream.Read(MaxSoldiers); + LoadStream.Read(RecruitDelay); + LoadStream.Read(RecruitCount); + LoadStream.Read(SerfsPerHouse); + LoadStream.Read(StartPosition); + LoadStream.Read(TownDefence); + LoadStream.Read(WorkerCount); + LoadStream.Read(AutoAttackRange); +end; + + +end. diff --git a/vendor/kam_remake/src/ai/KM_AITypes.pas b/vendor/kam_remake/src/ai/KM_AITypes.pas new file mode 100644 index 0000000..3eb9f6e --- /dev/null +++ b/vendor/kam_remake/src/ai/KM_AITypes.pas @@ -0,0 +1,47 @@ +unit KM_AITypes; +{$I KaM_Remake.inc} +interface + +type + //* AI defence position type + // For now IDs must match with KaM + TKMAIDefencePosType = (dtFrontLine, //Front line troops may not go on attacks, they are for defence + dtBackLine); //Back line troops may attack + //* AI attack type + TKMAIAttackType = ( + aatOnce, // Attack will occur once (after the set time has passed and if they have enough troops + aatRepeating // Attack will happen multiple times, (after delay time) whenever the AI has enough troops + ); + + //* AI attack target + //Indexes must match with KaM script values (for now) + TKMAIAttackTarget = (attClosestUnit, //Closest enemy unit (untested as to whether this is relative to army or start position) + attClosestBuildingFromArmy, //Closest building from the group(s) lauching the attack + attClosestBuildingFromStartPos, //Closest building from the AI's start position + attCustomPosition); //Custom point defined with CustomPosition + + TKMFormation = record + NumUnits: Integer; + UnitsPerRow: Integer; + procedure CopyFrom(aFormation: TKMFormation); + end; + + //* House repair mode + TKMAIRepairMode = ( + rmNone, + rmRepairNever, // disable AI repair for all houses + rmRepairAlways, // enable AI repair for all houses + rmRepairManual); // repair state is set by script manually via Actions.HouseRepairEnable + +implementation + +{ TKMFormation } +procedure TKMFormation.CopyFrom(aFormation: TKMFormation); +begin + NumUnits := aFormation.NumUnits; + UnitsPerRow := aFormation.UnitsPerRow; +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_AIParameters.pas b/vendor/kam_remake/src/ai/newAI/KM_AIParameters.pas new file mode 100644 index 0000000..f3fde31 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_AIParameters.pas @@ -0,0 +1,762 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_AIParameters; +{$I KaM_Remake.inc} + +interface +uses + SysUtils +{$IFDEF PARALLEL_RUNNER}, KM_CommonClasses; +{$ELSE}; +{$ENDIF} + +{$IFDEF PARALLEL_RUNNER} + procedure LoadGAParameters(LoadStream: TKMemoryStream); + procedure SaveGAParameters(SaveStream: TKMemoryStream); +{$ENDIF} + + +// AI parameters in enumerations +type + + TAIPar = ( + + ATTACK_ArmyVectorField_START + ,ATTACK_ArmyVectorField_FindPositions_DistEnemyOffset + ,ATTACK_ArmyVectorField_FindPositions_DistEnemyOffsetFF + ,ATTACK_ArmyVectorField_FindPositions_DistEnemyGainFF + ,ATTACK_ArmyVectorField_FindPositions_DistCloseToEnemy + ,ATTACK_ArmyVectorField_FindPositions_DistMaxWalk + ,ATTACK_ArmyVectorField_FindPositions_FollowEnemyVectorFieldUth + ,ATTACK_ArmyVectorField_FindPositions_AvoidTraffic + ,ATTACK_ArmyVectorField_FindPositions_RallyPointOffset + ,ATTACK_ArmyVectorField_EvalClusters_InPlace + ,ATTACK_ArmyVectorField_EvalClusters_AtAdvantage + ,ATTACK_ArmyVectorField_EvalClusters_Ambushed + ,ATTACK_ArmyVectorField_DivideForces_DefendCityAdv + ,ATTACK_ArmyVectorField_DivideForces_SupportAllyAdv + ,ATTACK_ArmyVectorField_END + + ,ATTACK_SQUAD_START + ,ATTACK_SQUAD_ChangeTarget_Delay + ,ATTACK_SQUAD_MinWalkingDistance + ,ATTACK_SQUAD_TargetReached_House + ,ATTACK_SQUAD_TargetReached_Position + ,ATTACK_SQUAD_TargetReached_RangedSquad + ,ATTACK_SQUAD_TargetReached_Unit + ,ATTACK_SQUAD_TrafficDetection_Limit + ,ATTACK_SQUAD_TrafficDetection_Threshold + ,ATTACK_SQUAD_END + + ,ATTACK_SUPERVISOR_START + ,ATTACK_SUPERVISOR_EvalTarget_DistanceGroup + ,ATTACK_SUPERVISOR_EvalTarget_OpportunityDistGain + ,ATTACK_SUPERVISOR_EvalTarget_OpportunityGain + ,ATTACK_SUPERVISOR_EvalTarget_DecreaseRisk + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainAntiHorse + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainDist + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainMelee + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainMounted + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainRangDist + ,ATTACK_SUPERVISOR_EvalTarget_ThreatGainRanged + ,ATTACK_SUPERVISOR_END + + ,NAVMESH_PATHFINDING_START + ,NAVMESH_PATHFINDING_AvoidTraffic + ,NAVMESH_PATHFINDING_LineLength + ,NAVMESH_PATHFINDING_AvoidSpecEnemy + ,NAVMESH_PATHFINDING_END + + ,BUILDER_START + ,BUILDER_BuildHouse_FieldMaxWork + ,BUILDER_BuildHouse_RTPMaxWork + ,BUILDER_BuildHouse_RoadMaxWork + ,BUILDER_ChHTB_AllWorkerCoef + ,BUILDER_ChHTB_FractionCoef + ,BUILDER_ChHTB_FreeWorkerCoef + ,BUILDER_ChHTB_TrunkBalance + ,BUILDER_ChHTB_TrunkFactor + ,BUILDER_CreateShortcuts_MaxWork + ,BUILDER_Shortage_Gold + ,BUILDER_Shortage_Stone + ,BUILDER_Shortage_StoneReserve + ,BUILDER_Shortage_Trunk + ,BUILDER_Shortage_Wood + ,BUILDER_END + + ,EYE_GetForests_START + ,EYE_GetForests_MaxAB + ,EYE_GetForests_MinRndSoil + ,EYE_GetForests_MinTrees + ,EYE_GetForests_Radius + ,EYE_GetForests_SPRndOwnLimMax + ,EYE_GetForests_SPRndOwnLimMin + ,EYE_GetForests_END + + ,MANAGEMENT_START + ,MANAGEMENT_CheckUnitCount_SerfGoldCoef + ,MANAGEMENT_CheckUnitCount_SerfLimit1 + ,MANAGEMENT_CheckUnitCount_SerfLimit2 + ,MANAGEMENT_CheckUnitCount_SerfLimit3 + ,MANAGEMENT_CheckUnitCount_WorkerGoldCoef + ,MANAGEMENT_GoldShortage + ,MANAGEMENT_END + + ,PLANNER_FARM_START + ,PLANNER_FARM_FieldCrit_FlatArea + ,PLANNER_FARM_FieldCrit_PolyRoute + ,PLANNER_FARM_FieldCrit_Soil + ,PLANNER_FARM_FindPlaceForHouse_CityCenter + ,PLANNER_FARM_FindPlaceForHouse_FlatArea + ,PLANNER_FARM_FindPlaceForHouse_HouseDist + ,PLANNER_FARM_FindPlaceForHouse_Route + ,PLANNER_FARM_PlanFields_CanBuild + ,PLANNER_FARM_PlanFields_Dist + ,PLANNER_FARM_PlanFields_ExistField + ,PLANNER_FARM_END + + ,PLANNER_FindPlaceForHouse_START + ,PLANNER_FindPlaceForHouse_CityCenter + ,PLANNER_FindPlaceForHouse_FlatArea + ,PLANNER_FindPlaceForHouse_HouseDist + ,PLANNER_FindPlaceForHouse_Route + ,PLANNER_FindPlaceForHouse_SeedDist + ,PLANNER_FindPlaceForHouse_SnapCrit + ,PLANNER_FindPlaceForHouse_END + + ,PLANNER_FindPlaceForQuary_START + ,MANAGEMENT_CheckStoreWares_Stone + ,PREDICTOR_WareNeedPerAWorker_Stone + ,PREDICTOR_WareNeedPerAWorker_StoneOffset + ,PREDICTOR_WorkerCountCoef + ,PLANNER_FindPlaceForQuary_StoneLoc_StoneCnt + ,PLANNER_FindPlaceForQuary_StoneLoc_AlreadyMined + ,PLANNER_FindPlaceForQuary_StoneLoc_Distance + ,PLANNER_FindPlaceForQuary_DistCity + ,PLANNER_FindPlaceForQuary_DistStone + ,PLANNER_FindPlaceForQuary_DistTimer + ,PLANNER_FindPlaceForQuary_Obstacle + ,PLANNER_FindPlaceForQuary_SnapCrit + ,PLANNER_FindPlaceForQuary_QtyStone + ,PLANNER_FindPlaceForQuary_END + + ,PLANNER_FOREST_START + ,PLANNER_FOREST_FindForestAround_MaxDist + ,PLANNER_FOREST_FindPlaceForWoodcutter_ABRange + ,PLANNER_FOREST_FindPlaceForWoodcutter_DistCrit + ,PLANNER_FOREST_FindPlaceForWoodcutter_DistTimer + ,PLANNER_FOREST_FindPlaceForWoodcutter_ExistForest + ,PLANNER_FOREST_FindPlaceForWoodcutter_FlatArea + ,PLANNER_FOREST_FindPlaceForWoodcutter_FreeTiles + ,PLANNER_FOREST_FindPlaceForWoodcutter_Radius + ,PLANNER_FOREST_FindPlaceForWoodcutter_Routes + ,PLANNER_FOREST_FindPlaceForWoodcutter_Soil + ,PLANNER_FOREST_FindPlaceForWoodcutter_TreeCnt + ,PLANNER_FOREST_FindPlaceForWoodcutter_TreeCntTimer + ,PLANNER_FOREST_PlaceWoodcutter_DistFromForest + ,PLANNER_FOREST_END + + ,PLANNER_Snap_START + ,PLANNER_ObstaclesInHousePlan_Road + ,PLANNER_ObstaclesInHousePlan_Tree + ,PLANNER_SnapCrit_Field + ,PLANNER_SnapCrit_HouseOrRoad + ,PLANNER_SnapCrit_NoBuild + ,PLANNER_SnapCrit_ObstacleInEntrance + ,PLANNER_SnapCrit_Road + ,PLANNER_SnapCrit_RoadInEntrance + ,PLANNER_Snap_END + + ,PREDICTOR_START + ,PREDICTOR_SecondSchool_MinRequiredUnits + ,PREDICTOR_WareNeedPerAWorker_Wood + ,PREDICTOR_END + + ,SHORTCUTS_START + ,SHORTCUTS_BasePrice + ,SHORTCUTS_Coal + ,SHORTCUTS_Field + ,SHORTCUTS_Forest + ,SHORTCUTS_OtherCase + ,SHORTCUTS_Road + ,SHORTCUTS_TurnPenalization + ,SHORTCUTS_noBuildArea + ,SHORTCUTS_END + + ,ROADS_START + ,ROADS_BasePrice + ,ROADS_Coal + ,ROADS_Field + ,ROADS_Forest + ,ROADS_OtherCase + ,ROADS_Road + ,ROADS_TurnPenalization + ,ROADS_noBuildArea + ,ROADS_END + ); + + +// Global constants for AI +//const + +// Global variables for AI +{$IFDEF DEBUG_NewAI} +var +{$ELSE} +const +{$ENDIF} + + + AI_Par: array[TAIPar] of Single = ( + 0.0000000, // ATTACK_ArmyVectorField_START + 23.8595066, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffset + 17.4091473, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffsetFF + 1.5993488, // ATTACK_ArmyVectorField_FindPositions_DistEnemyGainFF + 16.9659538, // ATTACK_ArmyVectorField_FindPositions_DistCloseToEnemy + 6.5492649, // ATTACK_ArmyVectorField_FindPositions_DistMaxWalk + 15.9957075, // ATTACK_ArmyVectorField_FindPositions_FollowEnemyVectorFieldUth + 9.1061239, // ATTACK_ArmyVectorField_FindPositions_AvoidTraffic + 7.7757473, // ATTACK_ArmyVectorField_FindPositions_RallyPointOffset + 0.9000000, // ATTACK_ArmyVectorField_EvalClusters_InPlace + 2.1793294, // ATTACK_ArmyVectorField_EvalClusters_AtAdvantage + 0.0341255, // ATTACK_ArmyVectorField_EvalClusters_Ambushed + 0.5000000, // ATTACK_ArmyVectorField_DivideForces_DefendCityAdv + 0.1121276, // ATTACK_ArmyVectorField_DivideForces_SupportAllyAdv + 0.0000000, // ATTACK_ArmyVectorField_END + + 0.0000000, // ATTACK_SQUAD_START + 416.4127197, // ATTACK_SQUAD_ChangeTarget_Delay + 5.0000000, // ATTACK_SQUAD_MinWalkingDistance + 8.0000000, // ATTACK_SQUAD_TargetReached_House + 5.0000000, // ATTACK_SQUAD_TargetReached_Position + 10.2428083, // ATTACK_SQUAD_TargetReached_RangedSquad + 35.0000000, // ATTACK_SQUAD_TargetReached_Unit + 1.0000000, // ATTACK_SQUAD_TrafficDetection_Limit + 10.0000000, // ATTACK_SQUAD_TrafficDetection_Threshold + 0.0000000, // ATTACK_SQUAD_END + + 0.0000000, // ATTACK_SUPERVISOR_START + 22.1900902, // ATTACK_SUPERVISOR_EvalTarget_DistanceGroup + 3.9091630, // ATTACK_SUPERVISOR_EvalTarget_OpportunityDistGain + 3.3577795, // ATTACK_SUPERVISOR_EvalTarget_OpportunityGain + 0.6074438, // ATTACK_SUPERVISOR_EvalTarget_DecreaseRisk + 6.6606860, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainAntiHorse + 6.9580350, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainDist + 2.6582916, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMelee + 3.9733243, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMounted + 2.8656545, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRangDist + 1.3565565, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRanged + 0.0000000, // ATTACK_SUPERVISOR_END + + 0.0000000, // NAVMESH_PATHFINDING_START + 0.4070168, // NAVMESH_PATHFINDING_AvoidTraffic + 1.1412202, // NAVMESH_PATHFINDING_LineLength + 5.1420155, // NAVMESH_PATHFINDING_AvoidSpecEnemy + 0.0000000, // NAVMESH_PATHFINDING_END + + 0.0000000, // BUILDER_START + 1.6684477, // BUILDER_BuildHouse_FieldMaxWork + 11.6014986, // BUILDER_BuildHouse_RTPMaxWork + 21.6772480, // BUILDER_BuildHouse_RoadMaxWork + 8.1070709, // BUILDER_ChHTB_AllWorkerCoef + 21.3621922, // BUILDER_ChHTB_FractionCoef + 17.1468201, // BUILDER_ChHTB_FreeWorkerCoef + 0.2159205, // BUILDER_ChHTB_TrunkBalance + 11.5937538, // BUILDER_ChHTB_TrunkFactor + 10.0000000, // BUILDER_CreateShortcuts_MaxWork + 29.1807594, // BUILDER_Shortage_Gold + 11.7483110, // BUILDER_Shortage_Stone + 14.0460310, // BUILDER_Shortage_StoneReserve + 1.8335937, // BUILDER_Shortage_Trunk + 19.8352127, // BUILDER_Shortage_Wood + 0.0000000, // BUILDER_END + + 0.0000000, // EYE_GetForests_START + 26.4097462, // EYE_GetForests_MaxAB + 45.2892570, // EYE_GetForests_MinRndSoil + 2.9898586, // EYE_GetForests_MinTrees + 6.1196084, // EYE_GetForests_Radius + 165.0055695, // EYE_GetForests_SPRndOwnLimMax + 98.0682449, // EYE_GetForests_SPRndOwnLimMin + 0.0000000, // EYE_GetForests_END + + 0.0000000, // MANAGEMENT_START + 0.3049391, // MANAGEMENT_CheckUnitCount_SerfGoldCoef + 22.1768589, // MANAGEMENT_CheckUnitCount_SerfLimit1 + 34.9827499, // MANAGEMENT_CheckUnitCount_SerfLimit2 + 51.9892654, // MANAGEMENT_CheckUnitCount_SerfLimit3 + 2.2670105, // MANAGEMENT_CheckUnitCount_WorkerGoldCoef + 6.1128011, // MANAGEMENT_GoldShortage + 0.0000000, // MANAGEMENT_END + + 0.0000000, // PLANNER_FARM_START + 13.7585087, // PLANNER_FARM_FieldCrit_FlatArea + 0.4989614, // PLANNER_FARM_FieldCrit_PolyRoute + 1.9767742, // PLANNER_FARM_FieldCrit_Soil + 5.6396270, // PLANNER_FARM_FindPlaceForHouse_CityCenter + 16.0000000, // PLANNER_FARM_FindPlaceForHouse_FlatArea + 19.9625053, // PLANNER_FARM_FindPlaceForHouse_HouseDist + -1.1648518, // PLANNER_FARM_FindPlaceForHouse_Route + 759.2076416, // PLANNER_FARM_PlanFields_CanBuild + 32.8001213, // PLANNER_FARM_PlanFields_Dist + 95.6147385, // PLANNER_FARM_PlanFields_ExistField + 0.0000000, // PLANNER_FARM_END + + 0.0000000, // PLANNER_FindPlaceForHouse_START + 40.0904541, // PLANNER_FindPlaceForHouse_CityCenter + 2.7339566, // PLANNER_FindPlaceForHouse_FlatArea + 43.2200470, // PLANNER_FindPlaceForHouse_HouseDist + 2.4208529, // PLANNER_FindPlaceForHouse_Route + 25.1297512, // PLANNER_FindPlaceForHouse_SeedDist + 0.8601482, // PLANNER_FindPlaceForHouse_SnapCrit + 0.0000000, // PLANNER_FindPlaceForHouse_END + + 0.0000000, // PLANNER_FindPlaceForQuary_START + 27.4838066, // MANAGEMENT_CheckStoreWares_Stone + 0.6821785, // PREDICTOR_WareNeedPerAWorker_Stone + 14.5459347, // PREDICTOR_WareNeedPerAWorker_StoneOffset + 0.0047831, // PREDICTOR_WorkerCountCoef + 5.0048351, // PLANNER_FindPlaceForQuary_StoneLoc_StoneCnt + 125.4238663, // PLANNER_FindPlaceForQuary_StoneLoc_AlreadyMined + 13.8679466, // PLANNER_FindPlaceForQuary_StoneLoc_Distance + 20.9321098, // PLANNER_FindPlaceForQuary_DistCity + 25.5000973, // PLANNER_FindPlaceForQuary_DistStone + 3051.0822754, // PLANNER_FindPlaceForQuary_DistTimer + 90.0000000, // PLANNER_FindPlaceForQuary_Obstacle + 14.2139816, // PLANNER_FindPlaceForQuary_SnapCrit + 26.7360783, // PLANNER_FindPlaceForQuary_QtyStone + 0.0000000, // PLANNER_FindPlaceForQuary_END + + 0.0000000, // PLANNER_FOREST_START + 8.3981934, // PLANNER_FOREST_FindForestAround_MaxDist + 43.0639000, // PLANNER_FOREST_FindPlaceForWoodcutter_ABRange + 18.3647213, // PLANNER_FOREST_FindPlaceForWoodcutter_DistCrit + 6053.0366211, // PLANNER_FOREST_FindPlaceForWoodcutter_DistTimer + 359.9281311, // PLANNER_FOREST_FindPlaceForWoodcutter_ExistForest + 5.8913641, // PLANNER_FOREST_FindPlaceForWoodcutter_FlatArea + 4.6900163, // PLANNER_FOREST_FindPlaceForWoodcutter_FreeTiles + 3.5208817, // PLANNER_FOREST_FindPlaceForWoodcutter_Radius + -0.6038398, // PLANNER_FOREST_FindPlaceForWoodcutter_Routes + 0.1276233, // PLANNER_FOREST_FindPlaceForWoodcutter_Soil + 7.2485070, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCnt + 21258.1250000, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCntTimer + 0.2943508, // PLANNER_FOREST_PlaceWoodcutter_DistFromForest + 0.0000000, // PLANNER_FOREST_END + + 0.0000000, // PLANNER_Snap_START + 293.8428345, // PLANNER_ObstaclesInHousePlan_Road + 599.5475464, // PLANNER_ObstaclesInHousePlan_Tree + 27.8181629, // PLANNER_SnapCrit_Field + 1.1461508, // PLANNER_SnapCrit_HouseOrRoad + -9.2810154, // PLANNER_SnapCrit_NoBuild + 201.9597015, // PLANNER_SnapCrit_ObstacleInEntrance + 61.5381699, // PLANNER_SnapCrit_Road + 22.1572151, // PLANNER_SnapCrit_RoadInEntrance + 0.0000000, // PLANNER_Snap_END + + 0.0000000, // PREDICTOR_START + 44.3221283, // PREDICTOR_SecondSchool_MinRequiredUnits + 0.3007088, // PREDICTOR_WareNeedPerAWorker_Wood + 0.0000000, // PREDICTOR_END + + 0.0000000, // SHORTCUTS_START + 95.1310349, // SHORTCUTS_BasePrice + 49.1626778, // SHORTCUTS_Coal + 50.0000000, // SHORTCUTS_Field + 18.1300087, // SHORTCUTS_Forest + 24.3808022, // SHORTCUTS_OtherCase + 46.6517181, // SHORTCUTS_Road + 33.4370956, // SHORTCUTS_TurnPenalization + 25.7135334, // SHORTCUTS_noBuildArea + 0.0000000, // SHORTCUTS_END + + 0.0000000, // ROADS_START + 42.2091637, // ROADS_BasePrice + 29.0325890, // ROADS_Coal + 46.5412674, // ROADS_Field + 57.8719749, // ROADS_Forest + 11.6849775, // ROADS_OtherCase + 23.1054745, // ROADS_Road + 50.0000000, // ROADS_TurnPenalization + 35.9236031, // ROADS_noBuildArea + 0.0000000 // ROADS_END + + ); + + + + +{$IFDEF DEBUG_NewAI} +const + AI_Par_Offset: array[TAIPar] of Single = ( + 0.00, // ATTACK_ArmyVectorField_START + 14.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffset + 12.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffsetFF + 1.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyGainFF + 12.00, // ATTACK_ArmyVectorField_FindPositions_DistCloseToEnemy + 1.00, // ATTACK_ArmyVectorField_FindPositions_DistMaxWalk + 5.00, // ATTACK_ArmyVectorField_FindPositions_FollowEnemyVectorFieldUth + 1.00, // ATTACK_ArmyVectorField_FindPositions_AvoidTraffic + 1.00, // ATTACK_ArmyVectorField_FindPositions_RallyPointOffset + 0.40, // ATTACK_ArmyVectorField_EvalClusters_InPlace + 0.00, // ATTACK_ArmyVectorField_EvalClusters_AtAdvantage + 0.00, // ATTACK_ArmyVectorField_EvalClusters_Ambushed + 0.50, // ATTACK_ArmyVectorField_DivideForces_DefendCityAdv + 0.00, // ATTACK_ArmyVectorField_DivideForces_SupportAllyAdv + 0.00, // ATTACK_ArmyVectorField_END + + 0.00, // ATTACK_SQUAD_START + 350.00, // ATTACK_SQUAD_ChangeTarget_Delay + 5.00, // ATTACK_SQUAD_MinWalkingDistance + 8.00, // ATTACK_SQUAD_TargetReached_House + 1.00, // ATTACK_SQUAD_TargetReached_Position + 9.00, // ATTACK_SQUAD_TargetReached_RangedSquad + 15.00, // ATTACK_SQUAD_TargetReached_Unit + 1.00, // ATTACK_SQUAD_TrafficDetection_Limit + 10.00, // ATTACK_SQUAD_TrafficDetection_Threshold + 0.00, // ATTACK_SQUAD_END + + 0.00, // ATTACK_SUPERVISOR_START + 10.00, // ATTACK_SUPERVISOR_EvalTarget_DistanceGroup + 1.00, // ATTACK_SUPERVISOR_EvalTarget_OpportunityDistGain + 1.00, // ATTACK_SUPERVISOR_EvalTarget_OpportunityGain + 0.50, // ATTACK_SUPERVISOR_EvalTarget_DecreaseRisk + 2.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainAntiHorse + 5.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainDist + 1.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMelee + 1.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMounted + 1.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRangDist + 1.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRanged + 0.00, // ATTACK_SUPERVISOR_END + + 0.00, // NAVMESH_PATHFINDING_START + 0.00, // NAVMESH_PATHFINDING_AvoidTraffic + 0.00, // NAVMESH_PATHFINDING_LineLength + 5.00, // NAVMESH_PATHFINDING_AvoidSpecEnemy + 0.00, // NAVMESH_PATHFINDING_END + + 0.00, // BUILDER_START + 1.00, // BUILDER_BuildHouse_FieldMaxWork + 1.00, // BUILDER_BuildHouse_RTPMaxWork + 5.00, // BUILDER_BuildHouse_RoadMaxWork + 8.00, // BUILDER_ChHTB_AllWorkerCoef + 5.00, // BUILDER_ChHTB_FractionCoef + 8.00, // BUILDER_ChHTB_FreeWorkerCoef + 0.00, // BUILDER_ChHTB_TrunkBalance + 8.00, // BUILDER_ChHTB_TrunkFactor + 1.00, // BUILDER_CreateShortcuts_MaxWork + 0.00, // BUILDER_Shortage_Gold + 10.00, // BUILDER_Shortage_Stone + 10.00, // BUILDER_Shortage_StoneReserve + 1.00, // BUILDER_Shortage_Trunk + 3.00, // BUILDER_Shortage_Wood + 0.00, // BUILDER_END + + 0.00, // EYE_GetForests_START + 1.00, // EYE_GetForests_MaxAB + 40.00, // EYE_GetForests_MinRndSoil + 1.00, // EYE_GetForests_MinTrees + 5.00, // EYE_GetForests_Radius + 100.00, // EYE_GetForests_SPRndOwnLimMax + 0.00, // EYE_GetForests_SPRndOwnLimMin + 0.00, // EYE_GetForests_END + + 0.00, // MANAGEMENT_START + 0.10, // MANAGEMENT_CheckUnitCount_SerfGoldCoef + 5.00, // MANAGEMENT_CheckUnitCount_SerfLimit1 + 20.00, // MANAGEMENT_CheckUnitCount_SerfLimit2 + 40.00, // MANAGEMENT_CheckUnitCount_SerfLimit3 + 0.10, // MANAGEMENT_CheckUnitCount_WorkerGoldCoef + 1.00, // MANAGEMENT_GoldShortage + 0.00, // MANAGEMENT_END + + 0.00, // PLANNER_FARM_START + 10.00, // PLANNER_FARM_FieldCrit_FlatArea + 0.00, // PLANNER_FARM_FieldCrit_PolyRoute + 0.00, // PLANNER_FARM_FieldCrit_Soil + 0.00, // PLANNER_FARM_FindPlaceForHouse_CityCenter + 10.00, // PLANNER_FARM_FindPlaceForHouse_FlatArea + 5.00, // PLANNER_FARM_FindPlaceForHouse_HouseDist + -2.00, // PLANNER_FARM_FindPlaceForHouse_Route + 500.00, // PLANNER_FARM_PlanFields_CanBuild + 0.00, // PLANNER_FARM_PlanFields_Dist + 30.00, // PLANNER_FARM_PlanFields_ExistField + 0.00, // PLANNER_FARM_END + + 0.00, // PLANNER_FindPlaceForHouse_START + 0.00, // PLANNER_FindPlaceForHouse_CityCenter + 0.00, // PLANNER_FindPlaceForHouse_FlatArea + 25.00, // PLANNER_FindPlaceForHouse_HouseDist + 0.00, // PLANNER_FindPlaceForHouse_Route + 0.00, // PLANNER_FindPlaceForHouse_SeedDist + 0.00, // PLANNER_FindPlaceForHouse_SnapCrit + 0.00, // PLANNER_FindPlaceForHouse_END + + 0.00, // PLANNER_FindPlaceForQuary_START + 0.00, // MANAGEMENT_CheckStoreWares_Stone + 0.50, // PREDICTOR_WareNeedPerAWorker_Stone + 10.00, // PREDICTOR_WareNeedPerAWorker_StoneOffset + 0.00, // PREDICTOR_WorkerCountCoef + 0.00, // PLANNER_FindPlaceForQuary_StoneLoc_StoneCnt + 100.00, // PLANNER_FindPlaceForQuary_StoneLoc_AlreadyMined + 0.00, // PLANNER_FindPlaceForQuary_StoneLoc_Distance + 0.00, // PLANNER_FindPlaceForQuary_DistCity + 0.00, // PLANNER_FindPlaceForQuary_DistStone + 0.00, // PLANNER_FindPlaceForQuary_DistTimer + 80.00, // PLANNER_FindPlaceForQuary_Obstacle + 5.00, // PLANNER_FindPlaceForQuary_SnapCrit + 0.00, // PLANNER_FindPlaceForQuary_QtyStone + 0.00, // PLANNER_FindPlaceForQuary_END + + 0.00, // PLANNER_FOREST_START + 5.00, // PLANNER_FOREST_FindForestAround_MaxDist + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_ABRange + 8.00, // PLANNER_FOREST_FindPlaceForWoodcutter_DistCrit + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_DistTimer + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_ExistForest + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_FlatArea + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_FreeTiles + 3.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Radius + -1.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Routes + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Soil + 0.00, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCnt + 12000.00, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCntTimer + 0.00, // PLANNER_FOREST_PlaceWoodcutter_DistFromForest + 0.00, // PLANNER_FOREST_END + + 0.00, // PLANNER_Snap_START + 200.00, // PLANNER_ObstaclesInHousePlan_Road + 500.00, // PLANNER_ObstaclesInHousePlan_Tree + -20.00, // PLANNER_SnapCrit_Field + -30.00, // PLANNER_SnapCrit_HouseOrRoad + -30.00, // PLANNER_SnapCrit_NoBuild + 0.00, // PLANNER_SnapCrit_ObstacleInEntrance + 25.00, // PLANNER_SnapCrit_Road + 0.00, // PLANNER_SnapCrit_RoadInEntrance + 0.00, // PLANNER_Snap_END + + 0.00, // PREDICTOR_START + 20.00, // PREDICTOR_SecondSchool_MinRequiredUnits + 0.01, // PREDICTOR_WareNeedPerAWorker_Wood + 0.00, // PREDICTOR_END + + 0.00, // SHORTCUTS_START + 70.00, // SHORTCUTS_BasePrice + 20.00, // SHORTCUTS_Coal + 0.00, // SHORTCUTS_Field + 10.00, // SHORTCUTS_Forest + 0.00, // SHORTCUTS_OtherCase + 20.00, // SHORTCUTS_Road + 20.00, // SHORTCUTS_TurnPenalization + 20.00, // SHORTCUTS_noBuildArea + 0.00, // SHORTCUTS_END + + 0.00, // ROADS_START + 25.00, // ROADS_BasePrice + 0.00, // ROADS_Coal + 20.00, // ROADS_Field + 30.00, // ROADS_Forest + 0.00, // ROADS_OtherCase + 0.00, // ROADS_Road + 0.00, // ROADS_TurnPenalization + 15.00, // ROADS_noBuildArea + 0.00 // ROADS_END + ); + + + AI_Par_Gain: array[TAIPar] of Single = ( + 0.00, // ATTACK_ArmyVectorField_START + 10.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffset + 10.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyOffsetFF + 1.00, // ATTACK_ArmyVectorField_FindPositions_DistEnemyGainFF + 5.00, // ATTACK_ArmyVectorField_FindPositions_DistCloseToEnemy + 10.00, // ATTACK_ArmyVectorField_FindPositions_DistMaxWalk + 15.00, // ATTACK_ArmyVectorField_FindPositions_FollowEnemyVectorFieldUth + 9.00, // ATTACK_ArmyVectorField_FindPositions_AvoidTraffic + 10.00, // ATTACK_ArmyVectorField_FindPositions_RallyPointOffset + 0.50, // ATTACK_ArmyVectorField_EvalClusters_InPlace + 3.00, // ATTACK_ArmyVectorField_EvalClusters_AtAdvantage + 0.25, // ATTACK_ArmyVectorField_EvalClusters_Ambushed + 0.00, // ATTACK_ArmyVectorField_DivideForces_DefendCityAdv + 0.90, // ATTACK_ArmyVectorField_DivideForces_SupportAllyAdv + 0.00, // ATTACK_ArmyVectorField_END + + 0.00, // ATTACK_SQUAD_START + 100.00, // ATTACK_SQUAD_ChangeTarget_Delay + 0.00, // ATTACK_SQUAD_MinWalkingDistance + 0.00, // ATTACK_SQUAD_TargetReached_House + 4.00, // ATTACK_SQUAD_TargetReached_Position + 2.00, // ATTACK_SQUAD_TargetReached_RangedSquad + 20.00, // ATTACK_SQUAD_TargetReached_Unit + 0.00, // ATTACK_SQUAD_TrafficDetection_Limit + 0.00, // ATTACK_SQUAD_TrafficDetection_Threshold + 0.00, // ATTACK_SQUAD_END + + 0.00, // ATTACK_SUPERVISOR_START + 15.00, // ATTACK_SUPERVISOR_EvalTarget_DistanceGroup + 6.00, // ATTACK_SUPERVISOR_EvalTarget_OpportunityDistGain + 4.00, // ATTACK_SUPERVISOR_EvalTarget_OpportunityGain + 0.25, // ATTACK_SUPERVISOR_EvalTarget_DecreaseRisk + 5.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainAntiHorse + 10.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainDist + 3.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMelee + 3.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainMounted + 3.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRangDist + 3.00, // ATTACK_SUPERVISOR_EvalTarget_ThreatGainRanged + 0.00, // ATTACK_SUPERVISOR_END + + 0.00, // NAVMESH_PATHFINDING_START + 2.00, // NAVMESH_PATHFINDING_AvoidTraffic + 3.00, // NAVMESH_PATHFINDING_LineLength + 4.00, // NAVMESH_PATHFINDING_AvoidSpecEnemy + 0.00, // NAVMESH_PATHFINDING_END + + 0.00, // BUILDER_START + 1.00, // BUILDER_BuildHouse_FieldMaxWork + 15.00, // BUILDER_BuildHouse_RTPMaxWork + 20.00, // BUILDER_BuildHouse_RoadMaxWork + 10.00, // BUILDER_ChHTB_AllWorkerCoef + 40.00, // BUILDER_ChHTB_FractionCoef + 20.00, // BUILDER_ChHTB_FreeWorkerCoef + 3.00, // BUILDER_ChHTB_TrunkBalance + 12.00, // BUILDER_ChHTB_TrunkFactor + 9.00, // BUILDER_CreateShortcuts_MaxWork + 35.00, // BUILDER_Shortage_Gold + 15.00, // BUILDER_Shortage_Stone + 40.00, // BUILDER_Shortage_StoneReserve + 3.00, // BUILDER_Shortage_Trunk + 20.00, // BUILDER_Shortage_Wood + 0.00, // BUILDER_END + + 0.00, // EYE_GetForests_START + 200.00, // EYE_GetForests_MaxAB + 22.00, // EYE_GetForests_MinRndSoil + 4.00, // EYE_GetForests_MinTrees + 4.00, // EYE_GetForests_Radius + 155.00, // EYE_GetForests_SPRndOwnLimMax + 155.00, // EYE_GetForests_SPRndOwnLimMin + 0.00, // EYE_GetForests_END + + 0.00, // MANAGEMENT_START + 3.00, // MANAGEMENT_CheckUnitCount_SerfGoldCoef + 20.00, // MANAGEMENT_CheckUnitCount_SerfLimit1 + 20.00, // MANAGEMENT_CheckUnitCount_SerfLimit2 + 30.00, // MANAGEMENT_CheckUnitCount_SerfLimit3 + 3.00, // MANAGEMENT_CheckUnitCount_WorkerGoldCoef + 15.00, // MANAGEMENT_GoldShortage + 0.00, // MANAGEMENT_END + + 0.00, // PLANNER_FARM_START + 10.00, // PLANNER_FARM_FieldCrit_FlatArea + 5.00, // PLANNER_FARM_FieldCrit_PolyRoute + 3.00, // PLANNER_FARM_FieldCrit_Soil + 10.00, // PLANNER_FARM_FindPlaceForHouse_CityCenter + 10.00, // PLANNER_FARM_FindPlaceForHouse_FlatArea + 15.00, // PLANNER_FARM_FindPlaceForHouse_HouseDist + 4.00, // PLANNER_FARM_FindPlaceForHouse_Route + 500.00, // PLANNER_FARM_PlanFields_CanBuild + 75.00, // PLANNER_FARM_PlanFields_Dist + 75.00, // PLANNER_FARM_PlanFields_ExistField + 0.00, // PLANNER_FARM_END + + 0.00, // PLANNER_FindPlaceForHouse_START + 80.00, // PLANNER_FindPlaceForHouse_CityCenter + 6.00, // PLANNER_FindPlaceForHouse_FlatArea + 20.00, // PLANNER_FindPlaceForHouse_HouseDist + 4.00, // PLANNER_FindPlaceForHouse_Route + 50.00, // PLANNER_FindPlaceForHouse_SeedDist + 3.00, // PLANNER_FindPlaceForHouse_SnapCrit + 0.00, // PLANNER_FindPlaceForHouse_END + + 0.00, // PLANNER_FindPlaceForQuary_START + 50.00, // MANAGEMENT_CheckStoreWares_Stone + 0.30, // PREDICTOR_WareNeedPerAWorker_Stone + 10.00, // PREDICTOR_WareNeedPerAWorker_StoneOffset + 0.01, // PREDICTOR_WorkerCountCoef + 10.00, // PLANNER_FindPlaceForQuary_StoneLoc_StoneCnt + 100.00, // PLANNER_FindPlaceForQuary_StoneLoc_AlreadyMined + 20.00, // PLANNER_FindPlaceForQuary_StoneLoc_Distance + 50.00, // PLANNER_FindPlaceForQuary_DistCity + 50.00, // PLANNER_FindPlaceForQuary_DistStone + 15000.00, // PLANNER_FindPlaceForQuary_DistTimer + 50.00, // PLANNER_FindPlaceForQuary_Obstacle + 20.00, // PLANNER_FindPlaceForQuary_SnapCrit + 50.00, // PLANNER_FindPlaceForQuary_QtyStone + 0.00, // PLANNER_FindPlaceForQuary_END + + 0.00, // PLANNER_FOREST_START + 5.00, // PLANNER_FOREST_FindForestAround_MaxDist + 150.00, // PLANNER_FOREST_FindPlaceForWoodcutter_ABRange + 20.00, // PLANNER_FOREST_FindPlaceForWoodcutter_DistCrit + 10000.00, // PLANNER_FOREST_FindPlaceForWoodcutter_DistTimer + 500.00, // PLANNER_FOREST_FindPlaceForWoodcutter_ExistForest + 6.00, // PLANNER_FOREST_FindPlaceForWoodcutter_FlatArea + 6.00, // PLANNER_FOREST_FindPlaceForWoodcutter_FreeTiles + 4.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Radius + 2.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Routes + 3.00, // PLANNER_FOREST_FindPlaceForWoodcutter_Soil + 21.00, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCnt + 12000.00, // PLANNER_FOREST_FindPlaceForWoodcutter_TreeCntTimer + 2.00, // PLANNER_FOREST_PlaceWoodcutter_DistFromForest + 0.00, // PLANNER_FOREST_END + + 0.00, // PLANNER_Snap_START + 500.00, // PLANNER_ObstaclesInHousePlan_Road + 1000.00, // PLANNER_ObstaclesInHousePlan_Tree + 50.00, // PLANNER_SnapCrit_Field + 50.00, // PLANNER_SnapCrit_HouseOrRoad + 50.00, // PLANNER_SnapCrit_NoBuild + 1000.00, // PLANNER_SnapCrit_ObstacleInEntrance + 50.00, // PLANNER_SnapCrit_Road + 300.00, // PLANNER_SnapCrit_RoadInEntrance + 0.00, // PLANNER_Snap_END + + 0.00, // PREDICTOR_START + 30.00, // PREDICTOR_SecondSchool_MinRequiredUnits + 0.30, // PREDICTOR_WareNeedPerAWorker_Wood + 0.00, // PREDICTOR_END + + 0.00, // SHORTCUTS_START + 40.00, // SHORTCUTS_BasePrice + 50.00, // SHORTCUTS_Coal + 50.00, // SHORTCUTS_Field + 40.00, // SHORTCUTS_Forest + 50.00, // SHORTCUTS_OtherCase + 50.00, // SHORTCUTS_Road + 50.00, // SHORTCUTS_TurnPenalization + 50.00, // SHORTCUTS_noBuildArea + 0.00, // SHORTCUTS_END + + 0.00, // ROADS_START + 30.00, // ROADS_BasePrice + 50.00, // ROADS_Coal + 40.00, // ROADS_Field + 50.00, // ROADS_Forest + 50.00, // ROADS_OtherCase + 50.00, // ROADS_Road + 50.00, // ROADS_TurnPenalization + 35.00, // ROADS_noBuildArea + 0.00 // ROADS_END + ); +{$ENDIF} + +implementation + +{$IFDEF PARALLEL_RUNNER} +procedure LoadGAParameters(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('LoadGAParameters'); + LoadStream.Read(AI_Par,SizeOf(AI_Par)); +end; + +procedure SaveGAParameters(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('LoadGAParameters'); + SaveStream.Write(AI_Par,SizeOf(AI_Par)); +end; +{$ENDIF} + +end. diff --git a/vendor/kam_remake/src/ai/newAI/KM_ArmyAttack.pas b/vendor/kam_remake/src/ai/newAI/KM_ArmyAttack.pas new file mode 100644 index 0000000..25468ba --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_ArmyAttack.pas @@ -0,0 +1,1784 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_ArmyAttack; +{$I KaM_Remake.inc} +interface +uses + Classes, KromUtils, Math, SysUtils, + KM_Units, KM_UnitGroup, + KM_CommonClasses, KM_CommonTypes, KM_Defaults, KM_Points, + KM_Houses, KM_ResHouses, KM_ResWares, KM_NavMeshPathFinding, + KM_Eye; + +type + TAISquad = class; // Combat group (orders to specific group: walk / attack) + TAICompany = class; // Company (selection of targets, positions etc.) + TKMArmyAttack = class; // Attack (time distribution, company initialization) + + TKMSquadList = array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of TKMList; + TKMSquadsArray = array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of record + Count: Word; + Squads: array of TAISquad; + TargetUnit: TKMUnitArray; + TargetHouse: TKMHouseArray; + end; + TKMTargetSelection = array of record + Index: Word; + CenterPoint: TKMPoint; + CloseThreat, DistantThreat: Single; + end; + TKMCompanyMode = (cmAttack, cmDefence, cmDestruction); + TKMCompanyState = (csAttack, csWalking, csIdle); + + TAISquad = class + private + fGroup: TKMUnitGroup; + fOnPlace, fTargetChanged: Boolean; + fFinalPosition: TKMPointDir; + fTargetHouse: TKMHouse; + fTargetUnit: TKMUnit; + fWalkTimeLimit, fAttackTimeLimit: Cardinal; + + function SquadInFight(): Boolean; inline; + function GetGroupPosition(): TKMPoint; inline; + function PlanPath(aTick: Cardinal; var aActualPosition, aTargetPosition: TKMPoint; aOrderAttack: Boolean = False; aOrderDestroy: Boolean = False): Boolean; + + procedure SetTargetHouse(aHouse: TKMHouse); + procedure SetTargetUnit(aUnit: TKMUnit); + procedure SetTargetPosition(aLoc: TKMPointDir); + public + {$IFDEF DEBUG_NewAI} + DEBUGPointPath: TKMPointArray; + {$ENDIF} + + constructor Create(aGroup: TKMUnitGroup); + constructor Load(LoadStream: TKMemoryStream); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure SyncLoad(); + + property Group: TKMUnitGroup read fGroup; + property OnPlace: Boolean read fOnPlace; + property InFight: Boolean read SquadInFight; + property FinalPosition: TKMPointDir read fFinalPosition write SetTargetPosition; + property Position: TKMPoint read GetGroupPosition; + property WalkTimeLimit: Cardinal read fWalkTimeLimit write fWalkTimeLimit; + property AttackTimeLimit: Cardinal read fAttackTimeLimit write fAttackTimeLimit; + property TargetHouse: TKMHouse read fTargetHouse write SetTargetHouse; + property TargetUnit: TKMUnit read fTargetUnit write SetTargetUnit; + + procedure UpdateState(aTick: Cardinal); + end; + + TAICompany = class + private + fOwner: TKMHandID; + fPathPosition: TKMPoint; + fScanPosition: TKMPoint; + fCompanyMode: TKMCompanyMode; + fTargetOwner: TKMHandID; + fTargetPoint: TKMPoint; + fTargetHouse: TKMHouse; + fTargetUnit: TKMUnit; + fState: TKMCompanyState; + fSquads: TKMSquadList; + + function GetPosition(): TKMPoint; overload; + function GetPosition(var aSQRRadius: Single): TKMPoint; overload; + function GetTargetPosition(): TKMPoint; + function OrderToAttack(aActualPosition: TKMPoint; UA: TKMUnitArray; UGA: TKMUnitGroupArray; HA: TKMHouseArray): Boolean; + function OrderMove(aTick: Cardinal; aActualPosition: TKMPoint): Boolean; + public + {$IFDEF DEBUG_NewAI} + DEBUGScanRad: Single; + DEBUGTargetU: TKMTargetSelection; + DEBUGPointPath, DEBUG_UA_POINTS, DEBUG_UGA_POINTS: TKMPointArray; + {$ENDIF} + + constructor Create(aOwner: TKMHandID; aCompanyMode: TKMCompanyMode); + constructor Load(LoadStream: TKMemoryStream); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure SyncLoad(); + + property Owner: TKMHandID read fOwner write fOwner; + property PathPosition: TKMPoint read fPathPosition; + property ScanPosition: TKMPoint read fScanPosition; + property CompanyMode: TKMCompanyMode read fCompanyMode write fCompanyMode; + property TargetPoint: TKMPoint read fTargetPoint write fTargetPoint; + property TargetPosition: TKMPoint read GetTargetPosition; + property State: TKMCompanyState read fState; + property Squads: TKMSquadList read fSquads; + + procedure InitCompany(); + procedure UpdateState(aTick: Cardinal); + procedure AddSquad(aGroup: TKMUnitGroup); + procedure DeleteSquad(aGT: TKMGroupType; aIdx: Integer); + function SquadCnt(aTypes: TKMGroupTypeSet = GROUP_TYPES_VALID): Word; + function WarriorCnt(aTypes: TKMGroupTypeSet = GROUP_TYPES_VALID): Word; + function IsGroupInCompany(aGroup: TKMUnitGroup): Boolean; + function SetTarget(aHouse: TKMHouse; aUnit: TKMUnit = nil): Boolean; + function ActualizeTarget(aInitPosition: TKMPoint; var aTargetHouse: TKMHouse; var aTargetUnit: TKMUnit; aAimCivilians: Boolean = True): Boolean; + end; + + TKMArmyAttack = class + private + fOwner: TKMHandID; + fCompanies: TKMList; + + function GetCount(): Integer; + function GetCompany(aIdx: Integer): TAICompany; + public + constructor Create(aOwner: TKMHandID); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + property Count: Integer read GetCount; + property Company[aIdx: Integer]: TAICompany read GetCompany; default; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure CreateCompany(aTargetPoint: TKMPoint; aGroups: TKMUnitGroupArray; aCompanyMode: TKMCompanyMode = cmAttack); + function IsGroupInAction(aGroup: TKMUnitGroup): Boolean; + + procedure LogStatus(var aBalanceText: UnicodeString); + procedure Paint(); + end; + +const + // Houses in TARGET_HOUSES will be selected as a primary target (so the company will come to this point but it will not attack it because of this list) + TARGET_HOUSES: TKMHouseTypeSet = [htBarracks, htStore, htSchool, htTownhall]; + // Houses in SCAN_HOUSES will be destroyed when they are in radius (it should also contain TARGET_HOUSES) + SCAN_HOUSES: TKMHouseTypeSet = [htWatchTower, htBarracks, htStore, htSchool, htTownhall]; + // All houses for final stage of attack algorithm + ALL_HOUSES: TKMHouseTypeSet = HOUSES_VALID; + +implementation +uses + Types, + KM_HandsCollection, KM_Terrain, KM_AIFields, + KM_NavMesh, KM_RenderAux, + KM_UnitWarrior, KM_AIParameters; + + +{ TAISquad } +constructor TAISquad.Create(aGroup: TKMUnitGroup); +begin + inherited Create; + fGroup := aGroup.GetPointer(); + fOnPlace := True; + fTargetChanged := True; + fWalkTimeLimit := 0; + fAttackTimeLimit := 0; + fTargetHouse := nil; + fTargetUnit := nil; + //fFinalPosition := KMPointDir(KMPOINT_ZERO, dirNA); +end; + + +destructor TAISquad.Destroy(); +begin + gHands.CleanUpGroupPointer(fGroup); + gHands.CleanUpUnitPointer(fTargetUnit); + gHands.CleanUpHousePointer(fTargetHouse); + inherited; +end; + + +constructor TAISquad.Load(LoadStream: TKMemoryStream); +begin + inherited Create; + LoadStream.CheckMarker('Squad'); + LoadStream.Read(fOnPlace); + LoadStream.Read(fTargetChanged); + LoadStream.Read(fFinalPosition); + LoadStream.Read(fWalkTimeLimit, SizeOf(fWalkTimeLimit)); + LoadStream.Read(fAttackTimeLimit, SizeOf(fAttackTimeLimit)); + //Subst on syncload + LoadStream.Read(fGroup, 4); + LoadStream.Read(fTargetUnit, 4); + LoadStream.Read(fTargetHouse, 4); +end; + + +procedure TAISquad.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('Squad'); + SaveStream.Write(fOnPlace); + SaveStream.Write(fTargetChanged); + SaveStream.Write(fFinalPosition); + SaveStream.Write(fWalkTimeLimit, SizeOf(fWalkTimeLimit)); + SaveStream.Write(fAttackTimeLimit, SizeOf(fAttackTimeLimit)); + if (fGroup <> nil) then + SaveStream.Write(fGroup.UID) //Store ID + else + SaveStream.Write(Integer(0)); + if (fTargetUnit <> nil) then + SaveStream.Write(fTargetUnit.UID) //Store ID + else + SaveStream.Write(Integer(0)); + if (fTargetHouse <> nil) then + SaveStream.Write(fTargetHouse.UID) //Store ID + else + SaveStream.Write(Integer(0)); +end; + + +procedure TAISquad.SyncLoad(); +begin + fGroup := gHands.GetGroupByUID(Integer(fGroup) ); + fTargetUnit := gHands.GetUnitByUID(Integer(fTargetUnit) ); + fTargetHouse := gHands.GetHouseByUID(Integer(fTargetHouse) ); +end; + + +procedure TAISquad.SetTargetUnit(aUnit: TKMUnit); +begin + if (fTargetUnit = aUnit) then + Exit; + // Archers will reaim (+ reset animation) only in case that new target is in specific distance from existing target + if (aUnit <> nil) AND not aUnit.IsDeadOrDying then + begin + if (fGroup.GroupType = gtRanged) + AND (fTargetUnit <> nil) + //AND not fTargetUnit.IsDeadOrDying + AND ( + ( + (fTargetUnit is TKMUnitWarrior) + AND (aUnit is TKMUnitWarrior) + AND (TKMUnitWarrior(fTargetUnit).Group = TKMUnitWarrior(aUnit).Group) + ) OR ( + (KMDistanceSqr(fTargetUnit.CurrPosition, aUnit.CurrPosition) < sqr(AI_Par[ATTACK_SQUAD_ChangeTarget_DistTolerance])) + ) + ) then + Exit; + fTargetChanged := True; + gHands.CleanUpUnitPointer(fTargetUnit); + fTargetUnit := aUnit.GetPointer; + end + else + gHands.CleanUpUnitPointer(fTargetUnit); // aUnit = nil case +end; + + +procedure TAISquad.SetTargetPosition(aLoc: TKMPointDir); +begin + fFinalPosition := aLoc; +end; + + +procedure TAISquad.SetTargetHouse(aHouse: TKMHouse); +begin + if (aHouse <> nil) then + SetTargetUnit(nil); // House have lower priority so if there is request for attacking house unit must be nil + if (fTargetHouse = aHouse) then + Exit; + fTargetChanged := True; + gHands.CleanUpHousePointer(fTargetHouse); + if (aHouse <> nil) then + fTargetHouse := aHouse.GetPointer; +end; + + +function TAISquad.SquadInFight(): Boolean; +begin + Result := not fGroup.CanTakeOrders; +end; + + +function TAISquad.GetGroupPosition(): TKMPoint; +begin + Result := fGroup.Position; +end; + + +// Update state of squad (group orders) +procedure TAISquad.UpdateState(aTick: Cardinal); + function GetTargetPosition(): TKMPoint; + var + K: Integer; + Dist, BestDist: Single; + BestTgt: TKMUnit; + G: TKMUnitGroup; + begin + Result := fTargetUnit.CurrPosition; + // Get closest warrior in enemy group if the squad is ranged + if (fGroup.GroupType = gtRanged) AND (fTargetUnit is TKMUnitWarrior) then + begin + BestTgt := nil; + G := TKMUnitWarrior(fTargetUnit).Group; + //Group will be nil if we target a warrior still walking out of barracks + if G <> nil then + begin + BestDist := 1E10; + for K := 0 to G.Count - 1 do + if not G.Members[K].IsDeadOrDying then + begin + Dist := KMDistanceSqr(fGroup.Position,G.Members[K].CurrPosition); + if (Dist < BestDist) then + begin + BestTgt := G.Members[K]; + BestDist := Dist; + end; + end; + if (BestTgt <> nil) then + begin + gHands.CleanUpUnitPointer(fTargetUnit); + fTargetUnit := BestTgt.GetPointer; + end; + end; + end; + end; +var + ActPos, FinPos: TKMPoint; +begin + fOnPlace := False; + // Check group status and possibility to give order + if (fGroup = nil) OR fGroup.IsDead OR InFight then + Exit; + + // Check targets + if (fTargetHouse <> nil) AND (fTargetHouse.IsDestroyed) then + gHands.CleanUpHousePointer(fTargetHouse); + if (fTargetUnit <> nil) AND (fTargetUnit.IsDead) then + gHands.CleanUpUnitPointer(fTargetUnit); + + // Do order + ActPos := fGroup.Position; + if (fTargetUnit <> nil) then + begin + + FinPos := GetTargetPosition(); + if PlanPath(aTick, ActPos, FinPos, True, False) then // Check if squad is in the place + Group.OrderWalk(FinPos, True, wtokAISquad, FinalPosition.Dir) + else if + fTargetChanged // Target has been changed + OR (fGroup.GroupType <> gtRanged) // If not ranged then send a command to attack every update + OR (KMDistanceSqr(FinPos,ActPos) > 12*12) // If ranged send attack command only until shoot distance to prevent reset of the shooting animation + OR (fGroup.Order in [goNone, goWalkTo]) // If ranged send attack command also if target is already in range but previous command was not attack something + OR (fAttackTimeLimit < aTick) // If ranged send attack command every X ticks to force at least first line of archers to shoot + then + begin + fAttackTimeLimit := aTick + Round(AI_Par[ATTACK_SQUAD_ChangeTarget_Delay]); + fTargetChanged := False; + Group.OrderAttackUnit(fTargetUnit, True); + end; + fOnPlace := True; + end + else if (fTargetHouse <> nil) then + begin + FinPos := fTargetHouse.Position; + if PlanPath(aTick, ActPos, FinPos, False, True) then + Group.OrderWalk(FinPos, True, wtokAISquad, FinalPosition.Dir) + else if (fGroup.GroupType <> gtRanged) OR fTargetChanged OR (fAttackTimeLimit < aTick) then + begin + fAttackTimeLimit := aTick + Round(AI_Par[ATTACK_SQUAD_ChangeTarget_Delay]); + fTargetChanged := False; + Group.OrderAttackHouse(fTargetHouse, True); + end; + fOnPlace := True; + end + else + begin + FinPos := FinalPosition.Loc; + if PlanPath(aTick, ActPos, FinPos, False, False) then + Group.OrderWalk(FinPos, True, wtokAISquad, FinalPosition.Dir) + else if not KMSamePoint(Group.Position, FinalPosition.Loc) then // Dont repeat order and let archers fire + Group.OrderWalk(FinalPosition.Loc, True, wtokAISquad, FinalPosition.Dir); + end; +end; + + +function TAISquad.PlanPath(aTick: Cardinal; var aActualPosition, aTargetPosition: TKMPoint; aOrderAttack: Boolean = False; aOrderDestroy: Boolean = False): Boolean; +var + InitPolygon, ClosestPolygon, Distance: Word; + I: Integer; + SQRDist: Single; + PointPath: TKMPointArray; +begin + Result := False; + fOnPlace := False; + SQRDist := KMDistanceSqr(aActualPosition, aTargetPosition); + // Time limit (time limit MUST be always set by higher rank (platoon)) + if (not (aOrderAttack OR aOrderDestroy) AND (fWalkTimeLimit < aTick)) // Time limit is set to 0 in case that unit attack something + // Target position is reached + OR (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_Position])) + // Target unit is close + OR (aOrderAttack AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_Unit]))) + // Target house is close + OR (aOrderDestroy AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_House]))) + // Archers should start fire as soon as possible + OR ((aOrderAttack OR aOrderDestroy) AND (fGroup.GroupType = gtRanged) AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_RangedSquad]))) then + begin + fOnPlace := True; + Exit; + end; + // Plan path with respect to enemy presence + if gAIFields.NavMesh.Pathfinding.AvoidEnemyRoute(Group.Owner, Group.GroupType, aActualPosition, aTargetPosition, Distance, PointPath) then + begin + if (Distance < 5) then // Just to be sure (default value of pathfinding, if is group stuck it should not influence platoon) + begin + fOnPlace := True; + Exit; + end + else + begin + InitPolygon := gAIFields.NavMesh.KMPoint2Polygon[aActualPosition]; + I := Length(PointPath)-2; // Skip next polygon -> fluent movement + repeat + aTargetPosition := PointPath[ Max(0, I) ]; + ClosestPolygon := gAIFields.NavMesh.KMPoint2Polygon[ aTargetPosition ]; + I := I - 1; + until (I < 0) OR ( (InitPolygon <> ClosestPolygon) + AND (tpWalk in gTerrain.Land^[aTargetPosition.Y, aTargetPosition.X].Passability) + AND (aOrderAttack OR (KMDistanceSqr(aActualPosition, aTargetPosition) > sqr(AI_Par[ATTACK_SQUAD_MinWalkingDistance]))) ); + + {$IFDEF DEBUG_NewAI} + DEBUGPointPath := PointPath; + {$ENDIF} + end; + end; + Result := True; +end; + + +{ TAICompany } +constructor TAICompany.Create(aOwner: TKMHandID; aCompanyMode: TKMCompanyMode); +var + GT: TKMGroupType; +begin + inherited Create; + fOwner := aOwner; + + fCompanyMode := aCompanyMode; + fTargetPoint := KMPOINT_ZERO; + fTargetOwner := -1; + fTargetHouse := nil; + fTargetUnit := nil; + + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + fSquads[GT] := TKMList.Create(); +end; + + +destructor TAICompany.Destroy(); +var + GT: TKMGroupType; +begin + gHands.CleanUpUnitPointer(fTargetUnit); + gHands.CleanUpHousePointer(fTargetHouse); + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + fSquads[GT].Free; + inherited; +end; + + +constructor TAICompany.Load(LoadStream: TKMemoryStream); +var + I,Cnt: Integer; + GT: TKMGroupType; +begin + inherited Create; + LoadStream.CheckMarker('Company'); + LoadStream.Read(fOwner); + LoadStream.Read(fPathPosition); + LoadStream.Read(fScanPosition); + LoadStream.Read(fCompanyMode, SizeOf(TKMCompanyMode)); + LoadStream.Read(fTargetPoint); + LoadStream.Read(fTargetOwner); + LoadStream.Read(fTargetUnit, 4); + LoadStream.Read(fTargetHouse, 4); + + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + fSquads[GT] := TKMList.Create(); + LoadStream.Read(Cnt); + for I := 0 to Cnt - 1 do + fSquads[GT].Add( TAISquad.Load(LoadStream) ); + end; +end; + + +procedure TAICompany.Save(SaveStream: TKMemoryStream); +var + I,Cnt: Integer; + GT: TKMGroupType; +begin + SaveStream.PlaceMarker('Company'); + SaveStream.Write(fOwner); + SaveStream.Write(fPathPosition); + SaveStream.Write(fScanPosition); + SaveStream.Write(fCompanyMode, SizeOf(TKMCompanyMode)); + SaveStream.Write(fTargetPoint); + SaveStream.Write(fTargetOwner); + if (fTargetUnit <> nil) then + SaveStream.Write(fTargetUnit.UID) //Store ID + else + SaveStream.Write(Integer(0)); + if (fTargetHouse <> nil) then + SaveStream.Write(fTargetHouse.UID) //Store ID + else + SaveStream.Write(Integer(0)); + + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + Cnt := fSquads[GT].Count; + SaveStream.Write(Cnt); + for I := 0 to Cnt - 1 do + TAISquad( Squads[GT].Items[I] ).Save(SaveStream); + end; +end; + + +procedure TAICompany.SyncLoad(); +var + I: Integer; + GT: TKMGroupType; +begin + fTargetUnit := gHands.GetUnitByUID(Integer(fTargetUnit) ); + fTargetHouse := gHands.GetHouseByUID(Integer(fTargetHouse) ); + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[GT].Count - 1 do + TAISquad( Squads[GT].Items[I] ).SyncLoad(); +end; + + +function TAICompany.SetTarget(aHouse: TKMHouse; aUnit: TKMUnit = nil): Boolean; +begin + Result := False; + if (aHouse = nil) AND (aUnit <> nil) then + begin + gHands.CleanUpUnitPointer(fTargetUnit); + fTargetUnit := aUnit.GetPointer; + fTargetOwner := aUnit.Owner; + Result := True; + end + else if (aHouse <> nil) AND (aUnit = nil) then + begin + gHands.CleanUpHousePointer(fTargetHouse); + fTargetHouse := aHouse.GetPointer; + fTargetOwner := aHouse.Owner; + Result := True; + end; +end; + + +function TAICompany.GetTargetPosition(): TKMPoint; +begin + Result := KMPOINT_ZERO; + if (fTargetHouse <> nil) AND not fTargetHouse.IsDestroyed then + Result := fTargetHouse.Position + else if (fTargetUnit <> nil) AND not fTargetUnit.IsDead then + Result := fTargetUnit.CurrPosition; +end; + + +// Update state of company, detect targets, call functions for orders +procedure TAICompany.UpdateState(aTick: Cardinal); + // Check if target still exist + function CheckPrimaryTarget(): Boolean; + begin + Result := False; + if (fTargetHouse <> nil) then + if fTargetHouse.IsDestroyed then + gHands.CleanUpHousePointer(fTargetHouse) + else + Result := True; + if (fTargetUnit <> nil) then + if fTargetUnit.IsDead then + gHands.CleanUpUnitPointer(fTargetUnit) + else + Result := True; + end; + // Check if are all squads in position and we can continue + function SquadsInPosition(): Boolean; + var + I: Integer; + GT: TKMGroupType; + Squad: TAISquad; + begin + Result := True; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := fSquads[GT].Count - 1 downto 0 do + begin + Squad := fSquads[GT].Items[I]; + if (Squad = nil) OR (Squad.Group = nil) OR Squad.Group.IsDead then + fSquads[GT].Delete(I) + else + Result := Result AND Squad.OnPlace; + end; + end; + // Filter target houses according to house type and influence + procedure FilterTargetHouses(var aHA: TKMHouseArray); + var + K, Cnt: Integer; + begin + if (fCompanyMode = cmDestruction) then + Exit; + Cnt := 0; + for K := Low(aHA) to High(aHA) do + if (aHA[K].HouseType in SCAN_HOUSES) OR + (gAIFields.Influences.OwnPoint[fOwner, aHA[K].Position] > 100) OR + (gAIFields.Influences.GetBestAllianceOwnership(fOwner, aHA[K].Position.X, aHA[K].Position.Y, atAlly) > 50) then + begin + aHA[Cnt] := aHA[K]; + Cnt := Cnt + 1; + end; + SetLength(aHA,Cnt); + end; + // Update state of Squads + procedure UpdateSquadsState(); + var + I: Integer; + GT: TKMGroupType; + begin + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := fSquads[GT].Count - 1 downto 0 do + TAISquad( fSquads[GT].Items[I] ).UpdateState(aTick); + end; +var + InPosition: Boolean; + {$IFDEF DEBUG_NewAI} + I: Integer; + {$ENDIF} + ScanRad, SQRRadius: Single; + HA: TKMHouseArray;// Target houses in radius + UA: TKMUnitArray; // Target closest soldiers in radius + UGA: TKMUnitGroupArray; // Group of closest soldiers in radius (reference to UA) + ClosestHouse: TKMHouse; + ClosestUnit: TKMUnit; +begin + if (SquadCnt = 0) then + Exit; + + InPosition := SquadsInPosition(); + + // Check target + ClosestHouse := nil; + ClosestUnit := nil; + + fScanPosition := GetPosition(SQRRadius); + + ScanRad := sqr(AI_Par[ATTACK_COMPANY_AttackRadius]) + Min(50*50, SQRRadius); + HA := gHands.GetHousesInRadius(ScanPosition, sqr(AI_Par[ATTACK_COMPANY_AttackRadius]), fOwner, atEnemy, ALL_HOUSES, False); + UA := gHands.GetGroupsMemberInRadius(ScanPosition, ScanRad, fOwner, atEnemy, UGA); + FilterTargetHouses(HA); + + {$IFDEF DEBUG_NewAI} + DEBUGScanRad := ScanRad; + SetLength(DEBUG_UA_POINTS, Length(UA)); + SetLength(DEBUG_UGA_POINTS, Length(UA)); + for I := 0 to Length(UA) - 1 do + begin + DEBUG_UA_POINTS[I] := UA[I].CurrPosition; + DEBUG_UGA_POINTS[I] := UGA[I].Position; + end; + {$ENDIF} + + // Actualize target + if not CheckPrimaryTarget() then + begin + if (Length(UA) > 0) then + ClosestUnit := UA[0]; + if (Length(HA) > 0) then + ClosestHouse := HA[0]; + if not SetTarget(ClosestHouse, ClosestUnit) then + begin + if ActualizeTarget(fScanPosition, ClosestHouse, ClosestUnit, False) then + begin + if not gAIFields.Supervisor.FFA + OR ((ClosestHouse <> nil) AND (ClosestHouse.Owner = fTargetOwner)) + OR ((ClosestUnit <> nil) AND (ClosestUnit.Owner = fTargetOwner)) then + SetTarget(ClosestHouse, ClosestUnit) + else + fState := csIdle; + end; + end; + end; + + // Give new orders + if OrderToAttack(ScanPosition, UA, UGA, HA) then + fState := csAttack + else + begin + fState := csWalking; + if InPosition AND not OrderMove(aTick, PathPosition) then + fState := csIdle; + end; + + UpdateSquadsState(); +end; + + +function TAICompany.OrderToAttack(aActualPosition: TKMPoint; UA: TKMUnitArray; UGA: TKMUnitGroupArray; HA: TKMHouseArray): Boolean; +type + TCompanyInfo = record + GTCnt: array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Word; // Count of soldiers sorted by GroupType + end; +var + AvailableSquads: TKMSquadsArray; + CompanyInfo: TCompanyInfo; + TargetU: TKMTargetSelection; + + // Find only available squads (we can give orders to them) and return if there are any + function FindAvailableSquads(var aSquadsInCombat: Boolean): Boolean; + var + Output: Boolean; + I: Integer; + GT: TKMGroupType; + Squad: TAISquad; + begin + Output := False; + aSquadsInCombat := False; + FillChar(CompanyInfo, SizeOf(CompanyInfo), #0); + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + AvailableSquads[GT].Count := 0; + SetLength(AvailableSquads[GT].Squads, fSquads[GT].Count); + end; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[GT].Count - 1 do + begin + Squad := fSquads[GT].Items[I]; + Inc(CompanyInfo.GTCnt[GT], Squad.Group.Count); + if not Squad.InFight then + begin + Output := True; + // Make sure that unit will not hunt target over the whole map and better stay inside company + if (GT <> gtRanged) then // ranged units are fixed in Squad class(set / reset target cause that they dont shoot and just reset animation) + begin + Squad.TargetUnit := nil; + //Squad.TargetHouse := nil; // This cause same problem like with archers + end; + AvailableSquads[GT].Squads[ AvailableSquads[GT].Count ] := Squad; + Inc(AvailableSquads[GT].Count); + end + else + aSquadsInCombat := True; + end; + Result := Output; + end; + + // Calculate evaluation to enemy groups in specific radius + procedure EvalEnemyGroupsInRadius(); + const + INIT_DIST = 1000000; + SQR_MAX_RANGE_INTEREST = 12*12; + SQR_RANGE_OF_PROJECTILES = 11*11; // Sqr( Max( Max(RANGE_BOWMAN_MAX,RANGE_ARBALETMAN_MAX),RANGE_SLINGSHOT_MAX ) ); + var + Polygon: Word; + I,K,L: Integer; + SqrDist, SqrClosestDist, SqrClosestDistToRanged, CloseCombatProtection: Single; + GT: TKMGroupType; + Squad: TAISquad; + GroupsInFightArr: TKMUnitGroupArray; + begin + SetLength(TargetU, Length(UA)); + for I := 0 to Length(TargetU) - 1 do + begin + // Get closest distance to Ranged groups and all groups + SqrClosestDist := INIT_DIST; + SqrClosestDistToRanged := INIT_DIST; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for K := 0 to fSquads[GT].Count - 1 do + begin + Squad := fSquads[GT].Items[K]; + L := 0; + while (L < Squad.Group.Count) do + begin + SqrDist := KMDistanceSqr(Squad.Group.Members[L].CurrPosition, UA[I].CurrPosition); + if (SqrDist < SqrClosestDist) then + SqrClosestDist := SqrDist; + if (GT = gtRanged) AND (SqrDist < SqrClosestDistToRanged) then + SqrClosestDistToRanged := SqrDist; + L := L + 3; + end; + end; + + // Calculate threat level + with TargetU[I] do + begin + Index := I; + CenterPoint := UGA[I].Position; + CloseThreat := 0; + DistantThreat := 0; + if (SqrClosestDist < SQR_MAX_RANGE_INTEREST) then + begin + CloseThreat := UGA[I].Count; // Threat level for close combat units + DistantThreat := CloseThreat; // Threat level for ranged group type + if (UGA[I].GroupType = gtRanged) then + begin + // Calculate distant threat level (determine whether archers are shooting at our troops) + CloseThreat := CloseThreat * AI_Par[ATTACK_COMPANY_AttackRangedGain]; + DistantThreat := DistantThreat * Byte(SQR_RANGE_OF_PROJECTILES > SqrClosestDist) * AI_Par[ATTACK_COMPANY_AttackRangedGain]; + // Close threat level is computed with using influences + CloseCombatProtection := 0; + Polygon := gAIFields.NavMesh.KMPoint2Polygon[ UGA[I].Position ]; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (GT <> gtRanged) then // Skip ranged units so AI have a tendency to walk through them if they are alone + CloseCombatProtection := CloseCombatProtection + gAIFields.Influences.EnemyGroupPresence[fOwner, Polygon, GT]; // Tune parameters + if (DistantThreat < CloseCombatProtection) then // Ranged units are well protected -> try shoot them + CloseThreat := Byte(SqrClosestDistToRanged <= SQR_RANGE_OF_PROJECTILES) // Lowest priority (=1) but dont ignore them (if we have no archers call infantry) + else // Ranged units are not protected -> attack with close combat units + DistantThreat := Byte(SqrClosestDist <= SQR_RANGE_OF_PROJECTILES); // Lowest priority but dont ignore them (if they are in range of archers shoot at them) + end + else + begin + // Close combat threat level (in case that group already fight agaist more soldiers there is 0 threat) + // In case that group kills ranged units threat must be increased + if UGA[I].InFightAgaistGroups(GroupsInFightArr) then + begin + for K := 0 to Length(GroupsInFightArr) - 1 do + if (GroupsInFightArr[K].GroupType = gtRanged) then + CloseThreat := CloseThreat + GroupsInFightArr[K].Count + else + CloseThreat := CloseThreat - GroupsInFightArr[K].Count; + end + // If group does not fight check how far is from ranged units + else + CloseThreat := CloseThreat + Max(0, (sqr(AI_Par[ATTACK_COMPANY_ProtectRangedRadius]) - SqrClosestDistToRanged) * AI_Par[ATTACK_COMPANY_ProtectRangedGain] ); + end; + end; + end; + end; + end; + + // Distribute available groups agaist enemies + function SelectTargetGroups(): Boolean; + const + INIT_THREAT = -10000000; + INIT_DISTANCE = 10000000; + BEST_TARGET: array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of array[0..3] of TKMGroupType = ( + (gtMelee, gtRanged, gtMounted, gtAntiHorse), // against gtMelee + (gtMelee, gtRanged, gtAntiHorse, gtMounted), // against gtAntiHorse + (gtMounted, gtRanged, gtMelee, gtAntiHorse), // against gtRanged + (gtAntiHorse, gtRanged, gtMounted, gtMelee) // against gtMounted + ); + var + Output: Boolean; + I,K,L,BestPrioIdx, TargetIdx, ThreatIdx, Cnt: Integer; + Threat, HighestThreat, Dist, BestDist, BestPrioCoeff: Single; + GT, BestGT: TKMGroupType; + Squad: TAISquad; + begin + Output := False; + if (Length(TargetU) <= 0) then + Exit; + + // Ranged groups view: our ranged unit -> select target => each unit should fire + GT := gtRanged; + ThreatIdx := 0; // Only for compiler + for I := AvailableSquads[GT].Count - 1 downto 0 do + begin + Squad := AvailableSquads[GT].Squads[I]; + HighestThreat := INIT_THREAT; + //BestDist := 0; + Dist := 0; + for K := 0 to Length(TargetU) - 1 do + if (TargetU[K].DistantThreat > 0) then + begin + Dist := KMDistanceSqr(TAISquad(fSquads[GT].Items[I]).Position, UA[ TargetU[K].Index ].CurrPosition); + Threat := TargetU[K].DistantThreat - Dist; + if (Threat > HighestThreat) then + begin + //BestDist := Dist; + HighestThreat := Threat; + ThreatIdx := K; + end; + end; + if (HighestThreat <> INIT_THREAT) then + begin + Output := True; + Squad.TargetUnit := UA[ TargetU[ThreatIdx].Index ]; + if (Dist >= sqr(AI_Par[ATTACK_COMPANY_ProtectRangedAllInDist])) then // If is enemy too cloose aim him but dont decrease threat level so next part of code can call close combat support + TargetU[ThreatIdx].DistantThreat := TargetU[ThreatIdx].DistantThreat - Squad.Group.Count; + // Unit will be targeted by Ranged group -> if there was minimal priority for close combat then remove it + if (TargetU[ThreatIdx].CloseThreat = 1) then + TargetU[ThreatIdx].CloseThreat := 0; + Dec(AvailableSquads[GT].Count); + AvailableSquads[GT].Squads[I] := AvailableSquads[GT].Squads[ AvailableSquads[GT].Count ]; + end + else + Squad.TargetUnit := nil; + end; + + // Close combat groups view: enemy units -> select oponent => keep something in reserve + Cnt := Length(TargetU); + BestGT := gtMelee; + TargetIdx := 0; // For compiler + BestPrioIdx := 0; // For compiler + BestPrioCoeff := 1; // For compiler + repeat + // Find top threat + HighestThreat := INIT_THREAT; + for I := Cnt - 1 downto 0 do + begin + if (TargetU[I].CloseThreat <= 0) then + begin + Cnt := Cnt - 1; + TargetU[I] := TargetU[Cnt]; + end + else if (TargetU[I].CloseThreat > HighestThreat) then + begin + HighestThreat := TargetU[I].CloseThreat; + ThreatIdx := I; + end; + end; + if (Cnt <= 0) then + break; + // Find best close combat opponent + BestDist := INIT_DISTANCE; + for K := 0 to 3 do + begin + GT := BEST_TARGET[ UGA[ TargetU[ThreatIdx].Index ].GroupType, K ]; + for L := 0 to AvailableSquads[GT].Count - 1 do + begin + Dist := KMDistanceSqr(AvailableSquads[GT].Squads[L].Position, UA[ TargetU[ThreatIdx].Index ].CurrPosition) + K * AI_Par[ATTACK_COMPANY_GroupTypePenalization]; + if (Dist < BestDist) then + begin + BestDist := Dist; + TargetIdx := L; + BestGT := GT; + BestPrioIdx := K; + end; + end; + end; + // Set target + if (BestDist < INIT_DISTANCE) then + begin + Output := True; + Squad := AvailableSquads[BestGT].Squads[TargetIdx]; + Squad.TargetUnit := UA[ TargetU[ThreatIdx].Index ]; + // Update threat level and call another squad if needed + case BestPrioIdx of + 0: BestPrioCoeff := AI_Par[ATTACK_COMPANY_DecreaseThreat_Prio1]; + 1: BestPrioCoeff := AI_Par[ATTACK_COMPANY_DecreaseThreat_Prio2]; + 2: BestPrioCoeff := AI_Par[ATTACK_COMPANY_DecreaseThreat_Prio3]; + 3: BestPrioCoeff := AI_Par[ATTACK_COMPANY_DecreaseThreat_Prio4]; + end; + TargetU[ThreatIdx].CloseThreat := TargetU[ThreatIdx].CloseThreat - Squad.Group.Count * BestPrioCoeff; + Dec(AvailableSquads[BestGT].Count); + AvailableSquads[BestGT].Squads[TargetIdx] := AvailableSquads[BestGT].Squads[ AvailableSquads[BestGT].Count ]; + end; + until (Cnt <= 0) OR (BestDist >= INIT_DISTANCE); + Result := Output; + end; + + + function OrderAttackHouse(): Boolean; + const + INIT_THREAT = 1000000; + LIMIT_RANGED_DESTROY_ALL_HOUSES = 6; // Archers will start to shoot at other houses if there is not enough close combat units in company + CLOSE_COMBAT_DISTANCE_LIMIT = 12; // Order to attack house starts at this distance (close combat groups; watchtowers have exception) + MAX_SOLDIERS_VS_HOUSE = 12; + MAX_ARCHERS_VS_TOWER = 9; + ATTACK_WATCHTOWER_WITH_CLOSE_COMBAT_DIST = 5; // Attack watchtower with close combat units + MAX_CLOSE_COMBAT_VS_UNIT_DIST = 3; // Kill citizens in this radius around house (workers tries to repair house) + var + Output: Boolean; + TargetIdx: Word; + I,K: Integer; + Dist, BestDist: Single; + GT: TKMGroupType; + U: TKMUnit; + GroupAttackCnt: TKMWordArray; + begin + Output := False; + SetLength(GroupAttackCnt, Length(HA)); + FillChar(GroupAttackCnt[0], SizeOf(GroupAttackCnt[0]) * Length(GroupAttackCnt), #0); + + // Target watchtowers with archers + GT := gtRanged; + TargetIdx := 0; // Only for compiler + for I := AvailableSquads[GT].Count - 1 downto 0 do + begin + BestDist := INIT_THREAT; + for K := 0 to Length(HA) - 1 do + if (HA[K].HouseType = htWatchTower) + AND (GroupAttackCnt[K] < MAX_ARCHERS_VS_TOWER) + AND (HA[K].CheckWareIn(wtStone) > 1) + AND HA[K].HasOwner then // Ignore towers without stone and without recruit inside + begin + Dist := KMDistanceSqr(AvailableSquads[GT].Squads[I].Position, HA[K].Position); + if (Dist < BestDist) then + begin + BestDist := Dist; + TargetIdx := K; + end; + end; + if (BestDist <> INIT_THREAT) then + begin + Output := True; + Inc(GroupAttackCnt[TargetIdx], AvailableSquads[GT].Squads[I].Group.Count); + // Find and kill workers who want to repair house + U := gAIFields.Eye.GetClosestUnitAroundHouse(HA[TargetIdx].HouseType, HA[TargetIdx].Position, AvailableSquads[GT].Squads[I].Position); + if (U <> nil) then + AvailableSquads[GT].Squads[I].TargetUnit := U + else + AvailableSquads[GT].Squads[I].TargetHouse := HA[TargetIdx]; + Dec(AvailableSquads[GT].Count); + AvailableSquads[GT].Squads[I] := AvailableSquads[GT].Squads[ AvailableSquads[GT].Count ]; + end; + end; + + // Target everything else with close combat units + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + if GT = gtRanged then // Ignore ranged units if we have enough close combat support (avoid friendly fire) + with CompanyInfo do + if (GTCnt[gtMelee] + GTCnt[gtAntiHorse] + GTCnt[gtMounted] > LIMIT_RANGED_DESTROY_ALL_HOUSES) then + continue; + for I := AvailableSquads[GT].Count - 1 downto 0 do + begin + BestDist := INIT_THREAT; + for K := 0 to Length(HA) - 1 do + if ( + (HA[K].HouseType <> htWatchTower) + OR ( KMDistanceSqr(AvailableSquads[GT].Squads[I].Position, HA[K].Position) < sqr(ATTACK_WATCHTOWER_WITH_CLOSE_COMBAT_DIST)) + ) + AND (GroupAttackCnt[K] < MAX_SOLDIERS_VS_HOUSE) then + begin + Dist := KMDistanceSqr(AvailableSquads[GT].Squads[I].Position, HA[K].Position); + if (Dist < BestDist) AND (Dist <= sqr(CLOSE_COMBAT_DISTANCE_LIMIT)) then + begin + BestDist := Dist; + TargetIdx := K; + end; + end; + if (BestDist <> INIT_THREAT) then + begin + Output := True; + GroupAttackCnt[TargetIdx] := GroupAttackCnt[TargetIdx] + AvailableSquads[GT].Squads[I].Group.Count; + // Find and kill workers who want to repair house + U := gAIFields.Eye.GetClosestUnitAroundHouse(HA[TargetIdx].HouseType, HA[TargetIdx].Position, AvailableSquads[GT].Squads[I].Position); + if (U <> nil) + AND ((GT = gtRanged) OR (KMDistanceSqr(U.CurrPosition, AvailableSquads[GT].Squads[I].Position) < sqr(MAX_CLOSE_COMBAT_VS_UNIT_DIST))) then + AvailableSquads[GT].Squads[I].TargetUnit := U + else + AvailableSquads[GT].Squads[I].TargetHouse := HA[TargetIdx]; + Dec(AvailableSquads[GT].Count); + AvailableSquads[GT].Squads[I] := AvailableSquads[GT].Squads[ AvailableSquads[GT].Count ]; + end; + end; + end; + Result := Output; + end; + + + procedure Regroup(); + var + Cnt: Word; + I: Integer; + GT: TKMGroupType; + Squad: TAISquad; + Positions: TKMPointArray; + InitPolygons: TKMWordArray; + begin + Cnt := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + Cnt := Cnt + AvailableSquads[GT].Count; + + if (Cnt = 0) then + Exit; + + // Get positions around center of scan area + SetLength(InitPolygons,1); + InitPolygons[0] := gAIFields.NavMesh.KMPoint2Polygon[ fScanPosition ]; + gAIFields.NavMesh.Positioning.FindPositions(Cnt, Round(AI_Par[ATTACK_COMPANY_MinCombatSpacing]), InitPolygons, Positions); + + Cnt := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to AvailableSquads[GT].Count - 1 do + begin + Squad := AvailableSquads[GT].Squads[I]; + Squad.FinalPosition := KMPointDir( Positions[Cnt], KMGetDirection( Squad.Position, Positions[Cnt] ) ); + // Time limit does not make sence for unit in combat + //Squad.TimeLimit := gGameParams.GameTick + KMDistanceAbs(Position, Squads[ClosestIdx].Position) * TIME_PER_A_TILE; + Cnt := Cnt + 1; + if (Cnt >= Length(Positions)) then + Exit; + end; + end; + + +var + FreeSquads, SquadsInCombat, AttackGroup, AttackHouse: Boolean; +begin + // Find Available squads (groups who obey orders / are not in combat) + FreeSquads := FindAvailableSquads(SquadsInCombat); + AttackGroup := False; + AttackHouse := False; + + // Attack groups in radius + if (Length(UA) > 0) AND FreeSquads then + begin + // Calculate threat level of each enemy group in radius + EvalEnemyGroupsInRadius(); + + // Attack hostile units in radius + AttackGroup := SelectTargetGroups(); + end; + + // Attack houses in radius + if (Length(HA) > 0) AND FreeSquads then + AttackHouse := OrderAttackHouse(); + + // Move troops in reserve into new center point + if AttackGroup OR AttackHouse then + Regroup(); + + Result := AttackGroup OR AttackHouse OR SquadsInCombat; +end; + + +function TAICompany.OrderMove(aTick: Cardinal; aActualPosition: TKMPoint): Boolean; + + function GetInitPolygons(aCnt: Integer; var aPointPath: TKMPointArray): TKMWordArray; + var + InitPolygon: Word; + I, Idx: Integer; + InitPolygons: TKMWordArray; + begin + // Get initial point on the path (it must be in specific distance from actual position to secure smooth moving of the company) + I := Length(aPointPath)-1; + while (I >= 0) AND (KMDistanceAbs(aActualPosition, aPointPath[I]) < AI_Par[ATTACK_COMPANY_MinimumMovement]) do + I := I - 1; + // Make sure that platoon will not start in actual polygon but position will be moved forward + InitPolygon := gAIFields.NavMesh.KMPoint2Polygon[ aActualPosition ]; + repeat + fPathPosition := aPointPath[ Max(0, I) ]; + I := I - 1; + until (InitPolygon <> gAIFields.NavMesh.KMPoint2Polygon[ fPathPosition ]) OR (I < 0); + + I := Max(0,I + 1); // I = 0 we are in polygon of our target + // Get several init polygons + SetLength(InitPolygons, Min(Length(aPointPath) - I, Max(1, Round(AI_Par[ATTACK_COMPANY_Positioning_InitPolyCnt]))) ); + Idx := 0; + while (I >= 0) AND (Idx < Length(InitPolygons)) do + begin + InitPolygons[Idx] := gAIFields.NavMesh.KMPoint2Polygon[ aPointPath[I] ]; + Idx := Idx + 1; + I := I - 2; + end; + if (Idx <> Length(InitPolygons)) then + SetLength(InitPolygons, Idx); + Result := InitPolygons; + end; + + procedure SetOrders(aCnt: Integer; aTargetPosition: TKMPoint; var aPositions: TKMPointArray); + const + INFLUENCE_DANGER = 20; + INIT_DIST = 1000; + var + I, K, Dist, ClosestDist, ClosestIdx, SelectedTime: Integer; + Dir: TKMDirection; + Position: TKMPoint; + GT: TKMGroupType; + Squads: array of TAISquad; + AvailableSquads: TBooleanArray; + TagPositions: TKMPointTagList; + begin + // Get influence and set speed of move + SelectedTime := Round(AI_Par[ATTACK_COMPANY_TimePerATile_Slow]); + if (gAIFields.Influences.GetBestAllianceOwnership(fOwner, gAIFields.NavMesh.KMPoint2Polygon[aActualPosition], atEnemy) < INFLUENCE_DANGER) then + SelectedTime := Round(AI_Par[ATTACK_COMPANY_TimePerATile_Fast]); + // Get formations and set orders + // Sort points according to aTargetPosition (it should work better than aActualPosition) + TagPositions := TKMPointTagList.Create; + try + for I := 0 to Min(aCnt, High(aPositions)) do + TagPositions.Add(aPositions[I], KMDistanceAbs(aTargetPosition, aPositions[I])); + TagPositions.SortByTag(); + //fScanPosition := TagPositions.Items[TagPositions.Count - 1]; + //fPathPosition := TagPositions.Items[(TagPositions.Count - 1) div 2]; + Dir := KMGetDirection( aActualPosition, fPathPosition ); + + SetLength(Squads, aCnt); + SetLength(AvailableSquads, aCnt); + K := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[GT].Count - 1 do + begin + Squads[K] := fSquads[GT].Items[I]; + AvailableSquads[K] := True; + K := K + 1; + end; + ClosestIdx := 0; // Only for compiler + for I := TagPositions.Count - 1 downto 0 do + begin + Position := TagPositions.Items[I]; + ClosestDist := INIT_DIST; + for K := 0 to Length(Squads) - 1 do + if AvailableSquads[K] then + begin + Dist := KMDistanceAbs(Position, Squads[K].Position); + if (Dist < ClosestDist) then + begin + ClosestDist := Dist; + ClosestIdx := K; + end; + end; + if (ClosestDist = INIT_DIST) then + break; + + Squads[ClosestIdx].TargetUnit := nil; + Squads[ClosestIdx].TargetHouse := nil; + Squads[ClosestIdx].FinalPosition := KMPointDir(Position, Dir); + Squads[ClosestIdx].WalkTimeLimit := aTick + KMDistanceAbs(Position, Squads[ClosestIdx].Position) * SelectedTime; + AvailableSquads[ClosestIdx] := False; + end; + finally + TagPositions.Free; + end; + end; + +var + Distance: Word; + Cnt: Integer; + TargetPoint: TKMPoint; + PointPath, Positions: TKMPointArray; + InitPolygons: TKMWordArray; +begin + if (fCompanyMode = cmDefence) then + begin + TargetPoint := fTargetPoint; + Result := not KMSamePoint(TargetPoint, aActualPosition); + end + else + begin + TargetPoint := GetTargetPosition(); + Result := not KMSamePoint(TargetPoint, KMPOINT_ZERO); + end; + + if not Result then + Exit; + + // Try find path to the target point + //if gAIFields.NavMesh.Pathfinding.ShortestRoute(aActualPosition, TargetPoint, Distance, PointPath) then + if gAIFields.NavMesh.Pathfinding.AvoidTrafficRoute(fOwner, aActualPosition, TargetPoint, Distance, PointPath) then + begin + Cnt := SquadCnt(); // Count of groups in company + + // Get init polygons -> polygons on road which are base for army positioning (groups will get order to walk there) + InitPolygons := GetInitPolygons(Cnt, PointPath); + + // Get positions around init polygons + gAIFields.NavMesh.Positioning.FindPositions(Cnt, Round(AI_Par[ATTACK_COMPANY_MinWalkSpacing]), InitPolygons, Positions); + + // Compute distance of new positions and select the closest group to walk there + SetOrders(Cnt, TargetPoint, Positions); + end; + + {$IFDEF DEBUG_NewAI} + DEBUGPointPath := PointPath; + {$ENDIF} +end; + + +function TAICompany.SquadCnt(aTypes: TKMGroupTypeSet = GROUP_TYPES_VALID): Word; +var + GT: TKMGroupType; +begin + Result := 0; + for GT in aTypes do + Result := Result + fSquads[GT].Count; +end; + +function TAICompany.WarriorCnt(aTypes: TKMGroupTypeSet = GROUP_TYPES_VALID): Word; +var + K: Integer; + G: TKMUnitGroup; + GT: TKMGroupType; +begin + Result := 0; + for GT in aTypes do + for K := 0 to fSquads[GT].Count - 1 do + begin + G := TAISquad(fSquads[GT].Items[K]).Group; + if (G <> nil) then + Result := Result + G.Count; + end; +end; + + +procedure TAICompany.AddSquad(aGroup: TKMUnitGroup); +begin + fSquads[ aGroup.GroupType ].Add( TAISquad.Create(aGroup) ); +end; + + +procedure TAICompany.DeleteSquad(aGT: TKMGroupType; aIdx: Integer); +var + Squad: TAISquad; +begin + Squad := fSquads[aGT].Items[aIdx]; + Squad.Free; + fSquads[aGT].Delete(aIdx); +end; + + +procedure TAICompany.InitCompany(); +begin + fPathPosition := GetPosition(); + fScanPosition := fPathPosition; +end; + + +function TAICompany.GetPosition(): TKMPoint; +var + I, Count: Integer; + Output: TKMPoint; + G: TKMGroupType; +begin + Output := KMPOINT_ZERO; + Count := 0; + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[G].Count-1 do + begin + Output := KMPointAdd(Output, TAISquad(fSquads[G].Items[I]).Group.Position); + Count := Count + 1; + end; + + if (Count > 0) then + begin + Output.X := Round( Output.X / Count ); + Output.Y := Round( Output.Y / Count ); + end; + + // If we cannot walk there choose first group instead + I := gAIFields.NavMesh.KMPoint2Polygon[Output]; + if not (gTerrain.CheckPassability(Output, tpWalk) + AND ((gAIFields.Influences.PresenceAllGroups[ fOwner, I ] > 0) + //OR (gAIFields.Influences.ArmyTraffic[ fOwner, I ] > 0) + ) + ) then + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (fSquads[G].Count > 0) then + begin + Output := TAISquad(fSquads[G].Items[0]).Group.Position; + break; + end; + Result := Output; +end; + + +function TAICompany.GetPosition(var aSQRRadius: Single): TKMPoint; +var + I: Integer; + G: TKMGroupType; +begin + Result := GetPosition(); + + aSQRRadius := 0; + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[G].Count-1 do + aSQRRadius := Max(aSQRRadius, KMDistanceSqr(Result, TAISquad(fSquads[G].Items[I]).Group.Position)); +end; + + +function TAICompany.ActualizeTarget(aInitPosition: TKMPoint; var aTargetHouse: TKMHouse; var aTargetUnit: TKMUnit; aAimCivilians: Boolean = True): Boolean; +var + TargetGroup: TKMUnitGroup; +begin + Result := False; + aTargetUnit := nil; + aTargetHouse := gHands.GetClosestHouse(aInitPosition, fOwner, atEnemy, TARGET_HOUSES, True); + if (aTargetHouse = nil) then + begin + TargetGroup := gHands.GetClosestGroup(aInitPosition, fOwner, atEnemy); + if (TargetGroup = nil) then + begin + if not aAimCivilians then + begin + aTargetHouse := gHands.GetClosestHouse(aInitPosition, fOwner, atEnemy, ALL_HOUSES, True); + if (aTargetHouse <> nil) then + fCompanyMode := cmDestruction; + end + else + begin + aTargetUnit := gHands.GetClosestUnit(aInitPosition, fOwner, atEnemy); + if (aTargetUnit = nil) then + Exit; + end; + end + else + aTargetUnit := TargetGroup.GetAliveMember; + end; + Result := True; +end; + + +function TAICompany.IsGroupInCompany(aGroup: TKMUnitGroup): Boolean; +var + I: Integer; + G: TKMGroupType; +begin + Result := True; + for G := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for I := 0 to fSquads[G].Count-1 do + if (TAISquad(fSquads[G].Items[I]).Group = aGroup) then + Exit; + Result := False; +end; + + +{ TKMArmyAttack } +constructor TKMArmyAttack.Create(aOwner: TKMHandID); +begin + inherited Create; + fCompanies := TKMList.Create(); + fOwner := aOwner; +end; + + +destructor TKMArmyAttack.Destroy; +begin + fCompanies.Free; + inherited; +end; + + +procedure TKMArmyAttack.Save(SaveStream: TKMemoryStream); +var + I: Integer; +begin + SaveStream.PlaceMarker('ArmyAttack'); + SaveStream.Write(fOwner); + SaveStream.Write( Integer(Count) ); + + for I := 0 to Count - 1 do + Company[I].Save(SaveStream); +end; + + +procedure TKMArmyAttack.Load(LoadStream: TKMemoryStream); +var + I, NewCount: Integer; +begin + LoadStream.CheckMarker('ArmyAttack'); + LoadStream.Read(fOwner); + LoadStream.Read(NewCount); + + for I := 0 to NewCount - 1 do + fCompanies.Add( TAICompany.Load(LoadStream) ); +end; + + +procedure TKMArmyAttack.SyncLoad(); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Company[I].SyncLoad(); +end; + + +procedure TKMArmyAttack.AfterMissionInit(); +begin + +end; + + +procedure TKMArmyAttack.UpdateState(aTick: Cardinal); + function DetectEnemyPresence(aPoint: TKMPoint): Boolean; + var + Idx: Integer; + GT: TKMGroupType; + begin + Result := True; + Idx := gAIFields.NavMesh.KMPoint2Polygon[aPoint]; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (gAIFields.Influences.EnemyGroupPresence[ fOwner, Idx, GT ] > 0) then + Exit; + Result := False; + end; +var + I: Integer; + Company: TAICompany; +begin + for I := Count - 1 downto 0 do + begin + Company := fCompanies.Items[I]; + Company.UpdateState(aTick); + if ( (Company.SquadCnt = 0) OR (Company.State = csIdle) ) then + //AND ( (Company.CompanyMode in [cmAttack, cmDestruction]) OR not DetectEnemyPresence(Company.TargetPoint) ) then + fCompanies.Remove( Company ); + end; +end; + + +procedure TKMArmyAttack.OwnerUpdate(aPlayer: TKMHandID); +var + I: Integer; +begin + fOwner := aPlayer; + for I := Count - 1 downto 0 do + Company[I].Owner := aPlayer; +end; + + +function TKMArmyAttack.GetCount(): Integer; +begin + Result := fCompanies.Count; +end; + + +function TKMArmyAttack.GetCompany(aIdx: Integer): TAICompany; +begin + Result := fCompanies.Items[aIdx]; +end; + + +function TKMArmyAttack.IsGroupInAction(aGroup: TKMUnitGroup): Boolean; +var + I: Integer; +begin + Result := True; + for I := 0 to Count - 1 do + if Company[I].IsGroupInCompany(aGroup) then + Exit; + Result := False; +end; + + +procedure TKMArmyAttack.CreateCompany(aTargetPoint: TKMPoint; aGroups: TKMUnitGroupArray; aCompanyMode: TKMCompanyMode = cmAttack); + procedure PrepareCompany(var aCompany: TAICompany; aTargetHouse: TKMHouse; aTargetUnit: TKMUnit); + var + I: Integer; + begin + aCompany.SetTarget(aTargetHouse, aTargetUnit); + for I := 0 to Length(aGroups) - 1 do + aCompany.AddSquad( aGroups[I] ); + aCompany.InitCompany(); + end; +var + Company: TAICompany; + TargetHouse: TKMHouse; + TargetUnit: TKMUnit; +begin + TargetHouse := nil; + TargetUnit := nil; + Company := TAICompany.Create(fOwner, aCompanyMode); + fCompanies.Add( Company ); + if (aCompanyMode = cmAttack) AND Company.ActualizeTarget(aTargetPoint, TargetHouse, TargetUnit) then + begin + PrepareCompany(Company, TargetHouse, TargetUnit); + end + else if (aCompanyMode = cmDefence) then + begin + Company.TargetPoint := aTargetPoint; + PrepareCompany(Company, TargetHouse, TargetUnit); + end + else + fCompanies.Remove( Company ); +end; + + +procedure TKMArmyAttack.LogStatus(var aBalanceText: UnicodeString); +begin + //aBalanceText := ''; +end; + + +procedure TKMArmyAttack.Paint; +const + COLOR_WHITE = $FFFFFF; + COLOR_BLACK = $000000; + COLOR_GREEN = $00FF00; + COLOR_RED = $0000FF; + COLOR_YELLOW = $00FFFF; + COLOR_BLUE = $FF0000; +var + CompanySelected: Boolean; + K,L: Integer; + {$IFDEF DEBUG_NewAI} + M: Integer; + {$ENDIF} + Col, CompOpacity1, CompOpacity2, GroupOpacity1, GroupOpacity2: Cardinal; + Position: TKMPoint; + GT: TKMGroupType; + Company: TAICompany; + Squad: TAISquad; +begin + //if (fOwner <> gMySpectator.HandID) then // Show just 1 player (it prevents notification to be mess) + // Exit; + //if (fOwner <> 1) then // Show just 1 player (it prevents notification to be mess) + // Exit; + CompanySelected := False; + for K := 0 to Count - 1 do + begin + // Company status log + Company := fCompanies.Items[K]; + CompOpacity1 := $09000000; + CompOpacity2 := $33000000; + // Check if company is selected + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for L := Company.Squads[GT].Count - 1 downto 0 do + if ((gMySpectator.Selected is TKMUnitGroup) AND (gMySpectator.Selected = TAISquad(Company.Squads[GT].Items[L]).Group)) then + begin + CompanySelected := True; + CompOpacity1 := $20000000; + CompOpacity2 := $FF000000; + end; + + // Pathfinding (squads) + targets + if CompanySelected then + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for L := Company.Squads[GT].Count - 1 downto 0 do + begin + Squad := Company.Squads[GT].Items[L]; + // Highlight selected group and squad + GroupOpacity1 := $20000000; + GroupOpacity2 := $30000000; + if (gMySpectator.Selected is TKMUnitGroup) AND (gMySpectator.Selected = Squad.Group) then + begin + GroupOpacity1 := $99000000; + GroupOpacity2 := $FF000000; + end; + // Order position of group + Position := Squad.Group.OrderLoc.Loc; + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 0.25, $FF000000 OR COLOR_YELLOW, $FF000000 OR COLOR_YELLOW); + // Position + Position := Squad.Position; + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 0.75, GroupOpacity2 OR COLOR_GREEN, GroupOpacity2 OR COLOR_GREEN); + + // Target unit + if (Squad.TargetUnit <> nil) then + begin + if not Squad.TargetUnit.IsDeadOrDying then + begin + gRenderAux.LineOnTerrain(Position, Squad.TargetUnit.CurrPosition, GroupOpacity2 OR COLOR_RED); + {$IFDEF DEBUG_NewAI} + if (Length(Squad.DEBUGPointPath) > 0) then + for M := Length(Squad.DEBUGPointPath)-2 downto 0 do + gRenderAux.LineOnTerrain(Squad.DEBUGPointPath[M+1], Squad.DEBUGPointPath[M], GroupOpacity1 OR COLOR_BLUE); + {$ENDIF} + end; + end + // Target house + else if (Squad.TargetHouse <> nil) then + if not Squad.TargetHouse.IsDestroyed then + begin + gRenderAux.LineOnTerrain(Position, Squad.TargetHouse.Position, GroupOpacity2 OR COLOR_RED); + {$IFDEF DEBUG_NewAI} + if (Length(Squad.DEBUGPointPath) > 0) then + for M := Length(Squad.DEBUGPointPath)-2 downto 0 do + gRenderAux.LineOnTerrain(Squad.DEBUGPointPath[M+1], Squad.DEBUGPointPath[M], GroupOpacity1 OR COLOR_BLUE); + {$ENDIF} + end; + // Pathfinding + if not KMSamePoint(Squad.FinalPosition.Loc,KMPOINT_ZERO) then + begin + //gRenderAux.LineOnTerrain(Position, Squad.FinalPosition.Loc, $AAFF5555); + gRenderAux.CircleOnTerrain(Squad.FinalPosition.Loc.X, Squad.FinalPosition.Loc.Y, 1, 0, GroupOpacity1 OR COLOR_BLUE); + {$IFDEF DEBUG_NewAI} + if (Length(Squad.DEBUGPointPath) > 0) then + for M := Length(Squad.DEBUGPointPath)-2 downto 0 do + gRenderAux.LineOnTerrain(Squad.DEBUGPointPath[M+1], Squad.DEBUGPointPath[M], GroupOpacity1 OR COLOR_BLUE); + {$ENDIF} + end; + end; + + // Change color according to state + Col := 0; // For compiler + case Company.State of + csAttack: Col := COLOR_RED; + csWalking: Col := COLOR_BLUE; + csIdle: Col := COLOR_BLACK; + end; + + // Mark company + Position := Company.ScanPosition; + {$IFDEF DEBUG_NewAI} + //gRenderAux.CircleOnTerrain(Position.X, Position.Y, Sqrt(Company.DEBUGScanRad), CompOpacity1 OR Col, CompOpacity2 OR Col); + {$ENDIF} + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 3, CompOpacity1 OR Col, CompOpacity2 OR Col); + Position := Company.PathPosition; + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 2, CompOpacity1 OR COLOR_GREEN, CompOpacity2 OR COLOR_GREEN); + + // Target aim + {$IFDEF DEBUG_NewAI} + for L := 0 to Length(Company.DEBUGTargetU) - 1 do + with Company.DEBUGTargetU[L] do + begin + Position := CenterPoint; + // Close threath + Col := (Min($FF, Max(0,Round(CloseThreat)) ) shl 24) OR COLOR_RED; + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 0.5, Col, $FF000000 OR COLOR_RED ); + // Distant threath + Col := (Min($FF, Max(0,Round(DistantThreat)) ) shl 24) OR COLOR_BLACK; + gRenderAux.CircleOnTerrain(Position.X, Position.Y+1, 0.5, Col, $FF000000 OR COLOR_BLACK ); + end; + {$ENDIF} + + // Pathfinding (company) + {$IFDEF DEBUG_NewAI} + if (Length(Company.DEBUGPointPath) > 0) then + for L := Length(Company.DEBUGPointPath)-2 downto 0 do + gRenderAux.LineOnTerrain(Company.DEBUGPointPath[L+1], Company.DEBUGPointPath[L], CompOpacity2 OR COLOR_YELLOW); + {$ENDIF} + end; + //gRenderAux.LineOnTerrain(P1, P2, $CCFF2222); + //gRenderAux.CircleOnTerrain(CenterPlatoon.X, CenterPlatoon.Y, 5, $09FFFFFF, $99FFFFFF); + //gRenderAux.Quad(Loc.X, Loc.Y, Color); +end; + + +// JUNK +{ + +function SelectClosestTarget(aInitPoint: TKMPoint; var aTargetHouse: TKMHouse; var aTargetUnit: TKMUnit; var aTargetGroup: TKMUnitGroup): Boolean; +function TKMArmyAttack.SelectClosestTarget(aInitPoint: TKMPoint; var aTargetHouse: TKMHouse; var aTargetUnit: TKMUnit; var aTargetGroup: TKMUnitGroup): Boolean; +begin + Result := False; + aTargetHouse := nil; + aTargetUnit := nil; + aTargetGroup := nil; + // Compute common stuf first + aTargetHouse := gHands.GetClosestHouse(aInitPoint, fOwner, atEnemy, TARGET_HOUSES, False); + if (aTargetHouse = nil) then + begin + aTargetGroup := gHands.GetClosestGroup(aInitPoint, fOwner, atEnemy); + if (aTargetGroup = nil) then + begin + aTargetUnit := gHands.GetClosestUnit(aInitPoint, fOwner, atEnemy); + if (aTargetUnit = nil) then + Exit; + end; + end; + + Result := True; +end; + +// Try find new target house in ownership area +function SelectNewTargetHouse(aPosition: TKMPoint): TKMHouse; +var + PLIdx: Word; + Enemies: TKMHandIndexArray; + HT: TKMHouseType; + H: TKMHouse; +begin + Result := nil; + Enemies := gAIFields.Influences.GetAllAllianceOwnership(fOwner, aPosition.X, aPosition.Y, atEnemy); + for PLIdx := 0 to Length(Enemies) - 1 do + for HT in TARGET_HOUSES do + begin + H := gHands[ Enemies[PLIdx] ].Houses.FindHouse(HT, aPosition.X, aPosition.Y); + if (H <> nil) then + begin + Result := H; + Exit; + end; + end; +end; +//} + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_ArmyAttackNew.pas b/vendor/kam_remake/src/ai/newAI/KM_ArmyAttackNew.pas new file mode 100644 index 0000000..9134831 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_ArmyAttackNew.pas @@ -0,0 +1,921 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_ArmyAttackNew; +{$I KaM_Remake.inc} +interface +uses + Generics.Collections, Classes, KromUtils, Math, SysUtils, + KM_Units, KM_UnitGroup, + KM_CommonClasses, KM_Defaults, KM_Points, + KM_Houses, KM_ResHouses, KM_NavMeshPathFinding, + KM_ResTypes; + +type + TKMTargetType = (ttNone, ttPoint, ttHouse, ttGroup, ttUnit); + TKMCombatPhase = (cpIdle, cpWalk, cpAttack, cpDead); + TKMStuckInTraffic = record + StuckInTraffic: Boolean; + StuckCounter: Byte; + PreviousPosition: TKMPoint; + end; + TKMCombatGroup = class; + TKMCombatGroupArray = array of TKMCombatGroup; + + TKMCombatGroup = class + fGroup: TKMUnitGroup; + fTargetType: TKMTargetType; + fCombatPhase: TKMCombatPhase; + fOnPlace, fTargetChanged: Boolean; + fTrafficDetection: TKMStuckInTraffic; + fTargetGroup: TKMUnitGroup; + fTargetUnit: TKMUnit; + fTargetHouse: TKMHouse; + fTargetPosition: TKMPointDir; + fTargetAim: TKMPoint; + fWalkTimeLimit, fAttackTimeLimit: Cardinal; + + function SquadInFight(): Boolean; inline; + function GetGroupPosition(): TKMPoint; inline; + function PlanPath(aTick: Cardinal; var aActualPosition, aTargetPosition: TKMPoint; aOrderAttack: Boolean = False; aOrderDestroy: Boolean = False): Boolean; + + procedure SetTargetGroup(aGroup: TKMUnitGroup); + procedure SetTargetUnit(aUnit: TKMUnit); + procedure ChangeTargetUnit(aUnit: TKMUnit); + procedure SetTargetHouse(aHouse: TKMHouse); + procedure SetTargetPosition(aLoc: TKMPointDir); + + public + {$IFDEF DEBUG_NewAI} + DEBUGPointPath: TKMPointArray; + {$ENDIF} + constructor Create(aGroup: TKMUnitGroup); + constructor Load(LoadStream: TKMemoryStream); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure SyncLoad(); + + property Group: TKMUnitGroup read fGroup; + property TargetType: TKMTargetType read fTargetType; + property CombatPhase: TKMCombatPhase read fCombatPhase; + property OnPlace: Boolean read fOnPlace; + property InFight: Boolean read SquadInFight; + property Position: TKMPoint read GetGroupPosition; + property StuckInTraffic: Boolean read fTrafficDetection.StuckInTraffic; + property WalkTimeLimit: Cardinal read fWalkTimeLimit write fWalkTimeLimit; + property AttackTimeLimit: Cardinal read fAttackTimeLimit write fAttackTimeLimit; + property TargetGroup: TKMUnitGroup read fTargetGroup write SetTargetGroup; + property TargetUnit: TKMUnit read fTargetUnit write SetTargetUnit; + property TargetHouse: TKMHouse read fTargetHouse write SetTargetHouse; + property TargetPosition: TKMPointDir read fTargetPosition write SetTargetPosition; + property TargetAim: TKMPoint read fTargetAim; + + procedure UpdateState(aTick: Cardinal); + end; + + TKMArmyAttackNew = class + private + fOwner: TKMHandID; + fCombatGroups: TObjectList; + + function GetCount(): Integer; + function GetCombatGroupIdx(aGroup: TKMUnitGroup): Integer; + function GetCombatGroup(aGroup: TKMUnitGroup): TKMCombatGroup; + public + constructor Create(aOwner: TKMHandID); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + property CG: TObjectList read fCombatGroups; + property Count: Integer read GetCount; + property CombatGroup[aGroup: TKMUnitGroup]: TKMCombatGroup read GetCombatGroup; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure OwnerUpdate(aPlayer: TKMHandID); + + function IsGroupInAction(aGroup: TKMUnitGroup): Boolean; + + function AddGroup(const aGroup: TKMUnitGroup): TKMCombatGroup; + procedure AddGroups(const aGroups: TKMUnitGroupArray); + procedure ReleaseGroup(aGroup: TKMUnitGroup); + procedure ReleaseGroups(); + procedure LinkGroup(aGroup: TKMUnitGroup); + + procedure LogStatus(var aBalanceText: UnicodeString); + procedure Paint(); + end; + +const + // Houses in TARGET_HOUSES will be selected as a primary target (so the company will come to this point but it will not attack it because of this list) + TARGET_HOUSES: TKMHouseTypeSet = [htBarracks, htStore, htSchool, htTownhall]; + // Houses in SCAN_HOUSES will be destroyed when they are in radius (it should also contain TARGET_HOUSES) + SCAN_HOUSES: TKMHouseTypeSet = [htWatchTower, htBarracks, htStore, htSchool, htTownhall]; + // All houses for final stage of attack algorithm + ALL_HOUSES: TKMHouseTypeSet = HOUSES_VALID; + +{$IFDEF DEBUG_NewAI} +var + gTimePathfinding, gTimeAiming: Int64; +{$ENDIF} + +implementation +uses + Types, TypInfo, + KM_Entity, + KM_Game, KM_GameParams, + KM_HandsCollection, KM_HandTypes, KM_HandEntity, + KM_Terrain, KM_AIFields, + KM_NavMesh, KM_RenderAux, + {$IFDEF DEBUG_NewAI} + KM_CommonUtils, + {$ENDIF} + KM_UnitWarrior, KM_AIParameters, KM_UnitActionFight, KM_UnitActionWalkTo, + KM_UnitGroupTypes; + + +{ TKMCombatGroup } +constructor TKMCombatGroup.Create(aGroup: TKMUnitGroup); +begin + inherited Create; + fTargetType := ttPoint; + fCombatPhase := cpIdle; + fOnPlace := False; + fTargetChanged := True; + fTrafficDetection.StuckInTraffic := False; + fTrafficDetection.PreviousPosition := aGroup.Position; + fTrafficDetection.StuckCounter := 0; + fTargetPosition := KMPointDir(KMPOINT_ZERO, dirNA); + fTargetAim := KMPOINT_ZERO; + fWalkTimeLimit := 0; + fAttackTimeLimit := 0; + fGroup := aGroup.GetPointer(); + fTargetGroup := nil; + fTargetUnit := nil; + fTargetHouse := nil; +end; + + +destructor TKMCombatGroup.Destroy(); +begin + gHands.CleanUpGroupPointer(fGroup); + gHands.CleanUpGroupPointer(fTargetGroup); + gHands.CleanUpUnitPointer(fTargetUnit); + gHands.CleanUpHousePointer(fTargetHouse); + inherited; +end; + + +constructor TKMCombatGroup.Load(LoadStream: TKMemoryStream); +begin + inherited Create; + LoadStream.CheckMarker('CombatGroup'); + LoadStream.Read(fTargetType, SizeOf(fTargetType)); + LoadStream.Read(fCombatPhase, SizeOf(fCombatPhase)); + LoadStream.Read(fOnPlace); + LoadStream.Read(fTargetChanged); + LoadStream.Read(fTargetPosition); + LoadStream.Read(fTargetAim, SizeOf(fTargetAim)); + LoadStream.Read(fWalkTimeLimit, SizeOf(fWalkTimeLimit)); + LoadStream.Read(fAttackTimeLimit, SizeOf(fAttackTimeLimit)); + LoadStream.Read(fTrafficDetection, SizeOf(TKMStuckInTraffic)); + //Subst on syncload + LoadStream.Read(fGroup, 4); + LoadStream.Read(fTargetGroup, 4); + LoadStream.Read(fTargetUnit, 4); + LoadStream.Read(fTargetHouse, 4); +end; + + +procedure TKMCombatGroup.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('CombatGroup'); + SaveStream.Write(fTargetType, SizeOf(fTargetType)); + SaveStream.Write(fCombatPhase, SizeOf(fCombatPhase)); + SaveStream.Write(fOnPlace); + SaveStream.Write(fTargetChanged); + SaveStream.Write(fTargetPosition); + SaveStream.Write(fTargetAim, SizeOf(fTargetAim)); + SaveStream.Write(fWalkTimeLimit, SizeOf(fWalkTimeLimit)); + SaveStream.Write(fAttackTimeLimit, SizeOf(fAttackTimeLimit)); + SaveStream.Write(fTrafficDetection, SizeOf(TKMStuckInTraffic)); + SaveStream.Write(fGroup.UID); + SaveStream.Write(fTargetGroup.UID); + SaveStream.Write(fTargetUnit.UID); + SaveStream.Write(fTargetHouse.UID); +end; + + +procedure TKMCombatGroup.SyncLoad(); +begin + fGroup := gHands.GetGroupByUID(Integer(fGroup)); + fTargetHouse := gHands.GetHouseByUID(Integer(fTargetHouse)); + fTargetGroup := gHands.GetGroupByUID(Integer(fTargetGroup)); + fTargetUnit := gHands.GetUnitByUID(Integer(fTargetUnit)); +end; + + +procedure TKMCombatGroup.SetTargetGroup(aGroup: TKMUnitGroup); +begin + // Check old target + if (aGroup = fTargetGroup) then + Exit; + // Clear pointer + gHands.CleanUpGroupPointer(fTargetGroup); + // Update target + if (aGroup = nil) OR aGroup.IsDead then + SetTargetUnit(nil) + else + begin + fTargetGroup := aGroup.GetPointer; + ChangeTargetUnit( aGroup.GetAliveMember() ); + end; +end; + + +procedure TKMCombatGroup.SetTargetUnit(aUnit: TKMUnit); +begin + // Check old target + if (fTargetUnit = aUnit) then + Exit; + // Remove group pointer + gHands.CleanUpGroupPointer(fTargetGroup); + // Archers will reaim (+ reset animation) only in case that new target is in specific distance from existing target + if (aUnit <> nil) AND not aUnit.IsDeadOrDying then + ChangeTargetUnit(aUnit) + else + gHands.CleanUpUnitPointer(fTargetUnit); +end; + + +procedure TKMCombatGroup.ChangeTargetUnit(aUnit: TKMUnit); +begin + fTargetChanged := (fTargetUnit = nil) OR not fTargetUnit.IsDeadOrDying + OR ((aUnit is TKMUnitWarrior) AND (fTargetUnit is TKMUnitWarrior) AND (TKMUnitWarrior(fTargetUnit).Group <> TKMUnitWarrior(aUnit).Group)); + gHands.CleanUpUnitPointer(fTargetUnit); + fTargetUnit := aUnit.GetPointer; +end; + + +procedure TKMCombatGroup.SetTargetHouse(aHouse: TKMHouse); +begin + // House have lower priority so if there is request for attacking house, then target group and unit must be nil + if (aHouse <> nil) AND not aHouse.IsDestroyed then + SetTargetGroup(nil); // Includes also nil of target unit + // Check old target + if (fTargetHouse = aHouse) then + Exit; + // Clean pointer + gHands.CleanUpHousePointer(fTargetHouse); + // Update target + fTargetChanged := True; + if (aHouse <> nil) then + fTargetHouse := aHouse.GetPointer; +end; + + +procedure TKMCombatGroup.SetTargetPosition(aLoc: TKMPointDir); +begin + SetTargetGroup(nil); + SetTargetHouse(nil); + fTargetPosition := aLoc; + fWalkTimeLimit := gGameParams.Tick + KMDistanceAbs(fTargetPosition.Loc, Position) * 5; +end; + + +function TKMCombatGroup.SquadInFight(): Boolean; +begin + Result := not fGroup.CanTakePlayerOrders; +end; + + +function TKMCombatGroup.GetGroupPosition(): TKMPoint; +begin + Result := fGroup.Position; +end; + + +// Update state of squad (group orders) +procedure TKMCombatGroup.UpdateState(aTick: Cardinal); + + function GetTargetUnitPosition(): TKMPoint; + var + K: Integer; + Dist, BestDist: Single; + BestTgt: TKMUnit; + G: TKMUnitGroup; + begin + Result := fTargetUnit.Position; + // Get closest warrior in enemy group if the squad is ranged + if (fGroup.GroupType = gtRanged) AND (fTargetUnit is TKMUnitWarrior) then + begin + BestTgt := nil; + G := TKMUnitWarrior(fTargetUnit).Group; + //Group will be nil if we target a warrior still walking out of barracks + if G <> nil then + begin + BestDist := 1E10; + for K := 0 to G.Count - 1 do + if not G.Members[K].IsDeadOrDying then + begin + Dist := KMDistanceSqr(fGroup.Position,G.Members[K].Position); + if (Dist < BestDist) then + begin + BestTgt := G.Members[K]; + BestDist := Dist; + end; + end; + if (BestTgt <> nil) then + begin + gHands.CleanUpUnitPointer(fTargetUnit); + fTargetUnit := BestTgt.GetPointer; + end; + end; + end; + end; + + procedure MoveRangedInFormation(); + var + K, CntFighting, CntWalking, CntCanFight: Integer; + NodeList: TKMPointList; + {$IFDEF DEBUG_NewAI} + Timer: Int64; + {$ENDIF} + begin + {$IFDEF DEBUG_NewAI} + Timer := TimeGetUsec(); + {$ENDIF} + // Target comes from behind + K := Abs(Byte(KMGetDirection(Position,TargetAim)) - Byte(Group.OrderLoc.Dir)); + if (K > 1) AND (K < 7) then + begin + Group.OrderAttackUnit(fTargetUnit, True); + Exit; + end; + //if Group.GetAliveMember.WithinFightRange(fTargetAim) then + // Check amount of shooting members + CntFighting := 0; + CntWalking := 0; + CntCanFight := 0; + for K := 0 to Group.Count - 1 do + begin + CntFighting := CntFighting + Byte(Group.Members[K].Action is TKMUnitActionFight); + CntWalking := CntWalking + Byte(Group.Members[K].Action is TKMUnitActionWalkTo); + CntCanFight := CntCanFight + Byte(Group.Members[K].WithinFightRange(fTargetAim)); + end; + if (CntFighting = 0) AND (CntCanFight > 0) then + begin + Group.OrderAttackUnit(fTargetUnit, True); + Exit; + end; + if (CntFighting > Group.Count * 0.7) OR (CntCanFight > Group.Count * 0.5) OR (CntWalking + CntFighting > Group.Count * 0.7) then + Exit; + NodeList := TKMPointList.Create; + try + if gGame.Pathfinding.Route_Make(Group.GetAliveMember.Position, TargetUnit.PositionNext, [tpWalk], Group.GetAliveMember.GetFightMaxRange, nil, NodeList) then + begin + fTargetPosition := KMPointDir(NodeList[NodeList.Count-1],KMGetDirection(NodeList[NodeList.Count-1], TargetUnit.PositionNext)); + if KMSamePoint(fTargetPosition.Loc, Position) then + fTargetPosition.Loc := KMGetPointInDir(fTargetPosition.Loc, fTargetPosition.Dir, 1); + Group.OrderWalk(fTargetPosition.Loc, True, wtokAISquad, fTargetPosition.Dir); + end; + finally + NodeList.Free; + end; + {$IFDEF DEBUG_NewAI} + gTimeAiming := gTimeAiming + TimeGetUsec() - Timer; + {$ENDIF} + end; + +var + walkedDistance: Integer; + ActPos: TKMPoint; +begin + fOnPlace := False; + // Check group status and possibility to give order + if (fGroup = nil) OR fGroup.IsDead then + fCombatPhase := cpDead; + if (fCombatPhase = cpDead) OR InFight then + Exit; + + // Check targets + if (fTargetGroup <> nil) AND fTargetGroup.IsDead then + SetTargetGroup(nil); + if (fTargetUnit <> nil) AND fTargetUnit.IsDeadOrDying then + begin + if (fTargetGroup <> nil) then + begin + ChangeTargetUnit( fTargetGroup.GetAliveMember() ); + fTargetAim := GetTargetUnitPosition(); + // New target is out of range -> wait for supervisor to update target group to the closest + if KMDistanceSqr(fTargetAim,Position) > Sqr(Group.GetAliveMember.GetFightMaxRange) then + begin + fTargetType := ttGroup; + fCombatPhase := cpAttack; + Exit; + end; + end + else + SetTargetUnit(nil); + end; + if (fTargetHouse <> nil) AND (fTargetHouse.IsDestroyed) then + SetTargetHouse(nil); + + // Orders + ActPos := Position; + if (fTargetUnit <> nil) OR (fTargetGroup <> nil) then + begin + fTargetAim := GetTargetUnitPosition(); + if PlanPath(aTick, ActPos, fTargetAim, True, False) then // Check if squad is in the place + Group.OrderWalk(fTargetAim, True, wtokAISquad, TargetPosition.Dir) + else if (fGroup.GroupType = gtRanged) then + MoveRangedInFormation() + else if + fTargetChanged // Target has been changed + OR (KMDistanceSqr(fTargetAim,ActPos) > 12*12) + OR (fGroup.Order in [goNone, goAttackHouse, goWalkTo]) // Force Group to change its task + OR (fAttackTimeLimit < aTick) // Make sure that unit is not stuck + then + begin + fAttackTimeLimit := aTick + Round(AI_Par[ATTACK_SQUAD_ChangeTarget_Delay]); + fTargetChanged := False; + Group.OrderAttackUnit(fTargetUnit, True); + end; + fOnPlace := True; + end + else if (fTargetHouse <> nil) then + begin + fTargetAim := fTargetHouse.Position; + if PlanPath(aTick, ActPos, fTargetAim, False, True) then + Group.OrderWalk(fTargetAim, True, wtokAISquad, TargetPosition.Dir) + else if (fGroup.GroupType <> gtRanged) OR fTargetChanged OR (fAttackTimeLimit < aTick) then + begin + fAttackTimeLimit := aTick + Round(AI_Par[ATTACK_SQUAD_ChangeTarget_Delay]); + fTargetChanged := False; + Group.OrderAttackHouse(fTargetHouse, True); + end; + fOnPlace := True; + end + else if not KMSamePoint(TargetPosition.Loc, KMPOINT_ZERO) then + begin + fTargetAim := TargetPosition.Loc; + if PlanPath(aTick, ActPos, fTargetAim, False, False) then + Group.OrderWalk(fTargetAim, True, wtokAISquad, TargetPosition.Dir) + else if not KMSamePoint(Group.Position, TargetPosition.Loc) then // Dont repeat order and let archers fire + Group.OrderWalk(TargetPosition.Loc, True, wtokAISquad, TargetPosition.Dir); + end + else + Group.OrderNone(); + + fTargetType := ttNone; + fCombatPhase := cpAttack; + if (fTargetHouse <> nil) then fTargetType := ttHouse + else if (fTargetGroup <> nil) then fTargetType := ttGroup + else if (fTargetUnit <> nil) then fTargetType := ttUnit + else if not KMSamePoint(fTargetPosition.Loc, KMPOINT_ZERO) then + begin + fTargetType := ttPoint; + fCombatPhase := cpWalk; + end + else + fCombatPhase := cpIdle; + + // Check traffic + walkedDistance := KMDistanceAbs(fTrafficDetection.PreviousPosition, fGroup.Position); + fTrafficDetection.StuckCounter := min(round(AI_Par[ATTACK_SQUAD_TrafficDetection_Limit]), max(0, Word(fCombatPhase = cpWalk) * fTrafficDetection.StuckCounter + Word(walkedDistance <= 1) * 2 - 1)); + fTrafficDetection.StuckInTraffic := fTrafficDetection.StuckCounter > AI_Par[ATTACK_SQUAD_TrafficDetection_Threshold]; + fTrafficDetection.PreviousPosition := fGroup.Position; +end; + + +function TKMCombatGroup.PlanPath(aTick: Cardinal; var aActualPosition, aTargetPosition: TKMPoint; aOrderAttack: Boolean = False; aOrderDestroy: Boolean = False): Boolean; +var + PathFound: Boolean; + InitPolygon, ClosestPolygon, Distance: Word; + I: Integer; + SQRDist: Single; + PointPath: TKMPointArray; + {$IFDEF DEBUG_NewAI} + Timer: Int64; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Timer := TimeGetUsec(); + {$ENDIF} + Result := False; + fOnPlace := False; + SQRDist := KMDistanceSqr(aActualPosition, aTargetPosition); + // Time limit + if (not (aOrderAttack OR aOrderDestroy) AND (fWalkTimeLimit < aTick)) // Time limit is set to 0 in case that unit attack something + // Target position is reached + OR (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_Position])) + // Target unit is close + OR (aOrderAttack AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_Unit]))) + // Target house is close + OR (aOrderDestroy AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_House]))) + // Archers should start fire as soon as possible + OR ((aOrderAttack OR aOrderDestroy) AND (fGroup.GroupType = gtRanged) AND (SQRDist < sqr(AI_Par[ATTACK_SQUAD_TargetReached_RangedSquad]))) then + begin + fOnPlace := True; + Exit; + end; + // Plan path with respect to enemy presence + if aOrderAttack then + PathFound := gAIFields.NavMesh.Pathfinding.AvoidEnemyRoute(Group.Owner, Group.GroupType, aActualPosition, aTargetPosition, Distance, PointPath) + else if aOrderDestroy then + PathFound := gAIFields.NavMesh.Pathfinding.ShortestRoute(aActualPosition, aTargetPosition, Distance, PointPath) + else + PathFound := gAIFields.NavMesh.Pathfinding.AvoidTrafficRoute(Group.Owner, aActualPosition, aTargetPosition, Distance, PointPath); + + if PathFound then + begin + if Distance < 5 then + begin + fOnPlace := True; + Exit; + end + else + begin + InitPolygon := gAIFields.NavMesh.KMPoint2Polygon[aActualPosition]; + I := Length(PointPath)-1; + repeat + aTargetPosition := PointPath[Max(0, I)]; + ClosestPolygon := gAIFields.NavMesh.KMPoint2Polygon[aTargetPosition]; + I := I - 1; + until (I < 0) or ( + (InitPolygon <> ClosestPolygon) + and (tpWalk in gTerrain.Land^[aTargetPosition.Y, aTargetPosition.X].Passability) + and (KMDistanceSqr(aActualPosition, aTargetPosition) > sqr(AI_Par[ATTACK_SQUAD_MinWalkingDistance])) + ); + + {$IFDEF DEBUG_NewAI} + DEBUGPointPath := PointPath; + {$ENDIF} + end; + end; + Result := True; + {$IFDEF DEBUG_NewAI} + gTimePathfinding := gTimePathfinding + TimeGetUsec() - Timer; + {$ENDIF} +end; + + +{ TKMArmyAttackNew } +constructor TKMArmyAttackNew.Create(aOwner: TKMHandID); +begin + inherited Create; + fCombatGroups := TObjectList.Create(); + fOwner := aOwner; + {$IFDEF DEBUG_NewAI} + gTimePathfinding := 0; + gTimeAiming := 0; + {$ENDIF} +end; + + +destructor TKMArmyAttackNew.Destroy; +begin + fCombatGroups.Free; // Calls also Clear() + inherited; +end; + + +procedure TKMArmyAttackNew.Save(SaveStream: TKMemoryStream); +var + K: Integer; +begin + SaveStream.PlaceMarker('ArmyAttack'); + SaveStream.Write(fOwner); + SaveStream.Write( Integer(Count) ); + + for K := 0 to Count - 1 do + fCombatGroups[K].Save(SaveStream); +end; + + +procedure TKMArmyAttackNew.Load(LoadStream: TKMemoryStream); +var + K, NewCount: Integer; +begin + LoadStream.CheckMarker('ArmyAttack'); + LoadStream.Read(fOwner); + LoadStream.Read(NewCount); + + for K := 0 to NewCount - 1 do + fCombatGroups.Add( TKMCombatGroup.Load(LoadStream) ); +end; + + +procedure TKMArmyAttackNew.SyncLoad(); +var + K: Integer; +begin + for K := 0 to Count - 1 do + fCombatGroups[K].SyncLoad(); +end; + + +procedure TKMArmyAttackNew.AfterMissionInit(); +begin + +end; + + +procedure TKMArmyAttackNew.UpdateState(aTick: Cardinal); +var + K: Integer; +begin + // Update target point + { + for K := fCombatGroups.Count - 1 downto 0 do + for L := 0 to Length( gAIFields.Supervisor.fArmyPos.fAllyGroups) - 1 do + if ( gAIFields.Supervisor.fArmyPos.fAllyGroups[L] = fCombatGroups[K].Group) then + begin + if (Length(gAIFields.Supervisor.fArmyPos.TargetPositions) > L) then + begin + fCombatGroups[K].TargetPosition := KMPointDir(gAIFields.Supervisor.fArmyPos.TargetPositions[L],dirNE); + fCombatGroups[K].WalkTimeLimit := aTick + ; + end; + break; + end; + } + + // Check state + //for K := fCombatGroups.Count - 1 downto 0 do + //begin + // CG := fCombatGroups.Items[K]; + // //CG.UpdateState(aTick); + //end; + + // Update state + for K := fCombatGroups.Count - 1 downto 0 do + begin + fCombatGroups[K].UpdateState(aTick); + if (fCombatGroups[K].CombatPhase = cpDead) then + fCombatGroups.Delete(K); + end; +end; + + +procedure TKMArmyAttackNew.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + + +function TKMArmyAttackNew.GetCount(): Integer; +begin + Result := fCombatGroups.Count; +end; + + +function TKMArmyAttackNew.GetCombatGroupIdx(aGroup: TKMUnitGroup): Integer; +var + K: Integer; +begin + Result := -1; + for K := 0 to Count - 1 do + if (fCombatGroups[K].Group = aGroup) then + Exit(K); +end; + + +function TKMArmyAttackNew.GetCombatGroup(aGroup: TKMUnitGroup): TKMCombatGroup; +var + K: Integer; +begin + Result := nil; + K := GetCombatGroupIdx(aGroup); + if (K <> -1) then + Result := fCombatGroups[K]; +end; + + +function TKMArmyAttackNew.IsGroupInAction(aGroup: TKMUnitGroup): Boolean; +begin + Result := GetCombatGroup(aGroup) <> nil; +end; + + +function TKMArmyAttackNew.AddGroup(const aGroup: TKMUnitGroup): TKMCombatGroup; +var + Idx: Integer; +begin + Result := nil; + if (aGroup <> nil) AND not aGroup.IsDead then + begin + Result := GetCombatGroup(aGroup); + if (Result = nil) then + begin + Idx := fCombatGroups.Add( TKMCombatGroup.Create(aGroup) ); + Result := fCombatGroups[Idx]; + end; + end; +end; + + +procedure TKMArmyAttackNew.AddGroups(const aGroups: TKMUnitGroupArray); +var + K: Integer; +begin + for K := 0 to Length(aGroups) - 1 do + AddGroup(aGroups[K]); +end; + + +procedure TKMArmyAttackNew.ReleaseGroup(aGroup: TKMUnitGroup); +var + K: Integer; +begin + K := GetCombatGroupIdx(aGroup); + if (K <> -1) then + fCombatGroups.Delete(K); +end; + + +procedure TKMArmyAttackNew.ReleaseGroups(); +begin + fCombatGroups.Clear(); +end; + + +procedure TKMArmyAttackNew.LinkGroup(aGroup: TKMUnitGroup); +var + K: Integer; +begin + for K := 0 to Count - 1 do + if (aGroup.GroupType = fCombatGroups[K].Group.GroupType) AND (fCombatGroups[K].Group.Count < 9) then + begin + if (fCombatGroups[K].Group.Count - 9 <= aGroup.Count) then + aGroup.OrderLinkTo(fCombatGroups[K].Group, True) + else + aGroup.OrderSplitLinkTo(fCombatGroups[K].Group, fCombatGroups[K].Group.Count - 9, True); + fCombatGroups[K].Group.UnitsPerRow := Max(3,fCombatGroups[K].Group.UnitsPerRow); + end; +end; + + +procedure TKMArmyAttackNew.LogStatus(var aBalanceText: UnicodeString); +var + K: Integer; + Order, GroupOrder: UnicodeString; + CG: TKMCombatGroup; +begin + {$IFDEF DEBUG_NewAI} + aBalanceText := Format('%s||Time pathfinding: %d|Time aiming:%d',[aBalanceText,gTimePathfinding,gTimeAiming]); + {$ENDIF} + if (gMySpectator.Selected is TKMUnitGroup) then + for K := 0 to fCombatGroups.Count - 1 do + if (gMySpectator.Selected = fCombatGroups[K].Group) then + begin + CG := fCombatGroups[K]; + + Order := 'CGTargets:|'; + if (CG.TargetGroup <> nil) AND not CG.TargetGroup.IsDead then + Order := Format('%s Group [%d;%d] %s|',[Order, CG.TargetGroup.Position.X,CG.TargetGroup.Position.Y, GetEnumName(TypeInfo(TKMGroupType), Integer(CG.TargetGroup.GroupType))]); + if (CG.TargetUnit <> nil) AND not CG.TargetUnit.IsDeadOrDying then + Order := Format('%s Unit [%d;%d] %s|',[Order, CG.TargetUnit.Position.X,CG.TargetUnit.Position.Y, GetEnumName(TypeInfo(TKMUnitType), Integer(CG.TargetUnit.UnitType))]); + if (CG.TargetHouse <> nil) AND not CG.TargetHouse.IsDestroyed then + Order := Format('%s House [%d;%d] %s|',[Order, CG.TargetHouse.Entrance.X, CG.TargetHouse.Entrance.Y, GetEnumName(TypeInfo(TKMHouseType), Integer(CG.TargetHouse.HouseType))]); + + GroupOrder := Format('GroupOrder: %s',[GetEnumName(TypeInfo(TKMGroupOrder), Integer(CG.Group.Order))]); + if (CG.Group.Order = goWalkTo) then + GroupOrder := Format('%s [%d;%d]|', [GroupOrder, CG.Group.OrderLoc.Loc.X, CG.Group.OrderLoc.Loc.Y]) + else if (CG.Group.Order in [goAttackHouse,goNone]) AND (CG.Group.OrderTargetHouse <> nil) then + GroupOrder := Format('%s %d [%d;%d]|', [GroupOrder, Integer(CG.Group.OrderTargetHouse), CG.Group.OrderTargetHouse.Position.X, CG.Group.OrderTargetHouse.Position.Y]) + else if (CG.Group.Order in [goAttackUnit,goNone]) AND (CG.Group.OrderTargetUnit <> nil) then + GroupOrder := Format('%s %d [%d;%d]|', [GroupOrder, Integer(CG.Group.OrderTargetUnit), CG.Group.OrderTargetUnit.Position.X, CG.Group.OrderTargetUnit.Position.Y]) + else if (CG.Group.Order = goNone) then + GroupOrder := Format('%s [%d;%d]|', [GroupOrder, CG.Group.OrderLoc.Loc.X, CG.Group.OrderLoc.Loc.Y]); + + aBalanceText := Format('%s|CG_ID: %d|Group_ID: %d|CombatPhase: %s|TargetType: %s|OnPlace: %d|InFight: %d|%sWalkTimeLimit: %d|AttackTimeLimit: %d|GroupPosition: [%d;%d]|TargetAim: [%d;%d]|DistanceFromAim: Sqr(%f) Abs(%d)|%s', [ + aBalanceText, + Integer(CG), + Integer(CG.Group), + GetEnumName(TypeInfo(TKMCombatPhase), Integer(CG.CombatPhase)), + GetEnumName(TypeInfo(TKMTargetType), Integer(CG.TargetType)), + Byte(CG.OnPlace), + Byte(CG.InFight), + Order, + Max(0, Integer(CG.WalkTimeLimit) - Integer(gGameParams.Tick)), + Max(0, Integer(CG.AttackTimeLimit) - Integer(gGameParams.Tick)), + CG.Position.X, CG.Position.Y, + CG.TargetAim.X, CG.TargetAim.Y, + KMDistanceSqr(CG.TargetAim,CG.Position), KMDistanceAbs(CG.TargetAim,CG.Position), + GroupOrder + ]); + end; +end; + + +procedure TKMArmyAttackNew.Paint; +var + Op1, Op2: Byte; + K: Integer; + Col1, Col2: Cardinal; + Position: TKMPoint; + CG: TKMCombatGroup; + {$IFDEF DEBUG_NewAI} + L: Integer; + {$ENDIF} +begin + for K := 0 to fCombatGroups.Count - 1 do + begin + CG := fCombatGroups[K]; + if CG.fTrafficDetection.StuckInTraffic then + gRenderAux.Quad(CG.Position.X, CG.Position.Y, $FF000000 OR tcRed); + end; + + + {$IFDEF DEBUG_NavMeshPathfinding} + if (fOwner = gMySpectator.HandID) then + gAIFields.NavMesh.Pathfinding.Paint(); + {$ENDIF} + //if (fOwner <> 1) then + // Exit; + + for K := 0 to fCombatGroups.Count - 1 do + begin + CG := fCombatGroups[K]; + + // Opacity + Op1 := $20; + Op2 := $30; + if (gMySpectator.Selected is TKMUnitGroup) AND (gMySpectator.Selected = CG.Group) then + begin + //Col1 := gMySpectator.Hand.FlagColor; + Op1 := $AA; + Op2 := $FF; + case CG.Group.Order of + goWalkTo: Position := CG.Group.OrderLoc.Loc; + goAttackHouse: + begin + if (CG.Group.OrderTargetHouse <> nil) then + Position := CG.Group.OrderTargetHouse.Position; + end; + goAttackUnit: + begin + if (CG.Group.OrderTargetUnit <> nil) then + Position := CG.Group.OrderTargetUnit.Position; + end; + goNone: + begin + if (CG.Group.OrderTargetHouse <> nil) then + Position := CG.Group.OrderTargetHouse.Position + else if (CG.Group.OrderTargetUnit <> nil) then + Position := CG.Group.OrderTargetUnit.Position + else + Position := CG.Group.OrderLoc.Loc; + end; + else begin end; // goStorm, goNone + end; + if not KMSamePoint(Position,KMPOINT_ZERO) then + gRenderAux.CircleOnTerrain(Position.X, Position.Y, 1.5, (Op1 shl 24) OR tcBlue, (Op2 shl 24) OR tcBlue); + gRenderAux.Quad(CG.TargetAim.X, CG.TargetAim.Y, $FF000000 OR tcWhite); + {$IFDEF DEBUG_NewAI} + if not KMSamePoint(CG.TargetAim, KMPOINT_ZERO) AND (Length(CG.DEBUGPointPath) > 0) then + with CG.DEBUGPointPath[Low(CG.DEBUGPointPath)] do + gRenderAux.Quad(X, Y, $FF000000 OR tcCyan); + {$ENDIF} + end; + + // Combat group circle + Col1 := tcWhite; + case CG.CombatPhase of + cpIdle: Col1 := tcWhite; + cpWalk: Col1 := tcGreen; + cpAttack: Col1 := tcRed; + cpDead: Col1 := tcBlack; + end; + Col2 := tcWhite; + case CG.TargetType of + ttNone: Col2 := tcWhite; + ttGroup: Col2 := tcRed; + ttUnit: Col2 := tcYellow; + ttHouse: Col2 := tcYellow; + ttPoint: Col2 := tcGreen; + end; + gRenderAux.CircleOnTerrain(CG.Position.X, CG.Position.Y, 1, (Op1 shl 24) OR Col1, (Op2 shl 24) OR Col2); + + // Select target + Col1 := tcWhite; + if (CG.CombatPhase = cpWalk) then Col1 := tcGreen + else if (CG.CombatPhase = cpAttack) then Col1 := tcRed; + {$IFDEF DEBUG_NewAI} + if not KMSamePoint(CG.TargetAim, KMPOINT_ZERO) then + for L := 1 to Length(CG.DEBUGPointPath) - 1 do + gRenderAux.LineOnTerrain(CG.DEBUGPointPath[L-1], CG.DEBUGPointPath[L], (Op2 shl 24) OR Col1); + {$ELSE} + if not KMSamePoint(CG.TargetAim, KMPOINT_ZERO) then + gRenderAux.LineOnTerrain(CG.Position, CG.TargetAim, (Op2 shl 24) OR Col1); + {$ENDIF} + end; + //gRenderAux.Quad(Loc.X, Loc.Y, Color); +end; + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_ArmyDefence.pas b/vendor/kam_remake/src/ai/newAI/KM_ArmyDefence.pas new file mode 100644 index 0000000..a4c75b1 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_ArmyDefence.pas @@ -0,0 +1,597 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_ArmyDefence; +{$I KaM_Remake.inc} +interface +uses + Classes, KM_CommonClasses, KM_CommonTypes, KM_Defaults, + KM_Points, KM_UnitGroup, KM_NavMeshDefences, KM_AIDefensePos; + + +type + TKMFormation = record NumUnits, UnitsPerRow: Integer; end; + + TKMDefencePosition = class + private + fWeight, fLine: Word; // Higher number = higher enemy influence or closer to the first line + fGroup: TKMUnitGroup; //Commander of group currently occupying position + fPosition: TKMPointDir; //Position and direction the group defending will stand + + procedure SetGroup(aGroup: TKMUnitGroup); + procedure SetPosition(const Value: TKMPointDir); + function GetGroupType(): TKMGroupType; + public + constructor Create(aWeight, aLine: Word; aPos: TKMPointDir); + constructor Load(LoadStream: TKMemoryStream); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure SyncLoad(); + + property Line: Word read fLine write fLine; + property Weight: Word read fWeight write fWeight; + property Position: TKMPointDir read fPosition write SetPosition; //Position and direction the group defending will stand + property Group: TKMUnitGroup read fGroup write SetGroup; + property GroupType: TKMGroupType read GetGroupType; + + function CanAccept(aGroup: TKMUnitGroup; aMaxUnits: Integer): Boolean; + procedure UpdateState(aTick: Cardinal); + end; + + + TKMArmyDefence = class + private + fOwner: TKMHandID; + fCityUnderAttack: Boolean; + fFirstLineCnt: Word; + fPositions: TKMList; + + function GetCount: Integer; inline; + function GetPosition(aIndex: Integer): TKMDefencePosition; inline; + function GetGroupsCount(): Word; + public + TroopFormations: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of TKMFormation; //Defines how defending troops will be formatted. 0 means leave unchanged. + + constructor Create(aOwner: TKMHandID); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + property Count: Integer read GetCount; + property Positions[aIndex: Integer]: TKMDefencePosition read GetPosition; default; + property FirstLineCnt: Word read fFirstLineCnt; + property GroupsCount: Word read GetGroupsCount; + property CityUnderAttack: Boolean read fCityUnderAttack; + + procedure OwnerUpdate(aOwner: TKMHandID); + procedure UpdateDefences(aDefCnt: Word; aPNewDef: array of PDefencePosition); + procedure UpdateFixedDefences(); + function DefenceStatus(): Single; + function FindPositionOf(aGroup: TKMUnitGroup; aIgnoreFirstLine: Boolean = False): TKMDefencePosition; + function FindPlaceForGroup(aGroup: TKMUnitGroup): Boolean; + procedure ReleaseGroup(aGroup: TKMUnitGroup); overload; + procedure ReleaseGroup(aDefPosIdx: Integer); overload; + function ReleaseAllGroups(): TKMUnitGroupArray; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure LogStatus(var aBalanceText: UnicodeString); + procedure Paint(); + end; + +const + MAX_SOLDIERS_IN_GROUP = 9; //These are the defaults in KaM + FORMATION_OF_GROUP = 3; + SQR_FIRST_LINE_RADIUS = 8*8; + FIRST_LINE_MAX_IDX = 0; + + +implementation +uses + Math, + KM_Entity, + KM_GameParams, KM_HandsCollection, KM_Hand, KM_RenderAux, + KM_AIFields, KM_NavMesh, + KM_UnitGroupTypes; + + +{ TKMDefencePosition } +constructor TKMDefencePosition.Create(aWeight, aLine: Word; aPos: TKMPointDir); +begin + inherited Create; + fWeight := aWeight; + fLine := aLine; + fPosition := aPos; + Group := nil; //Unoccupied +end; + + +destructor TKMDefencePosition.Destroy; +begin + Group := nil; //Ensure pointer is removed (property calls CleanUpGroupPointer) + inherited; +end; + + +procedure TKMDefencePosition.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('AdvDefencePosition'); + SaveStream.Write(fWeight); + SaveStream.Write(fLine); + SaveStream.Write(fPosition); + SaveStream.Write(fGroup.UID); //Store ID +end; + + +constructor TKMDefencePosition.Load(LoadStream: TKMemoryStream); +begin + inherited Create; + LoadStream.CheckMarker('AdvDefencePosition'); + LoadStream.Read(fWeight); + LoadStream.Read(fLine); + LoadStream.Read(fPosition); + LoadStream.Read(fGroup, 4); //Subst on syncload +end; + + +procedure TKMDefencePosition.SyncLoad(); +begin + fGroup := gHands.GetGroupByUID(Integer(fGroup)); +end; + + +procedure TKMDefencePosition.SetGroup(aGroup: TKMUnitGroup); +begin + gHands.CleanUpGroupPointer(fGroup); + if (aGroup <> nil) then + fGroup := aGroup.GetPointer; +end; + + +procedure TKMDefencePosition.SetPosition(const Value: TKMPointDir); +begin + Assert(gGameParams.IsMapEditor); + fPosition := Value; +end; + + +function TKMDefencePosition.GetGroupType(): TKMGroupType; +begin + Result := gtMelee; + if (Group <> nil) then + Result := Group.GroupType; +end; + + +function TKMDefencePosition.CanAccept(aGroup: TKMUnitGroup; aMaxUnits: Integer): Boolean; +begin + Result := (Group = nil) + or ((GroupType = UNIT_TO_GROUP_TYPE[aGroup.UnitType]) and (Group.Count < aMaxUnits)); +end; + + +procedure TKMDefencePosition.UpdateState(aTick: Cardinal); +begin + // If the group is Dead or too far away we should disassociate + // them from the defence position so new warriors can take up the defence if needs be + if (Group = nil) + or Group.IsDead + or Group.InFight + or (Group.Order in [goAttackHouse, goAttackUnit]) then + gHands.CleanUpGroupPointer(fGroup); + + // Tell group to walk to its position + // It's easier to repeat the order than check that all members are in place + if (Group <> nil) + and Group.IsIdleToAI([wtokFlagPoint, wtokHaltOrder]) + and Group.CanWalkTo(Position.Loc, 0) then + Group.OrderWalk(Position.Loc, True, wtokAIGotoDefencePos, Position.Dir); +end; + + +{ TKMArmyDefence } +constructor TKMArmyDefence.Create(aOwner: TKMHandID); +var + GT: TKMGroupType; +begin + inherited Create; + + fOwner := aOwner; + fCityUnderAttack := False; + fPositions := TKMList.Create; + + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + TroopFormations[GT].NumUnits := MAX_SOLDIERS_IN_GROUP; + TroopFormations[GT].UnitsPerRow := FORMATION_OF_GROUP; + end; +end; + + +destructor TKMArmyDefence.Destroy; +begin + fPositions.Free; + + inherited; +end; + + +procedure TKMArmyDefence.Save(SaveStream: TKMemoryStream); +var + I: Integer; +begin + SaveStream.PlaceMarker('AdvDefencePositions'); + SaveStream.Write(fOwner); + SaveStream.Write(fCityUnderAttack); + SaveStream.Write(fFirstLineCnt); + SaveStream.Write(TroopFormations, SizeOf(TroopFormations)); + + SaveStream.Write(Count); + for I := 0 to Count - 1 do + Positions[I].Save(SaveStream); +end; + + +procedure TKMArmyDefence.Load(LoadStream: TKMemoryStream); +var + I, newCount: Integer; +begin + LoadStream.CheckMarker('AdvDefencePositions'); + LoadStream.Read(fOwner); + LoadStream.Read(fCityUnderAttack); + LoadStream.Read(fFirstLineCnt); + LoadStream.Read(TroopFormations, SizeOf(TroopFormations)); + + LoadStream.Read(newCount); + for I := 0 to newCount - 1 do + fPositions.Add( TKMDefencePosition.Load(LoadStream) ); +end; + + +procedure TKMArmyDefence.SyncLoad; +var + I: Integer; +begin + for I := 0 to Count - 1 do + Positions[I].SyncLoad; +end; + + +procedure TKMArmyDefence.OwnerUpdate(aOwner: TKMHandID); +begin + fOwner := aOwner; +end; + + +function TKMArmyDefence.GetCount: Integer; +begin + Result := fPositions.Count; +end; + + +function TKMArmyDefence.GetPosition(aIndex: Integer): TKMDefencePosition; +begin + Result := fPositions[aIndex]; +end; + + +function TKMArmyDefence.GetGroupsCount(): Word; +var + I: Integer; +begin + Result := 0; + for I := 0 to Count - 1 do + Inc(Result, Ord(Positions[I].Group <> nil)); +end; + + +function TKMArmyDefence.FindPlaceForGroup(aGroup: TKMUnitGroup): Boolean; +var + K, BestIdx, Needed: Integer; + BestWeight: Word; + UG: TKMUnitGroup; +begin + Result := False; + + //Try to link to existing group + BestWeight := 0; + BestIdx := -1; + for K := 0 to Count - 1 do + if Positions[K].CanAccept(aGroup, TroopFormations[aGroup.GroupType].NumUnits) + AND (BestWeight < Positions[K].Weight) then + begin + BestIdx := K; + BestWeight := Positions[K].Weight; + end; + + if (BestIdx <> -1) then + begin + Result := True; + //New position + if (Positions[BestIdx].Group = nil) then + begin + Needed := TroopFormations[aGroup.GroupType].NumUnits; + // Add group to new defense position + Positions[BestIdx].Group := aGroup; + // Defence position requires less soldiers -> distribute other soldiers into different defence position + if (aGroup.Count > Needed) then + begin + UG := aGroup.OrderSplitUnit(aGroup.GetAliveMember, True); + if (UG <> nil) then + begin + if (aGroup.Count - Needed > 0) then + aGroup.OrderSplitLinkTo(UG, aGroup.Count - Needed, True); //Link only as many units as are needed + //FindPlaceForGroup(UG); // The rest of group will be added later (not in this tick) + end; + end; + UG := Positions[BestIdx].Group; + UG.OrderWalk(Positions[BestIdx].Position.Loc, True, wtokAIGotoDefencePos, Positions[BestIdx].Position.Dir); + end + // Restock + else + begin + //Append to existing position + UG := Positions[BestIdx].Group; + Needed := TroopFormations[ UG.GroupType ].NumUnits - UG.Count; + if (aGroup.Count <= Needed) then + aGroup.OrderLinkTo(UG, True) //Link entire group + else + begin + aGroup.OrderSplitLinkTo(UG, Needed, True); //Link only as many units as are needed + //FindPlaceForGroup(aGroup); // The rest of group will be added later (not in this tick) + end; + end; + if (UG.UnitsPerRow <> TroopFormations[UG.GroupType].UnitsPerRow) then + UG.UnitsPerRow := TroopFormations[UG.GroupType].UnitsPerRow; + end; +end; + + +// Find DefencePosition of a group +function TKMArmyDefence.FindPositionOf(aGroup: TKMUnitGroup; aIgnoreFirstLine: Boolean = False): TKMDefencePosition; +var + I: Integer; +begin + Result := nil; + + for I := 0 to Count - 1 do + if (Positions[I].Group = aGroup) then + begin + if (aIgnoreFirstLine and (Positions[I].Line <= FIRST_LINE_MAX_IDX)) then + Break; + Result := Positions[I]; + Break; + end; +end; + + +procedure TKMArmyDefence.ReleaseGroup(aGroup: TKMUnitGroup); +var + DP: TKMDefencePosition; +begin + DP := FindPositionOf(aGroup); + if (DP <> nil) then + DP.Group := nil; +end; + + +procedure TKMArmyDefence.ReleaseGroup(aDefPosIdx: Integer); +begin + if (aDefPosIdx < Count) then + Positions[aDefPosIdx].Group := nil; +end; + + +function TKMArmyDefence.ReleaseAllGroups(): TKMUnitGroupArray; +var + K, Cnt: Integer; +begin + Cnt := GroupsCount; + SetLength(Result, Cnt); + for K := 0 to Count - 1 do + if (Positions[K].Group <> nil) then + begin + Dec(Cnt); + Result[Cnt] := Positions[K].Group; + ReleaseGroup(K); + end; +end; + + +// Defence status = fulfill of first defence line +function TKMArmyDefence.DefenceStatus(): Single; +var + I, Cnt: Integer; +begin + Result := 0; // No defences + if (Count > 0) then + begin + Cnt := 0; + for I := 0 to Count - 1 do + if (Positions[I].Group <> nil) then + Inc(Cnt); + Result := Cnt / Max(1,fFirstLineCnt); + end; +end; + + +procedure TKMArmyDefence.UpdateDefences(aDefCnt: Word; aPNewDef: array of PDefencePosition); +var + I, K: Integer; + G: TKMUnitGroup; + VisitedNewPos, VisitedExistPos: TBooleanArray; +begin + //Get defence Polygons + if (aDefCnt = 0) then + Exit; + + SetLength(VisitedNewPos, aDefCnt); + FillChar(VisitedNewPos[0], SizeOf(VisitedNewPos[0])*Length(VisitedNewPos), #0); + SetLength(VisitedExistPos, fPositions.Count); + if (Length(VisitedExistPos) > 0) then + FillChar(VisitedExistPos[0], SizeOf(VisitedExistPos[0])*Length(VisitedExistPos), #0); + + // Compare new defences with old version and add new defences / remove old + for I := 0 to aDefCnt - 1 do + // Try find existing defence position + for K := 0 to fPositions.Count - 1 do + //if (Positions[K].Polygon = aPNewDef[I]^.Polygon) then // This cannot be used because 1 polygon can have 3 points + if KMSamePoint(Positions[K].Position.Loc, aPNewDef[I]^.DirPoint.Loc) then + begin + VisitedNewPos[I] := True; + VisitedExistPos[K] := True; + Positions[K].Weight := aPNewDef[I]^.Weight; + Positions[K].Line := aPNewDef[I]^.Line; + break; + end; + + // Remove old and unused defence positions + for I := fPositions.Count - 1 downto 0 do + if not VisitedExistPos[I] then + fPositions.Delete(I); + + // Add new defence positions + for I := 0 to aDefCnt - 1 do + if not VisitedNewPos[I] then + fPositions.Add( TKMDefencePosition.Create( aPNewDef[I]^.Weight, aPNewDef[I]^.Line, aPNewDef[I]^.DirPoint ) ); + // Recalculate group positions in case that group is not complete and get count of first line + fFirstLineCnt := 0; + for I := fPositions.Count - 1 downto 0 do + begin + if (Positions[I].Line <= FIRST_LINE_MAX_IDX) then + Inc(fFirstLineCnt); + G := Positions[I].Group; + if (G <> nil) AND (G.Count < TroopFormations[ G.GroupType ].NumUnits) then + begin + ReleaseGroup(I); + if not G.IsDead then + FindPlaceForGroup(G); + end; + end; +end; + + +procedure TKMArmyDefence.UpdateFixedDefences(); +var + K: Integer; + DefPos: TAIDefencePosition; + DP: TKMDefencePosArr; + aPNewDef: array of PDefencePosition; +begin + with gHands[fOwner].AI.General.DefencePositions do + begin + SetLength(DP,Count); + SetLength(aPNewDef,Count); + for K := 0 to Count - 1 do + begin + DefPos := Positions[K]; + DP[K].Line := 1; + DP[K].Polygon := 0; + DP[K].Weight := 1; + DP[K].DirPoint := DefPos.Position; + aPNewDef[K] := @DP[K]; + end; + UpdateDefences(Count, aPNewDef); + end; +end; + + +procedure TKMArmyDefence.AfterMissionInit(); +begin + +end; + + +procedure TKMArmyDefence.UpdateState(aTick: Cardinal); +const + FAST_UPDATE = MAX_HANDS * 5; + SLOW_UPDATE = MAX_HANDS * 20; +var + I: Integer; +begin + if (aTick mod FAST_UPDATE = fOwner) then + begin + for I := 0 to Count - 1 do + Positions[I].UpdateState(aTick); + if (aTick mod SLOW_UPDATE = fOwner) AND not gHands[fOwner].AI.Setup.AutoDefend then + UpdateFixedDefences(); + end; +end; + + +procedure TKMArmyDefence.LogStatus(var aBalanceText: UnicodeString); +begin + //aBalanceText := ''; +end; + + +procedure TKMArmyDefence.Paint(); +var + I, K, Idx, Threat, AllianceIdx: Integer; + Col: Cardinal; + Loc, Pos: TKMPoint; + GT: TKMGroupType; + UGA: TKMUnitGroupArray; +begin + if not OVERLAY_DEFENCES then + Exit; + + if (fOwner <> gMySpectator.HandID) then // Show just 1 player (it prevents notification to be mess) + Exit; + + // Draw defensive positions as a circles + for I := 0 to Count - 1 do + begin + Loc := Positions[I].Position.Loc; + Col := $22; + if (Positions[I].Group = nil) then + Col := 0; + gRenderAux.CircleOnTerrain(Loc.X, Loc.Y, 1, (Col shl 24) OR tcGreen, $FFFFFFFF); + end; + + // Draw defence position of selected unit + if (gMySpectator.Selected is TKMUnitGroup) then + for I := 0 to Count - 1 do + if (gMySpectator.Selected = Positions[I].Group) then + begin + Loc := Positions[I].Position.Loc; + gRenderAux.CircleOnTerrain(Loc.X, Loc.Y, 1, $AA000000 OR tcRed, $FFFFFFFF); + break; + end; + + if not gAIFields.Influences.GetAllianceIdx(fOwner,AllianceIdx) then + Exit; + // First line of defences + for I := 0 to fPositions.Count - 1 do + if (Positions[I].Line = 0) then + begin + Loc := Positions[I].Position.Loc; + Idx := gAIFields.NavMesh.KMPoint2Polygon[Loc]; + Threat := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + Threat := Threat + gAIFields.Influences.Presence[ AllianceIdx, Idx, GT ]; + + // Draw defensive lines as a triangles + Col := Max( $22, Min($FF, Threat) ); + gAIFields.NavMesh.DrawPolygon(Idx, Col, tcRed); + + // Draw hostile units around defensive lines + if (Threat > 0) then + begin + UGA := gHands.GetGroupsInRadius(Loc, SQR_FIRST_LINE_RADIUS, fOwner, atEnemy); + for K := 0 to Length(UGA) - 1 do + begin + Pos := UGA[K].Position; + gRenderAux.CircleOnTerrain(Pos.X, Pos.Y, 1, $44000000 OR tcRed, $FF000000 OR tcRed); + //gRenderAux.LineOnTerrain(Pos, Loc, $AA000000 OR clBlack); + end; + end; + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_ArmyManagement.pas b/vendor/kam_remake/src/ai/newAI/KM_ArmyManagement.pas new file mode 100644 index 0000000..56e55bb --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_ArmyManagement.pas @@ -0,0 +1,586 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_ArmyManagement; +{$I KaM_Remake.inc} +interface +uses + Classes, KromUtils, Math, SysUtils, + KM_CommonClasses, KM_Defaults, KM_Points, + KM_Houses, KM_Units, + KM_UnitGroup, KM_AISetup, KM_ResTypes, + KM_HandStats, KM_ArmyDefence, KM_AIAttacks, KM_ArmyAttackNew; + +const + ARMY_VECTOR_SCAN_HOUSES_DEF: TKMHouseTypeSet = [htBarracks, htStore, htSchool, htTownhall]; // htWatchTower + +type + // Agent interface (for Supervisor) + TKMAttackRequest = record + Active, FoodShortage, FFA: Boolean; + BestAllianceCmp,WorstAllianceCmp: Single; + BestEnemy: TKMHandID; // or index of Enemies array + Enemies: TKMHandIDArray; + end; + + TKMArmyManagement = class + private + fOwner: TKMHandID; + fSetup: TKMHandAISetup; + fFoodProblems: Boolean; + fLastEquippedTimeIron, fLastEquippedTimeLeather: Cardinal; + fAttackRequest: TKMAttackRequest; + fArmyVectorFieldScanHouses: TKMHouseTypeSet; + + fAttackNew: TKMArmyAttackNew; + fDefence: TKMArmyDefence; + + fBalanceText: UnicodeString; + + procedure RecruitSoldiers; + procedure CheckGroupsState; + procedure CheckAttack; + procedure SetAttackRequest(aAttackRequest: TKMAttackRequest); + + function CombineBalanceStrings: UnicodeString; + public + constructor Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); + destructor Destroy; override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad; + + property AttackNew: TKMArmyAttackNew read fAttackNew; + property Defence: TKMArmyDefence read fDefence write fDefence; + property AttackRequest: TKMAttackRequest read fAttackRequest write SetAttackRequest; + property BalanceText: UnicodeString read CombineBalanceStrings; + + property ArmyVectorFieldScanHouses: TKMHouseTypeSet read fArmyVectorFieldScanHouses write fArmyVectorFieldScanHouses; + + procedure AfterMissionInit; + procedure UpdateState(aTick: Cardinal); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure WarriorEquipped(aGroup: TKMUnitGroup); + + procedure Paint; + end; + + +implementation +uses + KM_Game, KM_GameParams, + KM_Hand, KM_HandsCollection, KM_HandTypes, KM_HandEntity, + KM_Terrain, + KM_HouseBarracks, + KM_CommonUtils, + KM_DevPerfLog, KM_DevPerfLogTypes, + KM_AITypes, KM_AIFields, + KM_MapTypes; + + +{ TKMArmyManagement } +constructor TKMArmyManagement.Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); +begin + inherited Create; + + fOwner := aPlayer; + fSetup := aSetup; + fFoodProblems := False; + fLastEquippedTimeIron := 0; + fLastEquippedTimeLeather := 0; + fArmyVectorFieldScanHouses := ARMY_VECTOR_SCAN_HOUSES_DEF; + fAttackRequest.Active := False; + + fAttackNew := TKMArmyAttackNew.Create(aPlayer); + fDefence := TKMArmyDefence.Create(aPlayer); +end; + + +destructor TKMArmyManagement.Destroy; +begin + fAttackNew.Free; + fDefence.Free; + + inherited; +end; + + +procedure TKMArmyManagement.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('ArmyManagement'); + SaveStream.Write(fOwner); + SaveStream.Write(fFoodProblems); + SaveStream.Write(fLastEquippedTimeIron); + SaveStream.Write(fLastEquippedTimeLeather); + SaveStream.Write(fArmyVectorFieldScanHouses, SizeOf(fArmyVectorFieldScanHouses)); + + with fAttackRequest do + begin + SaveStream.Write(Active); + SaveStream.Write(FoodShortage); + SaveStream.Write(FFA); + SaveStream.Write(BestAllianceCmp); + SaveStream.Write(WorstAllianceCmp); + SaveStream.Write(BestEnemy); + SaveStream.Write( Integer(Length(Enemies)) ); + if (Length(Enemies) > 0) then + SaveStream.Write(Enemies[0], SizeOf(Enemies[0])*Length(Enemies)); + end; + + fAttackNew.Save(SaveStream); + fDefence.Save(SaveStream); +end; + + +procedure TKMArmyManagement.Load(LoadStream: TKMemoryStream); +var + Count: Integer; +begin + LoadStream.CheckMarker('ArmyManagement'); + LoadStream.Read(fOwner); + LoadStream.Read(fFoodProblems); + LoadStream.Read(fLastEquippedTimeIron); + LoadStream.Read(fLastEquippedTimeLeather); + LoadStream.Read(fArmyVectorFieldScanHouses, SizeOf(fArmyVectorFieldScanHouses)); + + with fAttackRequest do + begin + LoadStream.Read(Active); + LoadStream.Read(FoodShortage); + LoadStream.Read(FFA); + LoadStream.Read(BestAllianceCmp); + LoadStream.Read(WorstAllianceCmp); + LoadStream.Read(BestEnemy); + LoadStream.Read(Count); + SetLength(Enemies,Count); + if (Length(Enemies) > 0) then + LoadStream.Read(Enemies[0], SizeOf(Enemies[0])*Length(Enemies)); + end; + + fAttackNew.Load(LoadStream); + fDefence.Load(LoadStream); +end; + + +procedure TKMArmyManagement.SyncLoad; +begin + fAttackNew.SyncLoad; + fDefence.SyncLoad; +end; + + +procedure TKMArmyManagement.AfterMissionInit; +begin + fAttackNew.AfterMissionInit; + fDefence.AfterMissionInit; +end; + + +procedure TKMArmyManagement.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fAttackNew.OwnerUpdate(aPlayer); + fDefence.OwnerUpdate(aPlayer); +end; + + +procedure TKMArmyManagement.WarriorEquipped(aGroup: TKMUnitGroup); +begin + //if (gAIFields.Supervisor.CombatStatus[fOwner,fOwner] = csDefending) AND (fDefence.GroupsCount = 0) AND (fAttackNew.Count > 0) then + if (fDefence.GroupsCount = 0) AND (fAttackNew.Count > 0) AND not fFoodProblems then + fAttackNew.LinkGroup(aGroup); + if (aGroup.Count > 0) then + fDefence.FindPlaceForGroup(aGroup); +end; + + +procedure TKMArmyManagement.RecruitSoldiers; + function CanEquipIron: Boolean; + begin + Result := not (fSetup.ArmyType = atLeather) + and (fSetup.UnlimitedEquip or gGame.CheckTime(fLastEquippedTimeIron + fSetup.EquipRateIron)); + end; + function CanEquipLeather: Boolean; + begin + Result := not (fSetup.ArmyType = atIron) + and (fSetup.UnlimitedEquip or gGame.CheckTime(fLastEquippedTimeLeather + fSetup.EquipRateLeather)); + end; +var + H: TKMHouse; + GT: TKMGroupType; + K,L: Integer; + UT: TKMUnitType; + pEquippedTime: ^Cardinal; + GroupReq: TKMGroupTypeArray; + Barracks: array of TKMHouseBarracks; +begin + // Peace time; Max soldiers limit reached; cannot equip; no Barracks + if gGame.IsPeaceTime + or ((fSetup.MaxSoldiers <> -1) and (gHands[fOwner].Stats.GetArmyCount >= fSetup.MaxSoldiers)) + or (not CanEquipIron and not CanEquipLeather) + or (gHands[fOwner].Stats.GetHouseQty(htBarracks) = 0) + or (fDefence.Count = 0) then + Exit; + + // Take required warriors from CityManagement (-> implemented consideration of required units + save time) + FillChar(GroupReq, SizeOf(GroupReq), #0); //Clear up + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + for K := Low(AI_TROOP_TRAIN_ORDER[GT]) to High(AI_TROOP_TRAIN_ORDER[GT]) do + if (AI_TROOP_TRAIN_ORDER[GT,K] <> utNone) then + Inc(GroupReq[GT], gHands[fOwner].AI.CityManagement.WarriorsDemands[ AI_TROOP_TRAIN_ORDER[GT,K] ] + 1); // Always recruit something + + // Find barracks + SetLength(Barracks, gHands[fOwner].Stats.GetHouseQty(htBarracks)); + for K := 0 to Length(Barracks) - 1 do + Barracks[K] := nil; // Just to be sure + L := 0; + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) AND not H.IsDestroyed AND (H.HouseType = htBarracks) AND H.IsComplete then + begin + Barracks[L] := TKMHouseBarracks(H); + Inc(L); + end; + end; + + // Train troops where possible in each barracks + for K := Low(Barracks) to High(Barracks) do + if (Barracks[K] <> nil) then + begin + // Chose a random group type that we are going to attempt to train (so we don't always train certain group types first) + L := 0; + repeat + GT := TKMGroupType(GROUP_TYPE_MIN_OFF + KaMRandom(4{$IFDEF DBG_RNG_SPY}, 'TKMArmyManagement.RecruitSoldiers'{$ENDIF})); //Pick random from overall count + Inc(L); + until (GroupReq[GT] > 0) or (L > 9); // Limit number of attempts to guarantee it doesn't loop forever + + if (GroupReq[GT] = 0) then + Continue; // Don't train + + for L := Low(AI_TROOP_TRAIN_ORDER[GT]) to High(AI_TROOP_TRAIN_ORDER[GT]) do + begin + UT := AI_TROOP_TRAIN_ORDER[GT, L]; + if (UT <> utNone) then + begin + if CanEquipIron and (UT in WARRIORS_IRON) then + pEquippedTime := @fLastEquippedTimeIron + else + if CanEquipLeather and not (UT in WARRIORS_IRON) then + pEquippedTime := @fLastEquippedTimeLeather + else + Continue; + + while Barracks[K].CanEquip(UT) + and (GroupReq[GT] > 0) + and ((fSetup.MaxSoldiers = -1) or (gHands[fOwner].Stats.GetArmyCount < fSetup.MaxSoldiers)) do + begin + Barracks[K].Equip(UT, 1); + Dec(GroupReq[GT]); + pEquippedTime^ := gGameParams.Tick; // Only reset it when we actually trained something (in IronThenLeather mode we don't count them separately) + end; + end; + end; + end; +end; + + +//Check army food level and positioning +procedure TKMArmyManagement.CheckGroupsState; +var + K: Integer; + Group: TKMUnitGroup; +begin + // Update food level + fFoodProblems := gAIFields.Eye.ArmyEvaluation.CheckFoodProblems([fOwner]); + + // Feed army and find unused groups + for K := 0 to gHands[fOwner].UnitGroups.Count - 1 do + begin + Group := gHands[fOwner].UnitGroups[K]; + + if (Group <> nil) AND not Group.IsDead AND not Group.InFight then + begin + // Check hunger and order food + if (Group.Condition < UNIT_MIN_CONDITION) AND not fFoodProblems then + // Cheat for autobuild AI: Only feed hungry group members (food consumption lower and more predictable) + Group.OrderFood(True, fSetup.AutoBuild); + + // Do not process attack or defence during peacetime + if gGame.IsPeaceTime then + Continue; + + // Group is in combat classes + if fAttackNew.IsGroupInAction(Group) then + Continue; + + // Group is in defence position + if (fDefence.FindPositionOf(Group) <> nil) then + Continue; + + if (fDefence.GroupsCount = 0) AND (fAttackNew.Count > 0) then + fAttackNew.LinkGroup(Group); + + if (Group.Count > 0) then + fDefence.FindPlaceForGroup(Group); + end; + end; +end; + + +procedure TKMArmyManagement.CheckAttack; +type + TKMAvailableGroups = record + Count: Word; + GroupsAvailable: TKMGroupTypeArray; + MenAvailable: TKMGroupTypeArray; + GroupArr: TKMUnitGroupArray; + end; + // Find all available groups + function GetGroups(aMobilizationCoef: Single): TKMAvailableGroups; + const + MIN_TROOPS_IN_GROUP = 4; + var + K: Integer; + Group: TKMUnitGroup; + AG: TKMAvailableGroups; + DP: TKMDefencePosition; + begin + AG.Count := 0; + SetLength(AG.GroupArr, gHands[fOwner].UnitGroups.Count); + for K := 0 to gHands[fOwner].UnitGroups.Count - 1 do + begin + Group := gHands[fOwner].UnitGroups[K]; + if (Group = nil) + OR Group.IsDead + //OR not Group.IsIdleToAI([wtokFlagPoint, wtokHaltOrder]) + OR ((aMobilizationCoef < 1) AND (Group.Count < MIN_TROOPS_IN_GROUP)) then + Continue; + // Add grop pointer to array (but dont increase count now so it will be ignored) + AG.GroupArr[AG.Count] := Group; + // Check if group can be in array + if (aMobilizationCoef = 1) then + begin + // Take all groups out of attack class + if not fAttackNew.IsGroupInAction(Group) then + Inc(AG.Count,1); // Confirm that the group should be in array GroupArr + end + else + begin + // Take group in defence position if it is required by mobilization + DP := fDefence.FindPositionOf(Group, KaMRandom({$IFDEF DBG_RNG_SPY}'TKMArmyManagement.RecruitSoldiers'{$ENDIF}) < aMobilizationCoef ); // True = First line will not be considered + if (DP <> nil) then + Inc(AG.Count,1); // Confirm that the group should be in array GroupArr + end; + end; + FillChar(AG.GroupsAvailable, SizeOf(AG.GroupsAvailable), #0); + FillChar(AG.MenAvailable, SizeOf(AG.MenAvailable), #0); + for K := 0 to AG.Count - 1 do + begin + Group := AG.GroupArr[K]; + Inc(AG.GroupsAvailable[ Group.GroupType ]); + Inc(AG.MenAvailable[ Group.GroupType ],Group.Count); + end; + Result := AG; + end; + // Filter groups + procedure FilterGroups(aTotalMen: Integer; aGroupAmounts: TKMGroupTypeArray; var aAG: TKMAvailableGroups); + var + GCnt, MenCnt, StartIdx, ActIdx: Integer; + G: TKMUnitGroup; + GT: TKMGroupType; + begin + if (aTotalMen = 0) then + Exit; + // Select the right number of groups + StartIdx := 0; + MenCnt := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + begin + GCnt := aGroupAmounts[GT]; + ActIdx := StartIdx; + while (GCnt > 0) AND (ActIdx < aAG.Count) do + begin + if (aAG.GroupArr[ActIdx].GroupType = GT) then + begin + G := aAG.GroupArr[StartIdx]; + aAG.GroupArr[StartIdx] := aAG.GroupArr[ActIdx]; + aAG.GroupArr[ActIdx] := G; + Inc(MenCnt, aAG.GroupArr[ActIdx].Count); + Inc(StartIdx); + Dec(GCnt); + end; + Inc(ActIdx); + end; + end; + // Add another groups if we dont have enough men + while (MenCnt < aTotalMen) AND (ActIdx < aAG.Count) do + begin + Inc(MenCnt, aAG.GroupArr[ActIdx].Count); + Inc(ActIdx); + end; + aAG.Count := ActIdx; + SetLength(aAG.GroupArr, ActIdx); + end; + + function FindScriptedTarget(aGroup: TKMUnitGroup; aTarget: TKMAIAttackTarget; aCustomPos: TKMPoint; var aTargetP: TKMPoint ): Boolean; + var + TargetHouse: TKMHouse; + TargetUnit: TKMUnit; + begin + aTargetP := KMPOINT_ZERO; + TargetHouse := nil; + TargetUnit := nil; + //Find target + case aTarget of + attClosestUnit: TargetUnit := gHands.GetClosestUnit(aGroup.Position, fOwner, atEnemy); + attClosestBuildingFromArmy: TargetHouse := gHands.GetClosestHouse(aGroup.Position, fOwner, atEnemy, TARGET_HOUSES, False); + attClosestBuildingFromStartPos: TargetHouse := gHands.GetClosestHouse(fSetup.StartPosition, fOwner, atEnemy, TARGET_HOUSES, False); + attCustomPosition: + begin + TargetHouse := gHands.HousesHitTest(aCustomPos.X, aCustomPos.Y); + if (TargetHouse <> nil) AND (gHands.CheckAlliance(fOwner, TargetHouse.Owner) = atAlly) then + TargetHouse := nil; + TargetUnit := gTerrain.UnitsHitTest(aCustomPos.X, aCustomPos.Y); + if (TargetUnit <> nil) AND ((gHands.CheckAlliance(fOwner, TargetUnit.Owner) = atAlly) OR TargetUnit.IsDeadOrDying) then + TargetUnit := nil; + end; + end; + //Choose best option + if (TargetHouse <> nil) then + aTargetP := TargetHouse.Position + else if (TargetUnit <> nil) then + aTargetP := TargetUnit.Position + else if (aTarget = attCustomPosition) then + aTargetP := aCustomPos; + Result := not KMSamePoint(aTargetP, KMPOINT_ZERO); + end; + + // Order attack by releasing Defensive groups and creating Combat groups + procedure OrderAttack(aTargetPoint: TKMPoint; var aAG: TKMAvailableGroups); + var + K: Integer; + begin + for K := 0 to aAG.Count - 1 do + fDefence.ReleaseGroup(aAG.GroupArr[K]); + + fAttackNew.AddGroups(aAG.GroupArr); + //fAttackNew.AddGroups( fDefence.ReleaseAllGroups ); + end; +const + MIN_DEF_RATIO = 1.2; + ATT_ADVANTAGE = 0.2; + MIN_BEST_ALLI_CMP = 0.8; + MIN_WORST_ALLI_CMP = 0.5; + MIN_GROUPS_IN_ATTACK = 4; +var + K: Integer; + DefRatio, MobilizationCoef: Single; + TargetPoint: TKMPoint; + AG: TKMAvailableGroups; +begin + if fAttackRequest.Active then + begin + fAttackRequest.Active := False; + // Check defences and comparison of strength + DefRatio := fDefence.DefenceStatus; + with fAttackRequest do + begin + // Exit if AI has NOT enough soldiers for defences in the FFA mode + if FFA AND not FoodShortage AND (DefRatio < MIN_DEF_RATIO) AND (gGameParams.MissionMode <> mmFighting) then + Exit; + // 1v1 or special game mode + if not FFA OR gGameParams.IsTactic then + MobilizationCoef := 1 + // Else compute if it is necessary to mobilize the first defence line (or fraction) + else + begin + // Relative def ratio + DefRatio := Max( 0, (DefRatio - 1) / Max(1, DefRatio) ); // = <0,1); 0 = army is in the first line of def. pos.; 1 = army is in second lines + // Mobilization of the first line // * (WorstAllianceCmp) + MobilizationCoef := Min(1, (1+ATT_ADVANTAGE) / (1+BestAllianceCmp) ) * (1 - DefRatio); + end; + end; + // Get array of pointers to available groups + AG := GetGroups(MobilizationCoef); + // If we dont have enough groups then exit (if we should take all check if there are already some combat groups) + if (MobilizationCoef < 1) AND (AG.Count < MIN_GROUPS_IN_ATTACK) then + Exit; + // Order attack + OrderAttack(TargetPoint, AG); + end + else if not fSetup.AutoAttack then + with gHands[fOwner].AI.General do + begin + AG := GetGroups(1); + for K := 0 to Attacks.Count - 1 do + if Attacks.CanOccur(K, AG.MenAvailable, AG.GroupsAvailable, gGameParams.Tick) then //Check conditions are right + begin + FilterGroups(Attacks[K].TotalMen, Attacks[K].GroupAmounts, AG); + if FindScriptedTarget(AG.GroupArr[0], Attacks[K].Target, Attacks[K].CustomPosition, TargetPoint) then + begin + OrderAttack(TargetPoint,AG); + Attacks.HasOccured(K); + break; // Just 1 attack in 1 tick + end; + end; + end; +end; + + +procedure TKMArmyManagement.SetAttackRequest(aAttackRequest: TKMAttackRequest); +begin + fAttackRequest.Active := aAttackRequest.Active; + fAttackRequest.FFA := aAttackRequest.FFA; + fAttackRequest.FoodShortage := aAttackRequest.FoodShortage; + fAttackRequest.BestAllianceCmp := aAttackRequest.BestAllianceCmp; + fAttackRequest.WorstAllianceCmp := aAttackRequest.WorstAllianceCmp; + fAttackRequest.BestEnemy := aAttackRequest.BestEnemy; + SetLength(fAttackRequest.Enemies, Length(aAttackRequest.Enemies) ); + Move(aAttackRequest.Enemies[0], fAttackRequest.Enemies[0], SizeOf(fAttackRequest.Enemies[0])*Length(fAttackRequest.Enemies)); +end; + + +procedure TKMArmyManagement.UpdateState(aTick: Cardinal); +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAIArmyAdv); + {$ENDIF} + try + if (aTick mod MAX_HANDS = fOwner) then + begin + if not gGame.IsPeaceTime then + begin + CheckAttack; + RecruitSoldiers; + end; + CheckGroupsState; + fAttackNew.UpdateState(aTick); + fDefence.UpdateState(aTick); + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAIArmyAdv); + {$ENDIF} + end; +end; + + +function TKMArmyManagement.CombineBalanceStrings: UnicodeString; +begin + Result := fBalanceText; + fAttackNew.LogStatus(Result); + fDefence.LogStatus(Result); +end; + + +procedure TKMArmyManagement.Paint; +begin + fAttackNew.Paint; + fDefence.Paint; +end; + + +end. diff --git a/vendor/kam_remake/src/ai/newAI/KM_CityBuilder.pas b/vendor/kam_remake/src/ai/newAI/KM_CityBuilder.pas new file mode 100644 index 0000000..d1b7378 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_CityBuilder.pas @@ -0,0 +1,2391 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_CityBuilder; +{$I KaM_Remake.inc} +interface +uses + KromUtils, Math, SysUtils, + KM_Defaults, KM_CommonClasses, KM_Points, KM_Sort, + KM_ResHouses, KM_HandConstructions, KM_Houses, + KM_AIInfluences, KM_CityPlanner, KM_CityPredictor, KM_Eye, KM_AIParameters, + KM_ResTypes; + +const + NODE_PRIO_RoadsUnlockHouse = 1; + NODE_PRIO_Roads = 2; + NODE_PRIO_RoadsReservation = 3; + NODE_PRIO_RemoveTreeInPlan = 3; + NODE_PRIO_Fields = 4; + NODE_PRIO_FieldsReservation = 4; + NODE_PRIO_Shortcuts = 3; + NODE_PRIO_Default = 255; + +type + + TBuildNode = record + Active, RemoveTreesMode, ShortcutMode: Boolean; + Priority: Byte; + FreeWorkers, RequiredWorkers, MaxReqWorkers: Integer; + CenterPoint: TKMPoint; + FieldType: TKMFieldType; //ftCorn, ftWine, ftRoad + FieldList: TKMPointList; + end; + + TConstructionState = (csNoNodeAvailable, csNoPlaceCanBeFound, csHousePlaced, csCannotPlaceHouse, csHouseReservation, csRemoveTreeProcedure); + + // City builder (build nodes, selection from required houses) + TKMCityBuilder = class + private + fStoneCrisis, fStoneShortage, fWoodShortage, fTrunkShortage, fGoldShortage: Boolean; + fFreeWorkersCnt: Integer; + fOwner: TKMHandID; + fBuildNodes: array of TBuildNode; + fWorkersPos: TKMPointArray; + + fPlanner: TKMCityPlanner; + fPredictor: TKMCityPredictor; + + {$IFDEF DEBUG_NewAI} + fTimePlanRoads: Cardinal; + {$ENDIF} + + procedure UpdateBuildNodes(); + procedure UpdateBuildNode(var aNode: TBuildNode); + + function BuildHouse(aIgnoreTrees, aHouseReservation, aIgnoreExistingPlans: Boolean; aHT: TKMHouseType; aRoadNodePrio: Byte = NODE_PRIO_Default): TConstructionState; + procedure LockNode(var aNode: TBuildNode); + procedure UnlockPointOfNode(aPoint: TKMPoint; aCheckHousePlan: Boolean = False); + procedure UnlockNode(var aNode: TBuildNode; aCheckHousePlan: Boolean = False); + + procedure CheckBasicMaterials(var aMaxPlans, aMaxPlace: Integer; var aTrunkBalance: Single; aTick: Cardinal); + procedure CreateShortcuts(); + public + constructor Create(aPlayer: TKMHandID; aPredictor: TKMCityPredictor); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + property Planner: TKMCityPlanner read fPlanner; + property FreeWorkerCnt: Integer read fFreeWorkersCnt; + property WorkersPos: TKMPointArray read fWorkersPos; + property StoneShortage: Boolean read fStoneShortage; + property StoneCrisis: Boolean read fStoneCrisis; + property WoodShortage: Boolean read fWoodShortage; + property TrunkShortage: Boolean read fTrunkShortage; + property GoldShortage: Boolean read fGoldShortage; + + procedure AfterMissionInit(); + procedure OwnerUpdate(aPlayer: TKMHandID); + + procedure UpdateState(aTick: Cardinal); + procedure ChooseHousesToBuild(aTick: Cardinal); + + procedure LockHouseLoc(aHT: TKMHouseType; aLoc: TKMPoint); + procedure UnlockHouseLoc(aHT: TKMHouseType; aLoc: TKMPoint); + + procedure LogStatus(var aBalanceText: UnicodeString); + procedure Paint(); + end; + + +implementation +uses + Classes, KM_Game, KM_Hand, KM_HandsCollection, KM_Terrain, KM_Resource, KM_ResWares, + KM_AIFields, KM_Units, KM_UnitsCollection, KM_UnitTaskBuild, + {$IFDEF DEBUG_NewAI} + KM_CommonUtils, + {$ENDIF} + KM_RenderAux, KM_ResMapElements; + +{ Procedural functions } +function CompareBuildNode(const aElem1, aElem2): Integer; +var + val1: TBuildNode absolute aElem1; + val2: TBuildNode absolute aElem2; +begin + if val1.Active AND val2.Active then + begin + if (val1.Priority = val2.Priority) then Result := 0 + else if (val1.Priority < val2.Priority) then Result := -1 + else Result := +1; + end + else if val1.Active then Result := -1 + else if val2.Active then Result := +1 + else Result := 0; +end; + + +{ TKMCityBuilder } +constructor TKMCityBuilder.Create(aPlayer: TKMHandID; aPredictor: TKMCityPredictor); +begin + inherited Create; + + fOwner := aPlayer; + fPredictor := aPredictor; + fPlanner := TKMCityPlanner.Create(aPlayer, aPredictor); + + {$IFDEF DEBUG_NewAI} + fTimePlanRoads := 0; + {$ENDIF} +end; + + +destructor TKMCityBuilder.Destroy; +var + I: Integer; +begin + fPlanner.Free; + for I := Low(fBuildNodes) to High(fBuildNodes) do + fBuildNodes[I].FieldList.Free; + inherited; +end; + + +procedure TKMCityBuilder.Save(SaveStream: TKMemoryStream); +var + I, Cnt: Integer; +begin + SaveStream.PlaceMarker('CityBuilder'); + SaveStream.Write(fFreeWorkersCnt); + SaveStream.Write(fStoneCrisis); + SaveStream.Write(fStoneShortage); + SaveStream.Write(fWoodShortage); + SaveStream.Write(fTrunkShortage); + SaveStream.Write(fGoldShortage); + SaveStream.Write(fOwner); + + Cnt := Length(fWorkersPos); + SaveStream.Write(Cnt); + if (Cnt > 0) then + SaveStream.Write(fWorkersPos[0], SizeOf(fWorkersPos[0]) * Cnt); + + Cnt := Length(fBuildNodes); + SaveStream.Write(Cnt); + for I := 0 to Cnt - 1 do + with fBuildNodes[I] do + begin + SaveStream.Write(Active); + SaveStream.Write(RemoveTreesMode); + SaveStream.Write(ShortcutMode); + SaveStream.Write(Priority); + SaveStream.Write(FreeWorkers); + SaveStream.Write(RequiredWorkers); + SaveStream.Write(MaxReqWorkers); + SaveStream.Write(CenterPoint, SizeOf(CenterPoint)); + SaveStream.Write(FieldType, SizeOf(TKMFieldType)); + FieldList.SaveToStream(SaveStream); + end; + + fPlanner.Save(SaveStream); +end; + + +procedure TKMCityBuilder.Load(LoadStream: TKMemoryStream); +var + I, Cnt: Integer; +begin + LoadStream.CheckMarker('CityBuilder'); + LoadStream.Read(fFreeWorkersCnt); + LoadStream.Read(fStoneCrisis); + LoadStream.Read(fStoneShortage); + LoadStream.Read(fWoodShortage); + LoadStream.Read(fTrunkShortage); + LoadStream.Read(fGoldShortage); + LoadStream.Read(fOwner); + + LoadStream.Read(Cnt); + SetLength(fWorkersPos, Cnt); + if (Cnt > 0) then + LoadStream.Read(fWorkersPos[0], SizeOf(fWorkersPos[0]) * Cnt); + + LoadStream.Read(Cnt); + SetLength(fBuildNodes, Cnt); + for I := 0 to Cnt - 1 do + with fBuildNodes[I] do + begin + LoadStream.Read(Active); + LoadStream.Read(RemoveTreesMode); + LoadStream.Read(ShortcutMode); + LoadStream.Read(Priority); + LoadStream.Read(FreeWorkers); + LoadStream.Read(RequiredWorkers); + LoadStream.Read(MaxReqWorkers); + LoadStream.Read(CenterPoint, SizeOf(CenterPoint)); + LoadStream.Read(FieldType, SizeOf(TKMFieldType)); + FieldList := TKMPointList.Create(); + FieldList.LoadFromStream(LoadStream); + end; + + fPlanner.Load(LoadStream); +end; + + +procedure TKMCityBuilder.SyncLoad(); +begin + fPlanner.SyncLoad(); +end; + + +procedure TKMCityBuilder.AfterMissionInit(); +var + I: Integer; +begin + fPlanner.AfterMissionInit(); + SetLength(fBuildNodes, gHands[fOwner].AI.CityManagement.Predictor.WorkerCount); + for I := Low(fBuildNodes) to High(fBuildNodes) do + begin + fBuildNodes[I].FieldList := TKMPointList.Create(); + fBuildNodes[I].Active := False; + end; +end; + + +procedure TKMCityBuilder.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fPlanner.OwnerUpdate(aPlayer); +end; + + +procedure TKMCityBuilder.UpdateState(aTick: Cardinal); +const + CHECK_STONE_RESERVES = 3 * 60 * MAX_HANDS; // Every 3 min check stone reserves + CHECK_FIELDS = 1 * 30 * MAX_HANDS; // Every 30 sec 1 Farm +var + K: Integer; +begin + if (aTick mod MAX_HANDS = fOwner) then + begin + fPlanner.UpdateState(aTick); // Planner must be updated as first to secure that completed houses are actualized + UpdateBuildNodes(); + if (fPredictor.RequiredHouses[htQuarry] <= 0) AND (aTick mod CHECK_STONE_RESERVES = fOwner) then // First update stone reserves + Planner.CheckStoneReserves(False, fPredictor.RequiredHouses[htQuarry]) + else if (aTick mod CHECK_FIELDS = fOwner) then + for K := Low(fBuildNodes) to High(fBuildNodes) do + with fBuildNodes[K] do + if not Active AND Planner.CheckFields(FieldType, FieldList) then + begin + LockNode(fBuildNodes[K]); + Active := True; + Priority := NODE_PRIO_Fields; + RemoveTreesMode := False; + ShortcutMode := False; + MaxReqWorkers := 1; + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); // Real count will be updated during building process + CenterPoint := FieldList[0]; + + break; + end; + end; +end; + + +procedure TKMCityBuilder.LockHouseLoc(aHT: TKMHouseType; aLoc: TKMPoint); +var + I,Dist: Integer; + Point: TKMPoint; + Dir: TDirection; +begin + // Reserve all tiles inside house plan + //if (aHT <> htCoalMine) then + + for I := Low(gAIFields.Eye.HousesMapping[aHT].Tiles) to High(gAIFields.Eye.HousesMapping[aHT].Tiles) do + begin + Point := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[aHT].Tiles[I]); + gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] := AVOID_BUILDING_HOUSE_INSIDE_LOCK; + gAIFields.Eye.BuildFF.ActualizeTile(Point.X, Point.Y); + end; + // Reserve all tiles in distance 1 from house plan + Dist := 1; + for Dir := Low(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist]) to High(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist]) do + for I := Low(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir]) to High(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir]) do + begin + Point := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir,I]); + // Skip coal tiles, forests and other reserved tiles + if (gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] < AVOID_BUILDING_HOUSE_INSIDE_LOCK) then + begin + gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] := AVOID_BUILDING_HOUSE_OUTSIDE_LOCK; + gAIFields.Eye.BuildFF.ActualizeTile(Point.X, Point.Y); + end; + end; +end; + + +procedure TKMCityBuilder.UnlockHouseLoc(aHT: TKMHouseType; aLoc: TKMPoint); +var + I,Dist: Integer; + Point: TKMPoint; + Dir: TDirection; +begin + if (aHT in [htGoldMine, htIronMine]) then + Exit; + // Free all tiles inside house plan + //if (aHT <> htCoalMine) then + for I := Low(gAIFields.Eye.HousesMapping[aHT].Tiles) to High(gAIFields.Eye.HousesMapping[aHT].Tiles) do + begin + Point := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[aHT].Tiles[I]); + gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] := AVOID_BUILDING_UNLOCK; + end; + // Free all tiles in distance 1 from house plan + Dist := 1; + for Dir := Low(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist]) to High(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist]) do + for I := Low(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir]) to High(gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir]) do + begin + Point := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[aHT].Surroundings[Dist,Dir,I]); + if (gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] = AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) then + gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] := AVOID_BUILDING_UNLOCK; + end; +end; + + +procedure TKMCityBuilder.LockNode(var aNode: TBuildNode); +var + NODE_TYPE: Byte; + I: Integer; +begin + case aNode.FieldType of + ftRoad: NODE_TYPE := AVOID_BUILDING_NODE_LOCK_ROAD; + else NODE_TYPE := AVOID_BUILDING_NODE_LOCK_FIELD; + end; + with aNode.FieldList do + for I := 0 to Count-1 do + if (gAIFields.Influences.AvoidBuilding[Items[I].Y, Items[I].X] < NODE_TYPE) then + begin + gAIFields.Influences.AvoidBuilding[Items[I].Y, Items[I].X] := NODE_TYPE; + gAIFields.Eye.BuildFF.ActualizeTile(Items[I].X, Items[I].Y); + end; +end; + + +procedure TKMCityBuilder.UnlockPointOfNode(aPoint: TKMPoint; aCheckHousePlan: Boolean = False); +var + AB: Byte; + X,Y: Integer; +begin + if aCheckHousePlan then + for Y := Max(1,aPoint.Y-1) to Min(aPoint.Y+1, gTerrain.MapY-1) do + for X := Max(1,aPoint.X-1) to Min(aPoint.X+1, gTerrain.MapX-1) do + if (gAIFields.Influences.AvoidBuilding[Y,X] = AVOID_BUILDING_HOUSE_INSIDE_LOCK) then + begin + gAIFields.Influences.AvoidBuilding[aPoint.Y, aPoint.X] := AVOID_BUILDING_HOUSE_OUTSIDE_LOCK; + Exit; + end; + AB := gAIFields.Influences.AvoidBuilding[aPoint.Y, aPoint.X]; + if (aCheckHousePlan AND not (AB in [AVOID_BUILDING_MINE_TILE, High(Byte)])) OR (AB = AVOID_BUILDING_NODE_LOCK_ROAD) then // Only roads are unlocked = aCheckHousePlan + gAIFields.Influences.AvoidBuilding[aPoint.Y, aPoint.X] := AVOID_BUILDING_UNLOCK; +end; + + +procedure TKMCityBuilder.UnlockNode(var aNode: TBuildNode; aCheckHousePlan: Boolean = False); +var + I: Integer; +begin + with aNode.FieldList do + for I := 0 to Count-1 do + UnlockPointOfNode(Items[I], aCheckHousePlan); +end; + + +procedure TKMCityBuilder.UpdateBuildNodes(); + function BuildingFirstSchool(): Boolean; + var + K: Integer; + Worker: TKMUnitWorker; + pomP : TKMPoint; + UnitTask: TKMTaskBuildHouseArea; + begin + with fPlanner.PlannedHouses[htSchool] do + begin + Result := (UnderConstruction = 1) AND (Completed = 0) AND (Plans[0].Placed) AND (Plans[0].House <> nil); + if Result then + begin + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active then + if KMSamePoint(KMPointBelow(Plans[0].Loc), fBuildNodes[K].FieldList[0]) then + Exit(False); + for K := 0 to gHands[fOwner].Units.Count - 1 do + if not gHands[fOwner].Units[K].IsDeadOrDying + AND (gHands[fOwner].Units[K] is TKMUnitWorker) then + begin + pomP.X := pomP.X*1; + Worker := TKMUnitWorker(gHands[fOwner].Units[K]); + if (Worker.Task <> nil) AND (Worker.Task.TaskType = uttBuildHouseArea) then + begin + UnitTask := TKMTaskBuildHouseArea(Worker.Task); + if (UnitTask.DigState > 1) then + Exit(False); + end; + end; + end; + end; + end; +//Worker tasks: +// Common phase of tasks +// 0: None (Think about plans) +// 1: Go to plan +// 2,3: Dig +// TTaskBuildRoad: +// 4: Wait for stone +// 5,6,7: Get stone, Build road, Build road + change tile +// 8: Complete road +// 9: End task +// TTaskBuildField +// 4: End task +// TTaskBuildWine +// 4: Dig + change tile +// 5: Wait for a wood +// 6,7: receive wood, build wine +// 8: End task +var + Check: Boolean; + K,L, ClosestIdx, ClosestDist, Dist, ReqWorkerCnt: Integer; + H: TKMHouse; + WorkersPos: TKMPointArray; +begin + // Dont update nodes when first school needs to be build + if BuildingFirstSchool() then + Exit; + + // Reset count of free workers in each node + for K := Low(fBuildNodes) to High(fBuildNodes) do + fBuildNodes[K].FreeWorkers := 0; + + // Get positions of workes with nil task (no task) + fFreeWorkersCnt := 0; + SetLength(WorkersPos, gHands[fOwner].Stats.GetUnitQty(utBuilder)); + for K := 0 to gHands[fOwner].Units.Count - 1 do + if not gHands[fOwner].Units[K].IsDeadOrDying + AND (gHands[fOwner].Units[K] is TKMUnitWorker) then + with gHands[fOwner].Units[K] do + begin + if ( (Task = nil) + //OR ( (UnitTask.TaskName = uttBuildRoad) AND (UnitTask.Phase > 8) ) // This actualy have big impact + //OR ( (UnitTask.TaskName = uttBuildField) AND (UnitTask.Phase > 3) ) // GA set fields max 1 worker so it have no sense to check it + //OR ( (UnitTask.TaskName = uttBuildWine) AND (UnitTask.Phase > 6) ) // GA set fields max 1 worker so it have no sense to check it + //OR (UnitTask.TaskName = uttBuildHouse) + ) then + //if (gHands[fOwner].Units[I].IsIdle) then + begin + WorkersPos[fFreeWorkersCnt] := Position; + fFreeWorkersCnt := fFreeWorkersCnt + 1; + end; + end; + + // Check that all houses with resources are under construction + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) AND not H.IsComplete AND (H.GetBuildResDeliveredPercent = 1) then + begin + Check := False; + for L := 0 to gHands[fOwner].Units.Count - 1 do + if not gHands[fOwner].Units[L].IsDeadOrDying AND (gHands[fOwner].Units[L] is TKMUnitWorker) then + with gHands[fOwner].Units[L] do + if (Task <> nil) AND (Task.TaskType = uttBuildHouse) AND (TKMTaskBuildHouse(Task).House = H) then + Check := True; + fFreeWorkersCnt := fFreeWorkersCnt - Ord(not Check); + end; + end; + fFreeWorkersCnt := fFreeWorkersCnt * Ord(fFreeWorkersCnt > 0); + SetLength(WorkersPos, fFreeWorkersCnt); + + // Sort buildNodes by priority and active state + SortCustom(fBuildNodes[0], Low(fBuildNodes), High(fBuildNodes), SizeOf(fBuildNodes[0]), CompareBuildNode); + + // Find closest build-node to each free worker and allow to expand it in next update + consider priority of node + K := 0; + L := 0; + ClosestIdx := 0; + while (fFreeWorkersCnt > 0) AND (K < Length(fBuildNodes)) AND (fBuildNodes[K].Active) do + begin + // Get best distance and assign worker + while (fFreeWorkersCnt > 0) do + begin + ClosestDist := High(Integer); + for L := K to High(fBuildNodes) do + if (fBuildNodes[K].Priority = fBuildNodes[L].Priority) AND (fBuildNodes[L].Active) then + begin + if (fBuildNodes[L].RequiredWorkers > 0) then + begin + Dist := KMDistanceAbs(WorkersPos[fFreeWorkersCnt - 1], fBuildNodes[L].CenterPoint); + if (Dist < ClosestDist) then + begin + ClosestDist := Dist; + ClosestIdx := L; + end; + end; + end + else + break; + if (ClosestDist <> High(Integer)) then + begin + fFreeWorkersCnt := fFreeWorkersCnt - 1; + with fBuildNodes[ClosestIdx] do + begin + RequiredWorkers := RequiredWorkers - 1; + FreeWorkers := FreeWorkers + 1; + end; + end + else + break; + end; + K := L; + end; + + //if (fFreeWorkersCnt > 0) then // Delete if? + CreateShortcuts(); + + // Update nodes + ReqWorkerCnt := 0; + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active then + begin + UpdateBuildNode(fBuildNodes[K]); + if fBuildNodes[K].Active then + ReqWorkerCnt := ReqWorkerCnt + fBuildNodes[K].RequiredWorkers; + end; + if (gHands[fOwner].Stats.GetHouseQty(htAny) > 15) then + fFreeWorkersCnt := Max(fFreeWorkersCnt, Ord(ReqWorkerCnt < 5)); + + fWorkersPos := WorkersPos; +end; + + +procedure TKMCityBuilder.UpdateBuildNode(var aNode: TBuildNode); + function IsPlan(aPoint: TKMPoint; aField: TKMFieldType): Boolean; overload; + begin + Result := gHands[fOwner].Constructions.FieldworksList.HasField(aPoint) = aField; + end; + function IsPlan(aPoint: TKMPoint; aLock: TKMTileLock): Boolean; overload; + begin + Result := gTerrain.Land^[aPoint.Y, aPoint.X].TileLock = aLock; + end; + function IsPlan(aPoint: TKMPoint; aLock: TKMTileLock; aField: TKMFieldType): Boolean; overload; + begin + Result := IsPlan(aPoint, aField) OR IsPlan(aPoint, aLock); + end; + function IsCompletedRoad(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsWalkableRoad(aPoint); + end; + function IsCompletedField(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsCornField(aPoint); + end; + function IsCompletedWine(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsWineField(aPoint); + end; + function IsRoad(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedRoad(aPoint) OR IsPlan(aPoint, tlRoadWork, ftRoad); + end; + function IsCornField(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedField(aPoint) OR IsPlan(aPoint, tlFieldWork, ftCorn); + end; + function IsWineField(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedWine(aPoint) OR IsPlan(aPoint, tlFieldWork, ftWine); + end; + + function BuildField(aIdx: Integer; aFieldType: TKMFieldType): Boolean; + var + Output: Boolean; + begin + Output := False; + if gHands[fOwner].CanAddFieldPlan(aNode.FieldList.Items[aIdx], aFieldType) then + begin + gHands[fOwner].Constructions.FieldworksList.AddField(aNode.FieldList.Items[aIdx], aFieldType); + aNode.FreeWorkers := aNode.FreeWorkers - 1; + aNode.RequiredWorkers := aNode.RequiredWorkers - 1; + Output := True; + end; + Result := Output; + end; + + // Build roads + procedure BuildRoad(); + var + K, ActiveWorkers: Integer; + begin + ActiveWorkers := 0; + with aNode do + begin + // Remove elements of exist road from list + for K := FieldList.Count - 1 downto 0 do + if IsCompletedRoad(FieldList.Items[K]) then + begin + UnlockPointOfNode(FieldList.Items[K], True); + FieldList.Delete(K); + end + else if not ShortcutMode then + break; + if (FieldList.Count = 0) then + begin + Active := False; + Exit; + end; + // Build road / check road plans / replace missing parts / reconnect road when is no more possible to place plan + RequiredWorkers := FieldList.Count; + for K := FieldList.Count - 1 downto 0 do + begin + // Is there field / wine plan in progress? + if IsPlan(FieldList.Items[K], ftWine) OR IsPlan(FieldList.Items[K], ftCorn) then + gHands[fOwner].Constructions.FieldworksList.RemFieldPlan( FieldList.Items[K] ); + // Is there road plan / work in progress? + if IsPlan(FieldList.Items[K], tlRoadWork, ftRoad) then + begin + ActiveWorkers := ActiveWorkers + 1; + RequiredWorkers := RequiredWorkers - 1; + end + else if IsPlan(FieldList.Items[K], tlFieldWork) AND ( IsPlan(FieldList.Items[K], ftCorn) OR IsPlan(FieldList.Items[K], ftCorn) ) then + begin + // Wait for worker to finish the corn + end + // Is there completed road? + else if IsCompletedRoad(FieldList.Items[K]) then + begin + RequiredWorkers := RequiredWorkers - 1; + CenterPoint := FieldList.Items[K]; // Actualize center point (distribution of workers by distance) + end + // When cannot place new plan try find another way by calling pathfinding + else + begin + // Does we have free workers? (this condition cannot be earlier because we need detection of ActiveWorkers) + if (FreeWorkers <= 0) then + break; + if not BuildField(K, ftRoad) then + begin + if ShortcutMode then + begin + UnlockPointOfNode(FieldList.Items[K], True); + FieldList.Delete(K); + end + else + begin + UnlockNode(aNode, True); + // If is not possible to connect 2 points by road destroy node + if not fPlanner.GetRoadBetweenPoints(CenterPoint, FieldList.Items[0], FieldList, FieldType) then + begin + FieldList.Clear; + Active := False; + end; + LockNode(aNode); + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); + Exit; // Node will be updated in next calling + end; + end; + end; + end; + // Restrict max required workers + RequiredWorkers := Min(Max(0, MaxReqWorkers - ActiveWorkers), RequiredWorkers); + end; + end; + + // Build Wine or Corn fields + procedure BuildFields(); + var + K, ActiveWorkers: Integer; + begin + ActiveWorkers := 0; + with aNode do + begin + RequiredWorkers := FieldList.Count; + for K := 0 to FieldList.Count - 1 do + begin + // Check if field was replaced by road + if (gAIFields.Influences.AvoidBuilding[FieldList.Items[K].Y, FieldList.Items[K].X] <> AVOID_BUILDING_NODE_LOCK_FIELD) then + begin + RequiredWorkers := RequiredWorkers - 1; + end + // Check if field already exists ... + else if ((FieldType = ftWine) AND IsCompletedWine(FieldList.Items[K])) + OR ((FieldType = ftCorn) AND IsCompletedField(FieldList.Items[K])) then + begin + RequiredWorkers := RequiredWorkers - 1; + end + else if ((FieldType = ftWine) AND IsPlan(FieldList.Items[K], tlFieldWork, ftWine)) + OR ((FieldType = ftCorn) AND IsPlan(FieldList.Items[K], tlFieldWork, ftCorn)) then + begin + ActiveWorkers := ActiveWorkers + 1; + if (MaxReqWorkers <= ActiveWorkers) then + break; + end + // ... else try build it + else + begin + BuildField(K, FieldType); + if (FreeWorkers <= 0) then + break; + end; + // When node reached all plans disable it + if (RequiredWorkers <= 0) OR (K = FieldList.Count-1) then + begin + // Only roads are unlocked + //for K := 0 to FieldList.Count-1 do + // if ((FieldType = ftWine) AND (IsCornField(FieldList.Items[K]))) + // OR ((FieldType = ftCorn) AND (IsWineField(FieldList.Items[K]))) then + // UnlockPointOfNode(FieldList.Items[K]); + FieldList.Clear; + Active := False; + end; + end; + // Restrict max required workers + RequiredWorkers := Min(Max(0, MaxReqWorkers - ActiveWorkers), RequiredWorkers); + end; + end; + + // Remove trees or Wine / Corn fields which block placing house plan + procedure RemoveObstaclesInPlan(); + var + K: Integer; + begin + with aNode do + begin + if (FieldList.Count = 0) then + begin + Active := False; + Exit; + end; + RequiredWorkers := FieldList.Count; + for K := FieldList.Count - 1 downto 0 do + begin + //if (FreeWorkers <= 0) then // Ignore FreeWorkers distribution system + // Exit; + // Detect obstacles in house plan + if gTerrain.ObjectIsChopableTree(FieldList.Items[K], [caAge1,caAge2,caAge3,caAgeFull]) then + begin + // Check if is wine plan already placed + if IsPlan(FieldList.Items[K], tlFieldWork, ftWine) then + begin + RequiredWorkers := RequiredWorkers - 1; + end + // If we cannot remove tree by placing wineyard remove point from list + else if not BuildField(K, ftWine) then + FieldList.Delete(K); + end + // If is plan blocked by fields which could be compensated by road do it + else if IsCompletedWine(FieldList.Items[K]) OR IsCompletedField(FieldList.Items[K]) OR IsRoad(FieldList.Items[K]) then + begin + if IsCompletedRoad(FieldList.Items[K]) then + FieldList.Delete(K) // Now can be item [K] deleted + // Else try place road plan or delete point + else if not IsPlan(FieldList.Items[K], tlRoadWork, ftRoad) then + begin + // Delete item [K] only in case that we cannot place road plan (point must be removed only in moment when is road completed) + if not BuildField(K, ftRoad) then + FieldList.Delete(K); + end; + end + // Tree was destroyed while worker is going to do it -> remove wine or corn plan and remove point from build node + else if (gHands[fOwner].Constructions.FieldworksList.HasField(FieldList.Items[K]) <> ftNone) then // ftNone is fine, road was checked before + begin + gHands[fOwner].Constructions.FieldworksList.RemFieldPlan(FieldList.Items[K]); + FieldList.Delete(K); + end + // There is digged wine / field + else if (gTerrain.Land^[FieldList.Items[K].Y, FieldList.Items[K].X].TileLock = tlFieldWork) then + begin + // do nothing (wait till worker finish tile and place road + end + // Tree was destroyed for example by script + else + begin + FieldList.Delete(K); + RequiredWorkers := RequiredWorkers - 1; + end; + end; + // Restrict max required workers + RequiredWorkers := Min(MaxReqWorkers, RequiredWorkers); + end; + end; + +begin + // Build procedures are split because of quite complex algorithm (or can be merged into mess) + if aNode.RemoveTreesMode then + RemoveObstaclesInPlan() + else + begin + case aNode.FieldType of + ftRoad: BuildRoad(); + ftWine, ftCorn: BuildFields(); + else begin end; + end; + end; +end; + + +procedure TKMCityBuilder.CheckBasicMaterials(var aMaxPlans, aMaxPlace: Integer; var aTrunkBalance: Single; aTick: Cardinal); +var + K, RequiredStones, RequiredWood, WoodReserves, Wood, Trunk: Integer; + H: TKMHouse; +begin + // Analyze basic force stats (max possible plans, construction ware, gold) + aMaxPlans := Ceil(fFreeWorkersCnt / Max(0.01,AI_Par[BUILDER_ChHTB_FreeWorkerCoef])); + // Use "rapid construction" in case that we have resources + if (fPredictor.WareBalance[wtStone].Exhaustion > 60) then // Some stone mines are too far so AI must slow down with expansion + //AND (fPredictor.WareBalance[wtWood].Exhaustion > 60) + //AND (fPredictor.WareBalance[wtGold].Exhaustion > 60) then + aMaxPlans := Max(aMaxPlans, Ceil(gHands[fOwner].Stats.GetUnitQty(utBuilder) / Max(0.01,AI_Par[BUILDER_ChHTB_AllWorkerCoef])) - fPlanner.ConstructedHouses); + + // Quarries have minimal delay + stones use only workers (towers after peace time) -> exhaustion for wtStone is OK + fStoneShortage := (fPredictor.WareBalance[wtStone].Exhaustion < AI_Par[BUILDER_Shortage_Stone]) AND not Planner.StonesDepleted; + + // Make sure that gold will be produced ASAP -> minimal delay, exhaustion is OK + fGoldShortage := (fPredictor.WareBalance[wtGold].Exhaustion < AI_Par[BUILDER_Shortage_Gold]); + + // Woodcutters have huge delay (8 min) + trunk is used only to produce wood -> decide shortage based on actual consumption and reserves + Trunk := gHands[fOwner].Stats.GetWareBalance(wtTrunk); + Wood := gHands[fOwner].Stats.GetWareBalance(wtTimber); + WoodReserves := Trunk * 2 + Wood; + aTrunkBalance := WoodReserves / (2 * Max(0.1, fPredictor.WareBalance[wtTrunk].ActualConsumption)); + fTrunkShortage := (aTrunkBalance < AI_Par[BUILDER_Shortage_Trunk]); + + // Compute building materials + RequiredStones := gHands[fOwner].Constructions.HousePlanList.GetPlansStoneDemands(); + RequiredWood := gHands[fOwner].Constructions.HousePlanList.GetPlansWoodDemands(); + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) AND not H.IsDestroyed AND not H.IsComplete then + begin + RequiredStones := RequiredStones + gRes.Houses[H.HouseType].StoneCost - H.GetBuildStoneDelivered; + RequiredWood := RequiredWood + gRes.Houses[H.HouseType].WoodCost - H.GetBuildWoodDelivered; + end; + end; + // Compute road demands + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active AND (fBuildNodes[K].FieldType = ftRoad) then + RequiredStones := RequiredStones + fBuildNodes[K].FieldList.Count - 1; + // Determine stone crisis (based on material) + with fPlanner.PlannedHouses[htQuarry] do + fStoneCrisis := ((UnderConstruction + Planned) > 0) + AND (Completed * PRODUCTION_RATE[wtStone] < gHands[fOwner].Stats.GetUnitQty(utBuilder) * AI_Par[PREDICTOR_WareNeedPerAWorker_Stone]) + AND (gHands[fOwner].Stats.GetWareBalance(wtStone) < RequiredStones + AI_Par[BUILDER_Shortage_StoneReserve]); + fStoneShortage := fStoneShortage OR fStoneCrisis; // Make sure that we have also shortage + // Determine wood shortage (based on material) + fTrunkShortage := fTrunkShortage OR (WoodReserves < RequiredWood); + aMaxPlace := Round((Wood // Available wood + + Min(Trunk * 2 , gHands[fOwner].Stats.GetHouseQty(htSawmill) * 4) // Trunk which can be turned into wood while the house is digged + - RequiredWood) / 3.5 // Consideration of required wood per a plan (approx 3.5) + ); + + // Secure wood production: only process trunk -> wood => minimal delay + fWoodShortage := + (fPredictor.WareBalance[wtTimber].Exhaustion < AI_Par[BUILDER_Shortage_Wood]) + OR + ( + ( + (fPredictor.RequiredHouses[htSawmill] > 0) + OR + (fPlanner.PlannedHouses[htSawmill].Planned > 0) + ) + AND + (RequiredWood > Wood) + AND + (RequiredWood < WoodReserves) + ); +end; + + +// Build house in standard game +// aIgnoreTrees: Boolean = allow remove trees in house plan mode +// aHouseReservation: Boolean = plan house plan and create reservation but dont place it (roads and fields will be constructed) +// aIgnoreExistingPlans: Boolean = planner will ignore existing plans and find new place for house (-> allow to plan multiple houses of 1 type) +// aHT: TKMHouseType = type of house +// Result: TConstructionState = state of construction +function TKMCityBuilder.BuildHouse(aIgnoreTrees, aHouseReservation, aIgnoreExistingPlans: Boolean; aHT: TKMHouseType; aRoadNodePrio: Byte = NODE_PRIO_Default): TConstructionState; +var + Output: TConstructionState; + FieldsComplete, Check: Boolean; + K, Node1Idx, Node2Idx, HouseIdx: Integer; + Loc: TKMPoint; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + Result := csNoNodeAvailable; + FieldsComplete := False; + // Find at least 2 non active build nodes + Node1Idx := -1; + Node2Idx := -1; + for K := Low(fBuildNodes) to High(fBuildNodes) do + if not fBuildNodes[K].Active then + if (Node1Idx = -1) then + Node1Idx := K + else + begin + Node2Idx := K; + break; + end; + + // We need min 2 free nodes (1 for road and second for field or 1 for wine and second for road to remove trees in plan) + if (Node1Idx = -1) OR (Node2Idx = -1) then + Exit; + + Output := csNoPlaceCanBeFound; + if fPlanner.GetHousePlan(aIgnoreTrees, aIgnoreExistingPlans, aHT, Loc, HouseIdx) then + begin + // Check if we can place house by default KaM function + if gHands[fOwner].CanAddHousePlan(Loc, aHT) then + begin + + // Update reservation status + if fPlanner.PlannedHouses[aHT].Plans[HouseIdx].HouseReservation then + begin + Output := csHouseReservation; // House is already reserved -> no nodes will be updated and workers still have nothing to do so we can build another house + if not aHouseReservation then + begin + fPlanner.PlannedHouses[aHT].Plans[HouseIdx].HouseReservation := False; + FieldsComplete := True; // Fields was completed in reservation (only for farm and wine) + end; + end; + + // if house is not reserved (or will be reserved in this tick) + if not fPlanner.PlannedHouses[aHT].Plans[HouseIdx].HouseReservation then + begin + Output := csHousePlaced; // Nodes will be updated -> workers will have something to do + gHands[fOwner].AddHousePlan(aHT, Loc); // Place house + // Add avoid building for Barracks and Store (road will be build later in shortcut procedure) + if ((aHT = htStore) OR (aHT = htBarracks)) AND (Loc.Y+2 < gTerrain.MapY) then + for K := Loc.X-1 to Loc.X+1 do + gAIFields.Influences.AvoidBuilding[Loc.Y+2, K] := AVOID_BUILDING_HOUSE_ENTRANCE; + // Add road to node + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + if fPlanner.GetRoadToHouse(aHT, HouseIdx, fBuildNodes[Node1Idx].FieldList, fBuildNodes[Node1Idx].FieldType) + AND (fBuildNodes[Node1Idx].FieldList.Count > 0) then + begin + with fBuildNodes[Node1Idx] do + begin + LockNode(fBuildNodes[Node1Idx]); + Active := True; + Priority := aRoadNodePrio; + RemoveTreesMode := False; + ShortcutMode := False; + MaxReqWorkers := Round(AI_Par[BUILDER_BuildHouse_RoadMaxWork]) + Ord(NODE_PRIO_RoadsUnlockHouse = aRoadNodePrio) * 20; + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); + CenterPoint := FieldList[ FieldList.Count-1 ]; // Road node must start from exist house + end; + // Add field to node (if is required [htFarm, htVineyard]) + if not FieldsComplete AND fPlanner.GetFieldToHouse(aHT, HouseIdx, fBuildNodes[Node2Idx].FieldList, fBuildNodes[Node2Idx].FieldType) then + begin + LockNode(fBuildNodes[Node2Idx]); + with fBuildNodes[Node2Idx] do + begin + Active := True; + Priority := Ord(aHouseReservation) * NODE_PRIO_FieldsReservation + Ord(not aHouseReservation) * NODE_PRIO_Fields; + RemoveTreesMode := False; + ShortcutMode := False; + MaxReqWorkers := Round(AI_Par[BUILDER_BuildHouse_FieldMaxWork]); + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); + CenterPoint := Loc; + end; + end; + end + else + begin + gHands[fOwner].RemHousePlan(Loc); + {$IFDEF DEBUG_NewAI} + fTimePlanRoads := fTimePlanRoads + TimeGet() - Time; + {$ENDIF} + Exit; + end; + {$IFDEF DEBUG_NewAI} + fTimePlanRoads := fTimePlanRoads + TimeGet() - Time; + {$ENDIF} + // Reserve house place + if aHouseReservation then + begin + fPlanner.PlannedHouses[aHT].Plans[HouseIdx].HouseReservation := True; + gHands[fOwner].RemHousePlan(Loc); + end + else + with fPlanner.PlannedHouses[aHT].Plans[HouseIdx] do + begin + HouseReservation := False; + RemoveTreeInPlanProcedure := False; + Placed := True; + end; + end; + end + else if gAIFields.Eye.CanPlaceHouse(Loc, aHT, True) then + begin + Output := csRemoveTreeProcedure; // Remove tree procedure does not require significant count of workers so there is not need for separate mark + // Remove tree procedure is already active + Check := False; + // Wait till is tree removed and check if there exist node with remove tree mode + if (fPlanner.PlannedHouses[aHT].Plans[HouseIdx].RemoveTreeInPlanProcedure) then + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active AND fBuildNodes[K].RemoveTreesMode then + begin + Check := True; + break; + end; + // House plan cannot be placed because of existing tree -> remove it by placing wine and road at specific tiles + if not Check then + begin + if (fPlanner.GetTreesInHousePlan(aHT, HouseIdx, fBuildNodes[Node1Idx].FieldList) > 0) then + begin + fPlanner.PlannedHouses[aHT].Plans[HouseIdx].RemoveTreeInPlanProcedure := True; + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active + AND fBuildNodes[K].RemoveTreesMode + AND (fBuildNodes[K].FieldList.Count > 0) + AND KMSamePoint(fBuildNodes[Node1Idx].FieldList.Items[0], fBuildNodes[K].FieldList.Items[0]) then + begin + fBuildNodes[Node1Idx].FieldList.Clear; + Exit; + end; + with fBuildNodes[Node1Idx] do + begin + Active := True; + Priority := NODE_PRIO_RemoveTreeInPlan; + RemoveTreesMode := True; + ShortcutMode := False; + MaxReqWorkers := Round(AI_Par[BUILDER_BuildHouse_RTPMaxWork]); + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); // Real count will be updated during building process + CenterPoint := Loc; + end; + end + // There is another problem... + else + Planner.RemovePlan(aHT, Loc); + end; + end + else + begin + // Plan cannot be placed - maybe because of terrain changes -> find build node with remove tree procedure and check if is active + for K := Low(fBuildNodes) to High(fBuildNodes) do + if fBuildNodes[K].Active AND fBuildNodes[K].RemoveTreesMode AND KMSamePoint(Loc,fBuildNodes[K].CenterPoint) then + begin + Output := csRemoveTreeProcedure; // Remove tree procedure is active + break; + end; + if (Output = csNoPlaceCanBeFound) then // Remove tree procedure is not active plan cannot be placed + Planner.RemovePlan(aHT, Loc); + end; + end + else + begin + Output := csNoPlaceCanBeFound; + end; + Result := Output; +end; + + +procedure TKMCityBuilder.ChooseHousesToBuild(aTick: Cardinal); +type + TSetOfWare = set of TKMWareType; + TSetOfHouseType = set of TKMHouseType; +const + + //htWoodcutters, htQuary, htSawmill, htIronMine, htGoldMine, + //htCoalMine, htIronSmithy, htMetallurgists, htVineyard, htFarm, + //htBakery, htMill, htTannery, htButchers, htSwine, + //htSwine, htArmorWorkshop, htArmorSmithy, htArmorWorkshop, htArmorSmithy, + //htWeaponWorkshop, htWeaponSmithy, htWeaponWorkshop, htWeaponSmithy, htWeaponWorkshop, + //htWeaponSmithy, htStables, htFisherHut + + + BASIC_HOUSES: TSetOfHouseType = [htSchool, htBarracks, htInn, htMarket, htStore]; + //BUILD_WARE: TSetOfWare = [wtGoldOre, wtCoal, wtGold, wtStone, wtTrunk, wtWood]; + //FOOD_WARE: TSetOfWare = [wtCorn, wtFlour, wtBread, wtPig, wtSausages, wtWine, wtFish, wtWood]; + //WEAPON_WARE: TSetOfWare = [wtSkin, wtLeather, wtHorse, wtIronOre, wtCoal, wtSteel, wtAxe, wtBow, wtPike, wtArmor, wtShield, wtSword, wtArbalet, wtHallebard, wtMetalShield, wtMetalArmor]; + // All considerable ware (from weapons / armors just 1 piece of ware type because it is produced in same house) + ALL_WARE: TSetOfWare = [wtCorn, wtPig, wtSausage, wtWine, wtFish, wtStone, wtTrunk, wtTimber, wtSkin, wtLeather, wtHorse, wtIronOre, wtCoal, wtIron, wtAxe, wtLeatherArmor, wtSword, wtIronArmor, wtFlour, wtBread]; + //BUILD_ORDER_WARE: array[0..8] of TKMWareType = (wtStone, wtGold, wtGoldOre, wtCoal, wtTrunk, wtWood, wtCorn, wtPig, wtSausages); + BUILD_ORDER_WARE: array[0..5] of TKMWareType = (wtStone, wtGoldOre, wtCoal, wtGold, wtTrunk, wtTimber); +var + MaxPlans, MaxPlace: Integer; + RequiredHouses: TRequiredHousesArray; + + + function TryUnlockByRnd(var aHT: TKMHouseType): Boolean; + const + FORBIDDEN_HOUSES = [htIronMine, htGoldMine, htCoalMine, htVineyard, htStables, htFishermans, htTownHall, htSiegeWorkshop, htIronSmithy, htArmorSmithy, htWeaponSmithy]; + var + HT: TKMHouseType; + begin + Result := False; + for HT := HOUSE_MIN to HOUSE_MAX do + if not gHands[fOwner].Locks.HouseBlocked[HT] + AND gHands[fOwner].Locks.HouseCanBuild(HT) + AND (gHands[fOwner].Stats.GetHouseTotal(HT) = 0) + AND not (HT in FORBIDDEN_HOUSES) then + begin + aHT := HT; + Result := True; + Exit; + end; + end; + + function GetHousesToUnlock(aHT: TKMHouseType; var aHTArr: TKMHouseTypeArray): Boolean; + begin + Result := True; + // Repeat until it finds an available house (to unlock target house) + SetLength(aHTArr,1); + aHTArr[ High(aHTArr) ] := aHT; + while not gHands[fOwner].Locks.HouseCanBuild(aHT) do + begin + if gHands[fOwner].Locks.HouseBlocked[aHT] then // House is blocked -> unlock is impossible + begin + // Try to guess old unlock order + if (aHT = htQuarry) AND not gHands[fOwner].Locks.HouseBlocked[htSchool] then + begin + if (fPlanner.PlannedHouses[htSchool].Completed > 0) then + SetLength(aHTArr, 2) + else + begin + SetLength(aHTArr, 3); + aHTArr[2] := htSchool; + end; + aHTArr[1] := htInn; + Exit(True); + end; + Exit(False); + end; + aHT := gRes.Houses[aHT].ReleasedBy; // House have to be unlocked by this house + SetLength(aHTArr, Length(aHTArr)+1 ); // Just few interaction + aHTArr[ High(aHTArr) ] := aHT; + end; + end; + + + function AddToConstruction(aHT: TKMHouseType; aUnlockProcedureAllowed: Boolean = False; aIgnoreWareReserves: Boolean = False): TConstructionState; + var + IgnoreTreesInPlan, HouseReservation, IgnoreExistingPlans, MaterialShortage: Boolean; + NodePrio: Byte; + K: Integer; + HTArr: TKMHouseTypeArray; + begin + Result := csCannotPlaceHouse; + if fStoneCrisis AND not (aHT in [htQuarry, htSchool, htInn]) then + Exit; + // Check if AI can build house (if is house blocked [by script] ignore it) + if GetHousesToUnlock(aHT, HTArr) AND ((aUnlockProcedureAllowed) OR (Length(HTArr) = 1)) then + begin + MaterialShortage := (MaxPlace <= 0) OR (not aIgnoreWareReserves AND (fWoodShortage OR fTrunkShortage OR fStoneShortage OR fGoldShortage)); + IgnoreTreesInPlan := not ((Length(HTArr) > 1) OR MaterialShortage); + for K := Low(HTArr) to High(HTArr) do + if (K <> High(HTArr)) OR (Length(HTArr) = 1) OR (fPlanner.PlannedHouses[ HTArr[K] ].Count = 0) then + begin + HouseReservation := MaterialShortage OR (K <> High(HTArr)); + IgnoreExistingPlans := (Length(HTArr) = 1) AND MaterialShortage AND not (aHT in [htWoodcutters, htGoldMine, htIronMine, htCoalMine]); + if (K <> High(HTArr)) then + NodePrio := NODE_PRIO_RoadsReservation // House is blocked, prio is low + else if (Length(HTArr) = 1) then + NodePrio := NODE_PRIO_Roads // House is unlocked, prio is high + else + NodePrio := NODE_PRIO_RoadsUnlockHouse; // House is unlocked and its construction will unlock another house, prio is TOP + Result := BuildHouse(IgnoreTreesInPlan, HouseReservation, IgnoreExistingPlans, HTArr[K], NodePrio); + RequiredHouses[ HTArr[K] ] := 0; + end; + end + else if aUnlockProcedureAllowed AND TryUnlockByRnd(aHT) then // There is scripted unlock order -> try to place random house (it works 100% for any crazy combinations which will scripters bring) + begin + Result := BuildHouse(False, False, False, aHT); + RequiredHouses[aHT] := 0; + end; + end; + + + function SelectHouse(const aSetOfWare: TSetOfWare): Boolean; + const + FRACTION_COEF = 20.0; + var + Output: Boolean; + K: Integer; + Priority: Single; + HT: TKMHouseType; + Ware, WT, POM_WT: TKMWareType; + WareOrder: array[0..10] of TKMWareType; + WarePriority: array[0..10] of Single; + begin + Output := False; + // Basic producing houses (secure resources for building) + for K := Low(WareOrder) to High(WareOrder) do + begin + WareOrder[K] := wtNone; + WarePriority[K] := 1000000; // Doesn't have to be initialized but in this case compilation throws warning + end; + // Find the most required house to be build + for Ware in aSetOfWare do + begin + WT := Ware; + if (RequiredHouses[ PRODUCTION_WARE2HOUSE[WT] ] > 0) then + begin + Priority := fPredictor.WareBalance[WT].Exhaustion - fPredictor.WareBalance[WT].Fraction * AI_Par[BUILDER_ChHTB_FractionCoef] + - Ord(PRODUCTION_WARE2HOUSE[WT] = htBakery) * 1000; + for K := Low(WareOrder) to High(WareOrder) do + if (WT = wtNone) then + break + else if (WareOrder[K] = wtNone) OR (Priority < WarePriority[K]) then // Buble sort is best for few elements + begin + POM_WT := WT; + WT := WareOrder[K]; + WareOrder[K] := POM_WT; + SwapFloat(Priority, WarePriority[K]); + end; + end; + end; + // Try build required houses + for K := Low(WareOrder) to High(WareOrder) do + begin + if (WareOrder[K] = wtNone) then + break; + HT := PRODUCTION_WARE2HOUSE[ WareOrder[K] ]; + if (RequiredHouses[HT] <= 0) then // wtLeather and wtPig require the same building so avoid to place 2 houses at once + Continue; + // Farms and wineyards should be placed ASAP because fields may change evaluation of terrain and change tpBuild status of surrouding tiles! + case AddToConstruction(HT, HT in [htFarm, htVineyard], False) of + csNoNodeAvailable: break; + csHouseReservation, csRemoveTreeProcedure: Output := True; + csHousePlaced: + begin + Output := True; + MaxPlans := MaxPlans - 1; + MaxPlace := MaxPlace - 1; + if (MaxPlans <= 0) then + Break; + end; + csNoPlaceCanBeFound: + begin + if (HT in [htIronMine, htGoldMine, htCoalMine]) then + fPredictor.MarkExhaustedMine(HT); + end + //csCannotPlaceHouse: + else + begin + + end; + end; + RequiredHouses[HT] := 0; // Make sure that next node will not scan this house in this tick + end; + Result := Output; + end; + + procedure SelectHouseBySetOrder(); + var + AllowStoneReservation: Boolean; + WT: TKMWareType; + HT: TKMHouseType; + begin + // Find the most required house to be build - use specific order + for WT in BUILD_ORDER_WARE do + begin + HT := PRODUCTION_WARE2HOUSE[WT]; + if (RequiredHouses[HT] > 0) AND (fPredictor.WareBalance[WT].Exhaustion < 30) then + begin + // Make sure that next cycle will not scan this house in this tick + RequiredHouses[HT] := 0; + + AllowStoneReservation := not fStoneShortage OR ( (WT = wtStone) AND (fPlanner.PlannedHouses[htSchool].Completed = 0) ); + // Try build required houses + case AddToConstruction(HT, AllowStoneReservation, AllowStoneReservation) of + csHousePlaced: + begin + MaxPlans := 0; // This house is critical so dont plan anything else + Exit; + end; + csNoPlaceCanBeFound: + begin + if (HT in [htIronMine, htGoldMine, htCoalMine]) then + fPredictor.MarkExhaustedMine(HT); + end + end; + end; + end; + end; + + procedure CheckHouseReservation(); + const + // Reservation sets must be able to unlock specific houses!!! + RESERVATION_FullSet: array[0..28] of TKMHouseType = ( + htSchool, htInn, htQuarry, htMarket, htWoodcutters, htSawmill, // Inn because of old unlock order + htGoldMine, htCoalMine, htMetallurgists, htBarracks, + htFarm, htMill, htBakery, htSwine, htButchers, htStables, htFishermans, + htIronMine, htIronSmithy, htArmorSmithy, htWeaponSmithy, + htTannery, htArmorWorkshop, htWeaponWorkshop, + htSiegeWorkshop, htTownHall, htVineyard, htStore, htWatchTower + ); + // If RESERVATION_FullSet was changed, then the following indexes must be changed too! + STONE_SHORTAGE_IDX = 2; + TRUNK_SHORTAGE_IDX = 4; + WOOD_SHORTAGE_IDX = 8; + GOLD_SHORTAGE_IDX = 8; + FULL_SET = 28; + var + K,L, MinIdx, MaxIdx, Overflow: Integer; + Gain, BestGain: Single; + HT, BestHT: TKMHouseType; + ReservationsCntArr: array[HOUSE_MIN..HOUSE_MAX] of Word; + begin + MinIdx := 0; + FillChar(ReservationsCntArr, SizeOf(ReservationsCntArr), #0); + if fStoneShortage then + MaxIdx := STONE_SHORTAGE_IDX + else if fWoodShortage then + begin + MaxIdx := WOOD_SHORTAGE_IDX; + if (fPlanner.PlannedHouses[htSawmill].Completed = 0) then + MinIdx := TRUNK_SHORTAGE_IDX+1; + end + else if fTrunkShortage AND (MaxPlace < 3) then // Allow to place something if MaxPlace is higher + MaxIdx := TRUNK_SHORTAGE_IDX + else if fGoldShortage then + MaxIdx := GOLD_SHORTAGE_IDX + else + MaxIdx := FULL_SET; + + for K := MinIdx to MaxIdx do + begin + HT := RESERVATION_FullSet[K]; + for L := 0 to fPlanner.PlannedHouses[HT].Count - 1 do + with fPlanner.PlannedHouses[HT].Plans[L] do + if not Placed AND (HouseReservation OR RemoveTreeInPlanProcedure) then + Inc(ReservationsCntArr[HT], 1); + end; + + Overflow := 0; + while (MaxPlace > 0) AND (Overflow <= MaxIdx) do + begin + Overflow := Overflow + 1; + BestHT := htNone; + BestGain := -1e10; + for K := MinIdx to MaxIdx do + if (ReservationsCntArr[ RESERVATION_FullSet[K] ] > 0) then + begin + HT := RESERVATION_FullSet[K]; + // Build first house with highest prio + //if (K <= GOLD_SHORTAGE_IDX) AND (fPlanner.PlannedHouses[HT].Completed = 0) AND (fPlanner.PlannedHouses[HT].UnderConstruction = 0) then + if (fPlanner.PlannedHouses[HT].Completed = 0) AND (fPlanner.PlannedHouses[HT].UnderConstruction = 0) then + begin + BestHT := HT; + break; + end; + // Otherwise ignore houses + Gain := ReservationsCntArr[HT] * 2 - K; + if (Gain > BestGain) then + begin + BestHT := HT; + BestGain := Gain; + end; + end; + if (BestHT = htNone) then + Exit; + if (csHousePlaced = AddToConstruction(BestHT,False,True)) then + begin + MaxPlace := MaxPlace - 1; + RequiredHouses[BestHT] := 0; + end; + ReservationsCntArr[BestHT] := 0; // Dont place more than 1 reserved house type in 1 tick + end; + end; + + function GetChopOnlyCnt(): Word; + var + K: Integer; + begin + Result := 0; + for K := 0 to fPlanner.PlannedHouses[htWoodcutters].Count - 1 do + if fPlanner.PlannedHouses[htWoodcutters].Plans[K].ChopOnly then + Result := Result + 1; + end; + +const + BUILD_TOWER_DELAY = 17 * 60 * 10; // 17 minutes before end of peace + MINIMAL_TOWER_DELAY = 50 * 60 * 10; // Towers will not be build before 50 minute +var + TrunkBalance: Single; + HT: TKMHouseType; +begin + // Get shortage info + CheckBasicMaterials(MaxPlans, MaxPlace, TrunkBalance, aTick); + + RequiredHouses := fPredictor.RequiredHouses; + + // Dont build more than 3 quarry at once if there is not quarry and stone shortage is possible + RequiredHouses[htQuarry] := RequiredHouses[htQuarry] * Ord(not (fStoneShortage AND (fPlanner.PlannedHouses[htQuarry].Completed < 3) AND (fPlanner.PlannedHouses[htQuarry].UnderConstruction > 2))); + if fStoneShortage AND (RequiredHouses[htQuarry] > 0) AND (fPlanner.PlannedHouses[htSchool].Completed > 0) then + begin + RequiredHouses[htQuarry] := 0; + if (AddToConstruction(htQuarry, True, True) = csHousePlaced) then + MaxPlans := MaxPlans - 1; + end; + + // Dont try to place wine if we are out of wood + RequiredHouses[htVineyard] := RequiredHouses[htVineyard] * Ord(not(fTrunkShortage OR (MaxPlace < 3))); + + // Find place for chop-only woodcutters when we start to be out of wood + if ((AI_Par[BUILDER_ChHTB_TrunkBalance] - TrunkBalance) / Max(1,AI_Par[BUILDER_ChHTB_TrunkFactor]) - GetChopOnlyCnt() > 0) then + fPlanner.FindForestAround(KMPOINT_ZERO, True); + + // Build woodcutter when is forest near new house (or when is woodcutter destroyed but this is not primarly intended) + HT := htWoodcutters; + if (gHands[fOwner].Stats.GetHouseTotal(HT) < fPlanner.PlannedHouses[HT].Count) + AND not fStoneShortage + AND ((fTrunkShortage OR not fGoldShortage) AND not fWoodShortage) + AND (AddToConstruction(HT, True, True) = csHousePlaced) then + begin + MaxPlans := MaxPlans - 1; + RequiredHouses[htWoodcutters] := 0; + end; + + if (MaxPlace > 0) then + CheckHouseReservation(); + if (MaxPlans <= 0) then + Exit; + + // Basic houses (for city management) + for HT in BASIC_HOUSES do + if (RequiredHouses[HT] > 0) AND (AddToConstruction(HT, True, True) = csHousePlaced) then + begin + MaxPlans := MaxPlans - 1; + if (MaxPlans <= 0) then + Exit; + end; + + // The most important houses for city production which will be soon depleted + SelectHouseBySetOrder(); + if (MaxPlans <= 0) then + Exit; + + // Watchtowers + HT := htWatchTower; + if (not Planner.DefenceTowersPlanned OR (gHands[fOwner].Stats.GetHouseTotal(HT) < Planner.PlannedHouses[HT].Count)) + AND (aTick + BUILD_TOWER_DELAY > gGame.Options.Peacetime * 600) + AND (aTick > MINIMAL_TOWER_DELAY) + AND (AddToConstruction(HT, True, True) = csHousePlaced) then + begin + MaxPlans := MaxPlans - 1; + if (MaxPlans <= 0) then + Exit; + end; + + // All other houses (food and weapon production) + houses which will be required in final city size + SelectHouse(ALL_WARE); +end; + + +procedure TKMCityBuilder.CreateShortcuts(); +const + MAX_SHORTCUTS_PER_HOUSE_TYPE = 2; + MAX_DISTANCE_TO_ALL_HOUSES = 10; + MAX_WORKERS_FOR_NODE = 4; + HOUSE_CONNECTION: array[HOUSE_MIN..HOUSE_MAX] of set of TKMHouseType = ( + {htArmorSmithy} [ htIronSmithy, htCoalMine, htBarracks ], + {htArmorWorkshop} [ htTannery, htBarracks ], + {htBakery} [ htInn, htStore, htMill ], + {htBarracks} [ htSchool ], + {htButchers} [ htInn, htStore, htSwine ], + {htCoalMine} [ htNone ], + {htFarm} [ htNone ], + {htFisherHut} [ htNone ], + {htGoldMine} [ htMetallurgists ], + {htInn} [ htStore, htInn ], + {htIronMine} [ htIronSmithy ], + {htIronSmithy} [ htCoalMine, htWeaponSmithy, htArmorSmithy ], + {htMarketplace} [ htStore ], + {htMetallurgists} [ htSchool, htGoldMine, htCoalMine ], + {htMill} [ htFarm, htBakery ], + {htQuary} [ htStore ], + {htSawmill} [ htArmorWorkshop, htStore ], + {htSchool} [ htMetallurgists, htStore, htBarracks ], + {htSiegeWorkshop} [ htIronSmithy, htSawmill, htStore ], + {htStables} [ htFarm, htBarracks ], + {htStore} [ htInn, htBarracks, htSchool ], + {htSwine} [ htFarm, htButchers ], + {htTannery} [ htArmorWorkshop, htSwine ], + {htTownHall} [ htMetallurgists, htStore ], + {htWatchTower} [ htNone ], + {htWeaponSmithy} [ htIronSmithy, htCoalMine, htBarracks ], + {htWeaponWorkshop} [ htSawmill, htBarracks ], + {htVineyard} [ htInn ], + {htWoodcutters} [ htNone ] + ); + + function FindAndMarkNewHouse(var aHT: TKMHouseType; var aLoc: TKMPoint): Boolean; + var + K: Integer; + HT: TKMHouseType; + begin + Result := True; + for HT := Low(fPlanner.PlannedHouses) to High(fPlanner.PlannedHouses) do + begin + if (HT = htWoodcutters) then + Continue; + with fPlanner.PlannedHouses[HT] do + for K := 0 to Count - 1 do + if Plans[K].Placed AND not Plans[K].ShortcutsCompleted then + begin + Plans[K].ShortcutsCompleted := True; + aLoc := KMPointBelow(Plans[K].Loc); + aHT := HT; + Exit; + end; + end; + Result := False; + end; + + // Plan road from aBaseLoc to points in aLocs + procedure PlanRoad(var aNode: TBuildNode; aBaseLoc: TKMPoint; var aLocs: TKMPointTagList; aAllLocs: Boolean = False); + var + K, L, cnt: Integer; + Road: TKMPointList; + begin + if (aLocs.Count > 0) then + begin + if not aAllLocs then // Sort in case that we want to pick just the closest points + aLocs.SortByTag(); + Road := TKMPointList.Create(); + try + cnt := 0; + for K := 0 to aLocs.Count-1 do + begin + Road.Clear(); + // Plan road + if fPlanner.GetRoadBetweenPoints(aLocs.Items[K], aBaseLoc, Road, aNode.FieldType) then + begin + // Copy new road to build node (1 node will have all roads -> shortcuts will not take + for L := 0 to Road.Count - 1 do + aNode.FieldList.Add(Road.Items[L]); + cnt := cnt + 1; + LockNode(aNode); // Lock must be here because next shortcut will see road reservation -> avoid to build 2 road next to each other + if not aAllLocs AND (cnt = MAX_SHORTCUTS_PER_HOUSE_TYPE) then + break; + end; + end; + finally + Road.Free; + end; + with aNode do + if (FieldList.Count > 0) then + begin + Active := True; + Priority := NODE_PRIO_Shortcuts; + RemoveTreesMode := False; + ShortcutMode := True; + MaxReqWorkers := Round(AI_Par[BUILDER_CreateShortcuts_MaxWork]);//MAX_WORKERS_FOR_NODE; + RequiredWorkers := Min(MaxReqWorkers, FieldList.Count); + CenterPoint := FieldList.Items[0]; + end; + end; + end; + +var + K,L,NodeIdx, Dist: Integer; + HT, BaseHT: TKMHouseType; + BaseLoc: TKMPoint; + PlannedHouses: TPlannedHousesArray; + Locs: TKMPointTagList; +begin + // Don't build shortcuts with low Exhaustion + if (fPredictor.WareBalance[wtStone].Exhaustion < 60) + //OR (fPredictor.WareBalance[wtWood].Exhaustion < 60) + OR (fPredictor.WareBalance[wtGold].Exhaustion < 60) + OR (gHands[fOwner].Stats.GetHouseQty(htSchool) = 0) + OR (gHands[fOwner].Stats.GetUnitQty(utBuilder) = 0) then + Exit; + + if Length(fBuildNodes) = 0 then Exit; + + // Check if there is free build node + for NodeIdx := Low(fBuildNodes) to High(fBuildNodes) do + if not fBuildNodes[NodeIdx].Active then + Break; + if fBuildNodes[ Min(High(fBuildNodes),NodeIdx) ].Active then + Exit; + + // Find house which was not checked for shortcuts + if not FindAndMarkNewHouse(BaseHT, BaseLoc) then + Exit; + + // Special case for entrance of Store and Barrack + if (BaseHT = htStore) OR (BaseHT = htBarracks) then + if (BaseLoc.Y < gTerrain.MapY - 1) then + for K := BaseLoc.X-1 to BaseLoc.X+1 do + begin + gAIFields.Influences.AvoidBuilding[BaseLoc.Y+1, K] := 255; + if gHands[fOwner].CanAddFieldPlan(KMPoint(K, BaseLoc.Y+1) , ftRoad) then + gHands[fOwner].Constructions.FieldworksList.AddField(KMPoint(K, BaseLoc.Y+1) , ftRoad); + end; + + // Find houses which should be connected + PlannedHouses := fPlanner.PlannedHouses; + Locs := TKMPointTagList.Create(); + HT := htNone; // For compiler + try + // Create basic connection to houses which are part of specific distribution network + for HT in HOUSE_CONNECTION[BaseHT] do + begin + if (HT = htNone) then + Break; + + Locs.Clear(); + for L := 0 to PlannedHouses[HT].Count - 1 do + with PlannedHouses[HT].Plans[L] do + if Placed then + Locs.Add( KMPointBelow(Loc), KMDistanceAbs(Loc, BaseLoc) ); + PlanRoad(fBuildNodes[NodeIdx], BaseLoc, Locs, False); + end; + + // Create additional shortcuts to closest houses + Locs.Clear(); + if (HT <> htNone) then + for HT := Low(PlannedHouses) to High(PlannedHouses) do + begin + if (HT = htWoodcutters) then + Continue; + for K := 0 to PlannedHouses[HT].Count - 1 do + with PlannedHouses[HT].Plans[K] do + if Placed then + begin + Dist := KMDistanceAbs(BaseLoc, KMPointBelow(Loc)); + if (Dist <> 0) AND (Dist < MAX_DISTANCE_TO_ALL_HOUSES) then + Locs.Add( KMPointBelow(Loc), Dist ); + end; + end; + PlanRoad(fBuildNodes[NodeIdx], BaseLoc, Locs, True); + finally + Locs.Free; + end; +end; + + +procedure TKMCityBuilder.LogStatus(var aBalanceText: UnicodeString); +const + COLOR_WHITE = '[$FFFFFF]'; + COLOR_RED = '[$0000FF]'; + COLOR_YELLOW = '[$00FFFF]'; + COLOR_GREEN = '[$00FF00]'; +var + K, cnt, Reservation, RemoveTrees, PlanPlaced, Construction: Integer; + HT: TKMHouseType; + Text: String; +begin + // Construction + aBalanceText := aBalanceText + '|Construction: '; + cnt := 1; + for HT := Low(fPlanner.PlannedHouses) to High(fPlanner.PlannedHouses) do + begin + Reservation := 0; + RemoveTrees := 0; + PlanPlaced := 0; + Construction := 0; + for K := 0 to fPlanner.PlannedHouses[HT].Count - 1 do + with fPlanner.PlannedHouses[HT].Plans[K] do + begin + if not Placed then + begin + Inc(Reservation, Ord(HouseReservation)); + Inc(Reservation, Ord(RemoveTreeInPlanProcedure)); + Inc(Reservation, Ord(not HouseReservation AND not RemoveTreeInPlanProcedure)); + end + else if (House <> nil) AND not (House.IsComplete) then + Inc(Construction,1); + end; + if ((Reservation + RemoveTrees + PlanPlaced + Construction) > 0) then + begin + Cnt := (Cnt + 1) mod 6; + if (Cnt = 0) then + aBalanceText := aBalanceText + '|'; + Text := ''; + if (Reservation > 0) then Text := Format('%s%dx Reservation ' ,[Text, Reservation]); + if (RemoveTrees > 0) then Text := Format('%s%dx RemoveTrees ' ,[Text, RemoveTrees]); + if (PlanPlaced > 0) then Text := Format('%s%dx PlanPlaced ' ,[Text, PlanPlaced]); + if (Construction > 0) then Text := Format('%s%dx Construction ',[Text, Construction]); + aBalanceText := Format( '%s %s (%s),', [aBalanceText, gRes.Houses[HT].HouseName, Text.SubString(0,Length(Text)-1)] ); + end; + end; + // Active nodes + cnt := 0; + for K := Low(fBuildNodes) to High(fBuildNodes) do + Inc(cnt, Ord(fBuildNodes[K].Active)); + aBalanceText := Format('%s|Active nodes: %d, Free workers: %d',[aBalanceText,cnt,fFreeWorkersCnt]); + // Material shortage + Text := ''; + if fStoneShortage then Text := Text + ' Stone,'; + if fTrunkShortage then Text := Text + ' Trunk,'; + if fWoodShortage then Text := Text + ' Wood,'; + if fGoldShortage then Text := Text + ' Gold,'; + if (Length(Text) > 0) then + aBalanceText := Format('%s|Shortage:%s%s[]',[aBalanceText,COLOR_RED,Text.SubString(0,Length(Text)-1)]); + {$IFDEF DEBUG_NewAI} + aBalanceText := Format('%s|Time Plan Roads: %d',[aBalanceText,fTimePlanRoads]); + {$ENDIF} + // Planner + fPlanner.LogStatus(aBalanceText); +end; + + +procedure TKMCityBuilder.Paint(); +var + K,L: Integer; + Color: Cardinal; + Point: TKMPoint; +begin +//{ + for K := 0 to gHands[fOwner].Units.Count - 1 do + with gHands[fOwner].Units[K] do + if not IsDeadOrDying then + begin + if (gHands[fOwner].Units[K] is TKMUnitSerf) AND IsIdle then + gRenderAux.Quad(Position.X, Position.Y, $44000000 OR tcBlue) + else if (gHands[fOwner].Units[K] is TKMUnitWorker) AND IsIdle then + gRenderAux.Quad(Position.X, Position.Y, $44000000 OR tcFuchsia); + end; + + Color := 0; // For compiler + for K := Low(fBuildNodes) to High(fBuildNodes) do + with fBuildNodes[K] do + if Active then + begin + case FieldType of + ftCorn: Color := $40000000 OR tcGreen; + ftWine: Color := $88000000 OR tcGreen; + ftRoad: Color := $80000000 OR tcCyan; + end; + if RemoveTreesMode then + Color := $60000000 OR tcBlue; + if ShortcutMode then + Color := $20000000 OR tcBlack; + for L := 0 to FieldList.Count - 1 do + begin + Point := FieldList.Items[L]; + gRenderAux.Quad(Point.X, Point.Y, Color); + end; + end; +//} +end; + + +{ +// Remove units when is game in GA mode (avoid to place houses at unit) +if GA_PLANNER then + for I := 0 to gHands[fOwner].Units.Count - 1 do + begin + U := gHands[fOwner].Units[I]; + if (U <> nil) then + U.KillUnit(fOwner, False, False); + end; + +function BuildHouse_GA_MODE(aHT: TKMHouseType): TConstructionState; + +// Build house na GA mode (for Runner) +// aHT: TKMHouseType = type of house +// Result: TConstructionState = state of construction +function TKMCityBuilder.BuildHouse_GA_MODE(aHT: TKMHouseType): TConstructionState; +var + FieldType: TKMFieldType; + FieldList: TKMPointList; + + procedure AddField(); + var + I: Integer; + begin + for I := FieldList.Count - 1 downto 0 do + case FieldType of + ftRoad: + begin + gTerrain.SetRoad(FieldList.Items[I], fOwner); + gTerrain.FlattenTerrain(FieldList.Items[I]); + if gMapElements[ gTerrain.Land^[ FieldList.Items[I].Y,FieldList.Items[I].X ].Obj ].WineOrCorn then + gTerrain.RemoveObject(FieldList.Items[I]); + end; + ftCorn,ftWine: + begin + gTerrain.SetField(FieldList.Items[I], fOwner, FieldType); + gAIFields.Influences.AvoidBuilding[FieldList.Items[I].Y, FieldList.Items[I].X] := AVOID_BUILDING_NODE_LOCK_FIELD; + end; + end; + end; + +var + Output: Boolean; + HouseIdx: Integer; + Loc: TKMPoint; + HPlan: TKMHousePlan; +begin + Result := csCannotPlaceHouse; + Output := False; + FieldList := TKMPointList.Create; + try + if fPlanner.GetHousePlan(False, False, aHT, Loc, HouseIdx) then + begin + Output := True; + gHands[fOwner].AddHousePlan(aHT, Loc); // Place house plan + if fPlanner.GetRoadToHouse(aHT, HouseIdx, FieldList, FieldType) then // Place roads + AddField(); + if fPlanner.GetFieldToHouse(aHT, HouseIdx, FieldList, FieldType) then // Place fields + AddField(); + if gHands[fOwner].Constructions.HousePlanList.TryGetPlan(Loc, HPlan) then // Remove house plan (it must be done because of road planning) + begin + gHands[fOwner].Constructions.HousePlanList.RemPlan(Loc); + gHands[fOwner].Stats.HousePlanRemoved(aHT); + end; + gHands[fOwner].AddHouse(aHT, Loc.X, Loc.Y, True); // Place house + end; + finally + FieldList.Free; + end; + if Output then + Result := csHousePlaced; +end; + + +var + GA_BUILDER_WORKER_COEF : Single = 8.516485214; + GA_BUILDER_EXHAUSTION_ARR: array[WARE_MIN..WARE_MAX] of Single = ( + 1.597312808, 2.605776548, 6.652187347, 4.734027863, 4.655752659, 2.305694342, 3.052431107, 2.866589546, 0.3297367692, 4.905310631, 4.637497902, 1.792099953, 1.758574486, 8.000164986, 4.496774197, 9.744778633, 8.297982216, 7.661552429, 1.597817659, 4.179779053, 1.837774515, 9.829838753, 5.807341576, 1.473491907, 5.093095303, 0.7045341134, 2.986746073, 1.279728413 + ); + GA_BUILDER_FRACTION_ARR: array[WARE_MIN..WARE_MAX] of Single = ( + 52.44208145, 97.94073486, 81.27591705, 14.42814064, 39.30894089, 23.50471687, 3.592087984, 90.95751953, 5.030199528, 14.30461979, 15.02885342, 23.04277039, 38.70484161, 34.08721161, 46.43330002, 36.89776611, 36.55716705, 61.80127335, 52.2832222, 64.24739075, 1.925330043, 89.33174133, 29.77691841, 100, 38.04268646, 88.26511383, 46.45424652, 85.67434692 + ); + // Length 30 + //GA_BUILDER_HOUSE_ARR: array[HOUSE_MIN..HOUSE_MAX] of Single = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29); + + //function ChooseHousesToBuildGA(aWorkerCnt: Integer): Boolean; + + +function TKMCityBuilder.ChooseHousesToBuildGA(aWorkerCnt: Integer): Boolean; +const + BASIC_HOUSES: set of TKMHouseType = [htSchool, htBarracks, htInn, htMarketPlace, htStore]; +var + MaxPlans: Integer; + RequiredHouses: TRequiredHousesArray; + WareBalance: TWareBalanceArray; + + + function GetHouseToUnlock(var aUnlockProcedure: Boolean; var aHT, aFollowingHouse: TKMHouseType): Boolean; + var + Output: Boolean; + initHT: TKMHouseType; + begin + Output := True; + // Repeat until is available house finded (to unlock target house) + initHT := aHT; + aFollowingHouse := htNone; + while Output AND not gHands[fOwner].Locks.HouseCanBuild(aHT) do + begin + aUnlockProcedure := True; + if gHands[fOwner].Locks.HouseBlocked[aHT] then // House is blocked -> unlock impossible + Output := False + else + begin + aFollowingHouse := aHT; + aHT := gRes.Houses[aHT].ReleasedBy; // House have to be unlocked by this house + end; + end; + // Output = False only in case that house is already under construction OR is blocked by script / settings from the map editor + Result := Output AND ( (initHT = aHT) OR (gHands[fOwner].Stats.GetHouseTotal(aHT) = 0) ); + end; + + + function AddToConstruction(aHT: TKMHouseType; aUnlockProcedureRequired: Boolean = False): TConstructionState; + var + UnlockProcedure: Boolean; + FollowingHouse: TKMHouseType; + Output: TConstructionState; + begin + Output := csCannotPlaceHouse; + UnlockProcedure := aUnlockProcedureRequired; // Unlock procedure = build house as soon as possible -> avoid to build house plan inside of tree (remove tree will take time) + // Check if AI can build house (if is house blocked [by script] ignore it) + if GetHouseToUnlock(UnlockProcedure, aHT, FollowingHouse) then + begin + if GA_PLANNER then + Output := BuildHouse_GA_MODE(aHT) + else + Output := BuildHouse(UnlockProcedure OR (aHT = htFarm), False, False, aHT); // Farms should be build as soon as possible + end + else if (FollowingHouse <> ht_None) AND (gHands[fOwner].Stats.GetHouseQty(htSchool) > 0) then // Activate house reservation (only when is first school completed) + begin + Output := BuildHouse(True, True, False, FollowingHouse); + end; + Result := Output; + end; + + procedure SelectBestHouses(); + var + I: Integer; + WT, HighWT: TKMWareType; + HighPriority: Single; + WarePriorityArr: array[WARE_MIN..WARE_MAX] of Single; + begin + for WT := Low(WarePriorityArr) to High(WarePriorityArr) do + WarePriorityArr[WT] := ( + WareBalance[WT].Fraction * GA_BUILDER_FRACTION_ARR[WT] *1000 + - WareBalance[WT].Exhaustion * GA_BUILDER_EXHAUSTION_ARR[WT] + ) * RequiredHouses[ PRODUCTION[WT] ]; + + for I := 0 to 4 do + begin + if (MaxPlans <= 0) then + Exit; + HighPriority := 0; + for WT := Low(WarePriorityArr) to High(WarePriorityArr) do + if (HighPriority < WarePriorityArr[WT]) then + begin + HighPriority := WarePriorityArr[WT]; + HighWT := WT; + end; + if (HighPriority = 0) then + Exit; + WarePriorityArr[HighWT] := 0; + // Try build required houses + case AddToConstruction( PRODUCTION[HighWT] ) of + csNoNodeAvailable: Exit; + csHouseReservation, csRemoveTreeProcedure: begin end; + csHousePlaced: + begin + MaxPlans := MaxPlans - 1; + RequiredHouses[ PRODUCTION[HighWT] ] := 0; // Make sure that next node will not scan this house in this tick + end; + csCannotPlaceHouse: + begin + RequiredHouses[ PRODUCTION[HighWT] ] := 0; // Make sure that next node will not scan this house in this tick + end; + end; + + end; + end; + + procedure CheckHouseReservation(); + var + I: Integer; + HT: TKMHouseType; + begin + for HT := Low(fPlanner.PlannedHouses) to High(fPlanner.PlannedHouses) do + for I := 0 to fPlanner.PlannedHouses[HT].Count - 1 do + with fPlanner.PlannedHouses[HT].Plans[I] do + if not Placed AND (HouseReservation OR RemoveTreeInPlanProcedure) + AND (csHousePlaced = AddToConstruction(HT)) then + begin + MaxPlans := MaxPlans - 1; + RequiredHouses[HT] := 0; + end; + end; +var + HT: TKMHouseType; +begin + RequiredHouses := fPredictor.RequiredHouses; + WareBalance := fPredictor.WareBalance; + + CheckHouseReservation(); + MaxPlans := Ceil(aWorkerCnt / GA_BUILDER_WORKER_COEF); + if (MaxPlans <= 0) then + Exit; + + // Basic houses (for city management) + for HT in BASIC_HOUSES do + if (RequiredHouses[HT] > 0) AND (AddToConstruction(HT, True) = csHousePlaced) then + if (MaxPlans <= 0) then + break; + + SelectBestHouses(); + +end; + + +function TKMCityBuilder.ChooseHousesToBuild(aMaxCnt: Integer): Boolean; +type + TSetOfWare = set of TKMWareType; +const + BASIC_HOUSES: set of TKMHouseType = [htSchool, htBarracks, htInn, htMarketPlace, htStore]; + BUILD_WARE: TSetOfWare = [wtGoldOre, wtCoal, wtGold, wtStone, wtTrunk, wtWood]; + FOOD_WARE: TSetOfWare = [wtCorn, wtFlour, wtBread, wtPig, wtSausages, wtWine, wtFish]; + WEAPON_WARE: TSetOfWare = [wtSkin, wtLeather, wtHorse, wtIronOre, wtCoal, wtSteel, wtAxe, wtBow, wtPike, wtArmor, wtShield, wtSword, wtArbalet, wtHallebard, wtMetalShield, wtMetalArmor]; +var + RequiredHouses: TRequiredHousesArray; + WareBalance: TWareBalanceArray; + + + function GetHouseToUnlock(var aUnlockProcedure: Boolean; var aHT, aFollowingHouse: TKMHouseType): Boolean; + var + Output: Boolean; + initHT: TKMHouseType; + begin + Output := True; + // Repeat until is available house finded (to unlock target house) + initHT := aHT; + aFollowingHouse := htNone; + while Output AND not gHands[fOwner].Locks.HouseCanBuild(aHT) do + begin + aUnlockProcedure := True; + if gHands[fOwner].Locks.HouseBlocked[aHT] then // House is blocked -> unlock impossible + Output := False + else + begin + aFollowingHouse := aHT; + aHT := gRes.Houses[aHT].ReleasedBy; // House have to be unlocked by this house + end; + end; + // Output = False only in case that house is already under construction OR is blocked by script / settings from the map editor + Result := Output AND ( (initHT = aHT) OR (gHands[fOwner].Stats.GetHouseTotal(aHT) = 0) ); + end; + + + function AddToConstruction(aHT: TKMHouseType; aUnlockProcedureRequired: Boolean = False): TConstructionState; + var + UnlockProcedure: Boolean; + FollowingHouse: TKMHouseType; + Output: TConstructionState; + begin + Output := csCannotPlaceHouse; + UnlockProcedure := aUnlockProcedureRequired; // Unlock procedure = build house as soon as possible -> avoid to build house plan inside of tree (remove tree will take time) + // Check if AI can build house (if is house blocked [by script] ignore it) + if GetHouseToUnlock(UnlockProcedure, aHT, FollowingHouse) then + begin + aMaxCnt := aMaxCnt - 1; + if GA_PLANNER then + Output := BuildHouse_GA_MODE(aHT) + else + Output := BuildHouse(UnlockProcedure, False, aHT); + end + else if (FollowingHouse <> ht_None) AND (gHands[fOwner].Stats.GetHouseQty(htSchool) > 0) then // Activate house reservation + begin + Output := BuildHouse(True, True, FollowingHouse); + end; + Result := Output; + end; + + function SelectHouse(const aSetOfWare: TSetOfWare): Boolean; + const + FRACTION_COEF = 3.0; + var + Output: Boolean; + I: Integer; + Priority, POM_Priority: Single; + Ware, WT, POM_WT: TKMWareType; + WareOrder: array[0..5] of TKMWareType; + WarePriority: array[0..5] of Single; + begin + Output := False; + // Basic producing houses (secure resources for building) + for I := Low(WareOrder) to High(WareOrder) do + begin + WareOrder[I] := wtNone; + WarePriority[I] := 0; // Doesn't have to be initialized but in this case compilation throws warning + end; + // Find the most required house to be build + for Ware in aSetOfWare do + begin + WT := Ware; + if (RequiredHouses[ PRODUCTION[WT] ] > 0) then + begin + Priority := WareBalance[WT].Exhaustion - WareBalance[WT].Fraction * FRACTION_COEF; + for I := Low(WareOrder) to High(WareOrder) do + if (WT = wtNone) then + break + else if (WareOrder[I] = wtNone) OR (Priority < WarePriority[I]) then // Buble sort is best for few elements + begin + POM_WT := WT; + WT := WareOrder[I]; + WareOrder[I] := POM_WT; + POM_Priority := Priority; + Priority := WarePriority[I]; + WarePriority[I] := POM_Priority; + end; + end; + end; + // Try build required houses + for I := Low(WareOrder) to High(WareOrder) do + begin + if (WareOrder[I] = wtNone) then + break; + case AddToConstruction(PRODUCTION[ WareOrder[I] ]) of + csNoNodeAvailable: break; + csHouseReservation, csRemoveTreeProcedure: Output := True; + csHousePlaced: + begin + Output := True; + aMaxCnt := aMaxCnt - 1; + if (aMaxCnt <= 0) then + break; + RequiredHouses[ PRODUCTION[ WareOrder[I] ] ] := 0; // Make sure that next node will not scan this house in this tick + end; + csCannotPlaceHouse: + begin + RequiredHouses[ PRODUCTION[ WareOrder[I] ] ] := 0; // Make sure that next node will not scan this house in this tick + //Dec(aRequiredHouses[ PRODUCTION[ WareOrder[I] ] ]); + end; + end; + end; + Result := Output; + end; + + procedure CheckHouseReservation(); + var + I: Integer; + HT: TKMHouseType; + begin + for HT := Low(fPlanner.PlannedHouses) to High(fPlanner.PlannedHouses) do + for I := 0 to fPlanner.PlannedHouses[HT].Count - 1 do + with fPlanner.PlannedHouses[HT].Plans[I] do + if not Placed AND (HouseReservation OR RemoveTreeInPlanProcedure) + AND (csHousePlaced = AddToConstruction(HT)) then + begin + aMaxCnt := aMaxCnt - 1; + RequiredHouses[HT] := 0; + end; + end; +var + Output: Boolean; + POMCoal: Integer; + HT: TKMHouseType; +begin + Output := False; + RequiredHouses := fPredictor.RequiredHouses; + WareBalance := fPredictor.WareBalance; + + CheckHouseReservation(); + if (aMaxCnt <= 0) then + Exit; + + // Basic houses (for city management) + for HT in BASIC_HOUSES do + if (RequiredHouses[HT] > 0) AND (AddToConstruction(HT, True) = csHousePlaced) then + begin + Output := True; + if (aMaxCnt <= 0) then + break; + end; + + WareBalance[wtTrunk].Fraction := Max(0, RequiredHouses[htWoodcutters] - gHands[fOwner].Stats.GetHouseQty(htWoodcutters) - 4); + POMCoal := RequiredHouses[htCoalMine]; // Coal is used by resource (Gold) and by weapon division -> extract just Gold requirements + RequiredHouses[htCoalMine] := Max(0,gHands[fOwner].Stats.GetHouseTotal(htGoldMine)-gHands[fOwner].Stats.GetHouseTotal(htCoalMine)); + RequiredHouses[htWoodcutters] := Max(0,RequiredHouses[htWoodcutters] - Round(Ord(WareBalance[wtGold].Exhaustion < 20) * RequiredHouses[htWoodcutters] * 0.5)); + if (aMaxCnt > 0) AND SelectHouse(BUILD_WARE) then + Output := True; + + // Make sure that gold will be produced (stones and wood are fines because of initial influence and order of construction) + //if (gHands[fOwner].Stats.GetWareBalance(wtWood) < 10) AND (WareBalance[wtGold].Exhaustion < 20) then + if (gHands[fOwner].Stats.GetWareBalance(wtWood) < 10) then + Exit; + + // Now return coal count back to original values + WareBalance[wtCoal].Fraction := (gHands[fOwner].Stats.GetHouseTotal(htCoalMine) - RequiredHouses[htCoalMine]) / POMCoal; + RequiredHouses[htCoalMine] := POMCoal; + if (aMaxCnt > 0) then + begin + Output := SelectHouse(FOOD_WARE); + SelectHouse(WEAPON_WARE); + SelectHouse(FOOD_WARE); + end; + + Result := Output; +end; + +procedure TKMCityBuilder.UpdateBuildNode(var aNode: TBuildNode); + function IsPlan(aPoint: TKMPoint; aLock: TKMTileLock; aField: TKMFieldType): Boolean; + begin + Result := (gHands[fOwner].Constructions.FieldworksList.HasField(aPoint) = aField) + OR (gTerrain.Land^[aPoint.Y, aPoint.X].TileLock = aLock); + end; + function IsCompletedRoad(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsWalkableRoad(aPoint); + end; + function IsCompletedField(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsCornField(aPoint); + end; + function IsCompletedWine(aPoint: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsWineField(aPoint); + end; + function IsRoad(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedRoad(aPoint) OR IsPlan(aPoint, tlRoadWork, ftRoad); + end; + function IsCornField(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedField(aPoint) OR IsPlan(aPoint, tlFieldWork, ftCorn); + end; + function IsWineField(aPoint: TKMPoint): Boolean; + begin + Result := IsCompletedWine(aPoint) OR IsPlan(aPoint, tlFieldWork, ftWine); + end; + + function BuildField(aIdx: Integer; aFieldType: TKMFieldType): Boolean; + var + Output: Boolean; + begin + Output := False; + if gHands[fOwner].CanAddFieldPlan(aNode.FieldList.Items[aIdx], aFieldType) then + begin + gHands[fOwner].Constructions.FieldworksList.AddField(aNode.FieldList.Items[aIdx], aFieldType); + aNode.FreeWorkers := aNode.FreeWorkers - 1; + Output := True; + end; + Result := Output; + end; + + // Build roads + procedure BuildRoad(); + var + I: Integer; + begin + with aNode do + begin + // Remove elements of exist road from list + for I := FieldList.Count - 1 downto 0 do + if IsCompletedRoad(FieldList.Items[I]) then + begin + UnlockPointOfNode(FieldList.Items[I]); + FieldList.Delete(I); + end + else + break; + if (FieldList.Count = 0) then + begin + Active := False; + Exit; + end; + RequiredWorkers := FieldList.Count; + // Build road / check road plans / replace missing parts / reconnect road when is no more possible to place plan + for I := FieldList.Count - 1 downto 0 do + begin + // Does we have free workers? + if (FreeWorkers <= 0) then + break; + // Is there already road / plan / work in progress? + if IsRoad(FieldList.Items[I]) then + begin + FreeWorkers := FreeWorkers - 1; + CenterPoint := FieldList.Items[I]; // Actualize center point (distribution of workers by distance) + end + // When cannot place new plan try find another way by calling pathfinding + else if not BuildField(I, ftRoad) then + begin + // If is not possible to connect 2 points by road destroy node + if not fPlanner.GetRoadBetweenPoints(CenterPoint, FieldList.Items[0], FieldList, FieldType) then + begin + FieldList.Clear; + Active := False; + end; + LockNode(aNode); + RequiredWorkers := FieldList.Count; + Exit; // Node will be updated in next calling + end; + end; + end; + end; + + // Build Wine or Corn fields + procedure BuildFields(); + var + I,K: Integer; + begin + with aNode do + begin + RequiredWorkers := FieldList.Count; + for I := 0 to FieldList.Count - 1 do + begin + if (FreeWorkers <= 0) then + Exit; + // Check if field already exists ... + if ((FieldType = ftWine) AND (IsCompletedField(FieldList.Items[I]))) + OR ((FieldType = ftCorn) AND (IsCompletedWine(FieldList.Items[I]))) then + begin + RequiredWorkers := RequiredWorkers - 1; + end + // ... or if is plan placed + else if (IsPlan(FieldList.Items[I], tlFieldWork, FieldType)) then + FreeWorkers := FreeWorkers - 1 + // ... else try build it + else + BuildField(I, FieldType); + // When node reached all plans disable it + if (RequiredWorkers <= 0) OR (I = FieldList.Count-1) then + begin + for K := 0 to FieldList.Count-1 do + if ((FieldType = ftWine) AND (IsCornField(FieldList.Items[I]))) + OR ((FieldType = ftCorn) AND (IsWineField(FieldList.Items[I]))) then + UnlockPointOfNode(FieldList.Items[K]); + FieldList.Clear; + Active := False; + end; + end; + end; + end; + + // Remove trees or Wine / Corn fields which block placing house plan + procedure RemoveObstaclesInPlan(); + var + I: Integer; + begin + with aNode do + begin + // Finish node + if (FieldList.Count = 0) then + begin + Active := False; + fPlanner.PlannedHouses[ResponsibleHouseType,ResponsibleHouseIdx].RemoveTreeInPlanProcedure := False; + UnlockHouseLoc(ResponsibleHouseType, fPlanner.PlannedHouses[ResponsibleHouseType,ResponsibleHouseIdx].Loc); + Exit; + end; + RequiredWorkers := FieldList.Count; + for I := FieldList.Count - 1 downto 0 do + begin + if (FreeWorkers <= 0) then + Exit; + // Detect obstacles in house plan + if gTerrain.ObjectIsChopableTree(FieldList.Items[I], [caAge1,caAge2,caAge3,caAgeFull]) then + begin + // Check if is wine plan already placed + if IsPlan(FieldList.Items[I], tlFieldWork, ftWine) then + begin + end + // If we cannot remove tree by placing wineyard remove point from list + else if not BuildField(I, ftWine) then + FieldList.Delete(I); + end + // If is plan blocked by fields which could be compensated by road do it + else if IsCompletedWine(FieldList.Items[I]) OR IsCompletedField(FieldList.Items[I]) OR IsRoad(FieldList.Items[I]) then + begin + if IsCompletedRoad(FieldList.Items[I]) then + FieldList.Delete(I) // Now can be item [I] deleted + // Else try place road plan or delete point + else if not IsPlan(FieldList.Items[I], tlRoadWork, ftRoad) then + begin + // Delete item [I] only in case that we cannot place road plan (point must be removed only in moment when is road completed) + if not BuildField(I, ftRoad) then + FieldList.Delete(I); + end; + end + // Tree could not be cutted down + else + begin + FieldList.Delete(I); + RequiredWorkers := RequiredWorkers - 1; + end; + end; + end; + end; + +begin + // Build procedures are split because of quite complex algorithm (or can be merged into mess) + if aNode.RemoveTreesMode then + RemoveObstaclesInPlan() + else + case aNode.FieldType of + ftRoad: BuildRoad(); + ftWine, ftCorn: BuildFields(); + else + begin + end; + end; + if aNode.Active then + aNode.RequiredWorkers := Min(aNode.MaxReqWorkers, aNode.RequiredWorkers); +end; +//} + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_CityManagement.pas b/vendor/kam_remake/src/ai/newAI/KM_CityManagement.pas new file mode 100644 index 0000000..867c1ea --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_CityManagement.pas @@ -0,0 +1,1131 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_CityManagement; +{$I KaM_Remake.inc} +interface +uses + Math, SysUtils, KM_Defaults, KM_CommonClasses, KM_Points, + KM_AISetup, KM_ResHouses, KM_ResUnits, KM_ResTypes, KM_HandStats, KM_HouseCollection, + KM_CityPredictor, KM_CityBuilder, KM_CityPlanner, KM_AIArmyEvaluation, KM_AIParameters; + +type + TKMWarfareArr = array[WARFARE_MIN..WARFARE_MAX] of record + Available, Required: Integer; + Fraction: Single; + end; + TKMWarriorsDemands = array[WARRIOR_EQUIPABLE_BARRACKS_MIN..WARRIOR_EQUIPABLE_BARRACKS_MAX] of Integer; + + TKMCityManagement = class + private + fOwner: TKMHandID; + fUnitReqCnt: Word; + fSetup: TKMHandAISetup; + + fBuilder: TKMCityBuilder; + fPredictor: TKMCityPredictor; + + fRequiredWeapons: TKMWarfareArr; + fWarriorsDemands: TKMWarriorsDemands; + + fBalanceText{, fUnitText}: UnicodeString; + + procedure CheckUnitCount(aTick: Cardinal); + procedure CheckMarketplaces(); + procedure CheckStoreWares(aTick: Cardinal); + procedure CheckExhaustedHouses(); + procedure CheckAutoRepair(); + procedure CheckWareDistribution(); + + procedure WeaponsBalance(); + procedure OrderWeapons(); + + public + constructor Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + procedure AfterMissionInit(); + procedure OwnerUpdate(aPlayer: TKMHandID); + + property RequiredUnitsCnt: Word read fUnitReqCnt; + property Builder: TKMCityBuilder read fBuilder write fBuilder; + property Predictor: TKMCityPredictor read fPredictor; + property WarriorsDemands: TKMWarriorsDemands read fWarriorsDemands; + property BalanceText: UnicodeString read fBalanceText; + + procedure UpdateState(aTick: Cardinal); + procedure LogStatus(var aBalanceText: UnicodeString); + + end; + + +implementation +uses + Classes, KM_Game, KM_Houses, KM_HouseSchool, KM_HandsCollection, KM_Hand, KM_Resource, KM_HouseStore, + KM_AIFields, KM_Units, KM_UnitsCollection, KM_HouseMarket, KM_DevPerfLog, KM_DevPerfLogTypes, + KM_HandTypes; + + +{ TKMCityManagement } +constructor TKMCityManagement.Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); +begin + inherited Create; + + fOwner := aPlayer; + fUnitReqCnt := 0; + fSetup := aSetup; + + fPredictor := TKMCityPredictor.Create(aPlayer, aSetup); + fBuilder := TKMCityBuilder.Create(aPlayer, fPredictor); +end; + + +destructor TKMCityManagement.Destroy(); +begin + fPredictor.Free; + fBuilder.Free; + + inherited; +end; + + +procedure TKMCityManagement.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('CityManagement'); + SaveStream.Write(fOwner); + SaveStream.Write(fUnitReqCnt); + SaveStream.Write(fWarriorsDemands, SizeOf(fWarriorsDemands)); // Used for Army management -> must be saved + //SaveStream.Write(fRequiredWeapons, SizeOf(fRequiredWeapons)); // Computed every time + + fPredictor.Save(SaveStream); + fBuilder.Save(SaveStream); +end; + + +procedure TKMCityManagement.Load(LoadStream: TKMemoryStream); +begin + LoadStream.CheckMarker('CityManagement'); + LoadStream.Read(fOwner); + LoadStream.Read(fUnitReqCnt); + LoadStream.Read(fWarriorsDemands, SizeOf(fWarriorsDemands)); + //LoadStream.Read(fRequiredWeapons, SizeOf(fRequiredWeapons)); + + fPredictor.Load(LoadStream); + fBuilder.Load(LoadStream); +end; + + +procedure TKMCityManagement.SyncLoad(); +begin + fBuilder.SyncLoad(); +end; + + +procedure TKMCityManagement.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fPredictor.OwnerUpdate(aPlayer); + fBuilder.OwnerUpdate(aPlayer); +end; + + +procedure TKMCityManagement.AfterMissionInit(); +begin + if SP_DEFAULT_ADVANCED_AI then + begin + fSetup.EnableAdvancedAI(True); + end; + + // Find resources around Loc and change building policy + gAIFields.Eye.ScanLoc(); + fPredictor.AfterMissionInit(); + fBuilder.AfterMissionInit(); +end; + + +procedure TKMCityManagement.UpdateState(aTick: Cardinal); +const + LONG_UPDATE = MAX_HANDS * 2; +begin + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionEnter(psAICityAdv); + {$ENDIF} + try + if fSetup.AutoBuild AND (aTick mod MAX_HANDS = fOwner) then + begin + fBuilder.UpdateState(aTick); + fPredictor.UpdateState(aTick); + if not SKIP_RENDER AND SHOW_AI_WARE_BALANCE then + begin + fBalanceText := ''; + fPredictor.LogStatus(fBalanceText); + fBalanceText := fBalanceText + Format('Management, unit count: %d',[fUnitReqCnt]); + end; + fBuilder.ChooseHousesToBuild(aTick); + if not SKIP_RENDER AND SHOW_AI_WARE_BALANCE then + begin + fBuilder.LogStatus(fBalanceText); + LogStatus(fBalanceText); + end; + end; + + if (aTick mod LONG_UPDATE = fOwner) then + begin + CheckUnitCount(aTick); + CheckMarketplaces(); + CheckStoreWares(aTick); + if fSetup.IsRepairAlways then + CheckAutoRepair(); + CheckWareDistribution(); + WeaponsBalance(); + OrderWeapons(); + CheckExhaustedHouses(); + end; + finally + {$IFDEF DBG_PERFLOG} + gPerfLogs.SectionLeave(psAICityAdv); + {$ENDIF} + end; +end; + + +procedure TKMCityManagement.CheckUnitCount(aTick: Cardinal); +type + TKMTrainPriorityArr = array[0..13] of TKMUnitType; + TKMSchoolHouseArray = array of TKMHouseSchool; + TKMHouseAvailArr = array[HOUSE_MIN..HOUSE_MAX] of Integer; + TKMUnitReqArr = array[CITIZEN_MIN..CITIZEN_MAX] of Integer; +const + TRAINING_PRIORITY: TKMTrainPriorityArr = ( + utMiner, utMetallurgist, utStonemason, utWoodcutter, utCarpenter, + utFarmer, utAnimalBreeder, utBaker, utButcher, utFisher, utSmith, utSerf, utBuilder, utRecruit + ); + TRAINING_PRIORITY_Serf: TKMTrainPriorityArr = ( + utMiner, utMetallurgist, utStonemason, utWoodcutter, utCarpenter, utSerf, + utFarmer, utAnimalBreeder, utBaker, utButcher, utFisher, utSmith, utBuilder, utRecruit + ); + DISMISS_UNITS: set of TKMUnitType = [ + utMiner, utMetallurgist, utStonemason, utWoodcutter, utCarpenter, //utSerf, + utFarmer, utAnimalBreeder, utBaker, utButcher, utFisher, utSmith, utBuilder // utRecruit + ]; +var + P: TKMHand; + Stats: TKMHandStats; + + function RecruitsNeeded(aCompletedWatchtowers: Word): Integer; + const + RECRUIT_PEACE_DELAY = 17 * 60 * 10; + MIN_2_TICK = 600; + var + Output: Integer; + begin + Output := aCompletedWatchtowers; + + if (aTick + RECRUIT_PEACE_DELAY > gGame.Options.Peacetime * MIN_2_TICK) + AND (Stats.GetHouseQty(htBarracks) > 0) + AND (aTick > fSetup.RecruitDelay * MIN_2_TICK) then + begin + if fSetup.UnlimitedEquip then + begin + // Iron soldiers + Inc( Output, Min( Stats.GetWareBalance(wtIronArmor), Stats.GetWareBalance(wtCrossbow) + Stats.GetWareBalance(wtPike) + Min( Stats.GetWareBalance(wtSword), Stats.GetWareBalance(wtIronShield)) ) ); + // Leather soldiers we can make + Inc( Output, Min( Stats.GetWareBalance(wtLeatherArmor), Stats.GetWareBalance(wtBow) + Stats.GetWareBalance(wtLance) + Min(Stats.GetWareBalance(wtAxe), Stats.GetWareBalance(wtWoodenShield)) ) ); + // Militia with leftover axes + Inc( Output, Max( 0, Stats.GetWareBalance(wtAxe) - Min(Stats.GetWareBalance(wtLeatherArmor), Stats.GetWareBalance(wtWoodenShield)) ) ); + end + else + Output := Output + 10; + end; + Result := Output; + end; + + function RequiredSerfCount: Integer; + var + I, serfCount, idleCount: Integer; + begin + serfCount := gHands[fOwner].Stats.GetUnitQty(utSerf); + Result := Max(0, Round(gHands[fOwner].Stats.GetUnitQty(utBuilder) - serfCount)); + + idleCount := 0; + for I := 0 to P.Units.Count - 1 do + if not P.Units[I].IsDeadOrDying + and (P.Units[I] is TKMUnitSerf) + and P.Units[I].IsIdle then + Inc(idleCount); + + // Increase count of serfs carefully (compute fraction of serfs who does not have job) + if idleCount = 0 then + Result := Max( 1 + + Ord(serfCount < AI_Par[MANAGEMENT_CheckUnitCount_SerfLimit1]) + + Ord(serfCount < AI_Par[MANAGEMENT_CheckUnitCount_SerfLimit2]) + + Ord(serfCount < AI_Par[MANAGEMENT_CheckUnitCount_SerfLimit3]), Result); + end; + + procedure TrainByPriority(const aPrior: TKMTrainPriorityArr; var aUnitReq: TKMUnitReqArr; var aSchools: TKMSchoolHouseArray; aSchoolCnt: Integer); + const + MAX_QUEUE = 4; + var + K,L,MinQueue,MinQueueIdx: Integer; + UT: TKMUnitType; + begin + for K := Low(aPrior) to High(aPrior) do + begin + UT := aPrior[K]; + while (aUnitReq[UT] > 0) do + begin + MinQueue := MAX_QUEUE; + MinQueueIdx := 0; + for L := 0 to aSchoolCnt - 1 do + if (aSchools[L].QueueCount < MinQueue) then + begin + MinQueue := aSchools[L].QueueCount; + MinQueueIdx := L; + end; + if (MinQueue < MAX_QUEUE) then // Order citizen, decrease unit requirement + Dec(aUnitReq[UT], aSchools[MinQueueIdx].AddUnitToQueue(UT,1)) + else + break; + end; + end; + end; + + procedure Dismiss(var aUnitReq: TKMUnitReqArr); + var + K: Integer; + UT: TKMUnitType; + HT: TKMHouseType; + begin + // Adjust worker count + aUnitReq[utBuilder] := aUnitReq[utBuilder] * Byte(fPredictor.CityCompleted); + // Convert planned houses to units + for HT := HOUSE_MIN to HOUSE_MAX do + if gRes.Houses[HT].CanHasWorker AND (HT <> htBarracks) then + Inc(aUnitReq[gRes.Houses[HT].WorkerType], fBuilder.Planner.PlannedHouses[HT].Count); + // Dismiss units + for UT in DISMISS_UNITS do + begin + K := 0; + while (aUnitReq[UT] < -1) AND (K < gHands[fOwner].Units.Count) do // -1 for reserve + begin + if (gHands[fOwner].Units[K].UnitType = UT) + AND (gHands[fOwner].Units[K].Home = nil) + AND gHands[fOwner].Units[K].Dismissable then + begin + Inc(aUnitReq[UT]); + gHands[fOwner].Units[K].Dismiss; + end; + Inc(K); + end; + end; + end; + +var + GoldShortage: Boolean; + K,L,cnt: Integer; + GoldProduced: Cardinal; + H: TKMHouse; + HT: TKMHouseType; + UT: TKMUnitType; + Schools: TKMSchoolHouseArray; + Houses: TKMHouseAvailArr; + UnitReq, UnitTrain: TKMUnitReqArr; +begin + P := gHands[fOwner]; + Stats := P.Stats; + //Clear up + FillChar(UnitReq, SizeOf(UnitReq), #0); + FillChar(UnitTrain, SizeOf(UnitTrain), #0); + FillChar(Houses, SizeOf(Houses), #0); + + //Citizens + // Make sure we have enough gold left for self-sufficient city + GoldProduced := Stats.GetWaresProduced(wtGold); + GoldShortage := (Stats.GetWareBalance(wtGold) < AI_Par[MANAGEMENT_GoldShortage]) AND (GoldProduced = 0); + if GoldShortage then + begin + UnitReq[utSerf] := 3; // 3x Serf + UnitReq[utBuilder] := Byte((fPredictor.WorkerCount > 0) AND (fSetup.AutoBuild OR fSetup.IsRepairAlways));// 1x Worker + UnitReq[utMiner] := Stats.GetHouseTotal(htCoalMine) + Stats.GetHouseTotal(htGoldMine) + Stats.GetHouseQty(htIronMine); // Miner can go into iron / gold / coal mines (idealy we need 1 gold and 1 coal but it is hard to catch it) + UnitReq[utMetallurgist] := Stats.GetHouseTotal(htMetallurgists) + Stats.GetHouseQty(htIronSmithy); // Metallurgist (same problem like in case of miner) + UnitReq[utWoodcutter] := Byte(Stats.GetHouseQty(htWoodcutters) > 0); // 1x Woodcutter + UnitReq[utStonemason] := Byte(Stats.GetHouseQty(htQuarry) > 0); // 1x StoneCutter + UnitReq[utCarpenter] := Byte(Stats.GetHouseQty(htSawmill) > 0); // 1x Lamberjack + end + //Count overall unit requirement (excluding Barracks and ownerless houses) + else + begin + // We need completed houses, houses in specific stage of construction and only completed watchtowers -> we have to scan houses + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) AND not H.IsDestroyed then + begin + if H.IsComplete then + Inc(Houses[H.HouseType], 1) + else if (H.BuildingProgress > 0) AND (H.HouseType <> htWatchTower) then + Inc(Houses[H.HouseType], 1); + end; + end; + + // Convert houses to required units + for HT := HOUSE_MIN to HOUSE_MAX do + if gRes.Houses[HT].CanHasWorker AND (HT <> htBarracks) then + Inc(UnitTrain[gRes.Houses[HT].WorkerType], Houses[HT]); + + UnitReq[utRecruit] := 0; + UnitReq[utSerf] := 0; + UnitReq[utBuilder] := 0; + if (Stats.GetWareBalance(wtGold) > AI_Par[MANAGEMENT_GoldShortage] * AI_Par[MANAGEMENT_CheckUnitCount_WorkerGoldCoef]) OR (GoldProduced > 0) then // Dont train servs / workers / recruits when we will be out of gold + begin + UnitReq[utBuilder] := fPredictor.WorkerCount * Byte(not gHands[fOwner].AI.ArmyManagement.Defence.CityUnderAttack) * Byte(fSetup.AutoBuild) + Byte(not fSetup.AutoBuild) * Byte(fSetup.IsRepairAlways) * 5; + UnitReq[utRecruit] := RecruitsNeeded(Houses[htWatchTower]); + end; + if (Stats.GetWareBalance(wtGold) > AI_Par[MANAGEMENT_GoldShortage] * AI_Par[MANAGEMENT_CheckUnitCount_SerfGoldCoef]) OR (GoldProduced > 0) then // Dont train servs / workers / recruits when we will be out of gold + UnitReq[utSerf] := Stats.GetUnitQty(utSerf) + RequiredSerfCount(); + end; + + // Consider existing units + fUnitReqCnt := 0; + for UT := Low(UnitReq) to High(UnitReq) do + begin + UnitReq[UT] := UnitReq[UT] - Stats.GetUnitQty(UT); + UnitTrain[UT] := UnitTrain[UT] + UnitReq[UT]; + fUnitReqCnt := Min(fUnitReqCnt + Max(0,UnitReq[UT]), High(Word)); + end; + + // Find completed schools, decrease UnitReq by already trained citizens + cnt := 0; + SetLength(Schools, Stats.GetHouseQty(htSchool)); + for K := 0 to P.Houses.Count - 1 do + if (P.Houses[K] <> nil) + AND not (P.Houses[K].IsDestroyed) + AND (P.Houses[K].IsComplete) + AND (P.Houses[K].HouseType = htSchool) then + begin + Schools[cnt] := TKMHouseSchool(P.Houses[K]); + if GoldShortage AND (Schools[cnt].CheckWareIn(wtGold) = 0) then // Ignore empty schools when we are out of gold + Continue; + for L := Schools[cnt].QueueLength - 1 downto 0 do + if (Schools[cnt].Queue[L] <> utNone) then + begin + if L = 0 then // Queue is already active + Dec(UnitTrain[ Schools[Cnt].Queue[L] ],1) + else // Remove from Queue (it doesn't have to be actual ... when is city under attack we have to save gold) + Schools[Cnt].RemUnitFromQueue(L); + end; + cnt := cnt + 1; + end; + + + // Order citizen training + if (cnt > 0) then + begin + if (gHands[fOwner].Stats.GetUnitQty(utSerf) < gHands[fOwner].Stats.GetHouseQty(htAny)) then // Keep minimal amount of serfs + TrainByPriority(TRAINING_PRIORITY_Serf, UnitTrain, Schools, cnt) + else + TrainByPriority(TRAINING_PRIORITY, UnitTrain, Schools, cnt); + end; + + // Dismiss unused units + Dismiss(UnitReq); +end; + + +// Try trade +procedure TKMCityManagement.CheckMarketplaces(); +var + RequiedCnt, AvailableCnt: Word; + RequiredWares, AvailableWares: array of TKMWareType; + procedure AddWare(aWare: TKMWareType; IsRequired: Boolean = True); + begin + if IsRequired then + begin + RequiredWares[RequiedCnt] := aWare; + RequiedCnt := RequiedCnt + 1; + end + else + begin + AvailableWares[AvailableCnt] := aWare; + AvailableCnt := AvailableCnt + 1; + end; + end; + + procedure CheckTrades(); + const + WARE_RESERVE = 3; + var + K: Integer; + Houses: TKMHousesCollection; + HM: TKMHouseMarket; + begin + Houses := gHands[fOwner].Houses; + for K := 0 to Houses.Count - 1 do + if (Houses[K] <> nil) + AND not Houses[K].IsDestroyed + AND Houses[K].IsComplete + AND (Houses[K].HouseType = htMarket) then + begin + HM := TKMHouseMarket(Houses[K]); + if (HM.WareOrder[0] > 0) + AND (gHands[fOwner].Stats.GetWareBalance(HM.ResFrom) < HM.WareOrder[0] * HM.RatioFrom + WARE_RESERVE) then + HM.WareOrder[0] := 0; // Cancel the trade + end; + end; + + procedure TryBuyItem(aResFrom, aResTo: TKMWareType); + const + TRADE_QUANTITY = 10; + var + K: Integer; + Houses: TKMHousesCollection; + HM, Market: TKMHouseMarket; + begin + Market := nil; + Houses := gHands[fOwner].Houses; + for K := 0 to Houses.Count - 1 do + if (Houses[K] <> nil) + AND not Houses[K].IsDestroyed + AND (Houses[K].HouseType = htMarket) + AND Houses[K].IsComplete then + begin + HM := TKMHouseMarket(Houses[K]); + // Market have an order + if (HM.WareOrder[0] > 0) then + begin + if (HM.ResTo = aResTo) then + Exit; + end + // Market is free + else if HM.AllowedToTrade(aResFrom) AND HM.AllowedToTrade(aResTo) then + Market := HM; + end; + if (Market <> nil) then + begin + Market.WareOrder[0] := 0; //First we must cancel the current trade + Market.ResFrom := aResFrom; + Market.ResTo := aResTo; + Market.WareOrder[0] := TRADE_QUANTITY; //Set the new trade + end; + end; +const + SOLD_ORDER: array[0..19] of TKMWareType = ( + wtSausage, wtWine, wtBread, wtFish, + wtWoodenShield, wtAxe, wtLance, wtBow, wtLeatherArmor, + wtIronShield, wtSword, wtPike, wtCrossbow, wtIronArmor, + wtHorse, wtFlour, + wtSkin, wtLeather, wtPig, + wtTrunk //wtTimber, wtCorn, + //wtSteel, wtGold, wtIronOre, wtCoal, wtGoldOre, + //wtStone + ); + LACK_OF_STONE = 50; + WARFARE_SELL_LIMIT = 10; + SELL_LIMIT = 30; +var + minGoldAmount, MarketCnt, I, WareCnt: Integer; + WT: TKMWareType; +begin + + MarketCnt := gHands[fOwner].Stats.GetHouseQty(htMarket); + if MarketCnt = 0 then + Exit + else + CheckTrades(); + + RequiedCnt := 0; + SetLength(RequiredWares,4); + with gHands[fOwner].Stats do + begin + // Gold + if (GetHouseQty(htMetallurgists) = 0) + AND (GetWareBalance(wtGold) <= AI_Par[MANAGEMENT_GoldShortage]) then + AddWare(wtGold); + // Stone + if (GetWareBalance(wtStone)-GetHouseQty(htWatchTower)*5 < LACK_OF_STONE) + AND (Builder.Planner.PlannedHouses[htQuarry].Completed = 0) then + AddWare(wtStone); + // Gold ore + minGoldAmount := Round(AI_Par[MANAGEMENT_GoldShortage] * 3); + if ( fPredictor.WareBalance[wtGoldOre].Exhaustion < 20 ) + AND ( GetWareBalance(wtGold) < minGoldAmount ) + AND ( GetWareBalance(wtGoldOre) < minGoldAmount ) then + AddWare(wtGoldOre); + // Coal + if ( fPredictor.WareBalance[wtCoal].Exhaustion < 50 ) + AND ( GetWareBalance(wtCoal) < minGoldAmount + 5 * (Builder.Planner.PlannedHouses[htWeaponSmithy].Completed + Builder.Planner.PlannedHouses[htIronSmithy].Completed + Builder.Planner.PlannedHouses[htArmorSmithy].Completed) ) + AND (Builder.Planner.PlannedHouses[htCoalMine].UnderConstruction = 0) then + AddWare(wtCoal); + end; + + if RequiedCnt = 0 then + Exit; + + AvailableCnt := 0; + SetLength(AvailableWares, RequiedCnt); + for WT in SOLD_ORDER do + if (AvailableCnt < RequiedCnt) then + begin + WareCnt := gHands[fOwner].Stats.GetWareBalance(WT); + if ( (WT in [WARFARE_MIN..WARFARE_MAX]) AND (WareCnt > WARFARE_SELL_LIMIT) ) + OR ( (WareCnt > SELL_LIMIT) AND (fPredictor.WareBalance[WT].Exhaustion > 90) ) then + AddWare(WT, False); + end; + + for I := 0 to RequiedCnt - 1 do + if (I < AvailableCnt) then + TryBuyItem(AvailableWares[I], RequiredWares[I]) + else + break; +end; + + +procedure TKMCityManagement.CheckStoreWares(aTick: Cardinal); +const + TRUNK_STORE_DELAY = 45 * 60 * 10; + WOOD_STORE_DELAY = 60 * 60 * 10; + STONE_STORE_DELAY = 60 * 60 * 10; + CORN_STORE_DELAY = 60 * 60 * 10; +var + I: Integer; + S: TKMHouseStore; +begin + //Iterate through all Stores and block certain wares to reduce serf usage + for I := 0 to gHands[fOwner].Houses.Count - 1 do + with gHands[fOwner] do + if (Houses[I] <> nil) + AND not Houses[I].IsDestroyed + AND (Houses[I].HouseType = htStore) + AND Houses[I].IsComplete then + begin + S := TKMHouseStore(Houses[I]); + + // Materials + S.NotAcceptFlag[wtTrunk] := (aTick > TRUNK_STORE_DELAY); // Trunk should not be blocked because of forest cleaning + S.NotAcceptFlag[wtTimber] := (S.CheckWareIn(wtTimber) > 20) OR (aTick > WOOD_STORE_DELAY);// AND (Predictor.WareBalance[wtWood].Exhaustion > 40); + S.NotAcceptFlag[wtStone] := (aTick > STONE_STORE_DELAY) OR (S.CheckWareIn(wtStone) * AI_Par[MANAGEMENT_CheckStoreWares_Stone] > Stats.GetUnitQty(utBuilder)); + S.NotAcceptFlag[wtGold] := S.CheckWareIn(wtGold) > 400; // Everyone needs as much gold as possible + + // Food - don't store food when we have enough (it will cause trafic before storehouse) + S.NotAcceptFlag[wtWine] := Stats.GetWareBalance(wtWine) > 100; + S.NotAcceptFlag[wtSausage] := Stats.GetWareBalance(wtSausage) > 100; + S.NotAcceptFlag[wtBread] := Stats.GetWareBalance(wtBread) > 100; + S.NotAcceptFlag[wtFish] := Stats.GetWareBalance(wtFish) > 100; + + // Others + S.NotAcceptFlag[wtGoldOre] := True; + S.NotAcceptFlag[wtCoal] := True; + S.NotAcceptFlag[wtIronOre] := Stats.GetHouseQty(htIronSmithy) > 0; + S.NotAcceptFlag[wtIron] := Stats.GetHouseQty(htWeaponSmithy) + + Stats.GetHouseQty(htArmorSmithy) > 0; + S.NotAcceptFlag[wtCorn] := (aTick > CORN_STORE_DELAY); + S.NotAcceptFlag[wtLeather] := True; + S.NotAcceptFlag[wtFlour] := True; + //Pigs and skin cannot be blocked since if swinefarm is full of one it stops working (blocks other) + //S.NotAcceptFlag[wtSkin] := Stats.GetHouseQty(htTannery) > 0; + //S.NotAcceptFlag[wtPig] := Stats.GetHouseQty(htButchers) > 0; + end; +end; + + +//Demolish any exhausted mines, they will be rebuilt if needed +procedure TKMCityManagement.CheckExhaustedHouses(); +var + I: Integer; + Loc: TKMPoint; + H: TKMHouse; +begin + //Wait until resource is depleted and output is empty + for I := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[I]; + if not H.IsDestroyed + AND H.ResourceDepleted then + begin + H.IsClosedForWorker := True; + if (H.CheckWareOut(wtAll) = 0) then + begin + Loc := H.Entrance; + // Remove avoid building around coal mine + if (H.HouseType = htCoalMine) then + gAIFields.Influences.RemAvoidBuilding(KMRect(Loc.X-3, Loc.Y-3, Loc.X+4, Loc.Y+2)); + // Mark house plan as exhausted + Builder.Planner.MarkAsExhausted(H.HouseType, Loc); + H.Demolish(fOwner); + end; + end; + end; +end; + + +// Allow auto repair procedure +procedure TKMCityManagement.CheckAutoRepair(); +var + I: Integer; +begin + if (gHands[fOwner].HandType <> hndComputer) then + Exit; + with gHands[fOwner] do + if gHands[fOwner].AI.ArmyManagement.Defence.CityUnderAttack then + begin + for I := 0 to Houses.Count - 1 do + begin + Houses[I].BuildingRepair := False; + if (Houses[I].HouseType = htWatchTower) AND (Houses[I].DeliveryMode = dmDelivery) then + Houses[I].SetDeliveryModeInstantly(dmClosed); + end; + end + else + begin + for I := 0 to Houses.Count - 1 do + begin + Houses[I].BuildingRepair := fSetup.IsRepairAlways; + if (Houses[I].HouseType = htWatchTower) AND (Houses[I].DeliveryMode = dmClosed) then + Houses[I].SetDeliveryModeInstantly(dmDelivery); + end; + end; +end; + + +procedure TKMCityManagement.CheckWareDistribution(); + // Serfs are too ill to bring coal to metallurgists if AI place it 1 tile farther than iron production so there has to be created this function + function GetGoldBalance(): Boolean; + const + MAX_DEFICIT = 2; + var + I, Deficit, HouseCnt: Integer; + H: TKMHouse; + begin + HouseCnt := 0; + Deficit := 0; + with Builder.Planner.PlannedHouses[htMetallurgists] do + for I := 0 to Count - 1 do + if (Plans[I].House <> nil) AND not (Plans[I].House.IsDestroyed) then + begin + Inc(HouseCnt); + H := Plans[I].House; + Inc(Deficit, H.CheckWareIn(wtGoldOre) + H.CheckWareOut(wtGoldOre) - H.CheckWareIn(wtCoal) - H.CheckWareOut(wtCoal)); + end; + Result := (Deficit / HouseCnt) > MAX_DEFICIT; + end; +begin + with gHands[fOwner].Stats do + begin + // Wood + if Builder.WoodShortage OR Builder.TrunkShortage then + begin + WareDistribution[wtTimber, htArmorWorkshop] := 0; + WareDistribution[wtTimber, htWeaponWorkshop] := 2; + end + else + begin + WareDistribution[wtTimber, htArmorWorkshop] := 2; + WareDistribution[wtTimber, htWeaponWorkshop] := 5; + end; + // Coal + if Builder.GoldShortage then + begin + gHands[fOwner].Stats.WareDistribution[wtCoal, htMetallurgists] := 5; + gHands[fOwner].Stats.WareDistribution[wtCoal, htIronSmithy] := 1; + gHands[fOwner].Stats.WareDistribution[wtCoal, htWeaponSmithy] := 0; + gHands[fOwner].Stats.WareDistribution[wtCoal, htArmorSmithy] := 0; + end + else if GetGoldBalance() then + begin + gHands[fOwner].Stats.WareDistribution[wtCoal, htMetallurgists] := 5; + gHands[fOwner].Stats.WareDistribution[wtCoal, htIronSmithy] := 1; + gHands[fOwner].Stats.WareDistribution[wtCoal, htWeaponSmithy] := 1; + gHands[fOwner].Stats.WareDistribution[wtCoal, htArmorSmithy] := 1; + end + else + begin + gHands[fOwner].Stats.WareDistribution[wtCoal, htMetallurgists] := 5; + gHands[fOwner].Stats.WareDistribution[wtCoal, htIronSmithy] := 4; + gHands[fOwner].Stats.WareDistribution[wtCoal, htWeaponSmithy] := 4; + gHands[fOwner].Stats.WareDistribution[wtCoal, htArmorSmithy] := 4; + end; + // Corn + if (gHands[fOwner].Stats.GetWareBalance(wtBread) > 20) then + begin + gHands[fOwner].Stats.WareDistribution[wtCorn, htMill] := 2; + gHands[fOwner].Stats.WareDistribution[wtCorn, htSwine] := 5; + gHands[fOwner].Stats.WareDistribution[wtCorn, htStables] := 4; + end + else + begin + gHands[fOwner].Stats.WareDistribution[wtCorn, htMill] := 4; + gHands[fOwner].Stats.WareDistribution[wtCorn, htSwine] := 5; + gHands[fOwner].Stats.WareDistribution[wtCorn, htStables] := 3; + end; + // Steel is updated in WeaponsBalance + //gHands[fOwner].Stats.WareDistribution[wtSteel, htWeaponSmithy] := 5; + //gHands[fOwner].Stats.WareDistribution[wtSteel, htArmorSmithy] := 5; + + gHands[fOwner].Houses.UpdateDemands; + end; +end; + + +// Calculate weapons demand from combat AI requirements +procedure TKMCityManagement.WeaponsBalance(); +var + EnemyEval, AllyEval: TKMArmyEval; + AllyCounterWeightRatio: array[GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Single; + + procedure ComputeGroupDemands(aGT: TKMGroupType; aIronRatio: Single); + const + // It doesnt depends on future "optimalization" of parameters: against cav should be always good pikes etc. so this array doesnt have to be computed + BEST_VERSUS_OPTION: array[GROUP_TYPE_MIN..GROUP_TYPE_MAX, GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Single = ( + // Melee, AntiHorse, Ranged, Mounted + (0.6, 0.0, 0.4, 0.0), // Melee + (0.4, 0.0, 0.6, 0.0), // AntiHorse + (0.0, 0.0, 0.7, 0.3), // Ranged + (0.0, 0.8, 0.2, 0.0) // Mounted + ); + var + I: Integer; + EnemyStrength, UnitStrength, UnitsRequired, Wood, Iron: Single; + UT: TKMUnitType; + GT: TKMGroupType; + UnitEval: TKMGroupEval; + begin + // Get best type of oponent and compute iron ratio + Wood := 0; + Iron := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (BEST_VERSUS_OPTION[aGT,GT] > 0) then + for I := 1 to 3 do + begin + UT := AI_TROOP_TRAIN_ORDER[GT,I]; + if (UT <> utNone) AND not gHands[fOwner].Locks.GetUnitBlocked(UT) then + if (I = 1) then + Iron := Iron + 1 + else + Wood := Wood + 1; + end; + if (Wood = 0) AND (Iron = 0) then + Exit + else if (Wood > 0) AND (Iron = 0) then + aIronRatio := 0 + else if (Wood = 0) AND (Iron > 0) then + aIronRatio := 1; + + // Compute strength of specific enemy group + EnemyStrength := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + with EnemyEval.Groups[aGT] do + EnemyStrength := EnemyStrength + BEST_VERSUS_OPTION[aGT,GT] + * (Attack + AttackHorse * Byte(GT = gtMounted)) + * IfThen( (GT = gtRanged), DefenceProjectiles, Defence ) + * HitPoints; + + // Decrease strength by owner's existing units + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + with AllyEval.Groups[GT] do + begin + EnemyStrength := EnemyStrength - BEST_VERSUS_OPTION[aGT,GT] + * (Attack + AttackHorse * Byte(aGT = gtMounted)) + * IfThen( (aGT = gtRanged), DefenceProjectiles, Defence ) + * HitPoints; + AllyCounterWeightRatio[GT] := AllyCounterWeightRatio[GT] + BEST_VERSUS_OPTION[aGT,GT] * Byte(EnemyEval.Groups[aGT].Count > 0); + end; + EnemyStrength := Max(0, EnemyStrength); + + // Compute unit requirements + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + if (BEST_VERSUS_OPTION[aGT,GT] > 0) then + for I := 1 to 3 do + begin + UT := AI_TROOP_TRAIN_ORDER[GT,I]; + // Skip unit type in case that it is blocked + if (UT = utNone) OR gHands[fOwner].Locks.GetUnitBlocked(UT) then + Continue; + // Calculate required count of specific unit type + UnitEval := gAIFields.Eye.ArmyEvaluation.UnitEvaluation(UT, True); + with UnitEval do + UnitStrength := (Attack + AttackHorse * Byte(aGT = gtMounted)) + * IfThen( (aGT = gtRanged), DefenceProjectiles, Defence ) + * HitPoints; + + UnitsRequired := BEST_VERSUS_OPTION[aGT,GT] * Power(EnemyStrength / Max(0.0001, UnitStrength), 1/3) * IfThen( (I = 1), aIronRatio, 1-aIronRatio ); + fWarriorsDemands[UT] := fWarriorsDemands[UT] + Max(0, Round(UnitsRequired)); + if (I = 2) then // In case that utAxeFighter is not blocked skip militia + Break; + end; + end; + + procedure CheckMinArmyReq(); + const + DEFAULT_COEFICIENT = 15; + DEFAULT_ARMY_REQUIREMENTS: array[WARRIOR_EQUIPABLE_BARRACKS_MIN..WARRIOR_EQUIPABLE_BARRACKS_MAX] of Single = ( + 1, 1, 1, 3,//utMilitia, utAxeFighter, utSwordsman, utBowman, + 2, 1, 1, 0.5,//utArbaletman, utPikeman, utHallebardman, utHorseScout, + 0.5//utCavalry + ); + WOOD_ARMY: set of TKMUnitType = [utAxeFighter, utBowman, utLanceCarrier]; //utHorseScout, + IRON_ARMY: set of TKMUnitType = [utSwordFighter, utCrossbowman, utPikeman]; //utCavalry + var + I, WoodReq, IronReq: Integer; + RatioSum: Single; + UT: TKMUnitType; + GT: TKMGroupType; + begin + // Get ratio of equiped soldiers + RatioSum := 0; + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + RatioSum := RatioSum + AllyCounterWeightRatio[GT]; + + // Wood + WoodReq := Max(+ fRequiredWeapons[wtLeatherArmor].Required - fRequiredWeapons[wtLeatherArmor].Available, + + fRequiredWeapons[wtAxe].Required - fRequiredWeapons[wtAxe].Available + + fRequiredWeapons[wtBow].Required - fRequiredWeapons[wtBow].Available + + fRequiredWeapons[wtLance].Required - fRequiredWeapons[wtLance].Available + ); + if (WoodReq < 5) then + begin + WoodReq := Round((DEFAULT_COEFICIENT - WoodReq) / 5.0); // 5 is equal to sum of all requirements in leather category + for UT in WOOD_ARMY do + begin + GT := UNIT_TO_GROUP_TYPE[UT]; + if not gHands[fOwner].Locks.GetUnitBlocked(UT) AND ((RatioSum = 0) OR (AllyCounterWeightRatio[GT] > 0)) then + for I := Low(TROOP_COST[UT]) to High(TROOP_COST[UT]) do + if (TROOP_COST[UT,I] <> wtNone) then + with fRequiredWeapons[ TROOP_COST[UT,I] ] do + Required := Min(High(Word), Available + Round(DEFAULT_ARMY_REQUIREMENTS[UT] * WoodReq * max(1, AllyCounterWeightRatio[GT] / max(1,RatioSum)) )); + end; + end; + + // Iron + IronReq := Max(+ fRequiredWeapons[wtIronArmor].Required - fRequiredWeapons[wtIronArmor].Available, + + fRequiredWeapons[wtSword].Required - fRequiredWeapons[wtSword].Available + + fRequiredWeapons[wtCrossbow].Required - fRequiredWeapons[wtCrossbow].Available + + fRequiredWeapons[wtPike].Required - fRequiredWeapons[wtPike].Available + ); + if (IronReq < 5) then + begin + //IronReq := Round((DEFAULT_COEFICIENT - IronReq) / 5.0); // 5 is equal to sum of all requirements in iron category + for UT in IRON_ARMY do + if not gHands[fOwner].Locks.GetUnitBlocked(UT) then + for I := Low(TROOP_COST[UT]) to High(TROOP_COST[UT]) do + if (TROOP_COST[UT,I] <> wtNone) then + with fRequiredWeapons[ TROOP_COST[UT,I] ] do + Required := Min(High(Word), Round(abs(IronReq) + DEFAULT_COEFICIENT * DEFAULT_ARMY_REQUIREMENTS[UT])); + fRequiredWeapons[wtIronArmor].Required := fRequiredWeapons[wtIronArmor].Required * 3; + end; + end; +//AITroopTrainOrder: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX, 1..3] of TKMUnitType = ( +// (utSwordsman, utAxeFighter, utMilitia), +// (utHallebardman, utPikeman, utNone), +// (utArbaletman, utBowman, utNone), +// (utCavalry, utHorseScout, utNone) +//); +//UnitGroups: array [WARRIOR_MIN..WARRIOR_MAX] of TKMGroupType = ( +// gtMelee,gtMelee,gtMelee, //utMilitia, utAxeFighter, utSwordsman +// gtRanged,gtRanged, //utBowman, utArbaletman +// gtAntiHorse,gtAntiHorse, //utPikeman, utHallebardman, +// gtMounted,gtMounted, //utHorseScout, utCavalry, +// gtMelee, //utBarbarian +// //TPR Army +// gtAntiHorse, //utPeasant +// gtRanged, //utSlingshot +// gtMelee, //utMetalBarbarian +// gtMounted //utHorseman +//); +//TroopCost: array [utMilitia..utCavalry, 1..4] of TKMWareType = ( +// (wtAxe, wtNone, wtNone, wtNone ), //Militia +// (wtShield, wtArmor, wtAxe, wtNone ), //Axefighter +// (wtMetalShield, wtMetalArmor, wtSword, wtNone ), //Swordfighter +// (wtArmor, wtBow, wtNone, wtNone ), //Bowman +// (wtMetalArmor, wtArbalet, wtNone, wtNone ), //Crossbowman +// (wtArmor, wtPike, wtNone, wtNone ), //Lance Carrier +// (wtMetalArmor, wtHallebard, wtNone, wtNone ), //Pikeman +// (wtShield, wtArmor, wtAxe, wtHorse), //Scout +// (wtMetalShield, wtMetalArmor, wtSword, wtHorse) //Knight +//); +//WARRIOR_EQUIPABLE_MIN = utMilitia; +//WARRIOR_EQUIPABLE_MAX = utCavalry; +// utMilitia, utAxeFighter, utSwordsman, utBowman, +// utArbaletman, utPikeman, utHallebardman, utHorseScout, +// utCavalry, utBarbarian, + +const + IRON_WEAPONS: set of TKMWareType = [wtSword, wtPike, wtCrossbow]; + IRON_ARMORS: set of TKMWareType = [wtIronArmor, wtIronShield]; +var + I, SmithyCnt, WorkshopCnt, ArmorCnt: Integer; + IronRatio, WeaponFraction, ArmorFraction, IronShare: Single; + WT: TKMWareType; + GT: TKMGroupType; + UT: TKMUnitType; +begin + ArmorCnt := gHands[fOwner].Stats.GetHouseQty(htArmorSmithy) + gHands[fOwner].Stats.GetHouseQty(htArmorWorkshop); + SmithyCnt := gHands[fOwner].Stats.GetHouseQty(htWeaponSmithy); + WorkshopCnt := gHands[fOwner].Stats.GetHouseQty(htWeaponWorkshop); + if (ArmorCnt + SmithyCnt + WorkshopCnt = 0) then // Save time when nothing can be produced + Exit; + IronRatio := 0.5; + if (SmithyCnt + WorkshopCnt > 0) then // This will avoid to divide by zero + IronRatio := SmithyCnt / ((SmithyCnt + WorkshopCnt)*1.0); + + // Humans may spam archers -> AI will not produce long-range support because of balancing units in team + // So it is better to calculate AllyEval just for Owner + //AllyEval := gAIFields.Eye.ArmyEvaluation.AllianceEvaluation(aPlayer, atAlly); + AllyEval := gAIFields.Eye.ArmyEvaluation.PlayerEvaluation(fOwner); + EnemyEval := gAIFields.Eye.ArmyEvaluation.AllianceEvaluation(fOwner, atEnemy); + + // Compute requirements of warriors + FillChar(AllyCounterWeightRatio, sizeOf(AllyCounterWeightRatio),#0); + FillChar(fWarriorsDemands, sizeOf(fWarriorsDemands),#0); + for GT := GROUP_TYPE_MIN to GROUP_TYPE_MAX do + ComputeGroupDemands(GT, IronRatio); + + // Get weapons reserves + for WT := Low(fRequiredWeapons) to High(fRequiredWeapons) do + begin + fRequiredWeapons[WT].Available := gHands[fOwner].Stats.GetWareBalance(WT); + fRequiredWeapons[WT].Required := 0; + end; + + // Get count of needed weapons + for UT := utAxeFighter to WARRIOR_EQUIPABLE_BARRACKS_MAX do // Skip militia + for I := Low(TROOP_COST[UT]) to High(TROOP_COST[UT]) do + if (TROOP_COST[UT,I] <> wtNone) then + begin + WT := TROOP_COST[UT,I]; + fRequiredWeapons[WT].Required := fRequiredWeapons[WT].Required + fWarriorsDemands[UT]; + end + else + break; + + // Make sure that we always produce something + CheckMinArmyReq(); + + // Calculate fraction of demands + for WT := Low(fRequiredWeapons) to High(fRequiredWeapons) do + with fRequiredWeapons[WT] do + Fraction := Max(1,Available) / Max(1,Required); + + // Dont produce bows and spears when we dont produce leather + if (gGame.Options.Peacetime < 45) AND ( + (gHands[fOwner].Stats.GetWareBalance(wtLeather) = 0) AND + (gHands[fOwner].Stats.GetWareBalance(wtLeatherArmor) = 0) ) then + begin + fRequiredWeapons[wtBow].Fraction := 1; + fRequiredWeapons[wtLance].Fraction := 1; + fRequiredWeapons[wtAxe].Fraction := 0; + end; + + // Calculate mean fraction of iron weapons and distribute steal + WeaponFraction := 0; + for WT in IRON_WEAPONS do + WeaponFraction := WeaponFraction + fRequiredWeapons[WT].Fraction; + WeaponFraction := WeaponFraction / 3.0; + if (fRequiredWeapons[wtIronArmor].Fraction > fRequiredWeapons[wtIronShield].Fraction) then + begin + ArmorFraction := 0; + for WT in IRON_ARMORS do + ArmorFraction := ArmorFraction + fRequiredWeapons[WT].Fraction; + ArmorFraction := ArmorFraction / 2.0; + end + else + ArmorFraction := fRequiredWeapons[wtIronArmor].Fraction; // Consider only metal armor in case that we have enough metal shields + // We always want the higher requirements equal to 5 + something between 1 <-> 5 for second production + IronShare := 5 * (WeaponFraction + ArmorFraction) / Max(WeaponFraction, ArmorFraction); + // Ware distribution = fraction / sum of fractions * 5 + gHands[fOwner].Stats.WareDistribution[wtIron, htWeaponSmithy] := Max( 1, Min(5, Round( ArmorFraction / (WeaponFraction + ArmorFraction) * IronShare) ) ); + gHands[fOwner].Stats.WareDistribution[wtIron, htArmorSmithy] := Max( 1, Min(5, Round( WeaponFraction / (WeaponFraction + ArmorFraction) * IronShare) ) ); + gHands[fOwner].Houses.UpdateDemands; +end; + + +// Distribute required weapons into exist houses (first will be produced the larger amount of wares) +procedure TKMCityManagement.OrderWeapons(); +const + WEAPONS_PER_A_UPDATE = 25; + PRODUCTION_HOUSES = [htArmorSmithy, htArmorWorkshop, htWeaponSmithy, htWeaponWorkshop]; +var + I, K, MaxIdx, HouseCnt: Integer; + MostRequired: Single; + HT: TKMHouseType; + WT, MaxWT: TKMWareType; + H: TKMHouse; +begin + MaxIdx := 0; // For compiler + for HT in PRODUCTION_HOUSES do + begin + // Check house cnt + HouseCnt := gHands[fOwner].Stats.GetHouseQty(HT); + if (HouseCnt = 0) then + Continue; + // Find produced ware which is the most required + MostRequired := 1.0; + MaxWT := wtNone; + for I := 1 to 4 do + begin + WT := gRes.Houses[HT].WareOutput[I]; + if (WT <> wtNone) AND (fRequiredWeapons[WT].Fraction < MostRequired) then + begin + MostRequired := fRequiredWeapons[WT].Fraction; + MaxWT := WT; + MaxIdx := I; + end; + end; + // Set order + if (MaxWT <> wtNone) then + for I := 0 to gHands[fOwner].Houses.Count - 1 do + if not gHands[fOwner].Houses[I].IsDestroyed then + begin + H := gHands[fOwner].Houses[I]; + if (H.HouseType <> HT) then + Continue; + for K := 1 to 4 do + H.WareOrder[K] := 0; + H.WareOrder[MaxIdx] := WEAPONS_PER_A_UPDATE; // With update each 1-2 minutes there is not need to calculate something more + if (HT = htArmorWorkshop) then + begin + for K := 1 to 4 do + begin + WT := gRes.Houses[HT].WareOutput[K]; + if (WT = wtLeatherArmor) then + begin + H.WareOrder[K] := 100; + Break; + end; + end; + end; + end; + end; +end; + + +procedure TKMCityManagement.LogStatus(var aBalanceText: UnicodeString); +const + COLOR_WHITE = '[$FFFFFF]'; + COLOR_RED = '[$0000FF]'; + COLOR_YELLOW = '[$00FFFF]'; + COLOR_GREEN = '[$00FF00]'; + WARFARE: array[WARFARE_MIN..WARFARE_MAX] of UnicodeString = + ('Shield ', 'MetalShield', 'Armor ', 'MetalArmor', 'Axe ', 'Sword ', + 'Pike ', 'Hallebard ', 'Bow ', 'Arbalet ', 'Horse '); +var + WT: TKMWareType; +begin + aBalanceText := aBalanceText + '||Weapons orders (weapon: Available, required, fraction)|'; + for WT := Low(fRequiredWeapons) to High(fRequiredWeapons) do + with fRequiredWeapons[WT] do + aBalanceText := aBalanceText + WARFARE[WT] + #9 + '(' + + Format( + COLOR_GREEN+'%D'+COLOR_WHITE+';' + #9 + +COLOR_RED+'%D'+COLOR_WHITE+';' + #9 + +COLOR_YELLOW+'%.2f'+COLOR_WHITE+')|', [Available, Required, Fraction] + ); +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_CityPlanner.pas b/vendor/kam_remake/src/ai/newAI/KM_CityPlanner.pas new file mode 100644 index 0000000..edc1387 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_CityPlanner.pas @@ -0,0 +1,3605 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_CityPlanner; +{$I KaM_Remake.inc} +interface +uses + SysUtils, Classes, Math, Contnrs, + KromUtils, + KM_Defaults, KM_Points, KM_CommonClasses, KM_CommonTypes, KM_CommonUtils, + KM_Houses, KM_ResHouses, KM_Sort, + KM_PathFindingRoad, KM_PathFindingAStarNew, KM_Eye, KM_AIParameters, + KM_AIInfluences, KM_NavMeshDefences, KM_CityPredictor, + KM_ResTypes; + +const + FARM_RADIUS = 11; + FIELDS_PER_FARM = 14; + FIELDS_PER_WINE = 9; + +type + THousePlan = record + Placed, ShortcutsCompleted, RemoveTreeInPlanProcedure, HouseReservation, ChopOnly: Boolean; + House: TKMHouse; + Loc, SpecPoint: TKMPoint; + end; + THousePlanArray = record + Count, // Number of houses + Completed, // Finished houses + UnderConstruction, // Digged plans + Planned: Word; // Reserved houses + Plans: array of THousePlan; + end; + TPlannedHousesArray = array [HOUSE_MIN..HOUSE_MAX] of THousePlanArray; + + TFieldEval = (feUnvisitedTile = 0, feFertileTile = 1, feExistingField = 2, feObstacle = 3); + TFieldPrice = array[-FARM_RADIUS..FARM_RADIUS,-FARM_RADIUS..FARM_RADIUS] of Integer; + TFieldMemory = record + Count, UpdateIdx: Word; + Farms: array of record + FieldAvailable: Boolean; + Center: TKMPoint; + FieldType: TKMFieldType; + Points: array[0..FIELDS_PER_FARM-1] of TKMPoint; + end; + end; + + TKMPathFindingCityPlanner = class(TKMPathFindingRoad) + protected + function IsWalkableTile(aX, aY: Word): Boolean; override; + function MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; override; + public + {$IFDEF DEBUG_NewAI} + Ctr: Word; + Price: array[0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Word; + Order: array[0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Word; + {$ENDIF} + function Route_Make(const aLocA, aLocB: TKMPoint; NodeList: TKMPointList): Boolean; reintroduce; + end; + + TKMPathFindingShortcutsCityPlanner = class(TKMPathFindingCityPlanner) + protected + function DestinationReached(aX, aY: Word): Boolean; override; + function MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; override; + end; + + + TKMFieldEvaluation = class + private + fMapX, fMapY: Word; + fOwner: TKMHandID; + fInitPoint: TKMPoint; + fQueue: TQueue; + fFieldType: TKMFieldType; + + function CanBeVisited(const aX,aY, aDistance: Word): Boolean; + procedure MarkAsVisited(const aX,aY, aDistance: Word); + procedure InsertInQueue(const aX,aY, aDistance: Word); + function RemoveFromQueue(var aX,aY, aDistance: Word): Boolean; + public + FieldEval: array[-FARM_RADIUS..FARM_RADIUS,-FARM_RADIUS..FARM_RADIUS] of TFieldEval; + FieldPrice: TFieldPrice; + + constructor Create(aMapX, aMapY: Word; aOwner: TKMHandID); + destructor Destroy(); override; + + procedure EvalField(aMaxDist: Word; aInitPoint: TKMPoint; aFieldType: TKMFieldType); + procedure OwnerUpdate(aPlayer: TKMHandID); + end; + + + // Create plan of city AfterMissionInit and update it during game (if it is required) + TKMCityPlanner = class + private + fDebugText: UnicodeString; + {$IFDEF DEBUG_NewAI} + fTimeSumSearchHouse: array[HOUSE_MIN..HOUSE_MAX] of Cardinal; + fTimePeakSearchHouse: array[HOUSE_MIN..HOUSE_MAX] of Cardinal; + fTimeSumBuildFFHouse: array[HOUSE_MIN..HOUSE_MAX] of Cardinal; + fTimePeakBuildFFHouse: array[HOUSE_MIN..HOUSE_MAX] of Cardinal; + fTimeSumSearchForest: Cardinal; + fTimePeakSearchForest: Cardinal; + fTimeSumPlanFields: Cardinal; + fTimePeakPlanFields: Cardinal; + fPlaceHouseDebugText: UnicodeString; + fPlaceFarmDebugText: UnicodeString; + fBestHouseLocs: TKMPointArray; + fBestHouseVal: TKMByteArray; + fForestDebugText: UnicodeString; + fFieldPrice: TFieldPrice; + + DA1: array [0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Integer; + DA2: array [0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Integer; + DA3: array [0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Integer; + DA4: array [0..MAX_MAP_SIZE,0..MAX_MAP_SIZE] of Integer; + {$ENDIF} + + fOwner: TKMHandID; + fPredictor: TKMCityPredictor; + fConstructedHouses: Word; + fDefenceTowersPlanned: Boolean; + fStonesDepleted: Boolean; + fPlannedHouses: TPlannedHousesArray; + fForestsInfo: TKMForestsInfo; + fFields: TFieldMemory; + + fRoadPlanner: TKMPathFindingCityPlanner; + fRoadShortcutPlanner: TKMPathFindingShortcutsCityPlanner; + fFieldEval: TKMFieldEvaluation; + + procedure AddPlan(aHT: TKMHouseType; aLoc: TKMPoint); overload; + procedure AddPlan(aHT: TKMHouseType; aLoc: TKMPoint; aSpecPoint: TKMPoint; aChopOnly: Boolean = False); overload; + function GetPlan(aHT: TKMHouseType; aOnlyLatest: Boolean; out aLoc: TKMPoint; out aIdx: Integer): Boolean; + + function ObstaclesInHousePlan(aHT: TKMHouseType; aLoc: TKMPoint): Single; + function FieldCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; + function SnapCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; + function DistCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; + + //procedure PlanWineFields(aLoc: TKMPoint; var aNodeList: TKMPointList); + //procedure PlanFarmFields(aLoc: TKMPoint; var aNodeList: TKMPointList); + procedure PlanFields(aCnt: Word; aLoc: TKMPoint; aFieldType: TKMFieldType; var aNodeList: TKMPointList; aReplaceFarmIdx: Integer = -1; aReplaceFieldIdx: Word = 0); + function FindPlaceForHouse(aIgnoreTrees: Boolean; aHT: TKMHouseType; out aBestLocs: TKMPointArray): Byte; + function FindPlaceForMines(aHT: TKMHouseType; var aLoc: TKMPoint): Boolean; + function FindPlaceForQuary(var StoneLocs: TKMPointTagList): Boolean; + function FindPlaceForWoodcutter(aCenter: TKMPoint; aChopOnly: Boolean = False): Boolean; + function FindForestAndWoodcutter(): Boolean; + function PlanDefenceTowers(): Boolean; + public + constructor Create(aPlayer: TKMHandID; aPredictor: TKMCityPredictor); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + procedure SyncLoad(); + + procedure AfterMissionInit(); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure UpdateState(aTick: Cardinal); + + // Properties for GA (in Runner) + property ConstructedHouses: Word read fConstructedHouses; + property PlannedHouses: TPlannedHousesArray read fPlannedHouses write fPlannedHouses; + property DefenceTowersPlanned: Boolean read fDefenceTowersPlanned; + property StonesDepleted: Boolean read fStonesDepleted; + + procedure MarkAsExhausted(aHT: TKMHouseType; aLoc: TKMPoint); + + procedure RemoveHouseType(aHT: TKMHouseType); + procedure RemovePlan(aHT: TKMHouseType; const aLoc: TKMPoint); overload; + procedure RemovePlan(aHT: TKMHouseType; aIdx: Integer); overload; + + function GetHousePlan(aIgnoreTrees, aIgnoreExistingPlans: Boolean; aHT: TKMHouseType; var aLoc: TKMPoint; var aIdx: Integer): Boolean; + function GetRoadBetweenPoints(aStart, aEnd: TKMPoint; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; + function GetRoadToHouse(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; + function GetFieldToHouse(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; + function GetTreesInHousePlan(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList): Byte; + function FindForestAround(const aPoint: TKMPoint; aCountByInfluence: Boolean = False): Boolean; + procedure CheckStoneReserves(aForceToPlaceQuarry: Boolean; aReqQuarryCnt: Integer); + function CheckFields(var aFieldType: TKMFieldType; var aNodeList: TKMPointList): Boolean; + + procedure LogStatus(var aBalanceText: UnicodeString); + procedure Paint(); + end; + + +const + HOUSE_DEPENDENCE: array[HOUSE_MIN..HOUSE_MAX] of set of TKMHouseType = ( // This array is sorted by priority + {htArmorSmithy} [ htCoalMine, htIronMine, htIronSmithy, htBarracks ], + {htArmorWorkshop} [ htSawmill, htTannery, htArmorWorkshop, htBarracks ], + {htBakery} [ htInn, htMill, htStore, htBakery ], + {htBarracks} [ htArmorWorkshop, htArmorSmithy, htWeaponSmithy, htWeaponWorkshop ], + {htButchers} [ htInn, htSwine, htStore, htButchers ], + {htCoalMine} [ htCoalMine, htGoldMine, htIronMine, htStore, htMetallurgists ], + {htFarm} [ htFarm, htSwine, htMill, htStables ], + {htFisherHut} [ htStore ], + {htGoldMine} [ htMetallurgists, htStore ], + {htInn} [ htButchers, htBakery, htStore, htVineyard ], + {htIronMine} [ htStore ], + {htIronSmithy} [ htCoalMine, htIronMine, htWeaponSmithy, htIronSmithy ], + {htMarket} [ htStore, htMetallurgists, htMarket, htBarracks ], + // Metallurgist must be only close to coal / gold because serfs are not able to support this extremely critical resources + {htMetallurgists} [ htCoalMine, htGoldMine ],// htSchool, htStore + {htMill} [ htBakery, htInn, htMill ], + {htQuary} [ htStore ], + {htSawmill} [ htArmorWorkshop, htSawmill, htWeaponWorkshop ], + {htSchool} [ htMetallurgists, htStore, htSchool ], + {htSiegeWorkshop} [ htIronSmithy, htSawmill, htStore, htSiegeWorkshop ], + {htStables} [ htFarm, htStables, htBarracks ], + {htStore} [ htInn, htSchool, htBarracks ], + {htSwine} [ htFarm, htButchers, htSwine ], + {htTannery} [ htArmorWorkshop, htTannery, htBarracks ], + {htTownHall} [ htMetallurgists, htStore, htTownHall ], + {htWatchTower} [ htStore ], + {htWeaponSmithy} [ htIronSmithy, htCoalMine, htBarracks, htIronMine ], + {htWeaponWorkshop} [ htSawmill, htWeaponWorkshop, htBarracks ], + {htVineyard} [ htInn, htQuarry, htCoalMine ], + {htWoodcutters} [ htStore ] + ); + +implementation +uses + KM_Entity, + KM_GameParams, + KM_HouseCollection, + KM_HandsCollection, KM_Hand, KM_HandTypes, + KM_Terrain, KM_Resource, + KM_AIFields, + KM_PathFinding, + KM_NavMesh, KM_HouseWoodcutters, KM_ResUnits, + KM_RenderAux, KM_ResMapElements; + + +{ Procedural functions } +function CompareForests(const aElem1, aElem2): Integer; +var + val1: TKMForestInfo absolute aElem1; + val2: TKMForestInfo absolute aElem2; +begin + //@Toxic: Possibly can replace with CompareValue() + if (val1.Bid = val2.Bid) then Result := 0 + else if (val1.Bid < val2.Bid) then Result := -1 + else Result := +1; +end; + + +{ TKMCityPlanner } +constructor TKMCityPlanner.Create(aPlayer: TKMHandID; aPredictor: TKMCityPredictor); +var + HT: TKMHouseType; +begin + fPredictor := aPredictor; + for HT := HOUSE_MIN to HOUSE_MAX do + with fPlannedHouses[HT] do + begin + Count := 0; + Completed := 0; + UnderConstruction := 0; + Planned := 0; + end; + fDebugText := ''; + {$IFDEF DEBUG_NewAI} + FillChar(fTimeSumSearchHouse, SizeOf(fTimeSumSearchHouse), #0); + FillChar(fTimePeakSearchHouse, SizeOf(fTimePeakSearchHouse), #0); + FillChar(fTimeSumBuildFFHouse, SizeOf(fTimeSumBuildFFHouse), #0); + FillChar(fTimePeakBuildFFHouse, SizeOf(fTimePeakBuildFFHouse), #0); + fTimeSumPlanFields := 0; + fTimePeakPlanFields := 0; + fTimeSumSearchForest := 0; + fTimePeakSearchForest := 0; + {$ENDIF} + fConstructedHouses := 0; + fOwner := aPlayer; + fDefenceTowersPlanned := False; + fStonesDepleted := False; + fForestsInfo.Count := 0; + SetLength(fForestsInfo.Forests,0); + fFields.Count := 0; + fFields.UpdateIdx := 0; + SetLength(fFields.Farms,0); + fRoadPlanner := TKMPathFindingCityPlanner.Create(fOwner); + fRoadShortcutPlanner := TKMPathFindingShortcutsCityPlanner.Create(fOwner); + fFieldEval := TKMFieldEvaluation.Create(gTerrain.MapX, gTerrain.MapY, fOwner); +end; + + +destructor TKMCityPlanner.Destroy(); +var + HT: TKMHouseType; + I: Integer; +begin + for HT := HOUSE_MIN to HOUSE_MAX do + for I := 0 to fPlannedHouses[HT].Count - 1 do + with fPlannedHouses[HT].Plans[I] do + if (House <> nil) then + gHands.CleanUpHousePointer(House); + + fRoadPlanner.Free; + fRoadShortcutPlanner.Free; + fFieldEval.Free; + + inherited; +end; + + +procedure TKMCityPlanner.Save(SaveStream: TKMemoryStream); +var + HT: TKMHouseType; + K, Len: Integer; +begin + SaveStream.PlaceMarker('CityPlanner'); + SaveStream.Write(fOwner); + SaveStream.Write(fConstructedHouses); + SaveStream.Write(fDefenceTowersPlanned); + SaveStream.Write(fStonesDepleted); + SaveStream.Write(fForestsInfo.Count); + if (fForestsInfo.Count > 0) then + SaveStream.Write(fForestsInfo.Forests[0], SizeOf(TKMForestInfo) * fForestsInfo.Count); + SaveStream.Write(fFields.Count); + SaveStream.Write(fFields.UpdateIdx); + if (fFields.Count > 0) then + SaveStream.Write(fFields.Farms[0], SizeOf(fFields.Farms[0]) * fFields.Count); + + for HT := HOUSE_MIN to HOUSE_MAX do + begin + SaveStream.Write(fPlannedHouses[HT].Count); + SaveStream.Write(fPlannedHouses[HT].Completed); + SaveStream.Write(fPlannedHouses[HT].UnderConstruction); + SaveStream.Write(fPlannedHouses[HT].Planned); + Len := Length(fPlannedHouses[HT].Plans); + SaveStream.Write( Len ); + for K := 0 to fPlannedHouses[HT].Count - 1 do + with fPlannedHouses[HT].Plans[K] do + begin + SaveStream.Write(Placed); + SaveStream.Write(ShortcutsCompleted); + SaveStream.Write(RemoveTreeInPlanProcedure); + SaveStream.Write(HouseReservation); + SaveStream.Write(ChopOnly); + SaveStream.Write(House.UID); // Store ID + SaveStream.Write(Loc, SizeOf(Loc)); + SaveStream.Write(SpecPoint, SizeOf(SpecPoint)); + end; + end; + + fRoadPlanner.Save(SaveStream); + fRoadShortcutPlanner.Save(SaveStream); +end; + + +procedure TKMCityPlanner.Load(LoadStream: TKMemoryStream); +var + HT: TKMHouseType; + K, Len: Integer; +begin + LoadStream.CheckMarker('CityPlanner'); + LoadStream.Read(fOwner); + LoadStream.Read(fConstructedHouses); + LoadStream.Read(fDefenceTowersPlanned); + LoadStream.Read(fStonesDepleted); + LoadStream.Read(fForestsInfo.Count); + SetLength(fForestsInfo.Forests,fForestsInfo.Count); + if (fForestsInfo.Count > 0) then + LoadStream.Read(fForestsInfo.Forests[0],SizeOf(TKMForestInfo) * fForestsInfo.Count); + LoadStream.Read(fFields.Count); + LoadStream.Read(fFields.UpdateIdx); + SetLength(fFields.Farms,fFields.Count); + if (fFields.Count > 0) then + LoadStream.Read(fFields.Farms[0], SizeOf(fFields.Farms[0]) * fFields.Count); + + for HT := HOUSE_MIN to HOUSE_MAX do + begin + LoadStream.Read(fPlannedHouses[HT].Count); + LoadStream.Read(fPlannedHouses[HT].Completed); + LoadStream.Read(fPlannedHouses[HT].UnderConstruction); + LoadStream.Read(fPlannedHouses[HT].Planned); + LoadStream.Read(Len); + SetLength(fPlannedHouses[HT].Plans, Len); + for K := 0 to fPlannedHouses[HT].Count - 1 do + with fPlannedHouses[HT].Plans[K] do + begin + LoadStream.Read(Placed); + LoadStream.Read(ShortcutsCompleted); + LoadStream.Read(RemoveTreeInPlanProcedure); + LoadStream.Read(HouseReservation); + LoadStream.Read(ChopOnly); + LoadStream.Read(House, 4); // Load ID + LoadStream.Read(Loc, SizeOf(Loc)); + LoadStream.Read(SpecPoint, SizeOf(SpecPoint)); + end; + end; + + fRoadPlanner.Load(LoadStream); + fRoadShortcutPlanner.Load(LoadStream); + fFieldEval.OwnerUpdate(fOwner); // UPDATE OWNER AFTER LOAD +end; + + +procedure TKMCityPlanner.SyncLoad(); +var + HT: TKMHouseType; + K: Integer; +begin + for HT := HOUSE_MIN to HOUSE_MAX do + for K := 0 to fPlannedHouses[HT].Count - 1 do + with fPlannedHouses[HT].Plans[K] do + House := gHands.GetHouseByUID(Integer(House)); +end; + + +procedure TKMCityPlanner.AfterMissionInit(); +begin + // Actual houses will be added in UpdateState (script may remove / add something after mission init ...) + UpdateState(0); +end; + +procedure TKMCityPlanner.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fRoadPlanner.OwnerUpdate(aPlayer); + fRoadShortcutPlanner.OwnerUpdate(aPlayer); + fFieldEval.OwnerUpdate(aPlayer); +end; + + +procedure TKMCityPlanner.UpdateState(aTick: Cardinal); + procedure ScanChopOnly(aW: TKMHouseWoodcutters); + begin + if (aW.CheckWareOut(wtAll) <> 0) then // There is still trunk + Exit; + if not gTerrain.CanFindTree(aW.FlagPoint, gRes.Units[utWoodcutter].MiningRange, True) then + begin + RemovePlan(htWoodcutters, aW.Entrance); + aW.Demolish(fOwner); + end; + end; + + procedure CheckWoodcutter(aHousePlan: THousePlan; aCheckChopOnly: Boolean); + var + Point: TKMPoint; + W: TKMHouseWoodcutters; + begin + // Make sure that this house is woodcutter + if (aHousePlan.House.HouseType <> htWoodcutters) then + Exit; + W := TKMHouseWoodcutters(aHousePlan.House); + // Check if is cutting point required (compare with default cutting point) + if not KMSamePoint(aHousePlan.SpecPoint, KMPOINT_ZERO) AND not W.IsFlagPointSet then + // Set the cutting point - do it only once because it reset empty message (woodcutters in chop only mode will not be destroyed) + W.FlagPoint := aHousePlan.SpecPoint; + // Check chop-only mode + Point := W.FlagPoint; + if aHousePlan.ChopOnly AND (gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] < AVOID_BUILDING_FOREST_MINIMUM) then + begin + if aCheckChopOnly then + ScanChopOnly(W); + if (W.WoodcutterMode <> wmChop) then // Center of forest is not in protected area => chop only mode + W.WoodcutterMode := wmChop + end + else if (W.WoodcutterMode <> wmChopAndPlant) then + W.WoodcutterMode := wmChopAndPlant; + end; + +const + WOODCUT_CHOP_ONLY_CHECK = MAX_HANDS * 100; +var + CheckChopOnly, CheckExistHouse, HouseExist: Boolean; + CompletedHouses,HousesUnderConstruction, PlannedHouses: Word; + I,K: Integer; + HT: TKMHouseType; + H: TKMHouse; +begin + // Priority: function is called from CityBuilder only in right time + CheckChopOnly := (aTick mod WOODCUT_CHOP_ONLY_CHECK = fOwner); + // Find new houses which are added by player / script / at the start of mission etc. and connect them with city plan + for I := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[I]; + if (H <> nil) AND not H.IsDestroyed then + begin + HT := H.HouseType; + CheckExistHouse := False; + for K := 0 to fPlannedHouses[HT].Count - 1 do + if KMSamePoint(fPlannedHouses[HT].Plans[K].Loc, H.Entrance) then + begin + if (fPlannedHouses[HT].Plans[K].House <> H) then + begin + // Make sure that reservation is no longer used + gHands[fOwner].AI.CityManagement.Builder.UnlockHouseLoc(HT, H.Entrance); + if (HT = htWoodcutters) then + gAIFields.Influences.MarkForest(fPlannedHouses[HT].Plans[K].SpecPoint, AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Radius], Min(AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_ABRange],AVOID_BUILDING_FOREST_RANGE-1) / sqr(AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Radius]), True); + if (fPlannedHouses[HT].Plans[K].House <> nil) then + gHands.CleanUpHousePointer(fPlannedHouses[HT].Plans[K].House); + fPlannedHouses[HT].Plans[K].House := H.GetPointer; + end; + CheckExistHouse := True; + Break; + end; + if not CheckExistHouse then // House was added by script / spectator in debug mode + begin + if (HT = htWoodcutters) then + AddPlan(HT, H.Entrance, TKMHouseWoodcutters(H).FlagPoint, TKMHouseWoodcutters(H).WoodcutterMode = wmChop) + else + AddPlan(HT, H.Entrance); + with fPlannedHouses[HT].Plans[fPlannedHouses[HT].Count-1] do + begin + House := H.GetPointer; + Placed := True; + end; + end; + end; + end; + // Check if are existing houses completed / destroyed + fConstructedHouses := 0; + for HT := Low(fPlannedHouses) to High(fPlannedHouses) do + begin + CompletedHouses := 0; + HousesUnderConstruction := 0; + PlannedHouses := 0; + for I := 0 to fPlannedHouses[HT].Count - 1 do + with fPlannedHouses[HT].Plans[I] do + begin + HouseExist := ((House <> nil) AND not House.IsDestroyed); + Placed := HouseExist OR gHands[fOwner].Constructions.HousePlanList.ExistPlan(Loc, HT); + if Placed then // House was placed + begin + if (HouseExist AND House.IsComplete) then + CompletedHouses := CompletedHouses + 1 + else + begin + fConstructedHouses := fConstructedHouses + 1; + HousesUnderConstruction := HousesUnderConstruction + 1; + end; + if (HT = htWoodcutters) then // Another exception for woodcutters + begin + if ChopOnly AND HouseExist AND House.IsComplete then // Dont consider choponly woodcutters + CompletedHouses := CompletedHouses - 1; + if (House <> nil) AND House.IsComplete then + CheckWoodcutter(fPlannedHouses[HT].Plans[I], CheckChopOnly); + end; + end + else if HouseReservation OR RemoveTreeInPlanProcedure then // House was reserved + begin + PlannedHouses := PlannedHouses + 1; + end + else // House was destroyed + begin + if (House <> nil) then + gHands.CleanUpHousePointer(House); + end; + end; + with fPlannedHouses[HT] do + begin + Completed := CompletedHouses; + UnderConstruction := HousesUnderConstruction; + Planned := PlannedHouses; + end; + end; +end; + + +procedure TKMCityPlanner.AddPlan(aHT: TKMHouseType; aLoc: TKMPoint); +begin + AddPlan(aHT, aLoc, KMPOINT_ZERO); // Cannot declare KMPOINT_ZERO as a default value so overload method is used instead +end; + +procedure TKMCityPlanner.AddPlan(aHT: TKMHouseType; aLoc: TKMPoint; aSpecPoint: TKMPoint; aChopOnly: Boolean = False); +const + ADD_VALUE = 8; +begin + // Check size of array + if (fPlannedHouses[aHT].Count >= Length(fPlannedHouses[aHT].Plans)) then + SetLength(fPlannedHouses[aHT].Plans, fPlannedHouses[aHT].Count + ADD_VALUE); + // Add plan + with fPlannedHouses[aHT].Plans[ fPlannedHouses[aHT].Count ] do + begin + Placed := False; + ShortcutsCompleted := False; + RemoveTreeInPlanProcedure := False; + HouseReservation := False; + ChopOnly := aChopOnly; + Loc := aLoc; + SpecPoint := aSpecPoint; + House := nil; + end; + fPlannedHouses[aHT].Count := fPlannedHouses[aHT].Count + 1; +end; + + +function TKMCityPlanner.GetPlan(aHT: TKMHouseType; aOnlyLatest: Boolean; out aLoc: TKMPoint; out aIdx: Integer): Boolean; +const + MAX_BID = 1000000; + CHOP_ONLY_ADVANTAGE = 200; + + // Try find gold / iron in range of mine + function IsExhaustedMine(aMineLoc: TKMPoint; aIsGold: Boolean): Boolean; + var + Y, X: Integer; + begin + Result := False; + for X := Max(aMineLoc.X-4, 1) to Min(aMineLoc.X+3, gTerrain.MapX-1) do + for Y := Max(aMineLoc.Y-8, 1) to aMineLoc.Y do + if ( not aIsGold AND gTerrain.TileHasIron(X, Y) ) + OR ( aIsGold AND gTerrain.TileHasGold(X, Y) ) then + Exit; + Result := True; + end; + + function IsExhaustedQuary(aQuaryLoc: TKMPoint): Boolean; + var + Y, X: Integer; + const + RADIUS = 15; + begin + Result := False; + for Y := Max(aQuaryLoc.Y-RADIUS, 1) to Min(aQuaryLoc.Y+RADIUS, gTerrain.MapY-1) do + for X := Max(aQuaryLoc.X-RADIUS, 1) to Min(aQuaryLoc.X+RADIUS, gTerrain.MapX-1) do + if gTerrain.TileHasStone(X, Y) then + Exit; + Result := True; + end; + + function IsExhaustedCoalMine(aCoalLoc: TKMPoint): Boolean; + var + X,Y,I: Integer; + begin + Result := False; + for I := Low(gAIFields.Eye.HousesMapping[htCoalMine].Tiles) to High(gAIFields.Eye.HousesMapping[htCoalMine].Tiles) do + begin + X := aCoalLoc.X + gAIFields.Eye.HousesMapping[htCoalMine].Tiles[I].X; + Y := aCoalLoc.Y + gAIFields.Eye.HousesMapping[htCoalMine].Tiles[I].Y; + if gTerrain.TileHasCoal(X, Y) then + Exit; + end; + Result := True; + end; + + function CheckMine(aIdx: Integer): Boolean; + var + Exhausted: Boolean; + begin + Exhausted := False; + with fPlannedHouses[aHT].Plans[aIdx] do + begin + case aHT of + htGoldMine: Exhausted := IsExhaustedMine(Loc, True); + htIronMine: Exhausted := IsExhaustedMine(Loc, False); + htCoalMine: Exhausted := IsExhaustedCoalMine(Loc); + htQuarry: Exhausted := IsExhaustedQuary(Loc); + else + begin + end; + end; + if Exhausted then + RemovePlan(aHT, aIdx); + Result := Exhausted; + end + end; + + function DistFromStore(aLoc: TKMPoint): Single; + var + I: Integer; + Output, Bid: Single; + begin + Output := MAX_BID; + for I := 0 to fPlannedHouses[htStore].Count - 1 do + begin + Bid := KMDistanceAbs(aLoc, fPlannedHouses[htStore].Plans[I].Loc); + if (Bid < Output) then + Output := Bid; + end; + if (Output = MAX_BID) then + Output := 0; + Result := Output; + end; +var + Output: Boolean; + I, BestIdx: Integer; + Bid, BestBid: Single; +begin + Output := False; + BestBid := MAX_BID; + BestIdx := 0; // For compiler + for I := fPlannedHouses[aHT].Count - 1 downto 0 do + with fPlannedHouses[aHT].Plans[I] do + if not Placed then + begin + if RemoveTreeInPlanProcedure OR gAIFields.Eye.CanAddHousePlan(Loc, aHT, True, True) then + begin + if (aHT in [htGoldMine, htIronMine, htCoalMine, htQuarry]) AND CheckMine(I) then // Filter mines / chop-only woodcutters + Continue; + Bid := //+ DistFromStore(Loc) + + ObstaclesInHousePlan(aHT, Loc) + - gAIFields.Influences.OwnPoint[fOwner, Loc] + - Byte((aHT = htWoodcutters) AND ChopOnly) * CHOP_ONLY_ADVANTAGE; // Chop only mode + if (Bid < BestBid) then + begin + BestBid := Bid; + BestIdx := I; + end; + if aOnlyLatest then + Break; + end + else + RemovePlan(aHT, I); + end; + if (BestBid <> MAX_BID) then + begin + aLoc := fPlannedHouses[aHT].Plans[BestIdx].Loc; + aIdx := BestIdx; + Output := True; + end; + Result := Output; +end; + + +procedure TKMCityPlanner.MarkAsExhausted(aHT: TKMHouseType; aLoc: TKMPoint); + function IsOrCanBeRoad(aX,aY: Integer): Boolean; + begin + Result := (tpWalkRoad in gTerrain.Land^[aY, aX].Passability) // Completed road + OR (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aX, aY)) = ftRoad) // Placed road plan + OR (gTerrain.Land^[aY, aX].TileLock = tlRoadWork); // Road under construction + end; +begin + RemovePlan(aHT, aLoc); + if (aHT = htCoalMine) AND IsOrCanBeRoad(aLoc.X+1, aLoc.Y+1) then + AddPlan(htVineyard, KMPoint(aLoc.X+1, aLoc.Y)) +end; + + +// Remove one of placed houses +procedure TKMCityPlanner.RemoveHouseType(aHT: TKMHouseType); +const + INIT_BID = 10000; + RESOURCE_PRICE = 1; + PRODUCT_PRICE = 5; + MAX_BID = 8; +var + Idx, BestIdx: Integer; + Bid, BestBid: Single; + H: TKMHouse; +begin + BestBid := INIT_BID; + BestIdx := 0; + for Idx := 0 to fPlannedHouses[aHT].Count - 1 do + with fPlannedHouses[aHT].Plans[Idx] do + begin + if not Placed then // Only plan -> remove it have high priority + begin + BestBid := 0; + BestIdx := Idx; + break; + end + else // Plan was placed or there is already house + begin + if (fPlannedHouses[aHT].Plans[Idx].House = nil) then // Plan was placed + begin + BestBid := 0; + BestIdx := Idx; + // Dont break for cycle - maybe there is unplaced plan + end + else // There is house + begin + H := fPlannedHouses[aHT].Plans[Idx].House; + Bid := H.CheckWareIn(wtAll) * RESOURCE_PRICE + H.CheckWareOut(wtAll) * PRODUCT_PRICE; + if (Bid < BestBid) then // Select house with lowest amount of resources + begin + BestBid := Bid; + BestIdx := Idx; + end; + end; + end; + end; + if (BestBid < MAX_BID) then + with fPlannedHouses[aHT].Plans[BestIdx] do + begin + if Placed then + begin + if (House = nil) then + gHands[fOwner].RemHousePlan(Loc) + else + House.Demolish(fOwner); + end; + RemovePlan(aHT, BestIdx); + end; +end; + +procedure TKMCityPlanner.RemovePlan(aHT: TKMHouseType; const aLoc: TKMPoint); +var + I: Integer; +begin + for I := 0 to fPlannedHouses[aHT].Count - 1 do + if KMSamePoint(fPlannedHouses[aHT].Plans[I].Loc, aLoc) then + begin + RemovePlan(aHT, I); + Exit; + end; +end; + +procedure TKMCityPlanner.RemovePlan(aHT: TKMHouseType; aIdx: Integer); +begin + with fPlannedHouses[aHT] do + begin + if (aIdx >= Count) then + Exit; + if (Plans[aIdx].House = nil) then // Unlock house plan + gHands[fOwner].AI.CityManagement.Builder.UnLockHouseLoc(aHT, Plans[aIdx].Loc); + Count := Count - 1; + Plans[aIdx] := Plans[Count]; + end; +end; + + +function TKMCityPlanner.GetHousePlan(aIgnoreTrees, aIgnoreExistingPlans: Boolean; aHT: TKMHouseType; var aLoc: TKMPoint; var aIdx: Integer): Boolean; +var + Output: Boolean; + Cnt: Byte; + BestLocs: TKMPointArray; +begin + if not aIgnoreExistingPlans AND GetPlan(aHT, False, aLoc, aIdx) then + Output := True + else + begin + case aHT of + htWoodcutters: FindForestAndWoodcutter(); + htGoldMine, htIronMine: FindPlaceForMines(aHT, aLoc); + htCoalMine: + begin + if FindPlaceForMines(aHT, aLoc) then + gHands[fOwner].AI.CityManagement.Builder.LockHouseLoc(htCoalMine, aLoc); + end; + htQuarry: + begin + CheckStoneReserves(True,0); + end; + htWatchTower: + begin + if not fDefenceTowersPlanned then + begin + fDefenceTowersPlanned := True; + PlanDefenceTowers(); + end; + end; + else + begin + Cnt := FindPlaceForHouse(aIgnoreTrees, aHT, BestLocs); + if (Cnt > 0) then + begin + aLoc := BestLocs[0]; + AddPlan(aHT, aLoc); + gHands[fOwner].AI.CityManagement.Builder.LockHouseLoc(aHT, aLoc); + FindForestAround(aLoc, False); + end; + end; + end; + Output := GetPlan(aHT, True, aLoc, aIdx); + end; + Result := Output; +end; + + +function TKMCityPlanner.GetRoadToHouse(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; + function IsRoad(aP: TKMPoint): Boolean; + begin + Result := (gAIFields.Influences.AvoidBuilding[aP.Y, aP.X] = AVOID_BUILDING_NODE_LOCK_ROAD) // Reserved road plan + OR (tpWalkRoad in gTerrain.Land^[aP.Y, aP.X].Passability) // Completed road + OR (gHands[fOwner].Constructions.FieldworksList.HasField(aP) = ftRoad) // Placed road plan + OR (gTerrain.Land^[aP.Y, aP.X].TileLock = tlRoadWork); // Road under construction + end; +// New house plan may overlap existing road -> new road must be done (new road will extend aField list) + procedure ReplaceOverlappingRoad(aLoc: TKMPoint); + const + VECTOR_ARR: array[0..3] of TKMPoint = ( (X:0; Y:1), (X:1; Y:0), (X:0; Y:-1), (X:-1; Y:0) ); // Move actual position to left, top, right and down + var + I,K,RoadsInsidePlanIdx: Integer; + Point: TKMPoint; + Road, Path: TKMPointList; + begin + Road := TKMPointList.Create(); + Path := TKMPointList.Create(); + try + // Find all road inside of newly placed house plan + for I := Low(gAIFields.Eye.HousesMapping[aHT].Tiles) to High(gAIFields.Eye.HousesMapping[aHT].Tiles) do + begin + Point := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[aHT].Tiles[I]); + if IsRoad(Point) then + Road.Add(Point); + end; + // Get outside roads which are connected to road plans inside of the house + RoadsInsidePlanIdx := Road.Count - 1; // Use Road list for those points + if RoadsInsidePlanIdx >= 0 then + begin + for I := RoadsInsidePlanIdx downto 0 do + for K := Low(VECTOR_ARR) to High(VECTOR_ARR) do + begin + Point := KMPointAdd(Road.Items[I], VECTOR_ARR[K]); + if IsRoad(Point) AND not Road.Contains(Point) then + Road.Add(Point); + end; + Point := Road.Items[RoadsInsidePlanIdx + 1]; + for I := RoadsInsidePlanIdx + 2 to Road.Count - 1 do + begin + Path.Clear; + if fRoadShortcutPlanner.Route_Make(Road.Items[I], Point, Path) then + for K := 0 to Path.Count - 1 do + aField.Add(Path.Items[K]); + end; + end; + finally + Road.Free; + Path.Free; + end; + end; + function FindClosestHouseEntrance(var aNewLoc, aExistLoc: TKMPoint): Boolean; + const + INIT_DIST = 1000000; + MAX_WATCHTOWER_DIST = 10; + var + K: Integer; + Dist, BestDist: Single; + Loc: TKMPoint; + HT: TKMHouseType; + begin + BestDist := INIT_DIST; + for HT := HOUSE_MIN to HOUSE_MAX do + for K := 0 to fPlannedHouses[HT].Count - 1 do + //if ((HT <> htWatchTower) OR (fPlannedHouses[HT].Plans[K].Placed))// Only placed houses in case of WatchTower + if (fPlannedHouses[HT].Plans[K].Placed)// Only placed houses in case of WatchTower + AND not fPlannedHouses[HT].Plans[K].RemoveTreeInPlanProcedure // Ignore Remove tree in plan procedure because there is not builded road + AND not KMSamePoint(fPlannedHouses[HT].Plans[K].Loc, aNewLoc) // Ignore itself + AND ((HT <> htWoodcutters) OR not fPlannedHouses[HT].Plans[K].ChopOnly) // Chop only woodcutters are planned without road connection so skip it + AND ((aHT <> htSchool) OR not fPlannedHouses[HT].Plans[K].HouseReservation) then // Dont connect first school with house plan + begin + Loc := fPlannedHouses[HT].Plans[K].Loc; + Dist := abs(Loc.X - aNewLoc.X) + abs(Loc.Y - aNewLoc.Y) * 1.5; // Prefer to connect road in X axis + // Watchtowers may be far from the city and path may leads out of protected area + // so if is distance from closest watchtower too far away better select other house type + // -> secure that path will lead directly to the city + if (Dist < BestDist) AND ( (aHT <> htWatchTower) OR (HT <> htWatchTower) OR (Dist < MAX_WATCHTOWER_DIST) ) then + begin + BestDist := Dist; + aExistLoc := Loc; + end; + end; + Result := BestDist <> INIT_DIST; + end; + + function CheckRoadToTowers(): Boolean; + const + MAX_ENEMY_INFLUENCE = 150; + var + PolygonIdx: Word; + K: Integer; + begin + Result := False; + // Check road and if it goes to enemy influence remove house plan + K := 0; + while (K < aField.Count) do + begin + PolygonIdx := gAIFields.NavMesh.KMPoint2Polygon[ aField[K] ]; + if (gAIFields.Influences.GetBestAllianceOwnership(fOwner, PolygonIdx, atEnemy) > MAX_ENEMY_INFLUENCE) then + Exit; + K := K + 5; + end; + Result := True; + end; + +const + MAX_ROAD_DISTANCE = 90; +var + Output: Boolean; + NewLoc, ExistLoc: TKMPoint; + //H: TKMHouse; +begin + aFieldType := ftRoad; + ExistLoc := KMPOINT_ZERO; + NewLoc := fPlannedHouses[aHT].Plans[aIdx].Loc; + Output := FindClosestHouseEntrance(NewLoc, ExistLoc); // Only placed in case of htWatchTower (htWatchTower are planned at once) + //H := gHands[fOwner].Houses.FindHouse(htAny, NewLoc.X, NewLoc.Y, 1, False); // True = complete house, False = house plan + //if (H <> nil) then + //begin + // Output := True; + // ExistLoc := H.PointBelowEntrance; + //end; + if Output AND fRoadPlanner.Route_Make(KMPointBelow(NewLoc), KMPointBelow(ExistLoc), aField) then + begin + if not ((aField.Count < MAX_ROAD_DISTANCE) OR (aHT = htWatchtower)) then + begin + Output := False; + RemovePlan(aHT,aIdx); + if (aHT in [htGoldMine, htIronMine, htCoalMine]) then + fPredictor.MarkExhaustedMine(aHT); + end + else + begin + Output := True; + ReplaceOverlappingRoad( fPlannedHouses[aHT].Plans[aIdx].Loc ); + + if (aHT = htWatchtower) AND not CheckRoadToTowers() then + begin + Output := False; + RemovePlan(aHT,aIdx); + end; + end; + end + else + begin + Output := False; + RemovePlan(aHT,aIdx); + end; + // Make sure list is empty + if not Output then + aField.Count := 0; + Result := Output; +end; + + +function TKMCityPlanner.GetRoadBetweenPoints(aStart, aEnd: TKMPoint; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; +var + Output: Boolean; +begin + Output := False; + aFieldType := ftRoad; + if fRoadShortcutPlanner.Route_Make(aEnd, aStart, aField) then + Output := True; + Result := Output; +end; + + +function TKMCityPlanner.GetFieldToHouse(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList; var aFieldType: TKMFieldType): Boolean; +begin + Result := (aHT in [htFarm, htVineyard]); + if not Result then + Exit; + + aFieldType := ftCorn; + if (aHT = htVineyard) then + aFieldType := ftWine; + aField.Clear; + PlanFields( IfThen(aHT = htVineyard,FIELDS_PER_WINE,FIELDS_PER_FARM), fPlannedHouses[aHT].Plans[aIdx].Loc, aFieldType, aField ); +end; + + +function TKMCityPlanner.GetTreesInHousePlan(aHT: TKMHouseType; aIdx: Integer; var aField: TKMPointList): Byte; +var + I: Integer; + Point: TKMPoint; +begin + aField.Clear; + for I := Low(gAIFields.Eye.HousesMapping[aHT].Tiles) to High(gAIFields.Eye.HousesMapping[aHT].Tiles) do + begin + Point := KMPointAdd( fPlannedHouses[aHT].Plans[aIdx].Loc, gAIFields.Eye.HousesMapping[aHT].Tiles[I] ); + if gTerrain.ObjectIsChopableTree(Point, [caAge1,caAge2,caAge3,caAgeFull]) then + aField.Add(Point); + end; + if (aField.Count > 0) then + for I := Low(gAIFields.Eye.HousesMapping[aHT].Tiles) to High(gAIFields.Eye.HousesMapping[aHT].Tiles) do + begin + Point := KMPointAdd( fPlannedHouses[aHT].Plans[aIdx].Loc, gAIFields.Eye.HousesMapping[aHT].Tiles[I] ); + if (gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] = 0) then + gAIFields.Influences.AvoidBuilding[Point.Y, Point.X] := 10; + end; + Result := aField.Count; +end; + + +{ +procedure TKMCityPlanner.PlanWineFields(aLoc: TKMPoint; var aNodeList: TKMPointList); +const + MAX_VINE = 10; +var + I,Dist: Integer; + Dir: TDirection; + HT: TKMHouseType; + FieldLoc: TKMPoint; +begin + HT := htVineyard; + for Dist := 1 to 4 do + begin + for Dir := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) do + for I := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) do + begin + FieldLoc := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir,I]); + if gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) // Tile must be in map + AND gHands[fOwner].CanAddFieldPlan(FieldLoc, ftWine) // Plan can be placed + AND (gAIFields.Influences.AvoidBuilding[FieldLoc.Y, FieldLoc.X] <= AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) then // Tile is not reserved + begin + aNodeList.Add(FieldLoc); + gAIFields.Influences.AvoidBuilding[FieldLoc.Y, FieldLoc.X] := AVOID_BUILDING_NODE_LOCK_FIELD; + end; + if (aNodeList.Count >= MAX_VINE) then + Exit; + end; + end; +end; + + +procedure TKMCityPlanner.PlanFarmFields(aLoc: TKMPoint; var aNodeList: TKMPointList); +type + TDirArrInt = array[TDirection] of Integer; + TDirArrByte = array[TDirection] of Byte; +const + MAX_FIELDS = 15; + SNAP_TO_EDGE = 5; + FIELD_PRICE = 1; + DIR_PRICE: array[TDirection] of Byte = (5,15,20,15); //(dirN,dirE,dirS,dirW); + PRICE_ARR_CONST: TDirArrInt = (0,0,0,0); + CNT_ARR_CONST: TDirArrByte = (0,0,0,0); +var + I,Dist: Integer; + Dir, BestDir: TDirection; + HT: TKMHouseType; + FieldLoc: TKMPoint; + PriceArr: TDirArrInt; + CntArr: TDirArrByte; +begin + PriceArr := PRICE_ARR_CONST; + CntArr := CNT_ARR_CONST; + HT := htFarm; + // Get best edge of current loc (try build field in edges) + Dist := 5; + for Dir := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) do + for I := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) + Dist to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) - Dist + 1 do + begin + FieldLoc := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir,I]); + if not gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) + OR not gTerrain.TileIsRoadable( FieldLoc ) then + PriceArr[Dir] := PriceArr[Dir] + SNAP_TO_EDGE; + end; + // Get count of possible fields + for Dist := 1 to 4 do + for Dir := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist]) do + for I := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) + Dist to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) - Dist + 1 do + begin + FieldLoc := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir,I]); + if gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) // Tile must be in map + AND gHands[fOwner].CanAddFieldPlan(FieldLoc, ftCorn) // Plan can be placed + AND (gAIFields.Influences.AvoidBuilding[FieldLoc.Y, FieldLoc.X] <= AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) then // Tile is not reserved + CntArr[Dir] := CntArr[Dir] + FIELD_PRICE; + end; + // Compute price of each direction + for Dir := Low(PriceArr) to High(PriceArr) do + PriceArr[Dir] := PriceArr[Dir] + CntArr[Dir] + DIR_PRICE[Dir]; + // Pic the best fields + while (aNodeList.Count < MAX_FIELDS) do + begin + // Find best direction + BestDir := Low(PriceArr); + for Dir := Low(PriceArr) to High(PriceArr) do + if (PriceArr[Dir] > PriceArr[BestDir]) then + BestDir := Dir; + // Anti-overload condition + if (PriceArr[BestDir] = -1) then + Break; + PriceArr[BestDir] := -1; + // Add best fields to aNodeList + Dir := BestDir; + for Dist := 1 to 4 do + begin + for I := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) + Dist to High(gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir]) - Dist + 1 do + begin + FieldLoc := KMPointAdd(aLoc, gAIFields.Eye.HousesMapping[HT].Surroundings[Dist,Dir,I]); + if gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) + AND gHands[fOwner].CanAddFieldPlan(FieldLoc, ftCorn) + AND (gAIFields.Influences.AvoidBuilding[FieldLoc.Y, FieldLoc.X] <= AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) then + aNodeList.Add(FieldLoc); + end; + if (aNodeList.Count > MAX_FIELDS) then + Break; + end; + end; +end; +} + + +function TKMCityPlanner.CheckFields(var aFieldType: TKMFieldType; var aNodeList: TKMPointList): Boolean; + function IsWine(aP: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsWineField(aP) + OR (gHands[fOwner].Constructions.FieldworksList.HasField(aP) = ftWine) + OR (gTerrain.Land^[aP.Y, aP.X].TileLock = tlFieldWork) + OR ((gAIFields.Influences.AvoidBuilding[aP.Y, aP.X] = AVOID_BUILDING_NODE_LOCK_FIELD) AND (gHands[fOwner].CanAddFieldPlan(aP, ftWine))); + end; + function IsField(aP: TKMPoint): Boolean; + begin + Result := gTerrain.TileIsCornField(aP) + OR (gHands[fOwner].Constructions.FieldworksList.HasField(aP) = ftCorn) + OR (gTerrain.Land^[aP.Y, aP.X].TileLock = tlFieldWork) + OR ((gAIFields.Influences.AvoidBuilding[aP.Y, aP.X] = AVOID_BUILDING_NODE_LOCK_FIELD) AND (gHands[fOwner].CanAddFieldPlan(aP, ftCorn))); + end; +var + K,Cnt,ExpectedCnt: Integer; + FldType: TKMFieldType; +begin + Result := False; + if (fFields.Count <= 0) then + Exit; + + fFields.UpdateIdx := (fFields.UpdateIdx + 1) mod fFields.Count; + with fFields.Farms[ fFields.UpdateIdx ] do + begin + if not FieldAvailable then + Exit; + FldType := FieldType; + ExpectedCnt := FIELDS_PER_FARM * Byte(FldType = ftCorn) + FIELDS_PER_WINE * Byte(FldType = ftWine); + Cnt := ExpectedCnt; + for K := ExpectedCnt - 1 downto Low(Points) do + if KMSamePoint(Points[K],KMPoint_ZERO) OR ((FldType = ftWine) AND not IsWine(Points[K])) OR ((FieldType = ftCorn) AND not IsField(Points[K])) then + begin + Cnt := Cnt - 1; + Points[K] := Points[Cnt]; + Points[Cnt] := KMPoint_ZERO; + end; + if (ExpectedCnt - Cnt > 1) then + begin + PlanFields(ExpectedCnt - Cnt, Center, FldType, aNodeList, fFields.UpdateIdx, Cnt); + aFieldType := FldType; + end; + end; + + Result := aNodeList.Count > 0; +end; + + +procedure TKMCityPlanner.PlanFields(aCnt: Word; aLoc: TKMPoint; aFieldType: TKMFieldType; var aNodeList: TKMPointList; aReplaceFarmIdx: Integer = -1; aReplaceFieldIdx: Word = 0); +const + NOBUILD = 0; + BSBUILD_TILE = 1; + BSBUILD_SQUARE = 2; + FIELD_EXIST = 4; + FERTILE = 8; + MIN_PRICE = -100000; +var + Build: array[-FARM_RADIUS..FARM_RADIUS,-FARM_RADIUS..FARM_RADIUS] of Byte; + + function CheckBit(const X,Y: Integer; const aBitInByte: Byte): Boolean; + begin + Result := + ((Build[Y-1,X-1] AND aBitInByte) = 0) OR ((Build[Y-1,X+0] AND aBitInByte) = 0) OR ((Build[Y-1,X+1] AND aBitInByte) = 0) OR + ((Build[Y+0,X-1] AND aBitInByte) = 0) OR ((Build[Y+0,X+0] AND aBitInByte) = 0) OR ((Build[Y+0,X+1] AND aBitInByte) = 0) OR + ((Build[Y+1,X-1] AND aBitInByte) = 0) OR ((Build[Y+1,X+0] AND aBitInByte) = 0) OR ((Build[Y+1,X+1] AND aBitInByte) = 0); + end; + + procedure AddBit(const X,Y: Integer; const aBitInByte: Byte); + begin + Build[Y-1,X-1] := Build[Y-1,X-1] OR aBitInByte; + Build[Y-1,X+0] := Build[Y-1,X+0] OR aBitInByte; + Build[Y-1,X+1] := Build[Y-1,X+1] OR aBitInByte; + Build[Y+0,X-1] := Build[Y+0,X-1] OR aBitInByte; + Build[Y+0,X+0] := Build[Y+0,X+0] OR aBitInByte; + Build[Y+0,X+1] := Build[Y+0,X+1] OR aBitInByte; + Build[Y+1,X-1] := Build[Y+1,X-1] OR aBitInByte; + Build[Y+1,X+0] := Build[Y+1,X+0] OR aBitInByte; + Build[Y+1,X+1] := Build[Y+1,X+1] OR aBitInByte; + end; + + procedure RemoveBit(const X,Y: Integer; const aBitInByte: Byte); + begin + Build[Y-1,X-1] := Build[Y-1,X-1] AND Byte(not aBitInByte); + Build[Y-1,X+0] := Build[Y-1,X+0] AND Byte(not aBitInByte); + Build[Y-1,X+1] := Build[Y-1,X+1] AND Byte(not aBitInByte); + Build[Y+0,X-1] := Build[Y+0,X-1] AND Byte(not aBitInByte); + Build[Y+0,X+0] := Build[Y+0,X+0] AND Byte(not aBitInByte); + Build[Y+0,X+1] := Build[Y+0,X+1] AND Byte(not aBitInByte); + Build[Y+1,X-1] := Build[Y+1,X-1] AND Byte(not aBitInByte); + Build[Y+1,X+0] := Build[Y+1,X+0] AND Byte(not aBitInByte); + Build[Y+1,X+1] := Build[Y+1,X+1] AND Byte(not aBitInByte); + end; + +var + K, X,Y, X2,Y2, canBuild,fieldNearby,distance, BestPrice,BestX,BestY: Integer; + BelowLoc, P: TKMPoint; + Price: TFieldPrice; + BuildFF: TKMBuildFF; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + FillChar(DA1, SizeOf(DA1), #0); + FillChar(DA2, SizeOf(DA2), #0); + FillChar(DA3, SizeOf(DA3), #0); + FillChar(DA4, SizeOf(DA4), #0); + {$ENDIF} + FillChar(Price, SizeOf(Price), #0); + + BuildFF := gAIFields.Eye.BuildFF; + BuildFF.UpdateState(); // BuildFF is already updated if Fields are requested in same tick like Farm + BelowLoc := KMPointBelow(aLoc); + + fFieldEval.EvalField(FARM_RADIUS, BelowLoc, aFieldType); + + // Find build areas (11*11 = 121) + for Y := -FARM_RADIUS to +FARM_RADIUS do + for X := -FARM_RADIUS to +FARM_RADIUS do + Build[Y,X] := BSBUILD_TILE * Byte(gTerrain.TileInMapCoords(BelowLoc.X+X, BelowLoc.Y+Y) AND (BuildFF.State[BelowLoc.Y+Y,BelowLoc.X+X] in [bsBuild, bsTree])); + + // Evaluate bsBuild + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + if not CheckBit(X,Y, BSBUILD_TILE) then + AddBit(X,Y, BSBUILD_SQUARE); + + {$IFDEF DEBUG_NewAI} + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + begin + P := KMPointAdd(KMPoint(X,Y),BelowLoc); + if gTerrain.TileInMapCoords(P.X, P.Y) then + DA1[P.Y,P.X] := Build[Y,X]; + end; + {$ENDIF} + + // Evaluate fertility + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + begin + // Evaluate fertile tiles + case fFieldEval.FieldEval[Y,X] of + feUnvisitedTile: + begin + {$IFDEF DEBUG_NewAI} + P := KMPointAdd(KMPoint(X,Y),BelowLoc); + if gTerrain.TileInMapCoords(P.X, P.Y) then + DA4[P.Y,P.X] := 50; + {$ENDIF} + end; + feExistingField: + begin + Build[Y,X] := FIELD_EXIST; + end; + feFertileTile: + begin + Build[Y,X] := Build[Y,X] OR FERTILE; + end; + feObstacle: begin end; + end; + end; + + // Evaluate fields + canBuild := Round(AI_Par[PLANNER_FARM_PlanFields_CanBuild]); + fieldNearby := Round(AI_Par[PLANNER_FARM_PlanFields_ExistField]); + distance := Round(AI_Par[PLANNER_FARM_PlanFields_Dist]); + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + begin + if ((Build[Y,X] AND FERTILE) > 0) then + Price[Y,X] := + - Integer((Build[Y,X] AND BSBUILD_SQUARE) > 0) * canBuild + + Integer(CheckBit(X,Y, FIELD_EXIST)) * fieldNearby + + (FARM_RADIUS - fFieldEval.FieldPrice[Y,X]) * distance + else + Price[Y,X] := MIN_PRICE; + {$IFDEF DEBUG_NewAI} + P := KMPointAdd(KMPoint(X,Y),BelowLoc); + if gTerrain.TileInMapCoords(P.X, P.Y) then + DA3[P.Y,P.X] := Price[Y,X]; + {$ENDIF} + end; + + // Select fields + if (Length(fFields.Farms) <= fFields.Count) then + SetLength(fFields.Farms,fFields.Count + 6); + K := 0; + BestX := 0; + BestY := 0; + while K < aCnt do + begin + BestPrice := MIN_PRICE; + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + if (Price[Y,X] > BestPrice) then + begin + BestPrice := Price[Y,X]; + BestX := X; + BestY := Y; + end; + if (BestPrice = MIN_PRICE) then + break; + + if ((Build[BestY,BestX] AND BSBUILD_SQUARE) > 0) then + begin + Build[BestY,BestX] := FIELD_EXIST; + RemoveBit(BestX,BestY, BSBUILD_SQUARE); + + X := max(-FARM_RADIUS+1,BestX-2); + X2 := min(+FARM_RADIUS-1,BestX+2); + for Y := max(-FARM_RADIUS+1,BestY-2) to min(+FARM_RADIUS-1,BestY+2) do + begin + if not CheckBit(X,Y, BSBUILD_TILE) then + AddBit(X,Y, BSBUILD_SQUARE); + if not CheckBit(X2,Y, BSBUILD_TILE) then + AddBit(X2,Y, BSBUILD_SQUARE); + end; + + Y := max(-FARM_RADIUS+1,BestY-2); + Y2 := min(+FARM_RADIUS-1,BestY+2); + for X := max(-FARM_RADIUS+1,BestX-2) to min(+FARM_RADIUS-1,BestX+2) do + begin + if not CheckBit(X,Y, BSBUILD_TILE) then + AddBit(X,Y, BSBUILD_SQUARE); + if not CheckBit(X,Y2, BSBUILD_TILE) then + AddBit(X,Y2, BSBUILD_SQUARE); + end; + end + else + Build[BestY,BestX] := FIELD_EXIST; + + for Y := BestY-1 to BestY+1 do + for X := BestX-1 to BestX+1 do + if ((Build[Y,X] AND FERTILE) > 0) then + Price[Y,X] := + - Integer((Build[Y,X] AND BSBUILD_SQUARE) > 0) * canBuild + + Integer(CheckBit(X,Y, FIELD_EXIST)) * fieldNearby + + (FARM_RADIUS - fFieldEval.FieldPrice[Y,X]) * distance + else + Price[Y,X] := MIN_PRICE; + + with fFields.Farms[ IfThen(aReplaceFarmIdx <> -1, aReplaceFarmIdx, fFields.Count) ] do + begin + P := KMPointAdd(KMPoint(BestX,BestY),BelowLoc); + Points[K + aReplaceFieldIdx] := P; + aNodeList.Add(P); + end; + Inc(K); + end; + + {$IFDEF DEBUG_NewAI} + for Y := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + for X := -FARM_RADIUS+1 to +FARM_RADIUS-1 do + begin + P := KMPointAdd(KMPoint(X,Y),BelowLoc); + if gTerrain.TileInMapCoords(P.X, P.Y) then + DA2[P.Y,P.X] := Build[Y,X]; + end; + {$ENDIF} + + with fFields.Farms[ IfThen(aReplaceFarmIdx <> -1, aReplaceFarmIdx, fFields.Count) ] do + begin + Center := aLoc; + FieldType := aFieldType; + FieldAvailable := K >= aCnt; + end; + fFields.Count := fFields.Count + Byte(aReplaceFarmIdx = -1); + + {$IFDEF DEBUG_NewAI} + fFieldPrice := Price; + Time := TimeGet() - Time; + fTimeSumPlanFields := fTimeSumPlanFields + Time; + if (Time > fTimePeakPlanFields) then + fTimePeakPlanFields := Time; + {$ENDIF} +end; + + +function TKMCityPlanner.ObstaclesInHousePlan(aHT: TKMHouseType; aLoc: TKMPoint): Single; +var + K,X,Y,Road,Tree: Integer; +begin + Road := 0; + Tree := 0; + with gAIFields.Eye.HousesMapping[aHT] do + for K := Low(Tiles) to High(Tiles) do + begin + X := aLoc.X + Tiles[K].X; + Y := aLoc.Y + Tiles[K].Y; + Tree := Tree + Ord(gTerrain.ObjectIsChopableTree(KMPoint(X,Y), [caAge1, caAge2, caAge3, caAgeFull])); + Road := Road + Ord(tpWalkRoad in gTerrain.Land^[Y, X].Passability); + end; + Result := Tree * AI_Par[PLANNER_ObstaclesInHousePlan_Tree] + Road * AI_Par[PLANNER_ObstaclesInHousePlan_Road]; +end; + + +function TKMCityPlanner.FieldCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; +const + MIN_CORN_FIELDS = 15; + MIN_WINE_FIELDS = 9; + DECREASE_CRIT = 1000; +var + X,Y,I,Dist,Fields: Integer; + Dir: TDirection; +begin + Fields := 0; + with gAIFields.Eye.HousesMapping[aHT] do + for Dist := 1 to (Byte(aHT = htVineyard) * 2) + (Byte(aHT = htFarm) * 5) do + for Dir := Low(Surroundings[Dist]) to High(Surroundings[Dist]) do + for I := Low(Surroundings[Dist,Dir]) + Dist to High(Surroundings[Dist,Dir]) - Dist + 1 do + begin + X := aLoc.X + Surroundings[Dist,Dir,I].X; + Y := aLoc.Y + Surroundings[Dist,Dir,I].Y; + if gTerrain.TileInMapCoords(X,Y) + AND (gAIFields.Influences.AvoidBuilding[Y,X] = 0) // Tile is not reserved (house / road / field / forest) + AND gHands[fOwner].CanAddFieldPlan(KMPoint(X,Y), ftCorn) then + Fields := Fields + 1; + end; + Result := - ( + + Max(0, MIN_WINE_FIELDS - Fields) * Byte(aHT = htVineyard) * DECREASE_CRIT + + Max(0, MIN_CORN_FIELDS - Fields) * Byte(aHT = htFarm) * DECREASE_CRIT + ) + - gAIFields.Eye.Routes[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FARM_FieldCrit_PolyRoute] + - gAIFields.Eye.FlatArea[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FARM_FieldCrit_FlatArea] + + gAIFields.Eye.Soil[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FARM_FieldCrit_Soil]; +end; + + +function TKMCityPlanner.SnapCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; + function IsPlan(aPoint: TKMPoint; aLock: TKMTileLock; aField: TKMFieldType): Boolean; + begin + Result := (gHands[fOwner].Constructions.FieldworksList.HasField(aPoint) = aField) // Placed plan + OR (gTerrain.Land^[aPoint.Y, aPoint.X].TileLock = aLock); // Plan under construction + end; + function IsRoad(aAvoidBuilding: Byte; aPoint: TKMPoint): Boolean; inline; + begin + Result := (aAvoidBuilding = AVOID_BUILDING_NODE_LOCK_ROAD) // Reserved road plan + OR gTerrain.TileIsWalkableRoad(aPoint) // Completed road + OR IsPlan(aPoint, tlRoadWork, ftRoad); // Check plan + end; + function IsCornField(aPoint: TKMPoint): Boolean; inline; + begin + Result := gTerrain.TileIsCornField(aPoint) OR IsPlan(aPoint, tlFieldWork, ftCorn); + end; + function IsWineField(aPoint: TKMPoint): Boolean; inline; + begin + Result := gTerrain.TileIsWineField(aPoint) OR IsPlan(aPoint, tlFieldWork, ftWine); + end; + function IsNearHouse(aAvoidBuilding: Byte; aPoint: TKMPoint): Boolean; inline; + begin + Result := (aAvoidBuilding = AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) + OR not (tpBuild in gTerrain.Land^[aPoint.Y,aPoint.X].Passability); + //Result := gAIFields.Eye.BuildFF.State + end; + function IsReservedField(aAvoidBuilding: Byte): Boolean; inline; + begin + Result := (aAvoidBuilding = AVOID_BUILDING_NODE_LOCK_FIELD); + end; +const + DIST = 1; +var + AvoidBuilding: Byte; + K: Integer; + Output: Single; + Point: TKMPoint; + Dir: TDirection; +begin + Output := 0; + with gAIFields.Eye.HousesMapping[aHT] do + for Dir := Low(Surroundings[DIST]) to High(Surroundings[DIST]) do + // Skip edges in specific direction (these points are shared in 2 directions) + for K := Low(Surroundings[DIST,Dir]) + Byte((Dir = dirE) OR (Dir = dirW)) to High(Surroundings[DIST,Dir]) - Byte((Dir = dirE) OR (Dir = dirW)) do + begin + Point := KMPointAdd(aLoc, Surroundings[DIST,Dir,K]); + AvoidBuilding := gAIFields.Influences.AvoidBuilding[Point.Y, Point.X]; + Output := Output + + Byte(gAIFields.Eye.BuildFF.State[Point.Y,Point.X] in [bsRoad, bsRoadPlan]) * AI_Par[PLANNER_SnapCrit_HouseOrRoad] + + Byte(gAIFields.Eye.BuildFF.State[Point.Y,Point.X] in [bsNoBuild]) * AI_Par[PLANNER_SnapCrit_NoBuild] + + Byte(IsRoad(AvoidBuilding,Point)) * AI_Par[PLANNER_SnapCrit_Road] + + Byte(IsReservedField(AvoidBuilding)) * AI_Par[PLANNER_SnapCrit_Field]; + //+ Byte(IsNearHouse(AvoidBuilding,Point)) * GA_PLANNER_SnapCrit_SnapToHouse + //+ Byte(IsReservedField(AvoidBuilding)) * GA_PLANNER_SnapCrit_SnapToFields // OR IsCornField(Point) OR IsWineField(Point) + //+ Byte(IsRoad(AvoidBuilding,Point)) * GA_PLANNER_SnapCrit_SnapToRoads; + end; + Output := Output + - Ord(IsReservedField( gAIFields.Influences.AvoidBuilding[aLoc.Y+1,aLoc.X] )) * AI_Par[PLANNER_SnapCrit_ObstacleInEntrance] + + Ord(IsRoad( gAIFields.Influences.AvoidBuilding[aLoc.Y+1,aLoc.X], aLoc )) * AI_Par[PLANNER_SnapCrit_RoadInEntrance]; + Result := Output; +end; + + +function TKMCityPlanner.DistCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; + function ClosestDistance(): Single; + const + MAX_DIST = 1000; + var + I: Integer; + Output, Bid: Single; + HT: TKMHouseType; + begin + Output := MAX_DIST; + for HT in HOUSE_DEPENDENCE[aHT] do + for I := 0 to fPlannedHouses[HT].Count - 1 do + begin + with fPlannedHouses[HT].Plans[I].Loc do + Bid := abs(aLoc.X - X) + abs(aLoc.Y - Y) * 1.5; + if (Bid < Output) then + Output := Bid; + end; + if (Output = MAX_DIST) then + Output := 0; + Result := Output; + end; + function AllDistances(): Single; + var + I: Integer; + HT: TKMHouseType; + begin + Result := 0; + for HT in HOUSE_DEPENDENCE[aHT] do + for I := 0 to fPlannedHouses[HT].Count - 1 do + Result := Result + KMDistanceAbs(aLoc, fPlannedHouses[HT].Plans[I].Loc); + end; +begin + if (aHT = htBarracks) then + Result := - AllDistances() + else + Result := - ClosestDistance(); +end; + + +// So far the fastest method for placing houses +function TKMCityPlanner.FindPlaceForHouse(aIgnoreTrees: Boolean; aHT: TKMHouseType; out aBestLocs: TKMPointArray): Byte; +const + BEST_PLANS_CNT = 8; + INIT_BEST_GAIN = -1E20; +var + CityCenter: TKMPoint; + BestGainArr: array[0..BEST_PLANS_CNT-1] of Double; + + function EvalFreeEntrance(aLoc: TKMPoint): Single; + const + OBSTACLE_COEF = 1000; + var + K: Integer; + begin + Result := 0; + if (aLoc.Y+2 >= gTerrain.MapY) then + begin + Result := OBSTACLE_COEF * 3; + Exit; + end; + for K := -1 to 1 do + Result := Result + Byte(tpWalk in gTerrain.Land^[aLoc.Y+2,aLoc.X+K].Passability) * OBSTACLE_COEF; + end; + + {$IFDEF DEBUG_NewAI} + procedure CommentFarmLoc(aLoc: TKMPoint; aObstacles, aSnap, aSeedDist, aHouseDist, aCenterDist, aRoutes, aFlatArea, aAllyInf, aEnemyInfl, aFieldCrit, aSum: Double); + var + Coef: Double; + begin + if KMSamePoint(aLoc, aBestLocs[0]) then + fPlaceFarmDebugText := Format('New farm; Time sum: %d, peak: %d; FF sum: %d, FF peak: %d' + + '|Perc' + + #9 + '[X,Y]' + + #9#9 + 'Obstac' + + #9#9 + 'Snap' + + #9#9 + 'SeedD' + + #9#9 + 'HouseD' + + #9#9 + 'CntrD' + + #9#9 + 'Routes' + + #9#9 + 'FlatAr' + + #9#9 + 'AllInf' + + #9#9 + 'EnmInf' + + #9#9 + 'FieldCrtit',[fTimeSumSearchHouse[htFarm],fTimePeakSearchHouse[htFarm], fTimeSumBuildFFHouse[htFarm], fTimePeakBuildFFHouse[htFarm]]); + + Coef := 1; + if (BestGainArr[0] <> 0) then + Coef := (-100 / BestGainArr[0]); + fPlaceFarmDebugText := fPlaceFarmDebugText + Format( + '|%3.1f' + #9 + '[%d,%d]' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f', + [aSum * Coef, aLoc.X, aLoc.Y, + Coef * aObstacles, + Coef * aSnap, + Coef * aSeedDist, + Coef * aHouseDist, + Coef * aCenterDist, + Coef * aRoutes, + Coef * aFlatArea, + Coef * aAllyInf, + Coef * aEnemyInfl, + Coef * aFieldCrit + ]); + end; + procedure CommentHouseLoc(aLoc: TKMPoint; aObstacles, aSnap, aSeedDist, aHouseDist, aCenterDist, aRoutes, aFlatArea, aAllyInf, aEnemyInfl, aFreeEntr, aSum: Double); + var + Coef: Double; + Sum, SumFF, Peak, PeakFF: Cardinal; + HT: TKMHouseType; + begin + Sum := 0; + SumFF := 0; + Peak := 0; + PeakFF := 0; + for HT := Low(fTimeSumSearchHouse) to High(fTimeSumSearchHouse) do + begin + if (HT <> htFarm) then + Sum := Sum + fTimeSumSearchHouse[HT]; + if (Peak < fTimePeakSearchHouse[HT]) then + Peak := fTimePeakSearchHouse[HT]; + if (HT <> htFarm) then + SumFF := SumFF + fTimeSumBuildFFHouse[HT]; + if (PeakFF < fTimePeakBuildFFHouse[HT]) then + PeakFF := fTimePeakBuildFFHouse[HT]; + end; + if KMSamePoint(aLoc, aBestLocs[0]) then + fPlaceHouseDebugText := Format('New house: %s; Time sum: %d, peak: %d; FF sum: %d, FF peak: %d' + + '|Perc' + + #9 + '[X,Y]' + + #9#9 + 'Obstac' + + #9#9 + 'Snap' + + #9#9 + 'SeedD' + + #9#9 + 'HouseD' + + #9#9 + 'CntrD' + + #9#9 + 'Routes' + + #9#9 + 'FlatAr' + + #9#9 + 'AllInf' + + #9#9 + 'EnmInf' + + #9#9 + 'FreeEntr',[gRes.Houses[aHT].HouseName, Sum, Peak, SumFF, PeakFF]); + Coef := 1; + if (BestGainArr[0] <> 0) then + Coef := (100 / BestGainArr[0]); + fPlaceHouseDebugText := fPlaceHouseDebugText + Format( + '|%3.1f' + #9 + '[%d,%d]'+ #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f', + [aSum * Coef, aLoc.X, aLoc.Y, + Coef * aObstacles, + Coef * aSnap, + Coef * aSeedDist, + Coef * aHouseDist, + Coef * aCenterDist, + Coef * aRoutes, + Coef * aFlatArea, + Coef * aAllyInf, + Coef * aEnemyInfl, + Coef * aFreeEntr + ]); + end; + {$ENDIF} + + procedure EvaluateLoc(aLoc: TKMPoint; aDebugLog: Boolean = False); + const + PLANNER_FindPlaceForHouse_AllyInfluence = 1; + PLANNER_FindPlaceForHouse_EnemyInfluence = 10; + var + L: Integer; + Gain, Obstacles, Snap, SeedDist, HouseDist, CenterDist, Routes, FlatArea, FreeEntrance, AllyInf, EnemyInfl, Field: Double; + begin + // Evaluate loc + if (aHT = htFarm) OR (aHT = htVineyard) then + begin + Obstacles := - ObstaclesInHousePlan(aHT, aLoc); + Snap := + SnapCrit(aHT, aLoc) * AI_Par[PLANNER_FindPlaceForHouse_SnapCrit]; + SeedDist := - gAIFields.Eye.BuildFF.Distance[aLoc] * AI_Par[PLANNER_FindPlaceForHouse_SeedDist]; + HouseDist := + DistCrit(aHT, aLoc) * AI_Par[PLANNER_FARM_FindPlaceForHouse_HouseDist]; + CenterDist := - KMDistanceAbs(CityCenter, aLoc) * AI_Par[PLANNER_FARM_FindPlaceForHouse_CityCenter]; + Routes := + gAIFields.Eye.Routes[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FARM_FindPlaceForHouse_Route]; + FlatArea := + gAIFields.Eye.FlatArea[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FARM_FindPlaceForHouse_FlatArea]; + AllyInf := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, aLoc.X, aLoc.Y, atAlly) * PLANNER_FindPlaceForHouse_AllyInfluence; + EnemyInfl := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, aLoc.X, aLoc.Y, atEnemy) * PLANNER_FindPlaceForHouse_EnemyInfluence; + Field := + FieldCrit(aHT, aLoc); + Gain := Snap + HouseDist + CenterDist + SeedDist + Routes + FlatArea + Obstacles + AllyInf + EnemyInfl + Field; + {$IFDEF DEBUG_NewAI} + if aDebugLog then + CommentFarmLoc(aLoc, Obstacles, Snap, SeedDist, HouseDist, CenterDist, Routes, FlatArea, AllyInf, EnemyInfl, Field, Gain); + {$ENDIF} + end + else + begin + Obstacles := - ObstaclesInHousePlan(aHT, aLoc); + Snap := + SnapCrit(aHT, aLoc) * AI_Par[PLANNER_FindPlaceForHouse_SnapCrit]; + SeedDist := - gAIFields.Eye.BuildFF.Distance[aLoc] * AI_Par[PLANNER_FindPlaceForHouse_SeedDist]; + HouseDist := + DistCrit(aHT, aLoc) * AI_Par[PLANNER_FindPlaceForHouse_HouseDist]; + CenterDist := - KMDistanceAbs(CityCenter, aLoc) * AI_Par[PLANNER_FindPlaceForHouse_CityCenter]; + Routes := + gAIFields.Eye.Routes[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FindPlaceForHouse_Route]; + FlatArea := + gAIFields.Eye.FlatArea[aLoc.Y, aLoc.X] * AI_Par[PLANNER_FindPlaceForHouse_FlatArea]; + AllyInf := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, aLoc.X, aLoc.Y, atAlly) * PLANNER_FindPlaceForHouse_AllyInfluence; + EnemyInfl := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, aLoc.X, aLoc.Y, atEnemy) * PLANNER_FindPlaceForHouse_EnemyInfluence; + FreeEntrance := 0; + if (aHT = htStore) OR (aHT = htBarracks) then + FreeEntrance := EvalFreeEntrance(aLoc); + Gain := Snap + HouseDist + CenterDist + SeedDist + Routes + FlatArea + Obstacles + AllyInf + EnemyInfl + FreeEntrance; + {$IFDEF DEBUG_NewAI} + if aDebugLog then + CommentHouseLoc(aLoc, Obstacles, Snap, SeedDist, HouseDist, CenterDist, Routes, FlatArea, AllyInf, EnemyInfl, FreeEntrance, Gain); + {$ENDIF} + end; + // Sort loc + if not aDebugLog then + for L := 0 to BEST_PLANS_CNT - 1 do + if KMSamePoint(aLoc, aBestLocs[L]) then // Just to be sure + break + else if (Gain > BestGainArr[L]) then // Insert sort for BEST_PLANS_CNT elements ... + begin + KMSwapPoints(aLoc, aBestLocs[L]); + KMSwapFloat(Gain, BestGainArr[L]); + end; + end; + +const + PROBABILITY = 0.3; + MAX_RND_HOUSES = 10; +var + {$IFDEF DEBUG_NewAI} + Time, TimeBuildFF: Cardinal; + Coef: Single; + {$ENDIF} + L: Integer; + HT: TKMHouseType; + InitPointList: TKMPointList; + HouseReq: TKMHouseRequirements; + BuildFF: TKMBuildFF; + CCPArr: TKMPointArray; +begin + Result := 0; + + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + + CCPArr := gAIFields.Eye.GetCityCenterPoints(False); + if (Length(CCPArr) <= 0) then + Exit; + CityCenter := CCPArr[0]; + + with HouseReq do + begin + HouseType := aHT; + IgnoreTrees := aIgnoreTrees; + IgnoreAvoidBuilding := False; + //MaxCnt := 40; // Huge performance impact (with 10 plans needs 40 ms to build city; 100 needs 320 ms) + MaxDist := 30 - 20 * Byte(aHT = htMetallurgists); + MaxCnt := 100; // Huge performance impact (with 10 plans needs 40 ms to build city; 100 needs 320 ms) + end; + + BuildFF := gAIFields.Eye.BuildFF; + + SetLength(aBestLocs, BEST_PLANS_CNT); + for L := 0 to BEST_PLANS_CNT - 1 do + BestGainArr[L] := INIT_BEST_GAIN; + + InitPointList := TKMPointList.Create(); + try + if SP_BOOST_AI_BUILD then + begin + for HT := HOUSE_MIN to HOUSE_MAX do + if not (HT in [htWatchTower, htWoodcutters, htCoalMine, htIronMine, htGoldMine]) then + for L := fPlannedHouses[HT].Count - 1 downto 0 do + InitPointList.Add(KMPointBelow(fPlannedHouses[HT].Plans[L].Loc)); // Place for mines can be problematic + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, True); + end + else + begin + for HT in HOUSE_DEPENDENCE[aHT] do + for L := 0 to fPlannedHouses[HT].Count - 1 do + InitPointList.Add(KMPointBelow(fPlannedHouses[HT].Plans[L].Loc)); // Place for mines can be problematic + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, True); + + if (BuildFF.Locs.Count < 10) then + begin + InitPointList.Clear(); + for HT := HOUSE_MIN to HOUSE_MAX do + begin + if not (HT in [htWatchTower, htWoodcutters, htCoalMine, htIronMine, htGoldMine]) + AND not (HT in HOUSE_DEPENDENCE[aHT]) then + for L := fPlannedHouses[HT].Count - 1 downto 0 do + if (InitPointList.Count = 0) OR (HT = htStore) OR (KaMRandom({$IFDEF DBG_RNG_SPY}'TKMCityPlanner.FindPlaceForHouse'{$ENDIF}) < PROBABILITY) then + begin + if (InitPointList.Count >= MAX_RND_HOUSES) then + break; + InitPointList.Add(KMPointBelow(fPlannedHouses[HT].Plans[L].Loc)); // Place for mines can be problematic + end; + if (InitPointList.Count >= MAX_RND_HOUSES) then + break; + end; + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, False); + end; + end; + finally + InitPointList.Free; + end; + {$IFDEF DEBUG_NewAI} + TimeBuildFF := TimeGet() - Time; + {$ENDIF} + + with BuildFF.Locs do + for L := 0 to Count - 1 do + EvaluateLoc(Items[L]); + + Result := Byte(INIT_BEST_GAIN <> BestGainArr[0] ); + + + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchHouse[aHT] := fTimeSumSearchHouse[aHT] + Time; + fTimeSumBuildFFHouse[aHT] := fTimeSumBuildFFHouse[aHT] + TimeBuildFF; + if (fTimePeakSearchHouse[aHT] < Time) then + fTimePeakSearchHouse[aHT] := Time; + if (fTimePeakBuildFFHouse[aHT] < TimeBuildFF) then + fTimePeakBuildFFHouse[aHT] := TimeBuildFF; + + SetLength(fBestHouseLocs,Min(BEST_PLANS_CNT-1,5)+1); + SetLength(fBestHouseVal,Length(fBestHouseLocs)); + Coef := Max(0.0000001, 100 / Max(0.00001,BestGainArr[0])); + for L := 0 to Min(BEST_PLANS_CNT-1,5) do + begin + if (INIT_BEST_GAIN = BestGainArr[L]) then + break; + fBestHouseLocs[L] := aBestLocs[L]; + fBestHouseVal[L] := Max(0, Min(250, Round(BestGainArr[L] * Coef) + 100 )); + EvaluateLoc(aBestLocs[L], True); + end; + {$ENDIF} +end; + + +function TKMCityPlanner.FindPlaceForMines(aHT: TKMHouseType; var aLoc: TKMPoint): Boolean; +const + MAX_LOCS = 5; + + // Get closest mine + function FindPlaceForMine(aMine: TKMHouseType): Boolean; + const + BEST_GAIN = -10000; + var + Output, Check: Boolean; + I, K, BestIdx: Integer; + Gain, BestGain: Single; + Loc: TKMPoint; + Locs: TKMPointTagList; + BuildFF: TKMBuildFF; + begin + Output := False; + BuildFF := gAIFields.Eye.BuildFF; + + Locs := gAIFields.Eye.GetMineLocs(aMine); + try + if (Locs.Count > 0) then + begin + BuildFF.UpdateState(); // Mark walkable area in owner's city + for I := 0 to Locs.Count - 1 do + if (BuildFF.VisitIdx = BuildFF.Visited[ Locs.Items[I].Y+1, Locs.Items[I].X ]) then // Prefer mines in walkable area + Locs.Tag[I] := 10000 + Locs.Tag[I] - BuildFF.Distance[ Locs.Items[I] ]*10 - gAIFields.Influences.GetOtherOwnerships(fOwner, Locs.Items[I].X, Locs.Items[I].Y); + Locs.SortByTag(); + BestGain := BEST_GAIN; + BestIdx := 0; // For compiler + for I := Locs.Count-1 downto 0 do + begin + // Check reserved mines + Check := True; + for K := 0 to fPlannedHouses[aMine].Count - 1 do + begin + Loc := fPlannedHouses[aMine].Plans[K].Loc; + if KMSamePoint(Loc, Locs.Items[I]) + AND not ( (Loc.Y <> Locs.Items[I].Y) OR (Abs(Loc.X - Locs.Items[I].X) > (3 + Byte(aMine = htIronMine))) ) then + begin + Check := False; + Continue; + end; + end; + if not Check then + Continue; + Gain := Locs.Tag[I] + DistCrit(aMine, Locs.Items[I]) * 4; + if (Gain > BestGain) then + begin + BestIdx := I; + BestGain := Gain; + end; + end; + if (BestGain <> BEST_GAIN) then + begin + AddPlan(aHT, Locs.Items[BestIdx]); + aLoc := Locs.Items[BestIdx]; + Output := True; + end; + end; + finally + Locs.Free; + end; + Result := Output; + end; + + // Coal mine planner + function FindPlaceForCoalMine(): Boolean; + const + INIT_GAIN = -10000; + var + I, BestIdx: Integer; + Gain, BestGain: Single; + HT: TKMHouseType; + InitPointList: TKMPointList; + HouseReq: TKMHouseRequirements; + BuildFF: TKMBuildFF; + begin + BuildFF := gAIFields.Eye.BuildFF; + + InitPointList := TKMPointList.Create(); + try + for HT := Low(fPlannedHouses) to High(fPlannedHouses) do + for I := 0 to fPlannedHouses[HT].Count - 1 do + InitPointList.Add(KMPointBelow(fPlannedHouses[HT].Plans[I].Loc)); // Place under mines can be problematic + + with HouseReq do + begin + HouseType := aHT; + IgnoreTrees := False; + IgnoreAvoidBuilding := True; + MaxCnt := 20; // Huge performance impact (with 10 plans needs 40 ms to build city; 100 needs 320 ms) + MaxDist := 30; + end; + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, True); + finally + InitPointList.Free; + end; + + BestGain := INIT_GAIN; + BestIdx := -1; + with BuildFF.Locs do + begin + for I := 0 to Count - 1 do + begin + Gain := - BuildFF.Distance[ Items[I] ] * 10 + + SnapCrit(htCoalMine, Items[I]) + - ObstaclesInHousePlan(htCoalMine, Items[I]) + - gAIFields.Influences.GetOtherOwnerships(fOwner, Items[I].X, Items[I].Y); + if (Gain > BestGain) then + begin + BestIdx := I; + aLoc := Items[BestIdx]; + BestGain := Gain; + end; + end; + if (BestIdx <> -1) then + AddPlan(aHT, Items[BestIdx]); + end; + Result := (BestIdx <> -1); + end; +var + Output: Boolean; //@Toxic: This kind of temp "Output" for "Result" is pointless + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + case aHT of + htGoldMine: Output := FindPlaceForMine(htGoldMine); + htIronMine: Output := FindPlaceForMine(htIronMine); + htCoalMine: Output := FindPlaceForCoalMine(); + else Output := False; + end; + Result := Output; + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchHouse[aHT] := fTimeSumSearchHouse[aHT] + Time; + if (fTimePeakSearchHouse[aHT] < Time) then + fTimePeakSearchHouse[aHT] := Time; + {$ENDIF} +end; + + +procedure TKMCityPlanner.CheckStoneReserves(aForceToPlaceQuarry: Boolean; aReqQuarryCnt: Integer); +const + HT = htQuarry; + MIN_CNT = 60; // possible to mine X layers of stone tile = X * 3 stones + MIN_CNT_USED = 25; +var + CanBeReplaced: Boolean; + I,K, LowestIdx: Integer; + StoneLocs, CopySL: TKMPointTagList; + CanMineCnt: TKMWordArray; +begin + // Exit if we dont need new quarry and there is not completed quarry or quarry is already builded + if not aForceToPlaceQuarry AND ((fPlannedHouses[HT].Completed = 0) OR (fPlannedHouses[HT].Count > fPlannedHouses[HT].Completed)) then + Exit; + StoneLocs := gAIFields.Eye.GetStoneLocs(); // Find stone locs + CopySL := nil; + try + if (StoneLocs.Count > 0) then + begin + if (fPlannedHouses[HT].Count > 0) then + begin + // Calculate usage of each mine and each stone tile + SetLength(CanMineCnt, fPlannedHouses[HT].Count); + FillChar(CanMineCnt[0], SizeOf(CanMineCnt[0]) * Length(CanMineCnt), #0); + FillChar(StoneLocs.Tag2[0], SizeOf(StoneLocs.Tag2[0]) * Length(StoneLocs.Tag2), #0); + for I := Low(CanMineCnt) to High(CanMineCnt) do + with fPlannedHouses[HT].Plans[I] do + for K := 0 to StoneLocs.Count - 1 do + if (KMDistanceSqr(Loc,StoneLocs.Items[K]) <= sqr(gRes.Units[utStonemason].MiningRange)) then + begin + Inc(CanMineCnt[I],StoneLocs.Tag[K]); + Inc(StoneLocs.Tag2[K]); + end; + // Find the most depleted house + LowestIdx := 0; + for I := High(CanMineCnt) downto Low(CanMineCnt) do + if (CanMineCnt[LowestIdx] >= CanMineCnt[I]) + AND (fPlannedHouses[HT].Plans[I].House <> nil) + AND not fPlannedHouses[HT].Plans[I].House.IsDestroyed then + LowestIdx := I; + // Try to remove 1 quarry + if (CanMineCnt[LowestIdx] < MIN_CNT) then + begin + // Find again all possible places where quarry can mine and check if every tile can be mined by another 2 mines + CanBeReplaced := True; + with fPlannedHouses[HT].Plans[LowestIdx] do + for I := StoneLocs.Count - 1 downto 0 do + if (StoneLocs.Tag2[I] < 3) AND (KMDistanceSqr(Loc,StoneLocs.Items[I]) <= sqr(gRes.Units[utStonemason].MiningRange)) then + begin + CanBeReplaced := False; + break; + end + else if (not aForceToPlaceQuarry AND (StoneLocs.Tag2[I] > 1)) // Allow lower tolerance in case of aForceToPlaceQuarry + OR ((StoneLocs.Tag2[I] > 0) AND (StoneLocs.Tag[I] < MIN_CNT_USED)) + OR (StoneLocs.Tag2[I] > 3) then + StoneLocs.Delete(I); + fStonesDepleted := StoneLocs.Count = 0; + if CanBeReplaced AND not fStonesDepleted then + begin + // Copy stone locs + //CopySL := TKMPointTagList.Create(); + //for I := 0 to StoneLocs.Count - 1 do + // CopySL.Add(StoneLocs.Items[I], StoneLocs.Tag[I]); + // Try to place new quarry + //if (aReqQuarryCnt >= 0) AND FindPlaceForQuary(CopySL) then + if (aReqQuarryCnt >= 0) AND FindPlaceForQuary(StoneLocs) then + begin + with fPlannedHouses[HT] do + Plans[ Count-1 ].HouseReservation := True; // Reserve houses so builder will init road + end + else + fStonesDepleted := True; + // Demolish old quarry (in case that alternative is completed) + if not aForceToPlaceQuarry AND (aReqQuarryCnt < 0) then + with fPlannedHouses[HT] do + begin + if (Plans[LowestIdx].House <> nil) then + Plans[LowestIdx].House.Demolish(fOwner); + RemovePlan(HT, LowestIdx); + end; + end + else if aForceToPlaceQuarry then + FindPlaceForQuary(StoneLocs); + end + else if aForceToPlaceQuarry then + FindPlaceForQuary(StoneLocs); + end + else if aForceToPlaceQuarry then + FindPlaceForQuary(StoneLocs); + end; + finally + if (StoneLocs <> nil) then + StoneLocs.Free; + if (CopySL <> nil) then + CopySL.Free; + end; +end; + + +// Quarry planner (constants in this function are critical and will not be set by CA) +function TKMCityPlanner.FindPlaceForQuary(var StoneLocs: TKMPointTagList): Boolean; +const + HT = htQuarry; + MAX_DERIVATION = 75; + MAX_SCAN_DIST = 3; + INIT_TAG = 0; +var + Output, IsWalkable: Boolean; + I, K, Y, X, MinIdx, MaxIdx: Integer; + NewTag, BestTag: Cardinal; + Gain, BestGain, stonesAvailable: Single; + Loc, BestLoc: TKMPoint; + HouseReq: TKMHouseRequirements; + InitPointList: TKMPointList; + BuildFF: TKMBuildFF; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + Result := False; + Output := False; + BuildFF := gAIFields.Eye.BuildFF; + if (StoneLocs = nil) then + Exit; // Find stone locs + + with HouseReq do + begin + HouseType := HT; + IgnoreTrees := False; + IgnoreAvoidBuilding := True; + MaxCnt := 150; // Placing quarry is CRITICAL, pick up the best if possible + MaxDist := 11; + end; + if (StoneLocs.Count > 0) then + begin + BuildFF.UpdateState(); // Mark walkable area in owner's city + // Consider Ownership in picking stone locs + with StoneLocs do + for I := Count - 1 downto 0 do + begin + BestTag := 0; + IsWalkable := False; + for Y := Max(Items[I].Y - 1, 1) to Min(Items[I].Y + MAX_SCAN_DIST, gTerrain.MapY - 1) do + for X := Max(Items[I].X - 1, 1) to Min(Items[I].X + 1, gTerrain.MapX - 1) do + // Set stone loc to closest walkable point (which is bellow actual point) + if (BuildFF.VisitIdx = BuildFF.Visited[Y,X]) then + begin + // Evaluate loc and find the best location + NewTag := Max(0, Round(100000 + + gAIFields.Influences.OwnPoint[ fOwner, KMPoint(X,Y) ] + - gAIFields.Influences.GetOtherOwnerships(fOwner,X,Y) + - BuildFF.Distance[ KMPoint(X,Y) ] * AI_Par[PLANNER_FindPlaceForQuary_StoneLoc_Distance])); + if (NewTag > BestTag) then + begin + BestLoc := KMPoint(X,Y); + BestTag := NewTag; + IsWalkable := True; + end; + end; + if not IsWalkable then // Remove stone locs without walkable tiles (under the loc) + Delete(I) + else + begin // Update stone loc so it is in walkable area + Items[I] := BestLoc; + NewTag := Tag[I]; // Save stone amount and move it to tag2 later + Tag[I] := Round(BestTag + + Tag[I] * AI_Par[PLANNER_FindPlaceForQuary_StoneLoc_StoneCnt] + - Tag2[I] * AI_Par[PLANNER_FindPlaceForQuary_StoneLoc_AlreadyMined] + ); + Tag2[I] := NewTag; + end; + end; + StoneLocs.SortByTag(); + MaxIdx := StoneLocs.Count - 1; + // Try find place for quarry + while not Output AND (MaxIdx > 0) do + begin + // Try find cluster of stone locs by influence + for MinIdx := MaxIdx - 1 downto 0 do + if (StoneLocs.Tag[MinIdx + 1] - StoneLocs.Tag[MinIdx] > MAX_DERIVATION) then + break; + // Copy points in stone mountain in specific influence (it can be multiple stone mountains but in same influence area) + InitPointList := TKMPointList.Create(); + try + for I := MaxIdx downto MinIdx + 1 do + InitPointList.Add(StoneLocs.Items[I]); + MaxIdx := MinIdx; + // Try to find stone locs -> array will be automatically filtered by walkable areas inside of BuildFF + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, True); + finally + InitPointList.Free; + end; + // Evaluate new locs + BestGain := -10000000; + for I := 0 to BuildFF.Locs.Count - 1 do + begin + Loc := BuildFF.Locs.Items[I]; + + stonesAvailable := 0; + for K := StoneLocs.Count - 1 downto 0 do + if (KMDistanceSqr(Loc,StoneLocs.Items[K]) < sqr(gRes.Units[utStonemason].MiningRange)-3) then + stonesAvailable := stonesAvailable + StoneLocs.Tag2[K]; + + Gain := - ObstaclesInHousePlan(HT,Loc) * AI_Par[PLANNER_FindPlaceForQuary_Obstacle] + - BuildFF.Distance[Loc] * AI_Par[PLANNER_FindPlaceForQuary_DistCity] * Max(1, AI_Par[PLANNER_FindPlaceForQuary_DistTimer] - gGameParams.Tick) + - BuildFF.DistanceInitPoint[Loc] * AI_Par[PLANNER_FindPlaceForQuary_DistStone] + + SnapCrit(HT, Loc) * AI_Par[PLANNER_FindPlaceForQuary_SnapCrit] + + stonesAvailable * AI_Par[PLANNER_FindPlaceForQuary_QtyStone]; + if (Gain > BestGain) then + begin + BestGain := Gain; + BestLoc := Loc; + Output := True; + end; + end; + end; + if Output then + begin + AddPlan(HT, BestLoc); + gHands[fOwner].AI.CityManagement.Builder.LockHouseLoc(htQuarry, BestLoc); + end; + end; + Result := Output; + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchHouse[htQuarry] := fTimeSumSearchHouse[htQuarry] + Time; + if (fTimePeakSearchHouse[htQuarry] < Time) then + fTimePeakSearchHouse[htQuarry] := Time; + {$ENDIF} +end; + + +// Find place for woodcutter +function TKMCityPlanner.FindPlaceForWoodcutter(aCenter: TKMPoint; aChopOnly: Boolean = False): Boolean; +const + RADIUS = 8; + COAL_PENALIZATON = 5; +var + Output: Boolean; + I,K, CoalTiles: Integer; + Gain, BestGain: Single; + Loc, BestLoc: TKMPoint; + HouseReq: TKMHouseRequirements; + InitPointList: TKMPointList; + BuildFF: TKMBuildFF; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + Output := False; + BuildFF := gAIFields.Eye.BuildFF; + with HouseReq do + begin + HouseType := htWoodcutters; + IgnoreTrees := False; + IgnoreAvoidBuilding := not aChopOnly; + MaxCnt := 20; + MaxDist := RADIUS; + end; + + InitPointList := TKMPointList.Create(); + try + InitPointList.Add(aCenter); + BuildFF.FindPlaceForHouse(HouseReq, InitPointList, True); + finally + InitPointList.Free; + end; + + BestGain := -1E10; + BestLoc := KMPOINT_ZERO; + for I := 0 to BuildFF.Locs.Count - 1 do + begin + Loc := BuildFF.Locs.Items[I]; + Gain := - AI_Par[PLANNER_FOREST_PlaceWoodcutter_DistFromForest] * BuildFF.DistanceInitPoint[Loc] + + DistCrit(htWoodcutters, Loc) + + SnapCrit(htWoodcutters, Loc); + if (Gain > BestGain) then // No need to check for coal tiles everything + begin + CoalTiles := 0; + for K := Low(gAIFields.Eye.HousesMapping[htWoodcutters].Tiles) to High(gAIFields.Eye.HousesMapping[htWoodcutters].Tiles) do + CoalTiles := CoalTiles + gTerrain.TileIsCoal(Loc.X + gAIFields.Eye.HousesMapping[htWoodcutters].Tiles[K].X, Loc.Y + gAIFields.Eye.HousesMapping[htWoodcutters].Tiles[K].Y); + Gain := Gain - CoalTiles * COAL_PENALIZATON; + if (Gain > BestGain) then + begin + BestGain := Gain; + BestLoc := Loc; + end; + end; + end; + + if (BestGain <> -1E10) then + begin + Output := True; + // Check whether is cutting point (center of forest) inside of house plan and in this case set it 1 point on left from house entrance + if ((aCenter.Y <= BestLoc.Y) AND (aCenter.Y >= BestLoc.Y-1)) AND ((aCenter.X <= BestLoc.X) AND (aCenter.X >= BestLoc.X-2)) then + aCenter := KMPoint(BestLoc.X-1, BestLoc.Y+1); + AddPlan(htWoodcutters, BestLoc, aCenter, aChopOnly); + gHands[fOwner].AI.CityManagement.Builder.LockHouseLoc(htWoodcutters, BestLoc); + end; + Result := Output; + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchHouse[htWoodcutters] := fTimeSumSearchHouse[htWoodcutters] + Time; + if (fTimePeakSearchHouse[htWoodcutters] < Time) then + fTimePeakSearchHouse[htWoodcutters] := Time; + {$ENDIF} +end; + + +function TKMCityPlanner.FindForestAndWoodcutter(): Boolean; +var + FI: TKMForestsInfo; + + function GetFreeTiles(aLoc: TKMPoint): Integer; + const + RADIUS = 4; + var + X,Y: Integer; + State: TKMBuildState; + begin + Result := 0; + for Y := Max(1,aLoc.Y-RADIUS) to Min(gTerrain.MapY-1, aLoc.Y+RADIUS) do + for X := Max(1,aLoc.X-RADIUS) to Min(gTerrain.MapX-1, aLoc.X+RADIUS) do + begin + State := gAIFields.Eye.BuildFF.State[Y,X]; + Result := Result + Byte( (State >= bsBuild) AND (State <= bsForest) ); + end; + end; + + {$IFDEF DEBUG_NewAI} + procedure LogForest(aIdx: Integer; aTreeCnt,aExistFrs,aRoutes,aFlatArea,aSoil,aDistCrit,aFreeTiles,aAllyInf,aEnemyInfl: Single); + var + Coef: Single; + begin + if (aIdx = FI.Count-1) then + fForestDebugText := Format('Forest - Time: %d; Peak: %d' + + '|Perc' + + #9 + '[X,Y]' + + #9#9 + 'TreeCnt' + + #9 + 'ExistFor' + + #9 + 'Routes' + + #9#9 + 'FltAr' + + #9#9 + 'Soil' + + #9#9 + 'Distance' + + #9#9 + 'FreeTiles' + + #9#9 + 'AllInf' + + #9#9 + 'EnmInfl',[fTimeSumSearchForest, fTimePeakSearchForest]); + Coef := Max(0.0000001, 100 / Max(0.0001,(FI.Forests[FI.Count-1].Bid))); + fForestDebugText := fForestDebugText + Format( + '|%3.1f' + #9 + '[%d,%d]' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f' + #9#9 + '%5.1f', + [ FI.Forests[aIdx].Bid * Coef, FI.Forests[aIdx].Loc.X, FI.Forests[aIdx].Loc.Y, + Coef * aTreeCnt, + Coef * aExistFrs, + Coef * aRoutes, + Coef * aFlatArea, + Coef * aSoil, + Coef * aDistCrit, + Coef * aFreeTiles, + Coef * aAllyInf, + Coef * aEnemyInfl + ]); + end; + {$ENDIF} + + procedure EvalForest(aIdx: Integer; aLogResult: Boolean); + const + PLANNER_FindForestAndWoodcutter_AllyInfluence = 3; + PLANNER_FindForestAndWoodcutter_EnemyInfluence = 10; + var + TreeCnt,ExistFrs,Routes,FlatArea,Soil,DistCrit,FreeTiles,AllyInf,EnemyInfl: Single; + P: TKMPoint; + begin + P := FI.Forests[aIdx].Loc; + TreeCnt := + FI.Forests[aIdx].TreeCout * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_TreeCnt] * Max(1, AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_TreeCntTimer] - gGameParams.Tick); + DistCrit := - FI.Forests[aIdx].Distance * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_DistCrit] * Max(1, AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_DistTimer] - gGameParams.Tick); + ExistFrs := + Byte(FI.Forests[aIdx].PartOfForest) * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_ExistForest]; + Routes := + gAIFields.Eye.Routes[P.Y, P.X] * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Routes]; + FlatArea := + gAIFields.Eye.FlatArea[P.Y, P.X] * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_FlatArea]; + Soil := + gAIFields.Eye.Soil[P.Y, P.X] * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Soil]; + FreeTiles := + GetFreeTiles(P) * AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_FreeTiles]; + AllyInf := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, P.X, P.Y, atAlly) * PLANNER_FindForestAndWoodcutter_AllyInfluence; + EnemyInfl := - gAIFields.Influences.GetBestAllianceOwnership(fOwner, P.X, P.Y, atEnemy) * PLANNER_FindForestAndWoodcutter_EnemyInfluence; + FI.Forests[aIdx].Bid := TreeCnt + DistCrit + ExistFrs + Routes + FlatArea + Soil + FreeTiles + AllyInf + EnemyInfl; + {$IFDEF DEBUG_NewAI} + if aLogResult then + LogForest(aIdx, TreeCnt, ExistFrs, Routes, FlatArea, Soil, DistCrit, FreeTiles, AllyInf, EnemyInfl); + {$ENDIF} + end; + +const + SQR_MIN_DIST_FROM_CHOP_ONLY = 12*12; +var + Output: Boolean; + K,L: Integer; + DecreaseSpeed: Single; + P: TKMPoint; + FIRnd: TKMForestsInfo; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + + FI := gAIFields.Eye.GetForests(); + //{ + FIRnd := gAIFields.Eye.GetPotentialForests(500); + if (FI.Count + FIRnd.Count > Length(FI.Forests)) then + SetLength(FI.Forests,FI.Count + FIRnd.Count); + + for K := 0 to FIRnd.Count - 1 do + begin + FI.Forests[FI.Count] := FIRnd.Forests[K]; + Inc(FI.Count); + end; + //} + + for K := FI.Count - 1 downto 0 do + begin + // Check influence + if (gAIFields.Influences.GetBestAllianceOwner(fOwner, FI.Forests[K].Loc, atEnemy) > 10) + or (gAIFields.Influences.GetBestOwner(FI.Forests[K].Loc.X, FI.Forests[K].Loc.Y) <> fOwner) then + begin + Dec(FI.Count); + FI.Forests[K] := FI.Forests[ FI.Count ]; + Continue; + end; + // Delete forests around chop-only woodcutters + for L := 0 to fPlannedHouses[htWoodcutters].Count - 1 do + with fPlannedHouses[htWoodcutters].Plans[L] do + if ChopOnly AND (KMDistanceSqr(FI.Forests[K].Loc, SpecPoint) < SQR_MIN_DIST_FROM_CHOP_ONLY) then + begin + Dec(FI.Count); + FI.Forests[K] := FI.Forests[ FI.Count ]; + Break; + end; + end; + + // Evaluate clusters of trees (tree cnt + relative position [influence]) + for K := 0 to FI.Count - 1 do + EvalForest(K, False); + if (FI.Count > 1) then + SortCustom(FI.Forests[0], 0, FI.Count-1, SizeOf(FI.Forests[0]), CompareForests); + + {$IFDEF DEBUG_NewAI} + for K := FI.Count - 1 downto Max(0,FI.Count - 5) do + EvalForest(K, True); + {$ENDIF} + + K := FI.Count; + Output := False; + while not Output AND (K > 0) do + begin + K := K - 1; + P := FI.Forests[K].Loc; // Get the best forest + Output := FindPlaceForWoodcutter(P,False); + // Mark forest by protected radius + if Output then + begin + // Rounding of paramters from GA may change border limit for forest +- 1 so substract it + DecreaseSpeed := Min(AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_ABRange],AVOID_BUILDING_FOREST_RANGE-1) / sqr(AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Radius]); + gAIFields.Influences.MarkForest(P, AI_Par[PLANNER_FOREST_FindPlaceForWoodcutter_Radius], DecreaseSpeed); + end; + end; + Result := Output; + fForestsInfo := FI; + + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchForest := fTimeSumSearchForest + Time; + if (fTimePeakSearchForest < Time) then + fTimePeakSearchForest := Time; + {$ENDIF} +end; + + +// This function have 2 purposes: detect forest in case of wood shortage and find forest near new house (chop-only mode) +function TKMCityPlanner.FindForestAround(const aPoint: TKMPoint; aCountByInfluence: Boolean = False): Boolean; +const + MIN_TREES = 3; + //SQR_MAX_DIST_FROM_HOUSE = 7*7; + SQR_MIN_DIST_FROM_ACTIVE_FORESTS = 10*10; + SQR_MIN_DIST_FROM_CHOP_ONLY = 12*12; +var + Output, Check: Boolean; + K,L: Integer; + Gain, BestGain: Byte; + Loc, BestLoc: TKMPoint; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + Output := False; + if (fForestsInfo.Count > 0) then + begin + BestGain := 0; + BestLoc := KMPOINT_ZERO; + gAIFields.Eye.BuildFF.UpdateState(); + for K := fForestsInfo.Count-1 downto 0 do + begin + Loc := fForestsInfo.Forests[K].Loc; + if (aCountByInfluence OR (KMDistanceSqr(aPoint, Loc) < Sqr(AI_Par[PLANNER_FOREST_FindForestAround_MaxDist]))) + AND (fForestsInfo.Forests[K].TreeCout >= MIN_TREES) + AND (gAIFields.Influences.GetBestAllianceOwnership(fOwner, Loc.X, Loc.Y, atEnemy) < 20) then + begin + Gain := gAIFields.Influences.OwnPoint[fOwner, Loc]; // This is equivalent of distance + if (Gain > BestGain) then + begin + Check := True; + for L := 0 to fPlannedHouses[htWoodcutters].Count - 1 do + if (KMDistanceSqr(Loc, fPlannedHouses[htWoodcutters].Plans[L].SpecPoint) < SQR_MIN_DIST_FROM_ACTIVE_FORESTS) then + begin + Check := False; + break; + end; + if Check then + begin + BestGain := Gain; + BestLoc := Loc; + Output := True; + end; + end; + end; + end; + if Output then + begin + Output := FindPlaceForWoodcutter(BestLoc, True); + // fForests is not updated so remove points around new chop only forest + if Output then + with fForestsInfo do + for K := Count-1 downto 0 do + if (KMDistanceSqr(Forests[K].Loc, BestLoc) < SQR_MIN_DIST_FROM_CHOP_ONLY) then + begin + Forests[K] := Forests[ fForestsInfo.Count-1 ]; + Dec(Count); + end; + end; + end; + + Result := Output; + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchForest := fTimeSumSearchForest + Time; + if (fTimePeakSearchForest < Time) then + fTimePeakSearchForest := Time; + {$ENDIF} +end; + + +function TKMCityPlanner.PlanDefenceTowers(): Boolean; + + procedure FindPlaceForTowers(aCenter: TKMPoint); + const + RADIUS = 3; + MAX_BID = 100000; + MAX_ENEMY_INFLUENCE = 100; + var + PL: TKMHandID; + X,Y: Integer; + Bid, BestBid: Single; + Loc, BestLoc: TKMPoint; + begin + // Filter defence positions, build towers only at the closest + PL := gAIFields.Influences.GetBestAllianceOwner(fOwner, aCenter, atAlly); + if (PL <> fOwner) AND (PL <> HAND_NONE) then + Exit; + if (gAIFields.Influences.GetBestAllianceOwnership(fOwner, gAIFields.NavMesh.Point2Polygon[aCenter.Y,aCenter.X], atEnemy) > MAX_ENEMY_INFLUENCE) then + Exit; + + BestBid := MAX_BID; + BestLoc := KMPOINT_ZERO; + for Y := Max(1, aCenter.Y - RADIUS) to Min(gTerrain.MapY, aCenter.Y + RADIUS) do + for X := Max(1, aCenter.X - RADIUS) to Min(gTerrain.MapX, aCenter.X + RADIUS) do + begin + Loc := KMPoint(X,Y); + if gAIFields.Eye.CanAddHousePlan(Loc, htWatchTower, True, False, False) then + begin + Bid := KMDistanceAbs(aCenter, Loc); + if (Bid < BestBid) then + begin + BestBid := Bid; + BestLoc := Loc; + end; + end; + end; + if (BestBid <> MAX_BID) then + begin + AddPlan(htWatchTower, BestLoc); + gHands[fOwner].AI.CityManagement.Builder.LockHouseLoc(htWatchTower, BestLoc); + end; + end; + +const + DISTANCE_BETWEEN_TOWERS = 8; +var + I, K, DefCount: Integer; + P1,P2: TKMPoint; + Ratio: Single; + DefLines: TKMDefenceLines; + BuildFF: TKMBuildFF; + {$IFDEF DEBUG_NewAI} + Time: Cardinal; + {$ENDIF} +begin + {$IFDEF DEBUG_NewAI} + Time := TimeGet(); + {$ENDIF} + Result := False; + + if not gHands[fOwner].Locks.HouseCanBuild(htWatchTower) + OR not gAIFields.NavMesh.Defences.FindDefenceLines(fOwner, DefLines) + OR (DefLines.Count < 1) then + Exit; + + // Mark walkable area in owner's city + BuildFF := gAIFields.Eye.BuildFF; + BuildFF.UpdateState(60); + + //Make list of defence positions + for I := 0 to DefLines.Count-1 do + begin + P1 := gAIFields.NavMesh.Nodes[ DefLines.Lines[I].Nodes[0] ]; + P2 := gAIFields.NavMesh.Nodes[ DefLines.Lines[I].Nodes[1] ]; + // Check if defensive position is visible by eye (sometimes edges are not passable so eye does not see them) + if not (BuildFF.VisitIdx = BuildFF.Visited[ round(abs(P1.Y+P2.Y)/2), round(abs(P1.X+P2.X)/2) ]) + AND not (BuildFF.VisitIdx = BuildFF.Visited[ P1.Y, P1.X ]) + AND not (BuildFF.VisitIdx = BuildFF.Visited[ P2.Y, P2.X ]) then + Continue; + DefCount := Ceil( KMLength(P1,P2) / DISTANCE_BETWEEN_TOWERS ); + for K := 0 to DefCount - 1 do + begin + Ratio := (K + 1) / (DefCount + 1); + FindPlaceForTowers( KMPointRound(KMLerp(P1, P2, Ratio)) ); + end; + end; + Result := True; + {$IFDEF DEBUG_NewAI} + Time := TimeGet() - Time; + fTimeSumSearchHouse[htWatchTower] := fTimeSumSearchHouse[htWatchTower] + Time; + {$ENDIF} +end; + + +procedure TKMCityPlanner.LogStatus(var aBalanceText: UnicodeString); +begin + {$IFDEF DEBUG_NewAI} + aBalanceText := Format('%s||CityPlanner: |%s|%s|%s',[aBalanceText,fPlaceHouseDebugText,fPlaceFarmDebugText,fForestDebugText]); + {$ENDIF} +end; + + +procedure TKMCityPlanner.Paint(); +var + K,L: Integer; + Division: Single; + H: TKMHouse; + HT: TKMHouseType; + Loc: TKMPoint; + Color: Cardinal; + {$IFDEF DEBUG_NewAI} + X,Y: Integer; + Val: Cardinal; + {$ENDIF} +begin + + {$IFDEF DEBUG_NewAI} + //fPrice[aToY,aTox] := Result; + with fRoadPlanner do + for Y := Low(Price) to High(Price) do + for X := Low(Price[Y]) to High(Price[Y]) do + begin + //Val := GA_PATHFINDING_BasePrice + Max(Max(GA_PATHFINDING_noBuildArea,GA_PATHFINDING_Field),Max(Max(GA_PATHFINDING_Coal,GA_PATHFINDING_Forest),GA_PATHFINDING_OtherCase)); + //Val := Cardinal(Max(0, Min(250, Round(Price[Y,X]/Single(Val)*250)))); + //gRenderAux.Quad(X, Y, (Val shl 24) OR tcRed); + //gRenderAux.Text(X, Y, IntToStr(Order[Y,X]), $FF000000); + end; + //fRoadPlanner: TKMPathFindingCityPlanner; + //fRoadShortcutPlanner: + {$ENDIF} + + {$IFDEF DEBUG_NewAI} + Division := 1; + for Y := Low(DA1) to High(DA1) do + for X := Low(DA1[0]) to High(DA1[0]) do + if (Division < DA3[Y,X]) then + Division := DA3[Y,X]; + for Y := Low(DA1) to High(DA1) do + for X := Low(DA1[0]) to High(DA1[0]) do + if gTerrain.TileInMapCoords(X,Y) then + begin + Val := Cardinal(Max(0, Min(250, Round(DA3[Y,X]/Division*250)))); + gRenderAux.Quad(X, Y, (Val shl 24) OR tcYellow); + //gRenderAux.Text(X, Y, IntToStr(Round(DA1[Y,X])), $FF000000); + //gRenderAux.Quad(X, Y, (Cardinal(Max(0, Min(250, DA1[Y,X]*25))) shl 24) OR tcWhite); + //gRenderAux.Quad(X, Y, (Cardinal(Max(0, Min(250, DA2[Y,X]*25))) shl 24) OR tcBlue); + //gRenderAux.Quad(X, Y, (Cardinal(Max(0, Min(127, DA4[Y,X]))) shl 24) OR tcBlack); + end; + {$ENDIF} + + {$IFDEF DEBUG_NewAI} + // Paint best places for last house + for K := 0 to Length(fBestHouseLocs) - 1 do + gRenderAux.Quad(fBestHouseLocs[K].X, fBestHouseLocs[K].Y, (fBestHouseVal[K] shl 24) OR tcBlack); + {$ENDIF} + + // Paint houses + for HT := HOUSE_MIN to HOUSE_MAX do + begin + case HT of + htStore,htSchool,htInn,htMarket: Color := tcBlack; + htQuarry,htWoodcutters,htSawmill: Color := tcBlue; + htGoldMine,htCoalMine,htIronMine,htMetallurgists: Color := tcYellow; + htIronSmithy,htArmorSmithy,htWeaponSmithy,htTannery,htArmorWorkshop,htWeaponWorkshop,htBarracks: Color := tcRed; + htBakery,htButchers,htMill,htSwine,htStables,htFarm,htVineyard: Color := tcGreen; + else Color := tcWhite; + end; + Color := $80000000 OR Color; + for K := 0 to fPlannedHouses[HT].Count - 1 do + begin + for L := 0 to Length(gAIFields.Eye.HousesMapping[HT].Tiles) - 1 do + begin + Loc := KMPointAdd(fPlannedHouses[HT].Plans[K].Loc, gAIFields.Eye.HousesMapping[HT].Tiles[L]); + gRenderAux.Quad(Loc.X, Loc.Y, Color); + end; + end; + end; + + // Paint potential forests + if (fForestsInfo.Count > 0) then + begin + // Forests are sorted + Division := 255 / (fForestsInfo.Forests[fForestsInfo.Count - 1].Bid - fForestsInfo.Forests[0].Bid); + for K := 0 to fForestsInfo.Count - 1 do + begin + Loc := fForestsInfo.Forests[K].Loc; + Color := (Min(255,Max(50,Round((fForestsInfo.Forests[K].Bid - fForestsInfo.Forests[0].Bid) * Division))) shl 24) OR tcRed; + gRenderAux.Quad(Loc.X, Loc.Y, Color); + end; + end; + + // Paint field of specific farm + if (gMySpectator.Selected is TKMHouse) then + begin + H := TKMHouse(gMySpectator.Selected); + if (H.HouseType in [htFarm, htVineyard]) then + for K := 0 to fFields.Count - 1 do + if KMSamePoint(H.Entrance,fFields.Farms[K].Center) then + with fFields.Farms[K] do + for L := Low(Points) to High(Points) do + if not KMSamePoint(Points[L],KMPOINT_ZERO) then + gRenderAux.Quad(Points[L].X, Points[L].Y, $AA000000 OR tcRed); + end; + + { + for K := 0 to fFields.Count - 1 do + with fFields.Farms[K] do + if FieldAvailable then + for L := Low(Points) to Min(High(Points), Byte(FieldType=ftWine)*8 + Byte(FieldType=ftCorn)*High(Points)) do + for X := Low(Points) to Min(High(Points), Byte(FieldType=ftWine)*8 + Byte(FieldType=ftCorn)*High(Points)) do + if (L<>X) AND KMSamePoint(Points[L],Points[X]) then + begin + gRenderAux.Quad(Points[L].X, Points[L].Y, $FF000000 OR tcRed); + end; + //} +end; + + +{ TKMPathFindingCityPlanner } +function TKMPathFindingCityPlanner.Route_Make(const aLocA, aLocB: TKMPoint; NodeList: TKMPointList): Boolean; +begin + //FillChar(Price,SizeOf(Price),#0); + //FillChar(Order,SizeOf(Order),#0); + + // Override Route_Make so pathfinding cache is not used + fLocA := aLocA; + fLocB := aLocB; + fPass := [tpMakeRoads, tpWalkRoad]; + fTargetNetwork := 0; + fTargetWalkConnect := wcWalk; + fDistance := 0; + fAvoidLocked := palNoAvoid; + fTargetHouse := nil; + + fDestination := pdLocation; + + Result := MakeRoute; + if Result then + ReturnRoute(NodeList) + else + NodeList.Clear; +end; + + +function TKMPathFindingCityPlanner.IsWalkableTile(aX, aY: Word): Boolean; +begin + // Just in case that worker will die while digging house plan or when you plan road near ally + Result := ( ([tpMakeRoads, tpWalkRoad] * gTerrain.Land^[aY,aX].Passability <> []) OR (gTerrain.Land^[aY, aX].TileLock in [tlRoadWork, tlFieldWork]) ) // Existing road / road construction + //AND (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aX, aY)) in [ftNone, ftRoad]) // AI can handle plans + //AND not gHands[fOwner].Constructions.HousePlanList.HasPlan(KMPoint(aX, aY)) // Use avoid building instead so plans are also considered + AND (gAIFields.Influences.AvoidBuilding[aY, aX] <> AVOID_BUILDING_HOUSE_INSIDE_LOCK); +end; + + +function TKMPathFindingCityPlanner.MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; +var + IsRoad: Boolean; + AvoidBuilding: Byte; + cost: Single; + Node: PANodeRec; +begin + cost := AI_Par[ROADS_BasePrice]; + + AvoidBuilding := gAIFields.Influences.AvoidBuilding[aToY, aToX]; + IsRoad := (AvoidBuilding = AVOID_BUILDING_NODE_LOCK_ROAD) // Reserved road plan + OR (tpWalkRoad in gTerrain.Land^[aToY, aToX].Passability) // Completed road + OR (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aToX, aToY)) = ftRoad) // Placed road plan + OR (gTerrain.Land^[aToY, aToX].TileLock = tlRoadWork); // Road under construction + + // Improve cost if tile is or will be road + if IsRoad then cost := Max(0, cost - AI_Par[ROADS_Road]) + // 1 tile from future house + else if (AvoidBuilding = AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) + // Snap to no-build areas (1 tile from house / mountain / special tiles) + OR (not (tpBuild in gTerrain.Land^[aToY,aToX].Passability) AND (AvoidBuilding = 0)) + // 1 tile form mine + OR (AvoidBuilding = AVOID_BUILDING_MINE_TILE) then cost := cost + AI_Par[ROADS_noBuildArea] + else + begin + // Penalization of change in direction in general case + Node := GetNodeAt(aFromX, aFromY); + if (Node <> nil) AND (Node.Parent <> nil) + AND (Node.Parent.X <> aToX) + AND (Node.Parent.Y <> aToY) then cost := cost + AI_Par[ROADS_TurnPenalization]; + // Corn / wine field + if (AvoidBuilding = AVOID_BUILDING_NODE_LOCK_FIELD) then cost := cost + AI_Par[ROADS_Field] + // Coal field + else if (AvoidBuilding = AVOID_BUILDING_COAL_TILE) then cost := cost + AI_Par[ROADS_Coal] + // Forest or blocking tile before house entrance + else if (AvoidBuilding > AVOID_BUILDING_FOREST_MINIMUM) then cost := cost + AI_Par[ROADS_Forest] + // Other case + else cost := cost + AI_Par[ROADS_OtherCase]; + end; + Result := Round(cost); + {$IFDEF DEBUG_NewAI} + Price[aToY,aTox] := Result; + if (Ctr >= High(Word)) then + Ctr := 0; + Inc(Ctr); + Order[aToY,aTox] := Ctr; + {$ENDIF} +end; + + +{ TKMPathFindingShortcutsCityPlanner } +function TKMPathFindingShortcutsCityPlanner.MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; +var + IsRoad: Boolean; + AvoidBuilding: Byte; + cost: Single; + Node: PANodeRec; +begin + cost := AI_Par[SHORTCUTS_BasePrice]; + + AvoidBuilding := gAIFields.Influences.AvoidBuilding[aToY, aToX]; + IsRoad := (AvoidBuilding = AVOID_BUILDING_NODE_LOCK_ROAD) // Reserved road plan + OR (tpWalkRoad in gTerrain.Land^[aToY, aToX].Passability) // Completed road + OR (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aToX, aToY)) = ftRoad) // Placed road plan + OR (gTerrain.Land^[aToY, aToX].TileLock = tlRoadWork); // Road under construction + + // Improve cost if tile is or will be road + if IsRoad then cost := Max(0, cost - AI_Par[SHORTCUTS_Road]) + // 1 tile from future house + else if (AvoidBuilding = AVOID_BUILDING_HOUSE_OUTSIDE_LOCK) + // Snap to no-build areas (1 tile from house or special tiles) + OR (not (tpBuild in gTerrain.Land^[aToY,aToX].Passability) AND (AvoidBuilding = 0)) + // 1 tile form mine + OR (AvoidBuilding = AVOID_BUILDING_MINE_TILE) then cost := cost + AI_Par[SHORTCUTS_noBuildArea] + else + begin + // Penalization of change in direction in general case + Node := GetNodeAt(aFromX, aFromY); + if (Node <> nil) AND (Node.Parent <> nil) + AND (Node.Parent.X <> aToX) + AND (Node.Parent.Y <> aToY) then cost := cost + AI_Par[SHORTCUTS_TurnPenalization]; + // Corn / wine field + if (AvoidBuilding = AVOID_BUILDING_NODE_LOCK_FIELD) then cost := cost + AI_Par[SHORTCUTS_Field] + // Coal field + else if (AvoidBuilding = AVOID_BUILDING_COAL_TILE) then cost := cost + AI_Par[SHORTCUTS_Coal] + // Forest or blocking tile before house entrance + else if (AvoidBuilding > AVOID_BUILDING_FOREST_MINIMUM) then cost := cost + AI_Par[SHORTCUTS_Forest] + // Other case + else cost := cost + AI_Par[SHORTCUTS_OtherCase]; + end; + Result := Round(cost); + {$IFDEF DEBUG_NewAI} + Price[aToY,aTox] := Result; + if (Ctr >= High(Word)) then + Ctr := 0; + Inc(Ctr); + Order[aToY,aTox] := Ctr; + {$ENDIF} +end; + + +function TKMPathFindingShortcutsCityPlanner.DestinationReached(aX, aY: Word): Boolean; +begin + Result := ((aX = fLocB.X) and (aY = fLocB.Y)); //We reached destination point +end; + + +{ TKMFieldEvaluation } +constructor TKMFieldEvaluation.Create(aMapX, aMapY: Word; aOwner: TKMHandID); +begin + fMapX := aMapX; + fMapY := aMapY; + fOwner := aOwner; + fQueue := TQueue.Create(); +end; + + +destructor TKMFieldEvaluation.Destroy(); +begin + fQueue.Free(); + inherited; +end; + + +function TKMFieldEvaluation.CanBeVisited(const aX,aY, aDistance: Word): Boolean; +var + K,L: Integer; +begin + K := aX - fInitPoint.X; + L := aY - fInitPoint.Y; + Result := (K >= - FARM_RADIUS) AND (L >= - FARM_RADIUS) AND (K <= + FARM_RADIUS) AND (L <= + FARM_RADIUS) AND (FieldPrice[L,K] = 0) + AND gTerrain.TileInMapCoords(aX, aY) AND (tpWalk in gTerrain.Land^[aY,aX].Passability) AND (gAIFields.Influences.AvoidBuilding[aY, aX] <> AVOID_BUILDING_HOUSE_INSIDE_LOCK); +end; + + +procedure TKMFieldEvaluation.MarkAsVisited(const aX,aY, aDistance: Word); +var + K,L: Integer; + P: TKMPoint; +begin + K := aX - fInitPoint.X; + L := aY - fInitPoint.Y; + + FieldPrice[L,K] := aDistance; + P := KMPoint(aX,aY); + case gAIFields.Influences.AvoidBuilding[aY, aX] of + AVOID_BUILDING_UNLOCK, AVOID_BUILDING_HOUSE_OUTSIDE_LOCK: + begin + if gTerrain.TileIsCornField(P) then + FieldEval[L,K] := feExistingField + else if gHands[fOwner].CanAddFieldPlan(P, fFieldType) then + FieldEval[L,K] := feFertileTile + else + FieldEval[L,K] := feObstacle; + end; + AVOID_BUILDING_NODE_LOCK_FIELD: + FieldEval[L,K] := feExistingField; + else begin end; + end; +end; + + +procedure TKMFieldEvaluation.InsertInQueue(const aX,aY, aDistance: Word); +var + DE: PDistElement; +begin + MarkAsVisited(aX,aY,aDistance); + New(DE); + DE^.X := aX; + DE^.Y := aY; + DE^.Distance := aDistance; + fQueue.Push(DE); +end; + + +function TKMFieldEvaluation.RemoveFromQueue(var aX,aY, aDistance: Word): Boolean; +var + DE: PDistElement; +begin + Result := (fQueue.Count > 0); + if Result then + begin + DE := fQueue.Pop; + aX := DE^.X; + aY := DE^.Y; + aDistance := DE^.Distance; + Dispose(DE); + end; +end; + + +procedure TKMFieldEvaluation.EvalField(aMaxDist: Word; aInitPoint: TKMPoint; aFieldType: TKMFieldType); +var + X,Y,Distance: Word; +begin + FillChar(FieldEval, SizeOf(FieldEval), #0); + FillChar(FieldPrice, SizeOf(FieldPrice), #0); + + fInitPoint := aInitPoint; + fFieldType := aFieldType; + if CanBeVisited(aInitPoint.X, aInitPoint.Y, 1) then + InsertInQueue(aInitPoint.X, aInitPoint.Y, 1); + + while RemoveFromQueue(X,Y,Distance) do + if (Distance < aMaxDist) then + begin + Distance := Distance + 1; + if (X > 0) AND CanBeVisited(X-1,Y,Distance) then InsertInQueue(X-1,Y,Distance); + if (X < fMapX-1) AND CanBeVisited(X+1,Y,Distance) then InsertInQueue(X+1,Y,Distance); + if (Y > 0) AND CanBeVisited(X,Y-1,Distance) then InsertInQueue(X,Y-1,Distance); + if (Y < fMapY-1) AND CanBeVisited(X,Y+1,Distance) then InsertInQueue(X,Y+1,Distance); + end; +end; + + +procedure TKMFieldEvaluation.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + + +{ JUNK: + + +{ +GA_PLANNER_DistCrit_CenterStore : Single = 3.870659351; +GA_PLANNER_DistCrit_Store : Single = 0.1000000015; +GA_PLANNER_DistCrit_School : Single = 39.48722076; +GA_PLANNER_DistCrit_Inn_Store : Single = 50; +GA_PLANNER_DistCrit_Inn_Inn : Single = 32.82717896; +GA_PLANNER_DistCrit_Marketplace : Single = 35.4796524; +GA_PLANNER_DistCrit_IronSmithy_Self : Single = 3.963907719; +GA_PLANNER_DistCrit_IronSmithy_Res : Single = 28.90864563; +GA_PLANNER_DistCrit_ArmorSmithy_Set : Single = 1.426353335; +GA_PLANNER_DistCrit_ArmorSmithy_Res : Single = 7.746329784; +GA_PLANNER_DistCrit_WeaponSmithy_Set : Single = 4.051534653; +GA_PLANNER_DistCrit_WeaponSmithy_Res : Single = 11.29830551; +GA_PLANNER_DistCrit_Tannery_Set : Single = 49.24342728; +GA_PLANNER_DistCrit_ArmorWorkshop_Set : Single = 4.114400864; +GA_PLANNER_DistCrit_WeaponWorkshop_Set : Single = 4.108706474; +GA_PLANNER_DistCrit_Barracks_Set : Single = 13.32427883; +GA_PLANNER_DistCrit_Bakery_Set : Single = 0.1000000015; +GA_PLANNER_DistCrit_Bakery_Res : Single = 47.20677948; +GA_PLANNER_DistCrit_Butchers_Set : Single = 50; +GA_PLANNER_DistCrit_Butchers_Res : Single = 31.10999107; +GA_PLANNER_DistCrit_Mill_Set : Single = 18.05562401; +GA_PLANNER_DistCrit_Mill_Res : Single = 50; +GA_PLANNER_DistCrit_Swine_Set : Single = 22.83971596; +GA_PLANNER_DistCrit_Swine_Res : Single = 11.5138216; +GA_PLANNER_DistCrit_Stables_Set : Single = 30.27074623; +GA_PLANNER_DistCrit_Stables_Res : Single = 31.47228622; +GA_PLANNER_DistCrit_Farm_Set : Single = 24.62744522; +GA_PLANNER_DistCrit_Farm_Res : Single = 33.97316742; +GA_PLANNER_DistCrit_Wineyard_Set : Single = 45.15957642; +GA_PLANNER_DistCrit_Wineyard_Res : Single = 50; +GA_PLANNER_DistCrit_Metallurgists_Set : Single = 50; +GA_PLANNER_DistCrit_Metallurgists_Res : Single = 7.292239189; +GA_PLANNER_DistCrit_GoldMine_Set : Single = 35.09430313; +GA_PLANNER_DistCrit_CoalMine_Set : Single = 29.58112717; +GA_PLANNER_DistCrit_IronMine_Set : Single = 29.57572556; +GA_PLANNER_DistCrit_Quary_Set : Single = 17.80814362; +GA_PLANNER_DistCrit_Woodcutters_Set : Single = 38.6776886; +GA_PLANNER_DistCrit_Sawmill_Set : Single = 10.2895546; +//} + +{ +function TKMCityPlanner.DistCrit(aHT: TKMHouseType; aLoc: TKMPoint): Single; +const + MAX_BID = 1000000; + + function DistFromHouses(aHTs: array of TKMHouseType): Single; + var + I,K: Integer; + Output: Single; + begin + Output := 0; + for I := Low(aHTs) to High(aHTs) do + for K := 0 to Min(2, fPlannedHouses[ aHTs[I] ].Count - 1) do + Output := Output + KMDistanceAbs(aLoc, fPlannedHouses[ aHTs[I] ].Plans[K].Loc); + Result := Output; + end; + + function DistFromHouse(aHTs: array of TKMHouseType): Single; + var + I,K: Integer; + Output, Bid: Single; + begin + Output := MAX_BID; + for I := Low(aHTs) to High(aHTs) do + for K := 0 to Min(2, fPlannedHouses[ aHTs[I] ].Count - 1) do + begin + Bid := KMDistanceAbs(aLoc, fPlannedHouses[ aHTs[I] ].Plans[K].Loc); + if (Bid < Output) then + Output := Bid; + end; + if (Output = MAX_BID) then + Output := 0; + Result := Output; + end; + +var + Output: Single; +begin + case aHT of + htStore: Output := + GA_PLANNER_DistCrit_Store * DistFromHouse([htStore]); + htSchool: Output := - GA_PLANNER_DistCrit_School * DistFromHouse([htStore,htMetallurgists]); + htInn: Output := - GA_PLANNER_DistCrit_Inn_Store * DistFromHouse([htStore]) + GA_PLANNER_DistCrit_Inn_Inn * DistFromHouse([htInn]); + htMarketplace: Output := - GA_PLANNER_DistCrit_Marketplace * DistFromHouse([htStore]); + + htIronSmithy: Output := - GA_PLANNER_DistCrit_IronSmithy_Self * DistFromHouse([htIronSmithy]) - GA_PLANNER_DistCrit_IronSmithy_Res * DistFromHouse([htCoalMine, htIronMine]); + htArmorSmithy: Output := - GA_PLANNER_DistCrit_ArmorSmithy_Set * DistFromHouse([htIronSmithy]) - GA_PLANNER_DistCrit_ArmorSmithy_Res * DistFromHouse([htCoalMine, htIronMine]); + htWeaponSmithy: Output := - GA_PLANNER_DistCrit_WeaponSmithy_Set * DistFromHouse([htIronSmithy]) - GA_PLANNER_DistCrit_WeaponSmithy_Res * DistFromHouse([htCoalMine, htIronMine]); + htTannery: Output := - GA_PLANNER_DistCrit_Tannery_Set * DistFromHouse([htSwine, htWeaponWorkshop]); + htArmorWorkshop: Output := - GA_PLANNER_DistCrit_ArmorWorkshop_Set * DistFromHouse([htSawmill, htBarracks]); + htWeaponWorkshop: Output := - GA_PLANNER_DistCrit_WeaponWorkshop_Set * DistFromHouse([htTannery, htBarracks]); + htBarracks: Output := - GA_PLANNER_DistCrit_Barracks_Set * DistFromHouses([htArmorSmithy, htArmorWorkshop, htWeaponSmithy, htWeaponWorkshop]); + + htBakery: Output := - GA_PLANNER_DistCrit_Bakery_Set * DistFromHouses([htStore, htInn, htMill]) + GA_PLANNER_DistCrit_Bakery_Res * DistFromHouse([htIronMine, htGoldMine]); + htButchers: Output := - GA_PLANNER_DistCrit_Butchers_Set * DistFromHouses([htStore, htInn, htSwine]) + GA_PLANNER_DistCrit_Butchers_Res * DistFromHouse([htIronMine, htGoldMine]); + htMill: Output := - GA_PLANNER_DistCrit_Mill_Set * DistFromHouses([htFarm, htBakery]) + GA_PLANNER_DistCrit_Mill_Res * DistFromHouse([htIronMine, htGoldMine]); + htSwine: Output := - GA_PLANNER_DistCrit_Swine_Set * DistFromHouses([htFarm]) + GA_PLANNER_DistCrit_Swine_Res * DistFromHouse([htIronMine, htGoldMine]); + htStables: Output := - GA_PLANNER_DistCrit_Stables_Set * DistFromHouses([htFarm]) + GA_PLANNER_DistCrit_Stables_Res * DistFromHouse([htIronMine, htGoldMine]); + htFarm: Output := - GA_PLANNER_DistCrit_Farm_Set * DistFromHouse([htFarm]) + GA_PLANNER_DistCrit_Farm_Res * DistFromHouse([htIronMine, htGoldMine]); + htVineyard: Output := - GA_PLANNER_DistCrit_Wineyard_Set * DistFromHouse([htInn]) + GA_PLANNER_DistCrit_Wineyard_Res * DistFromHouse([htIronMine, htGoldMine]); + + htMetallurgists: Output := - GA_PLANNER_DistCrit_Metallurgists_Set * DistFromHouse([htSchool, htStore, htMetallurgists]) - GA_PLANNER_DistCrit_Metallurgists_Res * DistFromHouse([htGoldMine]); + htGoldMine: Output := - GA_PLANNER_DistCrit_GoldMine_Set * DistFromHouse([htMetallurgists]); + htCoalMine: Output := - GA_PLANNER_DistCrit_CoalMine_Set * DistFromHouse([htMetallurgists, htIronSmithy, htArmorSmithy, htArmorWorkshop]); + htIronMine: Output := - GA_PLANNER_DistCrit_IronMine_Set * DistFromHouse([htIronSmithy]); + + htQuary: Output := - GA_PLANNER_DistCrit_Quary_Set * DistFromHouse([htStore]); + htWoodcutters: Output := - GA_PLANNER_DistCrit_Woodcutters_Set * DistFromHouse([htStore]); // maybe ownership for first woodcutters? gAIFields.Influences.Ownership[fOwner, Mines.Items[I].Y, Mines.Items[I].X] + htSawmill: Output := - GA_PLANNER_DistCrit_Sawmill_Set * DistFromHouse([htWoodcutters, htWeaponWorkshop]); + else + Output := 0; + end; + Result := Output - GA_PLANNER_DistCrit_CenterStore * DistFromHouse([htStore]); +end; +//} + + +// Faster method for placing house +{ +function TKMCityPlanner.FindPlaceForHouse(aUnlockProcedure: Boolean; aHT: TKMHouseType; out aBestLocs: TKMPointArray): Byte; +const + BEST_PLANS_CNT = 8; + INIT_BEST_BID = -1E20; +var + Count: Word; + CityCenter: TKMPoint; + BestBidArr: array[0..BEST_PLANS_CNT-1] of Double; + + function EvalFreeEntrance(aLoc: TKMPoint): Single; + const + OBSTACLE_COEF = 1000; + var + I: Integer; + begin + Result := 0; + if (aLoc.Y+2 >= gTerrain.MapY) then + begin + Result := OBSTACLE_COEF * 3; + Exit; + end; + for I := -1 to 1 do + Result := Result + Byte(tpWalk in gTerrain.Land^[aLoc.Y+2,aLoc.X+I].Passability) * OBSTACLE_COEF; + end; + + procedure EvaluateLoc(aLoc: TKMPoint; InitBid: Single); + var + L: Integer; + Bid: Double; + begin + Count := Count + 1; + Bid := - InitBid * GA_PLANNER_FindPlaceForHouse_CloseWorker + + SnapCrit(aHT, aLoc) * GA_PLANNER_FindPlaceForHouse_SnapCrit + + DistCrit(aHT, aLoc) * GA_PLANNER_FindPlaceForHouse_DistCrit + - KMDistanceSqr(CityCenter, aLoc) * GA_PLANNER_FindPlaceForHouse_CityCenter + - ObstaclesInHousePlan(aHT, aLoc) + - gAIFields.Influences.GetOtherOwnerships(fOwner, aLoc.X, aLoc.Y) * GA_PLANNER_FindPlaceForHouse_Influence + + gAIFields.Influences.EvalArea[aLoc.Y, aLoc.X] * GA_PLANNER_FindPlaceForHouse_EvalArea; + if (aHT = htFarm) OR (aHT = htVineyard) then + Bid := Bid + FieldCrit(aHT, aLoc) + else if (aHT = htStore) OR (aHT = htBarracks) then + Bid := Bid + EvalFreeEntrance(aLoc); + for L := 0 to BEST_PLANS_CNT - 1 do + if KMSamePoint(aLoc, aBestLocs[L]) then + break + else if (Bid > BestBidArr[L]) then // Insert sort for BEST_PLANS_CNT elements ... + begin + KMSwapPoints(aLoc, aBestLocs[L]); + KMSwapFloat(Bid, BestBidArr[L]); + end; + end; + + procedure FindPlaceAroundHType(aHT_HMA: TKMHouseType); + const + INFLUENCE_LIMIT = 100; + var + I,K, Dist: Integer; + Bid: Single; + Dir: TDirection; + Loc: TKMPoint; + WorkersPos: TKMPointArray; + HMA: THouseMappingArray; + InitBids: TSingleArray; + begin + WorkersPos := gHands[fOwner].AI.CityManagement.Builder.WorkersPos; + HMA := gAIFields.Eye.HousesMapping; + // Calculate distance of house from closest free workers + SetLength(InitBids, fPlannedHouses[aHT_HMA].Count); + for I := 0 to fPlannedHouses[aHT_HMA].Count - 1 do + begin + InitBids[I] := 1000000; + for K := 0 to Length(WorkersPos) - 1 do + begin + Bid := KMDistanceSqr(WorkersPos[K], fPlannedHouses[aHT_HMA].Plans[I].Loc); + if (Bid < InitBids[I]) then + InitBids[I] := Bid; + end; + end; + for Dist := 2 to MAX_SCAN_DIST_FROM_HOUSE do + begin + if (Dist > 2) AND (BestBidArr[BEST_PLANS_CNT-1] <> INIT_BEST_BID) then // When we have full array of possible houses break searching and save time + break; + for I := fPlannedHouses[aHT_HMA].Count - 1 downto 0 do // The newest houses have the highest chance that we can place something here so start from newest + for Dir := Low(HMA[aHT_HMA].Surroundings[Dist]) to High(HMA[aHT_HMA].Surroundings[Dist]) do + for K := Low(HMA[aHT_HMA].Surroundings[Dist,Dir]) to High(HMA[aHT_HMA].Surroundings[Dist,Dir]) do + begin + Loc := KMPointAdd(fPlannedHouses[aHT_HMA].Plans[I].Loc, HMA[aHT_HMA].Surroundings[Dist,Dir,K], HMA[aHT].MoveToEntrance[Dir]); + + if not (gTerrain.TileInMapCoords(Loc.X, Loc.Y, 1)) + OR (fPerfArr[Loc.Y,Loc.X] >= fPerfIdx) + OR (Dist > 4) AND (gAIFields.Influences.OwnPoint[fOwner, Loc] < INFLUENCE_LIMIT) then + Continue; + + fPerfArr[Loc.Y,Loc.X] := fPerfIdx; + if gAIFields.Eye.CanAddHousePlan(Loc, aHT, False, not aUnlockProcedure) then + EvaluateLoc(Loc, InitBids[I]); + end; + end; + end; + +var + Time: Cardinal; + + I, EditedCount: Integer; + Probability: Single; + HT: TKMHouseType; + CCPArr: TKMPointArray; +begin + + Time := TimeGet(); + + Result := 0; + CCPArr := gAIFields.Eye.GetCityCenterPoints(False); + if (Length(CCPArr) <= 0) then + Exit; + CityCenter := CCPArr[0]; + + if (fPerfIdx >= 255) then + ClearPerfArr(); + fPerfIdx := fPerfIdx + 1; + + Count := 0; + SetLength(aBestLocs, BEST_PLANS_CNT); + for I := 0 to BEST_PLANS_CNT - 1 do + BestBidArr[I] := INIT_BEST_BID; + + for HT in HOUSE_DEPENDENCE[aHT] do + FindPlaceAroundHType(HT); + + // In case that we have plans but criterium is not positive try to find better place everywhere + EditedCount := Count * Byte(BestBidArr[0] > 0); + // Probability will change in dependence on count of available plans + Probability := (BEST_PLANS_CNT - Min(EditedCount, BEST_PLANS_CNT-1)) / (BEST_PLANS_CNT*1.0); // 1 <> 0.125 + for HT := HOUSE_MIN to HOUSE_MAX do + if (HT <> htWatchTower) + AND (fPlannedHouses[HT].Count > 0) + AND (KaMRandom() < Probability) + AND not (HT in HOUSE_DEPENDENCE[aHT]) then + FindPlaceAroundHType(HT); + + Result := Min(Count, BEST_PLANS_CNT); + + + Time := TimeGet() - Time; + fTimeMeasure := fTimeMeasure + Time; + +end; +//} + + +// Original method (no optimalization) +{ +function TKMCityPlanner.FindPlaceForHouse(aUnlockProcedure: Boolean; aHT: TKMHouseType; out aBestLocs: TKMPointArray): Byte; +const + BEST_PLANS_CNT = 5; + INIT_BEST_BID = -1000000; +var + I,K,L,Dist: Integer; + Dir: TDirection; + HType: TKMHouseType; + Loc: TKMPoint; + Bid, POMBid: Single; + HMA: THouseMappingArray; + BestBidArr: array[0..BEST_PLANS_CNT-1] of Single; +begin + SetLength(aBestLocs, BEST_PLANS_CNT); + for I := Low(BestBidArr) to High(BestBidArr) do + BestBidArr[I] := INIT_BEST_BID; + + HMA := gAIFields.Eye.HousesMapping; + for HType := HOUSE_MIN to HOUSE_MAX do + for I := fPlannedHouses[HType].Count - 1 downto 0 do + begin + for Dist := 2 to MAX_SCAN_DIST_FROM_HOUSE do + begin + for Dir := Low(HMA[HType].Surroundings[Dist]) to High(HMA[HType].Surroundings[Dist]) do + for K := Low(HMA[HType].Surroundings[Dist,Dir]) to High(HMA[HType].Surroundings[Dist,Dir]) do + begin + Loc := KMPointAdd(fPlannedHouses[HType].Plans[I].Loc, HMA[HType].Surroundings[Dist,Dir,K], HMA[aHT].MoveToEntrance[Dir]); + if gAIFields.Eye.CanAddHousePlan(Loc, aHT, False, not aUnlockProcedure) then + begin + Bid := + SnapCrit(aHT, Loc) * GA_PLANNER_FindPlaceForHouse_SnapCrit + + DistCrit(aHT, Loc) * GA_PLANNER_FindPlaceForHouse_DistCrit + - GetTreesInHousePlanCnt(aHT, Loc) * GA_PLANNER_FindPlaceForHouse_TreeInPlan + //+ Abs(fPlannedHouses[HType,I].Loc.Y - Loc.Y) * 3 // Prefer to build houses on left / right side + //+ Abs(fPlannedHouses[HType,I].Loc.X - Loc.X) * 2 + - gAIFields.Influences.GetOtherOwnerships(fOwner,Loc.X,Loc.Y) * ManTune_PLANNER_FindPlaceForHouse_Influence; + if (aHT = htFarm) OR (aHT = htVineyard) then + Bid := Bid + FieldCrit(aHT, Loc) * GA_PLANNER_FindPlaceForHouse_FarmCrit; + for L := Low(BestBidArr) to High(BestBidArr) do + if KMSamePoint(Loc, aBestLocs[L]) then + break + else if (Bid > BestBidArr[L]) then + begin + KMSwapPoints(Loc, aBestLocs[L]); + POMBid := BestBidArr[L]; + BestBidArr[L] := Bid; + Bid := POMBid; + end; + end; + end; + if (Dist > 2) AND (BestBidArr[0] <> INIT_BEST_BID) then + break; + end; + end; + for I := High(BestBidArr) downto Low(BestBidArr) do + if (BestBidArr[I] <> INIT_BEST_BID) then + break; + Result := I; +end; +//} + +{ +function GetBlockingTrees(aHT: TKMHouseType; aLoc: TKMPoint; var aTrees: TKMPointArray): Boolean; +function GetBlockingFields(aHT: TKMHouseType; aLoc: TKMPoint; var aFields: TKMPointArray): Boolean; + +function TKMCityPlanner.GetBlockingTrees(aHT: TKMHouseType; aLoc: TKMPoint; var aTrees: TKMPointArray): Boolean; +var + Output: Boolean; + I,X,Y, TreeCnt: Integer; + HMA: THouseMappingArray; +begin + Result := True; + if (aHT in [htIronMine, htGoldMine, htCoalMine]) then + Exit; + + HMA := gAIFields.Eye.HousesMapping; + SetLength(aTrees, Length(HMA[aHT].Tiles)); + for I := Low(aTrees) to High(aTrees) do + aTrees[I] := KMPOINT_ZERO; + + Output := True; + TreeCnt := 0; + for I := Low(HMA[aHT].Tiles) to High(HMA[aHT].Tiles) do + begin + X := aLoc.X + HMA[aHT].Tiles[I].X; + Y := aLoc.Y + HMA[aHT].Tiles[I].Y; + Output := Output AND (tpBuild in gTerrain.Land^[Y,X].Passability); + if gTerrain.ObjectIsChopableTree(KMPoint(X,Y), [caAge1,caAge2,caAge3,caAgeFull]) then + begin + aTrees[TreeCnt] := KMPoint(X,Y); + TreeCnt := TreeCnt + 1; + end; + if not Output then + break; + end; + Result := Output; +end; + + +function TKMCityPlanner.GetBlockingFields(aHT: TKMHouseType; aLoc: TKMPoint; var aFields: TKMPointArray): Boolean; +var + I,X,Y, FieldCnt: Integer; + HMA: THouseMappingArray; +begin + Result := True; + if (aHT in [htIronMine, htGoldMine, htCoalMine]) then + Exit; + + HMA := gAIFields.Eye.HousesMapping; + SetLength(aFields, Length(HMA[aHT].Tiles)); + for I := Low(aFields) to High(aFields) do + aFields[I] := KMPOINT_ZERO; + + FieldCnt := 0; + for I := Low(HMA[aHT].Tiles) to High(HMA[aHT].Tiles) do + begin + X := aLoc.X + HMA[aHT].Tiles[I].X; + Y := aLoc.Y + HMA[aHT].Tiles[I].Y; + aFields[FieldCnt] := KMPoint(X,Y); + if (gHands[fOwner].Constructions.FieldworksList.HasField(aFields[FieldCnt]) = ftWine) + OR (gHands[fOwner].Constructions.FieldworksList.HasField(aFields[FieldCnt]) = ftCorn) then + FieldCnt := FieldCnt + 1; + end; + Result := (FieldCnt > 0); +end; + + +procedure TKMCityPlanner.PlanFarmFields(aLoc: TKMPoint; var aNodeTagList: TKMPointTagList); +const + NORTH_PENALIZATION = 10; + MAX_FIELDS = 16; + NOT_IN_AVOID_BUILDING = 5; + NOT_IN_FIELD = 8; + SUM_COEF = 1; +var + I,K,X,Y,I2,K2,Dist: Integer; + Price: Cardinal; + MaxP, MinP, Point: TKMPoint; + Weight: Cardinal; + Dir: TDirection; + HT: TKMHouseType; + FieldLoc: TKMPoint; + HMA: THouseMappingArray; + PriceArr: array of array of Word; +begin + HT := htFarm; + HMA := gAIFields.Eye.HousesMapping; + + MaxP := KMPoint(Min(aLoc.X + 2 + 4, gTerrain.MapX - 1), Min(aLoc.Y + 0 + 5, gTerrain.MapY - 1)); + MinP := KMPoint(Min(aLoc.X - 1 - 4, 1), Min(aLoc.Y - 2 - 4, 1)); + SetLength(PriceArr, MaxP.Y - MinP.Y, MaxP.X - MinP.X); + for I := Low(PriceArr) to High(PriceArr) do + begin + Y := MinP.Y + I; + for K := Low(PriceArr[I]) to High(PriceArr[I]) do + begin + X := MinP.X + K; + Point := KMPoint(X,Y); + if (gAIFields.Influences.AvoidBuilding[Y,X] > 0) OR not gHands[fOwner].CanAddFieldPlan(Point, ftCorn) then + PriceArr[I,K] := 0 + else + PriceArr[I,K] := + KMDistanceAbs(Point, aLoc) + + NOT_IN_AVOID_BUILDING * Byte(not (tpBuild in gTerrain.Land^[Y,X].Passability) ) + + NOT_IN_FIELD * Byte(not gTerrain.TileIsCornField(Point)) + + NORTH_PENALIZATION * Byte(Y < aLoc.Y - 2); + end; + end; + for I := Low(PriceArr) to High(PriceArr) do + begin + Y := MinP.Y + I; + for K := Low(PriceArr[I]) to High(PriceArr[I]) do + if (PriceArr[I,K] > 0) then + begin + X := MinP.X + K; + Price := 0; + for I2 := Max(Low(PriceArr),I-SUM_COEF) to Min(High(PriceArr),I+SUM_COEF) do + for K2 := Max(Low(PriceArr[I]),K-SUM_COEF) to Min(High(PriceArr[I]),K+SUM_COEF) do + Price := Price + PriceArr[I2,K2]; + aNodeTagList.Add(KMPoint(X,Y), Price); + end; + end; + aNodeTagList.SortByTag; +end; +//} + +{ +procedure TKMCityPlanner.PlanFarmFields(aLoc: TKMPoint; var aNodeTagList: TKMPointTagList); +const + NORTH_PENALIZATION = 10; + MAX_FIELDS = 16; + NOT_IN_AVOID_BUILDING = 3; + NOT_IN_FIELD = 5; +var + I,K,X,Y,I2,K2,Dist: Integer; + Price: Cardinal; + MaxP, MinP, Point: TKMPoint; + Weight: Cardinal; + Dir: TDirection; + HT: TKMHouseType; + FieldLoc: TKMPoint; + HMA: THouseMappingArray; + //PriceArr: array of array of Word; + PriceArr: array[TDirection] of Integer; +begin + HT := htFarm; + HMA := gAIFields.Eye.HousesMapping; + // Try find something to snap + + Dist := 5; + for Dir := Low(HMA[HT].Surroundings[Dist]) to High(HMA[HT].Surroundings[Dist]) do + begin + PriceArr[Dir] := 500; + for I := Low(HMA[HT].Surroundings[Dist,Dir]) to High(HMA[HT].Surroundings[Dist,Dir]) do + begin + FieldLoc := KMPointAdd(aLoc, HMA[HT].Surroundings[Dist,Dir,I]); + if not (gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) AND gHands[fOwner].CanAddFieldPlan(FieldLoc, ftCorn)) then + PriceArr[Dir] := PriceArr[Dir] - 5; + end; + end; + PriceArr[dirN] := Max(0, PriceArr[dirN] + NORTH_PENALIZATION); + // Find all possible places to build field + for Dist := 1 to 4 do + begin + for Dir := Low(HMA[HT].Surroundings[Dist]) to High(HMA[HT].Surroundings[Dist]) do + begin + if (Dist = 1) AND (Dir = dirS) then // Don't plan fields 1 tile under farm plan + Continue; + for I := Low(HMA[HT].Surroundings[Dist,Dir]) to High(HMA[HT].Surroundings[Dist,Dir]) do + begin + FieldLoc := KMPointAdd(aLoc, HMA[HT].Surroundings[Dist,Dir,I]); + if gTerrain.TileInMapCoords(FieldLoc.X, FieldLoc.Y) AND gHands[fOwner].CanAddFieldPlan(FieldLoc, ftCorn) then + begin + Weight := KMDistanceAbs(FieldLoc, aLoc) + PriceArr[Dir]; + aNodeTagList.Add(FieldLoc, Weight); + end; + end; + //if (aNodeTagList.Count >= MAX_FIELDS) then + // break; + end; + end; + + aNodeTagList.SortByTag; +end; +//} + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_CityPredictor.pas b/vendor/kam_remake/src/ai/newAI/KM_CityPredictor.pas new file mode 100644 index 0000000..8dd77f7 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_CityPredictor.pas @@ -0,0 +1,911 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_CityPredictor; +{$I KaM_Remake.inc} +interface +uses + SysUtils, Classes, Math, + KromUtils, + KM_Defaults, KM_CommonClasses, KM_CommonTypes, + KM_AISetup, KM_ResHouses, KM_ResWares, KM_HandStats, KM_AIParameters, + KM_ResTypes; + +type + TWareBalance = record + Production, ActualConsumption, FinalConsumption, Exhaustion, Fraction: Single; + end; + // Information about city (it can be replaced by player's stats but it doesnt allow prediction with different values) + TCityStats = record + CitizensCnt, WarriorsCnt, HousesCnt: Integer; + Citizens: array[CITIZEN_MIN..CITIZEN_MAX] of Integer; // Stats sometimes throw negative number in case of Recruit so keep integer + Warriors: array[WARRIOR_MIN..WARRIOR_MAX] of Integer; + Houses: array[HOUSE_MIN..HOUSE_MAX] of Integer; + end; + THouseBuildHistory = record + Count: Word; + Quantity: TKMWordArray; + Tick: TKMCardinalArray; + end; + TWareBalanceArray = array[WARE_MIN..WARE_MAX] of TWareBalance; + //TWarfareDemands = array[WARFARE_MIN..WARFARE_MAX] of Single; + TRequiredHousesArray = array[HOUSE_MIN..HOUSE_MAX] of Integer; + + // City predictor (calculation of required houses based on prediction of resource flow) + TKMCityPredictor = class + private + fOwner: TKMHandID; + fCityStats: TCityStats; + fCityUnderConstruction, fCityCompleted: Boolean; + fWorkerCount: Word; + fMaxGoldMineCnt, fDecCoalMineCnt, fIronMineCnt, fFieldCnt, fBuildCnt: Integer; + fMaxIronWeapProd, fMaxWoodWeapProd, fMaxSoldiersInMin, fPeaceFactor, fUpdatedPeaceFactor: Single; + fWareBalance: TWareBalanceArray; + fFarmBuildHistory: THouseBuildHistory; // Farms are another exception in production (production is delayed and depends on position of each farm) + fSetup: TKMHandAISetup; + + procedure UpdateWareProduction(aWT: TKMWareType); + procedure UpdateWareConsumption(aWT: TKMWareType; aInitialization: Boolean = False); + procedure UpdateFoodConsumption(aInitialization: Boolean = False); + procedure UpdateGoldConsumption(aInitialization: Boolean = False); + procedure UpdateBuildMaterialConsumption(aInitialization: Boolean = False); + procedure UpdateWareDerivation(aWT: TKMWareType; aInitialization: Boolean = False); + procedure UpdateWareBalance(aInitialization: Boolean = False); + + procedure UpdateBasicHouses(aTick: Cardinal; aInitialization: Boolean = False); + procedure UpdateFinalProduction(aIncPeaceFactor: Single = 0; aIncrementMines: Boolean = False); + procedure UpdateCityStats(); + + procedure FilterRequiredHouses(aTick: Cardinal); + public + RequiredHouses: TRequiredHousesArray; + + constructor Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + property UpdatedPeaceFactor: Single read fUpdatedPeaceFactor; + property CityStats: TCityStats read fCityStats; + property CityCompleted: Boolean read fCityCompleted; + property WareBalance: TWareBalanceArray read fWareBalance; + property WorkerCount: Word read fWorkerCount; + property MaxGoldMineCnt: Integer read fMaxGoldMineCnt write fMaxGoldMineCnt; + property IronMineCnt: Integer read fIronMineCnt write fIronMineCnt; + property FieldCnt: Integer read fFieldCnt write fFieldCnt; + property BuildCnt: Integer read fBuildCnt write fBuildCnt; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure LogStatus(var aBalanceText: UnicodeString); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure MarkExhaustedMine(aMineType: TKMHouseType); + + end; + +const + + { + TKMWareType: + wtNone, + wtTrunk, wtStone, wtWood, wtIronOre, wtGoldOre, + wtCoal, wtSteel, wtGold, wtWine, wtCorn, + wtBread, wtFlour, wtLeather, wtSausages, wtPig, + wtSkin, wtShield, wtMetalShield, wtArmor, wtMetalArmor, + wtAxe, wtSword, wtPike, wtHallebard, wtBow, + wtArbalet, wtHorse, wtFish, + wtAll, wtWarfare, wtFood + } + // Array of wares which are produced by specific houses + PRODUCTION_WARE2HOUSE: array[WARE_MIN..WARE_MAX] of TKMHouseType = ( + htWoodcutters, htQuarry, htSawmill, htIronMine, htGoldMine, + htCoalMine, htIronSmithy, htMetallurgists, htVineyard, htFarm, + htBakery, htMill, htTannery, htButchers, htSwine, + htSwine, htArmorWorkshop, htArmorSmithy, htArmorWorkshop, htArmorSmithy, + htWeaponWorkshop, htWeaponSmithy, htWeaponWorkshop, htWeaponSmithy, htWeaponWorkshop, + htWeaponSmithy, htStables, htFishermans + ); + // Possible transformation of wares: resource -> product + CONSUMPTION_WARE: array[WARE_MIN..WARE_MAX] of array[0..3] of TKMWareType = ( // wtShield are ignored + (wtTimber, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtAxe, wtNone, wtNone, wtNone), (wtIron, wtNone, wtNone, wtNone), (wtGold, wtNone, wtNone, wtNone), + (wtIron, wtGold, wtIronArmor, wtSword), (wtIronArmor, wtSword, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtFlour, wtPig, wtHorse, wtNone), + (wtNone, wtNone, wtNone, wtNone), (wtBread, wtNone, wtNone, wtNone), (wtLeatherArmor, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtSausage, wtNone, wtNone, wtNone), + (wtLeather, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), + (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), + (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone), (wtNone, wtNone, wtNone, wtNone) + ); + // Array of wares which are consumed in specific amount to achieve specific production (because of exceptions in htWeaponWorkshop / htSwine / htStables etc.) + CONSUMPTION_RATIO: array[wtTrunk..wtSkin] of array[0..3] of Single = ( + // 1 trunk = 2 Wood 2 wood = 1 axe/bow/spear 1 GoldOre = 2 Gold (+ 1 Coal) + (0.5, 1, 1, 1), (1, 1, 1, 1), (2, 1, 1, 1), (1, 1, 1, 1), (0.5, 1, 1, 1), + // 1 coal = 2 gold (+ 1 gold ore) BEAST_COST = 4 (per a pig / horse) + (0.5, 1, 1, 1), (1, 1, 1, 1), (1, 1, 1, 1), (1, 1, 1, 1), (1, 4, 4, 1), + // 1 flour = 2 bread 1 pig = 3 sausages + (1, 1, 1, 1), (0.5, 1, 1, 1), (1, 1, 1, 1), (1, 1, 1, 1), (0.333, 1, 1, 1), + // 1 skin = 2 leather + (0.5, 1, 1, 1) + ); + CONSUMPTION_ORDER: array[0..27] of TKMWareType = ( // Basicaly TKMWareType but sorted by order: resource -> product + wtStone, wtTrunk, wtTimber, + wtCorn, wtFlour, wtBread, wtWine, wtFish, + wtPig, wtSausage, wtSkin, wtLeather, wtHorse, + wtGoldOre, wtIronOre, wtCoal, wtGold, wtIron, + wtAxe, wtBow, wtLance, wtLeatherArmor, wtWoodenShield, + wtSword, wtCrossbow, wtPike, wtIronShield, wtIronArmor + ); + CO_WEAPONS_MIN = 18; + CO_WEAPONS_MAX = 27; + CO_IRON_WEAPONS_MIN = 23; + CO_IRON_WEAPONS_MAX = 27; + CO_WOOD_WEAPONS_MIN = 22; + CO_WOOD_WEAPONS_MAX = 18; + CO_WARE_MIN = 0; + CO_WARE_MAX = 17; + { + // Array of wares which are consumed by specific houses + CONSUMPTION_WARE: array[WARE_MIN..WARE_MAX] of array[0..3] of TKMHouseType = ( + (htSawmill, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htWeaponWorkshop, htArmorWorkshop, htNone, htNone), (htIronSmithy, htNone, htNone, htNone), (htMetallurgists, htNone, htNone, htNone), + (htMetallurgists, htIronSmithy, htArmorSmithy, htWeaponSmithy), (htArmorSmithy, htWeaponSmithy, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htMill, htSwine, htStables, htNone), + (htNone, htNone, htNone, htNone), (htBakery, htNone, htNone, htNone), (htArmorWorkshop, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htButchers, htNone, htNone, htNone), + (htTannery, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), + (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), + (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone), (htNone, htNone, htNone, htNone) + ); + } + +implementation +uses + KM_HandsCollection, KM_Hand, KM_Game, KM_GameParams, KM_CityPlanner; + + +{ TKMCityPredictor } +constructor TKMCityPredictor.Create(aPlayer: TKMHandID; aSetup: TKMHandAISetup); +begin + inherited Create; + fOwner := aPlayer; + fSetup := aSetup; + fWorkerCount := 0; + fCityUnderConstruction := False; + fCityCompleted := False; + + fMaxGoldMineCnt := 0; + fDecCoalMineCnt := 0; + fIronMineCnt := 0; + fFieldCnt := 0; + fBuildCnt := 0; + + fMaxIronWeapProd := 0; + fMaxWoodWeapProd := 0; + fMaxSoldiersInMin := 0; + fPeaceFactor := 0; + fUpdatedPeaceFactor := 0; + + with fFarmBuildHistory do + begin + Count := 1; + SetLength(Quantity,1); + SetLength(Tick,1); + Quantity[0] := 0; + Tick[0] := 10 * 60 * 10; // Init delay 10 min + end; +end; + +destructor TKMCityPredictor.Destroy(); +begin + inherited; +end; + + +procedure TKMCityPredictor.Save(SaveStream: TKMemoryStream); +var + WT: TKMWareType; +begin + SaveStream.PlaceMarker('CityPredictor'); + SaveStream.Write(fOwner); + SaveStream.Write(fWorkerCount); + SaveStream.Write(fCityUnderConstruction); + SaveStream.Write(fCityCompleted); + + + SaveStream.Write(fMaxGoldMineCnt); + SaveStream.Write(fDecCoalMineCnt); + SaveStream.Write(fIronMineCnt); + SaveStream.Write(fFieldCnt); + SaveStream.Write(fBuildCnt); + + SaveStream.Write(fMaxIronWeapProd); + SaveStream.Write(fMaxWoodWeapProd); + SaveStream.Write(fMaxSoldiersInMin); + SaveStream.Write(fPeaceFactor); + SaveStream.Write(fUpdatedPeaceFactor); + + SaveStream.Write(fFarmBuildHistory.Count); + if (fFarmBuildHistory.Count > 0) then + begin + SaveStream.Write(fFarmBuildHistory.Quantity[0], SizeOf(fFarmBuildHistory.Quantity[0]) * fFarmBuildHistory.Count); + SaveStream.Write(fFarmBuildHistory.Tick[0], SizeOf(fFarmBuildHistory.Tick[0]) * fFarmBuildHistory.Count); + end; + + // Requred houses should be saved because of public variable + SaveStream.Write(RequiredHouses, SizeOf(TRequiredHousesArray)); + // fWareBalance must be saved because of FinalConsumption, Trading and building algorithm + for WT := WARE_MIN to WARE_MAX do + SaveStream.Write(fWareBalance[WT], SizeOf(TWareBalance)); + // Stats are updated each cycle and doesn't have to be saved + //fCityStats: TCityStats; +end; + + +procedure TKMCityPredictor.Load(LoadStream: TKMemoryStream); +var + WT: TKMWareType; +begin + LoadStream.CheckMarker('CityPredictor'); + LoadStream.Read(fOwner); + LoadStream.Read(fWorkerCount); + LoadStream.Read(fCityUnderConstruction); + LoadStream.Read(fCityCompleted); + + LoadStream.Read(fMaxGoldMineCnt); + LoadStream.Read(fDecCoalMineCnt); + LoadStream.Read(fIronMineCnt); + LoadStream.Read(fFieldCnt); + LoadStream.Read(fBuildCnt); + + LoadStream.Read(fMaxIronWeapProd); + LoadStream.Read(fMaxWoodWeapProd); + LoadStream.Read(fMaxSoldiersInMin); + LoadStream.Read(fPeaceFactor); + LoadStream.Read(fUpdatedPeaceFactor); + + LoadStream.Read(fFarmBuildHistory.Count); + if (fFarmBuildHistory.Count > 0) then + begin + SetLength(fFarmBuildHistory.Quantity, fFarmBuildHistory.Count); + SetLength(fFarmBuildHistory.Tick, fFarmBuildHistory.Count); + LoadStream.Read(fFarmBuildHistory.Quantity[0], SizeOf(fFarmBuildHistory.Quantity[0]) * fFarmBuildHistory.Count); + LoadStream.Read(fFarmBuildHistory.Tick[0], SizeOf(fFarmBuildHistory.Tick[0]) * fFarmBuildHistory.Count); + end; + + // Requred houses should be saved because of public variable + LoadStream.Read(RequiredHouses, SizeOf(TRequiredHousesArray)); + // fWareBalance must be saved because of FinalConsumption + for WT := WARE_MIN to WARE_MAX do + LoadStream.Read(fWareBalance[WT], SizeOf(TWareBalance)); + // Stats are updated each cycle and doesn't have to be saved + //fCityStats: TCityStats; +end; + + +procedure TKMCityPredictor.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; +end; + + +procedure TKMCityPredictor.MarkExhaustedMine(aMineType: TKMHouseType); +begin + case aMineType of + htIronMine: Dec(fIronMineCnt); + htGoldMine: Dec(fMaxGoldMineCnt); + htCoalMine: Inc(fDecCoalMineCnt); + end; + UpdateFinalProduction(); +end; + + +// Update ware production +procedure TKMCityPredictor.UpdateWareProduction(aWT: TKMWareType); +begin + fWareBalance[aWT].Production := fCityStats.Houses[ PRODUCTION_WARE2HOUSE[aWT] ] * PRODUCTION_RATE[aWT]; +end; + + +// Update ware consumption +procedure TKMCityPredictor.UpdateWareConsumption(aWT: TKMWareType; aInitialization: Boolean = False); +var + I: Integer; +begin + fWareBalance[aWT].ActualConsumption := 0; + if aInitialization then + fWareBalance[aWT].FinalConsumption := 0; + for I := Low(CONSUMPTION_WARE[aWT]) to High(CONSUMPTION_WARE[aWT]) do + if (CONSUMPTION_WARE[aWT,I] <> wtNone) then + begin + fWareBalance[aWT].ActualConsumption := fWareBalance[aWT].ActualConsumption + fWareBalance[ CONSUMPTION_WARE[aWT,I] ].ActualConsumption * CONSUMPTION_RATIO[aWT,I]; + if aInitialization then + fWareBalance[aWT].FinalConsumption := fWareBalance[aWT].FinalConsumption + Max(fWareBalance[ CONSUMPTION_WARE[aWT,I] ].FinalConsumption, fWareBalance[ CONSUMPTION_WARE[aWT,I] ].ActualConsumption) * CONSUMPTION_RATIO[aWT,I]; + end + else + break; +end; + + +// Update food consumption +procedure TKMCityPredictor.UpdateFoodConsumption(aInitialization: Boolean = False); +const + CITIZEN_FOOD_COEF = 0.05; // On average citizen needs to eat each 40min but takes 2 food to full status = 1/20 = 0.05 + SOLDIER_FOOD_COEF = 0.025; // On average soldier needs to eat each 40min and takes 1 food to full status = 1/40 = 0.025 +var + Consumption: Single; +begin + // Get consumption of city + army + Consumption := (fCityStats.CitizensCnt * CITIZEN_FOOD_COEF) + (fCityStats.WarriorsCnt * SOLDIER_FOOD_COEF); + // Calculate consumption of leather armor / minute and pigs which are produced with this cycle + // 2x armor = 2x leather = 1x skin = 1x pig = 3x sausages ... sausages = 3 / 2 * armor = 1.5 * armor + fWareBalance[wtSausage].ActualConsumption := Min(Consumption, fWareBalance[wtLeatherArmor].FinalConsumption * 1.5); + // Split rest of consumtion into other houses + Consumption := Max(0, Consumption - fWareBalance[wtSausage].ActualConsumption); + fWareBalance[wtBread].ActualConsumption := Consumption * 0.7; + fWareBalance[wtWine].ActualConsumption := Consumption * 0.3; + fWareBalance[wtFish].ActualConsumption := 0; + // Expected food consumption of the final city size (it helps with build order to secure food and weapons production ASAP) + if aInitialization then + begin + fWareBalance[wtSausage].FinalConsumption := fWareBalance[wtSausage].ActualConsumption; + fWareBalance[wtBread].FinalConsumption := fWareBalance[wtBread].ActualConsumption; + fWareBalance[wtWine].FinalConsumption := fWareBalance[wtWine].ActualConsumption; + fWareBalance[wtFish].FinalConsumption := fWareBalance[wtFish].ActualConsumption; + end; +end; + + +// Update gold consumption +procedure TKMCityPredictor.UpdateGoldConsumption(aInitialization: Boolean = False); +const + GOLD_NEED_PER_A_SCHOOL = 3.5; // Amount of gold which requires school (in 1 minute) +begin + fWareBalance[wtGold].ActualConsumption := Min(fMaxSoldiersInMin, (fCityStats.Houses[htSchool] + RequiredHouses[htSchool]) * GOLD_NEED_PER_A_SCHOOL); +end; + + +// Update build material consumption +procedure TKMCityPredictor.UpdateBuildMaterialConsumption(aInitialization: Boolean = False); +begin + // Worker count is decreased after peace time -> compute with maximal count + fWareBalance[wtStone].ActualConsumption := Min(fCityStats.Citizens[utBuilder] + Round(AI_Par[PREDICTOR_WareNeedPerAWorker_StoneOffset]), fWorkerCount) * AI_Par[PREDICTOR_WareNeedPerAWorker_Stone]; + fWareBalance[wtStone].FinalConsumption := fWareBalance[wtStone].ActualConsumption; + // Raw wood expectations + UpdateWareConsumption(wtTimber, aInitialization); + fWareBalance[wtTimber].ActualConsumption := Max(fWareBalance[wtTimber].ActualConsumption, fCityStats.Citizens[utBuilder] * AI_Par[PREDICTOR_WareNeedPerAWorker_Wood]); + fWareBalance[wtTimber].FinalConsumption := Max(fWareBalance[wtTimber].FinalConsumption, fWorkerCount * AI_Par[PREDICTOR_WareNeedPerAWorker_Wood]); +end; + + +// Update ware derivation - 2 views: +// 1. Exhaustion = estimation of time when will be ware depleted (determine which house should be built at first) +// 2. Fraction = fraction of required and available houses +procedure TKMCityPredictor.UpdateWareDerivation(aWT: TKMWareType; aInitialization: Boolean = False); + function GetDependentWareBalance(): Single; + begin + Result := gHands[fOwner].Stats.GetWareBalance(aWT); + case aWT of + wtTrunk: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtTimber) / 2; + wtIronOre: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtIron); + //wtGoldOre: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtGold) / 2; + //wtCorn: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtGold) / 2; + wtFlour: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtBread) / 2; + wtPig: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtSausage) / 3; + wtSkin: Result := Result + gHands[fOwner].Stats.GetWareBalance(wtLeather) / 2; + end; + end; +var + houseReqCnt: Integer; + HT: TKMHouseType; +begin + HT := PRODUCTION_WARE2HOUSE[aWT]; + with fWareBalance[aWT] do + begin + // Calculate when will be ware depleted + Exhaustion := 999; + if (ActualConsumption - Production > 0) then + Exhaustion := Min( Exhaustion, GetDependentWareBalance() / (ActualConsumption - Production) ); + houseReqCnt := Ceil(( Max(ActualConsumption, FinalConsumption) - Production) / Max(0.0001, PRODUCTION_RATE[aWT]*1.0)); + if (houseReqCnt > 0) AND (Exhaustion >= 950) AND (fCityStats.Houses[ PRODUCTION_WARE2HOUSE[aWT] ] = 0) then + houseReqCnt := 1 + else + houseReqCnt := Byte(Exhaustion < 950) * houseReqCnt; + Fraction := houseReqCnt / Max(1.0,((fCityStats.Houses[HT] + houseReqCnt)*1.0)); + end; + RequiredHouses[HT] := houseReqCnt; +end; + + +// Update ware balance +procedure TKMCityPredictor.UpdateWareBalance(aInitialization: Boolean = False); +var + I: Integer; +begin + // Update weapons + for I := CO_WEAPONS_MAX downto CO_WEAPONS_MIN do + begin + UpdateWareProduction(CONSUMPTION_ORDER[I]); + // Final and actual consumptions for weapons are constant + fWareBalance[ CONSUMPTION_ORDER[I] ].ActualConsumption := fWareBalance[ CONSUMPTION_ORDER[I] ].FinalConsumption; + UpdateWareDerivation(CONSUMPTION_ORDER[I],aInitialization); + end; + + // Update "Normal" ware flow + UpdateFoodConsumption(aInitialization); + UpdateGoldConsumption(aInitialization); + UpdateBuildMaterialConsumption(aInitialization); + for I := CO_WARE_MAX downto CO_WARE_MIN do + begin + UpdateWareProduction(CONSUMPTION_ORDER[I]); + // Exeptions + case CONSUMPTION_ORDER[I] of + // Food was updated at once + wtWine, wtBread, wtSausage, wtFish: begin end; + // Update Gold + wtGold: begin end; + // Update materials + wtStone: begin end; + wtTimber: begin end; + // Other cases + else + UpdateWareConsumption(CONSUMPTION_ORDER[I], aInitialization); + end; + UpdateWareDerivation(CONSUMPTION_ORDER[I],aInitialization); + end; +end; + + +// Basic house requirements +procedure TKMCityPredictor.UpdateBasicHouses(aTick: Cardinal; aInitialization: Boolean = False); +const + INN_TIME_LIMIT = 60 * 10 * 14; // ~ 14 minutes from start + SCHOOL_PRODUCTION = 3; // Amount of gold which requires school (in 1 minute) - in ideal case it requires only 3.5 in real there is not gold so it must be lower + FIRST_MARKETPLACE = 10 * 60 * 60; + SECOND_MARKETPLACE = 10 * 60 * 100; + BARRACKS_PEACE_DELAY = 30; // Build barracks since 30 min + BARRACKS_BEFORE_PEACE_END = 20; // Allow to build barracks before peace time end +begin + // 1 Storehouse + RequiredHouses[htStore] := 1 - fCityStats.Houses[htStore]; + // 1 Barracks (build only when we have weapons and (from X tick or Y ticks before peace end -> avoid to build barracks in 1 minute when is still peace and we have predefined weapons in storehouse)) + RequiredHouses[htBarracks] := Byte(aInitialization OR ((gHands[fOwner].Stats.GetWareBalance(wtWarfare) > 0) AND ((aTick > BARRACKS_PEACE_DELAY * 600) OR (aTick > (gGame.Options.Peacetime - BARRACKS_BEFORE_PEACE_END) * 600)))) - fCityStats.Houses[htBarracks]; + // Schools (at least 1 + WarriorsPerMinute criterium) + with gHands[fOwner].AI.CityManagement do + RequiredHouses[htSchool] := Max( + 0, + Max( + 1 + Byte( (RequiredUnitsCnt > Round(AI_Par[PREDICTOR_SecondSchool_MinRequiredUnits])) AND not Builder.GoldShortage AND not Builder.StoneShortage AND not Builder.TrunkShortage AND not Builder.WoodShortage), + Byte( (fCityStats.Houses[htBarracks] > 0) OR aInitialization ) * (Ceil(fMaxSoldiersInMin / SCHOOL_PRODUCTION)) + ) - fCityStats.Houses[htSchool] + ); + // Inn (at least 1 after INN_TIME_LIMIT + CitizensCnt criterium) + RequiredHouses[htInn] := Max( + 0, + Ceil( Byte( (aTick > INN_TIME_LIMIT) OR aInitialization ) * fCityStats.CitizensCnt / 80 ) - fCityStats.Houses[htInn] + ); + // Marketplace - 1. after FIRST_MARKETPLACE; 2. after SECOND_MARKETPLACE + RequiredHouses[htMarket] := Byte( aInitialization OR (aTick > FIRST_MARKETPLACE) ) + Byte( aInitialization OR (aTick > SECOND_MARKETPLACE) ) - fCityStats.Houses[htMarket]; +end; + + +// Get players stats and store them into local variable (to be able to edit them later) +procedure TKMCityPredictor.UpdateCityStats(); +var + constructedHouses: Integer; + UT: TKMUnitType; + HT: TKMHouseType; +begin + with fCityStats do + begin + CitizensCnt := 0; + for UT := Low(Citizens) to High(Citizens) do + begin + Citizens[UT] := gHands[fOwner].Stats.GetUnitQty(UT); + Inc(CitizensCnt, Citizens[UT]); + end; + Dec(CitizensCnt, Citizens[utRecruit]); // Count recruits as soldiers + WarriorsCnt := Citizens[utRecruit]; + for UT := Low(Warriors) to High(Warriors) do + begin + Warriors[UT] := gHands[fOwner].Stats.GetUnitQty(UT); + Inc(WarriorsCnt, Warriors[UT]); + end; + end; + + constructedHouses := 0; + fCityStats.HousesCnt := 0; + with gHands[fOwner].AI.CityManagement.Builder do + begin + for HT := Low(fCityStats.Houses) to High(fCityStats.Houses) do + begin + //Houses[HT] := gHands[fOwner].Stats.GetHouseTotal(HT); // Does not consider planned houses + // Consider only placed, constructed or planned houses (not destroyed houses because plans will remain in CityPlanner) + fCityStats.Houses[HT] := Planner.PlannedHouses[HT].Completed + Planner.PlannedHouses[HT].UnderConstruction + Planner.PlannedHouses[HT].Planned; + Inc(fCityStats.HousesCnt, fCityStats.Houses[HT]); + Inc(constructedHouses, Planner.PlannedHouses[HT].UnderConstruction + Planner.PlannedHouses[HT].Planned); + end; + fCityUnderConstruction := (constructedHouses > 0) AND ((FreeWorkerCnt < 10) OR (constructedHouses > 3)); + fCityCompleted := (constructedHouses = 0) AND (FreeWorkerCnt = fCityStats.Citizens[utBuilder]); + end; +end; + + +procedure TKMCityPredictor.UpdateFinalProduction(aIncPeaceFactor: Single = 0; aIncrementMines: Boolean = False); +const + IRON_WARFARE: set of TKMWareType = [wtIronShield, wtIronArmor, wtSword, wtPike, wtCrossbow]; + WOOD_WARFARE: set of TKMWareType = [wtAxe, wtLance, wtBow]; + INV_AFTER_PEACE_SCALING = 1 / (30*10*60); // Peace factor will be completely removed after {30} mins since end of peace + MIN_IRON_PRODUCTION = 2; + MAX_IRON_PRODUCTION = 6; + INV_REQUIRED_TILES_PER_IRON = 1/250; + MIN_WOOD_PRODUCTION = 2; + MAX_WOOD_PRODUCTION = 6; + INV_REQUIRED_TILES_PER_WOOD = 1/450.0; + TILE_RESERVE = 1000; + IRON_RESERVE_COEF = 300; +var + maxIronWeapProd, maxWoodWeapProd, freePlace: Single; + WT: TKMWareType; +begin + // Update peace factor + fUpdatedPeaceFactor := Min(1,fUpdatedPeaceFactor + aIncPeaceFactor); + // Consider available space around loc + // Iron weapons - use only fixed peace factor because mines will run out anyway + freePlace := + Max( + 0, + (Min(fBuildCnt,2000) - TILE_RESERVE) * INV_REQUIRED_TILES_PER_IRON + ); + maxIronWeapProd := + Min( + Round(freePlace) + MIN_IRON_PRODUCTION, + Min( + MAX_IRON_PRODUCTION, + fIronMineCnt + (gHands[fOwner].Stats.GetWareBalance(wtIronOre) + gHands[fOwner].Stats.GetWareBalance(wtIron)) / IRON_RESERVE_COEF + ) + ); + // Wooden weapons + freePlace := + Max( + 0, + (Min(fFieldCnt,3000) - TILE_RESERVE) * INV_REQUIRED_TILES_PER_WOOD + ); + maxWoodWeapProd := + Min( + MAX_WOOD_PRODUCTION, + Max( MIN_WOOD_PRODUCTION, Round(freePlace * fUpdatedPeaceFactor) ) + ); + // Consider Iron production + maxWoodWeapProd := + Max( + MIN_WOOD_PRODUCTION - Byte(maxIronWeapProd > 0), + Round(maxWoodWeapProd - maxIronWeapProd * (1.0 - fUpdatedPeaceFactor) * 0.5) + ); + + // Iron weapons + maxIronWeapProd := maxIronWeapProd * PRODUCTION_RATE[wtIronOre] * 0.5; // Division into half because of iron weapon and armor + for WT in IRON_WARFARE do + fWareBalance[WT].FinalConsumption := maxIronWeapProd; + + // Wooden weapons + maxWoodWeapProd := maxWoodWeapProd * PRODUCTION_RATE[wtAxe]; // Production of weapons / armors is ~identical + for WT in WOOD_WARFARE do + fWareBalance[WT].FinalConsumption := maxWoodWeapProd; + // Exceptions + fWareBalance[wtLeatherArmor].FinalConsumption := maxWoodWeapProd; + fWareBalance[wtWoodenShield].FinalConsumption := maxWoodWeapProd / 5; // This only affect wood requirements, shields will be ordered by count of axes + + // Soldiers / min (only expected not final value) + fMaxSoldiersInMin := maxWoodWeapProd + maxIronWeapProd; + // Maybe there is no need to keep variable fMaxSoldiersInMin but I am afraid what scripters may do with fSetup + if (fSetup.NewAI AND fSetup.UnlimitedEquip) then + begin + fSetup.EquipRateIron := Round(600 / Max(0.01, maxIronWeapProd)); + fSetup.EquipRateLeather := Round(600 / Max(0.01, maxWoodWeapProd)); + end; + + // Predict final city stats (by potential size of city) + fCityStats.CitizensCnt := Round( Max( 0, Min(fBuildCnt,4000)-1500 )*0.052+70 ); // Min cnt of citizens is 70 and max 200 + fCityStats.WarriorsCnt := Round( Max( 0, Min(fBuildCnt,4000)-1500 )*0.042+50 ); // Min cnt of soldiers is 50 and max 150 + UpdateWareBalance(True); + + // Decide count of workers + build nodes + freePlace := Max( 0, Min( 2000, Min(fFieldCnt,fBuildCnt) - 1000 ) ); // FreePlace in <0,2000> + fWorkerCount := Round( Min( 50 - 35 * fUpdatedPeaceFactor * Byte(not gGame.IsPeaceTime), // Decrease count of required workers after peace + 15 + freePlace*AI_Par[PREDICTOR_WorkerCountCoef] + fPeaceFactor*8 ) + ); + // Try to build mines even when perf. optimalization prohibits it (once in ~8 min) + if aIncrementMines then + begin + //Inc(fMaxGoldMineCnt); + fDecCoalMineCnt := Max(0,fDecCoalMineCnt - 1); + end; +end; + + +// City initialization, estimation of maximal possible production and restriction by peace time and loc properties +procedure TKMCityPredictor.AfterMissionInit; +const + SCALE_MIN_PEACE_TIME = 50; + SCALE_MAX_PEACE_TIME = 90; + SCALE_PEACE_FACTOR = 1.0 / ((SCALE_MAX_PEACE_TIME - SCALE_MIN_PEACE_TIME)*1.0); +begin + // PeaceFactor: 0 = peace <= SCALE_MIN_PEACE_TIME; 1 = peace >= SCALE_MAX_PEACE_TIME + //fPeaceFactor := Max(0, + // (Min(SCALE_MAX_PEACE_TIME, gGame.Options.Peacetime) - SCALE_MIN_PEACE_TIME) + // ) * SCALE_PEACE_FACTOR; + fPeaceFactor := 0; // According to simulations the peace factor only harms + + UpdateFinalProduction(); +end; + + +procedure TKMCityPredictor.FilterRequiredHouses(aTick: Cardinal); + + function UpdateFarmHistory(): Boolean; + const + CORN_DELAY = 10 * 60 * 6; // Delay 6 minutes or use array ProductionLag from KM_ResWares + var + I, K, cnt: Integer; + begin + with fFarmBuildHistory do + begin + // Remove old history + if (Count > 1) then // Keep at least 1 element (the latest) + begin + I := 0; + while (I < Count) do // Find the actual tick + begin + if (Tick[I] > aTick) then + break; + I := I + 1; + end; + if (I > 1) then // Keep the latest older element + begin + cnt := 0; + for K := I - 1 to Count - 1 do // Remove old ticks + begin + Quantity[cnt] := Quantity[K]; + Tick[cnt] := Tick[K]; + cnt := cnt + 1; + end; + Count := cnt; + end; + end; + cnt := gHands[fOwner].Stats.GetHouseQty(htFarm); + if (Quantity[Count-1] <> cnt) then + begin + if (Length(Quantity) <= Count) then + begin + SetLength(Quantity, Length(Quantity) + 5); + SetLength(Tick, Length(Tick) + 5); + end; + Quantity[Count] := cnt; + Tick[Count] := aTick + CORN_DELAY; + Count := Count + 1; + end; + end; + Result := + fWareBalance[wtFlour].Production + + fWareBalance[wtPig].Production * 4 + + fWareBalance[wtHorse].Production * 4 + >= + + fFarmBuildHistory.Quantity[0] * PRODUCTION_RATE[wtCorn] + + gHands[fOwner].Stats.GetWareBalance(wtCorn) * 0.25; + end; + { + procedure CheckPeaceFactor(); + const + IGNORE_HOUSES: set of TKMHouseType = [htCoalMine, htGoldMine, htIronMine, htQuary, htVineyard]; + var + Cnt: Integer; + HT: TKMHouseType; + begin + if (fUpdatedPeaceFactor < 1) then + begin + Cnt := 0; + for HT := Low(RequiredHouses) to High(RequiredHouses) do + if not (HT in IGNORE_HOUSES) AND gHands[fOwner].Locks.HouseCanBuild(HT) then + Inc(Cnt, Max(0,RequiredHouses[HT])); + if (Cnt >= 0) then + UpdateFinalProduction(0.1); + end; + end; + //} + +const + WEAP_WORKSHOP_DELAY = 35 * 60 * 10; + WINEYARD_DELAY = 50 * 60 * 10; +var + stats: TKMHandStats; + planner: TKMCityPlanner; +begin + planner := gHands[fOwner].AI.CityManagement.Builder.Planner; + stats := gHands[fOwner].Stats; + + // Dont build anything if there is not completed school + if (fCityStats.Houses[htSchool] = 0) + OR ( (fCityStats.Houses[htSchool] = 1) + AND (not (planner.PlannedHouses[htSchool].Plans[0].Placed) + OR not ( (planner.PlannedHouses[htSchool].Plans[0].House <> nil) + AND planner.PlannedHouses[htSchool].Plans[0].House.IsComplete + ) + ) + ) then + begin + FillChar(RequiredHouses, SizeOf(RequiredHouses), #0); + // Allow to reserve quarries + UpdateWareProduction(wtStone); + fWareBalance[wtStone].ActualConsumption := Min(fCityStats.Citizens[utBuilder]+8, fWorkerCount) * AI_Par[PREDICTOR_WareNeedPerAWorker_Stone]; + fWareBalance[wtStone].FinalConsumption := Max(fCityStats.Citizens[utBuilder], fWorkerCount) * AI_Par[PREDICTOR_WareNeedPerAWorker_Stone]; + UpdateWareDerivation(wtStone); + RequiredHouses[htSchool] := Max(0, 1 - planner.PlannedHouses[htSchool].Count); + Exit; + end; + + // Check requirements + if not fCityUnderConstruction then + UpdateFinalProduction(0.1); + //CheckPeaceFactor(); + + // Remove unused houses (iron production) + if (RequiredHouses[htIronSmithy] < 0) AND (stats.GetWareBalance(wtIronOre) < 20) then // Dont destroy iron production when there is still iron ore + planner.RemoveHouseType(htIronSmithy); + if (RequiredHouses[htArmorSmithy] < 0) AND (RequiredHouses[htIronSmithy] = 0) then // And dont destroy following production if you dont want to destroy IronSmithy + planner.RemoveHouseType(htArmorSmithy); + if (RequiredHouses[htWeaponSmithy] < 0) AND (RequiredHouses[htIronSmithy] = 0) then + planner.RemoveHouseType(htWeaponSmithy); + + + // Change house requirements due to nonlinear delay, toons of exceptions and unlock order + // Dont build wineyard too early + if (fUpdatedPeaceFactor < 1) then + RequiredHouses[htVineyard] := 0; + // Consideration of corn delay - only remove all required houses, builder will find the right one if they are not removed + if UpdateFarmHistory() AND not gHands[fOwner].Locks.HouseBlocked[htFarm] then + begin + RequiredHouses[htMill] := Byte(fCityStats.Houses[htMill] = 0); // Allow 1 mill from the start + RequiredHouses[htSwine] := 0; + RequiredHouses[htStables] := 0; + end; + // Houses in dependence on corn delay + RequiredHouses[htBakery] := Min(RequiredHouses[htBakery], stats.GetHouseQty(htMill) - fCityStats.Houses[htBakery]); + RequiredHouses[htButchers] := Min(RequiredHouses[htButchers], Ceil(stats.GetHouseQty(htSwine)/3 - fCityStats.Houses[htButchers])); + RequiredHouses[htTannery] := Min(RequiredHouses[htTannery], Ceil(stats.GetHouseQty(htSwine)/2 - fCityStats.Houses[htTannery])); + RequiredHouses[htArmorWorkshop] := Min(RequiredHouses[htArmorWorkshop], stats.GetHouseTotal(htTannery)*2 - fCityStats.Houses[htArmorWorkshop]); + // Consideration of wood production + RequiredHouses[htWeaponWorkshop] := RequiredHouses[htWeaponWorkshop] * Byte( (RequiredHouses[htTannery] > 0) OR (WEAP_WORKSHOP_DELAY < aTick) OR (aTick > (gGame.Options.Peacetime-20) * 10 * 60) ); + + // Coal mines are used by top priority houses (Metallurgists) and low priority houses (smithy) + // To get reasonable production there should use something like following logic, good luck with understanding ;) + { + RequiredHouses[htCoalMine] := Min( RequiredHouses[htCoalMine], + Max( Planner.PlannedHouses[htMetallurgists].Count, // Gold production requirements + RequiredHouses[htGoldMine]) // Build coal mine in parallel to gold mine + + Stats.GetHouseTotal(htIronSmithy) // Iron production requirements + + Stats.GetHouseTotal(htArmorSmithy) + + Stats.GetHouseTotal(htWeaponSmithy) + - Planner.PlannedHouses[htCoalMine].Count + ); //} + RequiredHouses[htCoalMine] := Max( planner.PlannedHouses[htMetallurgists].Count,RequiredHouses[htGoldMine]) // Gold production requirements + - planner.PlannedHouses[htCoalMine].Count // Current production + // Build coal mine in parallel to gold mine + + stats.GetHouseTotal(htIronSmithy) // Iron production requirements + + stats.GetHouseTotal(htArmorSmithy) + + stats.GetHouseTotal(htWeaponSmithy) + + 1; // +1 works better for some reason + + // Consider exhausted city (save procesor time) + RequiredHouses[htCoalMine] := RequiredHouses[htCoalMine] - fDecCoalMineCnt; + RequiredHouses[htGoldMine] := Min(RequiredHouses[htGoldMine], fMaxGoldMineCnt); + + // Logical house requirements (delay takes too long so it is not used) + { + RequiredHouses[htSwine] := RequiredHouses[htSwine] * Byte(Stats.GetWareBalance(wtCorn) > 0); + RequiredHouses[htButchers] := RequiredHouses[htButchers] * Byte(Stats.GetWareBalance(wtPig) > 0); + RequiredHouses[htTannery] := RequiredHouses[htTannery] * Byte(Stats.GetWareBalance(wtLeather) > 0); + RequiredHouses[htArmorWorkshop] := RequiredHouses[htArmorWorkshop] * Byte(Stats.GetWareBalance(wtSkin) > 0); + RequiredHouses[htMill] := RequiredHouses[htMill] * Byte(Stats.GetWareBalance(wtFlour) > 0); + RequiredHouses[htBakery] := RequiredHouses[htBakery] * Byte(Stats.GetWareBalance(wtCorn) > 0); + //} + // Iron production (it will give time to build more mines) + { + RequiredHouses[htIronSmithy] := RequiredHouses[htIronSmithy] * Byte(Stats.GetWareBalance(wtIronOre) > 0); + RequiredHouses[htWeaponSmithy] := RequiredHouses[htWeaponSmithy] * Byte(Stats.GetWareBalance(wtSteel) > 0); + RequiredHouses[htArmorSmithy] := RequiredHouses[htArmorSmithy] * Byte(Stats.GetWareBalance(wtSteel) > 0); + //} +end; + + +procedure TKMCityPredictor.UpdateState(aTick: Cardinal); +const + UPDATE_PRODUCTION = MAX_HANDS * 60 * 5; +begin + // Update final production (based on size of city, mines etc.) + if (aTick mod UPDATE_PRODUCTION = fOwner) then + UpdateFinalProduction(0, True); + // Clear required houses + FillChar(RequiredHouses, SizeOf(RequiredHouses), #0); + // Update city stats + UpdateCityStats(); + // Update prediction and other houses (production of ware) + UpdateWareBalance(); + // Update required basic houses (main buildings) + UpdateBasicHouses(aTick, False); + + // Filter required houses + FilterRequiredHouses(aTick); +end; + + +procedure TKMCityPredictor.LogStatus(var aBalanceText: UnicodeString); +const + COLOR_WHITE = '[$FFFFFF]'; + COLOR_RED = '[$0000FF]'; + COLOR_YELLOW = '[$00FFFF]'; + COLOR_GREEN = '[$00FF00]'; + WARE_TO_STRING: array[WARE_MIN..WARE_MAX] of UnicodeString = ( + 'Trunk'#9#9, 'Stone'#9#9, 'Wood'#9#9, 'Iron ore'#9, 'Gold ore'#9, + 'Coal'#9#9, 'Steel'#9#9, 'Gold'#9#9, 'Wine'#9#9, 'Corn'#9#9, + 'Bread'#9#9, 'Flour'#9#9, 'Leather'#9, 'Sausages'#9, 'Pig'#9#9, + 'Skin'#9#9, 'Shield'#9#9, 'MetalShield'#9#9, 'Armor'#9#9, 'MetalArmor'#9#9, + 'Axe'#9#9, 'Sword'#9#9, 'Pike'#9#9, 'Hallebard'#9#9, 'Bow'#9#9, + 'Arbalet'#9#9, 'Horse'#9#9, 'Fish'#9#9 + ); + + procedure AddWare(aWT: TKMWareType; const aSpecificText: String); + var + houseCntColor, productionColor, actualConsumptionColor, finalConsumptionColor, fractionColor, exhaustionColor: UnicodeString; + cnt: Integer; + begin + cnt := RequiredHouses[ PRODUCTION_WARE2HOUSE[aWT] ]; + houseCntColor := COLOR_WHITE; + if (cnt > 0) then + houseCntColor := COLOR_RED; + with fWareBalance[aWT] do + begin + productionColor := COLOR_YELLOW; + actualConsumptionColor := COLOR_YELLOW; + finalConsumptionColor := COLOR_YELLOW; + fractionColor := COLOR_YELLOW; + exhaustionColor := COLOR_RED; + + if (Production > 0) then productionColor := COLOR_GREEN; + if (ActualConsumption > 0) then actualConsumptionColor := COLOR_RED; + if (FinalConsumption > 0) then finalConsumptionColor := COLOR_RED; + if (Fraction <= 0.1) then fractionColor := COLOR_GREEN + else fractionColor := COLOR_RED; + if (Exhaustion > 10) then exhaustionColor := COLOR_GREEN + else if (Exhaustion > 1) then exhaustionColor := COLOR_YELLOW; + + aBalanceText := Format('%s'#9 + + '%s%dx %s' + + '%s'#9 + + '%s%5.2f%s'#9#9#9 + + '%s%5.2f%s'#9#9#9#9 + + '%s%5.2f%s'#9#9#9 + + '%s%5.2f%s'#9#9 + + '%s%5.2f%s|', + [ aBalanceText, + houseCntColor, cnt, COLOR_WHITE, + aSpecificText, + productionColor, Production, COLOR_WHITE, + actualConsumptionColor, ActualConsumption, COLOR_WHITE, + finalConsumptionColor, FinalConsumption, COLOR_WHITE, + fractionColor, Fraction, COLOR_WHITE, + exhaustionColor, Exhaustion, COLOR_WHITE + ] + ); + end; + end; +var + K: Integer; +begin + aBalanceText := Format('%sWare balance|Required houses'#9'Production'#9#9'Actual consumption'#9#9'Final consumption'#9#9'Fraction'#9'Exhaustion|',[aBalanceText]); + for K := CO_WARE_MIN to CO_WARE_MAX do + AddWare(CONSUMPTION_ORDER[K], WARE_TO_STRING[ CONSUMPTION_ORDER[K] ]); + AddWare(wtLeatherArmor, 'Armor'#9#9); + AddWare(wtAxe, 'Weapon'#9#9); + AddWare(wtIronArmor, 'Iron Armor'#9); + AddWare(wtSword, 'Iron Weapon'#9); + aBalanceText := Format('%sPeace factor = %1.2f (update = %1.2f); Max workers: %d; Max gold = %d; Dec coal = %d; Iron = %d; Field coef = %d; Build coef = %d; |', [aBalanceText, fPeaceFactor, fUpdatedPeaceFactor, fWorkerCount, fMaxGoldMineCnt, fDecCoalMineCnt, fIronMineCnt, fFieldCnt, fBuildCnt]); +end; + + +end. diff --git a/vendor/kam_remake/src/ai/newAI/KM_Eye.pas b/vendor/kam_remake/src/ai/newAI/KM_Eye.pas new file mode 100644 index 0000000..9d28174 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_Eye.pas @@ -0,0 +1,1977 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_Eye; +{$I KaM_Remake.inc} +interface +uses + SysUtils, Classes, Math, Contnrs, + KromUtils, + KM_Defaults, KM_Points, KM_CommonClasses, KM_CommonTypes, + KM_ResHouses, KM_Houses, KM_Units, + KM_AIArmyEvaluation, KM_AIInfluences, KM_FloodFill, KM_AIParameters, + KM_ResTypes; + +const + MAX_SCAN_DIST_FROM_HOUSE = 10; + MIN_SCAN_DIST_FROM_HOUSE = 2; // Houses must have at least 1 tile of space between them + +type + TDirection = (dirN, dirE, dirS, dirW); + + THouseMapping = record // Record of vectors from loc of house to specific point + Tiles: TKMPointArray; // Tiles inside house plan + Surroundings: array[1..MAX_SCAN_DIST_FROM_HOUSE] of array[TDirection] of TKMPointArray; // Tiles around house plan in specific distance and direction + MoveToEntrance: array[TDirection] of TKMPoint; // Move entrance of house in dependence of direction to be able to place house plan + // Note: if we want place houses close to each other without "try and see" method we have to move from Loc of exist house into surrounding tiles and then move by entrance offset of new house) + end; + THouseMappingArray = array [HOUSE_MIN..HOUSE_MAX] of THouseMapping; + + TKMBuildState = (bsNoBuild = 0, bsHousePlan = 1, bsFieldPlan = 2, bsRoadPlan = 3, bsRoad = 4, bsBuild = 9, bsTree = 10, bsForest = 11, bsCoal = 12, bsMine = 13, bsDebug = 200, bsReserved = 255); + TKMBuildInfo = record + Visited, VisitedHouse: Byte; + State: TKMBuildState; + Next: Integer; + Distance,DistanceInitPoint,Y: Word; + end; + TKMBuildInfoArray = array of TKMBuildInfo; + + TKMHouseRequirements = record + HouseType: TKMHouseType; + IgnoreTrees,IgnoreAvoidBuilding: Boolean; + MaxCnt, MaxDist: Word; + end; + + TKMForestInfo = record + PartOfForest: Boolean; + Loc: TKMPoint; + TreeCout, Distance: Word; + Bid: Single; + end; + TKMForestsInfo = record + Count: Integer; + Forests: array of TKMForestInfo; + end; + + PDistElement = ^TKMDistElement; + TKMDistElement = record + X,Y,Distance: Word; + end; + + // This class transforms all house placing requirements into 1 array to avoid overlapping conditions + // Placing new house is then question of internal house tiles + TKMBuildFF = class + private + fOwner: TKMHandID; + fOwnerUpdateInfo: array[0..MAX_HANDS-1] of Byte; + fVisitIdx, fVisitIdxHouse: Byte; + fStartQueue, fEndQueue, fQueueCnt, fMapX, fMapY: Integer; + fUpdateTick: Cardinal; + fHouseReq: TKMHouseRequirements; + fLocs: TKMPointList; + fInfoArr: TKMBuildInfoArray; + +// function GetInfo(const aY,aX: Word): TKMBuildInfo; +// procedure SetInfo(const aY,aX,aNext,aDistance: Word; const aVisited: Byte; const aState: TKMBuildState); + function GetVisited(const aY,aX: Word): Byte; + procedure SetVisited(const aY,aX: Word; const aVisited: Byte); + function GetOwnersIndex(const aOwner: TKMHandID): Byte; + function GetState(const aY,aX: Word): TKMBuildState; + procedure SetState(const aY,aX: Word; const aState: TKMBuildState); + function GetStateFromIdx(const aIdx: Integer): TKMBuildState; + function GetDistance(const aPoint: TKMPoint): Word; + function GetDistanceInitPoint(const aPoint: TKMPoint): Word; + function GetNext(const aY,aX: Word): Word; + procedure SetNext(const aY,aX,aNext: Word); + + protected + procedure InitQueue(aHouseFF: Boolean); + function InsertInQueue(const aIdx: Integer): Integer; + function RemoveFromQueue(var aX,aY: Word; var aIdx: Integer): Boolean; + + function CanBeVisited(const aX,aY: Word; const aIdx: Integer; const aHouseQueue: Boolean = False): Boolean; overload; + procedure MarkAsVisited(const aY: Word; const aIdx,aDistance: Integer; const aState: TKMBuildState); overload; + procedure MarkAsVisited(const aX,aY: Word; const aIdx,aDistance: Integer); overload; + + function GetTerrainState(const aX,aY: Word): TKMBuildState; + procedure MarkPlans(); + procedure TerrainFF(aMaxDistance: Word); + procedure HouseFF(); + public + constructor Create(); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + //property Info[const aY,aX: Word]: TKMBuildInfo read GetInfo write SetInfo; + property VisitIdx: Byte read fVisitIdx; + property VisitIdxHouse: Byte read fVisitIdxHouse; + property Visited[const aY,aX: Word]: Byte read GetVisited write SetVisited; + property VisitIdxOwner[const aOwner: TKMHandID]: Byte read GetOwnersIndex; + property State[const aY,aX: Word]: TKMBuildState read GetState write SetState; + property StateIdx[const aIdx: Integer]: TKMBuildState read GetStateFromIdx; + property Distance[const aPoint: TKMPoint]: Word read GetDistance; + property DistanceInitPoint[const aPoint: TKMPoint]: Word read GetDistanceInitPoint; + property Next[const aY,aX: Word]: Word read GetNext write SetNext; + property Locs: TKMPointList read fLocs write fLocs; + property HouseRequirements: TKMHouseRequirements read fHouseReq write fHouseReq; + + procedure AfterMissionInit(); + procedure UpdateState(aMaxFFDistance: Word = 40); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure ActualizeTile(aX, aY: Word); + function CanBePlacedHouse(const aLoc: TKMPoint): Boolean; + procedure FindPlaceForHouse(aHouseReq: TKMHouseRequirements; aInitPointsArr: TKMPointList; aClearHouseList: Boolean = True); + end; + + + TKMFFInitPlace = class + private + fMapX, fMapY: Word; + fArea: TKMByteArray; + fVisitArr: TBooleanArray; + fQueue: TQueue; + protected + function CanBeVisited(const aX,aY: Word; const aDistance: Integer): Boolean; + procedure MarkAsVisited(const aIdx, aDistance: Integer); + procedure InsertInQueue(const aX,aY: Word; const aDistance: Integer); + function RemoveFromQueue(var aX,aY: Word; var aDistance: Integer): Boolean; + public + constructor Create(aMapX,aMapY: Word; var aArea: TKMByteArray); + destructor Destroy(); override; + + procedure FillArea(aCount: Word; aInitPoints: TKMPointArray); + end; + + + TKMFFCheckStoneTiles = class(TKMQuickFlood) + private + fMapX, fMapY: Word; + fVisitIdx: Byte; + fVisitArr: TKMByteArray; + fStoneCnt, fStoneLimit: Integer; + protected + function CanBeVisited(const aX,aY: SmallInt): Boolean; override; + function IsVisited(const aX,aY: SmallInt): Boolean; override; + procedure MarkAsVisited(const aX,aY: SmallInt); override; + public + constructor Create(aStoneLimit: Integer; const aScanEightTiles: Boolean = False); reintroduce; + function CheckCount(aX,aY: SmallInt): Boolean; + end; + + + // Transform game data into "AI view" ... this is how AI see the map (influences have its own class) + TKMEye = class + private + fOwner: TKMHandID; + fMapX, fMapY: Word; + fHousesMapping: THouseMappingArray; + fGoldLocs, fIronLocs, fStoneMiningTiles: TKMPointList; // Store coal tiles is not effective + fSoil, fRoutes, fFlatArea: TKMByteArray; // Soil = detection of soil tiles; fRoutes = expected city area; fFlatArea = terrain evaluation + + fBuildFF: TKMBuildFF; + fArmyEvaluation: TKMArmyEvaluation; + + function GetSoil(const aY,aX: Word): Byte; + procedure SetSoil(const aY,aX: Word; const aValue: Byte); + function GetRoutes(const aY,aX: Word): Byte; + procedure SetRoutes(const aY,aX: Word; const aValue: Byte); + function GetFlatArea(const aY,aX: Word): Byte; + procedure SetFlatArea(const aY,aX: Word; const aValue: Byte); + + procedure InitHousesMapping(); + function CheckResourcesNearMine(aLoc: TKMPoint; aHT: TKMHouseType): Boolean; +// function GetResourcesNearMine(aLoc: TKMPoint; aHT: TKMHouseType): Word; + public + constructor Create(); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + property HousesMapping: THouseMappingArray read fHousesMapping write fHousesMapping; + property BuildFF: TKMBuildFF read fBuildFF; + property ArmyEvaluation: TKMArmyEvaluation read fArmyEvaluation; + property Soil[const aY,aX: Word]: Byte read GetSoil write SetSoil; + property Routes[const aY,aX: Word]: Byte read GetRoutes write SetRoutes; + property FlatArea[const aY,aX: Word]: Byte read GetFlatArea write SetFlatArea; + property GoldLocs: TKMPointList read fGoldLocs; + property IronLocs: TKMPointList read fIronLocs; + property StoneMiningTiles: TKMPointList read fStoneMiningTiles; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure OwnerUpdate(aPlayer: TKMHandID); + procedure ScanLoc(); + + function CanPlaceHouse(aLoc: TKMPoint; aHT: TKMHouseType; aIgnoreTrees: Boolean = False): Boolean; + function CanAddHousePlan(aLoc: TKMPoint; aHT: TKMHouseType; aIgnoreAvoidBuilding: Boolean = False; aIgnoreTrees: Boolean = False; aIgnoreLocks: Boolean = True): Boolean; + + function FindSeparateMineLocs(aAllMines: Boolean; aMineType: TKMHouseType): TKMPointArray; + function GetMineLocs(aHT: TKMHouseType): TKMPointTagList; + function GetStoneLocs(): TKMPointTagList; + function GetForests(): TKMForestsInfo; + function GetPotentialForests(aMaxCnt: Integer): TKMForestsInfo; + function GetCityCenterPolygons(aMultiplePoints: Boolean = False): TKMWordArray; + function GetCityCenterPoints(aMultiplePoints: Boolean = False): TKMPointArray; + + function GetClosestUnitAroundHouse(aHT: TKMHouseType; aLoc: TKMPoint; aInitPoint: TKMPoint): TKMUnit; + + procedure Paint(aRect: TKMRect); + end; + + +implementation +uses + KM_GameParams, KM_Terrain, + KM_Hand, KM_HandsCollection, KM_HandTypes, KM_HandEntity, + KM_Resource, KM_AIFields, KM_RenderAux, KM_ResMapElements, + KM_NavMesh, KM_CityPlanner; + + +{ TKMEye } +constructor TKMEye.Create(); +begin + fGoldLocs := TKMPointList.Create(); + fIronLocs := TKMPointList.Create(); + fStoneMiningTiles := TKMPointList.Create(); + + fBuildFF := TKMBuildFF.Create(); + fArmyEvaluation := TKMArmyEvaluation.Create(); + + InitHousesMapping(); +end; + +destructor TKMEye.Destroy(); +begin + fGoldLocs.Free; + fIronLocs.Free; + fStoneMiningTiles.Free; + + fBuildFF.Free; + fArmyEvaluation.Free; + + inherited; +end; + + +procedure TKMEye.Save(SaveStream: TKMemoryStream); + procedure SaveByteArr(var aArray: TKMByteArray); + var + Len: Integer; + begin + Len := Length(aArray); + SaveStream.Write(Len); + SaveStream.Write(aArray[0], SizeOf(aArray[0]) * Len); + end; +begin + SaveStream.PlaceMarker('Eye'); + SaveStream.Write(fOwner); + SaveStream.Write(fMapX); + SaveStream.Write(fMapY); + + fGoldLocs.SaveToStream(SaveStream); + fIronLocs.SaveToStream(SaveStream); + fStoneMiningTiles.SaveToStream(SaveStream); + + SaveByteArr(fSoil); + SaveByteArr(fRoutes); + SaveByteArr(fFlatArea); + + fArmyEvaluation.Save(SaveStream); + fBuildFF.Save(SaveStream); + + // The following does not requires save + // fHousesMapping +end; + +procedure TKMEye.Load(LoadStream: TKMemoryStream); + procedure LoadByteArr(var aArray: TKMByteArray); + var + Len: Integer; + begin + LoadStream.Read(Len); + SetLength(aArray, Len); + LoadStream.Read(aArray[0], SizeOf(aArray[0]) * Len); + end; +begin + LoadStream.CheckMarker('Eye'); + LoadStream.Read(fOwner); + LoadStream.Read(fMapX); + LoadStream.Read(fMapY); + + fGoldLocs.LoadFromStream(LoadStream); + fIronLocs.LoadFromStream(LoadStream); + fStoneMiningTiles.LoadFromStream(LoadStream); + + LoadByteArr(fSoil); + LoadByteArr(fRoutes); + LoadByteArr(fFlatArea); + + fArmyEvaluation.Load(LoadStream); + fBuildFF.Load(LoadStream); +end; + + +function TKMEye.GetSoil(const aY,aX: Word): Byte; +begin + Result := fSoil[aY*fMapX + aX]; +end; +procedure TKMEye.SetSoil(const aY,aX: Word; const aValue: Byte); +begin + fSoil[aY*fMapX + aX] := aValue; +end; + +function TKMEye.GetRoutes(const aY,aX: Word): Byte; +begin + Result := fRoutes[aY*fMapX + aX]; +end; +procedure TKMEye.SetRoutes(const aY,aX: Word; const aValue: Byte); +begin + fRoutes[aY*fMapX + aX] := aValue; +end; + +function TKMEye.GetFlatArea(const aY,aX: Word): Byte; +begin + Result := fFlatArea[aY*fMapX + aX]; +end; +procedure TKMEye.SetFlatArea(const aY,aX: Word; const aValue: Byte); +begin + fFlatArea[aY*fMapX + aX] := aValue; +end; + + +procedure TKMEye.AfterMissionInit(); + procedure GeneralizeArray(const RADIUS: Byte; var aArr: TKMByteArray); + var + X,Y,Y2,X2,Idx: Integer; + CopyArr: TKMByteArray; + begin + SetLength(CopyArr, Length(aArr)); + Move(aArr[0],CopyArr[0],Sizeof(aArr[0])*Length(aArr)); + + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + begin + Idx := Y*fMapX + X; + for Y2 := Max(1, Y-RADIUS) to Min(fMapY-1, Y+RADIUS) do + for X2 := Y2*fMapX + Max(1, X-RADIUS) to Y2*fMapX + Min(fMapX-1, X+RADIUS) do + Inc(aArr[Idx], CopyArr[X2]); + end; + + // for Y := 1 to 1+RADIUS-1 do + // for X := 1 to 1+RADIUS do + // Inc(aArr[1*fMapX + 1], CopyArr[Y*fMapX + X]); + // for Y := 1 to fMapY - 1 do + // begin + // Idx := Y*fMapX + 1; + // aArr[Idx] := aArr[Max(Y-1,1)*fMapX + 1]; + // if (Y-RADIUS-1 > 0) then + // for X := 1 to 1+RADIUS do + // Dec(aArr[Idx], CopyArr[(Y-RADIUS-1)*fMapX + X]); + // if (Y+RADIUS < fMapY) then + // for X := 1 to 1+RADIUS do + // Inc(aArr[Idx], CopyArr[(Y+RADIUS)*fMapX + X]); + // + // for X := 2 to fMapX - 1 do + // begin + // Idx := Y*fMapX + X; + // aArr[Idx] := aArr[Idx-1]; + // if (X-RADIUS-1 > 0) then + // for Y2 := Max(1,Y-RADIUS) to Min(fMapY-1,Y+RADIUS) do + // Dec(aArr[Idx], CopyArr[Y2*fMapX + X-RADIUS-1]); + // if (X+RADIUS < fMapY) then + // for Y2 := Max(1,Y-RADIUS) to Min(fMapY-1,Y+RADIUS) do + // Inc(aArr[Idx], CopyArr[Y2*fMapX + X+RADIUS]); + // end; + // end; + end; +const + MIN_STONES_IN_MINE = 50; +var + X,Y: Integer; + Loc: TKMPoint; + StoneCheck: TKMFFCheckStoneTiles; +begin + fBuildFF.AfterMissionInit(); + fArmyEvaluation.AfterMissionInit(); + + fMapX := gTerrain.MapX; + fMapY := gTerrain.MapY; + + SetLength(fSoil, fMapX * fMapY); + SetLength(fRoutes, fMapX * fMapY); + SetLength(fFlatArea, fMapX * fMapY); + FillChar(fSoil[0], SizeOf(fSoil[0]) * Length(fSoil), #0); + FillChar(fRoutes[0], SizeOf(fRoutes[0]) * Length(fRoutes), #0); + FillChar(fFlatArea[0], SizeOf(fFlatArea[0]) * Length(fFlatArea), #0); + + StoneCheck := TKMFFCheckStoneTiles.Create(MIN_STONES_IN_MINE); + try + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + begin + Loc := KMPoint(X,Y); + FlatArea[Y,X] := Byte(gTerrain.TileIsWalkable(Loc)); + if gTerrain.TileIsSoil(X,Y) then + Soil[Y,X] := 1 + //else if (gTerrain.TileIsCoal(X,Y) > 1) then + else if gTerrain.TileHasStone(X,Y) then + begin + Soil[Y,X] := 1; // Stone tile can be mined and used for farms + if (Y < fMapY - 1) AND (tpWalk in gTerrain.Land^[Y+1,X].Passability) AND StoneCheck.CheckCount(X,Y) then + fStoneMiningTiles.Add(Loc); + end + else if CanAddHousePlan(Loc, htGoldMine, True, False) then + begin + if CheckResourcesNearMine(Loc, htGoldMine) then + fGoldLocs.Add(Loc); + end + else if CanAddHousePlan(Loc, htIronMine, True, False) then + begin + if CheckResourcesNearMine(Loc, htIronMine) then + fIronLocs.Add(Loc); + end; + end; + finally + StoneCheck.Free(); + end; + GeneralizeArray(4,fSoil); + GeneralizeArray(4,fFlatArea); +end; + + +// Search for ore - gold and iron mines have similar requirements so there are booth in 1 method +function TKMEye.CheckResourcesNearMine(aLoc: TKMPoint; aHT: TKMHouseType): Boolean; +var + X,Y: Integer; +begin + Result := True; + for X := Max(aLoc.X-4, 1) to Min(aLoc.X+3+Byte(aHT = htGoldMine), fMapX-1) do + for Y := Max(aLoc.Y-8, 1) to aLoc.Y do + if (aHT = htGoldMine) AND gTerrain.TileHasGold(X, Y) + OR (aHT = htIronMine) AND gTerrain.TileHasIron(X, Y) then + Exit; + Result := False; //Didn't find any ore +end; + + +//function TKMEye.GetResourcesNearMine(aLoc: TKMPoint; aHT: TKMHouseType): Word; +//var +// X,Y: Integer; +//begin +// Result := 0; +// for X := Max(aLoc.X-4, 1) to Min(aLoc.X+3+Byte(aHT = htGoldMine), fMapX-1) do +// for Y := Max(aLoc.Y-8, 1) to aLoc.Y do +// if (aHT = htGoldMine) then +// Result := Result + gTerrain.TileIsGold(X, Y) +// else if (aHT = htIronMine) then +// Result := Result + gTerrain.TileIsIron(X, Y); +//end; + + +function TKMEye.FindSeparateMineLocs(aAllMines: Boolean; aMineType: TKMHouseType): TKMPointArray; +var + I,K, Cnt: Integer; + InfluenceArr: TBooleanArray; + Mines: TKMPointList; + Output: TKMPointArray; +begin + SetLength(Result, 0); + if aAllMines then + begin + if (aMineType = htIronMine) then + Mines := fIronLocs + else if (aMineType = htGoldMine) then + Mines := fGoldLocs + else + Exit; + end + else + begin + if (aMineType = htIronMine) then + Mines := GetMineLocs(htIronMine) + else if (aMineType = htGoldMine) then + Mines := GetMineLocs(htGoldMine) + else + Exit; + end; + Cnt := 0; + SetLength(Output, Mines.Count); + if (Mines.Count > 0) then + begin + SetLength(InfluenceArr, Mines.Count); + FillChar(InfluenceArr[0], SizeOf(InfluenceArr[0]) * Length(InfluenceArr), #0); // => False + for I := 0 to Mines.Count-1 do + begin + InfluenceArr[I] := True; + for K := 0 to I-1 do + if InfluenceArr[K] AND + not ( (Mines.Items[K].Y <> Mines.Items[I].Y) + OR ( Abs(Mines.Items[K].X - Mines.Items[I].X) >= (3 + Byte(aMineType = htIronMine)) ) ) then + begin + InfluenceArr[I] := False; + break; + end; + if InfluenceArr[I] then + begin + Output[Cnt] := Mines.Items[I]; + Inc(Cnt); + end; + end; + end; + if (not aAllMines) then + Mines.Free; + SetLength(Output, Cnt); + Result := Output; +end; + + +procedure TKMEye.ScanLoc(); +var + PointsCnt: Word; + Road: TKMPointList; + InitPoints: TKMPointArray; + + procedure ScanLocArea(aStartP, aEndP: TKMPoint); + var + I: Integer; + FieldType: TKMFieldType; + begin + Road.Clear(); + if gHands[fOwner].AI.CityManagement.Builder.Planner.GetRoadBetweenPoints(aStartP, aEndP, Road, FieldType) then + begin + if (PointsCnt + Road.Count >= Length(InitPoints)) then + SetLength(InitPoints, PointsCnt + Road.Count + 512); + for I := 0 to Road.Count - 1 do + begin + InitPoints[PointsCnt] := Road.Items[I]; + PointsCnt := PointsCnt + 1; + end; + end; + end; +var + K, X,Y, FieldCnt, BuildCnt: Integer; + CenterPointArr, MineLocs: TKMPointArray; + //TagList: TKMPointTagList; + FFInitPlace: TKMFFInitPlace; +begin + // Init city center point (storehouse / school etc.) + CenterPointArr := GetCityCenterPoints(False); + PointsCnt := 0; + SetLength(InitPoints,0); + Road := TKMPointList.Create(); + try + // Scan Resources - gold, iron + MineLocs := FindSeparateMineLocs(False, htIronMine); + for K := 0 to Length(MineLocs) - 1 do + ScanLocArea(CenterPointArr[0], KMPointBelow(MineLocs[K])); + MineLocs := FindSeparateMineLocs(False, htGoldMine); + for K := 0 to Length(MineLocs) - 1 do + ScanLocArea(CenterPointArr[0], KMPointBelow(MineLocs[K])); + // Scan Resources - coal + //TagList := TKMPointTagList.Create(); + //try + // K := 0; + // Increment := Ceil(TagList.Count / 10.0); // Max 10 paths + // while (K < TagList.Count) do + // begin + // ScanLocArea(CenterPointArr[0], TagList.Items[K]); + // K := K + Increment; + // end; + //finally + // TagList.Free; + //end; + // Scan Resources - stones + { + TagList := GetStoneLocs(True); + try + K := 0; + Increment := Ceil(TagList.Count / 5.0); // Max 5 paths + while (K < TagList.Count) do + begin + ScanLocArea(TagList.Items[K]); + K := K + Increment; + end; + finally + TagList.Free; + end + //} + finally + Road.Free; + end; + + if (PointsCnt > 0) then + begin + FFInitPlace := TKMFFInitPlace.Create(fMapX,fMapY, fRoutes); + try + FFInitPlace.FillArea(PointsCnt, InitPoints); + finally + FFInitPlace.Free; + end; + end; + + FieldCnt := 0; + BuildCnt := 0; + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + if (gAIFields.Influences.GetBestOwner(X,Y) = fOwner) AND gTerrain.TileIsRoadable( KMPoint(X,Y) ) then + begin + Inc(FieldCnt, Byte(Soil[Y,X] > 0)); + Inc(BuildCnt, 1); + end; + gHands[fOwner].AI.CityManagement.Predictor.FieldCnt := FieldCnt; + gHands[fOwner].AI.CityManagement.Predictor.BuildCnt := BuildCnt; +end; + + +// Create mapping of surrounding tiles for each house +procedure TKMEye.InitHousesMapping(); +var + EnterOff: ShortInt; + House: TKMHouseType; + POMArr: array[1-MAX_SCAN_DIST_FROM_HOUSE..4+MAX_SCAN_DIST_FROM_HOUSE,1-MAX_SCAN_DIST_FROM_HOUSE..4+MAX_SCAN_DIST_FROM_HOUSE] of Byte; + CntArr, Index: array [TDirection] of Integer; + + procedure SearchAndFill(const aIdx: Integer; aFill: Boolean = False); + var + PointAdded: Boolean; + X,Y: Integer; + Dir: TDirection; + begin + //FillChar(CntArr, SizeOf(CntArr), #0); //Clear up + for dir := Low(CntArr) to High(CntArr) do + CntArr[dir] := 0; + + for Y := 1-aIdx to 4+aIdx do + for X := 1-aIdx to 4+aIdx do + if (POMArr[Y,X] = aIdx) then + begin + PointAdded := False; + if (X = Index[dirW]-aIdx) then + begin + PointAdded := True; + if aFill then + fHousesMapping[House].Surroundings[aIdx,dirW,CntArr[dirW]] := KMPoint(X - 3 - EnterOff, Y - 4); + Inc(CntArr[dirW],1); + end + else if (X = Index[dirE]+aIdx) then + begin + PointAdded := True; + if aFill then + fHousesMapping[House].Surroundings[aIdx,dirE,CntArr[dirE]] := KMPoint(X - 3 - EnterOff, Y - 4); + Inc(CntArr[dirE],1); + end; + if (Y = Index[dirS]+aIdx) then + begin + if aFill then + fHousesMapping[House].Surroundings[aIdx,dirS,CntArr[dirS]] := KMPoint(X - 3 - EnterOff, Y - 4); + Inc(CntArr[dirS],1); + end + else if not PointAdded OR (Y = Index[dirN]-aIdx) then // Plans with cutted top corners + begin + if aFill then + fHousesMapping[House].Surroundings[aIdx,dirN,CntArr[dirN]] := KMPoint(X - 3 - EnterOff, Y - 4); + Inc(CntArr[dirN],1); + end; + end; + if not aFill then + for dir := Low(CntArr) to High(CntArr) do + SetLength(fHousesMapping[House].Surroundings[aIdx,dir], CntArr[dir]); + end; + +var + I, X, Y, aX, aY, ActualIdx, Cnt: Integer; + HA: TKMHouseArea; +begin + for House := HOUSE_MIN to HOUSE_MAX do + begin + EnterOff := gRes.Houses[House].EntranceOffsetX; + + // Init POMArr with value 255; + for Y := Low(POMArr) to High(POMArr) do + for X := Low(POMArr[Y]) to High(POMArr[Y]) do + POMArr[Y,X] := 255; + + // Find house plan and save its shape into POMArr + HA := gRes.Houses[House].BuildArea; + Cnt := 0; + for Y := 1 to 4 do + for X := 1 to 4 do + if (HA[Y,X] <> 0) then + begin + POMArr[Y,X] := 0; + Inc(Cnt,1); + end; + + // Save vectors from entrance to each tile which is in house plan + SetLength(fHousesMapping[House].Tiles, Cnt); + Cnt := 0; + for Y := 1 to 4 do + for X := 1 to 4 do + if (POMArr[Y,X] = 0) then + begin + fHousesMapping[House].Tiles[Cnt] := KMPoint(X - 3 - EnterOff, Y - 4); + Inc(Cnt); + end; + + // Create around the house plan layers of increasing values in dependence on distance from the plan + for I := 1 to MAX_SCAN_DIST_FROM_HOUSE do + begin + ActualIdx := I-1; + for Y := 1-ActualIdx to 4+ActualIdx do + for X := 1-ActualIdx to 4+ActualIdx do + if (POMArr[Y,X] = ActualIdx) then + for aY := -1 to 1 do + for aX := -1 to 1 do + if (POMArr[Y+aY,X+aX] > I) then + POMArr[Y+aY,X+aX] := I; + end; + + // Calculate size of plan + Index[dirN] := 3 - Byte(POMArr[2,2] = 0) - Byte(POMArr[1,2] = 0); + Index[dirS] := 4; + Index[dirW] := 2 - Byte(POMArr[4,1] = 0); + Index[dirE] := 3 + Byte(POMArr[4,4] = 0); + + // Get entrance with respect to array HA + for X := 1 to 4 do + if (HA[4,X] = 2) then + break; + fHousesMapping[House].MoveToEntrance[dirN] := KMPoint(0, 0); + fHousesMapping[House].MoveToEntrance[dirS] := KMPoint(0, 4 - Index[dirN]); + fHousesMapping[House].MoveToEntrance[dirW] := KMPoint(X - Index[dirE], 0); + fHousesMapping[House].MoveToEntrance[dirE] := KMPoint(X - Index[dirW], 0); + + // Fill fHousesSurroundings + for I := 1 to MAX_SCAN_DIST_FROM_HOUSE do + begin + SearchAndFill(I, False); + SearchAndFill(I, True); + end; + + end; +end; + + +procedure TKMEye.UpdateState(aTick: Cardinal); +begin + fArmyEvaluation.UpdateState(aTick); +end; + + +procedure TKMEye.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fBuildFF.OwnerUpdate(aPlayer); +end; + + +// This function is copied (and reworked) from TKMTerrain.CanPlaceHouse and edited to be able to ignore trees +function TKMEye.CanPlaceHouse(aLoc: TKMPoint; aHT: TKMHouseType; aIgnoreTrees: Boolean = False): Boolean; +var + Output: Boolean; + I,X,Y: Integer; +begin + Output := True; + for I := Low(fHousesMapping[aHT].Tiles) to High(fHousesMapping[aHT].Tiles) do + begin + X := aLoc.X + fHousesMapping[aHT].Tiles[I].X; + Y := aLoc.Y + fHousesMapping[aHT].Tiles[I].Y; + // Inset one tile from map edges + Output := Output AND gTerrain.TileInMapCoords(X, Y, 1); + // Mines have specific requirements + case aHT of + htIronMine: Output := Output AND gTerrain.CanPlaceIronMine(X, Y); + htGoldMine: Output := Output AND gTerrain.CanPlaceGoldMine(X, Y); + else Output := Output AND ( (tpBuild in gTerrain.Land^[Y,X].Passability) + OR (aIgnoreTrees + AND gTerrain.ObjectIsChopableTree(KMPoint(X,Y), [caAge1,caAge2,caAge3,caAgeFull]) + AND gHands[fOwner].CanAddFieldPlan(KMPoint(X,Y), ftWine)) + ); + end; + if not Output then + break; + end; + Result := Output; +end; + + +// Modified version of TKMHand.CanAddHousePlan - added possibilities +// aIgnoreAvoidBuilding = ignore avoid building areas +// aIgnoreTrees = ignore trees inside of house plan +// aIgnoreLocks = ignore existing house plans inside of house plan tiles +function TKMEye.CanAddHousePlan(aLoc: TKMPoint; aHT: TKMHouseType; aIgnoreAvoidBuilding: Boolean = False; aIgnoreTrees: Boolean = False; aIgnoreLocks: Boolean = True): Boolean; + function CanBeRoad(X,Y: Integer): Boolean; + begin + Result := (gTerrain.Land^[Y, X].Passability * [tpMakeRoads, tpWalkRoad] <> []) + OR (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(X,Y)) <> ftNone) // We dont need strictly road just make sure that it is possible to place something here (and replace it by road later) + OR (gTerrain.Land^[Y, X].TileLock in [tlFieldWork, tlRoadWork]); + end; +var + LeftSideFree, RightSideFree: Boolean; + X, Y, I, K, PL: Integer; + Point: TKMPoint; + Dir: TDirection; +begin + Result := False; + + // The loc is out of map or in inaccessible area + if not gTerrain.TileInMapCoords(aLoc.X, aLoc.Y, 1) then + Exit; + + // Check if we can place house on terrain, this also makes sure the house is + // at least 1 tile away from map border (skip that below) + if not CanPlaceHouse(aLoc, aHT, aIgnoreTrees) then + Exit; + + // Make sure we can add road below house (1 tile is ok, BuildFF checked everything) + if not CanBeRoad(aLoc.X,aLoc.Y+1) then + Exit; + + // Make sure that we dont put new house into another plan (just entrance is enough because houses have similar size) + //if gHands[fOwner].Constructions.HousePlanList.HasPlan(KMPoint(aLoc.X,aLoc.Y)) then + // Exit; + + // Scan tiles inside house plan + for I := Low(fHousesMapping[aHT].Tiles) to High(fHousesMapping[aHT].Tiles) do + begin + X := aLoc.X + fHousesMapping[aHT].Tiles[I].X; + Y := aLoc.Y + fHousesMapping[aHT].Tiles[I].Y; + Point := KMPoint(X,Y); + + // Check with AvoidBuilding array to secure that new house will not be build in forests / coal tiles + if aIgnoreAvoidBuilding then + begin + if not aIgnoreLocks AND + (gAIFields.Influences.AvoidBuilding[Y, X] in [AVOID_BUILDING_HOUSE_OUTSIDE_LOCK, AVOID_BUILDING_HOUSE_INSIDE_LOCK]) then + Exit; + end + else if (gAIFields.Influences.AvoidBuilding[Y, X] > 0) then + Exit; + + //This tile must not contain fields/houseplans of allied players + for PL := 0 to gHands.Count - 1 do + if (gHands[fOwner].Alliances[PL] = atAlly) then// AND (PL <> fOwner) then + if (gHands[PL].Constructions.FieldworksList.HasField(Point) <> ftNone) then + Exit; + end; + + // Scan tiles in distance 1 from house plan + LeftSideFree := True; + RightSideFree := True; + I := 1; + for Dir := Low(fHousesMapping[aHT].Surroundings[I]) to High(fHousesMapping[aHT].Surroundings[I]) do + for K := Low(fHousesMapping[aHT].Surroundings[I,Dir]) to High(fHousesMapping[aHT].Surroundings[I,Dir]) do + begin + X := aLoc.X + fHousesMapping[aHT].Surroundings[I,Dir,K].X; + Y := aLoc.Y + fHousesMapping[aHT].Surroundings[I,Dir,K].Y; + Point := KMPoint(X,Y); + // Surrounding tiles must not be a house + for PL := 0 to gHands.Count - 1 do + if (gHands[fOwner].Alliances[PL] = atAlly) then + if gHands[PL].Constructions.HousePlanList.HasPlan(Point) then + Exit; + if (aHT in [htGoldMine, htIronMine]) then + Continue; + // Quarry / Woodcutters / CoalMine / Towers may take place for mine so its arena must be scaned completely + if aIgnoreAvoidBuilding then + begin + if (gAIFields.Influences.AvoidBuilding[Y, X] = AVOID_BUILDING_HOUSE_INSIDE_LOCK) then + Exit; + if (aHT = htWatchTower) then + begin + RightSideFree := RightSideFree AND ((Dir <> dirE) OR CanBeRoad(X,Y)); + LeftSideFree := LeftSideFree AND ((Dir <> dirW) OR CanBeRoad(X,Y)); + end; + end + // For "normal" houses there must be at least 1 side also free (on the left or right from house plan) + else if (Dir = dirE) then // Direction east + RightSideFree := RightSideFree AND CanBeRoad(X,Y) + else if (Dir = dirW) then // Direction west + LeftSideFree := LeftSideFree AND CanBeRoad(X,Y); + if not (LeftSideFree AND RightSideFree) then + Exit; + end; + + Result := True; +end; + + +function TKMEye.GetMineLocs(aHT: TKMHouseType): TKMPointTagList; +var + Ownership: Byte; + I,X,Y: Integer; + Mines: TKMPointList; + Output: TKMPointTagList; +begin + Output := TKMPointTagList.Create(); + Mines := nil; + case aHT of + htGoldMine: Mines := fGoldLocs; + htIronMine: Mines := fIronLocs; + end; + + if (Mines <> nil) then + for I := Mines.Count - 1 downto 0 do + begin + X := Mines.Items[I].X; + Y := Mines.Items[I].Y; + Ownership := gAIFields.Influences.Ownership[fOwner, Y, X]; + if ([tpMakeRoads, tpWalkRoad] * gTerrain.Land^[Y+1,X].Passability <> []) + AND (Ownership > 0) AND gAIFields.Influences.CanPlaceHouseByInfluence(fOwner, X,Y) then + if CanAddHousePlan(Mines.Items[I], aHT, True, False) AND CheckResourcesNearMine(Mines.Items[I], aHT) then + Output.Add(Mines.Items[I], Ownership) + else + Mines.Delete(I); + end; + Result := Output; +end; + + +function TKMEye.GetStoneLocs(): TKMPointTagList; + function AddStoneCount(var aX,aY, aCount: Integer): Byte; + begin + Result := gTerrain.TileIsStone(aX, aY); + aCount := aCount + Result; + end; +const + SCAN_LIMIT = 10; +var + X,Y,K, MaxDist, Sum: Integer; + Output: TKMPointTagList; +begin + Output := TKMPointTagList.Create(); + for K := fStoneMiningTiles.Count-1 downto 0 do + begin + X := fStoneMiningTiles.Items[K].X; + Y := fStoneMiningTiles.Items[K].Y; + MaxDist := Max(1, Y-SCAN_LIMIT); + // Find actual stone tile (if exist) + while not gTerrain.TileHasStone(X, Y) AND (Y > MaxDist) do + Y := Y - 1; + // Check if is possible to mine it + if gTerrain.TileHasStone(X, Y) AND (tpWalk in gTerrain.Land^[Y+1,X].Passability) then + begin + fStoneMiningTiles.Items[K] := KMPoint(X,Y); + // Save tile as a potential point for quarry + if gAIFields.Influences.CanPlaceHouseByInfluence(fOwner, X,Y+1) then + begin + Sum := 0; + while (Y > 1) AND (AddStoneCount(X,Y,Sum) > 0) do + Y := Y - 1; + Output.Add(fStoneMiningTiles.Items[K], Sum); + end; + end + else // Else remove point + fStoneMiningTiles.Delete(K); + end; + Result := Output; +end; + + +// Cluster algorithm (inspired by DBSCAN but clusters may overlap) +// Create possible places for forests and return count of already existed forests +function TKMEye.GetForests(): TKMForestsInfo; +const + UNVISITED_TILE = 0; + VISITED_TILE = 1; + UNVISITED_TREE = 2; + VISITED_TREE = 3; + UNVISITED_TREE_IN_FOREST = 4; + VISITED_TREE_IN_FOREST = 5; + MAX_SPARE_POINTS = 20; +var + InForest: Boolean; + AvoidBulding: Byte; + RADIUS, MAX_DIST: Word; + X,Y,X2,Y2, Cnt: Integer; + Point, sumPoint: TKMPoint; + VisitArr: TKMByte2Array; + FI: TKMForestsInfo; +begin + fBuildFF.UpdateState(); // Mark walkable area in owner's city + + // Init visit array and fill trees + SetLength(VisitArr, fMapY, fMapX); + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + begin + VisitArr[Y,X] := VISITED_TILE; + if (BuildFF.VisitIdx = BuildFF.Visited[Y,X]) + AND (BuildFF.State[Y,X] = bsTree) then + begin + AvoidBulding := gAIFields.Influences.AvoidBuilding[Y,X]; + // Tree is not part of existing forest + if (AvoidBulding < AVOID_BUILDING_FOREST_MINIMUM) then + VisitArr[Y,X] := UNVISITED_TREE + // Ignore trees which are too cloose to exist forest + else if (AvoidBulding < AVOID_BUILDING_FOREST_MINIMUM + AI_Par[EYE_GetForests_MaxAB]) then + VisitArr[Y,X] := UNVISITED_TREE_IN_FOREST; + end; + end; + + // Detect potential forests as a cluster of trees + RADIUS := Round(AI_Par[EYE_GetForests_Radius]); + MAX_DIST := RADIUS + 1; + FI.Count := 0; + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + if (VisitArr[Y,X] = UNVISITED_TREE) OR (VisitArr[Y,X] = UNVISITED_TREE_IN_FOREST) then + begin + Point := KMPoint(X,Y); + InForest := False; + sumPoint := KMPOINT_ZERO; + Cnt := 0; + // It is faster to find points in required radius than find closest points from list of points (small radius) + for Y2 := Max(1, Y-RADIUS) to Min(Y+RADIUS, fMapY-1) do + for X2 := Max(1, X-RADIUS) to Min(X+RADIUS, fMapX-1) do + if (VisitArr[Y2,X2] >= UNVISITED_TREE) // Detect tree and check maximal distance + AND (KMDistanceAbs(Point, KMPoint(X2,Y2)) <= MAX_DIST) then + begin + Cnt := Cnt + 1; + sumPoint := KMPointAdd(sumPoint, KMPoint(X2,Y2)); + if (VisitArr[Y2,X2] = UNVISITED_TREE) then + VisitArr[Y2,X2] := VISITED_TREE + else if (VisitArr[Y2,X2] >= UNVISITED_TREE_IN_FOREST) then + begin + InForest := True; + VisitArr[Y2,X2] := VISITED_TREE_IN_FOREST; + end; + end; + if (Cnt > AI_Par[EYE_GetForests_MinTrees]) then + begin + Point := KMPoint( Round(sumPoint.X/(Cnt*1.0)), Round(sumPoint.Y/(Cnt*1.0)) ); + if (Length(FI.Forests) >= FI.Count) then + SetLength(FI.Forests,Length(FI.Forests)+100); + with FI.Forests[ FI.Count ] do + begin + PartOfForest := InForest; + Loc := KMPoint( Round(sumPoint.X/Cnt), Round(sumPoint.Y/Cnt) ); + TreeCout := Cnt; + // Center point does not have to be visited by BuildFF + if (BuildFF.VisitIdx = BuildFF.Visited[Loc.Y,Loc.X]) then + Distance := BuildFF.Distance[Loc] + else + Distance := BuildFF.Distance[Point]; + Bid := 0; + end; + Inc(FI.Count); + end; + end; + Result := FI; +end; + + +function TKMEye.GetPotentialForests(aMaxCnt: Integer): TKMForestsInfo; +var + K: Integer; + Ownership: Byte; + Point: TKMPoint; +begin + fBuildFF.UpdateState(); // Mark walkable area in owner's city + // Try to find potential forests only in owner's influence areas + Result.Count := 0; + for K := 0 to gAIFields.NavMesh.PolygonsCnt - 1 do + begin + if (Result.Count >= aMaxCnt) then + break; + Ownership := gAIFields.Influences.OwnPoly[fOwner, K]; + if (Ownership > AI_Par[EYE_GetForests_SPRndOwnLimMin]) AND + (Ownership < AI_Par[EYE_GetForests_SPRndOwnLimMax]) then + begin + Point := gAIFields.NavMesh.Polygons[K].CenterPoint; + if (Soil[Point.Y,Point.X] > AI_Par[EYE_GetForests_MinRndSoil]) then + begin + if (Length(Result.Forests) >= Result.Count) then + SetLength(Result.Forests,Length(Result.Forests)+100); + with Result.Forests[ Result.Count ] do + begin + PartOfForest := False; + Loc := Point; + TreeCout := 0; + Distance := Byte(BuildFF.VisitIdx = BuildFF.Visited[Point.Y,Point.X]) * BuildFF.Distance[Point]; + Bid := 0; + end; + Inc(Result.Count); + end; + end; + end; +end; + + +function TKMEye.GetCityCenterPolygons(aMultiplePoints: Boolean = False): TKMWordArray; +var + K: Integer; + PointArray: TKMPointArray; +begin + PointArray := GetCityCenterPoints(aMultiplePoints); + SetLength(Result, Length(PointArray)); + for K := Low(Result) to High(Result) do + Result[K] := gAIFields.NavMesh.KMPoint2Polygon[ PointArray[K] ]; +end; + + +function TKMEye.GetCityCenterPoints(aMultiplePoints: Boolean = False): TKMPointArray; +const + SCANNED_HOUSES = [htStore, htSchool, htBarracks, htTownhall]; +var + K, Cnt: Integer; + HT: TKMHouseType; + H: TKMHouse; +begin + // Find required house cnt + Cnt := 0; + for HT in SCANNED_HOUSES do + Inc(Cnt, gHands[fOwner].Stats.GetHouseQty(HT)); + SetLength(Result, 1 + (Cnt-1) * Ord(aMultiplePoints)); + + // Exit if we have 0 houses + if Cnt = 0 then + Exit; + + Cnt := 0; + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) and not H.IsDestroyed and H.IsComplete and (H.HouseType in SCANNED_HOUSES) then + begin + Result[Cnt] := H.PointBelowEntrance; + Inc(Cnt); + + if Cnt >= Length(Result) then // in case of not aMultiplePoints + Exit; + end; + end; + + SetLength(Result, Cnt); // Just to be sure ... +end; + + +function TKMEye.GetClosestUnitAroundHouse(aHT: TKMHouseType; aLoc: TKMPoint; aInitPoint: TKMPoint): TKMUnit; +const + INIT_DIST = 10000; +var + X, Y, I, Dist, Closest, Distance: Integer; + Dir: TDirection; + U: TKMUnit; +begin + Result := nil; + Closest := INIT_DIST; + Dist := 1; + for Dir := Low(fHousesMapping[aHT].Surroundings[Dist]) to High(fHousesMapping[aHT].Surroundings[Dist]) do + for I := Low(fHousesMapping[aHT].Surroundings[Dist,Dir]) to High(fHousesMapping[aHT].Surroundings[Dist,Dir]) do + begin + Y := aLoc.Y + fHousesMapping[aHT].Surroundings[Dist,Dir,I].Y; + X := aLoc.X + fHousesMapping[aHT].Surroundings[Dist,Dir,I].X; + U := gTerrain.UnitsHitTest(X,Y); + if (U <> nil) + AND not U.IsDeadOrDying + AND (U.Owner >= 0) // Dont select animals! + AND (U.Owner <> fOwner) + AND (gHands[fOwner].Alliances[U.Owner] <> atAlly) then + begin + Distance := KMDistanceAbs(KMPoint(X,Y), aInitPoint); + if (Closest > Distance) then + begin + Closest := Distance; + Result := U; + end; + end; + end; +end; + + +procedure TKMEye.Paint(aRect: TKMRect); + + procedure DrawHMA(); + var + Dist,Idx,OFFSET,MAX_DIST: Integer; + Color: Cardinal; + Dir: TDirection; + Loc,Point: TKMPoint; + HT: TKMHouseType; + HMA: THouseMappingArray; + begin + MAX_DIST := Length(HMA[HOUSE_MIN].Surroundings); + OFFSET := MAX_DIST * 2 + 5; + Loc := KMPoint(0,OFFSET); + HMA := fHousesMapping; + for HT := HOUSE_MIN to HOUSE_MAX do + begin + if (Loc.X + OFFSET > gTerrain.MapX - OFFSET) then + begin + if (Loc.Y + OFFSET > gTerrain.MapY - OFFSET) then + break; + Loc.X := 0; + Loc.Y := Loc.Y + OFFSET; + end; + Loc.X := Loc.X + OFFSET; + for Idx := Low(HMA[HT].Tiles) to High(HMA[HT].Tiles) do + begin + Point := KMPointAdd(Loc, HMA[HT].Tiles[Idx]); + gRenderAux.Quad(Point.X, Point.Y, $80000000 OR tcBlue); + end; + for Dist := Low(HMA[HT].Surroundings) to High(HMA[HT].Surroundings) do + for Dir := Low(HMA[HT].Surroundings[Dist]) to High(HMA[HT].Surroundings[Dist]) do + for Idx := Low(HMA[HT].Surroundings[Dist,Dir]) to High(HMA[HT].Surroundings[Dist,Dir]) do + //for Idx := Low(HMA[HT].Surroundings[Dist,Dir]) + Byte((Dir = dirE) OR (Dir = dirW)) to High(HMA[HT].Surroundings[Dist,Dir]) - Byte((Dir = dirE) OR (Dir = dirW)) do + begin + Point := KMPointAdd(Loc, HMA[HT].Surroundings[Dist,Dir,Idx]); + Color := ((255 - Round(200 / MAX_DIST * Dist)) shl 24) OR tcWhite; + gRenderAux.Quad(Point.X, Point.Y, Color); + end; + gRenderAux.Quad(Loc.X, Loc.Y, $FF000000 OR tcRed); + gRenderAux.Text(Point.X, Point.Y, gRes.Houses[HT].HouseName, $FF000000); + end; + end; +var + PL: TKMHandID; + I,X,Y: Integer; +begin + //{ Build flood fill + if OVERLAY_AI_EYE then + begin + for PL := 0 to gHands.Count - 1 do + begin + OwnerUpdate(PL); + fBuildFF.UpdateState(); + end; + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + //if (fBuildFF.Visited[Y,X] = fBuildFF.VisitIdxOwner[fOwner]) then + //if (fBuildFF.Visited[Y,X] = fBuildFF.VisitIdx) then + case fBuildFF.State[Y,X] of + bsNoBuild: gRenderAux.Quad(X, Y, $BB000000 OR tcBlack); + bsHousePlan: gRenderAux.Quad(X, Y, $66000000 OR tcBlack); + bsFieldPlan: gRenderAux.Quad(X, Y, $55000000 OR tcGreen); + bsRoadPlan: gRenderAux.Quad(X, Y, $55000000 OR tcBlue); + bsRoad: gRenderAux.Quad(X, Y, $22000000 OR tcBlue); + bsBuild: gRenderAux.Quad(X, Y, $11000000 OR tcYellow); + bsTree: gRenderAux.Quad(X, Y, $99000000 OR tcGreen); + bsForest: gRenderAux.Quad(X, Y, $33000000 OR tcGreen); + bsCoal: gRenderAux.Quad(X, Y, $66000000 OR tcBlack); + bsMine: gRenderAux.Quad(X, Y, $33000000 OR tcRed); + bsDebug: gRenderAux.Quad(X, Y, $FF000000 OR tcRed); + bsReserved: gRenderAux.Quad(X, Y, $66000000 OR tcRed); + else begin end; + end; + //{ Build places of the last plan + for I := 0 to fBuildFF.Locs.Count - 1 do + gRenderAux.Quad(fBuildFF.Locs.Items[I].X, fBuildFF.Locs.Items[I].Y, $99000000 OR tcYellow); + //} + //{ Stone mining tiles + for I := 0 to fStoneMiningTiles.Count - 1 do + gRenderAux.Quad(fStoneMiningTiles.Items[I].X, fStoneMiningTiles.Items[I].Y, $99000000 OR tcRed); //} + end + else if OVERLAY_AI_SOIL then + begin + //{ Soil + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + gRenderAux.Quad(X, Y, (Soil[Y,X] shl 24) OR tcRed); //} + end + else if OVERLAY_AI_FLATAREA then + begin + //{ Flat Area + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + gRenderAux.Quad(X, Y, (FlatArea[Y,X] shl 24) OR tcRed); //} + end + else if OVERLAY_AI_ROUTES then + begin + //{ Routes + for Y := 1 to fMapY - 1 do + for X := 1 to fMapX - 1 do + gRenderAux.Quad(X, Y, (Routes[Y,X] shl 24) OR tcRed); //} + end; +end; + + +{ TKMBuildFF } +constructor TKMBuildFF.Create(); +begin + inherited Create(); + fUpdateTick := 0; + SetLength(fInfoArr,0); + FillChar(fHouseReq,SizeOf(fHouseReq),#0); + fLocs := TKMPointList.Create(); +end; + +destructor TKMBuildFF.Destroy(); +begin + fLocs.free; + inherited; +end; + + +procedure TKMBuildFF.Save(SaveStream: TKMemoryStream); +//var +// Len: Integer; +begin + SaveStream.PlaceMarker('BuildFF'); + + SaveStream.Write(fMapX); + SaveStream.Write(fMapY); + + +{ + + SaveStream.Write(fOwner); + SaveStream.Write(fVisitIdx); + SaveStream.Write(fVisitIdxHouse); + SaveStream.Write(fStartQueue); + SaveStream.Write(fEndQueue); + SaveStream.Write(fQueueCnt); + SaveStream.Write(fUpdateTick); + + SaveStream.Write(fOwnerUpdateInfo, SizeOf(fOwnerUpdateInfo)); + SaveStream.Write(fHouseReq, SizeOf(fHouseReq)); + + fLocs.SaveToStream(SaveStream); + + Len := Length(fInfoArr); + SaveStream.Write(Len); + if (Len > 0) then + SaveStream.Write(fInfoArr[0], SizeOf(fInfoArr[0]) * Len); + //} +end; + + +procedure TKMBuildFF.Load(LoadStream: TKMemoryStream); +//var +// Len: Integer; +begin + LoadStream.CheckMarker('BuildFF'); + + LoadStream.Read(fMapX); + LoadStream.Read(fMapY); + SetLength(fInfoArr, fMapX * fMapY); + fVisitIdx := 255; + fVisitIdxHouse := 255; +{ + + LoadStream.Read(fOwner); + LoadStream.Read(fVisitIdx); + LoadStream.Read(fVisitIdxHouse); + LoadStream.Read(fStartQueue); + LoadStream.Read(fEndQueue); + LoadStream.Read(fQueueCnt); + LoadStream.Read(fUpdateTick); + + LoadStream.Read(fOwnerUpdateInfo, SizeOf(fOwnerUpdateInfo)); + LoadStream.Read(fHouseReq, SizeOf(fHouseReq)); + + fLocs.LoadFromStream(LoadStream); + + LoadStream.Read(Len); + SetLength(fInfoArr,Len); + if (Len > 0) then + LoadStream.Read(fInfoArr[0], SizeOf(fInfoArr[0]) * Len); + //} +end; + + +// Transform 1D array to 2D +//function TKMBuildFF.GetInfo(const aY,aX: Word): TKMBuildInfo; +//begin +// Result := fInfoArr[aY*fMapX + aX]; +//end; +//procedure TKMBuildFF.SetInfo(const aY,aX,aNext,aDistance: Word; const aVisited: Byte; const aState: TKMBuildState); +//begin +// with fInfoArr[aY*fMapX + aX] do +// begin +// Visited := aVisited; +// State := aState; +// Next := aNext; +// Distance := aDistance; +// end; +//end; + +function TKMBuildFF.GetVisited(const aY,aX: Word): Byte; +begin + Result := fInfoArr[aY*fMapX + aX].Visited; +end; +procedure TKMBuildFF.SetVisited(const aY,aX: Word; const aVisited: Byte); +begin + fInfoArr[aY*fMapX + aX].Visited := aVisited; +end; + +function TKMBuildFF.GetOwnersIndex(const aOwner: TKMHandID): Byte; +begin + Result := fOwnerUpdateInfo[aOwner]; +end; + +function TKMBuildFF.GetState(const aY,aX: Word): TKMBuildState; +begin + Result := GetStateFromIdx(aY*fMapX + aX); +end; +procedure TKMBuildFF.SetState(const aY,aX: Word; const aState: TKMBuildState); +begin + fInfoArr[aY*fMapX + aX].State := aState; +end; + +function TKMBuildFF.GetStateFromIdx(const aIdx: Integer): TKMBuildState; +begin + Result := bsNoBuild; + with fInfoArr[aIdx] do + if (Visited = fVisitIdx) then + Result := State; +end; + +function TKMBuildFF.GetDistance(const aPoint: TKMPoint): Word; +begin + Result := 50; + with fInfoArr[aPoint.Y*fMapX + aPoint.X] do + if (Visited = fVisitIdx) then + Result := Distance; +end; +function TKMBuildFF.GetDistanceInitPoint(const aPoint: TKMPoint): Word; +begin + Result := 50; + with fInfoArr[aPoint.Y*fMapX + aPoint.X] do + if (Visited = fVisitIdx) then + Result := DistanceInitPoint; +end; + +function TKMBuildFF.GetNext(const aY,aX: Word): Word; +begin + Result := fInfoArr[aY*fMapX + aX].Next; +end; +procedure TKMBuildFF.SetNext(const aY,aX,aNext: Word); +begin + fInfoArr[aY*fMapX + aX].Next := aNext; +end; + + +// Init queue +procedure TKMBuildFF.InitQueue(aHouseFF: Boolean); +var + K: Integer; +begin + fQueueCnt := 0; + if aHouseFF then + begin + if (fVisitIdxHouse >= 254) then + begin + fVisitIdxHouse := 0; + for K := 0 to Length(fInfoArr) - 1 do + fInfoArr[K].VisitedHouse := 0; + end; + fVisitIdxHouse := fVisitIdxHouse + 1 + end + else + begin + if (fVisitIdx >= 254) then + begin + fVisitIdx := 0; + for K := 0 to Length(fInfoArr) - 1 do + fInfoArr[K].Visited := 0; + //FillChar(fInfoArr[0], SizeOf(TKMBuildInfo[0])*Length(fInfoArr), #0); + end; + fVisitIdx := fVisitIdx + 1; + end; +end; + + +function TKMBuildFF.InsertInQueue(const aIdx: Integer): Integer; +begin + if (fQueueCnt = 0) then + fStartQueue := aIdx + else + fInfoArr[fEndQueue].Next := aIdx; + fEndQueue := aIdx; + fQueueCnt := fQueueCnt + 1; + Result := aIdx; +end; + + +function TKMBuildFF.RemoveFromQueue(var aX,aY: Word; var aIdx: Integer): Boolean; +begin + Result := (fQueueCnt > 0); + if Result then + begin + aIdx := fStartQueue; + aY := fInfoArr[fStartQueue].Y;// aIdx div fMapX; + aX := aIdx - aY * fMapX; + fStartQueue := fInfoArr[fStartQueue].Next; + fQueueCnt := fQueueCnt - 1; + end; +end; + + +function TKMBuildFF.CanBeVisited(const aX,aY: Word; const aIdx: Integer; const aHouseQueue: Boolean = False): Boolean; +begin + // tpOwn - walkable tile + height evaluation + if aHouseQueue then + Result := (fInfoArr[aIdx].Visited = fVisitIdx) AND (fInfoArr[aIdx].VisitedHouse < fVisitIdxHouse) AND (tpOwn in gTerrain.Land^[aY,aX].Passability) + //Result := (fInfoArr[aIdx].Visited = fVisitIdx) AND (fInfoArr[aIdx].VisitedHouse < fVisitIdxHouse) AND gTerrain.TileIsRoadable( KMPoint(aX,aY) ) AND (tpOwn in gTerrain.Land^[aY,aX].Passability) + else + Result := (fInfoArr[aIdx].Visited < fVisitIdx) AND gTerrain.TileIsRoadable( KMPoint(aX,aY) );//(tpOwn in gTerrain.Land^[aY,aX].Passability); +end; + + +procedure TKMBuildFF.MarkAsVisited(const aY: Word; const aIdx,aDistance: Integer; const aState: TKMBuildState); +begin + with fInfoArr[aIdx] do + begin + Y := aY; + Visited := fVisitIdx; + State := aState; + Distance := aDistance; + end; +end; +procedure TKMBuildFF.MarkAsVisited(const aX,aY: Word; const aIdx,aDistance: Integer); +var + Point: TKMPoint; +begin + with fInfoArr[aIdx] do + begin + VisitedHouse := fVisitIdxHouse; + DistanceInitPoint := aDistance; + + Point := KMPoint(aX,aY); + if CanBePlacedHouse(Point) then + fLocs.Add(Point); + end; +end; + + +function TKMBuildFF.CanBePlacedHouse(const aLoc: TKMPoint): Boolean; +const + DIST = 1; +var + LeftSideFree, RightSideFree, CoalUnderPlan: Boolean; + K: Integer; + Point: TKMPoint; + Dir: TDirection; +begin + Result := False; + CoalUnderPlan := False; + with gAIFields.Eye.HousesMapping[fHouseReq.HouseType] do + begin + for K := Low(Tiles) to High(Tiles) do + begin + Point := KMPointAdd(aLoc, Tiles[K]); + if (Point.Y < 2) OR (Point.X < 2) OR (Point.X > fMapX - 2) OR (Point.Y > fMapY - 2) then + Exit; + case State[Point.Y, Point.X] of + bsDebug,bsBuild: + begin + + end; + bsTree: + begin + if not fHouseReq.IgnoreTrees then + Exit; + end; + bsCoal: + begin + CoalUnderPlan := True; + if not fHouseReq.IgnoreAvoidBuilding then + Exit; + end; + bsForest: + begin + if not fHouseReq.IgnoreAvoidBuilding then + Exit; + end; + else + Exit; + end; + end; + if (fHouseReq.HouseType = htCoalMine) AND not CoalUnderPlan then + Exit; + // Scan tiles in distance 1 from house plan + LeftSideFree := True; + RightSideFree := True; + for Dir := Low(Surroundings[DIST]) to High(Surroundings[DIST]) do + //for K := Low(Surroundings[DIST,Dir]) to High(Surroundings[DIST,Dir]) do + for K := Low(Surroundings[DIST,Dir]) + Byte(Dir = dirS) to High(Surroundings[DIST,Dir]) - Byte(Dir = dirS) do + begin + Point := KMPointAdd(aLoc, Surroundings[DIST,Dir,K]); + if fHouseReq.IgnoreAvoidBuilding AND (State[Point.Y, Point.X] in [bsReserved, bsHousePlan]) then + Exit; + if (Dir = dirS) AND (State[Point.Y, Point.X] in [bsNoBuild, bsHousePlan]) AND ((K < 2) OR (K > 3) OR (State[Point.Y, Point.X] <> bsFieldPlan)) then + Exit; + if (Dir = dirE) then + RightSideFree := RightSideFree AND not (State[Point.Y, Point.X] in [bsNoBuild, bsHousePlan]); + if (Dir = dirW) then + LeftSideFree := LeftSideFree AND not (State[Point.Y, Point.X] in [bsNoBuild, bsHousePlan]); + if not (LeftSideFree OR RightSideFree) then + Exit; + end; + end; + Result := True; +end; + + +function TKMBuildFF.GetTerrainState(const aX,aY: Word): TKMBuildState; +var + AB: Byte; + Output: TKMBuildState; +begin + Result := bsNoBuild; + + // Passability + if (tpBuild in gTerrain.Land^[aY,aX].Passability) then + Output := bsBuild + else if (gTerrain.ObjectIsChopableTree(KMPoint(aX,aY), [caAge1,caAge2,caAge3,caAgeFull]) + AND gHands[fOwner].CanAddFieldPlan(KMPoint(aX,aY), ftWine)) then + Output := bsTree + else if (gTerrain.Land^[aY,aX].Passability * [tpMakeRoads, tpWalkRoad] <> []) then + Output := bsRoad + else if (gTerrain.Land^[aY,aX].TileLock = tlRoadWork) then + Output := bsRoadPlan + else + Exit; + // Avoid building + AB := gAIFields.Influences.AvoidBuilding[aY, aX]; + case AB of + AVOID_BUILDING_NODE_LOCK_FIELD: Output := bsFieldPlan; + AVOID_BUILDING_NODE_LOCK_ROAD: Output := bsRoadPlan; + AVOID_BUILDING_HOUSE_INSIDE_LOCK: Output := bsReserved; + AVOID_BUILDING_HOUSE_OUTSIDE_LOCK: + begin + if (Output = bsBuild) then + Output := bsRoad; + end; + AVOID_BUILDING_HOUSE_ENTRANCE: Output := bsRoad; + AVOID_BUILDING_MINE_TILE: Output := bsMine; + AVOID_BUILDING_COAL_TILE: + begin + case Output of + bsTree: Output := bsNoBuild; + bsNoBuild: Output := bsNoBuild; + bsBuild: Output := bsCoal; + //bsRoad: Output := bsCoal; + //bsRoadPlan: Output := bsCoal; + end; + end; + else + begin + if (AB > AVOID_BUILDING_FOREST_MINIMUM) AND (Output <> bsTree) then + Output := bsForest; + end; + end; + Result := Output; +end; + + +procedure TKMBuildFF.MarkPlans(); +const + DIST = 1; +var + PL: TKMHandID; + K,L: Integer; + Dir: TDirection; + P1,P2: TKMPoint; + HT: TKMHouseType; +begin +// Mark plans (only allied houses) + for PL := 0 to gHands.Count - 1 do + if (gHands[fOwner].Alliances[PL] = atAlly) then + begin + // House plans + for K := 0 to gHands[PL].Constructions.HousePlanList.Count - 1 do + with gHands[PL].Constructions.HousePlanList.Plans[K] do + begin + HT := HouseType; + if (HT = htNone) then + Continue; + P1 := KMPointAdd( Loc, KMPoint(gRes.Houses[HT].EntranceOffsetX,0) ); // Plans have moved offset so fix it (because there is never enough exceptions ;) + // Internal house tiles + for L := Low(gAIFields.Eye.HousesMapping[HT].Tiles) to High(gAIFields.Eye.HousesMapping[HT].Tiles) do + begin + P2 := KMPointAdd(P1, gAIFields.Eye.HousesMapping[HT].Tiles[L]); + State[P2.Y, P2.X] := bsHousePlan; + end; + // External house tiles in distance 1 from house plan + for Dir := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[DIST]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[DIST]) do + for L := Low(gAIFields.Eye.HousesMapping[HT].Surroundings[DIST,Dir]) to High(gAIFields.Eye.HousesMapping[HT].Surroundings[DIST,Dir]) do + begin + P2 := KMPointAdd(P1, gAIFields.Eye.HousesMapping[HT].Surroundings[DIST,Dir,L]); + if (gTerrain.Land^[P2.Y,P2.X].Passability * [tpMakeRoads, tpWalkRoad] <> []) then + State[P2.Y, P2.X] := bsRoad + else if (State[P2.Y, P2.X] <> bsNoBuild) then + State[P2.Y, P2.X] := bsHousePlan; + end; + end; + // Field plans + for K := 0 to gHands[PL].Constructions.FieldworksList.Count - 1 do + with gHands[PL].Constructions.FieldworksList.Fields[K] do + case FieldType of + ftNone: Continue; + ftRoad: State[Loc.Y, Loc.X] := bsRoadPlan; + else State[Loc.Y, Loc.X] := bsFieldPlan; + end; + end; +end; + + +procedure TKMBuildFF.TerrainFF(aMaxDistance: Word); +var + X,Y: Word; + Idx,Distance: Integer; +begin + while RemoveFromQueue(X,Y,Idx) do + begin + Distance := fInfoArr[Idx].Distance + 1; + if (Distance > aMaxDistance) then + Break; + if (Y-1 >= 1 ) AND CanBeVisited(X,Y-1,Idx-fMapX) then MarkAsVisited(Y-1, InsertInQueue(Idx-fMapX), Distance, GetTerrainState(X,Y-1)); + if (X-1 >= 1 ) AND CanBeVisited(X-1,Y,Idx-1 ) then MarkAsVisited(Y, InsertInQueue(Idx-1) , Distance, GetTerrainState(X-1,Y)); + if (X+1 <= fMapX-1) AND CanBeVisited(X+1,Y,Idx+1 ) then MarkAsVisited(Y, InsertInQueue(Idx+1) , Distance, GetTerrainState(X+1,Y)); + if (Y+1 <= fMapY-1) AND CanBeVisited(X,Y+1,Idx+fMapX) then MarkAsVisited(Y+1, InsertInQueue(Idx+fMapX), Distance, GetTerrainState(X,Y+1)); + end; +end; + + +procedure TKMBuildFF.HouseFF(); +const + MAX_DIST = 40-10; +var + X,Y: Word; + Idx,Distance: Integer; +begin + while RemoveFromQueue(X,Y,Idx) do + begin + Distance := fInfoArr[Idx].DistanceInitPoint + 1; + if (Distance > MAX_DIST) + OR (fHouseReq.MaxCnt <= fLocs.Count) + OR (Distance > fHouseReq.MaxDist) then + break; + if (Y-1 >= 1 ) AND CanBeVisited(X,Y-1,Idx-fMapX,True) then MarkAsVisited(X,Y-1, InsertInQueue(Idx-fMapX), Distance); + if (X-1 >= 1 ) AND CanBeVisited(X-1,Y,Idx-1 ,True) then MarkAsVisited(X-1,Y, InsertInQueue(Idx-1) , Distance); + if (X+1 <= fMapX-1) AND CanBeVisited(X+1,Y,Idx+1 ,True) then MarkAsVisited(X+1,Y, InsertInQueue(Idx+1) , Distance); + if (Y+1 <= fMapY-1) AND CanBeVisited(X,Y+1,Idx+fMapX,True) then MarkAsVisited(X,Y+1, InsertInQueue(Idx+fMapX), Distance); + end; +end; + + +procedure TKMBuildFF.AfterMissionInit(); +begin + fMapX := gTerrain.MapX; + fMapY := gTerrain.MapY; + SetLength(fInfoArr, fMapX * fMapY); + fVisitIdx := 255; + fVisitIdxHouse := 255; +end; + + +procedure TKMBuildFF.UpdateState(aMaxFFDistance: Word = 40); + procedure MarkHouse(Loc: TKMPoint); + begin + MarkAsVisited(Loc.Y, InsertInQueue(Loc.Y*fMapX + Loc.X), 0, GetTerrainState(Loc.X,Loc.Y)); + end; +var + K: Integer; + H: TKMHouse; + HT: TKMHouseType; + Planner: TKMCityPlanner; +begin + Planner := gHands[fOwner].AI.CityManagement.Builder.Planner; + + if (fUpdateTick = 0) OR (fUpdateTick < gGameParams.Tick) then // Dont scan multile times terrain in 1 tick + begin + InitQueue(False); + fOwnerUpdateInfo[fOwner] := fVisitIdx; // Debug tool + + if (gGameParams.Tick <= MAX_HANDS) then // Make sure that Planner is already updated otherwise take only available houses + begin + for K := 0 to gHands[fOwner].Houses.Count - 1 do + begin + H := gHands[fOwner].Houses[K]; + if (H <> nil) AND not H.IsDestroyed AND not (H.HouseType in [htWatchTower, htWoodcutters]) then + MarkHouse(H.Entrance); + end; + end + else + begin + for HT := HOUSE_MIN to HOUSE_MAX do + if not (HT in [htWatchTower, htWoodcutters]) then + with Planner.PlannedHouses[HT] do + for K := 0 to Count - 1 do + MarkHouse(Plans[K].Loc); + end; + TerrainFF(aMaxFFDistance); + + fUpdateTick := gGameParams.Tick; + MarkPlans(); // Plans may change during placing houses but this event is caught in CityBuilder + end; +end; + + +procedure TKMBuildFF.OwnerUpdate(aPlayer: TKMHandID); +begin + fOwner := aPlayer; + fUpdateTick := 0; // Make sure that area will be scanned in next update +end; + + +procedure TKMBuildFF.ActualizeTile(aX, aY: Word); +begin + if (fUpdateTick = gGameParams.Tick) then // Actualize tile only when we need scan in this tick + State[aY, aX] := GetTerrainState(aX,aY); +end; + + +procedure TKMBuildFF.FindPlaceForHouse(aHouseReq: TKMHouseRequirements; aInitPointsArr: TKMPointList; aClearHouseList: Boolean = True); +var + K: Integer; +begin + if aClearHouseList then + fLocs.Clear; + if (aInitPointsArr = nil) OR (aInitPointsArr.Count <= 0) then + Exit; + + fHouseReq := aHouseReq; + UpdateState(); + + InitQueue(True); + for K := 0 to aInitPointsArr.Count - 1 do + with aInitPointsArr[K] do + if CanBeVisited(X,Y,Y*fMapX + X, True) then + MarkAsVisited(X,Y, InsertInQueue(Y*fMapX + X), 0); + + HouseFF(); +end; + + +{ TKMFFInitPlace } +constructor TKMFFInitPlace.Create(aMapX,aMapY: Word; var aArea: TKMByteArray); +begin + fMapX := aMapX; + fMapY := aMapY; + fArea := aArea; + SetLength(fVisitArr, (aMapX+1) * (aMapY+1)); + fQueue := TQueue.Create(); +end; + + +destructor TKMFFInitPlace.Destroy(); +begin + fQueue.Free(); + inherited; +end; + + +function TKMFFInitPlace.CanBeVisited(const aX,aY: Word; const aDistance: Integer): Boolean; +var + Idx: Integer; +begin + Idx := aY*fMapX + aX; + Result := not fVisitArr[Idx] AND (fArea[Idx] < aDistance); +end; + + +procedure TKMFFInitPlace.MarkAsVisited(const aIdx, aDistance: Integer); +begin + fVisitArr[aIdx] := True; + fArea[aIdx] := aDistance; +end; + + +procedure TKMFFInitPlace.InsertInQueue(const aX,aY: Word; const aDistance: Integer); +var + DE: PDistElement; +begin + MarkAsVisited(aY*fMapX + aX,aDistance); + New(DE); + DE^.X := aX; + DE^.Y := aY; + DE^.Distance := aDistance; + fQueue.Push(DE); +end; + + +function TKMFFInitPlace.RemoveFromQueue(var aX,aY: Word; var aDistance: Integer): Boolean; +var + DE: PDistElement; +begin + Result := (fQueue.Count > 0); + if Result then + begin + DE := fQueue.Pop; + aX := DE^.X; + aY := DE^.Y; + aDistance := DE^.Distance; + Dispose(DE); + end; +end; + + +procedure TKMFFInitPlace.FillArea(aCount: Word; aInitPoints: TKMPointArray); +const + INIT_VALUE = 255; + DEC_COEF = 15; +var + I,X,Y: Word; + Distance: Integer; +begin + FillChar(fVisitArr[0], SizeOf(fVisitArr[0]) * Length(fVisitArr), #0); + for I := 0 to aCount - 1 do + if CanBeVisited(aInitPoints[I].X, aInitPoints[I].Y, INIT_VALUE) then + InsertInQueue(aInitPoints[I].X, aInitPoints[I].Y, INIT_VALUE); + while RemoveFromQueue(X,Y,Distance) do + if (Distance > DEC_COEF) then + begin + Distance := Distance - DEC_COEF; + if (X > 0) AND CanBeVisited(X-1,Y,Distance) then InsertInQueue(X-1,Y,Distance); + if (X < fMapX-1) AND CanBeVisited(X+1,Y,Distance) then InsertInQueue(X+1,Y,Distance); + if (Y > 0) AND CanBeVisited(X,Y-1,Distance) then InsertInQueue(X,Y-1,Distance); + if (Y < fMapY-1) AND CanBeVisited(X,Y+1,Distance) then InsertInQueue(X,Y+1,Distance); + end; +end; + + +{ TKMFFCheckStoneTiles } +constructor TKMFFCheckStoneTiles.Create(aStoneLimit: Integer; const aScanEightTiles: Boolean = False); +begin + inherited Create(aScanEightTiles); + fMapX := gTerrain.MapX; + fMapY := gTerrain.MapY; + fMinLimit := KMPoint(1,1); + fMaxLimit := KMPoint(fMapX-1,fMapY-1); + fStoneLimit := aStoneLimit; + fVisitIdx := 0; + SetLength(fVisitArr,fMapX*fMapY); +end; + + +function TKMFFCheckStoneTiles.CanBeVisited(const aX,aY: SmallInt): Boolean; +begin + Result := gTerrain.TileHasStone(aX,aY) AND (fStoneLimit > fStoneCnt); +end; + + +function TKMFFCheckStoneTiles.IsVisited(const aX,aY: SmallInt): Boolean; +begin + Result := fVisitArr[aY*fMapX + aX] = fVisitIdx; +end; + + +procedure TKMFFCheckStoneTiles.MarkAsVisited(const aX,aY: SmallInt); +begin + fVisitArr[aY*fMapX + aX] := fVisitIdx; + fStoneCnt := fStoneCnt + gTerrain.TileIsStone(aX,aY)*3; +end; + + +function TKMFFCheckStoneTiles.CheckCount(aX,aY: SmallInt): Boolean; +begin + if (fVisitIdx > 254) then + begin + fVisitIdx := 0; + FillChar(fVisitArr[0], SizeOf(fVisitArr[0]) * Length(fVisitArr), #0); + end; + fVisitIdx := fVisitIdx + 1; + fStoneCnt := 0; + QuickFlood(aX,aY); + Result := (fStoneLimit <= fStoneCnt); +end; + + +end. + diff --git a/vendor/kam_remake/src/ai/newAI/KM_Supervisor.pas b/vendor/kam_remake/src/ai/newAI/KM_Supervisor.pas new file mode 100644 index 0000000..0289664 --- /dev/null +++ b/vendor/kam_remake/src/ai/newAI/KM_Supervisor.pas @@ -0,0 +1,1518 @@ +{ +Artificial intelligence +@author: Martin Toupal +@e-mail: poznamenany@gmail.com +} +unit KM_Supervisor; +{$I KaM_Remake.inc} +interface +uses + Classes, KM_CommonClasses, KM_CommonTypes, KM_Defaults, + KM_Points, KM_UnitGroup, KM_Units, KM_UnitWarrior, KM_Terrain, + KM_NavMeshDefences, KM_NavMeshInfluences, KM_ArmyManagement, KM_AIArmyEvaluation, + KM_ArmyAttackNew, KM_NavMeshArmyVectorField, + KM_Houses, KM_Sort; + +type + TKMCompFunc = function (const aElem1, aElem2): Integer; + TKMDefEval = record + Val: Word; + Owner: TKMHandID; + DefPos: PDefencePosition; + end; + TKMDefEvalArr = array of TKMDefEval; + TKMMineEval = record + Val: Word; + pPoint: ^TKMPoint; + end; + TKMMineEvalArr = array of TKMMineEval; + + TKMHandByteArr = array[0..MAX_HANDS-1] of Byte; + + TKMCombatStatusPLArray = array[0..MAX_HANDS-1,0..MAX_HANDS-1] of TKMCombatStatus; + + TThreatArray = array of record + DistRanged, Distance, Risk, WeightedCount: Single; + end; + {$IFDEF DEBUG_Supervisor} + TCombatStatusDebug = record + TargetGroups: array[0..MAX_HANDS-1] of TKMUnitGroupArray; + TargetHouses: array[0..MAX_HANDS-1] of TKMHouseArray; + end; + TArmyAttackDebug = record + Groups: TKMUnitGroupArray; + Threat: TThreatArray; + end; + {$ENDIF} + + +// Supervisor <-> agent relation ... cooperating AI players are just an illusion, agents does not see each other + TKMSupervisor = class + private + fFFA: Boolean; + fPL2Alli: TKMHandByteArr; + fAlli2PL: TKMHandID2Array; + fCombatStatus: TKMCombatStatusPLArray; + fArmyVector: TKMArmyVectorField; + {$IFDEF DEBUG_Supervisor} + fCombatStatusDebug: TCombatStatusDebug; + fArmyAttackDebug: TArmyAttackDebug; + {$ENDIF} + + procedure UpdateFFA(); + function IsNewAI(aID: TKMHandID): Boolean; + function NewAIInTeam(aTeam: Byte; aAttack, aDefence: Boolean): Boolean; + function IsTeamAlive(aTeam: Byte): Boolean; + function HasAssets(aPL: TKMHandID; aIncludeArmy: Boolean = True): Boolean; + + function GetInitPoints(var aPlayers: TKMHandIDArray): TKMPointArray; + function UpdateCombatStatus(aTeam: Byte; var aCityUnderAttack: Boolean): TKMCombatStatus; + procedure AttackCluster(aAttack: Boolean; aCCTIdx: Word; var A: pTKMGroupCounterWeightArray; const E: TKMUnitGroupArray; const H: TKMHouseArray); + procedure UpdateAttacks(aTeam: Byte; aTick: Cardinal); + procedure AttackDecision(aTeam: Byte); + + procedure UpdateDefPos(aTeam: Byte); + procedure DivideResources(); + //procedure EvaluateArmies(); + public + constructor Create(); + destructor Destroy(); override; + procedure Save(SaveStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + + property PL2Alli: TKMHandByteArr read fPL2Alli; + property Alli2PL: TKMHandID2Array read fAlli2PL; + property CombatStatus: TKMCombatStatusPLArray read fCombatStatus; + property FFA: boolean read fFFA; + + function FindClosestEnemies(var aPlayers: TKMHandIDArray; var aEnemyStats: TKMEnemyStatisticsArray): Boolean; + + procedure AfterMissionInit(); + procedure UpdateState(aTick: Cardinal); + procedure UpdateAlliances(); + + function LogStatus(): UnicodeString; + procedure Paint(aRect: TKMRect); + end; + + +implementation +uses + SysUtils, Math, + KM_Game, KM_GameParams, + KM_HandsCollection, KM_Hand, KM_HandEntity, KM_HandTypes, + {$IFDEF DEBUG_Supervisor} + KM_RenderAux, + {$ENDIF} + KM_AIFields, KM_CommonUtils, KM_AIParameters, + KM_ResTypes; + +type + TByteArray = array [Word] of byte; + PByteArray = ^TByteArray; + +{ Procedural functions } +function CompareDef(const aElem1, aElem2): Integer; +var + val1 : TKMDefEval absolute aElem1; + val2 : TKMDefEval absolute aElem2; +begin + if (val1.Val = val2.Val) then Result := 0 + else if (val1.Val < val2.Val) then Result := -1 + else Result := +1; +end; + +function CompareMines(const aElem1, aElem2): Integer; +var + val1 : TKMMineEval absolute aElem1; + val2 : TKMMineEval absolute aElem2; +begin + if (val1.Val = val2.Val) then Result := 0 + else if (val1.Val < val2.Val) then Result := -1 + else Result := +1; +end; + +function CompareInt(const aElem1, aElem2): Integer; +var + val1 : Integer absolute aElem1; + val2 : Integer absolute aElem2; +begin + if (val1 = val2) then Result := 0 + else if (val1 < val2) then Result := -1 + else Result := +1; +end; + + +{ TKMSupervisor } +constructor TKMSupervisor.Create(); +{$IFDEF DEBUG_Supervisor} + var + PL: Integer; +{$ENDIF} +begin + fArmyVector := TKMArmyVectorField.Create(True); + FillChar(fCombatStatus,SizeOf(fCombatStatus),#0); + {$IFDEF DEBUG_Supervisor} + SetLength(fArmyAttackDebug.Threat,0); + for PL := 0 to MAX_HANDS - 1 do + begin + SetLength(fCombatStatusDebug.TargetGroups[PL],0); + SetLength(fCombatStatusDebug.TargetHouses[PL],0); + end; + {$ENDIF} +end; + +destructor TKMSupervisor.Destroy(); +begin + fArmyVector.Free; + inherited; +end; + + +procedure TKMSupervisor.Save(SaveStream: TKMemoryStream); +var + K: Integer; +begin + SaveStream.PlaceMarker('Supervisor'); + SaveStream.Write(fFFA); + SaveStream.Write(fPL2Alli, SizeOf(fPL2Alli)); + SaveStream.Write( Integer(Length(fAlli2PL)) ); + for K := Low(fAlli2PL) to High(fAlli2PL) do + begin + SaveStream.Write( Integer(Length(fAlli2PL[K])) ); + SaveStream.Write(fAlli2PL[K,0], SizeOf(fAlli2PL[K,0])*Length(fAlli2PL[K])); + end; + SaveStream.Write(fCombatStatus, SizeOf(fCombatStatus)); +end; + +procedure TKMSupervisor.Load(LoadStream: TKMemoryStream); +var + K,L: Integer; +begin + LoadStream.CheckMarker('Supervisor'); + LoadStream.Read(fFFA); + LoadStream.Read(fPL2Alli, SizeOf(fPL2Alli)); + LoadStream.Read(L); + SetLength(fAlli2PL, L); + for K := Low(fAlli2PL) to High(fAlli2PL) do + begin + LoadStream.Read(L); + SetLength(fAlli2PL[K],L); + LoadStream.Read(fAlli2PL[K,0], SizeOf(fAlli2PL[K,0])*Length(fAlli2PL[K])); + end; + LoadStream.Read(fCombatStatus, SizeOf(fCombatStatus)); +end; + + +procedure TKMSupervisor.AfterMissionInit(); +begin + UpdateAlliances(); + DivideResources(); +end; + + +procedure TKMSupervisor.UpdateState(aTick: Cardinal); +const + DEFSUPPORT_DIVISION = 10 * MAX_HANDS * 2; // 24 sec + DEF_OR_ATT_DIVISION = 10 * MAX_HANDS * 10; // 2 min + DEFENCES = 500; + ATTACKS = 10; +var + Modulo: Word; +begin + // Attack / defence can be updated slower + Modulo := aTick mod DEF_OR_ATT_DIVISION; + if (Modulo >= DEFENCES) AND (Modulo - DEFENCES < Length(fAlli2PL)) then + UpdateDefPos(Modulo - DEFENCES); + if not gGame.IsPeaceTime then + begin + if (Modulo >= ATTACKS) AND (Modulo - ATTACKS < Length(fAlli2PL)) + AND ( gGameParams.IsTactic OR (aTick > (gGame.Options.Peacetime+3) * 10 * 60) ) then // In normal mode wait 3 minutes after peace + begin + UpdateFFA(); + AttackDecision(Modulo - ATTACKS); + end; + Modulo := (aTick mod MAX_HANDS); + if (Modulo < Length(fAlli2PL)) then + UpdateAttacks(Modulo,aTick); + end; +end; + + +procedure TKMSupervisor.UpdateAlliances(); +var + Check: Boolean; + AlliCnt, PLCnt: Byte; + Idx: Integer; + PL1,PL2,PL3: TKMHandID; +begin + if gGameParams.IsMapEditor then Exit; //No need to work in the mapEd + + FillChar(fPL2Alli, SizeOf(fPL2Alli), #255); // TKMHandIndex = SmallInt => Byte(255) = -1 = HAND_NONE + SetLength(fAlli2PL, gHands.Count, gHands.Count); + AlliCnt := 0; + for PL1 := 0 to gHands.Count - 1 do + if gHands[PL1].Enabled AND (fPL2Alli[PL1] = 255) then + begin + PLCnt := 0; + for PL2 := 0 to gHands.Count - 1 do + if gHands[PL2].Enabled AND (fPL2Alli[PL2] = 255) AND ((PL1 = PL2) OR (gHands[PL1].Alliances[PL2] = atAlly)) then + begin + Check := True; + for Idx := 0 to PLCnt - 1 do + begin + PL3 := fAlli2PL[AlliCnt,Idx]; + Check := Check AND ((gHands[PL3].Alliances[PL2] = atAlly) AND (gHands[PL2].Alliances[PL3] = atAlly)); + end; + if not Check then + Continue; + fPL2Alli[PL2] := AlliCnt; + fAlli2PL[AlliCnt,PLCnt] := PL2; + Inc(PLCnt); + end; + SetLength(fAlli2PL[AlliCnt], PLCnt); + Inc(AlliCnt); + end; + SetLength(fAlli2PL, AlliCnt); + UpdateFFA(); + gAIFields.Influences.UpdateAlliances(fAlli2PL); +end; + + +procedure TKMSupervisor.UpdateFFA(); +var + Team,PL,Cnt: Integer; +begin + Cnt := 0; + for Team := Low(fAlli2PL) to High(fAlli2PL) do + for PL := Low(fAlli2PL[Team]) to High(fAlli2PL[Team]) do + if HasAssets(fAlli2PL[Team,PL]) then + begin + Inc(Cnt); + break; + end; + fFFA := Cnt > 2; +end; + + +function TKMSupervisor.IsNewAI(aID: TKMHandID): Boolean; +begin + Result := gHands[aID].AI.Setup.NewAI; +end; + + +function TKMSupervisor.NewAIInTeam(aTeam: Byte; aAttack, aDefence: Boolean): Boolean; +var + IdxPL: Integer; +begin + Result := False; + for IdxPL := 0 to Length( fAlli2PL[aTeam] ) - 1 do + with gHands[ fAlli2PL[aTeam, IdxPL] ] do + if IsComputer + AND AI.Setup.NewAI + AND (not aAttack OR AI.Setup.AutoAttack) + AND (not aDefence OR AI.Setup.AutoDefend) then + Exit(True); +end; + + +function TKMSupervisor.IsTeamAlive(aTeam: Byte): Boolean; +var + PL: Integer; +begin + Result := False; + for PL in fAlli2PL[aTeam] do + if HasAssets(PL,True) then + Exit(True); +end; + + +function TKMSupervisor.HasAssets(aPL: TKMHandID; aIncludeArmy: Boolean = True): Boolean; +const + HOUSE_TYPES: array of TKMHouseType = [htBarracks, htStore, htSchool, htTownhall]; +begin + with gHands[aPL] do + Result := Enabled AND ((Stats.GetHouseQty(HOUSE_TYPES) > 0) OR (aIncludeArmy AND (Stats.GetArmyCount() > 0))); +end; + + +function TKMSupervisor.UpdateCombatStatus(aTeam: Byte; var aCityUnderAttack: Boolean): TKMCombatStatus; + procedure UpdateCS(aOwner,aEnemy: TKMHandID; aStatus: TKMCombatStatus); + begin + if (Byte(fCombatStatus[aOwner,aEnemy]) < Byte(aStatus)) then + fCombatStatus[aOwner,aEnemy] := aStatus; + end; + +const + SQR_DANGEROUS_DISTANCE = 15*15; + SQR_OFFENSIVE_DISTANCE = 30*30; + INFLUENCE_THRESHOLD = 150; + ARMY_IN_HOSTILE_CITY = 200; + TARGET_HOUSE_IN_INFLUENCE = 150; +var + CS: TKMCombatStatus; + K, L, M, CSNum: Integer; + P: TKMPoint; + G: TKMUnitGroup; + pCluster: pTKMCombatCluster; + Owner, PL: TKMHandID; +begin + Result := csNeutral; + aCityUnderAttack := False; + // Check if team have newAI + if not NewAIInTeam(aTeam, False, False) then + Exit; + + // Set default state = csNeutral (except attack combat status) + for Owner in fAlli2PL[aTeam] do + for PL := 0 to gHands.Count - 1 do + if (gHands[Owner].Alliances[PL] <> atEnemy) + OR (fCombatStatus[Owner,PL] in [csDefending, csCounterattack]) + OR (not HasAssets(PL)) + OR ((gHands[Owner].AI.ArmyManagement.AttackNew.Count = 0) AND not gHands[Owner].AI.ArmyManagement.AttackRequest.Active) then + fCombatStatus[Owner,PL] := csNeutral; + + // Scan distances in the NavMesh + if not fArmyVector.DetectEnemyPresence(fAlli2PL[aTeam]) then + Exit(csNeutral); + + // Get closest distance between ally and enemy groups + for K := 0 to fArmyVector.Ally.GroupsCount - 1 do + begin + L := fArmyVector.Ally.GroupsPoly[K]; + if (fArmyVector.QueueArray[L].Visited > 0) then + begin + pCluster := @fArmyVector.Clusters.Clusters[ fArmyVector.Clusters.Clusters[ fArmyVector.ClusterMapping[L] ].ReferenceID ]; + for M := Low(fArmyVector.CCT) to High(fArmyVector.CCT) do + if (fArmyVector.CCT[M].Cluster = pCluster) then + begin + fArmyVector.CCT[M].BestDist := Min(fArmyVector.CCT[M].BestDist, fArmyVector.QueueArray[L].Distance); + for Owner in fArmyVector.CCT[M].Owners do + UpdateCS(fArmyVector.Ally.Groups[K].Owner, Owner, csDefending); + end; + end; + end; + + // Evaluate cluster + for K := Low(fArmyVector.CCT) to High(fArmyVector.CCT) do + begin + pCluster := fArmyVector.CCT[K].Cluster; + + // Check if cluster is in the city + for M := 0 to pCluster.GroupsCount - 1 do + begin + G := fArmyVector.Enemy.Groups[ pCluster.Groups[M] ]; + Inc(fArmyVector.CCT[K].CounterWeight.WeightedCount[G.GroupType],G.Count); + P := G.Position; + for Owner in fAlli2PL[aTeam] do + if (gAIFields.Influences.OwnPoint[Owner, P] > INFLUENCE_THRESHOLD) then + begin + fArmyVector.CCT[K].AttackingCity := True; + aCityUnderAttack := True; + Result := csDefending; + UpdateCS(Owner,G.Owner,csDefending); + end; + end; + + // Get combat status - if CS = csAttackCity then increase threat + CSNum := Byte(csNeutral); + for M := 0 to Length(fArmyVector.CCT[K].Owners) - 1 do + for Owner in fAlli2PL[aTeam] do + CSNum := Max(CSNum, Byte(fCombatStatus[ Owner, fArmyVector.CCT[K].Owners[M] ]) ); + + // Estimate threat + with fArmyVector.CCT[K] do + begin + Threat := (CounterWeight.WeightedCount[gtMelee] + CounterWeight.WeightedCount[gtMounted] + CounterWeight.WeightedCount[gtRanged] + CounterWeight.WeightedCount[gtAntiHorse]); + ThreatNearby := Byte((BestDist < 1E4) OR AttackingCity) * Threat + + Byte( (CSNum >= Byte(csAttackingCity)) AND (pCluster.HousesCount > 0) ); + end; + end; + + + // Update combat status of the alliance in relation to allied units + for Owner in fAlli2PL[aTeam] do + begin + CS := csNeutral; + for PL := 0 to gHands.Count - 1 do + if (gHands[Owner].Alliances[PL] = atEnemy) then + begin + // Check if units are closer to enemy city and if so, then change status to counterattack + if (fCombatStatus[Owner,PL] in [csNeutral, csDefending]) AND HasAssets(PL,False) then + for K := 0 to gHands[Owner].UnitGroups.Count - 1 do + begin + G := gHands[Owner].UnitGroups.Groups[K]; + if (G <> nil) AND not G.IsDead AND (gAIFields.Influences.OwnPoint[ PL, G.Position ] > ARMY_IN_HOSTILE_CITY) then + begin + fCombatStatus[Owner,PL] := csCounterattack; + break; + end; + end; + // Update combat status + CS := TKMCombatStatus( Max( Byte(CS), Byte(fCombatStatus[Owner,PL]) ) ); + end; + Result := TKMCombatStatus( Max( Byte(CS), Byte(Result) ) ); + fCombatStatus[Owner,Owner] := CS; // Overall combat status of player + end; +end; + + +procedure TKMSupervisor.AttackCluster(aAttack: Boolean; aCCTIdx: Word; var A: pTKMGroupCounterWeightArray; const E: TKMUnitGroupArray; const H: TKMHouseArray); + + function GetIdx(aLen, aA, aE: Integer): Integer; inline; + begin + Result := aLen * aA + aE; + end; + +const + NO_THREAT = -1E6; + sqr_INTEREST_DISTANCE_House = 20*20; + sqr_MAX_DISTANCE_FROM_HOUSE = 10*10; + MAX_ATTACKERS_PER_HOUSE = 12; + WarriorPrice: array [utMilitia..utVagabond] of Single = ( + 1.0,2.0,3.0,2.0,3.0, // utMilitia,utAxeFighter,utSwordsman,utBowman,utArbaletman, + 2.0,3.0,2.0,3.0, // utPikeman,utHallebardman,utHorseScout,utCavalry + 3.5,1.0,1.0,3.5,1.0 // utBarbarian,utPeasant,utSlingshot,utMetalBarbarian,utHorseman + ); + OpportunityArr: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX, GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Single = ( + // gtMelee, gtAntiHorse, gtRanged, gtMounted + ( 1.0, 1.5, 3.0, 0.5), // gtMelee + ( 0.5, 1.0, 2.0, 4.0), // gtAntiHorse + ( 1.0, 1.5, 2.0, 0.5), // gtRanged + ( 1.0, 0.5, 5.0, 1.0) // gtMounted + ); + +var + IdxA,IdxE, CntA, CntE, Overflow, Overflow2, BestIdxE, BestIdxA: Integer; + BestThreat, Opportunity, BestOpportunity: Single; + U: TKMUnit; + UW: TKMUnitWarrior; + pGCWA: pTKMGroupCounterWeight; + TargetH: TKMHouse; + Dist: array of Single; + Threat: TThreatArray; + AttackingHouseCnt: array of Word; +begin + // Init variables for compiler + BestIdxA := 0; + BestIdxE := 0; + CntA := Length(A); + CntE := Length(E); + + // Remove groups that already attack house (destroy it at all cost) + SetLength(AttackingHouseCnt, Length(H)); + if (Length(AttackingHouseCnt) > 0) then + begin + FillChar(AttackingHouseCnt[0], Length(AttackingHouseCnt) * SizeOf(AttackingHouseCnt[0]), #0); + for IdxA := CntA - 1 downto 0 do + begin + TargetH := A[IdxA].Group.OrderTargetHouse; + if (TargetH <> nil) AND (A[IdxA].Group.GroupType <> gtRanged) AND (KMDistanceSqr(A[IdxA].Group.Position,TargetH.Entrance) < sqr_MAX_DISTANCE_FROM_HOUSE) then + begin + // Consider units if house is in the combat line + for IdxE := 0 to Length(H) - 1 do + if (H[IdxE] = TargetH) then + begin + Inc(AttackingHouseCnt[IdxE],A[IdxA].Group.Count); + break; + end; + Dec(CntA); + // Swap groups so groups < CntA waits for orders but threat is computed from all + pGCWA := A[IdxA]; + A[IdxA] := A[CntA]; + A[CntA] := pGCWA; + end; + end; + end; + + if aAttack AND (Length(E) > 0) then + begin + + // Set orders for ranged groups in range (the closest enemy, top prio) + for IdxA := CntA - 1 downto 0 do + if (A[IdxA].Group.GroupType = gtRanged) then + begin + U := gTerrain.UnitsHitTestWithinRad(A[IdxA].Group.Position, 0.5, A[IdxA].Group.GetAliveMember.GetFightMaxRange(True), A[IdxA].Group.Owner, atEnemy, dirNA, False); + if (U is TKMUnitWarrior) then + begin + A[IdxA].CG.TargetGroup := TKMUnitWarrior(U).Group; + Dec(CntA); + // Swap groups so groups < CntA waits for orders but threat is computed from all + pGCWA := A[IdxA]; + A[IdxA] := A[CntA]; + A[CntA] := pGCWA; + end; + end; + + // Compute distances (it is used for threat so compute it for all groups) + SetLength(Dist, Length(A)*Length(E)); + for IdxA := 0 to Length(A) - 1 do + for IdxE := 0 to Length(E) - 1 do + Dist[ GetIdx(CntE,IdxA,IdxE) ] := KMDistanceSqr(A[IdxA].Group.Position,E[IdxE].Position); + + // Compute threat + SetLength(Threat, Length(E)); + for IdxE := 0 to CntE - 1 do + begin + // Estimate threat + Threat[IdxE].Distance := 1E6; + Threat[IdxE].DistRanged := 1E6; + for IdxA := 0 to Length(A) - 1 do // Over all groups + if (A[IdxA].Group.GroupType = gtRanged) AND (Dist[ GetIdx(CntE,IdxA,IdxE) ] < Threat[IdxE].DistRanged) then + Threat[IdxE].DistRanged := Dist[ GetIdx(CntE,IdxA,IdxE) ] + else if (Dist[ GetIdx(CntE,IdxA,IdxE) ] < Threat[IdxE].Distance) then + Threat[IdxE].Distance := Dist[ GetIdx(CntE,IdxA,IdxE) ]; + // Estimate group price (use just 1 warrior type * count) + UW := E[IdxE].GetAliveMember; + Threat[IdxE].WeightedCount := E[IdxE].Count * WarriorPrice[UW.UnitType]; + case E[IdxE].GroupType of // + City influence - Group in combat + gtMelee: Threat[IdxE].Risk := Threat[IdxE].WeightedCount * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainMelee]; + gtAntiHorse: Threat[IdxE].Risk := Threat[IdxE].WeightedCount * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainAntiHorse]; + gtRanged: Threat[IdxE].Risk := Threat[IdxE].WeightedCount * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainRanged]; + gtMounted: Threat[IdxE].Risk := Threat[IdxE].WeightedCount * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainMounted]; + else Threat[IdxE].Risk := NO_THREAT; + end; + // Consider distance + Threat[IdxE].Risk := + + Threat[IdxE].Risk + - Threat[IdxE].DistRanged * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainRangDist] * Byte(Threat[IdxE].DistRanged <> 1E6) + - Threat[IdxE].Distance * AI_Par[ATTACK_SUPERVISOR_EvalTarget_ThreatGainDist] * Byte(Threat[IdxE].Distance <> 1E6); + end; + + {$IFDEF DEBUG_Supervisor} + SetLength(fArmyAttackDebug.Groups, Length(Threat)); + SetLength(fArmyAttackDebug.Threat, Length(Threat)); + if (Length(Threat) > 0) then + begin + Move(E[0], fArmyAttackDebug.Groups[0], Length(E) * SizeOf(E[0])); + Move(Threat[0], fArmyAttackDebug.Threat[0], Length(Threat) * SizeOf(Threat[0])); + end; + {$ENDIF} + + // Set targets + + // Archers (out of range) - shoot the nearest enemy + for IdxA := 0 to CntA - 1 do + if (A[IdxA].Group.GroupType = gtRanged) then + begin + BestOpportunity := abs(NO_THREAT); + for IdxE := Low(Threat) to High(Threat) do + if (Dist[ GetIdx(CntE,IdxA,IdxE) ] < BestOpportunity) then + begin + BestIdxE := IdxE; + BestOpportunity := Dist[ GetIdx(CntE,IdxA,IdxE) ]; + end; + // Set order + if (BestOpportunity <> abs(NO_THREAT)) then + begin + A[IdxA].CG.TargetGroup := E[BestIdxE]; + // Remove group from selection + A[IdxA] := nil; + end; + end; + + // Melee - attack the most dangerous enemy + Overflow := 0; + while (Overflow < Length(E)) do + begin + Inc(Overflow); + // Find the most dangerous enemy (closest and strongest group) + BestThreat := NO_THREAT; + for IdxE := Low(Threat) to High(Threat) do + if (Threat[IdxE].Risk > BestThreat) then + begin + BestIdxE := IdxE; + BestThreat := Threat[IdxE].Risk; + end; + if (BestThreat <= NO_THREAT) then + break; + // Find something that can beat it (distance, strength and group type) + with Threat[BestIdxE] do + begin + Overflow2 := 0; + while (WeightedCount > 0) AND (Min(DistRanged, Distance) < sqr(AI_Par[ATTACK_SUPERVISOR_EvalTarget_DistanceGroup])) AND (Overflow2 < 100) do + begin + Inc(Overflow2); + BestOpportunity := NO_THREAT; + for IdxA := 0 to CntA - 1 do + if (A[IdxA] <> nil) then // Skip already used group + begin + Opportunity := + OpportunityArr[ A[IdxA].Group.GroupType, E[BestIdxE].GroupType ] * AI_Par[ATTACK_SUPERVISOR_EvalTarget_OpportunityGain] + - Dist[ GetIdx(CntE,IdxA,BestIdxE) ] * AI_Par[ATTACK_SUPERVISOR_EvalTarget_OpportunityDistGain]; + if (BestOpportunity < Opportunity) then + begin + BestIdxA := IdxA; + BestOpportunity := Opportunity; + end; + end; + if (BestOpportunity <> NO_THREAT) then + begin + // SetOrders + UW := A[BestIdxA].Group.GetAliveMember; + // Decrease risk + WeightedCount := WeightedCount - A[BestIdxA].Group.Count * WarriorPrice[UW.UnitType] * AI_Par[ATTACK_SUPERVISOR_EvalTarget_DecreaseRisk]; + // Set order + A[BestIdxA].CG.TargetGroup := E[BestIdxE]; + // Remove group from selection + A[BestIdxA] := nil; + end + else + break; + end; + Risk := NO_THREAT; + end; + end; + end; + + // Attack houses + for IdxE := 0 to Length(H) - 1 do + begin + Overflow := 0; + while (AttackingHouseCnt[IdxE] < MAX_ATTACKERS_PER_HOUSE) AND (Overflow < 5) do + begin + Inc(Overflow); + BestOpportunity := abs(NO_THREAT); + for IdxA := 0 to CntA - 1 do + if (A[IdxA] <> nil) AND (A[IdxA].Group.GroupType <> gtRanged) then + begin + Opportunity := KMDistanceSqr(H[IdxE].Entrance, A[IdxA].Group.Position); + if (BestOpportunity > Opportunity) AND (Opportunity < sqr_INTEREST_DISTANCE_House) then + begin + BestIdxA := IdxA; + BestOpportunity := Opportunity; + end; + end; + // Set order + if (BestOpportunity <> abs(NO_THREAT)) then + begin + Inc(AttackingHouseCnt[IdxE],A[BestIdxA].Group.Count); + A[BestIdxA].CG.TargetHouse := H[IdxE]; + A[BestIdxA] := nil; + end; + end; + end; + // Remove groups with orders from A (the rest is going to get command to walk) + for IdxA := cntA to Length(A) - 1 do + A[IdxA] := nil; +end; + + +procedure TKMSupervisor.UpdateAttacks(aTeam: Byte; aTick: Cardinal); + + procedure EvaluateEnemy(aAttack: Boolean; aIdx: Word); + var + K, Cnt: Integer; + EG: TKMUnitGroupArray; + pGCWA: pTKMGroupCounterWeightArray; + H: TKMHouseArray; + begin + // Copy allied groups (they will be edited) + SetLength(pGCWA, fArmyVector.CCT[aIdx].CounterWeight.CGCount); + Cnt := 0; + for K := 0 to fArmyVector.CCT[aIdx].CounterWeight.GroupsCount - 1 do + begin + pGCWA[Cnt] := @fArmyVector.CCT[aIdx].CounterWeight.Groups[K]; + Inc(Cnt,Byte(pGCWA[Cnt].CG <> nil)); + if (Cnt = fArmyVector.CCT[aIdx].CounterWeight.CGCount) then + break; + end; + // Set orders to attack + with fArmyVector.CCT[aIdx].Cluster^ do + begin + SetLength(EG, GroupsCount); + for K := 0 to GroupsCount - 1 do + EG[K] := fArmyVector.Enemy.Groups[ Groups[K] ]; + SetLength(H, HousesCount); + Cnt := 0; + // Barracks first + for K := 0 to HousesCount - 1 do + if (fArmyVector.Enemy.Houses[ Houses[K] ].HouseType = htBarracks) then + begin + H[Cnt] := fArmyVector.Enemy.Houses[ Houses[K] ]; + Inc(Cnt); + end; + for K := 0 to HousesCount - 1 do + if (fArmyVector.Enemy.Houses[ Houses[K] ].HouseType <> htBarracks) then + begin + H[Cnt] := fArmyVector.Enemy.Houses[ Houses[K] ]; + Inc(Cnt); + end; + AttackCluster(aAttack, aIdx, pGCWA, EG, H); + end; + // Set orders to move + for K := Low(pGCWA) to High(pGCWA) do + if (pGCWA[K] <> nil) AND (pGCWA[K].CG <> nil) then + pGCWA[K].CG.TargetPosition := pGCWA[K].TargetPosition + end; + +var + PlayerInCombat, CityUnderAttack: Boolean; + K, L: Integer; + PL: TKMHandID; + CS: TKMCombatStatus; + CSA: TKMCombatStatusArray; +begin + // Check if team have newAI + if not NewAIInTeam(aTeam, False, False) then + Exit; + // Check if there are hostile units around + CityUnderAttack := False; + CS := UpdateCombatStatus(aTeam,CityUnderAttack); + // Check if hostile units are around specific player (if not release combat groups) + if not CityUnderAttack then + for K := 0 to Length(fAlli2PL[aTeam]) - 1 do + if IsNewAI(fAlli2PL[aTeam,K]) then + begin + PlayerInCombat := False; + for L := 0 to Length(fCombatStatus[ fAlli2PL[aTeam,K] ]) - 1 do + PlayerInCombat := PlayerInCombat OR (fCombatStatus[ fAlli2PL[aTeam,K], L ] <> csNeutral); + if not PlayerInCombat then + gHands[ fAlli2PL[aTeam,K] ].AI.ArmyManagement.AttackNew.ReleaseGroups(); + end; + if (CS = csNeutral) then + Exit; + // Check if team have groups + if not (fArmyVector.Ally.GroupsCount > 0) OR (fArmyVector.Clusters.Count = 0) then + Exit; + + // Add everything to defence if AI is defending + for K := Low(fArmyVector.CCT) to High(fArmyVector.CCT) do + if (fArmyVector.CCT[K].AttackingCity) then + begin + for PL in fAlli2PL[aTeam] do + if IsNewAI(PL) then + with gHands[PL].AI.ArmyManagement do + AttackNew.AddGroups( Defence.ReleaseAllGroups() ); + break; + end; + + // Divide forces and find positions + for PL in fAlli2PL[aTeam] do + CSA[PL] := fCombatStatus[PL,PL]; + fArmyVector.DivideForces(CS, CSA); + fArmyVector.FindPositions(); + + // Set orders + for K := 0 to Length(fArmyVector.CCT) - 1 do + with fArmyVector.CCT[K].CounterWeight do + if (CGCount > 0) then + EvaluateEnemy(InPlace OR AtAdvantage OR Ambushed, K); +end; + + +function TKMSupervisor.GetInitPoints(var aPlayers: TKMHandIDArray): TKMPointArray; +var + IdxPL: Integer; + Player: TKMHandID; + Group: TKMUnitGroup; + CenterPoints: TKMPointArray; +begin + SetLength(Result, 0); + + // Find center points of cities / armies (where we should start scan - init point / center screen is useless for this) + for IdxPL := 0 to High(aPlayers) do + begin + Player := aPlayers[IdxPL]; + gAIFields.Eye.OwnerUpdate(Player); + CenterPoints := gAIFields.Eye.GetCityCenterPoints(True); + if (Length(CenterPoints) = 0) then // Important houses were not found -> try find soldier + begin + if (gHands[Player].UnitGroups.Count = 0) then + Continue; + Group := gHands[Player].UnitGroups.Groups[ KaMRandom(gHands[Player].UnitGroups.Count{$IFDEF DBG_RNG_SPY}, 'TKMSupervisor.GetInitPoints'{$ENDIF}) ]; + if (Group <> nil) AND not Group.IsDead AND not KMSamePoint(KMPOINT_ZERO,Group.Position) then + begin + SetLength(CenterPoints, 1); + CenterPoints[0] := Group.Position; + end + else + Continue; + end; + SetLength(Result, Length(Result) + Length(CenterPoints)); + Move(CenterPoints[0], Result[ Length(Result) - Length(CenterPoints) ], SizeOf(CenterPoints[0]) * Length(CenterPoints)); + end; +end; + + +function TKMSupervisor.FindClosestEnemies(var aPlayers: TKMHandIDArray; var aEnemyStats: TKMEnemyStatisticsArray): Boolean; +var + InitPoints: TKMPointArray; +begin + // Get init points + InitPoints := GetInitPoints(aPlayers); + // Try find enemies by influence area + Result := (Length(InitPoints) <> 0) + AND ( + gAIFields.Influences.InfluenceSearch.FindClosestEnemies(aPlayers[0], InitPoints, aEnemyStats, True) + //OR gAIFields.Influences.InfluenceSearch.FindClosestEnemies(aPlayers[0], InitPoints, aEnemyStats, False) + ); +end; + + +// Find best target -> to secure that AI will be as universal as possible find only point in map and company will destroy everything around automatically +procedure TKMSupervisor.AttackDecision(aTeam: Byte); + + function FindTargetAssets(aTeamIdx: Byte; var aTargetSoldiers: Boolean; var aPolygons: TKMWordArray): Integer; + const + SCANNED_HOUSES = [htStore, htSchool, htBarracks, htTownhall]; + var + K: Integer; + PL: TKMHandID; + H: TKMHouse; + G: TKMUnitGroup; + begin + aTargetSoldiers := False; + Result := 0; + FillChar(aPolygons[0], SizeOf(aPolygons[0])*Length(aPolygons), #0); + for PL in fAlli2PL[aTeamIdx] do + begin + for K := 0 to gHands[PL].Houses.Count - 1 do + begin + H := gHands[PL].Houses[K]; + if (H <> nil) AND not H.IsDestroyed AND H.IsComplete AND (H.HouseType in SCANNED_HOUSES) then + begin + aPolygons[PL] := gAIFields.NavMesh.KMPoint2Polygon[ H.PointBelowEntrance ]; + Inc(Result); + break; + end; + end; + end; + if (Result = 0) then + begin + aTargetSoldiers := True; + for PL in fAlli2PL[aTeamIdx] do + for K := 0 to gHands[PL].UnitGroups.Count - 1 do + begin + G := gHands[PL].UnitGroups.Groups[K]; + if (G <> nil) AND not G.IsDead AND not KMSamePoint(KMPOINT_ZERO,G.Position) then + begin + aPolygons[PL] := gAIFields.NavMesh.KMPoint2Polygon[ G.Position ]; + Inc(Result); + break; + end; + end; + end; + end; + + function CompareAlliances(out aBestCmpTeam, aWorstCmpTeam: Byte; out aBestCmp, aAvrgCmp, aWorstCmp: Single; out aBestTarget: TKMHandID): Boolean; + const + // Decrease chance to attack enemy in distance + DISTANCE_COEF_1v1 = 0.4; + DISTANCE_COEF_FFA = 2; + var + ATargetSoldiers, ETargetSoldiers: Boolean; + Distance, MinDist, MaxDist: Word; + K, L, ACnt, ECnt, TeamIdx: Integer; + Comparison, DistCoef: Single; + TargetPL: TKMHandIDArray; + AllyPoly,EnemyPoly,RoutePoly,DistArr: TKMWordArray; + begin + Result := False; + ATargetSoldiers := False; + ETargetSoldiers := False; + SetLength(AllyPoly,MAX_HANDS); + SetLength(EnemyPoly,MAX_HANDS); + ACnt := FindTargetAssets(aTeam, ATargetSoldiers, AllyPoly); + aBestCmp := -1; + aAvrgCmp := 0; + aWorstCmp := 1; + aBestCmpTeam := 0; + aWorstCmpTeam := 0; + + // Compute walking distance between alliances + Distance := 0; + MinDist := High(Word); + MaxDist := 0; + SetLength(DistArr, Length(fAlli2PL)); + SetLength(TargetPL, Length(fAlli2PL)); + for TeamIdx := Low(fAlli2PL) to High(fAlli2PL) do + begin + DistArr[TeamIdx] := High(Word); + if (TeamIdx <> aTeam) AND IsTeamAlive(TeamIdx) then + begin + ECnt := FindTargetAssets(TeamIdx, ATargetSoldiers, EnemyPoly); + if (ECnt <= 0) then + Continue; + for K := Low(AllyPoly) to High(AllyPoly) do + if (AllyPoly[K] > 0) then + for L := Low(EnemyPoly) to High(EnemyPoly) do + if (EnemyPoly[L] > 0) AND gAIFields.NavMesh.Pathfinding.ShortestPolygonRoute(AllyPoly[K], EnemyPoly[L], Distance, RoutePoly) then + begin + if (DistArr[TeamIdx] > Distance) then + begin + DistArr[TeamIdx] := Distance; + TargetPL[TeamIdx] := L; + end; + end; + if (DistArr[TeamIdx] = High(Word)) then + Continue; + Result := True; + MinDist := Min(MinDist, DistArr[TeamIdx]); + MaxDist := Max(MaxDist, DistArr[TeamIdx]); + end; + end; + + // Compute comparison + DistCoef := IfThen(FFA, DISTANCE_COEF_FFA, DISTANCE_COEF_1v1); + for TeamIdx := Low(fAlli2PL) to High(fAlli2PL) do + if (DistArr[TeamIdx] <> High(Word)) then + begin + Comparison := + gAIFields.Eye.ArmyEvaluation.CompareAllianceStrength(fAlli2PL[aTeam], fAlli2PL[TeamIdx]) + - (DistArr[TeamIdx] - MinDist) / Max(1,(MaxDist - MinDist)); + aAvrgCmp := aAvrgCmp + Comparison; + if (Comparison >= aBestCmp) then + begin + aBestCmp := Comparison; + aBestCmpTeam := TeamIdx; + aBestTarget := TargetPL[TeamIdx]; + end; + if (Comparison <= aWorstCmp) then + begin + aWorstCmp := Comparison; + aWorstCmpTeam := TeamIdx; + end; + end; + aAvrgCmp := aAvrgCmp / Max(1,Length(fAlli2PL)-1); + end; + +const + MIN_DEF_RATIO = 1.2; + MIN_ADVANTAGE = 0.15; // 15% advantage for attacker +var + FoodProblems: Boolean; + BestCmpTeam, WorstCmpTeam: Byte; + IdxPL: Integer; + DefRatio, BestCmp, AvrgCmp, WorstCmp: Single; + PL, PL2, BestTarget: TKMHandID; + AR: TKMAttackRequest; +begin + if not NewAIInTeam(aTeam, True, False) OR not IsTeamAlive(aTeam) OR (Length(fAlli2PL) < 2) then // I sometimes use my loc as a spectator (alliance with everyone) so make sure that search for enemy will use AI loc + Exit; + // Check if alliance can attack (have available soldiers) in the FFA mode (if there are just 2 teams attack if we have advantage) + if FFA AND not gGameParams.IsTactic then + begin + DefRatio := 0; + for IdxPL := 0 to Length( fAlli2PL[aTeam] ) - 1 do + with gHands[ fAlli2PL[aTeam, IdxPL] ] do + if IsComputer AND AI.Setup.NewAI AND AI.Setup.AutoAttack then + begin + DefRatio := Max(DefRatio, AI.ArmyManagement.Defence.DefenceStatus); + KMSwapInt(fAlli2PL[aTeam, 0], fAlli2PL[aTeam, IdxPL]); // Make sure that player in first index is new AI + end; + // AI does not have enough soldiers + if (DefRatio < MIN_DEF_RATIO) then + Exit; + end; + // Try to find enemies, find best comparison - value in interval <-1,1>, positive value = advantage, negative = disadvantage + if CompareAlliances(BestCmpTeam, WorstCmpTeam, BestCmp, AvrgCmp, WorstCmp, BestTarget) then + begin + // Consider food + FoodProblems := gAIFields.Eye.ArmyEvaluation.CheckFoodProblems(fAlli2PL[aTeam]); + // Make decision + if (BestCmp > MIN_ADVANTAGE) OR (FoodProblems AND (fCombatStatus[fAlli2PL[aTeam,0],fAlli2PL[aTeam,0]] = csNeutral)) OR gGameParams.IsTactic then + begin + with AR do + begin + Active := True; + FFA := fFFA; + FoodShortage := FoodProblems; + BestAllianceCmp := BestCmp; + WorstAllianceCmp := WorstCmp; + BestEnemy := BestTarget; + SetLength(Enemies, Length(fAlli2PL[BestCmpTeam]) ); + Move(fAlli2PL[BestCmpTeam,0], Enemies[0], SizeOf(Enemies[0])*Length(Enemies)); + end; + for PL in fAlli2PL[aTeam] do + if gHands[PL].AI.Setup.AutoAttack then + begin + gHands[PL].AI.ArmyManagement.AttackRequest := AR; + if gGameParams.IsTactic then + fCombatStatus[PL,BestTarget] := csAttackingEverything + else + fCombatStatus[PL,BestTarget] := csAttackingCity; + end; + end; + // Stop attack if food problem was solved + if (BestCmp < MIN_ADVANTAGE) AND not FoodProblems AND not gGameParams.IsTactic then + begin + for PL in fAlli2PL[aTeam] do + if gHands[PL].AI.Setup.AutoAttack then + for PL2 := 0 to MAX_HANDS - 1 do + if (fCombatStatus[PL,PL2] = csAttackingCity) OR (fCombatStatus[PL,PL2] = csAttackingEverything) then + fCombatStatus[PL,PL2] := csNeutral; + end; + end; +end; + + +procedure TKMSupervisor.UpdateDefPos(aTeam: Byte); +type + TKMDistDefPos = array[0..MAX_HANDS-1] of record + Count: Word; + DefPos: array of PDefencePosition; + end; + + procedure DivideDefences(var aOwners: TKMHandIDArray; var aDefPosReq: TKMWordArray; var aTeamDefPos: TKMTeamDefPos); + const + DISTANCE_PRICE = 1; + FRONT_LINE_PRICE = 40; + var + Line: Byte; + I, K, PolyIdx, IdxPL, Cnt: Integer; + Point: TKMPoint; + DistributedPos: TKMDistDefPos; + DefEval: TKMDefEvalArr; + CenterPoints, Points: TKMPointArray; + begin + // Find center points + SetLength(CenterPoints, Length(aOwners)); + for IdxPL := 0 to Length(aOwners) - 1 do + begin + gAIFields.Eye.OwnerUpdate( aOwners[IdxPL] ); + Points := gAIFields.Eye.GetCityCenterPoints(False); + CenterPoints[IdxPL] := Points[0]; + end; + // Set Length + Cnt := 0; + for I := 0 to Length(aTeamDefPos) - 1 do + Inc(Cnt, Length(aTeamDefPos[I].DefPosArr)*Length(aTeamDefPos[I].Owners)); + SetLength(DefEval,Cnt); + // Evaluate defences (price of each defence depends on potential owner) + Cnt := 0; + for I := 0 to Length(aTeamDefPos) - 1 do + with aTeamDefPos[I] do + for K := 0 to Length(DefPosArr) - 1 do + begin + PolyIdx := DefPosArr[K].Polygon; + Line := DefPosArr[K].Line; + Point := DefPosArr[K].DirPoint.Loc; + DefPosArr[K].Weight := 0; // Mark defence as available + for IdxPL := 0 to Length(Owners) - 1 do + begin + DefEval[Cnt].Owner := Owners[IdxPL]; + DefEval[Cnt].Val := + 64000 // Base price + + gAIFields.Influences.OwnPoly[Owners[IdxPL], PolyIdx] // Max + 255 + - KMDistanceAbs(CenterPoints[IdxPL], Point) * DISTANCE_PRICE + - Line * FRONT_LINE_PRICE; + DefEval[Cnt].DefPos := @DefPosArr[K]; + Inc(Cnt); + end; + end; + if (Length(DefEval) > 0) then + begin + // Sort by evaluation + SortCustom(DefEval[0], Low(DefEval), Cnt-1, SizeOf(DefEval[0]), CompareDef); + // Prepare output array + for I := 0 to Length(aOwners) - 1 do + with DistributedPos[ aOwners[I] ] do + begin + Count := 0; + SetLength(DefPos, aDefPosReq[I]); + end; + // Split defences between players + for I := Length(DefEval) - 1 downto 0 do + if (DefEval[I].DefPos^.Weight = 0) then + with DistributedPos[ DefEval[I].Owner ] do + if (Count < Length(DefPos)) then + begin + DefEval[I].DefPos^.Weight := Max(0, DefEval[I].Val - gAIFields.Influences.GetBestAllianceOwnership(DefEval[I].Owner, DefEval[I].DefPos.Polygon, atAlly) * 50); // Copy price for defense but try to keep soldier out of ally city + DefPos[ Count ] := DefEval[I].DefPos; + Inc(Count); + end; + // Send defences to owner + for I := 0 to Length(aOwners) - 1 do + with gHands[ aOwners[I] ] do + if IsComputer AND AI.Setup.NewAI AND AI.Setup.AutoDefend then + AI.ArmyManagement.Defence.UpdateDefences(DistributedPos[ aOwners[I] ].Count, DistributedPos[ aOwners[I] ].DefPos); + end; + end; + +const + RESERVE_DEF_POS = 5; +var + IdxPL,Troops: Integer; + DefPosReq: TKMWordArray; + TeamDefPos: TKMTeamDefPos; +begin + if NewAIInTeam(aTeam, False, True) AND (Length(fAlli2PL) > 1) then + begin + SetLength(DefPosReq, Length( fAlli2PL[aTeam] ) ); + for IdxPL := 0 to Length(DefPosReq) - 1 do + with gHands[ fAlli2PL[aTeam, IdxPL] ] do + begin + Troops := Byte(IsComputer) * (Stats.GetUnitQty(utRecruit) + Stats.GetArmyCount); // Consider also recruits so after peace time the AI already have prepared defences + DefPosReq[IdxPL] := Round(Troops / 8) + RESERVE_DEF_POS; // Each group have 9 troops so we need max (Troops / 9) positions + reserves + end; + SetLength(TeamDefPos,0); + gAIFields.NavMesh.Defences.FindTeamDefences(fAlli2PL[aTeam], DefPosReq, TeamDefPos); + DivideDefences(fAlli2PL[aTeam], DefPosReq, TeamDefPos); + end; +end; + + +procedure TKMSupervisor.DivideResources(); + function FindAndDivideMines(var aPlayers: TKMHandIDArray; var aMines: TKMPointArray): TKMWordArray; + const + MAX_INFLUENCE = 256; + var + K, IdxPL, IdxPL2, Cnt, PLCnt, BestPrice: Integer; + PL: TKMHandID; + PLMines,PLPossibleMines: TKMWordArray; + Mines: TKMMineEvalArr; + begin + SetLength(Result, 0); + // Init + SetLength(PLMines, Length(aPlayers)); + SetLength(PLPossibleMines, Length(aPlayers)); + FillChar(PLMines[0], SizeOf(PLMines[0]) * Length(PLMines), #0); + FillChar(PLPossibleMines[0], SizeOf(PLPossibleMines[0]) * Length(PLPossibleMines), #0); + // Get only mines in influence of alliance + Cnt := 0; + SetLength(Mines, Length(aMines)); + for K := High(aMines) downto 0 do + begin + // Evaluate point if there can be mine (in dependence on influence) + PL := gAIFields.Influences.GetBestOwner(aMines[K].X,aMines[K].Y); + for IdxPL := 0 to High(aPlayers) do + if (PL = aPlayers[IdxPL]) then + begin + PLCnt := 0; + for IdxPL2 := 0 to High(aPlayers) do // Mark players which can place mine here (by influence) + if (gAIFields.Influences.OwnPoint[aPlayers[IdxPL2], aMines[K]] > 0) then + begin + Inc(PLPossibleMines[IdxPL2]); + Inc(PLCnt); + end; + Mines[Cnt].Val := PLCnt * MAX_INFLUENCE + gAIFields.Influences.OwnPoint[PL, aMines[K]]; + Mines[Cnt].pPoint := @aMines[K]; + Inc(Cnt); + end; + end; + if (Cnt > 0) then + begin + // Sort mines by evaluation + SortCustom(Mines[0], Low(Mines), Cnt-1, SizeOf(Mines[0]), CompareMines); + // Distribute mines by evaluation and possible mine cnt per a player + for K := 0 to Cnt - 1 do // Lower index = less players can own this mine + begin + IdxPL2 := 0; + BestPrice := High(Word); + for IdxPL := 0 to High(aPlayers) do + if (gAIFields.Influences.OwnPoint[aPlayers[IdxPL], Mines[K].pPoint^] > 0) + AND (PLPossibleMines[IdxPL] + PLMines[IdxPL] < BestPrice) then + begin + BestPrice := PLPossibleMines[IdxPL] + PLMines[IdxPL]; + IdxPL2 := IdxPL; + end; + if (BestPrice <> High(Word)) then + begin + Inc(PLMines[IdxPL2]); + // Decrease possible mine cnt + for IdxPL2 := 0 to High(aPlayers) do + if (gAIFields.Influences.OwnPoint[aPlayers[IdxPL2], Mines[K].pPoint^] > 0) then + Dec(PLPossibleMines[IdxPL2]); + end; + end; + end; + Result := PLMines; + end; +var + Alli, IdxPL: Integer; + MineCnt: TKMWordArray; + GoldMines, IronMines: TKMPointArray; +begin + IronMines := gAIFields.Eye.FindSeparateMineLocs(True, htIronMine); + GoldMines := gAIFields.Eye.FindSeparateMineLocs(True, htGoldMine); + for Alli := 0 to Length(fAlli2PL) - 1 do + begin + MineCnt := FindAndDivideMines(fAlli2PL[Alli], IronMines); + if (Length(MineCnt) > 0) then + for IdxPL := 0 to Length(fAlli2PL[Alli]) - 1 do + gHands[ fAlli2PL[Alli,IdxPL] ].AI.CityManagement.Predictor.IronMineCnt := MineCnt[IdxPL]; + MineCnt := FindAndDivideMines(fAlli2PL[Alli], GoldMines); + if (Length(MineCnt) > 0) then + for IdxPL := 0 to Length(fAlli2PL[Alli]) - 1 do + gHands[ fAlli2PL[Alli,IdxPL] ].AI.CityManagement.Predictor.MaxGoldMineCnt := MineCnt[IdxPL]; + end; +end; + + +function TKMSupervisor.LogStatus(): UnicodeString; +const + STR_COLOR_WHITE = '[$FFFFFF]'; + STR_COLOR_RED = '[$0000FF]'; +var + Team, SelectedTeam, K: Integer; + Color: Cardinal; + Power: Single; + PL,PL2, Cnt: TKMHandID; + CombatStatusText: UnicodeString; +begin + Result := ''; + if not OVERLAY_AI_SUPERVISOR then + Exit; + SelectedTeam := -1; + if (gMySpectator.HandID <> HAND_NONE) then + SelectedTeam := fPL2Alli[ gMySpectator.HandID ]; + // Head + Cnt := 0; + for PL := 0 to gHands.Count-1 do + Cnt := Cnt + Byte(gHands[PL].Enabled); + Result := Format('Supervisor (%sFFA = %d%s; Teams = %d; Players = %d)',[STR_COLOR_RED, Byte(fFFA), STR_COLOR_WHITE, Length(fAlli2PL), Cnt]); + + // Diplomacy + combat status + for Team := Low(fAlli2PL) to High(fAlli2PL) do + begin + Result := Format('%s| Team %d: ',[Result,Team]); + for K := Low(fAlli2PL[Team]) to High(fAlli2PL[Team]) do + begin + PL := Alli2PL[Team,K]; + if not gHands[ Alli2PL[Team,K] ].AI.Setup.NewAI then + Result := Format('%s[$%s] PL %s %d (%d;%d), ',[Result,IntToHex(gHands[PL].FlagColor AND $FFFFFF,6),STR_COLOR_WHITE,PL,Byte(gHands[PL].Enabled),Byte(not HasAssets(PL))]); + end; + if (SelectedTeam = Team) then + begin + Result := Format('%s SELECTED TEAM',[Result]); + if gAIFields.Eye.ArmyEvaluation.CheckFoodProblems(fAlli2PL[Team]) then + Result := Format('%s %sFOOD PROBLEMS%s',[Result, STR_COLOR_RED, STR_COLOR_WHITE]); + end + else if (SelectedTeam <> -1) then + begin + Power := gAIFields.Eye.ArmyEvaluation.CompareAllianceStrength(fAlli2PL[SelectedTeam], fAlli2PL[Team]); + if (Power < -0.5) then Color := tcRed + else if (Power < -0.1) then Color := tcFuchsia + else if (Power < +0.1) then Color := tcWhite + else if (Power < +0.5) then Color := tcTeal + else Color := tcGreen; + Result := Format('%s [$%s]Power = %.2f%s',[Result, IntToHex(Color,6), Power, STR_COLOR_WHITE]); + end; + for K := Low(fAlli2PL[Team]) to High(fAlli2PL[Team]) do + if gHands[ Alli2PL[Team,K] ].AI.Setup.NewAI then + begin + PL := Alli2PL[Team,K]; + Result := Format('%s| [$%s] NewAI %s %d (E %d; D: %d)',[Result,IntToHex(gHands[PL].FlagColor AND $FFFFFF,6),STR_COLOR_WHITE,PL,Byte(gHands[PL].Enabled),Byte(not HasAssets(PL))]); + for PL2 := Low(fCombatStatus[PL]) to High(fCombatStatus[PL]) do + if (PL <> PL2) then + begin + case fCombatStatus[PL,PL2] of + csNeutral: Continue; + csDefending: CombatStatusText := 'def'; + csCounterattack: CombatStatusText := 'count att'; + csAttackingCity: CombatStatusText := 'att city'; + csAttackingEverything: CombatStatusText := 'att all'; + end; + Result := Format('%s [$%s] %s %s %d,',[Result,IntToHex(gHands[PL2].FlagColor AND $FFFFFF,6),CombatStatusText,STR_COLOR_WHITE,PL2]); + end; + end; + end; + Result := Format('%s|%s',[Result, fArmyVector.LogStatus()]); + {$IFDEF DEBUG_Supervisor} + if (gMySpectator.Selected is TKMUnitGroup) then + for K := 0 to Length(fArmyAttackDebug.Groups) - 1 do + if (TKMUnitGroup(gMySpectator.Selected) = fArmyAttackDebug.Groups[K]) then + with fArmyAttackDebug.Threat[K] do + begin + Result := Format('%s||Selected unit:| Distance ranged = %f;| Distance = %f;| Risk = %f;| Weighted count = %f;',[Result, DistRanged, Distance, Risk, WeightedCount]); + Break; + end; + {$ENDIF} +end; + + +procedure TKMSupervisor.Paint(aRect: TKMRect); +{$IFDEF DEBUG_Supervisor} + var + Owner: TKMHandID; + InRange: Boolean; + K, L, M, PL: Integer; + MaxThreat,MinThreat: Single; + G: TKMUnitGroup; + CG: TKMCombatGroup; +{$ENDIF} +begin + //EvaluateArmies(); + + {$IFDEF DEBUG_ArmyVectorField} + fArmyVector.Paint(); + {$ENDIF} + + if not OVERLAY_AI_SUPERVISOR then + Exit; + + {$IFDEF DEBUG_Supervisor} + Owner := gMySpectator.HandID; + if (Owner = HAND_NONE) then + Exit; + + MaxThreat := -1E10; + MinThreat := +1E10; + for K := 0 to Length(fArmyAttackDebug.Threat) - 1 do + begin + MaxThreat := Max(MaxThreat,fArmyAttackDebug.Threat[K].Risk); + MinThreat := Min(MinThreat,fArmyAttackDebug.Threat[K].Risk); + end; + with fCombatStatusDebug do + if (MaxThreat <> 0) then + for K := Low(TargetGroups[Owner]) to High(TargetGroups[Owner]) do + for PL := 0 to gHands.Count - 1 do + if (gHands[Owner].Alliances[PL] = atEnemy) then + for L := 0 to gHands[PL].UnitGroups.Count - 1 do + if (TargetGroups[Owner,K] = gHands[PL].UnitGroups.Groups[L]) then + begin + InRange := False; + for M := 0 to Length(fArmyAttackDebug.Groups) - 1 do + if (TargetGroups[Owner,K] = fArmyAttackDebug.Groups[M]) then + begin + G := TargetGroups[Owner,K]; + gRenderAux.CircleOnTerrain(G.Position.X, G.Position.Y, 0.5, (Round(255 - (fArmyAttackDebug.Threat[M].Risk-MinThreat)/(MaxThreat-MinThreat)*220) shl 24) OR tcRed, $11FFFFFF); + InRange := True; + break; + end; + if not InRange then + with fCombatStatusDebug.TargetGroups[Owner,K].Position do + gRenderAux.CircleOnTerrain(X, Y, 1, $10FFFFFF, $FFFFFFFF); + end; + + if (gMySpectator.Selected is TKMUnitGroup) then + begin + G := TKMUnitGroup(gMySpectator.Selected); + for PL := 0 to gHands.Count - 1 do + if (gHands[G.Owner].Alliances[PL] = atEnemy) AND gHands[PL].AI.Setup.NewAI then + for K := 0 to gHands[PL].AI.ArmyManagement.AttackNew.Count - 1 do + begin + CG := gHands[PL].AI.ArmyManagement.AttackNew.CG[K]; + if (G = CG.TargetGroup) then + gRenderAux.Line(CG.Position.X, CG.Position.Y, G.Position.X, G.Position.Y, $FF000000 OR tcRed); + end; + end; + {$ENDIF} +end; + + +{ +procedure TKMSupervisor.EvaluateArmies(); +type + TKMPGroupEvalSup = ^TKMGroupEvalSup; + TKMGroupEvalSup = record + Aggressive: Single; + Own, Nearby: TKMGroupEval; + Group, HostileGroup: TKMUnitGroup; + pHostileGroup: TKMPGroupEvalSup; + end; +const + LIM_INFLUENCE = 1/255; + LIM_CLOSEST = 15; + LIM_AGGRESSIVE = 0.5; + DIST_TOLERANCE = 8; +var + X,Y: Integer; + Alli, Enemy, IdxPL, GIdx, GIdx2, GCnt, K, Closest, Distance: Integer; + Dist: Single; + P: TKMPoint; + PL: TKMHandID; + GE: TKMGroupEval; + A: array of array of TKMGroupEvalSup; + Time: Cardinal; +begin + Time := TimeGet(); + // Compute strength of groups + SetLength(A,Length(fAlli2PL)); + for Alli := Low(fAlli2PL) to High(fAlli2PL) do + begin + GCnt := 0; + for IdxPL := Low(fAlli2PL[Alli]) to High(fAlli2PL[Alli]) do + GCnt := GCnt + gHands[ fAlli2PL[Alli,IdxPL] ].UnitGroups.Count; + if (GCnt <= 0) then + Continue; + SetLength(A[Alli], GCnt); + FillChar(A[Alli,0], SizeOf(TKMGroupEval)*GCnt, #0); + GIdx := 0; + for IdxPL := Low(fAlli2PL[Alli]) to High(fAlli2PL[Alli]) do + begin + PL := fAlli2PL[Alli,IdxPL]; + for K := 0 to gHands[PL].UnitGroups.Count - 1 do + begin + A[Alli,GIdx].Group := gHands[PL].UnitGroups[K]; + A[Alli,GIdx].Own := gAIFields.Eye.ArmyEvaluation.GroupEvaluation(A[Alli,GIdx].Group,True); + Inc(GIdx); + end; + end; + end; + for Alli := Low(A) to High(A) do + begin + // Spread influence of each group to surrounding groups + for GIdx := Low(A[Alli]) to High(A[Alli]) do + begin + for GIdx2 := Low(A[Alli]) to High(A[Alli]) do + if (GIdx2 <> GIdx) then + begin + Dist := 1 / Max(KMDistanceAbs(A[Alli,GIdx].Group.Position,A[Alli,GIdx2].Group.Position) - DIST_TOLERANCE,1); + if (Dist > 0.1) then + with A[Alli,GIdx].Nearby do + begin + Attack := Attack + A[Alli,GIdx2].own.Attack * Dist; + AttackHorse := AttackHorse + A[Alli,GIdx2].own.AttackHorse * Dist; + Defence := Defence + A[Alli,GIdx2].own.Defence * Dist; + DefenceProjectiles := DefenceProjectiles + A[Alli,GIdx2].own.DefenceProjectiles * Dist; + HitPoints := HitPoints + A[Alli,GIdx2].own.HitPoints * Dist; + end; + end; + // Compute Aggressivity of all groups = group is close to hostile unit or house + P := A[Alli,GIdx].Group.Position; + A[Alli,GIdx].Aggressive := gAIFields.Influences.GetBestAllianceOwnership(A[Alli,GIdx].Group.Owner,P.X,P.Y,atEnemy) * LIM_INFLUENCE; + Closest := High(Integer); + for Enemy := Low(A) to High(A) do + if (Alli <> Enemy) then + for GIdx2 := Low(A[Enemy]) to High(A[Enemy]) do + begin + Distance := KMDistanceAbs(P,A[Enemy,GIdx2].Group.Position); + if (Distance < Closest) then + begin + Closest := Distance; + A[Alli,GIdx].pHostileGroup := @A[Enemy,GIdx2]; + end; + end; + if (Closest < LIM_CLOSEST) then + A[Alli,GIdx].Aggressive := A[Alli,GIdx].Aggressive + 1 / Max(1,Closest - LIM_CLOSEST); + end; + end; + + // Detect problematic groups + for Alli := Low(A) to High(A) do + begin + for Enemy := Low(A) to High(A) do + if (Enemy <> Alli) then + for GIdx := Low(A[Enemy]) to High(A[Enemy]) do + if (A[Enemy,GIdx].Aggressive > LIM_AGGRESSIVE) then + begin + + end; + break; // DEBUG + end; + + Time := TimeGet() - Time; + + for Alli := Low(A) to High(A) do + for GIdx := Low(A[Alli]) to High(A[Alli]) do + begin + P := A[Alli,GIdx].Group.Position; + //gRenderAux.Quad(P.X, P.Y, $FF000000 OR tcRed); + //gRenderAux.LineOnTerrain(Company.PointPath[K+1], Company.PointPath[K], $60000000 OR tcYellow); + //gRenderAux.Line(P.X-0.5, P.Y-1, P.X-0.5, P.Y-1-A[Alli,GIdx].Attack/100, $FF000000 OR tcBlack); + // Strenght + gRenderAux.Triangle(P.X-1.5, P.Y, P.X-1.25, P.Y-A[Alli,GIdx].Own.Attack /200, P.X-1.0, P.Y, $55000000 OR tcRed); + gRenderAux.Triangle(P.X-1.5, P.Y, P.X-1.25, P.Y-A[Alli,GIdx].Own.AttackHorse /200, P.X-1.0, P.Y, $AA000000 OR tcRed); + gRenderAux.Triangle(P.X-1.0, P.Y, P.X-0.75, P.Y-A[Alli,GIdx].Own.Defence /10, P.X-0.5, P.Y, $AA000000 OR tcBlue); + gRenderAux.Triangle(P.X-1.0, P.Y, P.X-0.75, P.Y-A[Alli,GIdx].Own.DefenceProjectiles/10, P.X-0.5, P.Y, $55000000 OR tcBlue); + gRenderAux.Triangle(P.X-0.5, P.Y, P.X-0.25, P.Y-A[Alli,GIdx].Own.HitPoints /10, P.X-0.0, P.Y, $AA000000 OR tcGreen); + // Influence + gRenderAux.Triangle(P.X+0.0, P.Y, P.X+0.25, P.Y-A[Alli,GIdx].Nearby.Attack /200, P.X+0.5, P.Y, $22000000 OR tcRed); + gRenderAux.Triangle(P.X+0.0, P.Y, P.X+0.25, P.Y-A[Alli,GIdx].Nearby.AttackHorse /200, P.X+0.5, P.Y, $55000000 OR tcRed); + gRenderAux.Triangle(P.X+0.5, P.Y, P.X+0.75, P.Y-A[Alli,GIdx].Nearby.Defence /10, P.X+1.0, P.Y, $55000000 OR tcBlue); + gRenderAux.Triangle(P.X+0.5, P.Y, P.X+0.75, P.Y-A[Alli,GIdx].Nearby.DefenceProjectiles/10, P.X+1.0, P.Y, $22000000 OR tcBlue); + gRenderAux.Triangle(P.X+1.0, P.Y, P.X+1.25, P.Y-A[Alli,GIdx].Nearby.HitPoints /10, P.X+1.5, P.Y, $55000000 OR tcGreen); + end; +end; +//} + +end. diff --git a/vendor/kam_remake/src/common/KM_CommonClasses.pas b/vendor/kam_remake/src/common/KM_CommonClasses.pas new file mode 100644 index 0000000..e967a30 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_CommonClasses.pas @@ -0,0 +1,1894 @@ +unit KM_CommonClasses; +{$I KaM_Remake.inc} +interface +uses + Classes, SysUtils, KM_Points, KM_CommonTypes; + + // Delphi 11.0 Alexandria had a bug with Stream.CopyFrom for TCompressionStream + // Bug occurs only during debugging, but its quite annoying + // It was fixed in Delphi 11.1 and up + // RTLVersion111 define is used to determine Delphi 11.1. Delphi 11.1, 11.2, 11.3 all include this define, only Delphi 11.0 does not + // + // https://quality.embarcadero.com/projects/RSP/issues/RSP-35516?filter=allopenissues + // https://forum.fast-report.com/en/discussion/17186/tfrxpdfexport-ezcompressionerror-with-message-invalid-zstream-operation-in-delphi-11-2021-3 + // https://stackoverflow.com/questions/70242669/error-invalid-zstream-operation-delphi-11-0 + {$IFDEF VER350} + {$IF NOT RTLVersion111} + {$IFDEF DEBUG} + {$DEFINE NO_COMPRESSION} + {$ENDIF} + {$ENDIF} + {$ENDIF} + +type + TKMSaveStreamFormat = (ssfBinary, ssfText); + + TKMemoryStream = class(TMemoryStream) + private + fShouldBeCompressed: Boolean; // Flag to show if current stream should be compressed (either while save or load operations) + + procedure AppendNotCompressedStream(aStream: TKMemoryStream; const aMarker: string); + procedure CompressAndAppendStream(aStream: TKMemoryStream; const aMarker: string); + public + constructor Create(aShouldBeCompressed: Boolean = False); + + // Assert savegame sections + procedure CheckMarker(const aTitle: string); virtual; abstract; + procedure PlaceMarker(const aTitle: string); virtual; abstract; + + procedure ReadANSI(out aValue: string); virtual; abstract; + procedure WriteANSI(const aValue: string); virtual; abstract; + + //Ansistrings saved by PascalScript into savegame + procedure ReadHugeString(out Value: AnsiString); overload; + procedure WriteHugeString(const Value: AnsiString); overload; + + procedure ReadHugeStringW(out Value: UnicodeString); overload; + procedure WriteHugeStringW(const Value: UnicodeString); overload; + +// {$IFDEF DESKTOP} + //Legacy format for campaigns info, maxlength 65k ansichars + procedure ReadA(out Value: AnsiString); reintroduce; overload; virtual; abstract; + procedure WriteA(const Value: AnsiString); reintroduce; overload; virtual; abstract; +// {$ENDIF} +// {$IFDEF TABLET} +// //Legacy format for campaigns info, maxlength 65k ansichars +// procedure ReadA(out Value: string); reintroduce; overload; virtual; abstract; +// procedure WriteA(const Value: string); reintroduce; overload; virtual; abstract; +// {$ENDIF} + + // Unicode strings + procedure ReadW(out Value: UnicodeString); reintroduce; overload; virtual; abstract; + procedure WriteW(const Value: UnicodeString); reintroduce; overload; virtual; abstract; + + function Write(const Buffer; Count: Longint): Longint; overload; override; + + procedure Write(const Value: TKMDirection ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMPoint ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMPointW ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMPointF ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMPointDir ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMRangeInt ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMRangeSingle); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TKMRect ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Single ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Extended ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Integer ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Cardinal ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Int64 ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Byte ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Boolean ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: Word ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: ShortInt ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: SmallInt ); reintroduce; overload; virtual; abstract; + procedure Write(const Value: TDateTime ); reintroduce; overload; virtual; abstract; + + procedure Read(out Value: TKMDirection ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMPoint ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMPointW ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMPointF ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMPointDir ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMRangeInt ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMRangeSingle); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TKMRect ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Single ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Extended ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Integer ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Cardinal ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Int64 ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Byte ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Boolean ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: Word ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: ShortInt ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: SmallInt ); reintroduce; overload; virtual; abstract; + procedure Read(out Value: TDateTime ); reintroduce; overload; virtual; abstract; + + procedure ReadBytes(out Value: TBytes); + procedure WriteBytes(const Value: TBytes); + + //ZLib's decompression streams don't work with the normal TStreams.CopyFrom since + //it uses ReadBuffer. This procedure will work when Source is a TDecompressionStream + procedure CopyFromDecompression(Source: TStream); + + procedure SaveToFileCompressed(const aFileName: string; const aMarker: string); + procedure LoadFromFileCompressed(const aFileName: string; const aMarker: string); + + procedure SaveToStreamCompressed(aStream: TKMemoryStream; const aMarker: string = ''); + procedure LoadFromStreamCompressed(aStream: TKMemoryStream; const aMarker: string = ''); + + procedure AppendStream(aStream: TKMemoryStream; const aMarker: string); + procedure TrimToPosition; + + procedure LoadToStream(aStream: TKMemoryStream; const aMarker: string); + procedure LoadToStreams(aStream1, aStream2: TKMemoryStream; const aMarker1, aMarker2: string); + + function ToBase64: String; + procedure LoadFromBase64(aBase64: string); + + function ToBase64Compressed: String; + procedure LoadFromBase64Compressed(aBase64: string); + end; + + // Extended with custom Read/Write commands which accept various types without asking for their length + TKMemoryStreamBinary = class(TKMemoryStream) + public + // Assert savegame sections + procedure CheckMarker(const aTitle: string); override; + procedure PlaceMarker(const aTitle: string); override; + + procedure ReadANSI(out aValue: string); override; + procedure WriteANSI(const aValue: string); override; + +// {$IFDEF DESKTOP} + //Legacy format for campaigns info, maxlength 65k ansichars + procedure ReadA(out Value: AnsiString); override; + procedure WriteA(const Value: AnsiString); override; +// {$ENDIF} +// {$IFDEF TABLET} +// //Legacy format for campaigns info, maxlength 65k ansichars +// procedure ReadA(out Value: string); override; +// procedure WriteA(const Value: string); override; +// {$ENDIF} + + // Unicode strings + procedure ReadW(out Value: UnicodeString); override; + procedure WriteW(const Value: UnicodeString); override; + + function Write(const Buffer; Count: Longint): Longint; override; + + procedure Write(const Value: TKMDirection ); override; + procedure Write(const Value: TKMPoint ); override; + procedure Write(const Value: TKMPointW ); override; + procedure Write(const Value: TKMPointF ); override; + procedure Write(const Value: TKMPointDir ); override; + procedure Write(const Value: TKMRangeInt ); override; + procedure Write(const Value: TKMRangeSingle); override; + procedure Write(const Value: TKMRect ); override; + procedure Write(const Value: Single ); override; + procedure Write(const Value: Extended ); override; + procedure Write(const Value: Integer ); override; + procedure Write(const Value: Cardinal ); override; + procedure Write(const Value: Int64 ); override; + procedure Write(const Value: Byte ); override; + procedure Write(const Value: Boolean ); override; + procedure Write(const Value: Word ); override; + procedure Write(const Value: ShortInt ); override; + procedure Write(const Value: SmallInt ); override; + procedure Write(const Value: TDateTime ); override; + + procedure Read(out Value: TKMDirection ); override; + procedure Read(out Value: TKMPoint ); override; + procedure Read(out Value: TKMPointW ); override; + procedure Read(out Value: TKMPointF ); override; + procedure Read(out Value: TKMPointDir ); override; + procedure Read(out Value: TKMRangeInt ); override; + procedure Read(out Value: TKMRangeSingle); override; + procedure Read(out Value: TKMRect ); override; + procedure Read(out Value: Single ); override; + procedure Read(out Value: Extended ); override; + procedure Read(out Value: Integer ); override; + procedure Read(out Value: Cardinal ); override; + procedure Read(out Value: Int64 ); override; + procedure Read(out Value: Byte ); override; + procedure Read(out Value: Boolean ); override; + procedure Read(out Value: Word ); override; + procedure Read(out Value: ShortInt ); override; + procedure Read(out Value: SmallInt ); override; + procedure Read(out Value: TDateTime ); override; + end; + + // Text writer + TKMemoryStreamText = class(TKMemoryStream) + private + fLastSection: string; + procedure WriteText(const aString: string); + public + procedure PlaceMarker(const aTitle: string); override; + + procedure WriteANSI(const aValue: string); override; + procedure WriteA(const Value: AnsiString); override; + procedure WriteW(const Value: UnicodeString); override; + + function Write(const Buffer; Count: Longint): Longint; override; + + procedure Write(const Value: TKMDirection ); override; + procedure Write(const Value: TKMPoint ); override; + procedure Write(const Value: TKMPointW ); override; + procedure Write(const Value: TKMPointF ); override; + procedure Write(const Value: TKMPointDir ); override; + procedure Write(const Value: TKMRangeInt ); override; + procedure Write(const Value: TKMRangeSingle); override; + procedure Write(const Value: TKMRect ); override; + procedure Write(const Value: Single ); override; + procedure Write(const Value: Extended ); override; + procedure Write(const Value: Integer ); override; + procedure Write(const Value: Cardinal ); override; + procedure Write(const Value: Int64 ); override; + procedure Write(const Value: Byte ); override; + procedure Write(const Value: Boolean ); override; + procedure Write(const Value: Word ); override; + procedure Write(const Value: ShortInt ); override; + procedure Write(const Value: SmallInt ); override; + procedure Write(const Value: TDateTime ); override; + + //Not implemented methods yet + procedure CheckMarker(const aTitle: string); override; + + procedure ReadANSI(out aValue: string); override; + procedure ReadA(out Value: AnsiString); override; + procedure ReadW(out Value: UnicodeString); override; + + procedure Read(out Value: TKMDirection ); override; + procedure Read(out Value: TKMPoint ); override; + procedure Read(out Value: TKMPointW ); override; + procedure Read(out Value: TKMPointF ); override; + procedure Read(out Value: TKMPointDir ); override; + procedure Read(out Value: TKMRangeInt ); override; + procedure Read(out Value: TKMRangeSingle); override; + procedure Read(out Value: TKMRect ); override; + procedure Read(out Value: Single ); override; + procedure Read(out Value: Extended ); override; + procedure Read(out Value: Integer ); override; + procedure Read(out Value: Cardinal ); override; + procedure Read(out Value: Int64 ); override; + procedure Read(out Value: Byte ); override; + procedure Read(out Value: Boolean ); override; + procedure Read(out Value: Word ); override; + procedure Read(out Value: ShortInt ); override; + procedure Read(out Value: SmallInt ); override; + procedure Read(out Value: TDateTime ); override; + end; + + + TStreamEvent = procedure (aData: TKMemoryStream) of object; + TStreamIntEvent = procedure (aData: TKMemoryStream; aSenderIndex: ShortInt) of object; + + + //todo -cPractical: Replace usages with TList + //TXStringList using integer values, instead of its String represantation, when sorted + TXStringList = class(TStringList) + protected + function CompareStrings(const S1, S2: string): Integer; override; + end; + + + //TKMList owns items and frees them when they are deleted from the list + TKMList = class(TList) + protected + //This one function is enough to free all deleted/cleared/rewritten objects + procedure Notify(Ptr: Pointer; Action: TListNotification); override; + end; + + TKMPointList = class + private + fCount: Integer; + fItems: array of TKMPoint; //0..Count-1 + function GetPoint(aIndex: Integer): TKMPoint; inline; + procedure SetPoint(aIndex: Integer; const aValue: TKMPoint); inline; //1..Count + function GetLast: TKMPoint; + function GetLen: Single; + public + constructor Create; + + property Count: Integer read fCount write fCount; + property Items[aIndex: Integer]: TKMPoint read GetPoint write SetPoint; default; + property Last: TKMPoint read GetLast; + function IsEmpty: Boolean; + property Len: Single read GetLen; + + procedure Clear; virtual; + procedure Copy(aSrc: TKMPointList); + procedure Add(const aLoc: TKMPoint); overload; virtual; + procedure Add(X, Y: Integer); overload; + procedure AddList(aList: TKMPointList); + procedure AddUnique(const aLoc: TKMPoint); + procedure AddListUnique(aList: TKMPointList); + function Remove(const aLoc: TKMPoint): Integer; virtual; + procedure Delete(aIndex: Integer); virtual; + procedure Insert(ID: Integer; const aLoc: TKMPoint); + function GetRandom(out Point: TKMPoint): Boolean; + function GetClosest(const aLoc: TKMPoint; out Point: TKMPoint): Boolean; + function Contains(const aLoc: TKMPoint): Boolean; + function IndexOf(const aLoc: TKMPoint): Integer; + procedure Inverse; + procedure SparseToDense; + function GetBounds(out Bounds: TKMRect): Boolean; + procedure SaveToStream(SaveStream: TKMemoryStream); virtual; + procedure LoadFromStream(LoadStream: TKMemoryStream); virtual; + end; + + TKMPointListArray = array of TKMPointList; + + TKMWeightedPointList = class(TKMPointList) + fWeight: array of Single; + public + procedure Add(const aLoc: TKMPoint; aWeight: Single); reintroduce; + function GetWeightedRandom(out Point: TKMPoint): Boolean; + end; + + TKMPointCenteredList = class(TKMWeightedPointList) + private + fCenter: TKMPoint; + public + constructor Create(const aCenter: TKMPoint); + procedure Add(const aLoc: TKMPoint); reintroduce; + end; + + TKMPointTagList = class(TKMPointList) + public + Tag, Tag2: array of Cardinal; //0..Count-1 + procedure Clear; override; + procedure Add(const aLoc: TKMPoint; aTag: Cardinal; aTag2: Cardinal = 0); reintroduce; virtual; + function IndexOf(const aLoc: TKMPoint; aTag: Cardinal; aTag2: Cardinal): Integer; overload; + procedure SortByTag; + function Remove(const aLoc: TKMPoint): Integer; override; + procedure Delete(aIndex: Integer); override; + procedure SaveToStream(SaveStream: TKMemoryStream); override; + procedure LoadFromStream(LoadStream: TKMemoryStream); override; + end; + + + TKMPointDirList = class //Used for finding fishing places, fighting positions, etc. + private + fItems: array of TKMPointDir; //0..Count-1 + fCount: Integer; + function GetItem(aIndex: Integer): TKMPointDir; + public + procedure Clear; + procedure Add(const aLoc: TKMPointDir); virtual; + property Count: Integer read fCount; + property Items[aIndex: Integer]: TKMPointDir read GetItem; default; + function GetRandom(out Point: TKMPointDir): Boolean; //overload; + +// function GetRandom(aCloseToLoc: TKMPoint; out Point: TKMPointDir): Boolean; overload; + procedure ToPointList(aList: TKMPointList; aUnique: Boolean); + procedure LoadFromStream(LoadStream: TKMemoryStream); virtual; + procedure SaveToStream(SaveStream: TKMemoryStream); virtual; + end; + + + TKMPointDirCenteredList = class(TKMPointDirList) + private + fCenter: TKMPoint; + fWeight: array of Single; + public + constructor Create(aCenter: TKMPoint); + procedure Add(const aLoc: TKMPointDir); override; + function GetWeightedRandom(out Point: TKMPointDir): Boolean; + end; + + + TKMPointDirTagList = class(TKMPointDirList) + public + Tag: array of Cardinal; //0..Count-1 + procedure Add(const aLoc: TKMPointDir; aTag: Cardinal); reintroduce; + procedure SortByTag; + procedure SaveToStream(SaveStream: TKMemoryStream); override; + procedure LoadFromStream(LoadStream: TKMemoryStream); override; + end; + + + TKMPointCounterList = class(TKMPointTagList) + private +// fAppearences: array of Word; + public + procedure Add(const aLoc: TKMPoint; aTag2: Cardinal = 0); reintroduce; + procedure AddNew(const aLoc: TKMPoint; aTag2: Cardinal = 0); + function GetPointsCnt(aIndex: Integer): Word; overload; + function GetPointsCnt(const aLoc: TKMPoint): Word; overload; + end; + + +implementation +uses + Math, + System.NetEncoding, + {$IFDEF FPC} zstream, {$ENDIF} + {$IFDEF WDC} ZLib, {$ENDIF} + KM_CommonUtils, KM_Defaults; + +const + // Compression level + //------------------------------------ + // Test results: + // Time Size + // clNone 110ms 26503Kb + // clFastest 227ms 3130Kb + // clDefault 803ms 2424Kb + // clMax 9995ms 2304Kb + //------------------------------------ + // clDefault is optimal by time / compression ratio factor + STREAM_COMPRESSION_LEVEL: TCompressionLevel = clDefault; + + +function GetCompressionLvl: TCompressionLevel; +begin + if FEAT_SAVE_COMPRESSION then + Result := STREAM_COMPRESSION_LEVEL + else + Result := clNone; +end; + + +{TXStringList} +//List custom comparation, using Integer value, instead of its String represantation +function TXStringList.CompareStrings(const S1, S2: string): Integer; +var + i1, i2, e1, e2: Integer; +begin + Val(S1, i1, e1); + Assert((e1 = 0) or (S1[e1] = NameValueSeparator)); + Val(S2, i2, e2); + Assert((e2 = 0) or (S2[e2] = NameValueSeparator)); + Result := CompareValue(i1, i2); +end; + + +{ TKMList } +// We were notified that the item is deleted from the list +procedure TKMList.Notify(Ptr: Pointer; Action: TListNotification); +begin + inherited; + if (Action = lnDeleted) then + TObject(Ptr).Free; +end; + + +{ TKMemoryStream } +constructor TKMemoryStream.Create(aShouldBeCompressed: Boolean = False); +begin + inherited Create; + fShouldBeCompressed := aShouldBeCompressed; +end; + + +procedure TKMemoryStream.ReadBytes(out Value: TBytes); +var + I: Word; +begin + Read(I, SizeOf(I)); + SetLength(Value, I); + if I > 0 then + Read(Pointer(Value)^, I); +end; + + +procedure TKMemoryStream.WriteBytes(const Value: TBytes); +var + I: Word; +begin + I := Length(Value); + inherited Write(I, SizeOf(I)); + if I = 0 then Exit; + inherited Write(Pointer(Value)^, I); +end; + + +procedure TKMemoryStream.AppendStream(aStream: TKMemoryStream; const aMarker: string); +begin + if aStream.fShouldBeCompressed then + CompressAndAppendStream(aStream, aMarker) + else + AppendNotCompressedStream(aStream, aMarker); +end; + + +procedure TKMemoryStream.AppendNotCompressedStream(aStream: TKMemoryStream; const aMarker: string); +begin + PlaceMarker(aMarker); + Write(aStream.fShouldBeCompressed); + Write(Cardinal(aStream.Size)); + CopyFrom(aStream, 0); +end; + + +procedure TKMemoryStream.CompressAndAppendStream(aStream: TKMemoryStream; const aMarker: string); +var + S: TKMemoryStream; + {$IFNDEF NO_COMPRESSION} + CS: TCompressionStream; + {$ENDIF} +begin + S := TKMemoryStreamBinary.Create(True); + try + {$IFDEF NO_COMPRESSION} + S.fShouldBeCompressed := False; + S.CopyFrom(aStream, 0); + {$ELSE} + CS := TCompressionStream.Create(GetCompressionLvl, S); + try + CS.CopyFrom(aStream, 0); + finally + CS.Free; + end; + {$ENDIF} + + AppendNotCompressedStream(S, aMarker); + finally + S.Free; + end; +end; + + +procedure TKMemoryStream.LoadToStream(aStream: TKMemoryStream; const aMarker: string); +var + isCompressed: Boolean; + streamSize: Cardinal; + {$IFNDEF NO_COMPRESSION} + S: TKMemoryStream; + DS: TDecompressionStream; + {$ENDIF} +begin + if Position >= Size then Exit; + + CheckMarker(aMarker); + Read(isCompressed); + Read(streamSize); + + if isCompressed then + begin + {$IFDEF NO_COMPRESSION} + raise Exception.Create('Using compression streams is not allowed! F.e. on Delphi 11 Alexandria under debug'); + {$ELSE} + S := TKMemoryStreamBinary.Create(True); + try + S.CopyFrom(Self, streamSize); + S.Position := 0; + DS := TDecompressionStream.Create(S); + try + aStream.CopyFromDecompression(DS); + aStream.Position := 0; + finally + DS.Free; + end; + finally + S.Free; + end; + {$ENDIF} + end + else + begin + aStream.CopyFrom(Self, streamSize); + aStream.Position := 0; + end; +end; + + +procedure TKMemoryStream.LoadToStreams(aStream1, aStream2: TKMemoryStream; const aMarker1, aMarker2: string); +begin + LoadToStream(aStream1, aMarker1); + LoadToStream(aStream2, aMarker2); +end; + + +function TKMemoryStream.ToBase64: String; +var + Encoding: TBase64Encoding; +begin + Result := ''; + {$IFDEF WDC} + Encoding := TBase64Encoding.Create(0); + try + Result := Encoding.EncodeBytesToString(Memory, Size); + finally + Encoding.Free; + end; + {$ENDIF} + {$IFDEF FPC} + // Not supported yet (no support was needed yet) + {$ENDIF} +end; + + +function TKMemoryStream.ToBase64Compressed: String; +var + compStream: TKMemoryStream; +begin + compStream := TKMemoryStreamBinary.Create; + try + SaveToStreamCompressed(compStream); + Result := compStream.ToBase64; + finally + compStream.Free; + end; +end; + + + +procedure TKMemoryStream.LoadFromBase64(aBase64: string); +{$IFDEF WDC} +var + Bytes: TBytes; + Encoding: TBase64Encoding; +{$ENDIF} +begin + {$IFDEF WDC} + Encoding := TBase64Encoding.Create(0); + try + Bytes := Encoding.DecodeStringToBytes(aBase64); + WriteData(Bytes, Length(Bytes)); + Position := 0; + finally + Encoding.Free; + end; + {$ENDIF} + {$IFDEF FPC} + // Not supported yet (no support was needed yet) + {$ENDIF} +end; + + +procedure TKMemoryStream.LoadFromBase64Compressed(aBase64: string); +var + compStream: TKMemoryStream; +begin + compStream := TKMemoryStreamBinary.Create; + try + compStream.LoadFromBase64(aBase64); + LoadFromStreamCompressed(compStream); + finally + compStream.Free; + end; +end; + + +// Set size to current position +procedure TKMemoryStream.TrimToPosition; +begin + SetSize(Position); +end; + + +procedure TKMemoryStream.CopyFromDecompression(Source: TStream); +const + MAX_BUF_SIZE = $F000; +var + count: Integer; + buffer: PByte; +begin + Source.Position := 0; + GetMem(buffer, MAX_BUF_SIZE); + try + count := Source.Read(buffer^, MAX_BUF_SIZE); + while count > 0 do + begin + WriteBuffer(buffer^, count); + count := Source.Read(buffer^, MAX_BUF_SIZE); + end; + finally + FreeMem(buffer, MAX_BUF_SIZE); + end; +end; + + +procedure TKMemoryStream.SaveToFileCompressed(const aFileName: string; const aMarker: string); +var + S: TKMemoryStream; +begin + S := TKMemoryStreamBinary.Create; + try + SaveToStreamCompressed(S, aMarker); + S.SaveToFile(aFileName); + finally + S.Free; + end; +end; + + +procedure TKMemoryStream.LoadFromFileCompressed(const aFileName: string; const aMarker: string); +var + S: TKMemoryStream; +begin + S := TKMemoryStreamBinary.Create; + try + S.LoadFromFile(aFileName); + LoadFromStreamCompressed(S, aMarker); + finally + S.Free; + end; +end; + + +procedure TKMemoryStream.SaveToStreamCompressed(aStream: TKMemoryStream; const aMarker: string = ''); +{$IFNDEF NO_COMPRESSION} +var + CS: TCompressionStream; +{$ENDIF} +begin + if aMarker <> '' then + aStream.PlaceMarker(aMarker); + {$IFDEF NO_COMPRESSION} + aStream.CopyFrom(Self, 0); + {$ELSE} + CS := TCompressionStream.Create(GetCompressionLvl, aStream); + try + CS.CopyFrom(Self, 0); + finally + CS.Free; + end; + {$ENDIF} +end; + + +procedure TKMemoryStream.LoadFromStreamCompressed(aStream: TKMemoryStream; const aMarker: string = ''); +{$IFNDEF NO_COMPRESSION} +var + DS: TDecompressionStream; +{$ENDIF} +begin + if aMarker <> '' then + aStream.CheckMarker(aMarker); + {$IFDEF NO_COMPRESSION} + CopyFrom(aStream, aStream.Size - aStream.Position); + {$ELSE} + DS := TDecompressionStream.Create(aStream); + try + CopyFromDecompression(DS); + finally + DS.Free; + end; + {$ENDIF} + Position := 0; +end; + + +{ TKMPointList } +constructor TKMPointList.Create; +begin + inherited; +end; + + +procedure TKMPointList.Clear; +begin + fCount := 0; +end; + + +procedure TKMPointList.Add(const aLoc: TKMPoint); +begin + if fCount >= Length(fItems) then + SetLength(fItems, fCount + 32); + fItems[fCount] := aLoc; + Inc(fCount); +end; + + +procedure TKMPointList.Add(X, Y: Integer); +begin + Add(TKMPoint.New(X, Y)); +end; + + +procedure TKMPointList.AddList(aList: TKMPointList); +var + I: Integer; +begin + for I := 0 to aList.Count - 1 do + Add(aList[I]); +end; + + +procedure TKMPointList.AddUnique(const aLoc: TKMPoint); +begin + if not Contains(aLoc) then + Add(aLoc); +end; + + +procedure TKMPointList.AddListUnique(aList: TKMPointList); +var + I: Integer; +begin + for I := 0 to aList.Count - 1 do + AddUnique(aList[I]); +end; + + +//Remove point from the list if is there. Return index of removed entry or -1 on failure +function TKMPointList.Remove(const aLoc: TKMPoint): Integer; +var + I: Integer; +begin + Result := -1; + + //Scan whole list to detect duplicate entries + for I := 0 to fCount - 1 do + if KMSamePoint(fItems[I], aLoc) then + Result := I; + + //Remove found entry + if (Result <> -1) then + Delete(Result); +end; + + +procedure TKMPointList.Delete(aIndex: Integer); +begin + if not InRange(aIndex, 0, Count-1) then Exit; + if (aIndex <> fCount - 1) then + Move(fItems[aIndex+1], fItems[aIndex], SizeOf(fItems[aIndex]) * (fCount - 1 - aIndex)); + Dec(fCount); +end; + + +//Insert an entry and check if list is still walkable +//Walkable means that every point is next to neighbour points } +procedure TKMPointList.Insert(ID: Integer; const aLoc: TKMPoint); +begin + Assert(InRange(ID, 0, fCount)); + + //Grow the list + if fCount >= Length(fItems) then + SetLength(fItems, fCount + 32); + + //Shift items towards end + if fCount <> 0 then + Move(fItems[ID], fItems[ID+1], SizeOf(fItems[ID]) * (fCount - ID)); + + fItems[ID] := aLoc; + Inc(fCount); +end; + + +function TKMPointList.GetRandom(out Point: TKMPoint): Boolean; +begin + Result := fCount <> 0; + if Result then + Point := fItems[KaMRandom(fCount{$IFDEF DBG_RNG_SPY}, 'TKMPointList.GetRandom'{$ENDIF})]; +end; + + +function TKMPointList.GetClosest(const aLoc: TKMPoint; out Point: TKMPoint): Boolean; +var + I: Integer; +begin + Result := fCount <> 0; + if Result then + begin + Point := fItems[0]; + for I := 1 to fCount - 1 do + if KMLengthSqr(fItems[I], aLoc) < KMLengthSqr(Point, aLoc) then + Point := fItems[I]; + end; +end; + + +function TKMPointList.Contains(const aLoc: TKMPoint): Boolean; +begin + Result := IndexOf(aLoc) <> -1; +end; + + +function TKMPointList.IndexOf(const aLoc: TKMPoint): Integer; +var + I: Integer; +begin + Result := -1; + for I := fCount - 1 downto 0 do + if KMSamePoint(aLoc, fItems[I]) then + begin + Result := I; + Break; + end; +end; + + +function TKMPointList.GetLast: TKMPoint; +begin + if IsEmpty then + raise Exception.Create('No points in list'); + Result := fItems[fCount - 1]; +end; + + +function TKMPointList.IsEmpty: Boolean; +begin + Result := fCount = 0; +end; + + +procedure TKMPointList.Copy(aSrc: TKMPointList); +begin + fCount := aSrc.Count; + SetLength(fItems, fCount); + + Move(aSrc.fItems[0], fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +function TKMPointList.GetPoint(aIndex: Integer): TKMPoint; +begin + Result := fItems[aIndex]; +end; + + +procedure TKMPointList.SetPoint(aIndex: Integer; const aValue: TKMPoint); +begin + fItems[aIndex] := aValue; +end; + + +function TKMPointList.GetLen: Single; +var + I: Integer; +begin + Result := 0; + for I := 0 to fCount - 2 do + Result := Result + KMLengthDiag(fItems[I], fItems[I + 1]); +end; + + +//Reverse the list +procedure TKMPointList.Inverse; +var + I: Integer; +begin + for I := 0 to fCount div 2 - 1 do + KMSwapPoints(fItems[I], fItems[fCount-1-I]); +end; + + +//Used in JPS pathfinding +//Take the sparse walk route with nodes in corners (A------B) +//and add all the missing nodes inbetween like so: (A123456B) +procedure TKMPointList.SparseToDense; +var + I, K, J: Integer; + tmp: array of TKMPoint; + span: Word; + C, N: ^TKMPoint; +begin + K := 0; + SetLength(tmp, 8192); + for I := 0 to fCount - 1 do + begin + tmp[K] := fItems[I]; + Inc(K); + + if (I <> fCount - 1) then + begin + C := @fItems[I]; + N := @fItems[I+1]; + span := Max(Abs(N.X - C.X), Abs(N.Y - C.Y)); + for J := 1 to span - 1 do + begin + tmp[K].X := C.X + Round((N.X - C.X) / span * J); + tmp[K].Y := C.Y + Round((N.Y - C.Y) / span * J); + Inc(K); + end; + end; + end; + + fCount := K; + SetLength(fItems, fCount); + Move(tmp[0], fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +function TKMPointList.GetBounds(out Bounds: TKMRect): Boolean; +var + I: Integer; +begin + Result := fCount <> 0; + + if Result then + begin + //Something to start with + Bounds.Left := fItems[0].X; + Bounds.Top := fItems[0].Y; + Bounds.Right := fItems[0].X; + Bounds.Bottom := fItems[0].Y; + for I := 1 to fCount - 1 do + begin + if fItems[I].X < Bounds.Left then Bounds.Left := fItems[I].X; + if fItems[I].Y < Bounds.Top then Bounds.Top := fItems[I].Y; + if fItems[I].X > Bounds.Right then Bounds.Right := fItems[I].X; + if fItems[I].Y > Bounds.Bottom then Bounds.Bottom := fItems[I].Y; + end; + end; +end; + + +procedure TKMPointList.SaveToStream(SaveStream: TKMemoryStream); +begin + SaveStream.Write(fCount); + if fCount > 0 then + SaveStream.Write(fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +procedure TKMPointList.LoadFromStream(LoadStream: TKMemoryStream); +begin + LoadStream.Read(fCount); + SetLength(fItems, fCount); + if fCount > 0 then + LoadStream.Read(fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +{ TKMWeightedPointList } +procedure TKMWeightedPointList.Add(const aLoc: TKMPoint; aWeight: Single); +begin + inherited Add(aLoc); + + if fCount >= Length(fWeight) then + SetLength(fWeight, fCount + 32); + + fWeight[fCount - 1] := aWeight; +end; + + +function TKMWeightedPointList.GetWeightedRandom(out Point: TKMPoint): Boolean; +var + I: Integer; + weightsSum, rnd: Extended; +begin + Result := False; + + if Count = 0 then + Exit; + + weightsSum := 0; + for I := 0 to fCount - 1 do + weightsSum := weightsSum + fWeight[I]; + + rnd := KaMRandomS1(weightsSum{$IFDEF DBG_RNG_SPY}, 'TKMPointCenteredList.GetWeightedRandom'{$ENDIF}); + + for I := 0 to fCount - 1 do + begin + if rnd < fWeight[I] then + begin + Point := fItems[I]; + Exit(True); + end; + rnd := rnd - fWeight[I]; + end; + Assert(False, 'Error getting weighted random'); +end; + + +{ TKMPointCenteredList } +constructor TKMPointCenteredList.Create(const aCenter: TKMPoint); +begin + inherited Create; + fCenter := aCenter; +end; + + +procedure TKMPointCenteredList.Add(const aLoc: TKMPoint); +const + BASE_VAL = 100; +var + dist, weight: Single; +begin + dist := KMLength(fCenter, aLoc); + + if dist = 0 then + weight := BASE_VAL * 2 // High weight when aLoc is in the center + else + weight := BASE_VAL / dist; // Smaller weight for distant locs + + inherited Add(aLoc, weight); +end; + + +{ TKMPointTagList } +procedure TKMPointTagList.Clear; +begin + inherited; +end; + + +procedure TKMPointTagList.Add(const aLoc: TKMPoint; aTag: Cardinal; aTag2: Cardinal = 0); +begin + inherited Add(aLoc); + + if fCount >= Length(Tag) then SetLength(Tag, fCount + 32); //Expand the list + if fCount >= Length(Tag2) then SetLength(Tag2, fCount + 32); //+32 is just a way to avoid further expansions + Tag[fCount-1] := aTag; + Tag2[fCount-1] := aTag2; +end; + + +function TKMPointTagList.IndexOf(const aLoc: TKMPoint; aTag, aTag2: Cardinal): Integer; +var + I: Integer; +begin + Result := -1; + for I := fCount - 1 downto 0 do + if KMSamePoint(aLoc, fItems[I]) and (aTag = Tag[I]) and (aTag2 = Tag2[I]) then + begin + Result := I; + Break; + end; +end; + + +function TKMPointTagList.Remove(const aLoc: TKMPoint): Integer; +begin + Result := inherited Remove(aLoc); + //Tags are moved by Delete function. No need to move them here +end; + + +procedure TKMPointTagList.Delete(aIndex: Integer); +begin + if not InRange(aIndex, 0, Count - 1) or (Count = 0) then Exit; + + inherited Delete(aIndex); + + //Note that fCount is already decreased by 1 + if (aIndex <> fCount) then + begin + Move(Tag[aIndex+1], Tag[aIndex], SizeOf(Tag[aIndex]) * (fCount - aIndex)); + Move(Tag2[aIndex+1], Tag2[aIndex], SizeOf(Tag2[aIndex]) * (fCount - aIndex)); + end; +end; + + +procedure TKMPointTagList.SaveToStream(SaveStream: TKMemoryStream); +begin + inherited; //Writes Count + + if fCount > 0 then + begin + SaveStream.Write(Tag[0], SizeOf(Tag[0]) * fCount); + SaveStream.Write(Tag2[0], SizeOf(Tag2[0]) * fCount); + end; +end; + + +procedure TKMPointTagList.SortByTag; + // Quicksort implementation (because there is not specified count of elements buble does not give any sense) + procedure QuickSort(MinIdx,MaxIdx: Integer); + var + I, K, X: Integer; + begin + I := MinIdx; + K := MaxIdx; + X := Tag[(MinIdx+MaxIdx) div 2]; + repeat + while (Tag[I] < X) do + I := I + 1; + while (X < Tag[K]) do + K := K - 1; + if (I <= K) then + begin + KMSwapPoints(fItems[I], fItems[K]); + KMSwapInt(Tag[I], Tag[K]); + KMSwapInt(Tag2[I], Tag2[K]); + I := I + 1; + K := K - 1; + end; + until (I > K); + if (MinIdx < K) then + QuickSort(MinIdx,K); + if (I < MaxIdx) then + QuickSort(I,MaxIdx); + end; + +//var I,K: Integer; +begin + // Buble sort + //for I := 0 to fCount - 1 do + // for K := I + 1 to fCount - 1 do + // if Tag[K] < Tag[I] then + // begin + // KMSwapPoints(fItems[I], fItems[K]); + // KMSwapInt(Tag[I], Tag[K]); + // KMSwapInt(Tag2[I], Tag2[K]); + // end; + if (fCount > 1) then + QuickSort(0, fCount - 1); +end; + + +procedure TKMPointTagList.LoadFromStream(LoadStream: TKMemoryStream); +begin + inherited; //Reads Count + + SetLength(Tag, fCount); + SetLength(Tag2, fCount); + if fCount > 0 then + begin + LoadStream.Read(Tag[0], SizeOf(Tag[0]) * fCount); + LoadStream.Read(Tag2[0], SizeOf(Tag2[0]) * fCount); + end; +end; + + +{ TKMPointList } +procedure TKMPointDirList.Clear; +begin + fCount := 0; +end; + + +procedure TKMPointDirList.Add(const aLoc: TKMPointDir); +begin + if fCount >= Length(fItems) then + SetLength(fItems, fCount + 32); + fItems[fCount] := aLoc; + inc(fCount); +end; + + +function TKMPointDirList.GetItem(aIndex: Integer): TKMPointDir; +begin + Assert(InRange(aIndex, 0, fCount - 1)); + Result := fItems[aIndex]; +end; + + +function TKMPointDirList.GetRandom(out Point: TKMPointDir):Boolean; +begin + Result := False; + if fCount > 0 then + begin + Point := fItems[KaMRandom(fCount{$IFDEF DBG_RNG_SPY}, 'TKMPointDirList.GetRandom'{$ENDIF})]; + Result := True; + end; +end; + + +procedure TKMPointDirList.ToPointList(aList: TKMPointList; aUnique: Boolean); +var + I: Integer; +begin + for I := 0 to fCount - 1 do + if aUnique then + aList.AddUnique(fItems[I].Loc) + else + aList.Add(fItems[I].Loc) +end; + + +procedure TKMPointDirList.SaveToStream(SaveStream: TKMemoryStream); +begin + SaveStream.Write(fCount); + if fCount > 0 then + SaveStream.Write(fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +procedure TKMPointDirList.LoadFromStream(LoadStream: TKMemoryStream); +begin + LoadStream.Read(fCount); + SetLength(fItems, fCount); + if fCount > 0 then + LoadStream.Read(fItems[0], SizeOf(fItems[0]) * fCount); +end; + + +{ TKMPointDirCenteredList } +constructor TKMPointDirCenteredList.Create(aCenter: TKMPoint); +begin + inherited Create; + fCenter := aCenter; +end; + + +procedure TKMPointDirCenteredList.Add(const aLoc: TKMPointDir); +const + BASE_VAL = 100; +var + len: Single; +begin + inherited; + + if fCount >= Length(fWeight) then + SetLength(fWeight, fCount + 32); + + len := KMLength(fCenter, aLoc.Loc); + //Special case when we aLoc is in the center + if len = 0 then + fWeight[fCount - 1] := BASE_VAL * 2 + else + fWeight[fCount - 1] := BASE_VAL / len; //smaller weight for distant locs +end; + + +function TKMPointDirCenteredList.GetWeightedRandom(out Point: TKMPointDir): Boolean; +var + I: Integer; + weightsSum, rnd: Single; +begin + Result := False; + + if Count = 0 then + Exit; + + weightsSum := 0; + for I := 0 to fCount - 1 do + weightsSum := weightsSum + fWeight[I]; + + rnd := KaMRandomS1(weightsSum{$IFDEF DBG_RNG_SPY}, 'TKMPointDirCenteredList.GetWeightedRandom'{$ENDIF}); + + for I := 0 to fCount - 1 do + begin + if rnd < fWeight[I] then + begin + Point := fItems[I]; + Exit(True); + end; + rnd := rnd - fWeight[I]; + end; + Assert(False, 'Error getting weighted random'); +end; + + +{ TKMPointDirTagList } +procedure TKMPointDirTagList.Add(const aLoc: TKMPointDir; aTag: Cardinal); +begin + inherited Add(aLoc); + + if fCount >= Length(Tag) then SetLength(Tag, fCount + 32); //Expand the list + Tag[fCount-1] := aTag; +end; + + +procedure TKMPointDirTagList.SortByTag; +var + I, K: Integer; +begin + for I := 0 to fCount - 1 do + for K := I + 1 to fCount - 1 do + if Tag[K] < Tag[I] then + begin + KMSwapPointDir(fItems[I], fItems[K]); + KMSwapInt(Tag[I], Tag[K]); + end; +end; + + +procedure TKMPointDirTagList.SaveToStream(SaveStream: TKMemoryStream); +begin + inherited; //Writes Count + + if fCount > 0 then + SaveStream.Write(Tag[0], SizeOf(Tag[0]) * fCount); +end; + + +procedure TKMPointDirTagList.LoadFromStream(LoadStream: TKMemoryStream); +begin + inherited; //Reads Count + + SetLength(Tag, fCount); + if fCount > 0 then + LoadStream.Read(Tag[0], SizeOf(Tag[0]) * fCount); +end; + + +{ TKMPointCounterList } +procedure TKMPointCounterList.Add(const aLoc: TKMPoint; aTag2: Cardinal = 0); +var + ind: Integer; +begin + ind := IndexOf(aLoc); + if ind <> -1 then + Tag[ind] := Tag[ind] + 1 + else + inherited Add(aLoc, 1, aTag2); +end; + + +procedure TKMPointCounterList.AddNew(const aLoc: TKMPoint; aTag2: Cardinal = 0); +begin + if Contains(aLoc) then Exit; + + inherited Add(aLoc, 1, aTag2); +end; + + +function TKMPointCounterList.GetPointsCnt(aIndex: Integer): Word; +begin + Result := Tag[aIndex]; +end; + + +function TKMPointCounterList.GetPointsCnt(const aLoc: TKMPoint): Word; +var + ind: Integer; +begin + ind := IndexOf(aLoc); + if ind = -1 then + Result := 0 + else + Result := Tag[ind]; +end; + + +{ TKMemoryStream } +procedure TKMemoryStream.ReadHugeString(out Value: AnsiString); +var + I: Cardinal; +begin + Read(I, SizeOf(I)); + SetLength(Value, I); + if I > 0 then + Read(Pointer(Value)^, I); +end; + + +procedure TKMemoryStream.WriteHugeString(const Value: AnsiString); +var + I: Cardinal; +begin + I := Length(Value); + inherited Write(I, SizeOf(I)); + if I = 0 then Exit; + inherited Write(Pointer(Value)^, I); +end; + + +procedure TKMemoryStream.ReadHugeStringW(out Value: UnicodeString); +var + I: Cardinal; +begin + Read(I, SizeOf(I)); + SetLength(Value, I); + if I > 0 then + Read(Pointer(Value)^, I * SizeOf(WideChar)); +end; + + +procedure TKMemoryStream.WriteHugeStringW(const Value: UnicodeString); +var + I: Cardinal; +begin + I := Length(Value); + inherited Write(I, SizeOf(I)); + if I = 0 then Exit; + inherited Write(Pointer(Value)^, I * SizeOf(WideChar)); +end; + + +{ TKMemoryStreamBinary } +function TKMemoryStreamBinary.Write(const Buffer; Count: Longint): Longint; +begin + Result := inherited Write(Buffer, Count); +end; + + +procedure TKMemoryStreamBinary.CheckMarker(const aTitle: string); +var + s: string; +begin + // We use only Latin for Markers, hence ANSI is fine + // But since Android does not support "AnsiString" we take "string" as input + ReadANSI(s); + Assert(s = aTitle); +end; + + +procedure TKMemoryStreamBinary.PlaceMarker(const aTitle: string); +begin + // We use only Latin for Markers, hence ANSI is fine + // But since Android does not support "AnsiString" we take "string" as input + WriteANSI(aTitle); +end; + + +procedure TKMemoryStreamBinary.ReadANSI(out aValue: string); +var + I: Word; + bytes: TBytes; +begin + aValue := ''; + inherited Read(I, SizeOf(I)); + SetLength(bytes, I); + if I = 0 then Exit; + inherited Read(bytes[0], I); + aValue := TEncoding.ANSI.GetString(bytes); +end; + + +procedure TKMemoryStreamBinary.WriteANSI(const aValue: string); +var + I: Word; + bytes: TBytes; +begin + bytes := TEncoding.ANSI.GetBytes(aValue); + I := Length(bytes); + Write(I, SizeOf(I)); + if I = 0 then Exit; + Write(bytes[0], I); +end; + + +//{$IFDEF DESKTOP} +procedure TKMemoryStreamBinary.ReadA(out Value: AnsiString); +var + I: Word; +begin + Read(I, SizeOf(I)); + SetLength(Value, I); + if I > 0 then + Read(Pointer(Value)^, I); +end; + +procedure TKMemoryStreamBinary.WriteA(const Value: AnsiString); +var + I: Word; +begin + I := Length(Value); + inherited Write(I, SizeOf(I)); + if I = 0 then Exit; + inherited Write(Pointer(Value)^, I); +end; +//{$ENDIF} + + +//{$IFDEF TABLET} +//procedure TKMemoryStream.ReadA(out Value: string); +//var I: Word; +//begin +// Read(I, SizeOf(I)); +// SetLength(Value, I); +// if I > 0 then +// Read(Pointer(Value)^, I * SizeOf(WideChar)); +//end; +// +//procedure TKMemoryStream.WriteA(const Value: string); +//var I: Word; +//begin +// I := Length(Value); +// inherited Write(I, SizeOf(I)); +// if I = 0 then Exit; +// inherited Write(Pointer(Value)^, I * SizeOf(WideChar)); +//end; +//{$ENDIF} + + +procedure TKMemoryStreamBinary.ReadW(out Value: UnicodeString); +var + I: Word; +begin + Read(I, SizeOf(I)); + SetLength(Value, I); + if I > 0 then + Read(Pointer(Value)^, I * SizeOf(WideChar)); +end; + + +procedure TKMemoryStreamBinary.WriteW(const Value: UnicodeString); +var + I: Word; +begin + I := Length(Value); + inherited Write(I, SizeOf(I)); + if I = 0 then Exit; + inherited Write(Pointer(Value)^, I * SizeOf(WideChar)); +end; + +function TKMemoryStream.Write(const Buffer; Count: Longint): Longint; +begin + Result := inherited Write(Buffer, Count); +end; + +procedure TKMemoryStreamBinary.Read(out Value: TKMDirection); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMPoint); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMPointW); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMPointF); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMPointDir); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMRangeInt); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMRangeSingle); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TKMRect); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Single); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Extended); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Integer); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Cardinal); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Int64); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Byte); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Boolean); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: Word); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: ShortInt); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: SmallInt); begin inherited Read(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Read(out Value: TDateTime); begin inherited Read(Value, SizeOf(Value)); end; + + +procedure TKMemoryStreamBinary.Write(const Value: TKMDirection); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMPoint); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMPointW); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMPointF); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMPointDir); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMRangeInt); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMRangeSingle); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TKMRect); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Single); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Extended); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Integer); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Cardinal); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Int64); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Byte); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Boolean); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: Word); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: ShortInt); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: SmallInt); begin inherited Write(Value, SizeOf(Value)); end; +procedure TKMemoryStreamBinary.Write(const Value: TDateTime); begin inherited Write(Value, SizeOf(Value)); end; + + +{ TKMemoryStreamText } +procedure TKMemoryStreamText.WriteText(const aString: string); +var + I: Word; + bytes: TBytes; +begin + bytes := TEncoding.ANSI.GetBytes(aString + ' '); + + I := Length(bytes); + inherited Write(bytes[0], I); +end; + +function TKMemoryStreamText.Write(const Buffer; Count: Longint): Longint; +begin + if Count = 1 then + WriteText(IntToHex(PByte(@Buffer)^, 2) + 'h') + else + if Count = 2 then + WriteText(IntToHex(PWord(@Buffer)^, 4) + 'h') + else + WriteText(IntToStr(Count) + 'bytes'); + Result := -1; +end; + +procedure TKMemoryStreamText.PlaceMarker(const aTitle: string); +begin + fLastSection := aTitle; + WriteText(sLineBreak + '[' + aTitle + ']' + sLineBreak); +end; + +procedure TKMemoryStreamText.WriteA(const Value: AnsiString); +begin + WriteText(UnicodeString(Value)); +end; + +procedure TKMemoryStreamText.WriteANSI(const aValue: string); +begin + WriteText(aValue); +end; + +procedure TKMemoryStreamText.WriteW(const Value: UnicodeString); +begin + WriteText(Value); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMPointDir); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMRangeInt); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMRangeSingle); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMRect); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMDirection); +begin + WriteText('Dir' + IntToStr(Ord(Value))); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMPoint); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMPointW); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: TKMPointF); +begin + WriteText(Value.ToString); +end; + +procedure TKMemoryStreamText.Write(const Value: Boolean); +begin + WriteText(BoolToStr(Value, True)); +end; + +procedure TKMemoryStreamText.Write(const Value: Word); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: ShortInt); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: SmallInt); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: Byte); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: Single); +begin + WriteText(Format('%.5f', [Value])); +end; + +procedure TKMemoryStreamText.Write(const Value: Extended); +begin + WriteText(Format('%.5f', [Value])); +end; + +procedure TKMemoryStreamText.Write(const Value: Integer); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: Cardinal); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: Int64); +begin + WriteText(IntToStr(Value)); +end; + +procedure TKMemoryStreamText.Write(const Value: TDateTime); +var + str: String; +begin + DateTimeToString(str, 'dd.mm.yyyy hh:nn:ss.zzz', Value); + WriteText(str); +end; + + +//Not implemented methods +procedure TKMemoryStreamText.CheckMarker(const aTitle: string); +begin + raise Exception.Create('MemoryStreamText.CheckMarker is not implemented yet'); +end; + +procedure TKMemoryStreamText.ReadANSI(out aValue: string); +begin + raise Exception.Create('MemoryStreamText.ReadANSI is not implemented yet'); +end; + +procedure TKMemoryStreamText.ReadA(out Value: AnsiString); +begin + raise Exception.Create('MemoryStreamText.ReadA is not implemented yet'); +end; + +procedure TKMemoryStreamText.ReadW(out Value: UnicodeString); +begin + raise Exception.Create('MemoryStreamText.ReadW is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMDirection); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMPoint); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMPointW); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMPointF); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMPointDir); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMRangeInt); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMRangeSingle); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TKMRect); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Single); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Extended); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Integer); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Cardinal); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Int64); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Byte); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Boolean); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: Word); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: ShortInt); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: SmallInt); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + +procedure TKMemoryStreamText.Read(out Value: TDateTime); +begin + raise Exception.Create('MemoryStreamText.Read is not implemented yet'); +end; + + +end. diff --git a/vendor/kam_remake/src/common/KM_CommonClassesExt.pas b/vendor/kam_remake/src/common/KM_CommonClassesExt.pas new file mode 100644 index 0000000..6880d9d --- /dev/null +++ b/vendor/kam_remake/src/common/KM_CommonClassesExt.pas @@ -0,0 +1,443 @@ +unit KM_CommonClassesExt; +{$I KaM_Remake.inc} +interface +uses + SysUtils, TypInfo, Generics.Collections, + KM_CommonClasses, KM_CommonTypes; + +type + ERuntimeTypeError = class(Exception); + + TSet = class + const + BIT_MASKS: array [0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128); + strict private + class function TypeInfo: PTypeInfo; inline; static; + class function GetCardinality(const PSet: PByteArray; const SizeOfSet(*in bytes*): Integer): Integer; inline; static; + class function GetSetToString(const PSet: PByteArray; const SizeOfSet(*in bytes*): Integer): String; static; + public + class function IsSet: Boolean; static; + class function Cardinality(const Value: T): Integer; static; + class function SetToString(const Value: T): String; static; + end; + + // List with unique elements + // Potentially very slow implementation because of 'Contains' + // (which loops through whole list when adding 1 element) + // However, we use it for Grou.UnitTypes which is at most like 4 values xD + TKMListUnique = class(TList) + public + function Add(const Value: T): Integer; reintroduce; + end; + + + TKMWeightedList = class(TList) + fWeight: array of Single; + public + procedure Add(const aValue: T; aWeight: Single); reintroduce; + function GetWeightedRandom(out aValue: T): Boolean; + end; + + TKMLimitedList = class(TList) + private + fMaxLength: Integer; + public + constructor Create(aMaxLength: Integer); + function Add(const Value: T): Integer; reintroduce; + end; + + TKMLimitedUniqueList = class(TKMLimitedList) + public + constructor Create(aMaxLength: Integer); + + function Add(const Value: T): Integer; reintroduce; + end; + + TKMEnumUtils = class + class function TryGetAs(aEnumStr: String; out aEnumValue: T): Boolean; + end; + + TKMVarValue = class + private + type + TKMVarValueType = (rcNone, rcAnsiString, rcUnicodeString, rcInteger, rcExtended, rcBoolean); + var + fType: TKMVarValueType; + fStrA: AnsiString; + fStrW: UnicodeString; + fInt: Int64; + fExtn: Extended; + fBool: Boolean; + public + constructor Create(aVarRec: TVarRec); overload; + + procedure SetByVarRec(aValue: TVarRec); + function ToVarRec: TVarRec; + + procedure Save(aStream: TKMemoryStream); + procedure Load(aStream: TKMemoryStream); + end; + + TKMVarValueList = class(TObjectList) + public + function ToVarRecArray: TKMVarRecArray; + procedure AddVarRecs(aParams: array of const); + + procedure Save(aSaveStream: TKMemoryStream); + procedure Load(aLoadStream: TKMemoryStream); + end; + + +implementation +uses + KM_CommonUtils; + + +{ TSet + + Usage: Writeln(TSet.Cardinality(Value)); + + taken from: + https://stackoverflow.com/questions/34442102/how-can-i-get-the-number-of-elements-of-any-variable-of-type-set } +class function TSet.TypeInfo: PTypeInfo; +begin + Result := System.TypeInfo(T); +end; + + +class function TSet.IsSet: Boolean; +begin + Result := TypeInfo.Kind = tkSet; +end; + + +class function TSet.GetCardinality(const PSet: PByteArray; const SizeOfSet(*in bytes*): Integer): Integer; +var + I, J: Integer; +begin + Result := 0; + for I := 0 to SizeOfSet - 1 do + for J := 0 to 7 do + if (PSet^[I] and BIT_MASKS[J]) > 0 then + Inc(Result); +end; + + +class function TSet.GetSetToString(const PSet: PByteArray; const SizeOfSet(*in bytes*): Integer): String; +var + I, J: Integer; + BaseType: PTypeInfo; +begin + Result := ''; + + BaseType := GetTypeData(TypeInfo).CompType{$IFDEF WDC}^{$ENDIF}; //FPC has PTypeInfo here, while WDC has PPTypeInfo + + for I := 0 to SizeOfSet - 1 do + for J := 0 to 7 do + if (PSet^[I] and BIT_MASKS[J]) > 0 then + begin + if Result <> '' then + Result := Result + ', '; + {$IFDEF WDC} + Result := Result + GetEnumName(BaseType, J + I*8); + {$ENDIF} + {$IFDEF FPC} + if BaseType^.Kind = tkInteger then //For some reason FPC can't return EnumName, at least for tkInteger values + Result := Result + IntToStr(J + I*8) + else + Result := Result + GetEnumName(BaseType, J + I*8); + {$ENDIF} + end; + Result := '[' + Result + ']'; +end; + + +class function TSet.Cardinality(const Value: T): Integer; +begin + if not IsSet then + raise ERuntimeTypeError.Create('Invalid type in TSet, T must be a set'); + Result := GetCardinality(PByteArray(@Value), SizeOf(Value)); +end; + + +class function TSet.SetToString(const Value: T): String; +begin + if not IsSet then + raise ERuntimeTypeError.Create('Invalid type in TSet, T must be a set'); + + Result := GetSetToString(PByteArray(@Value), SizeOf(Value)); +end; + + +{ TKMEnumUtils } +// example from https://stackoverflow.com/questions/2472487/converting-an-string-to-a-enum-type-using-tvalue +// Get enum value from enum string +class function TKMEnumUtils.TryGetAs(aEnumStr: String; out aEnumValue: T): Boolean; +var + tipInfo: PTypeInfo; + enumIntVal: Integer; + PEnumVal: Pointer; +begin + tipInfo := TypeInfo(T); + enumIntVal := GetEnumValue(tipInfo, aEnumStr); + + if enumIntVal = -1 then + Exit(False); + + PEnumVal := @enumIntVal; + aEnumValue := T(PEnumVal^); + Result := True; +end; + + +{ TKMListUnique } +function TKMListUnique.Add(const Value: T): Integer; +begin + if Contains(Value) then Exit(0); + + Result := inherited Add(Value); +end; + + +{ TKMWeightedList } +procedure TKMWeightedList.Add(const aValue: T; aWeight: Single); +begin + inherited Add(aValue); + + if Count >= Length(fWeight) then + SetLength(fWeight, Count + 32); + + fWeight[Count - 1] := aWeight; +end; + + +function TKMWeightedList.GetWeightedRandom(out aValue: T): Boolean; +var + I: Integer; + WeightsSum, Rnd: Extended; +begin + Result := False; + + if Count = 0 then + Exit; + + WeightsSum := 0; + for I := 0 to Count - 1 do + WeightsSum := WeightsSum + fWeight[I]; + + Rnd := KaMRandomS1(WeightsSum{$IFDEF DBG_RNG_SPY}, 'TKMWeightedList.GetWeightedRandom'{$ENDIF}); + + for I := 0 to Count - 1 do + begin + if Rnd < fWeight[I] then + begin + aValue := Items[I]; + Exit(True); + end; + Rnd := Rnd - fWeight[I]; + end; + Assert(False, 'Error getting weighted random'); +end; + + +{ TKMLimitedList } +constructor TKMLimitedList.Create(aMaxLength: Integer); +begin + inherited Create; + + fMaxLength := aMaxLength; +end; + + +function TKMLimitedList.Add(const Value: T): Integer; +begin + Result := inherited Add(Value); + + if Count > fMaxLength then + Delete(0); // Delete the oldest item +end; + + +{ TKMLimitedUniqueList } +constructor TKMLimitedUniqueList.Create(aMaxLength: Integer); +begin + inherited Create(aMaxLength); +end; + + +function TKMLimitedUniqueList.Add(const Value: T): Integer; +begin + if Contains(Value) then Exit(0); + + Result := inherited Add(Value); + + if Count > fMaxLength then + begin + Delete(0); // Delete the oldest item + Result := Result - 1; + end; +end; + + +{ TKMVarValue } +constructor TKMVarValue.Create(aVarRec: TVarRec); +begin + inherited Create; + + SetByVarRec(aVarRec); +end; + + +function TKMVarValue.ToVarRec: TVarRec; +begin + case fType of + rcAnsiString: begin + Result.VType := vtAnsiString; + Result.VAnsiString := Pointer(fStrA); + end; + rcUnicodeString:begin + Result.VType := vtUnicodeString; + Result.VUnicodeString := Pointer(fStrW); + end; + rcInteger: begin + Result.VType := vtInt64; + Result.VInt64 := @fInt; + end; + rcExtended: begin + Result.VType := vtExtended; + Result.VExtended := @fExtn; + end; + rcBoolean: begin + Result.VType := vtBoolean; + Result.VBoolean := fBool; + end; + else + raise Exception.Create('Unexpected type'); + end; +end; + + +procedure TKMVarValue.SetByVarRec(aValue: TVarRec); +begin + with aValue do + begin + case VType of + vtInteger: fInt := VInteger; + vtBoolean: fBool := VBoolean; + vtChar: fStrA := VChar; + vtExtended: fExtn := VExtended^; + vtInt64: fInt := VInt64^; + vtPChar: fStrA := VPChar^; + vtPWideChar: fStrW := string(VPWideChar^); + vtString: fStrA := VString^; + vtAnsiString: fStrA := AnsiString(VAnsiString); + vtUnicodeString: fStrW := string(VUnicodeString); + else + raise Exception.Create('Unexpected type'); + end; + + fType := rcNone; + case VType of + vtInteger, + vtInt64: fType := rcInteger; + vtBoolean: fType := rcBoolean; + vtExtended: fType := rcExtended; + vtChar, + vtPChar, + vtString, + vtAnsiString: fType := rcAnsiString; + vtPWideChar, + vtUnicodeString: fType := rcUnicodeString; + else + raise Exception.Create('Unexpected type'); + end; + end; +end; + + +procedure TKMVarValue.Load(aStream: TKMemoryStream); +begin + aStream.Read(fType, SizeOf(fType)); + + case fType of + rcAnsiString: aStream.ReadA(fStrA); + rcUnicodeString: aStream.ReadW(fStrW); + rcInteger: aStream.Read(fInt); + rcExtended: aStream.Read(fExtn); + rcBoolean: aStream.Read(fBool); + else + raise Exception.Create('Unexpected type'); + end; +end; + + +procedure TKMVarValue.Save(aStream: TKMemoryStream); +begin + aStream.Write(fType, SizeOf(fType)); + + case fType of + rcAnsiString: aStream.WriteA(fStrA); + rcUnicodeString: aStream.WriteW(fStrW); + rcInteger: aStream.Write(fInt); + rcExtended: aStream.Write(fExtn); + rcBoolean: aStream.Write(fBool); + else + raise Exception.Create('Unexpected type'); + end; +end; + + +{ TKMVarValueList } +procedure TKMVarValueList.AddVarRecs(aParams: array of const); +var + I: Integer; + varValue: TKMVarValue; +begin + for I := 0 to High(aParams) do + begin + varValue := TKMVarValue.Create(aParams[I]); + Add(varValue); + end; +end; + + +function TKMVarValueList.ToVarRecArray: TKMVarRecArray; +var + I: Integer; +begin + SetLength(Result, Count); + + for I := 0 to Count - 1 do + Result[I] := Items[I].ToVarRec; +end; + + +procedure TKMVarValueList.Load(aLoadStream: TKMemoryStream); +var + I, cnt: Integer; + varRec: TKMVarValue; +begin + aLoadStream.CheckMarker('VarValueList'); + aLoadStream.Read(cnt); + for I := 0 to cnt - 1 do + begin + varRec := TKMVarValue.Create; + varRec.Load(aLoadStream); + Add(varRec); + end; +end; + + +procedure TKMVarValueList.Save(aSaveStream: TKMemoryStream); +var + I: Integer; +begin + aSaveStream.PlaceMarker('VarValueList'); + aSaveStream.Write(Count); + for I := 0 to Count - 1 do + Items[I].Save(aSaveStream); +end; + + +end. + diff --git a/vendor/kam_remake/src/common/KM_CommonExceptions.pas b/vendor/kam_remake/src/common/KM_CommonExceptions.pas new file mode 100644 index 0000000..2474182 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_CommonExceptions.pas @@ -0,0 +1,29 @@ +unit KM_CommonExceptions; +{$I KaM_Remake.inc} +interface +uses + SysUtils, KM_Points; + +type + //Custom Exception that includes a TKMPoint + ELocError = class(Exception) + Loc: TKMPoint; + constructor Create(const aMsg: UnicodeString; const aLoc: TKMPoint); + end; + + // Error while game initialization + // madExcept ignores it, since we just want to show simple message instead + EGameInitError = class(Exception); + +implementation + + +{ ELocError } +constructor ELocError.Create(const aMsg: UnicodeString; const aLoc: TKMPoint); +begin + inherited Create(aMsg); + Loc := aLoc; +end; + + +end. diff --git a/vendor/kam_remake/src/common/KM_CommonGameTypes.pas b/vendor/kam_remake/src/common/KM_CommonGameTypes.pas new file mode 100644 index 0000000..e95215e --- /dev/null +++ b/vendor/kam_remake/src/common/KM_CommonGameTypes.pas @@ -0,0 +1,10 @@ +unit KM_CommonGameTypes; +{$I KaM_Remake.inc} +interface + +type + TKMProjectileType = (ptArrow, ptBolt, ptSlingRock, ptTowerRock); {ptBallistaRock, } + +implementation + +end. diff --git a/vendor/kam_remake/src/common/KM_CommonTypes.pas b/vendor/kam_remake/src/common/KM_CommonTypes.pas new file mode 100644 index 0000000..38b92c2 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_CommonTypes.pas @@ -0,0 +1,337 @@ +unit KM_CommonTypes; +{$I KaM_Remake.inc} +interface +uses + KM_Points; + +type + TKMByteSet = set of Byte; + //* Array of bytes + //Legacy support for old scripts + TByteSet = set of Byte; + + TBooleanArray = array of Boolean; + TBoolean2Array = array of array of Boolean; + TKMByteArray = array of Byte; + TKMByte2Array = array of TKMByteArray; + TKMByteSetArray = array of TKMByteSet; + PKMByte2Array = ^TKMByte2Array; + TKMWordArray = array of Word; + TKMWord2Array = array of array of Word; + PKMWordArray = ^TKMWordArray; + TKMCardinalArray = array of Cardinal; + PKMCardinalArray = ^TKMCardinalArray; + TSmallIntArray = array of SmallInt; + //* array of integer values + TIntegerArray = array of Integer; + TInteger2Array = array of array of Integer; + //* array of string values + TAnsiStringArray = array of AnsiString; + TSingleArray = array of Single; + TSingle2Array = array of array of Single; + TKMStringArray = array of string; + TKMCharArray = array of Char; + TRGB = record R,G,B: Byte end; + TRGBArray = array of TRGB; + TKMStaticByteArray = array [0..MaxInt - 1] of Byte; + PKMStaticByteArray = ^TKMStaticByteArray; + TKMVarRecArray = array of TVarRec; + + TKMEvent = procedure of object; + TPointEventSimple = procedure (const X,Y: Integer) of object; + TPointFEvent = procedure (const aPoint: TKMPointF) of object; + TBooleanEvent = procedure (aValue: Boolean) of object; + TIntegerEvent = procedure (aValue: Integer) of object; + TIntBoolEvent = procedure (aIntValue: Integer; aBoolValue: Boolean) of object; + TObjectIntegerEvent = procedure (Sender: TObject; X: Integer) of object; + TSingleEvent = procedure (aValue: Single) of object; + TAnsiStringEvent = procedure (const aData: AnsiString) of object; + TUnicodeStringEvent = procedure (const aData: UnicodeString) of object; + TUnicodeStringWDefEvent = procedure (const aData: UnicodeString = '') of object; + TUnicodeStringEventProc = procedure (const aData: UnicodeString); + TUnicode2StringEventProc = procedure (const aData1, aData2: UnicodeString); + TUnicodeStringObjEvent = procedure (Obj: TObject; const aData: UnicodeString) of object; + TUnicodeStringObjEventProc = procedure (Sender: TObject; const aData: UnicodeString); + TUnicodeStringBoolEvent = procedure (const aData: UnicodeString; aBool: Boolean) of object; + TGameStartEvent = procedure (const aData: UnicodeString; Spectating: Boolean) of object; + TResyncEvent = procedure (aSender: ShortInt; aTick: cardinal) of object; + TIntegerStringEvent = procedure (aValue: Integer; const aText: UnicodeString) of object; + TBooleanFunc = function(Obj: TObject): Boolean of object; + TBooleanWordFunc = function (aValue: Word): Boolean of object; + TBooleanStringFunc = function (const aValue: String): Boolean of object; + TBooleanFuncSimple = function: Boolean of object; + TBoolIntFuncSimple = function (aValue: Integer): Boolean of object; + TBoolCardFuncSimple = function (aValue: Cardinal): Boolean of object; + TCardinalEvent = procedure (aValue: Cardinal) of object; + TCoordDistanceFn = function (X, Y: Integer): Single; + + {$IFDEF FPC} + TProc = procedure; + {$ENDIF} + + TKMAnimLoop = packed record + Step: array [1 .. 30] of SmallInt; + Count: SmallInt; + MoveX, MoveY: Integer; + end; + PKMAnimLoop = ^TKMAnimLoop; + + TKMCursorDir = (cdNone = 0, cdForward = 1, cdBack = -1); + + TWonOrLost = (wolNone, wolWon, wolLost); + + //Menu load type - load / no load / load unsupported version + TKMGameStartMode = (gsmNoStart, gsmStart, gsmStartWithWarn, gsmNoStartWithWarn); + + TKMCustomScriptParam = (cspTHTroopCosts, cspMarketGoldPrice); + + TKMCustomScriptParamData = record + Added: Boolean; + Data: UnicodeString; + end; + + TKMImageType = (itJpeg, itPng, itBmp); + + TKMUserActionType = (uatNone, uatKeyDown, uatKeyUp, uatKeyPress, uatMouseDown, uatMouseUp, uatMouseMove, uatMouseWheel); + TKMUserActionEvent = procedure (aActionType: TKMUserActionType) of object; + + + TKMCustomScriptParamDataArray = array [TKMCustomScriptParam] of TKMCustomScriptParamData; + + TKMPlayerColorMode = (pcmNone, pcmDefault, pcmAllyEnemy, pcmTeams); + + TKMGameRevision = Word; // Word looks enough for now... + + TKMColor3f = record + R,G,B: Single; + function ToCardinal: Cardinal; + class function Generic(aIndex: Integer): TKMColor3f; static; + class function RandomWSeed(aSeed: Integer): TKMColor3f; static; + class function New(aR,aG,aB: Single): TKMColor3f; static; + class function NewB(aR,aG,aB: Byte): TKMColor3f; static; + class function NewC(aRGB: Cardinal): TKMColor3f; static; + function ToString: string; + end; + + TKMColor3b = record + R,G,B: Byte; + function ToCardinal: Cardinal; + class function New(aR,aG,aB: Byte): TKMColor3b; static; + end; + + TKMColor4f = record + R,G,B,A: Single; + class function New(aR,aG,aB,aA: Single): TKMColor4f; overload; static; + class function New(aR,aG,aB: Byte): TKMColor4f; overload; static; + class function NewB(aR,aG,aB,aA: Byte): TKMColor4f; overload; static; + class function New(aCol: Cardinal): TKMColor4f; overload; static; + class function New(aCol: TKMColor3f): TKMColor4f; overload; static; + class function New(const aCol: TKMColor3f; aAlpha: Single): TKMColor4f; overload; static; + class function White: TKMColor4f; static; + class function Black: TKMColor4f; static; + function Alpha50: TKMColor4f; + function Alpha(aAlpha: Single): TKMColor4f; + function ToColor3f: TKMColor3f; + function ToCardinal: Cardinal; + end; + + TKMColor3bArray = array of TKMColor3b; + +const + COLOR3F_WHITE: TKMColor3f = (R: 1; G: 1; B: 1); + COLOR3F_BLACK: TKMColor3f = (R: 0; G: 0; B: 0); + + COLOR4F_WHITE: TKMColor4f = (R: 1; G: 1; B: 1; A: 1); + COLOR4F_BLACK: TKMColor4f = (R: 0; G: 0; B: 0; A: 1); + +const + IMAGE_TYPE_EXT: array[TKMImageType] of string = ('.jpeg', '.png', '.bmp'); + +const + WonOrLostText: array [TWonOrLost] of UnicodeString = ('None', 'Won', 'Lost'); + + NO_SUCCESS_INT: Integer = -1; + +implementation +uses + Math, SysUtils, KM_CommonUtils; + + +{ TKMColor3f } +class function TKMColor3f.New(aR, aG, aB: Single): TKMColor3f; +begin + Result.R := aR; + Result.G := aG; + Result.B := aB; +end; + + +class function TKMColor3f.NewB(aR, aG, aB: Byte): TKMColor3f; +begin + Result.R := aR / 255; + Result.G := aG / 255; + Result.B := aB / 255; +end; + + +class function TKMColor3f.NewC(aRGB: Cardinal): TKMColor3f; +begin + Result.B := (aRGB and $FF) / 255; + Result.G := (aRGB shr 8 and $FF) / 255; + Result.R := (aRGB shr 16 and $FF) / 255; +end; + + +function TKMColor3f.ToCardinal: Cardinal; +begin + Result := (Round(R * 255) + (Round(G * 255) shl 8) + (Round(B * 255) shl 16)) {or $FF000000}; +end; + + +class function TKMColor3f.Generic(aIndex: Integer): TKMColor3f; +const + MAX_GENERIC_COLORS = 6; + GENERIC_COLORS: array [0..MAX_GENERIC_COLORS-1] of TKMColor3f = ( + (R:1.0; G:0.2; B:0.2), + (R:1.0; G:1.0; B:0.2), + (R:0.2; G:1.0; B:0.2), + (R:0.2; G:1.0; B:1.0), + (R:0.2; G:0.2; B:1.0), + (R:1.0; G:0.2; B:1.0) + ); +begin + Result := GENERIC_COLORS[aIndex mod MAX_GENERIC_COLORS]; +end; + + +class function TKMColor3f.RandomWSeed(aSeed: Integer): TKMColor3f; +begin + Result.R := KaMRandomWSeedS1(aSeed, 1); + Result.G := KaMRandomWSeedS1(aSeed, 1); + Result.B := KaMRandomWSeedS1(aSeed, 1); +end; + + +function TKMColor3f.ToString: string; +begin + Result := Format('[%d:%d:%d]', [Round(255*R), Round(255*G), Round(255*B)]); +end; + + +{ TKMColor3b } +class function TKMColor3b.New(aR, aG, aB: Byte): TKMColor3b; +begin + Result.R := aR; + Result.G := aG; + Result.B := aB; +end; + + +function TKMColor3b.ToCardinal: Cardinal; +begin + Result := (R + (G shl 8) + (B shl 16)); {or $FF000000}; +end; + + +{ TKMColor4f } +class function TKMColor4f.New(aR,aG,aB,aA: Single): TKMColor4f; +begin + Result.R := aR; + Result.G := aG; + Result.B := aB; + Result.A := aA; +end; + + +class function TKMColor4f.New(aR,aG,aB: Byte): TKMColor4f; +begin + Result.R := aR / 255; + Result.G := aG / 255; + Result.B := aB / 255; + Result.A := 1; +end; + + +class function TKMColor4f.NewB(aR,aG,aB,aA: Byte): TKMColor4f; +begin + Result.R := aR / 255; + Result.G := aG / 255; + Result.B := aB / 255; + Result.A := aA / 255; +end; + + +class function TKMColor4f.New(aCol: Cardinal): TKMColor4f; +begin + Result.R := (aCol and $FF) / 255; + Result.G := ((aCol shr 8) and $FF) / 255; + Result.B := ((aCol shr 16) and $FF) / 255; + Result.A := ((aCol shr 24) and $FF) / 255; +end; + + +class function TKMColor4f.New(aCol: TKMColor3f): TKMColor4f; +begin + Result.R := aCol.R; + Result.G := aCol.G; + Result.B := aCol.B; + Result.A := 1; +end; + + +class function TKMColor4f.New(const aCol: TKMColor3f; aAlpha: Single): TKMColor4f; +begin + Result.R := aCol.R; + Result.G := aCol.G; + Result.B := aCol.B; + Result.A := aAlpha; +end; + + +class function TKMColor4f.White: TKMColor4f; +begin + Result.R := 1; + Result.G := 1; + Result.B := 1; + Result.A := 1; +end; + + +class function TKMColor4f.Black: TKMColor4f; +begin + Result.R := 0; + Result.G := 0; + Result.B := 0; + Result.A := 1; +end; + + +function TKMColor4f.Alpha50: TKMColor4f; +begin + Result := Self; + Result.A := 0.5; +end; + + +function TKMColor4f.Alpha(aAlpha: Single): TKMColor4f; +begin + Result := Self; + Result.A := aAlpha; +end; + + +function TKMColor4f.ToColor3f: TKMColor3f; +begin + Result.R := R; + Result.G := G; + Result.B := B; +end; + + +function TKMColor4f.ToCardinal: Cardinal; +begin + Result := Round(R * 255) + (Round(G * 255) shl 8) + (Round(B * 255) shl 16) + (Round(A * 255) shl 24); +end; + + +end. diff --git a/vendor/kam_remake/src/common/KM_Defaults.pas b/vendor/kam_remake/src/common/KM_Defaults.pas new file mode 100644 index 0000000..5f48d4d --- /dev/null +++ b/vendor/kam_remake/src/common/KM_Defaults.pas @@ -0,0 +1,1130 @@ +unit KM_Defaults; +{$I KaM_Remake.inc} +interface + +// Global constants +const + MAX_MAP_SIZE = 256; + MIN_MAP_SIZE = 32; + CELL_SIZE_PX = 40; // Single cell size in pixels (width) + CELL_HEIGHT_DIV = 33.333; // Height divider, controlls terrains pseudo-3d look + TOOLBAR_WIDTH = 224; // Toolbar width in game + MAPED_TOOLBAR_WIDTH = 284; // Toolbar width in map editor + TERRAIN_PACE = 200; // Each tile gets updated once per ** ticks (100 by default), Warning, it affects field/tree growth rate + FOW_PACE = 10; // Each tile gets updated once per ** ticks (10 by default) + + MIN_FPS_CAP = 10; // Minimum FPS Cap - limit fps + DEF_FPS_CAP = 60; // Default FPS Cap + MAX_FPS_CAP = 1000; // Maximum FPS Cap (means no CAP at all) + FPS_INTERVAL = 1000; // Time in ms between FPS measurements, bigger value = more accurate result + MENU_DESIGN_X = 1024; // Thats the size menu was designed for. All elements are placed in this size + MENU_DESIGN_Y = 768; // Thats the size menu was designed for. All elements are placed in this size + RESOLUTION_WIDTH_MIN = 1024; // Lowest supported resolution X + RESOLUTION_HEIGHT_MIN = 720; // Lowest supported resolution Y + + // It would be nice to have the declaration as: + // GAME_REVISION_NUM = {$I KM_Revision.inc} + // This would also allow to disuse the initialization section down below + // However for some odd reason this kills Reys IDE .. + {$I KM_Revision.inc}; + {$I KM_NetProtocolRevision.inc}; + +const + // Anything that is a debug mechanism not intended for the Release whould be listed here, so that we know at a glance what kind of build we are having + GAME_VERSION_POSTFIX = '' + {$IFDEF DBG_SKIP_SECURE_AUTH} + ' [UNSECURE]' {$ENDIF} + {$IFDEF DEBUG} + ' [DEBUG]' {$ENDIF} + {$IFDEF WDC64} + ' [x64]' {$ENDIF} + {$IFDEF DBG_RNG_SPY} + ' [RNGSPY]' {$ENDIF} + {$IFDEF DBG_PERFLOG} + ' [PERFLOG]' {$ENDIF} + ; + + GAME_VERSION_PREFIX = ''; // Custom prefix for the test builds + GAME_VERSION_POSTFIX2 = ''; // Custom postfix for the test builds + +var + // Game revision is set in initialisation block + GAME_REVISION: AnsiString; // "r12345" Should be updated for every release (each time save format is changed) + GAME_VERSION: AnsiString; // "Prefix r12345 [ Postfix ] Postfix" Game version string displayed in menu corner + NET_PROTOCOL_REVISON: AnsiString; // "r12345" Clients of this version may connect to the dedicated server + +const + GAME_TITLE = 'Knights and Merchants Remake'; + SETTINGS_FILE = 'KaM Remake Settings.xml'; + SERVER_SETTINGS_FILE = 'KaM Remake Server Settings.ini'; + DEFAULT_LOCALE: AnsiString = 'eng'; + + MP_NICKNAME_LENGTH_MAX = 16; + + LOGS_DELETE_WHEN_OLDER_THAN = 14; // In days + + TEMPLATE_LIBX_FILE_TEXT = 'text.%s.libx'; + + DEFAULT_WATER_LIGHT_MULTIPLIER = 1.3; // Default multiplier for terrain water light + + // Max number of ticks, played on 1 game update. + // We must limit number of ticks per update to be able to leave update cycle fast (when turn off ultra fast speedup, f.e.) + // Also there is a technical limit, of how many ticks we can calculate per update + MAX_TICKS_PER_GAME_UPDATE = 100; + +{$IFDEF DEBUG} + DEBUG_CFG = True; //Debug preset for most usable debug options. ON for Debug build configuration +{$ELSE} + DEBUG_CFG = False; //Debug preset for most usable debug options. OFF for Release build configuration +{$ENDIF} + +var + // These should be True (we can occasionally turn them Off to speed up the debug) + // We keep them as `var` to keep compiler happy (otherwise it sees a lot of "unused var usage" around) + CALC_EXPECTED_TICK :Boolean = not DEBUG_CFG; //Do we calculate expected tick and try to be in-time (send as many tick as needed to get to expected tick) + DYNAMIC_TERRAIN :Boolean = True; //Update terrain each tick to grow things + CHEATS_SP_ENABLED :Boolean = True; //Enable cheats in game (add_resource, instant_win, etc) + FREE_POINTERS :Boolean = True; //If True, units/houses will be freed and removed from the list once they are no longer needed + CAP_MAX_FPS :Boolean = True; //Should limit rendering performance to avoid GPU overheating (disable to measure debug performance) + CRASH_ON_REPLAY :Boolean = True; //Crash as soon as replay consistency fails (random numbers mismatch) + BLOCK_DUPLICATE_APP :Boolean = not DEBUG_CFG; //Do not allow to run multiple games at once (to prevent MP cheating) + DO_NETWORK_AUTH :Boolean = not DEBUG_CFG; //Do network auth. If no its equivalent to use KM_NetAuthUnsecure + QUERY_ON_FORM_CLOSE :Boolean = not DEBUG_CFG; //Do we ask player about lost changes on game exit ? + RESET_DEBUG_CONTROLS :Boolean = not DEBUG_CFG; //Reset Debug controls (F11) on game start + SKIP_LOG_TEMP_COMMANDS:Boolean = True; + BLOCK_GAME_ON_PAUSE :Boolean = not DEBUG_CFG; // Should we block game input, viewport scrolling etc on game pause? + DELETE_OLD_LOGS :Boolean = not DEBUG_CFG; // Should we delete old logs? + + // Gameplay features (aka "feature flags") + // Implemented. Once the feature is implemented and adopted by the players the flag is safe to remove + FEAT_ALLOW_TO_DISMISS_UNITS :Boolean = True; // Show button to order citizens to go back to school + FEAT_SETTINGS_IN_MYDOC :Boolean = True; // Save settings in the "C:\Users\Username\My Documents\My Games\GAME_TITLE\" folder as many other games do + FEAT_UNIT_INTERACTION :Boolean = True; // Unit interaction + FEAT_AVOID_UNITS_IN_PATH :Boolean = True; // Add additional cost to tiles in A* if they are occupied by other units (IsUnit=1) + FEAT_CUSTOM_RANDOM :Boolean = True; // Use our custom random number generator instead of the "Random()" + FEAT_USE_WALKING_DISTANCE :Boolean = True; // Use the walking distance for deciding place to mine rather than direct distance + FEAT_ARCHER_RANDOM_TARGETS :Boolean = True; // Archers use random targets instead of closest + FEAT_HUNGARIAN_GROUP_ORDER :Boolean = True; // Use Hungarian algorithm to reorder warrior groups when walking + FEAT_AI_GENERATE_NAVMESH :Boolean = True; // Generate navmesh for AI to plan attacks/defenses + FEAT_AI_GENERATE_INFLUENCE :Boolean = True; // Generate influence maps for AI to plan attacks/defenses + FEAT_SAVE_COMPRESSION :Boolean = True; // Apply compression to savegame files, (disable to make them more readable) + FEAT_SFX_ADJUST_SAMPLE_RATE :Boolean = True; // Adjust SFX sample rate + + // Not fully implemented yet + FEAT_CCL_WALKCONNECT :Boolean = False; // Use CCL instead of FloodFill for walk-connect (CCL is generaly worse. It's a bit slower, counts 1 tile areas and needs more AreaIDs to work / makes sparsed IDs) + FEAT_DYNAMIC_FOG_OF_WAR :Boolean = False; // Whenever dynamic fog of war is enabled or not + CHECK_8087CW :Boolean = False; // Check that 8087CW (FPU flags) are set correctly each frame, in case some lib/API changed them + FEAT_SCROLL_ACCEL :Boolean = False; // Acceleration for viewport scrolling + PATHFINDER_TO_USE :Byte = 1; // Use TKMPathfindingAStarNew + FEAT_VIDEOS_UNDER_WINE :Boolean = False; // Enable videos under Wine + + //Cache / delivery / pathfinding + CACHE_PATHFINDING :Boolean = True; //Cache routes incase they are needed soon (Vortamic PF runs x4 faster even with lame approach) + CACHE_PATHFINDING_AVOID_LOCKED :Boolean = True; //Cache unsuccesfull tries to find route with avoid locked (as non walkable) + DELIVERY_BID_CALC_USE_PATHFINDING :Boolean = True; //Do we use simple distance on map or pathfinding for calc delivery bids cost? + {$IFDEF WDC} //Work only in Delphi + CACHE_DELIVERY_BIDS: Boolean = True; //Cache delivery bids cost. Must be turned ON if we want to use pathfinding for bid calc, huge impact on performance in that case + {$ENDIF} + UPDATE_DELIVERY_MODE_IMMEDIATELY: Boolean = DEBUG_CFG; // Do we update house delivery mode immediately ? + + WARFARE_ORDER_SEQUENTIAL :Boolean = True; //Pick weapon orders like KaM did + WARFARE_ORDER_PROPORTIONAL :Boolean = False; //New proportional way (looks like a bad idea) + + //These are debug things, should be False + {Runner} + {$IFDEF PARALLEL_RUNNER} + THREAD_NUMBER :Word = 1; // Thread number for parallel runner and saves + {$ENDIF} + DEFAULT_PEACE_TIME :Word = 0; //Default peacetime for SP games when SP_DEFAULT_ADVANCED_AI set to True + {AI} + SP_BOOST_AI_BUILD :Boolean = False; //Boost build algorithm of the new AI (performance impact) + SP_DEFAULT_ADVANCED_AI :Boolean = False; //Set advanced AI as default for SP games + {User interface options} + DEBUG_SPEEDUP_SPEED :Integer = 300; //Speed for speedup from debug menu + DEBUG_LOGS :Boolean = True; //Log debug info + DEBUG_SCRIPTING_EXEC :Boolean = False; //Use slow debug executor (about 3 times slower! never use on release version). Using it we can find exact position of execution time error (row/col/pos/module) + USE_KMR_DIR_FOR_SETTINGS:Boolean = DEBUG_CFG; // Do we use KMR local directory for settings? + SKIP_RNG_CHECKS_FOR_SOME_GIC: Boolean = True; //Skip rng checks for Autosave and few other commands to have same AI city with predefined seed + mapconfig + ALLOW_SELECT_ALLIES :Boolean = True; //Do we allow to select ally units or groups + ALLOW_SELECT_ALL :Boolean = DEBUG_CFG; //Do we allow to select all entities (allies and enemies) + DBG_SHOW_EXACT_WARE_COUNT :Boolean = DEBUG_CFG; // Do we show resource amount with K postfix (10123 -> 10k) + DBG_SKIP_SAVE_POINTS_TO_FILE :Boolean = False; // Skip save game savepoints (into .spt file) + DBG_GAME_SAVE_STRIP_FOR_CRC :Boolean = False; // Strip unsynced data from Game saves, to compare saves CRC + ALLOW_LOAD_UNSUP_VERSION_SAVE: + Boolean = DEBUG_CFG; //Allow to try load saves / replay with unsupported version + + DBG_LOG_SETTINGS_SAVE_CALLSTACK :Boolean = True; //todo: DEBUG. Remove after bugfix + DBG_DISALLOW_TO_SAVE_RANDOM_CHECKS :Boolean = False; // Forbid saving of random checks data in to separate file (used by Runner) + DBG_NET_RANDOM_CHECK_EVERY_TICK :Boolean = True; //todo: DEBUG. Remove in release, no need to check on every tick in release version + + DBG_KILL_GROUP_BUTTON :Boolean = DEBUG_CFG; // The button to kill group + DBG_KILL_UNIT_BUTTON :Boolean = DEBUG_CFG; // Show unit 'Kill' button + DBG_SAVE_GAME_AS_TEXT :Boolean = True; {Save game serialized} //todo: DEBUG. set to False before releases + + SHOW_ENEMIES_STATS :Boolean = False; //Do we allow to show enemies stats during the game + SHOW_CONTROLS_OVERLAY :Boolean = False; //Draw colored overlays ontop of controls! always Off here + SHOW_CONTROLS_ID :Boolean = False; //Draw controls ID + SHOW_FOCUSED_CONTROL :Boolean = False; //Outline focused control + SHOW_CONTROL_OVER :Boolean = False; //Outline control with mouse over + SHOW_TEXT_OUTLINES :Boolean = False; //Display text areas outlines + SKIP_RENDER_TEXT :Boolean = False; //Skip painting labels + ENABLE_DESIGN_CONTORLS :Boolean = False; //Enable special mode to allow to move/edit controls + MODE_DESIGN_CONTROLS :Boolean = False; //Special mode to move/edit controls activated by F7, it must block OnClick events! always Off here + DBG_UI_HINT_POS :Boolean = False; //Show coordinates near cursor, with axis + + OVERLAY_RESOLUTIONS :Boolean = False; //Render constraining frame + LOCAL_SERVER_LIST :Boolean = False; //Instead of loading server list from master server, add localhost:56789 (good for testing) + SHOW_LOG_IN_CHAT :Boolean = False; //Show log messages in MP game chat + LOG_GAME_TICK :Boolean = False; //Log game tick + {Gameplay display} + SHOW_UNITS_IN_HOUSE :Boolean = False; //Should we hide units when they are in house ? + IGNORE_MOUSE_SCROLLING :Boolean = False; //Ignore mouse scrolling + SKIP_RENDER :Boolean = False; //Skip all the rendering in favor of faster logic + DO_NOT_SKIP_LOAD_TILESET:Boolean = False; //Do not skip load tileset even if SKIP_RENDER is set + SKIP_SOUND :Boolean = False; //Skip all the sounds in favor of faster logic + SKIP_LOADING_CURSOR :Boolean = False; //Skip loading and setting cursor + SKIP_SETTINGS_SAVE :Boolean = False; //Skip save main/game settings into the ini file +// SKIP_POINTER_REF_CHECK :Boolean = False; //Skip Pointer reference check (gGame.AllowGetPointer) + AGGRESSIVE_REPLAYS :Boolean = True; //Write a command gicTempDoNothing every tick in order to find exactly when a replay mismatch occurs + SHOW_GAME_TICK :Boolean = DEBUG_CFG; //Show game tick next to game time + SHOW_FPS :Boolean = False; //Show FPS + SHOW_TERRAIN_IDS :Boolean = False; //Show number of every tile terrain on it (also show layers terrain ids) + SKIP_TER_RENDER_ANIMS :Boolean = False; //Skip render terrain animations + SKIP_TER_RENDER_LIGHT :Boolean = False; //Skip render terrain lighting + SKIP_TER_RENDER_SHADOW :Boolean = False; //Skip render terrain shadows + DO_DEBUG_TER_RENDER :Boolean = False; //Do we do debug terrain layers? If yes, then only chosen terrain layers will be rendered + DEBUG_TERRAIN_LAYERS :set of Byte = [0,1,2,3]; //Terrain layers to render while debugging with DO_DEBUG_LAYERS + SKIP_RENDER_TER_LAYERS :Boolean = False; //Do not render terrain layers + SHOW_TERRAIN_KINDS :Boolean = False; //Show terrain kind ids on every tile corner + SHOW_TERRAIN_OVERLAYS :Boolean = False; //Show terrain tile overlays + SHOW_TERRAIN_HEIGHT :Boolean = False; //Show terrain tile overlays + SHOW_TERRAIN_TILES_GRID :Boolean = False; //Show terrain tiles grid + SHOW_BRUSH_APPLY_AREA :Boolean = False; //Show brushes apply area + SHOW_TERRAIN_WIRES :Boolean = False; //Makes terrain height visible + SHOW_TERRAIN_PASS :Byte = 0; //Byte(TKMTerrainPassability) + SHOW_UNIT_ROUTES :Boolean = False; //Draw unit routes + SHOW_UNIT_ROUTES_STEPS :Boolean = False; //Draw unit routes step numbers + SHOW_SEL_BUFFER :Boolean = False; //Display selection buffer + SHOW_PROJECTILES :Boolean = False; //Shows projectiles trajectory + SHOW_POINTER_DOTS :Boolean = False; //Show pointer count as small dots below unit/houses + SHOW_GROUND_LINES :Boolean = False; //Show a line below all sprites to mark the ground height used in Z-Order + SHOW_UNIT_MOVEMENT :Boolean = False; //Draw unit movement overlay (occupied tile), Only if unit interaction enabled + SHOW_VIEWPORT_POS :Boolean = False; //Draw viewport position + SHOW_JAM_METER :Boolean = False; //Show jam meter value on terrain + SHOW_TILE_OBJECT_ID :Boolean = False; //Show tiles object ID + SHOW_TILES_OWNER :Boolean = False; //Show tiles owner + SHOW_TREE_AGE :Boolean = False; //Show tiles tree age + SHOW_FIELD_AGE :Boolean = False; //Show tiles field age + SHOW_TILE_LOCK :Boolean = False; //Show tiles lock + SHOW_TILE_UNIT :Boolean = False; //Show tiles units + SHOW_VERTEX_UNIT :Boolean = False; //Show vertex unit (if vertex is occupied) + SHOW_UIDs :Boolean = False; //Show units/groups/houses UIDs + SHOW_WALK_CONNECT :Boolean = False; //Show floodfill areas of interconnected areas + SHOW_GROUP_MEMBERS_POS :Boolean = False; //Show group members position + TEST_VIEW_CLIP_INSET :Boolean = False; //Renders smaller area to see if everything gets clipped well + OUTLINE_ALL_SPRITES :Boolean = False; //Render outline around every sprite + SHOW_ATTACK_RADIUS :Boolean = False; //Render towers/archers attack radius + DISPLAY_SOUNDS :Boolean = False; //Display sounds on map + RENDER_3D :Boolean = False; //Experimental 3D render + LINEAR_FILTER_SPRITES :Boolean = False; //To check pixel sampling alignment issues (bouncing) at 100% zoom + HOUSE_BUILDING_STEP :Single = 0; + WATER_LIGHT_MULTIPLIER :Single = DEFAULT_WATER_LIGHT_MULTIPLIER; //Terrain light multiplier + OVERLAY_NAVMESH :Boolean = False; //Show navmesh + OVERLAY_HIGHLIGHT_POLY :Integer = 0; //Highlight plygon in navmesh + OVERLAY_DEFENCES :Boolean = False; //Show AI defence perimeters + OVERLAY_DEFENCES_A :Boolean = False; //Show AI defence perimeters (Animation) + OVERLAY_INFLUENCE :Boolean = False; //Show influence map + OVERLAY_OWNERSHIP :Boolean = False; //Show ownership map + OVERLAY_AVOID :Boolean = False; //Show avoidance map + OVERLAY_AI_BUILD :Boolean = False; //Show build progress of new AI + OVERLAY_AI_COMBAT :Boolean = False; //Show combat marks of new AI + OVERLAY_AI_PATHFINDING :Boolean = False; //Show combat marks of new AI + OVERLAY_AI_EYE :Boolean = False; //Show Eye vision of new AI + OVERLAY_AI_SOIL :Boolean = False; //Show Soil vision of new AI + OVERLAY_AI_FLATAREA :Boolean = False; //Show FlatArea vision of new AI + OVERLAY_AI_ROUTES :Boolean = False; //Show Routes to resources vision of new AI + OVERLAY_AI_SUPERVISOR :Boolean = False; //Show Supervisor vision of new AI + OVERLAY_AI_VEC_FLD_ENEM :Boolean = False; //Show Vector field of enemy (combat AI) + OVERLAY_AI_VEC_FLD_ALLY :Boolean = False; //Show Vector field of ally (combat AI) + OVERLAY_AI_CLUSTERS :Boolean = False; //Show combat clusters (combat AI) + OVERLAY_AI_ALLIEDGROUPS :Boolean = False; //Show show allied groups (combat AI) + {Render} + SAVE_MAP_TO_FBO_RENDER :Boolean = False; //Do Render is performed into FBO off-screen buffer? + {Stats} + SHOW_SPRITE_COUNT :Boolean = False; //display rendered controls/sprites count + SHOW_POINTER_COUNT :Boolean = False; //Show debug total count of unit/house pointers being tracked + SHOW_CMDQUEUE_COUNT :Boolean = False; //Show how many commands were processed and stored by TGameInputProcess + SHOW_NETWORK_DELAY :Boolean = False; //Show the current delay in multiplayer game + SHOW_ARMYEVALS :Boolean = False; //Show result of enemy armies evaluation + SHOW_AI_WARE_BALANCE :Boolean = False; //Show wares balance (Produced - Consumed) + SHOW_NET_PACKETS_STATS :Boolean = False; //Show network packet statistics + SHOW_NET_PACKETS_LIMIT :Integer = 1; + SHOW_SELECTED_OBJ_INFO :Boolean = False; //Show selected object (Unit/Group + Unit/House) data (UID/order/action etc) + SHOW_HANDS_INFO :Boolean = False; //Show hands info + SHOW_VIEWPORT_INFO :Boolean = False; //Show viewport info + SHOW_GIP :Boolean = False; //Show GIP commands + SHOW_GIP_AS_BYTES :Boolean = False; //Show GIP commands as bytes (or as 'parsed type' if False) + INI_HITPOINT_RESTORE :Boolean = False; //Use the hitpoint restore rate from the INI file to compare with KaM + ALLOW_CAMP_SCRIPT_DATA_UNCOMPRESSED + :Boolean = False; //Allow to save script data uncompressed + SLOW_MAP_SCAN :Boolean = False; //Scan maps with a pause to emulate uncached file access + SLOW_CAMPAIGN_SCAN :Boolean = False; //Scan campaigns with a pause to emulate uncached file access + SLOW_CAMP_PROGRESS_SAVE_LOAD:Boolean = False; //Scan campaigns with a pause to emulate uncached file access + SLOW_SAVE_SCAN :Boolean = False; //Scan saves with a pause to emulate uncached file access + SLOW_GAME_SAVE_ASYNC :Boolean = False; //Emulate slow game save (in the async save thread) + SLOW_MAP_SAVE_LOAD :Boolean = False; //Load map or save to emulate slow network + SLOW_ASYNC_RES_LOADER :Boolean = False; //Emulate slow async resource loader (slow res load in async thread) + DO_PERF_LOGGING :Boolean = False; //Write each ticks time to log (DEPRECATED PERF_LOGGER) + MP_RESULTS_IN_SP :Boolean = False; //Display each players stats in SP + SHOW_DEBUG_OVERLAY_BEVEL:Boolean = True; //Show debug text overlay Bevel (for better text readability) + SHOW_LOG_IN_GUI :Boolean = False; //Show log in GUI + UPDATE_LOG_FOR_GUI :Boolean = False; //Update log to be shown in GUI + DEBUG_TEXT_FONT_ID :Integer = 7; //Debug font ID (7 is fntMonospaced) + + {Gameplay} + LOBBY_SET_SPECS_DEFAULT :Boolean = DEBUG_CFG; //Set 'Allow spectators' flag in the lobby by default + LOBBY_HOST_AS_SPECTATOR :Boolean = DEBUG_CFG; //Host lobby as spectator by default + CUSTOM_SEED_VALUE :Integer = 0; //Custom seed value. Not applied if set to 0 + PAUSE_GAME_BEFORE_TICK :Integer = -1; //Pause after specified game tick + MAKE_SAVEPT_BEFORE_TICK :Integer = -1; //Make savepoint after a certain tick (for both game and replay) + ALLOW_SAVE_IN_REPLAY :Boolean = DEBUG_CFG; //Allow to save game from replay, good for debug + SAVE_NO_COMPRESSION :Boolean = False; // do not use compression for game save body + SAVE_GAME_AFTER_LOAD :Boolean = False; // Save game immediately after load, could be useful for debugging + + {Gameplay cheats} + UNLOCK_CAMPAIGN_MAPS :Boolean = False; //Unlock more maps for debug + REDUCE_SHOOTING_RANGE :Boolean = False; //Reduce shooting range for debug + MULTIPLAYER_CHEATS :Boolean = DEBUG_CFG; //Allow cheats and debug overlays (e.g. CanWalk) in Multiplayer + DEBUG_CHEATS :Boolean = DEBUG_CFG; //Cheats for debug (place scout and reveal map) which can be turned On from menu + MULTIPLAYER_SPEEDUP :Boolean = DEBUG_CFG; //Allow you to use F8 to speed up multiplayer for debugging (only effects local client) + SKIP_EXE_CRC :Boolean = False; //Don't check KaM_Remake.exe CRC before MP game (useful for testing with different versions) + ALLOW_MP_MODS :Boolean = DEBUG_CFG; //Don't let people enter MP mode if they are using mods (unit.dat, house.dat, etc.) + ALLOW_TAKE_AI_PLAYERS :Boolean = False; //Allow to load SP maps without Human player (usefull for AI testing) + {Data output} + BLOCK_SAVE :Boolean = False; //Block saving game (used in parallel Runner) + BLOCK_FILE_WRITE :Boolean = False; //Block to write into txt file (used in parallel Runner) + WRITE_DECODED_MISSION :Boolean = False; //Save decoded mission as txt file + WRITE_WALKTO_LOG :Boolean = False; //Write even more output into log + slows down game noticably + WriteResourceInfoToTXT :Boolean = False; //Whenever to write txt files with defines data properties on loading + EXPORT_SPRITE_ATLASES :Boolean = False; //Whenever to write all generated textures to PNG on loading (extremely time consuming) + EXPORT_SPRITE_ATLASES_RXA:Boolean = False; //Whenever to write all loaded from .RXA files textures to PNG on loading (super extremely time consuming) + LOG_FONTS_RAM_USAGE :Boolean = False; + + +const + MAX_WARES_IN_HOUSE = 5; //Maximum resource items allowed to be in house + MAX_WARES_OUT_WORKSHOP = 5; //Maximum sum resource items allowed to output in workshops. Value: 5 - 20; + MAX_WARES_ORDER = 999; //Number of max allowed items to be ordered in production houses (Weapon/Armor/etc) + + MAX_UNITS_AROUND_HOUSE = 50; + +const + MAX_WOODCUTTER_CUT_PNT_DISTANCE = 5; //Max distance for woodcutter new cutting point from his house + +const + MAX_HANDS = 27; // Maximum players (human or AI) per map + MAX_LOBBY_PLAYERS = 12; // Maximum number of players (not spectators) allowed in the lobby. Map can have additional AI locations up to MAX_HANDS (for co-op). + MAX_LOBBY_SPECTATORS = 2; // Slots available in lobby. Additional slots can be used by spectators + MAX_LOBBY_SLOTS = MAX_LOBBY_PLAYERS + MAX_LOBBY_SPECTATORS; + MAX_TEAMS = MAX_LOBBY_PLAYERS div 2; + + GAME_SPEED_NORMAL = 1; + GAME_SP_SPEED_MAX = 10; + GAME_MP_SPEED_MAX = 2.5; + + SPEED_PACE_DEFAULT = 100; // ms, frequency of game updates + + + AUTOSAVE_COUNT_DEF = 5; //How many autosaves to backup by default - this MUST be variable (Parallel Runner) + AUTOSAVE_COUNT_MIN = 1; + AUTOSAVE_COUNT_MAX = 50; // 99 max, since it should be 2-digit width to cope with our rename algo + AUTOSAVE_FREQUENCY_MIN = 300; // 30 sec + AUTOSAVE_FREQUENCY_MAX = 6000; // 10 minutes + AUTOSAVE_FREQUENCY_DEFAULT = 600; // 1 min, How often to do autosave, every N ticks + BASESAVE_NAME = 'basesave'; + AUTOSAVE_SAVE_NAME = 'autosave'; + AUTOSAVE_AFTER_PT_END_SAVE_NAME = 'autosave_after_pt_end'; + CRASHREPORT_SAVE_NAME = 'crashreport'; + + // Checkpoint, which are made in the memory while watching replay + REPLAY_SAVEPOINT_FREQUENCY_MIN = 30*10; //30 sec + REPLAY_SAVEPOINT_FREQUENCY_MAX = 60*60*10; // 1 hour + REPLAY_SAVEPOINT_FREQUENCY_DEF = 5*60*10; // 5 min + REPLAY_SAVEPOINT_CNT_MAX = 60; // Max number of replay autosaves + + // Checkpoints, which are made during the game and saved in the .spt file +{$IFDEF DEBUG} +var +{$ENDIF} + GAME_SAVE_CHECKPOINT_FREQ_MIN: Integer = 5*60*10; // 5 min + GAME_SAVE_CHECKPOINT_FREQ_MAX: Integer = 2*60*60*10; // 2 hours + GAME_SAVE_CHECKPOINT_FREQ_DEF: Integer = 15*60*10; // 15 minutes + GAME_SAVE_CHECKPOINT_CNT_LIMIT_MIN: Integer = 0; // Min limit for number of game checkpoints + GAME_SAVE_CHECKPOINT_CNT_LIMIT_MAX: Integer = 60; // Max limit for number of game checkpoints + GAME_SAVE_CHECKPOINT_CNT_LIMIT_DEF: Integer = 30; // Def limit for number of game checkpoints +{$IFDEF DEBUG} +const +{$ENDIF} + + BEACON_COOLDOWN = 400; //Minimum time in milliseconds between beacons + + DYNAMIC_HOTKEYS_NUM = 20; // Number of dynamic hotkeys + + GLOBAL_TICK_UPDATE_FREQ = 100; // In ms. + +var + HITPOINT_RESTORE_PACE: Word = 100; //1 hitpoint is restored to units every X ticks (using Humbelum's advice) + +const + TERRAIN_MAX_BLENDING_LEVEL = 15; + TERRAIN_DEF_BLENDING_LVL = (TERRAIN_MAX_BLENDING_LEVEL + 1) div 2; + MAPED_BRUSH_MAX_SIZE = 32; + + //Here we store options that are hidden somewhere in code + //Unit condition + UNIT_CONDITION_PACE = 10; // Check unit conditions only once per 10 ticks + UNIT_CONDITION_FULL_THRESHOLD = 0.9; // Unit condition level, until which we allow unit to eat foods + UNIT_MAX_CONDITION = 45*60; // Minutes of life. In KaM it's 45min + UNIT_MIN_CONDITION = 6*60; // If unit condition is less it will look for Inn. In KaM it's 6min + TROOPS_FEED_MAX = 0.55; // Maximum amount of condition a troop can have to order food (more than this means they won't order food) + UNIT_CONDITION_BASE = 0.6; // Base amount of health a unit starts with (measured in KaM) + UNIT_CONDITION_RANDOM = 0.1; // Random jitter of unit's starting health (KaM did not have this, all units started the same) + TROOPS_TRAINED_CONDITION = 0.6; // Condition troops start with when trained (measured from KaM) + + //Units are fed acording to this: (from knightsandmerchants.de tips and tricks) + //Bread = +40% + //Sausages = +60% + //Wine = +20% (We changed this to +30% for balance) + //Fish = +50% + BREAD_RESTORE = 0.4; + SAUSAGE_RESTORE = 0.6; + WINE_RESTORE = 0.3; + FISH_RESTORE = 0.5; + + + DEFAULT_HITPOINT_RESTORE = 100; //1 hitpoint is restored to units every X ticks (using Humbelum's advice) + TIME_BETWEEN_MESSAGES = 4*600; //Time between messages saying house is unoccupied or unit is hungry. In KaM it's 4 minutes + + WATCHTOWER_RANGE_MAX = 6.99; //Measured in KaM. Distance from the doorway of tower + WATCHTOWER_RANGE_MIN = 0; //In KaM towers have no minimum range, they will shoot any unit less than the range + + GROUP_LINK_RADIUS = 5; //Radius to search for groups to link to after being trained at the barracks (measured from KaM) + + FRIENDLY_FIRE = True; //Whenever archers could kill fellow men with their arrows + + NET_DROP_PLAYER_MIN_WAIT = 15; // in seconds. Host must wait at least this long before dropping disconnected players + ANNOUNCE_BUILD_MAP = 30*60*10; //30 minutes + ANNOUNCE_BATTLE_MAP = 2*60*10; //2 minutes + + RESULTS_UPDATE_RATE = 15; //Each 1.5 sec + CHARTS_SAMPLING_FOR_ECONOMY = 150; //Each 15sec + CHARTS_SAMPLING_FOR_TACTICS = 30; //Each 3sec, cos average game length is much shorter + + RETURN_TO_LOBBY_SAVE = 'paused'; + DOWNLOADED_LOBBY_SAVE = 'downloaded'; + + SERVER_DEFAULT_UDP_SCAN_PORT = 56788; + SERVER_DEFAULT_UDP_ANNOUNCE_PORT = 56789; + EMPTY_ROOM_DEFAULT_GAME_REVISION = 0; //Placeholder for game revision in room + + LOC_RANDOM = 0; + LOC_SPECTATE = -1; + LOC_ANY = -1000; + + MIN_PLAYER_COLOR_DIST = 0.15; // Minimun color distance between players + + EXT_SAVE_TXT_DOT = '.txt'; + EXT_SAVE_REPLAY = 'rpl'; + EXT_SAVE_MAIN = 'sav'; + EXT_SAVE_BASE = 'bas'; + EXT_SAVE_MP_LOCAL = 'sloc'; + EXT_FILE_SCRIPT = 'script'; + + // Well-known extensions + // Note that typically extension include a dot, so if would be desireable to operate with only dotted extensions (below) and disuse ones above + EXT_SAVE_REPLAY_DOT = '.' + EXT_SAVE_REPLAY; + EXT_SAVE_GAME_SAVEPTS_DOT = '.spt'; + EXT_SAVE_MAIN_DOT = '.' + EXT_SAVE_MAIN; + EXT_SAVE_MAIN_TXT_DOT = '.' + EXT_SAVE_MAIN + EXT_SAVE_TXT_DOT; + EXT_SAVE_BASE_DOT = '.' + EXT_SAVE_BASE; + EXT_SAVE_MP_LOCAL_DOT = '.' + EXT_SAVE_MP_LOCAL; + EXT_SAVE_RNG_LOG_DOT = '.rng'; + EXT_FILE_SCRIPT_DOT = '.' + EXT_FILE_SCRIPT; + +type + TKMHandID = {type} ShortInt; + TKMHandIDArray = array of TKMHandID; + TKMHandID2Array = array of TKMHandIDArray; + TKMHandEnabledArray = array [0..MAX_HANDS-1] of Boolean; + +const + // Used to reset on new game start + OWN_MARGIN_DEF :Byte = 190; + OWN_THRESHOLD_DEF:Byte = 126; + +var + //Values are empirical + //todo -cPractical: Can move this to AIInfluences as parameter + OWN_MARGIN :Byte = 190; + OWN_THRESHOLD:Byte = 126; + + +const + LAST_SENT_COMMANDS_TICK_NONE = 0; + +type + TKMCursorMode = ( + cmNone, + cmErase, //Remove player controlled assets (plans, houses) with a confirmation dialog + cmRoad, + cmField, + cmWine, + cmHouses, // Gameplay + + //Map Editor + cmElevate, //Height elevation + cmEqualize, //Height equalization + cmConstHeight, //Constant height brush + cmElevateAll, //Terrain kind elevation + cmBrush, //Terrain brush + cmTiles, // Individual tiles + cmObjects, //Terrain objects + cmObjectsBrush, //Objects brush + cmMagicWater, //Magic water + cmSelection, //Selection manipulations + cmUnits, //Units + cmMarkers, //CenterScreen, FOW, Defence, AIStart, Rally/Cutting Point markers + cmEyedropper, //Terrain eyedropper + cmPaintBucket, //PaintBucket - change color(team) for map objects + cmUniversalEraser, //Universal eraser for units/groups/houses/terrain objects/roads and fields (corn/wine) + cmRotateTile, //Rotate terrain tile + cmOverlays //Tile overlays + ); + + // How cursor field placing will act (depends on which tile LMB was pressed) + TKMCursorFieldMode = ( + cfmNone, // Disabled + cfmPlan, // Placing plans + cfmErase // Erasing plans + ); + + // Shape types for MapEditor + TKMMapEdShape = (hsCircle, hsSquare); + + +const + MARKER_REVEAL = 1; + MARKER_DEFENCE = 2; + MARKER_CENTERSCREEN = 3; + MARKER_AISTART = 4; + MARKER_RALLY_POINT = 5; + + DATE_TIME_ZERO: TDateTime = 0; // DateTime as 0, for simplicity. Some compilers (Delphi Berlin, f.e.) can't handle TDateTime(0) + +const + DIR_CURSOR_CIRCLE_RAD = 32; //Radius of the direction selector cursor restriction area + DIR_CURSOR_NA_RAD = 20; //Radius of centeral part that has no direction + + +type + // Game result + TKMGameResultMsg = ( + grWin, // Player has won the game + grDefeat, // Player was defeated + grCancel, // Game was cancelled (unfinished) + grError, // Some known error occured + grDisconnect, // Disconnected from multiplayer game + grSilent, // Used when loading savegame from running game (show no screens) + grReplayEnd, // Replay was cancelled - return to menu without screens + grMapEdEnd, // Map Editor was closed - return to menu without screens + grGameContinues // Game is not finished yet, it is continious + ); + +type + TKMAllianceType = (atEnemy, atAlly); + +const + FOG_OF_WAR_MIN = 80; //Minimum value for explored but FOW terrain, MIN/ACT determines FOW darkness + FOG_OF_WAR_ACT = 160; //Until this value FOW is not rendered at all + FOG_OF_WAR_MAX = 255; //This is max value that FOW can be, MAX-ACT determines how long until FOW appears + FOG_OF_WAR_INC = 128; //Increment for FOW + FOG_OF_WAR_DEC = 12; //Decrement for FOW + +const + MAPED_HISTORY_DEPTH_MIN = 20; + MAPED_HISTORY_DEPTH_MAX = 1000; + MAPED_HISTORY_DEPTH_DEF = 250; + + +const + MAPS_FOLDER_NAME = 'Maps'; + MAPS_MP_FOLDER_NAME = 'MapsMP'; + MAPS_DL_FOLDER_NAME = 'MapsDL'; + MAPS_RMG_NAME = 'Randomly generated map'; + TUTORIALS_FOLDER_NAME = 'Tutorials'; + CAMPAIGNS_FOLDER_NAME = 'Campaigns'; + SAVES_FOLDER_NAME = 'Saves'; + SAVES_MP_FOLDER_NAME = 'SavesMP'; + SAVES_CMP_FOLDER_NAME = 'SavesCMP'; + + +{ Terrain } +type + //* Terrain passability + TKMTerrainPassability = ( + tpNone, + tpWalk, // General passability of tile for any walking units + tpWalkRoad, // Type of passability for Serfs when transporting wares, only roads have it + tpBuildNoObj, // Can we build a house on this tile after removing an object on the tile or house near it? + tpBuild, // Can we build a house on this tile? + tpMakeRoads, // Thats less strict than house building, roads Can be placed almost everywhere where units Can walk, except e.g. bridges + tpCutTree, // Can tree be cut + tpFish, // Water tiles where fish Can move around + tpCrab, // Sand tiles where crabs Can move around + tpWolf, // Soil tiles where wolfs Can move around + tpElevate, // Nodes which are forbidden to be elevated by workers (house basements, water, etc..) + tpWorker, // Like CanWalk but allows walking on building sites + tpOwn, // For AI ownership + tpFactor // Allows vertex (top left) to be factored as a neighbour in flattening algorithm (it is to stop mines flattening strangely due to surrounding hills) + ); + TKMTerrainPassabilitySet = set of TKMTerrainPassability; + + TKMHeightPass = (hpWalking, hpBuilding, hpBuildingMines); + +const + PASSABILITY_GUI_TEXT: array [TKMTerrainPassability] of UnicodeString = ( + 'Unused', + 'Can walk', + 'Can walk road', + 'Can build without|object', + 'Can build', + 'Can make roads', + 'Can cut tree', + 'Can fish', + 'Can crab', + 'Can wolf', + 'Can elevate', + 'Can worker', + 'Can own', + 'Can factor' + ); + + +type + TKMWalkConnect = ( + wcWalk, + wcRoad, + wcFish, //Required for fisherman finding fish in a pond, NOT for fish movement (uses steering). Updated ONLY on load because water doesn't change. + wcWork //CanWorker areas + ); + + TKMWalkConnectSet = set of TKMWalkConnect; + + +const + UID_NONE: Integer = -1; // Would be better to have it 0. But now it's -1 for backwards compatibility + + +{Units} +type + //* Unit type + TKMUnitType = (utNone, utAny, + utSerf, utWoodcutter, utMiner, utAnimalBreeder, + utFarmer, utCarpenter, utBaker, utButcher, + utFisher, utBuilder, utStonemason, utSmith, + utMetallurgist, utRecruit, + + utMilitia, utAxeFighter, utSwordFighter, utBowman, + utCrossbowman, utLanceCarrier, utPikeman, utScout, + utKnight, utBarbarian, + + utRebel, utRogue, utWarrior, utVagabond, + //utCatapult, utBallista, + + utWolf, utFish, utWatersnake, utSeastar, + utCrab, utWaterflower, utWaterleaf, utDuck); + //* Unit type set + TKMUnitTypeSet = set of TKMUnitType; + +const + UNIT_MIN = utSerf; + UNIT_MAX = utDuck; + CITIZEN_MIN = utSerf; + CITIZEN_MAX = utRecruit; + WARRIOR_MIN = utMilitia; + WARRIOR_MAX = utVagabond; + WARRIOR_EQUIPABLE_BARRACKS_MIN = utMilitia; //Available from barracks + WARRIOR_EQUIPABLE_BARRACKS_MAX = utKnight; + WARRIOR_EQUIPABLE_TH_MIN = utBarbarian; //Available from Townhall + WARRIOR_EQUIPABLE_TH_MAX = utVagabond; + HUMANS_MIN = utSerf; + HUMANS_MAX = utVagabond; + ANIMAL_MIN = utWolf; + ANIMAL_MAX = utDuck; + + UNITS_VALID = [UNIT_MIN..UNIT_MAX]; + UNITS_ANIMALS = [ANIMAL_MIN..ANIMAL_MAX]; + UNITS_CITIZEN = [CITIZEN_MIN..CITIZEN_MAX]; + UNITS_WARRIORS = [WARRIOR_MIN..WARRIOR_MAX]; + UNITS_HUMAN = [HUMANS_MIN..HUMANS_MAX]; + + WARRIORS_IRON = [utSwordFighter, utCrossbowman, utPikeman, utKnight]; + + CITIZENS_CNT = Integer(CITIZEN_MAX) - Integer(CITIZEN_MIN) + 1; + WARRIORS_CNT = Integer(WARRIOR_MAX) - Integer(WARRIOR_MIN) + 1; + +type + TKMCheckAxis = (axX, axY); + +// Used for AI defence and linking troops +type + //* Group type + TKMGroupType = (gtNone, gtAny, gtMelee, gtAntiHorse, gtRanged, gtMounted); + //* Group type set + TKMGroupTypeSet = set of TKMGroupType; + +const + GROUP_TYPE_MIN = gtMelee; + GROUP_TYPE_MAX = gtMounted; + GROUP_TYPE_MIN_OFF = Ord(GROUP_TYPE_MIN); + GROUP_TYPES: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Byte = (0, 1, 2, 3); + GROUP_TYPES_VALID = [GROUP_TYPE_MIN..GROUP_TYPE_MAX]; + GROUP_TYPES_CNT = Integer(GROUP_TYPE_MAX) - Integer(GROUP_TYPE_MIN) + 1; + +type + TKMGroupTypeArray = array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Word; + //* AI army type + TKMArmyType = (atIronThenLeather, atLeather, atIron, atIronAndLeather); + +const + UNIT_TO_GROUP_TYPE: array [WARRIOR_MIN..WARRIOR_MAX] of TKMGroupType = ( + gtMelee,gtMelee,gtMelee, //utMilitia, utAxeFighter, utSwordsman + gtRanged,gtRanged, //utBowman, utArbaletman + gtAntiHorse,gtAntiHorse, //utPikeman, utHallebardman, + gtMounted,gtMounted, //utHorseScout, utCavalry, + gtMelee, //utBarbarian + //TPR Army + gtAntiHorse, //utPeasant + gtRanged, //utSlingshot + gtMelee, //utMetalBarbarian + gtMounted //utHorseman + {gtRanged,gtRanged, //utCatapult, utBallista,} + ); + + //AI's prefences for training troops + AI_TROOP_TRAIN_ORDER: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX, 1..3] of TKMUnitType = ( + (utSwordFighter, utAxeFighter, utMilitia), + (utPikeman, utLanceCarrier, utNone), + (utCrossbowman, utBowman, utNone), + (utKnight, utScout, utNone)); + +type + TKMGoInDirection = (gdGoOutside=-1, gdGoInside=1); //Switch to set if unit goes into house or out of it + + TKMUnitThought = (thNone, thEat, thHome, thBuild, thStone, thWood, thDeath, thQuest, thDismiss); + +const + //TileCursors + TC_OUTLINE = 0; + TC_BLOCK = 479; + TC_BLOCK_MINE = 480; + TC_ENTRANCE = 481; + TC_BLOCK_ENTRANCE = 482; + +type + TKMUnitTaskType = ( + uttUnknown, // Uninitialized task to detect bugs + uttSelfTrain, uttDeliver, uttBuildRoad, uttBuildWine, uttBuildField, + uttBuildHouseArea, uttBuildHouse, uttBuildHouseRepair, uttGoHome, uttDismiss, + uttGoEat, uttMining, uttDie, uttGoOutShowHungry, uttAttackHouse, + uttThrowRock + ); + + TKMUnitActionName = (uanStay, uanWalkTo, uanGoInOut, uanAbandonWalk, uanFight, uanStormAttack, uanSteer); + + TKMUnitActionType = ( + uaWalk = 120, uaWork, uaSpec, uaDie, uaWork1, + uaWork2, uaWorkEnd, uaEat, uaWalkArm, uaWalkTool, + uaWalkBooty, uaWalkTool2, uaWalkBooty2, uaUnknown); + TKMUnitActionTypeSet = set of TKMUnitActionType; + +const + UNIT_ACT_MIN = uaWalk; + UNIT_ACT_MAX = uaWalkBooty2; + UNIT_ACT_STR: array [TKMUnitActionType] of string = ( + 'uaWalk', 'uaWork', 'uaSpec', 'uaDie', 'uaWork1', + 'uaWork2', 'uaWorkEnd', 'uaEat', 'uaWalkArm', 'uaWalkTool', + 'uaWalkBooty', 'uaWalkTool2', 'uaWalkBooty2', 'uaUnknown'); + + +type + TKMGatheringScript = ( + gsNone, + gsWoodCutterCut, gsWoodCutterPlant, + gsFarmerSow, gsFarmerCorn, gsFarmerWine, + gsFisherCatch, + gsStoneCutter, + gsCoalMiner, gsGoldMiner, gsIronMiner, + gsHorseBreeder, gsSwineBreeder); + +{Houses in game} +type + //House has 3 basic states: no owner inside, owner inside, owner working inside + TKMHouseState = (hstEmpty, hstIdle, hstWork); + //These are house building states + //todo -cComplicated: Can add other possible build states like hbsDigged, hbsRoadConnected, hbsBuildStart + TKMHouseBuildState = (hbsNoGlyph, hbsWood, hbsStone, hbsDone); + + TKMHouseActionType = ( + haWork1, haWork2, haWork3, haWork4, haWork5, //Start, InProgress, .., .., Finish + haSmoke, haFlagpole, haIdle, + haFlag1, haFlag2, haFlag3, + haFire1, haFire2, haFire3, haFire4, haFire5, haFire6, haFire7, haFire8); + TKMHouseActionSet = set of TKMHouseActionType; + +const + HOUSE_ACTION_STR: array [TKMHouseActionType] of string = ( + 'ha_Work1', 'ha_Work2', 'ha_Work3', 'ha_Work4', 'ha_Work5', //Start, InProgress, .., .., Finish + 'ha_Smoke', 'ha_FlagShtok', 'ha_Idle', + 'ha_Flag1', 'ha_Flag2', 'ha_Flag3', + 'ha_Fire1', 'ha_Fire2', 'ha_Fire3', 'ha_Fire4', 'ha_Fire5', 'ha_Fire6', 'ha_Fire7', 'ha_Fire8' + ); + + +{Terrain} +type + //* Field type + TKMFieldType = ( + ftNone, + ftRoad, + ftCorn, + ftWine, + ftInitWine //Reset rotation and set grapes ground, but without Grapes yet + ); + + TKMHouseStage = ( + hsNone, //Nothing, clear area + hsFence, //Wooden fence, partially walkable as workers digg it up + hsBuilt //Done + ); + + //There are 4 steps in tile blocking scheme: + // 0. Tile is normally walkable + // 1. Set the tile as CantBuild + // 2. Sets the tile as CantWalk to anyone except workers who are performing + // the digging task, so they could escape the area. + // The Worker will push out any unit on his way. + // sidenote: CanElevate is per-vertex property, hence it's not identical to CanWorker + // 3. Set the tile as fully blocked + TKMTileLock = ( // CanBuild CanWalk CanWorker CanElevate House Digged Fenced + tlNone, // X X X X - - - + tlFenced, // - X X X X - X + tlDigged, // - - X X X X X + tlHouse, // - - - - X X - + //Used by workers making roads/fields to prevent you from building over them + tlFieldWork,// - X X X - X - + tlRoadWork // - X X X - X - + ); + + // Panel indexes on KM_FormMain.StatusBar + TKMStatusBarPanel = ( + spKMRVersion, + spMapSize, + spCursorCoord, + spTile, + spTime, + spFPS, + spObjectUID, + spControlId); + +type + TKMMapSize = (msNone, msXS, msS, msM, msL, msXL, msXXL); + +const + MAP_SIZE_ENUM_MIN = msXS; + MAP_SIZE_ENUM_MAX = msXXL; + +type + //Enum representing map visible layers + TKMGameVisibleLayer = ( + mlObjects, + mlHouses, + mlUnits, + mlOverlays, + mlMiningRadius, + mlTowersAttackRadius, + mlUnitsAttackRadius, + mlDefencesAll, + mlFlatTerrain + ); + + TKMMapVisibleLayerSet = set of TKMGameVisibleLayer; //Set of above enum + + //Enum representing mapEd visible layers + TKMMapEdVisibleLayers = ( + melDeposits, + melRevealFOW, + melCenterScreen, + melAIStart, + melSelection, + melWaterFlow, + melMapResize, + melDefences + ); + + TKMMapEdVisibleLayerSet = set of TKMMapEdVisibleLayers; //Set of above enum + + TKMDebugControls = (dcNone, dcFlatTerrain); + +const + DEV_SETTINGS_XML_FILENAME = 'kmr_dev.xml'; + + +const + //Colors available for selection in multiplayer + MP_COLOR_COUNT = 26; + MP_PLAYER_COLORS: array [1..MP_COLOR_COUNT] of Cardinal = ( + $FF0000EB, // 1 Red + $FF076CF8, // 2 Orange + $FF00B5FF, // 3 Gold + $FF07FFFF, // 4 Lauenburg yellow + $FF0EC5A2, // 5 Lime green + $FF88FF88, // 6 Light green + $FF07FF07, // 7 Neon green + $FF00A100, // 8 Bright green + $FF134B00, // 9 Dark green + $FF7A9E00, // 10 Teal + $FFFACE64, // 11 Sky blue + $FFFB886D, // 12 Light violet blue + $FFCC6600, // 13 Medium blue + $FF581F00, // 14 Dark blue + $FFCB3972, // 15 Violet (Amethyst) + $FF720468, // 16 Purple + $FFDE8FFB, // 17 Pink + $FFFF07FF, // 18 Magenta + $FF4A00A8, // 19 Dark pink + $FF00005E, // 20 Maroon + $FF666690, // 21 Light brown + $FF103C52, // 22 Brown + $FF519EC9, // 23 Tan + $FFFFFFFF, // 24 White + $FF838383, // 25 Grey + $FF1B1B1B // 26 Black + ); + + //Players colors, as they appear in KaM when the color is not specified in the script, copied from palette values. + //Using these as the defaults when loading the script means the colors will be the same as KaM when not defined. + //Default IDs from KaM: + {229, //Red + 36, //Cyan + 106, //Green + 20, //Magenta + 233, //Yellow + 213, //Grey + 3, //Black + 3, //Black + 255 //White} + DEFAULT_PLAYERS_COLORS: array [0..MAX_HANDS-1] of Cardinal = ( + $FF0000EB, // 1 Red + $FF076CF8, // 2 Orange + $FF00B5FF, // 3 Gold + $FF07FFFF, // 4 Lauenburg yellow + $FF0EC5A2, // 5 Lime green + $FF88FF88, // 6 Light green + $FF07FF07, // 7 Neon green + $FF00A100, // 8 Bright green + $FF134B00, // 9 Dark green + $FF7A9E00, // 10 Teal + $FFFACE64, // 11 Sky blue + $FFFB886D, // 12 Light violet blue + $FFCC6600, // 13 Medium blue + $FF581F00, // 14 Dark blue + $FFCB3972, // 15 Violet (Amethyst) + $FF720468, // 16 Purple + $FFDE8FFB, // 17 Pink + $FFFF07FF, // 18 Magenta + $FF9DB4FB, // 27 Light Light Red + $FF4A00A8, // 19 Dark pink + $FF00005E, // 20 Maroon + $FF666690, // 21 Light brown + $FF103C52, // 22 Brown + $FF519EC9, // 23 Tan + $FFFFFFFF, // 24 White + $FF838383, // 25 Grey + $FF1B1B1B // 26 Black + ); + + // Colors which are used for an MP teams + MP_TEAM_COLORS: array[0..MAX_TEAMS - 1] of Cardinal = ( + $FF0000EB, // 1 Red + $FF076CF8, // 2 Orange + $FF07FFFF, // 3 Lauenburg yellow + $FF07FF07, // 4 Neon green + $FFFACE64, // 5 Sky blue + $FFDE8FFB // 6 Pink + ); + + // DEBUG colors (transparent color - opacity will be added by debug tools) + tcBlack = $000000; + tcBlue = $FF0000; + tcCream = $F0FBFF; + tcCyan = $FFFF00; + tcDarkGrey = $808080; + tcFuchsia = $FF00FF; + tcGreen = $008000; + tcGrey = $808080; + tcLightGrey = $C0C0C0; + tcLimeGreen = $00FF00; + tcMaroon = $000080; + tcMediumGrey = $A4A0A0; + tcMintGreen = $C0DCC0; + tcNavyBlue = $800000; + tcOliveGreen = $008080; + tcPurple = $800080; + tcRed = $0000FF; + tcSilver = $C0C0C0; + tcSkyBlue = $F0CAA6; + tcTeal = $808000; + tcWhite = $FFFFFF; + tcYellow = $00FFFF; + + //Interface colors + icGreen = $FF00C000; + icYellow = $FF07FFFF; + icOrange = $FF0099FF; + icRed = $FF0707FF; + icBlue = $FFFF0707; + icCyan = $FFFFFF00; + + icTransparent = $00; + icDarkGray = $FF606060; + icDarkGrayTrans = $60606060; + icDarkestGrayTrans = $20303030; + icGray = $FF808080; + icGray2 = $FF888888; + icLightGray = $FFA0A0A0; + icLightGray2 = $FFD0D0D0; + icLightGrayTrans = $80A0A0A0; + icWhite = $FFFFFFFF; + icBlack = $FF000000; + icLightCyan = $FFFFFF80; + icLightOrange = $FF80CCFF; + icLightRed = $FF7070FF; + icLight2Red = $FFB0B0FF; + icLightLightRed = $FF9DB4FB; + icDarkOrange = $FF0060FF; + icDarkCyan = $FFB0B000; + icLightGreen = $FF00F000; + icDeepGreen = $FF008000; + icGreenYellow = $FF00FFBB; + icTeal = $FF808000; + + icPink = $FFFF00FF; + icDarkPink = $FFAA00AA; + + icSteelBlue = $FFA56D53; + icDarkBlue = $FF770707; + + icRoyalYellow = $FF4AC7FF; + icGoldenYellow = $FF00B0FF; + icAmberBrown = $FF006797; + icDarkGoldenRod = $FF0080B0; // brown shade color + + icBarColorGreen = $FF00AA26; + icBarColorBlue = $FFBBAA00; + + icBlackish = $FF333333; + + // Interface colors (by usage) + clWhiteText = icWhite; + clBlackText = icBlackish; + + clPingLow = icGreen; + clPingNormal = icYellow; + clPingHigh = icOrange; + clPingCritical = icRed; + + clFpsCritical = icRed; + clFpsLow = icOrange; + clFpsNormal = icYellow; + clFpsHigh = icGreen; + + clTextSelection = icSteelBlue; + + clMPSrvDetailsGameInfoFont = icLightGray; + clStatsUnitDefault = icWhite; + clStatsUnitMissingHL = $FF0080FF; + + clMessageUnitUnread = icGoldenYellow; + clMessageUnitUnreadHL = icRoyalYellow; + clMessageUnitRead = icDarkGoldenRod; + clMessageUnitReadHL = icAmberBrown; + + clLobbyOpponentAll = icRoyalYellow; + clLobbyOpponentAllHL = icAmberBrown; + + clListSelShape = $88888888; + clListSelOutline = icWhite; + clListSelShapeUnfocused = $66666666; + clListSelOutlineUnfocused = icLightGray; + clListSeparatorShape = icDarkGray; + + clMapEdBtnField = icYellow; + clMapEdBtnWine = icYellow; + + clChartHighlight = icPink; + clChartHighlight2 = icDarkPink; + clChartDashedHLn = icDarkGray; + clChartDashedVLn = icDarkGrayTrans; + clChartPeacetimeLn = icDarkGoldenRod; + clChartPeacetimeLbl = icGoldenYellow; + clChartSeparator = icTransparent; + + clChkboxOutline = icLightGrayTrans; + + clPlayerSelf = icRed; + clPlayerAlly = icYellow; + clPlayerEnemy = icCyan; + + clScriptCmdName = icYellow; + clScriptCmdParam = icLightGray; + + clSaveLoadOk = icWhite; + clSaveLoadTry = icLightLightRed; + clSaveLoadError = icLightRed; + +// clGameSelf = icRed; +// clGameAlly = icYellow; +// clGameEnemy = icCyan; + + GROUP_IMG: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Word = ( + 371, 374, + 376, 377); + + GROUP_TXT_COLOR: array [GROUP_TYPE_MIN..GROUP_TYPE_MAX] of Cardinal = ( + icWhite, + icGreen, + icPink, + icRed); + +var + ExeDir: UnicodeString; + +const + WARRIORS_POWER_RATES: array [WARRIOR_MIN..WARRIOR_MAX] of Single = ( + 1, 2.4, 5.2, // utMilitia, utAxeFighter, utSwordFighter + 2.4, 4, // utBowman, utCrossbowman + 2, 4, // utLanceCarrier, utPikeman + 3.3, 6.3, // utScout, utKnight + 5.3, 0.8, 1.2, // utBarbarian, utRebel, utRogue + 5.3, 1.9 // utWarrior, utVagabond + ); + +implementation +uses + SysUtils; + +initialization +begin + GAME_REVISION := AnsiString('r' + IntToStr(GAME_REVISION_NUM)); + GAME_VERSION := GAME_VERSION_PREFIX + GAME_REVISION + GAME_VERSION_POSTFIX + GAME_VERSION_POSTFIX2; + //Clients of this net protocol version may connect to the dedicated server + NET_PROTOCOL_REVISON := AnsiString('r' + IntToStr(NET_PROTOCOL_REVISION_NUM)); +end; + +end. diff --git a/vendor/kam_remake/src/common/KM_Entity.pas b/vendor/kam_remake/src/common/KM_Entity.pas new file mode 100644 index 0000000..c909919 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_Entity.pas @@ -0,0 +1,87 @@ +unit KM_Entity; +{$I KaM_Remake.inc} +interface +uses + KM_CommonClasses; + +type + // Abstract entity (has only the basic properties) + TKMEntity = class abstract + private + fUID: Integer; //unique entity ID + protected + // Accessing field directly with a getter is a hair faster, + // but it is more cumbersome to have 2 getters and we don't need it anyway, + // since getting 65k UIDs (in XXL Terrain.Load) speeds up by only 0.05sec + function GetUID: Integer; inline; + procedure SetUID(aUID: Integer); + public + constructor Create(aUID: Integer); + constructor Load(LoadStream: TKMemoryStream); virtual; + procedure Save(SaveStream: TKMemoryStream); virtual; + + property UID: Integer read GetUID; + + function ObjToString(const aSeparator: String = '|'): String; virtual; + function ObjToStringShort(const aSeparator: String = '|'): String; virtual; + end; + + +implementation +uses + SysUtils, + KM_Defaults; + + +{ TKMEntity } +constructor TKMEntity.Create(aUID: Integer); +begin + inherited Create; + + fUID := aUID; +end; + + +constructor TKMEntity.Load(LoadStream: TKMemoryStream); +begin + inherited Create; + + LoadStream.CheckMarker('Entity'); + LoadStream.Read(fUID); +end; + + +procedure TKMEntity.Save(SaveStream: TKMemoryStream); +begin + SaveStream.PlaceMarker('Entity'); + SaveStream.Write(fUID); +end; + + +procedure TKMEntity.SetUID(aUID: Integer); +begin + fUID := aUID; +end; + + +function TKMEntity.GetUID: Integer; +begin + if Self = nil then Exit(UID_NONE); + + Result := fUID; +end; + + +function TKMEntity.ObjToStringShort(const aSeparator: String = '|'): String; +begin + Result := Format('UID = %d', [UID]); +end; + + +function TKMEntity.ObjToString(const aSeparator: String = '|'): String; +begin + Result := ObjToStringShort(aSeparator); +end; + + +end. diff --git a/vendor/kam_remake/src/common/KM_Lists.pas b/vendor/kam_remake/src/common/KM_Lists.pas new file mode 100644 index 0000000..ea98101 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_Lists.pas @@ -0,0 +1,198 @@ +unit KM_Lists; +{$I KaM_Remake.inc} +interface +uses + Classes, + SysUtils, + KM_CommonTypes; + +type + TKMMapsCRCList = class + private + fEnabled: Boolean; + fMapsList: TStringList; + fOnMapsUpdate: TUnicodeStringEvent; + + procedure MapsUpdated; + function GetCount: Integer; + public + constructor Create; + destructor Destroy; override; + + procedure LoadFromString(const aString: UnicodeString); + function PackToString: UnicodeString; + + property OnMapsUpdate: TUnicodeStringEvent read fOnMapsUpdate write fOnMapsUpdate; + property Count: Integer read GetCount; + property Enabled: Boolean read fEnabled write fEnabled; + + procedure Clear; + procedure RemoveMissing(aMapsCRCArray: TKMCardinalArray); + function Contains(aMapCRC: Cardinal): Boolean; + procedure Add(aMapCRC: Cardinal); + procedure Remove(aMapCRC: Cardinal); + procedure Replace(aOldCRC, aNewCRC: Cardinal); + end; + +implementation + +const + MAPS_CRC_DELIMITER = ':'; + +{ TKMMapsCRCList } +constructor TKMMapsCRCList.Create; +begin + inherited Create; + + fEnabled := True; + fMapsList := TStringList.Create; + fMapsList.Delimiter := MAPS_CRC_DELIMITER; + fMapsList.StrictDelimiter := True; // Requires D2006 or newer. +end; + + +destructor TKMMapsCRCList.Destroy; +begin + FreeAndNil(fMapsList); + inherited; +end; + + +function TKMMapsCRCList.GetCount: Integer; +begin + if not fEnabled then Exit(0); + + Result := fMapsList.Count; +end; + + +procedure TKMMapsCRCList.MapsUpdated; +begin + if Assigned(fOnMapsUpdate) then + fOnMapsUpdate(PackToString); +end; + + +procedure TKMMapsCRCList.LoadFromString(const aString: UnicodeString); +var + I: Integer; + mapCRC : Int64; + stringList: TStringList; +begin + if not fEnabled then Exit; + + fMapsList.Clear; + stringList := TStringList.Create; + stringList.Delimiter := MAPS_CRC_DELIMITER; + stringList.DelimitedText := Trim(aString); + + for I := 0 to stringList.Count - 1 do + begin + if TryStrToInt64(Trim(stringList[I]), mapCRC) + and (mapCRC > 0) + and not Contains(Cardinal(mapCRC)) then + fMapsList.Add(Trim(stringList[I])); + end; + + stringList.Free; +end; + + +function TKMMapsCRCList.PackToString: UnicodeString; +begin + if not fEnabled then Exit(''); + + Result := fMapsList.DelimitedText; +end; + + +procedure TKMMapsCRCList.Clear; +begin + if not fEnabled then Exit; + + fMapsList.Clear; +end; + + +//Remove missing Favourites Maps from list, check if are of them are presented in the given maps CRC array. +procedure TKMMapsCRCList.RemoveMissing(aMapsCRCArray: TKMCardinalArray); + + function ArrayContains(aValue: Cardinal): Boolean; + var + I: Integer; + begin + Result := False; + for I := Low(aMapsCRCArray) to High(aMapsCRCArray) do + if aMapsCRCArray[I] = aValue then + begin + Result := True; + Break; + end; + end; + +var + I: Integer; +begin + if not fEnabled then Exit; + + I := fMapsList.Count - 1; + //We must check, that all values from favorites are presented in maps CRC array. If not - then remove it from favourites + while (fMapsList.Count > 0) and (I >= 0) do + begin + if not ArrayContains(StrToInt64(fMapsList[I])) then + begin + fMapsList.Delete(I); + MapsUpdated; + end; + + Dec(I); + end; +end; + + +function TKMMapsCRCList.Contains(aMapCRC: Cardinal): Boolean; +begin + if (Self = nil) or not fEnabled then Exit(False); + + Result := fMapsList.IndexOf(IntToStr(aMapCRC)) <> -1; +end; + + +procedure TKMMapsCRCList.Add(aMapCRC: Cardinal); +begin + if not fEnabled then Exit; + + if not Contains(aMapCRC) then + begin + fMapsList.Add(IntToStr(aMapCRC)); + MapsUpdated; + end; +end; + + +procedure TKMMapsCRCList.Remove(aMapCRC: Cardinal); +var + I: Integer; +begin + if not fEnabled then Exit; + + I := fMapsList.IndexOf(IntToStr(aMapCRC)); + if I <> -1 then + fMapsList.Delete(I); + + MapsUpdated; +end; + + +procedure TKMMapsCRCList.Replace(aOldCRC, aNewCRC: Cardinal); +begin + if not fEnabled then Exit; + + if Contains(aOldCRC) then + begin + Remove(aOldCRC); + Add(aNewCRC); + end; +end; + +end. diff --git a/vendor/kam_remake/src/common/KM_Points.pas b/vendor/kam_remake/src/common/KM_Points.pas new file mode 100644 index 0000000..87cdb06 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_Points.pas @@ -0,0 +1,1291 @@ +unit KM_Points; +{$I KaM_Remake.inc} +interface + + +type + //* Facing direction + TKMDirection = (dirNA, dirN, dirNE, dirE, dirSE, dirS, dirSW, dirW, dirNW); + TKMDirection4 = (drNA, drN, drE, drS, drW); + TKMDirection4Set = set of TKMDirection4; + +const + DIR_MIN = dirN; + DIR_MAX = dirNW; + DIRS_VALID = [DIR_MIN..DIR_MAX]; + +type + //Records must be packed so they are stored identically in MP saves (padding bytes are unknown values) + TKMPointF = record + X,Y: Single; + class operator Equal(const A, B: TKMPointF): Boolean; + class operator NotEqual(const A, B: TKMPointF): Boolean; + class operator Add(const A, B: TKMPointF): TKMPointF; + class function New(aX, aY: Single): TKMPointF; static; + function ToString: String; + end; + + //* Point with integer coordinates X and Y + TKMPoint = record + X,Y: Integer; + + function ToString: String; + + class operator Equal(const A, B: TKMPoint): Boolean; + class operator NotEqual(const A, B: TKMPoint): Boolean; + class operator Add(const A, B: TKMPoint): TKMPoint; + class function New(aX, aY: Integer): TKMPoint; static; + function Compare(const aPoint: TKMPoint): Integer; + function ToFloat: TKMPointF; + end; + + TKMPointDir = packed record + Loc: TKMPoint; + Dir: TKMDirection; + function ToString: String; + end; + + TKMPointExact = packed record Loc: TKMPoint; Exact: Boolean; end; + + TKMPointW = record + X,Y: Word; + function ToString: String; + end; // For backwards compatibility with cmp files + + TKMPointArray = array of TKMPoint; + TKMPoint2Array = array of array of TKMPoint; + TKMPointDirArray = array of TKMPointDir; + TKMTrisArray = array of array [0..2] of Integer; + + TKMPointFArray = array of TKMPointF; + + TKMTriMesh = record + Vertices: TKMPointArray; + Polygons: TKMTrisArray; + end; + + //We have our own TKMRect that consistently matches TKMPoint range + //Rects are often used without range checking and include negative off-map coords + TKMRect = packed record + Left, Top, Right, Bottom: Integer; + function ToString: String; + function Width: Integer; + function Height: Integer; + procedure SetLeft(aLeft: Integer); + procedure SetRight(aRight: Integer); + procedure SetTop(aTop: Integer); + procedure SetBottom(aBottom: Integer); + class operator Equal(const A, B: TKMRect): Boolean; + class operator NotEqual(const A, B: TKMRect): Boolean; + end; + + TKMRectF = packed record Left, Top, Right, Bottom: Single end; + + TKMRangeInt = record + Min, Max: Integer; + function ToString: String; + end; + + TKMRangeSingle = record + Min, Max: Single; + function ToString: String; + end; + + TKMPointFunction = function(aPoint: TKMPoint): Boolean of object; + + function KMPoint(aX,aY: Integer): TKMPoint; + function KMPointF(X,Y: Single): TKMPointF; overload; + function KMPointF(const P: TKMPoint): TKMPointF; overload; + function KMPointDir(X,Y: Integer; Dir: TKMDirection): TKMPointDir; overload; + function KMPointDir(const P: TKMPoint; Dir: TKMDirection): TKMPointDir; overload; + function KMPointX1Y1(const P:TKMPoint): TKMPoint; + function KMPointBelow(const P: TKMPoint): TKMPoint; + function KMPointAbove(const P: TKMPoint): TKMPoint; + function KMPointLeft(const P: TKMPoint): TKMPoint; + function KMPointRight(const P: TKMPoint): TKMPoint; + function KMNormVector(const P: TKMPoint; R: Integer): TKMPoint; + + function KMPointRound(const P: TKMPointF): TKMPoint; + function KMPointFRoundTo(const P: TKMPointF; aBase: Single): TKMPointF; + function KMSamePoint(const P1,P2: TKMPoint): Boolean; overload; + function KMSamePointF(const P1,P2: TKMPointF): Boolean; overload; + function KMSamePointF(const P1,P2: TKMPointF; Epsilon: Single): Boolean; overload; + function KMSamePointDir(const P1,P2: TKMPointDir): Boolean; + + function KMRect(aLeft, aTop, aRight, aBottom: SmallInt): TKMRect; overload; + function KMRect(const aPoint: TKMPoint): TKMRect; overload; + function KMRect(const aPoint: TKMPointF): TKMRect; overload; + function KMRectF(const aRect: TKMRect): TKMRectF; overload; + function KMRectF(const aPoint: TKMPointF): TKMRectF; overload; + function KMRectF(aLeft, aTop, aRight, aBottom: SmallInt): TKMRectF; overload; + function KMRectF(aLeft, aTop, aRight, aBottom: Single): TKMRectF; overload; + function KMRectRound(const aRect: TKMRectF): TKMRect; + function KMSameRect(const aRect1, aRect2: TKMRect): Boolean; + function KMRectWidth(const aRect: TKMRect): Integer; + function KMRectHeight(const aRect: TKMRect): Integer; + function KMRectGrow(const aRect: TKMRect; aInset: Integer): TKMRect; overload; + function KMRectGrowNoLimits(const aRect: TKMRect; aInset: Integer): TKMRect; + function KMRectGrow(const aRect, aInsetRect: TKMRect): TKMRect; overload; + function KMRectGrow(const aRect: TKMRect; const aDir: TKMDirection; aInset: Integer = 1): TKMRect; overload; + function KMRectGrowTopLeft(const aRect: TKMRect; aInset: Integer = 1): TKMRect; + function KMRectGrowTopRight(const aRect: TKMRect; aInset: Integer = 1): TKMRect; + function KMRectGrowBottomLeft(const aRect: TKMRect; aInset: Integer = 1): TKMRect; + function KMRectShinkTopLeft(const aRect: TKMRect): TKMRect; + function KMRectGrowBottomRight(const aRect: TKMRect; aInset: Integer = 1): TKMRect; + function KMClipRect(const aRect: TKMRect; X1,Y1,X2,Y2: Integer): TKMRect; overload; + function KMClipRect(const aRect1, aRect2: TKMRect): TKMRect; overload; + function KMRectIntersect(const aRect1: TKMRect; X1,Y1,X2,Y2: Integer): TKMRect; overload; + function KMRectIntersect(const aRect1, aRect2: TKMRect): TKMRect; overload; + function KMRectCorners(const aRect: TKMRect): TKMPointArray; + function KMInRect(const aPoint: TKMPoint; const aRect: TKMRect): Boolean; overload; + function KMInRect(const aPoint: TKMPointF; const aRect: TKMRect): Boolean; overload; + function KMInRect(const aPoint: TKMPointF; const aRect: TKMRectF): Boolean; overload; + function KMRectFitInRect(const aInnerRect, aOuterRect: TKMRect): Boolean; + function KMRectArea(const aRect: TKMRect): Integer; + function KMRectMove(const aRect: TKMRect; X,Y: Integer): TKMRect; + procedure KMRectIncludePoint(var aRect: TKMRect; X,Y: Integer); overload; + procedure KMRectIncludePoint(var aRect: TKMRect; const aPoint: TKMPoint); overload; + procedure KMRectIncludeRect(var aRect: TKMRect; aRect2: TKMRect); + + function KMGetDirection(aDirF: Single): TKMDirection; overload; inline; + function KMGetDirection(X,Y: Single; aDirNAThreshold: Integer = 0): TKMDirection; overload; + function KMGetDirection(const P: TKMPointF): TKMDirection; overload; + function KMGetDirection(const FromPos, ToPos: TKMPoint): TKMDirection; overload; + function KMGetDirection(const FromPos, ToPos: TKMPointF): TKMDirection; overload; + function GetDirModifier(const aDir1, aDir2: TKMDirection): Byte; + function KMGetVertexDir(X,Y: Integer): TKMDirection; + function KMGetVertexTile(const P: TKMPoint; const Dir: TKMDirection): TKMPoint; + function KMGetVertex(const aDir: TKMDirection): TKMPointF; + function KMGetPointInDir(const aPoint: TKMPoint; const aDir: TKMDirection; aDist: Byte = 1): TKMPoint; + + function KMAddDirection(const aDir: TKMDirection; aAdd: Integer): TKMDirection; + function KMNextDirection(const aDir: TKMDirection): TKMDirection; + function KMPrevDirection(const aDir: TKMDirection): TKMDirection; + + function KMPointsAround(const P: TKMPoint; aIncludeSelf: Boolean = False): TKMPointArray; + + function KMGetDiagVertex(const P1,P2:TKMPoint): TKMPoint; + function KMStepIsDiag(const P1,P2:TKMPoint): Boolean; + function KMStepIsDiagAdjust(const P1,P2: TKMPoint): Boolean; + function KMStepIsBeside(const P1,P2: TKMPoint): Boolean; + + function KMPointAverage(const A, B: TKMPoint): TKMPoint; + function KMPointSubtract(const A, B: TKMPoint): TKMPoint; + function KMPointAdd(const A, B: TKMPoint): TKMPoint; overload; + function KMPointAdd(const A, B, C: TKMPoint): TKMPoint; overload; + function KMDotProduct(const A, B: TKMPoint): Single; + function KMDistanceAbs(const A, B: TKMPoint): Integer; + function KMDistanceWalk(const A, B: TKMPoint): Integer; + function KMDistanceSqr(const A, B: TKMPoint): Single; overload; + function KMDistanceSqr(const A, B: TKMPointF): Single; overload; + + function KMPerpendecular(const A,B: TKMPoint): TKMPointF; + //Cross product of 2D vectors, pointed either Up or Down + function KMNormal2Poly(const v1,v2,v3: TKMPoint): Single; overload; + function KMPointInTriangle(const P, A, B, C: TKMPoint): Boolean; + function KMSegmentsIntersect(const A, B, C, D: TKMPoint): Boolean; + function KMSegmentsIntersectOrTouch(const A, B, C, D: TKMPoint): Boolean; + + function KMLength(A,B: Single): Single; overload; + function KMLength(const A, B: TKMPoint): Single; overload; + function KMLength(const A, B: TKMPointF): Single; overload; + function KMLengthDiag(X, Y: Integer): Single; overload; + function KMLengthDiag(const A, B: TKMPoint): Single; overload; + function KMLengthDiag(X,Y: Integer; const B: TKMPoint): Single; overload; + function KMLengthSqr(const A, B: TKMPoint): Integer; overload; + function KMLengthSqr(const X1, Y1, X2, Y2: Integer): Integer; overload; + function KMLengthSqr(const A, B: TKMPointF): Single; overload; + function KMLengthSqr(const A: TKMPoint; const B: TKMPointF): Single; overload; + + function KMLerp(const A,B: TKMPoint; MixValue: Single): TKMPointF; overload; + function KMLerp(const A,B: TKMPointF; MixValue: Single): TKMPointF; overload; + + procedure KMSwapPoints(var A,B: TKMPoint); + procedure KMSwapPointDir(var A,B: TKMPointDir); + + function TypeToString(const P: TKMPoint): string; overload; + function TypeToString(const P: TKMPointW): string; overload; + function TypeToString(const P: TKMPointDir): string; overload; + function TypeToString(const P: TKMPointF): string; overload; + function TypeToString(const T: TKMDirection): string; overload; + + function StringToType(const Str: String): TKMPoint; overload; + + function KMRange(aMin, aMax: Integer): TKMRangeInt; overload; + function KMRange(aMin, aMax: Single): TKMRangeSingle; overload; + + function KMInRange(aValue: Integer; const aRangeInt: TKMRangeInt): Boolean; overload; + function KMInRange(aValue: Single; const aRangeSingle: TKMRangeSingle): Boolean; overload; + + function KMEnsureRange(aValue: Integer; const aRange: TKMRangeInt): Integer; overload; + function KMEnsureRange(aValue: Single; const aRange: TKMRangeSingle): Single; overload; + + function KMEnlargeRange(const aRange: TKMRangeInt; aValue: Integer): TKMRangeInt; overload; + function KMEnlargeRange(const aRange: TKMRangeSingle; aValue: Single): TKMRangeSingle; overload; + + +const + KMPOINT_ZERO: TKMPoint = (X: 0; Y: 0); + KMPOINTF_ZERO: TKMPointF = (X: 0.0; Y: 0.0); + KMPOINT_INVALID_TILE: TKMPoint = (X: -1; Y: -1); + KMPOINTF_INVALID_TILE: TKMPointF = (X: -1; Y: -1); + + KMRECT_ZERO: TKMRect = (Left: 0; Top: 0; Right: 0; Bottom: 0); + KMRECT_INVALID_TILES: TKMRect = (Left: -1; Top: -1; Right: -1; Bottom: -1); + + DIAG_DIRECTION: array[TKMDirection] of Boolean = (False, False, True, False, True, False, True, False, True); + + +implementation +uses + SysUtils, TypInfo, Math, + KM_Defaults, KM_CommonUtils; + + +class function TKMPoint.New(aX, aY: Integer): TKMPoint; +begin + Result.X := aX; + Result.Y := aY; +end; + + +function TKMPoint.Compare(const aPoint: TKMPoint): Integer; +begin + Result := (Y - aPoint.Y) * MAX_MAP_SIZE + (X - aPoint.X); +end; + + +class operator TKMPoint.Equal(const A, B: TKMPoint): Boolean; +begin + Result := KMSamePoint(A,B); +end; + + +class operator TKMPoint.NotEqual(const A, B: TKMPoint): Boolean; +begin + Result := not KMSamePoint(A,B); +end; + + +class operator TKMPoint.Add(const A, B: TKMPoint): TKMPoint; +begin + Result := TKMPoint.New(A.X + B.X,A.Y + B.Y); +end; + + +function TKMPoint.ToFloat: TKMPointF; +begin + Result := KMPointF(X, Y); +end; + + +function TKMPoint.ToString: String; +begin + Result := TypeToString(Self); +end; + + +class function TKMPointF.New(aX, aY: Single): TKMPointF; +begin + Result.X := aX; + Result.Y := aY; +end; + + +class operator TKMPointF.Equal(const A, B: TKMPointF): Boolean; +begin + Result := KMSamePointF(A,B); +end; + + +class operator TKMPointF.NotEqual(const A, B: TKMPointF): Boolean; +begin + Result := not KMSamePointF(A,B); +end; + + +class operator TKMPointF.Add(const A, B: TKMPointF): TKMPointF; +begin + Result := KMPointF(A.X + B.X, A.Y + B.Y); +end; + + +function TKMPointF.ToString: String; +begin + Result := TypeToString(Self); +end; + + +function TKMPointW.ToString: String; +begin + Result := TypeToString(Self); +end; + + +function TKMPointDir.ToString: String; +begin + Result := TypeToString(Self); +end; + + +function TKMRect.ToString: String; +begin + Result := Format('(%d, %d, %d, %d)', [Left, Top, Right, Bottom]);; +end; + + +function TKMRect.Width: Integer; +begin + Result := Right - Left + 1; +end; + +function TKMRect.Height: Integer; +begin + Result := Bottom - Top + 1; +end; + +procedure TKMRect.SetLeft(aLeft: Integer); +begin + Left := aLeft; +end; + +procedure TKMRect.SetRight(aRight: Integer); +begin + Right := aRight; +end; + +procedure TKMRect.SetTop(aTop: Integer); +begin + Top := aTop; +end; + +procedure TKMRect.SetBottom(aBottom: Integer); +begin + Bottom := aBottom; +end; + +class operator TKMRect.Equal(const A, B: TKMRect): Boolean; +begin + Result := KMSameRect(A,B); +end; + +class operator TKMRect.NotEqual(const A, B: TKMRect): Boolean; +begin + Result := not KMSameRect(A,B); +end; + +function TKMRangeInt.ToString: String; +begin + Result := Format('%d - %d', [Min, Max]); +end; + +function TKMRangeSingle.ToString: String; +begin + Result := Format('%.5f - %.5f', [Min, Max]); +end; + + +function KMPoint(aX,aY: Integer): TKMPoint; +begin + Result.X := aX; + Result.Y := aY; +end; + + +function KMPointF(const P: TKMPoint): TKMPointF; +begin + Result.X := P.X; + Result.Y := P.Y; +end; + + +function KMPointF(X, Y: Single): TKMPointF; +begin + Result.X := X; + Result.Y := Y; +end; + + +function KMPointDir(X,Y: Integer; Dir: TKMDirection): TKMPointDir; +begin + Result.Loc.X := X; + Result.Loc.Y := Y; + Result.Dir := Dir; +end; + + +function KMPointDir(const P: TKMPoint; Dir: TKMDirection): TKMPointDir; +begin + Result.Loc := P; + Result.Dir := Dir; +end; + + +function KMPointX1Y1(const P: TKMPoint): TKMPoint; +begin + Result.X := P.X + 1; + Result.Y := P.Y + 1; +end; + + +function KMPointBelow(const P: TKMPoint): TKMPoint; +begin + Result.X := P.X; + Result.Y := P.Y + 1; +end; + + +function KMPointAbove(const P: TKMPoint): TKMPoint; +begin + Result.X := P.X; + Result.Y := P.Y - 1; +end; + +function KMPointLeft(const P: TKMPoint): TKMPoint; +begin + Result.X := P.X - 1; + Result.Y := P.Y; +end; + +function KMPointRight(const P: TKMPoint): TKMPoint; +begin + Result.X := P.X + 1; + Result.Y := P.Y; +end; + +function KMNormVector(const P: TKMPoint; R: Integer): TKMPoint; +begin + Result.X := Round(R*P.X / sqrt(sqr(P.X) + sqr(P.Y))); + Result.Y := Round(R*P.Y / sqrt(sqr(P.X) + sqr(P.Y))); +end; + +function KMPointRound(const P: TKMPointF): TKMPoint; +begin + Result.X := Round(P.X); + Result.Y := Round(P.Y); +end; + + +function KMPointFRoundTo(const P: TKMPointF; aBase: Single): TKMPointF; +begin + Result.X := Round(P.X / aBase) * aBase; + Result.Y := Round(P.Y / aBase) * aBase; +end; + + +function KMSamePoint(const P1,P2: TKMPoint): Boolean; +begin + Result := ( P1.X = P2.X ) and ( P1.Y = P2.Y ); +end; + + +function KMSamePointF(const P1,P2: TKMPointF): Boolean; +begin + Result := ( P1.X = P2.X ) and ( P1.Y = P2.Y ); +end; + + +function KMSamePointF(const P1,P2: TKMPointF; Epsilon: Single): Boolean; +begin + Result := (abs(P1.X - P2.X) < Epsilon) and (abs(P1.Y - P2.Y) < Epsilon); +end; + + +function KMSamePointDir(const P1,P2: TKMPointDir): boolean; +begin + Result := ( P1.Loc.X = P2.Loc.X ) and ( P1.Loc.Y = P2.Loc.Y ) and ( P1.Dir = P2.Dir ); +end; + + +function KMRect(aLeft, aTop, aRight, aBottom: SmallInt): TKMRect; +begin + Result.Left := aLeft; + Result.Right := aRight; + Result.Top := aTop; + Result.Bottom := aBottom; +end; + + +//Make rect with single point +function KMRect(const aPoint: TKMPoint): TKMRect; +begin + Result.Left := aPoint.X; + Result.Right := aPoint.X; + Result.Top := aPoint.Y; + Result.Bottom := aPoint.Y; +end; + + +//Encompass PointF into fixed-point rect (2x2) +function KMRect(const aPoint: TKMPointF): TKMRect; +begin + Result.Left := Floor(aPoint.X) - Byte(Frac(aPoint.X) = 0); + Result.Right := Ceil(aPoint.X) + Byte(Frac(aPoint.X) = 0); + Result.Top := Floor(aPoint.Y) - Byte(Frac(aPoint.Y) = 0); + Result.Bottom := Ceil(aPoint.Y) + Byte(Frac(aPoint.Y) = 0); +end; + + +function KMRectF(const aRect: TKMRect): TKMRectF; +begin + Result.Left := aRect.Left; + Result.Right := aRect.Right; + Result.Top := aRect.Top; + Result.Bottom := aRect.Bottom; +end; + + +function KMRectF(const aPoint: TKMPointF): TKMRectF; +begin + Result.Left := aPoint.X; + Result.Right := aPoint.X; + Result.Top := aPoint.Y; + Result.Bottom := aPoint.Y; +end; + + +function KMRectF(aLeft, aTop, aRight, aBottom: SmallInt): TKMRectF; +begin + Result.Left := aLeft; + Result.Right := aRight; + Result.Top := aTop; + Result.Bottom := aBottom; +end; + + +function KMRectF(aLeft, aTop, aRight, aBottom: Single): TKMRectF; +begin + Result.Left := aLeft; + Result.Right := aRight; + Result.Top := aTop; + Result.Bottom := aBottom; +end; + + +function KMRectRound(const aRect: TKMRectF): TKMRect; +begin + Result.Left := Round(aRect.Left); + Result.Right := Round(aRect.Right); + Result.Top := Round(aRect.Top); + Result.Bottom := Round(aRect.Bottom); +end; + + +function KMSameRect(const aRect1, aRect2: TKMRect): Boolean; +begin + Result := (aRect1.Left = aRect2.Left) + and (aRect1.Top = aRect2.Top) + and (aRect1.Right = aRect2.Right) + and (aRect1.Bottom = aRect2.Bottom); +end; + + +function KMRectWidth(const aRect: TKMRect): Integer; +begin + Result := aRect.Right - aRect.Left; +end; + + +function KMRectHeight(const aRect: TKMRect): Integer; +begin + Result := aRect.Bottom - aRect.Top; +end; + + +function KMRectGrow(const aRect: TKMRect; aInset: Integer): TKMRect; +begin + Result.Left := Math.Max(aRect.Left - aInset, 0); + Result.Right := Math.Max(aRect.Right + aInset, 0); + Result.Top := Math.Max(aRect.Top - aInset, 0); + Result.Bottom := Math.Max(aRect.Bottom + aInset, 0); +end; + + +function KMRectGrowNoLimits(const aRect: TKMRect; aInset: Integer): TKMRect; +begin + Result.Left := aRect.Left - aInset; + Result.Right := aRect.Right + aInset; + Result.Top := aRect.Top - aInset; + Result.Bottom := aRect.Bottom + aInset; +end; + + +function KMRectGrow(const aRect, aInsetRect: TKMRect): TKMRect; +begin + Result.Left := Math.Max(aRect.Left + aInsetRect.Left, 0); + Result.Right := Math.Max(aRect.Right + aInsetRect.Right, 0); + Result.Top := Math.Max(aRect.Top + aInsetRect.Top, 0); + Result.Bottom := Math.Max(aRect.Bottom + aInsetRect.Bottom, 0); +end; + + +function KMRectGrow(const aRect: TKMRect; const aDir: TKMDirection; aInset: Integer = 1): TKMRect; overload; +begin + case aDir of + dirNA: Result := KMRectGrow(aRect, aInset); + dirNE: Result := KMRectGrowTopRight(aRect, aInset); + dirSE: Result := KMRectGrowBottomRight(aRect, aInset); + dirSW: Result := KMRectGrowBottomLeft(aRect, aInset); + dirNW: Result := KMRectGrowTopLeft(aRect, aInset); + else + Result := aRect; //not implemented yet + end; +end; + + +function KMRectGrowTopLeft(const aRect: TKMRect; aInset: Integer = 1): TKMRect; +begin + Result.Left := aRect.Left - aInset; + Result.Right := aRect.Right; + Result.Top := aRect.Top - aInset; + Result.Bottom := aRect.Bottom; +end; + + +function KMRectGrowTopRight(const aRect: TKMRect; aInset: Integer = 1): TKMRect; +begin + Result.Left := aRect.Left; + Result.Right := aRect.Right + aInset; + Result.Top := aRect.Top - aInset; + Result.Bottom := aRect.Bottom; +end; + + +function KMRectGrowBottomLeft(const aRect: TKMRect; aInset: Integer = 1): TKMRect; +begin + Result.Left := aRect.Left - aInset; + Result.Right := aRect.Right; + Result.Top := aRect.Top; + Result.Bottom := aRect.Bottom + aInset; +end; + + +function KMRectShinkTopLeft(const aRect: TKMRect): TKMRect; +begin + Result.Left := aRect.Left + 1; + Result.Right := aRect.Right; + Result.Top := aRect.Top + 1; + Result.Bottom := aRect.Bottom; +end; + + +function KMRectGrowBottomRight(const aRect: TKMRect; aInset: Integer = 1): TKMRect; +begin + Result.Left := aRect.Left; + Result.Right := aRect.Right + aInset; + Result.Top := aRect.Top; + Result.Bottom := aRect.Bottom + aInset; +end; + + +function KMClipRect(const aRect: TKMRect; X1,Y1,X2,Y2: Integer): TKMRect; +begin + Result.Left := EnsureRange(aRect.Left, X1, X2); + Result.Right := EnsureRange(aRect.Right, X1, X2); + Result.Top := EnsureRange(aRect.Top, Y1, Y2); + Result.Bottom := EnsureRange(aRect.Bottom, Y1, Y2); +end; + + +function KMClipRect(const aRect1, aRect2: TKMRect): TKMRect; +begin + Result := KMClipRect(aRect1, aRect2.Left, aRect2.Top, aRect2.Right, aRect2.Bottom); +end; + + +function KMRectIntersect(const aRect1: TKMRect; X1,Y1,X2,Y2: Integer): TKMRect; +begin + if (aRect1.Right < X1) + or (aRect1.Left > X2) + or (aRect1.Bottom < Y1) + or (aRect1.Top > Y2) then + Result := KMRECT_INVALID_TILES + else + Result := KMClipRect(aRect1, X1,Y1,X2,Y2); +end; + + +function KMRectIntersect(const aRect1, aRect2: TKMRect): TKMRect; +begin + Result := KMRectIntersect(aRect1, aRect2.Left, aRect2.Top, aRect2.Right, aRect2.Bottom); +end; + + +function KMRectCorners(const aRect: TKMRect): TKMPointArray; +begin + SetLength(Result, 4); + Result[0] := KMPoint(aRect.Left, aRect.Top); + Result[1] := KMPoint(aRect.Right, aRect.Top); + Result[2] := KMPoint(aRect.Right, aRect.Bottom); + Result[3] := KMPoint(aRect.Left, aRect.Bottom); +end; + + +function KMInRect(const aPoint: TKMPoint; const aRect: TKMRect): Boolean; +begin + Result := InRange(aPoint.X, aRect.Left, aRect.Right) and InRange(aPoint.Y, aRect.Top, aRect.Bottom); +end; + + +function KMInRect(const aPoint: TKMPointF; const aRect: TKMRect): Boolean; +begin + Result := InRange(aPoint.X, aRect.Left, aRect.Right) and InRange(aPoint.Y, aRect.Top, aRect.Bottom); +end; + + +function KMInRect(const aPoint: TKMPointF; const aRect: TKMRectF): Boolean; +begin + Result := InRange(aPoint.X, aRect.Left, aRect.Right) and InRange(aPoint.Y, aRect.Top, aRect.Bottom); +end; + + +function KMRectFitInRect(const aInnerRect, aOuterRect: TKMRect): Boolean; +begin + Result := (KMRectHeight(aInnerRect) <= KMRectHeight(aOuterRect)) + and (KMRectWidth(aInnerRect) <= KMRectWidth(aOuterRect)) +end; + + +function KMRectArea(const aRect: TKMRect):Integer; +begin + Result := (aRect.Right - aRect.Left) * (aRect.Bottom - aRect.Top); +end; + + +function KMRectMove(const aRect: TKMRect; X,Y: Integer): TKMRect; +begin + Result.Left := aRect.Left + X; + Result.Right := aRect.Right + X; + Result.Top := aRect.Top + Y; + Result.Bottom := aRect.Bottom + Y; +end; + + +procedure KMRectIncludePoint(var aRect: TKMRect; X,Y: Integer); +begin + KMRectIncludePoint(aRect, KMPoint(X,Y)); +end; + + +procedure KMRectIncludePoint(var aRect: TKMRect; const aPoint: TKMPoint); +begin + if KMInRect(aPoint, aRect) then Exit; + aRect.Left := Min(aPoint.X, aRect.Left); + aRect.Right := Max(aPoint.X, aRect.Right); + aRect.Top := Min(aPoint.Y, aRect.Top); + aRect.Bottom := Max(aPoint.Y, aRect.Bottom); +end; + + +procedure KMRectIncludeRect(var aRect: TKMRect; aRect2: TKMRect); +begin + KMRectIncludePoint(aRect, aRect2.Left, aRect2.Top); + KMRectIncludePoint(aRect, aRect2.Right, aRect2.Top); + KMRectIncludePoint(aRect, aRect2.Right, aRect2.Bottom); + KMRectIncludePoint(aRect, aRect2.Left, aRect2.Bottom); +end; + + +function KMGetDirection(aDirF: Single): TKMDirection; +begin + // Convert angle value to direction + // 3600 is a lame way of ensuring we deal with 0..359 angle + Result := TKMDirection((Round((aDirF / Pi * 180) + 3600 + 22.5) mod 360) div 45 + 1); +end; + + +//todo -cPractical: This algorithm is quite wastefull when in 9 out of 10 cases we just pass integers in [-1..1] range +function KMGetDirection(X, Y: Single; aDirNAThreshold: Integer = 0): TKMDirection; +var + ang, distSqr: Single; +begin + distSqr := Sqr(X) + Sqr(Y); + + if distSqr > Sqr(aDirNAThreshold) then + begin + ang := ArcTan2(Y/distSqr, X/distSqr); + // We have North at zero + Result := KMGetDirection(ang + Pi/2); + end + else + Result := dirNA; +end; + + +function KMGetDirection(const P: TKMPointF): TKMDirection; +begin + Result := KMGetDirection(P.X, P.Y); +end; + + +function KMGetDirection(const FromPos, ToPos: TKMPoint): TKMDirection; +begin + Result := KMGetDirection(Integer(ToPos.X - FromPos.X), Integer(ToPos.Y - FromPos.Y)); +end; + + +function KMGetDirection(const FromPos, ToPos: TKMPointF): TKMDirection; +begin + Result := KMGetDirection(ToPos.X - FromPos.X, ToPos.Y - FromPos.Y); +end; + + +// How big is the difference between directions (in fights hit from behind is 5 times stronger) +// 1 0 1 +// 2 2 +// 3 4 3 +function GetDirModifier(const aDir1, aDir2: TKMDirection): Byte; +begin + Result := Abs(Ord(aDir1) - ((Ord(aDir2) + 4) mod 8)); + + if Result > 4 then + Result := 8 - Result; // Mirror it, as the difference must always be 0..4 +end; + + +function KMGetVertexDir(X,Y: Integer): TKMDirection; +const + DirectionsBitfield: array [-1..0, -1..0] of TKMDirection = ((dirSE, dirNE), (dirSW, dirNW)); +begin + Result := DirectionsBitfield[X,Y]; +end; + + +function KMGetVertexTile(const P: TKMPoint; const Dir: TKMDirection): TKMPoint; +const + XBitField: array [TKMDirection] of SmallInt = (0,0,1,0,1,0,0,0,0); + YBitField: array [TKMDirection] of SmallInt = (0,0,0,0,1,0,1,0,0); +begin + Result := KMPoint(P.X+XBitField[Dir], P.Y+YBitField[Dir]); +end; + + +function KMGetVertex(const aDir: TKMDirection): TKMPointF; +const + XBitField: array [TKMDirection] of single = (0, 0, 0.7,1,0.7,0,-0.7,-1,-0.7); + YBitField: array [TKMDirection] of single = (0,-1,-0.7,0,0.7,1, 0.7, 0,-0.7); +begin + Result := KMPointF(XBitField[aDir], YBitField[aDir]); +end; + + +function KMGetPointInDir(const aPoint: TKMPoint; const aDir: TKMDirection; aDist: Byte = 1): TKMPoint; +const + XBitField: array [TKMDirection] of SmallInt = (0, 0, 1, 1, 1, 0,-1,-1,-1); + YBitField: array [TKMDirection] of SmallInt = (0,-1,-1, 0, 1, 1, 1, 0,-1); +begin + Result.X := aPoint.X + XBitField[aDir] * aDist; + Result.Y := aPoint.Y + YBitField[aDir] * aDist; +end; + + +function KMAddDirection(const aDir: TKMDirection; aAdd: Integer): TKMDirection; +begin + Assert(aDir <> dirNA); + Result := TKMDirection((Ord(aDir) + aAdd - 1 + 8) mod 8 + 1); +end; + + +function KMNextDirection(const aDir: TKMDirection): TKMDirection; +begin + if aDir < dirNW then + Result := Succ(aDir) + else + Result := dirN; //Rewind to start +end; + + +function KMPrevDirection(const aDir: TKMDirection): TKMDirection; +begin + if aDir > dirN then + Result := Pred(aDir) + else + Result := dirNW; //Rewind to end +end; + + +function KMPointsAround(const P: TKMPoint; aIncludeSelf: Boolean = False): TKMPointArray; +var + I,J,K: Integer; +begin + SetLength(Result, 8 + Ord(aIncludeSelf)); + + K := 0; + for I := -1 to 1 do + for J := -1 to 1 do + if aIncludeSelf or (I <> 0) or (J <> 0) then + begin + Result[K] := KMPoint(P.X + J, P.Y + I); + Inc(K); + end; +end; + + +function KMGetDiagVertex(const P1,P2: TKMPoint): TKMPoint; +begin + // Returns the position of the vertex inbetween the two diagonal points (points must be diagonal) + Result.X := Max(P1.X,P2.X); + Result.Y := Max(P1.Y,P2.Y); +end; + + +function KMStepIsDiag(const P1,P2: TKMPoint): Boolean; +begin + Result := (P2.X - P1.X <> 0) and (P2.Y - P1.Y <> 0); +end; + + +// Points are adjustment by diag +function KMStepIsDiagAdjust(const P1,P2: TKMPoint): Boolean; +begin + Result := (Abs(P2.X - P1.X) = 1) and (Abs(P2.Y - P1.Y) = 1); +end; + + +// Point is adjustment by X or Y +function KMStepIsBeside(const P1,P2: TKMPoint): Boolean; +begin + Result := ((Abs(P2.X - P1.X) = 1) and (Abs(P2.Y - P1.Y) = 0)) + or ((Abs(P2.X - P1.X) = 0) and (Abs(P2.Y - P1.Y) = 1)); +end; + + + +function KMPointAverage(const A, B: TKMPoint): TKMPoint; +begin + Result.X := (A.X + B.X) shr 1; + Result.Y := (A.Y + B.Y) shr 1; +end; + + +function KMPointSubtract(const A, B: TKMPoint): TKMPoint; +begin + Result.X := A.X - B.X; + Result.Y := A.Y - B.Y; +end; + + +function KMPointAdd(const A, B: TKMPoint): TKMPoint; +begin + Result.X := A.X + B.X; + Result.Y := A.Y + B.Y; +end; + + +function KMPointAdd(const A, B, C: TKMPoint): TKMPoint; +begin + Result.X := A.X + B.X + C.X; + Result.Y := A.Y + B.Y + C.Y; +end; + + +function KMDotProduct(const A, B: TKMPoint): Single; +begin + Result := A.X * B.X + A.Y * B.Y; +end; + + +// Faster version of distance when we need just approximate information and Integer +function KMDistanceAbs(const A, B: TKMPoint): Integer; +begin + Result := Abs(A.X - B.X) + Abs(A.Y - B.Y); +end; + +// Walking distance in relation to time to get from point A to B (movement in a straight line, vertically / horizontally / diagonally) +function KMDistanceWalk(const A, B: TKMPoint): Integer; +begin + Result := Max(Abs(A.X - B.X), Abs(A.Y - B.Y)); +end; + + +function KMDistanceSqr(const A, B: TKMPoint): Single; +begin + Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y); +end; + + +function KMDistanceSqr(const A, B: TKMPointF): Single; +begin + Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y); +end; + + +function KMPerpendecular(const A,B: TKMPoint): TKMPointF; +var + Tmp: TKMPointF; + D: Single; +begin + Tmp.X := B.X - A.X; + Tmp.Y := B.Y - A.Y; + + D := Sqrt(Tmp.X * Tmp.X + Tmp.Y * Tmp.Y); + + Result.X := A.X - Tmp.Y / D; + Result.Y := A.Y + Tmp.X / D; +end; + + +function KMNormal2Poly(const v1,v2,v3: TKMPoint): Single; +begin + Result := (v1.Y - v2.Y) * (v1.X - v3.X) - (v1.X - v2.X) * (v1.Y - v3.Y); +end; + + +function KMPointInTriangle(const P, A, B, C: TKMPoint): Boolean; +begin + Result := (KMNormal2Poly(A, B, P) > 0) and (KMNormal2Poly(B, C, P) > 0) and (KMNormal2Poly(C, A, P) > 0); +end; + + +//Segments intersect +function KMSegmentsIntersect(const A, B, C, D: TKMPoint): Boolean; +var + ABx, ABy, CDx, CDy: Single; + D2, S, T: Single; +begin + ABx := B.x - A.x; ABy := B.y - A.y; + CDx := D.x - C.x; CDy := D.y - C.y; + + D2 := -CDx * ABy + ABx * CDy; + + S := (-ABy * (A.x - C.x) + ABx * (A.y - C.y)) / D2; + T := ( CDx * (A.y - C.y) - CDy * (A.x - C.x)) / D2; + + Result := (S > 0) and (S < 1) and (T > 0) and (T < 1) + and not IsNaN(S) and not IsNaN(T) + and not IsInfinite(S) and not IsInfinite(T); +end; + + +function KMSegmentsIntersectOrTouch(const A, B, C, D: TKMPoint): Boolean; +var + ABx, ABy, CDx, CDy: Single; + D2, S, T: Single; +begin + ABx := B.x - A.x; ABy := B.y - A.y; + CDx := D.x - C.x; CDy := D.y - C.y; + + //todo -cPractical: Cover with tests and rewrite to avoid / 0. In Delphi Rio behaviour will change + // As said by Rey: + //if S = -NaN and T = -NaN, then + //Result := (S >= 0) and (S <= 1) and (T >= 0) and (T <= 1); + // Delphi Berlin - False + // Delphi Rio - True + D2 := -CDx * ABy + ABx * CDy; + + S := (-ABy * (A.x - C.x) + ABx * (A.y - C.y)) / D2; + T := ( CDx * (A.y - C.y) - CDy * (A.x - C.x)) / D2; + + Result := (S >= 0) and (S <= 1) and (T >= 0) and (T <= 1) + and not IsNaN(S) and not IsNaN(T) + and not IsInfinite(S) and not IsInfinite(T); +end; + + +function KMLength(A,B: Single): Single; +begin + Result := Sqrt(Sqr(A) + Sqr(B)); +end; + + +//True length between 2 points +function KMLength(const A,B: TKMPoint): Single; +begin + Result := Sqrt(Sqr(A.X - B.X) + Sqr(A.Y - B.Y)); +end; + + +function KMLength(const A,B: TKMPointF): Single; +begin + Result := Sqrt(Sqr(A.X - B.X) + Sqr(A.Y - B.Y)); +end; + + +//Rough and faster Length as combination of straight and diagonal +function KMLengthDiag(const A, B: TKMPoint): Single; +var + absX, absY: Integer; +begin + absX := Abs(A.X - B.X); + absY := Abs(A.Y - B.Y); + if absX > absY then + Result := absX + absY * 0.41 + else + Result := absY + absX * 0.41; +end; + + +function KMLengthDiag(X, Y: Integer; const B: TKMPoint): Single; +begin + if Abs(X - B.X) > Abs(Y - B.Y) then + Result := Abs(X - B.X) + Abs(Y - B.Y) * 0.41 + else + Result := Abs(Y - B.Y) + Abs(X - B.X) * 0.41; +end; + + +//Diag length to the KMPOINT_ZERO +function KMLengthDiag(X, Y: Integer): Single; +begin + Result := KMLengthDiag(X, Y, KMPOINT_ZERO); +end; + + +//Squared length for cases where we need to compare two lengths +//or pick the best one and actual value is not that important +//we can save some cycles on ommitting SQRT +function KMLengthSqr(const A, B: TKMPoint): Integer; +begin + Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y); +end; + + +function KMLengthSqr(const X1, Y1, X2, Y2: Integer): Integer; +begin + Result := Sqr(X1 - X2) + Sqr(Y1 - Y2); +end; + + +function KMLengthSqr(const A, B: TKMPointF): Single; +begin + Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y); +end; + + +function KMLengthSqr(const A: TKMPoint; const B: TKMPointF): Single; +begin + Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y); +end; + + +function KMLerp(const A,B: TKMPoint; MixValue: Single): TKMPointF; +begin + Result.X := A.X + (B.X - A.X) * MixValue; + Result.Y := A.Y + (B.Y - A.Y) * MixValue; +end; + + +function KMLerp(const A,B: TKMPointF; MixValue: Single): TKMPointF; +begin + Result.X := A.X + (B.X - A.X) * MixValue; + Result.Y := A.Y + (B.Y - A.Y) * MixValue; +end; + + +procedure KMSwapPoints(var A,B: TKMPoint); +var T: Integer; +begin + T:=A.X; A.X:=B.X; B.X:=T; + T:=A.Y; A.Y:=B.Y; B.Y:=T; +end; + + +procedure KMSwapPointDir(var A,B: TKMPointDir); +var + T: TKMPointDir; +begin + T := A; + A := B; + B := T; +end; + + +function TypeToString(const P: TKMPoint): string; +begin + Result := '(' + IntToStr(P.X) + ';' + IntToStr(P.Y) + ')'; +end; + +function TypeToString(const P: TKMPointW): string; +begin + Result := '(' + IntToStr(P.X) + ';' + IntToStr(P.Y) + ')'; +end; + + +function TypeToString(const P: TKMPointDir): string; +begin + Result := Format('%s Dir = %s', [TypeToString(P.Loc), GetEnumName(TypeInfo(TKMDirection), Integer(P.Dir))]); +end; + + +function TypeToString(const P: TKMPointF): string; +begin + Result := Format('(%s;%s)', [FormatFloat('##0.##', P.X), FormatFloat('##0.##', P.Y)]); +end; + + +function StringToType(const Str: String): TKMPoint; +var + DelimPos, X, Y: Integer; +begin + Result := KMPOINT_INVALID_TILE; + DelimPos := StrIndexOf(Str, ';'); + if DelimPos > 0 then + begin + if TryStrToInt(Copy(Str, 2, DelimPos - 1), X) + and TryStrToInt(Copy(Str, DelimPos + 2, Length(Str) - DelimPos - 2), Y) then + Result := KMPoint(X,Y); + end; +end; + + +function TypeToString(const T: TKMDirection): string; +const + S: array [TKMDirection] of string = ('N/A', 'N', 'NE', 'E', 'SE', 'S', 'SW', 'W', 'NW'); +begin + Result := S[T]; +end; + + +function KMRange(aMin, aMax: Integer): TKMRangeInt; +begin + Result.Min := Min(aMin, aMax); + Result.Max := Max(aMin, aMax); +end; + + +function KMRange(aMin, aMax: Single): TKMRangeSingle; +begin + Result.Min := Min(aMin, aMax); + Result.Max := Max(aMin, aMax); +end; + + +function KMInRange(aValue: Integer; const aRangeInt: TKMRangeInt): Boolean; +begin + Result := InRange(aValue, aRangeInt.Min, aRangeInt.Max); +end; + + +function KMInRange(aValue: Single; const aRangeSingle: TKMRangeSingle): Boolean; +begin + Result := InRange(aValue, aRangeSingle.Min, aRangeSingle.Max); +end; + + +function KMEnsureRange(aValue: Integer; const aRange: TKMRangeInt): Integer; +begin + Result := EnsureRange(aValue, aRange.Min, aRange.Max); +end; + + +function KMEnsureRange(aValue: Single; const aRange: TKMRangeSingle): Single; +begin + Result := EnsureRange(aValue, aRange.Min, aRange.Max); +end; + + +function KMEnlargeRange(const aRange: TKMRangeInt; aValue: Integer): TKMRangeInt; +begin + Result.Min := Min(aRange.Min, aValue); + Result.Max := Max(aRange.Max, aValue); +end; + + +function KMEnlargeRange(const aRange: TKMRangeSingle; aValue: Single): TKMRangeSingle; +begin + Result.Min := Min(aRange.Min, aValue); + Result.Max := Max(aRange.Max, aValue); +end; + + +end. diff --git a/vendor/kam_remake/src/common/KM_WorkerThread.pas b/vendor/kam_remake/src/common/KM_WorkerThread.pas new file mode 100644 index 0000000..a4058ba --- /dev/null +++ b/vendor/kam_remake/src/common/KM_WorkerThread.pas @@ -0,0 +1,301 @@ +unit KM_WorkerThread; +{$I KaM_Remake.inc} +interface +uses + Classes, SysUtils, Generics.Collections; + +type + // FPC 3.2.2 still has problems with TProc and TProc<> + // Hence the simplest solution is to excelude this utility unit from DedicatedServer projects + {$IFDEF WDC} + TKMWorkerThreadTask = class + public + TaskName: string; + Proc: TProc; + OnDone: TProc; + end; + {$ENDIF} + + TKMWorkerThread = class(TThread) + // FPC 3.2.2 still has problems with TProc and TProc<> + // Hence the simplest solution is to excelude this utility unit from DedicatedServer projects + {$IFDEF WDC} + private + fWorkerThreadName: string; + fWorkCompleted: Boolean; + fTaskQueue: TQueue; + + procedure NameThread; overload; + procedure NameThread(aThreadName: string); overload; + function GetBaseThreadName: string; + public + //Special mode for exception handling. Runs work synchronously inside QueueWork + fSynchronousExceptionMode: Boolean; + + constructor Create(const aThreadName: string = ''); + destructor Destroy; override; + procedure Execute; override; + + procedure QueueWork(aProc: TProc; aTaskName: string = ''); + // It is a bit odd that we want the callback to return the aTaskName + procedure QueueWorkAndCallback(aProc: TProc; aOnDone: TProc = nil; aTaskName: string = ''); + procedure QueueWorkAndLog(aProc: TProc; aTaskName: string = ''); + + procedure WaitForAllWorkToComplete; + {$ENDIF} + end; + + + // Holder of WorkerThread + // It should manage its state and recreate an instance if needed + TKMWorkerThreadHolder = class + {$IFDEF WDC} + private + fWorkerThreadName: string; + fWorkerThread: TKMWorkerThread; + function GetWorkerThread: TKMWorkerThread; + public + constructor Create(const aThreadName: String); + destructor Destroy; override; + + property Worker: TKMWorkerThread read GetWorkerThread write fWorkerThread; + {$ENDIF} + end; + + +implementation +uses + KM_Log; + + +{$IFDEF WDC} +{ TKMWorkerThread } +constructor TKMWorkerThread.Create(const aThreadName: string = ''); +begin + //Thread isn't started until all constructors have run to completion + //so Create(False) may be put in front as well + inherited Create(False); + + fWorkerThreadName := aThreadName; + + {$IFDEF DEBUG} + if fWorkerThreadName <> '' then + TThread.NameThreadForDebugging(fWorkerThreadName, ThreadID); + {$ENDIF} + + fWorkCompleted := False; + fSynchronousExceptionMode := False; + fTaskQueue := TQueue.Create; +end; + +destructor TKMWorkerThread.Destroy; +begin + Terminate; + //Wake the thread if it's waiting + TMonitor.Enter(fTaskQueue); + try + TMonitor.Pulse(fTaskQueue); + finally + TMonitor.Exit(fTaskQueue); + end; + + inherited Destroy; + + fTaskQueue.Free; // Free task queue after Worker thread is destroyed so we don't wait for it +end; + + +function TKMWorkerThread.GetBaseThreadName: string; +begin + {$IFDEF DEBUG} + Result := fWorkerThreadName + ' Jobs=' + IntToStr(fTaskQueue.Count); // Has to be synced! + {$ELSE} + Result := ''; + {$ENDIF} +end; + + +procedure TKMWorkerThread.NameThread; +begin + {$IFDEF DEBUG} + NameThread(fWorkerThreadName); + {$ENDIF} +end; + + +procedure TKMWorkerThread.NameThread(aThreadName: string); +begin + {$IFDEF DEBUG} + if fWorkerThreadName <> '' then + TThread.NameThreadForDebugging(aThreadName); + {$ENDIF} +end; + + +procedure TKMWorkerThread.Execute; +var + task: TKMWorkerThreadTask; + loopRunning: Boolean; + threadName: string; +begin + task := nil; + loopRunning := True; + threadName := ''; + + while loopRunning do + begin + TMonitor.Enter(fTaskQueue); + try + threadName := GetBaseThreadName; // get name under TMonitor, cause we access fTaskQueue + if fTaskQueue.Count > 0 then + begin + task := fTaskQueue.Dequeue; + end + else + begin + //We may only terminate once we have finished all our work + if Terminated then + begin + loopRunning := False; + end + else + begin + //Notify main thread that worker is idle if it's blocked in WaitForAllWorkToComplete + fWorkCompleted := True; + TMonitor.Pulse(fTaskQueue); + + TMonitor.Wait(fTaskQueue, 10000); + if fTaskQueue.Count > 0 then + task := fTaskQueue.Dequeue; + end; + end; + finally + TMonitor.Exit(fTaskQueue); + end; + + if task <> nil then + begin + NameThread(threadName); + task.Proc(); + + if Assigned(task.OnDone) then + task.OnDone(task.TaskName); + + FreeAndNil(task); + end; + + NameThread; + end; +end; + + +procedure TKMWorkerThread.QueueWorkAndLog(aProc: TProc; aTaskName: string = ''); +begin + QueueWorkAndCallback( + aProc, + // aOnDone (aTaskNameInt = aTaskName, we just use a different name to avoid sideeffects) + procedure(aTaskNameInt: String) + begin + gLog.AddTime('Job "%s" is completed', [aTaskNameInt]); + end, + aTaskName); +end; + + +procedure TKMWorkerThread.QueueWork(aProc: TProc; aTaskName: string = ''); +begin + QueueWorkAndCallback(aProc, nil, aTaskName); +end; + + +procedure TKMWorkerThread.QueueWorkAndCallback(aProc: TProc; aOnDone: TProc = nil; aTaskName: string = ''); +var + task: TKMWorkerThreadTask; +begin + if fSynchronousExceptionMode then + begin + aProc(); + end + else + begin + if Finished then + raise Exception.Create('Worker thread not running in TKMWorkerThread.QueueWork'); + + task := TKMWorkerThreadTask.Create; + task.Proc := aProc; + task.OnDone := aOnDone; + task.TaskName := aTaskName; + + TMonitor.Enter(fTaskQueue); + try + fWorkCompleted := False; + fTaskQueue.Enqueue(task); + + TMonitor.Pulse(fTaskQueue); + finally + TMonitor.Exit(fTaskQueue); + end; + end; +end; + + +procedure TKMWorkerThread.WaitForAllWorkToComplete; +begin + if fSynchronousExceptionMode then + Exit; + + TMonitor.Enter(fTaskQueue); + try + if not fWorkCompleted and not Finished then + begin + //Wait infinite until worker thread finish his task + while not TMonitor.Wait(fTaskQueue, 1000) do ; + end; + finally + TMonitor.Exit(fTaskQueue); + end; +end; + + +{ TKMWorkerThreadHolder } +constructor TKMWorkerThreadHolder.Create(const aThreadName: String); +begin + inherited Create; + + fWorkerThreadName := aThreadName; +end; + + +destructor TKMWorkerThreadHolder.Destroy; +begin + FreeAndNil(fWorkerThread); + + inherited; +end; + + +// Get working thread instance +// Working thread could be Finished, f.e. in case of an error during its execution +// Thread is not running in that case after Continue is pressed in madexcept window and has Finished flag +// We can call old thread destructor via Free-ing it and then recreate new worker thread. +function TKMWorkerThreadHolder.GetWorkerThread: TKMWorkerThread; +begin + if (fWorkerThread = nil) then + // Create new thread + fWorkerThread := TKMWorkerThread.Create(fWorkerThreadName) + else + if fWorkerThread.Finished then + begin + // Call destructor of an old thread + fWorkerThread.Free; + // Create new one instead + fWorkerThread := TKMWorkerThread.Create(fWorkerThreadName); + end; + + Result := fWorkerThread; +end; +{$ENDIF} + + +end. + diff --git a/vendor/kam_remake/src/common/KM_WorkerThreadUtils.pas b/vendor/kam_remake/src/common/KM_WorkerThreadUtils.pas new file mode 100644 index 0000000..ced4191 --- /dev/null +++ b/vendor/kam_remake/src/common/KM_WorkerThreadUtils.pas @@ -0,0 +1,116 @@ +unit KM_WorkerThreadUtils; +{$I KaM_Remake.inc} +interface +uses + Classes + {$IF DEFINED(WDC) OR (FPC_FULLVERSION >= 30200)}, KM_CommonClasses, KM_WorkerThread {$ENDIF}; + +{$IF DEFINED(WDC) OR (FPC_FULLVERSION >= 30200)} +procedure AsyncSaveToFileAndFree(var aStream: TKMemoryStream; const aFileName: string; aWorkerThread: TKMWorkerThread); +procedure AsyncSaveToFileCompressedAndFree(var aStream: TKMemoryStream; const aFileName: string; const aMarker: string; aWorkerThread: TKMWorkerThread); +procedure AsyncSaveStreamsToFileAndFree(var aMainStream, aSubStream1, aSubStream2: TKMemoryStream; const aFileName: string; + const aMarker1, aMarker2: string; aWorkerThread: TKMWorkerThread); +{$ENDIF} + +implementation + + +{$IF DEFINED(WDC) OR (FPC_FULLVERSION >= 30200)} +procedure AsyncSaveToFileAndFree(var aStream: TKMemoryStream; const aFileName: string; aWorkerThread: TKMWorkerThread); +var + localStream: TKMemoryStream; +begin + localStream := aStream; + aStream := nil; //So caller doesn't use it by mistake + + {$IFDEF WDC} + aWorkerThread.QueueWork( + procedure + begin + try + localStream.SaveToFile(aFileName); + finally + localStream.Free; + end; + end, 'SaveToFile'); + {$ELSE} + try + localStream.SaveToFile(aFileName); + finally + localStream.Free; + end; + {$ENDIF} +end; + + +procedure AsyncSaveToFileCompressedAndFree(var aStream: TKMemoryStream; const aFileName: string; const aMarker: string; + aWorkerThread: TKMWorkerThread); +var + localStream: TKMemoryStream; +begin + localStream := aStream; + aStream := nil; //So caller doesn't use it by mistake + + {$IFDEF WDC} + aWorkerThread.QueueWork( + procedure + begin + try + localStream.SaveToFileCompressed(aFileName, aMarker); + finally + localStream.Free; + end; + end, 'SaveToFileCompressed ' + aMarker); + {$ELSE} + try + localStream.SaveToFileCompressed(aFileName, aMarker); + finally + localStream.Free; + end; + {$ENDIF} +end; + + +procedure AsyncSaveStreamsToFileAndFree(var aMainStream, aSubStream1, aSubStream2: TKMemoryStream; const aFileName: string; + const aMarker1, aMarker2: string; aWorkerThread: TKMWorkerThread); +var + localSubStream1, localSubStream2, localMainStream: TKMemoryStream; +begin + localMainStream := aMainStream; + localSubStream1 := aSubStream1; + localSubStream2 := aSubStream2; + aMainStream := nil; //So caller doesn't use it by mistake + aSubStream1 := nil; //So caller doesn't use it by mistake + aSubStream2 := nil; //So caller doesn't use it by mistake + + {$IFDEF WDC} + aWorkerThread.QueueWork( + procedure + begin + try + localMainStream.AppendStream(localSubStream1, aMarker1); + localMainStream.AppendStream(localSubStream2, aMarker2); + localMainStream.SaveToFile(aFileName); + finally + localSubStream1.Free; + localSubStream2.Free; + localMainStream.Free; + end; + end, 'SaveStreamsToFile ' + aMarker1 + ' ' + aMarker2); + {$ELSE} + try + localMainStream.AppendStream(localSubStream1, aMarker1); + localMainStream.AppendStream(localSubStream2, aMarker2); + localMainStream.SaveToFile(aFileName); + finally + localSubStream1.Free; + localSubStream2.Free; + localMainStream.Free; + end; + {$ENDIF} +end; +{$ENDIF} + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_Controls.pas b/vendor/kam_remake/src/controls/KM_Controls.pas new file mode 100644 index 0000000..09a23b5 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_Controls.pas @@ -0,0 +1,2138 @@ +unit KM_Controls; +{$I KaM_Remake.inc} +interface +uses + Classes, + Controls, + Generics.Collections, + KromOGLUtils, + KM_RenderUI, KM_Pics, + KM_ResFonts, KM_ResTypes, + KM_CommonClasses, KM_CommonTypes, KM_Points, KM_Defaults; + + +type + TKMNotifyEventShift = procedure(Sender: TObject; Shift: TShiftState) of object; + TKMNotifyEventMouseWheel = procedure(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean) of object; + TKMNotifyEventMouseMove = procedure(Sender: TObject; X,Y: Integer; Shift: TShiftState) of object; + TKMNotifyEventMouseButton = procedure(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton) of object; + TKMNotifyEventKey = procedure(Sender: TObject; Key: Word) of object; + TKMNotifyEventKeyShift = procedure(Sender: TObject; Key: Word; Shift: TShiftState) of object; + TKMNotifyEventXY = procedure(Sender: TObject; const aX, aY: Integer) of object; + TKMNotifyEventButton = procedure(Sender: TObject; AButton: TMouseButton; var aHandled: Boolean) of object; + TKMNotifyEventBoolean = procedure (Sender: TObject; aValue: Boolean) of object; + TKMNotifyEventInteger = procedure (Sender: TObject; const aValue: Integer) of object; + + TKMNotifyFuncKey = function(Sender: TObject; Key: Word): Boolean of object; //todo -cPractical: This should be reworked to use standard "var aHandled" pattern + TKMNotifyFuncKeyShift = function(Sender: TObject; Key: Word; Shift: TShiftState): Boolean of object; //todo -cPractical: This should be reworked to use standard "var aHandled" pattern + + TKMControlState = (csDown, csFocus, csOver); + TKMControlStateSet = set of TKMControlState; + + TKMHintKind = (hkControl, // Rendered above control + hkStatic, // 'Classic' hint: rendered in the game / mapEd at the bottom left of the play-area + hkTextNotFit); // Hint to show text, when it could not fit in the control, f.e. in the Lists and ColumnBoxes + + TKMControl = class; + TKMPanel = class; + + { TKMMasterControl } + TKMMasterControl = class + private + fMasterPanel: TKMPanel; //Parentmost control (TKMPanel with all its childs) + fCtrlDown: TKMControl; //Control that was pressed Down + fCtrlFocus: TKMControl; //Control which has input Focus + fCtrlOver: TKMControl; //Control which has cursor Over it + fCtrlUp: TKMControl; //Control above which cursor was released + + fControlIDCounter: Integer; + + fMouseMoveSubsList: TList; + fMouseDownSubsList: TList; + fMouseUpSubsList: TList; + + function IsCtrlCovered(aCtrl: TKMControl): Boolean; + procedure SetCtrlDown(aCtrl: TKMControl); + procedure SetCtrlFocus(aCtrl: TKMControl); + procedure SetCtrlOver(aCtrl: TKMControl); + procedure SetCtrlUp(aCtrl: TKMControl); + + function GetNextCtrlID: Integer; + public + constructor Create; + destructor Destroy; override; + + property MasterPanel: TKMPanel read fMasterPanel; + function IsFocusAllowed(aCtrl: TKMControl): Boolean; + function IsAutoFocusAllowed(aCtrl: TKMControl): Boolean; + procedure UpdateFocus(aSender: TKMControl); + + property CtrlDown: TKMControl read fCtrlDown write SetCtrlDown; + property CtrlFocus: TKMControl read fCtrlFocus write SetCtrlFocus; + property CtrlOver: TKMControl read fCtrlOver write SetCtrlOver; + property CtrlUp: TKMControl read fCtrlUp write SetCtrlUp; + + procedure SubscribeOnOtherMouseMove(const aMouseMoveEvent: TKMNotifyEventMouseMove); + procedure SubscribeOnOtherMouseDown(const aMouseDownEvent: TKMNotifyEventMouseButton); + procedure SubscribeOnOtherMouseUp(const aMouseUpEvent: TKMNotifyEventMouseButton); + + function HitControl(X,Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): TKMControl; + + function KeyDown (Key: Word; Shift: TShiftState): Boolean; + procedure KeyPress (Key: Char); + function KeyUp (Key: Word; Shift: TShiftState): Boolean; + procedure MouseDown (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + procedure MouseMove (X,Y: Integer; Shift: TShiftState); + procedure MouseUp (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + procedure MouseWheel(X,Y: Integer; WheelSteps: Integer; var aHandled: Boolean); + + procedure Paint; + + procedure SaveToFile(const aFileName: UnicodeString); + + procedure UpdateState(aGlobalTickCount: Cardinal); + end; + + + // Base class for all TKM controls + TKMControl = class + public class var + PaintCount: Cardinal; +// type +// TKMKeyPressKind = (kpkDown, kpkPress); +// TKMKeyPress = record +// Time: Int64; +//// Key: Word; +// C: Char; +// Kind: TKMKeyPressKind; +// function ToString: string; +// end; + private +// fKeyPressList: TList; + + fParent: TKMPanel; + fAnchors: TKMAnchorsSet; + + //Left and Top are floating-point to allow to precisely store controls position + //when Anchors [] are used. Cos that means that control must be centered + //even if the Parent resized by 1px. Otherwise error quickly accumulates on + //multiple 1px resizes + //Everywhere else Top and Left are accessed through Get/Set and treated as Integers + fLeft: Single; + fTop: Single; + fWidth: Integer; + fHeight: Integer; + + fFitInParent: Boolean; // Do we force to fit into parent width / height. Check TKMPanel.SetHeight / SetWidth for details + fBaseWidth: Integer; // initial width / height used to restore control sizes when fFitInParent property is set + fBaseHeight: Integer; + + fEnabled: Boolean; + fVisible: Boolean; + fFocusable: Boolean; //Can this control have focus (e.g. TKMEdit sets this True) + fHitable: Boolean; //Can this control be hit with the cursor? + fControlIndex: Integer; //Index number of this control in his Parent's (TKMPanel) collection + fID: Integer; //Control global ID + fHint: UnicodeString; //Text that shows up when cursor is over that control, mainly for Buttons + fHintBackColor: TKMColor4f; //Hint background color + + fClickHoldMode: Boolean; + fClickHoldHandled: Boolean; + fTimeOfLastMouseDown: Cardinal; + fLastMouseDownButton: TMouseButton; + fLastClickPos: TKMPoint; + + fOnClick: TNotifyEvent; + fOnClickShift: TKMNotifyEventShift; + fOnClickRight: TKMNotifyEventXY; + fOnClickHold: TKMNotifyEventButton; + fOnDoubleClick: TNotifyEvent; + fOnMouseWheel: TKMNotifyEventMouseWheel; + fOnFocus: TKMNotifyEventBoolean; + fOnChangeVisibility: TKMNotifyEventBoolean; + fOnChangeEnableStatus: TKMNotifyEventBoolean; + fOnKeyDown: TKMNotifyFuncKeyShift; + fOnKeyUp: TKMNotifyFuncKeyShift; + + fOnWidthChange: TKMNotifyEventInteger; + fOnHeightChange: TKMNotifyEventInteger; + fOnSizeSet: TNotifyEvent; + fOnPositionSet: TNotifyEvent; + + fIsHitTestUseDrawRect: Boolean; //Should we use DrawRect for hitTest, or AbsPositions? + + function GetAbsLeft: Integer; + function GetAbsTop: Integer; + function GetAbsRight: Integer; + function GetAbsBottom: Integer; + + function GetLeft: Integer; + function GetTop: Integer; + function GetRight: Integer; + function GetBottom: Integer; + function GetHeight: Integer; + function GetWidth: Integer; + function GetCenter: TKMPoint; + + function GetVisible: Boolean; + procedure SetAbsLeft(aValue: Integer); + procedure SetAbsTop(aValue: Integer); + procedure SetTopF(aValue: Single); + procedure SetLeftF(aValue: Single); + function GetControlRect: TKMRect; + function GetControlAbsRect: TKMRect; + function GetIsFocused: Boolean; + function GetIsClickable: Boolean; + + procedure ResetClickHoldMode; + + procedure DebugKeyDown(Key: Word; Shift: TShiftState); + procedure SetFocusable(const aValue: Boolean); + function GetMasterPanel: TKMPanel; + protected + fEnabledVisually: Boolean; + fMouseWheelStep: Integer; + fTimeOfLastClick: Cardinal; //Required to handle double-clicks + + procedure SetLeft(aValue: Integer); virtual; + procedure SetTop(aValue: Integer); virtual; + procedure SetHeight(aValue: Integer); virtual; + procedure SetWidth(aValue: Integer); virtual; + + procedure SetLeftSilently(aValue: Integer); + procedure SetTopSilently(aValue: Integer); + procedure SetHeightSilently(aValue: Integer); + procedure SetWidthSilently(aValue: Integer); + + function GetAbsDrawLeft: Integer; virtual; + function GetAbsDrawTop: Integer; virtual; + function GetAbsDrawRight: Integer; virtual; + function GetAbsDrawBottom: Integer; virtual; + + property AbsDrawLeft: Integer read GetAbsDrawLeft; + property AbsDrawRight: Integer read GetAbsDrawRight; + property AbsDrawTop: Integer read GetAbsDrawTop; + property AbsDrawBottom: Integer read GetAbsDrawBottom; + + function GetDrawRect: TKMRect; virtual; + + procedure SetVisible(aValue: Boolean); virtual; + procedure SetEnabled(aValue: Boolean); virtual; + procedure SetAnchors(aValue: TKMAnchorsSet); virtual; + procedure SetHitable(const aValue: Boolean); virtual; + function GetIsPainted: Boolean; virtual; + function GetSelfAbsLeft: Integer; virtual; + function GetSelfAbsTop: Integer; virtual; + function GetSelfHeight: Integer; virtual; + function GetSelfWidth: Integer; virtual; + procedure UpdateVisibility; virtual; + procedure UpdateEnableStatus; virtual; +// procedure ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); virtual; +// procedure ControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); virtual; + procedure FocusChanged(aFocused: Boolean); virtual; + //Let the control know that it was clicked to do its internal magic + procedure DoClick(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); virtual; + procedure DoClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); virtual; + function DoHandleMouseWheelByDefault: Boolean; virtual; + + function GetHint: UnicodeString; virtual; + function GetHintKind: TKMHintKind; virtual; + function GetHintFont: TKMFont; virtual; + function IsHintSelected: Boolean; virtual; + function GetHintBackColor: TKMColor4f; virtual; + function GetHintTextColor: TColor4; virtual; + function GetHintBackRect: TKMRect; virtual; + function GetHintTextOffset: TKMPoint; virtual; + procedure SetHint(const aHint: UnicodeString); virtual; + procedure SetHintBackColor(const aValue: TKMColor4f); virtual; + + function CanFocusNext: Boolean; virtual; + public + AutoFocusable: Boolean; //Can we focus on this element automatically (f.e. if set to False we will able to Focus only by manual mouse click) + HandleMouseWheelByDefault: Boolean; //Do control handle MW by default? Usually it is + CanChangeEnable: Boolean; //Enable state could be changed + + State: TKMControlStateSet; //Each control has it localy to avoid quering Collection on each Render + Scale: Single; //Child controls position is scaled + + Tag: Integer; //Some tag which can be used for various needs + Tag2: Integer; //Some tag which can be used for various needs + + DebugHighlight: Boolean; + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + destructor Destroy; override; + function HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; virtual; + + property Parent: TKMPanel read fParent; + property MasterPanel: TKMPanel read GetMasterPanel; + + property AbsLeft: Integer read GetAbsLeft write SetAbsLeft; + property AbsRight: Integer read GetAbsRight; + property AbsTop: Integer read GetAbsTop write SetAbsTop; + property AbsBottom: Integer read GetAbsBottom; + + property Left: Integer read GetLeft write SetLeft; + property Right: Integer read GetRight; + property Top: Integer read GetTop write SetTop; + property Bottom: Integer read GetBottom; + property Width: Integer read GetWidth write SetWidth; + property Height: Integer read GetHeight write SetHeight; + property BaseWidth: Integer read fBaseWidth write fBaseWidth; + property BaseHeight: Integer read fBaseHeight write fBaseHeight; + + property Center: TKMPoint read GetCenter; + property ID: Integer read fID; + function GetIDsStr: String; + property Hint: UnicodeString read GetHint write SetHint; //Text that shows up when cursor is over that control, mainly for Buttons + property HintKind: TKMHintKind read GetHintKind; + property HintFont: TKMFont read GetHintFont; + property HintSelected: Boolean read IsHintSelected; + property HintBackColor: TKMColor4f read GetHintBackColor write SetHintBackColor; + property HintTextColor: TColor4 read GetHintTextColor; + property HintBackRect: TKMRect read GetHintBackRect; + property HintTextOffset: TKMPoint read GetHintTextOffset; + + property MouseWheelStep: Integer read fMouseWheelStep write fMouseWheelStep; + + property FitInParent: Boolean read fFitInParent write fFitInParent; + property IsHitTestUseDrawRect: Boolean read fIsHitTestUseDrawRect write fIsHitTestUseDrawRect; + + // "Self" coordinates - this is the coordinates of control itself. + // For simple controls they are equal to normal coordinates + // but for composite controls this is coord. for control itself, without any other controls inside composite + // (f.e. for TKMNumericEdit this is his internal edit coord without Inc/Dec buttons) + property SelfAbsLeft: Integer read GetSelfAbsLeft; + property SelfAbsTop: Integer read GetSelfAbsTop; + property SelfWidth: Integer read GetSelfWidth; + property SelfHeight: Integer read GetSelfHeight; + + property Rect: TKMRect read GetControlRect; + property AbsRect: TKMRect read GetControlAbsRect; + property Anchors: TKMAnchorsSet read fAnchors write SetAnchors; + property Enabled: Boolean read fEnabled write SetEnabled; + property Visible: Boolean read GetVisible write SetVisible; + property Focusable: Boolean read fFocusable write SetFocusable; + property Hitable: Boolean read fHitable write SetHitable; + property IsSetVisible: Boolean read fVisible; + property IsPainted: Boolean read GetIsPainted; + property IsFocused: Boolean read GetIsFocused; + property IsClickable: Boolean read GetIsClickable; // Control considered 'Clickabale' if it is Visible and Enabled + property ControlIndex: Integer read fControlIndex; + procedure Enable; + procedure Disable; + procedure Show; virtual; + procedure Hide; + procedure DoSetVisible; //Differs from Show, that we do not force to show Parents + procedure Focus; + procedure Unfocus; + procedure AnchorsCenter; + procedure AnchorsStretch; + procedure ToggleVisibility; + function MasterParent: TKMPanel; + + procedure SetPosCenter; + procedure SetPosCenterW; + procedure SetPosCenterH; + + function KeyDown(Key: Word; Shift: TShiftState): Boolean; virtual; + procedure KeyPress(Key: Char); virtual; + function KeyUp(Key: Word; Shift: TShiftState): Boolean; virtual; + procedure MouseDown (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); virtual; + procedure MouseMove (X,Y: Integer; Shift: TShiftState); virtual; + procedure MouseUp (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); virtual; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); virtual; + + property OnClick: TNotifyEvent read fOnClick write fOnClick; + property OnClickShift: TKMNotifyEventShift read fOnClickShift write fOnClickShift; + property OnClickRight: TKMNotifyEventXY read fOnClickRight write fOnClickRight; + property OnClickHold: TKMNotifyEventButton read fOnClickHold write fOnClickHold; + property OnDoubleClick: TNotifyEvent read fOnDoubleClick write fOnDoubleClick; + property OnMouseWheel: TKMNotifyEventMouseWheel read fOnMouseWheel write fOnMouseWheel; + property OnFocus: TKMNotifyEventBoolean read fOnFocus write fOnFocus; + property OnChangeVisibility: TKMNotifyEventBoolean read fOnChangeVisibility write fOnChangeVisibility; + property OnChangeEnableStatus: TKMNotifyEventBoolean read fOnChangeEnableStatus write fOnChangeEnableStatus; + property OnKeyDown: TKMNotifyFuncKeyShift read fOnKeyDown write fOnKeyDown; + property OnKeyUp: TKMNotifyFuncKeyShift read fOnKeyUp write fOnKeyUp; + + property OnWidthChange: TKMNotifyEventInteger read fOnWidthChange write fOnWidthChange; + property OnHeightChange: TKMNotifyEventInteger read fOnHeightChange write fOnHeightChange; + property OnSizeSet: TNotifyEvent read fOnSizeSet write fOnSizeSet; + property OnPositionSet: TNotifyEvent read fOnPositionSet write fOnPositionSet; + + procedure Paint; virtual; + procedure UpdateState(aTickCount: Cardinal); virtual; + + function ToStr: string; + end; + + TKMControlClass = class of TKMControl; + TKMControlClassArray = array of TKMControlClass; + + + { Panel which keeps child items in it, it's virtual and invisible } + TKMPanel = class(TKMControl) + private + procedure Init; + protected + fMasterControl: TKMMasterControl; + //Do not propogate SetEnabled and SetVisible because that would show/enable ALL childs childs + //e.g. scrollbar on a listbox + procedure SetHeight(aValue: Integer); override; + procedure SetWidth(aValue: Integer); override; + +// procedure ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; +// procedure ControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure UpdateVisibility; override; + procedure UpdateEnableStatus; override; + function DoPanelHandleMouseWheelByDefault: Boolean; virtual; + public + PanelHandleMouseWheelByDefault: Boolean; //Do whole panel handle MW by default? Usually it is + FocusedControlIndex: Integer; //Index of currently focused control on this Panel + ChildCount: Word; + Childs: array of TKMControl; + constructor Create(aParent: TKMMasterControl; aLeft, aTop, aWidth, aHeight: Integer); overload; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); overload; + destructor Destroy; override; + function AddChild(aChild: TKMControl): Integer; virtual; + procedure SetCanChangeEnable(aEnable: Boolean; aExceptControls: array of TKMControlClass; aAlsoSetEnable: Boolean = True); + + function FindFocusableControl(aFindNext: Boolean): TKMControl; + procedure FocusNext; + procedure ResetFocusedControlIndex; + + property MasterControl: TKMMasterControl read fMasterControl; + + procedure Paint; override; + + procedure UpdateState(aTickCount: Cardinal); override; + end; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + SysUtils, StrUtils, Math, + Clipbrd, + KromUtils, + KM_System, + KM_ControlsBase, KM_ControlsDragger, KM_ControlsEdit, KM_ControlsSwitch, KM_ControlsTrackBar, KM_ControlsTypes, + KM_ControlsWaresRow, + KM_Resource, KM_ResSprites, KM_ResSound, KM_ResTexts, KM_ResKeys, + KM_Render, KM_RenderTypes, + KM_Sound, KM_CommonUtils, KM_UtilsExt, + KM_GameSettings, KM_InterfaceTypes; + + +const + CLICK_HOLD_TIME_THRESHOLD = 200; // Time period, determine delay between mouse down and 1st click hold events + + +{ TKMControl } +constructor TKMControl.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create; + + Scale := 1; + fHitable := True; //All controls can be clicked by default + CanChangeEnable := True; //All controls can change enable status by default + fLeft := aLeft; + fTop := aTop; + fWidth := aWidth; + fHeight := aHeight; + + fBaseWidth := aWidth; + fBaseHeight := aHeight; + + Anchors := [anLeft, anTop]; + State := []; + fEnabled := True; + fVisible := True; + Tag := 0; + fHint := ''; + fHintBackColor := TKMColor4f.New(0, 0, 0, 0.7); // Black with 0.7 alpha + fMouseWheelStep := 1; + fControlIndex := -1; + AutoFocusable := True; + HandleMouseWheelByDefault := True; + fLastClickPos := KMPOINT_ZERO; + fIsHitTestUseDrawRect := False; + DebugHighlight := False; + +// fKeyPressList := TList.Create; + + if aParent <> nil then + fID := aParent.fMasterControl.GetNextCtrlID + else + if Self is TKMPanel then + fID := 0; + + //Parent will be Nil only for master Panel which contains all the controls in it + fParent := aParent; + if aParent <> nil then + fControlIndex := aParent.AddChild(Self); +end; + +destructor TKMControl.Destroy; +begin +// fKeyPressList.Free; + + inherited; +end; + + +procedure TKMControl.DebugKeyDown(Key: Word; Shift: TShiftState); +var + amt: Byte; +begin + if MODE_DESIGN_CONTROLS then + begin + amt := 1; + if ssShift in Shift then amt := 10; + if ssAlt in Shift then amt := 100; + + if Key = VK_LEFT then fLeft := fLeft - amt; + if Key = VK_RIGHT then fLeft := fLeft + amt; + if Key = VK_UP then fTop := fTop - amt; + if Key = VK_DOWN then fTop := fTop + amt; + if Key = VK_HOME then fWidth := fWidth + amt; + if Key = VK_END then fWidth := fWidth - amt; + if Key = VK_PRIOR then fHeight := fHeight + amt; + if Key = VK_NEXT then fHeight := fHeight - amt; + end; +end; + + +function TKMControl.KeyDown(Key: Word; Shift: TShiftState): Boolean; +//var +// keyPress: TKMKeyPress; +begin +// if fKeyPressList.Count = 0 then +// keyPress.Time := TimeGetUSec +// else +// keyPress.Time := TimeSinceUSec(fKeyPressList[0].Time); + +// keyPress.Key := Key; +// keyPress.C := Char(Key); +// keyPress.Kind := kpkDown; +// fKeyPressList.Add(keyPress); + + Result := MODE_DESIGN_CONTROLS; + + if Assigned(fOnKeyDown) then + Result := fOnKeyDown(Self, Key, Shift); + + // Exit if control handlers handle the event + if Result then + Exit; + + // Unfocus focused control without AutoFocusable flag on Esc key + if IsFocused and not AutoFocusable and (Key = VK_ESCAPE) then + Unfocus; +end; + + +procedure TKMControl.KeyPress(Key: Char); +//var +// I: Integer; +// keyPress: TKMKeyPress; +begin +// if fKeyPressList.Count = 0 then +// keyPress.Time := TimeGetUSec +// else +// keyPress.Time := TimeSinceUSec(fKeyPressList[0].Time); +//// keyPress.Key := 0; +// keyPress.C := Key; +// keyPress.Kind := kpkPress; +// +// fKeyPressList.Add(keyPress); + +// gLog.AddTime('KeyPressList cnt ' + IntToStr(fKeyPressList.Count)); +// for I := 0 to fKeyPressList.Count - 1 do +// gLog.AddTime(fKeyPressList[I].ToString); + + //Could be something common +end; + + +function TKMControl.CanFocusNext: Boolean; +begin + Result := True; +end; + + +function TKMControl.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := False; + if (Key = VK_TAB) and CanFocusNext and IsFocused then + begin + Parent.FocusNext; + Exit(True); + end; + + if Assigned(fOnKeyUp) then + Result := fOnKeyUp(Self, Key, Shift); +end; + + +procedure TKMControl.ResetClickHoldMode; +begin + if Self <> nil then // Could be nil when control is destroyes already, f.e. on game (map) exit + begin + fClickHoldMode := False; + fClickHoldHandled := False; + end; +end; + + +procedure TKMControl.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + //if Assigned(fOnMouseDown) then fOnMouseDown(Self); { Unused } + fClickHoldMode := True; + fTimeOfLastMouseDown := TimeGet; + fLastMouseDownButton := Button; +end; + + +procedure TKMControl.MouseMove(X,Y: Integer; Shift: TShiftState); +begin + //if Assigned(fOnMouseOver) then fOnMouseOver(Self); { Unused } + if (csDown in State) then + begin + //Update fClickHoldMode + if InRange(X, AbsLeft, AbsRight) and InRange(Y, AbsTop, AbsBottom) then + fClickHoldMode := True + else + fClickHoldMode := False; + end; +end; + + +procedure TKMControl.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + clickHoldHandled: Boolean; +begin + //if Assigned(fOnMouseUp) then OnMouseUp(Self); { Unused } + + if (csDown in State) then + begin + State := State - [csDown]; + clickHoldHandled := fClickHoldHandled; + ResetClickHoldMode; + //Send Click events + if not clickHoldHandled then // Do not send click event, if it was handled already while in click hold mode + DoClick(X, Y, Shift, Button); + end; + // No code is allowed after DoClick, as control object could be destroyed, + // that means we will modify freed memory, which will cause memory leaks +end; + + +function TKMControl.GetIDsStr: String; +begin + if Self = nil then Exit(''); + + Result := IntToStr(fID) + ' ' + fParent.GetIDsStr; +end; + + +function TKMControl.GetHint: UnicodeString; +begin + Result := fHint; +end; + + +function TKMControl.GetHintFont: TKMFont; +begin + Result := fntMonospaced; // Should be actually overridden in the ancestors +end; + + +function TKMControl.IsHintSelected: Boolean; +begin + Result := False; +end; + + +function TKMControl.GetHintKind: TKMHintKind; +begin + Result := hkControl; +end; + + +procedure TKMControl.SetHintBackColor(const aValue: TKMColor4f); +begin + fHintBackColor := aValue; +end; + + +function TKMControl.GetHintBackColor: TKMColor4f; +begin + Result := fHintBackColor; +end; + + +function TKMControl.GetHintBackRect: TKMRect; +begin + Result := KMRECT_ZERO; +end; + + +function TKMControl.GetHintTextColor: TColor4; +begin + Result := icWhite; +end; + + +function TKMControl.GetHintTextOffset: TKMPoint; +begin + Result := KMPOINT_ZERO; +end; + + +procedure TKMControl.SetHint(const aHint: UnicodeString); +begin + //fHint := StringReplace(aHint, '|', ' ', [rfReplaceAll]); //Not sure why we were need to replace | here... + fHint := aHint; +end; + + +function TKMControl.DoHandleMouseWheelByDefault: Boolean; +begin + Result := HandleMouseWheelByDefault //Controls handle MouseWheel by default + and Parent.DoPanelHandleMouseWheelByDefault; //But their parent could override this +end; + + +procedure TKMControl.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + if Assigned(fOnMouseWheel) then + fOnMouseWheel(Self, WheelSteps, aHandled) + else + if fParent <> nil then + begin + if DoHandleMouseWheelByDefault then + fParent.MouseWheel(Sender, WheelSteps, aHandled) + else + aHandled := False; + end + else + aHandled := False; +end; + + +//fVisible is checked earlier +function TKMControl.HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; +begin + Result := False; + if (Hitable or aIncludeNotHitable) + and (fEnabled or aIncludeDisabled) then + begin + //DrawRect could is restricted by parent panel size and also could be restricted with parent ScrollPanel + //While outside of ScrollPanel its better to use Abs coordinates + //since some childs could be outside of its parent borders for some reason + if fIsHitTestUseDrawRect then + Result := KMInRect(TKMPoint.New(X,Y), GetDrawRect) + else + Result := InRange(X, AbsLeft, AbsRight) + and InRange(Y, AbsTop, AbsBottom); + end; +end; + + +// One common thing - draw childs for self +procedure TKMControl.Paint; +var + sColor: TColor4; + tmp: TKMPoint; + skipText: Boolean; +begin + Inc(PaintCount); + + if SHOW_FOCUSED_CONTROL and (csFocus in State) then + TKMRenderUI.WriteOutline(AbsLeft-2, AbsTop-2, Width+4, Height+4, 2, $FF00D0FF); + + if (SHOW_CONTROL_OVER or MODE_DESIGN_CONTROLS) and (csOver in State) then + TKMRenderUI.WriteOutline(AbsLeft-2, AbsTop-2, Width+4, Height+4, 2, $FFFFD000); + + if SHOW_CONTROLS_ID then + begin + skipText := SKIP_RENDER_TEXT; //Save value + SKIP_RENDER_TEXT := False; // Force Render debug data + TKMRenderUI.WriteText(AbsLeft+1, AbsTop, fWidth, IntToStr(fID), TKMFont(DEBUG_TEXT_FONT_ID), taLeft); + SKIP_RENDER_TEXT := skipText; // Restore value + end; + + if DebugHighlight then + TKMRenderUI.WriteOutline(AbsLeft-2, AbsTop-2, Width+4, Height+4, 2, icRed); + + if not SHOW_CONTROLS_OVERLAY then Exit; + + sColor := $00000000; + + if Self is TKMPanel then sColor := $200000FF; + + if Self is TKMLabel then + begin //Special case for aligned text + tmp := TKMLabel(Self).TextSize; + TKMRenderUI.WriteShape(TKMLabel(Self).TextLeft, AbsTop, tmp.X, tmp.Y, $4000FFFF, $80FFFFFF); + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, fWidth, fHeight, 1, $FFFFFFFF); + TKMRenderUI.WriteShape(AbsLeft-3, AbsTop-3, 6, 6, sColor or $FF000000, $FFFFFFFF); + Exit; + end; + + if Self is TKMLabelScroll then + begin //Special case for aligned text + tmp := TKMLabelScroll(Self).TextSize; + TKMRenderUI.WriteShape(TKMLabelScroll(Self).TextLeft, AbsTop, tmp.X, tmp.Y, $4000FFFF, $80FFFFFF); + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, fWidth, fHeight, 1, $FFFFFFFF); + TKMRenderUI.WriteShape(AbsLeft-3, AbsTop-3, 6, 6, sColor or $FF000000, $FFFFFFFF); + Exit; + end; + + if Self is TKMImage then sColor := $2000FF00; + if Self is TKMImageStack then sColor := $2080FF00; + if Self is TKMCheckBox then sColor := $20FF00FF; + if Self is TKMTrackBar then sColor := $2000FF00; + if Self is TKMCostsRow then sColor := $2000FFFF; + if Self is TKMRadioGroup then sColor := $20FFFF00; + + if csOver in State then sColor := sColor OR $30000000; //Highlight on mouse over + + TKMRenderUI.WriteShape(AbsLeft, AbsTop, fWidth, fHeight, sColor, $FFFFFFFF); + TKMRenderUI.WriteShape(AbsLeft-3, AbsTop-3, 6, 6, sColor or $FF000000, $FFFFFFFF); +end; + + +function TKMControl.GetMasterPanel: TKMPanel; +begin + // Parent is nil only for MasterPanel itself + if Parent = nil then Exit(TKMPanel(Self)); + + Result := Parent.MasterControl.MasterPanel; +end; + + +{Shortcuts to Controls properties} +procedure TKMControl.SetAbsLeft(aValue: Integer); +begin + if Parent = nil then + Left := aValue + else + Left := Round((aValue - Parent.AbsLeft) / Parent.Scale); +end; + +procedure TKMControl.SetAbsTop(aValue: Integer); +begin + if Parent = nil then + Top := aValue + else + Top := Round((aValue - Parent.AbsTop) / Parent.Scale); +end; + +//GetAbsCoordinates +function TKMControl.GetAbsBottom: Integer; +begin + Result := GetAbsTop + GetHeight; +end; + +function TKMControl.GetAbsLeft: Integer; +begin + if Parent = nil then + Result := Round(fLeft) + else + Result := Round(fLeft * Parent.Scale) + Parent.GetAbsLeft; +end; + +function TKMControl.GetAbsRight: Integer; +begin + Result := GetAbsLeft + GetWidth; +end; + +function TKMControl.GetAbsTop: Integer; +begin + if Parent = nil then + Result := Round(fTop) + else + Result := Round(fTop * Parent.Scale) + Parent.GetAbsTop; +end; +//------------------------------- + +//AbsDrawCoordinates +function TKMControl.GetAbsDrawLeft: Integer; +begin + Result := GetAbsLeft; +end; + +function TKMControl.GetAbsDrawTop: Integer; +begin + Result := GetAbsTop; +end; + +function TKMControl.GetAbsDrawRight: Integer; +begin + Result := GetAbsRight; +end; + +function TKMControl.GetAbsDrawBottom: Integer; +begin + Result := GetAbsBottom; +end; +//------------------------------- + +function TKMControl.GetLeft: Integer; +begin + Result := Round(fLeft) +end; + +function TKMControl.GetTop: Integer; +begin + Result := Round(fTop) +end; + +function TKMControl.GetBottom: Integer; +begin + Result := GetTop + GetHeight; +end; + +function TKMControl.GetRight: Integer; +begin + Result := GetLeft + GetWidth; +end; + + +procedure TKMControl.SetLeft(aValue: Integer); +begin + fLeft := aValue; + + if Assigned(fOnPositionSet) then + fOnPositionSet(Self); +end; + + +procedure TKMControl.SetTop(aValue: Integer); +begin + fTop := aValue; + + if Assigned(fOnPositionSet) then + fOnPositionSet(Self); +end; + + +procedure TKMControl.SetLeftSilently(aValue: Integer); +begin + fLeft := aValue; +end; + + +procedure TKMControl.SetTopSilently(aValue: Integer); +begin + fTop := aValue; +end; + + +procedure TKMControl.SetHeightSilently(aValue: Integer); +begin + fHeight := aValue; +end; + + +procedure TKMControl.SetWidthSilently(aValue: Integer); +begin + fWidth := aValue; +end; + + +function TKMControl.GetHeight: Integer; +begin + Result := fHeight; +end; + + +function TKMControl.GetWidth: Integer; +begin + Result := fWidth; +end; + + +function TKMControl.GetCenter: TKMPoint; +begin + Result := TKMPoint.New(GetLeft + (GetWidth div 2), GetTop + (GetHeight div 2)); +end; + + +function TKMControl.GetSelfAbsLeft: Integer; +begin + Result := AbsLeft; +end; + + +function TKMControl.GetSelfAbsTop: Integer; +begin + Result := AbsTop; +end; + + +function TKMControl.GetSelfHeight: Integer; +begin + Result := fHeight; +end; + + +function TKMControl.GetSelfWidth: Integer; +begin + Result := fWidth; +end; + + +procedure TKMControl.SetTopF(aValue: Single); +begin + //Call child classes SetTop methods + SetTop(Round(aValue)); + + //Assign actual FP value + fTop := aValue; +end; + +procedure TKMControl.SetLeftF(aValue: Single); +begin + //Call child classes SetTop methods + SetLeft(Round(aValue)); + + //Assign actual FP value + fLeft := aValue; +end; + + +function TKMControl.GetControlRect: TKMRect; +begin + Result := KMRect(Left, Top, Left + Width, Top + Height); +end; + + +function TKMControl.GetControlAbsRect: TKMRect; +begin + Result := KMRect(AbsLeft, AbsTop, AbsRight, AbsBottom); +end; + + +function TKMControl.GetIsFocused: Boolean; +begin + Result := csFocus in State; +end; + + +function TKMControl.GetIsClickable: Boolean; +begin + Result := Visible and Enabled; +end; + + +//Overriden in child classes +procedure TKMControl.SetHeight(aValue: Integer); +var + oldH: Integer; +begin + oldH := fHeight; + fHeight := aValue; + + if (oldH <> fHeight) and Assigned(fOnHeightChange) then + fOnHeightChange(Self, fHeight); + + if Assigned(fOnSizeSet) then + fOnSizeSet(Self); +end; + +//Overriden in child classes +procedure TKMControl.SetWidth(aValue: Integer); +var + oldW: Integer; +begin + oldW := fHeight; + fWidth := aValue; + + if (oldW <> fWidth) and Assigned(fOnWidthChange) then + fOnWidthChange(Self, fWidth); + + if Assigned(fOnSizeSet) then + fOnSizeSet(Self); +end; + + +function TKMControl.GetDrawRect: TKMRect; +begin + if fParent <> nil then + begin + Result := fParent.GetDrawRect; + if Result <> KMRECT_INVALID_TILES then + Result := KMRectIntersect(Result, AbsDrawLeft, AbsDrawTop, AbsDrawRight, AbsDrawBottom); + end else + Result := KMRect(AbsDrawLeft, AbsDrawTop, AbsDrawRight, AbsDrawBottom); +end; + + +//Let the control know that it was clicked to do its internal magic +procedure TKMControl.DoClick(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + //Note that we process double-click separately (actual sequence is Click + Double-Click) + //because we would not like to delay Click just to make sure it is single. + //On the ther hand it does no harm to call Click first + if (Button = mbLeft) + and Assigned(fOnDoubleClick) + and KMSamePoint(fLastClickPos, TKMPoint.New(X,Y)) + and (TimeSince(fTimeOfLastClick) <= GetDoubleClickTime) then + begin + fTimeOfLastClick := 0; + fOnDoubleClick(Self); + end + else + begin + if (Button = mbLeft) and Assigned(fOnDoubleClick) then + begin + fTimeOfLastClick := TimeGet; + fLastClickPos := TKMPoint.New(X,Y); + end; + + if Assigned(fOnClickShift) then + fOnClickShift(Self, Shift) + else + if (Button = mbLeft) and Assigned(fOnClick) then + fOnClick(Self) + else + if (Button = mbRight) and Assigned(fOnClickRight) then + fOnClickRight(Self, X, Y); + end; +end; + + +procedure TKMControl.DoClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); +begin + aHandled := False; + //Let descendants override this method +end; + + +// Check Control including all its Parents to see if Control is actually displayed/visible +function TKMControl.GetVisible: Boolean; +begin + if Self = nil then Exit(False); + + Result := fVisible and ((Parent = nil) or Parent.Visible); +end; + + +function TKMControl.GetIsPainted: Boolean; +begin + Result := GetVisible; +end; + + +procedure TKMControl.SetEnabled(aValue: Boolean); +var + oldEnabled: Boolean; +begin + if not CanChangeEnable then Exit; //Change enability is blocked + + oldEnabled := fEnabled; + fEnabled := aValue; + + // Only swap focus if enability changed + if (oldEnabled <> fEnabled) and (Focusable or (Self is TKMPanel)) then + MasterParent.fMasterControl.UpdateFocus(Self); + + UpdateEnableStatus; +end; + + +procedure TKMControl.SetFocusable(const aValue: Boolean); +var + oldFocusable: Boolean; +begin + oldFocusable := fFocusable; + + fFocusable := aValue; + + // Update focus if Focusable was changed + if oldFocusable <> fFocusable then + Parent.MasterControl.UpdateFocus(Self); +end; + + +procedure TKMControl.SetHitable(const aValue: Boolean); +begin + fHitable := aValue; +end; + + +procedure TKMControl.SetAnchors(aValue: TKMAnchorsSet); +begin + fAnchors := aValue; +end; + + +procedure TKMControl.SetVisible(aValue: Boolean); +var + oldVisible: Boolean; +begin + oldVisible := fVisible; + fVisible := aValue; + + //Swap focus and UpdateVisibility only if visibility changed + if (oldVisible <> fVisible) then + begin + if Focusable or (Self is TKMPanel) then + MasterParent.fMasterControl.UpdateFocus(Self); + + UpdateVisibility; + end; +end; + + +procedure TKMControl.UpdateState(aTickCount: Cardinal); +var + sameMouseBtn: Boolean; +begin + if (csDown in State) and fClickHoldMode and (TimeSince(fTimeOfLastMouseDown) > CLICK_HOLD_TIME_THRESHOLD) then + begin + sameMouseBtn := False; + case fLastMouseDownButton of + mbLeft: sameMouseBtn := (GetKeyState(VK_LBUTTON) < 0); + mbRight: sameMouseBtn := (GetKeyState(VK_RBUTTON) < 0); + end; + if sameMouseBtn then + begin + DoClickHold(Self, fLastMouseDownButton, fClickHoldHandled); + if Assigned(fOnClickHold) then + fOnClickHold(Self, fLastMouseDownButton, fClickHoldHandled); + end else + ResetClickHoldMode; //Can happen if user alt-tab from game window while holding MB. Reset Click Hold mode then + end; + +end; + + +procedure TKMControl.UpdateVisibility; +begin + if Assigned(fOnChangeVisibility) then + fOnChangeVisibility(Self, fVisible); + //Let descendants override this method +end; + + +procedure TKMControl.UpdateEnableStatus; +begin + if Assigned(fOnChangeEnableStatus) then + fOnChangeEnableStatus(Self, fEnabled); + //Let descendants override this method +end; + + +procedure TKMControl.FocusChanged(aFocused: Boolean); +begin + //Let descendants override this method +end; + + +//procedure TKMControl.ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +//begin +// //Let descendants override this method +//end; +// +// +//procedure TKMControl.ControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +//begin +// //Let descendants override this method +//end; + + +procedure TKMControl.Enable; begin SetEnabled(True); end; //Overrides will be set too +procedure TKMControl.Disable; begin SetEnabled(False); end; + + +// Show up entire branch in which control resides +procedure TKMControl.Show; +begin + if Parent <> nil then Parent.Show; + Visible := True; +end; + + +procedure TKMControl.ToggleVisibility; +begin + Visible := not Visible; +end; + + +procedure TKMControl.Hide; +begin + Visible := False; +end; + + +procedure TKMControl.DoSetVisible; +begin + Visible := True; +end; + + +procedure TKMControl.AnchorsCenter; +begin + Anchors := []; +end; + + +procedure TKMControl.AnchorsStretch; +begin + Anchors := [anLeft, anTop, anRight, anBottom]; +end; + + +procedure TKMControl.Focus; +begin + if not IsFocused and Focusable then + begin + // Reset master control focus + Parent.fMasterControl.CtrlFocus := nil; + Parent.FocusedControlIndex := ControlIndex; + Parent.fMasterControl.CtrlFocus := Self; +// Parent.fMasterControl.UpdateFocus(Parent); // It looks like we can manually set focus, no need for update procedure + end; +end; + + +procedure TKMControl.Unfocus; +begin + Parent.fMasterControl.CtrlFocus := nil; +end; + + +function TKMControl.MasterParent: TKMPanel; +var + P: TKMPanel; +begin + if not (Self is TKMPanel) then + P := Parent + else + P := TKMPanel(Self); + + while P.Parent <> nil do + P := P.Parent; + Result := P; +end; + + +procedure TKMControl.SetPosCenterW; +begin + Left := (Parent.Width - Width) div 2; +end; + + +procedure TKMControl.SetPosCenterH; +begin + Top := (Parent.Height - Height) div 2; +end; + + +procedure TKMControl.SetPosCenter; +begin + SetPosCenterW; + SetPosCenterH; +end; + + +function TKMControl.ToStr: string; +begin + if Self = nil then Exit('nil'); + + Result := Format('ID=%d ParentID=%d Class=%s AbsPos: (%d;%d) Pos: (%d;%d) Sizes: [%d;%d]', + [fID, Parent.ID, ClassName, AbsLeft, AbsTop, Left, Top, fWidth, fHeight]); +end; + + +{ TKMPanel } //virtual panels that contain child items +constructor TKMPanel.Create(aParent: TKMMasterControl; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(nil, aLeft, aTop, aWidth, aHeight); + + fMasterControl := aParent; + aParent.fMasterPanel := Self; + Init; +end; + + +constructor TKMPanel.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fMasterControl := aParent.fMasterControl; + Init; +end; + + +procedure TKMPanel.Init; +begin + ResetFocusedControlIndex; + PanelHandleMouseWheelByDefault := True; //Panels handle mousewheel by default +end; + + +procedure TKMPanel.ResetFocusedControlIndex; +begin + FocusedControlIndex := -1; +end; + + +destructor TKMPanel.Destroy; +var + I: Integer; +begin + for I := 0 to ChildCount - 1 do + Childs[I].Free; + + inherited; +end; + + +function TKMPanel.FindFocusableControl(aFindNext: Boolean): TKMControl; +var + I, ctrlToFocusI: Integer; +begin + Result := nil; + ctrlToFocusI := -1; + for I := 0 to ChildCount - 1 do + if fMasterControl.IsAutoFocusAllowed(Childs[I]) and ( + (FocusedControlIndex = -1) // If FocusControl was not set (no focused element on panel) + or (FocusedControlIndex = Childs[I].ControlIndex) // We've found last focused Control + or (ctrlToFocusI <> -1)) then // We did find last focused Control on previos iterations + begin + //Do we need to find next focusable control ? + if aFindNext and (ctrlToFocusI = -1) + //FocusedControlIndex = -1 means there is no focus on this panel. Then we need to focus on first good control + and (FocusedControlIndex <> -1) then + begin + ctrlToFocusI := I; + Continue; + end else begin + Result := Childs[I]; // We find Control to focus on, then exit + Exit; + end; + end; + + // If we did not find Control to focus on, try to find in the first controls of Panel (let's cycle the search) + if ctrlToFocusI <> -1 then + begin + // We will try to find it until the same Control, that we find before in previous For cycle + for I := 0 to ctrlToFocusI do // So if there will be no proper controls, then set focus again to same control with I = CtrlToFocusI + if fMasterControl.IsAutoFocusAllowed(Childs[I]) then + begin + Result := Childs[I]; + Exit; + end; + end; +end; + + +//Focus next focusable control on this Panel +procedure TKMPanel.FocusNext; +var + ctrl: TKMControl; +begin + if InRange(FocusedControlIndex, 0, ChildCount - 1) then + begin + ctrl := FindFocusableControl(True); + if ctrl <> nil then + FocusedControlIndex := ctrl.ControlIndex; // update FocusedControlIndex to let fCollection.UpdateFocus focus on it + //Need to update Focus only through UpdateFocus + fMasterControl.UpdateFocus(Self); + end; +end; + + +function TKMPanel.AddChild(aChild: TKMControl): Integer; +begin + //Descendants of TKMScrollPanel should all use DrawRect for HitTest + aChild.fIsHitTestUseDrawRect := fIsHitTestUseDrawRect; + + if ChildCount >= Length(Childs) then + SetLength(Childs, ChildCount + 16); + + Childs[ChildCount] := aChild; + Result := ChildCount; + Inc(ChildCount); +end; + + +procedure TKMPanel.SetCanChangeEnable(aEnable: Boolean; aExceptControls: array of TKMControlClass; aAlsoSetEnable: Boolean = True); +var + I, J: Integer; + skipChild: Boolean; +begin + if aEnable and aAlsoSetEnable then + Enabled := aEnable; + for I := 0 to ChildCount - 1 do + begin + if Childs[I] is TKMPanel then + TKMPanel(Childs[I]).SetCanChangeEnable(aEnable, aExceptControls, aAlsoSetEnable) + else begin + skipChild := False; + for J := Low(aExceptControls) to High(aExceptControls) do + if Childs[I] is aExceptControls[J] then + begin + skipChild := True; + Break; + end; + + if skipChild then + Continue; + + //Unblock first to be able to change Enable status + if aEnable then + Childs[I].CanChangeEnable := aEnable; + + if aAlsoSetEnable then + begin + Childs[I].Enabled := aEnable; + //Set fEnabledVisually for TKMButtonFlat. They looks better in that case + if Childs[I] is TKMButtonFlat then + Childs[I].fEnabledVisually := not aEnable; + end; + + if not aEnable then + Childs[I].CanChangeEnable := aEnable; + end; + end; + if not aEnable and aAlsoSetEnable then + Enabled := aEnable; +end; + + +procedure TKMPanel.SetHeight(aValue: Integer); +var + I, diff: Integer; +begin + for I := 0 to ChildCount - 1 do + begin + diff := aValue - fHeight; + + if (anTop in Childs[I].Anchors) and (anBottom in Childs[I].Anchors) then + Childs[I].Height := Childs[I].Height + diff + else + if anTop in Childs[I].Anchors then + //Do nothing + else + if anBottom in Childs[I].Anchors then + Childs[I].SetTopF(Childs[I].fTop + diff) + else + begin + // Fit into parent panel + if Childs[I].FitInParent then + begin + // Child base is bigger, than parent is going to be + if aValue < Childs[I].BaseHeight then + begin + Childs[I].Height := aValue; + Childs[I].SetTopF(0); + end + else + // Child base is smaller, restore it BaseHeight + begin + Childs[I].Height := Childs[I].BaseHeight; + // Use 'centered' position for now + // We could try to save or to set 'baseTop as a float value of total parent height' in the future + Childs[I].SetTopF((aValue - Childs[I].Height) / 2); + end; + end + else + Childs[I].SetTopF(Childs[I].fTop + diff / 2); + end; + end; + + inherited; +end; + + +procedure TKMPanel.SetWidth(aValue: Integer); +var + I: Integer; +begin + for I := 0 to ChildCount - 1 do + if (anLeft in Childs[I].Anchors) and (anRight in Childs[I].Anchors) then + Childs[I].Width := Childs[I].Width + (aValue - fWidth) + else + if anLeft in Childs[I].Anchors then + //Do nothing + else + if anRight in Childs[I].Anchors then + Childs[I].SetLeftF(Childs[I].fLeft + (aValue - fWidth)) + else + begin + // Fit into parent panel + if Childs[I].FitInParent then + begin + // Child base is bigger, than parent is going to be + if aValue < Childs[I].BaseWidth then + begin + Childs[I].Width := aValue; + Childs[I].SetLeftF(0); + end + else + // Child base is smaller, restore it BaseWidth + begin + Childs[I].Width := Childs[I].BaseWidth; + // Use 'centered' position for now + // We could try to save or to set 'baseLeft as a float value of total parent width' in the future + Childs[I].SetLeftF((aValue - Childs[I].Width) / 2); + end; + end + else + Childs[I].SetLeftF(Childs[I].fLeft + (aValue - fWidth) / 2); + end; + + inherited; +end; + + +//procedure TKMPanel.ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +//var +// I: Integer; +//begin +// inherited; +// for I := 0 to ChildCount - 1 do +// Childs[I].ControlMouseDown(Sender, X, Y, Shift, Button); +//end; +// +// +//procedure TKMPanel.ControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +//var +// I: Integer; +//begin +// inherited; +// for I := 0 to ChildCount - 1 do +// Childs[I].ControlMouseUp(Sender, X, Y, Shift, Button); +//end; + + +procedure TKMPanel.UpdateState(aTickCount: Cardinal); +var + I: Integer; +begin + for I := 0 to ChildCount - 1 do + Childs[I].UpdateState(aTickCount); +end; + + +procedure TKMPanel.UpdateVisibility; +var + I: Integer; +begin + inherited; + for I := 0 to ChildCount - 1 do + Childs[I].UpdateVisibility; +end; + + +procedure TKMPanel.UpdateEnableStatus; +var + I: Integer; +begin + inherited; + for I := 0 to ChildCount - 1 do + Childs[I].UpdateEnableStatus; +end; + + +function TKMPanel.DoPanelHandleMouseWheelByDefault: Boolean; +begin + Result := PanelHandleMouseWheelByDefault //Panels handle mousewheel by default + and ((Parent = nil) or Parent.DoPanelHandleMouseWheelByDefault); //But their parents could override this +end; + + +procedure TKMPanel.Paint; +var + I: Integer; +begin + // Paint self (dev overlays) + inherited; + + // Paint children + for I := 0 to ChildCount - 1 do + if Childs[I].fVisible then + Childs[I].Paint; +end; + + +{ TKMMasterControl } +constructor TKMMasterControl.Create; +begin + inherited; + + fMouseMoveSubsList := TList.Create; + fMouseDownSubsList := TList.Create; + fMouseUpSubsList := TList.Create; +end; + + +destructor TKMMasterControl.Destroy; +begin + fMouseUpSubsList.Free; + fMouseDownSubsList.Free; + fMouseMoveSubsList.Free; + + // Free and nil to avoid problems on game Exit (MouseMove invokes ScanChilds over object, while he is going to be freed) + // So we want to object to be nil'ed first, so we could check it in the ScanChilds + // Will destroy all its childs as well + FreeAndNil(fMasterPanel); + + inherited; +end; + + +procedure TKMMasterControl.SubscribeOnOtherMouseMove(const aMouseMoveEvent: TKMNotifyEventMouseMove); +begin + if Self = nil then Exit; + + fMouseMoveSubsList.Add(aMouseMoveEvent); +end; + + +procedure TKMMasterControl.SubscribeOnOtherMouseDown(const aMouseDownEvent: TKMNotifyEventMouseButton); +begin + if Self = nil then Exit; + + fMouseDownSubsList.Add(aMouseDownEvent); +end; + + +procedure TKMMasterControl.SubscribeOnOtherMouseUp(const aMouseUpEvent: TKMNotifyEventMouseButton); +begin + if Self = nil then Exit; + + fMouseUpSubsList.Add(aMouseUpEvent); +end; + + +procedure TKMMasterControl.SetCtrlDown(aCtrl: TKMControl); +begin + if fCtrlDown <> nil then + fCtrlDown.State := fCtrlDown.State - [csDown]; //Release previous + + if aCtrl <> nil then + aCtrl.State := aCtrl.State + [csDown]; //Press new + + fCtrlDown := aCtrl; //Update info +end; + + +procedure TKMMasterControl.SetCtrlFocus(aCtrl: TKMControl); +begin + if fCtrlFocus <> nil then + fCtrlFocus.State := fCtrlFocus.State - [csFocus]; + + if aCtrl <> nil then + aCtrl.State := aCtrl.State + [csFocus]; + + if aCtrl <> fCtrlFocus then + begin + if fCtrlFocus <> nil then + begin + fCtrlFocus.FocusChanged(False); + if fCtrlFocus <> nil then + begin + if Assigned(fCtrlFocus.fOnFocus) then + fCtrlFocus.fOnFocus(fCtrlFocus, False); + // Reset Parent Panel FocusedControlIndex only for different parents + if (aCtrl = nil) or (aCtrl.Parent <> fCtrlFocus.Parent) then + fCtrlFocus.Parent.ResetFocusedControlIndex; + end; + end; + + if aCtrl <> nil then + begin + aCtrl.FocusChanged(True); + if Assigned(aCtrl.fOnFocus) then + aCtrl.fOnFocus(aCtrl, True); + aCtrl.Parent.FocusedControlIndex := aCtrl.ControlIndex; //Set Parent Panel FocusedControlIndex to new focused control + end; + end; + + fCtrlFocus := aCtrl; +end; + + +procedure TKMMasterControl.SetCtrlOver(aCtrl: TKMControl); +begin + if fCtrlOver <> nil then fCtrlOver.State := fCtrlOver.State - [csOver]; + if aCtrl <> nil then aCtrl.State := aCtrl.State + [csOver]; + fCtrlOver := aCtrl; +end; + + +procedure TKMMasterControl.SetCtrlUp(aCtrl: TKMControl); +begin + fCtrlUp := aCtrl; + //Give focus only to controls with Focusable=True + if (fCtrlUp <> nil) and fCtrlUp.Focusable then + if fCtrlDown = fCtrlUp then + CtrlFocus := fCtrlUp + else + CtrlFocus := nil; +end; + + +//Check If Control if it is allowed to be focused on (manual or automatically) +function TKMMasterControl.IsFocusAllowed(aCtrl: TKMControl): Boolean; +begin + if Self = nil then Exit(False); + + Result := aCtrl.fVisible + and aCtrl.Enabled + and aCtrl.Focusable + and not IsCtrlCovered(aCtrl); // Do not allow to focus on covered Controls +end; + + +//Check If Control if it is allowed to be automatically (not manual, by user) focused on +function TKMMasterControl.IsAutoFocusAllowed(aCtrl: TKMControl): Boolean; +begin + if Self = nil then Exit(False); + + Result := aCtrl.AutoFocusable and IsFocusAllowed(aCtrl); +end; + + +function TKMMasterControl.GetNextCtrlID: Integer; +begin + Inc(fControlIDCounter); + Result := fControlIDCounter; +end; + + +//Update focused control +procedure TKMMasterControl.UpdateFocus(aSender: TKMControl); + + function FindFocusable(C: TKMPanel): Boolean; + var + I: Integer; + ctrl: TKMControl; + begin + Result := False; + ctrl := C.FindFocusableControl(False); + if ctrl <> nil then + begin + CtrlFocus := ctrl; + Result := True; + Exit; + end; + + for I := 0 to C.ChildCount - 1 do + if C.Childs[I].fVisible + and C.Childs[I].Enabled + and (C.Childs[I] is TKMPanel) then + begin + Result := FindFocusable(TKMPanel(C.Childs[I])); + if Result then Exit; + end; + end; + +begin + if Self = nil then Exit; + + if aSender.Visible and aSender.Enabled + and ((not (aSender is TKMPanel) and aSender.Focusable) or (aSender is TKMPanel)) then + begin + // Something showed up or became enabled + + // If something showed up - focus on it + if not (aSender is TKMPanel) and aSender.Focusable then + CtrlFocus := aSender; + // If panel showed up - try to focus on its contents + if aSender is TKMPanel then + FindFocusable(TKMPanel(aSender)); + end else + begin + // Something went hidden or disabled + if (CtrlFocus = nil) or not CtrlFocus.Visible or not CtrlFocus.Enabled or not CtrlFocus.Focusable then + begin + // If there was no focus, or it is our Focus control that went hidden or disabled + CtrlFocus := nil; + FindFocusable(fMasterPanel); + end; + end; +end; + + +procedure TKMMasterControl.UpdateState(aGlobalTickCount: Cardinal); +begin + if (Self = nil) or (fMasterPanel = nil) then Exit; + + fMasterPanel.UpdateState(aGlobalTickCount); +end; + + +//Check if control is covered by other controls or not +//We assume that control is covered if any of his 4 corners is covered +//For corners used actual corners with 1 px offset inside to solve border collisions +//Use Self coordinates to check, because some controls can contain other sub-controls (f.e. TKMNumericEdit) +function TKMMasterControl.IsCtrlCovered(aCtrl: TKMControl): Boolean; +begin + Result := (HitControl(aCtrl.SelfAbsLeft + 1, aCtrl.SelfAbsTop + 1) <> aCtrl) + or (HitControl(aCtrl.SelfAbsLeft + aCtrl.SelfWidth - 1, aCtrl.SelfAbsTop + 1) <> aCtrl) + or (HitControl(aCtrl.SelfAbsLeft + 1, aCtrl.SelfAbsTop + aCtrl.SelfHeight - 1) <> aCtrl) + or (HitControl(aCtrl.SelfAbsLeft + aCtrl.SelfWidth - 1, aCtrl.SelfAbsTop + aCtrl.SelfHeight - 1) <> aCtrl); +end; + + +{ Recursing function to find topmost control (excl. Panels)} +function TKMMasterControl.HitControl(X,Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): TKMControl; + + function ScanChild(P: TKMPanel; aX,aY: Integer): TKMControl; + var + I: Integer; + child: TKMControl; + begin + // Could sometimes happen on game exit? + if (Self = nil) or (P = nil) then Exit(nil); + + Result := nil; + //Process controls in reverse order since last created are on top + for I := P.ChildCount - 1 downto 0 do + begin + child := P.Childs[I]; + if child.fVisible then //If we can't see it, we can't touch it + begin + //Scan Panels childs first, if none is hit - hittest the panel + if (child is TKMPanel) then + begin + Result := ScanChild(TKMPanel(child),aX,aY); + if Result <> nil then + Exit; + end; + if child.HitTest(aX, aY, aIncludeDisabled, aIncludeNotHitable) then + begin + Result := child; + Exit; + end; + end; + end; + end; + +begin + if Self = nil then Exit(nil); + + Result := ScanChild(fMasterPanel, X, Y); +end; + + +function TKMMasterControl.KeyDown(Key: Word; Shift: TShiftState): Boolean; +var + control: TKMControl; +begin + Result := False; + + if Self = nil then Exit; + + //CtrlFocus could be on another menu page and no longer visible + if (CtrlFocus <> nil) and CtrlFocus.Visible then + begin + control := CtrlFocus; + //Lets try to find who can handle KeyDown event in controls tree + while (control <> nil) and not control.KeyDown(Key, Shift) do + control := control.Parent; + + Result := control <> nil; // means we find someone, who handle that event + end; + + if MODE_DESIGN_CONTROLS and (CtrlOver <> nil) then + CtrlOver.DebugKeyDown(Key, Shift); +end; + + +procedure TKMMasterControl.KeyPress(Key: Char); +begin + if Self = nil then Exit; + + //CtrlFocus could be on another menu page and no longer visible + if (CtrlFocus <> nil) and CtrlFocus.Visible then + CtrlFocus.KeyPress(Key); +end; + + +function TKMMasterControl.KeyUp(Key: Word; Shift: TShiftState): Boolean; +var + control: TKMControl; +begin + Result := False; + + if Self = nil then Exit; + + //CtrlFocus could be on another menu page and no longer visible + if (CtrlFocus <> nil) and CtrlFocus.Visible then + begin + control := CtrlFocus; + //Lets try to find who can handle KeyUp event in controls tree + while (control <> nil) and not control.KeyUp(Key, Shift) do + control := control.Parent; + + Result := control <> nil; // means we find someone, who handle that event + end; +end; + + +procedure TKMMasterControl.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + I: Integer; +begin + if Self = nil then Exit; + + CtrlDown := HitControl(X,Y); + + // Notify all ControlMouseDown subscribers + for I := 0 to fMouseDownSubsList.Count - 1 do + if Assigned(fMouseDownSubsList[I]) then + fMouseDownSubsList[I](CtrlDown, X, Y, Shift, Button); +// fMasterPanel.ControlMouseDown(CtrlDown, X, Y, Shift, Button); + + if CtrlDown <> nil then + CtrlDown.MouseDown(X, Y, Shift, Button); +end; + + +procedure TKMMasterControl.MouseMove(X,Y: Integer; Shift: TShiftState); +var + I: Integer; +begin + if Self = nil then Exit; + + CtrlOver := HitControl(X,Y); + + // Notify all ControlMouseMove subscribers + for I := 0 to fMouseMoveSubsList.Count - 1 do + if Assigned(fMouseMoveSubsList[I]) then + fMouseMoveSubsList[I](CtrlOver, X, Y, Shift); + + //User is dragging some Ctrl (e.g. scrollbar) and went away from Ctrl bounds + if (CtrlDown <> nil) and CtrlDown.Visible then + CtrlDown.MouseMove(X, Y, Shift) + else + if CtrlOver <> nil then + CtrlOver.MouseMove(X, Y, Shift); + + //The Game hides cursor when using DirectionSelector, don't spoil it + if gSystem.Cursor <> kmcInvisible then + begin + if CtrlOver is TKMEdit then + gSystem.Cursor := kmcEdit + else + if CtrlOver is TKMDragger then + gSystem.Cursor := kmcDragUp + else + if gSystem.Cursor in [kmcEdit, kmcDragUp] then + gSystem.Cursor := kmcDefault; //Reset the cursor from these two special cursors + end; +end; + + +procedure TKMMasterControl.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + I: Integer; +begin + CtrlUp := HitControl(X,Y); + + //Here comes tricky part, we can't do anything after calling an event (it might Destroy everything, + //e.g. Exit button, or Resolution change). We need to release CtrlDown (otherwise it remains + //pressed), but we need to keep csDown state until it's registered by Control.MouseUp + //to call OnClick. So, we nil fCtrlDown here and Control.MouseUp will reset ControlState + //Other case, if we don't care for OnClick (CtrlDown<>CtrlUp) - just release the CtrDown as usual + if CtrlDown <> CtrlUp then + CtrlDown := nil + else + fCtrlDown := nil; + + + // Notify all ControlMouseUp subscribers + for I := 0 to fMouseUpSubsList.Count - 1 do + if Assigned(fMouseUpSubsList[I]) then + fMouseUpSubsList[I](CtrlUp, X, Y, Shift, Button); + +// fMasterPanel.ControlMouseUp(CtrlUp, X, Y, Shift, Button); // Must be invoked before CtrlUp.MouseUp to avoid problems on game Exit + + if CtrlUp <> nil then + CtrlUp.MouseUp(X, Y, Shift, Button); + + //Do not place any code here, we could have Exited in OnClick event +end; + + +procedure TKMMasterControl.MouseWheel(X,Y: Integer; WheelSteps: Integer; var aHandled: Boolean); +var + ctrl: TKMControl; +begin + if Self = nil then Exit; + + ctrl := HitControl(X, Y); + if ctrl <> nil then + ctrl.MouseWheel(ctrl, WheelSteps, aHandled); +end; + + +// Paint controls +// Leave painting of childs to their parent control +procedure TKMMasterControl.Paint; +var + str: string; +begin + if Self = nil then Exit; + + // Reset counter + TKMControl.PaintCount := 0; + + fMasterPanel.Paint; + + if MODE_DESIGN_CONTROLS and (CtrlOver <> nil) then + begin + if GetKeyState(VK_CONTROL) < 0 then + str := Format('%d:%d/%d:%d', [CtrlOver.AbsLeft, CtrlOver.AbsTop, CtrlOver.Width, CtrlOver.Height]) + else + str := Format('%d:%d/%d:%d', [CtrlOver.Left, CtrlOver.Top, CtrlOver.Width, CtrlOver.Height]); + + TKMRenderUI.WriteText(CtrlOver.AbsLeft, CtrlOver.AbsTop - 14, 0, str, fntGrey, taLeft); + end; +end; + + +procedure TKMMasterControl.SaveToFile(const aFileName: UnicodeString); +var + ft: Textfile; +begin + if Self = nil then Exit; + + AssignFile(ft,aFileName); + Rewrite(ft); + + //fCtrl.SaveToFile; //Will save all the childs as well, recursively alike Paint or HitControl + //writeln(ft, ClassName); + //writeln(ft, Format('[%d %d %d %d]', [fLeft, fTop, fWidth, fHeight])); + + CloseFile(ft); +end; + + +{ TKMControl.TKMKeyPress } +//function TKMControl.TKMKeyPress.ToString: string; +//var +// kindStr: string; +//begin +// case Kind of +// kpkDown: kindStr := 'Down'; +// kpkPress: kindStr := 'Press'; +// else kindStr := 'unknown'; +// end; +//// Result := Format('T=%d %s Key=%d C=%s ', [Integer(Time), kpkPress, Key, String(C)]); +// Result := Format('T=%d %s C=%d ', [Integer(Time), kindStr, {Key, }Ord(c)]); +//end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsBase.pas b/vendor/kam_remake/src/controls/KM_ControlsBase.pas new file mode 100644 index 0000000..8241482 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsBase.pas @@ -0,0 +1,848 @@ +unit KM_ControlsBase; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KromOGLUtils, + KM_Controls, + KM_RenderUI, + KM_ResFonts, KM_ResTypes, + KM_CommonTypes, KM_Points; + + +type + // Beveled area + TKMBevel = class(TKMControl) + const + DEF_BACK_ALPHA = 0.4; + DEF_EDGE_ALPHA = 0.75; + public + BackAlpha: Single; + EdgeAlpha: Single; + Color: TKMColor3f; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + + procedure SetDefBackAlpha; + procedure SetDefEdgeAlpha; + procedure SetDefColor; + + procedure Paint; override; + end; + + + // Rectangle area + TKMShape = class(TKMControl) + public + FillColor: TColor4; + LineColor: TColor4; //color of outline + LineWidth: Byte; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + procedure Paint; override; + end; + + + // Text Label + TKMLabel = class(TKMControl) + private + fWordWrap: Boolean; + fFont: TKMFont; + fFontColor: TColor4; //Usually white (self-colored) + fCaption: UnicodeString; //Original text + fText: UnicodeString; //Reformatted text + fTextAlign: TKMTextAlign; + fTextVAlign: TKMTextVAlign; + fTextSize: TKMPoint; + fStrikethrough: Boolean; + fTabWidth: Integer; + + procedure SetCaption(const aCaption: UnicodeString); + procedure SetWordWrap(aValue: Boolean); + procedure ReformatText; + procedure SetFont(const Value: TKMFont); + protected + procedure SetWidth(aValue: Integer); override; + + function GetIsPainted: Boolean; override; + public + MaxLines: Integer; + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aFont: TKMFont; aTextAlign: TKMTextAlign); overload; + constructor Create(aParent: TKMPanel; aLeft,aTop: Integer; const aCaption: UnicodeString; aFont: TKMFont; + aTextAlign: TKMTextAlign); overload; + + function HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; override; + procedure SetColor(aColor: Cardinal); + + property WordWrap: Boolean read fWordWrap write SetWordWrap; //Whether to automatically wrap text within given text area width + property Caption: UnicodeString read fCaption write SetCaption; + property FontColor: TColor4 read fFontColor write fFontColor; + property Strikethrough: Boolean read fStrikethrough write fStrikethrough; + property TabWidth: Integer read fTabWidth write fTabWidth; + property TextSize: TKMPoint read fTextSize; + function TextLeft: Integer; + property TextVAlign: TKMTextVAlign read fTextVAlign write fTextVAlign; + property Font: TKMFont read fFont write SetFont; + procedure Paint; override; + end; + + + // Label that is scrolled within an area. Used in Credits + TKMLabelScroll = class(TKMLabel) + public + SmoothScrollToTop: Cardinal; //Delta between this and TimeGetTime affects vertical position + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; aFont: TKMFont; aTextAlign: TKMTextAlign); + procedure Paint; override; + end; + + + // Image + TKMImage = class(TKMControl) + private + fRX: TRXType; + fTexID: Word; + fFlagColor: TColor4; + protected + function GetIsPainted: Boolean; override; + public + ImageAnchors: TKMAnchorsSet; + Highlight: Boolean; + HighlightOnMouseOver: Boolean; + HighlightCoef: Single; + Lightness: Single; + ClipToBounds: Boolean; + Tiled: Boolean; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID: Word; aRX: TRXType = rxGui; + aImageAnchors: TKMAnchorsSet = [anLeft, anTop]); + property RX: TRXType read fRX write fRX; + property TexID: Word read fTexID write fTexID; + property FlagColor: TColor4 read fFlagColor write fFlagColor; + function Click: Boolean; + procedure ImageStretch; + procedure ImageCenter; + procedure Paint; override; + end; + + + // Image stack - for army formation view + TKMImageStack = class(TKMControl) + private + fRX: TRXType; + fTexID1, fTexID2: Word; //Normal and commander + fCount: Integer; + fColumns: Integer; + fDrawWidth: Integer; + fDrawHeight: Integer; + fHighlightID: Integer; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID1, aTexID2: Word; aRX: TRXType = rxGui); + procedure SetCount(aCount, aColumns, aHighlightID: Word); + procedure Paint; override; + end; + + + // 3D Button + TKMButton = class(TKMControl) + private + fCaption: UnicodeString; + fTextAlign: TKMTextAlign; + fStyle: TKMButtonStyle; + fRX: TRXType; + fAutoHeight: Boolean; //Set button height automatically depending text size (height) + procedure InitCommon(aStyle: TKMButtonStyle); + procedure SetCaption(const aCaption: UnicodeString); + procedure SetAutoHeight(aValue: Boolean); + procedure UpdateHeight; + public + FlagColor: TColor4; //When using an image + CapColor: TColor4; + Font: TKMFont; + MakesSound: Boolean; + TexID: Word; + CapOffsetX: Shortint; + CapOffsetY: Shortint; + ShowImageEnabled: Boolean; // show picture as enabled or not (normal or darkened) + TextVAlign: TKMTextVAlign; + AutoTextPadding: Byte; //text padding for autoHeight + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID: Word; aRX: TRXType; + aStyle: TKMButtonStyle); overload; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aStyle: TKMButtonStyle); overload; + function Click: Boolean; //Try to click a button and return TRUE if succeded + + property Caption: UnicodeString read fCaption write SetCaption; + property AutoHeight: Boolean read fAutoHeight write SetAutoHeight; + + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure Paint; override; + end; + + + // Common Flat Button + TKMButtonFlatCommon = class abstract(TKMControl) + private + public + RX: TRXType; + TexID: Word; + TexOffsetX: Shortint; + TexOffsetY: Shortint; + CapOffsetX: Shortint; + CapOffsetY: Shortint; + Caption: UnicodeString; + CapColor: TColor4; + FlagColor: TColor4; + Font: TKMFont; + HideHighlight: Boolean; + Clickable: Boolean; //Disables clicking without dimming + EdgeAlpha: Single; + BackAlpha: Single; + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight, aTexID: Integer; aRX: TRXType = rxGui); + + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + + procedure Paint; override; + end; + + + // FlatButton + TKMButtonFlat = class(TKMButtonFlatCommon) + public + Down: Boolean; + procedure Paint; override; + end; + + + // FlatButton with Shape on it + TKMFlatButtonShape = class(TKMControl) + private + fCaption: UnicodeString; + fFont: TKMFont; + fFontHeight: Byte; + public + Down: Boolean; + FontColor: TColor4; + ShapeColor: TColor4; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; aFont: TKMFont; aShapeColor: TColor4); + procedure Paint; override; + end; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + StrUtils, Math, + KM_ControlsTypes, + KM_Sound, + KM_Resource, KM_ResSound, KM_ResSprites, + KM_Defaults, KM_CommonUtils, + KM_RenderTypes; + + +{ TKMBevel } +constructor TKMBevel.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + SetDefBackAlpha; + SetDefEdgeAlpha; +end; + + +procedure TKMBevel.SetDefBackAlpha; +begin + BackAlpha := DEF_BACK_ALPHA; //Default value +end; + + +procedure TKMBevel.SetDefEdgeAlpha; +begin + EdgeAlpha := DEF_EDGE_ALPHA; //Default value +end; + + +procedure TKMBevel.SetDefColor; +begin + Color := COLOR3F_BLACK; //Default value +end; + + +procedure TKMBevel.Paint; +begin + inherited; + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height, Color, EdgeAlpha, BackAlpha); +end; + + +{ TKMShape } +constructor TKMShape.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + LineWidth := 2; +end; + + +procedure TKMShape.Paint; +begin + inherited; + TKMRenderUI.WriteShape(AbsLeft, AbsTop, Width, Height, FillColor); + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, Width, Height, LineWidth, LineColor); +end; + + +{ TKMLabel } +constructor TKMLabel.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aFont: TKMFont; aTextAlign: TKMTextAlign); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + fFontColor := $FFFFFFFF; + fTextAlign := aTextAlign; + fTextVAlign := tvaTop; + fWordWrap := False; + fTabWidth := FONT_TAB_WIDTH; + SetCaption(aCaption); +end; + + +//Same as above but with width/height ommitted, as in most cases we don't know/don't care +constructor TKMLabel.Create(aParent: TKMPanel; aLeft, aTop: Integer; const aCaption: UnicodeString; aFont: TKMFont; + aTextAlign: TKMTextAlign); +begin + Create(aParent, aLeft, aTop, 0, 0, aCaption, aFont, aTextAlign); +end; + + +function TKMLabel.TextLeft: Integer; +begin + case fTextAlign of + taLeft: Result := AbsLeft; + taCenter: Result := AbsLeft + Round((Width - fTextSize.X) / 2); + taRight: Result := AbsLeft + (Width - fTextSize.X); + else Result := AbsLeft; + end; +end; + + +procedure TKMLabel.SetCaption(const aCaption: UnicodeString); +begin + fCaption := aCaption; + ReformatText; +end; + + +procedure TKMLabel.SetWordWrap(aValue: Boolean); +begin + fWordWrap := aValue; + ReformatText; +end; + + +//Override usual hittest with regard to text alignment +function TKMLabel.HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; +begin + Result := (Hitable or aIncludeNotHitable) + and InRange(X, TextLeft, TextLeft + fTextSize.X) + and InRange(Y, AbsTop, AbsTop + Height); +end; + + +procedure TKMLabel.SetColor(aColor: Cardinal); +begin + fCaption := StripColor(fCaption); + Caption := WrapColor(fCaption, aColor); +end; + + +procedure TKMLabel.SetFont(const Value: TKMFont); +begin + fFont := Value; + ReformatText; +end; + + +// Existing EOLs should be preserved, and new ones added where needed +// Keep original intact incase we need to Reformat text once again +procedure TKMLabel.ReformatText; +var + I: Integer; + stake: Integer; +begin + if fWordWrap then + fText := gRes.Fonts[fFont].WordWrap(fCaption, Width, True, False) + else + fText := fCaption; + + // We may need to display only N lines + if MaxLines > 0 then + begin + stake := 0; + for I := 1 to MaxLines do + begin + stake := PosEx(#124, fText, stake+1); + if stake = 0 then + Break; + end; + + if stake > 0 then + fText := LeftStr(fText, stake - 1); + end; + + fTextSize := gRes.Fonts[fFont].GetTextSize(fText); +end; + + +procedure TKMLabel.SetWidth(aValue: Integer); +begin + inherited; + + if fWordWrap then + ReformatText; +end; + + +function TKMLabel.GetIsPainted: Boolean; +begin + Result := inherited and (Length(fCaption) > 0 ); +end; + + +// Send caption to render +procedure TKMLabel.Paint; +var + t: Integer; + col: Cardinal; +begin + inherited; + + if Enabled then + col := FontColor + else + col := $FF888888; + + t := 0; + if Height > 0 then + begin + case fTextVAlign of + tvaNone, + tvaTop: ; + tvaMiddle: t := (Height - fTextSize.Y) div 2; + tvaBottom: t := Height - fTextSize.Y; + end; + end; + + TKMRenderUI.WriteText(AbsLeft, AbsTop + t, Width, fText, fFont, fTextAlign, col, False, False, False, fTabWidth); + + if fStrikethrough then + TKMRenderUI.WriteShape(TextLeft, AbsTop + fTextSize.Y div 2 - 2, fTextSize.X, 3, col, $FF000000); +end; + + +{ TKMLabelScroll } +constructor TKMLabelScroll.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; aFont: TKMFont; aTextAlign: TKMTextAlign); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aCaption, aFont, aTextAlign); + SmoothScrollToTop := 0; //Disabled by default +end; + + +procedure TKMLabelScroll.Paint; +var + newTop: Integer; + col: Cardinal; +begin + TKMRenderUI.SetupClipY(AbsTop, AbsTop + Height); + newTop := EnsureRange(AbsTop + Height - TimeSince(SmoothScrollToTop) div 50, -MINSHORT, MAXSHORT); //Compute delta and shift by it upwards (Credits page) + + if Enabled then + col := FontColor + else + col := $FF888888; + + TKMRenderUI.WriteText(AbsLeft, newTop, Width, fCaption, fFont, fTextAlign, col); + TKMRenderUI.ReleaseClipY; +end; + + +{ TKMImage } +constructor TKMImage.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID: Word; aRX: TRXType = rxGui; + aImageAnchors: TKMAnchorsSet = [anLeft, anTop]); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fRX := aRX; + fTexID := aTexID; + fFlagColor := $FFFF00FF; + ImageAnchors := aImageAnchors; + Highlight := False; + HighlightOnMouseOver := False; + HighlightCoef := CTRL_HIGHLIGHT_COEF_DEF; +end; + + +function TKMImage.GetIsPainted: Boolean; +begin + Result := inherited and (TexID <> 0); +end; + + +//DoClick is called by keyboard shortcuts +//It's important that Control must be: +// IsVisible (can't shortcut invisible/unaccessible button) +// Enabled (can't shortcut disabled function, e.g. Halt during fight) +function TKMImage.Click: Boolean; +begin + if Visible and Enabled then + begin + //Mark self as CtrlOver and CtrlUp, don't mark CtrlDown since MouseUp manually Nils it + Parent.MasterControl.CtrlOver := Self; + Parent.MasterControl.CtrlUp := Self; + if Assigned(OnClick) then OnClick(Self); + Result := True; //Click has happened + end + else + Result := False; //No, we couldn't click for Control is unreachable +end; + + +procedure TKMImage.ImageStretch; +begin + ImageAnchors := [anLeft, anRight, anTop, anBottom]; //Stretch image to fit +end; + + +procedure TKMImage.ImageCenter; //Render image from center +begin + ImageAnchors := []; +end; + + +{If image area is bigger than image - do center image in it} +procedure TKMImage.Paint; +var + x, y: Integer; + col, row: Integer; + paintLightness: Single; + drawLeft, drawTop: Integer; + drawWidth, drawHeight: Integer; +begin + inherited; + if fTexID = 0 then Exit; //No picture to draw + + if ClipToBounds then + begin + TKMRenderUI.SetupClipX(AbsLeft, AbsLeft + Width); + TKMRenderUI.SetupClipY(AbsTop, AbsTop + Height); + end; + + paintLightness := Lightness + HighlightCoef * (Byte(HighlightOnMouseOver and (csOver in State)) + Byte(Highlight)); + + if Tiled then + begin + drawWidth := gGFXData[fRX, fTexID].PxWidth; + drawHeight := gGFXData[fRX, fTexID].PxHeight; + drawLeft := AbsLeft + Width div 2 - drawWidth div 2; + drawTop := AbsTop + Height div 2 - drawHeight div 2; + + col := Width div drawWidth + 1; + row := Height div drawHeight + 1; + for x := -col div 2 to col div 2 do + for y := -row div 2 to row div 2 do + TKMRenderUI.WritePicture(drawLeft + x * drawWidth, drawTop + y * drawHeight, drawWidth, drawHeight, ImageAnchors, fRX, fTexID, Enabled, fFlagColor, paintLightness); + end + else + TKMRenderUI.WritePicture(AbsLeft, AbsTop, Width, Height, ImageAnchors, fRX, fTexID, Enabled, fFlagColor, paintLightness); + + if ClipToBounds then + begin + TKMRenderUI.ReleaseClipX; + TKMRenderUI.ReleaseClipY; + end; +end; + + +{ TKMImageStack } +constructor TKMImageStack.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID1, aTexID2: Word; aRX: TRXType = rxGui); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fRX := aRX; + fTexID1 := aTexID1; + fTexID2 := aTexID2; +end; + + +procedure TKMImageStack.SetCount(aCount, aColumns, aHighlightID: Word); +var + aspect: Single; +begin + fCount := aCount; + fColumns := Math.max(1, aColumns); + fHighlightID := aHighlightID; + + fDrawWidth := EnsureRange(Width div fColumns, 8, gGFXData[fRX, fTexID1].PxWidth); + fDrawHeight := EnsureRange(Height div Ceil(fCount/fColumns), 6, gGFXData[fRX, fTexID1].PxHeight); + + aspect := gGFXData[fRX, fTexID1].PxWidth / gGFXData[fRX, fTexID1].PxHeight; + if fDrawHeight * aspect <= fDrawWidth then + fDrawWidth := Round(fDrawHeight * aspect) + else + fDrawHeight := Round(fDrawWidth / aspect); +end; + + +// If image area is bigger than image - do center image in it +procedure TKMImageStack.Paint; +var + I: Integer; + offsetX, offsetY, centerX, centerY: SmallInt; //variable parameters + texID: Word; +begin + inherited; + if fTexID1 = 0 then Exit; //No picture to draw + + offsetX := Width div fColumns; + offsetY := Height div Ceil(fCount / fColumns); + + centerX := (Width - offsetX * (fColumns-1) - fDrawWidth) div 2; + centerY := (Height - offsetY * (Ceil(fCount/fColumns) - 1) - fDrawHeight) div 2; + + for I := 0 to fCount - 1 do + begin + texID := IfThen(I = fHighlightID, fTexID2, fTexId1); + + TKMRenderUI.WritePicture(AbsLeft + centerX + offsetX * (I mod fColumns), + AbsTop + centerY + offsetY * (I div fColumns), + fDrawWidth, fDrawHeight, [anLeft, anTop, anRight, anBottom], fRX, texID, Enabled); + end; +end; + + +{ TKMButton } +constructor TKMButton.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aTexID: Word; aRX: TRXType; + aStyle: TKMButtonStyle); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + InitCommon(aStyle); + fRX := aRX; + TexID := aTexID; +end; + + +{Different version of button, with caption on it instead of image} +constructor TKMButton.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aStyle: TKMButtonStyle); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + InitCommon(aStyle); + Caption := aCaption; +end; + + +procedure TKMButton.InitCommon(aStyle: TKMButtonStyle); +begin + TexID := 0; + Caption := ''; + FlagColor := $FFFF00FF; + Font := fntMetal; + fTextAlign := taCenter; //Thats default everywhere in KaM + TextVAlign := tvaMiddle;//tvaNone; + fStyle := aStyle; + MakesSound := True; + ShowImageEnabled := True; + AutoHeight := False; + AutoTextPadding := 5; + CapColor := icWhite; +end; + + +procedure TKMButton.UpdateHeight; +var + textY: Integer; +begin + if fAutoHeight then + begin + textY := gRes.Fonts[Font].GetTextSize(Caption).Y; + if textY + AutoTextPadding > Height then + Height := textY + AutoTextPadding; + end; +end; + + +procedure TKMButton.SetCaption(const aCaption: UnicodeString); +begin + fCaption := aCaption; + UpdateHeight; +end; + + +procedure TKMButton.SetAutoHeight(aValue: Boolean); +begin + fAutoHeight := aValue; + UpdateHeight; +end; + + +//DoClick is called by keyboard shortcuts +//It puts a focus on the button and depresses it if it was DoPress'ed +//It's important that Control must be: +// Visible (can't shortcut invisible/unaccessible button) +// Enabled (can't shortcut disabled function, e.g. Halt during fight) +function TKMButton.Click: Boolean; +begin + if Visible and Enabled then + begin + //Mark self as CtrlOver and CtrlUp, don't mark CtrlDown since MouseUp manually Nils it + Parent.MasterControl.CtrlOver := Self; + Parent.MasterControl.CtrlUp := Self; + if Assigned(OnClick) then + OnClick(Self); + Result := True; //Click has happened + end + else + Result := False; //No, we couldn't click for Control is unreachable +end; + + +procedure TKMButton.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if Enabled and MakesSound and (csDown in State) then + gSoundPlayer.Play(sfxnButtonClick); + + inherited; +end; + + +procedure TKMButton.Paint; +var + col: TColor4; + stateSet: TKMButtonStateSet; + textY, top: Integer; +begin + inherited; + stateSet := []; + if (csOver in State) and Enabled then + stateSet := stateSet + [bsOver]; + if (csOver in State) and (csDown in State) then + stateSet := stateSet + [bsDown]; + if not Enabled then + stateSet := stateSet + [bsDisabled]; + + TKMRenderUI.Write3DButton(AbsLeft, AbsTop, Width, Height, fRX, TexID, FlagColor, stateSet, fStyle, ShowImageEnabled); + + if TexID <> 0 then Exit; + + //If disabled then text should be faded + col := IfThen(Enabled, CapColor, icGray); + + top := AbsTop + Byte(bsDown in stateSet) + CapOffsetY; + + textY := gRes.Fonts[Font].GetTextSize(Caption).Y; + case TextVAlign of + tvaNone: Inc(top, (Height div 2) - 7); + tvaTop: Inc(top, 2); + tvaMiddle: Inc(top, (Height div 2) - (textY div 2) + 2); + tvaBottom: Inc(top, Height - textY); + end; + TKMRenderUI.WriteText(AbsLeft + Byte(bsDown in stateSet) + CapOffsetX, top, + Width, Caption, Font, fTextAlign, col); +end; + + +{TKMButtonFlatCommon} +constructor TKMButtonFlatCommon.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight, aTexID: Integer; aRX: TRXType = rxGui); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + RX := aRX; + TexID := aTexID; + FlagColor := $FFFF00FF; + CapColor := $FFFFFFFF; + Font := fntGame; + Clickable := True; + EdgeAlpha := BEVEL_EDGE_ALPHA_DEF; + BackAlpha := BEVEL_BACK_ALPHA_DEF; +end; + + +procedure TKMButtonFlatCommon.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if not Clickable then Exit; + if Enabled and (csDown in State) then + gSoundPlayer.Play(sfxClick); + + inherited; +end; + + +procedure TKMButtonFlatCommon.Paint; +begin + inherited; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height, EdgeAlpha, BackAlpha); + + if (csOver in State) and Enabled and not HideHighlight then + TKMRenderUI.WriteShape(AbsLeft+1, AbsTop+1, Width-2, Height-2, $40FFFFFF); +end; + + +//Simple version of button, with a caption and image +{TKMButtonFlat} +procedure TKMButtonFlat.Paint; +var + textCol: TColor4; +begin + inherited; + + if TexID <> 0 then + TKMRenderUI.WritePicture(AbsLeft + TexOffsetX, + AbsTop + TexOffsetY - 6 * Byte(Caption <> ''), + Width, Height, [], RX, TexID, Enabled or fEnabledVisually, FlagColor); + + textCol := IfThen(Enabled or fEnabledVisually, CapColor, icGray); + TKMRenderUI.WriteText(AbsLeft + CapOffsetX, AbsTop + (Height div 2) + 4 + CapOffsetY, Width, Caption, Font, taCenter, textCol); + + if Down then + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, Width, Height, 1, $FFFFFFFF); + {if not fEnabled then + TKMRenderUI.WriteShape(Left, Top, Width, Height, $80000000);} +end; + + +{ TKMFlatButtonShape } +constructor TKMFlatButtonShape.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; aFont: TKMFont; aShapeColor: TColor4); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fCaption := aCaption; + ShapeColor := aShapeColor; + fFont := aFont; + fFontHeight := gRes.Fonts[fFont].BaseHeight + 2; + FontColor := icWhite; +end; + + +procedure TKMFlatButtonShape.Paint; +begin + inherited; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height); + + //Shape within bevel + TKMRenderUI.WriteShape(AbsLeft + 1, AbsTop + 1, Width - 2, Width - 2, ShapeColor); + + TKMRenderUI.WriteText(AbsLeft, AbsTop + (Height - fFontHeight) div 2, + Width, fCaption, fFont, taCenter, FontColor); + + if (csOver in State) and Enabled then + TKMRenderUI.WriteShape(AbsLeft + 1, AbsTop + 1, Width - 2, Height - 2, $40FFFFFF); + + if (csDown in State) or Down then + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, Width, Height, 1, icWhite); +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsChart.pas b/vendor/kam_remake/src/controls/KM_ControlsChart.pas new file mode 100644 index 0000000..b7df1cb --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsChart.pas @@ -0,0 +1,519 @@ +unit KM_ControlsChart; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KromOGLUtils, + KM_Controls, + KM_RenderUI, KM_ResFonts, + KM_CommonClasses, KM_CommonTypes, KM_Points, KM_Defaults; + + +type + TKMNotifyLegendClick = procedure(Sender: TObject; aLineIndex: Integer; aLineVisible: Boolean) of object; + + TKMGraphLine = record + Title: UnicodeString; + TitleDetailed: TKMStringArray; + TitleDetailedColor: TKMCardinalArray; + Tag: Integer; + Color: TColor4; + Visible: Boolean; + Values: TKMCardinalArray; + ValuesAlt: TKMCardinalArray; + end; + + TKMChart = class(TKMControl) + private + fCaption: UnicodeString; + fFont: TKMFont; + fCount: Integer; + fItemHeight: Byte; + fLegendWidth: Word; + fLegendCaption: String; + fLineOver: Integer; + fLines: array of TKMGraphLine; + fMaxLength: Cardinal; //Maximum samples (by horizontal axis) + fMinTime: Cardinal; //Minimum time (in sec), used only for Rendering time ticks + fMaxTime: Cardinal; //Maximum time (in sec), used only for Rendering time ticks + fMaxValue: Cardinal; //Maximum value (by vertical axis) + fPeaceTime: Cardinal; + + //Legend separators + fSeparatorPositions: TXStringList; + fSeparatorHeight: Byte; + fSeparatorColor: TColor4; + + fOnLegendClick: TKMNotifyLegendClick; + procedure UpdateMaxValue; + function GetLine(aIndex:Integer): TKMGraphLine; + function GetLineNumber(aY: Integer): Integer; +// function GetSeparatorsHeight(aIndex: Integer): Integer; + function GetSeparatorPos(aIndex: Integer): Integer; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + destructor Destroy; override; + + procedure AddLine(const aTitle: UnicodeString; aColor: TColor4; const aValues: TKMCardinalArray; aTag: Integer = -1); overload; + procedure AddLine(const aTitle: UnicodeString; aColor: TColor4; const aTitleDetailed: TKMStringArray; + const aTitleDetailedColor: TKMCardinalArray; const aValues: TKMCardinalArray; aTag: Integer = -1); overload; + procedure AddAltLine(const aAltValues: TKMCardinalArray); + procedure TrimToFirstVariation; + property Caption: UnicodeString read fCaption write fCaption; + procedure Clear; + procedure SetLineVisible(aLineID:Integer; aVisible:Boolean); + property MaxLength: Cardinal read fMaxLength write fMaxLength; + property MaxTime: Cardinal read fMaxTime write fMaxTime; + property Lines[aIndex: Integer]: TKMGraphLine read GetLine; + property LineCount:Integer read fCount; + property Font: TKMFont read fFont write fFont; + property LegendWidth: Word read fLegendWidth write fLegendWidth; + property LegendCaption: String read fLegendCaption write fLegendCaption; + property Peacetime: Cardinal read fPeaceTime write fPeaceTime; + + property SeparatorPos[aIndex: Integer]: Integer read GetSeparatorPos; + property SeparatorColor: TColor4 read fSeparatorColor write fSeparatorColor; + property SeparatorHeight: Byte read fSeparatorHeight write fSeparatorHeight; + + procedure AddSeparator(aPosition: Integer); + procedure SetSeparatorPositions(aSeparatorPositions: TStringList); + procedure ClearSeparators; + + property OnLegendClick: TKMNotifyLegendClick read fOnLegendClick write fOnLegendClick; + + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + + procedure Paint; override; + end; + + +implementation +uses + SysUtils, Math, + KM_Resource, KM_ResTexts, + KM_CommonUtils; + + +{ TKMChart } +constructor TKMChart.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fSeparatorPositions := TXStringList.Create; + fSeparatorPositions.Sorted := True; // Better we have separators sorted + + fFont := fntOutline; + fItemHeight := 20; + fLineOver := -1; + fLegendWidth := 150; + fSeparatorColor := clChartSeparator; + fSeparatorHeight := 10; +end; + + +destructor TKMChart.Destroy; +begin + FreeAndNil(fSeparatorPositions); + inherited; +end; + + +procedure TKMChart.AddLine(const aTitle: UnicodeString; aColor: TColor4; const aValues: TKMCardinalArray; aTag: Integer = -1); +var + titleDetailed: TKMStringArray; + titleDetailedColor: TKMCardinalArray; +begin + SetLength(titleDetailed, 0); + SetLength(titleDetailedColor, 0); + AddLine(aTitle, aColor, titleDetailed, titleDetailedColor, aValues, aTag); +end; + + +procedure TKMChart.AddLine(const aTitle: UnicodeString; aColor: TColor4; const aTitleDetailed: TKMStringArray; + const aTitleDetailedColor: TKMCardinalArray; const aValues: TKMCardinalArray; aTag: Integer = -1); +begin + if fMaxLength = 0 then Exit; + + Assert(Length(aTitleDetailed) = Length(aTitleDetailedColor), 'aTitleDetailed and aTitleDetailedColor should have same length'); + + //Make sure there is enough Values to copy to local storage with Move procedure + Assert(Length(aValues) >= fMaxLength); + + SetLength(fLines, fCount + 1); + + fLines[fCount].Color := aColor; + fLines[fCount].Title := aTitle; + fLines[fCount].Tag := aTag; + fLines[fCount].Visible := True; + fLines[fCount].TitleDetailed := aTitleDetailed; + fLines[fCount].TitleDetailedColor := aTitleDetailedColor; + SetLength(fLines[fCount].Values, fMaxLength); + if SizeOf(aValues) <> 0 then + Move(aValues[0], fLines[fCount].Values[0], SizeOf(aValues[0]) * fMaxLength); + Inc(fCount); + + UpdateMaxValue; +end; + + +function TKMChart.GetSeparatorPos(aIndex: Integer): Integer; +begin + Result := -1; + if not InRange(aIndex, 0, fSeparatorPositions.Count - 1) then Exit; + + Result := StrToInt(fSeparatorPositions[aIndex]); +end; + + +//function TKMChart.GetSeparatorsHeight(aIndex: Integer): Integer; +//var +// I, Pos: Integer; +//begin +// Result := 0; +// for I := 0 to fSeparatorPositions.Count - 1 do +// begin +// Pos := SeparatorPos[I]; +// if (Pos <> -1) and (Pos <= aIndex) then +// Inc(Result, fSeparatorHeight); +// end; +//end; + + +procedure TKMChart.AddSeparator(aPosition: Integer); +begin + fSeparatorPositions.Add(IntToStr(aPosition)); +end; + + +procedure TKMChart.SetSeparatorPositions(aSeparatorPositions: TStringList); +begin + fSeparatorPositions.Clear; + fSeparatorPositions.AddStrings(aSeparatorPositions); +end; + + +//Add alternative values line (e.g. wares count vs. wares produced) +procedure TKMChart.AddAltLine(const aAltValues: TKMCardinalArray); +begin + Assert(Length(aAltValues) >= fMaxLength); + + SetLength(fLines[fCount-1].ValuesAlt, fMaxLength); + if SizeOf(aAltValues) <> 0 then + Move(aAltValues[0], fLines[fCount-1].ValuesAlt[0], SizeOf(aAltValues[0]) * fMaxLength); + + UpdateMaxValue; +end; + + +//Trims the graph until 5% before the first variation +procedure TKMChart.TrimToFirstVariation; +var + I, K, firstVarSample: Integer; + startVal: Cardinal; +begin + firstVarSample := -1; + for I:=0 to fCount-1 do + if Length(fLines[I].Values) > 0 then + begin + startVal := fLines[I].Values[0]; + for K:=1 to Length(fLines[I].Values)-1 do + if fLines[I].Values[K] <> startVal then + begin + if (K < firstVarSample) or (firstVarSample = -1) then + firstVarSample := K - 1; + Break; + end; + end; + if firstVarSample <= 0 then + begin + fMinTime := 0; //No variation at all, so don't trim it (but clear previous value) + Exit; + end; + //Take 5% before the first varied sample + firstVarSample := Max(0, firstVarSample - Max(1, Round(0.05*(fMaxLength - firstVarSample)))); + //Trim all fLines[I].Values to start at FirstVarSample + for I := 0 to fCount - 1 do + begin + Move(fLines[I].Values[firstVarSample], fLines[I].Values[0], (Length(fLines[I].Values)-firstVarSample)*SizeOf(fLines[I].Values[0])); + SetLength(fLines[I].Values, Length(fLines[I].Values)-firstVarSample); + end; + //Set start time so the horizontal time ticks are rendered correctly + fMinTime := Round((firstVarSample/fMaxLength) * fMaxTime); + //All lines have now been trimmed, so update fMaxLength + fMaxLength := fMaxLength - firstVarSample; +end; + + +procedure TKMChart.Clear; +begin + fCount := 0; + SetLength(fLines, 0); + fMaxValue := 0; + ClearSeparators; +end; + + +procedure TKMChart.ClearSeparators; +begin + fSeparatorPositions.Clear; +end; + + +procedure TKMChart.SetLineVisible(aLineID: Integer; aVisible: Boolean); +begin + fLines[aLineID].Visible := aVisible; + UpdateMaxValue; +end; + + +procedure TKMChart.UpdateMaxValue; +var + I, K: Integer; +begin + fMaxValue := 0; + for I := 0 to fCount - 1 do + if fLines[I].Visible then + for K := 0 to fMaxLength - 1 do + if fLines[I].Values[K] > fMaxValue then + fMaxValue := fLines[I].Values[K]; +end; + + +function TKMChart.GetLine(aIndex: Integer): TKMGraphLine; +begin + Result := fLines[aIndex]; +end; + + +function TKMChart.GetLineNumber(aY: Integer): Integer; +var + I, S, lineTop, lineBottom: Integer; +begin + Result := -1; + S := 0; + lineTop := AbsTop + 5 + 20*Byte(fLegendCaption <> ''); + for I := 0 to fCount - 1 do + begin + if SeparatorPos[S] = I then + begin + Inc(lineTop, fSeparatorHeight); + Inc(S); + end; + lineBottom := lineTop + fItemHeight*(1 + Length(Lines[I].TitleDetailed)); + if InRange(aY, lineTop, lineBottom) then + begin + Result := I; + Exit; + end; + lineTop := lineBottom; + end; +end; + + +procedure TKMChart.MouseMove(X, Y: Integer; Shift: TShiftState); +begin + inherited; + + fLineOver := -1; + if X < AbsLeft + Width - fLegendWidth + 5 then Exit; + fLineOver := GetLineNumber(Y); +end; + + +procedure TKMChart.MouseUp(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + I: Integer; +begin + inherited; + + if X < AbsLeft + Width - fLegendWidth+5 then Exit; + + I := GetLineNumber(Y); + if not InRange(I, 0, fCount - 1) then Exit; + + fLines[I].Visible := not fLines[I].Visible; + + UpdateMaxValue; + + if Assigned(fOnLegendClick) then + fOnLegendClick(Self, I, fLines[I].Visible); +end; + + +procedure TKMChart.Paint; +const + INTERVAL_CNT: array [0..9] of Word = (1, 5, 10, 50, 100, 500, 1000, 5000, 10000, 50000); + INTERVAL_TIME: array [0..10] of Word = (30, 1*60, 5*60, 10*60, 15*60, 30*60, 1*60*60, 2*60*60, 3*60*60, 4*60*60, 5*60*60); + +var + G: TKMRect; + topValue: Integer; + + procedure PaintAxisLabel(aTime: Integer; aIsPT: Boolean = False); + var + xPos: Integer; + begin + xPos := G.Left + Round((aTime - fMinTime) / (fMaxTime-fMinTime) * (G.Right - G.Left)); + TKMRenderUI.WriteShape(xPos, G.Bottom - 2, 2, 5, IfThen(aIsPT, clChartPeacetimeLn, icWhite)); + TKMRenderUI.WriteText (xPos, G.Bottom + 4, 0, TimeToString(aTime / 24 / 60 / 60), fntGame, taLeft, IfThen(aIsPT, clChartPeacetimeLbl, icWhite)); + TKMRenderUI.WriteLine(xPos, G.Top, xPos, G.Bottom, IfThen(aIsPT, clChartPeacetimeLn, clChartDashedVLn), $CCCC); + if aIsPT then + TKMRenderUI.WriteText(xPos - 3, G.Bottom + 4, 0, gResTexts[TX_CHART_PT_END], fntGame, taRight, clChartPeacetimeLbl); + end; + + procedure RenderHorizontalAxisTicks; + var + I, best: Integer; + begin + //Find first time interval that will have less than 10 ticks + best := 0; + for I := Low(INTERVAL_TIME) to High(INTERVAL_TIME) do + if (fMaxTime-fMinTime) div INTERVAL_TIME[I] < 7 then + begin + best := INTERVAL_TIME[I]; + Break; + end; + + //Paint time axis labels + if (best <> 0) and (fMaxTime <> fMinTime) then + if (fPeaceTime <> 0) and InRange(fPeaceTime, fMinTime, fMaxTime) then + begin + //Labels before PT and PT himself + for I := 0 to ((fPeaceTime - fMinTime) div best) do + PaintAxisLabel(fPeaceTime - I * best, I = 0); + + //Labels after PT + for I := 1 to ((fMaxTime - fPeaceTime) div best) do + PaintAxisLabel(fPeaceTime + I * best); + end else + for I := Ceil(fMinTime / best) to (fMaxTime div best) do + PaintAxisLabel(I * best); + end; + + function GetLineColor(aColor: Cardinal): Cardinal; + begin + //Adjust the color if it blends with black background + Result := EnsureBrightness(aColor, 0.3); + + // If color is similar to highlight color, then use alternative HL color + if GetColorDistance(Result, clChartHighlight) < 0.1 then + Result := clChartHighlight2; + end; + + procedure RenderChartAndLegend; + const + MARKS_FONT: TKMFont = fntGrey; + var + I, J, S, checkSize, xPos, yPos, height: Integer; + titleDetailedH: Integer; + newColor: TColor4; + begin + checkSize := gRes.Fonts[MARKS_FONT].GetTextSize('v').Y + 1; + S := 0; + xPos := G.Right + 10; + yPos := G.Top + 8 + 20*Byte(fLegendCaption <> ''); + + titleDetailedH := 0; + //Charts and legend + for I := 0 to fCount - 1 do + begin + newColor := GetLineColor(fLines[I].Color); + + if (csOver in State) and (I = fLineOver) then + newColor := clChartHighlight; + + //Charts + if fLines[I].Visible then + begin + TKMRenderUI.WritePlot(G.Left, G.Top, G.Right-G.Left, G.Bottom-G.Top, fLines[I].Values, topValue, newColor, 2); + if Length(fLines[I].ValuesAlt) > 0 then + TKMRenderUI.WritePlot(G.Left, G.Top, G.Right-G.Left, G.Bottom-G.Top, fLines[I].ValuesAlt, topValue, newColor, 1); + end; + + if SeparatorPos[S] = I then + begin + Inc(yPos, fSeparatorHeight); + Inc(S); + end; + + //Checkboxes + TKMRenderUI.WriteBevel(xPos, yPos, checkSize - 4, checkSize - 4, 1, 0.3); + TKMRenderUI.WriteOutline(xPos, yPos, checkSize - 4, checkSize - 4, 1, clChkboxOutline); + if fLines[I].Visible then + TKMRenderUI.WriteText(xPos + (checkSize-4) div 2, yPos - 1, 0, 'v', MARKS_FONT, taCenter, newColor); + + //Legend + TKMRenderUI.WriteText(xPos + checkSize, yPos, 0, fLines[I].Title, fntGame, taLeft, newColor); + Inc(yPos, fItemHeight); + + //Detailed legend + for J := Low(fLines[I].TitleDetailed) to High(fLines[I].TitleDetailed) do + begin + TKMRenderUI.WriteText(xPos + checkSize + 5, yPos, 0, fLines[I].TitleDetailed[J], fntGrey, taLeft, GetLineColor(fLines[I].TitleDetailedColor[J])); + Inc(yPos, fItemHeight); + Inc(titleDetailedH, fItemHeight); + end; + end; + + //Legend title and outline + height := fItemHeight*fCount + titleDetailedH + 6 + 20*Byte(fLegendCaption <> '') + fSeparatorPositions.Count*fSeparatorHeight; + TKMRenderUI.WriteShape(G.Right + 5, G.Top, fLegendWidth, height, icDarkestGrayTrans); + TKMRenderUI.WriteOutline(G.Right + 5, G.Top, fLegendWidth, height, 1, icGray); + if fLegendCaption <> '' then + TKMRenderUI.WriteText(G.Right + 5, G.Top + 4, fLegendWidth, fLegendCaption, fntMetal, taCenter, icWhite); + end; + +var + I: Integer; + best, tmp: Integer; +begin + inherited; + + G := KMRect(AbsLeft + 40, AbsTop, AbsLeft + Width - fLegendWidth, AbsTop + Height - 20); + + //Add margin to MaxValue so that it does not blends with upper border + topValue := Max(Round(fMaxValue * 1.1), fMaxValue + 1); + + //Find first interval that will have less than 10 ticks + best := 0; + for I := Low(INTERVAL_CNT) to High(INTERVAL_CNT) do + if topValue div INTERVAL_CNT[I] < 10 then + begin + best := INTERVAL_CNT[I]; + Break; + end; + + //Dashed lines in the background + if best <> 0 then + for I := 1 to (topValue div best) do + begin + tmp := G.Top + Round((1 - I * best / topValue) * (G.Bottom - G.Top)); + TKMRenderUI.WriteText(G.Left - 5, tmp - 6, 0, IntToStr(I * best), fntGame, taRight); + TKMRenderUI.WriteLine(G.Left, tmp, G.Right, tmp, clChartDashedHLn, $CCCC); + end; + + //Render horizontal axis ticks + RenderHorizontalAxisTicks; + + RenderChartAndLegend; + + //Render the highlighted line above all the others and thicker so you can see where it goes under others + if (csOver in State) and InRange(fLineOver, 0, fCount-1) and fLines[fLineOver].Visible then + TKMRenderUI.WritePlot(G.Left, G.Top, G.Right-G.Left, G.Bottom-G.Top, fLines[fLineOver].Values, topValue, clChartHighlight, 3); + + //Outline + TKMRenderUI.WriteOutline(G.Left, G.Top, G.Right-G.Left, G.Bottom-G.Top, 1, icWhite); + + //Title + TKMRenderUI.WriteText(G.Left + 5, G.Top + 5, 0, fCaption, fFont, taLeft); + + //Render vertical axis captions + TKMRenderUI.WriteText(G.Left - 5, G.Bottom - 6, 0, IntToStr(0), fntGame, taRight); + //TKMRenderUI.WriteText(Left+20, Top + 20, 0, 0, IntToStr(fMaxValue), fntGame, taRight); + +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsColor.pas b/vendor/kam_remake/src/controls/KM_ControlsColor.pas new file mode 100644 index 0000000..558278d --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsColor.pas @@ -0,0 +1,152 @@ +unit KM_ControlsColor; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KromOGLUtils, + KM_Controls, KM_ControlsBase, + KM_CommonTypes; + + +type + // Color swatch - to select a color from given samples/palette + TKMColorSwatch = class(TKMControl) + private + fBackAlpha: single; // Alpha of background (usually 0.5, dropbox 1) + fCellSize: Byte; // Size of the square in pixels + fColumnCount: Byte; + fRowCount: Byte; + fColorIndex: Integer; + Colors: array of TColor4; + fOnChange: TNotifyEvent; + fInclRandom: Boolean; + public + constructor Create(aParent: TKMPanel; aLeft,aTop,aColumnCount,aRowCount,aSize: Integer); + procedure SetColors(const aColors: array of TColor4; aInclRandom: Boolean = False); + procedure SelectByColor(aColor: TColor4); + property BackAlpha: single read fBackAlpha write fBackAlpha; + property ColorIndex: Integer read fColorIndex write fColorIndex; + function GetColor: TColor4; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + property OnChange: TNotifyEvent write fOnChange; + procedure Paint; override; + end; + + +implementation +uses + Math, + KM_RenderUI, + KM_ResFonts, KM_ResTypes, + KM_CommonUtils; + + +{ TKMColorSwatch } +constructor TKMColorSwatch.Create(aParent: TKMPanel; aLeft,aTop,aColumnCount,aRowCount,aSize: Integer); +begin + inherited Create(aParent, aLeft, aTop, 0, 0); + + fBackAlpha := 0.5; + fColumnCount := aColumnCount; + fRowCount := aRowCount; + fCellSize := aSize; + fInclRandom := False; + fColorIndex := -1; + + Width := fColumnCount * fCellSize; + Height := fRowCount * fCellSize; +end; + + +procedure TKMColorSwatch.SetColors(const aColors: array of TColor4; aInclRandom: Boolean = False); +begin + fInclRandom := aInclRandom; + if fInclRandom then + begin + SetLength(Colors, Length(aColors)+SizeOf(TColor4)); + Colors[0] := $00000000; //This one is reserved for random + Move((@aColors[0])^, (@Colors[1])^, SizeOf(aColors)); + end + else + begin + SetLength(Colors, Length(aColors)); + Move((@aColors[0])^, (@Colors[0])^, SizeOf(aColors)); + end; +end; + + +procedure TKMColorSwatch.SelectByColor(aColor: TColor4); +var + I: Integer; +begin + fColorIndex := -1; + for I:=0 to Length(Colors)-1 do + if Colors[I] = aColor then + fColorIndex := I; +end; + + +function TKMColorSwatch.GetColor: TColor4; +begin + if fColorIndex <> -1 then + Result := Colors[fColorIndex] + else + Result := $FF000000; //Black by default +end; + + +procedure TKMColorSwatch.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + newColor: Integer; +begin + if Button = mbLeft then + begin + newColor := EnsureRange((Y-AbsTop) div fCellSize, 0, fRowCount-1)*fColumnCount + + EnsureRange((X-AbsLeft) div fCellSize, 0, fColumnCount-1); + if InRange(newColor, 0, Length(Colors)-1) then + begin + fColorIndex := newColor; + if Assigned(fOnChange) then fOnChange(Self); + end; + end; + + inherited; +end; + + +procedure TKMColorSwatch.Paint; +var + I, start: Integer; + selColor: TColor4; +begin + inherited; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height, 1, fBackAlpha); + + start := 0; + if fInclRandom then + begin + //Render miniature copy of all available colors with '?' on top + for I := 0 to Length(Colors) - 1 do + TKMRenderUI.WriteShape(AbsLeft+(I mod fColumnCount)*(fCellSize div fColumnCount)+2, AbsTop+(I div fColumnCount)*(fCellSize div fColumnCount)+2, (fCellSize div fColumnCount), (fCellSize div fColumnCount), Colors[I]); + TKMRenderUI.WriteText(AbsLeft + fCellSize div 2, AbsTop + fCellSize div 4, 0, '?', fntMetal, taCenter); + start := 1; + end; + + for I := start to Length(Colors) - 1 do + TKMRenderUI.WriteShape(AbsLeft+(I mod fColumnCount)*fCellSize, AbsTop+(I div fColumnCount)*fCellSize, fCellSize, fCellSize, Colors[I]); + + if fColorIndex < 0 then Exit; + + if GetColorBrightness(Colors[fColorIndex]) >= 0.5 then + selColor := $FF000000 + else + selColor := $FFFFFFFF; + + //Paint selection + TKMRenderUI.WriteOutline(AbsLeft+(fColorIndex mod fColumnCount)*fCellSize, AbsTop+(fColorIndex div fColumnCount)*fCellSize, fCellSize, fCellSize, 1, selColor); +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsDragger.pas b/vendor/kam_remake/src/controls/KM_ControlsDragger.pas new file mode 100644 index 0000000..3f1ebfa --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsDragger.pas @@ -0,0 +1,109 @@ +unit KM_ControlsDragger; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls; + + +type + //Element that player can drag within allowed bounds + TKMDragger = class(TKMControl) + private + fMinusX, fMinusY, fPlusX, fPlusY: Integer; //Restrictions + fPositionX: Integer; + fPositionY: Integer; + fStartDragX: Integer; + fStartDragY: Integer; + public + OnMove: TKMNotifyEventXY; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + + procedure SetBounds(aMinusX, aMinusY, aPlusX, aPlusY: Integer); + + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + + procedure Paint; override; + end; + + +implementation +uses + Math, + KM_RenderUI, + KM_ResTypes; + + +{ TKMDragger } +constructor TKMDragger.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + //Original position is used to resrict movement + fPositionX := 0; + fPositionY := 0; +end; + + +procedure TKMDragger.SetBounds(aMinusX, aMinusY, aPlusX, aPlusY: Integer); +begin + fMinusX := aMinusX; + fMinusY := aMinusY; + fPlusX := aPlusX; + fPlusY := aPlusY; +end; + + +procedure TKMDragger.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + fStartDragX := X - fPositionX; + fStartDragY := Y - fPositionY; + + MouseMove(X,Y,Shift); +end; + + +procedure TKMDragger.MouseMove(X,Y: Integer; Shift: TShiftState); +begin + inherited; + + if csDown in State then + begin + //Bounds are signed numbers, set them properly + fPositionX := EnsureRange((X - fStartDragX), fMinusX, fPlusX); + fPositionY := EnsureRange((Y - fStartDragY), fMinusY, fPlusY); + + if Assigned(OnMove) then OnMove(Self, fPositionX, fPositionY); + end; +end; + + +procedure TKMDragger.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + MouseMove(X,Y,Shift); +end; + + +procedure TKMDragger.Paint; +var + stateSet: TKMButtonStateSet; +begin + inherited; + stateSet := []; + if (csOver in State) and Enabled then + stateSet := stateSet + [bsOver]; + if (csDown in State) then + stateSet := stateSet + [bsDown]; + if not Enabled then + stateSet := stateSet + [bsDisabled]; + + TKMRenderUI.Write3DButton(AbsLeft, AbsTop, Width, Height, rxGui, 0, $FFFF00FF, stateSet, bsGame); +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsDrop.pas b/vendor/kam_remake/src/controls/KM_ControlsDrop.pas new file mode 100644 index 0000000..d99d78b --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsDrop.pas @@ -0,0 +1,792 @@ +unit KM_ControlsDrop; +interface +uses + Classes, + Controls, + KromOGLUtils, + KM_Controls, KM_ControlsBase, KM_ControlsList, + KM_ResTypes, KM_ResFonts, + KM_RenderUI; + + +type + TKMDropCommon = class(TKMControl) + private + fDropCount: Integer; + fDropUp: Boolean; + fFont: TKMFont; + fButton: TKMButton; + fShape: TKMShape; + fAutoClose: Boolean; + + fOnChange: TNotifyEvent; + fOnShowList: TNotifyEvent; + + procedure UpdateDropPosition; virtual; abstract; + procedure ButtonClick(Sender: TObject); + procedure ListShow(Sender: TObject); virtual; + procedure ListClick(Sender: TObject); virtual; + procedure ListChange(Sender: TObject); virtual; + procedure ListHide(Sender: TObject); virtual; + function ListVisible: Boolean; virtual; abstract; + function GetItemIndex: SmallInt; virtual; abstract; + procedure SetItemIndex(aIndex: SmallInt); virtual; abstract; + protected + procedure DoClick(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure SetLeft(aValue: Integer); override; + procedure SetTop(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function ListKeyDown(Sender: TObject; Key: Word; Shift: TShiftState): Boolean; + procedure UpdateVisibility; override; + function GetCount: Integer; virtual; abstract; + procedure SetDropCount(const aValue: Integer); virtual; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle; + aAutoClose: Boolean = True); + + procedure Clear; virtual; abstract; + procedure OpenList; + procedure CloseList; + procedure SetOpenList(aOpen: Boolean); + procedure SwitchOpen; + + property DropCount: Integer read fDropCount write SetDropCount; + property DropUp: Boolean read fDropUp write fDropUp; + property ItemIndex: SmallInt read GetItemIndex write SetItemIndex; + function IsOpen: Boolean; virtual; + property Count: Integer read GetCount; + + property OnShowList: TNotifyEvent read fOnShowList write fOnShowList; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + procedure Paint; override; + end; + + + //DropBox with a ListBox + TKMDropList = class(TKMDropCommon) + private + fCaption: UnicodeString; //Current caption (Default or from list) + fDefaultCaption: UnicodeString; + fDropWidth: Integer; + fList: TKMListBox; + fListTopIndex: Integer; + procedure UpdateDropPosition; override; + procedure ListShow(Sender: TObject); override; + procedure ListClick(Sender: TObject); override; + procedure ListChange(Sender: TObject); override; + procedure ListHide(Sender: TObject); override; + function ListVisible: Boolean; override; + function GetItem(aIndex: Integer): UnicodeString; + function GetItemIndex: smallint; override; + procedure SetItemIndex(aIndex: smallint); override; + procedure SetDropWidth(aDropWidth: Integer); + function GetShowHintWhenShort: Boolean; + procedure SetShowHintWhenShort(const aValue: Boolean); + protected + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function GetCount: Integer; override; + procedure SetDropCount(const aValue: Integer); override; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; const aDefaultCaption: UnicodeString; + aStyle: TKMButtonStyle; aAutoClose: Boolean = True; aBackAlpha: Single = 0.85); + procedure Clear; override; + procedure Add(const aItem: UnicodeString; aTag: Integer = 0); + procedure SelectByName(const aText: UnicodeString); + procedure SelectByTag(aTag: Integer); + function HasTag(aTag: Integer): Boolean; + function GetTag(aIndex: Integer): Integer; + function GetSelectedTag: Integer; + function IsSelected: Boolean; + property ShowHintWhenShort: Boolean read GetShowHintWhenShort write SetShowHintWhenShort; + property DefaultCaption: UnicodeString read fDefaultCaption write fDefaultCaption; + property Item[aIndex: Integer]: UnicodeString read GetItem; + property List: TKMListBox read fList; + function IsOpen: Boolean; override; + property DropWidth: Integer read fDropWidth write SetDropWidth; + + procedure Paint; override; + end; + + + //DropBox with a ColumnBox + TKMDropColumns = class(TKMDropCommon) + private + fDefaultCaption: UnicodeString; + fDropWidth: Integer; + fList: TKMColumnBox; + fListTopIndex: Integer; + fColumnsToShowWhenListHidden: array of Boolean; //which columns to show, when list is hidden + procedure UpdateDropPosition; override; + procedure ListShow(Sender: TObject); override; + procedure ListClick(Sender: TObject); override; + procedure ListChange(Sender: TObject); override; + procedure ListHide(Sender: TObject); override; + function ListVisible: Boolean; override; + function GetItem(aIndex: Integer): TKMListRow; + function GetItemIndex: Smallint; override; + procedure SetItemIndex(aIndex: Smallint); override; + procedure SetDropWidth(aDropWidth: Integer); + function GetShowHintWhenShort: Boolean; + procedure SetShowHintWhenShort(const aValue: Boolean); + protected + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function GetCount: Integer; override; + public + FadeImageWhenDisabled: Boolean; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; const aDefaultCaption: UnicodeString; aStyle: TKMButtonStyle; aShowHeader: Boolean = True); + procedure Add(aItem: TKMListRow); + procedure Clear; override; + property List: TKMColumnBox read fList; + property Item[aIndex: Integer]: TKMListRow read GetItem; default; + procedure SetColumns(aFont: TKMFont; aColumns: array of string; aColumnOffsets: array of Word); overload; + procedure SetColumns(aFont: TKMFont; aColumns: array of string; aColumnOffsets: array of Word; aColumnsToShowWhenListHidden: array of Boolean); overload; + property DefaultCaption: UnicodeString read fDefaultCaption write fDefaultCaption; + property DropWidth: Integer read fDropWidth write SetDropWidth; + property ShowHintWhenShort: Boolean read GetShowHintWhenShort write SetShowHintWhenShort; + + procedure Paint; override; + end; + + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + Math, + KM_Defaults; + + +{ TKMDropCommon } +constructor TKMDropCommon.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; + aStyle: TKMButtonStyle; aAutoClose: Boolean = True); +var + P: TKMPanel; +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fDropCount := 10; + fDropUp := False; + fFont := aFont; + + fButton := TKMButton.Create(aParent, aLeft+aWidth-aHeight, aTop, aHeight, aHeight, 590, rxGui, aStyle); + fButton.OnClick := ButtonClick; + fButton.MakesSound := False; + + P := MasterParent; + fShape := TKMShape.Create(P, 0, 0, P.Width, P.Height); + fShape.AnchorsStretch; + fShape.OnClick := ListHide; + + fAutoClose := aAutoClose; +end; + + +procedure TKMDropCommon.UpdateVisibility; +begin + inherited; + if not Visible then + CloseList; +end; + + +function TKMDropCommon.IsOpen: Boolean; +begin + Result := fShape.Visible; +end; + + +procedure TKMDropCommon.ButtonClick(Sender: TObject); +begin + //Call the DoDlick event to show the list AND generate DropBox.OnClick event + DoClick(fButton.AbsLeft + fButton.Width div 2, fButton.AbsTop + fButton.Height div 2, [], mbLeft); +end; + + +procedure TKMDropCommon.ListShow(Sender: TObject); +begin + if ListVisible then + begin + ListHide(nil); + Exit; + end; + + if fAutoClose and (Count > 0) then + fShape.Show; + + if Assigned(fOnShowList) then fOnShowList(Self); +end; + + +procedure TKMDropCommon.DoClick(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + //do not invoke inherited here, to fully override parent DoClick method + + //It's common behavior when click on dropbox will show the list + if fAutoClose then + ListShow(Self) + else + if not ListVisible then + begin + fButton.TexId := 591; + ListShow(Self) + end else begin + fButton.TexId := 590; + ListHide(Self); + end; + + inherited; +end; + + +//Handle KeyDown on List +function TKMDropCommon.ListKeyDown(Sender: TObject; Key: Word; Shift: TShiftState): Boolean; +begin + if fAutoClose and (Key = VK_ESCAPE) then // Close List on ESC, if autoclosable + begin + ListHide(nil); + Result := True; + end else + Result := False; +end; + + +procedure TKMDropCommon.ListClick(Sender: TObject); +begin + //No need to call fOnChange here since ListChange was already called + if fAutoClose then ListHide(nil); +end; + + +procedure TKMDropCommon.ListChange(Sender: TObject); +begin + if (ItemIndex <> -1) then + if Assigned(fOnChange) then fOnChange(Self); +end; + + +procedure TKMDropCommon.ListHide(Sender: TObject); +begin + fShape.Hide; +end; + + +procedure TKMDropCommon.SetDropCount(const aValue: Integer); +begin + fDropCount := aValue; +end; + + +procedure TKMDropCommon.SetEnabled(aValue: Boolean); +begin + inherited; + fButton.Enabled := Enabled; +end; + + +procedure TKMDropCommon.OpenList; +begin + ListShow(nil); +end; + + +procedure TKMDropCommon.CloseList; +begin + ListHide(nil); +end; + + +procedure TKMDropCommon.SetOpenList(aOpen: Boolean); +begin + if aOpen then + OpenList + else + CloseList; +end; + + +procedure TKMDropCommon.SwitchOpen; +begin + if IsOpen then + CloseList + else + OpenList; +end; + + +procedure TKMDropCommon.SetLeft(aValue: Integer); +begin + inherited; + // Stick the button to us + fButton.Left := Left + Width - Height; +end; + + +procedure TKMDropCommon.SetTop(aValue: Integer); +begin + inherited; + // Stick the button to us + fButton.Top := Top; +end; + + +procedure TKMDropCommon.SetVisible(aValue: Boolean); +begin + inherited; + fButton.Visible := aValue; + if not aValue then ListHide(Self); +end; + + +procedure TKMDropCommon.Paint; +begin + inherited; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height); + + // Make sure the list stays where it needs to be relative DropBox (e.g. on window resize) + UpdateDropPosition; +end; + + +{ TKMDropList } +constructor TKMDropList.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; const aDefaultCaption: UnicodeString; + aStyle: TKMButtonStyle; aAutoClose: Boolean = True; aBackAlpha: Single = 0.85); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aFont, aStyle, aAutoClose); + + fDefaultCaption := aDefaultCaption; + + fListTopIndex := 0; + + fList := TKMListBox.Create(MasterParent, 0, 0, aWidth, 0, fFont, aStyle); + fList.Height := fList.ItemHeight * fDropCount; + fList.AutoHideScrollBar := True; //A drop box should only have a scrollbar if required + fList.BackAlpha := aBackAlpha; + fList.OnClick := ListClick; + fList.OnChange := ListChange; + + DropWidth := aWidth; + + ListHide(nil); + fList.OnKeyDown := ListKeyDown; +end; + + +procedure TKMDropList.ListShow(Sender: TObject); +begin + inherited; + if ListVisible or (Count < 1) then Exit; + + //Make sure the selected item is visible when list is opened + if (ItemIndex <> -1) then + begin + if InRange(ItemIndex, fListTopIndex, fListTopIndex + fList.GetVisibleRows) then //Try to open list at previously saved scroll position + fList.TopIndex := fListTopIndex + else + fList.TopIndex := ItemIndex; + end; + + fList.Show; +end; + + +procedure TKMDropList.ListClick(Sender: TObject); +begin + fCaption := fList.Item[ItemIndex]; + + inherited; +end; + + +procedure TKMDropList.ListChange(Sender: TObject); +begin + fCaption := fList.Item[ItemIndex]; + + inherited; +end; + + +procedure TKMDropList.ListHide(Sender: TObject); +begin + fListTopIndex := fList.TopIndex; //Save list scroll position + inherited; + fList.Hide; +end; + + +function TKMDropList.ListVisible: Boolean; +begin + Result := fList.Visible; +end; + + +function TKMDropList.GetItemIndex: Smallint; +begin + Result := fList.ItemIndex; +end; + + +procedure TKMDropList.SetItemIndex(aIndex: Smallint); +begin + fList.ItemIndex := aIndex; + if aIndex <> -1 then + fCaption := fList.Item[fList.ItemIndex] + else + fCaption := fDefaultCaption; +end; + + +function TKMDropList.GetShowHintWhenShort: Boolean; +begin + Result := fList.ShowHintWhenShort; +end; + + +procedure TKMDropList.SetShowHintWhenShort(const aValue: Boolean); +begin + fList.ShowHintWhenShort := aValue; +end; + + +function TKMDropList.IsOpen: Boolean; +begin + Result := fList.Visible; +end; + + +procedure TKMDropList.SetDropCount(const aValue: Integer); +begin + inherited; + + fList.Height := fList.ItemHeight * fDropCount; +end; + + +procedure TKMDropList.SetDropWidth(aDropWidth: Integer); +begin + fDropWidth := aDropWidth; + fList.AbsLeft := AbsLeft + Width - aDropWidth; + fList.Width := aDropWidth; +end; + + +procedure TKMDropList.SetEnabled(aValue: Boolean); +begin + inherited; + fList.Enabled := Enabled; + if not Enabled and fList.Visible then + ListHide(nil); +end; + + +procedure TKMDropList.SetVisible(aValue: Boolean); +begin + inherited; + if not aValue then ListHide(Self); +end; + + +function TKMDropList.GetCount: Integer; +begin + Result := fList.Count; +end; + + +// When new items are added to the list we must update the drop height and position +procedure TKMDropList.UpdateDropPosition; +begin + if Count > 0 then + begin + fList.Height := Math.Min(fDropCount, fList.Count) * fList.ItemHeight + fList.SeparatorsCount*fList.SeparatorHeight; + + if fDropUp then + fList.AbsTop := AbsTop - fList.Height + else + fList.AbsTop := AbsTop + Height; + + fList.Left := AbsLeft + Width - DropWidth - MasterParent.AbsLeft; + end; +end; + + +procedure TKMDropList.Add(const aItem: UnicodeString; aTag: Integer = 0); +begin + fList.Add(aItem, aTag); +end; + + +procedure TKMDropList.SelectByName(const aText: UnicodeString); +var I: Integer; +begin + fList.ItemIndex := -1; + for I := 0 to fList.Count - 1 do + if fList.Item[I] = aText then + SetItemIndex(I); +end; + + +procedure TKMDropList.SelectByTag(aTag: Integer); +var I: Integer; +begin + fList.ItemIndex := -1; + for I := 0 to fList.Count - 1 do + if fList.ItemTags[I] = aTag then + SetItemIndex(I); +end; + + +function TKMDropList.HasTag(aTag: Integer): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to fList.Count - 1 do + if fList.ItemTags[I] = aTag then + Exit(True); +end; + + +function TKMDropList.IsSelected: Boolean; +begin + Result := fList.ItemIndex <> -1; +end; + + +function TKMDropList.GetTag(aIndex: Integer): Integer; +begin + Result := fList.ItemTags[aIndex]; +end; + + +function TKMDropList.GetSelectedTag: Integer; +begin + Result := GetTag(fList.ItemIndex); +end; + +function TKMDropList.GetItem(aIndex: Integer): UnicodeString; +begin + Result := fList.Item[aIndex]; +end; + + +procedure TKMDropList.Clear; +begin + fList.Clear; +end; + + +procedure TKMDropList.Paint; +var + col: TColor4; +begin + inherited; + + if Enabled then + col := icWhite + else + col := icGray2; + + TKMRenderUI.WriteText(AbsLeft+4, AbsTop+4, Width-8, fCaption, fFont, taLeft, col); +end; + + +{ TKMDropColumns } +constructor TKMDropColumns.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; const aDefaultCaption: UnicodeString; aStyle: TKMButtonStyle; aShowHeader: Boolean = True); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aFont, aStyle); + + fListTopIndex := 0; + + fDefaultCaption := aDefaultCaption; + + fList := TKMColumnBox.Create(MasterParent, 0, 0, aWidth, 0, fFont, aStyle); + fList.BackAlpha := 0.85; + fList.OnClick := ListClick; + fList.OnChange := ListChange; + fList.ShowHeader := aShowHeader; + + DropWidth := aWidth; + + ListHide(nil); + fList.OnKeyDown := ListKeyDown; +end; + + +procedure TKMDropColumns.ListShow(Sender: TObject); +begin + inherited; + if ListVisible or (Count < 1) then Exit; + + //Make sure the selected item is visible when list is opened + if (ItemIndex <> -1) then + begin + if InRange(ItemIndex, fListTopIndex, fListTopIndex + fList.GetVisibleRows) then //Try to open list at previously saved scroll position + fList.TopIndex := fListTopIndex + else + fList.TopIndex := ItemIndex; + end; + + fList.Show; +end; + + +procedure TKMDropColumns.ListClick(Sender: TObject); +begin + inherited; +end; + + +procedure TKMDropColumns.ListChange(Sender: TObject); +begin + inherited; +end; + + +procedure TKMDropColumns.ListHide(Sender: TObject); +begin + fListTopIndex := fList.TopIndex; //Save list scroll position + inherited; + fList.Hide; +end; + + +function TKMDropColumns.ListVisible: Boolean; +begin + Result := fList.Visible; +end; + + +function TKMDropColumns.GetItemIndex: smallint; +begin + Result := fList.ItemIndex; +end; + + +procedure TKMDropColumns.SetItemIndex(aIndex: smallint); +begin + fList.ItemIndex := aIndex; +end; + + +procedure TKMDropColumns.SetDropWidth(aDropWidth: Integer); +begin + fDropWidth := aDropWidth; + fList.AbsLeft := AbsLeft + Width - aDropWidth; + fList.Width := aDropWidth; +end; + + +function TKMDropColumns.GetShowHintWhenShort: Boolean; +begin + Result := fList.ShowHintWhenShort +end; + + +procedure TKMDropColumns.SetShowHintWhenShort(const aValue: Boolean); +begin + fList.ShowHintWhenShort := aValue; +end; + + +procedure TKMDropColumns.SetColumns(aFont: TKMFont; aColumns: array of string; aColumnOffsets: array of Word); +var + I: Integer; + columnsToShowWhenListHidden: array of Boolean; +begin + SetLength(columnsToShowWhenListHidden, Length(aColumns)); + for I := Low(columnsToShowWhenListHidden) to High(columnsToShowWhenListHidden) do + columnsToShowWhenListHidden[I] := True; // by default show all columns + SetColumns(aFont, aColumns, aColumnOffsets, columnsToShowWhenListHidden); +end; + + +procedure TKMDropColumns.SetColumns(aFont: TKMFont; aColumns: array of string; aColumnOffsets: array of Word; aColumnsToShowWhenListHidden: array of Boolean); +var + I: Integer; +begin + Assert(Length(aColumns) = Length(aColumnsToShowWhenListHidden)); + fList.SetColumns(aFont, aColumns, aColumnOffsets); + SetLength(fColumnsToShowWhenListHidden, Length(aColumnsToShowWhenListHidden)); + for I := Low(aColumnsToShowWhenListHidden) to High(aColumnsToShowWhenListHidden) do + fColumnsToShowWhenListHidden[I] := aColumnsToShowWhenListHidden[I]; +end; + + +procedure TKMDropColumns.SetEnabled(aValue: Boolean); +begin + inherited; + fList.Enabled := Enabled; +end; + + +procedure TKMDropColumns.SetVisible(aValue: Boolean); +begin + inherited; + if not aValue then ListHide(Self); +end; + + +function TKMDropColumns.GetCount: Integer; +begin + Result := fList.RowCount; +end; + + +//When new items are added to the list we must update the drop height and position +procedure TKMDropColumns.UpdateDropPosition; +begin + if Count > 0 then + begin + fList.Height := Math.Min(fDropCount, fList.RowCount) * fList.ItemHeight + fList.Header.Height * Ord(fList.ShowHeader); + + if fDropUp then + fList.AbsTop := AbsTop - fList.Height + else + fList.AbsTop := AbsTop + Height; + + fList.Left := AbsLeft + Width - DropWidth - MasterParent.AbsLeft; + end; +end; + + +procedure TKMDropColumns.Add(aItem: TKMListRow); +begin + fList.AddItem(aItem); +end; + + +function TKMDropColumns.GetItem(aIndex: Integer): TKMListRow; +begin + Result := fList.Rows[aIndex]; +end; + + +procedure TKMDropColumns.Clear; +begin + fList.Clear; +end; + + +procedure TKMDropColumns.Paint; +var + col: TColor4; +begin + inherited; + + if Enabled then + col := icWhite + else + col := icGray2; + + if ItemIndex = -1 then + TKMRenderUI.WriteText(AbsLeft + 4, AbsTop + 4, Width - 8 - fButton.Width, fDefaultCaption, fFont, taLeft, col) + else + fList.DoPaintLine(ItemIndex, AbsLeft, AbsTop, Width - fButton.Width, fColumnsToShowWhenListHidden, False); +end; + + +end. \ No newline at end of file diff --git a/vendor/kam_remake/src/controls/KM_ControlsEdit.pas b/vendor/kam_remake/src/controls/KM_ControlsEdit.pas new file mode 100644 index 0000000..760c0ec --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsEdit.pas @@ -0,0 +1,1050 @@ +unit KM_ControlsEdit; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsBase, KM_ControlsTypes, + KM_RenderUI, + KM_ResFonts, + KM_Points; + + +type + // Basic Edit class with selection available + TKMSelectableEdit = class abstract(TKMControl) + private + fFont: TKMFont; + fLeftIndex: Integer; //The position of the character shown left-most when text does not fit + + fCursorPos: Integer; + fSelectable: Boolean; + fSelectionStart: Integer; + fSelectionEnd: Integer; + fSelectionInitialPos: Integer; + + procedure SetCursorPos(aPos: Integer); + function GetCursorPosAt(X: Integer): Integer; + procedure ResetSelection; + function HasSelection: Boolean; + function GetSelectedText: UnicodeString; + procedure SetSelectionStart(aValue: Integer); + procedure SetSelectionEnd(aValue: Integer); + procedure DeleteSelectedText; + procedure SetSelections(aValue1, aValue2: Integer); + procedure UpdateSelection(aOldCursorPos: Integer; aIsSelecting: Boolean); + protected + fText: UnicodeString; + procedure SelEditCtrlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + procedure FocusChanged(aFocused: Boolean); override; + function GetMaxLength: Word; virtual; abstract; + function IsCharValid(aChar: WideChar): Boolean; virtual; abstract; + procedure ValidateText(aTriggerOnChange: Boolean = True); virtual; + function KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; virtual; abstract; + procedure PaintSelection; + function DrawEolSymbol: Boolean; virtual; + function DoShowMarkup: Boolean; virtual; +// function GetControlMouseDownProc: TKMMouseUpDownEvent; virtual; + + procedure Changed; + public + ReadOnly: Boolean; + BlockInput: Boolean; // Blocks all input into the field, but allow focus, selection and copy selected text + + OnChange: TNotifyEvent; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean = True); + + property CursorPos: Integer read fCursorPos write SetCursorPos; + property Selectable: Boolean read fSelectable write fSelectable; + property SelectionStart: Integer read fSelectionStart write SetSelectionStart; + property SelectionEnd: Integer read fSelectionEnd write SetSelectionEnd; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + function KeyDown(Key: Word; Shift: TShiftState): Boolean; override; + procedure KeyPress(Key: Char); override; + function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; + end; + + // Edit for text + TKMEdit = class(TKMSelectableEdit) + private + fAllowedChars: TKMAllowedChars; + procedure SetText(const aText: UnicodeString); + protected + function GetMaxLength: Word; override; + function IsCharValid(aChar: WideChar): Boolean; override; + procedure ValidateText(aTriggerOnChange: Boolean = True); override; + function KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; override; + function GetRText: UnicodeString; + function DrawEolSymbol: Boolean; override; + function DoShowMarkup: Boolean; override; + public + Masked: Boolean; //Mask entered text as *s + MaxLen: Word; + ShowColors: Boolean; + DrawOutline: Boolean; + OutlineColor: Cardinal; + OnIsKeyEventHandled: TKMNotifyFuncKey; //Invoked to check is key overrides default handle policy or not + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean = True); + + property AllowedChars: TKMAllowedChars read fAllowedChars write fAllowedChars; + property Text: UnicodeString read fText write SetText; + procedure UpdateText(const aText: UnicodeString; aTriggerOnChange: Boolean = True); + procedure SetTextSilently(const aText: UnicodeString); + + function HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; override; + procedure Paint; override; + end; + + + TKMFilenameEdit = class(TKMEdit) + private + function GetIsValid: Boolean; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean = True); + + property IsValid: Boolean read GetIsValid; + end; + + + TKMNumericEdit = class(TKMSelectableEdit) + private + fButtonInc: TKMButton; + fButtonDec: TKMButton; + fValue: Integer; + procedure ButtonClick(Sender: TObject; Shift: TShiftState); + + procedure SetValueNCheckRange(aValue: Int64); + procedure SetValue(aValue: Integer); + procedure CheckValueOnUnfocus; + procedure ClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); + protected + procedure SetLeft(aValue: Integer); override; + procedure SetTop(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + procedure SetHint(const aValue: UnicodeString); override; + function GetSelfAbsLeft: Integer; override; + function GetSelfWidth: Integer; override; + function GetMaxLength: Word; override; + function IsCharValid(Key: WideChar): Boolean; override; + procedure ValidateText(aTriggerOnChange: Boolean = True); override; + procedure FocusChanged(aFocused: Boolean); override; + function KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; override; + procedure NumEdCtrlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + function DoHandleMouseWheelByDefault: Boolean; override; + public + ValueMin: Integer; + ValueMax: Integer; + constructor Create(aParent: TKMPanel; aLeft, aTop, aValueMin, aValueMax: Integer; aFont: TKMFont = fntGrey; aSelectable: Boolean = True); + property Value: Integer read fValue write SetValue; + + function KeyDown(Key: Word; Shift: TShiftState): Boolean; override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + procedure Paint; override; + end; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + Clipbrd, + SysUtils, StrUtils, Math, + KromUtils, KromOGLUtils, + KM_ControlsUtils, + KM_Resource, KM_ResTypes, + KM_CommonTypes, KM_Defaults, + KM_CommonUtils, KM_UtilsExt; + + +{ TKMSelectableEdit } +constructor TKMSelectableEdit.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + CursorPos := 0; + + //Text input fields are focusable by concept + Focusable := True; + ReadOnly := False; + BlockInput := False; + fSelectable := aSelectable; + + // Descendants of TKMSelectableEdit could add more event handlers + aParent.MasterControl.SubscribeOnOtherMouseDown(SelEditCtrlMouseDown); +end; + + +procedure TKMSelectableEdit.DeleteSelectedText; +begin + Delete(fText, fSelectionStart+1, fSelectionEnd-fSelectionStart); + + if CursorPos = fSelectionEnd then + CursorPos := CursorPos - (fSelectionEnd-fSelectionStart); + + ResetSelection; +end; + + +function TKMSelectableEdit.GetCursorPosAt(X: Integer): Integer; +var + rText: UnicodeString; +begin + rText := Copy(fText, fLeftIndex+1, Length(fText) - fLeftIndex); + if gRes.Fonts[fFont].GetTextSize(rText, DoShowMarkup, DrawEolSymbol).X < X-SelfAbsLeft-4 then + Result := Length(rText) + fLeftIndex + else + Result := gRes.Fonts[fFont].CharsThatFit(rText, X-SelfAbsLeft-4, DoShowMarkup, DrawEolSymbol) + fLeftIndex; +end; + + +function TKMSelectableEdit.GetSelectedText: UnicodeString; +begin + Result := ''; + if HasSelection then + Result := Copy(fText, fSelectionStart+1, fSelectionEnd - fSelectionStart); +end; + + +function TKMSelectableEdit.HasSelection: Boolean; +begin + Result := (fSelectionStart <> -1) and (fSelectionEnd <> -1) and (fSelectionStart <> fSelectionEnd); +end; + + +procedure TKMSelectableEdit.ResetSelection; +begin + fSelectionStart := -1; + fSelectionEnd := -1; + fSelectionInitialPos := -1; +end; + + +procedure TKMSelectableEdit.SetSelectionEnd(aValue: Integer); +begin + if fSelectable then + fSelectionEnd := EnsureRange(aValue, 0, Length(fText)); +end; + + +procedure TKMSelectableEdit.SetSelectionStart(aValue: Integer); +begin + if fSelectable then + fSelectionStart := EnsureRange(aValue, 0, Length(fText)); +end; + + +//Set selections with pair of value, using he fact, that fSelectionStart <= fSelectionEnd +procedure TKMSelectableEdit.SetSelections(aValue1, aValue2: Integer); +begin + SelectionStart := Min(aValue1, aValue2); + SelectionEnd := Max(aValue1, aValue2); +end; + + +procedure TKMSelectableEdit.ValidateText(aTriggerOnChange: Boolean = True); +begin + if aTriggerOnChange then + Changed; +end; + + +procedure TKMSelectableEdit.Changed; +begin + // OnChange should be called here, since we changed the input and don't want to wait until KeyUp event + if Assigned(OnChange) then + OnChange(Self); +end; + + +procedure TKMSelectableEdit.SetCursorPos(aPos: Integer); +var + rText: UnicodeString; +begin + fCursorPos := EnsureRange(aPos, 0, Length(fText)); + if fCursorPos < fLeftIndex then + fLeftIndex := fCursorPos + else + begin + //Remove characters to the left of fLeftIndex + rText := Copy(fText, fLeftIndex+1, Length(fText)); + while fCursorPos-fLeftIndex > gRes.Fonts[fFont].CharsThatFit(rText, Width-8, False, DrawEolSymbol) do + begin + Inc(fLeftIndex); + //Remove characters to the left of fLeftIndex + rText := Copy(fText, fLeftIndex+1, Length(fText)); + end; + end; +end; + + +//Update selection start/end due to change cursor position +procedure TKMSelectableEdit.UpdateSelection(aOldCursorPos: Integer; aIsSelecting: Boolean); +begin + if aIsSelecting then + begin + if HasSelection then + begin + if aOldCursorPos = SelectionStart then + SetSelections(CursorPos, SelectionEnd) + else + if aOldCursorPos = SelectionEnd then + SetSelections(SelectionStart, CursorPos); + end else + SetSelections(aOldCursorPos, CursorPos); + end + else + ResetSelection; +end; + + +function TKMSelectableEdit.KeyDown(Key: Word; Shift: TShiftState): Boolean; + + // Update cursor pos considering Ctrl Key to go to the next / prev word in the text + procedure UpdateCursorPos(aCursorDir: TKMCursorDir); + begin + if ssCtrl in Shift then + begin + case aCursorDir of + cdNone: ; + cdForward: CursorPos := GetNextWordPos(fText, CursorPos); + cdBack: CursorPos := GetPrevWordPos(fText, CursorPos); + end; + end + else + CursorPos := CursorPos + ShortInt(aCursorDir); + end; + +var + oldCursorPos: Integer; +begin + Result := KeyEventHandled(Key, Shift); + if inherited KeyDown(Key, Shift) or ReadOnly then Exit; + + //Allow some keys while blocking input + if BlockInput + and not ((Key in [VK_LEFT, VK_RIGHT, VK_HOME, VK_END]) + or ((ssCtrl in Shift) and (Key in [VK_LEFT, VK_RIGHT, Ord('A'), Ord('C')]))) then Exit; + + oldCursorPos := CursorPos; + + //Clipboard operations + if (Shift = [ssCtrl]) and (Key <> VK_CONTROL) then + case Key of + Ord('A'): begin + SelectionStart := 0; + SelectionEnd := Length(fText); + end; + Ord('C'): if HasSelection then + Clipboard.AsText := GetSelectedText; + Ord('X'): if HasSelection then + begin + Clipboard.AsText := GetSelectedText; + DeleteSelectedText; + ValidateText; + end; + Ord('V'): begin + if HasSelection then + begin + Delete(fText, fSelectionStart + 1, fSelectionEnd-fSelectionStart); + Insert(Clipboard.AsText, fText, fSelectionStart + 1); + ValidateText; + if CursorPos = fSelectionStart then + CursorPos := CursorPos + Length(Clipboard.AsText) + else if CursorPos = fSelectionEnd then + CursorPos := CursorPos + Length(Clipboard.AsText) - (fSelectionEnd-fSelectionStart); + ResetSelection; + end else begin + Insert(Clipboard.AsText, fText, CursorPos + 1); + ValidateText; + CursorPos := CursorPos + Length(Clipboard.AsText); + end; + end; + end; + + case Key of + VK_BACK: if HasSelection then + begin + DeleteSelectedText; + ValidateText; + end + else + begin + Delete(fText, CursorPos, 1); + CursorPos := CursorPos - 1; + ValidateText; + end; + VK_DELETE: if HasSelection then + begin + DeleteSelectedText; + ValidateText; + end + else + begin + Delete(fText, CursorPos + 1, 1); + ValidateText; + end; + end; + + case Key of + VK_LEFT, + VK_RIGHT: begin + UpdateCursorPos(GetCursorDir(Key)); + UpdateSelection(oldCursorPos, IsSelecting(Key, Shift)); + end; + VK_HOME: begin + CursorPos := 0; + UpdateSelection(oldCursorPos, IsSelecting(Key, Shift)); + end; + VK_END: begin + CursorPos := Length(fText); + UpdateSelection(oldCursorPos, IsSelecting(Key, Shift)); + end; + end; +end; + + +procedure TKMSelectableEdit.KeyPress(Key: Char); +begin + inherited; + + if ReadOnly or BlockInput then Exit; + + if HasSelection and IsCharValid(Key) then + DeleteSelectedText + else + if Length(fText) >= GetMaxLength then Exit; + + Insert(Key, fText, CursorPos + 1); + CursorPos := CursorPos + 1; //Before ValidateText so it moves the cursor back if the new char was invalid + ValidateText; //Validate text at the end of all changes (delete selected and insert) +end; + + +function TKMSelectableEdit.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := KeyEventHandled(Key, Shift); + if inherited KeyUp(Key, Shift) or ReadOnly then Exit; +end; + + +procedure TKMSelectableEdit.MouseDown(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + oldCursorPos: Integer; +begin + if ReadOnly then Exit; + inherited; + // Update Focus now, because we need to focus on MouseDown, not on MouseUp as by default for all controls + MasterParent.MasterControl.UpdateFocus(Self); + + oldCursorPos := CursorPos; + CursorPos := GetCursorPosAt(X); + + if Focusable then + begin + //Try select on Shift + LMB click + UpdateSelection(oldCursorPos, (oldCursorPos <> -1) and (Shift = [ssLeft, ssShift])); + fSelectionInitialPos := CursorPos; + end; +end; + + +procedure TKMSelectableEdit.MouseMove(X, Y: Integer; Shift: TShiftState); +var + curCursorPos, oldCursorPos: Integer; +begin + if ReadOnly then Exit; + inherited; + if (ssLeft in Shift) and (fSelectionInitialPos <> -1) then + begin + curCursorPos := GetCursorPosAt(X); + // To rotate line to left while selecting + if (X-SelfAbsLeft-4 < 0) and (fLeftIndex > 0) then + curCursorPos := curCursorPos - 1; + + oldCursorPos := CursorPos; + CursorPos := CurCursorPos; + UpdateSelection(oldCursorPos, True); + end; +end; + + +procedure TKMSelectableEdit.MouseUp(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if ReadOnly then Exit; + inherited; + fSelectionInitialPos := -1; +end; + + +procedure TKMSelectableEdit.PaintSelection; +var + beforeSelectionText, selectionText: UnicodeString; + beforeSelectionW, selectionW: Integer; +begin + if HasSelection then + begin + beforeSelectionText := Copy(fText, fLeftIndex+1, max(fSelectionStart, fLeftIndex) - fLeftIndex); + selectionText := Copy(fText, max(fSelectionStart, fLeftIndex)+1, fSelectionEnd - max(fSelectionStart, fLeftIndex)); + + beforeSelectionW := gRes.Fonts[fFont].GetTextSize(beforeSelectionText, DoShowMarkup, DrawEolSymbol).X; + selectionW := gRes.Fonts[fFont].GetTextSize(selectionText, DoShowMarkup, DrawEolSymbol).X; + + TKMRenderUI.WriteShape(SelfAbsLeft+4+beforeSelectionW, AbsTop+3, min(selectionW, Width-8), Height-6, clTextSelection); + end; +end; + + +function TKMSelectableEdit.DrawEolSymbol: Boolean; +begin + Result := False; //EOL is not showing by default +end; + + +function TKMSelectableEdit.DoShowMarkup: Boolean; +begin + Result := False; // Markup is not showing by default +end; + + +procedure TKMSelectableEdit.SelEditCtrlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if (Sender <> Self) then + ResetSelection; +end; + + +//function TKMSelectableEdit.GetControlMouseDownProc: TKMMouseUpDownEvent; +//begin +// Result := ControlMouseDown; +//end; + + +procedure TKMSelectableEdit.FocusChanged(aFocused: Boolean); +begin + inherited; + if not aFocused then + ResetSelection; +end; + + +{ TKMEdit } +constructor TKMEdit.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean = True); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aFont, aSelectable); + fAllowedChars := acText; //Set to the widest by default + MaxLen := 256; //Default max length to prevent chat spam +end; + + +function TKMEdit.GetMaxLength: Word; +begin + Result := MaxLen; +end; + + +function TKMEdit.GetRText: UnicodeString; +begin + if Masked then + Result := StringOfChar('*', Length(fText)) + else + Result := fText; + Result := Copy(Result, fLeftIndex+1, Length(Result)); +end; + + +function TKMEdit.DrawEolSymbol: Boolean; +begin + Result := AllowedChars = acAll; +end; + + +function TKMEdit.DoShowMarkup: Boolean; +begin + Result := ShowColors; +end; + + +function TKMEdit.HitTest(X, Y: Integer; aIncludeDisabled: Boolean = False; aIncludeNotHitable: Boolean = False): Boolean; +begin + //When control is read-only we don't want to recieve Focus event + Result := inherited HitTest(X,Y) and not ReadOnly; +end; + + +procedure TKMEdit.SetText(const aText: UnicodeString); +begin + UpdateText(aText); + //Setting the text should place cursor to the end + fLeftIndex := 0; + SetCursorPos(Length(Text)); +end; + + +procedure TKMEdit.UpdateText(const aText: UnicodeString; aTriggerOnChange: Boolean = True); +begin + fText := aText; + ValidateText(aTriggerOnChange); //Validate first since it could change fText + CursorPos := Math.Min(CursorPos, Length(fText)); +end; + + +procedure TKMEdit.SetTextSilently(const aText: UnicodeString); +begin + UpdateText(aText, False); +end; + + +function TKMEdit.IsCharValid(aChar: WideChar): Boolean; +begin + Result := IsCharAllowed(aChar, fAllowedChars); +end; + + +//Validates fText basing on predefined sets of allowed or disallowed chars +//It iterates from end to start of a string - deletes chars and moves cursor appropriately +procedure TKMEdit.ValidateText(aTriggerOnChange: Boolean = True); +var + I: Integer; +begin + //Parse whole text incase user placed it from clipboard + //Validate contents + for I := Length(fText) downto 1 do + if not IsCharValid(fText[I]) then + begin + Delete(fText, I, 1); + if CursorPos >= I then //Keep cursor in place + CursorPos := CursorPos - 1; + end; + + //Validate length + if Length(fText) > MaxLen then + fText := Copy(fText, 0, MaxLen); + + inherited ValidateText(aTriggerOnChange); //Could trigger OnChange event +end; + + +//Key events which have no effect should not be handled (allows scrolling while chat window open with no text entered) +function TKMEdit.KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; +begin + Result := True; + + //Don't include backspace/delete because edits should always handle those. Otherwise when you + //press backspace repeatedly to remove all characters it will apply other shortcuts like + //resetting the zoom if you press it once too many times. + case Key of + VK_UP, + VK_DOWN, + VK_LEFT, + VK_RIGHT, + VK_HOME, + VK_END: Result := (fText <> ''); //These keys have no effect when text is blank + end; + + //We want these keys to be ignored by TKMEdit + if Key in [VK_F1..VK_F12, VK_ESCAPE, VK_RETURN, VK_TAB, VK_MBUTTON] then Result := False; + + //Ctrl can be used as an escape character, e.g. CTRL+B places beacon while chat is open + if ssCtrl in Shift then Result := (Key in [VK_LEFT, VK_RIGHT, Ord('A'), Ord('C'), Ord('X'), Ord('V')]); + + // If key is ignored, then check if can still handle it (check via OnIsKeyEventHandled) + if not Result and Assigned(OnIsKeyEventHandled) then + Result := OnIsKeyEventHandled(Self, Key); +end; + + +procedure TKMEdit.Paint; +var + col: TColor4; + rText: UnicodeString; + offX: Integer; +begin + inherited; + + if DrawOutline then + begin + TKMRenderUI.WriteShape(AbsLeft-1, AbsTop-1, Width+2, Height+2, $00000000, OutlineColor); + TKMRenderUI.WriteShape(AbsLeft-2, AbsTop-2, Width+4, Height+4, $00000000, OutlineColor); + end; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height); + + if not Enabled then + col := icGray2 + else if BlockInput then + col := icLightGray + else + col := icWhite; + + if Masked then + rText := StringOfChar('*', Length(fText)) + else + rText := fText; + rText := Copy(fText, fLeftIndex+1, Length(fText)); //Remove characters to the left of fLeftIndex + + PaintSelection; + + //Characters that do not fit are trimmed + TKMRenderUI.WriteText(AbsLeft+4, AbsTop+3, Width-8, rText, fFont, taLeft, col, not ShowColors, True, DrawEolSymbol); + + //Render text cursor + if (csFocus in State) and ((TimeGet div 500) mod 2 = 0) then + begin + SetLength(rText, CursorPos - fLeftIndex); + offX := AbsLeft + 2 + gRes.Fonts[fFont].GetTextSize(rText, True, DrawEolSymbol).X; + TKMRenderUI.WriteShape(offX, AbsTop+2, 3, Height-4, col, $FF000000); + end; +end; + + +{ TKMFilenameEdit } +constructor TKMFilenameEdit.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aSelectable: Boolean = True); +const + MAX_SAVENAME_LENGTH = 50; +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aFont, aSelectable); + + fAllowedChars := acFileName; // Set to the widest by default + MaxLen := MAX_SAVENAME_LENGTH; +end; + + +function TKMFilenameEdit.GetIsValid: Boolean; +const + // Windows has the following reserved folder names, according to: + // https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file + WIN_RESERVED_FILENAMES: array [0..21] of string = ( + 'CON', 'PRN', 'AUX', 'NUL', 'COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', + 'COM7', 'COM8', 'COM9', 'LPT1', 'LPT2', 'LPT3', 'LPT4', 'LPT5', 'LPT6', 'LPT7', + 'LPT8', 'LPT9'); +var + S, txt: string; +begin + txt := Trim(fText); + Result := (txt <> '') and (RightStr(txt, 1) <> '.'); + if not Result then Exit; + + for S in WIN_RESERVED_FILENAMES do + if S = txt.ToUpper then + Exit(False); +end; + + +{ TKMNumericEdit } +constructor TKMNumericEdit.Create(aParent: TKMPanel; aLeft, aTop, aValueMin, aValueMax: Integer; aFont: TKMFont = fntGrey; aSelectable: Boolean = True); +var + W: Word; +begin + // Text width + padding + buttons + W := Max(gRes.Fonts[fntGrey].GetTextSize(IntToStr(aValueMax)).X, gRes.Fonts[fntGrey].GetTextSize(IntToStr(aValueMin)).X) + 10 + 20 + 20; + + inherited Create(aParent, aLeft, aTop, W, 20, aFont, aSelectable); + + ReadOnly := False; + + ValueMin := aValueMin; + ValueMax := aValueMax; + Value := 0; + + fButtonDec := TKMButton.Create(aParent, aLeft, aTop, 20, 20, '-', bsGame); + fButtonInc := TKMButton.Create(aParent, aLeft + W - 20, aTop, 20, 20, '+', bsGame); + fButtonInc.CapOffsetY := 1; + fButtonDec.OnClickShift := ButtonClick; + fButtonInc.OnClickShift := ButtonClick; + fButtonDec.OnMouseWheel := MouseWheel; + fButtonInc.OnMouseWheel := MouseWheel; + fButtonDec.OnClickHold := ClickHold; + fButtonInc.OnClickHold := ClickHold; + + aParent.MasterControl.SubscribeOnOtherMouseDown(NumEdCtrlMouseDown); +end; + + +procedure TKMNumericEdit.ClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); +var + amt: Integer; +begin + inherited; + aHandled := True; + + amt := GetMultiplicator(Button); + + if Sender = fButtonDec then + Value := Value - amt + else + if Sender = fButtonInc then + Value := Value + amt; + + if (amt <> 0) and Assigned(OnChange) then + OnChange(Self); +end; + + +function TKMNumericEdit.KeyDown(Key: Word; Shift: TShiftState): Boolean; +begin + Result := KeyEventHandled(Key, Shift); + inherited KeyDown(Key, Shift); + + case Key of + VK_UP: begin + SetValueNCheckRange(Int64(Value) + 1 + 9*Byte(ssShift in Shift)); + Changed; + end; + VK_DOWN: begin + SetValueNCheckRange(Int64(Value) - 1 - 9*Byte(ssShift in Shift)); + Changed; + end; + VK_DELETE: ValidateText; //Update value, cause we just deleted text and KeyPress was not invoked + end; +end; + + +function TKMNumericEdit.KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; +begin + Result := True; + + //Don't include backspace/delete because edits should always handle those. Otherwise when you + //press backspace repeatedly to remove all characters it will apply other shortcuts like + //resetting the zoom if you press it once too many times. + case Key of + VK_LEFT, + VK_RIGHT, + VK_HOME, + VK_END: Result := (fText <> ''); //These keys have no effect when text is blank + end; + + //We want these keys to be ignored by TKMNumericEdit + if Key in [VK_F1..VK_F12, VK_ESCAPE, VK_RETURN, VK_TAB, VK_MBUTTON] then Result := False; + + //Ctrl can be used as an escape character, e.g. CTRL+B places beacon while chat is open + if ssCtrl in Shift then + Result := (Key in [VK_LEFT, VK_RIGHT, Ord('A'), Ord('C'), Ord('X'), Ord('V')]); +end; + + +function TKMNumericEdit.GetMaxLength: Word; +var + minValue: Integer; +begin + if ValueMin = Low(Integer) then + minValue := ValueMin + 1 // to prevent integer overflow, when take Abs(MinValue); + else + minValue := ValueMin; + + if (Max(Abs(ValueMax), Abs(minValue)) <> 0) then + Result := Trunc(Max(Log10(Abs(ValueMax)) + Byte(ValueMax < 0), Log10(Abs(minValue)) + Byte(minValue < 0))) + 1 + else + Result := 1; +end; + + +function TKMNumericEdit.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMNumericEdit.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + inherited; + + if aHandled then Exit; + + SetValueNCheckRange(Int64(Value) + WheelSteps*(1 + 9*Byte(GetKeyState(VK_SHIFT) < 0))); + + aHandled := WheelSteps <> 0; + + Focus; + + if Assigned(OnChange) then + OnChange(Self); +end; + + +procedure TKMNumericEdit.ButtonClick(Sender: TObject; Shift: TShiftState); +begin + if Sender = fButtonDec then + SetValueNCheckRange(Int64(Value) - GetMultiplicator(Shift)) + else + if Sender = fButtonInc then + SetValueNCheckRange(Int64(Value) + GetMultiplicator(Shift)) + else + Exit; + + Focus; + + if Assigned(OnChange) then + OnChange(Self); +end; + + +procedure TKMNumericEdit.SetTop(aValue: Integer); +begin + inherited; + + fButtonDec.Top := Top; + fButtonInc.Top := Top; +end; + + +procedure TKMNumericEdit.SetLeft(aValue: Integer); +begin + inherited; + + fButtonDec.Left := Left; + fButtonInc.Left := Left + Width - 20; +end; + + +procedure TKMNumericEdit.SetEnabled(aValue: Boolean); +begin + inherited; + fButtonDec.Enabled := Enabled; + fButtonInc.Enabled := Enabled; +end; + + +procedure TKMNumericEdit.SetHint(const aValue: UnicodeString); +begin + inherited; + fButtonDec.Hint := aValue; + fButtonInc.Hint := aValue; +end; + + +procedure TKMNumericEdit.SetVisible(aValue: Boolean); +begin + inherited; + fButtonDec.Visible := IsSetVisible; + fButtonInc.Visible := IsSetVisible; +end; + + +function TKMNumericEdit.GetSelfAbsLeft: Integer; +begin + Result := AbsLeft + 20; +end; + + +function TKMNumericEdit.GetSelfWidth: Integer; +begin + Result := Width - 40; +end; + + +function TKMNumericEdit.IsCharValid(Key: WideChar): Boolean; +begin + Result := SysUtils.CharInSet(Key, ['0'..'9']) or ((Key = '-') and (ValueMin < 0)); +end; + + +procedure TKMNumericEdit.SetValueNCheckRange(aValue: Int64); +begin + SetValue(EnsureRange(aValue, Low(Integer), High(Integer))); +end; + + +procedure TKMNumericEdit.SetValue(aValue: Integer); +begin + fValue := EnsureRange(aValue, ValueMin, ValueMax); + fText := IntToStr(fValue); + + //External Value assignment should not generate OnChange event +end; + + +procedure TKMNumericEdit.ValidateText(aTriggerOnChange: Boolean = True); +var + I: Integer; + allowedChars: TSetOfAnsiChar; + onlyMinus, isEmpty: Boolean; +begin + isEmpty := (fText = #8); // When deleting text with Backspace last character is still in string - backspace character (#8) + + allowedChars := ['0'..'9']; + //Validate contents + for I := Length(fText) downto 1 do + begin + if I = 1 then Include(allowedChars, '-'); + + if not KromUtils.CharInSet(fText[I], allowedChars) then + begin + Delete(fText, I, 1); + if CursorPos >= I then //Keep cursor in place + CursorPos := CursorPos - 1; + end; + end; + + onlyMinus := (fText = '-'); + + if (fText = '') or onlyMinus or isEmpty then + Value := 0 + else + SetValueNCheckRange(StrToInt64(fText)); + + if onlyMinus then fText := '-'; //Set text back to '-' while still editing. + if isEmpty then fText := ''; //Set text back to '' while still editing. + + CursorPos := Min(CursorPos, Length(fText)); //In case we had leading zeros in fText string + + inherited ValidateText(aTriggerOnChange); //Could trigger OnChange event +end; + + +procedure TKMNumericEdit.Paint; +var + col: TColor4; + rText: UnicodeString; + offX: Integer; +begin + inherited; + + TKMRenderUI.WriteBevel(AbsLeft + 20, AbsTop, Width - 40, Height); + + if Enabled then + col := $FFFFFFFF + else + col := $FF888888; + + rText := Copy(fText, fLeftIndex+1, Length(fText)); //Remove characters to the left of fLeftIndex + + PaintSelection; + + TKMRenderUI.WriteText(AbsLeft+24, AbsTop+3, 0, fText, fFont, taLeft, col); //Characters that do not fit are trimmed + + //Render text cursor + if (csFocus in State) and ((TimeGet div 500) mod 2 = 0) then + begin + SetLength(rText, CursorPos - fLeftIndex); + offX := AbsLeft + 22 + gRes.Fonts[fFont].GetTextSize(rText).X; + TKMRenderUI.WriteShape(offX, AbsTop+2, 3, Height-4, col, $FF000000); + end; +end; + + +procedure TKMNumericEdit.CheckValueOnUnfocus; +begin + if (fText = '-') or (fText = '') then //after unfocus, if only '-' is in string, set value to 0 + Value := 0; +end; + + +procedure TKMNumericEdit.FocusChanged(aFocused: Boolean); +begin + inherited; + if not aFocused then + CheckValueOnUnfocus; +end; + + +procedure TKMNumericEdit.NumEdCtrlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if (Sender <> Self) then + CheckValueOnUnfocus; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsForm.pas b/vendor/kam_remake/src/controls/KM_ControlsForm.pas new file mode 100644 index 0000000..088be55 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsForm.pas @@ -0,0 +1,350 @@ +unit KM_ControlsForm; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsBase, + KM_CommonTypes, KM_Points, KM_ResFonts; + + +type + TKMFormBackgroundType = ( + fbGray, // Dark grey scroll with big header roll + fbYellow, // Yellow scroll without header roll + fbScroll // Yellow scroll with small header roll + ); + + TKMForm = class(TKMPanel) + const + DEFAULT_CAPTION_FONT = fntOutline; + private + fDragging: Boolean; + fDragStartPos: TKMPoint; + fBackground: TKMFormBackgroundType; + fHandleCloseKey: Boolean; + fCapOffsetY: Integer; + + fOnClose: TKMEvent; + procedure UpdateSizes; + procedure Close(Sender: TObject); + + procedure HandleOtherControlMouseMove(Sender: TObject; X,Y: Integer; Shift: TShiftState); + procedure HandleOtherControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + procedure HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + + function MarginMainLeftRight: Integer; + function MarginMainTop: Integer; + function MarginMainBottom: Integer; + function MarginCrossTop: Integer; + function MarginCrossRight: Integer; + + function GetActualWidth: Integer; + procedure SetActualWidth(aValue: Integer); + function GetActualHeight: Integer; + procedure SetActualHeight(aValue: Integer); + + procedure SetHandleCloseKey(aValue: Boolean); + procedure SetCapOffsetY(aValue: Integer); + function GetCaption: string; + procedure SetCaption(const aValue: string); + protected + Bevel_Contents: TKMBevel; + Bevel_ModalBackground: TKMBevel; + Image_Background, Image_Close: TKMImage; + Label_Caption: TKMLabel; + procedure SetWidth(aValue: Integer); override; + procedure SetHeight(aValue: Integer); override; + public + ItemsPanel: TKMPanel; + DragEnabled: Boolean; + + constructor Create(aParent: TKMPanel; aContentWidth, aContentHeight: Integer; const aCaption: UnicodeString = ''; + aBackground: TKMFormBackgroundType = fbYellow; aCloseIcon: Boolean = False; + aBevelForContents: Boolean = True; aModalBackground: Boolean = True); + + procedure MouseDown (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove (X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + + function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; + + property OnClose: TKMEvent read fOnClose write fOnClose; + + property ActualHeight: Integer read GetActualHeight write SetActualHeight; + property ActualWidth: Integer read GetActualWidth write SetActualWidth; + property CapOffsetY: Integer read fCapOffsetY write SetCapOffsetY; + property Caption: string read GetCaption write SetCaption; + + property HandleCloseKey: Boolean read fHandleCloseKey write SetHandleCloseKey; + end; + + +implementation +uses + Math, + KM_RenderUI, + KM_ResTexts, KM_ResKeys, KM_ResTypes; + + +{ TKMForm } +constructor TKMForm.Create(aParent: TKMPanel; aContentWidth, aContentHeight: Integer; const aCaption: UnicodeString = ''; + aBackground: TKMFormBackgroundType = fbYellow; aCloseIcon: Boolean = False; + aBevelForContents: Boolean = True; aModalBackground: Boolean = True); +const + BG_RX: array [TKMFormBackgroundType] of TRXType = (rxGuiMain, rxGuiMain, rxGui); + BG_ID: array [TKMFormBackgroundType] of Word = (15, 18, 409); +begin + fBackground := aBackground; + + var desiredWidth := aContentWidth + 2 * MarginMainLeftRight; + var desiredHeight := aContentHeight + MarginMainBottom + MarginMainTop; + var desiredLeft := Max(0, (aParent.Width - desiredWidth) div 2); + var desiredTop := Max(0, (aParent.Height - desiredHeight) div 2); + + // Create panel with calculated sizes + inherited Create(aParent, desiredLeft, desiredTop, desiredWidth, desiredHeight); + + // Fix its base sizes as a desired one + BaseWidth := desiredWidth; + BaseHeight := desiredHeight; + +// FitInParent := True; not sure if this is ever needed + DragEnabled := False; + fHandleCloseKey := False; + fCapOffsetY := 0; + + if aModalBackground then + Bevel_ModalBackground := TKMBevel.Create(Self, -5000, -5000, 10000, 10000); + + Image_Background := TKMImage.Create(Self, 0, 0, desiredWidth, desiredHeight, BG_ID[fBackground], BG_RX[fBackground]); + Image_Background.AnchorsStretch; + Image_Background.ImageStretch; + + if aCloseIcon then + begin + Image_Close := TKMImage.Create(Self, Width - MarginCrossRight, MarginCrossTop, 31, 30, 52); + Image_Close.Anchors := [anTop, anRight]; + Image_Close.Hint := gResTexts[TX_MSG_CLOSE_HINT]; + Image_Close.OnClick := Close; + Image_Close.HighlightOnMouseOver := True; + end; + + ItemsPanel := TKMPanel.Create(Self, MarginMainLeftRight, MarginMainTop, Width - 2*MarginMainLeftRight, Height - MarginMainTop - MarginMainBottom); + ItemsPanel.AnchorsStretch; + if aBevelForContents then + begin + Bevel_Contents := TKMBevel.Create(ItemsPanel, 0, 0, ItemsPanel.Width, ItemsPanel.Height); + Bevel_Contents.AnchorsStretch; + end; + + Label_Caption := TKMLabel.Create(ItemsPanel, 0, -25, ItemsPanel.Width, 20, aCaption, DEFAULT_CAPTION_FONT, taCenter); + + AnchorsCenter; + Hide; + + fMasterControl.SubscribeOnOtherMouseMove(HandleOtherControlMouseMove); + fMasterControl.SubscribeOnOtherMouseDown(HandleOtherControlMouseDown); + fMasterControl.SubscribeOnOtherMouseUp(HandleOtherControlMouseUp); +end; + + +function TKMForm.MarginMainLeftRight: Integer; +const + MARGIN_SIDE: array [TKMFormBackgroundType] of Byte = (20, 35, 20); +begin + Result := MARGIN_SIDE[fBackground]; +end; + + +function TKMForm.MarginMainTop: Integer; +const + MARGIN_TOP: array [TKMFormBackgroundType] of Byte = (40, 80, 50); +begin + Result := MARGIN_TOP[fBackground]; +end; + + +function TKMForm.MarginMainBottom: Integer; +const + MARGIN_BOTTOM: array [TKMFormBackgroundType] of Byte = (20, 50, 20); +begin + Result := MARGIN_BOTTOM[fBackground]; +end; + + +function TKMForm.MarginCrossTop: Integer; +const + CROSS_TOP: array [TKMFormBackgroundType] of Byte = (24, 40, 24); +begin + Result := CROSS_TOP[fBackground]; +end; + + +function TKMForm.MarginCrossRight: Integer; +const + // Margin from right side, depends on bg graphics + CROSS_RIGHT: array [TKMFormBackgroundType] of Byte = (50, 130, 55); +begin + Result := CROSS_RIGHT[fBackground]; +end; + + +function TKMForm.GetCaption: string; +begin + Result := Label_Caption.Caption; +end; + + +procedure TKMForm.Close(Sender: TObject); +begin + Hide; + + if Assigned(fOnClose) then + fOnClose; +end; + + +procedure TKMForm.HandleOtherControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if Sender = Image_Background then + MouseDown(X, Y, Shift, Button); +end; + + +procedure TKMForm.HandleOtherControlMouseMove(Sender: TObject; X, Y: Integer; Shift: TShiftState); +begin + inherited; + + MouseMove(X, Y, Shift); +end; + + +procedure TKMForm.HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + MouseUp(X, Y, Shift, Button); +end; + + +procedure TKMForm.MouseDown(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + + if not DragEnabled then Exit; + + fDragging := True; + fDragStartPos := TKMPoint.New(X,Y); +end; + +procedure TKMForm.MouseMove(X, Y: Integer; Shift: TShiftState); +begin + inherited; + + if not DragEnabled or not fDragging then Exit; + + Left := EnsureRange(Left + X - fDragStartPos.X, 0, fMasterControl.MasterPanel.Width - Width); + Top := EnsureRange(Top + Y - fDragStartPos.Y, -Image_Background.Top, fMasterControl.MasterPanel.Height - Height); + + fDragStartPos := TKMPoint.New(X,Y); +end; + +procedure TKMForm.MouseUp(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + + if not DragEnabled then Exit; + + fDragging := False; +end; + + +function TKMForm.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := inherited; + if Result then Exit; // Key already handled + + if not fHandleCloseKey then Exit; + + if Key = gResKeys[kfCloseMenu] then + begin + Close(nil); + Result := True; + end; +end; + + +procedure TKMForm.SetHeight(aValue: Integer); +begin + inherited; + + UpdateSizes; +end; + + +procedure TKMForm.SetWidth(aValue: Integer); +begin + inherited; + + UpdateSizes; +end; + + +procedure TKMForm.UpdateSizes; +begin + // Reposition buttons? +end; + + +function TKMForm.GetActualWidth: Integer; +begin + Result := ItemsPanel.Width; +end; + + +procedure TKMForm.SetActualWidth(aValue: Integer); +var + baseW: Integer; +begin + baseW := aValue + MarginMainLeftRight*2; + SetWidth(Min(Parent.Width, baseW)); +end; + + +function TKMForm.GetActualHeight: Integer; +begin + Result := ItemsPanel.Height; +end; + + +procedure TKMForm.SetActualHeight(aValue: Integer); +var + baseH, h: Integer; +begin + baseH := aValue + MarginMainBottom + MarginMainTop; + h := Min(Parent.Height, baseH); + SetHeight(h); +end; + + +procedure TKMForm.SetHandleCloseKey(aValue: Boolean); +begin + fHandleCloseKey := aValue; + Focusable := aValue; +end; + + +procedure TKMForm.SetCapOffsetY(aValue: Integer); +begin + Label_Caption.Top := Label_Caption.Top + aValue - fCapOffsetY; + + fCapOffsetY := aValue; +end; + + +procedure TKMForm.SetCaption(const aValue: string); +begin + Label_Caption.Caption := aValue; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsList.pas b/vendor/kam_remake/src/controls/KM_ControlsList.pas new file mode 100644 index 0000000..b99e059 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsList.pas @@ -0,0 +1,2093 @@ +unit KM_ControlsList; +{$I KaM_Remake.inc} +interface +uses + Classes, + Controls, + KromOGLUtils, + KM_Controls, KM_ControlsScroll, + KM_RenderUI, + KM_ResFonts, + KM_Pics, + KM_Defaults, KM_Points, KM_CommonTypes; + + +type + TKMNotifyCellClick = procedure(Sender: TObject; const aCellX, aCellY: Integer; var aHandled: Boolean) of object; + TKMNotifyCellClickShift = procedure(Sender: TObject; const aCellX, aCellY: Integer; Shift: TShiftState; var aHandled: Boolean) of object; + TKMNotifyColumnClick = procedure(Sender: TObject; const aColumn: Integer) of object; + + TKMSearchableList = class(TKMControl) + private + fSearch: UnicodeString; //Contains user input characters we should search for + fLastKeyTime: Cardinal; + protected + fFont: TKMFont; //Should not be changed from inital value, it will mess up the word wrapping + fOnChange: TNotifyEvent; + function GetHintKind: TKMHintKind; override; + function GetHintFont: TKMFont; override; + function IsHintSelected: Boolean; override; + + function CanSearch: Boolean; virtual; abstract; + function GetRowCount: Integer; virtual; abstract; + function GetItemIndex: Integer; virtual; abstract; + procedure SetItemIndex(aIndex: Integer); virtual; abstract; + function GetTopIndex: Integer; virtual; abstract; + procedure SetTopIndex(aIndex: Integer); overload; virtual; abstract; + function GetVisibleRows: Integer; virtual; abstract; + function GetItemString(aIndex: Integer): UnicodeString; virtual; abstract; + function GetMouseOverRow: Integer; virtual; abstract; + + function KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; virtual; + function CanChangeSelection: Boolean; virtual; + public + procedure SetTopIndex(aIndex: Integer; aStayOnList: Boolean); overload; + property ItemIndex: Integer read GetItemIndex write SetItemIndex; + property TopIndex: Integer read GetTopIndex write SetTopIndex; + property RowCount: Integer read GetRowCount; + + function KeyDown(Key: Word; Shift: TShiftState): Boolean; override; + procedure KeyPress(Key: Char); override; + function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; + end; + + + TKMListBox = class(TKMSearchableList) + const + TXT_PAD_X = 4; + TXT_PAD_Y = 3; + private + fAutoHideScrollBar: Boolean; + fBackAlpha: Single; //Alpha of background (usually 0.5, dropbox 1) + fItemHeight: Byte; + fItemIndex: Integer; + fItems: TStringList; + fMouseOverRow: SmallInt; + fShowHintWhenShort: Boolean; + fSeparatorPositions: array of Integer; + fSeparatorHeight: Byte; + fSeparatorColor: TColor4; + fSeparatorTexts: TStringList; + fSeparatorFont: TKMFont; + fScrollBar: TKMScrollBar; + fSearchEnabled: Boolean; + procedure SetBackAlpha(aValue: Single); + procedure SetItemHeight(const Value: Byte); + procedure SetAutoHideScrollBar(Value: Boolean); + function GetItem(aIndex: Integer): UnicodeString; + function GetSeparatorPos(aIndex: Integer): Integer; + function GetItemTop(aIndex: Integer): Integer; + + function GetPaintWidth: Integer; + function GetRenderTextWidth: Integer; + + property PaintWidth: Integer read GetPaintWidth; + property RenderTextWidth: Integer read GetRenderTextWidth; + + function GetCount: Integer; + function GetSeparatorsCount: Integer; + protected + procedure SetLeft(aValue: Integer); override; + procedure SetTop(aValue: Integer); override; + procedure SetHeight(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function GetSelfWidth: Integer; override; + function DoHandleMouseWheelByDefault: Boolean; override; + + function GetHint: UnicodeString; override; + function GetHintBackRect: TKMRect; override; + function GetHintTextOffset: TKMPoint; override; + + //TKMSearchableList + function CanSearch: Boolean; override; + function GetRowCount: Integer; override; + function GetItemIndex: Integer; override; + procedure SetItemIndex(aIndex: Integer); override; + function GetTopIndex: Integer; override; + procedure SetTopIndex(aIndex: Integer); override; + function GetItemString(aIndex: Integer): UnicodeString; override; + function GetMouseOverRow: Integer; override; + public + ItemTags: array of Integer; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle); + destructor Destroy; override; + + property AutoHideScrollBar: boolean read fAutoHideScrollBar write SetAutoHideScrollBar; + property BackAlpha: Single write SetBackAlpha; + + property SearchEnabled: Boolean read fSearchEnabled write fSearchEnabled; + + procedure Add(const aItem: UnicodeString; aTag: Integer = 0); + procedure AddSeparator(aPosition: Integer; const aText: String = ''); + procedure ClearSeparators; + + procedure Clear; + property Count: Integer read GetCount; + property SeparatorsCount: Integer read GetSeparatorsCount; + + function GetVisibleRows: Integer; override; + + property Item[aIndex: Integer]: UnicodeString read GetItem; default; + property ItemHeight: Byte read fItemHeight write SetItemHeight; //Accessed by DropBox + property Items: TStringList read fItems; + procedure UpdateScrollBar; + + property ShowHintWhenShort: Boolean read fShowHintWhenShort write fShowHintWhenShort; + + property SeparatorPos[aIndex: Integer]: Integer read GetSeparatorPos; + property SeparatorFont: TKMFont read fSeparatorFont write fSeparatorFont; + property SeparatorColor: TColor4 read fSeparatorColor write fSeparatorColor; + property SeparatorHeight: Byte read fSeparatorHeight write fSeparatorHeight; + + function Selected: Boolean; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + + procedure Paint; override; + end; + + TKMSortDirection = (sdNone, sdUp, sdDown); + + TKMListHeaderColumn = class + Caption: UnicodeString; + Glyph: TKMPic; + HeaderHint: UnicodeString; + Offset: Word; //Offsets are easier to handle than widths + end; + + TKMListHeader = class(TKMControl) + private + fFont: TKMFont; + fCount: Integer; + fColumns: array of TKMListHeaderColumn; + fColumnHighlight: Integer; + fSortIndex: Integer; + fSortDirection: TKMSortDirection; + fTextAlign: TKMTextAlign; + function GetColumnIndex(X: Integer): Integer; + function GetColumn(aIndex: Integer): TKMListHeaderColumn; + procedure ClearColumns; + function GetColumnWidth(aIndex: Integer): Integer; + function GetOffset(aIndex: Integer): Word; + procedure SetOffset(aIndex: Integer; aValue: Word); + function GetHeaderHint(aIndex: Integer): UnicodeString; + procedure SetHeaderHint(aIndex: Integer; const aValue: UnicodeString); + protected + procedure DoClick(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + function GetHint: UnicodeString; override; + public + BackAlpha: Single; //Alpha of background + EdgeAlpha: Single; //Alpha of background outline + + OnColumnClick: TKMNotifyColumnClick; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); + destructor Destroy; override; + + procedure SetColumns(aFont: TKMFont; aColumns: array of String; aColumnOffsets: array of Word); overload; + procedure SetColumns(aFont: TKMFont; aColumns, aHints: array of String; aColumnOffsets: array of Word); overload; + property Offset[aIndes: Integer]: Word read GetOffset write SetOffset; + property HeaderHint[aIndes: Integer]: UnicodeString read GetHeaderHint write SetHeaderHint; + + property Count: Integer read fCount; + property Font: TKMFont read fFont write fFont; + property ColumnCount: Integer read fCount; + property Columns[aIndex: Integer]: TKMListHeaderColumn read GetColumn; + property SortIndex: Integer read fSortIndex write fSortIndex; + property SortDirection: TKMSortDirection read fSortDirection write fSortDirection; + property TextAlign: TKMTextAlign read fTextAlign write fTextAlign; + property ColumnWidth[aIndex: Integer]: Integer read GetColumnWidth; + + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure Paint; override; + end; + + TKMListRow = record + Cells: array of record + Caption: UnicodeString; //Main Text + SubTxt: UnicodeString; //Gray text below main text + CellHint: UnicodeString; + Color: TColor4; + HighlightColor: TColor4; + HighlightOnMouseOver: Boolean; + Enabled: Boolean; + Pic: TKMPic; + end; + Tag: Integer; + end; + + TKMListColumn = class + Font: TKMFont; + HintFont: TKMFont; + TextAlign: TKMTextAlign; + TriggerOnChange: Boolean; + end; + + TKMColumnBox = class(TKMSearchableList) + const + COL_PAD_X = 4; + TXT_PAD_Y = 2; + private + fBackAlpha: Single; //Alpha of background + fEdgeAlpha: Single; //Alpha of outline + fItemHeight: Byte; + fItemIndex: Integer; + fSearchColumn: ShortInt; //which columns text we should search, -1 for disabled + fRowCount: Integer; + fColumns: array of TKMListColumn; + fHeader: TKMListHeader; + fShowHeader: Boolean; + fShowLines: Boolean; + fMouseOverRow: SmallInt; + fShowHintWhenShort: Boolean; + fMouseOverColumn: SmallInt; + fMouseOverCell: TKMPoint; + fScrollBar: TKMScrollBar; + fOnCellClick: TKMNotifyCellClick; + fOnCellClickShift: TKMNotifyCellClickShift; + fOnChangeInvoked: Boolean; + procedure SetBackAlpha(aValue: Single); + procedure SetEdgeAlpha(aValue: Single); + function GetSortIndex: Integer; + procedure SetSortIndex(aIndex: Integer); + function GetSortDirection: TKMSortDirection; + procedure SetSortDirection(aDirection: TKMSortDirection); + procedure UpdateScrollBar; + procedure SetShowHeader(aValue: Boolean); + function GetOnColumnClick: TKMNotifyColumnClick; + procedure SetOnColumnClick(const aValue: TKMNotifyColumnClick); + function GetColumn(aIndex: Integer): TKMListColumn; + procedure ClearColumns; + procedure SetSearchColumn(aValue: ShortInt); + procedure ResetMouseOver; + procedure UpdateMouseOverPosition(X,Y: Integer); + procedure UpdateItemIndex(Shift: TShiftState; var aOnChangeInvoked: Boolean); + function GetItem(aIndex: Integer): TKMListRow; + function GetSelectedItem: TKMListRow; + function GetSelectedItemTag: Integer; + procedure ScrollBarChangeVisibility; + procedure ScrollBarChanged(Sender: TObject); + protected + procedure SetLeft(aValue: Integer); override; + procedure SetTop(aValue: Integer); override; + procedure SetWidth(aValue: Integer); override; + procedure SetHeight(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function GetSelfAbsTop: Integer; override; + function GetSelfHeight: Integer; override; + function GetSelfWidth: Integer; override; + function DoHandleMouseWheelByDefault: Boolean; override; + function GetHint: UnicodeString; override; + function GetHintTextColor: TColor4; override; + function GetHintBackRect: TKMRect; override; + function GetHintTextOffset: TKMPoint; override; + + // TKMSearchableList methods implementation + function CanSearch: Boolean; override; + function GetRowCount: Integer; override; + function GetItemIndex: Integer; override; + procedure SetItemIndex(aIndex: Integer); override; + function GetTopIndex: Integer; override; + procedure SetTopIndex(aIndex: Integer); override; + function GetItemString(aIndex: Integer): UnicodeString; override; + function GetMouseOverRow: Integer; override; + + function CanChangeSelection: Boolean; override; + + function CanFocusNext: Boolean; override; + public + HideSelection: Boolean; + HighlightError: Boolean; + HighlightOnMouseOver: Boolean; + Rows: array of TKMListRow; //Exposed to public since we need to edit sub-fields + PassAllKeys: Boolean; + ColumnIdForScroll: Integer; //When scroll is visible, we can move columns to the left. Using specified ColumnId. If ColumnId = -1, then no column width is changed + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle); + destructor Destroy; override; + + property Item[aIndex: Integer]: TKMListRow read GetItem; default; + property SelectedItem: TKMListRow read GetSelectedItem; + property SelectedItemTag: Integer read GetSelectedItemTag; + procedure SetColumns(aHeaderFont: TKMFont; aCaptions: array of String; aOffsets: array of Word); overload; + procedure SetColumns(aHeaderFont: TKMFont; aCaptions: array of string; aOffsets: array of Word; aCaptionsAsHints: Boolean); overload; + procedure SetColumns(aHeaderFont: TKMFont; aCaptions, aHints: array of String; aOffsets: array of Word); overload; + procedure AddItem(aItem: TKMListRow); + procedure Clear; + function GetVisibleRows: Integer; override; + function GetVisibleRowsExact: Single; + function IsSelected: Boolean; + property ShowHeader: Boolean read fShowHeader write SetShowHeader; + property ShowHintWhenShort: Boolean read fShowHintWhenShort write fShowHintWhenShort; + property ShowLines: Boolean read fShowLines write fShowLines; + property SearchColumn: ShortInt read fSearchColumn write SetSearchColumn; + + property Columns[aIndex: Integer]: TKMListColumn read GetColumn; + property BackAlpha: Single read fBackAlpha write SetBackAlpha; + property EdgeAlpha: Single read fEdgeAlpha write SetEdgeAlpha; + property RowCount: Integer read fRowCount; + property ItemHeight: Byte read fItemHeight write fItemHeight; + property Header: TKMListHeader read fHeader; + + //Sort properties are just hints to render Up/Down arrows. Actual sorting is done by client + property OnColumnClick: TKMNotifyColumnClick read GetOnColumnClick write SetOnColumnClick; + property OnCellClick: TKMNotifyCellClick read fOnCellClick write fOnCellClick; + property OnCellClickShift: TKMNotifyCellClickShift read fOnCellClickShift write fOnCellClickShift; + property SortIndex: Integer read GetSortIndex write SetSortIndex; + property SortDirection: TKMSortDirection read GetSortDirection write SetSortDirection; + + procedure JumpToSelected; + + function KeyDown(Key: Word; Shift: TShiftState): Boolean; override; + procedure KeyPress(Key: Char); override; + function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + procedure DoClick(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + + procedure DoPaintLine(aIndex: Integer; X,Y: Integer; PaintWidth: Integer; aAllowHighlight: Boolean = True); overload; + procedure DoPaintLine(aIndex: Integer; X, Y: Integer; PaintWidth: Integer; aColumnsToShow: array of Boolean; aAllowHighlight: Boolean = True); overload; + procedure Paint; override; + end; + + + function MakeListRow(const aCaption: array of String; aTag: Integer = 0): TKMListRow; overload; + function MakeListRow(const aCaption, aHint: array of String; aTag: Integer = 0): TKMListRow; overload; + function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; aTag: Integer = 0): TKMListRow; overload; + function MakeListRow(const aCaption, aHint: array of string; const aColor: array of TColor4; aTag: Integer = 0): TKMListRow; overload; + function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; const aColorHighlight: array of TColor4; aTag: Integer = 0): TKMListRow; overload; + function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; const aPic: array of TKMPic; aTag: Integer = 0): TKMListRow; overload; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + SysUtils, StrUtils, Math, + KM_ControlsTypes, KM_ControlsUtils, + KM_Resource, KM_ResTypes, + KM_CommonUtils; + + +function MakeListRow(const aCaption: array of String; aTag: Integer = 0): TKMListRow; +var + I: Integer; +begin + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].Color := $FFFFFFFF; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +function MakeListRow(const aCaption, aHint: array of String; aTag: Integer = 0): TKMListRow; +var + I: Integer; +begin + Assert(Length(aCaption) = Length(aHint)); + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].CellHint := aHint[I]; + Result.Cells[I].Color := $FFFFFFFF; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; aTag: Integer = 0): TKMListRow; +var I: Integer; +begin + Assert(Length(aCaption) = Length(aColor)); + + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].Color := aColor[I]; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +function MakeListRow(const aCaption, aHint: array of string; const aColor: array of TColor4; aTag: Integer = 0): TKMListRow; +var I: Integer; +begin + Assert(Length(aCaption) = Length(aColor)); + Assert(Length(aCaption) = Length(aHint)); + + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].CellHint := aHint[I]; + Result.Cells[I].Color := aColor[I]; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; const aColorHighlight: array of TColor4; aTag: Integer = 0): TKMListRow; +var + I: Integer; +begin + Assert(Length(aCaption) = Length(aColor)); + Assert(Length(aCaption) = Length(aColorHighlight)); + + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].Color := aColor[I]; + Result.Cells[I].HighlightColor := aColorHighlight[I]; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +function MakeListRow(const aCaption: array of string; const aColor: array of TColor4; const aPic: array of TKMPic; + aTag: Integer = 0): TKMListRow; +var + I: Integer; +begin + Assert(Length(aCaption) = Length(aColor)); + Assert(Length(aCaption) = Length(aPic)); + + SetLength(Result.Cells, Length(aCaption)); + + for I := 0 to High(aCaption) do + begin + Result.Cells[I].Caption := aCaption[I]; + Result.Cells[I].Color := aColor[I]; + Result.Cells[I].Pic := aPic[I]; + Result.Cells[I].Enabled := True; + end; + Result.Tag := aTag; +end; + + +{ TKMSearchableList } +procedure TKMSearchableList.KeyPress(Key: Char); +var + I, oldIndex: Integer; +begin + //KeyPress used only for key input search, do not allow unsupported Keys. + //Otherwise fOnChange will be invoked on any key pressed + if not IsCharAllowed(Key, acFileName) then Exit; + + if not CanSearch then + Exit; + + oldIndex := GetItemIndex; + + //Allow to type several characters in a row to pick some item + if TimeSince(fLastKeyTime) < 1000 then + fSearch := fSearch + Key + else + fSearch := Key; + + fLastKeyTime := TimeGet; + + for I := 0 to GetRowCount - 1 do + if AnsiStartsText(fSearch, GetItemString(I)) then + begin + SetItemIndex(I); + SetTopIndex(GetItemIndex - GetVisibleRows div 2); + Break; + end; + + if Assigned(fOnChange) and (oldIndex <> GetItemIndex) then + fOnChange(Self); +end; + + +function TKMSearchableList.KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; +begin + //We want these keys to be ignored + if Key in [VK_F1..VK_F12, VK_ESCAPE, VK_RETURN, VK_DELETE, VK_TAB, VK_MBUTTON] then + Result := False + else + Result := CanSearch or (Key in [VK_UP, VK_DOWN, VK_HOME, VK_END, VK_PRIOR, VK_NEXT]); + + Result := Result and CanChangeSelection; //Don't handle keys if can't change selection +end; + + +function TKMSearchableList.CanChangeSelection: Boolean; +begin + Result := True; +end; + + +function TKMSearchableList.GetHintFont: TKMFont; +begin + Result := fFont; +end; + + +function TKMSearchableList.GetHintKind: TKMHintKind; +begin + Result := hkTextNotFit; +end; + + +function TKMSearchableList.IsHintSelected: Boolean; +begin + Result := (ItemIndex <> -1) and (GetMouseOverRow = ItemIndex); +end; + + +function TKMSearchableList.KeyDown(Key: Word; Shift: TShiftState): Boolean; +var + oldIndex, newIndex: Integer; + pageScrolling: Boolean; +begin + Result := KeyEventHandled(Key, Shift); + if inherited KeyDown(Key, Shift) then Exit; + + if not CanChangeSelection then Exit; //Can't change selection + + pageScrolling := False; + oldIndex := ItemIndex; + case Key of + VK_UP: newIndex := ItemIndex - 1; + VK_DOWN: newIndex := ItemIndex + 1; + VK_HOME: newIndex := 0; + VK_END: newIndex := RowCount - 1; + VK_PRIOR: begin + newIndex := EnsureRange(ItemIndex - GetVisibleRows, 0, RowCount - 1); + pageScrolling := True; + end; + VK_NEXT: begin + newIndex := EnsureRange(ItemIndex + GetVisibleRows, 0, RowCount - 1); + pageScrolling := True; + end; + VK_RETURN: begin + //Trigger click to hide drop downs + if Assigned(OnClick) then + OnClick(Self); + //Double click on Enter + if Assigned(OnDoubleClick) then + OnDoubleClick(Self); + Exit; + end; + else Exit; + end; + + if InRange(newIndex, 0, RowCount - 1) then + begin + ItemIndex := newIndex; + if pageScrolling then + TopIndex := ItemIndex - (oldIndex - TopIndex) // Save position from the top of the list + else if TopIndex < ItemIndex - GetVisibleRows + 1 then //Moving down + TopIndex := ItemIndex - GetVisibleRows + 1 + else if TopIndex > ItemIndex then //Moving up + TopIndex := ItemIndex; + end; + + if Assigned(fOnChange) and (oldIndex <> newIndex) then + fOnChange(Self); +end; + + +function TKMSearchableList.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := KeyEventHandled(Key, Shift); + if inherited KeyUp(Key, Shift) then Exit; +end; + + +procedure TKMSearchableList.SetTopIndex(aIndex: Integer; aStayOnList: Boolean); +begin + if not aStayOnList + or not InRange(aIndex - TopIndex, 0, GetVisibleRows - 1) then + begin + if aIndex < TopIndex then + TopIndex := ItemIndex + else + if aIndex > TopIndex + GetVisibleRows - 1 then + TopIndex := aIndex - GetVisibleRows + 1; + end; +end; + + +{ TKMListBox } +constructor TKMListBox.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fBackAlpha := 0.5; + fItemHeight := 20; + fItemIndex := -1; + fItems := TStringList.Create; + fFont := aFont; + fAutoHideScrollBar := False; //Always show the scrollbar by default, then it can be turned off if required + fShowHintWhenShort := False; + Focusable := True; //For up/down keys + fSeparatorHeight := 0; + fSeparatorTexts := TStringList.Create; + fSeparatorFont := fntAntiqua; //Looks good on dark solid background + fSeparatorColor := clListSeparatorShape; + fSearchEnabled := False; + + fScrollBar := TKMScrollBar.Create(aParent, aLeft+aWidth-20, aTop, 20, aHeight, saVertical, aStyle); + UpdateScrollBar; //Initialise the scrollbar +end; + + +destructor TKMListBox.Destroy; +begin + fSeparatorTexts.Free; + fItems.Free; + inherited; +end; + + +function TKMListBox.CanSearch: Boolean; +begin + Result := fSearchEnabled; +end; + + +function TKMListBox.GetRowCount: Integer; +begin + Result := fItems.Count; +end; + + +procedure TKMListBox.SetItemHeight(const Value: byte); +begin + fItemHeight := Value; + UpdateScrollBar; +end; + + +procedure TKMListBox.SetItemIndex(aIndex: Integer); +begin + if InRange(aIndex, 0, GetRowCount - 1) then + fItemIndex := aIndex + else + fItemIndex := -1; +end; + + +function TKMListBox.GetItemIndex: Integer; +begin + Result := fItemIndex; +end; + + +function TKMListBox.GetItemString(aIndex: Integer): UnicodeString; +begin + Result := fItems[aIndex]; +end; + + +procedure TKMListBox.SetLeft(aValue: Integer); +begin + inherited; + fScrollBar.Left := Left + Width - fScrollBar.Width; +end; + + +procedure TKMListBox.SetTop(aValue: Integer); +begin + inherited; + fScrollBar.Top := Top; +end; + + +procedure TKMListBox.SetHeight(aValue: Integer); +begin + inherited; + fScrollBar.Height := Height; + UpdateScrollBar; //Since height has changed +end; + + +//Copy property to scrollbar. Otherwise it won't be rendered +procedure TKMListBox.SetVisible(aValue: Boolean); +begin + inherited; + fScrollBar.Visible := IsSetVisible and (not fAutoHideScrollBar or fScrollBar.Enabled); //Hide scrollbar and its buttons +end; + + +function TKMListBox.GetSelfWidth: Integer; +begin + if fScrollBar.Visible then + Result := Width - fScrollBar.Width //Leave space for scrollbar + else + Result := Width; //List takes up the entire width +end; + + +function TKMListBox.GetTopIndex: Integer; +begin + Result := fScrollBar.Position; +end; + + +procedure TKMListBox.SetTopIndex(aIndex: Integer); +begin + fScrollBar.Position := aIndex; +end; + + +procedure TKMListBox.SetBackAlpha(aValue: single); +begin + fBackAlpha := aValue; + fScrollBar.BackAlpha := aValue; +end; + + +procedure TKMListBox.SetEnabled(aValue: Boolean); +begin + inherited; + fScrollBar.Enabled := Enabled; +end; + + +//fItems.Count has changed +procedure TKMListBox.UpdateScrollBar; +begin + fScrollBar.MaxValue := fItems.Count - GetVisibleRows; + fScrollBar.Visible := IsSetVisible and (not fAutoHideScrollBar or fScrollBar.Enabled); + //Separators can not be used with scroll bar for now. + //Scrollbar works line-wise, not pixel-wise, + //so adding separators could cause visual issues + //(list 'jumping' when there is or there is no separator, when separator width is not equal to line width) + Assert(not (fScrollBar.Visible and (SeparatorsCount > 0)), 'Separators can not be used with scroll bar'); +end; + + +procedure TKMListBox.Add(const aItem: UnicodeString; aTag: Integer = 0); +begin + fItems.Add(aItem); + SetLength(ItemTags, Length(ItemTags) + 1); + ItemTags[Length(ItemTags)-1] := aTag; + UpdateScrollBar; +end; + + +//Add separator just before aPosition item in list with aText on it +procedure TKMListBox.AddSeparator(aPosition: Integer; const aText: String = ''); +begin + fSeparatorTexts.Add(aText); + SetLength(fSeparatorPositions, Length(fSeparatorPositions) + 1); + fSeparatorPositions[Length(fSeparatorPositions)-1] := aPosition; + // Update List height, since we added separator to it + Height := Height + SeparatorHeight; + //Separators can not be used with scroll bar for now. + //Scrollbar works line-wise, not pixel-wise, + //so adding separators could cause visual issues + //(list 'jumping' when there is or there is no separator, when separator width is not equal to line width) + Assert(not fScrollBar.Visible, 'Separators can not be used with scroll bar'); +end; + + +procedure TKMListBox.ClearSeparators; +var + sepCnt: Integer; +begin + // SeparatorsCount locally. + // We should update Height only after clearing separators arrays + sepCnt := SeparatorsCount; + fSeparatorTexts.Clear; + SetLength(fSeparatorPositions, 0); + // Update List height, since we removed separators from it + Height := Height - sepCnt*SeparatorHeight; +end; + + +procedure TKMListBox.Clear; +begin + fItems.Clear; + SetLength(ItemTags, 0); + ClearSeparators; + fItemIndex := -1; + UpdateScrollBar; +end; + + +//Hide the scrollbar if it is not required (disabled) This is used for drop boxes. +procedure TKMListBox.SetAutoHideScrollBar(Value: boolean); +begin + fAutoHideScrollBar := Value; + UpdateScrollBar; +end; + + +function TKMListBox.GetCount: Integer; +begin + Result := fItems.Count; +end; + + +function TKMListBox.Selected: Boolean; +begin + Result := fItemIndex <> -1; +end; + + +function TKMListBox.GetSeparatorsCount: Integer; +begin + Result := Length(fSeparatorPositions); +end; + + +function TKMListBox.GetVisibleRows: Integer; +begin + Result := (Height - fSeparatorHeight*SeparatorsCount) div fItemHeight; +end; + + +function TKMListBox.GetHint: UnicodeString; +var + hintStr: string; +begin + Result := inherited GetHint; + + if not fShowHintWhenShort or (fMouseOverRow = -1) then Exit; + + if Result = '' then + begin + if //Got crashed sometimes when mouse over empty disabled ComboBox with Header (fMouseOverCell = [0;0]) + fItems.Count > fMouseOverRow then + begin + hintStr := fItems[fMouseOverRow]; + // Show hint, if caption does not fit into the cell + if gRes.Fonts[fFont].GetTextSize(hintStr).X > RenderTextWidth then + Result := hintStr; + end; + end; +end; + + +function TKMListBox.GetHintBackRect: TKMRect; +const + SELECT_PAD = 1; +var + top: Integer; +begin + if fMouseOverRow = -1 then Exit(KMRECT_ZERO); + + top := GetItemTop(fMouseOverRow) - GetItemTop(TopIndex) - SELECT_PAD; + Result := KMRect(-1, top, PaintWidth, top + fItemHeight + SELECT_PAD); +end; + + +function TKMListBox.GetHintTextOffset: TKMPoint; +begin + if fMouseOverRow = -1 then Exit(KMPOINT_ZERO); + + Result := TKMPoint.New(TXT_PAD_X, TXT_PAD_Y + GetItemTop(fMouseOverRow) - GetItemTop(TopIndex)); +end; + + +function TKMListBox.GetItem(aIndex: Integer): UnicodeString; +begin + Result := fItems[aIndex]; +end; + + +function TKMListBox.GetSeparatorPos(aIndex: Integer): Integer; +begin + Result := fSeparatorPositions[aIndex]; +end; + + +//Get aIndex item top position, considering separators +function TKMListBox.GetItemTop(aIndex: Integer): Integer; +var + I: Integer; +begin + Result := fItemHeight*aIndex; + for I := 0 to Length(fSeparatorPositions) - 1 do + if fSeparatorPositions[I] <= aIndex then + Inc(Result, fSeparatorHeight); +end; + + +function TKMListBox.GetMouseOverRow: Integer; +begin + Result := fMouseOverRow; +end; + + +function TKMListBox.GetPaintWidth: Integer; +begin + Result := Width - fScrollBar.Width * Byte(fScrollBar.Visible); +end; + + +function TKMListBox.GetRenderTextWidth: Integer; +begin + Result := PaintWidth - 2*TXT_PAD_X; +end; + + +procedure TKMListBox.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + MouseMove(X,Y,Shift); //Will change Position and call OnChange event +end; + + +procedure TKMListBox.MouseMove(X,Y: Integer; Shift: TShiftState); + + // We should use this function, to go from 1st line to the next lines, because we could have separators in the list + function GetItemOverIndex(aY: Integer): Integer; + var + I: Integer; + begin + Result := -1; + for I := 0 to Min(fItems.Count, GetVisibleRows) - 1 do + if InRange(aY, AbsTop + GetItemTop(I), AbsTop + GetItemTop(I) + fItemHeight) then + Exit(I); + end; + +var + newIndex: Integer; +begin + inherited; + + fMouseOverRow := -1; + + if not InRange(X, AbsLeft, AbsLeft + Width - (fScrollBar.Width * Byte(fScrollBar.Visible))) + or not InRange(Y, AbsTop, AbsTop + Height) then Exit; + + fMouseOverRow := GetItemOverIndex(Y); + + if fMouseOverRow <> -1 then + fMouseOverRow := fMouseOverRow + TopIndex + else + Exit; + + if (ssLeft in Shift) then + begin + newIndex := fMouseOverRow; + + if newIndex > fItems.Count - 1 then + begin + //Double clicking not allowed if we are clicking past the end of the list, but keep last item selected + fTimeOfLastClick := 0; + newIndex := fItems.Count - 1; + end; + + if newIndex <> fItemIndex then + begin + fItemIndex := newIndex; + fTimeOfLastClick := 0; //Double click shouldn't happen if you click on one server A, then server B + if Assigned(fOnChange) then + fOnChange(Self); + end; + end; +end; + + +function TKMListBox.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMListBox.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + inherited; + + if aHandled then Exit; + + SetTopIndex(TopIndex - WheelSteps); + fScrollBar.Position := TopIndex; //Make the scrollbar move too when using the wheel + + aHandled := WheelSteps <> 0; +end; + + +procedure TKMListBox.Paint; +var + I: Integer; + shapeColor, outlineColor: TColor4; +begin + inherited; + + // Draw background + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, PaintWidth, Height, 1, fBackAlpha); + + // Draw selection outline and rectangle (shape) + if (fItemIndex <> -1) and InRange(fItemIndex - TopIndex, 0, GetVisibleRows - 1) then + begin + if IsFocused then + begin + shapeColor := clListSelShape; + outlineColor := clListSelOutline; + end else begin + shapeColor := clListSelShapeUnfocused; + outlineColor := clListSelOutlineUnfocused; + end; + TKMRenderUI.WriteShape(AbsLeft, AbsTop + GetItemTop(fItemIndex) - GetItemTop(TopIndex), + PaintWidth, fItemHeight, shapeColor, outlineColor); + end; + + // Draw text lines + for I := 0 to Min(fItems.Count, GetVisibleRows) - 1 do + TKMRenderUI.WriteText(AbsLeft + TXT_PAD_X, AbsTop + GetItemTop(I) + TXT_PAD_Y, RenderTextWidth, fItems.Strings[TopIndex+I] , fFont, taLeft); + + // Draw separators + for I := 0 to Length(fSeparatorPositions) - 1 do + begin + TKMRenderUI.WriteShape(AbsLeft, AbsTop + GetItemTop(fSeparatorPositions[I]) - fSeparatorHeight, + PaintWidth - 1, fSeparatorHeight, fSeparatorColor); + if fSeparatorTexts[I] <> '' then + TKMRenderUI.WriteText(AbsLeft + TXT_PAD_X, AbsTop + GetItemTop(fSeparatorPositions[I]) - fSeparatorHeight, + RenderTextWidth, fSeparatorTexts[I], fSeparatorFont, taCenter) + end; +end; + + +{ TKMListHeader } +constructor TKMListHeader.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + BackAlpha := 0.5; + EdgeAlpha := 0.75; + fSortDirection := sdNone; + fSortIndex := -1; +end; + + +destructor TKMListHeader.Destroy; +begin + ClearColumns; + + inherited; +end; + + +procedure TKMListHeader.ClearColumns; +var + I: Integer; +begin + for I := 0 to fCount - 1 do + FreeAndNil(fColumns[I]); +end; + + +function TKMListHeader.GetColumnIndex(X: Integer): Integer; +var + I, cellRightOffset: Integer; +begin + Result := -1; + + for I := 0 to fCount - 1 do + begin + if I = fCount - 1 then + cellRightOffset := AbsLeft + Width + else + cellRightOffset := AbsLeft + fColumns[I+1].Offset - 1; + if InRange(X, AbsLeft + fColumns[I].Offset, cellRightOffset) then + Result := I; + end; +end; + + +function TKMListHeader.GetColumn(aIndex: Integer): TKMListHeaderColumn; +begin + Result := fColumns[aIndex]; +end; + + +function TKMListHeader.GetColumnWidth(aIndex: Integer): Integer; +begin + if aIndex = fCount - 1 then + Result := Width - fColumns[aIndex].Offset + else + Result := fColumns[aIndex+1].Offset - fColumns[aIndex].Offset; +end; + + +function TKMListHeader.GetHint: UnicodeString; +begin + Result := inherited GetHint; + if (Result = '') and (fColumnHighlight <> -1) then + Result := HeaderHint[fColumnHighlight]; +end; + + +//We know we were clicked and now we can decide what to do +procedure TKMListHeader.DoClick(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + columnID: Integer; +begin + //do not invoke inherited here, to fully override parent DoClick method + columnID := GetColumnIndex(X); + if (columnID <> -1) and Assigned(OnColumnClick) then + begin + //We could process the clicks here (i.e. do the sorting inplace) + //but there are various circumstances where plain string sorting will look wrong + //and the ListBox just misses the knowledge to do it right: + //MP game status (sort by type), ping (sort 1>9), playercount (sort 9>1), dates (sort by TDateTime) + //Let the UI communicate to Game and do it right + + //Apply sorting to the column, toggling the state, sdDown is default + if fSortIndex = columnID then + if fSortDirection = sdDown then + fSortDirection := sdUp + else + fSortDirection := sdDown + else + fSortDirection := sdDown; + fSortIndex := columnID; + OnColumnClick(Self, columnID); + end + else + inherited; //Process the usual clicks if e.g. there are no columns +end; + + +procedure TKMListHeader.SetColumns(aFont: TKMFont; aColumns: array of String; aColumnOffsets: array of Word); +var + hints: array of String; +begin + SetLength(hints, Length(aColumns)); + SetColumns(aFont, aColumns, hints, aColumnOffsets); +end; + + +procedure TKMListHeader.SetColumns(aFont: TKMFont; aColumns, aHints: array of String; aColumnOffsets: array of Word); +var + I: Integer; +begin + Assert(Length(aColumns) = Length(aColumnOffsets)); + Assert(Length(aHints) = Length(aColumnOffsets)); + + fFont := aFont; + + ClearColumns; + + fCount := Length(aColumns); + SetLength(fColumns, fCount); + for I := 0 to fCount - 1 do + begin + fColumns[I] := TKMListHeaderColumn.Create; + fColumns[I].Caption := aColumns[I]; + fColumns[I].HeaderHint := aHints[I]; + fColumns[I].Offset := aColumnOffsets[I]; + end; +end; + + +function TKMListHeader.GetOffset(aIndex: Integer): Word; +begin + Result := fColumns[aIndex].Offset; +end; + + +procedure TKMListHeader.SetOffset(aIndex: Integer; aValue: Word); +begin + fColumns[aIndex].Offset := aValue; +end; + + +function TKMListHeader.GetHeaderHint(aIndex: Integer): UnicodeString; +begin + Result := fColumns[aIndex].HeaderHint; +end; + + +procedure TKMListHeader.SetHeaderHint(aIndex: Integer; const aValue: UnicodeString); +begin + fColumns[aIndex].HeaderHint := aValue; +end; + + +procedure TKMListHeader.MouseMove(X, Y: Integer; Shift: TShiftState); +begin + inherited; + fColumnHighlight := GetColumnIndex(X); +end; + + +procedure TKMListHeader.Paint; +var + I: Integer; + columnLeft: Integer; + columnWidth: Integer; + textSize: TKMPoint; +begin + inherited; + + for I := 0 to fCount - 1 do + begin + if I < fCount - 1 then + columnWidth := fColumns[I+1].Offset - fColumns[I].Offset + else + columnWidth := Width - fColumns[I].Offset; + + if columnWidth <= 0 then Break; + + columnLeft := AbsLeft + fColumns[I].Offset; + + TKMRenderUI.WriteBevel(columnLeft, AbsTop, columnWidth, Height, EdgeAlpha, BackAlpha); + if Assigned(OnColumnClick) and (csOver in State) and (fColumnHighlight = I) then + TKMRenderUI.WriteShape(columnLeft, AbsTop, columnWidth, Height, $20FFFFFF); + + if fColumns[I].Glyph.ID <> 0 then + TKMRenderUI.WritePicture(columnLeft + 4, AbsTop, columnWidth - 8, Height, [], fColumns[I].Glyph.RX, fColumns[I].Glyph.ID) + else + begin + textSize := gRes.Fonts[fFont].GetTextSize(fColumns[I].Caption); + TKMRenderUI.WriteText(columnLeft + 4, AbsTop + (Height - textSize.Y) div 2 + 2, columnWidth - 8, fColumns[I].Caption, fFont, fTextAlign); + end; + + if Assigned(OnColumnClick) and (fSortIndex = I) then + case fSortDirection of + sdDown: TKMRenderUI.WritePicture(columnLeft + columnWidth - 4-10, AbsTop + 6, 10, 11, [], rxGui, 60); + sdUp: TKMRenderUI.WritePicture(columnLeft + columnWidth - 4-10, AbsTop + 6, 10, 11, [], rxGui, 59); + end; + end; +end; + + +{ TKMColumnListBox } +constructor TKMColumnBox.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle); +const + DEF_HEADER_HEIGHT = 24; +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + fItemHeight := 20; + fItemIndex := -1; + fShowHeader := True; + fShowHintWhenShort := False; + SearchColumn := -1; //Disabled by default + Focusable := True; //For up/down keys + ColumnIdForScroll := -1; + + fHeader := TKMListHeader.Create(aParent, aLeft, aTop, aWidth - fItemHeight, DEF_HEADER_HEIGHT); + + fScrollBar := TKMScrollBar.Create(aParent, aLeft+aWidth-fItemHeight, aTop, fItemHeight, aHeight, saVertical, aStyle); + fScrollBar.OnChange := ScrollBarChanged; + UpdateScrollBar; //Initialise the scrollbar + + SetEdgeAlpha(1); + SetBackAlpha(0.5); +end; + + +destructor TKMColumnBox.Destroy; +begin + ClearColumns; + + inherited; +end; + + +function TKMColumnBox.CanSearch: Boolean; +begin + Result := SearchColumn <> -1; +end; + + +function TKMColumnBox.GetRowCount: Integer; +begin + Result := fRowCount; +end; + + +function TKMColumnBox.GetItemIndex: Integer; +begin + Result := fItemIndex; +end; + + +function TKMColumnBox.GetItemString(aIndex: Integer): UnicodeString; +begin + Result := Rows[aIndex].Cells[SearchColumn].Caption; +end; + + +function TKMColumnBox.GetMouseOverRow: Integer; +begin + Result := fMouseOverRow; +end; + + +procedure TKMColumnBox.SetSearchColumn(aValue: ShortInt); +begin + fSearchColumn := aValue; +end; + + +procedure TKMColumnBox.SetShowHeader(aValue: Boolean); +begin + fHeader.Visible := aValue; + fShowHeader := aValue; +end; + + +procedure TKMColumnBox.SetLeft(aValue: Integer); +begin + inherited; + + fHeader.Left := Left; + fScrollBar.Left := Left + Width - fScrollBar.Width; +end; + + +procedure TKMColumnBox.SetTop(aValue: Integer); +begin + inherited; + + //Update header and scrollbar so that their Top matched + fHeader.Top := Top; + fScrollBar.Top := Top; +end; + + +procedure TKMColumnBox.SetWidth(aValue: Integer); +begin + inherited; + + fHeader.Width := Width; + fScrollBar.Left := Left + Width - fScrollBar.Width; +end; + + +procedure TKMColumnBox.SetHeight(aValue: Integer); +begin + inherited; + fScrollBar.Height := Height; + UpdateScrollBar; //Since height has changed +end; + + +procedure TKMColumnBox.SetItemIndex(aIndex: Integer); +begin + if InRange(aIndex, 0, RowCount - 1) then + fItemIndex := aIndex + else + fItemIndex := -1; +end; + + +procedure TKMColumnBox.SetOnColumnClick(const aValue: TKMNotifyColumnClick); +begin + fHeader.OnColumnClick := aValue; +end; + + +procedure TKMColumnBox.SetSortDirection(aDirection: TKMSortDirection); +begin + fHeader.SortDirection := aDirection; +end; + + +procedure TKMColumnBox.SetSortIndex(aIndex: Integer); +begin + fHeader.SortIndex := aIndex; +end; + + +//Copy property to scrollbar. Otherwise it won't be rendered +procedure TKMColumnBox.SetVisible(aValue: Boolean); +begin + inherited; + fHeader.Visible := IsSetVisible and fShowHeader; + fScrollBar.Visible := IsSetVisible and fScrollBar.Enabled; //Hide scrollbar and its buttons +end; + + +function TKMColumnBox.GetSelfAbsTop: Integer; +begin + Result := AbsTop + (fHeader.Height + 1) * Byte(fShowHeader); +end; + + +function TKMColumnBox.GetSelfHeight: Integer; +begin + Result := Height - (fHeader.Height + 1) * Byte(fShowHeader); +end; + + +function TKMColumnBox.GetSelfWidth: Integer; +begin + if fScrollBar.Visible then + Result := Width - fScrollBar.Width //Leave space for scrollbar + else + Result := Width; //List takes up the entire width +end; + + +function TKMColumnBox.GetTopIndex: Integer; +begin + Result := fScrollBar.Position; +end; + + +function TKMColumnBox.GetVisibleRows: Integer; +begin + Result := Floor(GetVisibleRowsExact); +end; + + +function TKMColumnBox.GetVisibleRowsExact: Single; +begin + Result := (Height - fHeader.Height * Byte(ShowHeader)) / fItemHeight; +end; + + +function TKMColumnBox.IsSelected: Boolean; +begin + Result := fItemIndex <> -1; +end; + + +procedure TKMColumnBox.SetTopIndex(aIndex: Integer); +begin + fScrollBar.Position := aIndex; +end; + + +procedure TKMColumnBox.SetBackAlpha(aValue: Single); +begin + fBackAlpha := aValue; + fHeader.BackAlpha := aValue; + fScrollBar.BackAlpha := aValue; +end; + + +procedure TKMColumnBox.SetEdgeAlpha(aValue: Single); +begin + fEdgeAlpha := aValue; + fHeader.EdgeAlpha := aValue; + fScrollBar.EdgeAlpha := aValue; +end; + + +procedure TKMColumnBox.SetEnabled(aValue: Boolean); +begin + inherited; + fHeader.Enabled := Enabled; + fScrollBar.Enabled := Enabled; +end; + + +function TKMColumnBox.GetColumn(aIndex: Integer): TKMListColumn; +begin + Result := fColumns[aIndex]; +end; + + +function TKMColumnBox.GetItem(aIndex: Integer): TKMListRow; +begin + if InRange(aIndex, 0, RowCount - 1) then + Result := Rows[aIndex] + else + raise Exception.Create('Cannot get Item with index ' + IntToStr(aIndex)); +end; + + +function TKMColumnBox.GetSelectedItem: TKMListRow; +begin + if IsSelected then + Result := Rows[fItemIndex] + else + raise Exception.Create('No selected item found'); +end; + + +function TKMColumnBox.GetSelectedItemTag: Integer; +begin + Result := -1; + if IsSelected then + Result := GetSelectedItem.Tag; +end; + + +procedure TKMColumnBox.ScrollBarChangeVisibility; +var + I: Integer; +begin + if Visible and (ColumnIdForScroll <> -1) then + begin + if fScrollBar.Visible then + for I := ColumnIdForScroll to fHeader.Count - 1 do + fHeader.Offset[I] := fHeader.Offset[I] - fScrollBar.Width + else + begin + for I := ColumnIdForScroll to fHeader.Count - 1 do + fHeader.Offset[I] := fHeader.Offset[I] + fScrollBar.Width; + end; + end; +end; + + +procedure TKMColumnBox.ScrollBarChanged(Sender: TObject); +begin + // Reset mouse over field, since we don't want hints to be shown while changing scrollbar f.e. + ResetMouseOver; +end; + + +function TKMColumnBox.GetOnColumnClick: TKMNotifyColumnClick; +begin + Result := fHeader.OnColumnClick; +end; + + +function TKMColumnBox.GetSortDirection: TKMSortDirection; +begin + Result := fHeader.SortDirection; +end; + + +function TKMColumnBox.GetSortIndex: Integer; +begin + Result := fHeader.SortIndex; +end; + + +// fRowCount or Height has changed +procedure TKMColumnBox.UpdateScrollBar; +var + oldScrollBarVisible: Boolean; +begin + fScrollBar.MaxValue := fRowCount - (Height - fHeader.Height * Byte(ShowHeader)) div fItemHeight; + Assert(fScrollBar.MaxValue >= fScrollBar.MinValue); + oldScrollBarVisible := fScrollBar.Visible; + fScrollBar.Visible := IsSetVisible and (fScrollBar.MaxValue <> fScrollBar.MinValue); + if fScrollBar.Visible <> oldScrollBarVisible then + ScrollBarChangeVisibility; +end; + + +// If we don't add columns there will be Assert on items add +procedure TKMColumnBox.SetColumns(aHeaderFont: TKMFont; aCaptions: array of string; aOffsets: array of Word); +var + hints: array of string; +begin + SetLength(hints, Length(aCaptions)); + SetColumns(aHeaderFont, aCaptions, hints, aOffsets); +end; + + +procedure TKMColumnBox.SetColumns(aHeaderFont: TKMFont; aCaptions: array of string; aOffsets: array of Word; aCaptionsAsHints: Boolean); +begin + if aCaptionsAsHints then + SetColumns(aHeaderFont, aCaptions, aCaptions, aOffsets) + else + SetColumns(aHeaderFont, aCaptions, aOffsets); +end; + + +procedure TKMColumnBox.SetColumns(aHeaderFont: TKMFont; aCaptions, aHints: array of String; aOffsets: array of Word); +var + I: Integer; +begin + Assert(Length(aCaptions) = Length(aOffsets)); + Assert(Length(aHints) = Length(aOffsets)); + + Clear; //We don't want to conflict with already added rows elements + ClearColumns; + + fHeader.SetColumns(aHeaderFont, aCaptions, aHints, aOffsets); + + SetLength(fColumns, fHeader.ColumnCount); + for I := 0 to fHeader.ColumnCount - 1 do + begin + fColumns[I] := TKMListColumn.Create; + fColumns[I].Font := fFont; //Reset to default font + fColumns[I].TextAlign := taLeft; //Default alignment + fColumns[I].TriggerOnChange := True; //by default all columns trigger OnChange + end; +end; + + +procedure TKMColumnBox.AddItem(aItem: TKMListRow); +begin + Assert(fHeader.ColumnCount > 0); + Assert(Length(aItem.Cells) = fHeader.ColumnCount); + + if fRowCount >= Length(Rows) then + SetLength(Rows, fRowCount + 16); + + Rows[fRowCount] := aItem; + + Inc(fRowCount); + UpdateScrollBar; +end; + + +procedure TKMColumnBox.Clear; +begin + fRowCount := 0; + fItemIndex := -1; + UpdateScrollBar; +end; + + +procedure TKMColumnBox.ClearColumns; +var + I: Integer; +begin + for I := 0 to fHeader.ColumnCount - 1 do + FreeAndNil(fColumns[I]); +end; + + +procedure TKMColumnBox.JumpToSelected; +begin + if (ItemIndex <> -1) + and not InRange(ItemIndex - TopIndex, 0, GetVisibleRows-1) + then + if ItemIndex < TopIndex then + TopIndex := ItemIndex + else + if ItemIndex > TopIndex + GetVisibleRows - 1 then + TopIndex := ItemIndex - GetVisibleRows + 1; +end; + + +function TKMColumnBox.KeyDown(Key: Word; Shift: TShiftState): Boolean; +begin + if PassAllKeys then Exit(False); + + Result := inherited; +end; + + +function TKMColumnBox.CanChangeSelection: Boolean; +begin + Result := not HideSelection; +end; + + +function TKMColumnBox.CanFocusNext: Boolean; +begin + Result := not PassAllKeys; +end; + + +procedure TKMColumnBox.KeyPress(Key: Char); +begin + if PassAllKeys then + Exit + else + inherited; +end; + + +function TKMColumnBox.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := False; + if PassAllKeys then + begin + if Assigned(OnKeyUp) then + Result := OnKeyUp(Self, Key, Shift); + + Exit; + end; + + Result := inherited; +end; + + +procedure TKMColumnBox.ResetMouseOver; +begin + fMouseOverColumn := -1; + fMouseOverRow := -1; + fMouseOverCell := KMPOINT_INVALID_TILE; +end; + + +//Update mouse over row/cell positions (fMouseOver* variables) +procedure TKMColumnBox.UpdateMouseOverPosition(X,Y: Integer); +var + I, cellLeftOffset, cellRightOffset: Integer; +begin + ResetMouseOver; + + if InRange(X, AbsLeft, AbsLeft + Width - fScrollBar.Width * Byte(fScrollBar.Visible)) + and InRange(Y, AbsTop + fHeader.Height*Byte(fHeader.Visible), AbsTop + fHeader.Height*Byte(fHeader.Visible) + Floor(GetVisibleRowsExact * fItemHeight) - 1) then + begin + for I := 0 to fHeader.ColumnCount - 1 do + begin + cellLeftOffset := AbsLeft + fHeader.Columns[I].Offset; + if I = fHeader.ColumnCount - 1 then + cellRightOffset := AbsLeft + Width - fScrollBar.Width * Byte(fScrollBar.Visible) + else + cellRightOffset := AbsLeft + fHeader.Columns[I+1].Offset - 1; + if InRange(X, cellLeftOffset, cellRightOffset) then + begin + fMouseOverColumn := I; + Break; + end; + end; + + fMouseOverRow := TopIndex + (Y - AbsTop - fHeader.Height * Byte(fShowHeader)) div fItemHeight; + + if fMouseOverRow >= fRowCount then + fMouseOverRow := -1; + + if (fMouseOverRow <> -1) and (fMouseOverColumn <> -1) then + fMouseOverCell := TKMPoint.New(fMouseOverColumn, fMouseOverRow); + end; +end; + + +procedure TKMColumnBox.DoClick(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + isClickHandled: Boolean; +begin + //do not invoke inherited here, to fully override parent DoClick method + isClickHandled := False; + + if not KMSamePoint(fMouseOverCell, KMPOINT_INVALID_TILE) + and Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Enabled then + begin + if Assigned(fOnCellClick) then + fOnCellClick(Self, fMouseOverCell.X, fMouseOverCell.Y, isClickHandled) + else + if Assigned(fOnCellClickShift) then + fOnCellClickShift(Self, fMouseOverCell.X, fMouseOverCell.Y, Shift, isClickHandled); + end; + + // Let propagate click event only when OnCellClick did not handle it + if isClickHandled then Exit; + + inherited DoClick(X, Y, Shift, Button); + if Assigned(fOnChange) + and not fOnChangeInvoked + and (fMouseOverCell <> KMPOINT_INVALID_TILE) //Only trigger ovew cells + and Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Enabled then // Only trigger for enabled cells + fOnChange(Self); +end; + + +procedure TKMColumnBox.UpdateItemIndex(Shift: TShiftState; var aOnChangeInvoked: Boolean); +var + newIndex: Integer; +begin + aOnChangeInvoked := False; + if not (ssLeft in Shift) or (fMouseOverRow = -1) then + Exit; + + // Do not do anything else, in case Cell we are working on is Disabled + if (fMouseOverCell = KMPOINT_INVALID_TILE) + or not Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Enabled then + Exit; + + newIndex := fMouseOverRow; + + if newIndex >= fRowCount then + begin + //Double clicking not allowed if we are clicking past the end of the list, but keep last item selected + fTimeOfLastClick := 0; + newIndex := -1; + end; + + if InRange(newIndex, 0, fRowCount - 1) and (newIndex <> fItemIndex) then + begin + fTimeOfLastClick := 0; //Double click shouldn't happen if you click on one server A, then server B + ItemIndex := newIndex; + if not KMSamePoint(fMouseOverCell, KMPOINT_INVALID_TILE) + and Columns[fMouseOverCell.X].TriggerOnChange + and (fMouseOverCell <> KMPOINT_INVALID_TILE) //Only trigger ovew cells + and Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Enabled // Only trigger for enabled cells + and Assigned(fOnChange) then + begin + fOnChange(Self); + aOnChangeInvoked := True; + end; + end; +end; + + +procedure TKMColumnBox.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + UpdateMouseOverPosition(X, Y); + UpdateItemIndex(Shift, fOnChangeInvoked); + //Lets do DoClick here instead of MouseUp event handler, because of some TKMColumnBox specific logic + if (csDown in State) then + begin + State := State - [csDown]; + + //Send Click events + DoClick(X, Y, Shift, Button); + fOnChangeInvoked := False; + end; +end; + + +procedure TKMColumnBox.MouseMove(X,Y: Integer; Shift: TShiftState); +var + onChangeInvoked: Boolean; +begin + inherited; + UpdateMouseOverPosition(X, Y); + UpdateItemIndex(Shift, onChangeInvoked); +end; + + +procedure TKMColumnBox.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + //We handle normal MouseUp event in MouseDown, so just hide ancestor MouseUp here +end; + + +function TKMColumnBox.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMColumnBox.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + inherited; + + if aHandled then Exit; + + SetTopIndex(TopIndex - WheelSteps); + fScrollBar.Position := TopIndex; //Make the scrollbar move too when using the wheel + + aHandled := WheelSteps <> 0; +end; + + +function TKMColumnBox.GetHint: UnicodeString; +var + hintStr: String; +begin + Result := inherited GetHint; + if Result = '' then + begin + if not KMSamePoint(fMouseOverCell, KMPOINT_INVALID_TILE) + //Got crashed sometimes when mouse over empty disabled ComboBox with Header (fMouseOverCell = [0;0]) + and (Length(Rows) > fMouseOverCell.Y) + and (Length(Rows[fMouseOverCell.Y].Cells) > fMouseOverCell.X) then + begin + Result := Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].CellHint; + if fShowHintWhenShort and (Result = '') then + begin + hintStr := Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Caption; + // Show hint, if caption does not fit into the cell + if gRes.Fonts[fFont].GetTextSize(hintStr).X > fHeader.ColumnWidth[fMouseOverCell.X] - COL_PAD_X then + Result := hintStr; + end; + end; + end; +end; + + +function TKMColumnBox.GetHintTextColor: TColor4; +begin + if fMouseOverCell = KMPOINT_INVALID_TILE then Exit(inherited); + + Result := Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Color; +end; + + +function TKMColumnBox.GetHintBackRect: TKMRect; +const + SELECT_PAD = 1; +var + top: Integer; +begin + if fMouseOverCell = KMPOINT_INVALID_TILE then Exit(KMRECT_ZERO); + + top := fHeader.Height * Byte(fShowHeader) + (fMouseOverCell.Y - TopIndex) * fItemHeight - SELECT_PAD; + Result := KMRect(fHeader.Columns[fMouseOverCell.X].Offset, //beware we dont consider hidden columns here, since there are none needed atm + top, + 0, // Width is not used + top + fItemHeight + SELECT_PAD); +end; + + +function TKMColumnBox.GetHintTextOffset: TKMPoint; +var + textSize: TKMPoint; +begin + if fMouseOverCell = KMPOINT_INVALID_TILE then Exit(KMPOINT_ZERO); + + textSize := gRes.Fonts[fFont].GetTextSize(Rows[fMouseOverCell.Y].Cells[fMouseOverCell.X].Caption); + + Result := TKMPoint.New(COL_PAD_X + fHeader.Columns[fMouseOverCell.X].Offset, //beware we dont consider hidden columns here, since there are none needed atm + TXT_PAD_Y + fHeader.Height * Byte(fShowHeader) + + (fMouseOverCell.Y - TopIndex) * fItemHeight + + (fItemHeight - textSize.Y) div 2); +end; + + +procedure TKMColumnBox.DoPaintLine(aIndex: Integer; X, Y: Integer; PaintWidth: Integer; aAllowHighlight: Boolean = True); +var + I: Integer; + columnsToShow: array of Boolean; +begin + SetLength(columnsToShow, Length(fColumns)); + for I := Low(columnsToShow) to High(columnsToShow) do + columnsToShow[I] := True; // show all columns by default + DoPaintLine(aIndex, X, Y, PaintWidth, columnsToShow, aAllowHighlight); +end; + + +procedure TKMColumnBox.DoPaintLine(aIndex: Integer; X, Y: Integer; PaintWidth: Integer; aColumnsToShow: array of Boolean; + aAllowHighlight: Boolean = True); + function IsHighlightOverCell(aCellIndex: Integer): Boolean; + begin + Result := aAllowHighlight + and Rows[aIndex].Cells[aCellIndex].HighlightOnMouseOver + and (fMouseOverCell.X = aCellIndex) and (fMouseOverCell.Y = aIndex) + and (csOver in State); + end; + +var + I: Integer; + availWidth, hiddenColumnsTotalWidth: Integer; + textSize: TKMPoint; + color: Cardinal; +begin + Assert(Length(fColumns) = Length(aColumnsToShow)); + hiddenColumnsTotalWidth := 0; + for I := 0 to fHeader.ColumnCount - 1 do + begin + if not aColumnsToShow[I] then + begin + Inc(hiddenColumnsTotalWidth, fHeader.ColumnWidth[I]); + Continue; + end; + //Determine available width + if I = fHeader.ColumnCount - 1 then + availWidth := PaintWidth - 4 - fHeader.Columns[I].Offset - COL_PAD_X + else + availWidth := fHeader.Columns[I+1].Offset - fHeader.Columns[I].Offset - COL_PAD_X; + //Trim the width based on our allowed PaintWidth + availWidth := Min(availWidth, PaintWidth - fHeader.Columns[I].Offset); + + if availWidth <= 0 then Continue; //If the item overflows our allowed PaintWidth do not paint it + + //Paint column + if Rows[aIndex].Cells[I].Pic.ID <> 0 then + TKMRenderUI.WritePicture(X + COL_PAD_X + fHeader.Columns[I].Offset - hiddenColumnsTotalWidth, Y + 1, + availWidth, fItemHeight, [], + Rows[aIndex].Cells[I].Pic.RX, + Rows[aIndex].Cells[I].Pic.ID, + Rows[aIndex].Cells[I].Enabled, + Rows[aIndex].Cells[I].Color, + 0.4*Byte(IsHighlightOverCell(I) or (HighlightOnMouseOver and (csOver in State) and (fMouseOverRow = aIndex)))); + + if Rows[aIndex].Cells[I].Caption <> '' then + if Rows[aIndex].Cells[I].SubTxt <> '' then + begin + textSize := gRes.Fonts[fFont].GetTextSize(Rows[aIndex].Cells[I].Caption); + TKMRenderUI.WriteText(X + COL_PAD_X + fHeader.Offset[I] - hiddenColumnsTotalWidth, + Y + 4, + availWidth, + Rows[aIndex].Cells[I].Caption, + fColumns[I].Font, fColumns[I].TextAlign, Rows[aIndex].Cells[I].Color); + TKMRenderUI.WriteText(X + COL_PAD_X + fHeader.Offset[I] - hiddenColumnsTotalWidth, + Y + 1 + fItemHeight div 2, + availWidth, + Rows[aIndex].Cells[I].SubTxt, + fColumns[I].HintFont, fColumns[I].TextAlign, $FFB0B0B0); + end else + begin + textSize := gRes.Fonts[fFont].GetTextSize(Rows[aIndex].Cells[I].Caption); + if aAllowHighlight + and ((HighlightOnMouseOver and (csOver in State) and (fMouseOverRow = aIndex)) + or (HighlightError and (aIndex = ItemIndex)) + or IsHighlightOverCell(I)) then + color := Rows[aIndex].Cells[I].HighlightColor + else + color := Rows[aIndex].Cells[I].Color; + + if not Enabled then + color := ReduceBrightness(color, 136); + TKMRenderUI.WriteText(X + COL_PAD_X + fHeader.Offset[I] - hiddenColumnsTotalWidth, + Y + TXT_PAD_Y + (fItemHeight - textSize.Y) div 2, + availWidth, + Rows[aIndex].Cells[I].Caption, + fColumns[I].Font, fColumns[I].TextAlign, color); + end; + end; +end; + + +procedure TKMColumnBox.Paint; +var + I, paintWidth, maxItem, Y: Integer; + outlineColor, shapeColor: TColor4; +begin + inherited; + + if fScrollBar.Visible then + paintWidth := Width - fScrollBar.Width //Leave space for scrollbar + else + paintWidth := Width; //List takes up the entire width + + fHeader.Width := paintWidth; + + Y := AbsTop + fHeader.Height * Byte(fShowHeader); + maxItem := GetVisibleRows; + + TKMRenderUI.WriteBevel(AbsLeft, Y, paintWidth, Height - fHeader.Height * Byte(fShowHeader), fEdgeAlpha, fBackAlpha); + + //Grid lines should be below selection focus + if fShowLines then + for I := 0 to Math.Min(fRowCount, maxItem) do + TKMRenderUI.WriteShape(AbsLeft+1, Y + I * fItemHeight - 1, paintWidth - 2, 1, $FFBBBBBB); + + TKMRenderUI.SetupClipY(AbsTop, AbsTop + Height - 1); + + //Selection highlight + if not HideSelection + and (fItemIndex <> -1) + and InRange(ItemIndex - TopIndex, 0, maxItem) then + begin + + if IsFocused then + begin + shapeColor := clListSelShape; + outlineColor := clListSelOutline; + end else begin + shapeColor := clListSelShapeUnfocused; + outlineColor := clListSelOutlineUnfocused; + end; + + TKMRenderUI.WriteShape(AbsLeft, Y + fItemHeight * (fItemIndex - TopIndex), paintWidth, fItemHeight, shapeColor); + TKMRenderUI.WriteOutline(AbsLeft, Y + fItemHeight * (fItemIndex - TopIndex), paintWidth, fItemHeight, 1 + Byte(fShowLines), outlineColor); + end; + + //Paint rows text and icons above selection for clear visibility + for I := 0 to Math.min(fRowCount - TopIndex - 1, maxItem) do + DoPaintLine(TopIndex + I, AbsLeft, Y + I * fItemHeight, paintWidth); + + TKMRenderUI.ReleaseClipY; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsMemo.pas b/vendor/kam_remake/src/controls/KM_ControlsMemo.pas new file mode 100644 index 0000000..79a8d78 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsMemo.pas @@ -0,0 +1,783 @@ +unit KM_ControlsMemo; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsScroll, + KM_RenderUI, KM_ResFonts, + KM_CommonTypes, KM_Points; + + +type + TKMMemo = class(TKMControl) + private + fFont: TKMFont; //Should not be changed from inital value, it will mess up the word wrapping + fItemHeight: Byte; + fItems: TStringList; + fWordWrap: Boolean; + fIndentAfterNL: Boolean; + fText: UnicodeString; + fScrollDown: Boolean; + fScrollBar: TKMScrollBar; + fOnChange: TNotifyEvent; + fCursorPos: Integer; + fSelectable: Boolean; + fSelectionStart: Integer; + fSelectionEnd: Integer; + fSelectionInitialPos: Integer; + + procedure SetWordWrap(const Value: Boolean); + function GetText: UnicodeString; + procedure SetText(const aText: UnicodeString); + function GetTopIndex: smallint; + procedure SetTopIndex(aIndex: SmallInt); + procedure ReformatText; + procedure UpdateScrollBar; + + function KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; + + procedure SetCursorPos(aPos: Integer); + function LinearToPointPos(aPos: Integer): TKMPoint; + function PointToLinearPos(aColumn, aRow: Integer): Integer; + function GetCharPosAt(X,Y: Integer): TKMPoint; + function GetCursorPosAt(X,Y: Integer): Integer; + procedure ResetSelection; + function HasSelection: Boolean; + function GetPlainText(aUsePipeAsEOL: Boolean; aStart: Integer = -1; aEnd: Integer = -1): UnicodeString; + function GetSelectedText: UnicodeString; + function GetMaxCursorPos: Integer; + function GetMaxPosInRow(aRow: Integer): Integer; + function GetMinPosInRow(aRow: Integer): Integer; + function GetMaxCursorPosInRow: Integer; + function GetMinCursorPosInRow: Integer; + procedure SetSelectionStart(aValue: Integer); + procedure SetSelectionEnd(aValue: Integer); + procedure SetSelections(aValue1, aValue2: Integer); + procedure UpdateSelection(aOldCursorPos: Integer; aIsSelecting: Boolean); + protected + procedure SetHeight(aValue: Integer); override; + procedure SetWidth(aValue: Integer); override; + procedure SetVisible(aValue: Boolean); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetTop(aValue: Integer); override; + procedure FocusChanged(aFocused: Boolean); override; + procedure ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + function DoHandleMouseWheelByDefault: Boolean; override; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle; aSelectable: Boolean = True); + destructor Destroy; override; + + procedure Add(const aItem: UnicodeString); + procedure Clear; + procedure ScrollToBottom; + property WordWrap: Boolean read fWordWrap write SetWordWrap; //Whether to automatically wrap text within given text area width + property IndentAfterNL: Boolean read fIndentAfterNL write fIndentAfterNL; + property Text: UnicodeString read GetText write SetText; + property ItemHeight: Byte read fItemHeight write fItemHeight; + property TopIndex: Smallint read GetTopIndex write SetTopIndex; + property ScrollDown: Boolean read fScrollDown write fScrollDown; + property CursorPos: Integer read fCursorPos write SetCursorPos; + property Selectable: Boolean read fSelectable write fSelectable; + property SelectionStart: Integer read fSelectionStart write SetSelectionStart; + property SelectionEnd: Integer read fSelectionEnd write SetSelectionEnd; + + function GetVisibleRows: Integer; + function KeyDown(Key: Word; Shift: TShiftState): Boolean; override; + function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + + property OnChange: TNotifyEvent read fOnChange write fOnChange; + + procedure Paint; override; + end; + + +implementation +uses + KM_Defaults, + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + SysUtils, StrUtils, Math, + Clipbrd, + KromUtils, + KM_ControlsUtils, + KM_Resource, KM_Render, KM_RenderTypes, + KM_CommonUtils; + + +{ TKMMemo } +constructor TKMMemo.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont; aStyle: TKMButtonStyle; aSelectable: Boolean = True); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fItemHeight := 20; + fItems := TStringList.Create; + fFont := aFont; + + fScrollBar := TKMScrollBar.Create(aParent, aLeft+aWidth-20, aTop, 20, aHeight, saVertical, aStyle); + UpdateScrollBar; //Initialise the scrollbar + fSelectable := aSelectable; + + aParent.MasterControl.SubscribeOnOtherMouseDown(ControlMouseDown); +end; + + +destructor TKMMemo.Destroy; +begin + fItems.Free; + inherited; +end; + + +procedure TKMMemo.SetHeight(aValue: Integer); +begin + inherited; + fScrollBar.Height := Height; + UpdateScrollBar; //Since height has changed +end; + + +procedure TKMMemo.SetWidth(aValue: Integer); +begin + inherited; + fScrollBar.Left := Left + Width - fScrollBar.Width; + ReformatText; //Repositions the scroll bar as well +end; + + +//Copy property to scrollbar. Otherwise it won't be rendered +procedure TKMMemo.SetVisible(aValue: Boolean); +begin + inherited; + + //Hide scrollbar and its buttons + fScrollBar.Visible := IsSetVisible and (fScrollBar.MaxValue <> fScrollBar.MinValue); +end; + + +function TKMMemo.GetTopIndex: smallint; +begin + Result := fScrollBar.Position; +end; + + +procedure TKMMemo.SetTopIndex(aIndex: smallint); +begin + fScrollBar.Position := aIndex; +end; + + +procedure TKMMemo.SetEnabled(aValue: Boolean); +begin + inherited; + fScrollBar.Enabled := Enabled; +end; + + +procedure TKMMemo.SetTop(aValue: Integer); +begin + inherited; + fScrollBar.Top := Top; +end; + + +procedure TKMMemo.SetWordWrap(const Value: boolean); +begin + fWordWrap := Value; + ReformatText; +end; + + +function TKMMemo.GetText: UnicodeString; +begin + Result := fText; +end; + + +procedure TKMMemo.SetText(const aText: UnicodeString); +begin + fText := aText; + ReformatText; + + if Assigned(fOnChange) then + fOnChange(Self); +end; + + +procedure TKMMemo.ReformatText; +var + newText: UnicodeString; +begin + if fWordWrap then + newText := gRes.Fonts[fFont].WordWrap(fText, Width - fScrollBar.Width - 8, True, IndentAfterNL) + else + newText := fText; + + //KaM uses | for new line, fItems.Text:= uses standard eol to parse each item from the string + fItems.Text := StringReplace(newText, '|', EolW, [rfReplaceAll]); + UpdateScrollBar; +end; + + +function TKMMemo.GetVisibleRows: Integer; +begin + Result := Height div fItemHeight; +end; + + +//fItems.Count or Height has changed +procedure TKMMemo.UpdateScrollBar; +var + oldMax: Integer; +begin + oldMax := fScrollBar.MaxValue; + fScrollBar.MaxValue := fItems.Count - GetVisibleRows; + fScrollBar.Visible := IsSetVisible and (fScrollBar.MaxValue <> fScrollBar.MinValue); + + if fScrollDown then + begin + if oldMax - fScrollBar.Position <= 2 then //If they were near the bottom BEFORE updating, keep them at the bottom + SetTopIndex(fItems.Count) //This puts it at the bottom because of the EnsureRange in SetTopIndex + end + else + SetTopIndex(fScrollBar.Position); +end; + + +procedure TKMMemo.SetCursorPos(aPos: Integer); +begin + fCursorPos := EnsureRange(aPos, 0, GetMaxCursorPos); +end; + + +function TKMMemo.GetPlainText(aUsePipeAsEOL: Boolean; aStart: Integer = -1; aEnd: Integer = -1): UnicodeString; +begin + if aStart = -1 then + aStart := 0; + + if aEnd = -1 then + aEnd := Length(fItems.Text); + + // First remove EOL's to get correct positions in text + Result := StringReplace(fItems.Text, EolW, '|', [rfReplaceAll]); + // Get text with selected positions, cleaned of color markup + Result := Copy(GetNoColorMarkupText(Result), aStart + 1, aEnd - aStart); + // Return EOL's back + if not aUsePipeAsEOL then + Result := StringReplace(Result, '|', EolW, [rfReplaceAll]); +end; + + +function TKMMemo.GetSelectedText: UnicodeString; +begin + Result := ''; + if HasSelection then + Result := GetPlainText(False, fSelectionStart, fSelectionEnd); +end; + + +function TKMMemo.HasSelection: Boolean; +begin + Result := (fSelectionStart <> -1) and (fSelectionEnd <> -1) and (fSelectionStart <> fSelectionEnd); +end; + + +procedure TKMMemo.ResetSelection; +begin + fSelectionStart := -1; + fSelectionEnd := -1; + fSelectionInitialPos := -1; +end; + + +//We are using 2 systems for position: Linear (cumulative) and 'Point' (2D with column and row) +//Every system have Length(RowText)+1 positions in every line +//Convert Linear position into 2D position +function TKMMemo.LinearToPointPos(aPos: Integer): TKMPoint; +var I, row, column: Integer; + rowText: UnicodeString; + rowStartPos, rowEndPos: Integer; +begin + row := 0; + column := 0; + for I := 0 to fItems.Count - 1 do + begin + rowText := GetNoColorMarkupText(fItems[I]); + rowStartPos := PointToLinearPos(0, I); + rowEndPos := rowStartPos + Length(rowText); + if InRange(aPos, rowStartPos, rowEndPos) then + begin + row := I; + column := aPos - rowStartPos; + Break; + end; + end; + Result := TKMPoint.New(column, row); +end; + + +//We are using 2 systems for position: Linear (cumulative) and 'Point' (2D with column and row) +//Every system have Length(RowText)+1 positions in every line +//Convert 2D position into Linear position +function TKMMemo.PointToLinearPos(aColumn, aRow: Integer): Integer; +var + I: Integer; +begin + Result := 0; + aRow := EnsureRange(aRow, 0, fItems.Count-1); + for I := 0 to aRow-1 do + Inc(Result, Length(GetNoColorMarkupText(fItems[I])) + 1); //+1 for special KaM new line symbol ('|') + Inc(Result, EnsureRange(aColumn, 0, GetMaxPosInRow(aRow))); +end; + + +//Return position of Cursor in 2D of point X,Y on the screen +function TKMMemo.GetCharPosAt(X,Y: Integer): TKMPoint; +var + row, column: Integer; +begin + row := 0; + column := 0; + + if fItems.Count > 0 then + begin + row := (EnsureRange(Y-AbsTop-3, 0, Height-6) div fItemHeight) + TopIndex; + row := EnsureRange(row, 0, fItems.Count-1); + column := gRes.Fonts[fFont].CharsThatFit(GetNoColorMarkupText(fItems[row]), X-AbsLeft-4); + end; + Result := TKMPoint.New(column, row); +end; + + +//Return position of Cursor in linear system of point X,Y on the screen +function TKMMemo.GetCursorPosAt(X,Y: Integer): Integer; +var + charPos: TKMPoint; +begin + charPos := GetCharPosAt(X, Y); + Result := PointToLinearPos(charPos.X, charPos.Y); +end; + + +// Maximum possible position of Cursor +function TKMMemo.GetMaxCursorPos: Integer; +begin + Result := Length(StringReplace(fItems.Text, EolW, '', [rfReplaceAll])) + EnsureRange(fItems.Count-1, 0, fItems.Count); +end; + + +// Minimum possible position of Cursor in its current Row +function TKMMemo.GetMinCursorPosInRow: Integer; +begin + Result := GetMinPosInRow(LinearToPointPos(CursorPos).Y) +end; + + +// Maximum possible position of Cursor in its current Row +function TKMMemo.GetMaxCursorPosInRow: Integer; +begin + Result := GetMaxPosInRow(LinearToPointPos(CursorPos).Y) +end; + + +// Minimum possible position of Cursor in the specified aRow +function TKMMemo.GetMinPosInRow(aRow: Integer): Integer; +begin + if aRow = 0 then + Result := 0 + else + Result := GetMaxPosInRow(aRow - 1) + 1; +end; + + +// Maximum possible position of Cursor in the specified aRow +function TKMMemo.GetMaxPosInRow(aRow: Integer): Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to min(aRow, fItems.Count - 1) do + Inc(Result, Length(GetNoColorMarkupText(fItems[I])) + 1); + Result := EnsureRange(Result - 1, 0, Result); +end; + + +procedure TKMMemo.SetSelectionStart(aValue: Integer); +var + maxPos: Integer; +begin + if fSelectable then + begin + maxPos := GetMaxCursorPos; + fSelectionStart := EnsureRange(aValue, 0, maxPos); + end; +end; + + +procedure TKMMemo.SetSelectionEnd(aValue: Integer); +var + maxPos: Integer; +begin + if fSelectable then + begin + maxPos := GetMaxCursorPos; + fSelectionEnd := EnsureRange(aValue, 0, maxPos); + end; +end; + + +//Set selections with pair of value, using he fact, that fSelectionStart <= fSelectionEnd +procedure TKMMemo.SetSelections(aValue1, aValue2: Integer); +begin + fSelectionStart := Min(aValue1, aValue2); + fSelectionEnd := Max(aValue1, aValue2); +end; + + +//Update selection start/end due to change cursor position +procedure TKMMemo.UpdateSelection(aOldCursorPos: Integer; aIsSelecting: Boolean); +begin + if aIsSelecting then + begin + if HasSelection then + begin + if aOldCursorPos = SelectionStart then + SetSelections(CursorPos, SelectionEnd) + else + if aOldCursorPos = SelectionEnd then + SetSelections(SelectionStart, CursorPos); + end else + SetSelections(aOldCursorPos, CursorPos); + end + else + ResetSelection; +end; + + +procedure TKMMemo.Add(const aItem: UnicodeString); +begin + if fText <> '' then + fText := fText + '|'; + + fText := fText + aItem; //Append the new string + + SetText(fText); //Updates the text in fItems + UpdateScrollBar; //Scroll down with each item that is added. + + if Assigned(fOnChange) then + fOnChange(Self); +end; + + +procedure TKMMemo.Clear; +begin + fText := ''; + fItems.Clear; + ResetSelection; + UpdateScrollBar; + + if Assigned(fOnChange) then + fOnChange(Self); +end; + + +procedure TKMMemo.ScrollToBottom; +begin + SetTopIndex(fItems.Count); +end; + + +//Key events which have no effect should not be handled (allows scrolling while chat window open with no text entered) +function TKMMemo.KeyEventHandled(Key: Word; Shift: TShiftState): Boolean; +begin + Result := True; + + //Don't include backspace/delete because edits should always handle those. Otherwise when you + //press backspace repeatedly to remove all characters it will apply other shortcuts like + //resetting the zoom if you press it once too many times. + case Key of + VK_UP, + VK_DOWN, + VK_LEFT, + VK_RIGHT, + VK_HOME, + VK_END, + VK_PRIOR, + VK_NEXT: Result := (fText <> ''); //These keys have no effect when text is blank + end; + + //We want these keys to be ignored by chat, so game shortcuts still work + if Key in [VK_F1..VK_F12, VK_ESCAPE, VK_MBUTTON] then Result := False; + + //Ctrl can be used as an escape character, e.g. CTRL+B places beacon while chat is open + if ssCtrl in Shift then Result := (Key in [VK_LEFT, VK_RIGHT, Ord('A'), Ord('C'), Ord('X')]); +end; + + +function TKMMemo.KeyDown(Key: Word; Shift: TShiftState): Boolean; + //Move cursor vertically (change cursor row) + procedure MoveCursorVertically(aRowIncrement: Integer); + var + cursorPointPos: TKMPoint; + newCursorPosY: Integer; + srcLineText, destLineText: UnicodeString; + begin + cursorPointPos := LinearToPointPos(CursorPos); + newCursorPosY := EnsureRange(cursorPointPos.Y + aRowIncrement, 0, fItems.Count-1); + if newCursorPosY <> cursorPointPos.Y then + begin + // Because we don't use monospaces fonts, then its better to find proper column, which depends of text width in px + srcLineText := GetNoColorMarkupText(Copy(fItems[cursorPointPos.Y], 1, cursorPointPos.X)); + destLineText := GetNoColorMarkupText(fItems[newCursorPosY]); + //Use 'rounding' version of CharsThatFit to get more precise position + cursorPointPos.X := gRes.Fonts[fFont].CharsThatFit(destLineText, gRes.Fonts[fFont].GetTextSize(srcLineText).X, True); + CursorPos := PointToLinearPos(cursorPointPos.X, newCursorPosY); + // Update scroll position, if needed + if TopIndex > newCursorPosY then + TopIndex := newCursorPosY + else if TopIndex < newCursorPosY - GetVisibleRows + 1 then + TopIndex := newCursorPosY - GetVisibleRows + 1; + end; + end; + + // Update cursor pos considering Ctrl Key to go to the next / prev word in the text + procedure UpdateCursorPos(aCursorDir: TKMCursorDir); + begin + if ssCtrl in Shift then + begin + case aCursorDir of + cdNone: ; + cdForward: CursorPos := GetNextWordPos(GetPlainText(True), CursorPos); + cdBack: CursorPos := GetPrevWordPos(GetPlainText(True), CursorPos); + end; + end + else + CursorPos := CursorPos + ShortInt(aCursorDir); + end; + +var + oldCursorPos: Integer; + isSelect: Boolean; +begin + Result := KeyEventHandled(Key, Shift); + if inherited KeyDown(Key, Shift) then Exit; + + //Clipboard operations + if (Shift = [ssCtrl]) and (Key <> VK_CONTROL) then + case Key of + Ord('A'): SetSelections(0, GetMaxCursorPos); + Ord('C'), + Ord('X'): if HasSelection then + Clipboard.AsText := GetSelectedText; + end; + + oldCursorPos := CursorPos; + isSelect := IsSelecting(Key, Shift); + + case Key of + VK_LEFT, + VK_RIGHT: begin + UpdateCursorPos(GetCursorDir(Key)); + UpdateSelection(oldCursorPos, isSelect); + end; + VK_UP: begin + MoveCursorVertically(-1); + UpdateSelection(oldCursorPos, isSelect); + end; + VK_DOWN: begin + MoveCursorVertically(1); + UpdateSelection(oldCursorPos, isSelect); + end; + VK_PRIOR: begin + MoveCursorVertically(-GetVisibleRows); + UpdateSelection(oldCursorPos, isSelect); + end; + VK_NEXT: begin + MoveCursorVertically(GetVisibleRows); + UpdateSelection(oldCursorPos, isSelect); + end; + VK_HOME: begin + CursorPos := GetMinCursorPosInRow; + UpdateSelection(oldCursorPos, isSelect); + end; + VK_END: begin + CursorPos := GetMaxCursorPosInRow; + UpdateSelection(oldCursorPos, isSelect); + end; + end +end; + + +function TKMMemo.KeyUp(Key: Word; Shift: TShiftState): Boolean; +begin + Result := inherited KeyUp(Key, Shift) or KeyEventHandled(Key, Shift); +end; + + +function TKMMemo.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMMemo.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + inherited; + + if aHandled then Exit; + + SetTopIndex(TopIndex - WheelSteps); + + aHandled := WheelSteps <> 0; +end; + + +procedure TKMMemo.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + oldCursorPos: Integer; +begin + inherited; + + Focusable := fSelectable and (fText <> ''); // Do not focus on empty Memo's + // Update Focus now, because we need to focus on MouseDown, not on MouseUp as by default for all controls + MasterParent.MasterControl.UpdateFocus(Self); + + oldCursorPos := CursorPos; + CursorPos := GetCursorPosAt(X, Y); + + if Focusable then + begin + //Try select on Shift + LMB click + UpdateSelection(oldCursorPos, (oldCursorPos <> -1) and (Shift = [ssLeft, ssShift])); + fSelectionInitialPos := CursorPos; + end; +end; + + +procedure TKMMemo.MouseMove(X,Y: Integer; Shift: TShiftState); +var + oldCursorPos: Integer; + charPos: TKMPoint; +begin + inherited; + if (ssLeft in Shift) and (fSelectionInitialPos <> -1) then + begin + charPos := GetCharPosAt(X, Y); + + // To rotate text to top while selecting + if (Y-AbsTop-3 < 0) and (TopIndex > 0) then + begin + Dec(charPos.Y); + SetTopIndex(TopIndex-1); + end; + // To rotate text to bottom while selecting + if (Y-AbsTop-3 > Height) + and (fScrollBar.Position < fScrollBar.MaxValue) then + begin + charPos.Y := EnsureRange(charPos.Y+1, 0, fItems.Count); + SetTopIndex(TopIndex+1); + end; + + oldCursorPos := CursorPos; + CursorPos := PointToLinearPos(charPos.X, charPos.Y);; + UpdateSelection(oldCursorPos, True); + end; +end; + + +procedure TKMMemo.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + fSelectionInitialPos := -1; +end; + + +procedure TKMMemo.ControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + // Reset all, if other control was clicked + if Sender <> Self then + begin + ResetSelection; + Focusable := False; + CursorPos := -1; + MasterParent.MasterControl.UpdateFocus(Self); + end; +end; + + +procedure TKMMemo.FocusChanged(aFocused: Boolean); +begin + if not aFocused then + begin + ResetSelection; + CursorPos := -1; + Focusable := False; + end; +end; + + +procedure TKMMemo.Paint; +var + I, paintWidth, selPaintTop, selPaintHeight: Integer; + beforeSelectionText, selectionText, rowText: UnicodeString; + beforeSelectionW, selectionW, selStartPosInRow, selEndPosInRow, rowStartPos, rowEndPos: Integer; + offX, offY: Integer; +begin + inherited; + if fScrollBar.Visible then + paintWidth := Width - fScrollBar.Width //Leave space for scrollbar + else + paintWidth := Width; //List takes up the entire width + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, paintWidth, Height, 1, 0.5); + + for I := 0 to Math.min(fItems.Count-1, GetVisibleRows - 1) do + begin + rowText := GetNoColorMarkupText(fItems[TopIndex+I]); + rowStartPos := PointToLinearPos(0, TopIndex+I); + rowEndPos := rowStartPos + Length(rowText); + if HasSelection then + begin + selStartPosInRow := fSelectionStart - rowStartPos; + selEndPosInRow := fSelectionEnd - rowStartPos; + + selStartPosInRow := EnsureRange(selStartPosInRow, 0, rowEndPos); + selEndPosInRow := EnsureRange(selEndPosInRow, selStartPosInRow, rowEndPos); + + if selStartPosInRow <> selEndPosInRow then + begin + beforeSelectionText := Copy(rowText, 1, selStartPosInRow); + selectionText := Copy(rowText, selStartPosInRow+1, selEndPosInRow - selStartPosInRow); + + beforeSelectionW := gRes.Fonts[fFont].GetTextSize(beforeSelectionText).X; + selectionW := gRes.Fonts[fFont].GetTextSize(selectionText).X; + + selPaintHeight := fItemHeight; + selPaintTop := AbsTop+I*fItemHeight; + if I = 0 then + begin + Dec(selPaintHeight, 3); + Inc(selPaintTop, 3); + end; + + TKMRenderUI.WriteShape(AbsLeft+4+beforeSelectionW, selPaintTop, min(selectionW, Width-8), selPaintHeight, clTextSelection); + end; + end; + + //Render text cursor + if fSelectable and (csFocus in State) and ((TimeGet div 500) mod 2 = 0) + and InRange(CursorPos, rowStartPos, rowEndPos) then + begin + offX := AbsLeft + 2 + gRes.Fonts[fFont].GetTextSize(Copy(rowText, 1, CursorPos-rowStartPos)).X; + offY := AbsTop + 2 + I*fItemHeight; + TKMRenderUI.WriteShape(offX, offY, 3, fItemHeight-4, $FFFFFFFF, $FF000000); + end; + TKMRenderUI.WriteText(AbsLeft+4, AbsTop+I*fItemHeight+3, Width-8, fItems.Strings[TopIndex+I] , fFont, taLeft); + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsMinimapView.pas b/vendor/kam_remake/src/controls/KM_ControlsMinimapView.pas new file mode 100644 index 0000000..1e0aeff --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsMinimapView.pas @@ -0,0 +1,339 @@ +unit KM_ControlsMinimapView; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KromOGLUtils, + KM_RenderUI, KM_Minimap, KM_Viewport, + KM_ResFonts, KM_CommonTypes, KM_Points, KM_Defaults, + KM_Controls, KM_ControlsBase; + + +type + TKMMinimapEvent = procedure (Sender: TObject; const aLocX, aLocY: Integer) of object; + TKMMinimapLocEvent = procedure (Sender: TObject; const aLoc: Integer) of object; + + // MinimapView relies on fMinimap and fViewport that provide all the data + // MinimapView itself is just a painter + TKMMinimapView = class(TKMControl) + private + fBevel: TKMBevel; + fMinimap: TKMMinimap; + fView: TKMViewport; + fPaintWidth: Integer; + fPaintHeight: Integer; + fLeftOffset: Integer; + fTopOffset: Integer; + + fMapTex: TTexture; + fWidthPOT: Word; + fHeightPOT: Word; + + fOnMinimapChange: TKMMinimapEvent; + fOnMinimapClick: TKMMinimapEvent; + fShowLocs: Boolean; + fLocRad: Byte; + fClickableOnce: Boolean; + procedure UpdateTexture; + procedure ResizeMinimap; + protected + procedure SetAnchors(aValue: TKMAnchorsSet); override; + public + OnMinimapLocationClick: TKMMinimapLocEvent; + + constructor Create(aMinimap: TKMMinimap; aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aWithBevel: Boolean = False); + + function LocalToMapCoords(X,Y: Integer): TKMPoint; + function MapCoordsToLocal(X,Y: Single; const Inset: ShortInt = 0): TKMPoint; + procedure UpdateSizes; + procedure SetViewport(aViewport: TKMViewport); + property ShowLocs: Boolean read fShowLocs write fShowLocs; + property ClickableOnce: Boolean read fClickableOnce write fClickableOnce; + property OnMinimapChange: TKMMinimapEvent write fOnMinimapChange; + property OnMinimapClick: TKMMinimapEvent read fOnMinimapClick write fOnMinimapClick; + + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure Paint; override; + end; + + +implementation +uses + SysUtils, + Math, + KromUtils, + KM_MinimapGame, + KM_Render, KM_RenderTypes, + KM_CommonUtils, + KM_GameSettings, KM_InterfaceTypes; + + +{ TKMMinimapView } +constructor TKMMinimapView.Create(aMinimap: TKMMinimap; aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aWithBevel: Boolean = False); +begin + //Create Bevel first + if aWithBevel then + fBevel := TKMBevel.Create(aParent, aLeft - 4, aTop - 4, aWidth + 8, aHeight + 8); + + //Then Minimap control itself + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + //Radius of circle around player location + fLocRad := 8; + + fMinimap := aMinimap; + if fMinimap <> nil then + begin + fMinimap.SubOnUpdateTexture(UpdateTexture); + fMinimap.SubOnResize(ResizeMinimap); + + fMapTex.Tex := TKMRender.GenerateTextureCommon(ftNearest, ftNearest); + end; +end; + + +procedure TKMMinimapView.UpdateSizes; +begin + if fMinimap.MapX > fMinimap.MapY then + begin + fPaintWidth := Width; + fPaintHeight := Round(Height * fMinimap.MapY / Max(fMinimap.MapX, 1)); // X could = 0 + fLeftOffset := 0; + fTopOffset := (Height - fPaintHeight) div 2; + end + else + begin + fPaintWidth := Round(Width * fMinimap.MapX / Max(fMinimap.MapY, 1)); // Y could = 0 + fPaintHeight := Height; + fLeftOffset := (Width - fPaintWidth) div 2; + fTopOffset := 0; + end; +end; + + +procedure TKMMinimapView.SetViewport(aViewport: TKMViewport); +begin + fView := aViewport; +end; + + +procedure TKMMinimapView.ResizeMinimap; +begin + if Self = nil then Exit; + + fWidthPOT := MakePOT(fMinimap.MapX); + fHeightPOT := MakePOT(fMinimap.MapY); + fMapTex.U := fMinimap.MapX / fWidthPOT; + fMapTex.V := fMinimap.MapY / fHeightPOT; +end; + + +procedure TKMMinimapView.UpdateTexture; +var + wData: Pointer; + I: Word; +begin + if Self = nil then Exit; + + GetMem(wData, fWidthPOT * fHeightPOT * 4); + + if fMinimap.MapY > 0 then //if MapY = 0 then loop will overflow to MaxWord + for I := 0 to fMinimap.MapY - 1 do + Move(Pointer(NativeUint(fMinimap.Base) + I * fMinimap.MapX * 4)^, + Pointer(NativeUint(wData) + I * fWidthPOT * 4)^, fMinimap.MapX * 4); + + TKMRender.UpdateTexture(fMapTex.Tex, fWidthPOT, fHeightPOT, tfRGBA8, wData); + FreeMem(wData); + + UpdateSizes; +end; + + +function TKMMinimapView.LocalToMapCoords(X,Y: Integer): TKMPoint; +begin + Result.X := EnsureRange(Trunc((X - AbsLeft - fLeftOffset) * (fMinimap.MapX + 1) / fPaintWidth), 1, fMinimap.MapX); + Result.Y := EnsureRange(Trunc((Y - AbsTop - fTopOffset ) * (fMinimap.MapY + 1) / fPaintHeight), 1, fMinimap.MapY); +end; + + +function TKMMinimapView.MapCoordsToLocal(X,Y: Single; const Inset: ShortInt = 0): TKMPoint; +begin + Assert(Inset >= -1, 'Min allowed inset is -1, to be within TKMPoint range of 0..n'); + Result.X := AbsLeft + fLeftOffset + EnsureRange(Round(X * fPaintWidth / fMinimap.MapX), Inset, fPaintWidth - Inset); + Result.Y := AbsTop + fTopOffset + EnsureRange(Round(Y * fPaintHeight / fMinimap.MapY), Inset, fPaintHeight - Inset); +end; + + +procedure TKMMinimapView.SetAnchors(aValue: TKMAnchorsSet); +begin + inherited; + + if fBevel <> nil then + fBevel.Anchors := aValue; +end; + + +procedure TKMMinimapView.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + + MouseMove(X,Y,Shift); +end; + + +procedure TKMMinimapView.MouseMove(X,Y: Integer; Shift: TShiftState); +var + viewPos: TKMPoint; +begin + inherited; + + if (ssLeft in Shift) and not fClickableOnce then + begin + viewPos := LocalToMapCoords(X,Y); + if Assigned(fOnMinimapChange) then + fOnMinimapChange(Self, viewPos.X, viewPos.Y); + end; +end; + + +procedure TKMMinimapView.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + I: Integer; + T, viewPos: TKMPoint; +begin + inherited; + + if fClickableOnce then + begin + fClickableOnce := False; //Not clickable anymore + viewPos := LocalToMapCoords(X,Y); + if Assigned(fOnMinimapClick) then + fOnMinimapClick(Self, viewPos.X, viewPos.Y); + end; + + if fShowLocs then + for I := 0 to MAX_HANDS - 1 do + if fMinimap.HandShow[I] and not KMSamePoint(fMinimap.HandLocs[I], KMPOINT_ZERO) then + begin + T := MapCoordsToLocal(fMinimap.HandLocs[I].X, fMinimap.HandLocs[I].Y, fLocRad); + if Sqr(T.X - X) + Sqr(T.Y - Y) < Sqr(fLocRad) then + begin + if Assigned(OnMinimapLocationClick) then + OnMinimapLocationClick(Self, I); + + // Do not repeat events for overlapping locations + Break; + end; + end; +end; + + +procedure TKMMinimapView.Paint; +const + ALERT_RAD = 4; +var + I, K: Integer; + R: TKMRect; + S: TKMDirection4Set; + T, T1, T2: TKMPoint; + minimapGame: TKMMiniMapGame; + miniLeft, miniTop, miniRight, miniBottom: SmallInt; +begin + inherited; + + if (fMinimap = nil) or (fMinimap.MapX * fMinimap.MapY = 0) then + Exit; + + if (fMapTex.Tex <> 0) then + TKMRenderUI.WriteTexture(AbsLeft + fLeftOffset, AbsTop + fTopOffset, fPaintWidth, fPaintHeight, fMapTex, $FFFFFFFF) + else + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width, Height); + + //Alerts (under viewport rectangle) + if fMinimap is TKMMiniMapGame then + begin + minimapGame := TKMMiniMapGame(fMinimap); + + if (minimapGame.Alerts <> nil) then + for I := 0 to minimapGame.Alerts.Count - 1 do + if minimapGame.Alerts[I].VisibleMinimap then + begin + T := MapCoordsToLocal(minimapGame.Alerts[I].Loc.X, minimapGame.Alerts[I].Loc.Y, ALERT_RAD); + TKMRenderUI.WritePicture(T.X, T.Y, 0, 0, [], + minimapGame.Alerts[I].TexMinimap.RX, minimapGame.Alerts[I].TexMinimap.ID, + True, minimapGame.Alerts[I].TeamColor, Abs((TimeGet mod 1000) / 500 - 1)); + end; + + //Viewport rectangle + if fView <> nil then + begin + R := fView.GetMinimapClip; + if (R.Right - R.Left) * (R.Bottom - R.Top) > 0 then + begin + if gGameSettings.ZoomBehaviour = zbRestricted then + begin + TKMRenderUI.WriteOutline(AbsLeft + fLeftOffset + Round((R.Left - 1)*fPaintWidth / fMinimap.MapX), + AbsTop + fTopOffset + Round((R.Top - 1)*fPaintHeight / fMinimap.MapY), + Round((R.Right - R.Left)*fPaintWidth / fMinimap.MapX), + Round((R.Bottom - R.Top)*fPaintHeight / fMinimap.MapY), 1, $FFFFFFFF); + end + else + begin + miniLeft := AbsLeft + fLeftOffset + Round((R.Left - 1)*fPaintWidth / fMinimap.MapX) + 1; + miniTop := AbsTop + fTopOffset + Round((R.Top - 1)*fPaintHeight / fMinimap.MapY) + 1; + miniRight := AbsLeft + fLeftOffset + Round((R.Right - 1)*fPaintWidth / fMinimap.MapX); + miniBottom := AbsTop + fTopOffset + Round((R.Bottom - 1)*fPaintHeight / fMinimap.MapY); + + S := fView.GetMinimapClipLines; + if drW in S then + TKMRenderUI.WriteLine(miniLeft, miniBottom, miniLeft, miniTop, $FFFFFFFF); + if drN in S then + TKMRenderUI.WriteLine(miniLeft-1, miniTop, miniRight, miniTop, $FFFFFFFF); + if drE in S then + TKMRenderUI.WriteLine(miniRight, miniBottom, miniRight, miniTop, $FFFFFFFF); + if drS in S then + TKMRenderUI.WriteLine(miniLeft-1, miniBottom, miniRight, miniBottom, $FFFFFFFF); + end; + end; + end; + end; + + if fShowLocs then + begin + //Connect allied players + for I := 0 to MAX_HANDS - 1 do + if fMinimap.HandShow[I] and not KMSamePoint(fMinimap.HandLocs[I], KMPOINT_ZERO) then + for K := I + 1 to MAX_HANDS - 1 do + if fMinimap.HandShow[K] and not KMSamePoint(fMinimap.HandLocs[K], KMPOINT_ZERO) then + if (fMinimap.HandTeam[I] <> 0) and (fMinimap.HandTeam[I] = fMinimap.HandTeam[K]) then + begin + T1 := MapCoordsToLocal(fMinimap.HandLocs[I].X, fMinimap.HandLocs[I].Y, fLocRad); + T2 := MapCoordsToLocal(fMinimap.HandLocs[K].X, fMinimap.HandLocs[K].Y, fLocRad); + TKMRenderUI.WriteLine(T1.X, T1.Y, T2.X, T2.Y, $FFFFFFFF); + end; + + //Draw all the circles, THEN all the numbers so the numbers are not covered by circles when they are close + for I := 0 to MAX_HANDS - 1 do + if fMinimap.HandShow[I] and not KMSamePoint(fMinimap.HandLocs[I], KMPOINT_ZERO) then + begin + T := MapCoordsToLocal(fMinimap.HandLocs[I].X, fMinimap.HandLocs[I].Y, fLocRad); + TKMRenderUI.WriteCircle(T.X, T.Y, fLocRad, fMinimap.HandColors[I]); + end; + + for I := 0 to MAX_HANDS - 1 do + if fMinimap.HandShow[I] and not KMSamePoint(fMinimap.HandLocs[I], KMPOINT_ZERO) then + begin + T := MapCoordsToLocal(fMinimap.HandLocs[I].X, fMinimap.HandLocs[I].Y, fLocRad); + TKMRenderUI.WriteText(T.X, T.Y - 6, 0, IntToStr(I+1), fntOutline, taCenter); + end; + end; + + if not Enabled then + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, Width+1, Height+1, 0, 0.5); +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsPopUp.pas b/vendor/kam_remake/src/controls/KM_ControlsPopUp.pas new file mode 100644 index 0000000..f6e50f7 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsPopUp.pas @@ -0,0 +1,176 @@ +unit KM_ControlsPopUp; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsBase, KM_ControlsList, + KM_CommonTypes, KM_Points, + KM_ResFonts; + + +type + TKMPopUpMenuMode = ( + pmActOnMouseUp, // Action triggered only by mouse up (default) + pmActOnMouseDownNMove // Action triggered by mouse down and mouse move (drag) + ); + +type + // Popup with a short list (context menu) + // For bigger taks - use TKMForm! + TKMPopUpMenu = class(TKMPanel) + private + fMenuMode: TKMPopUpMenuMode; + procedure MenuHide(Sender: TObject); + procedure MenuActionTriggered(Sender: TObject); + procedure HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); + procedure SetItemIndex(aValue: Integer); + function GetItemIndex: Integer; + function GetItemTag(aIndex: Integer): Integer; + protected + Shape_Background: TKMShape; + ColumnBox_List: TKMColumnBox; + public + constructor Create(aParent: TKMPanel; aWidth: Integer; aMenuMode: TKMPopUpMenuMode = pmActOnMouseUp); + procedure AddItem(const aCaption: UnicodeString; aTag: Integer = 0); + procedure UpdateItem(aIndex: Integer; const aCaption: UnicodeString); + procedure Clear; + property ItemIndex: Integer read GetItemIndex write SetItemIndex; + property ItemTags[aIndex: Integer]: Integer read GetItemTag; + procedure ShowAt(X,Y: Integer); + procedure HideMenu; + + property MenuMode: TKMPopUpMenuMode read fMenuMode; + + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + end; + + +implementation +uses + Math, + KM_RenderUI; + + +{ TKMPopUpMenu } +constructor TKMPopUpMenu.Create(aParent: TKMPanel; aWidth: Integer; aMenuMode: TKMPopUpMenuMode = pmActOnMouseUp); +begin + inherited Create(aParent, 0, 0, aWidth, 0); + + fMenuMode := aMenuMode; + + // Note that Shape belongs to us, but we will manually position it to align with Parent to cover it + Shape_Background := TKMShape.Create(Self, 0, 0, aParent.Width, aParent.Height); + Shape_Background.OnClick := MenuHide; + + ColumnBox_List := TKMColumnBox.Create(Self, 0, 0, aWidth, 0, fntGrey, bsMenu); + ColumnBox_List.AnchorsStretch; + ColumnBox_List.BackAlpha := 0.8; + ColumnBox_List.Focusable := False; + ColumnBox_List.SetColumns(fntGrey, [''], [0]); + ColumnBox_List.ShowHeader := False; + + case fMenuMode of + pmActOnMouseUp: ColumnBox_List.OnClick := MenuActionTriggered; + pmActOnMouseDownNMove: ColumnBox_List.OnChange := MenuActionTriggered; + end; + + fMasterControl.SubscribeOnOtherMouseUp(HandleOtherControlMouseUp); + + Hide; +end; + + +procedure TKMPopUpMenu.Clear; +begin + ColumnBox_List.Clear; +end; + + +function TKMPopUpMenu.GetItemIndex: Integer; +begin + Result := ColumnBox_List.ItemIndex; +end; + + +function TKMPopUpMenu.GetItemTag(aIndex: Integer): Integer; +begin + Result := ColumnBox_List.Rows[aIndex].Tag; +end; + + +procedure TKMPopUpMenu.SetItemIndex(aValue: Integer); +begin + ColumnBox_List.ItemIndex := aValue; +end; + + +procedure TKMPopUpMenu.AddItem(const aCaption: UnicodeString; aTag: Integer = 0); +begin + ColumnBox_List.AddItem(MakeListRow([aCaption], aTag)); + + // Set own height (and anchored List will follow) + Height := ColumnBox_List.ItemHeight * ColumnBox_List.RowCount; +end; + + +procedure TKMPopUpMenu.UpdateItem(aIndex: Integer; const aCaption: UnicodeString); +begin + ColumnBox_List.Rows[aIndex].Cells[0].Caption := aCaption; +end; + + +procedure TKMPopUpMenu.MenuActionTriggered(Sender: TObject); +begin + if Assigned(OnClick) then + OnClick(Self); + + if fMenuMode = pmActOnMouseUp then + HideMenu; +end; + + +procedure TKMPopUpMenu.MenuHide(Sender: TObject); +begin + Hide; +end; + + +procedure TKMPopUpMenu.HideMenu; +begin + MenuHide(nil); +end; + + +procedure TKMPopUpMenu.ShowAt(X, Y: Integer); +begin + // Position self (and List will follow) + AbsLeft := X; + AbsTop := Y; + + // Actualize modal background position + Shape_Background.AbsLeft := Parent.AbsLeft; + Shape_Background.AbsTop := Parent.AbsTop; + + // Reset previously selected item + ColumnBox_List.ItemIndex := -1; + + Show; +end; + + +procedure TKMPopUpMenu.HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + MouseUp(X, Y, Shift, Button); +end; + + +procedure TKMPopUpMenu.MouseUp(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + + Hide; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsProgressBar.pas b/vendor/kam_remake/src/controls/KM_ControlsProgressBar.pas new file mode 100644 index 0000000..55ff2bb --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsProgressBar.pas @@ -0,0 +1,350 @@ +unit KM_ControlsProgressBar; +{$I KaM_Remake.inc} +interface +uses + Generics.Collections, + KromOGLUtils, + Classes, Controls, + KM_Controls, + KM_RenderUI, + KM_ResFonts, + KM_Points, + KM_CommonTypes; + + +type + // Abstract Progress bar + TKMProgressBarAbstract = class abstract(TKMControl) + private + fFont: TKMFont; + fTextAlign: TKMTextAlign; + protected + procedure PaintBar; virtual; abstract; + public + //CaptionLeft and CaptionRight are shown to the left and right from main Caption. Use them only with taCenter + Caption, CaptionLeft, CaptionRight: UnicodeString; + FontColor: TColor4; + TextYOffset: Integer; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); + procedure SetCaptions(const aCaptionLeft, aCaption, aCaptionRight: UnicodeString); + procedure Paint; override; + end; + + + {Percent bar} + TKMPercentBar = class(TKMProgressBarAbstract) + private + fPosition: Single; + fSeam: Single; + fMainColor: Cardinal; + fAddColor: Cardinal; + procedure SetPosition(aValue: Single); + procedure SetSeam(aValue: Single); + protected + procedure PaintBar; override; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); + property Seam: Single read fSeam write SetSeam; + property Position: Single read fPosition write SetPosition; + property MainColor: Cardinal read fMainColor write fMainColor; + property AddColor: Cardinal read fAddColor write fAddColor; + end; + + + TKMReplayBar = class(TKMPercentBar) + private + fIsDirty: Boolean; //True is Marks are not not sorted yet + fPosition: Integer; + fPeacetime: Integer; + fMaxValue: Integer; + fHighlightMark: Integer; + fMarks: TList; + fMarksPattern: Word; + fOnMarkClick: TIntegerEvent; + fHintResText: Word; + procedure TrySortMarks; + procedure SetPosition(aValue: Integer); + procedure SetPeacetime(aValue: Integer); + procedure SetMaxValue(aValue: Integer); + protected + procedure ControlMouseMove(Sender: TObject; X, Y: Integer; Shift: TShiftState); + procedure PaintBar; override; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); overload; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight, aPosition, aPeacetime, aMaxValue: Integer; aFont: TKMFont = fntMini); overload; + destructor Destroy; override; + + property Position: Integer read fPosition; + property Peacetime: Integer read fPeacetime; + property MaxValue: Integer read fMaxValue write SetMaxValue; + + procedure SetParameters(aPosition, aPeacetime, aMaxValue: Integer); + property MarksPattern: Word read fMarksPattern write fMarksPattern; + property HintResText: Word read fHintResText write fHintResText; +// property Marks: TList read GetMarks; + + procedure AddMark(aMark: Integer); + procedure Clear; + + property OnMarkClick: TIntegerEvent read fOnMarkClick write fOnMarkClick; + + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseUp (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + end; + + +implementation +uses + SysUtils, + Math, + KM_Resource, KM_ResTexts, + KM_Defaults, + KM_CommonUtils; + + +{ TKMProgressBarAbstract } +constructor TKMProgressBarAbstract.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + FontColor := $FFFFFFFF; + fTextAlign := taCenter; +end; + + +procedure TKMProgressBarAbstract.SetCaptions(const aCaptionLeft, aCaption, aCaptionRight: UnicodeString); +begin + CaptionLeft := aCaptionLeft; + Caption := aCaption; + CaptionRight := aCaptionRight; +end; + + +procedure TKMProgressBarAbstract.Paint; +var + captionSize: TKMPoint; +begin + inherited; + + PaintBar; + + //Now draw text over the bar, if it is required + if Caption <> '' then + begin + //Shadow + TKMRenderUI.WriteText(AbsLeft + 2, (AbsTop + Height div 2)+TextYOffset-4, + Width-4, Caption, fFont, fTextAlign, $FF000000); + //Text + TKMRenderUI.WriteText(AbsLeft + 1, (AbsTop + Height div 2)+TextYOffset-5, + Width-4, Caption, fFont, fTextAlign, FontColor); + end; + + if (CaptionLeft <> '') or (CaptionRight <> '') then + captionSize := gRes.Fonts[fFont].GetTextSize(Caption); + + if CaptionLeft <> '' then + begin + //Shadow + TKMRenderUI.WriteText(AbsLeft + 2, (AbsTop + Height div 2)+TextYOffset-4, + (Width-4 - captionSize.X) div 2, CaptionLeft, fFont, taRight, $FF000000); + //Text + TKMRenderUI.WriteText(AbsLeft + 1, (AbsTop + Height div 2)+TextYOffset-5, + (Width-4 - captionSize.X) div 2, CaptionLeft, fFont, taRight, FontColor); + end; + + if CaptionRight <> '' then + begin + //Shadow + TKMRenderUI.WriteText(AbsLeft + 2 + ((Width-4 + captionSize.X) div 2), (AbsTop + Height div 2)+TextYOffset-4, + (Width-4 - captionSize.X) div 2, CaptionRight, fFont, taLeft, $FF000000); + //Text + TKMRenderUI.WriteText(AbsLeft + 1 + ((Width-4 + captionSize.X) div 2), (AbsTop + Height div 2)+TextYOffset-5, + (Width-4 - captionSize.X) div 2, CaptionRight, fFont, taLeft, FontColor); + end; +end; + + +{ TKMPercentBar } +constructor TKMPercentBar.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); +begin + inherited; + + fMainColor := icBarColorGreen; + fAddColor := icBarColorBlue; +end; + + +procedure TKMPercentBar.SetPosition(aValue: Single); +begin + fPosition := EnsureRange(aValue, 0, 1); +end; + + +procedure TKMPercentBar.SetSeam(aValue: Single); +begin + fSeam := EnsureRange(aValue, 0, 1); +end; + + +procedure TKMPercentBar.PaintBar; +begin + TKMRenderUI.WritePercentBar(AbsLeft, AbsTop, Width, Height, fPosition, fSeam, fMainColor, fAddColor); +end; + + +{ TKMReplayBar } +constructor TKMReplayBar.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont = fntMini); +begin + Create(aParent, aLeft, aTop, aWidth, aHeight, 0, MaxInt, MaxInt, aFont); +end; + + +constructor TKMReplayBar.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight, aPosition, aPeacetime, aMaxValue: Integer; + aFont: TKMFont = fntMini); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight, aFont); + + SetParameters(aPosition, aPeacetime, aMaxValue); + fMarksPattern := $CF3; //Looks good for 25px height bar + + fHighlightMark := -1; + + fMarks := TList.Create; + + aParent.MasterControl.SubscribeOnOtherMouseMove(ControlMouseMove); +end; + + +destructor TKMReplayBar.Destroy; +begin + FreeAndNil(fMarks); + + inherited; +end; + + +procedure TKMReplayBar.SetParameters(aPosition, aPeacetime, aMaxValue: Integer); +begin + //Apply setters + MaxValue := aMaxValue; //Should be first, since we restrict Position and PT with MaxValue + SetPosition(aPosition); + SetPeacetime(aPeacetime); +end; + + +procedure TKMReplayBar.AddMark(aMark: Integer); +begin + if Self = nil then Exit; + + Assert(fMarks <> nil, 'Marks is not initilized'); + + fMarks.Add(aMark); + fIsDirty := True; +end; + + +procedure TKMReplayBar.SetPosition(aValue: Integer); +begin + fPosition := EnsureRange(aValue, 0, fMaxValue); +// Caption := IntToStr(fPosition); +end; + + +procedure TKMReplayBar.SetPeacetime(aValue: Integer); +begin + fPeacetime := EnsureRange(aValue, 0, MaxInt); +end; + + +procedure TKMReplayBar.SetMaxValue(aValue: Integer); +begin + fMaxValue := EnsureRange(aValue, 1, MaxInt); +end; + + +procedure TKMReplayBar.MouseMove(X,Y: Integer; Shift: TShiftState); +const + MAX_DIST_PERCENT = 0.02; +var + pos, bestDist, dist: Integer; + mark, bestMark: Integer; +begin + inherited; + pos := Round((X - AbsLeft) / Width * MaxValue); + + bestDist := MaxInt; + bestMark := -1; + + TrySortMarks; + for mark in fMarks do + begin + dist := Abs(pos - mark); + if dist < MAX_DIST_PERCENT*fMaxValue then + begin + if dist < bestDist then + begin + bestDist := dist; + bestMark := mark; + end else + Break; //List is sorted, we have found what we need + end; + end; + + fHighlightMark := bestMark; + + if fHighlightMark <> -1 then + begin + Hint := Format(gResTexts[fHintResText], [TickToTimeStr(fHighlightMark)]); +// Caption := IntToStr(fPosition) + ' (' + IntToStr(fHighlightMark) + ')'; + end + else + begin + Hint := ''; +// Caption := IntToStr(fPosition); + end; +end; + + +procedure TKMReplayBar.MouseUp(X: Integer; Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + + if (fHighlightMark <> -1) and Assigned(fOnMarkClick) then + fOnMarkClick(fHighlightMark); +end; + + +procedure TKMReplayBar.TrySortMarks; +begin + if fIsDirty then + begin + fIsDirty := False; + fMarks.Sort; + end; +end; + + +procedure TKMReplayBar.PaintBar; +begin + inherited; + TKMRenderUI.WriteReplayBar(AbsLeft, AbsTop, Width, Height, fPosition, fPeacetime, fMaxValue, fMarks, MarksPattern, fHighlightMark); +end; + + +procedure TKMReplayBar.Clear; +begin + fMarks.Clear; +end; + + +procedure TKMReplayBar.ControlMouseMove(Sender: TObject; X, Y: Integer; Shift: TShiftState); +begin + inherited; + if not InRange(X, AbsLeft, AbsRight) + or not InRange(Y, AbsTop, AbsBottom) then + fHighlightMark := -1; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsScroll.pas b/vendor/kam_remake/src/controls/KM_ControlsScroll.pas new file mode 100644 index 0000000..091c537 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsScroll.pas @@ -0,0 +1,823 @@ +unit KM_ControlsScroll; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsBase, + KM_RenderUI, + KM_Points; + + +type + TKMScrollAxis = (saVertical, saHorizontal); + TKMScrollStyle = (ssGame, ssCommon); + TKMScrollAxisSet = set of TKMScrollAxis; + + TKMScrollBar = class(TKMPanel) + private + fScrollAxis: TKMScrollAxis; + fStyle: TKMButtonStyle; + fMinValue: Integer; + fMaxValue: Integer; + fPosition: Integer; + fThumbPos: Integer; //Position of the thumb + fThumbSize: Word; //Length of the thumb + fOffset: Integer; + fScrollDec: TKMButton; + fScrollInc: TKMButton; + fOnChange: TNotifyEvent; + procedure SetMinValue(Value: Integer); + procedure SetMaxValue(Value: Integer); + procedure SetPosition(Value: Integer); + procedure IncPosition(Sender: TObject); + procedure DecPosition(Sender: TObject); + procedure UpdateThumbPos; + procedure UpdateThumbSize; + protected + procedure SetHeight(aValue: Integer); override; + procedure SetWidth(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + function DoHandleMouseWheelByDefault: Boolean; override; + public + BackAlpha: Single; //Alpha of background (usually 0.5, dropbox 1) + EdgeAlpha: Single; //Alpha of background outline (usually 1) + WheelStep: Word; + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aScrollAxis: TKMScrollAxis; + aStyle: TKMButtonStyle; aScrollStyle: TKMScrollStyle = ssGame); + property MinValue: Integer read fMinValue write SetMinValue; + property MaxValue: Integer read fMaxValue write SetMaxValue; + property Position: Integer read fPosition write SetPosition; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + procedure Paint; override; + end; + + + TKMScrollPanel = class(TKMPanel) + private + fChildsPanel: TKMPanel; + + fClipRect: TKMRect; + fScrollBarH: TKMScrollBar; + fScrollBarV: TKMScrollBar; + fScrollAxisSet: TKMScrollAxisSet; + + fPadding: TKMRect; + fScrollV_PadTop: Integer; + fScrollV_PadBottom: Integer; + fScrollV_PadLeft: Integer; + + procedure UpdateScrolls(Sender: TObject; aValue: Boolean); overload; + procedure UpdateScrolls(Sender: TObject); overload; + procedure UpdateScrollV; overload; + procedure UpdateScrollV(aChildsRect: TKMRect); overload; + procedure UpdateScrollV(Sender: TObject; const aValue: Integer); overload; + procedure UpdateScrollH; overload; + procedure UpdateScrollH(aChildsRect: TKMRect); overload; + procedure UpdateScrollH(Sender: TObject; const aValue: Integer); overload; + procedure ScrollChanged(Sender: TObject); + function GetChildsRect: TKMRect; + + function AllowScrollV: Boolean; + function AllowScrollH: Boolean; + procedure SetScrollVPadTop(const Value: Integer); + procedure SetScrollVPadBottom(const Value: Integer); + + procedure SetScrollVPadLeft(const Value: Integer); + protected + procedure SetVisible(aValue: Boolean); override; + procedure SetHitable(const aValue: Boolean); override; + + procedure SetLeft(aValue: Integer); override; + procedure SetTop(aValue: Integer); override; + procedure SetHeight(aValue: Integer); override; + procedure SetWidth(aValue: Integer); override; + + function GetDrawRect: TKMRect; override; + + function GetAbsDrawLeft: Integer; override; + function GetAbsDrawTop: Integer; override; + function GetAbsDrawRight: Integer; override; + function GetAbsDrawBottom: Integer; override; + + procedure UpdateVisibility; override; + public + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aScrollAxisSet: TKMScrollAxisSet; + aStyle: TKMButtonStyle; aScrollStyle: TKMScrollStyle); + + property ScrollH: TKMScrollBar read fScrollBarH; + property ScrollV: TKMScrollBar read fScrollBarV; + + function AddChild(aChild: TKMControl): Integer; override; + property ClipRect: TKMRect read fClipRect; + property Padding: TKMRect read fPadding write fPadding; + property ScrollV_PadTop: Integer read fScrollV_PadTop write SetScrollVPadTop; + property ScrollV_PadLeft: Integer read fScrollV_PadLeft write SetScrollVPadLeft; + property ScrollV_PadBottom: Integer read fScrollV_PadBottom write SetScrollVPadBottom; + + procedure Show; override; + + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + + procedure ClipY; + procedure UnClipY; + + procedure UpdateScrolls; overload; + + procedure Paint; override; + end; + + +implementation +uses + Math, + KM_ResTypes; + + +{ TKMScrollBar } +constructor TKMScrollBar.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aScrollAxis: TKMScrollAxis; + aStyle: TKMButtonStyle; aScrollStyle: TKMScrollStyle = ssGame); +var + decId, incId: Integer; +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + BackAlpha := 0.5; + EdgeAlpha := 0.75; + fScrollAxis := aScrollAxis; + fMinValue := 0; + fMaxValue := 10; + fPosition := 0; + fStyle := aStyle; + WheelStep := 1; + + if aScrollAxis = saVertical then + begin + fScrollDec := TKMButton.Create(Self, 0, 0, aWidth, aWidth, 591, rxGui, aStyle); + fScrollInc := TKMButton.Create(Self, 0, aHeight-aWidth, aWidth, aWidth, 590, rxGui, aStyle); + fScrollDec.Anchors := [anLeft, anTop, anRight]; + fScrollInc.Anchors := [anLeft, anRight, anBottom]; + end; + if aScrollAxis = saHorizontal then + begin + if aScrollStyle = ssGame then + begin + decId := 2; + incId := 3; + end else begin + decId := 674; + incId := 675; + end; + fScrollDec := TKMButton.Create(Self, 0, 0, aHeight, aHeight, decId, rxGui, aStyle); + fScrollInc := TKMButton.Create(Self, aWidth-aHeight, 0, aHeight, aHeight, incId, rxGui, aStyle); + fScrollDec.Anchors := [anLeft, anTop, anBottom]; + fScrollInc.Anchors := [anTop, anRight, anBottom]; + end; + fScrollDec.OnClick := DecPosition; + fScrollDec.OnMouseWheel := MouseWheel; + fScrollInc.OnClick := IncPosition; + fScrollInc.OnMouseWheel := MouseWheel; + UpdateThumbSize; +end; + + +procedure TKMScrollBar.SetHeight(aValue: Integer); +begin + inherited; + + //Update Thumb size + UpdateThumbSize; +end; + + +procedure TKMScrollBar.SetWidth(aValue: Integer); +begin + inherited; + + //Update Thumb size + UpdateThumbSize; +end; + + +procedure TKMScrollBar.SetEnabled(aValue: Boolean); +begin + inherited; + fScrollDec.Enabled := Enabled; + fScrollInc.Enabled := Enabled; +end; + + +procedure TKMScrollBar.SetMinValue(Value: Integer); +begin + fMinValue := Max(0, Value); + Enabled := (fMaxValue > fMinValue); + SetPosition(fPosition); +end; + + +procedure TKMScrollBar.SetMaxValue(Value: Integer); +begin + fMaxValue := Max(0, Value); + Enabled := (fMaxValue > fMinValue); + SetPosition(fPosition); +end; + + +procedure TKMScrollBar.SetPosition(Value: Integer); +begin + fPosition := EnsureRange(Value, fMinValue, fMaxValue); + UpdateThumbPos; +end; + + +procedure TKMScrollBar.IncPosition(Sender: TObject); +begin + SetPosition(fPosition + WheelStep); + + if Assigned(fOnChange) then + fOnChange(Self); +end; + + +procedure TKMScrollBar.DecPosition(Sender: TObject); +begin + SetPosition(fPosition - WheelStep); + + if Assigned(fOnChange) then + fOnChange(Self); +end; + + +procedure TKMScrollBar.UpdateThumbPos; +begin + fThumbPos := 0; + + if fMaxValue > fMinValue then + case fScrollAxis of + saVertical: fThumbPos := (fPosition-fMinValue)*(Height-Width*2-fThumbSize) div (fMaxValue-fMinValue); + saHorizontal: fThumbPos := (fPosition-fMinValue)*(Width-Height*2-fThumbSize) div (fMaxValue-fMinValue); + end + else + case fScrollAxis of + saVertical: fThumbPos := Math.max((Height-Width*2-fThumbSize),0) div 2; + saHorizontal: fThumbPos := Math.max((Width-Height*2-fThumbSize),0) div 2; + end; +end; + + +procedure TKMScrollBar.UpdateThumbSize; +begin + case fScrollAxis of + saVertical: fThumbSize := Math.max(0, (Height-2*Width)) div 4; + saHorizontal: fThumbSize := Math.max(0, (Width-2*Height)) div 4; + end; + + //If size has changed, then Pos needs to be updated as well (depends on it) + UpdateThumbPos; +end; + + +procedure TKMScrollBar.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + T: Integer; +begin + inherited; + + fOffset := 0; + case fScrollAxis of + saVertical: begin + T := Y - AbsTop - Width - fThumbPos; + if InRange(T, 0, fThumbSize) then + fOffset := T - fThumbSize div 2; + end; + saHorizontal: begin + T := X - AbsLeft - Height - fThumbPos; + if InRange(T, 0, fThumbSize) then + fOffset := T - fThumbSize div 2; + end; + end; + + MouseMove(X,Y,Shift); //Will change Position and call OnChange event +end; + + +procedure TKMScrollBar.MouseMove(X,Y: Integer; Shift: TShiftState); +var + newPos: Integer; + T: Integer; +begin + inherited; + if not (ssLeft in Shift) then Exit; + + newPos := fPosition; + + case fScrollAxis of + saVertical: + begin + T := Y - fOffset - AbsTop - Width; + if InRange(T, 0, Height - Width * 2) then + newPos := Round(fMinValue+((T - fThumbSize / 2) / (Height-Width*2-fThumbSize)) * (fMaxValue - fMinValue) ); + end; + + saHorizontal: + begin + T := X - fOffset - AbsLeft - Height; + if InRange(T, 0, Width - Height * 2) then + newPos := Round(fMinValue+((T - fThumbSize / 2) / (Width-Height*2-fThumbSize)) * (fMaxValue - fMinValue) ); + end; + end; + + if newPos <> fPosition then + begin + SetPosition(newPos); + if Assigned(fOnChange) then + fOnChange(Self); + end; +end; + + +function TKMScrollBar.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMScrollBar.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + inherited; + + if aHandled then Exit; + + aHandled := WheelSteps <> 0; + + if aHandled then + begin + Position := Position - WheelStep * WheelSteps; + + if Assigned(fOnChange) then + fOnChange(Self); + end; +end; + + +procedure TKMScrollBar.Paint; +var + buttonState: TKMButtonStateSet; +begin + inherited; + + case fScrollAxis of + saVertical: TKMRenderUI.WriteBevel(AbsLeft, AbsTop+Width, Width, Height - Width*2, EdgeAlpha, BackAlpha); + saHorizontal: TKMRenderUI.WriteBevel(AbsLeft+Height, AbsTop, Width - Height*2, Height, EdgeAlpha, BackAlpha); + end; + + if fMaxValue > fMinValue then + buttonState := [] + else + buttonState := [bsDisabled]; + + if not (bsDisabled in buttonState) then //Only show thumb when usable + case fScrollAxis of + saVertical: TKMRenderUI.Write3DButton(AbsLeft,AbsTop+Width+fThumbPos,Width,fThumbSize,rxGui,0,$FFFF00FF,buttonState,fStyle); + saHorizontal: TKMRenderUI.Write3DButton(AbsLeft+Height+fThumbPos,AbsTop,fThumbSize,Height,rxGui,0,$FFFF00FF,buttonState,fStyle); + end; +end; + + +{ TKMScrollPanel } +constructor TKMScrollPanel.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aScrollAxisSet: TKMScrollAxisSet; + aStyle: TKMButtonStyle; aScrollStyle: TKMScrollStyle); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + fPadding := KMRect(0, 0, 0, 0); + + fScrollAxisSet := aScrollAxisSet; + + fChildsPanel := TKMPanel.Create(Self, aLeft, aTop, aWidth, aHeight); + fChildsPanel.AnchorsStretch; + fChildsPanel.IsHitTestUseDrawRect := True; // We want DrawRect to be used on the ScrollPanel + + // We should create scroll bars on Parent panel, since we move panel there and back and scroll should not be scrolled as well + fScrollBarH := TKMScrollBar.Create(aParent, aLeft, aTop + aHeight - 20, aWidth, 20, saHorizontal, aStyle, aScrollStyle); + fScrollBarH.Hide; + fScrollBarH.OnChange := ScrollChanged; + fScrollBarH.WheelStep := 10; + + fScrollBarV := TKMScrollBar.Create(aParent, aLeft + aWidth - 20, aTop, 20, aHeight, saVertical, aStyle, aScrollStyle); + fScrollBarV.Hide; + fScrollBarV.OnChange := ScrollChanged; + fScrollBarV.WheelStep := 10; + + IsHitTestUseDrawRect := True; // We want DrawRect to be used on the ScrollPanel + + fScrollV_PadTop := 0; + fScrollV_PadBottom := 0; + + fClipRect := KMRect(Left, Top, Right, Bottom); +end; + + +function TKMScrollPanel.AddChild(aChild: TKMControl): Integer; +begin + aChild.IsHitTestUseDrawRect := True; + if fChildsPanel = nil then + Result := inherited AddChild(aChild) + else + begin + Result := fChildsPanel.AddChild(aChild); + + aChild.OnHeightChange := UpdateScrollV; + aChild.OnWidthChange := UpdateScrollH; + aChild.OnPositionSet := UpdateScrolls; + aChild.OnChangeVisibility := UpdateScrolls; + aChild.OnChangeEnableStatus := UpdateScrolls; + end; +end; + + +//Update View is usefull when use Padding Left or Top +//To show panel properly initially. Beeter to invoke from Show Element +procedure TKMScrollPanel.UpdateVisibility; +begin + inherited; + if Visible + and ((fPadding.Left > 0) or (fPadding.Top > 0)) then //Update visibility only when left/top padding > 0 + begin + if saHorizontal in fScrollAxisSet then + begin + fScrollBarH.Position := fPadding.Left; + ScrollChanged(fScrollBarH); + end; + + if saVertical in fScrollAxisSet then + begin + fScrollBarV.Position := fPadding.Top; + ScrollChanged(fScrollBarV); + end; + end; +end; + + +procedure TKMScrollPanel.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +begin + if (saVertical in fScrollAxisSet) and fScrollBarV.Visible then + fScrollBarV.MouseWheel(Sender, WheelSteps, aHandled) + else if (saHorizontal in fScrollAxisSet) and fScrollBarH.Visible then + fScrollBarH.MouseWheel(Sender, WheelSteps, aHandled) + else + inherited; +end; + + +procedure TKMScrollPanel.ScrollChanged(Sender: TObject); +var + oldValue: Integer; +begin + if Sender = fScrollBarH then + begin + oldValue := Left; + Left := fClipRect.Left - fScrollBarH.Position + fPadding.Left; + //To compensate changes in SetLeft + Inc(fClipRect.Left, oldValue - Left); + Inc(fClipRect.Right, oldValue - Left); + end else + if Sender = fScrollBarV then + begin + oldValue := Top; + Top := fClipRect.Top - fScrollBarV.Position + fPadding.Top; + //To compensate changes in SetTop + Inc(fClipRect.Top, oldValue - Top); + Inc(fClipRect.Bottom, oldValue - Top); + end; +end; + + +procedure TKMScrollPanel.UpdateScrolls(Sender: TObject; aValue: Boolean); +begin + // No need to update scrolls if panel is not visible + // In case we've just hide panel then DrawRect is RECT_ZERO and scrools will be set to 0 position + if not Visible then Exit; + + if (Sender <> fScrollBarH) and (Sender <> fScrollBarV) then + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.UpdateScrollH(Sender: TObject; const aValue: Integer); +begin + if (Sender <> fScrollBarH) then + UpdateScrollH; +end; + + +procedure TKMScrollPanel.UpdateScrollH; +begin + if not (saHorizontal in fScrollAxisSet) then Exit; + + UpdateScrollH(GetChildsRect); +end; + + +procedure TKMScrollPanel.UpdateScrollH(aChildsRect: TKMRect); +var + newPos: Integer; + showScroll: Boolean; +begin + if not (saHorizontal in fScrollAxisSet) then Exit; + + showScroll := False; + + if aChildsRect.Width + fPadding.Left + fPadding.Right > fClipRect.Width then + begin + fScrollBarH.MaxValue := aChildsRect.Width - fClipRect.Width + fPadding.Left + fPadding.Right; + newPos := fClipRect.Left - Left; + + if newPos > fScrollBarH.MaxValue then + SetLeftSilently(Left + newPos - fScrollBarH.MaxValue); //Slightly move panel to the top, when resize near maxvalue position + showScroll := True; + end else begin + fScrollBarH.Position := 0; + if Left <> fClipRect.Left then + SetLeftSilently(fClipRect.Left); //Set directrly to avoid SetLeft call + end; + + fScrollBarH.Width := Width; + if showScroll <> fScrollBarH.Visible then + begin + fScrollBarH.Visible := showScroll; + fChildsPanel.Height := Height - 20*Byte(showScroll); + end; +end; + + +procedure TKMScrollPanel.UpdateScrollV(Sender: TObject; const aValue: Integer); +begin + if (Sender <> fScrollBarV) then + UpdateScrollV; +end; + + +procedure TKMScrollPanel.UpdateScrollV; +begin + if not (saVertical in fScrollAxisSet) then Exit; + + UpdateScrollV(GetChildsRect); +end; + + +procedure TKMScrollPanel.UpdateScrollV(aChildsRect: TKMRect); +var + newPos: Integer; + showScroll: Boolean; +begin + if not (saVertical in fScrollAxisSet) then Exit; + + //Do not set Visible, avoid trigger OnChangeVisibility + showScroll := False; + + if aChildsRect.Height + fPadding.Top + fPadding.Bottom > fClipRect.Height then + begin + fScrollBarV.MaxValue := aChildsRect.Height - fClipRect.Height + fPadding.Top + fPadding.Bottom; + newPos := fClipRect.Top - Top; + + if newPos > fScrollBarV.MaxValue then + SetTopSilently(Top + newPos - fScrollBarV.MaxValue); //Slightly move panel to the top, when resize near maxvalue position + showScroll := True; + end else begin + fScrollBarV.Position := 0; + if Top <> fClipRect.Top then + SetTopSilently(fClipRect.Top); //Set directrly to avoid SetTop call + end; + + fScrollBarV.Height := Height - fScrollV_PadTop - fScrollV_PadBottom; + if showScroll <> fScrollBarV.Visible then + begin + fScrollBarV.Visible := showScroll; + fChildsPanel.Width := Width - 20*Byte(showScroll); + end; +end; + + +procedure TKMScrollPanel.UpdateScrolls; +begin + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.UpdateScrolls(Sender: TObject); +var + childsRect: TKMRect; +begin + childsRect := GetChildsRect; + + UpdateScrollV(childsRect); + UpdateScrollH(childsRect); +end; + + +procedure TKMScrollPanel.SetLeft(aValue: Integer); +var + oldValue: Integer; +begin + oldValue := Left; + inherited; + + Inc(fClipRect.Left, Left - oldValue); + Inc(fClipRect.Right, Left - oldValue); + + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.SetScrollVPadBottom(const Value: Integer); +begin + fScrollV_PadBottom := Value; + fScrollBarV.Height := fScrollBarV.Height - Value; +end; + + +procedure TKMScrollPanel.SetScrollVPadLeft(const Value: Integer); +begin + fScrollV_PadLeft := Value; +end; + + +procedure TKMScrollPanel.SetScrollVPadTop(const Value: Integer); +begin + fScrollV_PadTop := Value; + fScrollBarV.Top := fScrollBarV.Top + Value; + fScrollBarV.Height := fScrollBarV.Height - Value; +end; + + +procedure TKMScrollPanel.SetTop(aValue: Integer); +var + oldValue: Integer; +begin + oldValue := Top; + inherited; + + Inc(fClipRect.Top, Top - oldValue); + Inc(fClipRect.Bottom, Top - oldValue); + + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.SetVisible(aValue: Boolean); +begin + inherited; + + // Hide ScrollBars with if we hide ScrollPanel + if not aValue then + begin + fScrollBarH.Visible := aValue; + fScrollBarV.Visible := aValue; + end; +end; + + +procedure TKMScrollPanel.SetWidth(aValue: Integer); +var + oldValue: Integer; +begin + oldValue := Width; + inherited; + + Inc(fClipRect.Right, Width - oldValue); + + fScrollBarV.Left := fClipRect.Left + Width + fScrollV_PadLeft; + + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.Show; +begin + inherited; + + // We can use Visible here, since Self is he parent of ChildsPanel + fChildsPanel.Visible := True; +end; + + +procedure TKMScrollPanel.SetHeight(aValue: Integer); +var + oldValue: Integer; +begin + oldValue := Height; + inherited; + + Inc(fClipRect.Bottom, Height - oldValue); + + fScrollBarH.Top := fClipRect.Top + Height; + + UpdateScrolls(nil); +end; + + +procedure TKMScrollPanel.SetHitable(const aValue: Boolean); +begin + inherited; + + fChildsPanel.Hitable := aValue; +end; + + +function TKMScrollPanel.GetChildsRect: TKMRect; +var + I: Integer; +begin + Result := KMRECT_ZERO; //Zero rect, by default + + for I := 0 to fChildsPanel.ChildCount - 1 do + begin + if not fChildsPanel.Childs[I].IsPainted then + Continue; + + if fChildsPanel.Childs[I].Left < Result.Left then + Result.Left := fChildsPanel.Childs[I].Left; + + if fChildsPanel.Childs[I].Top < Result.Top then + Result.Top := fChildsPanel.Childs[I].Top; + + if fChildsPanel.Childs[I].Right > Result.Right then + Result.Right := fChildsPanel.Childs[I].Right; + + if fChildsPanel.Childs[I].Bottom > Result.Bottom then + Result.Bottom := fChildsPanel.Childs[I].Bottom; + end; +end; + + +function TKMScrollPanel.AllowScrollV: Boolean; +begin + Result := saVertical in fScrollAxisSet; +end; + + +function TKMScrollPanel.AllowScrollH: Boolean; +begin + Result := saHorizontal in fScrollAxisSet; +end; + + +function TKMScrollPanel.GetDrawRect: TKMRect; +begin + Result := KMRect(AbsDrawLeft, AbsDrawTop, AbsDrawRight, AbsDrawBottom); +end; + + +function TKMScrollPanel.GetAbsDrawLeft: Integer; +begin + Result := Parent.AbsLeft + fClipRect.Left; +end; + + +function TKMScrollPanel.GetAbsDrawTop: Integer; +begin + Result := Parent.AbsTop + fClipRect.Top; +end; + + +function TKMScrollPanel.GetAbsDrawRight: Integer; +begin + Result := Parent.AbsLeft + fClipRect.Right + 20*Byte(AllowScrollV and not fScrollBarV.Visible); +end; + + +function TKMScrollPanel.GetAbsDrawBottom: Integer; +begin + Result := Parent.AbsTop + fClipRect.Bottom + 20*Byte(AllowScrollH and not fScrollBarH.Visible); +end; + + +procedure TKMScrollPanel.Paint; +begin + TKMRenderUI.SetupClipX(AbsDrawLeft, AbsDrawRight); + TKMRenderUI.SetupClipY(AbsDrawTop, AbsDrawBottom); + + inherited; + + TKMRenderUI.ReleaseClipY; + TKMRenderUI.ReleaseClipX; +end; + + +procedure TKMScrollPanel.ClipY; +begin + TKMRenderUI.SetupClipY(AbsDrawTop, AbsDrawBottom); +end; + + +procedure TKMScrollPanel.UnClipY; +begin + TKMRenderUI.ReleaseClipY; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsSwitch.pas b/vendor/kam_remake/src/controls/KM_ControlsSwitch.pas new file mode 100644 index 0000000..778e751 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsSwitch.pas @@ -0,0 +1,455 @@ +unit KM_ControlsSwitch; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KromOGLUtils, + KM_Controls, + KM_ResFonts; + + +type + TKMCheckBoxState = (cbsUnchecked, cbsSemiChecked, cbsChecked); + + { Checkbox } + TKMCheckBox = class(TKMControl) + private + fCaption: UnicodeString; + fState: TKMCheckBoxState; + fHasSemiState: Boolean; + fFont: TKMFont; + + function GetCheckedBool: Boolean; + public + DrawOutline: Boolean; + LineColor: TColor4; //color of outline + LineWidth: Byte; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aFont: TKMFont; aHasSemiState: Boolean = False); overload; + property Caption: UnicodeString read fCaption write fCaption; + procedure SetChecked(aChecked: Boolean); + property Checked: Boolean read GetCheckedBool write SetChecked; + property CheckState: TKMCheckBoxState read fState write fState; + function IsSemiChecked: Boolean; + procedure Check; + procedure Uncheck; + procedure SemiCheck; + procedure SwitchCheck(aForward: Boolean = True); + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure Paint; override; + end; + + + TKMRadioGroupItem = record + Text: UnicodeString; + Hint: UnicodeString; + Enabled: Boolean; + Visible: Boolean; + end; + + + { TKMRadioGroup } + TKMRadioGroup = class(TKMControl) + private + fItemIndex: Integer; + fCount: Integer; + fItems: array of TKMRadioGroupItem; + fFont: TKMFont; + fMouseOverItem: SmallInt; + fOnChange: TNotifyEvent; + procedure UpdateMouseOverPositions(X,Y: Integer); + function GetItem(aIndex: Integer): TKMRadioGroupItem; + function GetItemIndexByRow(aRowIndex: Integer): Integer; + function GetVisibleCount: Integer; + function GetLineHeight: Single; + function GetIsSelected: Boolean; + protected + function GetHint: UnicodeString; override; + public + AllowUncheck: Boolean; //Do we allow to uncheck selected element ? Usually not, but its possible + DrawChkboxOutline: Boolean; + LineColor: TColor4; //color of outline + LineWidth: Byte; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont); + + procedure Add(const aText: String; aEnabled: Boolean = True); overload; + procedure Add(const aText: String; aEnabled, aVisible: Boolean); overload; + procedure Add(const aText, aHint: String; aEnabled: Boolean = True; aVisible: Boolean = True); overload; + procedure Clear; + property Count: Integer read fCount; + property IsSelected: Boolean read GetIsSelected; + property VisibleCount: Integer read GetVisibleCount; + property ItemIndex: Integer read fItemIndex write fItemIndex; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + property Item[aIndex: Integer]: TKMRadioGroupItem read GetItem; + procedure SetItemEnabled(aIndex: Integer; aEnabled: Boolean; aUncheckDisabled: Boolean = True); + procedure SetItemVisible(aIndex: Integer; aEnabled: Boolean); + procedure CheckFirstCheckable; + property LineHeight: Single read GetLineHeight; + procedure MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure Paint; override; + end; + + +implementation +uses + SysUtils, Math, + KM_RenderUI, + KM_Resource, + KM_Defaults; + + +{ TKMCheckBox } +constructor TKMCheckBox.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; const aCaption: UnicodeString; + aFont: TKMFont; aHasSemiState: Boolean = False); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + fCaption := aCaption; + fHasSemiState := aHasSemiState; + LineWidth := 1; + LineColor := clChkboxOutline; +end; + + +procedure TKMCheckBox.SetChecked(aChecked: Boolean); +begin + if aChecked then + fState := cbsChecked + else + fState := cbsUnchecked; +end; + + +function TKMCheckBox.GetCheckedBool: Boolean; +begin + Result := fState = cbsChecked; +end; + + +function TKMCheckBox.IsSemiChecked: Boolean; +begin + Result := fState = cbsSemiChecked; +end; + + +procedure TKMCheckBox.Check; +begin + fState := cbsChecked; +end; + + +procedure TKMCheckBox.SemiCheck; +begin + fState := cbsSemiChecked; +end; + + +procedure TKMCheckBox.Uncheck; +begin + fState := cbsUnchecked; +end; + + +procedure TKMCheckBox.SwitchCheck(aForward: Boolean = True); +begin + if fHasSemiState then + fState := TKMCheckBoxState((Byte(fState) + 3 + 2*Byte(aForward) - 1) mod 3) + else + begin + if Checked then + Uncheck + else + Check; + end; +end; + + +procedure TKMCheckBox.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + if (csDown in State) and (Button = mbLeft) then + case fState of + cbsSemiChecked, + cbsUnchecked: Check; //Let's assume we prefer check for now + cbsChecked: Uncheck; + end; + inherited; //There are OnMouseUp and OnClick events there +end; + + +//We can replace it with something better later on. For now [x] fits just fine +//Might need additional graphics to be added to gui.rx +//Some kind of box with an outline, darkened background and shadow maybe, similar to other controls. +procedure TKMCheckBox.Paint; +var + col, semiCol: TColor4; + checkSize: Integer; +begin + inherited; + + if Enabled then + begin + col := icWhite; + semiCol := $FFCCCCCC; + end + else + begin + col := icGray2; + semiCol := $FF888888; + end; + + checkSize := gRes.Fonts[fFont].GetTextSize('x').Y + 1; + + + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop, checkSize - 4, checkSize-4, 1, Byte(not IsSemiChecked and Enabled)*0.35); + + if DrawOutline then + TKMRenderUI.WriteOutline(AbsLeft, AbsTop, checkSize - 4, checkSize - 4, LineWidth, LineColor); + + case fState of + cbsChecked: TKMRenderUI.WriteText(AbsLeft + (checkSize-4) div 2, AbsTop - 1, 0, 'x', fFont, taCenter, col); + cbsSemiChecked: TKMRenderUI.WriteText(AbsLeft + (checkSize-4) div 2, AbsTop - 1, 0, 'x', fFont, taCenter, semiCol); + cbsUnchecked: ; //Do not draw anything + end; + + + TKMRenderUI.WriteText(AbsLeft + checkSize, AbsTop, Width - checkSize, fCaption, fFont, taLeft, col); +end; + + +{ TKMRadioGroup } +constructor TKMRadioGroup.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aFont: TKMFont); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + fFont := aFont; + fItemIndex := -1; + LineWidth := 1; + LineColor := clChkboxOutline; + AllowUncheck := False; +end; + + +procedure TKMRadioGroup.Add(const aText: String; aEnabled: Boolean); +begin + Add(aText, '', aEnabled); +end; + + +procedure TKMRadioGroup.Add(const aText: String; aEnabled, aVisible: Boolean); +begin + Add(aText, '', aEnabled, aVisible); +end; + + +procedure TKMRadioGroup.Add(const aText, aHint: String; aEnabled: Boolean = True; aVisible: Boolean = True); +begin + if fCount >= Length(fItems) then + SetLength(fItems, fCount + 8); + + fItems[fCount].Text := aText; + fItems[fCount].Hint := aHint; + fItems[fCount].Enabled := aEnabled; + fItems[fCount].Visible := aVisible; + + Inc(fCount); +end; + + +procedure TKMRadioGroup.Clear; +begin + fCount := 0; +end; + + +procedure TKMRadioGroup.MouseUp(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +var + changed: Boolean; +begin + if (csDown in State) and (Button = mbLeft) then + begin + UpdateMouseOverPositions(X,Y); + if (fMouseOverItem <> -1) and fItems[fMouseOverItem].Enabled then + begin + changed := False; + if (fMouseOverItem = fItemIndex) then + begin + if AllowUncheck then + begin + fItemIndex := -1; //Uncheck + changed := True; + end; + end else begin + fItemIndex := fMouseOverItem; + changed := True; + end; + + if changed and Assigned(fOnChange) then + begin + fOnChange(Self); + Exit; //Don't generate OnClick after OnChanged event (esp. when reloading Game on local change) + end; + end; + end; + + inherited; //There are OnMouseUp and OnClick events there +end; + + +procedure TKMRadioGroup.MouseMove(X,Y: Integer; Shift: TShiftState); +begin + inherited; + UpdateMouseOverPositions(X,Y); +end; + + +procedure TKMRadioGroup.UpdateMouseOverPositions(X,Y: Integer); +var + mouseOverRow, itemIndex: Integer; +begin + fMouseOverItem := -1; + + if InRange(Y, AbsTop, AbsTop + Height) and (LineHeight > 0) then + begin + mouseOverRow := EnsureRange((Y - AbsTop) div Round(LineHeight), 0, VisibleCount - 1); + itemIndex := GetItemIndexByRow(mouseOverRow); + if (itemIndex <> -1) and InRange(X, AbsLeft, AbsLeft + LineHeight + gRes.Fonts[fFont].GetTextSize(fItems[itemIndex].Text).X) then + fMouseOverItem := itemIndex; + end; +end; + + +function TKMRadioGroup.GetItem(aIndex: Integer): TKMRadioGroupItem; +begin + Assert(aIndex < fCount, 'Can''t get radio group item for index ' + IntToStr(aIndex)); + Result := fItems[aIndex]; +end; + + +function TKMRadioGroup.GetItemIndexByRow(aRowIndex: Integer): Integer; +var + I, K: Integer; +begin + Assert(aRowIndex < VisibleCount, 'GetItemByRow: aRowIndex >= VisibleCount'); + K := 0; + Result := -1; + for I := 0 to fCount - 1 do + begin + if not fItems[I].Visible then Continue; + if aRowIndex = K then + begin + Result := I; + Exit; + end; + Inc(K); + end; +end; + + +function TKMRadioGroup.GetVisibleCount: Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to fCount - 1 do + if fItems[I].Visible then + Inc(Result); +end; + + +function TKMRadioGroup.GetLineHeight: Single; +begin + Result := IfThen(VisibleCount > 0, Height / VisibleCount, Height); +end; + + +function TKMRadioGroup.GetIsSelected: Boolean; +begin + Result := fItemIndex <> -1; +end; + + +procedure TKMRadioGroup.SetItemEnabled(aIndex: Integer; aEnabled: Boolean; aUncheckDisabled: Boolean = True); +begin + Assert(aIndex < fCount, 'Can''t SetItemEnabled for index ' + IntToStr(aIndex)); + fItems[aIndex].Enabled := aEnabled; + + // Reset item index, if this item was selected + if aUncheckDisabled and not aEnabled and (fItemIndex = aIndex) then + fItemIndex := -1; +end; + + +procedure TKMRadioGroup.SetItemVisible(aIndex: Integer; aEnabled: Boolean); +begin + Assert(aIndex < fCount, 'Can''t SetItemVisible for index ' + IntToStr(aIndex)); + fItems[aIndex].Visible := aEnabled; +end; + + +procedure TKMRadioGroup.CheckFirstCheckable; +var + I: Integer; +begin + if fItemIndex <> -1 then Exit; + + for I := 0 to fCount - 1 do + if fItems[I].Enabled and fItems[I].Visible then + begin + fItemIndex := I; + Exit; + end; +end; + + +function TKMRadioGroup.GetHint: UnicodeString; +begin + Result := inherited GetHint; + if Result = '' then + begin + if fMouseOverItem <> -1 then + Result := fItems[fMouseOverItem].Hint; + end; +end; + + +//We can replace it with something better later on. For now [x] fits just fine +//Might need additional graphics to be added to gui.rx +//Some kind of box with an outline, darkened background and shadow maybe, similar to other controls. +procedure TKMRadioGroup.Paint; +const + FONT_COL: array [Boolean] of TColor4 = ($FF888888, $FFFFFFFF); +var + CheckSize: Integer; + I, VisibleI: Integer; +begin + inherited; + if (Count = 0) or (VisibleCount = 0) then Exit; //Avoid dividing by zero + + CheckSize := gRes.Fonts[fFont].GetTextSize('x').Y + 1; + + VisibleI := 0; + for I := 0 to Count - 1 do + begin + if not fItems[I].Visible then + Continue; + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop + Round(VisibleI * LineHeight), CheckSize-4, CheckSize-4, 1, 0.3); + if DrawChkboxOutline then + TKMRenderUI.WriteOutline(AbsLeft, AbsTop + Round(VisibleI * LineHeight), CheckSize-4, CheckSize-4, LineWidth, LineColor); + + if fItemIndex = I then + TKMRenderUI.WriteText(AbsLeft + (CheckSize - 4) div 2, AbsTop + Round(VisibleI * LineHeight) - 1, 0, + 'x', fFont, taCenter, FONT_COL[Enabled and fItems[I].Enabled]); + + // Caption + TKMRenderUI.WriteText(AbsLeft + CheckSize, AbsTop + Round(VisibleI * LineHeight), Width - Round(LineHeight), + fItems[I].Text, fFont, taLeft, FONT_COL[Enabled and fItems[I].Enabled]); + Inc(VisibleI); + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsTrackBar.pas b/vendor/kam_remake/src/controls/KM_ControlsTrackBar.pas new file mode 100644 index 0000000..6e5a741 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsTrackBar.pas @@ -0,0 +1,266 @@ +unit KM_ControlsTrackBar; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, + KM_ResFonts, + KM_Points; + +type + TKMTrackBar = class(TKMControl) + private + fTrackTop: Byte; //Offset trackbar from top (if Caption <> '') + fTrackHeight: Byte; //Trackbar height + fMinValue: Word; + fMaxValue: Word; + fOnChange: TNotifyEvent; + fCaption: UnicodeString; + fPosition: Word; + fFont: TKMFont; + fRange: TKMRangeInt; + fThumbText: UnicodeString; + fAutoThumbWidth: Boolean; + fFixedThumbWidth: Boolean; + procedure SetCaption(const aValue: UnicodeString); + procedure SetPosition(aValue: Word); + procedure SetRange(const aRange: TKMRangeInt); + procedure UpdateThumbWidth; + procedure SetThumbText(const Value: UnicodeString); + procedure SetAutoThumbWidth(const aValue: Boolean); + protected + function DoHandleMouseWheelByDefault: Boolean; override; + public + Step: Byte; //Change Position by this amount each time + ThumbWidth: Word; + CaptionWidth: Integer; + SliderFont: TKMFont; + + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aMin, aMax: Word); + + property Caption: UnicodeString read fCaption write SetCaption; + property Position: Word read fPosition write SetPosition; + property Range: TKMRangeInt read fRange write SetRange; + property Font: TKMFont read fFont write fFont; + property MinValue: Word read fMinValue; + property MaxValue: Word read fMaxValue; + property ThumbText: UnicodeString read fThumbText write SetThumbText; + property AutoThumbWidth: Boolean read fAutoThumbWidth write SetAutoThumbWidth; + property FixedThumbWidth: Boolean read fAutoThumbWidth write fFixedThumbWidth; + procedure ResetRange; + property OnChange: TNotifyEvent read fOnChange write fOnChange; + procedure MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; + procedure MouseMove(X,Y: Integer; Shift: TShiftState); override; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + procedure Paint; override; + const + THUMB_WIDTH_ADD = 24; + end; + + +implementation +uses + SysUtils, Math, + KromUtils, KromOGLUtils, + KM_RenderUI, + KM_Resource, KM_ResTypes; + + +{ TKMTrackBar } +constructor TKMTrackBar.Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aMin, aMax: Word); +begin + inherited Create(aParent, aLeft,aTop,aWidth,0); + Assert(aMax > aMin, 'TKMTrackBar''s minValue >= maxValue'); + fMinValue := aMin; + fMaxValue := aMax; + fTrackHeight := 20; + fRange := KMRange(aMin, aMax); //set Range before position + Position := (fMinValue + fMaxValue) div 2; + Caption := ''; + Font := fntMetal; + SliderFont := fntMetal; + CaptionWidth := -1; + + Step := 1; + fAutoThumbWidth := False; + fFixedThumbWidth := False; + + UpdateThumbWidth; +end; + + +procedure TKMTrackBar.UpdateThumbWidth; +begin + if fFixedThumbWidth then Exit; + + if AutoThumbWidth then + ThumbWidth := Max(gRes.Fonts[SliderFont].GetTextSize(IntToStr(MaxValue)).X, + gRes.Fonts[SliderFont].GetTextSize(ThumbText).X) + else + ThumbWidth := gRes.Fonts[SliderFont].GetTextSize(IntToStr(MaxValue)).X; + + ThumbWidth := ThumbWidth + THUMB_WIDTH_ADD; +end; + + +procedure TKMTrackBar.SetAutoThumbWidth(const aValue: Boolean); +begin + fAutoThumbWidth := aValue; + UpdateThumbWidth; +end; + + +procedure TKMTrackBar.SetCaption(const aValue: UnicodeString); +begin + fCaption := aValue; + + if Trim(fCaption) <> '' then + begin + SetHeightSilently(20 + fTrackHeight); + fTrackTop := 20; + end + else + begin + SetHeightSilently(fTrackHeight); + fTrackTop := 0; + end; +end; + + +procedure TKMTrackBar.SetPosition(aValue: Word); +begin + fPosition := KMEnsureRange(aValue, Range); + ThumbText := IntToStr(fPosition); +end; + + +procedure TKMTrackBar.SetRange(const aRange: TKMRangeInt); +begin + fRange.Min := EnsureRange(aRange.Min, MinValue, MaxValue); + fRange.Max := EnsureRange(aRange.Max, MinValue, MaxValue); + Position := fPosition; //Update position due to range change +end; + + +procedure TKMTrackBar.SetThumbText(const Value: UnicodeString); +begin + fThumbText := Value; + UpdateThumbWidth; +end; + + +procedure TKMTrackBar.ResetRange; +begin + fRange.Min := MinValue; + fRange.Max := MaxValue; +end; + + +procedure TKMTrackBar.MouseDown(X,Y: Integer; Shift: TShiftState; Button: TMouseButton); +begin + inherited; + MouseMove(X, Y, Shift); +end; + + +procedure TKMTrackBar.MouseMove(X,Y: Integer; Shift: TShiftState); +var + newPos: Integer; + posX, stepX: Single; +begin + inherited; + + newPos := Position; + if (ssLeft in Shift) + and InRange(Y - AbsTop - fTrackTop, 0, fTrackHeight) then + begin + posX := 0; + if AutoThumbWidth then + begin + stepX := (Width - ThumbWidth) / (fMaxValue - fMinValue) / Step; // width between marks + posX := stepX * (Position / Step) + (ThumbWidth div 2); // actual marks positions on track + end; + if not AutoThumbWidth + or not InRange(X - AbsLeft, posX - ThumbWidth div 2, posX + ThumbWidth div 2) then // do not update pos, if we hover over thumb + newPos := EnsureRange(fMinValue + Round(((X-AbsLeft-ThumbWidth div 2) / (Width - ThumbWidth - 4))*(fMaxValue - fMinValue)/Step)*Step, fMinValue, fMaxValue); + end; + + if newPos <> Position then + begin + Position := newPos; + + if Assigned(fOnChange) then + fOnChange(Self); + end; +end; + + +function TKMTrackBar.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMTrackBar.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +var + newPos: Integer; +begin + inherited; + + if aHandled or (WheelSteps = 0) then Exit; + + aHandled := WheelSteps <> 0; + + Focus; + + newPos := Position; + + if WheelSteps <> 0 then + newPos := EnsureRange(newPos - Step*fMouseWheelStep*WheelSteps, fMinValue, fMaxValue); + + if newPos <> Position then + begin + Position := newPos; + + if Assigned(fOnChange) then + fOnChange(Self); + end; +end; + + +procedure TKMTrackBar.Paint; +const + TEXT_COLOR: array [Boolean] of TColor4 = ($FF888888, $FFFFFFFF); +var + thumbPos, thumbHeight, rangeMinPos, rangeMaxPos: Word; + capWidth: Integer; +begin + inherited; + + if fCaption <> '' then + begin + if CaptionWidth = -1 then + capWidth := Width + else + capWidth := CaptionWidth; + + TKMRenderUI.WriteText(AbsLeft, AbsTop, capWidth, fCaption, fFont, taLeft, TEXT_COLOR[Enabled]); + end; + + rangeMinPos := Round(Width*(fRange.Min-fMinValue) / (fMaxValue - fMinValue)); + rangeMaxPos := Round(Width*(fRange.Max-fMinValue) / (fMaxValue - fMinValue)); + + TKMRenderUI.WriteBevel(AbsLeft, AbsTop+fTrackTop+1, rangeMinPos, fTrackHeight-2, 0, 0.3); + TKMRenderUI.WriteBevel(AbsLeft + rangeMinPos, AbsTop+fTrackTop+2, rangeMaxPos - rangeMinPos, fTrackHeight-4); + TKMRenderUI.WriteBevel(AbsLeft + rangeMaxPos, AbsTop+fTrackTop+1, Width - rangeMaxPos, fTrackHeight-2, 0, 0.3); + + thumbPos := Round(Mix (0, Width - ThumbWidth, 1-(Position-fMinValue) / (fMaxValue - fMinValue))); + thumbHeight := gRes.Sprites[rxGui].RXData.Size[132].Y; + + TKMRenderUI.WritePicture(AbsLeft + thumbPos, AbsTop+fTrackTop, ThumbWidth, thumbHeight, [anLeft,anRight], rxGui, 132); + TKMRenderUI.WriteText(AbsLeft + thumbPos + ThumbWidth div 2, AbsTop+fTrackTop+3, 0, ThumbText, SliderFont, taCenter, TEXT_COLOR[Enabled]); +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsTypes.pas b/vendor/kam_remake/src/controls/KM_ControlsTypes.pas new file mode 100644 index 0000000..285f9f3 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsTypes.pas @@ -0,0 +1,23 @@ +unit KM_ControlsTypes; +{$I KaM_Remake.inc} +interface + + +type + TKMAllowedChars = ( + acDigits, // Only 0..9 digits, for numeric input + acHex, // Only 0..9 A..F a..f, for input hex values (colors) + acANSI7, // #33..#123,#125,#126 - only basic latin chars and symbols for user nickname, except | + acFileName, // Exclude symbols that can't be used in filenames + acText, // Anything is allowed except for eol symbol + acAll // Anything is allowed + ); + +const + CTRL_HIGHLIGHT_COEF_DEF = 0.4; + + +implementation + + +end. diff --git a/vendor/kam_remake/src/controls/KM_ControlsUtils.pas b/vendor/kam_remake/src/controls/KM_ControlsUtils.pas new file mode 100644 index 0000000..3a60b55 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsUtils.pas @@ -0,0 +1,62 @@ +unit KM_ControlsUtils; +{$I KaM_Remake.inc} +interface +uses + Classes, + KM_ControlsTypes, + KM_CommonTypes; + + + // Check if specified aChar is allowed for specified aAllowedChars type + function IsCharAllowed(aChar: WideChar; aAllowedChars: TKMAllowedChars): Boolean; + + function IsSelecting(Key: Word; Shift: TShiftState): Boolean; + + function GetCursorDir(aKey: Word): TKMCursorDir; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + Math, + KromUtils; + + +// Check if specified aChar is allowed for specified aAllowedChars type +function IsCharAllowed(aChar: WideChar; aAllowedChars: TKMAllowedChars): Boolean; +const + HEX_DIGITS: TSetOfAnsiChar = [#48..#57, #65..#70, #97..#102]; // 0..9 A..F a..f + ANSI7_CHARS: TSetOfAnsiChar = [#32..#123, #125..#126]; // except | character + NON_FILE_CHARS: TSetOfAnsiChar = [#0 .. #31, '<', '>', #176, '|', '"', '\', '/', ':', '*', '?']; + NON_TEXT_CHARS_WEOL: TSetOfAnsiChar = [#0 .. #31, #176, '|']; // ° has negative width so acts like a backspace in KaM fonts + NON_TEXT_CHARS: TSetOfAnsiChar = [#0 .. #31, #176]; // ° has negative width so acts like a backspace in KaM fonts +begin + Result := not ((aAllowedChars = acDigits) and not InRange(Ord(aChar), 48, 57) + or (aAllowedChars = acHex) and not CharInSet(aChar, HEX_DIGITS) + or (aAllowedChars = acANSI7) and not CharInSet(aChar, ANSI7_CHARS) + or (aAllowedChars = acFileName) and CharInSet(aChar, NON_FILE_CHARS) + or (aAllowedChars = acText) and CharInSet(aChar, NON_TEXT_CHARS_WEOL) + or (aAllowedChars = acAll) and CharInSet(aChar, NON_TEXT_CHARS)); +end; + + +function IsSelecting(Key: Word; Shift: TShiftState): Boolean; +begin + Result := (ssShift in Shift) and (Key <> VK_SHIFT); +end; + + +function GetCursorDir(aKey: Word): TKMCursorDir; +begin + case aKey of + VK_LEFT: Result := cdBack; + VK_RIGHT: Result := cdForward; + else + Result := cdNone; + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/controls/KM_ControlsWaresRow.pas b/vendor/kam_remake/src/controls/KM_ControlsWaresRow.pas new file mode 100644 index 0000000..19878f7 --- /dev/null +++ b/vendor/kam_remake/src/controls/KM_ControlsWaresRow.pas @@ -0,0 +1,309 @@ +unit KM_ControlsWaresRow; +{$I KaM_Remake.inc} +interface +uses + Classes, Controls, + KM_Controls, KM_ControlsBase, + KM_ResTypes, + KM_CommonTypes, KM_Defaults; + + +type + // Row with resource name and icons + TKMWaresRow = class(TKMButtonFlatCommon) + public + WareCount: Word; + WareCntAsNumber: Boolean; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer); overload; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aClickable: Boolean); overload; + procedure Paint; override; + end; + + + // Ware order bar + TKMWareOrderRow = class(TKMControl) + private + fWaresRow: TKMWaresRow; + fOrderAdd: TKMButton; + fOrderLab: TKMLabel; + fOrderRem: TKMButton; + fOrderCount: Integer; + fImmediateOrder: Boolean; // Order count can be changed immediately in control. Always set False because of MP delay + procedure ButtonClick(Sender: TObject; Shift: TShiftState); + procedure ClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); + procedure SetOrderRemHint(const aValue: UnicodeString); + procedure SetOrderAddHint(const aValue: UnicodeString); + procedure SetOrderCount(aValue: Integer); + protected + procedure SetTop(aValue: Integer); override; + procedure SetEnabled(aValue: Boolean); override; + procedure SetVisible(aValue: Boolean); override; + function DoHandleMouseWheelByDefault: Boolean; override; + public + OrderCntMax: Integer; + OnChange: TKMNotifyEventInteger; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aOrderCntMax: Integer = MAX_WARES_IN_HOUSE); + property WareRow: TKMWaresRow read fWaresRow; + property OrderCount: Integer read fOrderCount write SetOrderCount; + property OrderRemHint: UnicodeString write SetOrderRemHint; + property OrderAddHint: UnicodeString write SetOrderAddHint; + procedure MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); override; + procedure Paint; override; + end; + + + // Production cost bar + TKMCostsRow = class(TKMControl) + public + RX: TRXType; + TexID1, TexID2: Word; + Count: Byte; + Caption: UnicodeString; + MaxCount: Byte; + constructor Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aMaxCount: Byte = 6); + procedure Paint; override; + end; + + +implementation +uses + {$IFDEF MSWindows} Windows, {$ENDIF} + {$IFDEF Unix} LCLIntf, LCLType, {$ENDIF} + SysUtils, Math, + KM_RenderUI, + KM_ResFonts, + KM_UtilsExt; + +const + WARE_ROW_HEIGHT = 21; + + +{ TKMWaresRow } +constructor TKMWaresRow.Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer); +begin + Create(aParent, aLeft, aTop, aWidth, False); +end; + + +constructor TKMWaresRow.Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aClickable: Boolean); +begin + inherited Create(aParent, aLeft, aTop, aWidth, WARE_ROW_HEIGHT, 0); + Clickable := aClickable; + HideHighlight := not aClickable; +end; + + +procedure TKMWaresRow.Paint; +var + I: Integer; +begin + inherited; + TKMRenderUI.WriteText(AbsLeft + 4, AbsTop + 3, Width-8, Caption, fntGame, taLeft, $FFE0E0E0); + //Render in reverse order so the rightmost resource is on top (otherwise lighting looks wrong) + if WareCntAsNumber then + begin + TKMRenderUI.WriteText(AbsLeft + Width - 18 - 70 + 24, AbsTop + 3, 40, IntToStr(WareCount), fntGame, taRight, $FFE0E0E0); + TKMRenderUI.WritePicture(AbsLeft + Width - 18, AbsTop + 3, 14, 14, [], RX, TexID); + end else + for I := WareCount - 1 downto 0 do + TKMRenderUI.WritePicture(AbsLeft + Width - 18 - I * 14, AbsTop + 3, 14, 14, [], RX, TexID); +end; + + +{ TKMWareOrderRow } +constructor TKMWareOrderRow.Create(aParent: TKMPanel; aLeft, aTop, aWidth: Integer; aOrderCntMax: Integer = MAX_WARES_IN_HOUSE); +begin + inherited Create(aParent, aLeft, aTop, aWidth, WARE_ROW_HEIGHT); + + fWaresRow := TKMWaresRow.Create(aParent, aLeft + 68, aTop, aWidth - 68); + + fImmediateOrder := False; + + OrderCntMax := aOrderCntMax; + + fOrderRem := TKMButton.Create(aParent, aLeft, 0, 20, Height - 2, '-', bsGame); + fOrderAdd := TKMButton.Create(aParent, aLeft + 46, 0, 20, Height - 2, '+', bsGame); + //Label after buttons, to be sure it will be on top of them, to let player read value from it, if too long (more then 3 symbols) + fOrderLab := TKMLabel.Create (aParent, aLeft + 33, 0, '', fntGrey, taCenter); + + fOrderAdd.CapOffsetY := 1; + + fOrderRem.OnClickShift := ButtonClick; + fOrderAdd.OnClickShift := ButtonClick; + fOrderRem.OnMouseWheel := MouseWheel; + fOrderAdd.OnMouseWheel := MouseWheel; + fWaresRow.OnMouseWheel := MouseWheel; + fOrderRem.OnClickHold := ClickHold; + fOrderAdd.OnClickHold := ClickHold; +end; + + +procedure TKMWareOrderRow.ButtonClick(Sender: TObject; Shift: TShiftState); +var + amt: Integer; +begin + amt := GetMultiplicator(Shift); + if Sender = fOrderRem then + amt := -amt; + + if amt = 0 then Exit; + + if fImmediateOrder then + OrderCount := fOrderCount + amt; + + Focus; + + if Assigned(OnChange) then + OnChange(Self, amt); +end; + + +function TKMWareOrderRow.DoHandleMouseWheelByDefault: Boolean; +begin + Result := False; +end; + + +procedure TKMWareOrderRow.MouseWheel(Sender: TObject; WheelSteps: Integer; var aHandled: Boolean); +var + amt: Integer; +begin + inherited; + + if aHandled then Exit; + + amt := MouseWheelStep * WheelSteps; + if GetKeyState(VK_SHIFT) < 0 then + amt := amt * 10; + + if fImmediateOrder then + OrderCount := fOrderCount + amt; + + aHandled := amt <> 0; + + Focus; + + if Assigned(OnChange) then + OnChange(Self, amt); +end; + + +procedure TKMWareOrderRow.ClickHold(Sender: TObject; Button: TMouseButton; var aHandled: Boolean); +var + amt: Integer; +begin + inherited; + aHandled := True; + + amt := GetMultiplicator(Button); + + if Sender = fOrderRem then + amt := -amt; + + if amt = 0 then Exit; + + if fImmediateOrder then + OrderCount := fOrderCount + amt; + + if Assigned(OnChange) then + OnChange(Self, amt); +end; + + +procedure TKMWareOrderRow.SetOrderCount(aValue: Integer); +begin + fOrderCount := EnsureRange(aValue, 0, OrderCntMax); +end; + + +procedure TKMWareOrderRow.SetOrderRemHint(const aValue: UnicodeString); +begin + fOrderRem.Hint := aValue; +end; + + +procedure TKMWareOrderRow.SetOrderAddHint(const aValue: UnicodeString); +begin + fOrderAdd.Hint := aValue; +end; + + +procedure TKMWareOrderRow.SetTop(aValue: Integer); +begin + inherited; + fWaresRow.Top := aValue; +end; + + +//Copy property to buttons +procedure TKMWareOrderRow.SetEnabled(aValue: Boolean); +begin + inherited; + fWaresRow.Enabled := Enabled; + fOrderRem.Enabled := Enabled; + fOrderLab.Enabled := Enabled; + fOrderAdd.Enabled := Enabled; +end; + + +//Copy property to buttons. Otherwise they won't be rendered +procedure TKMWareOrderRow.SetVisible(aValue: Boolean); +begin + inherited; + fWaresRow.Visible := IsSetVisible; + fOrderRem.Visible := IsSetVisible; + fOrderLab.Visible := IsSetVisible; + fOrderAdd.Visible := IsSetVisible; +end; + + +procedure TKMWareOrderRow.Paint; +begin + inherited; + + fOrderRem.Top := Top + 1; //Use internal fTop instead of GetTop (which will return absolute value) + fOrderLab.Top := Top + 4; + fOrderAdd.Top := Top + 1; + + fOrderLab.Caption := IntToKStr(OrderCount, 1000); +end; + + +{ TKMCostsRow } +constructor TKMCostsRow.Create(aParent: TKMPanel; aLeft, aTop, aWidth, aHeight: Integer; aMaxCount: Byte = 6); +begin + inherited Create(aParent, aLeft, aTop, aWidth, aHeight); + + MaxCount := aMaxCount; +end; + + +procedure TKMCostsRow.Paint; +var + I, gap: Integer; +begin + inherited; + TKMRenderUI.WriteText(AbsLeft, AbsTop + 4, Width-20, Caption, fntGrey, taLeft, $FFFFFFFF); + + if Count > 0 then + begin + if Count <= MaxCount then + gap := 20 + else + gap := Trunc(MaxCount * 20 / Count); + + if TexID1 <> 0 then + for I := Count - 1 downto 0 do + TKMRenderUI.WritePicture(AbsLeft+Width-gap*(I+1), AbsTop, 20, Height, [], RX, TexID1); + end else + begin + if TexID1 <> 0 then + TKMRenderUI.WritePicture(AbsLeft+Width-40, AbsTop, 20, Height, [], RX, TexID1); + if TexID2 <> 0 then + TKMRenderUI.WritePicture(AbsLeft+Width-20, AbsTop, 20, Height, [], RX, TexID2); + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/basiccolorspace.inc b/vendor/kam_remake/src/ext/BGRABitmap/basiccolorspace.inc new file mode 100644 index 0000000..0e9ce01 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/basiccolorspace.inc @@ -0,0 +1,1635 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + {* Possible channels in a bitmap using any RGBA colorspace } + TChannel = (cRed, cGreen, cBlue, cAlpha); + {** Combination of channels } + TChannels = set of TChannel; + +const + TBGRAPixel_ChannelByteOffset : array[TChannel] of integer = + (TBGRAPixel_RedByteOffset, TBGRAPixel_GreenByteOffset, TBGRAPixel_BlueByteOffset, TBGRAPixel_AlphaByteOffset); + +{ Gamma conversion arrays. Should be used as readonly } +var + // TBGRAPixel -> TExpandedPixel + GammaExpansionTab: packed array[0..255] of word; + GammaExpansionTabHalf: packed array[0..254] of word; + + // TExpandedPixel -> TBGRAPixel + GammaCompressionTab : packed array[0..65535] of byte; //rounded value + +procedure BGRASetGamma(AGamma: single = 1.7); +function BGRAGetGamma: single; + +type + PExpandedPixel = ^TExpandedPixel; + { TExpandedPixel } + {* Stores a gamma expanded RGB color. Values range from 0 to 65535 } + TExpandedPixel = packed record + red, green, blue, alpha: word; + end; + TExpandedPixelBuffer = packed array of TExpandedPixel; + + procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer; ASize: integer); + + {** Converts a pixel from sRGB to gamma expanded RGB } + function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline; + {** Converts a pixel from gamma expanded RGB to sRGB } + function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline; overload; + {** Converts a pixel from gamma expanded RGB to sRGB } + function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline; overload; + {** Apply gamma compression with word values } + function GammaCompressionW(AExpanded: word): word; + {** Apply gamma expansion with word values } + function GammaExpansionW(ACompressed: word): word; + {** Returns the intensity of an gamma-expanded pixel. The intensity is the + maximum value reached by any component } + function GetIntensity(const c: TExpandedPixel): word; inline; + {** Sets the intensity of a gamma-expanded pixel } + function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel; + {** Returns the lightness of an gamma-expanded pixel. The lightness is the + perceived brightness, 0 being black and 65535 being white } + function GetLightness(const c: TExpandedPixel): word; inline; overload; + {** Sets the lightness of a gamma-expanded pixel } + function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel; overload; + {** Sets the lightness of a gamma expanded pixel, provided you already know the current + value of lightness ''curLightness''. It is a bit faster than the previous function } + function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; overload; + {** Returns the importance of the color. It is similar to saturation + in HSL colorspace, except it is gamma corrected. A value of zero indicates + a black/gray/white, and a value of 65535 indicates a bright color } + function ColorImportance(ec: TExpandedPixel): word; + {** Merge two gamma expanded pixels (so taking into account gamma correction) } + function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload; + function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel; weight2: integer): TExpandedPixel; overload; + {** Computes the difference (with gamma correction) between two pixels, + taking into account all dimensions, including transparency. The + result ranges from 0 to 65535 } + function ExpandedDiff(ec1, ec2: TExpandedPixel): word; + + function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean=true): TExpandedPixel; + function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean=true): TFPColor; + +type + {* General purpose color variable with single-precision floating point values } + TColorF = packed array[1..4] of single; + ArrayOfTColorF = array of TColorF; + + {** Creates a TColorF structure } + function ColorF(red,green,blue,alpha: single): TColorF; + function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF; overload; + function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean): ArrayOfTColorF; overload; + function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel; + function GammaCompressionF(c: TColorF): TColorF; + function GammaExpansionF(c: TColorF): TColorF; + {** Subtract each component separately } + operator - (const c1, c2: TColorF): TColorF; inline; + {** Add each component separately } + operator + (const c1, c2: TColorF): TColorF; inline; + {** Multiply each component separately } + operator * (const c1, c2: TColorF): TColorF; inline; + {** Multiply each component by ''factor'' } + operator * (const c1: TColorF; factor: single): TColorF; inline; + +type + {* Pixel color defined in HSL colorspace. Values range from 0 to 65535 } + + { THSLAPixel } + + THSLAPixel = packed record + {** Hue of the pixel. Extremum values 0 and 65535 are red } + hue: word; + {** Saturation of the color. 0 is gray and 65535 is the brightest color (including white) } + saturation: word; + {** Lightness of the color. 0 is black, 32768 is normal, and 65535 is white } + lightness: word; + {** Opacity of the pixel. 0 is transparent and 65535 is opaque } + alpha: word; + end; + + {** Creates a pixel with given HSLA values, where A stands for alpha } + function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; overload; inline; + {** Creates an opaque pixel with given HSL values } + function HSLA(hue, saturation, lightness: word): THSLAPixel; overload; inline; + {** Converts a pixel from sRGB to HSL color space } + function BGRAToHSLA(c: TBGRAPixel): THSLAPixel; + {** Converts a pixel from gamma expanded RGB to HSL color space } + function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel; + {** Converts a pixel from HSL colorspace to sRGB } + function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel; + {** Converts a pixel from HSL colorspace to gamma expanded RGB } + function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel; + {** Computes the hue difference } + function HueDiff(h1, h2: word): word; + {** Returns the hue of a gamma expanded pixel } + function GetHue(ec: TExpandedPixel): word; + +type + {* Pixel color defined in corrected HSL colorspace. G stands for corrected hue + and B stands for actual brightness. Values range from 0 to 65535 } + TGSBAPixel = packed record + {** Hue of the pixel. Extremum values 0 and 65535 are red } + hue: word; + {** Saturation of the color. 0 is gray and 65535 is the brightest color (excluding white) } + saturation: word; + {** Actual perceived brightness. 0 is black, 32768 is normal, and 65535 is white } + lightness: word; + {** Opacity of the pixel. 0 is transparent and 65535 is opaque } + alpha: word; + end; + + {** Converts a pixel from sRGB to correct HSL color space } + function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel; + {** Converts a pixel from gamma expanded RGB to correct HSL color space } + function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel; + {** Converts a G hue (GSBA) to a H hue (HSLA) } + function GtoH(ghue: word): word; + {** Converts a H hue (HSLA) to a G hue (GSBA) } + function HtoG(hue: word): word; + {** Converts a pixel from corrected HSL to sRGB } + function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel; overload; + function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel; overload; + {** Converts a pixel from correct HSL to gamma expanded RGB } + function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel; overload; + function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel; overload; + {** Converts a pixel from correct HSL to usual HSL } + function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel; overload; + function GSBAToHSLA(const c: THSLAPixel): THSLAPixel; overload; + function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel; + +type + { TBGRAPixelBasicHelper } + + TBGRAPixelBasicHelper = record helper for TBGRAPixel + function ToExpanded: TExpandedPixel; + procedure FromExpanded(const AValue: TExpandedPixel); + function ToHSLAPixel: THSLAPixel; + procedure FromHSLAPixel(const AValue: THSLAPixel); + function ToGSBAPixel: TGSBAPixel; + procedure FromGSBAPixel(const AValue: TGSBAPixel); overload; + procedure FromGSBAPixel(const AValue: THSLAPixel); overload; + function ToColorF(AGammaExpansion: boolean): TColorF; + procedure FromColorF(const AValue: TColorF; AGammaCompression: boolean); + end; + + { TExpandedPixelBasicHelper } + + TExpandedPixelBasicHelper = record helper for TExpandedPixel + function ToFPColor(AGammaCompression: boolean = true): TFPColor; + procedure FromFPColor(const AValue: TFPColor; AGammaExpansion: boolean = true); + function ToColor: TColor; + procedure FromColor(const AValue: TColor); + function ToBGRAPixel: TBGRAPixel; + procedure FromBGRAPixel(AValue: TBGRAPixel); + function ToHSLAPixel: THSLAPixel; + procedure FromHSLAPixel(const AValue: THSLAPixel); + function ToGSBAPixel: TGSBAPixel; + procedure FromGSBAPixel(const AValue: TGSBAPixel); overload; + procedure FromGSBAPixel(const AValue: THSLAPixel); overload; + end; + +operator := (const AValue: TExpandedPixel): TColor; +operator := (const AValue: TColor): TExpandedPixel; +Operator := (const Source: TExpandedPixel): TBGRAPixel; +Operator := (const Source: TBGRAPixel): TExpandedPixel; + +type + { TFPColorBasicHelper } + + TFPColorBasicHelper = record helper for TFPColor + function ToColor: TColor; + procedure FromColor(const AValue: TColor); + function ToBGRAPixel: TBGRAPixel; + procedure FromBGRAPixel(AValue: TBGRAPixel); + function ToExpanded(AGammaExpansion: boolean = true): TExpandedPixel; + procedure FromExpanded(const AValue: TExpandedPixel; AGammaCompression: boolean = true); + function ToHSLAPixel(AGammaExpansion: boolean = true): THSLAPixel; + procedure FromHSLAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true); + function ToGSBAPixel(AGammaExpansion: boolean = true): TGSBAPixel; + procedure FromGSBAPixel(const AValue: TGSBAPixel; AGammaCompression: boolean = true); overload; + procedure FromGSBAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true); overload; + end; + + { THSLAPixelBasicHelper } + + THSLAPixelBasicHelper = record helper for THSLAPixel + function ToColor: TColor; + procedure FromColor(const AValue: TColor); + function ToBGRAPixel: TBGRAPixel; + procedure FromBGRAPixel(AValue: TBGRAPixel); + function ToGSBAPixel: TGSBAPixel; + procedure FromGSBAPixel(AValue: TGSBAPixel); + function ToExpanded: TExpandedPixel; + procedure FromExpanded(AValue: TExpandedPixel); + function ToFPColor(AGammaCompression: boolean=true): TFPColor; + procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true); + end; + +Operator := (const Source: THSLAPixel): TBGRAPixel; +Operator := (const Source: TBGRAPixel): THSLAPixel; +Operator := (const Source: THSLAPixel): TExpandedPixel; +Operator := (const Source: TExpandedPixel): THSLAPixel; +operator := (const AValue: TColor): THSLAPixel; +operator := (const AValue: THSLAPixel): TColor; + +type + { TGSBAPixelBasicHelper } + + TGSBAPixelBasicHelper = record helper for TGSBAPixel + function ToColor: TColor; + procedure FromColor(const AValue: TColor); + function ToBGRAPixel: TBGRAPixel; + procedure FromBGRAPixel(AValue: TBGRAPixel); + function ToHSLAPixel: THSLAPixel; + procedure FromHSLAPixel(AValue: THSLAPixel); + function ToExpanded: TExpandedPixel; + procedure FromExpanded(AValue: TExpandedPixel); + function ToFPColor(AGammaCompression: boolean=true): TFPColor; + procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true); + end; + +Operator := (const Source: TGSBAPixel): TBGRAPixel; +Operator := (const Source: TBGRAPixel): TGSBAPixel; +Operator := (const Source: TGSBAPixel): TExpandedPixel; +Operator := (const Source: TExpandedPixel): TGSBAPixel; +operator := (const AValue: TColor): TGSBAPixel; +operator := (const AValue: TGSBAPixel): TColor; +Operator := (const Source: TGSBAPixel): THSLAPixel; //no conversion, just copying for backward compatibility (use ToHSLAPixel instead for conversion) +Operator := (const Source: THSLAPixel): TGSBAPixel; //no conversion, just copying for backward compatibility (use ToGSBAPixel instead for conversion) +{$ENDIF} + + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +{ TBGRAPixel } + +function TBGRAPixel.GetClassIntensity: word; +begin + result := GetIntensity(self); +end; + +function TBGRAPixel.GetClassLightness: word; +begin + result := GetLightness(self); +end; + +procedure TBGRAPixel.SetClassIntensity(AValue: word); +begin + self := SetIntensity(self, AValue); +end; + +procedure TBGRAPixel.SetClassLightness(AValue: word); +begin + self := SetLightness(self, AValue); +end; + +procedure TBGRAPixel.FromRGB(ARed, AGreen, ABlue: Byte; AAlpha: Byte); +begin + red := ARed; + green := AGreen; + blue := ABlue; + alpha := AAlpha; +end; + +procedure TBGRAPixel.FromColor(AColor: TColor; AAlpha: Byte); +begin + if AColor = clNone then + Self := BGRAPixelTransparent + else + begin + RedGreenBlue(ColorToRGB(AColor), red,green,blue); + alpha := AAlpha; + end; +end; + +procedure TBGRAPixel.FromString(AStr: string); +begin + Self := StrToBGRA(AStr); +end; + +procedure TBGRAPixel.FromFPColor(AColor: TFPColor); +begin + self := FPColorToBGRA(AColor); +end; + +procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue, AAlpha: Byte); +begin + ARed := red; + AGreen := green; + ABlue := blue; + AAlpha := alpha; +end; + +procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue: Byte); +begin + ARed := red; + AGreen := green; + ABlue := blue +end; + +function TBGRAPixel.ToColor: TColor; +begin + if alpha = 0 then + result := clNone + else + result := RGBToColor(red,green,blue); +end; + +function TBGRAPixel.ToString: string; +begin + result := BGRAToStr(Self, CSSColors); +end; + +function TBGRAPixel.ToGrayscale(AGammaCorrection: boolean): TBGRAPixel; +begin + if AGammaCorrection then + result := BGRAToGrayscale(self) + else + result := BGRAToGrayscaleLinear(self); +end; + +function TBGRAPixel.ToFPColor: TFPColor; +begin + result := BGRAToFPColor(Self); +end; + +function TBGRAPixel.EqualsExactly(constref AColor: TBGRAPixel): boolean; +begin + result := PLongWord(@AColor)^ = PLongWord(@self)^; +end; + +class operator TBGRAPixel.:=(Source: TBGRAPixel): TColor; +begin + result := Source.ToColor; +end; + +class operator TBGRAPixel.:=(Source: TColor): TBGRAPixel; +begin + result.FromColor(Source); +end; + +{ The gamma correction is approximated here by a power function } +var + GammaExpFactor : single; //exponent + +const + redWeightShl10 = 306; // = 0.299 + greenWeightShl10 = 601; // = 0.587 + blueWeightShl10 = 117; // = 0.114 + +procedure BGRANoGamma; +var i,j: integer; + prevExp, nextExp: Word; +begin + GammaExpFactor := 1; + prevExp := 0; + for i := 0 to 255 do + begin + GammaExpansionTab[i] := (i shl 8) + i; + if i = 255 then nextExp := 65535 + else + begin + nextExp := GammaExpansionTab[i]+128; + GammaExpansionTabHalf[i] := nextExp+1; + end; + for j := prevExp to nextExp do + GammaCompressionTab[j] := i; + if i < 255 then + prevExp := nextExp+1; + end; +end; + +procedure BGRASetGamma(AGamma: single); +var + GammaLinearFactor: single; + i,j,prevpos,nextpos,midpos: Int32or64; +begin + if AGamma = 1 then + begin + BGRANoGamma; + exit; + end; + GammaExpFactor := AGamma; + //the linear factor is used to normalize expanded values in the range 0..65535 + GammaLinearFactor := 65535 / power(255, GammaExpFactor); + GammaExpansionTab[0] := 0; + nextpos := 0; + for i := 0 to 255 do + begin + prevpos := nextpos; + midpos := round(power(i, GammaExpFactor) * GammaLinearFactor); + if i = 255 then + nextpos := 65536 + else + nextpos := round(power(i+0.5, GammaExpFactor) * GammaLinearFactor); + GammaExpansionTab[i] := midpos; + if i < 255 then + GammaExpansionTabHalf[i] := nextpos; + for j := prevpos to midpos-1 do + GammaCompressionTab[j] := i; + for j := midpos to nextpos-1 do + GammaCompressionTab[j] := i; + end; + GammaCompressionTab[0] := 0; +end; + +function BGRAGetGamma: single; +begin + result := GammaExpFactor; +end; + +procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer; + ASize: integer); +begin + if ASize > length(ABuffer) then + setlength(ABuffer, max(length(ABuffer)*2,ASize)); +end; + +{ Apply gamma correction using conversion tables } +function GammaExpansion(c: TBGRAPixel): TExpandedPixel; +begin + Result.red := GammaExpansionTab[c.red]; + Result.green := GammaExpansionTab[c.green]; + Result.blue := GammaExpansionTab[c.blue]; + Result.alpha := c.alpha shl 8 + c.alpha; +end; + +function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; +begin + Result.red := GammaCompressionTab[ec.red]; + Result.green := GammaCompressionTab[ec.green]; + Result.blue := GammaCompressionTab[ec.blue]; + Result.alpha := ec.alpha shr 8; +end; + +function GammaCompression(red, green, blue, alpha: word): TBGRAPixel; +begin + Result.red := GammaCompressionTab[red]; + Result.green := GammaCompressionTab[green]; + Result.blue := GammaCompressionTab[blue]; + Result.alpha := alpha shr 8; +end; + +function GammaExpansionW(ACompressed: word): word; +const + fracShift = 8; + fracHalf = 1 shl (fracShift-1); + fracQuarter = 1 shl (fracShift-2); +var + intPart, fracPart, half: word; + byteVal: byte; +begin + if ACompressed = 0 then + result := 0 + else if ACompressed = $ffff then + result := $ffff + else + begin + //div 257 + byteVal := ACompressed shr fracShift; + intPart := (byteVal shl fracShift) + byteVal; + if ACompressed < intPart then + begin + dec(byteVal); + dec(intPart, 257); + end; + + fracPart := ACompressed - intPart; + if fracPart >= fracHalf then dec(fracPart); //[0..256] -> [0..255] + + if fracPart >= fracHalf then + begin + result := GammaExpansionTab[byteVal+1]; + half := GammaExpansionTabHalf[byteVal]; + dec(result, ((result-half)*((1 shl fracShift)-fracPart)+fracQuarter) shr (fracShift-1)); + end + else + begin + result := GammaExpansionTab[byteVal]; + if fracPart > 0 then + begin + half := GammaExpansionTabHalf[byteVal]; + inc(result, ((half-result)*fracPart+fracQuarter) shr (fracShift-1)); + end; + end; + end; +end; + +function GammaCompressionW(AExpanded: word): word; +var + compByte: Byte; + reExp, reExpDelta: Word; +begin + if AExpanded=0 then exit(0) else + if AExpanded=65535 then exit(65535) else + begin + compByte := GammaCompressionTab[AExpanded]; + reExp := GammaExpansionTab[compByte]; + result := compByte + (compByte shl 8); + if reExp < AExpanded then + begin + reExpDelta := GammaExpansionTabHalf[compByte]-reExp; + if reExpDelta<>0 then + inc(result, ((AExpanded-reExp)*128+(reExpDelta shr 1)) div reExpDelta); + end else + begin + reExpDelta := reExp-GammaExpansionTabHalf[compByte-1]; + if reExpDelta<>0 then + dec(result, ((reExp-AExpanded)*128+(reExpDelta shr 1)) div reExpDelta); + end; + end; +end; + +{ The intensity is defined here as the maximum value of any color component } +function GetIntensity(const c: TExpandedPixel): word; inline; +begin + Result := c.red; + if c.green > Result then + Result := c.green; + if c.blue > Result then + Result := c.blue; +end; + +function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel; +var + curIntensity: word; +begin + curIntensity := GetIntensity(c); + if curIntensity = 0 then //suppose it's gray if there is no color information + begin + Result.red := intensity; + Result.green := intensity; + Result.blue := intensity; + result.alpha := c.alpha; + end + else + begin + //linear interpolation to reached wanted intensity + Result.red := (c.red * intensity + (curIntensity shr 1)) div curIntensity; + Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity; + Result.blue := (c.blue * intensity + (curIntensity shr 1)) div curIntensity; + Result.alpha := c.alpha; + end; +end; + +{ The lightness here is defined as the subjective sensation of luminosity, where + blue is the darkest component and green the lightest } +function GetLightness(const c: TExpandedPixel): word; inline; +begin + Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 + + c.blue * blueWeightShl10 + 512) shr 10; +end; + +function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel; +var + curLightness: word; +begin + curLightness := GetLightness(c); + if lightness = curLightness then + begin //no change + Result := c; + exit; + end; + result := SetLightness(c, lightness, curLightness); +end; + +function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; +var + AddedWhiteness, maxBeforeWhite: word; + clip: boolean; +begin + if lightness = curLightness then + begin //no change + Result := c; + exit; + end; + if lightness = 65535 then //set to white + begin + Result.red := 65535; + Result.green := 65535; + Result.blue := 65535; + Result.alpha := c.alpha; + exit; + end; + if lightness = 0 then //set to black + begin + Result.red := 0; + Result.green := 0; + Result.blue := 0; + Result.alpha := c.alpha; + exit; + end; + if curLightness = 0 then //set from black + begin + Result.red := lightness; + Result.green := lightness; + Result.blue := lightness; + Result.alpha := c.alpha; + exit; + end; + if lightness < curLightness then //darker is easy + begin + result.alpha:= c.alpha; + result.red := (c.red * lightness + (curLightness shr 1)) div curLightness; + result.green := (c.green * lightness + (curLightness shr 1)) div curLightness; + result.blue := (c.blue * lightness + (curLightness shr 1)) div curLightness; + exit; + end; + //lighter and grayer + Result := c; + AddedWhiteness := lightness - curLightness; + maxBeforeWhite := 65535 - AddedWhiteness; + clip := False; + if Result.red <= maxBeforeWhite then + Inc(Result.red, AddedWhiteness) + else + begin + Result.red := 65535; + clip := True; + end; + if Result.green <= maxBeforeWhite then + Inc(Result.green, AddedWhiteness) + else + begin + Result.green := 65535; + clip := True; + end; + if Result.blue <= maxBeforeWhite then + Inc(Result.blue, AddedWhiteness) + else + begin + Result.blue := 65535; + clip := True; + end; + + if clip then //light and whiter + begin + curLightness := GetLightness(Result); + addedWhiteness := lightness - curLightness; + maxBeforeWhite := 65535 - curlightness; + Result.red := Result.red + addedWhiteness * (65535 - Result.red) div + maxBeforeWhite; + Result.green := Result.green + addedWhiteness * (65535 - Result.green) div + maxBeforeWhite; + Result.blue := Result.blue + addedWhiteness * (65535 - Result.blue) div + maxBeforeWhite; + end; +end; + +function ColorImportance(ec: TExpandedPixel): word; +var min,max: word; +begin + min := ec.red; + max := ec.red; + if ec.green > max then + max := ec.green + else + if ec.green < min then + min := ec.green; + if ec.blue > max then + max := ec.blue + else + if ec.blue < min then + min := ec.blue; + result := max - min; +end; + +{ Merge two colors of same importance } +function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; +var c12: LongWord; +begin + if (ec1.alpha = 0) then + Result := ec2 + else + if (ec2.alpha = 0) then + Result := ec1 + else + begin + c12 := ec1.alpha + ec2.alpha; + Result.red := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12; + Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12; + Result.blue := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12; + Result.alpha := (c12 + 1) shr 1; + end; +end; + +function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel; + weight2: integer): TExpandedPixel; +var + f1,f2,f12: int64; +begin + if (weight1 = 0) then + begin + if (weight2 = 0) then + result := BGRAPixelTransparent + else + Result := ec2 + end + else + if (weight2 = 0) then + Result := ec1 + else + if (weight1+weight2 = 0) then + Result := BGRAPixelTransparent + else + begin + f1 := int64(ec1.alpha)*weight1; + f2 := int64(ec2.alpha)*weight2; + f12 := f1+f2; + if f12 = 0 then + result := BGRAPixelTransparent + else + begin + Result.red := (ec1.red * f1 + ec2.red * f2 + f12 shr 1) div f12; + Result.green := (ec1.green * f1 + ec2.green * f2 + f12 shr 1) div f12; + Result.blue := (ec1.blue * f1 + ec2.blue * f2 + f12 shr 1) div f12; + {$hints off} + Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2); + {$hints on} + end; + end; +end; + +function LessStartSlope65535(value: word): word; +var factor: word; +begin + factor := 4096 - (not value)*3 shr 7; + result := value*factor shr 12; +end; + +function ExpandedDiff(ec1, ec2: TExpandedPixel): word; +var + CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2, + CompGreenAlpha2, CompBlueAlpha2: integer; + DiffAlpha: word; + ColorDiff: word; + TempHueDiff: word; +begin + if (ec1.alpha = 0) and (ec2.alpha = 0) then exit(0) else + if (ec1.alpha = ec2.alpha) and (ec1.red = ec2.red) and + (ec1.green = ec2.green) and (ec1.blue = ec2.blue) then exit(0); + CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535 + CompGreenAlpha1 := ec1.green * ec1.alpha shr 16; + CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16; + CompRedAlpha2 := ec2.red * ec2.alpha shr 16; + CompGreenAlpha2 := ec2.green * ec2.alpha shr 16; + CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16; + Result := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 + + Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 + + Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10; + ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2)); + if ColorDiff > 0 then + begin + TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2))); + if TempHueDiff < 32768 then + TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4 + else + TempHueDiff := TempHueDiff shr 3; + Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12; + end; + DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha)); + if DiffAlpha > Result then + Result := DiffAlpha; +end; + +function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean): TExpandedPixel; +begin + result.FromFPColor(AColor, AGammaExpansion); +end; + +function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean): TFPColor; +begin + result.FromExpanded(AExpanded, AGammaCompression); +end; + +function ColorF(red, green, blue, alpha: single): TColorF; +begin + result[1] := red; + result[2] := green; + result[3] := blue; + result[4] := alpha; +end; + +function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF; +const OneOver255 = 1/255; + OneOver65535 = 1/65535; +begin + if not AGammaExpansion then + begin + result[1] := c.red*OneOver255; + result[2] := c.green*OneOver255; + result[3] := c.blue*OneOver255; + result[4] := c.alpha*OneOver255; + end else + with GammaExpansion(c) do + begin + result[1] := red*OneOver65535; + result[2] := green*OneOver65535; + result[3] := blue*OneOver65535; + result[4] := alpha*OneOver65535; + end; +end; + +function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean + ): ArrayOfTColorF; +var + i: Int32or64; +begin + setlength(result, length(a)); + for i := 0 to high(a) do + result[i] := BGRAToColorF(a[i],AGammaExpansion); +end; + +function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel; +begin + if not AGammaCompression then + begin + result.red := Min(255,Max(0,round(c[1]*255))); + result.green := Min(255,Max(0,round(c[2]*255))); + result.blue := Min(255,Max(0,round(c[3]*255))); + end else + begin + result.red := GammaCompressionTab[Min(65535,Max(0,round(c[1]*65535)))]; + result.green := GammaCompressionTab[Min(65535,Max(0,round(c[2]*65535)))]; + result.blue := GammaCompressionTab[Min(65535,Max(0,round(c[3]*65535)))]; + end; + result.alpha := Min(255,Max(0,round(c[4]*255))); +end; + +function GammaCompressionF(c: TColorF): TColorF; +var inv: single; +begin + inv := 1/GammaExpFactor; + result := ColorF(power(c[1],inv),power(c[2],inv),power(c[3],inv),c[4]); +end; + +function GammaExpansionF(c: TColorF): TColorF; +begin + result := ColorF(power(c[1],GammaExpFactor),power(c[2],GammaExpFactor),power(c[3],GammaExpFactor),c[4]); +end; + +operator-(const c1, c2: TColorF): TColorF; +begin + result[1] := c1[1]-c2[1]; + result[2] := c1[2]-c2[2]; + result[3] := c1[3]-c2[3]; + result[4] := c1[4]-c2[4]; +end; + +operator+(const c1, c2: TColorF): TColorF; +begin + result[1] := c1[1]+c2[1]; + result[2] := c1[2]+c2[2]; + result[3] := c1[3]+c2[3]; + result[4] := c1[4]+c2[4]; +end; + +operator*(const c1, c2: TColorF): TColorF; +begin + result[1] := c1[1]*c2[1]; + result[2] := c1[2]*c2[2]; + result[3] := c1[3]*c2[3]; + result[4] := c1[4]*c2[4]; +end; + +operator*(const c1: TColorF; factor: single): TColorF; +begin + result[1] := c1[1]*factor; + result[2] := c1[2]*factor; + result[3] := c1[3]*factor; + result[4] := c1[4]*factor; +end; + +{ THSLAPixel } + +function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; +begin + Result.hue := hue; + Result.saturation := saturation; + Result.lightness := lightness; + Result.alpha := alpha; +end; + +function HSLA(hue, saturation, lightness: word): THSLAPixel; +begin + Result.hue := hue; + Result.saturation := saturation; + Result.lightness := lightness; + Result.alpha := $ffff; +end; + +{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space } +function BGRAToHSLA(c: TBGRAPixel): THSLAPixel; +begin + result := ExpandedToHSLA(GammaExpansion(c)); +end; + +procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline; +const + deg60 = 10922; + deg120 = 21845; + deg240 = 43690; +var + min, max, minMax: Int32or64; + UMinMax,UTwiceLightness: UInt32or64; +begin + if g > r then + begin + max := g; + min := r; + end else + begin + max := r; + min := g; + end; + if b > max then + max := b else + if b < min then + min := b; + minMax := max - min; + + if minMax = 0 then + dest.hue := 0 + else + if max = r then + {$PUSH}{$RANGECHECKS OFF} + dest.hue := ((g - b) * deg60) div minMax + {$POP} + else + if max = g then + dest.hue := ((b - r) * deg60) div minMax + deg120 + else + {max = b} dest.hue := ((r - g) * deg60) div minMax + deg240; + UTwiceLightness := max + min; + if min = max then + dest.saturation := 0 else + begin + UMinMax:= minMax; + if UTwiceLightness < 65536 then + dest.saturation := (UMinMax shl 16) div (UTwiceLightness + 1) + else + dest.saturation := (UMinMax shl 16) div (131072 - UTwiceLightness); + end; + dest.lightness := UTwiceLightness shr 1; +end; + +function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel; +begin + result.alpha := ec.alpha; + ExpandedToHSLAInline(ec.red,ec.green,ec.blue,result); +end; + +{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space } +function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel; +var ec: TExpandedPixel; +begin + ec := HSLAToExpanded(c); + Result := GammaCompression(ec); +end; + +function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel; +const + deg30 = 4096; + deg60 = 8192; + deg120 = deg60 * 2; + deg180 = deg60 * 3; + deg240 = deg60 * 4; + deg360 = deg60 * 6; + + function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline; + begin + if h < deg180 then + begin + if h < deg60 then + Result := p + ((q - p) * h + deg30) div deg60 + else + Result := q + end else + begin + if h < deg240 then + Result := p + ((q - p) * (deg240 - h) + deg30) div deg60 + else + Result := p; + end; + end; + +var + q, p, L, S, H: Int32or64; +begin + L := c.lightness; + S := c.saturation; + if S = 0 then //gray + begin + result.red := L; + result.green := L; + result.blue := L; + result.alpha := c.alpha; + exit; + end; + {$hints off} + if L < 32768 then + q := (L shr 1) * ((65535 + S) shr 1) shr 14 + else + q := L + S - ((L shr 1) * + (S shr 1) shr 14); + {$hints on} + if q > 65535 then q := 65535; + p := (L shl 1) - q; + if p > 65535 then p := 65535; + H := c.hue * deg360 shr 16; + result.green := ComputeColor(p, q, H); + inc(H, deg120); + if H > deg360 then Dec(H, deg360); + result.red := ComputeColor(p, q, H); + inc(H, deg120); + if H > deg360 then Dec(H, deg360); + result.blue := ComputeColor(p, q, H); + result.alpha := c.alpha; +end; + +function HueDiff(h1, h2: word): word; +begin + result := abs(integer(h1)-integer(h2)); + if result > 32768 then result := 65536-result; +end; + +function GetHue(ec: TExpandedPixel): word; +const + deg60 = 8192; + deg120 = deg60 * 2; + deg240 = deg60 * 4; + deg360 = deg60 * 6; +var + min, max, minMax: integer; + r,g,b: integer; +begin + r := ec.red; + g := ec.green; + b := ec.blue; + min := r; + max := r; + if g > max then + max := g + else + if g < min then + min := g; + if b > max then + max := b + else + if b < min then + min := b; + minMax := max - min; + + if minMax = 0 then + Result := 0 + else + if max = r then + Result := (((g - b) * deg60) div + minMax + deg360) mod deg360 + else + if max = g then + Result := ((b - r) * deg60) div minMax + deg120 + else + {max = b} Result := + ((r - g) * deg60) div minMax + deg240; + + Result := (Result shl 16) div deg360; //normalize +end; + +{ TGSBAPixel } + +function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel; +var + ec: TExpandedPixel; +begin + ec := GammaExpansion(c); + result := ExpandedToGSBA(ec); +end; + +function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel; +var lightness: UInt32Or64; + red,green,blue: Int32or64; + hsla: THSLAPixel; +begin + red := ec.red; + green := ec.green; + blue := ec.blue; + hsla.alpha := ec.alpha; + + lightness := (red * redWeightShl10 + green * greenWeightShl10 + + blue * blueWeightShl10 + 512) shr 10; + + ExpandedToHSLAInline(red,green,blue,hsla); + result := TGSBAPixel(hsla); + + if result.lightness > 32768 then + result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767; + result.lightness := lightness; + result.hue := HtoG(result.hue); +end; + +function GtoH(ghue: word): word; +const + segment: array[0..5] of UInt32or64 = + (13653, 10923, 8192, 13653, 10923, 8192); +var g: UInt32or64; +begin + g := ghue; + if g < segment[0] then + result := g * 10923 div segment[0] + else + begin + dec(g, segment[0]); + if g < segment[1] then + result := g * (21845-10923) div segment[1] + 10923 + else + begin + dec(g, segment[1]); + if g < segment[2] then + result := g * (32768-21845) div segment[2] + 21845 + else + begin + dec(g, segment[2]); + if g < segment[3] then + result := g * (43691-32768) div segment[3] + 32768 + else + begin + dec(g, segment[3]); + if g < segment[4] then + result := g * (54613-43691) div segment[4] + 43691 + else + begin + dec(g, segment[4]); + result := g * (65536-54613) div segment[5] + 54613; + end; + end; + end; + end; + end; +end; + +function HtoG(hue: word): word; +const + segmentDest: array[0..5] of UInt32or64 = + (13653, 10923, 8192, 13653, 10923, 8192); + segmentSrc: array[0..5] of UInt32or64 = + (10923, 10922, 10923, 10923, 10922, 10923); +var + h,g: UInt32or64; +begin + h := hue; + if h < segmentSrc[0] then + g := h * segmentDest[0] div segmentSrc[0] + else + begin + g := segmentDest[0]; + dec(h, segmentSrc[0]); + if h < segmentSrc[1] then + inc(g, h * segmentDest[1] div segmentSrc[1]) + else + begin + inc(g, segmentDest[1]); + dec(h, segmentSrc[1]); + if h < segmentSrc[2] then + inc(g, h * segmentDest[2] div segmentSrc[2]) + else + begin + inc(g, segmentDest[2]); + dec(h, segmentSrc[2]); + if h < segmentSrc[3] then + inc(g, h * segmentDest[3] div segmentSrc[3]) + else + begin + inc(g, segmentDest[3]); + dec(h, segmentSrc[3]); + if h < segmentSrc[4] then + inc(g, h * segmentDest[4] div segmentSrc[4]) + else + begin + inc(g, segmentDest[4]); + dec(h, segmentSrc[4]); + inc(g, h * segmentDest[5] div segmentSrc[5]); + end; + end; + end; + end; + end; + result := g; +end; + +function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel; +var ec: TExpandedPixel; +begin + ec := GSBAToExpanded(c); + result := GammaCompression(ec); +end; + +function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel; +begin + result := GSBAToBGRA(TGSBAPixel(c)); +end; + +function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel; +var lightness: word; +begin + c.hue := GtoH(c.hue); + lightness := c.lightness; + c.lightness := 32768; + result := SetLightness(HSLAToExpanded(THSLAPixel(c)),lightness); +end; + +function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel; +begin + result := GSBAToExpanded(TGSBAPixel(c)); +end; + +function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel; +begin + result := ExpandedToHSLA(GSBAToExpanded(c)); +end; + +function GSBAToHSLA(const c: THSLAPixel): THSLAPixel; +begin + result := ExpandedToHSLA(GSBAToExpanded(TGSBAPixel(c))); +end; + +function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel; +begin + result := ExpandedToGSBA(HSLAToExpanded(c)); +end; + +{ TBGRAPixelBasicHelper } + +function TBGRAPixelBasicHelper.ToExpanded: TExpandedPixel; +begin + result := GammaExpansion(self); +end; + +procedure TBGRAPixelBasicHelper.FromExpanded(const AValue: TExpandedPixel); +begin + Self := GammaCompression(AValue); +end; + +function TBGRAPixelBasicHelper.ToHSLAPixel: THSLAPixel; +begin + result := BGRAToHSLA(Self); +end; + +procedure TBGRAPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel); +begin + Self := HSLAToBGRA(AValue); +end; + +function TBGRAPixelBasicHelper.ToGSBAPixel: TGSBAPixel; +begin + result := BGRAToGSBA(Self); +end; + +procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel); +begin + Self := GSBAToBGRA(AValue); +end; + +procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel); +begin + Self := GSBAToBGRA(AValue); +end; + +function TBGRAPixelBasicHelper.ToColorF(AGammaExpansion: boolean): TColorF; +begin + result := BGRAToColorF(Self,AGammaExpansion); +end; + +procedure TBGRAPixelBasicHelper.FromColorF(const AValue: TColorF; + AGammaCompression: boolean); +begin + Self := ColorFToBGRA(AValue,AGammaCompression); +end; + +{ TExpandedPixelBasicHelper } + +function TExpandedPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; +begin + if AGammaCompression then + begin + result.red := GammaCompressionW(self.red); + result.green := GammaCompressionW(self.green); + result.blue := GammaCompressionW(self.blue); + end else + begin + result.red := self.red; + result.green := self.green; + result.blue := self.blue; + end; + result.alpha := self.alpha; +end; + +procedure TExpandedPixelBasicHelper.FromFPColor(const AValue: TFPColor; + AGammaExpansion: boolean); +begin + if AGammaExpansion then + begin + self.red := GammaExpansionW(AValue.red); + self.green := GammaExpansionW(AValue.green); + self.blue := GammaExpansionW(AValue.blue); + end else + begin + self.red := AValue.red; + self.green := AValue.green; + self.blue := AValue.blue; + end; + self.alpha := AValue.alpha; +end; + +function TExpandedPixelBasicHelper.ToColor: TColor; +begin + result := BGRAToColor(GammaCompression(self)); +end; + +procedure TExpandedPixelBasicHelper.FromColor(const AValue: TColor); +begin + self := GammaExpansion(ColorToBGRA(AValue)); +end; + +function TExpandedPixelBasicHelper.ToBGRAPixel: TBGRAPixel; +begin + result := GammaCompression(Self); +end; + +procedure TExpandedPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin + Self := GammaExpansion(AValue); +end; + +function TExpandedPixelBasicHelper.ToHSLAPixel: THSLAPixel; +begin + result := ExpandedToHSLA(Self); +end; + +procedure TExpandedPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel); +begin + Self := HSLAToExpanded(AValue); +end; + +function TExpandedPixelBasicHelper.ToGSBAPixel: TGSBAPixel; +begin + result := ExpandedToGSBA(Self); +end; + +procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel); +begin + Self := GSBAToExpanded(AValue); +end; + +procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel); +begin + Self := GSBAToExpanded(AValue); +end; + +operator := (const AValue: TExpandedPixel): TColor; +begin Result := BGRAToColor(GammaCompression(AValue)); end; + +operator := (const AValue: TColor): TExpandedPixel; +begin Result := GammaExpansion(ColorToBGRA(AValue)) end; + +operator :=(const Source: TExpandedPixel): TBGRAPixel; +begin + result := GammaCompression(Source); +end; + +operator :=(const Source: TBGRAPixel): TExpandedPixel; +begin + result := GammaExpansion(Source); +end; + +{ TFPColorBasicHelper } + +function TFPColorBasicHelper.ToColor: TColor; +begin + result := FPColorToTColor(self); +end; + +procedure TFPColorBasicHelper.FromColor(const AValue: TColor); +begin + self := TColorToFPColor(AValue); +end; + +function TFPColorBasicHelper.ToBGRAPixel: TBGRAPixel; +begin + result := FPColorToBGRA(self); +end; + +procedure TFPColorBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin + self := BGRAToFPColor(AValue); +end; + +function TFPColorBasicHelper.ToExpanded(AGammaExpansion: boolean): TExpandedPixel; +begin + result.FromFPColor(self, AGammaExpansion); +end; + +procedure TFPColorBasicHelper.FromExpanded(const AValue: TExpandedPixel; + AGammaCompression: boolean); +begin + self := AValue.ToFPColor(AGammaCompression); +end; + +function TFPColorBasicHelper.ToHSLAPixel(AGammaExpansion: boolean): THSLAPixel; +begin + result.FromFPColor(self, AGammaExpansion); +end; + +procedure TFPColorBasicHelper.FromHSLAPixel(const AValue: THSLAPixel; + AGammaCompression: boolean); +begin + FromExpanded(AValue.ToExpanded, AGammaCompression); +end; + +function TFPColorBasicHelper.ToGSBAPixel(AGammaExpansion: boolean): TGSBAPixel; +begin + result.FromFPColor(self, AGammaExpansion); +end; + +procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel; + AGammaCompression: boolean); +begin + FromExpanded(AValue.ToExpanded, AGammaCompression); +end; + +procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: THSLAPixel; + AGammaCompression: boolean); +begin + FromExpanded(AValue.ToExpanded, AGammaCompression); +end; + +{ THSLAPixelBasicHelper } + +function THSLAPixelBasicHelper.ToColor: TColor; +begin + result := BGRAToColor(HSLAToBGRA(self)); +end; + +procedure THSLAPixelBasicHelper.FromColor(const AValue: TColor); +begin + self := BGRAToHSLA(ColorToBGRA(AValue)); +end; + +function THSLAPixelBasicHelper.ToBGRAPixel: TBGRAPixel; +begin + result := HSLAToBGRA(self); +end; + +procedure THSLAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin + self := BGRAToHSLA(AValue); +end; + +function THSLAPixelBasicHelper.ToGSBAPixel: TGSBAPixel; +begin + result := HSLAToGSBA(self); +end; + +procedure THSLAPixelBasicHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin + self := GSBAToHSLA(AValue); +end; + +function THSLAPixelBasicHelper.ToExpanded: TExpandedPixel; +begin + result := HSLAToExpanded(Self); +end; + +procedure THSLAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel); +begin + Self := ExpandedToHSLA(AValue); +end; + +function THSLAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; +begin + result.FromExpanded(self.ToExpanded, AGammaCompression); +end; + +procedure THSLAPixelBasicHelper.FromFPColor(AValue: TFPColor; + AGammaExpansion: boolean); +begin + FromExpanded(AValue.ToExpanded(AGammaExpansion)); +end; + +operator :=(const Source: THSLAPixel): TBGRAPixel; +begin + result := HSLAToBGRA(Source); +end; + +operator :=(const Source: TBGRAPixel): THSLAPixel; +begin + result := BGRAToHSLA(Source); +end; + +operator :=(const Source: THSLAPixel): TExpandedPixel; +begin + result := HSLAToExpanded(Source); +end; + +operator:=(const Source: TExpandedPixel): THSLAPixel; +begin + result := ExpandedToHSLA(Source); +end; + +operator := (const AValue: TColor): THSLAPixel; +begin Result := BGRAToHSLA(ColorToBGRA(AValue)) end; + +operator := (const AValue: THSLAPixel): TColor; +begin Result := BGRAToColor(HSLAToBGRA(AValue)) end; + +{ TGSBAPixelBasicHelper } + +function TGSBAPixelBasicHelper.ToColor: TColor; +begin + result := BGRAToColor(GSBAToBGRA(self)); +end; + +procedure TGSBAPixelBasicHelper.FromColor(const AValue: TColor); +begin + self := BGRAToGSBA(ColorToBGRA(AValue)); +end; + +function TGSBAPixelBasicHelper.ToBGRAPixel: TBGRAPixel; +begin + result := GSBAToBGRA(self); +end; + +procedure TGSBAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin + self := BGRAToGSBA(AValue); +end; + +function TGSBAPixelBasicHelper.ToHSLAPixel: THSLAPixel; +begin + result := GSBAToHSLA(self); +end; + +procedure TGSBAPixelBasicHelper.FromHSLAPixel(AValue: THSLAPixel); +begin + self := HSLAToGSBA(AValue); +end; + +function TGSBAPixelBasicHelper.ToExpanded: TExpandedPixel; +begin + result := GSBAToExpanded(self); +end; + +procedure TGSBAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel); +begin + self := ExpandedToGSBA(AValue); +end; + +function TGSBAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; +begin + result.FromGSBAPixel(self, AGammaCompression); +end; + +procedure TGSBAPixelBasicHelper.FromFPColor(AValue: TFPColor; + AGammaExpansion: boolean); +begin + FromExpanded(AValue.ToExpanded(AGammaExpansion)); +end; + +operator :=(const Source: TGSBAPixel): TBGRAPixel; +begin + result := GSBAToBGRA(Source); +end; + +operator :=(const Source: TBGRAPixel): TGSBAPixel; +begin + result := BGRAToGSBA(Source); +end; + +operator :=(const Source: TGSBAPixel): TExpandedPixel; +begin + result := GSBAToExpanded(Source); +end; + +operator:=(const Source: TExpandedPixel): TGSBAPixel; +begin + result := ExpandedToGSBA(Source); +end; + +operator := (const AValue: TColor): TGSBAPixel; +begin Result := BGRAToGSBA(ColorToBGRA(AValue)) end; + +operator := (const AValue: TGSBAPixel): TColor; +begin Result := BGRAToColor(GSBAToBGRA(AValue)) end; + +operator :=(const Source: TGSBAPixel): THSLAPixel; +begin + result := THSLAPixel(Pointer(@Source)^); +end; + +operator:=(const Source: THSLAPixel): TGSBAPixel; +begin + result := TGSBAPixel(Pointer(@Source)^); +end; +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bezier.inc b/vendor/kam_remake/src/ext/BGRABitmap/bezier.inc new file mode 100644 index 0000000..c4a0e1c --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bezier.inc @@ -0,0 +1,1463 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} + +type + { TCubicBezierCurve } + {* Definition of a Bézier curve of order 3. It has two control points ''c1'' and ''c2''. Those are not reached by the curve } + TCubicBezierCurve = object + private + function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; + public + {** Starting point (reached) } + p1: TPointF; + {** First control point (not reached by the curve) } + c1: TPointF; + {** Second control point (not reached by the curve) } + c2: TPointF; + {** Ending point (reached) } + p2: TPointF; + {** Computes the point at time ''t'', varying from 0 to 1 } + function ComputePointAt(t: single): TPointF; + {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' } + procedure Split(out ALeft, ARight: TCubicBezierCurve); + {** Compute an approximation of the length of the curve. ''AAcceptedDeviation'' indicates the + maximum orthogonal distance that is ignored and approximated by a straight line. } + function ComputeLength(AAcceptedDeviation: single = 0.1): single; + {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the + maximum orthogonal distance that is ignored and approximated by a straight line. + ''AIncludeFirstPoint'' indicates if the first point must be included in the array } + function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; + procedure CopyToPath(ADest: IBGRAPath); + function GetBounds: TRectF; + end; + + {** Creates a structure for a cubic Bézier curve } + function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload; + +type + { TQuadraticBezierCurve } + {* Definition of a Bézier curve of order 2. It has one control point } + TQuadraticBezierCurve = object + private + function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; + function ComputeExtremumPositionOutsideSegment: single; + public + {** Starting point (reached) } + p1: TPointF; + {** Control point (not reached by the curve) } + c: TPointF; + {** Ending point (reached) } + p2: TPointF; + {** Computes the point at time ''t'', varying from 0 to 1 } + function ComputePointAt(t: single): TPointF; + {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' } + procedure Split(out ALeft, ARight: TQuadraticBezierCurve); + {** Compute the '''exact''' length of the curve } + function ComputeLength: single; + {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the + maximum orthogonal distance that is ignored and approximated by a straight line. + ''AIncludeFirstPoint'' indicates if the first point must be included in the array } + function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; + procedure CopyToPath(ADest: IBGRAPath); + function GetBounds: TRectF; + end; + + {** Creates a structure for a quadratic Bézier curve } + function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload; + {** Creates a structure for a quadratic Bézier curve without curvature } + function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload; + +type + { A quasi-standard rational quadratic Bezier curve is defined by three points and a number: + p1 = starting point + c = control point + p2 = ending point + weight = weight for the control point + + The curve is defined with the function (t in [0;1]): + f: t -> ((1-t)^2*p1 + 2*t*(1-t)*weight*c + t^2*p2) / (1-t)^2 + 2*t*(1-t)*weight + t^2) + + The curve is an arc of: + - ellipse when weight in ]-1;1[ + - parabola when weight = 1 (classical quadratic Bezier curve) + - hyperbola when weight > 1 + + A negative weight give the complementary curve for its positive counterpart. + So when weight <= -1 the curve is discontinuous: + - infinite branches of parabola when weight = -1 + - infinite branches of hyperbola and symetric hyperbola when weight < -1 + + To transform a rational quadratic Bezier curve with an affin transformation, you + only have to transform the three points and leave the weight as it is. } + + ArrayOfSingle = array of single; + + { TRationalQuadraticBezierCurve } + {* Definition of a quasi-standard rational Bézier curve of order 2. It has one weighted control point } + TRationalQuadraticBezierCurve = object + //** Starting, control and ending points + p1, c, p2 : TPointF; + //** Weight of control point + weight : single; + private + function GetIsInfinite: boolean; + function InternalComputePoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; + function GetBoundingPositions(AIncludeFirstAndLast: boolean; ASorted: boolean): ArrayOfSingle; + public + function ComputePointAt(t: single): TPointF; + function ComputeLength(AAcceptedDeviation: single = 0.1): single; + function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; overload; + function ToPoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; overload; + function GetBounds: TRectF; + procedure Split(out ALeft, ARight: TRationalQuadraticBezierCurve); + property IsInfinite: boolean read GetIsInfinite; + end; + + function BezierCurve(origin, control, destination: TPointF; Aweight:single) : TRationalQuadraticBezierCurve; overload; + +type + TEasyBezierCurveMode= (cmAuto, cmCurve, cmAngle); + TEasyBezierPointTransformFunc = function(APoint: PPointF; AData: Pointer): TPointF of object; + + { TEasyBezierCurve } + + TEasyBezierCurve = object + private + function GetCurveMode(AIndex: integer): TEasyBezierCurveMode; + function GetCurveStartPoint: TPointF; + function GetPoint(AIndex: integer): TPointF; + function GetPointCount: integer; + procedure SetClosed(AValue: boolean); + procedure SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode); + procedure SetMinimumDotProduct(AValue: single); + procedure SetPoint(AIndex: integer; AValue: TPointF); + protected + FCurves: array of record + isCurvedToNext,isCurvedToPrevious: boolean; + Center,ControlPoint,NextCenter: TPointF; + end; + FInvalidated: boolean; + FPoints: array of record + Coord: TPointF; + CurveMode: TEasyBezierCurveMode; + end; + FMinimumDotProduct: single; + FClosed: boolean; + function MaybeCurve(start1, end1, start2, end2: integer): boolean; + procedure ComputeQuadraticCurves; + function PointTransformNone(APoint: PPointF; {%H-}AData: Pointer): TPointF; + function PointTransformOffset(APoint: PPointF; AData: Pointer): TPointF; + public + procedure Init; + procedure Clear; + procedure SetPoints(APoints: array of TPointF; ACurveMode: TEasyBezierCurveMode); overload; + procedure SetPoints(APoints: array of TPointF; ACurveMode: array of TEasyBezierCurveMode); overload; + procedure SetPoints(APoints: array of TPointF; ACurveMode: TEasyBezierCurveMode; AStart, ACount: integer); overload; + procedure SetPoints(APoints: array of TPointF; ACurveMode: array of TEasyBezierCurveMode; AStart, ACount: integer); overload; + procedure CopyToPath(ADest: IBGRAPath); overload; + procedure CopyToPath(ADest: IBGRAPath; AOffset: TPointF; AReverse: boolean = false); overload; + procedure CopyToPath(ADest: IBGRAPath; ATransformFunc: TEasyBezierPointTransformFunc; ATransformData: Pointer; AReverse: boolean = false); overload; + property Point[AIndex: integer]: TPointF read GetPoint write SetPoint; + property CurveMode[AIndex: integer]: TEasyBezierCurveMode read GetCurveMode write SetCurveMode; + property PointCount: integer read GetPointCount; + property MinimumDotProduct: single read FMinimumDotProduct write SetMinimumDotProduct; + property Closed: boolean read FClosed write SetClosed; + property CurveStartPoint: TPointF read GetCurveStartPoint; + function ToPoints: ArrayOfTPointF; + function ComputeLength: single; + end; + +const + EasyBezierDefaultMinimumDotProduct = 0.707; + + function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; ACurveMode: TEasyBezierCurveMode; + AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; + + function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; ACurveMode: array of TEasyBezierCurveMode; + AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; + + function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; ACurveMode: TEasyBezierCurveMode; + AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; + + function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; ACurveMode: array of TEasyBezierCurveMode; + AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +//-------------- Bézier curves definitions ---------------- +// See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve + +// Define a Bézier curve with two control points. +function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve; +begin + result.p1 := origin; + result.c1 := control1; + result.c2 := control2; + result.p2 := destination; +end; + +// Define a Bézier curve with one control point. +function BezierCurve(origin, control, destination: TPointF + ): TQuadraticBezierCurve; +begin + result.p1 := origin; + result.c := control; + result.p2 := destination; +end; + +//straight line +function BezierCurve(origin, destination: TPointF): TQuadraticBezierCurve; +begin + result.p1 := origin; + result.c := (origin+destination)*0.5; + result.p2 := destination; +end; + +// rational Bezier curve +function BezierCurve(origin, control, destination: TPointF; Aweight:single) : TRationalQuadraticBezierCurve; +begin + result.p1 := origin; + result.c := control; + result.p2 := destination; + result.weight := Aweight; +end; + +function ComputeBezierCurvePrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = 0.1): integer; +var + len: single; +begin + len := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y); + len := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)); + len := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)); + Result := round(sqrt(sqrt(len)/ AAcceptedDeviation) * 1); + if Result<=0 then Result:=1; +end; + +{ TCubicBezierCurve } + +function TCubicBezierCurve.SimpleComputePoints(AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +var + t,step: single; + i,nb: Integer; + a,b,c: TpointF; +begin + nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation/2); + if nb <= 1 then nb := 2; + a:=p2-p1+3*(c1-c2); + b:=3*(p1+c2)-6*c1; + c:=3*(c1-p1); + if AIncludeFirstPoint then + begin + setlength(result,nb); + result[0] := p1; + result[nb-1] := p2; + step := 1/(nb-1); + t := 0; + for i := 1 to nb-2 do + begin + IncF(t, step); + result[i] := p1+t*(c+t*(b+t*a)) + end; + end else + begin + setlength(result,nb-1); + result[nb-2] := p2; + step := 1/(nb-1); + t := 0; + for i := 0 to nb-3 do + begin + IncF(t, step); + result[i] := p1+t*(c+t*(b+t*a)) + end; + end; +end; + +function TCubicBezierCurve.ComputePointAt(t: single): TPointF; +var + f1,f2,f3,f4: single; +begin + f1 := (1-t); + f2 := f1*f1; + f1 := f1 * f2; + f2 := f2 * t*3; + f4 := t*t; + f3 := f4*(1-t)*3; + f4 := f4 * t; + + result.x := f1*p1.x + f2*c1.x + + f3*c2.x + f4*p2.x; + result.y := f1*p1.y + f2*c1.y + + f3*c2.y + f4*p2.y; +end; + +procedure TCubicBezierCurve.Split(out ALeft, ARight: TCubicBezierCurve); +var midc: TPointF; +begin + ALeft.p1 := p1; + ALeft.c1 := 0.5*(p1+c1); + ARight.p2 := p2; + ARight.c2 := 0.5*(p2+c2); + midc := 0.5*(c1+c2); + ALeft.c2 := 0.5*(ALeft.c1+midc); + ARight.c1 := 0.5*(ARight.c2+midc); + ALeft.p2 := 0.5*(ALeft.c2+ARight.c1); + ARight.p1 := ALeft.p2; +end; + +function TCubicBezierCurve.ComputeLength(AAcceptedDeviation: single): single; +var + t,step: single; + i,nb: Integer; + curCoord,nextCoord: TPointF; +begin + nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation); + if nb <= 1 then nb := 2; + result := 0; + curCoord := p1; + step := 1/(nb-1); + t := 0; + for i := 1 to nb-2 do + begin + IncF(t, step); + nextCoord := ComputePointAt(t); + IncF(result, VectLen(nextCoord-curCoord)); + curCoord := nextCoord; + end; + IncF(result, VectLen(p2-curCoord)); +end; + +function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +begin + result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint); +end; + +procedure TCubicBezierCurve.CopyToPath(ADest: IBGRAPath); +begin + ADest.lineTo(p1); + ADest.bezierCurveTo(c1,c2,p2); +end; + +{//The following function computes by splitting the curve. It is slower than the simple function. +function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single; + ARelativeDeviation: boolean): ArrayOfTPointF; + function ToPointsRec(const ACurve: TCubicBezierCurve): ArrayOfTPointF; + var simpleLen2: single; + v: TPointF; + left,right: TCubicBezierCurve; + subLeft,subRight: ArrayOfTPointF; + maxDev,dev1,dev2: single; + subLeftLen: integer; + + procedure ComputeExtremum; + begin + raise Exception.Create('Not implemented'); + result := nil; + end; + + begin + v := ACurve.p2-ACurve.p1; + simpleLen2 := v*v; + if simpleLen2 = 0 then + begin + if (ACurve.c1.x = ACurve.p1.x) and (ACurve.c1.y = ACurve.p1.y) and + (ACurve.c2.x = ACurve.p2.x) and (ACurve.c2.y = ACurve.p2.y) then + begin + result := nil; + exit; + end; + ACurve.Split(left,right); + end else + begin + ACurve.Split(left,right); + if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2); + maxDev := AAcceptedDeviation*simpleLen2; + if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1)) <= maxDev then + begin + dev1 := PointF(v.y,-v.x) * (ACurve.c1-ACurve.p1); + dev2 := PointF(v.y,-v.x) * (ACurve.c2-ACurve.p2); + if not ((Sign(dev1)<>Sign(dev2)) and ((abs(dev1) > maxDev) or (abs(dev2) > maxDev))) then + begin + result := nil; + if ((ACurve.c1-ACurve.p1)*v < -maxDev) or + ((ACurve.c1-ACurve.p2)*v > maxDev) or + ((ACurve.c2-ACurve.p1)*v < -maxDev) or + ((ACurve.c2-ACurve.p2)*v > maxDev) then + ComputeExtremum; + exit; + end; + end; + end; + subRight := ToPointsRec(right); + subLeft := ToPointsRec(left); + subLeftLen := length(subLeft); + + //avoid leaving a gap in memory + result := subLeft; + subLeft := nil; + setlength(result, subLeftLen+1+length(subRight)); + result[subLeftLen] := left.p2; + move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF)); + end; + +var + subLen: integer; + +begin + if (c1.x = p1.x) and (c1.y = p1.y) and + (c1.x = c2.x) and (c1.y = c2.y) and + (c1.x = p2.x) and (c1.y = p2.y) then + begin + setlength(result,1); + result[0] := c1; + exit; + end else + begin + result := ToPointsRec(self); + subLen := length(result); + setlength(result, length(result)+2); + move(result[0], result[1], subLen*sizeof(TPointF)); + result[0] := p1; + result[high(result)] := p2; + end; +end;} + +function TCubicBezierCurve.GetBounds: TRectF; +const precision = 1e-5; + + procedure Include(pt: TPointF); + begin + if pt.x < result.Left then result.Left := pt.x + else if pt.x > result.Right then result.Right := pt.x; + if pt.y < result.Top then result.Top := pt.y + else if pt.y > result.Bottom then result.Bottom := pt.y; + end; + + procedure IncludeT(t: single); + begin + if (t > 0) and (t < 1) then + Include(ComputePointAt(t)); + end; + + procedure IncludeABC(a,b,c: single); + var b2ac, sqrtb2ac: single; + begin + if abs(a) < precision then + begin + if abs(b) < precision then exit; + IncludeT(-c/b); + end else + begin + b2ac := sqr(b) - 4 * a * c; + if b2ac >= 0 then + begin + sqrtb2ac := sqrt(b2ac); + IncludeT((-b + sqrtb2ac) / (2 * a)); + IncludeT((-b - sqrtb2ac) / (2 * a)); + end; + end; + end; + +var + va, vb, vc: TPointF; + +begin + result.TopLeft := p1; + result.BottomRight := p1; + Include(p2); + + vb := 6 * p1 - 12 * c1 + 6 * c2; + va := -3 * p1 + 9 * c1 - 9 * c2 + 3 * p2; + vc := 3 * c1 - 3 * p1; + + IncludeABC(va.x,vb.x,vc.x); + IncludeABC(va.y,vb.y,vc.y); +end; + +{ TQuadraticBezierCurve } + +function TQuadraticBezierCurve.SimpleComputePoints(AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +var + t,step: single; + i,nb: Integer; + pA,pB : TpointF; +begin + nb := ComputeBezierCurvePrecision(p1,c,c,p2, AAcceptedDeviation); + if nb <= 1 then nb := 2; + pA := p2+p1-2*c; pB := 2*(c-p1); + if AIncludeFirstPoint then + begin + setlength(result,nb); + result[0] := p1; + result[nb-1] := p2; + step := 1/(nb-1); + t := 0; + for i := 1 to nb-2 do + begin + IncF(t, step); + result[i] := p1+t*(pB+t*pA); + end; + end else + begin + setlength(result,nb-1); + result[nb-2] := p2; + step := 1/(nb-1); + t := 0; + for i := 0 to nb-3 do + begin + IncF(t, step); + result[i] := p1+t*(pB+t*pA); + end; + end; +end; + +function TQuadraticBezierCurve.ComputeExtremumPositionOutsideSegment: single; +var a,b: single; + v: TPointF; +begin + v := self.p2-self.p1; + a := (self.p1-2*self.c+self.p2)*v; + if a = 0 then //no solution + begin + result := -1; + exit; + end; + b := (self.c-self.p1)*v; + result := -b/a; +end; + +function TQuadraticBezierCurve.ComputePointAt(t: single): TPointF; +var + rev_t,f2,t2: single; +begin + rev_t := (1-t); + f2 := rev_t*t*2; + rev_t := rev_t * rev_t; + t2 := t*t; + result.x := rev_t*p1.x + f2*c.x + t2*p2.x; + result.y := rev_t*p1.y + f2*c.y + t2*p2.y; +end; + +procedure TQuadraticBezierCurve.Split(out ALeft, ARight: TQuadraticBezierCurve); +begin + ALeft.p1 := p1; + ALeft.c := 0.5*(p1+c); + ARight.p2 := p2; + ARight.c := 0.5*(p2+c); + ALeft.p2 := 0.5*(ALeft.c+ARight.c); + ARight.p1 := ALeft.p2; +end; + +function TQuadraticBezierCurve.ComputeLength: single; +var a,b: TPointF; + A_,AB_,B_,Sabc,A_2,A_32,B_2,BA, + divisor: single; + extremumPos: single; + extremum: TPointF; +begin + a := p1 - 2*c + p2; + b := 2*(c - p1); + A_ := 4*(a*a); + B_ := b*b; + if (A_ = 0) or (B_ = 0) then + begin + result := VectLen(p2-p1); + exit; + end; + AB_ := 4*(a*b); + + A_2 := sqrt(A_); + B_2 := 2*sqrt(B_); + BA := AB_/A_2; + divisor := BA+B_2; + if divisor <= 0 then + begin + extremumPos:= ComputeExtremumPositionOutsideSegment; + if (extremumPos <= 0) or (extremumPos >= 1) then + result := VectLen(p2-p1) + else + begin + extremum := ComputePointAt(extremumPos); + result := VectLen(extremum-p1)+VectLen(p2-extremum); + end; + exit; + end; + + Sabc := 2*sqrt(A_+AB_+B_); + A_32 := 2*A_*A_2; + result := ( A_32*Sabc + + A_2*AB_*(Sabc-B_2) + + (4*B_*A_-AB_*AB_)*ln( (2*A_2+BA+Sabc)/divisor ) + )/(4*A_32); +end; + +function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +begin + result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint); +end; + +procedure TQuadraticBezierCurve.CopyToPath(ADest: IBGRAPath); +begin + ADest.lineTo(p1); + ADest.quadraticCurveTo(c,p2); +end; + +function TQuadraticBezierCurve.GetBounds: TRectF; +const precision = 1e-5; + + procedure Include(pt: TPointF); + begin + if pt.x < result.Left then result.Left := pt.x + else if pt.x > result.Right then result.Right := pt.x; + if pt.y < result.Top then result.Top := pt.y + else if pt.y > result.Bottom then result.Bottom := pt.y; + end; + + procedure IncludeT(t: single); + begin + if (t > 0) and (t < 1) then + Include(ComputePointAt(t)); + end; + + procedure IncludeABC(a,b,c: single); + var denom: single; + begin + denom := a-2*b+c; + if abs(denom) < precision then exit; + IncludeT((a-b)/denom); + end; + +begin + result.TopLeft := p1; + result.BottomRight := p1; + Include(p2); + + IncludeABC(p1.x,c.x,p2.x); + IncludeABC(p1.y,c.y,p2.y); +end; + +{//The following function computes by splitting the curve. It is slower than the simple function +function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; ARelativeDeviation: boolean): ArrayOfTPointF; + + function ToPointsRec(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; + var simpleLen2: single; + v: TPointF; + left,right: TQuadraticBezierCurve; + subLeft,subRight: ArrayOfTPointF; + subLeftLen: Integer; + + procedure ComputeExtremum; + var + t: single; + begin + t := ACurve.ComputeExtremumPositionOutsideSegment; + if (t <= 0) or (t >= 1) then + result := nil + else + begin + setlength(result,1); + result[0] := ACurve.ComputePointAt(t); + end; + end; + + begin + v := ACurve.p2-ACurve.p1; + simpleLen2 := v*v; + if simpleLen2 = 0 then + begin + if (ACurve.c.x = ACurve.p1.x) and (ACurve.c.y = ACurve.p1.y) then + begin + result := nil; + exit; + end; + ACurve.Split(left,right); + end else + begin + ACurve.Split(left,right); + if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2); + if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1)) + <= AAcceptedDeviation*simpleLen2 then + begin + result := nil; + if ((ACurve.c-ACurve.p1)*v < -AAcceptedDeviation*simpleLen2) or + ((ACurve.c-ACurve.p2)*v > AAcceptedDeviation*simpleLen2) then + ComputeExtremum; + exit; + end; + end; + subRight := ToPointsRec(right); + subLeft := ToPointsRec(left); + subLeftLen := length(subLeft); + + //avoid leaving a gap in memory + result := subLeft; + subLeft := nil; + setlength(result, subLeftLen+1+length(subRight)); + result[subLeftLen] := left.p2; + move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF)); + end; + +var + subLen: integer; + +begin + if (c.x = p1.x) and (c.y = p1.y) and + (c.x = p2.x) and (c.y = p2.y) then + begin + setlength(result,1); + result[0] := c; + exit; + end else + begin + result := ToPointsRec(self); + subLen := length(result); + setlength(result, length(result)+2); + move(result[0], result[1], subLen*sizeof(TPointF)); + result[0] := p1; + result[high(result)] := p2; + end; +end;} + +{ TRationalQuadraticBezierCurve } + +function TRationalQuadraticBezierCurve.GetIsInfinite: boolean; +begin + result:= (weight <= -1); +end; + +function TRationalQuadraticBezierCurve.InternalComputePoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +var + pA,pB : TpointF; + a1,b1: single; + + function InternalComputeAt(t: single): TPointF; + var + den: single; + begin + den := (1+t*(b1+t*a1)); + if den <> 0 then + result := (p1+t*(pB+t*pA))*(1/den) + else + result := EmptyPointF + end; + + procedure ComputeFactors; + var + c2 : TpointF; + c1: single; + begin + c1 := 2*weight; c2 := c1*c; + pA := p2+p1-c2; pB := -2*p1+c2; + a1 := 2-c1; b1 := -a1; + end; + + function ComputeContinuous(t1,t2: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; + var + pointCount: integer; + + procedure AddPoint(APoint: TPointF); + begin + if isEmptyPointF(APoint) then exit; + if pointCount >= length(result) then + setlength(result, pointCount*2+4); + result[pointCount] := APoint; + inc(pointCount); + end; + + procedure ComputeRec(left: single; constref leftPoint: TPointF; right: single; constref rightPoint: TPointF); + var + middlePoint, u: TPointF; + middle, lenU, deviation: Single; + begin + if rightPoint<>leftPoint then + begin + middle := (left+right)*0.5; + middlePoint := InternalComputeAt(middle); + u := rightPoint-leftPoint; + lenU := VectLen(u); + if lenU>0 then u.Scale(1/lenU); + deviation := abs((middlePoint-leftPoint)*PointF(u.y,-u.x)); + if deviation > AAcceptedDeviation then + begin + ComputeRec(left, leftPoint, middle, middlePoint); + AddPoint(middlePoint); + ComputeRec(middle, middlePoint, right, rightPoint); + end else + if deviation > AAcceptedDeviation*0.6 then + AddPoint(middlePoint); + end; + end; + + var + startPoint, endPoint: TPointF; + begin + pointCount := 0; + result:= nil; + startPoint := InternalComputeAt(t1); + endPoint := InternalComputeAt(t2); + if AIncludeFirstPoint then AddPoint(startPoint); + if endPoint <> startPoint then + begin + ComputeRec(t1,startPoint,t2,endPoint); + AddPoint(endPoint); + end; + setlength(result,PointCount); + end; + +var + tSplitA, tSplitB, tSplit1, tSplit2, delta: single; + leftPart,middlePart,rightPart: array of TPointF; + tList: ArrayOfSingle; + parts: array of ArrayOfTPointF; + i: Integer; + + function PointWithinInifiniteBounds(APoint: TPointF): boolean; + begin + result := not isEmptyPointF(APoint) and + (APoint.x > AInfiniteBounds.Left) and (APoint.x < AInfiniteBounds.Right) and + (APoint.y > AInfiniteBounds.Top) and (APoint.y < AInfiniteBounds.Bottom); + end; + +begin + if weight = 0 then exit(PointsF([p1,p2])); + ComputeFactors; + + if weight > -1 then + begin + tList := GetBoundingPositions(true,true); + setlength(parts, length(tList)-1); + for i := 0 to high(parts) do + parts[i] := ComputeContinuous(tList[i],tList[i+1], AIncludeFirstPoint and (i=0)); + result := ConcatPointsF(parts); + end + else + if weight = -1 then + begin + tSplit1 := 0.5; + tSplitA := 0; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; + tSplitB := 1; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit1)*0.5; + + tList := GetBoundingPositions(true,true); + setlength(parts, length(tList)-1); + for i := 0 to high(parts) do + begin + if (tList[i] > tSplitA) and (tList[i+1] <= tSplitB) then parts[i] := nil + else + if (tList[i] <= tSplitA) and (tList[i+1] >= tSplitA) then + begin + parts[i] := ComputeContinuous(tList[i],tSplitA, AIncludeFirstPoint or (i>0)); + setlength(parts[i], length(parts[i])+1); + parts[i][high(parts[i])] := EmptyPointF; + + if tList[i+1] > tSplitB then + parts[i] := ConcatPointsF([parts[i], ComputeContinuous(tSplitB,tList[i+1], true)]) + else + tList[i+1] := tSplitB; + end + else + if (tList[i] < tSplitB) and (tList[i+1] >= tSplitB) then + parts[i] := ComputeContinuous(tSplitB,tList[i+1], AIncludeFirstPoint or (i>0)) + else + parts[i] := ComputeContinuous(tList[i],tList[i+1], AIncludeFirstPoint or (i>0)); + end; + result := ConcatPointsF(parts); + end else + begin + delta:= 1 - 2/(1-weight); + tSplit1 := (1 - sqrt(delta))/2; + tSplit2 := 1-tSplit1; + + tSplitA := 0; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; + leftPart := ComputeContinuous(0, tSplitA, AIncludeFirstPoint); + + tSplitA := (tSplit1+tSplit2)*0.5; + tSplitB := tSplitA; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit2)*0.5; + middlePart := ComputeContinuous(tSplitA, tSplitB, true); + + tSplitB := 1; + while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit2)*0.5; + rightPart:= ComputeContinuous(tSplitB, 1, true); + result := ConcatPointsF([leftPart, PointsF([EmptyPointF]), middlePart, PointsF([EmptyPointF]), rightPart]); + end; +end; + +function TRationalQuadraticBezierCurve.GetBoundingPositions( + AIncludeFirstAndLast: boolean; ASorted: boolean): ArrayOfSingle; +const precision = 1e-6; +var a,delta,sqrtDelta,den,invDen: single; + A_,B_,p2_,c_: TPointF; + posCount : integer; + + procedure Include(t: single); + var + i: Integer; + begin + if (t < 0) or (t > 1) then exit; + for i := 0 to PosCount-1 do + if result[i] = t then exit; + result[posCount] := t; + inc(posCount); + end; + + procedure SortList; + var i,j,k: integer; + temp: single; + begin + for i := 1 to high(result) do + begin + j := i; + while (j > 0) and (result[j-1] > result[i]) do dec(j); + if j <> i then + begin + temp := result[i]; + for k := i downto j+1 do + result[k] := result[k-1]; + result[j] := temp; + end; + end; + end; + +begin + setlength(result, 6); + posCount := 0; + + if AIncludeFirstAndLast then + begin + Include(0); + Include(1); + end; + + p2_ := p2-p1; c_ := c-p1; //translation with -p1 + B_ := 2*weight*c_; A_ := p2_-B_; + a := 2*(1-weight); + + //on Ox + den := a*p2_.x; + if abs(den) >= precision then + begin + delta := sqr(A_.x)+den*B_.x; + if delta >= 0 then + begin + invDen := 1/den; + sqrtDelta := sqrt(delta); + Include( (A_.x-sqrtDelta)*invDen ); + Include( (A_.x+sqrtDelta)*invDen ); + end; + end else //den=0 + if abs(A_.x) >= precision then + Include( -B_.x/A_.x*0.5 ); + + //on Oy + den := a*p2_.y; + if abs(den) >= precision then + begin + delta := sqr(A_.y)+den*B_.y; + if delta >= 0 then + begin + invDen := 1/den; + sqrtDelta := sqrt(delta); + Include( (A_.y-sqrtDelta)*invDen ); + Include( (A_.y+sqrtDelta)*invDen ); + end; + end else //den=0 + if abs(A_.y) >= precision then + Include( -B_.y/A_.y*0.5 ); + + setlength(result, posCount); + if ASorted then SortList; +end; + +function TRationalQuadraticBezierCurve.ComputePointAt(t: single): TPointF; +var + rev_t,f2,t2,den: single; +begin + rev_t := (1-t); + t2 := t*t; + f2 := weight*rev_t*t*2; + rev_t := rev_t * rev_t; + den := rev_t+f2+t2; + if den <> 0 then + begin + result.x := (rev_t*p1.x + f2*c.x + t2*p2.x)/den; + result.y := (rev_t*p1.y + f2*c.y + t2*p2.y)/den; + end + else + result := EmptyPointF +end; + +function TRationalQuadraticBezierCurve.ToPoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single; + AIncludeFirstPoint: boolean = true): ArrayOfTPointF; +begin + if weight=1 then + result := BezierCurve(p1,c,p2).ToPoints(AAcceptedDeviation, AIncludeFirstPoint) + else + result := InternalComputePoints(AInfiniteBounds, AAcceptedDeviation, AIncludeFirstPoint) +end; + +function TRationalQuadraticBezierCurve.GetBounds: TRectF; +var a: single; + A_,B_,p2_,c_: TPointF; + t: single; + tList: array of Single; + i: Integer; + + procedure Include(pt: TPointF); + begin + if pt.x < result.Left then result.Left := pt.x + else if pt.x > result.Right then result.Right := pt.x; + if pt.y < result.Top then result.Top := pt.y + else if pt.y > result.Bottom then result.Bottom := pt.y; + end; + +begin + if weight=1 then exit(BezierCurve(p1,c,p2).GetBounds); + if IsInfinite then exit(EmptyRectF); + tList:= GetBoundingPositions(false,false); + + result.TopLeft := p1; + result.BottomRight := p1; + Include(p2); + + p2_ := p2-p1; c_ := c-p1; //translation with -p1 + B_ := 2*weight*c_; A_ := p2_-B_; + a := 2*(1-weight); + + for i := 0 to high(tList) do + begin + t := tList[i]; + Include( p1+t*(B_+t*A_)*(1/(1+t*(-a+t*a))) ); + end; +end; + +function TRationalQuadraticBezierCurve.ComputeLength(AAcceptedDeviation: single): single; +var i: Integer; + curCoord,nextCoord: TPointF; + pts: ArrayOfTPointF; +begin + if weight = 1 then exit(BezierCurve(p1,c,p2).ComputeLength); + if weight <= -1 then exit(EmptySingle); // no bounds in this case + pts := InternalComputePoints(EmptyRectF, AAcceptedDeviation, true); + curCoord := p1; result:=0; + for i := 1 to high(pts) do + begin + nextCoord := pts[i]; + if (nextCoord <> EmptyPointF) and (curCoord <> EmptyPointF) then + IncF(result, VectLen(nextCoord-curCoord)); + curCoord := nextCoord; + end; + finalize(pts) +end; + +function TRationalQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; + AIncludeFirstPoint: boolean): ArrayOfTPointF; +begin + result := ToPoints(RectF(-64,-64, 16384, 16384), AAcceptedDeviation, AIncludeFirstPoint); +end; + +procedure TRationalQuadraticBezierCurve.Split(out ALeft, ARight: TRationalQuadraticBezierCurve); +const precision=1E-6; +var M, D, E, H, c1, c2: TPointF; + alpha, sg, w: single; + + function Intersec(): TPointF; //dichotomie + var t, t1, t2: single; + U, V: TPointF; + begin + t1 := 0; t2 := 0.5; U := E-c1; + if VectDet(U,p1-c1)>0 then sg := 1 else sg := -1; + while (t2-t1) > precision do //19 iterations + begin + t := (t1+t2)/2; + V := ComputePointAt(t)-c1; + if VectDet(U,V)*sg>0 then t1 := t else t2 := t; + end; + result := ComputePointAt((t1+t2)/2) + end; + +begin + if IsInfinite then raise exception.Create('Cannot split an infinite curve'); + + M := ComputePointAt(0.5); + ALeft.p1 := p1; + ALeft.p2 := M; + ARight.p1 := M; + ARight.p2 := p2; + ALeft.weight := 1; + ARight.weight := 1; + D := 0.5*(p1+p2); + if (weight = 1) or (D = c) then + begin + ALeft.c := 0.5*(p1+c); + ARight.c := 0.5*(p2+c); + exit; + end; + if weight > 0 then + alpha := VectLen(D-M)/VectLen(D-c) + else + alpha := -VectLen(D-M)/VectLen(D-c); + c1 := p1 + alpha*(c-p1); + c2 := p2 + alpha*(c-p2); + ALeft.c := c1; + ARight.c := c2; + E := 0.5*(p1+M); + H := Intersec(); //between [c1;E] and the curve + w := VectLen(E-c1)/VectLen(H-c1)-1; // new weight + ALeft.weight := w; + ARight.weight := w; +end; + +{ TEasyBezierCurve } + +function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; + ACurveMode: TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; +begin + result := EasyBezierCurve(APoints, 0, length(APoints), AClosed, ACurveMode, AMinimumDotProduct); +end; + +function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; + ACurveMode: array of TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; +begin + result := EasyBezierCurve(APoints, 0, length(APoints), AClosed, ACurveMode, AMinimumDotProduct); +end; + +function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; + ACurveMode: TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; +begin + result.Init; + result.SetPoints(APoints, ACurveMode, AStart, ACount); + result.Closed:= AClosed; + result.MinimumDotProduct:= AMinimumDotProduct; +end; + +function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; + ACurveMode: array of TEasyBezierCurveMode; + AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; +begin + result.Init; + result.SetPoints(APoints, ACurveMode, AStart, ACount); + result.Closed:= AClosed; + result.MinimumDotProduct:= AMinimumDotProduct; +end; + +procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath; ATransformFunc: TEasyBezierPointTransformFunc; + ATransformData: Pointer; AReverse: boolean); +var i: integer; + nextMove: boolean; + pt,startCoord: TPointF; +begin + if PointCount = 0 then exit; + if (FCurves = nil) or FInvalidated then ComputeQuadraticCurves; + nextMove := true; + + if AReverse then + begin + for i := PointCount-1 downto 0 do + begin + pt := Point[i]; + if isEmptyPointF(pt) then + begin + if not nextMove and FClosed then ADest.closePath; + nextMove := true; + end else + begin + pt := Point[i]; + with FCurves[i] do + begin + if isCurvedToNext then + begin + if nextMove then + begin + ADest.moveTo(ATransformFunc(@NextCenter,ATransformData)); + nextMove := false; + end; + ADest.quadraticCurveTo(ATransformFunc(@ControlPoint,ATransformData),ATransformFunc(@Center,ATransformData)); + end; + if not isCurvedToPrevious then + begin + if nextMove then + begin + ADest.moveTo(ATransformFunc(@pt,ATransformData)); + nextMove := false; + end else + ADest.lineTo(ATransformFunc(@pt,ATransformData)); + end; + end; + end; + end; + end else + begin + for i := 0 to PointCount-1 do + begin + pt := Point[i]; + if isEmptyPointF(pt) then + begin + if not nextMove and FClosed then ADest.closePath; + nextMove := true; + end else + begin + with FCurves[i] do + begin + if nextMove then + begin + if not isCurvedToPrevious then + startCoord := pt + else + startCoord := Center; + ADest.moveTo(ATransformFunc(@startCoord,ATransformData)); + nextMove := false; + end else + if not isCurvedToPrevious then + ADest.lineTo(ATransformFunc(@pt,ATransformData)); + + if isCurvedToNext then + begin + if not isCurvedToPrevious then ADest.lineTo(ATransformFunc(@Center,ATransformData)); + ADest.quadraticCurveTo(ATransformFunc(@ControlPoint,ATransformData),ATransformFunc(@NextCenter,ATransformData)); + end; + end; + end; + end; + end; + if not nextMove and FClosed then ADest.closePath; +end; + +function TEasyBezierCurve.ToPoints: ArrayOfTPointF; +var p: TBGRACustomPath; +begin + if not Assigned(BGRAPathFactory) then raise exception.Create('BGRAPath unit needed'); + p := BGRAPathFactory.Create; + CopyToPath(p); + result := p.getPoints; + p.Free; +end; + +function TEasyBezierCurve.ComputeLength: single; +var p: TBGRACustomPath; +begin + if not Assigned(BGRAPathFactory) then raise exception.Create('BGRAPath unit needed'); + p := BGRAPathFactory.Create; + CopyToPath(p); + result := p.getLength; + p.Free; +end; + +procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath); +begin + CopyToPath(ADest, @PointTransformNone, nil); +end; + +procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath; AOffset: TPointF; AReverse: boolean); +begin + CopyToPath(ADest, @PointTransformOffset, @AOffset, AReverse); +end; + +procedure TEasyBezierCurve.ComputeQuadraticCurves; +var + i,FirstPointIndex,NextPt,NextPt2: integer; +begin + setlength(FCurves, PointCount); + FirstPointIndex := 0; + for i := 0 to PointCount-1 do + FCurves[i].isCurvedToPrevious := false; + for i := 0 to PointCount-1 do + begin + FCurves[i].isCurvedToNext := false; + FCurves[i].Center := EmptyPointF; + FCurves[i].ControlPoint := EmptyPointF; + FCurves[i].NextCenter := EmptyPointF; + + if IsEmptyPointF(Point[i]) then + begin + FirstPointIndex := i+1; + end else + begin + NextPt := i+1; + if (NextPt = PointCount) or isEmptyPointF(Point[NextPt]) then NextPt := FirstPointIndex; + NextPt2 := NextPt+1; + if (NextPt2 = PointCount) or isEmptyPointF(Point[NextPt2]) then NextPt2 := FirstPointIndex; + + FCurves[i].Center := (Point[i]+Point[NextPt])*0.5; + FCurves[i].NextCenter := (Point[NextPt]+Point[NextPt2])*0.5; + FCurves[i].ControlPoint := Point[NextPt]; + + if (i < PointCount-2) or FClosed then + begin + case CurveMode[nextPt] of + cmAuto: FCurves[i].isCurvedToNext:= MaybeCurve(i,NextPt,NextPt,NextPt2); + cmCurve: FCurves[i].isCurvedToNext:= true; + else FCurves[i].isCurvedToNext:= false; + end; + FCurves[NextPt].isCurvedToPrevious := FCurves[i].isCurvedToNext; + end; + end; + end; + FInvalidated:= false; +end; + +function TEasyBezierCurve.PointTransformNone(APoint: PPointF; AData: Pointer): TPointF; +begin + result := APoint^; +end; + +function TEasyBezierCurve.PointTransformOffset(APoint: PPointF; AData: Pointer): TPointF; +begin + result := APoint^ + PPointF(AData)^; +end; + +procedure TEasyBezierCurve.Init; +begin + FClosed := false; + FMinimumDotProduct:= EasyBezierDefaultMinimumDotProduct; + FPoints := nil; + FInvalidated := true; +end; + +procedure TEasyBezierCurve.Clear; +begin + FPoints := nil; +end; + +procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; + ACurveMode: TEasyBezierCurveMode); +begin + SetPoints(APoints, ACurveMode, 0, length(APoints)); +end; + +procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; + ACurveMode: array of TEasyBezierCurveMode); +begin + SetPoints(APoints, ACurveMode, 0, length(APoints)); +end; + +procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; + ACurveMode: TEasyBezierCurveMode; AStart, ACount: integer); +var + i: Integer; +begin + if (AStart < 0) or (AStart+ACount > length(APoints)) then + raise exception.Create('Index out of bounds'); + setlength(FPoints, ACount); + for i := 0 to ACount-1 do + begin + FPoints[i].Coord := APoints[AStart + i]; + FPoints[i].CurveMode:= ACurveMode; + end; + FInvalidated:= true; +end; + +procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; + ACurveMode: array of TEasyBezierCurveMode; AStart, ACount: integer); +var + i,j: Integer; +begin + if (AStart < 0) or (AStart+ACount > length(APoints)) then + raise exception.Create('Index out of bounds'); + setlength(FPoints, ACount); + if length(ACurveMode) > 0 then + j := AStart mod length(ACurveMode); + for i := 0 to ACount-1 do + begin + FPoints[i].Coord := APoints[i + AStart]; + if length(ACurveMode) = 0 then + FPoints[i].CurveMode:= cmAuto + else + begin + FPoints[i].CurveMode:= ACurveMode[j]; + inc(j); + if j = length(ACurveMode) then j := 0; + end; + end; + FInvalidated:= true; +end; + +function TEasyBezierCurve.GetCurveMode(AIndex: integer): TEasyBezierCurveMode; +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + result:= FPoints[AIndex].CurveMode; +end; + +function TEasyBezierCurve.GetCurveStartPoint: TPointF; +begin + if (PointCount=0) or isEmptyPointF(Point[0]) then exit(EmptyPointF); + if FInvalidated or (FCurves = nil) then ComputeQuadraticCurves; + if not FCurves[0].isCurvedToPrevious then + result := Point[0] + else + result := FCurves[0].Center; +end; + +function TEasyBezierCurve.GetPoint(AIndex: integer): TPointF; +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + result:= FPoints[AIndex].Coord; +end; + +function TEasyBezierCurve.GetPointCount: integer; +begin + result:= length(FPoints); +end; + +procedure TEasyBezierCurve.SetClosed(AValue: boolean); +begin + if FClosed=AValue then Exit; + FClosed:=AValue; + FInvalidated:= true; +end; + +procedure TEasyBezierCurve.SetCurveMode(AIndex: integer; + AValue: TEasyBezierCurveMode); +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + if FPoints[AIndex].CurveMode = AValue then exit; + FPoints[AIndex].CurveMode := AValue; + FInvalidated:= true; +end; + +procedure TEasyBezierCurve.SetMinimumDotProduct(AValue: single); +begin + if FMinimumDotProduct=AValue then Exit; + FMinimumDotProduct:=AValue; + FInvalidated:= true; +end; + +procedure TEasyBezierCurve.SetPoint(AIndex: integer; AValue: TPointF); +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + if FPoints[AIndex].Coord = AValue then exit; + FPoints[AIndex].Coord := AValue; + FInvalidated:= true; +end; + +function TEasyBezierCurve.MaybeCurve(start1,end1,start2,end2: integer): boolean; +var + u,v: TPointF; + lu,lv: single; +begin + if (start1=-1) or (end1=-1) or (start2=-1) or (end2=-1) then + begin + result := false; + exit; + end; + u := pointF(Point[end1].x - Point[start1].x, Point[end1].y - Point[start1].y); + lu := sqrt(u*u); + if lu <> 0 then u.Scale(1/lu); + v := pointF(Point[end2].x - Point[start2].x, Point[end2].y - Point[start2].y); + lv := sqrt(v*v); + if lv <> 0 then v.Scale(1/lv); + + result := u*v > FMinimumDotProduct; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraanimatedgif.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraanimatedgif.pas new file mode 100644 index 0000000..16c17a4 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraanimatedgif.pas @@ -0,0 +1,1225 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAAnimatedGif; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, FPImage, BGRABitmap, BGRABitmapTypes, + BGRAPalette, BGRAGifFormat; + +type + TDisposeMode = BGRAGifFormat.TDisposeMode; + TGifSubImage = BGRAGifFormat.TGifSubImage; + TGifSubImageArray = BGRAGifFormat.TGifSubImageArray; + + //how to deal with the background under the GIF animation + TGifBackgroundMode = (gbmSimplePaint, gbmEraseBackground, + gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously); + + { TBGRAAnimatedGif } + + TBGRAAnimatedGif = class(TGraphic) + private + FAspectRatio: single; + FWidth, FHeight: integer; + FBackgroundColor: TColor; + + FPrevDate: TDateTime; + FPaused: boolean; + FTimeAccumulator: double; + FCurrentImage, FWantedImage: integer; + FTotalAnimationTime: int64; + FPreviousDisposeMode: TDisposeMode; + + FBackgroundImage, FPreviousVirtualScreen, FStretchedVirtualScreen, + FInternalVirtualScreen, FRestoreImage: TBGRABitmap; + FImageChanged: boolean; + + procedure CheckFrameIndex(AIndex: integer); + function GetAverageDelayMs: integer; + function GetCount: integer; + function GetFrameDelayMs(AIndex: integer): integer; + function GetFrameDisposeMode(AIndex: integer): TDisposeMode; + function GetFrameHasLocalPalette(AIndex: integer): boolean; + function GetFrameImage(AIndex: integer): TBGRABitmap; + function GetFrameImagePos(AIndex: integer): TPoint; + function GetTimeUntilNextImage: integer; + procedure Render(StretchWidth, StretchHeight: integer); + procedure SetAspectRatio(AValue: single); + procedure SetBackgroundColor(AValue: TColor); + procedure SetFrameDelayMs(AIndex: integer; AValue: integer); + procedure SetFrameDisposeMode(AIndex: integer; AValue: TDisposeMode); + procedure SetFrameHasLocalPalette(AIndex: integer; AValue: boolean); + procedure SetFrameImage(AIndex: integer; AValue: TBGRABitmap); + procedure SetFrameImagePos(AIndex: integer; AValue: TPoint); + procedure UpdateSimple(Canvas: TCanvas; ARect: TRect; + DrawOnlyIfChanged: boolean = True); + procedure UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; + DrawOnlyIfChanged: boolean = True); + procedure Init; + function GetBitmap: TBitmap; + function GetMemBitmap: TBGRABitmap; + procedure SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); + procedure SetCurrentImage(Index: integer); + + protected + FImages: TGifSubImageArray; + + {TGraphic} + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; + function GetEmpty: boolean; override; + function GetHeight: integer; override; + function GetTransparent: boolean; override; + function GetWidth: integer; override; + procedure SetHeight({%H-}Value: integer); override; + procedure SetTransparent({%H-}Value: boolean); override; + procedure SetWidth({%H-}Value: integer); override; + procedure ClearViewer; virtual; + + public + EraseColor: TColor; + BackgroundMode: TGifBackgroundMode; + LoopCount: Word; + LoopDone: Integer; + + constructor Create(filenameUTF8: string); overload; + constructor Create(stream: TStream); overload; + constructor Create(stream: TStream; AMaxImageCount: integer); overload; + constructor Create; overload; override; + function Duplicate: TBGRAAnimatedGif; + function AddFrame(AImage: TFPCustomImage; X,Y: integer; ADelayMs: integer; + ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false) : integer; + procedure InsertFrame(AIndex: integer; AImage: TFPCustomImage; X,Y: integer; ADelayMs: integer; + ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false); + procedure DeleteFrame(AIndex: integer; AEnsureNextFrameDoesNotChange: boolean); + + //add a frame that replaces completely the previous one + function AddFullFrame(AImage: TFPCustomImage; ADelayMs: integer; + AHasLocalPalette: boolean = true): integer; + procedure InsertFullFrame(AIndex: integer; + AImage: TFPCustomImage; ADelayMs: integer; + AHasLocalPalette: boolean = true); + procedure ReplaceFullFrame(AIndex: integer; + AImage: TFPCustomImage; ADelayMs: integer; + AHasLocalPalette: boolean = true); + + {TGraphic} + procedure LoadFromStream(Stream: TStream); overload; override; + procedure LoadFromStream(Stream: TStream; AMaxImageCount: integer); overload; + procedure LoadFromResource(AFilename: string); + procedure SaveToStream(Stream: TStream); overload; override; + procedure LoadFromFile(const AFilenameUTF8: string); override; + procedure SaveToFile(const AFilenameUTF8: string); override; + class function GetFileExtensions: string; override; + + procedure SetSize(AWidth,AHeight: integer); virtual; + procedure SaveToStream(Stream: TStream; AQuantizer: TBGRAColorQuantizerAny; + ADitheringAlgorithm: TDitheringAlgorithm); overload; virtual; + procedure Clear; override; + destructor Destroy; override; + procedure Pause; + procedure Resume; + + procedure Show(Canvas: TCanvas; ARect: TRect); overload; + procedure Update(Canvas: TCanvas; ARect: TRect); overload; + procedure Hide(Canvas: TCanvas; ARect: TRect); overload; + + property BackgroundColor: TColor Read FBackgroundColor write SetBackgroundColor; + property Count: integer Read GetCount; + property Width: integer Read FWidth; + property Height: integer Read FHeight; + property Paused: boolean Read FPaused; + property Bitmap: TBitmap Read GetBitmap; + property MemBitmap: TBGRABitmap Read GetMemBitmap; + property CurrentImage: integer Read FCurrentImage Write SetCurrentImage; + property TimeUntilNextImageMs: integer read GetTimeUntilNextImage; + property FrameImage[AIndex: integer]: TBGRABitmap read GetFrameImage write SetFrameImage; + property FrameHasLocalPalette[AIndex: integer]: boolean read GetFrameHasLocalPalette write SetFrameHasLocalPalette; + property FrameImagePos[AIndex: integer]: TPoint read GetFrameImagePos write SetFrameImagePos; + property FrameDelayMs[AIndex: integer]: integer read GetFrameDelayMs write SetFrameDelayMs; + property FrameDisposeMode[AIndex: integer]: TDisposeMode read GetFrameDisposeMode write SetFrameDisposeMode; + property AspectRatio: single read FAspectRatio write SetAspectRatio; + property TotalAnimationTimeMs: Int64 read FTotalAnimationTime; + property AverageDelayMs: integer read GetAverageDelayMs; + end; + + { TBGRAReaderGIF } + + TBGRAReaderGIF = class(TFPCustomImageReader) + protected + procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; + function InternalCheck(Str: TStream): boolean; override; + end; + + { TBGRAWriterGIF } + + TBGRAWriterGIF = class(TFPCustomImageWriter) + protected + procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; + end; + +const + GifBackgroundModeStr: array[TGifBackgroundMode] of string = + ('gbmSimplePaint', 'gbmEraseBackground', 'gbmSaveBackgroundOnce', + 'gbmUpdateBackgroundContinuously'); + +implementation + +uses BGRABlend, BGRAUTF8{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; + +const + {$IFDEF ENDIAN_LITTLE} + AlphaMask = $FF000000; + {$ELSE} + AlphaMask = $000000FF; + {$ENDIF} + + +{ TBGRAAnimatedGif } + +class function TBGRAAnimatedGif.GetFileExtensions: string; +begin + Result := 'gif'; +end; + +procedure TBGRAAnimatedGif.SetSize(AWidth, AHeight: integer); +begin + ClearViewer; + FWidth := AWidth; + FHeight := AHeight; +end; + +procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream; + AQuantizer: TBGRAColorQuantizerAny; + ADitheringAlgorithm: TDitheringAlgorithm); +var data: TGIFData; +begin + data.Height:= Height; + data.Width := Width; + data.AspectRatio := 1; + data.BackgroundColor := BackgroundColor; + data.Images := FImages; + data.LoopCount := LoopCount; + GIFSaveToStream(data, Stream, AQuantizer, ADitheringAlgorithm); +end; + +procedure TBGRAAnimatedGif.Render(StretchWidth, StretchHeight: integer); +var + curDate: TDateTime; + previousImage, nextImage: integer; + +begin + if FInternalVirtualScreen = nil then + begin + FInternalVirtualScreen := TBGRABitmap.Create(FWidth, FHeight); + if (Count = 0) and (BackgroundColor <> clNone) then + FInternalVirtualScreen.Fill(BackgroundColor) + else + FInternalVirtualScreen.Fill(BGRAPixelTransparent); + FImageChanged := True; + end; + + if Count = 0 then + exit; + + previousImage := FCurrentImage; + + curDate := Now; + if FWantedImage <> -1 then + begin + nextImage := FWantedImage; + FTimeAccumulator := 0; + FWantedImage := -1; + end + else + if FCurrentImage = -1 then + begin + nextImage := 0; + FTimeAccumulator := 0; + FPreviousDisposeMode := dmNone; + end + else + begin + if not FPaused then + IncF(FTimeAccumulator, (curDate - FPrevDate) * 24 * 60 * 60 * 1000); + if FTotalAnimationTime > 0 then FTimeAccumulator:= frac(FTimeAccumulator/FTotalAnimationTime)*FTotalAnimationTime; + nextImage := FCurrentImage; + while FTimeAccumulator > FImages[nextImage].DelayMs do + begin + DecF(FTimeAccumulator, FImages[nextImage].DelayMs); + Inc(nextImage); + if nextImage >= Count then + begin + if (LoopCount > 0) and (LoopDone >= LoopCount-1) then + begin + LoopDone := LoopCount; + dec(nextImage); + break; + end else + begin + nextImage := 0; + inc(LoopDone); + end; + end; + + if nextImage = previousImage then + begin + if not ((LoopCount > 0) and (LoopDone >= LoopCount-1)) then + begin + Inc(nextImage); + if nextImage >= Count then + nextImage := 0; + end; + break; + end; + end; + end; + FPrevDate := curDate; + + while FCurrentImage <> nextImage do + begin + Inc(FCurrentImage); + if FCurrentImage >= Count then + begin + FCurrentImage := 0; + FPreviousDisposeMode := dmErase; + end; + + case FPreviousDisposeMode of + dmErase: FInternalVirtualScreen.Fill(BGRAPixelTransparent); + dmRestore: if FRestoreImage <> nil then + FInternalVirtualScreen.PutImage(0, 0, FRestoreImage, dmSet); + end; + + with FImages[FCurrentImage] do + begin + if disposeMode = dmRestore then + begin + if FRestoreImage = nil then + FRestoreImage := TBGRABitmap.Create(FWidth, FHeight); + FRestoreImage.PutImage(0, 0, FInternalVirtualScreen, dmSet); + end; + + if Image <> nil then + FInternalVirtualScreen.PutImage(Position.X, Position.Y, Image, + dmSetExceptTransparent); + FPreviousDisposeMode := DisposeMode; + end; + + FImageChanged := True; + previousImage := FCurrentImage; + FInternalVirtualScreen.InvalidateBitmap; + end; + + if FStretchedVirtualScreen <> nil then + FStretchedVirtualScreen.FreeReference; + if (FInternalVirtualScreen.Width = StretchWidth) and + (FInternalVirtualScreen.Height = StretchHeight) then + FStretchedVirtualScreen := TBGRABitmap(FInternalVirtualScreen.NewReference) + else + FStretchedVirtualScreen := + TBGRABitmap(FInternalVirtualScreen.Resample(StretchWidth, StretchHeight)); +end; + +procedure TBGRAAnimatedGif.SetAspectRatio(AValue: single); +begin + if AValue < 0.25 then AValue := 0.25; + if AValue > 4 then AValue := 4; + if FAspectRatio=AValue then Exit; + FAspectRatio:=AValue; +end; + +procedure TBGRAAnimatedGif.SetBackgroundColor(AValue: TColor); +begin + if FBackgroundColor=AValue then Exit; + FBackgroundColor:=AValue; +end; + +procedure TBGRAAnimatedGif.SetFrameDelayMs(AIndex: integer; AValue: integer); +begin + CheckFrameIndex(AIndex); + if AValue < 0 then AValue := 0; + FTotalAnimationTime := FTotalAnimationTime + AValue - FImages[AIndex].DelayMs; + FImages[AIndex].DelayMs := AValue; +end; + +procedure TBGRAAnimatedGif.SetFrameDisposeMode(AIndex: integer; + AValue: TDisposeMode); +begin + CheckFrameIndex(AIndex); + FImages[AIndex].DisposeMode := AValue; +end; + +procedure TBGRAAnimatedGif.SetFrameHasLocalPalette(AIndex: integer; + AValue: boolean); +begin + CheckFrameIndex(AIndex); + FImages[AIndex].HasLocalPalette := AValue; + +end; + +procedure TBGRAAnimatedGif.SetFrameImage(AIndex: integer; AValue: TBGRABitmap); +var ACopy: TBGRABitmap; +begin + CheckFrameIndex(AIndex); + ACopy := AValue.Duplicate; + FImages[AIndex].Image.FreeReference; + FImages[AIndex].Image := ACopy; +end; + +procedure TBGRAAnimatedGif.SetFrameImagePos(AIndex: integer; AValue: TPoint); +begin + CheckFrameIndex(AIndex); + FImages[AIndex].Position := AValue; +end; + +procedure TBGRAAnimatedGif.UpdateSimple(Canvas: TCanvas; ARect: TRect; + DrawOnlyIfChanged: boolean = True); +begin + if FPreviousVirtualScreen <> nil then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end; + + Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); + if FImageChanged then + begin + FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, False); + FImageChanged := False; + end + else + if not DrawOnlyIfChanged then + FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, False); + + FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.NewReference); +end; + +procedure TBGRAAnimatedGif.CheckFrameIndex(AIndex: integer); +begin + if (AIndex < 0) or (AIndex >= Count) then Raise ERangeError.Create('Index out of bounds'); +end; + +function TBGRAAnimatedGif.GetAverageDelayMs: integer; +var sum: int64; + i: Integer; +begin + if Count > 0 then + begin + sum := 0; + for i := 0 to Count-1 do + inc(sum, FrameDelayMs[i]); + result := sum div Count; + end else + result := 100; //default +end; + +function TBGRAAnimatedGif.GetCount: integer; +begin + Result := length(FImages); +end; + +function TBGRAAnimatedGif.GetFrameDelayMs(AIndex: integer): integer; +begin + CheckFrameIndex(AIndex); + result := FImages[AIndex].DelayMs; +end; + +function TBGRAAnimatedGif.GetFrameDisposeMode(AIndex: integer): TDisposeMode; +begin + CheckFrameIndex(AIndex); + result := FImages[AIndex].DisposeMode; +end; + +function TBGRAAnimatedGif.GetFrameHasLocalPalette(AIndex: integer): boolean; +begin + CheckFrameIndex(AIndex); + result := FImages[AIndex].HasLocalPalette; +end; + +function TBGRAAnimatedGif.GetFrameImage(AIndex: integer): TBGRABitmap; +begin + CheckFrameIndex(AIndex); + result := FImages[AIndex].Image; +end; + +function TBGRAAnimatedGif.GetFrameImagePos(AIndex: integer): TPoint; +begin + CheckFrameIndex(AIndex); + result := FImages[AIndex].Position; +end; + +function TBGRAAnimatedGif.GetTimeUntilNextImage: integer; +var + acc: double; +begin + if Count <= 1 then result := 60*1000 else + if (FWantedImage <> -1) or (FCurrentImage = -1) then + result := 0 + else + begin + acc := FTimeAccumulator; + if not FPaused then IncF(acc, (Now- FPrevDate) * 24 * 60 * 60 * 1000); + if acc >= FImages[FCurrentImage].DelayMs then + result := 0 + else + result := round(FImages[FCurrentImage].DelayMs-FTimeAccumulator); + end; +end; + +constructor TBGRAAnimatedGif.Create(filenameUTF8: string); +begin + inherited Create; + Init; + LoadFromFile(filenameUTF8); +end; + +constructor TBGRAAnimatedGif.Create(stream: TStream); +begin + inherited Create; + Init; + LoadFromStream(stream); +end; + +constructor TBGRAAnimatedGif.Create(stream: TStream; AMaxImageCount: integer); +begin + inherited Create; + Init; + LoadFromStream(stream, AMaxImageCount); +end; + +constructor TBGRAAnimatedGif.Create; +begin + inherited Create; + Init; + LoadFromStream(nil); +end; + +function TBGRAAnimatedGif.Duplicate: TBGRAAnimatedGif; +var + i: integer; +begin + Result := TBGRAAnimatedGif.Create; + setlength(Result.FImages, length(FImages)); + for i := 0 to high(FImages) do + begin + Result.FImages[i] := FImages[i]; + FImages[i].Image.NewReference; + end; + Result.FWidth := FWidth; + Result.FHeight := FHeight; + Result.FBackgroundColor := FBackgroundColor; +end; + +function TBGRAAnimatedGif.AddFrame(AImage: TFPCustomImage; X, Y: integer; + ADelayMs: integer; ADisposeMode: TDisposeMode; AHasLocalPalette: boolean + ): integer; +begin + result := length(FImages); + setlength(FImages, length(FImages)+1); + if ADelayMs < 0 then ADelayMs:= 0; + with FImages[result] do + begin + Image := TBGRABitmap.Create(AImage); + Position := Point(x,y); + DelayMs := ADelayMs; + HasLocalPalette := AHasLocalPalette; + DisposeMode := ADisposeMode; + end; + inc(FTotalAnimationTime, ADelayMs); +end; + +procedure TBGRAAnimatedGif.InsertFrame(AIndex: integer; AImage: TFPCustomImage; X, + Y: integer; ADelayMs: integer; ADisposeMode: TDisposeMode; + AHasLocalPalette: boolean); +var i: integer; +begin + if (AIndex < 0) or (AIndex > Count) then + raise ERangeError.Create('Index out of bounds'); + setlength(FImages, length(FImages)+1); + if ADelayMs < 0 then ADelayMs:= 0; + for i := high(FImages) downto AIndex+1 do + FImages[i] := FImages[i-1]; + with FImages[AIndex] do + begin + Image := TBGRABitmap.Create(AImage); + Position := Point(x,y); + DelayMs := ADelayMs; + HasLocalPalette := AHasLocalPalette; + DisposeMode := ADisposeMode; + end; + inc(FTotalAnimationTime, ADelayMs); +end; + +function TBGRAAnimatedGif.AddFullFrame(AImage: TFPCustomImage; + ADelayMs: integer; AHasLocalPalette: boolean): integer; +begin + if (AImage.Width <> Width) or (AImage.Height <> Height) then + raise exception.Create('Size mismatch'); + if Count > 0 then + FrameDisposeMode[Count-1] := dmErase; + result := AddFrame(AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); +end; + +procedure TBGRAAnimatedGif.InsertFullFrame(AIndex: integer; + AImage: TFPCustomImage; ADelayMs: integer; AHasLocalPalette: boolean); +var nextImage: TBGRABitmap; +begin + if (AIndex < 0) or (AIndex > Count) then + raise ERangeError.Create('Index out of bounds'); + + if AIndex = Count then + AddFullFrame(AImage, ADelayMs, AHasLocalPalette) + else + begin + //if previous image did not clear up, ensure that + //next image will stay the same + if (AIndex > 0) and (FrameDisposeMode[AIndex-1] <> dmErase) then + begin + CurrentImage := AIndex; + nextImage := MemBitmap.Duplicate; + FrameImagePos[AIndex] := Point(0,0); + FrameImage[AIndex] := nextImage; + FrameHasLocalPalette[AIndex] := true; + FreeAndNil(nextImage); + + FrameDisposeMode[AIndex-1] := dmErase; + end; + + InsertFrame(AIndex, AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); + end; +end; + +procedure TBGRAAnimatedGif.ReplaceFullFrame(AIndex: integer; + AImage: TFPCustomImage; ADelayMs: integer; AHasLocalPalette: boolean); +begin + DeleteFrame(AIndex, True); + if AIndex > 0 then FrameDisposeMode[AIndex-1] := dmErase; + InsertFrame(AIndex, AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); +end; + +procedure TBGRAAnimatedGif.DeleteFrame(AIndex: integer; + AEnsureNextFrameDoesNotChange: boolean); +var + nextImage: TBGRABitmap; + i: Integer; +begin + CheckFrameIndex(AIndex); + + //if this frame did not clear up, ensure that + //next image will stay the same + if AEnsureNextFrameDoesNotChange and + ((AIndex < Count-1) and (FrameDisposeMode[AIndex] <> dmErase)) then + begin + CurrentImage := AIndex+1; + nextImage := MemBitmap.Duplicate; + FrameImagePos[AIndex+1] := Point(0,0); + FrameImage[AIndex+1] := nextImage; + FrameHasLocalPalette[AIndex+1] := true; + FreeAndNil(nextImage); + end; + + dec(FTotalAnimationTime, FImages[AIndex].DelayMs); + + FImages[AIndex].Image.FreeReference; + for i := AIndex to Count-2 do + FImages[i] := FImages[i+1]; + SetLength(FImages, Count-1); + + if (CurrentImage >= Count) then + CurrentImage := 0; +end; + +procedure TBGRAAnimatedGif.LoadFromStream(Stream: TStream); +begin + LoadFromStream(Stream, maxLongint); +end; + +procedure TBGRAAnimatedGif.LoadFromStream(Stream: TStream; + AMaxImageCount: integer); +var data: TGIFData; + i: integer; +begin + data := GIFLoadFromStream(Stream, AMaxImageCount); + + ClearViewer; + Clear; + FWidth := data.Width; + FHeight := data.Height; + FBackgroundColor := data.BackgroundColor; + FAspectRatio:= data.AspectRatio; + LoopDone := 0; + LoopCount := data.LoopCount; + + SetLength(FImages, length(data.Images)); + FTotalAnimationTime:= 0; + for i := 0 to high(FImages) do + begin + FImages[i] := data.Images[i]; + inc(FTotalAnimationTime, FImages[i].DelayMs); + end; +end; + +procedure TBGRAAnimatedGif.LoadFromResource(AFilename: string); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream); +begin + SaveToStream(Stream, BGRAColorQuantizerFactory, daFloydSteinberg); +end; + +procedure TBGRAAnimatedGif.LoadFromFile(const AFilenameUTF8: string); +var stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(stream); + finally + Stream.Free; + end; +end; + +procedure TBGRAAnimatedGif.SaveToFile(const AFilenameUTF8: string); +var + Stream: TFileStreamUTF8; +begin + Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TBGRAAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect); +begin + if FBackgroundImage <> nil then + FreeAndNil(FBackgroundImage); + SaveBackgroundOnce(ACanvas, Rect); + + if FPreviousVirtualScreen <> nil then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end; + + Render(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top); + FStretchedVirtualScreen.Draw(ACanvas, Rect.Left, Rect.Top, false); + FImageChanged := False; + + FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.Duplicate); +end; + +function TBGRAAnimatedGif.GetEmpty: boolean; +begin + Result := (length(FImages) = 0); +end; + +function TBGRAAnimatedGif.GetHeight: integer; +begin + Result := FHeight; +end; + +function TBGRAAnimatedGif.GetTransparent: boolean; +begin + Result := True; +end; + +function TBGRAAnimatedGif.GetWidth: integer; +begin + Result := FWidth; +end; + +procedure TBGRAAnimatedGif.SetHeight(Value: integer); +begin + //not implemented +end; + +procedure TBGRAAnimatedGif.SetTransparent(Value: boolean); +begin + //not implemented +end; + +procedure TBGRAAnimatedGif.SetWidth(Value: integer); +begin + //not implemented +end; + +procedure TBGRAAnimatedGif.ClearViewer; +begin + FCurrentImage := -1; + FWantedImage := -1; + FTimeAccumulator := 0; + + if FStretchedVirtualScreen <> nil then + FStretchedVirtualScreen.FreeReference; + if FPreviousVirtualScreen <> nil then + FPreviousVirtualScreen.FreeReference; + FInternalVirtualScreen.Free; + FRestoreImage.Free; + FBackgroundImage.Free; + + FInternalVirtualScreen := nil; + FStretchedVirtualScreen := nil; + FRestoreImage := nil; + FBackgroundImage := nil; + FPreviousVirtualScreen := nil; + + FPreviousDisposeMode := dmNone; +end; + +procedure TBGRAAnimatedGif.SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); +begin + if (FBackgroundImage <> nil) and + ((FBackgroundImage.Width <> ARect.Right - ARect.Left) or + (FBackgroundImage.Height <> ARect.Bottom - ARect.Top)) then + FreeAndNil(FBackgroundImage); + + if (BackgroundMode in [gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously]) and + (FBackgroundImage = nil) then + begin + FBackgroundImage := TBGRABitmap.Create(ARect.Right - ARect.Left, + ARect.Bottom - ARect.Top); + FBackgroundImage.GetImageFromCanvas(Canvas, ARect.Left, ARect.Top); + end; +end; + +procedure TBGRAAnimatedGif.SetCurrentImage(Index: integer); +begin + if (Index >= 0) and (Index < Length(FImages)) then + FWantedImage := Index; +end; + +procedure TBGRAAnimatedGif.Clear; +var + i: integer; +begin + inherited Clear; + + for i := 0 to Count - 1 do + FImages[i].Image.FreeReference; + FImages := nil; + LoopDone := 0; + LoopCount := 0; +end; + +destructor TBGRAAnimatedGif.Destroy; +begin + Clear; + + if FStretchedVirtualScreen <> nil then + FStretchedVirtualScreen.FreeReference; + if FPreviousVirtualScreen <> nil then + FPreviousVirtualScreen.FreeReference; + FInternalVirtualScreen.Free; + FRestoreImage.Free; + FBackgroundImage.Free; + inherited Destroy; +end; + +procedure TBGRAAnimatedGif.Pause; +begin + FPaused := True; +end; + +procedure TBGRAAnimatedGif.Resume; +begin + FPaused := False; +end; + +procedure TBGRAAnimatedGif.Show(Canvas: TCanvas; ARect: TRect); +begin + Canvas.StretchDraw(ARect, self); +end; + +procedure TBGRAAnimatedGif.Update(Canvas: TCanvas; ARect: TRect); +var + n: integer; + PChangePix, PNewPix, PBackground, PNewBackground: PLongWord; + oldpix, newpix, newbackpix: LongWord; + NewBackgroundImage: TBGRABitmap; +begin + if (BackgroundMode = gbmUpdateBackgroundContinuously) and + (FBackgroundImage = nil) then + BackgroundMode := gbmSaveBackgroundOnce; + + SaveBackgroundOnce(Canvas, ARect); + + case BackgroundMode of + gbmSimplePaint: + begin + UpdateSimple(Canvas, ARect); + exit; + end; + gbmEraseBackground: + begin + UpdateEraseBackground(Canvas, ARect); + exit; + end; + gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: + begin + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end + else + FPreviousVirtualScreen := TBGRABitmap(FPreviousVirtualScreen.GetUnique); + end; + + Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); + + if FImageChanged then + begin + if BackgroundMode = gbmUpdateBackgroundContinuously then + begin + NewBackgroundImage := + TBGRABitmap.Create(FStretchedVirtualScreen.Width, + FStretchedVirtualScreen.Height); + NewBackgroundImage.GetImageFromCanvas(Canvas, ARect.Left, ARect.Top); + + if FPreviousVirtualScreen = nil then + begin + FPreviousVirtualScreen := TBGRABitmap.Create(FWidth, FHeight); + FPreviousVirtualScreen.Fill(BGRAPixelTransparent); + end; + + PChangePix := PLongWord(FPreviousVirtualScreen.Data); + PNewPix := PLongWord(FStretchedVirtualScreen.Data); + PBackground := PLongWord(FBackgroundImage.Data); + PNewBackground := PLongWord(NewBackgroundImage.Data); + for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do + begin + oldpix := PChangePix^; + + if (oldpix and AlphaMask = AlphaMask) then //pixel opaque précédent + begin + newbackpix := PNewBackground^; + if (newbackpix <> oldpix) then //stocke nouveau fond + PBackground^ := newbackpix; + end; + + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then + PChangePix^ := newpix //pixel opaque + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := PBackground^; + DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then + PChangePix^ := PBackground^; //efface précédent + +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} + + Inc(PNewPix); + Inc(PChangePix); + Inc(PBackground); + Inc(PNewBackground); + end; + NewBackgroundImage.Free; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); + FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); + end + else + begin + if FPreviousVirtualScreen = nil then + begin + FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); + FPreviousVirtualScreen := + TBGRABitmap(FStretchedVirtualScreen.NewReference); + end + else + begin + PChangePix := PLongWord(FPreviousVirtualScreen.Data); + PNewPix := PLongWord(FStretchedVirtualScreen.Data); + PBackground := PLongWord(FBackgroundImage.Data); + for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do + begin + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then + PChangePix^ := newpix //pixel opaque + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := PBackground^; + DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then + PChangePix^ := PBackground^; //efface précédent + +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} + + Inc(PNewPix); + Inc(PChangePix); + Inc(PBackground); + end; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); + FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); + end; + end; + FImageChanged := False; + end; + end; + end; +end; + +procedure TBGRAAnimatedGif.Hide(Canvas: TCanvas; ARect: TRect); +var + shape: TBGRABitmap; + p, pback: PBGRAPixel; + MemEraseColor: TBGRAPixel; + n: integer; +begin + MemEraseColor := ColorToBGRA(EraseColor); + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end; + end; + + case BackgroundMode of + gbmEraseBackground, gbmSimplePaint: + begin + if FPreviousVirtualScreen <> nil then + begin + shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate); + p := shape.Data; + for n := shape.NbPixels - 1 downto 0 do + begin + if p^.alpha <> 0 then + p^ := MemEraseColor + else + p^ := BGRAPixelTransparent; + Inc(p); + end; + shape.Draw(Canvas, ARect.Left, ARect.Top, false); + shape.FreeReference; + end; + end; + gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: + begin + if (FPreviousVirtualScreen <> nil) and (FBackgroundImage <> nil) then + begin + shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate); + p := shape.Data; + pback := FBackgroundImage.Data; + for n := shape.NbPixels - 1 downto 0 do + begin + if p^.alpha <> 0 then + p^ := pback^ + else + p^ := BGRAPixelTransparent; + Inc(p); + Inc(pback); + end; + shape.Draw(Canvas, ARect.Left, ARect.Top, false); + shape.FreeReference; + end; + end; + end; +end; + +procedure TBGRAAnimatedGif.UpdateEraseBackground(Canvas: TCanvas; + ARect: TRect; DrawOnlyIfChanged: boolean); +var + n: integer; + PChangePix, PNewPix: PLongWord; + newpix: LongWord; + MemPixEraseColor: LongWord; +begin + if EraseColor = clNone then + begin + UpdateSimple(Canvas, ARect, DrawOnlyIfChanged); + exit; + end; + + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end + else + FPreviousVirtualScreen := TBGRABitmap(FPreviousVirtualScreen.GetUnique); + end; + + Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); + if FImageChanged then + begin + PBGRAPixel(@MemPixEraseColor)^ := ColorToBGRA(EraseColor); + if FPreviousVirtualScreen = nil then + begin + FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); + FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.NewReference); + end + else + begin + PChangePix := PLongWord(FPreviousVirtualScreen.Data); + PNewPix := PLongWord(FStretchedVirtualScreen.Data); + for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do + begin + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then + PChangePix^ := newpix //pixel opaque + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := MemPixEraseColor; + DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then + PChangePix^ := MemPixEraseColor; //efface précédent +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent} + + Inc(PNewPix); + Inc(PChangePix); + end; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); + FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); + end; + + FImageChanged := False; + end; +end; + +procedure TBGRAAnimatedGif.Init; +begin + BackgroundMode := gbmSaveBackgroundOnce; + LoopCount := 0; + LoopDone := 0; +end; + +function TBGRAAnimatedGif.GetBitmap: TBitmap; +begin + Render(FWidth, FHeight); + Result := FStretchedVirtualScreen.Bitmap; +end; + +function TBGRAAnimatedGif.GetMemBitmap: TBGRABitmap; +begin + Render(FWidth, FHeight); + Result := FStretchedVirtualScreen; +end; + +{ TBGRAReaderGIF } + +procedure TBGRAReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage); +var + gif: TBGRAAnimatedGif; + x, y: integer; + Mem: TBGRABitmap; +begin + gif := TBGRAAnimatedGif.Create(Str, 1); + Mem := gif.MemBitmap; + if Img is TBGRABitmap then + begin + TBGRABitmap(Img).Assign(Mem); + end + else + begin + Img.SetSize(gif.Width, gif.Height); + for y := 0 to gif.Height - 1 do + for x := 0 to gif.Width - 1 do + with Mem.GetPixel(x, y) do + Img.Colors[x, y] := FPColor(red * $101, green * $101, blue * + $101, alpha * $101); + end; + gif.Free; +end; + +function TBGRAReaderGIF.InternalCheck(Str: TStream): boolean; +var + GIFSignature: TGIFSignature; + savepos: int64; +begin + savepos := str.Position; + try + fillchar({%H-}GIFSignature, sizeof(GIFSignature), 0); + str.Read(GIFSignature, sizeof(GIFSignature)); + if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and + (GIFSignature[3] = 'F') then + begin + Result := True; + end + else + Result := False; + except + on ex: Exception do + Result := False; + end; + str.Position := savepos; +end; + +{ TBGRAWriterGIF } + +procedure TBGRAWriterGIF.InternalWrite(Str: TStream; Img: TFPCustomImage); +var + gif: TBGRAAnimatedGif; +begin + gif := TBGRAAnimatedGif.Create; + try + gif.SetSize(Img.Width,Img.Height); + gif.AddFrame(Img, 0,0,0); + gif.SaveToStream(Str, BGRAColorQuantizerFactory, daFloydSteinberg); + except + on ex: EColorQuantizerMissing do + begin + FreeAndNil(gif); + raise EColorQuantizerMissing.Create('Please define the color quantizer factory. You can do that with the following statements: Uses BGRAPalette, BGRAColorQuantization; BGRAColorQuantizerFactory:= TBGRAColorQuantizer;'); + end; + on ex: Exception do + begin + FreeAndNil(gif); + raise ex; + end; + end; + FreeAndNil(gif); +end; + +initialization + + DefaultBGRAImageReader[ifGif] := TBGRAReaderGIF; + DefaultBGRAImageWriter[ifGif] := TBGRAWriterGIF; + + //Free Pascal Image + ImageHandlers.RegisterImageReader('Animated GIF', TBGRAAnimatedGif.GetFileExtensions, + TBGRAReaderGIF); + ImageHandlers.RegisterImageWriter('Animated GIF', TBGRAAnimatedGif.GetFileExtensions, + TBGRAWriterGIF); + + {$IFDEF BGRABITMAP_USE_LCL} + //Lazarus Picture + TPicture.RegisterFileFormat(TBGRAAnimatedGif.GetFileExtensions, 'Animated GIF', + TBGRAAnimatedGif); + {$ENDIF} +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraarrow.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraarrow.pas new file mode 100644 index 0000000..4173e37 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraarrow.pas @@ -0,0 +1,527 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAArrow; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRABitmapTypes, BGRAGraphics; + +type + { TBGRAArrow } + + TBGRAArrow = class(TBGRACustomArrow) + private + FLineCap: TPenEndCap; + FWidth : single; + FStart : ArrayOfTPointF; + FStartComputed: boolean; + FStartStyle: TBGRAArrowStyle; + FStartSizeFactor: TPointF; + FStartTipStyle: TPenJoinStyle; + FStartOffsetX: single; + FStartRepeatCount: integer; + FStartRelativePenWidth: single; + FStartTriangleBackOffset: single; + FEnd : ArrayOfTPointF; + FEndComputed: boolean; + FEndStyle: TBGRAArrowStyle; + FEndSizeFactor: TPointF; + FEndTipStyle: TPenJoinStyle; + FEndOffsetX: single; + FEndRepeatCount: integer; + FEndRelativePenWidth: single; + FEndTriangleBackOffset: single; + function ComputeAnyAt(const AData: ArrayOfTPointF; const APosition, ADirection: TPointF): ArrayOfTPointF; + function ComputeData(AStyle: TBGRAArrowStyle; const ASizeFactor: TPointF; + ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; const AWidth: single; AOffsetX: single; + ARepeatCount: integer; ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF; + procedure SetWidth(AValue: single); + protected + function GetEndRepeatCount: integer; override; + function GetEndSizeFactor: TPointF; override; + function GetIsEndDefined: boolean; override; + function GetIsStartDefined: boolean; override; + function GetEndOffsetX: single; override; + function GetStartOffsetX: single; override; + function GetStartRepeatCount: integer; override; + function GetStartSizeFactor: TPointF; override; + procedure SetEndOffsetX(AValue: single); override; + procedure SetEndRepeatCount(AValue: integer); override; + procedure SetEndSizeFactor(AValue: TPointF); override; + procedure SetStartOffsetX(AValue: single); override; + procedure SetStartRepeatCount(AValue: integer); override; + procedure SetStartSizeFactor(AValue: TPointF); override; + function GetLineCap: TPenEndCap; override; + procedure SetLineCap(AValue: TPenEndCap); override; + procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); + procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); + public + constructor Create; + procedure StartAsNone; override; + procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; + procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; + procedure StartAsTail; override; + procedure EndAsNone; override; + procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; + procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; + procedure EndAsTail; override; + function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override; + function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override; + + end; + +implementation + +uses BGRAClasses, BGRATransform, BGRAPen, BGRAPath; + +{ TBGRAArrow } + +function TBGRAArrow.ComputeAnyAt(const AData: ArrayOfTPointF; const APosition, + ADirection: TPointF): ArrayOfTPointF; +var m: TAffineMatrix; + i: integer; +begin + if (AData = nil) or isEmptyPointF(APosition) or isEmptyPointF(ADirection) or ((ADirection.x = 0) and (ADirection.y = 0)) then + begin + result := nil; + exit; + end; + m := AffineMatrixTranslation(APosition.x,APosition.y)*AffineMatrixLinear(ADirection, PointF(-ADirection.y, ADirection.x)); + setlength(result, length(AData)); + for i := 0 to high(result) do + if not isEmptyPointF(AData[i]) then + result[i] := m*AData[i] + else + result[i] := EmptyPointF; +end; + +function TBGRAArrow.ComputeData(AStyle: TBGRAArrowStyle; + const ASizeFactor: TPointF; ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; + const AWidth: single; AOffsetX: single; ARepeatCount: integer; + ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF; +var sizeFactorX,sizeFactorY,ofsX: single; + prefix,suffix,middle: ArrayOfTPointF; + arc: TArcDef; + i,j,n : integer; + withCut: ArrayOfTPointF; + subResult: ArrayOfTPointF; + w: single; + backOfs: single; + tailSizeX, tailAdditionalWidth: single; +begin + sizeFactorX := abs(ASizeFactor.X)*AWidth; + sizeFactorY := abs(ASizeFactor.Y)*AWidth; + if (sizeFactorX = 0) or (sizeFactorY = 0) then + begin + result := nil; + exit; + end; + w := AWidth*ARelativePenWidth; + if AStyle in [asTail,asTailRepeat] then + begin + tailSizeX := sizeFactorX/SizeFactorY*AWidth*0.5; + if AStyle = asTailRepeat then + begin + tailAdditionalWidth:= AWidth-tailSizeX; + if tailAdditionalWidth < 0 then tailAdditionalWidth := 0; + end else + tailAdditionalWidth:=0; + end + else + begin + tailSizeX := 0; + tailAdditionalWidth:=0; + end; + case AStyle of + asTriangle,asHollowTriangle: begin + backOfs := ATriangleBackOffset*sizeFactorX; + if AStyle = asHollowTriangle then + begin + result := ComputeWidePolylinePoints(PointsF([PointF(0.5*w,-AWidth*0.5), + PointF(0.5*w-backOfs,-sizeFactorY+w*0.5), + PointF(sizeFactorX-w*0.5,0), + PointF(w*0.5-backOfs,sizeFactorY-w*0.5), + PointF(0.5*w,AWidth*0.5)]), + w,BGRABlack,ALineCap,ATipStyle,nil,[plCycle]); + end else + begin + prefix := PointsF([PointF(0,-AWidth*0.5),PointF(-backOfs,-sizeFactorY)]); + suffix := PointsF([PointF(-backOfs,sizeFactorY),PointF(0,AWidth*0.5)]); + if (ATipStyle in[pjsRound,pjsBevel]) then + begin + arc := Html5ArcTo(prefix[1],PointF(sizeFactorX,0),suffix[0],AWidth*0.5); + if ATipStyle = pjsRound then + middle := ComputeArc(arc) + else + middle := PointsF([ArcStartPoint(arc),ArcEndPoint(arc)]); + end + else middle := PointsF([PointF(sizeFactorX,0)]); + result := ConcatPointsF([prefix,middle,suffix]); + end; + end; + asNormal,asCut: + begin + if AStyle = asCut then ALineCap:= pecSquare; + result := ComputeWidePolylinePoints([PointF(-sizeFactorX,-sizeFactorY), + PointF(0,0),PointF(-sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]); + end; + asFlipped,asFlippedCut: + begin + if AStyle = asFlippedCut then ALineCap:= pecSquare; + result := ComputeWidePolylinePoints([PointF(+sizeFactorX,-sizeFactorY), + PointF(0,0),PointF(+sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]); + end; + asTail: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX,-0.5*AWidth),PointF(0,0),PointF(tailSizeX,0.5*AWidth),PointF(0,0.5*AWidth)]); + asTailRepeat: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX+tailAdditionalWidth,-0.5*AWidth),PointF(tailAdditionalWidth,0),PointF(tailSizeX+tailAdditionalWidth,0.5*AWidth),PointF(0,0.5*AWidth),PointF(-tailSizeX,0)]); + else + result := nil; + end; + if (AStyle in [asCut,asFlippedCut,asHollowTriangle]) then + begin + n := 0; + setlength(withCut,length(result)*2); + for i := 0 to high(result) do + if isEmptyPointF(result[i]) then + begin + if (n > 0) and not isEmptyPointF(withCut[n-1]) then + begin + withCut[n] := EmptyPointF; + inc(n); + end; + end else + if abs(result[i].y)<=sizeFactorY then + begin + withCut[n] := result[i]; + inc(n); + end else + if result[i].y>sizeFactorY then + begin + j := (i+length(result)-1) mod length(result); + if result[j].y<=sizeFactorY then + begin + withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y); + withCut[n].y := sizeFactorY; + inc(n); + end; + j := (i+1) mod length(result); + if result[j].y<=sizeFactorY then + begin + withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y); + withCut[n].y := sizeFactorY; + inc(n); + end; + end else + if result[i].y<-sizeFactorY then + begin + j := (i+length(result)-1) mod length(result); + if result[j].y>=-sizeFactorY then + begin + withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y); + withCut[n].y := -sizeFactorY; + inc(n); + end; + j := (i+1) mod length(result); + if result[j].y>=-sizeFactorY then + begin + withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y); + withCut[n].y := -sizeFactorY; + inc(n); + end; + end; + if (n > 0) and isEmptyPointF(withCut[n-1]) then dec(n); + setlength(withCut,n); + result := withCut; + end; + if AOffsetX <> 0 then + begin + ofsX := AOffsetX*AWidth; + for i := 0 to high(result) do + if not isEmptyPointF(result[i]) then + IncF(result[i].x, ofsX); + end; + if ARepeatCount > 1 then + begin + if ARepeatCount > 10 then ARepeatCount:= 10; + if AStyle in[asTriangle,asHollowTriangle] then IncF(AOffsetX, sizeFactorX/AWidth) + else if AStyle in[asTail,asTailRepeat] then IncF(AOffsetX, (tailSizeX+tailAdditionalWidth)/AWidth+1) + else IncF(AOffsetX, 2*ARelativePenWidth); + if AStyle = asTail then AStyle := asTailRepeat; + subResult := ComputeData(AStyle,ASizeFactor,ATipStyle,ALineCap,AWidth,AOffsetX,ARepeatCount-1,ARelativePenWidth,ATriangleBackOffset); + result := ConcatPointsF([result,PointsF([EmptyPointF]),subResult]); + end; +end; + +function TBGRAArrow.GetIsEndDefined: boolean; +begin + result := FEndStyle <> asNone; +end; + +function TBGRAArrow.GetIsStartDefined: boolean; +begin + result := FStartStyle <> asNone; +end; + +function TBGRAArrow.GetEndOffsetX: single; +begin + result := FEndOffsetX; +end; + +function TBGRAArrow.GetStartOffsetX: single; +begin + result := FStartOffsetX; +end; + +function TBGRAArrow.GetStartRepeatCount: integer; +begin + result := FStartRepeatCount; +end; + +function TBGRAArrow.GetStartSizeFactor: TPointF; +begin + result := FStartSizeFactor; +end; + +procedure TBGRAArrow.SetEndOffsetX(AValue: single); +begin + if FEndOffsetX=AValue then Exit; + FEndOffsetX:=AValue; + FEndComputed:= false; + FEnd := nil; +end; + +function TBGRAArrow.GetLineCap: TPenEndCap; +begin + result := FLineCap; +end; + +procedure TBGRAArrow.SetEndRepeatCount(AValue: integer); +begin + if FEndRepeatCount=AValue then Exit; + FEndRepeatCount:=AValue; + FEndComputed:= false; + FEnd := nil; +end; + +procedure TBGRAArrow.SetEndSizeFactor(AValue: TPointF); +begin + if FEndSizeFactor=AValue then Exit; + FEndSizeFactor:=AValue; + FEndComputed:= false; + FEnd := nil; +end; + +procedure TBGRAArrow.SetLineCap(AValue: TPenEndCap); +begin + if FLineCap=AValue then Exit; + FLineCap:=AValue; + FStartComputed:= false; + FEndComputed:= false; + FStart:= nil; + FEnd := nil; +end; + +procedure TBGRAArrow.SetStartOffsetX(AValue: single); +begin + if FStartOffsetX=AValue then Exit; + FStartOffsetX:=AValue; + FStartComputed:= false; + FStart := nil; +end; + +procedure TBGRAArrow.SetStartRepeatCount(AValue: integer); +begin + if FStartRepeatCount=AValue then Exit; + FStartRepeatCount:=AValue; + FStartComputed:= false; + FStart := nil; +end; + +procedure TBGRAArrow.SetStartSizeFactor(AValue: TPointF); +begin + if FStartSizeFactor=AValue then Exit; + FStartSizeFactor:=AValue; + FStartComputed:= false; + FStart := nil; +end; + +procedure TBGRAArrow.SetWidth(AValue: single); +begin + if FWidth=AValue then Exit; + FWidth:=AValue; + FStartComputed := false; + FEndComputed:= false; +end; + +function TBGRAArrow.GetEndRepeatCount: integer; +begin + Result:= FEndRepeatCount; +end; + +function TBGRAArrow.GetEndSizeFactor: TPointF; +begin + Result:= FEndSizeFactor; +end; + +constructor TBGRAArrow.Create; +begin + FWidth := 1; + FStartSizeFactor := PointF(2,2); + FEndSizeFactor := PointF(2,2); +end; + +procedure TBGRAArrow.StartAsNone; +begin + SetStart(asNone); +end; + +procedure TBGRAArrow.StartAsClassic(AFlipped: boolean; ACut: boolean; + ARelativePenWidth: single); +var join: TPenJoinStyle; +begin + if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter; + if ACut then + begin + if AFlipped then + SetStart(asFlippedCut,join,ARelativePenWidth) + else + SetStart(asCut,join,ARelativePenWidth) + end + else + begin + if AFlipped then + SetStart(asFlipped,join,ARelativePenWidth) + else + SetStart(asNormal,join,ARelativePenWidth) + end; +end; + +procedure TBGRAArrow.StartAsTriangle(ABackOffset: single; ARounded: boolean; + AHollow: boolean; AHollowPenWidth: single); +var join: TPenJoinStyle; +begin + if ARounded then join := pjsRound else join := pjsMiter; + if AHollow then + SetStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset) + else + SetStart(asTriangle, join,1,ABackOffset); +end; + +procedure TBGRAArrow.StartAsTail; +begin + SetStart(asTail); +end; + +procedure TBGRAArrow.EndAsNone; +begin + SetEnd(asNone); +end; + +procedure TBGRAArrow.EndAsClassic(AFlipped: boolean; ACut: boolean; + ARelativePenWidth: single); +var join: TPenJoinStyle; +begin + if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter; + if ACut then + begin + if AFlipped then + SetEnd(asFlippedCut,join,ARelativePenWidth) + else + SetEnd(asCut,join,ARelativePenWidth) + end + else + begin + if AFlipped then + SetEnd(asFlipped,join,ARelativePenWidth) + else + SetEnd(asNormal,join,ARelativePenWidth) + end; +end; + +procedure TBGRAArrow.EndAsTriangle(ABackOffset: single; ARounded: boolean; + AHollow: boolean; AHollowPenWidth: single); +var join: TPenJoinStyle; +begin + if ARounded then join := pjsRound else join := pjsMiter; + if AHollow then + SetEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset) + else + SetEnd(asTriangle, join,1, ABackOffset); +end; + +procedure TBGRAArrow.EndAsTail; +begin + SetEnd(asTail); +end; + +procedure TBGRAArrow.SetStart(AStyle: TBGRAArrowStyle; + ATipStyle: TPenJoinStyle; ARelativePenWidth: single; ATriangleBackOffset: single); +begin + FStartStyle := AStyle; + FStartTipStyle := ATipStyle; + FStartComputed := false; + FStartRelativePenWidth:= ARelativePenWidth; + FStartTriangleBackOffset := ATriangleBackOffset; + FStart := nil; +end; + +procedure TBGRAArrow.SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle; + ARelativePenWidth: single; ATriangleBackOffset: single); +begin + FEndStyle := AStyle; + FEndTipStyle := ATipStyle; + FEndComputed := false; + FEndRelativePenWidth:= ARelativePenWidth; + FEndTriangleBackOffset := ATriangleBackOffset; + FEnd := nil; +end; + +function TBGRAArrow.ComputeStartAt(const APosition: TPointF; + const ADirection: TPointF; const AWidth: single; const ACurrentPos: single + ): ArrayOfTPointF; +begin + if not IsStartDefined then + begin + result := nil; + exit; + end; + if AWidth <> FWidth then + begin + FWidth := AWidth; + FStartComputed:= false; + end; + if not FStartComputed then + begin + FStart := ComputeData(FStartStyle,FStartSizeFactor,FStartTipStyle,FLineCap,FWidth, + FStartOffsetX-ACurrentPos,FStartRepeatCount,FStartRelativePenWidth,FStartTriangleBackOffset); + FStartComputed:= true; + end; + result := ComputeAnyAt(FStart,APosition,ADirection); +end; + +function TBGRAArrow.ComputeEndAt(const APosition: TPointF; + const ADirection: TPointF; const AWidth: single; const ACurrentPos: single + ): ArrayOfTPointF; +begin + if not IsEndDefined then + begin + result := nil; + exit; + end; + if AWidth <> FWidth then + begin + FWidth := AWidth; + FEndComputed:= false; + end; + if not FEndComputed then + begin + FEnd := ComputeData(FEndStyle,FEndSizeFactor,FEndTipStyle,FLineCap,FWidth, + FEndOffsetX-ACurrentPos,FEndRepeatCount,FEndRelativePenWidth,FEndTriangleBackOffset); + FEndComputed:= true; + end; + result := ComputeAnyAt(FEnd,APosition,ADirection); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.inc new file mode 100644 index 0000000..955d85a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.inc @@ -0,0 +1,34 @@ +{$DEFINE BGRABITMAP} +{ You can define the following compiler directives in the package options, + in tab Compiler options, in section Other. Directives must be prefixed with + "-d". So for example: + + - to always have RGBA pixel format, write "-dBGRABITMAP_RGBAPIXEL" + - to always have BGRA pixel format, write "-dBGRABITMAP_BGRAPIXEL" + - to use fpGUI toolkit, write "-dBGRABITMAP_USE_FPGUI" } +{$IFNDEF BGRABITMAP_DONT_USE_LCL} + {$IFDEF LCL} + {$DEFINE BGRABITMAP_USE_LCL} + {$ENDIF} +{$ENDIF} +{$IFDEF BGRABITMAP_USE_FPGUI} + {$UNDEF BGRABITMAP_USE_LCL} + {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE} +{$ENDIF} +{$IFDEF BGRABITMAP_USE_MSEGUI} + {$UNDEF BGRABITMAP_USE_LCL} + {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE} + {$DEFINE BGRABITMAP_DONT_USE_FPCANVAS} +{$ENDIF} +{$IFNDEF BGRABITMAP_DONT_USE_FPCANVAS} + {$DEFINE BGRABITMAP_USE_FPCANVAS} +{$ENDIF} + +{ Extensions of LCL to be used. Add // at the beginning of the line + to comment them if the functions are not available } +{$DEFINE BGRABITMAP_USE_LCL12} { Use functions of Lazarus 1.2 } +{$DEFINE BGRABITMAP_USE_LCL15} { Use functions of Lazarus 1.5 } + +{$MODESWITCH ADVANCEDRECORDS} +{$MODESWITCH TypeHelpers} + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.pas new file mode 100644 index 0000000..3929360 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.pas @@ -0,0 +1,508 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgrabitmap.pas + -------------- + Free easy-to-use memory bitmap 32-bit, + 8-bit for each channel, transparency. + Channels can be in the following orders: + - B G R A (recommended for Windows, required for fpGUI) + - R G B A (recommended for Gtk and MacOS) + + - Drawing primitives + - Resample + - Reference counter + - Drawing on LCL canvas + - Loading and saving images + + Note : line order can change, so if you access + directly to bitmap data, check LineOrder value + or use Scanline to compute position. + + + --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause. +} + +unit BGRABitmap; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +{ Compiler directives are used to include the best version according + to the platform } + +uses + BGRAClasses, BGRABitmapTypes, FPImage, SysUtils, +{$IFDEF BGRABITMAP_USE_FPGUI} + BGRAfpGUIBitmap, +{$ELSE} + {$IFDEF BGRABITMAP_USE_LCL} + {$IFDEF LCLwin32} + BGRAWinBitmap, + {$ELSE} + {$IFDEF LCLgtk} + BGRAGtkBitmap, + {$ELSE} + {$IFDEF LCLgtk2} + BGRAGtkBitmap, + {$ELSE} + {$IF defined(LCLqt) or defined(LCLqt5)} + BGRAQtBitmap, + {$ELSE} + {$IFDEF DARWIN} + BGRAMacBitmap, + {$ELSE} + BGRALCLBitmap, + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ELSE} + {$IFDEF BGRABITMAP_USE_MSEGUI} + BGRAMSEguiBitmap, + {$ELSE} + BGRANoGuiBitmap, + {$ENDIF} + {$ENDIF} +{$ENDIF} + BGRAGraphics; + +type +{$IFDEF BGRABITMAP_USE_FPGUI} + TBGRABitmap = class(TBGRAfpGUIBitmap) +{$ELSE} + {$IFDEF BGRABITMAP_USE_LCL} + {$IFDEF LCLwin32} + TBGRABitmap = class(TBGRAWinBitmap) + {$ELSE} + {$IFDEF LCLgtk} + TBGRABitmap = class(TBGRAGtkBitmap) + {$ELSE} + {$IFDEF LCLgtk2} + + { TBGRABitmap } + + TBGRABitmap = class(TBGRAGtkBitmap) + {$ELSE} + {$IF defined(LCLqt) or defined(LCLqt5)} + TBGRABitmap = class(TBGRAQtBitmap) + {$ELSE} + {$IFDEF DARWIN} + TBGRABitmap = class(TBGRAMacBitmap) + {$ELSE} + TBGRABitmap = class(TBGRALCLBitmap) + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ELSE} + {$IFDEF BGRABITMAP_USE_MSEGUI} + TBGRABitmap = class(TBGRAMSEguiBitmap) + {$ELSE} + TBGRABitmap = class(TBGRANoGUIBitmap) + {$ENDIF} + {$ENDIF} +{$ENDIF} + public + function NewBitmap: TBGRABitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer): TBGRABitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRABitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRABitmap; overload; override; + function NewBitmap(Filename: string): TBGRABitmap; overload; override; + function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap; overload; override; + function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRABitmap; overload; override; + function NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap; overload; override; + function NewReference: TBGRABitmap; override; + function GetUnique: TBGRABitmap; override; + function Duplicate(DuplicateProperties: Boolean = False): TBGRABitmap; overload; override; + function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGRABitmap; overload; override; + function GetPart(const ARect: TRect): TBGRABitmap; override; + function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; + AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRABitmap; override; + function Resample(newWidth, newHeight: integer; + mode: TResampleMode = rmFineResample): TBGRABitmap; override; + function RotateCW: TBGRABitmap; override; + function RotateCCW: TBGRABitmap; override; + function RotateUD: TBGRABitmap; override; + function FilterSmartZoom3(Option: TMedianOption): TBGRABitmap; override; + function FilterMedian(Option: TMedianOption): TBGRABitmap; override; + function FilterSmooth: TBGRABitmap; override; + function FilterSharpen(Amount: single = 1): TBGRABitmap; overload; override; + function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRABitmap; overload; override; + function FilterContour(AGammaCorrection: boolean = false): TBGRABitmap; override; + function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRABitmap; override; + function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; + function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; + function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override; + function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override; + function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGRABitmap; overload; override; + function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGRABitmap; overload; override; + function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override; + function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRABitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap; overload; override; + function FilterGrayscale: TBGRABitmap; overload; override; + function FilterGrayscale(ABounds: TRect): TBGRABitmap; overload; override; + function FilterNormalize(eachChannel: boolean = True): TBGRABitmap; overload; override; + function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRABitmap; overload; override; + function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRABitmap; override; + function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRABitmap; override; + function FilterSphere: TBGRABitmap; override; + function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override; + function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override; + function FilterCylinder: TBGRABitmap; override; + function FilterPlane: TBGRABitmap; override; + end; + +// draw a bitmap from pure data +procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean); + +{ Replace the content of the variable Destination with the variable + Temp and frees previous object contained in Destination. + + This function is useful as a shortcut for : + + var + temp: TBGRABitmap; + begin + ... + temp := someBmp.Filter... as TBGRABitmap; + someBmp.Free; + someBmp := temp; + end; + + which becomes : + + begin + ... + BGRAReplace(someBmp, someBmp.Filter... ); + end; +} +procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject); + +implementation + +uses BGRAReadBMP, BGRAReadBmpMioMap, BGRAReadGif, + BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, BGRAReadPCX, + BGRAReadPng, BGRAWritePNG, BGRAReadPSD, BGRAReadTGA, BGRAReadXPM, + BGRAWriteLzp, BGRAReadWebP, BGRAWriteWebP; + +var + tempBmp: TBGRABitmap; + +procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean); +var + LineOrder: TRawImageLineOrder; +begin + if tempBmp = nil then + tempBmp := TBGRABitmap.Create; + if VerticalFlip then + LineOrder := riloBottomToTop + else + LineOrder := riloTopToBottom; + if Opaque then + tempBmp.DataDrawOpaque(ACanvas, Rect, AData, LineOrder, AWidth, AHeight) + else + tempBmp.DataDrawTransparent(ACanvas, Rect, AData, LineOrder, AWidth, AHeight); +end; + +procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject); +begin + Destination.Free; + Destination := Temp as TBGRABitmap; +end; + +{ TBGRABitmap } + +function TBGRABitmap.NewBitmap: TBGRABitmap; +begin + Result:=inherited NewBitmap as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(AWidth, AHeight: integer): TBGRABitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel + ): TBGRABitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer + ): TBGRABitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(Filename: string): TBGRABitmap; +begin + Result:=inherited NewBitmap(Filename) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap; +begin + Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean; + AOptions: TBGRALoadingOptions): TBGRABitmap; +begin + Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGRABitmap; +end; + +function TBGRABitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap; +begin + Result:=inherited NewBitmap(AFPImage) as TBGRABitmap; +end; + +function TBGRABitmap.NewReference: TBGRABitmap; +begin + Result:=inherited NewReference as TBGRABitmap; +end; + +function TBGRABitmap.GetUnique: TBGRABitmap; +begin + Result:=inherited GetUnique as TBGRABitmap; +end; + +function TBGRABitmap.Duplicate(DuplicateProperties: Boolean): TBGRABitmap; +begin + Result:=inherited Duplicate(DuplicateProperties) as TBGRABitmap; +end; + +function TBGRABitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean + ): TBGRABitmap; +begin + Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGRABitmap; +end; + +function TBGRABitmap.GetPart(const ARect: TRect): TBGRABitmap; +begin + Result:=inherited GetPart(ARect) as TBGRABitmap; +end; + +function TBGRABitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; + APatternColor, ABackgroundColor: TBGRAPixel; AWidth: integer; + AHeight: integer; APenWidth: single): TBGRABitmap; +begin + Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, + ABackgroundColor, AWidth, AHeight, APenWidth) as TBGRABitmap; +end; + +function TBGRABitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode + ): TBGRABitmap; +begin + Result:=inherited Resample(newWidth, newHeight, mode) as TBGRABitmap; +end; + +function TBGRABitmap.RotateCW: TBGRABitmap; +begin + Result:=inherited RotateCW as TBGRABitmap; +end; + +function TBGRABitmap.RotateCCW: TBGRABitmap; +begin + Result:=inherited RotateCCW as TBGRABitmap; +end; + +function TBGRABitmap.RotateUD: TBGRABitmap; +begin + Result:=inherited RotateUD as TBGRABitmap; +end; + +function TBGRABitmap.FilterSmartZoom3(Option: TMedianOption): TBGRABitmap; +begin + Result:=inherited FilterSmartZoom3(Option) as TBGRABitmap; +end; + +function TBGRABitmap.FilterMedian(Option: TMedianOption): TBGRABitmap; +begin + Result:=inherited FilterMedian(Option) as TBGRABitmap; +end; + +function TBGRABitmap.FilterSmooth: TBGRABitmap; +begin + Result:=inherited FilterSmooth as TBGRABitmap; +end; + +function TBGRABitmap.FilterSharpen(Amount: single): TBGRABitmap; +begin + Result:=inherited FilterSharpen(Amount) as TBGRABitmap; +end; + +function TBGRABitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGRABitmap; +begin + Result:=inherited FilterSharpen(ABounds, Amount) as TBGRABitmap; +end; + +function TBGRABitmap.FilterContour(AGammaCorrection: boolean = false): TBGRABitmap; +begin + Result:=inherited FilterContour(AGammaCorrection) as TBGRABitmap; +end; + +function TBGRABitmap.FilterPixelate(pixelSize: integer; useResample: boolean; + filter: TResampleFilter): TBGRABitmap; +begin + Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType + ): TBGRABitmap; +begin + Result:=inherited FilterBlurRadial(radius, blurType) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radius: single; + blurType: TRadialBlurType): TBGRABitmap; +begin + Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurRadial(radiusX, radiusY: single; + blurType: TRadialBlurType): TBGRABitmap; +begin + Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; + blurType: TRadialBlurType): TBGRABitmap; +begin + Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurMotion(distance: single; angle: single; + oriented: boolean): TBGRABitmap; +begin + Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGRABitmap; +end; + +function TBGRABitmap.FilterBlurMotion(const ABounds: TRect; distance: single; + angle: single; oriented: boolean): TBGRABitmap; +begin + Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGRABitmap; +end; + +function TBGRABitmap.FilterCustomBlur(mask: TCustomUniversalBitmap + ): TBGRABitmap; +begin + Result:=inherited FilterCustomBlur(mask) as TBGRABitmap; +end; + +function TBGRABitmap.FilterCustomBlur(const ABounds: TRect; + mask: TCustomUniversalBitmap): TBGRABitmap; +begin + Result:=inherited FilterCustomBlur(ABounds, mask) as TBGRABitmap; +end; + +function TBGRABitmap.FilterEmboss(angle: single; AStrength: integer; + AOptions: TEmbossOptions): TBGRABitmap; +begin + Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGRABitmap; +end; + +function TBGRABitmap.FilterEmboss(angle: single; ABounds: TRect; + AStrength: integer; AOptions: TEmbossOptions): TBGRABitmap; +begin + Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGRABitmap; +end; + +function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection) as TBGRABitmap; +end; + +function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel): TBGRABitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGRABitmap; +end; + +function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGRABitmap; +end; + +function TBGRABitmap.FilterGrayscale: TBGRABitmap; +begin + Result:=inherited FilterGrayscale as TBGRABitmap; +end; + +function TBGRABitmap.FilterGrayscale(ABounds: TRect): TBGRABitmap; +begin + Result:=inherited FilterGrayscale(ABounds) as TBGRABitmap; +end; + +function TBGRABitmap.FilterNormalize(eachChannel: boolean): TBGRABitmap; +begin + Result:=inherited FilterNormalize(eachChannel) as TBGRABitmap; +end; + +function TBGRABitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean + ): TBGRABitmap; +begin + Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGRABitmap; +end; + +function TBGRABitmap.FilterRotate(origin: TPointF; angle: single; + correctBlur: boolean): TBGRABitmap; +begin + Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGRABitmap; +end; + +function TBGRABitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean + ): TBGRABitmap; +begin + Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGRABitmap; +end; + +function TBGRABitmap.FilterSphere: TBGRABitmap; +begin + Result:=inherited FilterSphere as TBGRABitmap; +end; + +function TBGRABitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; + ATurn: Single; AExponent: Single): TBGRABitmap; +begin + Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGRABitmap; +end; + +function TBGRABitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; + ARadius: Single; ATurn: Single; AExponent: Single): TBGRABitmap; +begin + Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRABitmap; +end; + +function TBGRABitmap.FilterCylinder: TBGRABitmap; +begin + Result:=inherited FilterCylinder as TBGRABitmap; +end; + +function TBGRABitmap.FilterPlane: TBGRABitmap; +begin + Result:=inherited FilterPlane as TBGRABitmap; +end; + +initialization + + //this variable is assigned to access appropriate functions + //depending on the platform + BGRABitmapFactory := TBGRABitmap; + +finalization + + tempBmp.Free; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack.pas new file mode 100644 index 0000000..8c46a1f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack.pas @@ -0,0 +1,36 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit BGRABitmapPack; + +{$warn 5023 off : no warning about unused units} +interface + +uses + BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, + BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, + BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, + BGRAFreeType, BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, + BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, + BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, + BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRAText, BGRATextFX, + BGRATransform, BGRATypewriter, BGRAVectorize, BGRAGrayscaleMask, + BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, BGRAReadPSD, + BGRAThumbnail, BGRAReadTGA, BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, + UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRASVG, BGRAUnits, + BGRASVGShapes, BGRASVGType, BGRAReadBmpMioMap, BGRAArrow, BGRAPalette, + BGRAColorQuantization, BGRADithering, BGRAUTF8, BGRALCLBitmap, BGRAWritePNG, + BGRAGifFormat, BGRAGraphics, BGRASceneTypes, BGRARenderer3D, + BGRAWriteBmpMioMap, BGRAOpenGLType, BGRASpriteGL, BGRAOpenGL, BGRACanvasGL, + BGRAFontGL, BGRAOpenGL3D, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, + BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRALazResource, + BGRAIconCursor, BGRABlurGL, BGRAReadTiff, BGRALazPaint, BGRAMemDirectory, + BGRAUnicode, BGRATextBidi, BGRALayerOriginal, BGRASVGOriginal, + BGRAGradientOriginal, BGRAUnicodeText, UniversalDrawer, LinearRGBABitmap, + XYZABitmap, BGRAWriteTiff, WordXYZABitmap, ExpandedBitmap, libwebp, + linuxlib, BGRAReadWebP, BGRAWriteWebP, BGRAClasses; + +implementation + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4fpgui.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4fpgui.pas new file mode 100644 index 0000000..596f378 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4fpgui.pas @@ -0,0 +1,30 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit BGRABitmapPack4fpGUI; + +{$warn 5023 off : no warning about unused units} +interface + +uses + BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, + BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, + BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, + BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, + BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, + BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, + BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, + BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, + BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, + UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, + BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRAfpGUIBitmap, + BGRATypewriter, BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, + BGRAColorQuantization, BGRADithering, BGRAFreeType, BGRACustomTextFX, + BGRAWritePNG, BGRAGifFormat, BGRASceneTypes, BGRARenderer3D, + BGRAWriteBmpMioMap, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, + BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRAUnicode, BGRAClasses; + +implementation + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4nogui.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4nogui.pas new file mode 100644 index 0000000..2f2d0cc --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4nogui.pas @@ -0,0 +1,31 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit BGRABitmapPack4NoGUI; + +{$warn 5023 off : no warning about unused units} +interface + +uses + BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, + BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, + BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, + BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, + BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, + BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, + BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, + BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, + BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, + UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, + BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRATypewriter, + BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, BGRAColorQuantization, + BGRADithering, BGRAFreeType, BGRACustomTextFX, BGRAWritePNG, BGRAGifFormat, + BGRANoGUIBitmap, BGRASceneTypes, BGRARenderer3D, BGRAWriteBmpMioMap, + BGRASpriteGL, BGRAOpenGLType, BGRAOpenGL, BGRACanvasGL, BGRAPhoxo, + BGRAFilterScanner, BGRAFilterType, BGRAFilterBlur, BGRAMultiFileType, + BGRAWinResource, BGRAUnicode, BGRAClasses; + +implementation + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmaptypes.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmaptypes.pas new file mode 100644 index 0000000..4a416bc --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrabitmaptypes.pas @@ -0,0 +1,1533 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgrabitmaptypes.pas + ------------------- + This unit defines basic types and it must be + included in the 'uses' clause. + + --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause. + If you are using LCL types, add also BGRAGraphics unit. +} + +unit BGRABitmapTypes; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, BGRAGraphics, BGRAUnicode, + FPImage{$IFDEF BGRABITMAP_USE_FPCANVAS}, FPImgCanv{$ENDIF} + {$IFDEF BGRABITMAP_USE_LCL}, LCLType, GraphType, LResources{$ENDIF}, + BGRAMultiFileType; + + +const + BGRABitmapVersion = 11030100; + + function BGRABitmapVersionStr: string; + +type + TMultiFileContainer = BGRAMultiFileType.TMultiFileContainer; + Int32or64 = BGRAClasses.Int32or64; + UInt32or64 = BGRAClasses.UInt32or64; + HDC = {$IFDEF BGRABITMAP_USE_LCL}LCLType.HDC{$ELSE}PtrUInt{$ENDIF}; + +{=== Miscellaneous types ===} + +type + {* Options when doing a floodfill (also called bucket fill) } + TFloodfillMode = ( + {** Pixels that are filled are replaced } + fmSet, + {** Pixels that are filled are drawn upon with the fill color } + fmDrawWithTransparency, + {** Pixels that are filled are drawn without gamma correction upon with the fill color } + fmLinearBlend, + {** Pixels that are XORed with the fill color} + fmXor, + {** Pixels that are filled are drawn upon to the extent that the color underneath is similar to + the start color. The more different the different is, the less it is drawn upon } + fmProgressive); + + {* Specifies how much smoothing is applied to the computation of the median } + TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth); + {* Specifies the shape of a predefined blur } + TRadialBlurType = ( + {** Gaussian-like, pixel importance decreases progressively } + rbNormal, + {** Disk blur, pixel importance does not decrease progressively } + rbDisk, + {** Pixel are considered when they are at a certain distance } + rbCorona, + {** Gaussian-like, but 10 times smaller than ''rbNormal'' } + rbPrecise, + {** Gaussian-like but simplified to be computed faster } + rbFast, + {** Box blur, pixel importance does not decrease progressively + and the pixels are included when they are in a square. + This is much faster than ''rbFast'' however you may get + square shapes in the resulting image } + rbBox); + + TEmbossOption = (eoTransparent, eoPreserveHue); + TEmbossOptions = set of TEmbossOption; + + {* List of image formats } + TBGRAImageFormat = ( + {** Unknown format } + ifUnknown, + {** JPEG format, opaque, lossy compression } + ifJpeg, + {** PNG format, transparency, lossless compression } + ifPng, + {** GIF format, single transparent color, lossless in theory but only low number of colors allowed } + ifGif, + {** BMP format, transparency, no compression. Note that transparency is + not supported by all BMP readers so it is recommended to avoid + storing images with transparency in this format } + ifBmp, + {** iGO BMP (16-bit, rudimentary lossless compression) } + ifBmpMioMap, + {** ICO format, contains different sizes of the same image } + ifIco, + {** CUR format, has hotspot, contains different sizes of the same image } + ifCur, + {** PCX format, opaque, rudimentary lossless compression } + ifPcx, + {** Paint.NET format, layers, lossless compression } + ifPaintDotNet, + {** LazPaint format, layers, lossless compression } + ifLazPaint, + {** OpenRaster format, layers, lossless compression } + ifOpenRaster, + {** Phoxo format, layers } + ifPhoxo, + {** Photoshop format, layers, rudimentary lossless compression } + ifPsd, + {** Targa format (TGA), transparency, rudimentary lossless compression } + ifTarga, + {** TIFF format, limited support } + ifTiff, + {** X-Window capture, limited support } + ifXwd, + {** X-Pixmap, text encoded image, limited support } + ifXPixMap, + {** text or binary encoded image, no compression, extension PBM, PGM, PPM } + ifPortableAnyMap, + {** Scalable Vector Graphic, vectorial, read-only as raster } + ifSvg, + {** Lossless or lossy compression using V8 algorithm (need libwebp library) } + ifWebP); + + {* Options when loading an image } + TBGRALoadingOption = ( + {** Do not clear RGB channels when alpha is zero (not recommended) } + loKeepTransparentRGB, + {** Consider BMP to be opaque if no alpha value is provided (for compatibility) } + loBmpAutoOpaque, + {** Load JPEG quickly however with a lower quality } + loJpegQuick); + TBGRALoadingOptions = set of TBGRALoadingOption; + + TTextLayout = BGRAGraphics.TTextLayout; + TFontBidiMode = BGRAUnicode.TFontBidiMode; + TBidiTextAlignment = (btaNatural, btaOpposite, btaLeftJustify, btaRightJustify, btaCenter); + +const + fbmAuto = BGRAUnicode.fbmAuto; + fbmLeftToRight = BGRAUnicode.fbmLeftToRight; + fbmRightToLeft = BGRAUnicode.fbmRightToLeft; + + function AlignmentToBidiTextAlignment(AAlign: TAlignment; ARightToLeft: boolean): TBidiTextAlignment; overload; + function AlignmentToBidiTextAlignment(AAlign: TAlignment): TBidiTextAlignment; overload; + function BidiTextAlignmentToAlignment(ABidiAlign: TBidiTextAlignment; ARightToLeft: boolean): TAlignment; + +const + RadialBlurTypeToStr: array[TRadialBlurType] of string = + ('Normal','Disk','Corona','Precise','Fast','Box'); + + + tlTop = BGRAGraphics.tlTop; + tlCenter = BGRAGraphics.tlCenter; + tlBottom = BGRAGraphics.tlBottom; + + // checks the bounds of an image in the given clipping rectangle + function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer; const cliprect: TRect): boolean; + +{==== Imported from GraphType ====} +//if this unit is defined, otherwise +//define here the types used by the library. +{$IFDEF BGRABITMAP_USE_LCL} + type + { Order of the lines in an image } + TRawImageLineOrder = GraphType.TRawImageLineOrder; + { Order of the bits in a byte containing pixel values } + TRawImageBitOrder = GraphType.TRawImageBitOrder; + { Order of the bytes in a group of byte containing pixel values } + TRawImageByteOrder = GraphType.TRawImageByteOrder; + { Definition of a single line 3D bevel } + TGraphicsBevelCut = GraphType.TGraphicsBevelCut; + + const + riloTopToBottom = GraphType.riloTopToBottom; // The first line (line 0) is the top line + riloBottomToTop = GraphType.riloBottomToTop; // The first line (line 0) is the bottom line + + riboBitsInOrder = GraphType.riboBitsInOrder; // Bit 0 is pixel 0 + riboReversedBits = GraphType.riboReversedBits; // Bit 0 is pixel 7 (Bit 1 is pixel 6, ...) + + riboLSBFirst = GraphType.riboLSBFirst; // least significant byte first (little endian) + riboMSBFirst = GraphType.riboMSBFirst; // most significant byte first (big endian) + + fsSurface = GraphType.fsSurface; //type is defined as Graphics.TFillStyle + fsBorder = GraphType.fsBorder; + + bvNone = GraphType.bvNone; + bvLowered = GraphType.bvLowered; + bvRaised = GraphType.bvRaised; + bvSpace = GraphType.bvSpace; +{$ELSE} + type + {* Order of the lines in an image } + TRawImageLineOrder = ( + {** The first line in memory (line 0) is the top line } + riloTopToBottom, + {** The first line in memory (line 0) is the bottom line } + riloBottomToTop); + + {* Order of the bits in a byte containing pixel values } + TRawImageBitOrder = ( + {** The lowest bit is on the left. So with a monochrome picture, bit 0 would be pixel 0 } + riboBitsInOrder, + {** The lowest bit is on the right. So with a momochrome picture, bit 0 would be pixel 7 (bit 1 would be pixel 6, ...) } + riboReversedBits); + + {* Order of the bytes in a group of byte containing pixel values } + TRawImageByteOrder = ( + {** Least significant byte first (little endian) } + riboLSBFirst, + {** most significant byte first (big endian) } + riboMSBFirst); + + {* Definition of a single line 3D bevel } + TGraphicsBevelCut = + ( + {** No bevel } + bvNone, + {** Shape is lowered, light is on the bottom-right corner } + bvLowered, + {** Shape is raised, light is on the top-left corner } + bvRaised, + {** Shape is at the same level, there is no particular lighting } + bvSpace); +{$ENDIF} + +{$DEFINE INCLUDE_INTERFACE} +{$I bgrapixel.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$I geometrytypes.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$i csscolorconst.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$I bgrascanner.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$I unibitmap.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$I unibitmapgeneric.inc} + +{==== Integer math ====} + + {* Computes the value modulo cycle, and if the ''value'' is negative, the result + is still positive } + function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload; + + { Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values. + They use a table to store already computed values. The return value is an integer + ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is + 32768 instead of 1. The input has a period of 65536, so you can supply any integer + without applying a modulo. } + + { Compute all values now } + procedure PrecalcSin65536; + + {* Returns an integer approximation of the sine. Value ranges from 0 to 65535, + where 65536 corresponds to the next cycle } + function Sin65536(value: word): Int32or64; inline; + {* Returns an integer approximation of the cosine. Value ranges from 0 to 65535, + where 65536 corresponds to the next cycle } + function Cos65536(value: word): Int32or64; inline; + + {* Returns the square root of the given byte, considering that + 255 is equal to unity } + function ByteSqrt(value: byte): byte; inline; + +{==== Types provided for fonts ====} +type + {* Quality to be used to render text } + TBGRAFontQuality = ( + {** Use the system capabilities. It is rather fast however it may be + not be smoothed. } + fqSystem, + {** Use the system capabilities to render with ClearType. This quality is + of course better than fqSystem however it may not be perfect.} + fqSystemClearType, + {** Garanties a high quality antialiasing. } + fqFineAntialiasing, + {** Fine antialiasing with ClearType assuming an LCD display in red/green/blue order } + fqFineClearTypeRGB, + {** Fine antialiasing with ClearType assuming an LCD display in blue/green/red order } + fqFineClearTypeBGR); + + TGetFineClearTypeAutoFunc = function(): TBGRAFontQuality; +var + fqFineClearType : TGetFineClearTypeAutoFunc; + +type + {* Measurements of a font } + TFontPixelMetric = record + {** The values have been computed } + Defined: boolean; + {** Position of the baseline, where most letters lie } + Baseline, + {** Position of the top of the small letters (x being one of them) } + xLine, + {** Position of the top of the UPPERCASE letters } + CapLine, + {** Position of the bottom of letters like g and p } + DescentLine, + {** Total line height including line spacing defined by the font } + Lineheight: integer; + end; + + {* Measurements of a font in floating point values } + TFontPixelMetricF = record + {** The values have been computed } + Defined: boolean; + {** Position of the baseline, where most letters lie } + Baseline, + {** Position of the top of the small letters (x being one of them) } + xLine, + {** Position of the top of the UPPERCASE letters } + CapLine, + {** Position of the bottom of letters like g and p } + DescentLine, + {** Total line height including line spacing defined by the font } + Lineheight: single; + end; + + {* Vertical anchoring of the font. When text is drawn, a start coordinate + is necessary. Text can be positioned in different ways. This enum + defines what position it is regarding the font } + TFontVerticalAnchor = ( + {** The top of the font. Everything will be drawn below the start coordinate. } + fvaTop, + {** The center of the font } + fvaCenter, + {** The top of capital letters } + fvaCapLine, + {** The center of capital letters } + fvaCapCenter, + {** The top of small letters } + fvaXLine, + {** The center of small letters } + fvaXCenter, + {** The baseline, the bottom of most letters } + fvaBaseline, + {** The bottom of letters that go below the baseline } + fvaDescentLine, + {** The bottom of the font. Everything will be drawn above the start coordinate } + fvaBottom); + + {* Definition of a function that handles work-break } + TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object; + + {* Alignment for a typewriter, that does not have any more information + than a square shape containing glyphs } + TBGRATypeWriterAlignment = (twaTopLeft, twaTop, twaTopRight, twaLeft, twaMiddle, twaRight, twaBottomLeft, twaBottom, twaBottomRight); + {* How a typewriter must render its content on a Canvas2d } + TBGRATypeWriterOutlineMode = (twoPath, twoFill, twoStroke, twoFillOverStroke, twoStrokeOverFill, twoFillThenStroke, twoStrokeThenFill); + + { TBGRACustomFontRenderer } + {* Abstract class for all font renderers } + TBGRACustomFontRenderer = class + protected + {** Specifies the height of the font without taking into account additional line spacing. + A negative value means that it is the full height instead } + FFontEmHeightF: single; + function GetFontEmHeight: integer; + procedure SetFontEmHeight(AValue: integer); + public + {** Specifies the font to use. Unless the font renderer accept otherwise, + the name is in human readable form, like 'Arial', 'Times New Roman', ... } + FontName: string; + + {** Specifies the set of styles to be applied to the font. + These can be fsBold, fsItalic, fsStrikeOut, fsUnderline. + So the value [fsBold,fsItalic] means that the font must be bold and italic } + FontStyle: TFontStyles; + + {** Specifies the quality of rendering. Default value is fqSystem } + FontQuality : TBGRAFontQuality; + + {** Specifies the rotation of the text, for functions that support text rotation. + It is expressed in tenth of degrees, positive values going counter-clockwise } + FontOrientation: integer; + + {** Returns measurement for the current font in pixels } + function GetFontPixelMetric: TFontPixelMetric; virtual; abstract; + function GetFontPixelMetricF: TFontPixelMetricF; virtual; + function FontExists(AName: string): boolean; virtual; abstract; + + {** Returns the total size of the string provided using the current font. + Orientation is not taken into account, so that the width is along the text } + function TextSize(sUTF8: string): TSize; overload; virtual; abstract; + function TextSizeF(sUTF8: string): TPointF; overload; virtual; + function TextSize(sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; overload; virtual; abstract; + function TextSizeF(sUTF8: string; AMaxWidthF: single; ARightToLeft: boolean): TPointF; overload; virtual; + function TextSizeAngle(sUTF8: string; {%H-}orientationTenthDegCCW: integer): TSize; virtual; + function TextSizeAngleF(sUTF8: string; {%H-}orientationTenthDegCCW: integer): TPointF; virtual; + + {** Returns the number of Unicode characters that fit into the specified size } + function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; virtual; abstract; + function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; virtual; + + {** Draws the UTF8 encoded string, with color ''c''. + If align is taLeftJustify, (''x'',''y'') is the top-left corner. + If align is taCenter, (''x'',''y'') is at the top and middle of the text. + If align is taRightJustify, (''x'',''y'') is the top-right corner. + The value of ''FontOrientation'' is taken into account, so that the text may be rotated } + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; abstract; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; + + {** Same as above functions, except that the text is filled using texture. + The value of ''FontOrientation'' is taken into account, so that the text may be rotated } + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; abstract; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; + + {** Same as above, except that the orientation is specified, overriding the value of the property ''FontOrientation'' } + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; abstract; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; + {** Same as above, except that the orientation is specified, overriding the value of the property ''FontOrientation'' } + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; abstract; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; + + {** Draw the UTF8 encoded string at the coordinate (''x'',''y''), clipped inside the rectangle ''ARect''. + Additional style information is provided by the style parameter. + The color ''c'' is used to fill the text. No rotation is applied. } + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; virtual; abstract; + + {** Same as above except a ''texture'' is used to fill the text } + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; virtual; abstract; + + {** Copy the path for the UTF8 encoded string into ''ADest''. + If ''align'' is ''taLeftJustify'', (''x'',''y'') is the top-left corner. + If ''align'' is ''taCenter'', (''x'',''y'') is at the top and middle of the text. + If ''align'' is ''taRightJustify'', (''x'',''y'') is the top-right corner. } + procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment); virtual; //optional + procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment; {%H-}ARightToLeft: boolean); virtual; //optional + function HandlesTextPath: boolean; virtual; + + property FontEmHeight: integer read GetFontEmHeight write SetFontEmHeight; + property FontEmHeightF: single read FFontEmHeightF write FFontEmHeightF; + end; + + {* Output mode for the improved renderer for readability. This is used by the font renderer based on LCL in ''BGRAText'' } + TBGRATextOutImproveReadabilityMode = (irMask, irNormal, irClearTypeRGB, irClearTypeBGR); + +{** Removes line ending and tab characters from a string (for a function + like ''TextOut'' that does not handle this). this works with UTF8 strings + as well } +function CleanTextOutString(const s: string): string; +{** Remove the line ending at the specified position or return False. + This works with UTF8 strings however the index is the byte index } +function RemoveLineEnding(var s: string; indexByte: integer): boolean; +{** Remove the line ending at the specified position or return False. + The index is the character index, that may be different from the + byte index } +function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; +{** Default word break handler } +procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string); + +{==== Images and resampling ====} + +type + {* How the resample is to be computed } + TResampleMode = ( + {** Low quality resample by repeating pixels, stretching them } + rmSimpleStretch, + {** Use resample filters. This gives high + quality resampling however this the proportion changes slightly because + the first and last pixel are considered to occupy only half a unit as + they are considered as the border of the picture + (pixel-centered coordinates) } + rmFineResample); + + {* List of resample filter to be used with ''rmFineResample'' } + TResampleFilter = ( + {** Equivalent of simple stretch with high quality and pixel-centered coordinates } + rfBox, + {** Linear interpolation giving slow transition between pixels } + rfLinear, + {** Mix of ''rfLinear'' and ''rfCosine'' giving medium speed stransition between pixels } + rfHalfCosine, + {** Cosine-like interpolation giving fast transition between pixels } + rfCosine, + {** Simple bi-cubic filter (blurry) } + rfBicubic, + {** Mitchell filter, good for downsizing interpolation } + rfMitchell, + {** Spline filter, good for upsizing interpolation, however slightly blurry } + rfSpline, + {** Lanczos with radius 2, blur is corrected } + rfLanczos2, + {** Lanczos with radius 3, high contrast } + rfLanczos3, + {** Lanczos with radius 4, high contrast } + rfLanczos4, + {** Best quality using rfMitchell or rfSpline } + rfBestQuality); + +const + {** List of strings to represent resample filters } + ResampleFilterStr : array[TResampleFilter] of string = + ('Box','Linear','HalfCosine','Cosine','Bicubic','Mitchell','Spline', + 'Lanczos2','Lanczos3','Lanczos4','BestQuality'); + + {** Gives the sample filter represented by a string } + function StrToResampleFilter(str: string): TResampleFilter; + +type + {* Image information from superficial analysis } + TQuickImageInfo = record + {** Width in pixels } + Width, + {** Height in pixels } + Height, + {** Bitdepth for colors (1, 2, 4, 8 for images with palette/grayscale, 16, 24 or 48 if each channel is present) } + ColorDepth, + {** Bitdepth for alpha (0 if no alpha channel, 1 if bit mask, 8 or 16 if alpha channel) } + AlphaDepth: integer; + end; + + {* Bitmap reader with additional features } + TBGRAImageReader = class(TFPCustomImageReader) + {** Return bitmap information (size, bit depth) } + function GetQuickInfo(AStream: TStream): TQuickImageInfo; virtual; abstract; + {** Return a draft of the bitmap, the ratio may change compared to the original width and height (useful to make thumbnails) } + function GetBitmapDraft(AStream: TStream; AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; virtual; abstract; + end; + + { TBGRACustomWriterPNG } + + TBGRACustomWriterPNG = class(TFPCustomImageWriter) + protected + function GetUseAlpha: boolean; virtual; abstract; + procedure SetUseAlpha(AValue: boolean); virtual; abstract; + public + property UseAlpha : boolean read GetUseAlpha write SetUseAlpha; + end; + +var + {** List of stream readers for images } + DefaultBGRAImageReader: array[TBGRAImageFormat] of TFPCustomImageReaderClass; + {** List of stream writers for images } + DefaultBGRAImageWriter: array[TBGRAImageFormat] of TFPCustomImageWriterClass; + + {** Detect the file format of a given file } + function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat; + {** Detect the file format of a given stream. ''ASuggestedExtensionUTF8'' can + be provided to guess the format } + function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string = ''): TBGRAImageFormat; + {** Returns the file format that is most likely to be stored in the + given filename (according to its extension) } + function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat; + {** Returns a likely image extension for the format } + function SuggestImageExtension(AFormat: TBGRAImageFormat): string; + {** Create an image reader for the given format } + function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader; + {** Create an image writer for the given format. ''AHasTransparentPixels'' + specifies if alpha channel must be supported } + function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter; + +{$DEFINE INCLUDE_INTERFACE} +{$I bgracustombitmap.inc} + +operator =(const AGuid1, AGuid2: TGuid): boolean; + +type + { TBGRAResourceManager } + + TBGRAResourceManager = class + protected + function GetWinResourceType(AExtension: string): pchar; + public + function GetResourceStream(AFilename: string): TStream; virtual; + function IsWinResource(AFilename: string): boolean; virtual; + end; + +var + BGRAResource : TBGRAResourceManager; + +implementation + +uses Math, SysUtils, BGRAUTF8, + FPReadXwd, FPReadXPM, + FPWriteJPEG, FPWriteBMP, FPWritePCX, + FPWriteTGA, FPWriteXPM, FPReadPNM, FPWritePNM; + +function BGRABitmapVersionStr: string; +var numbers: TStringList; + i,remaining: LongWord; +begin + numbers := TStringList.Create; + remaining := BGRABitmapVersion; + for i := 1 to 4 do + begin + numbers.Insert(0, IntToStr(remaining mod 100)); + remaining := remaining div 100; + end; + while (numbers.Count > 1) and (numbers[numbers.Count-1]='0') do + numbers.Delete(numbers.Count-1); + numbers.Delimiter:= '.'; + result := numbers.DelimitedText; + numbers.Free; +end; + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I geometrytypes.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I unibitmap.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I unibitmapgeneric.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I csscolorconst.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I bgracustombitmap.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I bgrascanner.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I bgrapixel.inc} + +function AlignmentToBidiTextAlignment(AAlign: TAlignment; ARightToLeft: boolean): TBidiTextAlignment; +begin + case AAlign of + taCenter: result := btaCenter; + taRightJustify: if ARightToLeft then result := btaNatural else result := btaOpposite; + else {taLeftJustify} + if ARightToLeft then result := btaOpposite else result := btaNatural; + end; +end; + +function AlignmentToBidiTextAlignment(AAlign: TAlignment): TBidiTextAlignment; +begin + case AAlign of + taCenter: result := btaCenter; + taRightJustify: result := btaRightJustify; + else {taLeftJustify} + result := btaLeftJustify; + end; +end; + +function BidiTextAlignmentToAlignment(ABidiAlign: TBidiTextAlignment; + ARightToLeft: boolean): TAlignment; +begin + case ABidiAlign of + btaCenter: result := taCenter; + btaLeftJustify: result := taLeftJustify; + btaRightJustify: result := taRightJustify; + btaOpposite: if ARightToLeft then result := taLeftJustify else result := taRightJustify; + else {btaNatural} + if ARightToLeft then result := taRightJustify else result := taLeftJustify; + end; +end; + +function CleanTextOutString(const s: string): string; +var idxIn, idxOut: integer; +begin + setlength(result, length(s)); + idxIn := 1; + idxOut := 1; + while IdxIn <= length(s) do + begin + if not (s[idxIn] in[#13,#10,#9]) then //those characters are always 1 byte long so it is the same with UTF8 + begin + result[idxOut] := s[idxIn]; + inc(idxOut); + end; + inc(idxIn); + end; + setlength(result, idxOut-1); +end; + +function RemoveLineEnding(var s: string; indexByte: integer): boolean; +begin //we can ignore UTF8 character length because #13 and #10 are always 1 byte long + //so this function can be applied to UTF8 strings as well + result := false; + if length(s) >= indexByte then + begin + if s[indexByte] in[#13,#10] then + begin + result := true; + if length(s) >= indexByte+1 then + begin + if (s[indexByte+1] <> s[indexByte]) and (s[indexByte+1] in[#13,#10]) then + delete(s,indexByte,2) + else + delete(s,indexByte,1); + end + else + delete(s,indexByte,1); + end else + if (s[indexByte] = #$C2) and (length(s) >= indexByte+1) and (s[indexByte+1] = #$85) then + begin + result := true; + delete(s,indexByte,2); + end else + if (s[indexByte] = #$E2) and (length(s) >= indexByte+2) and (s[indexByte+1] = #$80) and + (s[indexByte+2] in[#$A8,#$A9]) then + begin + result := true; + delete(s,indexByte,3); + end + end; +end; + +function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; +var indexByte: integer; + pIndex: PChar; +begin + pIndex := UTF8CharStart(@sUTF8[1],length(sUTF8),indexUTF8); + if pIndex = nil then + begin + result := false; + exit; + end; + indexByte := pIndex - @sUTF8[1]; + result := RemoveLineEnding(sUTF8, indexByte); +end; + +procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string); +const spacingChars = [' ']; + wordBreakChars = [' ',#9,'-','?','!']; +var p, charLen: integer; + u: LongWord; +begin + if (AAfter <> '') and (ABefore <> '') and not (AAfter[1] in spacingChars) and not (ABefore[length(ABefore)] in wordBreakChars) then + begin + p := length(ABefore); + while (p > 1) and not (ABefore[p-1] in wordBreakChars) do dec(p); + while (p < length(ABefore)+1) and (ABefore[p] in [#$80..#$BF]) do inc(p); //do not split UTF8 char + //keep non-spacing mark together + while p <= length(ABefore) do + begin + charLen := UTF8CharacterLength(@ABefore[p]); + if p+charLen > length(ABefore)+1 then charLen := length(ABefore)+1-p; + u := UTF8CodepointToUnicode(@ABefore[p],charLen); + if (GetUnicodeBidiClassEx(u) in[ubcNonSpacingMark, ubcCombiningLeftToRight]) then + inc(p,charLen) + else + break; + end; + + if p = 1 then + begin + //keep ideographic punctuation together + charLen := UTF8CharacterLength(@AAfter[p]); + if charLen > length(AAfter) then charLen := length(AAfter); + u := UTF8CodepointToUnicode(@AAfter[p],charLen); + case u of + UNICODE_IDEOGRAPHIC_COMMA, + UNICODE_IDEOGRAPHIC_FULL_STOP, + UNICODE_FULLWIDTH_COMMA, + UNICODE_HORIZONTAL_ELLIPSIS: + begin + p := length(ABefore)+1; + while p > 1 do + begin + charLen := 1; + dec(p); + while (p > 0) and (ABefore[p] in [#$80..#$BF]) do + begin + dec(p); //do not split UTF8 char + inc(charLen); + end; + if charLen <= 4 then + u := UTF8CodepointToUnicode(@ABefore[p],charLen) + else + u := ord('A'); + case GetUnicodeBidiClass(u) of + ubcNonSpacingMark: ; // include NSM + ubcOtherNeutrals, ubcWhiteSpace, ubcCommonSeparator, ubcEuropeanNumberSeparator: + begin + p := 1; + break; + end + else + break; + end; + end; + end; + end; + end; + + if p > 1 then //can put the word after + begin + AAfter := copy(ABefore,p,length(ABefore)-p+1)+AAfter; + ABefore := copy(ABefore,1,p-1); + end else + begin //cannot put the word after, so before + + end; + end; + while (ABefore <> '') and (ABefore[length(ABefore)] in spacingChars) do delete(ABefore,length(ABefore),1); + while (AAfter <> '') and (AAfter[1] in spacingChars) do delete(AAfter,1,1); +end; + + +function StrToResampleFilter(str: string): TResampleFilter; +var f: TResampleFilter; +begin + result := rfLinear; + str := LowerCase(str); + for f := low(TResampleFilter) to high(TResampleFilter) do + if CompareText(str,ResampleFilterStr[f])=0 then + begin + result := f; + exit; + end; +end; + +function GetFineClearTypeAuto: TBGRAFontQuality; +begin + result := fqFineClearTypeRGB; +end; + +{ TBGRACustomFontRenderer } + +function TBGRACustomFontRenderer.GetFontEmHeight: integer; +begin + result := round(FFontEmHeightF); +end; + +procedure TBGRACustomFontRenderer.SetFontEmHeight(AValue: integer); +begin + FFontEmHeightF:= AValue; +end; + +function TBGRACustomFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; +begin + with GetFontPixelMetric do + begin + result.Defined := Defined; + result.Baseline := Baseline; + result.xLine := xLine; + result.CapLine := CapLine; + result.DescentLine := DescentLine; + result.Lineheight := LineHeight; + end; +end; + +function TBGRACustomFontRenderer.TextSizeF(sUTF8: string): TPointF; +begin + with TextSize(sUTF8) do + result := PointF(cx,cy); +end; + +function TBGRACustomFontRenderer.TextSizeF(sUTF8: string; AMaxWidthF: single; + ARightToLeft: boolean): TPointF; +begin + with TextSize(sUTF8, round(AMaxWidthF), ARightToLeft) do + result := PointF(cx,cy); +end; + +function TBGRACustomFontRenderer.TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; +begin + result := TextFitInfo(sUTF8, round(AMaxWidthF)); +end; + +function TBGRACustomFontRenderer.TextSizeAngle(sUTF8: string; + orientationTenthDegCCW: integer): TSize; +begin + result := TextSize(sUTF8); //ignore orientation by default +end; + +function TBGRACustomFontRenderer.TextSizeAngleF(sUTF8: string; + orientationTenthDegCCW: integer): TPointF; +begin + result := TextSizeF(sUTF8); //ignore orientation by default +end; + +procedure TBGRACustomFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; + ARightToLeft: boolean); +begin + //if RightToLeft is not handled + TextOut(ADest,x,y,sUTF8,c,align); +end; + +procedure TBGRACustomFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; + ARightToLeft: boolean); +begin + //if RightToLeft is not handled + TextOut(ADest,x,y,sUTF8,texture,align); +end; + +procedure TBGRACustomFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; + align: TAlignment; ARightToLeft: boolean); +begin + //if RightToLeft is not handled + TextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,align); +end; + +procedure TBGRACustomFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientationTenthDegCCW: integer; sUTF8: string; + texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); +begin + //if RightToLeft is not handled + TextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,texture,align); +end; + +procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); +begin {optional implementation} end; + +procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, + y: single; s: string; align: TAlignment; ARightToLeft: boolean); +begin + //if RightToLeft is not handled + CopyTextPathTo(ADest, x,y, s, align); +end; + +function TBGRACustomFontRenderer.HandlesTextPath: boolean; +begin + result := false; +end; + + +function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, + maxyb, ignoreleft: integer; const cliprect: TRect): boolean; +var x2,y2: integer; +begin + if (x >= cliprect.Right) or (y >= cliprect.Bottom) or (x <= cliprect.Left-tx) or + (y <= cliprect.Top-ty) or (ty <= 0) or (tx <= 0) then + begin + result := false; + exit; + end; + + x2 := x + tx - 1; + y2 := y + ty - 1; + + if y < cliprect.Top then + minyb := cliprect.Top + else + minyb := y; + if y2 >= cliprect.Bottom then + maxyb := cliprect.Bottom - 1 + else + maxyb := y2; + + if x < cliprect.Left then + begin + ignoreleft := cliprect.Left-x; + minxb := cliprect.Left; + end + else + begin + ignoreleft := 0; + minxb := x; + end; + if x2 >= cliprect.Right then + maxxb := cliprect.Right - 1 + else + maxxb := x2; + + result := true; +end; + +{************************** Cyclic functions *******************} + +// Get the cyclic value in the range [0..cycle-1] +function PositiveMod(value, cycle: Int32or64): Int32or64; inline; +begin + result := value mod cycle; + if result < 0 then //modulo can be negative + Inc(result, cycle); +end; + +{ Table of precalc values. Note : the value is stored for + the first half of the cycle, and values are stored 'minus 1' + in order to stay in the range 0..65535 } +var + sinTab65536: packed array of word; + byteSqrtTab: packed array of word; + +function Sin65536(value: word): Int32or64; +var b: integer; +begin + //allocate array + if sinTab65536 = nil then + setlength(sinTab65536,32768); + + if value >= 32768 then //function is upside down after half-period + begin + b := value xor 32768; + if sinTab65536[b] = 0 then //precalc + sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1; + result := not sinTab65536[b]; + end else + begin + b := value; + if sinTab65536[b] = 0 then //precalc + sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1; + {$hints off} + result := sinTab65536[b]+1; + {$hints on} + end; +end; + +function Cos65536(value: word): Int32or64; +begin + {$PUSH}{$R-} + result := Sin65536(value+16384); //cosine is translated + {$POP} +end; + +procedure PrecalcSin65536; +var + i: Integer; +begin + for i := 0 to 32767 do Sin65536(i); +end; + +procedure PrecalcByteSqrt; +var i: integer; +begin + if byteSqrtTab = nil then + begin + setlength(byteSqrtTab,256); + for i := 0 to 255 do + byteSqrtTab[i] := round(sqrt(i/255)*255); + end; +end; + +function ByteSqrt(value: byte): byte; inline; +begin + if byteSqrtTab = nil then PrecalcByteSqrt; + result := ByteSqrtTab[value]; +end; + +function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat; +var stream: TFileStreamUTF8; +begin + try + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); + except + result := ifUnknown; + exit; + end; + try + result := DetectFileFormat(stream, ExtractFileExt(AFilenameUTF8)); + finally + stream.Free; + end; +end; + +function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string + ): TBGRAImageFormat; +var + scores: array[TBGRAImageFormat] of integer; + imageFormat,bestImageFormat: TBGRAImageFormat; + bestScore: integer; + + procedure DetectFromStream; + var + {%H-}magic: packed array[0..7] of byte; + {%H-}dwords: packed array[0..9] of LongWord; + magicAsText, moreMagic: string; + + streamStartPos, maxFileSize: Int64; + expectedFileSize: LongWord; + + procedure DetectTarga; + var + paletteCount: integer; + {%H-}targaPixelFormat: packed record pixelDepth: byte; imgDescriptor: byte; end; + begin + if (magic[1] in[$00,$01]) and (magic[2] in[0,1,2,3,9,10,11]) and (maxFileSize >= 18) then + begin + paletteCount:= magic[5] + magic[6] shl 8; + if ((paletteCount = 0) and (magic[7] = 0)) or + (magic[7] in [16,24,32]) then //check palette bit count + begin + AStream.Position:= streamStartPos+16; + if AStream.Read({%H-}targaPixelFormat,2) = 2 then + begin + if (targaPixelFormat.pixelDepth in [8,16,24,32]) and + (targaPixelFormat.imgDescriptor and 15 < targaPixelFormat.pixelDepth) then + inc(scores[ifTarga],2); + end; + end; + end; + end; + + procedure DetectLazPaint; + var + w,h: LongWord; + i: integer; + begin + if (copy(magicAsText,1,8) = 'LazPaint') then //with header + begin + AStream.Position:= streamStartPos+8; + if AStream.Read(dwords,10*4) = 10*4 then + begin + for i := 0 to 6 do dwords[i] := LEtoN(dwords[i]); + if (dwords[0] = 0) and (dwords[1] <= maxFileSize) and (dwords[5] <= maxFileSize) and + (dwords[9] <= maxFileSize) and + (dwords[6] = 0) then inc(scores[ifLazPaint],2); + end; + end else //without header + if ((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and + ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0) then + begin + w := magic[0] + (magic[1] shl 8); + h := magic[4] + (magic[5] shl 8); + AStream.Position:= streamStartPos+8; + if AStream.Read(dwords,4) = 4 then + begin + dwords[0] := LEtoN(dwords[0]); + if (dwords[0] > 0) and (dwords[0] < 65536) then + begin + if 12+dwords[0] < expectedFileSize then + begin + AStream.Position:= streamStartPos+12+dwords[0]; + if AStream.Read(dwords,6*4) = 6*4 then + begin + for i := 0 to 5 do dwords[i] := LEtoN(dwords[i]); + if (dwords[0] <= w) and (dwords[1] <= h) and + (dwords[2] <= w) and (dwords[3] <= h) and + (dwords[2] >= dwords[0]) and (dwords[3] >= dwords[1]) and + ((dwords[4] = 0) or (dwords[4] = 1)) and + (dwords[5] > 0) then inc(scores[ifLazPaint],1); + end; + end; + end; + end; + end; + end; + + begin + fillchar({%H-}magic, sizeof(magic), 0); + fillchar({%H-}dwords, sizeof(dwords), 0); + + streamStartPos:= AStream.Position; + maxFileSize:= AStream.Size - streamStartPos; + if maxFileSize < 8 then exit; + if AStream.Read(magic,sizeof(magic)) <> sizeof(magic) then + begin + fillchar(scores,sizeof(scores),0); + exit; + end; + setlength(magicAsText,sizeof(magic)); + move(magic[0],magicAsText[1],sizeof(magic)); + + if (magic[0] = $ff) and (magic[1] = $d8) then + begin + inc(scores[ifJpeg]); + if (magic[2] = $ff) and (magic[3] >= $c0) then inc(scores[ifJpeg]); + end; + + if (magic[0] = $89) and (magic[1] = $50) and (magic[2] = $4e) and + (magic[3] = $47) and (magic[4] = $0d) and (magic[5] = $0a) and + (magic[6] = $1a) and (magic[7] = $0a) then inc(scores[ifPng],2); + + if (copy(magicAsText,1,6)='GIF87a') or (copy(magicAsText,1,6)='GIF89a') then inc(scores[ifGif],2); + + if (magic[0] = $0a) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) then + inc(scores[ifPcx],2); + + if (copy(magicAsText,1,2)='BM') then + begin + inc(scores[ifBmp]); + expectedFileSize:= magic[2] + (magic[3] shl 8) + (magic[4] shl 16) + (magic[5] shl 24); + if expectedFileSize = maxFileSize then inc(scores[ifBmp]); + end else + if (copy(magicAsText,1,2)='RL') then + begin + inc(scores[ifBmpMioMap]); + if (magic[2] in[0,1]) and (magic[3] = 0) then inc(scores[ifBmpMioMap]); + end; + + if (magic[0] = $00) and (magic[1] = $00) and (magic[3] = $00) and + (magic[4] + (magic[5] shl 8) > 0) then + begin + if magic[2] = $01 then + inc(scores[ifIco]) + else if magic[2] = $02 then + inc(scores[ifCur]); + end; + + if (copy(magicAsText,1,4) = 'PDN3') then + begin + expectedFileSize:= 6 + (magic[4] + (magic[5] shl 8) + (magic[6] shl 16)) + 2; + if expectedFileSize <= maxFileSize then + begin + inc(scores[ifPaintDotNet]); + if magic[7] = $3c then inc(scores[ifPaintDotNet]); + end; + end; + + if (copy(magicAsText,1,4) = 'oXo ') then + begin + inc(scores[ifPhoxo],1); + if (magic[4] = 1) and (magic[5] = 0) and (magic[6] = 0) and (magic[7] = 0) then + inc(scores[ifPhoxo],1); + end; + + DetectLazPaint; + + if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then + begin + if DefaultBGRAImageReader[ifOpenRaster] = nil then inc(scores[ifOpenRaster]) else + with CreateBGRAImageReader(ifOpenRaster) do + try + AStream.Position := streamStartPos; + if CheckContents(AStream) then inc(scores[ifOpenRaster],2); + finally + Free; + end; + end; + + if (copy(magicAsText,1,4) = '8BPS') and (magic[4] = $00) and (magic[5] = $01) then inc(scores[ifPsd],2); + + DetectTarga; + + if (copy(magicAsText,1,2)='II') and (magic[2] = 42) and (magic[3]=0) then inc(scores[ifTiff]) else + if (copy(magicAsText,1,2)='MM') and (magic[2] = 0) and (magic[3]=42) then inc(scores[ifTiff]); + + if (copy(magicAsText,1,8) = '/* XPM *') or (copy(magicAsText,1,6) = '! XPM2') then inc(scores[ifXPixMap]); + + if (copy(magicAsText,1,6) = '3) and (magicAsText[1]='P') and + (magicAsText[2] in['1'..'6']) and (magicAsText[3] = #10) then inc(scores[ifPortableAnyMap]); + + if (copy(magicAsText,1,4) = 'RIFF') then + begin + AStream.Position:= streamStartPos+8; + setlength(moreMagic, 4); + if (AStream.Read(moreMagic[1],4) = 4) + and (moreMagic = 'WEBP') then + inc(scores[ifWebP], 2); + end; + + AStream.Position := streamStartPos; + end; + +var + extFormat: TBGRAImageFormat; + +begin + result := ifUnknown; + for imageFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do + scores[imageFormat] := 0; + + ASuggestedExtensionUTF8:= UTF8LowerCase(ASuggestedExtensionUTF8); + if (ASuggestedExtensionUTF8 <> '') and (ASuggestedExtensionUTF8[1] <> '.') then //first UTF8 char is in first pos + ASuggestedExtensionUTF8 := '.'+ASuggestedExtensionUTF8; + + extFormat:= SuggestImageFormat(ASuggestedExtensionUTF8); + if extFormat <> ifUnknown then inc(scores[extFormat]); + + If AStream <> nil then DetectFromStream; + + bestScore := 0; + bestImageFormat:= ifUnknown; + for imageFormat:=low(TBGRAImageFormat) to high(TBGRAImageFormat) do + if scores[imageFormat] > bestScore then + begin + bestScore:= scores[imageFormat]; + bestImageFormat:= imageFormat; + end; + result := bestImageFormat; +end; + +function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat; +var ext: string; + posDot: integer; +begin + result := ifUnknown; + + ext := ExtractFileName(AFilenameOrExtensionUTF8); + posDot := LastDelimiter('.', ext); + if posDot <> 0 then ext := copy(ext,posDot,length(ext)-posDot+1) + else ext := '.'+ext; + ext := UTF8LowerCase(ext); + + if (ext = '.jpg') or (ext = '.jpeg') then result := ifJpeg else + if (ext = '.png') then result := ifPng else + if (ext = '.gif') then result := ifGif else + if (ext = '.pcx') then result := ifPcx else + if (ext = '.bmp') then result := ifBmp else + if (ext = '.ico') then result := ifIco else + if (ext = '.cur') then result := ifCur else + if (ext = '.pdn') then result := ifPaintDotNet else + if (ext = '.lzp') then result := ifLazPaint else + if (ext = '.ora') then result := ifOpenRaster else + if (ext = '.psd') then result := ifPsd else + if (ext = '.tga') then result := ifTarga else + if (ext = '.tif') or (ext = '.tiff') then result := ifTiff else + if (ext = '.xwd') then result := ifXwd else + if (ext = '.xpm') then result := ifXPixMap else + if (ext = '.oxo') then result := ifPhoxo else + if (ext = '.svg') then result := ifSvg else + if (ext = '.pbm') or (ext = '.pgm') or (ext = '.ppm') then result := ifPortableAnyMap else + if (ext = '.webp') then result := ifWebP; +end; + +function SuggestImageExtension(AFormat: TBGRAImageFormat): string; +begin + case AFormat of + ifJpeg: result := 'jpg'; + ifPng: result := 'png'; + ifGif: result := 'gif'; + ifBmp: result := 'bmp'; + ifBmpMioMap: result := 'bmp'; + ifIco: result := 'ico'; + ifCur: result := 'ico'; + ifPcx: result := 'pcx'; + ifPaintDotNet: result := 'pdn'; + ifLazPaint: result := 'lzp'; + ifOpenRaster: result := 'ora'; + ifPhoxo: result := 'oXo'; + ifPsd: result := 'psd'; + ifTarga: result := 'tga'; + ifTiff: result := 'tif'; + ifXwd: result := 'xwd'; + ifXPixMap: result := 'xpm'; + ifSvg: result := 'svg'; + ifPortableAnyMap: result := 'ppm'; + ifWebP: result := 'webp'; + else result := '?'; + end; +end; + +function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader; +begin + if DefaultBGRAImageReader[AFormat] = nil then + begin + case AFormat of + ifUnknown: raise exception.Create('The image format is unknown.'); + ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to read this image.'); + ifPaintDotNet: raise exception.Create('You need to call BGRAPaintNet.RegisterPaintNetFormat to read this image.'); + ifSvg: raise exception.Create('You need to call BGRA.RegisterSvgFormat to read this image.'); + else + raise exception.Create('The image reader is not registered for this image format.'); + end; + end; + result := DefaultBGRAImageReader[AFormat].Create; +end; + +function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter; +begin + if DefaultBGRAImageWriter[AFormat] = nil then + begin + case AFormat of + ifUnknown: raise exception.Create('The image format is unknown'); + ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to write with this image format.'); + ifPhoxo: raise exception.Create('You need to call BGRAPhoxo.RegisterPhoxoFormat to write with this image format.'); + else + raise exception.Create('The image writer is not registered for this image format.'); + end; + end; + + if AFormat = ifPng then + begin + result := DefaultBGRAImageWriter[AFormat].Create; + if result is TBGRACustomWriterPNG then + TBGRACustomWriterPNG(result).UseAlpha := AHasTransparentPixels; + end else + if AFormat = ifBmp then + begin + result := TFPWriterBMP.Create; + if AHasTransparentPixels then + TFPWriterBMP(result).BitsPerPixel := 32 else + TFPWriterBMP(result).BitsPerPixel := 24; + end else + if AFormat = ifXPixMap then + begin + result := TFPWriterXPM.Create; + TFPWriterXPM(result).ColorCharSize := 2; + end else + result := DefaultBGRAImageWriter[AFormat].Create; +end; + +operator =(const AGuid1, AGuid2: TGuid): boolean; +begin + result := CompareMem(@AGuid1, @AGuid2, sizeof(TGuid)); +end; + +type + TResourceType = record + ext: string; + code: pchar; + end; + +{$IFNDEF BGRABITMAP_USE_LCL}{$IFDEF MSWINDOWS} +const + RT_BITMAP = MAKEINTRESOURCE(2); + RT_RCDATA = MAKEINTRESOURCE(10); + RT_GROUP_CURSOR = MAKEINTRESOURCE(12); + RT_GROUP_ICON = MAKEINTRESOURCE(14); + RT_HTML = MAKEINTRESOURCE(23); +{$ENDIF}{$ENDIF} + +const + ResourceTypes: array[1..7] of TResourceType = + ((ext: 'CUR'; code: RT_GROUP_CURSOR), + (ext: 'BMP'; code: RT_BITMAP), + (ext: 'ICO'; code: RT_GROUP_ICON), + (ext: 'DAT'; code: RT_RCDATA), + (ext: 'DATA'; code: RT_RCDATA), + (ext: 'HTM'; code: RT_HTML), + (ext: 'HTML'; code: RT_HTML)); + +{ TBGRAResourceManager } + +function TBGRAResourceManager.GetWinResourceType(AExtension: string): pchar; +var + i: Integer; +begin + if (AExtension <> '') and (AExtension[1]='.') then delete(AExtension,1,1); + for i := low(ResourceTypes) to high(ResourceTypes) do + if AExtension = ResourceTypes[i].ext then + exit(ResourceTypes[i].code); + + exit(RT_RCDATA); +end; + +function TBGRAResourceManager.GetResourceStream(AFilename: string): TStream; +var + name,ext: RawByteString; + rt: PChar; +begin + ext := UpperCase(ExtractFileExt(AFilename)); + name := ChangeFileExt(AFilename,''); + rt := GetWinResourceType(ext); + + if (rt = RT_GROUP_CURSOR) or (rt = RT_GROUP_ICON) then + raise exception.Create('Not implemented'); + + result := TResourceStream.Create(HINSTANCE, name, rt); +end; + +function TBGRAResourceManager.IsWinResource(AFilename: string): boolean; +var + name,ext: RawByteString; + rt: PChar; +begin + ext := UpperCase(ExtractFileExt(AFilename)); + name := ChangeFileExt(AFilename,''); + rt := GetWinResourceType(ext); + result := FindResource(HINSTANCE, pchar(name), rt)<>0; +end; + +{$IFDEF BGRABITMAP_USE_LCL} +type + + { TLCLResourceManager } + + TLCLResourceManager = class(TBGRAResourceManager) + protected + function FindLazarusResource(AFilename: string): TLResource; + public + function GetResourceStream(AFilename: string): TStream; override; + function IsWinResource(AFilename: string): boolean; override; + end; + +function TLCLResourceManager.FindLazarusResource(AFilename: string): TLResource; +var + name,ext: RawByteString; +begin + ext := UpperCase(ExtractFileExt(AFilename)); + if (ext<>'') and (ext[1]='.') then Delete(ext,1,1); + name := ChangeFileExt(AFilename,''); + if ext<>'' then + result := LazarusResources.Find(name,ext) + else + result := LazarusResources.Find(name); +end; + +function TLCLResourceManager.GetResourceStream(AFilename: string): TStream; +var + res: TLResource; +begin + res := FindLazarusResource(AFilename); + if Assigned(res) then + result := TLazarusResourceStream.CreateFromHandle(res) + else + result := inherited GetResourceStream(AFilename); +end; + +function TLCLResourceManager.IsWinResource(AFilename: string): boolean; +begin + if FindLazarusResource(AFilename)<>nil then + result := false + else + Result:=inherited IsWinResource(AFilename); +end; + +{$ENDIF} + +initialization + + {$DEFINE INCLUDE_INIT} + {$I bgrapixel.inc} + + {$DEFINE INCLUDE_INIT} + {$I csscolorconst.inc} + + fqFineClearType := @GetFineClearTypeAuto; + + DefaultBGRAImageWriter[ifJpeg] := TFPWriterJPEG; + DefaultBGRAImageWriter[ifBmp] := TFPWriterBMP; + DefaultBGRAImageWriter[ifPcx] := TFPWriterPCX; + DefaultBGRAImageWriter[ifTarga] := TFPWriterTarga; + DefaultBGRAImageWriter[ifXPixMap] := TFPWriterXPM; + DefaultBGRAImageWriter[ifPortableAnyMap] := TFPWriterPNM; + //writing XWD not implemented + + DefaultBGRAImageReader[ifXwd] := TFPReaderXWD; + DefaultBGRAImageReader[ifPortableAnyMap] := TFPReaderPNM; + //the other readers are registered by their unit + + {$IFDEF BGRABITMAP_USE_LCL} + BGRAResource := TLCLResourceManager.Create; + {$ELSE} + BGRAResource := TBGRAResourceManager.Create; + {$ENDIF} + +finalization + + {$DEFINE INCLUDE_FINAL} + {$I csscolorconst.inc} + + {$DEFINE INCLUDE_FINAL} + {$I bgrapixel.inc} + + BGRAResource.Free; +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrablend.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrablend.pas new file mode 100644 index 0000000..4cb0e29 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrablend.pas @@ -0,0 +1,1974 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRABlend; + +{ This unit contains pixel blending functions. They take a destination adress as parameter, + and draw pixels at this address with different blending modes. These functions are used + by many functions in BGRABitmap library to do the low level drawing. } + +{$mode objfpc}{$H+} + +interface + +uses + BGRABitmapTypes; + +{ Brush providers } + +procedure BGRASolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); +procedure BGRAScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); +procedure BGRAMaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; AOffsetX: integer = 0; AOffsetY: integer = 0); +procedure BGRAEraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); +procedure BGRAAlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); + +{ Draw one pixel with alpha blending } +procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; +procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; +procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); inline; overload; +procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); inline; overload; //alpha in 'c' parameter +procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; +procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; calpha: byte); inline; overload; +procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel); inline; +procedure InterpolateBilinear(pUpLeft,pUpRight,pDownLeft,pDownRight: PBGRAPixel; + iFactX,iFactY: Integer; ADest: PBGRAPixel); +procedure InterpolateBilinearMask(pUpLeft,pUpRight,pDownLeft,pDownRight: PByteMask; + iFactX,iFactY: Integer; ADest: PByteMask); + +procedure CopyPixelsWithOpacity(dest,src: PBGRAPixel; opacity: byte; Count: integer); inline; +function ApplyOpacity(opacity1,opacity2: byte): byte; inline; +function FastRoundDiv255(value: LongWord): LongWord; inline; + +{ Draw a series of pixels with alpha blending } +procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer; mode: TDrawMode; AOpacity:byte); +procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; overload; +procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; Count: integer); inline; overload; +procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); inline; overload; //alpha in 'c' parameter + +{ Draw one pixel with linear alpha blending } +procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; +procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; + +{ Draw a series of pixels with linear alpha blending } +procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; + +{ Replace a series of pixels } +procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; + +{ Xor a series of pixels } +procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; +procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); + +{ Set alpha value for a series of pixels } +procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline; + +{ Erase a series of pixels, i.e. decrease alpha value } +procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline; + +{ Draw a pixel to the extent the current pixel is close enough to compare value. + It should not be called on pixels that have not been checked to be close enough } +procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; + maxDiff: byte); inline; +{ Draw a series of pixel to the extent the current pixel is close enough to compare value } +procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel; + Count: integer; compare: TBGRAPixel; maxDiff: byte); inline; + +{ Blend pixels with scanner content } +procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); + +{ Perform advanced blending operation } +procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; + blendOp: TBlendOperation; Count: integer; excludeChannels: TChannels = []); + +{ Perform blending operation and merge over destination } +procedure BlendPixelsOver(pdest: PBGRAPixel; psrc: PBGRAPixel; + blendOp: TBlendOperation; Count: integer; opacity: byte; linearBlend: boolean = false; + excludeChannels: TChannels = []); + +//layer blend modes +//- http://www.pegtop.net/delphi/articles/blendmodes/ +//- http://www.w3.org/TR/2009/WD-SVGCompositing-20090430/#comp-op +//- http://docs.gimp.org/en/gimp-concepts-layer-modes.html +procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearAddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure ColorBurnPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure DividePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure ExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearSubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearSubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure SubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure SubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure NegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearNegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LightenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure DarkenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure BlendMaskPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearMultiplySaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearHueInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearColorInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure LinearSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure CorrectedHueInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure CorrectedColorInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure CorrectedLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure CorrectedSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); +procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; + mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; + KeepRGBOrder: boolean); +procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: Int32or64; maskRowSize: Int32or64; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); + +implementation + +type + PBGRASolidBrushFixedData = ^TBGRASolidBrushFixedData; + TBGRASolidBrushFixedData = record + BGRA: TBGRAPixel; + Expanded: TExpandedPixel; + end; + +procedure BGRASolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PBGRAPixel; + bAlpha: Byte; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + FillDWord(pDest^, ACount, PLongWord(@PBGRASolidBrushFixedData(AFixedData)^.BGRA)^); + inc(pDest, ACount); + end else + begin + with PBGRASolidBrushFixedData(AFixedData)^ do + begin + if BGRA.alpha = 255 then + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + DrawExpandedPixelInlineNoAlphaCheck(pDest, Expanded, bAlpha); + inc(pDest); + dec(ACount); + end; + end + else + begin + while ACount > 0 do + begin + pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, Expanded, AAlpha)); + inc(pDest); + dec(ACount); + end; + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRASolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PBGRAPixel(AContextData^.Dest), ACount); +end; + +procedure BGRASolidBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: byte; + pDest: PBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + with PBGRASolidBrushFixedData(AFixedData)^ do + begin + pDest := PBGRAPixel(AContextData^.Dest); + bAlpha := FastRoundDiv257(Expanded.alpha*AAlpha shr 16); + if bAlpha = 255 then + begin + FillDWord(pDest^, ACount, PLongWord(@BGRA)^); + inc(pDest, ACount); + end else + begin + while ACount > 0 do + begin + DrawExpandedPixelInlineNoAlphaCheck(pDest, Expanded, bAlpha); + inc(pDest); + dec(ACount); + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; + end; +end; + +procedure BGRASolidBrushLinearDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + c: TBGRAPixel; + pDest: PBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + with PBGRASolidBrushFixedData(AFixedData)^ do + begin + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + FastBlendPixelInline(pDest, BGRA); + inc(pDest); + dec(ACount); + end; + end else + begin + c := BGRA; + c.alpha := FastRoundDiv257(c.alpha*AAlpha shr 8); + while ACount > 0 do + begin + FastBlendPixelInline(pDest, c); + inc(pDest); + dec(ACount); + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; + end; +end; + +procedure BGRASolidBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + c: TBGRAPixel; + pDest: PBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + with PBGRASolidBrushFixedData(AFixedData)^ do + begin + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor PLongWord(@BGRA)^; + inc(pDest); + dec(ACount); + end; + end else + begin + while ACount > 0 do + begin + PLongWord(@c)^ := PLongWord(pdest)^ xor PLongWord(@BGRA)^; + pDest^ := MergeBGRA(pDest^, not AAlpha, c, AAlpha); + inc(pDest); + dec(ACount); + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; + end; +end; + +procedure BGRASolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; + ADrawMode: TDrawMode); +begin + ABrush.Colorspace:= TBGRAPixelColorspace; + with PBGRASolidBrushFixedData(@ABrush.FixedData)^ do + begin + BGRA := PBGRAPixel(AColor)^; + if not (ADrawMode in[dmLinearBlend,dmXor]) then + Expanded := GammaExpansion(BGRA); + end; + ABrush.InternalInitContext:= nil; + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @BGRASolidBrushSetPixels; + + dmSetExceptTransparent: if PBGRAPixel(AColor)^.alpha <> 255 then + begin + ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end else ABrush.InternalPutNextPixels:= @BGRASolidBrushSetPixels; + + dmDrawWithTransparency: if PBGRAPixel(AColor)^.alpha = 0 then + begin + ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end else ABrush.InternalPutNextPixels:= @BGRASolidBrushDrawPixels; + + dmLinearBlend: if PBGRAPixel(AColor)^.alpha = 0 then + begin + ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end + else ABrush.InternalPutNextPixels:= @BGRASolidBrushLinearDrawPixels; + + dmXor: if PLongWord(AColor)^ = 0 then + begin + ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end else ABrush.InternalPutNextPixels:= @BGRASolidBrushXorPixels; + end; + +end; + +type + PBGRAScannerBrushFixedData = ^TBGRAScannerBrushFixedData; + TBGRAScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + case boolean of + true: (HasPutPixels: boolean); //BGRA + false: (Conversion: TBridgedConversion); //other + end; + +procedure BRGBAScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure BGRAScannerBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: Byte; + pDest: PBGRAPixel; + buf: packed array[0..3] of TBGRAPixel; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + if HasPutPixels then + begin + IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmSet); + inc(pDest, ACount); + end else + while ACount > 0 do + begin + pDest^ := IBGRAScanner(Scanner).ScanNextPixel; + inc(pDest); + dec(ACount); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + if HasPutPixels then + begin + while ACount > 3 do + begin + IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); + pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); + (pDest+1)^ := MergeBGRAWithGammaCorrection((pDest+1)^, not bAlpha, buf[1], bAlpha); + (pDest+2)^ := MergeBGRAWithGammaCorrection((pDest+2)^, not bAlpha, buf[2], bAlpha); + (pDest+3)^ := MergeBGRAWithGammaCorrection((pDest+3)^, not bAlpha, buf[3], bAlpha); + inc(pDest, 4); + dec(ACount, 4); + end; + end; + while ACount > 0 do + begin + pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, IBGRAScanner(Scanner).ScanNextPixel, bAlpha); + inc(pDest); + dec(ACount); + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pBuf,pDest: PBGRAPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TBGRAPixel; + bAlpha: Byte; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, pDest, qty, pixSize, sizeof(TBGRAPixel), nil); + inc(pDest, qty); + dec(ACount, qty); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, pBuf^, bAlpha); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end; + AContextData^.Dest := pDest; + end; + end; +end; + +procedure BGRAScannerBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: Byte; + pDest: PBGRAPixel; + buf: packed array[0..3] of TBGRAPixel; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + if HasPutPixels then + begin + IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmSetExceptTransparent); + inc(pDest, ACount); + end else + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + if buf[0].alpha = 255 then pDest^ := buf[0]; + inc(pDest); + dec(ACount); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + if HasPutPixels then + begin + while ACount > 3 do + begin + IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); + if buf[0].alpha = 255 then pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); + if buf[1].alpha = 255 then (pDest+1)^ := MergeBGRAWithGammaCorrection((pDest+1)^, not bAlpha, buf[1], bAlpha); + if buf[2].alpha = 255 then (pDest+2)^ := MergeBGRAWithGammaCorrection((pDest+2)^, not bAlpha, buf[2], bAlpha); + if buf[3].alpha = 255 then (pDest+3)^ := MergeBGRAWithGammaCorrection((pDest+3)^, not bAlpha, buf[3], bAlpha); + inc(pDest, 4); + dec(ACount, 4); + end; + end; + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + if buf[0].alpha = 255 then + pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); + inc(pDest); + dec(ACount); + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pBuf,pDest: PBGRAPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TBGRAPixel; + bAlpha: Byte; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + if pBuf^.alpha = 255 then pDest^ := pBuf^; + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + if pBuf^.alpha = 255 then + pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, pBuf^, bAlpha); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end; + AContextData^.Dest := pDest; + end; + end; +end; + +procedure BGRAScannerBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: Byte; + pDest: PBGRAPixel; + buf: packed array[0..3] of TBGRAPixel; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + if HasPutPixels then + begin + IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmDrawWithTransparency); + inc(pDest, ACount); + end else + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + DrawPixelInlineWithAlphaCheck(pDest, buf[0]); + inc(pDest); + dec(ACount); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + if HasPutPixels then + begin + while ACount > 3 do + begin + IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); + DrawPixelInlineWithAlphaCheck(pDest, buf[0], bAlpha); + DrawPixelInlineWithAlphaCheck(pDest+1, buf[1], bAlpha); + DrawPixelInlineWithAlphaCheck(pDest+2, buf[2], bAlpha); + DrawPixelInlineWithAlphaCheck(pDest+3, buf[3], bAlpha); + inc(pDest, 4); + dec(ACount, 4); + end; + end; + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + DrawPixelInlineWithAlphaCheck(pDest, buf[0], bAlpha); + inc(pDest); + dec(ACount); + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAScannerConvertBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pBuf,pDest: PBGRAPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TBGRAPixel; + bAlpha: Byte; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + DrawPixelInlineWithAlphaCheck(pDest, pBuf^); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + DrawPixelInlineWithAlphaCheck(pDest, pBuf^, bAlpha); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end; + AContextData^.Dest := pDest; + end; + end; +end; + +procedure BGRAScannerBrushLinearDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: Byte; + pDest: PBGRAPixel; + buf: packed array[0..3] of TBGRAPixel; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + if HasPutPixels then + begin + IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmLinearBlend); + inc(pDest, ACount); + end else + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + FastBlendPixelInline(pDest, buf[0]); + inc(pDest); + dec(ACount); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + if HasPutPixels then + begin + while ACount > 3 do + begin + IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); + FastBlendPixelInline(pDest, buf[0], bAlpha); + FastBlendPixelInline(pDest+1, buf[1], bAlpha); + FastBlendPixelInline(pDest+2, buf[2], bAlpha); + FastBlendPixelInline(pDest+3, buf[3], bAlpha); + inc(pDest, 4); + dec(ACount, 4); + end; + end; + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + FastBlendPixelInline(pDest, buf[0], bAlpha); + inc(pDest); + dec(ACount); + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAScannerConvertBrushLinearDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pBuf,pDest: PBGRAPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TBGRAPixel; + bAlpha: Byte; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + FastBlendPixelInline(pDest, pBuf^); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + FastBlendPixelInline(pDest, pBuf^, bAlpha); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end; + AContextData^.Dest := pDest; + end; + end; +end; + +procedure BGRAScannerBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: byte; + pDest: PBGRAPixel; + buf: packed array[0..3] of TBGRAPixel; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + if HasPutPixels then + begin + IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmXor); + inc(pDest, ACount); + end else + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + PLongWord(pdest)^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; + inc(pDest); + dec(ACount); + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + if HasPutPixels then + begin + while ACount > 3 do + begin + IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); + PLongWord(@buf[0])^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; + PLongWord(@buf[1])^ := PLongWord(pdest+1)^ xor PLongWord(@buf[1])^; + PLongWord(@buf[2])^ := PLongWord(pdest+2)^ xor PLongWord(@buf[2])^; + PLongWord(@buf[3])^ := PLongWord(pdest+3)^ xor PLongWord(@buf[3])^; + pDest^ := MergeBGRA(pDest^, not bAlpha, buf[0], bAlpha); + (pDest+1)^ := MergeBGRA((pDest+1)^, not bAlpha, buf[1], bAlpha); + (pDest+2)^ := MergeBGRA((pDest+2)^, not bAlpha, buf[2], bAlpha); + (pDest+3)^ := MergeBGRA((pDest+3)^, not bAlpha, buf[3], bAlpha); + inc(pDest, 4); + dec(ACount, 4); + end; + end; + while ACount > 0 do + begin + buf[0] := IBGRAScanner(Scanner).ScanNextPixel; + PLongWord(@buf[0])^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; + pDest^ := MergeBGRA(pDest^, not bAlpha, buf[0], bAlpha); + inc(pDest); + dec(ACount); + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAScannerConvertBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pBuf,pDest: PBGRAPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TBGRAPixel; + bAlpha: Byte; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + PLongWord(pDest)^ := PLongWord(pDest)^ xor PLongWord(pBuf)^; + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); + pBuf := @buf; + dec(ACount, qty); + while qty > 0 do + begin + PLongWord(pBuf)^ := PLongWord(pDest)^ xor PLongWord(pBuf)^; + pDest^ := MergeBGRA(pDest^, not bAlpha, pBuf^, bAlpha); + inc(pDest); + inc(pBuf); + dec(qty); + end; + end; + end; + AContextData^.Dest := pDest; + end; + end; +end; + +procedure BGRAScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + ADrawMode: TDrawMode; AOffsetX: integer = 0; AOffsetY: integer = 0); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TBGRAPixelColorspace; + with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + HasPutPixels:= AScanner.IsScanPutPixelsDefined; + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @BRGBAScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if (AScanner.IsScanPutPixelsDefined) or (sourceSpace = TBGRAPixelColorspace) + or (sourceSpace = TExpandedPixelColorspace) then + begin + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @BGRAScannerBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @BGRAScannerBrushSetPixelsExceptTransparent; + dmDrawWithTransparency: ABrush.InternalPutNextPixels:= @BGRAScannerBrushDrawPixels; + dmLinearBlend: ABrush.InternalPutNextPixels:= @BGRAScannerBrushLinearDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @BGRAScannerBrushXorPixels; + end; + end else + begin + with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TBGRAPixelColorspace); + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushSetPixelsExceptTransparent; + dmLinearBlend: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushLinearDrawPixels; + dmDrawWithTransparency: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushXorPixels; + end; + end; +end; + +procedure BGRASolidBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: byte; + pDest: PBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + bAlpha := PByte(AFixedData)^ * AAlpha shr 16; + while ACount > 0 do + begin + ErasePixelInline(pDest, bAlpha); + inc(pDest); + dec(ACount); + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + bAlpha: Byte; + pDest: PBGRAPixel; + qty, maskStride: Integer; + pMask: PByteMask; +begin + with PBGRAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + if AAlpha >= $ff7f then + begin + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := ApplyOpacity(pDest^.alpha, pMask^.gray); + if pDest^.alpha = 0 then pDest^ := BGRAPixelTransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end else + begin + bAlpha := FastRoundDiv257(AAlpha); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := ApplyOpacity(pDest^.alpha, ApplyOpacity(pMask^.gray, bAlpha)); + if pDest^.alpha = 0 then pDest^ := BGRAPixelTransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAMaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TBGRAPixelColorspace; + with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @BRGBAScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @BGRAMaskBrushApply; +end; + +procedure BGRAEraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); +var + bAlpha: Byte; +begin + if AAlpha >= $ff7f then + BGRASolidBrushIndirect(ABrush, @BGRAPixelTransparent, dmSet) + else + begin + ABrush.Colorspace:= TBGRAPixelColorspace; + bAlpha := FastRoundDiv257(AAlpha); + PByte(@ABrush.FixedData)^ := bAlpha; + ABrush.InternalInitContext:= nil; + if bAlpha = 0 then + ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels + else + ABrush.InternalPutNextPixels:= @BGRASolidBrushErasePixels; + end; +end; + +procedure BGRASolidBrushAlphaPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + alphaAdd: Word; + pDest: PBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end else + if AAlpha >= $ff7f then + begin + AlphaFillInline(PBGRAPixel(AContextData^.Dest), PByte(AFixedData)^, ACount); + inc(PBGRAPixel(AContextData^.Dest), ACount); + end else + begin + pDest := PBGRAPixel(AContextData^.Dest); + alphaAdd := PByte(AFixedData)^*AAlpha; + while ACount > 0 do + begin + pDest^.alpha := (pDest^.alpha*(not AAlpha) + alphaAdd) shr 16; + inc(pDest); + dec(ACount); + end; + PBGRAPixel(AContextData^.Dest) := pDest; + end; +end; + +procedure BGRAAlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); +var + bAlpha: Byte; +begin + if AAlpha <= $80 then + BGRASolidBrushIndirect(ABrush, @BGRAPixelTransparent, dmSet) + else + begin + ABrush.Colorspace:= TBGRAPixelColorspace; + bAlpha := FastRoundDiv257(AAlpha); + PByte(@ABrush.FixedData)^ := bAlpha; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @BGRASolidBrushAlphaPixels; + end; +end; + +procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: Int32or64; maskRowSize: Int32or64; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); +var + pdest: PBGRAPixel; + ClearTypePixel: array[0..2] of byte; + curThird: integer; + + procedure OutputPixel; inline; + begin + if texture <> nil then + color := texture.ScanNextPixel; + if RGBOrder then + ClearTypeDrawPixel(pdest, ClearTypePixel[0],ClearTypePixel[1],ClearTypePixel[2], color) + else + ClearTypeDrawPixel(pdest, ClearTypePixel[2],ClearTypePixel[1],ClearTypePixel[0], color); + end; + + procedure NextAlpha(alphaValue: byte); inline; + begin + ClearTypePixel[curThird] := alphaValue; + inc(curThird); + if curThird = 3 then + begin + OutputPixel; + curThird := 0; + Fillchar(ClearTypePixel, sizeof(ClearTypePixel),0); + inc(pdest); + end; + end; + + procedure EndRow; inline; + begin + if curThird > 0 then OutputPixel; + end; + +var + yMask,n: integer; + a: byte; + pmask: PByte; + dx:integer; + miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer; + leftOnSide, rightOnSide: boolean; + countBetween: integer; + v1,v2,v3: byte; + + procedure StartRow; inline; + begin + pdest := dest.Scanline[yMask+y]+minx; + if texture <> nil then + texture.ScanMoveTo(minx,yMask+y); + + curThird := minxThird; + ClearTypePixel[0] := 0; + ClearTypePixel[1] := 0; + ClearTypePixel[2] := 0; + end; + +begin + alphaLineLen := maskWidth+2; + + dec(xThird); //for first subpixel + + if xThird >= 0 then dx := xThird div 3 + else dx := -((-xThird+2) div 3); + inc(x, dx); + dec(xThird, dx*3); + + if y >= dest.ClipRect.Top then miny := 0 + else miny := dest.ClipRect.Top-y; + if y+maskHeight-1 < dest.ClipRect.Bottom then + maxy := maskHeight-1 else + maxy := dest.ClipRect.Bottom-1-y; + + if x >= dest.ClipRect.Left then + begin + minx := x; + minxThird := xThird; + alphaMinX := 0; + leftOnSide := false; + end else + begin + minx := dest.ClipRect.Left; + minxThird := 0; + alphaMinX := (dest.ClipRect.Left-x)*3 - xThird; + leftOnSide := true; + end; + + if x*3+xThird+maskWidth-1 < dest.ClipRect.Right*3 then + begin + maxx := (x*3+xThird+maskWidth-1) div 3; + alphaMaxX := alphaLineLen-1; + rightOnSide := false; + end else + begin + maxx := dest.ClipRect.Right-1; + alphaMaxX := maxx*3+2 - (x*3+xThird); + rightOnSide := true; + end; + + countBetween := alphaMaxX-alphaMinX-1; + + if (alphaMinX <= alphaMaxX) then + begin + for yMask := miny to maxy do + begin + StartRow; + + if leftOnSide then + begin + pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize; + a := pmask^ div 3; + v1 := a+a; + v2 := a; + v3 := 0; + inc(pmask, maskPixelSize); + end else + begin + pmask := maskData + (yMask*maskRowSize); + v1 := 0; + v2 := 0; + v3 := 0; + end; + + for n := countBetween-1 downto 0 do + begin + a := pmask^ div 3; + inc(v1, a); + inc(v2, a); + inc(v3, a); + inc(pmask, maskPixelSize); + + NextAlpha(v1); + v1 := v2; + v2 := v3; + v3 := 0; + end; + + if rightOnSide then + begin + a := pmask^ div 3; + inc(v1, a); + inc(v2, a+a); + end; + + NextAlpha(v1); + NextAlpha(v2); + + EndRow; + end; + end; +end; + +procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); +var delta: Int32or64; +begin + delta := mask.Width*sizeof(TBGRAPixel); + if mask.LineOrder = riloBottomToTop then + delta := -delta; + BGRAFillClearTypeMaskPtr(dest,x,y,xThird,pbyte(mask.ScanLine[0])+1,sizeof(TBGRAPixel),delta,mask.Width,mask.Height,color,texture,RGBOrder); +end; + +procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; + mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; + KeepRGBOrder: boolean); +var + minx,miny,maxx,maxy,countx,n,yb: integer; + pdest,psrc: PBGRAPixel; +begin + if y >= dest.ClipRect.Top then miny := 0 + else miny := dest.ClipRect.Top-y; + if y+mask.Height-1 < dest.ClipRect.Bottom then + maxy := mask.Height-1 else + maxy := dest.ClipRect.Bottom-1-y; + + if x >= dest.ClipRect.Left then minx := 0 + else minx := dest.ClipRect.Left-x; + if x+mask.Width-1 < dest.ClipRect.Right then + maxx := mask.Width-1 else + maxx := dest.ClipRect.Right-1-x; + + countx := maxx-minx+1; + if countx <= 0 then exit; + + for yb := miny to maxy do + begin + pdest := dest.ScanLine[y+yb]+(x+minx); + psrc := mask.ScanLine[yb]+minx; + if texture <> nil then + texture.ScanMoveTo(x+minx, y+yb); + if KeepRGBOrder then + begin + for n := countx-1 downto 0 do + begin + if texture <> nil then color := texture.ScanNextPixel; + ClearTypeDrawPixel(pdest, psrc^.red, psrc^.green, psrc^.blue, color); + inc(pdest); + inc(psrc); + end; + end else + begin + for n := countx-1 downto 0 do + begin + if texture <> nil then color := texture.ScanNextPixel; + ClearTypeDrawPixel(pdest, psrc^.blue, psrc^.green, psrc^.red, color); + inc(pdest); + inc(psrc); + end; + end; + end; +end; + +procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel); +var merge,mergeClearType: TBGRAPixel; + acc: word; + keep,dont_keep: byte; +begin + Cr := ApplyOpacity(Cr,color.alpha); + Cg := ApplyOpacity(Cg,color.alpha); + Cb := ApplyOpacity(Cb,color.alpha); + acc := Cr+Cg+Cb; + if acc = 0 then exit; + + merge := pdest^; + mergeClearType.red := GammaCompressionTab[(GammaExpansionTab[merge.red] * (not byte(Cr)) + + GammaExpansionTab[color.red] * Cr + 128) div 255]; + mergeClearType.green := GammaCompressionTab[(GammaExpansionTab[merge.green] * (not byte(Cg)) + + GammaExpansionTab[color.green] * Cg + 128) div 255]; + mergeClearType.blue := GammaCompressionTab[(GammaExpansionTab[merge.blue] * (not byte(Cb)) + + GammaExpansionTab[color.blue] * Cb + 128) div 255]; + mergeClearType.alpha := merge.alpha; + + if (mergeClearType.alpha = 255) then + pdest^:= mergeClearType + else + begin + if Cg <> 0 then + DrawPixelInlineWithAlphaCheck(@merge, color, Cg); + dont_keep := mergeClearType.alpha; + if dont_keep > 0 then + begin + keep := not dont_keep; + merge.red := GammaCompressionTab[(GammaExpansionTab[merge.red] * keep + GammaExpansionTab[mergeClearType.red] * dont_keep) div 255]; + merge.green := GammaCompressionTab[(GammaExpansionTab[merge.green] * keep + GammaExpansionTab[mergeClearType.green] * dont_keep) div 255]; + merge.blue := GammaCompressionTab[(GammaExpansionTab[merge.blue] * keep + GammaExpansionTab[mergeClearType.blue] * dont_keep) div 255]; + merge.alpha := mergeClearType.alpha + ApplyOpacity(merge.alpha, not mergeClearType.alpha); + end; + pdest^ := merge; + end; +end; + +procedure InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, + pDownRight: PBGRAPixel; iFactX,iFactY: Integer; ADest: PBGRAPixel); +var + w1,w2,w3,w4,alphaW: LongWord; + rSum, gSum, bSum: LongWord; //rgbDiv = aSum + aSum, aDiv: LongWord; +begin + rSum := 0; + gSum := 0; + bSum := 0; + aSum := 0; + aDiv := 0; + + w4 := (iFactX*iFactY+127) shr 8; + w3 := iFactY-w4; + {$PUSH}{$HINTS OFF} + w1 := (256-iFactX)-w3; + {$POP} + w2 := iFactX-w4; + + if (pUpLeft <> nil) and (pUpRight <> nil) and (pDownLeft <> nil) and (pDownRight <> nil) and + (pUpLeft^.alpha = pUpRight^.alpha) and (pUpLeft^.alpha = pDownLeft^.alpha) and + (pUpRight^.alpha = pDownRight^.alpha) then + begin + if pUpLeft^.alpha = 0 then + ADest^ := BGRAPixelTransparent + else + begin + ADest^.red := (pUpLeft^.red*w1 + pUpRight^.red*w2 + pDownLeft^.red*w3 + pDownRight^.red*w4 + 128) shr 8; + ADest^.green := (pUpLeft^.green*w1 + pUpRight^.green*w2 + pDownLeft^.green*w3 + pDownRight^.green*w4 + 128) shr 8; + ADest^.blue := (pUpLeft^.blue*w1 + pUpRight^.blue*w2 + pDownLeft^.blue*w3 + pDownRight^.blue*w4 + 128) shr 8; + ADest^.alpha := pUpLeft^.alpha; + end; + exit; + end; + + { For each pixel around the coordinate, compute + the weight for it and multiply values by it before + adding to the sum } + if pUpLeft <> nil then + with pUpLeft^ do + begin + alphaW := alpha * w1; + inc(aDiv, w1); + inc(aSum, alphaW); + inc(rSum, red * alphaW); + inc(gSum, green * alphaW); + inc(bSum, blue * alphaW); + end; + if pUpRight <> nil then + with pUpRight^ do + begin + alphaW := alpha * w2; + inc(aDiv, w2); + inc(aSum, alphaW); + inc(rSum, red * alphaW); + inc(gSum, green * alphaW); + inc(bSum, blue * alphaW); + end; + if pDownLeft <> nil then + with pDownLeft^ do + begin + alphaW := alpha * w3; + inc(aDiv, w3); + inc(aSum, alphaW); + inc(rSum, red * alphaW); + inc(gSum, green * alphaW); + inc(bSum, blue * alphaW); + end; + if pDownRight <> nil then + with pDownRight^ do + begin + alphaW := alpha * w4; + inc(aDiv, w4); + inc(aSum, alphaW); + inc(rSum, red * alphaW); + inc(gSum, green * alphaW); + inc(bSum, blue * alphaW); + end; + + if aSum < 128 then //if there is no alpha + ADest^ := BGRAPixelTransparent + else + with ADest^ do + begin + red := (rSum + aSum shr 1) div aSum; + green := (gSum + aSum shr 1) div aSum; + blue := (bSum + aSum shr 1) div aSum; + if aDiv = 256 then + alpha := (aSum + 128) shr 8 + else + alpha := (aSum + aDiv shr 1) div aDiv; + end; +end; + +procedure InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, + pDownRight: PByteMask; iFactX, iFactY: Integer; ADest: PByteMask); +var + w1,w2,w3,w4,sum: LongWord; +begin + w4 := (iFactX*iFactY+127) shr 8; + w3 := iFactY-w4; + {$PUSH}{$HINTS OFF} + w1 := (256-iFactX)-w3; + {$POP} + w2 := iFactX-w4; + + if (pUpLeft <> nil) and (pUpRight <> nil) and (pDownLeft <> nil) and (pDownRight <> nil) then + ADest^.gray := (pUpLeft^.gray*w1 + pUpRight^.gray*w2 + pDownLeft^.gray*w3 + pDownRight^.gray*w4 + 128) shr 8 + else + begin + sum := 0; + if pUpLeft <> nil then inc(sum, pUpLeft^.gray*w1); + if pUpRight <> nil then inc(sum, pUpRight^.gray*w2); + if pDownLeft <> nil then inc(sum, pDownLeft^.gray*w3); + if pDownRight <> nil then inc(sum, pDownRight^.gray*w4); + ADest^.gray := (sum + 128) shr 8; + end; +end; + +procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); +var c : TBGRAPixel; + i: Integer; + scanNextFunc: function(): TBGRAPixel of object; +begin + if scan.IsScanPutPixelsDefined then + scan.ScanPutPixels(pdest,count,mode) else + begin + scanNextFunc := @scan.ScanNextPixel; + case mode of + dmLinearBlend: + for i := 0 to count-1 do + begin + FastBlendPixelInline(pdest, scanNextFunc()); + inc(pdest); + end; + dmDrawWithTransparency: + for i := 0 to count-1 do + begin + DrawPixelInlineWithAlphaCheck(pdest, scanNextFunc()); + inc(pdest); + end; + dmSet: + for i := 0 to count-1 do + begin + pdest^ := scanNextFunc(); + inc(pdest); + end; + dmXor: + for i := 0 to count-1 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(scanNextFunc()); + inc(pdest); + end; + dmSetExceptTransparent: + for i := 0 to count-1 do + begin + c := scanNextFunc(); + if c.alpha = 255 then pdest^ := c; + inc(pdest); + end; + end; + end; +end; + +procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + PLongWord(dest)^ := PLongWord(dest)^ xor LongWord(c); + Inc(dest); + Dec(Count); + end; +end; + +procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); +begin + while Count > 0 do + begin + PLongWord(pdest)^ := PLongWord(psrc)^ xor PLongWord(pdest)^; + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +{$i blendpixels.inc} + +procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline; +begin + while Count > 0 do + begin + dest^.alpha := alpha; + Inc(dest); + Dec(Count); + end; +end; + +procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; +begin + FillDWord(dest^, Count, LongWord(c)); +end; + +procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); +var + n: integer; +begin + if c.alpha = 0 then exit; + for n := Count - 1 downto 0 do + begin + FastBlendPixelInline(dest, c); + Inc(dest); + end; +end; + +procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer; + mode: TDrawMode; AOpacity: byte); +var i: integer; tempPixel: TBGRAPixel; +begin + case mode of + dmSet: + begin + if AOpacity <> 255 then + CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount) + else + move(psource^, pdest^, copycount * sizeof(TBGRAPixel)); + end; + dmSetExceptTransparent: + begin + if AOpacity <> 255 then + begin + for i := copycount - 1 downto 0 do + begin + if psource^.alpha = 255 then + begin + tempPixel := psource^; + tempPixel.alpha := ApplyOpacity(tempPixel.alpha,AOpacity); + FastBlendPixelInline(pdest,tempPixel); + end; + Inc(pdest); + Inc(psource); + end; + end else + for i := copycount - 1 downto 0 do + begin + if psource^.alpha = 255 then + pdest^ := psource^; + Inc(pdest); + Inc(psource); + end; + end; + dmDrawWithTransparency: + begin + if AOpacity <> 255 then + begin + for i := copycount - 1 downto 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest, psource^, AOpacity); + Inc(pdest); + Inc(psource); + end; + end + else + for i := copycount - 1 downto 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest, psource^); + Inc(pdest); + Inc(psource); + end; + end; + dmFastBlend: + begin + if AOpacity <> 255 then + begin + for i := copycount - 1 downto 0 do + begin + FastBlendPixelInline(pdest, psource^, AOpacity); + Inc(pdest); + Inc(psource); + end; + end else + for i := copycount - 1 downto 0 do + begin + FastBlendPixelInline(pdest, psource^); + Inc(pdest); + Inc(psource); + end; + end; + dmXor: + begin + if AOpacity <> 255 then + begin + for i := copycount - 1 downto 0 do + begin + PLongWord(@tempPixel)^ := PLongWord(pdest)^ xor PLongWord(psource)^; + FastBlendPixelInline(pdest, tempPixel, AOpacity); + Inc(pdest); + Inc(psource); + end; + end else + XorPixels(pdest, psource, copycount); + end; + end; +end; + +procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); +var + n: integer; + ec: TExpandedPixel; +begin + if c.alpha = 0 then exit; + if c.alpha = 255 then + begin + filldword(dest^,count,LongWord(c)); + exit; + end; + ec := GammaExpansion(c); + for n := Count - 1 downto 0 do + begin + DrawExpandedPixelInlineNoAlphaCheck(dest, ec,c.alpha); + Inc(dest); + end; +end; + +procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; + Count: integer); +var + n: integer; + c: TBGRAPixel; +begin + if ec.alpha < $0100 then exit; + if ec.alpha >= $FF00 then + begin + c := GammaCompression(ec); + filldword(dest^,count,LongWord(c)); + exit; + end; + for n := Count - 1 downto 0 do + begin + DrawExpandedPixelInlineNoAlphaCheck(dest, ec, ec.alpha shr 8); + Inc(dest); + end; +end; + +procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); +var + n: integer; +begin + if c.alpha = 0 then exit; + if c.alpha = 255 then + begin + filldword(dest^,count,LongWord(c)); + exit; + end; + for n := Count - 1 downto 0 do + begin + DrawExpandedPixelInlineNoAlphaCheck(dest, ec, c.alpha); + Inc(dest); + end; +end; + +procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel; + Count: integer; compare: TBGRAPixel; maxDiff: byte); inline; +var + n: integer; +begin + for n := Count - 1 downto 0 do + begin + DrawPixelInlineDiff(dest, c, compare, maxDiff); + Inc(dest); + end; +end; + +procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); +begin + case c.alpha of + 0: ; + 255: dest^ := c; + else + DrawPixelInlineNoAlphaCheck(dest,c); + end; +end; + +procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); +begin + c.alpha := ApplyOpacity(c.alpha,appliedOpacity); + DrawPixelInlineWithAlphaCheck(dest, c); +end; + +procedure CopyPixelsWithOpacity(dest, src: PBGRAPixel; opacity: byte; + Count: integer); +begin + while count > 0 do + begin + dest^ := MergeBGRAWithGammaCorrection(src^,opacity,dest^,not opacity); + inc(src); + inc(dest); + dec(count); + end; +end; + +function ApplyOpacity(opacity1, opacity2: byte): byte; +begin + result := opacity1*(opacity2+1) shr 8; +end; + +function FastRoundDiv255(value: LongWord): LongWord; inline; +begin + result := (value + (value shr 7)) shr 8; +end; + +procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); +var + calpha: byte; +begin + calpha := ec.alpha shr 8; + case calpha of + 0: ; + 255: dest^ := GammaCompression(ec); + else + DrawExpandedPixelInlineNoAlphaCheck(dest,ec,calpha); + end; +end; + +procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); +begin + case c.alpha of + 0: ; + 255: dest^ := c; + else + DrawExpandedPixelInlineNoAlphaCheck(dest,ec,c.alpha); + end; +end; + +procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); +var + a1f, a2f, a12, a12m, alphaCorr: UInt32or64; +begin + case dest^.alpha of + 0: dest^ := c; + 255: + begin + alphaCorr := c.alpha; + if alphaCorr >= 128 then inc(alphaCorr); + dest^.red := GammaCompressionTab[(GammaExpansionTab[dest^.red] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.red]*alphaCorr) shr 8]; + dest^.green := GammaCompressionTab[(GammaExpansionTab[dest^.green] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.green]*alphaCorr) shr 8]; + dest^.blue := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.blue]*alphaCorr) shr 8]; + end; + else + begin + {$HINTS OFF} + a12 := 65025 - (not dest^.alpha) * (not c.alpha); + {$HINTS ON} + a12m := a12 shr 1; + + a1f := dest^.alpha * (not c.alpha); + a2f := (c.alpha shl 8) - c.alpha; + + PLongWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f + + GammaExpansionTab[c.red] * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or + ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f + + GammaExpansionTab[c.green] * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or + ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f + + GammaExpansionTab[c.blue] * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or + (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); + end; + end; +end; + +procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; + const ec: TExpandedPixel; calpha: byte); +var + a1f, a2f, a12, a12m, alphaCorr: UInt32or64; +begin + case dest^.alpha of + 0: begin + dest^.red := GammaCompressionTab[ec.red]; + dest^.green := GammaCompressionTab[ec.green]; + dest^.blue := GammaCompressionTab[ec.blue]; + dest^.alpha := calpha; + end; + 255: + begin + alphaCorr := calpha; + if alphaCorr >= 128 then inc(alphaCorr); + dest^.red := GammaCompressionTab[(GammaExpansionTab[dest^.red] * UInt32or64(256-alphaCorr) + ec.red*alphaCorr) shr 8]; + dest^.green := GammaCompressionTab[(GammaExpansionTab[dest^.green] * UInt32or64(256-alphaCorr) + ec.green*alphaCorr) shr 8]; + dest^.blue := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * UInt32or64(256-alphaCorr) + ec.blue*alphaCorr) shr 8]; + end; + else + begin + {$HINTS OFF} + a12 := 65025 - (not dest^.alpha) * (not calpha); + {$HINTS ON} + a12m := a12 shr 1; + + a1f := dest^.alpha * (not calpha); + a2f := (calpha shl 8) - calpha; + + PLongWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f + + ec.red * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or + ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f + + ec.green * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or + ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f + + ec.blue * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or + (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); + end; + end; +end; + +procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); +var + a1f, a2f, a12, a12m, alphaCorr: UInt32or64; +begin + case c.alpha of + 0: ; + 255: dest^ := c; + else + begin + case dest^.alpha of + 0: dest^ := c; + 255: + begin + alphaCorr := c.alpha; + if alphaCorr >= 128 then inc(alphaCorr); + dest^.red := (dest^.red * UInt32or64(256-alphaCorr) + c.red*(alphaCorr+1)) shr 8; + dest^.green := (dest^.green * UInt32or64(256-alphaCorr) + c.green*(alphaCorr+1)) shr 8; + dest^.blue := (dest^.blue * UInt32or64(256-alphaCorr) + c.blue*(alphaCorr+1)) shr 8; + end; + else + begin + {$HINTS OFF} + a12 := 65025 - (not dest^.alpha) * (not c.alpha); + {$HINTS ON} + a12m := a12 shr 1; + + a1f := dest^.alpha * (not c.alpha); + a2f := (c.alpha shl 8) - c.alpha; + + PLongWord(dest)^ := (((dest^.red * a1f + c.red * a2f + a12m) div a12) shl TBGRAPixel_RedShift) or + (((dest^.green * a1f + c.green * a2f + a12m) div a12) shl TBGRAPixel_GreenShift) or + (((dest^.blue * a1f + c.blue * a2f + a12m) div a12) shl TBGRAPixel_BlueShift) or + (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); + end; + end; + end; + end; +end; + +procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; + appliedOpacity: byte); +begin + c.alpha := ApplyOpacity(c.alpha,appliedOpacity); + FastBlendPixelInline(dest,c); +end; + +procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; + maxDiff: byte); inline; +var alpha: Int32or64; +begin + alpha := (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div + (maxDiff + 1); + if alpha > 0 then + DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue, alpha)); +end; + +procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline; +var + newAlpha: byte; +begin + newAlpha := ApplyOpacity(dest^.alpha, not alpha); + if newAlpha = 0 then + dest^ := BGRAPixelTransparent + else + dest^.alpha := newAlpha; +end; + +{$i blendpixelsover.inc} + +{$i blendpixelinline.inc} + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrablurgl.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrablurgl.pas new file mode 100644 index 0000000..aa3357b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrablurgl.pas @@ -0,0 +1,200 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRABlurGL; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; + +type + + { TBGLBlurShader } + + TBGLBlurShader = class(TBGLShader3D) + private + function GetDirection: TPointF; + function GetImageIndex: integer; + function GetRadius: Single; + function GetTextureSize: TPoint; + procedure SetDirection(AValue: TPointF); + procedure SetImageIndex(AValue: integer); + procedure SetRadius(AValue: Single); + procedure SetTextureSize(AValue: TPoint); + protected + FTextureSize: TUniformVariablePoint; + FImageIndex: TUniformVariableInteger; + FDirection: TUniformVariablePointF; + FRadius: TUniformVariableSingle; + FBlurType: TRadialBlurType; + procedure StartUse; override; + public + constructor Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType); + function FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; overload; + function FilterBlurMotion(ATexture: IBGLTexture; ADirection: TPointF): IBGLTexture; overload; + function FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture; + property ImageIndex: integer read GetImageIndex write SetImageIndex; + property TextureSize: TPoint read GetTextureSize write SetTextureSize; + property Direction: TPointF read GetDirection write SetDirection; + property Radius: Single read GetRadius write SetRadius; + property BlurType: TRadialBlurType read FBlurType; + end; + +implementation + +{ TBGLBlurShader } + +function TBGLBlurShader.GetDirection: TPointF; +begin + result := FDirection.Value; +end; + +function TBGLBlurShader.GetImageIndex: integer; +begin + result := FImageIndex.Value; +end; + +function TBGLBlurShader.GetRadius: Single; +begin + result := FRadius.Value; + if FBlurType = rbPrecise then result := result * 10; +end; + +function TBGLBlurShader.GetTextureSize: TPoint; +begin + result := FTextureSize.Value; +end; + +procedure TBGLBlurShader.SetDirection(AValue: TPointF); +begin + FDirection.Value := AValue; +end; + +procedure TBGLBlurShader.SetImageIndex(AValue: integer); +begin + FImageIndex.Value := AValue; +end; + +procedure TBGLBlurShader.SetRadius(AValue: Single); +begin + if FBlurType = rbPrecise then AValue := AValue/10; + FRadius.Value := AValue; +end; + +procedure TBGLBlurShader.SetTextureSize(AValue: TPoint); +begin + FTextureSize.Value:= AValue; +end; + +constructor TBGLBlurShader.Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType); +var weightFunc: string; +begin + FBlurType:= ABlurType; + case ABlurType of + rbNormal,rbPrecise: weightFunc:= +' float sigma = max(0.1,radius/1.8);'#10+ +' float normalized = x/sigma;'#10 + +' return 1/(2.506628274631*sigma)*exp(-0.5*normalized*normalized);'; + rbCorona: weightFunc := 'return max(0, 1-abs(x-radius));'; + rbFast: weightFunc := 'return max(0,radius+1-x);'; + else {rbBox,rbDisk} + weightFunc := 'if (x <= radius) return 1; else return max(0,radius+1-x);'; + end; + + inherited Create(ACanvas, +'void main(void) {'#10 + +' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 + +' texCoord = vec2(gl_MultiTexCoord0);'#10 + +'}', + +'uniform sampler2D image;'#10 + +'uniform ivec2 textureSize;'#10 + +'uniform vec2 direction;'#10 + +'uniform float radius;'#10 + +'out vec4 FragmentColor;'#10 + + +'float computeWeight(float x)'#10 + +'{'#10 + +weightFunc + #10 + +'}'#10 + + +'void main(void)'#10 + +'{'#10 + +' int range = int(radius+1.5);'#10 + + +' float weight = computeWeight(0);'#10 + +' float totalWeight = weight;'#10 + +' FragmentColor = texture2D( image, texCoord ) * weight;'#10 + + +' for (int i=1; i<=range; i++) {'#10 + +' weight = computeWeight(i);'#10 + +' FragmentColor += texture2D( image, texCoord + i*direction/textureSize ) * weight;'#10 + +' FragmentColor += texture2D( image, texCoord - i*direction/textureSize ) * weight;'#10 + +' totalWeight += 2*weight;'#10 + +' }'#10 + + +' FragmentColor /= totalWeight;'#10 + +'}', + +'varying vec2 texCoord;', '130'); + + FImageIndex := UniformInteger['image']; + FTextureSize := UniformPoint['textureSize']; + FDirection := UniformPointF['direction']; + FRadius := UniformSingle['radius']; + + ImageIndex:= 0; + Direction := PointF(1,0); + TextureSize := Point(1,1); + Radius := 0; +end; + +function TBGLBlurShader.FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture; +var horiz: IBGLTexture; +begin + horiz := FilterBlurMotion(ATexture, PointF(1,0)); + result := FilterBlurMotion(horiz, PointF(0,1)); +end; + +function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; +var previousBuf,buf: TBGLCustomFrameBuffer; + previousShader: TBGLCustomShader; +begin + previousBuf := Canvas.ActiveFrameBuffer; + buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height); + Canvas.ActiveFrameBuffer := buf; + + TextureSize := Point(ATexture.Width,ATexture.Height); + previousShader := Canvas.Lighting.ActiveShader; + Canvas.Lighting.ActiveShader := self; + + ATexture.Draw(0, 0); //perform horiz blur + + Canvas.Lighting.ActiveShader := previousShader; + Canvas.ActiveFrameBuffer := previousBuf; + result := buf.MakeTextureAndFree; +end; + +function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture; + ADirection: TPointF): IBGLTexture; +var prevDir: TPointF; +begin + prevDir := Direction; + Direction := ADirection; + result := FilterBlurMotion(ATexture); + Direction := prevDir; +end; + +procedure TBGLBlurShader.StartUse; +begin + inherited StartUse; + FImageIndex.Update; + FTextureSize.Update; + FDirection.Update; + FRadius.Update; +end; + +end. + + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas.pas new file mode 100644 index 0000000..44dbc28 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas.pas @@ -0,0 +1,1909 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACanvas; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, FPImage, BGRABitmapTypes + {$IFDEF BGRABITMAP_USE_FPCANVAS}, FPCanvas{$ENDIF}; + +type + + { TBGRAColoredObject } + + TBGRAColoredObject = class + private + function GetColor: TColor; + function GetOpacity: Byte; + procedure SetColor(const AValue: TColor); + procedure SetOpacity(const AValue: Byte); + public + BGRAColor: TBGRAPixel; + procedure Assign(Source: TObject); virtual; + property Color: TColor read GetColor write SetColor; + property Opacity: Byte read GetOpacity write SetOpacity; + end; + + { TBGRAPen } + + TBGRAPen = class(TBGRAColoredObject) + private + FPenMode: TPenMode; + function GetActualColor: TBGRAPixel; + function GetActualDrawMode: TDrawMode; + function GetActualWidth: integer; + function GetCustomPenStyle: TBGRAPenStyle; + function GetInvisible: boolean; + function GetPenStyle: TPenStyle; + procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); + procedure SetPenMode(AValue: TPenMode); + procedure SetPenStyle(const AValue: TPenStyle); + protected + FCustomPenStyle: TBGRAPenStyle; + FPenStyle: TPenStyle; + public + Width: Integer; + EndCap: TPenEndCap; + JoinStyle: TPenJoinStyle; + constructor Create; + procedure Assign(Source: TObject); override; + procedure GetUniversalBrush(out ABrush: TUniversalBrush); + property Style: TPenStyle read GetPenStyle Write SetPenStyle; + property Mode: TPenMode read FPenMode write SetPenMode; + property CustomStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; + property ActualWidth: integer read GetActualWidth; + property ActualColor: TBGRAPixel read GetActualColor; + property ActualDrawMode: TDrawMode read GetActualDrawMode; + property Invisible: boolean read GetInvisible; + end; + + { TBGRABrush } + + TBGRABrush = class(TBGRAColoredObject) + private + function GetActualColor: TBGRAPixel; + function GetActualDrawMode: TDrawMode; + function GetInvisible: boolean; + procedure SetBackColor(const AValue: TBGRAPixel); + procedure SetBrushStyle(const AValue: TBrushStyle); + procedure SetTexture(AValue: IBGRAScanner); + protected + FStyle, FStyleBeforeTexture: TBrushStyle; + FBackColor: TBGRAPixel; + FTexture: IBGRAScanner; + FInternalBitmap: TBGRACustomBitmap; + FInternalBitmapColor: TBGRAPixel; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TObject); override; + procedure GetUniversalBrush(ABitmapPrototype: TBGRACustomBitmap; out ABrush: TUniversalBrush); + function BuildTexture(Prototype: TBGRACustomBitmap): IBGRAScanner; + property Style: TBrushStyle read FStyle write SetBrushStyle; + property BackColor: TBGRAPixel read FBackColor write SetBackColor; + property ActualColor: TBGRAPixel read GetActualColor; + property ActualDrawMode: TDrawMode read GetActualDrawMode; + property Invisible: boolean read GetInvisible; + property Texture: IBGRAScanner read FTexture write SetTexture; + end; + + { TBGRAFont } + + TBGRAFont = class(TBGRAColoredObject) + private + function GetAntialiasing: Boolean; + procedure SetAntialiasing(const AValue: Boolean); + public + Name: string; + Height: Integer; + Style: TFontStyles; + Quality : TBGRAFontQuality; + Orientation: integer; + Texture: IBGRAScanner; + constructor Create; + procedure Assign(Source: TObject); override; + property Antialiasing: Boolean read GetAntialiasing write SetAntialiasing; + + end; + + { TBGRACanvas } + + TBGRACanvas = class + procedure SetBrush(const AValue: TBGRABrush); + procedure SetPen(const AValue: TBGRAPen); + function GetPixelColor(X, Y: Integer): TColor; + procedure SetPixelColor(X, Y: Integer; const AValue: TColor); + private + function GetClipping: Boolean; + function GetClipRect: TRect; + function GetExpandedPixel(X, Y: Integer): TExpandedPixel; + function GetFPPixelColor(X, Y: Integer): TFPColor; + function GetHeight: integer; + function GetWidth: integer; + procedure SetClipping(const AValue: Boolean); + procedure SetClipRect(const AValue: TRect); + procedure SetExpandedPixel(X, Y: Integer; const AValue: TExpandedPixel); + procedure SetFont(const AValue: TBGRAFont); + procedure SetFPPixelColor(X, Y: Integer; const AValue: TFPColor); + function ComputeEllipseC(x1, y1, x2, y2: integer; out cx,cy,rx,ry: single): boolean; + function CheckRectangle(var x1, y1, x2, y2: integer; out tx,ty: integer): boolean; + + protected + FBitmap: TBGRACustomBitmap; + FBrush: TBGRABrush; + FPen: TBGRAPen; + FPenPos: TPoint; + FFont : TBGRAFont; + FInactiveClipRect: TRect; + FClippingOn: Boolean; + procedure ApplyPenStyle; + procedure ApplyFont; + function NoPen: boolean; + function NoBrush: boolean; + public + AntialiasingMode: TAntialiasingMode; + FillMode : TFillMode; + TextStyle : TTextStyle; + DrawFontBackground : boolean; + constructor Create(ABitmap: TBGRACustomBitmap); + destructor Destroy; override; + procedure MoveTo(x,y: integer); overload; + procedure MoveTo(p: TPoint); overload; + procedure LineTo(x,y: integer); overload; + procedure LineTo(p: TPoint); overload; + procedure Line(x1,y1,x2,y2: integer); overload; + procedure Line(p1,p2: TPoint); overload; + procedure Arc(x1,y1,x2,y2,sx,sy,ex,ey: integer); + procedure Arc(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); + procedure Arc65536(x1,y1,x2,y2: integer; start65536,end65536: word; Options: TArcOptions); + procedure Chord(x1,y1,x2,y2,sx,sy,ex,ey: integer); + procedure Chord(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); + procedure Pie(x1,y1,x2,y2,sx,sy,ex,ey: integer); + procedure Pie(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); + procedure RadialPie(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); + procedure Ellipse(x1,y1,x2,y2: integer); + procedure Ellipse(const bounds: TRect); + procedure Rectangle(x1,y1,x2,y2: integer; Filled: Boolean = True); + procedure Rectangle(const bounds: TRect; Filled: Boolean = True); + procedure Frame(x1,y1,x2,y2: integer); + procedure Frame(const bounds: TRect); + procedure RoundRect(x1,y1,x2,y2: integer; dx,dy: integer); + procedure RoundRect(const bounds: TRect; dx,dy: integer); + procedure EllipseC(x,y,rx,ry: integer); + procedure FillRect(x1,y1,x2,y2: integer); + procedure FillRect(const bounds: TRect); + procedure FrameRect(x1,y1,x2,y2: integer; width: integer = 1); + procedure FrameRect(const bounds: TRect; width: integer = 1); + procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut); overload; + procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); overload; + procedure GradientFill(ARect: TRect; AStart, AStop: TColor; + ADirection: TGradientDirection; GammaCorrection: Boolean = false); + procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); + procedure FloodFill(X, Y: Integer; FillColor: TBGRAPixel; FillStyle: TFillStyle); + procedure FloodFill(X, Y: Integer); + procedure Polygon(const APoints: array of TPoint); + procedure Polygon(const Points: array of TPoint; + Winding: Boolean; + StartIndex: Integer = 0; + NumPts: Integer = -1); + procedure Polygon(Points: PPoint; NumPts: Integer; + Winding: boolean = False); + procedure PolygonF(const APoints: array of TPointF); + procedure PolygonF(const APoints: array of TPointF; Winding: Boolean; FillOnly: Boolean = False); + procedure Polyline(const APoints: array of TPoint); + procedure Polyline(const Points: array of TPoint; + StartIndex: Integer; + NumPts: Integer = -1); + procedure Polyline(Points: PPoint; NumPts: Integer); + procedure PolylineF(const APoints: array of TPointF); + procedure PolyBezier(Points: PPoint; NumPts: Integer; + Filled: boolean = False; + Continuous: boolean = False); + procedure PolyBezier(const Points: array of TPoint; + Filled: boolean = False; + Continuous: boolean = False); + procedure Draw(X,Y: Integer; SrcBitmap: TBGRACustomBitmap); overload; + procedure Draw(X,Y: Integer; SrcBitmap: TBitmap); overload; + procedure CopyRect(X,Y: Integer; SrcBitmap: TBGRACustomBitmap; SrcRect: TRect); + procedure StretchDraw(DestRect: TRect; SrcBitmap: TBGRACustomBitmap; HorizFlip: Boolean = false; VertFlip: Boolean = false); + procedure DrawFocusRect(bounds: TRect); + procedure CopyRect(Dest: TRect; SrcBmp: TBGRACustomBitmap; + Source: TRect); virtual; + + procedure TextOut(X,Y: Integer; const Text: String); + procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string); + procedure TextRect(ARect: TRect; X, Y: integer; const Text: string; + const Style: TTextStyle); + function TextExtent(const Text: string): TSize; + function TextHeight(const Text: string): Integer; + function TextWidth(const Text: string): Integer; + + property Pen: TBGRAPen read FPen write SetPen; + property PenPos : TPoint read FPenPos write FPenPos; + property Brush: TBGRABrush read FBrush write SetBrush; + property Font: TBGRAFont read FFont write SetFont; + property Pixels[X,Y: Integer]: TColor read GetPixelColor write SetPixelColor; + property GammaExpandedPixels[X,Y: Integer]: TExpandedPixel read GetExpandedPixel write SetExpandedPixel; + property Colors[X,Y: Integer]: TFPColor read GetFPPixelColor write SetFPPixelColor; + property Height: integer read GetHeight; + property Width : integer read GetWidth; + property ClipRect: TRect read GetClipRect write SetClipRect; + property Clipping: Boolean read GetClipping write SetClipping; + end; + +implementation + +uses BGRAPen, BGRAPath, BGRAPolygon, BGRAPolygonAliased, Math, BGRABlend; + +{ TBGRAFont } + +function TBGRAFont.GetAntialiasing: Boolean; +begin + result := Quality <> fqSystem; +end; + +procedure TBGRAFont.SetAntialiasing(const AValue: Boolean); +begin + if AValue = Antialiasing then exit; + if AValue then + Quality := fqFineAntialiasing + else + Quality := fqSystem; +end; + +constructor TBGRAFont.Create; +begin + Name := 'default'; + Height := 12; + Style := []; + Antialiasing := False; + Orientation := 0; + Texture := nil; + BGRAColor := BGRABlack; +end; + +procedure TBGRAFont.Assign(Source: TObject); +var sf: TBGRAFont; + f: TFont; + {$IFDEF BGRABITMAP_USE_FPCANVAS}cf: TFPCustomFont;{$ENDIF} +begin + if Source is TFont then + begin + f := TFont(Source); + Color := f.Color; + Opacity := 255; + Style := f.Style; + Name := f.Name; + Orientation := f.Orientation; + if f.Height= 0 then + Height := 16 else + Height := f.Height; + end else + if Source is TBGRAFont then + begin + sf := Source as TBGRAFont; + Name := sf.Name; + Height := sf.Height; + Style := sf.Style; + Quality := sf.Quality; + Orientation := sf.Orientation; + Texture := sf.Texture; + end + {$IFDEF BGRABITMAP_USE_FPCANVAS}else + if Source is TFPCustomFont then + begin + cf := Source as TFPCustomFont; + Color := FPColorToTColor(cf.FPColor); + Style := []; + if cf.Bold then include(Style, fsBold); + if cf.Italic then include(Style, fsItalic); + if cf.Underline then include(Style, fsUnderline); +{$IF FPC_FULLVERSION>=20602} //changed in 2.6.2 and 2.7 + if cf.StrikeThrough then include(Style, fsStrikeOut); +{$ELSE} + if cf.StrikeTrough then include(Style, fsStrikeOut); +{$ENDIF} + Name := cf.Name; + //Orientation := cf.Orientation; + if cf.Size = 0 then + Height := 16 else + Height := round(cf.Size*1.8); + end{$ENDIF}; + inherited Assign(Source); +end; + +{ TBGRABrush } + +function TBGRABrush.GetActualColor: TBGRAPixel; +begin + if (Style = bsClear) or (Opacity = 0) then + result := BGRAPixelTransparent + else + result := BGRAColor; +end; + +function TBGRABrush.GetActualDrawMode: TDrawMode; +begin + result := dmDrawWithTransparency; +end; + +function TBGRABrush.GetInvisible: boolean; +begin + result := (texture = nil) and ((style = bsClear) or ((style= bsSolid) and (bgracolor.alpha = 0)) + or ((bgracolor.alpha = 0) and (BackColor.alpha = 0))); +end; + +procedure TBGRABrush.SetBackColor(const AValue: TBGRAPixel); +begin + if FBackColor=AValue then exit; + FBackColor:=AValue; + FreeAndNil(FInternalBitmap); +end; + +procedure TBGRABrush.SetBrushStyle(const AValue: TBrushStyle); +begin + if FStyle=AValue then exit; + FStyle:=AValue; + if FStyle <> bsImage then FTexture := nil; + FreeAndNil(FInternalBitmap); +end; + +procedure TBGRABrush.SetTexture(AValue: IBGRAScanner); +begin + if FTexture=AValue then Exit; + FTexture:=AValue; + if Assigned(AValue) then + begin + if FStyle <> bsImage then + begin + FStyleBeforeTexture:= FStyle; + FStyle:= bsImage; + end; + end else + begin + if FStyle = bsImage then + FStyle := FStyleBeforeTexture; + end; +end; + +constructor TBGRABrush.Create; +begin + BGRAColor := BGRAWhite; + FInternalBitmap := nil; + FInternalBitmapColor := BGRAPixelTransparent; + FStyle := bsSolid; + FStyleBeforeTexture:= Style; + FTexture := nil; + FBackColor := BGRAPixelTransparent; +end; + +destructor TBGRABrush.Destroy; +begin + Texture := nil; + FInternalBitmap.Free; + inherited Destroy; +end; + +procedure TBGRABrush.Assign(Source: TObject); +var sb: TBGRABrush; + b: TBrush; +begin + if Source is TBGRABrush then + begin + sb := Source as TBGRABrush; + Texture := sb.Texture; + BackColor := sb.BackColor; + Style := sb.Style; + end else + if Source is TBrush then + begin + b := Source as TBrush; + Color := b.Color; + Opacity := 255; + Style := b.Style; + end; + inherited Assign(Source); +end; + +procedure TBGRABrush.GetUniversalBrush(ABitmapPrototype: TBGRACustomBitmap; out ABrush: TUniversalBrush); +var + tex: IBGRAScanner; + c: TBGRAPixel; +begin + tex := BuildTexture(ABitmapPrototype); + if tex <> nil then + BGRAScannerBrush(ABrush, tex, ActualDrawMode) + else + begin + c := ActualColor; + BGRASolidBrushIndirect(ABrush, @c, ActualDrawMode); + end; +end; + +function TBGRABrush.BuildTexture(Prototype: TBGRACustomBitmap): IBGRAScanner; +begin + //user-defined texture + if Texture <> nil then + result := texture + else + begin + //free pattern if color has changed + if (FInternalBitmap <> nil) and (FInternalBitmapColor <> BGRAColor) then + FreeAndNil(FInternalBitmap); + + //styles that do not have pattern + if Style in[bsSolid,bsClear] then + result := nil + else + begin + //create pattern if needed + if FInternalBitmap = nil then + begin + FInternalBitmap := CreateBrushTexture(Prototype, Style, BGRAColor,BackColor); + FInternalBitmapColor := BGRAColor; + end; + result := FInternalBitmap; + end; + end; +end; + +{ TBGRAPen } + +function TBGRAPen.GetActualColor: TBGRAPixel; +begin + if (Style = psClear) or (Opacity = 0) then + result := BGRAPixelTransparent + else + begin + case Mode of + pmBlack: result := BGRABlack; + pmWhite: result := BGRAWhite; + pmNop: result := BGRAPixelTransparent; + pmNot: result := BGRA(255,255,255,0); + pmCopy: result := BGRAColor; + pmNotCopy: result := BGRA(not BGRAColor.red, not BGRAColor.green, not BGRAColor.blue, BGRAColor.alpha); + pmMerge, pmNotMerge, pmMask, pmNotMask, pmXor: result := BGRA(BGRAColor.red, BGRAColor.green, BGRAColor.blue, 0); + pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmNotXor: result := BGRA(not BGRAColor.red, not BGRAColor.green, not BGRAColor.blue, 0); + else + raise exception.Create('Unhandled pen mode'); + end; + end; +end; + +function TBGRAPen.GetActualDrawMode: TDrawMode; +begin + case Mode of + pmBlack, pmWhite, pmNop, pmCopy, pmNotCopy: + result := dmDrawWithTransparency; + else + {pmNot, pmXor, pmNotXor and others} + result := dmXor; + end; +end; + +function TBGRAPen.GetActualWidth: integer; +begin + if width < 1 then result := 1 else + result := Width; +end; + +function TBGRAPen.GetCustomPenStyle: TBGRAPenStyle; +begin + result := DuplicatePenStyle(FCustomPenStyle); +end; + +function TBGRAPen.GetInvisible: boolean; +var b: TUniversalBrush; +begin + GetUniversalBrush(b); + result := b.DoesNothing; +end; + +function TBGRAPen.GetPenStyle: TPenStyle; +begin + Result:= FPenStyle; +end; + +procedure TBGRAPen.SetCustomPenStyle(const AValue: TBGRAPenStyle); +begin + FCustomPenStyle := DuplicatePenStyle(AValue); + FPenStyle:= BGRAToPenStyle(AValue); +end; + +procedure TBGRAPen.SetPenMode(AValue: TPenMode); +begin + if FPenMode=AValue then Exit; + FPenMode:=AValue; +end; + +procedure TBGRAPen.SetPenStyle(const AValue: TPenStyle); +begin + if AValue = psPattern then exit; + FCustomPenStyle := PenStyleToBGRA(AValue); + FPenStyle := AValue; +end; + +constructor TBGRAPen.Create; +begin + Width := 1; + EndCap := pecRound; + JoinStyle := pjsRound; + Style := psSolid; + BGRAColor := BGRABlack; + Mode := pmCopy; +end; + +procedure TBGRAPen.Assign(Source: TObject); +var sp: TBGRAPen; + p: TPen; +begin + if Source is TBGRAPen then + begin + sp := Source as TBGRAPen; + Mode := sp.Mode; + Width := sp.Width; + EndCap := sp.EndCap; + JoinStyle := sp.JoinStyle; + Style := sp.Style; + CustomStyle := sp.CustomStyle; + end else + if Source is TPen then + begin + p := Source as TPen; + Mode := p.Mode; + Width := p.Width; + EndCap := p.EndCap; + JoinStyle := p.JoinStyle; + Style := p.Style; + Color := p.Color; + Opacity := 255; + end; + inherited Assign(Source); +end; + +type + PBGRAPenBrushFixedData = ^TBGRAPenBrushFixedData; + TBGRAPenBrushFixedData = record + BGRA: TBGRAPixel; + NotResult: boolean; + end; + +procedure BGRAPenSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PBGRAPixel(AContextData^.Dest), ACount); +end; + +procedure BGRAPenMergePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PBGRAPixel; + merged: TBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + with PBGRAPenBrushFixedData(AFixedData)^ do + begin + while ACount > 0 do + begin + merged.red := pDest^.red or PBGRAPenBrushFixedData(AFixedData)^.BGRA.red; + merged.green := pDest^.green or PBGRAPenBrushFixedData(AFixedData)^.BGRA.green; + merged.blue := pDest^.blue or PBGRAPenBrushFixedData(AFixedData)^.BGRA.blue; + if NotResult then + begin + merged.red := not merged.red; + merged.green := not merged.green; + merged.blue := not merged.blue; + end; + if AAlpha >= $ff7f then + pDest^ := merged else + pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, + GammaExpansion(merged), AAlpha)); + inc(pDest); + dec(ACount); + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure BGRAPenMaskPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PBGRAPixel; + merged: TBGRAPixel; +begin + if AAlpha <= $80 then + begin + inc(PBGRAPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PBGRAPixel(AContextData^.Dest); + with PBGRAPenBrushFixedData(AFixedData)^ do + begin + while ACount > 0 do + begin + merged.red := pDest^.red and PBGRAPenBrushFixedData(AFixedData)^.BGRA.red; + merged.green := pDest^.green and PBGRAPenBrushFixedData(AFixedData)^.BGRA.green; + merged.blue := pDest^.blue and PBGRAPenBrushFixedData(AFixedData)^.BGRA.blue; + if NotResult then + begin + merged.red := not merged.red; + merged.green := not merged.green; + merged.blue := not merged.blue; + end; + if AAlpha >= $ff7f then + pDest^ := merged else + pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, + GammaExpansion(merged), AAlpha)); + inc(pDest); + dec(ACount); + end; + end; + PBGRAPixel(AContextData^.Dest) := pDest; +end; + +procedure TBGRAPen.GetUniversalBrush(out ABrush: TUniversalBrush); +var c: TBGRAPixel; +begin + if Opacity = 0 then + begin + TBGRACustomBitmap.IdleBrush(ABrush); + exit; + end; + c := ActualColor; + case Mode of + pmMerge, pmNotMerge, pmMergeNotPen, pmMaskPenNot: //or-based + begin + ABrush.Colorspace:= TBGRAPixelColorspace; + ABrush.InternalInitContext:= nil; + PBGRAPenBrushFixedData(@ABrush.FixedData)^.BGRA := c; + if Mode in [pmNotMerge, pmMaskPenNot] then + begin + ABrush.DoesNothing := false; + PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= true; + ABrush.InternalPutNextPixels:= @BGRAPenMergePixels; + end else + begin + ABrush.DoesNothing:= (c.red = 0) and (c.green = 0) and (c.blue = 0); + PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= false; + if ABrush.DoesNothing then + ABrush.InternalPutNextPixels:= @BGRAPenSkipPixels + else + ABrush.InternalPutNextPixels:= @BGRAPenMergePixels; + end; + end; + pmMask, pmNotMask, pmMaskNotPen, pmMergePenNot: //and-based + begin + ABrush.Colorspace:= TBGRAPixelColorspace; + ABrush.InternalInitContext:= nil; + PBGRAPenBrushFixedData(@ABrush.FixedData)^.BGRA := c; + if Mode in [pmNotMask, pmMergePenNot] then + begin + ABrush.DoesNothing := false; + PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= true; + ABrush.InternalPutNextPixels:= @BGRAPenMaskPixels; + end else + begin + ABrush.DoesNothing:= (c.red = 255) and (c.green = 255) and (c.blue = 255); + PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= false; + if ABrush.DoesNothing then + ABrush.InternalPutNextPixels:= @BGRAPenSkipPixels + else + ABrush.InternalPutNextPixels:= @BGRAPenMaskPixels; + end; + end; + else //draw-based and xor-based + BGRASolidBrushIndirect(ABrush, @c, ActualDrawMode); + end; +end; + +{ TBGRAColoredObject } + +function TBGRAColoredObject.GetColor: TColor; +begin + result := BGRAToColor(BGRAColor); +end; + +function TBGRAColoredObject.GetOpacity: Byte; +begin + result := BGRAColor.alpha; +end; + +procedure TBGRAColoredObject.SetColor(const AValue: TColor); +begin + BGRAColor := ColorToBGRA(AValue,BGRAColor.alpha); +end; + +procedure TBGRAColoredObject.SetOpacity(const AValue: Byte); +begin + BGRAColor.alpha := AValue; +end; + +procedure TBGRAColoredObject.Assign(Source: TObject); +var so: TBGRAColoredObject; +begin + if Source is TBGRAColoredObject then + begin + so := Source as TBGRAColoredObject; + BGRAColor := so.BGRAColor; + end; +end; + +{ TBGRACanvas } + +procedure TBGRACanvas.SetBrush(const AValue: TBGRABrush); +begin + if FBrush=AValue then exit; + FBrush.Assign(AValue); +end; + +procedure TBGRACanvas.SetPen(const AValue: TBGRAPen); +begin + if FPen=AValue then exit; + FPen.Assign(AValue); +end; + +function TBGRACanvas.GetPixelColor(X, Y: Integer): TColor; +begin + result := BGRAToColor(FBitmap.GetPixel(x,y)); +end; + +procedure TBGRACanvas.SetPixelColor(X, Y: Integer; const AValue: TColor); +begin + FBitmap.SetPixel(x,y,ColorToBGRA(AValue)); +end; + +function TBGRACanvas.GetClipping: Boolean; +begin + result := FClippingOn; +end; + +function TBGRACanvas.GetClipRect: TRect; +begin + if not Clipping then + result := FInactiveClipRect else + result := FBitmap.ClipRect; +end; + +function TBGRACanvas.GetExpandedPixel(X, Y: Integer): TExpandedPixel; +begin + result := GammaExpansion(FBitmap.GetPixel(X,Y)); +end; + +function TBGRACanvas.GetFPPixelColor(X, Y: Integer): TFPColor; +begin + result := BGRAToFPColor(FBitmap.GetPixel(x,y)); +end; + +function TBGRACanvas.GetHeight: integer; +begin + result := FBitmap.Height; +end; + +function TBGRACanvas.GetWidth: integer; +begin + result := FBitmap.Width; +end; + +procedure TBGRACanvas.SetClipping(const AValue: Boolean); +begin + FClippingOn := AValue; + if not AValue then FBitmap.NoClip else + FBitmap.ClipRect := FInactiveClipRect; +end; + +procedure TBGRACanvas.SetClipRect(const AValue: TRect); +begin + FInactiveClipRect := AValue; + if FClippingOn then + begin + FBitmap.ClipRect := AValue; + FInactiveClipRect := FBitmap.ClipRect; + end; +end; + +procedure TBGRACanvas.SetExpandedPixel(X, Y: Integer; + const AValue: TExpandedPixel); +begin + FBitmap.SetPixel(x,y,GammaCompression(AValue)); +end; + +procedure TBGRACanvas.SetFont(const AValue: TBGRAFont); +begin + if FFont=AValue then exit; + FFont.Assign(AValue); +end; + +procedure TBGRACanvas.SetFPPixelColor(X, Y: Integer; const AValue: TFPColor); +begin + FBitmap.SetPixel(x,y,FPColorToBGRA(AValue)); +end; + +function TBGRACanvas.ComputeEllipseC(x1, y1, x2, y2: integer; out cx, cy, rx, + ry: single): boolean; +begin + cx := (x1+x2-1)/2; + cy := (y1+y2-1)/2; + rx := abs((x2-x1)/2); + ry := abs((y2-y1)/2); + result := (rx<>0) and (ry<>0); +end; + +function TBGRACanvas.CheckRectangle(var x1, y1, x2, y2: integer; out tx, ty: integer + ): boolean; +var + temp: integer; +begin + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + tx := x2-x1; + ty := y2-y1; + result := (tx<>0) and (ty <>0); +end; + +procedure TBGRACanvas.ApplyPenStyle; +var + TempPenStyle: TBGRAPenStyle; + i: Integer; +begin + FBitmap.JoinStyle := FPen.JoinStyle; + FBitmap.LineCap := FPen.EndCap; + if FPen.Width = 1 then + begin + SetLength(TempPenStyle, length(FPen.CustomStyle)); + for i := 0 to high(TempPenStyle) do + TempPenStyle[i] := FPen.CustomStyle[i]*4; + FBitmap.CustomPenStyle := TempPenStyle; + end else + FBitmap.CustomPenStyle := FPen.CustomStyle; +end; + +procedure TBGRACanvas.ApplyFont; +begin + FBitmap.FontName := Font.Name; + FBitmap.FontHeight := -Font.Height; + FBitmap.FontStyle := Font.Style; + FBitmap.FontQuality := Font.Quality; + FBitmap.FontOrientation := Font.Orientation; +end; + +function TBGRACanvas.NoPen: boolean; +begin + result := Pen.Invisible; +end; + +function TBGRACanvas.NoBrush: boolean; +begin + result := Brush.Invisible; +end; + +constructor TBGRACanvas.Create(ABitmap: TBGRACustomBitmap); +begin + FBitmap := ABitmap; + AntialiasingMode := amOn; + FPen := TBGRAPen.Create; + FPenPos := Point(0,0); + FFont := TBGRAFont.Create; + FBrush := TBGRABrush.Create; + FClippingOn := False; + FInactiveClipRect := FBitmap.ClipRect; + FillMode := fmWinding; + DrawFontBackground := True; +end; + +destructor TBGRACanvas.Destroy; +begin + FPen.Free; + FBrush.Free; + FFont.Free; +end; + +procedure TBGRACanvas.MoveTo(x, y: integer); +begin + MoveTo(Point(x,y)); +end; + +procedure TBGRACanvas.MoveTo(p: TPoint); +begin + FPenPos := p; +end; + +procedure TBGRACanvas.LineTo(x, y: integer); +var pts: array of TPointF; + b: TUniversalBrush; +begin + Pen.GetUniversalBrush(b); + if not b.DoesNothing then + begin + //1 pixel-wide solid pen is rendered with pixel line + if (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then + begin + if AntialiasingMode = amOff then + FBitmap.DrawLine(FPenPos.x,FPenPos.y,x,y, b, False) + else + FBitmap.DrawLineAntialias(FPenPos.x,FPenPos.y,x,y, b, False); + end else + begin + ApplyPenStyle; + if AntialiasingMode = amOff then + begin + pts := FBitmap.ComputeWidePolyline([PointF(FPenPos.x,FPenPos.y),PointF(x,y)],Pen.ActualWidth); + FBitmap.FillPoly(pts, b); + end else + FBitmap.DrawLineAntialias(FPenPos.x,FPenPos.y,x,y, b, Pen.ActualWidth); + end; + end; + MoveTo(x,y); +end; + +procedure TBGRACanvas.LineTo(p: TPoint); +begin + LineTo(p.x,p.y); +end; + +procedure TBGRACanvas.Line(x1, y1, x2, y2: integer); +begin + MoveTo(x1,y1); + LineTo(x2,y2); +end; + +procedure TBGRACanvas.Line(p1, p2: TPoint); +begin + MoveTo(p1); + LineTo(p2); +end; + +procedure TBGRACanvas.Arc(x1, y1, x2, y2, sx, sy, ex, ey: integer); +var + angle1,angle2: word; + cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; + angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)); + angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)); + Arc65536(x1,y1,x2,y2,angle1, angle2, []); +end; + +procedure TBGRACanvas.Arc(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); +begin + if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; + Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45, []); +end; + +procedure TBGRACanvas.Arc65536(x1, y1, x2, y2: integer; start65536, end65536: word; Options: TArcOptions); +var cx,cy,rx,ry,w: single; + arcPts,penPts: array of TPointF; + multi: TBGRAMultishapeFiller; + tex: IBGRAScanner; + hasFill, hasPen: Boolean; + b: TUniversalBrush; +begin + if NoPen and NoBrush then exit; + if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; + + DecF(rx, 0.50); + DecF(ry, 0.50); + w := Pen.ActualWidth; + + if AntialiasingMode = amOff then + begin + if not NoPen and not Odd(Pen.ActualWidth) then + begin + DecF(rx, 0.01); + DecF(ry, 0.01); + end; + end; + + if NoPen then + begin + DecF(cx, 0.5); + DecF(cy, 0.5); + DecF(rx, 0.2); + DecF(ry, 0.2); + if (rx<0) or (ry<0) then exit; + end; + + arcPts := ComputeArc65536(cx,cy,rx,ry,start65536,end65536); + if (aoPie in Options) and (start65536 <> end65536) then + begin + setlength(arcPts,length(arcPts)+1); + arcPts[high(arcPts)] := PointF(cx,cy); + end; + + hasFill := (aoFillPath in Options) and not NoBrush; + hasPen := not NoPen; + if hasPen then + begin + ApplyPenStyle; + if (aoClosePath in Options) or (aoPie in Options) then + penPts := FBitmap.ComputeWidePolygon(arcPts,w) + else penPts := FBitmap.ComputeWidePolyline(arcPts,w); + end; + + if hasPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then + begin + if hasFill then + begin + Brush.GetUniversalBrush(FBitmap, b); + if AntialiasingMode <> amOff then + FBitmap.FillPolyAntialias(arcPts, b) + else FBitmap.FillPoly(arcPts, b); + end; + if hasPen then + begin + Pen.GetUniversalBrush(b); + if AntialiasingMode <> amOff then + FBitmap.FillPolyAntialias(penPts, b) + else FBitmap.FillPoly(penPts, b); + end; + end else + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + multi.FillMode := FillMode; + multi.PolygonOrder := poLastOnTop; + multi.AliasingIncludeBottomRight := True; + if hasFill then + begin + tex := Brush.BuildTexture(FBitmap); + if tex <> nil then + multi.AddPolygon(arcPts, tex) else + multi.AddPolygon(arcPts, Brush.ActualColor); + end; + if hasPen then + multi.AddPolygon(penPts, Pen.ActualColor); + multi.Draw(FBitmap, Brush.ActualDrawMode); + multi.Free; + end; +end; + +procedure TBGRACanvas.Chord(x1, y1, x2, y2, sx, sy, ex, ey: integer); +var + angle1,angle2: word; + cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; + angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)) and 65535; + angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)) and 65535; + Arc65536(x1,y1,x2,y2,angle1, angle2, [aoClosePath,aoFillPath]); +end; + +procedure TBGRACanvas.Chord(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); +begin + if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; + Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45,[aoClosePath,aoFillPath]); +end; + +procedure TBGRACanvas.Pie(x1, y1, x2, y2, sx, sy, ex, ey: integer); +var + angle1,angle2: word; + cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; + angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)) and 65535; + angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)) and 65535; + Arc65536(x1,y1,x2,y2,angle1, angle2, [aoPie,aoFillPath]); +end; + +procedure TBGRACanvas.Pie(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); +begin + if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; + Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45,[aoPie,aoFillPath]); +end; + +procedure TBGRACanvas.RadialPie(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer + ); +begin + Pie(x1,y1,x2,y2,StartDeg16,LengthDeg16); +end; + +procedure TBGRACanvas.Ellipse(x1, y1, x2, y2: integer); +var cx,cy,rx,ry,w: single; + tex: IBGRAScanner; + multi: TBGRAMultishapeFiller; + pb, bb: TUniversalBrush; +begin + if NoPen and NoBrush then exit; + if (AntialiasingMode = amOff) and not NoPen and (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then + begin + Pen.GetUniversalBrush(pb); + Brush.GetUniversalBrush(FBitmap, bb); + BGRARoundRectAliased(FBitmap, x1,y1,x2,y2, abs(x2-x1),abs(y2-y1), pb,bb, 65535); + exit; + end; + if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; + w := Pen.ActualWidth; + DecF(rx, 0.50); + DecF(ry, 0.50); + + if AntialiasingMode = amOff then + begin + if not NoPen and not Odd(Pen.ActualWidth) then + begin + DecF(rx, 0.01); + DecF(ry, 0.01); + end; + end; + + if NoPen then + begin + DecF(cx, 0.5); + DecF(cy, 0.5); + DecF(rx, 0.2); + DecF(ry, 0.2); + if (rx<0) or (ry<0) then exit; + end; + + if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then + begin + if not NoBrush then + begin + Brush.GetUniversalBrush(FBitmap, bb); + if AntialiasingMode <> amOff then + FBitmap.FillEllipseAntialias(cx,cy,rx,ry, bb) + else FBitmap.FillEllipseInRect( + rect(round(cx-rx+0.5), round(cy-ry+0.5), round(cx+rx+0.5), round(cy+ry+0.5)), bb); + end; + if not NoPen then + begin + Pen.GetUniversalBrush(pb); + ApplyPenStyle; + if AntialiasingMode <> amOff then + FBitmap.EllipseAntialias(cx,cy,rx,ry, pb, w) + else FBitmap.Ellipse(cx,cy,rx,ry, pb, w); + end; + end else + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + multi.PolygonOrder := poLastOnTop; + multi.AliasingIncludeBottomRight := True; + if not NoBrush then + begin + tex := Brush.BuildTexture(FBitmap); + if tex <> nil then + multi.AddEllipse(cx,cy,rx,ry,tex) + else + multi.AddEllipse(cx,cy,rx,ry,Brush.ActualColor); + end; + if not NoPen then + begin + if (Pen.Style = psSolid) and multi.Antialiasing then + multi.AddEllipseBorder(cx,cy,rx,ry,w,Pen.ActualColor) + else + begin + ApplyPenStyle; + multi.AddPolygon(FBitmap.ComputeWidePolygon(ComputeEllipse(cx,cy,rx,ry),w),Pen.ActualColor); + end; + end; + multi.Draw(FBitmap); + multi.Free; + end; +end; + +procedure TBGRACanvas.Ellipse(const bounds: TRect); +begin + Ellipse(bounds.left,bounds.top,bounds.right,bounds.Bottom); +end; + +procedure TBGRACanvas.Rectangle(x1, y1, x2, y2: integer; Filled: Boolean = True); +var tx,ty: integer; + tex: IBGRAScanner; + multi: TBGRAMultishapeFiller; + b: TUniversalBrush; +begin + if NoBrush then Filled := false; + if NoPen and not Filled then exit; + if not CheckRectangle(x1,y1,x2,y2,tx,ty) then exit; + + if NoPen then + FillRect(x1,y1,x2-1,y2-1) //one pixel + else + begin + dec(x2); + dec(y2); + + if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then + begin + if AntialiasingMode <> amOff then + begin + if Filled then FillRect(x1,y1,x2,y2); + ApplyPenStyle; + Pen.GetUniversalBrush(b); + FBitmap.RectangleAntialias(x1,y1,x2,y2, b, Pen.ActualWidth); + end else + PolygonF([PointF(x1,y1), PointF(x2,y1), PointF(x2,y2), PointF(x1,y2)]); + end else + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + multi.PolygonOrder := poLastOnTop; + if Filled then + begin + tex := Brush.BuildTexture(FBitmap); + if tex <> nil then + multi.AddRectangle(x1,y1,x2,y2,tex) + else multi.AddRectangle(x1,y1,x2,y2,Brush.ActualColor); + end; + if not NoPen then + begin + ApplyPenStyle; + if (Pen.Style = psSolid) and (Pen.JoinStyle = pjsMiter) and (FBitmap.JoinMiterLimit > 1.4142) then + multi.AddRectangleBorder(x1,y1,x2,y2, Pen.ActualWidth, Pen.ActualColor) + else + multi.AddPolygon(FBitmap.ComputeWidePolygon( + [PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)], Pen.ActualWidth), + Pen.ActualColor); + end; + multi.Draw(FBitmap); + multi.Free; + end; + end; +end; + +procedure TBGRACanvas.Rectangle(const bounds: TRect; Filled: Boolean = True); +begin + Rectangle(bounds.left,bounds.top,bounds.right,bounds.Bottom, Filled); +end; + +procedure TBGRACanvas.Frame(x1, y1, x2, y2: integer); +begin + Rectangle(x1,y1,x2,y2,False); +end; + +procedure TBGRACanvas.Frame(const bounds: TRect); +begin + Rectangle(bounds,False); +end; + +procedure TBGRACanvas.RoundRect(x1, y1, x2, y2: integer; dx,dy: integer); +var tx,ty: integer; + tex: IBGRAScanner; + multi: TBGRAMultishapeFiller; + x1f,y1f,x2f,y2f: single; + pb, fb: TUniversalBrush; +begin + if not CheckRectangle(x1,y1,x2,y2,tx,ty) then exit; + if not NoPen and (AntialiasingMode = amOff) and (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then + begin + ApplyPenStyle; + Pen.GetUniversalBrush(pb); + Brush.GetUniversalBrush(FBitmap, fb); + FBitmap.RoundRect(x1,y1,x2,y2, dx,dy, pb, fb); + end else + begin + dec(x2); + dec(y2); + if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then + PolygonF(FBitmap.ComputeRoundRect(x1,y1,x2,y2, dx/2,dy/2, [])) else + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + multi.PolygonOrder := poLastOnTop; + if not NoBrush then + begin + if NoPen then + begin + x1f := x1-0.5; + y1f := y1-0.5; + x2f := x2+0.5; + y2f := y2+0.5; + end else + begin + x1f := x1; + y1f := y1; + x2f := x2; + y2f := y2; + end; + tex := Brush.BuildTexture(FBitmap); + if tex <> nil then + multi.AddRoundRectangle(x1f,y1f,x2f,y2f,dx/2,dy/2,tex) + else + multi.AddRoundRectangle(x1f,y1f,x2f,y2f,dx/2,dy/2,Brush.ActualColor); + end; + if not NoPen then + begin + ApplyPenStyle; + if Pen.Style = psSolid then + multi.AddRoundRectangleBorder(x1,y1,x2,y2,dx/2,dy/2, Pen.ActualWidth ,Pen.ActualColor) + else + multi.AddPolygon(FBitmap.ComputeWidePolygon(ComputeRoundRect(x1,y1,x2,y2,dx/2,dy/2), Pen.ActualWidth), + Pen.ActualColor); + end; + multi.Draw(FBitmap); + multi.Free; + end; + end; +end; + +procedure TBGRACanvas.RoundRect(const bounds: TRect; dx,dy: integer); +begin + RoundRect(bounds.left,bounds.top,bounds.right,bounds.Bottom,dx,dy); +end; + +procedure TBGRACanvas.EllipseC(x, y, rx, ry: integer); +begin + Ellipse (Rect(x-rx,y-ry,x+rx,y+ry)); +end; + +procedure TBGRACanvas.FillRect(x1, y1, x2, y2: integer); +var + b: TUniversalBrush; +begin + if NoBrush then exit; + Brush.GetUniversalBrush(FBitmap, b); + FBitmap.FillRect(x1,y1,x2,y2, b); +end; + +procedure TBGRACanvas.FillRect(const bounds: TRect); +begin + FillRect(bounds.left,bounds.top,bounds.right,bounds.Bottom); +end; + +procedure TBGRACanvas.FrameRect(x1, y1, x2, y2: integer; width: integer = 1); +var + Temp: integer; + b: TUniversalBrush; + ofs: single; +begin + if (x1= x2) or (y1 =y2) or NoBrush then exit; + if x1 > x2 then + begin + Temp := x1; + x1 := x2; + x2 := Temp; + end; + if y1 > y2 then + begin + Temp := y1; + y1 := y2; + y2 := Temp; + end; + dec(x2); + dec(y2); + + Brush.GetUniversalBrush(FBitmap, b); + FBitmap.PenStyle := psSolid; + FBitmap.JoinStyle := pjsMiter; + if not odd(width) and (AntialiasingMode = amOff) then + ofs := 0.5 else ofs := 0; + FBitmap.RectangleAntialias(x1+ofs, y1+ofs, x2+ofs, y2+ofs, b, width); +end; + +procedure TBGRACanvas.FrameRect(const bounds: TRect; width: integer = 1); +begin + FrameRect(bounds.left,bounds.top,bounds.right,bounds.Bottom,width); +end; + +procedure TBGRACanvas.Frame3D(var bounds: TRect; width: integer; + Style: TGraphicsBevelCut); +begin + Frame3D(bounds,width,style,ColorToBGRA(clRgbBtnHighlight),ColorToBGRA(clRgbBtnShadow)); +end; + +procedure TBGRACanvas.Frame3D(var bounds: TRect; width: integer; + Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); +var temp: TBGRAPixel; + multi: TBGRAMultishapeFiller; + color1,color2: TBGRAPixel; +begin + if width <= 0 then exit; + color1 := LightColor; + color2 := ShadowColor; + if Style = bvLowered then + begin + temp := color1; + color1 := color2; + color2 := temp; + end; + if Style in [bvLowered,bvRaised] then + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + multi.AddPolygon([PointF(bounds.Left-0.5,bounds.Top-0.5),PointF(bounds.Right-0.5,bounds.Top-0.5), + PointF(bounds.Right-0.5-width,bounds.Top-0.5+width),PointF(bounds.Left-0.5+width,bounds.Top-0.5+width), + PointF(bounds.Left-0.5+width,bounds.Bottom-0.5-width),PointF(bounds.Left-0.5,bounds.Bottom-0.5)],color1); + multi.AddPolygon([PointF(bounds.Right-0.5,bounds.Bottom-0.5),PointF(bounds.Left-0.5,bounds.Bottom-0.5), + PointF(bounds.Left-0.5+width,bounds.Bottom-0.5-width),PointF(bounds.Right-0.5-width,bounds.Bottom-0.5-width), + PointF(bounds.Right-0.5-width,bounds.Top-0.5+width),PointF(bounds.Right-0.5,bounds.Top-0.5)],color2); + multi.Draw(FBitmap); + multi.Free; + end; + bounds.Inflate(-width,-width); +end; + +procedure TBGRACanvas.GradientFill(ARect: TRect; AStart, AStop: TColor; + ADirection: TGradientDirection; GammaCorrection: Boolean = false); +var + Count: Integer; + + procedure NotGammaCorrected; + var + c: TBGRAPixel; + I: Integer; + BDiff,GDiff,RDiff: Integer; + BStop,BStart: Byte; + GStop,GStart: Byte; + RStop,RStart: Byte; + begin + RedGreenBlue(ColorToRGB(AStart), RStart, GStart, BStart); + RedGreenBlue(ColorToRGB(AStop), RStop, GStop, BStop); + + RDiff := RStop - RStart; + GDiff := GStop - GStart; + BDiff := BStop - BStart; + + for I := 0 to Count-1 do + begin + c := BGRA(RStart + (i * RDiff) div Count, + GStart + (i * GDiff) div Count, + BStart + (i * BDiff) div Count); + + if ADirection = gdHorizontal then + FBitmap.SetVertLine(ARect.Left+I,ARect.Top,ARect.Bottom-1,c) + else + FBitmap.SetHorizLine(ARect.Left,ARect.Top+I,ARect.Right-1,c); + end; + end; + + procedure GammaCorrected; + var + ec: TExpandedPixel; + c: TBGRAPixel; + I: Integer; + BDiff,GDiff,RDiff: Integer; + CStart,CStop: TExpandedPixel; + begin + CStart := GammaExpansion(ColorToBGRA(AStart)); + CStop := GammaExpansion(ColorToBGRA(AStop)); + + RDiff := CStop.red - CStart.red; + GDiff := CStop.green - CStart.green; + BDiff := CStop.blue - CStart.blue; + + for I := 0 to Count-1 do + begin + ec.red := CStart.red + (i * RDiff) div Count; + ec.green := CStart.green + (i * GDiff) div Count; + ec.blue := CStart.blue + (i * BDiff) div Count; + ec.alpha := $ffff; + c := GammaCompression(ec); + + if ADirection = gdHorizontal then + FBitmap.SetVertLine(ARect.Left+I,ARect.Top,ARect.Bottom-1,c) + else + FBitmap.SetHorizLine(ARect.Left,ARect.Top+I,ARect.Right-1,c); + end; + end; + +begin + with ARect do + if (Right <= Left) or (Bottom <= Top) then + Exit; + + if ADirection = gdVertical then + Count := ARect.Bottom - ARect.Top + else + Count := ARect.Right - ARect.Left; + + if GammaCorrection then + GammaCorrected else + NotGammaCorrected; +end; + +procedure TBGRACanvas.FloodFill(X, Y: Integer; FillColor: TColor; + FillStyle: TFillStyle); +begin + FloodFill(X,Y,ColorToBGRA(FillColor,255),FillStyle); +end; + +procedure TBGRACanvas.FloodFill(X, Y: Integer; FillColor: TBGRAPixel; + FillStyle: TFillStyle); +var + b: TUniversalBrush; +begin + if FillStyle = fsSurface then + begin + if FBitmap.GetPixel(X,Y) <> FillColor then exit; + Brush.GetUniversalBrush(FBitmap, b); + FBitmap.FloodFill(X,Y, b, false); + end; + //fsBorder not handled +end; + +procedure TBGRACanvas.FloodFill(X, Y: Integer); +begin + FloodFill(X,Y,FBitmap.GetPixel(X,Y),fsSurface); +end; + +procedure TBGRACanvas.Polygon(const APoints: array of TPoint); +begin + Polygon(@APoints[0],length(APoints), FillMode = fmWinding); +end; + +procedure TBGRACanvas.Polygon(const Points: array of TPoint; Winding: Boolean; + StartIndex: Integer; NumPts: Integer); +begin + if (StartIndex < 0) or (StartIndex >= length(Points)) then exit; + if NumPts < 0 then NumPts := length(Points)-StartIndex; + Polygon(@Points[StartIndex], NumPts, Winding); +end; + +procedure TBGRACanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean); +var + ptsF: array of TPointF; + i: Integer; + Ofs: TPointF; +begin + if NoPen and NoBrush then exit; + if NoPen then Ofs := PointF(-0.5,-0.5) else Ofs := PointF(0,0); + setlength(ptsF, NumPts); + for i := 0 to NumPts-1 do + begin + ptsF[i] := PointF(Points^.x,Points^.y)+Ofs; + inc(Points); + end; + PolygonF(ptsF, Winding); +end; + +procedure TBGRACanvas.PolygonF(const APoints: array of TPointF); +begin + PolygonF(APoints, FillMode = fmWinding); +end; + +procedure TBGRACanvas.PolygonF(const APoints: array of TPointF; Winding: Boolean; FillOnly: Boolean = False); +var + hasPen, hasBrush: Boolean; + b: TUniversalBrush; + penPts: ArrayOfTPointF; + multi: TBGRAMultishapeFiller; + tex: IBGRAScanner; +begin + hasPen := not NoPen and not FillOnly; + hasBrush := not NoBrush; + if not HasPen and not HasBrush then exit; + if hasPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then + begin + ApplyPenStyle; + Pen.GetUniversalBrush(b); + penPts := FBitmap.ComputeWidePolygon(APoints, Pen.ActualWidth); + if AntialiasingMode = amOff then + FBitmap.FillPoly(penPts, b) + else FBitmap.FillPolyAntialias(penPts, b); + if hasBrush then + PolygonF(APoints, Winding, true); + end else + begin + multi := TBGRAMultishapeFiller.Create; + multi.Antialiasing := AntialiasingMode <> amOff; + if Winding then multi.FillMode := fmWinding else + multi.FillMode := fmAlternate; + multi.PolygonOrder := poLastOnTop; + if hasBrush then + begin + tex := Brush.BuildTexture(FBitmap); + if tex <> nil then + multi.AddPolygon(APoints, tex) + else multi.AddPolygon(APoints, Brush.ActualColor); + end; + if hasPen then + begin + ApplyPenStyle; + multi.AddPolygon(FBitmap.ComputeWidePolygon(APoints,Pen.ActualWidth), Pen.ActualColor); + end; + multi.Draw(FBitmap); + multi.Free + end; +end; + +procedure TBGRACanvas.Polyline(const APoints: array of TPoint); +begin + Polyline(@APoints[0],length(APoints)); +end; + +procedure TBGRACanvas.Polyline(const Points: array of TPoint; StartIndex: Integer; NumPts: Integer); +begin + if (StartIndex < 0) or (StartIndex >= length(Points)) then exit; + if NumPts < 0 then NumPts := length(Points)-StartIndex; + Polyline(@Points[StartIndex],NumPts); +end; + +procedure TBGRACanvas.Polyline(Points: PPoint; NumPts: Integer); +var + i: Integer; + ptsF: array of TPointF; + oldPos: TPoint; +begin + if NoPen or (NumPts <= 0) then exit; + + if (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then + begin + oldPos := FPenPos; + MoveTo(Points^.x,Points^.y); + for i := 1 to NumPts-1 do + begin + inc(Points); + LineTo(Points^.x,Points^.y); + end; + FPenPos := oldPos; + exit; + end; + + setlength(ptsF, NumPts); + for i := 0 to NumPts-1 do + begin + ptsF[i] := PointF(Points^.x,Points^.y); + inc(Points); + end; + PolylineF(ptsF); +end; + +procedure TBGRACanvas.PolylineF(const APoints: array of TPointF); +var ptsF: Array of TPointF; +begin + if NoPen then exit; + ApplyPenStyle; + FBitmap.FillMode := fmWinding; + ptsF := FBitmap.ComputeWidePolyline(APoints,Pen.ActualWidth); + if AntialiasingMode = amOff then + FBitmap.FillPoly(ptsF,Pen.ActualColor,dmDrawWithTransparency) else + FBitmap.FillPolyAntialias(ptsF,Pen.ActualColor); +end; + +procedure TBGRACanvas.PolyBezier(Points: PPoint; NumPts: Integer; + Filled: boolean; Continuous: boolean); +var + beziers: array of TCubicBezierCurve; + nbBeziers,i: integer; + PrevPt: TPointF; + spline: array of TPointF; +begin + if NumPts < 4 then exit; + if Continuous then + begin + nbBeziers := 1+(NumPts-4) div 3; + setlength(beziers, nbBeziers); + PrevPt := PointF(Points^.x,Points^.y); + inc(Points); + for i := 0 to nbBeziers-1 do + begin + beziers[i].p1 := prevPt; + beziers[i].c1 := PointF(Points^.x,Points^.y); + inc(Points); + beziers[i].c2 := PointF(Points^.x,Points^.y); + inc(Points); + beziers[i].p2 := PointF(Points^.x,Points^.y); + inc(Points); + prevPt := beziers[i].p2; + end; + end else + begin + nbBeziers := NumPts div 4; + setlength(beziers, nbBeziers); + for i := 0 to nbBeziers-1 do + begin + beziers[i].p1 := PointF(Points^.x,Points^.y); + inc(Points); + beziers[i].c1 := PointF(Points^.x,Points^.y); + inc(Points); + beziers[i].c2 := PointF(Points^.x,Points^.y); + inc(Points); + beziers[i].p2 := PointF(Points^.x,Points^.y); + inc(Points); + end; + end; + spline := ComputeBezierSpline(beziers); + if Filled then + PolygonF(spline) else + PolylineF(spline); +end; + +procedure TBGRACanvas.PolyBezier(const Points: array of TPoint; + Filled: boolean; Continuous: boolean); +begin + PolyBezier(@Points[0],length(Points),Filled,Continuous); +end; + +procedure TBGRACanvas.Draw(X, Y: Integer; SrcBitmap: TBGRACustomBitmap); +begin + FBitmap.PutImage(X,Y,SrcBitmap,dmDrawWithTransparency); +end; + +procedure TBGRACanvas.Draw(X, Y: Integer; SrcBitmap: TBitmap); +begin + FBitmap.PutImage(X,Y,SrcBitmap,dmDrawWithTransparency); +end; + +procedure TBGRACanvas.CopyRect(X, Y: Integer; SrcBitmap: TBGRACustomBitmap; + SrcRect: TRect); +begin + FBitmap.PutImagePart(X,Y,SrcBitmap,SrcRect,dmDrawWithTransparency); +end; + +procedure TBGRACanvas.StretchDraw(DestRect: TRect; SrcBitmap: TBGRACustomBitmap; HorizFlip: Boolean = false; VertFlip: Boolean = false); +var Stretched: TBGRACustomBitmap; + temp: Integer; +begin + with DestRect do + begin + if (Left= Right) or (Top =Bottom) then exit; + if Left > Right then + begin + Temp := Left; + Left := Right+1; + Right := Temp+1; + HorizFlip := not HorizFlip; + end; + if Top > Bottom then + begin + Temp := Top; + Top := Bottom+1; + Bottom := Temp+1; + VertFlip := not VertFlip; + end; + end; + if (DestRect.Right-DestRect.Left <> SrcBitmap.Width) or + (DestRect.Bottom-DestRect.Top <> SrcBitmap.Height) or + HorizFlip or VertFlip then + begin + if AntialiasingMode = amOff then + Stretched := SrcBitmap.Resample(DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,rmSimpleStretch) else + Stretched := SrcBitmap.Resample(DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,rmFineResample); + if HorizFlip then Stretched.HorizontalFlip; + if VertFlip then Stretched.VerticalFlip; + FBitmap.PutImage(DestRect.Left,DestRect.Top,Stretched,dmDrawWithTransparency); + Stretched.Free; + end else + FBitmap.PutImage(DestRect.Left,DestRect.Top,SrcBitmap,dmDrawWithTransparency); +end; + +procedure TBGRACanvas.DrawFocusRect(bounds: TRect); +var + temp: Integer; + xb,yb: integer; + c: TBGRAPixel; +begin + c := Brush.ActualColor; + if (c.red = 0) and (c.Green =0) and (c.Blue =0) then exit; + c.alpha := 0; + with bounds do + begin + if (Left= Right) or (Top =Bottom) then exit; + if Left > Right then + begin + Temp := Left; + Left := Right; + Right := Temp; + end; + if Top > Bottom then + begin + Temp := Top; + Top := Bottom; + Bottom := Temp; + end; + dec(Right); + dec(Bottom); + for xb := max(FBitmap.ClipRect.Left, bounds.Left+1) to min(FBitmap.ClipRect.Right-1,bounds.Right-1) do + begin + if odd(xb) xor odd(Top) then FBitmap.XorPixel(xb,Top,c); + if odd(xb) xor odd(Bottom) then FBitmap.XorPixel(xb,Bottom,c); + end; + for yb := max(FBitmap.ClipRect.Top, bounds.Top) to min(FBitmap.ClipRect.Bottom-1,bounds.Bottom) do + begin + if odd(yb) xor odd(Left) then FBitmap.XorPixel(Left,yb,c); + if odd(yb) xor odd(Right) then FBitmap.XorPixel(Right,yb,c); + end; + end; +end; + +procedure TBGRACanvas.CopyRect(Dest: TRect; SrcBmp: TBGRACustomBitmap; + Source: TRect); +var TempBmp: TBGRACustomBitmap; + Temp: Integer; + FlipHoriz,FlipVert: Boolean; +begin + if (Dest.Right-Dest.Left = Source.Right-Source.Left) and (Dest.Bottom-Dest.Top = Source.Bottom-Source.Top) and + (Dest.Right > Dest.Left) and (Dest.Bottom > Dest.Top) then + begin + CopyRect(Dest.Left,Dest.Top, SrcBmp, Source); + exit; + end; + if (Source.Left = Source.Right) or (Source.Bottom = Source.Top) or + (Dest.Left = Dest.Right) or (Dest.Bottom = Dest.Top) then exit; + if Source.Left > Source.Right then + begin + Temp := Source.Left; + Source.Left := Source.Right+1; + Source.Right := Temp+1; + FlipHoriz := True; + end else + FlipHoriz := false; + if Source.Top > Source.Bottom then + begin + Temp := Source.Top; + Source.Top := Source.Bottom+1; + Source.Bottom := Temp+1; + FlipVert := True; + end else + FlipVert := false; + TempBmp := SrcBmp.GetPart(Source); + StretchDraw(Dest,TempBmp,FlipHoriz,FlipVert); + TempBmp.Free; +end; + +procedure TBGRACanvas.TextOut(X, Y: Integer; const Text: String); +var size: TSize; + c,s: single; +begin + ApplyFont; + if DrawFontBackground then + begin + size := TextExtent(Text); + c := cos(Font.Orientation*Pi/1800); + s := -sin(Font.Orientation*Pi/1800); + PolygonF([PointF(X,Y),PointF(X+c*size.cx,Y+s*size.cx), + PointF(X+c*size.cx-s*size.cy,Y+s*size.cx+c*size.cy), + PointF(X-s*size.cy,Y+c*size.cy)],False,True); + end; + if Font.Texture <> nil then + FBitmap.TextOut(x,y,Text,Font.Texture) else + FBitmap.TextOut(x,y,Text,Font.BGRAColor); +end; + +procedure TBGRACanvas.TextRect(const ARect: TRect; X, Y: integer; + const Text: string); +begin + ApplyFont; + if Font.Texture <> nil then + FBitmap.TextRect(ARect,x,y,Text,self.TextStyle,Font.Texture) else + FBitmap.TextRect(ARect,x,y,Text,self.TextStyle,Font.BGRAColor); +end; + +procedure TBGRACanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string; + const Style: TTextStyle); +begin + ApplyFont; + if Font.Texture <> nil then + FBitmap.TextRect(ARect,x,y,Text,Style,Font.Texture) else + FBitmap.TextRect(ARect,x,y,Text,Style,Font.BGRAColor); +end; + +function TBGRACanvas.TextExtent(const Text: string): TSize; +begin + ApplyFont; + result := FBitmap.TextSize(Text); +end; + +{$hints off} +function TBGRACanvas.TextHeight(const Text: string): Integer; +begin + ApplyFont; + result := FBitmap.TextSize(Text).cy; +end; +{$hints on} + +function TBGRACanvas.TextWidth(const Text: string): Integer; +begin + ApplyFont; + result := FBitmap.TextSize(Text).cx; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas2d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas2d.pas new file mode 100644 index 0000000..2e0bad6 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvas2d.pas @@ -0,0 +1,2851 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACanvas2D; + +{ To do : + + draw text with a different precision if the matrix is scaled + drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh) + -> using FillPoly with texture coordinates + linear gradient any transformation + clearPath clipping + createRadialGradient + globalCompositeOperation + image data functions +} + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform, + BGRAGradientScanner, BGRAPath, BGRAPen, BGRAGrayscaleMask; + +type + ArrayOfString = array of string; + + IBGRACanvasTextureProvider2D = interface + function getTexture: IBGRAScanner; + property texture: IBGRAScanner read GetTexture; + end; + + IBGRACanvasGradient2D = interface(IBGRACanvasTextureProvider2D) + procedure addColorStop(APosition: single; AColor: TBGRAPixel); + procedure addColorStop(APosition: single; AColor: TColor); + procedure addColorStop(APosition: single; AColor: string); + procedure setColors(ACustomGradient: TBGRACustomGradient); + function GetGammaCorrection: boolean; + procedure SetGammaCorrection(AValue: boolean); + function GetRepetition: TBGRAGradientRepetition; + procedure SetRepetition(AValue: TBGRAGradientRepetition); + property gammaCorrection: boolean read GetGammaCorrection write SetGammaCorrection; + property repetition: TBGRAGradientRepetition read GetRepetition write SetRepetition; + end; + + { TBGRACanvasTextureProvider2D } + + TBGRACanvasTextureProvider2D = class(TInterfacedObject,IBGRACanvasTextureProvider2D) + function getTexture: IBGRAScanner; virtual; abstract; + end; + + { TBGRACanvasState2D } + + TBGRACanvasState2D = class + private + FClipMask: TGrayscaleMask; + FClipMaskOwned: boolean; + function GetClipMaskReadWrite: TGrayscaleMask; + public + strokeColor: TBGRAPixel; + strokeTextureProvider: IBGRACanvasTextureProvider2D; + fillColor: TBGRAPixel; + fillMode: TFillMode; + fillTextureProvider: IBGRACanvasTextureProvider2D; + globalAlpha: byte; + + fontName: string; + fontStyle: TFontStyles; + fontEmHeight: single; + textAlign: TAlignment; + textBaseline: string; + textDirection: TFontBidiMode; + + lineWidth: single; + penStroker: TBGRAPenStroker; + + shadowOffsetX,shadowOffsetY,shadowBlur: single; + shadowColor: TBGRAPixel; + shadowFastest: boolean; + + matrix: TAffineMatrix; + constructor Create(AMatrix: TAffineMatrix; AClipMask: TGrayscaleMask; AClipMaskOwned: boolean); + function Duplicate: TBGRACanvasState2D; + destructor Destroy; override; + procedure transform(AMatrix: TAffineMatrix); + procedure SetClipMask(AClipMask: TGrayscaleMask; AOwned: boolean); + property clipMaskReadOnly: TGrayscaleMask read FClipMask; + property clipMaskReadWrite: TGrayscaleMask read GetClipMaskReadWrite; + end; + + TCanvas2dTextSize = record + width,height: single; + end; + + { TBGRACanvas2D } + + TBGRACanvas2D = class(IBGRAPath) + private + FSurface: TBGRACustomBitmap; + StateStack: TList; + currentState: TBGRACanvasState2D; + FCanvasOffset: TPointF; + FPixelCenteredCoordinates: boolean; + FPathPoints: array of TPointF; + FPathPointCount: integer; + FTextPaths: array of record + Text: string; + FontName: string; + FontMatrix: TAffineMatrix; + FontAlign: TAlignment; + FontAnchor: TFontVerticalAnchor; + FontStyle: TFontStyles; + TextDirection: TFontBidiMode; + end; + FFontRenderer: TBGRACustomFontRenderer; + FLastCoord, FStartCoord: TPointF; + function GetCurrentPathAsPoints: ArrayOfTPointF; + function GetTextDirection: TFontBidiMode; + function GetFontName: string; + function GetFontRenderer: TBGRACustomFontRenderer; + function GetFontEmHeight: single; + function GetFontString: string; + function GetFontStyle: TFontStyles; + function GetGlobalAlpha: single; + function GetHasShadow: boolean; + function GetHeight: Integer; + function GetLineCap: string; + function GetLineCapLCL: TPenEndCap; + function GetlineJoin: string; + function GetlineJoinLCL: TPenJoinStyle; + function GetLineWidth: single; + function GetMatrix: TAffineMatrix; + function GetMiterLimit: single; + function GetPixelCenteredCoordinates: boolean; + function GetShadowBlur: single; + function GetShadowFastest: boolean; + function GetShadowOffset: TPointF; + function GetShadowOffsetX: single; + function GetShadowOffsetY: single; + function GetStrokeMatrix: TAffineMatrix; + function GetTextAlign: string; + function GetTextAlignLCL: TAlignment; + function GetTextBaseline: string; + function GetFillMode: TFillMode; + function GetWidth: Integer; + procedure SetTextDirection(AValue: TFontBidiMode); + procedure SetFontName(AValue: string); + procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); + procedure SetFontEmHeight(AValue: single); + procedure SetFontString(AValue: string); + procedure SetFontStyle(AValue: TFontStyles); + procedure SetGlobalAlpha(const AValue: single); + procedure SetLineCap(const AValue: string); + procedure SetLineCapLCL(AValue: TPenEndCap); + procedure SetLineJoin(const AValue: string); + procedure FillPoly(const points: array of TPointF); + procedure FillStrokePoly(const points: array of TPointF; fillOver: boolean); + procedure FillTexts(AErase: boolean); + procedure SetLineJoinLCL(AValue: TPenJoinStyle); + procedure SetLineWidth(const AValue: single); + procedure SetMatrix(AValue: TAffineMatrix); + procedure SetMiterLimit(const AValue: single); + procedure SetPixelCenteredCoordinates(const AValue: boolean); + procedure SetShadowBlur(const AValue: single); + procedure SetShadowFastest(AValue: boolean); + procedure SetShadowOffset(const AValue: TPointF); + procedure SetShadowOffsetX(const AValue: single); + procedure SetShadowOffsetY(const AValue: single); + procedure SetStrokeMatrix(AValue: TAffineMatrix); + procedure SetTextAlign(AValue: string); + procedure SetTextAlignLCL(AValue: TAlignment); + procedure SetTextBaseline(AValue: string); + procedure SetFillMode(mode: TFillMode); + procedure StrokePoly(const points: array of TPointF); + procedure DrawShadow(const points, points2: array of TPointF; AFillMode: TFillMode = fmWinding); + procedure DrawShadowMask(X,Y: integer; AMask: TCustomUniversalBitmap; AMaskOwned: boolean); + procedure ClearPoly(const points: array of TPointF); + function ApplyTransform(const points: array of TPointF; matrix: TAffineMatrix): ArrayOfTPointF; overload; + function ApplyTransform(const points: array of TPointF): ArrayOfTPointF; overload; + function ApplyTransform(point: TPointF): TPointF; overload; + function GetPenPos(defaultX, defaultY: single): TPointF; + function GetPenPos(defaultPt: TPointF): TPointF; + procedure AddPoint(point: TPointF); + procedure AddPoints(const points: array of TPointF); + procedure AddPointsRev(const points: array of TPointF); + function ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel; + function GetDrawMode: TDrawMode; + procedure copyTo({%H-}dest: IBGRAPath); //IBGRAPath + function getPoints: ArrayOfTPointF; //IBGRAPath + function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; //IBGRAPath + function getCursor: TBGRACustomPathCursor; //IBGRAPath + public + antialiasing, linearBlend, gradientGammaCorrection: boolean; + constructor Create(ASurface: TBGRACustomBitmap); + destructor Destroy; override; + + function toDataURL(mimeType: string = 'image/png'): string; + + procedure save; + procedure restore; + procedure scale(x,y: single); overload; + procedure scale(factor: single); overload; + procedure rotate(angleRadCW: single); + procedure translate(x,y: single); + procedure skewx(angleRadCW: single); + procedure skewy(angleRadCW: single); + procedure transform(m11,m21, m12,m22, m13,m23: single); overload; + procedure transform(AMatrix: TAffineMatrix); overload; + procedure setTransform(m11,m21, m12,m22, m13,m23: single); + procedure resetTransform; + + procedure strokeScale(x,y: single); + procedure strokeSkewx(angleRadCW: single); + procedure strokeSkewy(angleRadCW: single); + procedure strokeResetTransform; + + procedure strokeStyle(color: TBGRAPixel); overload; + procedure strokeStyle(color: TColor); overload; + procedure strokeStyle(color: string); overload; + procedure strokeStyle(texture: IBGRAScanner); overload; + procedure strokeStyle(provider: IBGRACanvasTextureProvider2D); overload; + procedure fillStyle(color: TBGRAPixel); overload; + procedure fillStyle(color: TColor); overload; + procedure fillStyle(color: string); overload; + procedure fillStyle(texture: IBGRAScanner); overload; + procedure fillStyle(provider: IBGRACanvasTextureProvider2D); overload; + procedure shadowColor(color: TBGRAPixel); overload; + procedure shadowColor(color: TColor); overload; + procedure shadowColor(color: string); overload; + procedure shadowNone; + function getShadowColor: TBGRAPixel; + + function createLinearGradient(x0,y0,x1,y1: single): IBGRACanvasGradient2D; overload; + function createLinearGradient(p0,p1: TPointF): IBGRACanvasGradient2D; overload; + function createLinearGradient(x0,y0,x1,y1: single; Colors: TBGRACustomGradient): IBGRACanvasGradient2D; overload; + function createLinearGradient(p0,p1: TPointF; Colors: TBGRACustomGradient): IBGRACanvasGradient2D; overload; + + function createRadialGradient(x0,y0,r0,x1,y1,r1: single; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; + function createRadialGradient(p0: TPointF; r0: single; p1: TPointF; r1: single; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; + function createRadialGradient(x0,y0,r0,x1,y1,r1: single; Colors: TBGRACustomGradient; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; + function createRadialGradient(p0: TPointF; r0: single; p1: TPointF; r1: single; Colors: TBGRACustomGradient; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; + + function createPattern(image: TBGRACustomBitmap; repetition: string): IBGRACanvasTextureProvider2D; overload; + function createPattern(texture: IBGRAScanner): IBGRACanvasTextureProvider2D; overload; + + procedure fillRect(x,y,w,h: single); + procedure strokeRect(x,y,w,h: single); + procedure clearRect(x,y,w,h: single); + + procedure addPath(APath: IBGRAPath); overload; + procedure addPath(ASvgPath: string); overload; + procedure path(APath: IBGRAPath); overload; + procedure path(ASvgPath: string); overload; + procedure beginPath; + procedure closePath; + procedure toSpline(closed: boolean; style: TSplineStyle= ssOutside); + procedure moveTo(x,y: single); overload; + procedure lineTo(x,y: single); overload; + procedure moveTo(constref pt: TPointF); overload; + procedure lineTo(constref pt: TPointF); overload; + procedure polylineTo(const pts: array of TPointF); + procedure quadraticCurveTo(cpx,cpy,x,y: single); overload; + procedure quadraticCurveTo(constref cp,pt: TPointF); overload; + procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload; + procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); overload; + procedure rect(x,y,w,h: single); + procedure roundRect(x,y,w,h,radius: single); overload; + procedure roundRect(x,y,w,h,rx,ry: single); overload; + procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); + procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); + procedure spline(const pts: array of TPointF; style: TSplineStyle= ssOutside); + procedure splineTo(const pts: array of TPointF; style: TSplineStyle= ssOutside); + procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; + procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); overload; + procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; + procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload; + procedure arc(constref arcDef: TArcDef); overload; + procedure arcTo(x1, y1, x2, y2, radius: single); overload; + procedure arcTo(p1,p2: TPointF; radius: single); overload; + procedure arcTo(rx, ry, xAngleRadCW: single; largeArc,anticlockwise: boolean; x, y: single); + procedure circle(x,y,r: single); + procedure ellipse(x,y,rx,ry: single); + procedure text(AText: string; x,y: single); + procedure fillText(AText: string; x,y: single); + procedure strokeText(AText: string; x,y: single); + function measureText(AText: string): TCanvas2dTextSize; + + procedure fill; overload; + procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; + procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; //may not render curve nicely + procedure stroke; overload; + procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; + procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; //may not render curve nicely + procedure fillOverStroke; + procedure strokeOverFill; + procedure clearPath; + procedure clip; + procedure unclip; + function isPointInPath(x,y: single): boolean; overload; + function isPointInPath(pt: TPointF): boolean; overload; + + procedure drawImage(image: TBGRACustomBitmap; dx,dy: single; AFilter: TResampleFilter = rfLinear); overload; + procedure drawImage(image: TBGRACustomBitmap; dx,dy,dw,dh: single; AFilter: TResampleFilter = rfLinear); overload; + + function getLineStyle: TBGRAPenStyle; + procedure lineStyle(const AValue: array of single); overload; + procedure lineStyle(AStyle: TPenStyle); overload; + + class function StrToFontNameList(AText: string): ArrayOfString; + class function FontNameListToStr(AList: ArrayOfString): string; + class function CSSFontNameToLCL(AName: string): string; + + property surface: TBGRACustomBitmap read FSurface; + property width: Integer read GetWidth; + property height: Integer read GetHeight; + property pixelCenteredCoordinates: boolean read GetPixelCenteredCoordinates write SetPixelCenteredCoordinates; + property globalAlpha: single read GetGlobalAlpha write SetGlobalAlpha; + property matrix: TAffineMatrix read GetMatrix write SetMatrix; + property strokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix; + + property lineWidth: single read GetLineWidth write SetLineWidth; + property lineCap: string read GetLineCap write SetLineCap; + property lineCapLCL: TPenEndCap read GetLineCapLCL write SetLineCapLCL; + property lineJoin: string read GetlineJoin write SetLineJoin; + property lineJoinLCL: TPenJoinStyle read GetlineJoinLCL write SetLineJoinLCL; + property miterLimit: single read GetMiterLimit write SetMiterLimit; + + property shadowOffsetX: single read GetShadowOffsetX write SetShadowOffsetX; + property shadowOffsetY: single read GetShadowOffsetY write SetShadowOffsetY; + property shadowOffset: TPointF read GetShadowOffset write SetShadowOffset; + property shadowBlur: single read GetShadowBlur write SetShadowBlur; + property shadowFastest: boolean read GetShadowFastest write SetShadowFastest; + property hasShadow: boolean read GetHasShadow; + + property fontName: string read GetFontName write SetFontName; + property fontEmHeight: single read GetFontEmHeight write SetFontEmHeight; + property fontStyle: TFontStyles read GetFontStyle write SetFontStyle; + property font: string read GetFontString write SetFontString; + property textAlignLCL: TAlignment read GetTextAlignLCL write SetTextAlignLCL; + property textAlign: string read GetTextAlign write SetTextAlign; + property textBaseline: string read GetTextBaseline write SetTextBaseline; + property direction: TFontBidiMode read GetTextDirection write SetTextDirection; + + property fillMode: TFillMode read GetFillMode write SetFillMode; + + property currentPath: ArrayOfTPointF read GetCurrentPathAsPoints; + property fontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer; + + protected + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + end; + +implementation + +uses Math, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64; + +type + TColorStop = record + position: single; + color: TBGRAPixel; + end; + + TGradientArrayOfColors = array of TBGRAPixel; + TGradientArrayOfPositions = array of single; + + { TBGRACanvasGradient2D } + + TBGRACanvasGradient2D = class(TBGRACanvasTextureProvider2D, IBGRACanvasGradient2D) + private + colorStops: array of TColorStop; + nbColorStops: integer; + FCustomGradient: TBGRACustomGradient; + FGammaCorrection: boolean; + FRepetition: TBGRAGradientRepetition; + protected + scanner: TBGRAGradientScanner; + procedure CreateScanner; virtual; abstract; + function getColorArray: TGradientArrayOfColors; + function getPositionArray: TGradientArrayOfPositions; + procedure GetBGRAGradient(out ABGRAGradient: TBGRACustomGradient; out AOwned: boolean); + function GetGammaCorrection: boolean; + procedure SetGammaCorrection(AValue: boolean); + function GetRepetition: TBGRAGradientRepetition; + procedure SetRepetition(AValue: TBGRAGradientRepetition); + public + constructor Create; + function getTexture: IBGRAScanner; override; + destructor Destroy; override; + procedure addColorStop(APosition: single; AColor: TBGRAPixel); + procedure addColorStop(APosition: single; AColor: TColor); + procedure addColorStop(APosition: single; AColor: string); + procedure setColors(ACustomGradient: TBGRACustomGradient); + property texture: IBGRAScanner read GetTexture; + property colorStopCount: integer read nbColorStops; + property gammaCorrection: boolean read GetGammaCorrection write SetGammaCorrection; + property repetition: TBGRAGradientRepetition read GetRepetition write SetRepetition; + end; + + { TBGRACanvasLinearGradient2D } + + TBGRACanvasLinearGradient2D = class(TBGRACanvasGradient2D) + protected + o1,o2: TPointF; + FTransform: TAffineMatrix; + procedure CreateScanner; override; + public + constructor Create(x0,y0,x1,y1: single; transform: TAffineMatrix); + constructor Create(p0,p1: TPointF; transform: TAffineMatrix); + end; + + { TBGRACanvasRadialGradient2D } + + TBGRACanvasRadialGradient2D = class(TBGRACanvasGradient2D) + protected + c0,c1: TPointF; + cr0,cr1: single; + FFlipGradient: boolean; + FTransform: TAffineMatrix; + procedure CreateScanner; override; + public + constructor Create(x0,y0,r0,x1,y1,r1: single; transform: TAffineMatrix; flipGradient: boolean=false); + constructor Create(p0: TPointF; r0: single; p1: TPointF; r1: single; transform: TAffineMatrix; flipGradient: boolean=false); + end; + + { TBGRACanvasPattern2D } + + TBGRACanvasPattern2D = class(TBGRACanvasTextureProvider2D) + protected + scanner: TBGRACustomScanner; + foreignInterface: IBGRAScanner; + ownScanner: boolean; + public + function getTexture: IBGRAScanner; override; + constructor Create(source: TBGRACustomBitmap; repeatX,repeatY: boolean; Origin, HAxis, VAxis: TPointF); + constructor Create(source: IBGRAScanner; transformation: TAffineMatrix); + destructor Destroy; override; + end; + +{ TBGRACanvasPattern2D } + +function TBGRACanvasPattern2D.GetTexture: IBGRAScanner; +begin + if ownScanner then + result := scanner + else + result := foreignInterface; +end; + +constructor TBGRACanvasPattern2D.Create(source: TBGRACustomBitmap; repeatX, + repeatY: boolean; Origin, HAxis, VAxis: TPointF); +var + affine: TBGRAAffineBitmapTransform; +begin + if (abs(Origin.X-round(Origin.X)) < 1e-6) and + (abs(Origin.Y-round(Origin.Y)) < 1e-6) and + (HAxis = Origin+PointF(1,0)) and + (VAxis = Origin+PointF(0,1)) then + begin + if (round(Origin.X)=0) and (round(Origin.Y)=0) and repeatX and repeatY then + begin + foreignInterface := source; + ownScanner:= false; + end else + begin + scanner := TBGRABitmapScanner.Create(source,repeatX,repeatY,Point(round(Origin.X),round(Origin.Y))); + ownScanner := true; + end; + end + else + begin + affine := TBGRAAffineBitmapTransform.Create(source,repeatX,repeatY); + affine.Fit(Origin,HAxis,VAxis); + scanner := affine; + ownScanner:= true; + end; +end; + +constructor TBGRACanvasPattern2D.Create(source: IBGRAScanner; + transformation: TAffineMatrix); +var + affine : TBGRAAffineScannerTransform; +begin + if (abs(transformation[1,1]-1) < 1e-6) and + (abs(transformation[2,2]-1) < 1e-6) and + (abs(transformation[1,2]) < 1e-6) and + (abs(transformation[2,1]) < 1e-6) and + (abs(transformation[1,3]-round(transformation[1,3])) < 1e-6) and + (abs(transformation[2,3]-round(transformation[2,3])) < 1e-6) then + begin + if (abs(transformation[1,3]) < 1e-6) and + (abs(transformation[2,3]) < 1e-6) then + begin + foreignInterface := source; + ownScanner := false; + end else + begin + scanner := TBGRAScannerOffset.Create(source,Point(round(transformation[1,3]),round(transformation[2,3]))); + ownScanner := true; + end; + end else + begin + affine := TBGRAAffineScannerTransform.Create(source); + affine.Matrix := transformation; + affine.Invert; + scanner := affine; + ownScanner:= true; + end; +end; + +destructor TBGRACanvasPattern2D.Destroy; +begin + fillchar(foreignInterface,sizeof(foreignInterface),0); + if ownScanner then FreeAndNil(scanner); + inherited Destroy; +end; + +{ TBGRACanvasLinearGradient2D } + +procedure TBGRACanvasLinearGradient2D.CreateScanner; +var GradientOwner: boolean; + GradientColors: TBGRACustomGradient; +begin + GetBGRAGradient(GradientColors,GradientOwner); + scanner := TBGRAGradientScanner.Create(GradientColors,gtLinear,o1,o2,False,GradientOwner); + scanner.Transform := FTransform; +end; + +constructor TBGRACanvasLinearGradient2D.Create(x0, y0, x1, y1: single; transform: TAffineMatrix); +begin + o1 := PointF(x0,y0); + o2 := PointF(x1,y1); + FTransform := transform; +end; + +constructor TBGRACanvasLinearGradient2D.Create(p0, p1: TPointF; transform: TAffineMatrix); +begin + o1 := p0; + o2 := p1; + FTransform := transform; +end; + +{ TBGRACanvasRadialGradient2D } + +procedure TBGRACanvasRadialGradient2D.CreateScanner; +var GradientOwner: boolean; + GradientColors: TBGRACustomGradient; +begin + GetBGRAGradient(GradientColors,GradientOwner); + scanner := TBGRAGradientScanner.Create(GradientColors,c0,cr0,c1,cr1,GradientOwner); + scanner.FlipGradient := not FFlipGradient; + scanner.Transform := FTransform; +end; + +constructor TBGRACanvasRadialGradient2D.Create(x0, y0, r0, x1, y1, r1: single; + transform: TAffineMatrix; flipGradient: boolean); +begin + self.c0 := PointF(x0,y0); + self.cr0 := r0; + self.c1 := PointF(x1,y1); + self.cr1 := r1; + FTransform := transform; + FFlipGradient := flipGradient; +end; + +constructor TBGRACanvasRadialGradient2D.Create(p0: TPointF; r0: single; + p1: TPointF; r1: single; transform: TAffineMatrix; flipGradient: boolean); +begin + self.c0 := p0; + self.cr0 := r0; + self.c1 := p1; + self.cr1 := r1; + FTransform := transform; + FFlipGradient := flipGradient; +end; + +{ TBGRACanvasGradient2D } + +function TBGRACanvasGradient2D.getTexture: IBGRAScanner; +begin + if scanner = nil then CreateScanner; + result := scanner; +end; + +function TBGRACanvasGradient2D.GetGammaCorrection: boolean; +begin + result := FGammaCorrection; +end; + +procedure TBGRACanvasGradient2D.SetGammaCorrection(AValue: boolean); +begin + FGammaCorrection:= AValue; + FreeAndNil(scanner); +end; + +constructor TBGRACanvasGradient2D.Create; +begin + inherited Create; + scanner := nil; + FGammaCorrection:= false; +end; + +function TBGRACanvasGradient2D.GetRepetition: TBGRAGradientRepetition; +begin + result := FRepetition; +end; + +procedure TBGRACanvasGradient2D.SetRepetition( + AValue: TBGRAGradientRepetition); +begin + FRepetition := AValue; + FreeAndNil(scanner); +end; + +function TBGRACanvasGradient2D.getColorArray: TGradientArrayOfColors; +var + i: Integer; +begin + setlength(result, nbColorStops); + for i := 0 to nbColorStops-1 do + result[i] := colorStops[i].color; +end; + +function TBGRACanvasGradient2D.getPositionArray: TGradientArrayOfPositions; +var + i: Integer; +begin + setlength(result, nbColorStops); + for i := 0 to nbColorStops-1 do + result[i] := colorStops[i].position; +end; + +procedure TBGRACanvasGradient2D.GetBGRAGradient(out + ABGRAGradient: TBGRACustomGradient; out AOwned: boolean); +begin + if FCustomGradient = nil then + begin + if (colorStopCount = 2) and (colorStops[0].position = 0) and (colorStops[1].position = 1) then + begin + if FGammaCorrection then + ABGRAGradient := TBGRASimpleGradientWithGammaCorrection.Create(colorStops[0].color, colorStops[1].color, FRepetition) + else + ABGRAGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(colorStops[0].color, colorStops[1].color, FRepetition); + end + else + ABGRAGradient := TBGRAMultiGradient.Create(getColorArray,getPositionArray,FGammaCorrection, FRepetition = grRepeat); + AOwned := true; + end else + begin + ABGRAGradient := FCustomGradient; + AOwned := false; + end; +end; + +destructor TBGRACanvasGradient2D.Destroy; +begin + FreeAndNil(scanner); + inherited Destroy; +end; + +procedure TBGRACanvasGradient2D.addColorStop(APosition: single; + AColor: TBGRAPixel); +begin + FreeAndNil(scanner); + if nbColorStops = length(colorStops) then + setlength(colorStops, (length(colorStops)+1)*2); + + with colorStops[nbColorStops] do + begin + position := APosition; + color := AColor; + end; + inc(nbColorStops); +end; + +procedure TBGRACanvasGradient2D.addColorStop(APosition: single; AColor: TColor + ); +begin + addColorStop(APosition, ColorToBGRA(AColor)); +end; + +procedure TBGRACanvasGradient2D.addColorStop(APosition: single; AColor: string + ); +begin + addColorStop(APosition, StrToBGRA(AColor)); +end; + +procedure TBGRACanvasGradient2D.setColors(ACustomGradient: TBGRACustomGradient + ); +begin + FCustomGradient := ACustomGradient; +end; + +{ TBGRACanvasState2D } + +function TBGRACanvasState2D.GetClipMaskReadWrite: TGrayscaleMask; +begin + if not FClipMaskOwned then + begin + if FClipMask <> nil then + FClipMask := FClipMask.Duplicate as TGrayscaleMask; + FClipMaskOwned := true; + end; + result := FClipMask; +end; + +constructor TBGRACanvasState2D.Create(AMatrix: TAffineMatrix; + AClipMask: TGrayscaleMask; AClipMaskOwned: boolean); +begin + strokeColor := BGRABlack; + fillColor := BGRABlack; + globalAlpha := 255; + + fontName := 'sans-serif'; + fontEmHeight := 10; + fontStyle := []; + textDirection := fbmAuto; + textAlign:= taLeftJustify; + textBaseline := 'alphabetic'; + + lineWidth := 1; + penStroker := TBGRAPenStroker.Create; + penStroker.LineCap := pecFlat; + penStroker.JoinStyle := pjsMiter; + penStroker.CustomPenStyle := DuplicatePenStyle(SolidPenStyle); + penStroker.MiterLimit := 10; + penStroker.StrokeMatrix := AffineMatrixIdentity; + + shadowOffsetX := 0; + shadowOffsetY := 0; + shadowBlur := 0; + shadowColor := BGRAPixelTransparent; + shadowFastest:= false; + + matrix := AMatrix; + FClipMask := nil; + FClipMaskOwned := true; + SetClipMask(AClipMask,AClipMaskOwned); +end; + +function TBGRACanvasState2D.Duplicate: TBGRACanvasState2D; +begin + result := TBGRACanvasState2D.Create(matrix,clipMaskReadOnly,false); + result.strokeColor := strokeColor; + result.strokeTextureProvider := strokeTextureProvider; + result.fillColor := fillColor; + result.fillMode := fillMode; + result.fillTextureProvider := fillTextureProvider; + result.globalAlpha := globalAlpha; + + result.fontName:= fontName; + result.fontEmHeight := fontEmHeight; + result.fontStyle := fontStyle; + result.textDirection:= textDirection; + result.textBaseline:= textBaseline; + + result.lineWidth := lineWidth; + result.penStroker.LineCap := penStroker.LineCap; + result.penStroker.JoinStyle := penStroker.JoinStyle; + result.penStroker.CustomPenStyle := DuplicatePenStyle(penStroker.CustomPenStyle); + result.penStroker.MiterLimit := penStroker.MiterLimit; + result.penStroker.StrokeMatrix := penStroker.StrokeMatrix; + + result.shadowOffsetX := shadowOffsetX; + result.shadowOffsetY := shadowOffsetY; + result.shadowBlur := shadowBlur; + result.shadowColor := shadowColor; + result.shadowFastest := shadowFastest; +end; + +destructor TBGRACanvasState2D.Destroy; +begin + if FClipMaskOwned and Assigned(FClipMask) then + FClipMask.Free; + penStroker.Free; + inherited Destroy; +end; + +procedure TBGRACanvasState2D.transform(AMatrix: TAffineMatrix); +begin + matrix := matrix*AMatrix; +end; + +procedure TBGRACanvasState2D.SetClipMask(AClipMask: TGrayscaleMask; + AOwned: boolean); +begin + if FClipMaskOwned and Assigned(FClipMask) then FreeAndNil(FClipMask); + FClipMask := AClipMask; + FClipMaskOwned := AOwned; +end; + +{ TBGRACanvas2D } + +function TBGRACanvas2D.GetHeight: Integer; +begin + if Assigned(surface) then + result := Surface.Height + else + result := 0; +end; + +function TBGRACanvas2D.GetLineCap: string; +begin + case currentState.penStroker.LineCap of + pecRound: result := 'round'; + pecSquare: result := 'square'; + else result := 'butt'; + end; +end; + +function TBGRACanvas2D.GetLineCapLCL: TPenEndCap; +begin + result := currentState.penStroker.LineCap; +end; + +function TBGRACanvas2D.GetlineJoin: string; +begin + case currentState.penStroker.JoinStyle of + pjsBevel: result := 'bevel'; + pjsRound: result := 'round'; + else result := 'miter'; + end; +end; + +function TBGRACanvas2D.GetlineJoinLCL: TPenJoinStyle; +begin + result := currentState.penStroker.JoinStyle; +end; + +function TBGRACanvas2D.getLineStyle: TBGRAPenStyle; +begin + result := DuplicatePenStyle(currentState.penStroker.CustomPenStyle); +end; + +function TBGRACanvas2D.GetLineWidth: single; +begin + result := currentState.lineWidth; +end; + +function TBGRACanvas2D.GetMatrix: TAffineMatrix; +begin + result := currentState.matrix; +end; + +function TBGRACanvas2D.GetMiterLimit: single; +begin + result := currentState.penStroker.MiterLimit; +end; + +function TBGRACanvas2D.GetPixelCenteredCoordinates: boolean; +begin + result := FPixelCenteredCoordinates; +end; + +function TBGRACanvas2D.GetShadowBlur: single; +begin + result := currentState.shadowBlur; +end; + +function TBGRACanvas2D.GetShadowFastest: boolean; +begin + result := currentState.shadowFastest; +end; + +function TBGRACanvas2D.GetShadowOffset: TPointF; +begin + result := PointF(shadowOffsetX,shadowOffsetY); +end; + +function TBGRACanvas2D.GetShadowOffsetX: single; +begin + result := currentState.shadowOffsetX; +end; + +function TBGRACanvas2D.GetShadowOffsetY: single; +begin + result := currentState.shadowOffsetY; +end; + +function TBGRACanvas2D.GetStrokeMatrix: TAffineMatrix; +begin + result := currentState.penStroker.StrokeMatrix; +end; + +function TBGRACanvas2D.GetTextAlign: string; +begin + case currentState.textAlign of + taRightJustify: result := 'right'; + taCenter: result := 'center'; + else + result := 'left'; + end; +end; + +function TBGRACanvas2D.GetTextAlignLCL: TAlignment; +begin + result := currentState.textAlign; +end; + +function TBGRACanvas2D.GetTextBaseline: string; +begin + result := currentState.textBaseline; +end; + +function TBGRACanvas2D.GetGlobalAlpha: single; +begin + result := currentState.globalAlpha/255; +end; + +function TBGRACanvas2D.GetCurrentPathAsPoints: ArrayOfTPointF; +var i: integer; +begin + setlength(result, FPathPointCount); + for i := 0 to high(result) do + result[i] := FPathPoints[i]; +end; + +function TBGRACanvas2D.GetTextDirection: TFontBidiMode; +begin + result := currentState.textDirection; +end; + +function TBGRACanvas2D.GetFontName: string; +begin + result := currentState.fontName; +end; + +function TBGRACanvas2D.GetFontRenderer: TBGRACustomFontRenderer; +var zoom1,zoom2,zoom: single; +begin + if FFontRenderer = nil then + begin + if FSurface <> nil then + result := FSurface.FontRenderer + else + result := nil; + end else + result := FFontRenderer; + if Assigned(result) then + begin + result.FontName := CSSFontNameToLCL(currentState.fontName); + result.FontStyle := currentState.fontStyle; + if antialiasing then + result.FontQuality:= fqFineAntialiasing + else + result.FontQuality := fqSystem; + result.FontOrientation := 0; + zoom1 := VectLen(currentState.matrix[1,1],currentState.matrix[2,1]); + zoom2 := VectLen(currentState.matrix[1,2],currentState.matrix[2,2]); + if zoom1>zoom2 then zoom := zoom1 else zoom := zoom2; + result.FontEmHeight := round(currentState.fontEmHeight*zoom); + end; +end; + +function TBGRACanvas2D.GetFontEmHeight: single; +begin + result := currentState.fontEmHeight; +end; + +function TBGRACanvas2D.GetFontString: string; +var formats: TFormatSettings; +begin + formats := DefaultFormatSettings; + formats.DecimalSeparator := '.'; + + result := ''; + if fsItalic in currentState.fontStyle then + AppendStr(result, 'italic '); + if fsBold in currentState.fontStyle then + AppendStr(result, 'bold '); + AppendStr(result, FloatToStrF(currentState.fontEmHeight,ffGeneral,6,0,formats)+'px '); + AppendStr(result, currentState.fontName); + result := trim(result); +end; + +function TBGRACanvas2D.GetFontStyle: TFontStyles; +begin + result := currentState.fontStyle; +end; + +function TBGRACanvas2D.GetHasShadow: boolean; +begin + result := (ApplyGlobalAlpha(currentState.shadowColor).alpha <> 0) and + ( (currentState.shadowBlur <> 0) or (currentState.shadowOffsetX <> 0) + or (currentState.shadowOffsetY <> 0) ); +end; + +function TBGRACanvas2D.GetWidth: Integer; +begin + if Assigned(Surface) then + result := Surface.Width + else + result := 0; +end; + +procedure TBGRACanvas2D.SetTextDirection(AValue: TFontBidiMode); +begin + currentState.textDirection := AValue; +end; + +procedure TBGRACanvas2D.SetFontName(AValue: string); +var + list: ArrayOfString; + i: Integer; +begin + list := StrToFontNameList(AValue); + for i := 0 to high(list) do + begin + if (list[i] = 'serif') or (list[i] = 'sans-serif') or (list[i] = 'monospace') + or (list[i] = 'cursive') or (list[i] = 'fantasy') then + begin + currentState.fontName:= list[i]; + exit; + end else + if Assigned(fontRenderer) and fontRenderer.FontExists(list[i]) then + begin + currentState.fontName := list[i]; + exit; + end; + end; + currentState.fontName := 'sans-serif'; +end; + +procedure TBGRACanvas2D.SetFontRenderer(AValue: TBGRACustomFontRenderer); +begin + if AValue = FFontRenderer then exit; + FreeAndNil(FFontRenderer); + FFontRenderer := AValue; +end; + +procedure TBGRACanvas2D.SetFontEmHeight(AValue: single); +begin + currentState.fontEmHeight := AValue; +end; + +procedure TBGRACanvas2D.SetFontString(AValue: string); +var idxSpace,errPos: integer; + attrib,u: string; + value: single; +begin + currentState.fontStyle := []; + currentState.fontEmHeight := 10; + currentState.fontName := 'sans-serif'; + AValue := trim(AValue); + while AValue <> '' do + begin + while (AValue <> '') and (AValue[1]in [#0..#32]) do delete(AValue,1,1); + idxSpace := pos(' ',AValue); + if idxSpace = 0 then + attrib := AValue + else + attrib := copy(AValue,1,idxSpace-1); + attrib := lowerCase(attrib); + if attrib = '' then break; + if (attrib = 'normal') or (attrib = 'small-caps') or (attrib = 'lighter') then + begin + //nothing + end else + if (attrib = 'italic') or (attrib = 'oblique') then + begin + include(currentState.fontStyle, fsItalic); + end else + if (attrib = 'bold') or (attrib = 'bolder') then + begin + include(currentState.fontStyle, fsBold); + end else + if (attrib[1] in ['.','0'..'9']) then + begin + u := ''; + while (length(attrib)>0) and (attrib[length(attrib)] in['a'..'z']) do + begin + u := attrib[length(attrib)]+u; + delete(attrib,length(attrib),1); + end; + val(attrib,value,errPos); + if errPos = 0 then + begin + if u = '' then //weight + begin + if value >= 600 then include(currentState.fontStyle, fsBold); + end else + if u = 'px' then currentState.fontEmHeight := value else + if u = 'pt' then currentState.fontEmHeight:= value/72*96 else + if u = 'in' then currentState.fontEmHeight:= value*96 else + if u = 'mm' then currentState.fontEmHeight:= value/25.4*96 else + if u = 'cm' then currentState.fontEmHeight:= value/2.54*96; + end; + end else + break; + delete(AValue,1,length(attrib)+1); + end; + AValue := trim(AValue); + if AValue <> '' then currentState.fontName := AValue; +end; + +procedure TBGRACanvas2D.SetFontStyle(AValue: TFontStyles); +begin + currentState.fontStyle:= AValue; +end; + +procedure TBGRACanvas2D.SetGlobalAlpha(const AValue: single); +begin + if AValue < 0 then currentState.globalAlpha:= 0 else + if AValue > 1 then currentState.globalAlpha:= 255 else + currentState.globalAlpha:= round(AValue*255); +end; + +procedure TBGRACanvas2D.SetLineCap(const AValue: string); +begin + if CompareText(AValue,'round')=0 then + currentState.penStroker.LineCap := pecRound else + if CompareText(AValue,'square')=0 then + currentState.penStroker.LineCap := pecSquare + else + currentState.penStroker.LineCap := pecFlat; +end; + +procedure TBGRACanvas2D.SetLineCapLCL(AValue: TPenEndCap); +begin + currentState.penStroker.LineCap := AValue; +end; + +procedure TBGRACanvas2D.SetLineJoin(const AValue: string); +begin + if CompareText(AValue,'round')=0 then + currentState.penStroker.JoinStyle := pjsRound else + if CompareText(AValue,'bevel')=0 then + currentState.penStroker.JoinStyle := pjsBevel + else + currentState.penStroker.JoinStyle := pjsMiter; +end; + +procedure TBGRACanvas2D.FillPoly(const points: array of TPointF); +var + bfill: boolean; + tempScan: TBGRACustomScanner; +begin + if (length(points) = 0) or (surface = nil) then exit; + If hasShadow then DrawShadow(points,[],fillMode); + bfill:= currentState.fillMode = fmWinding; + if currentState.clipMaskReadOnly <> nil then + begin + if currentState.fillTextureProvider <> nil then + tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) + else + tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); + if self.antialiasing then + BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, bfill, linearBlend) + else + BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, bfill, GetDrawMode); + tempScan.free; + end else + begin + if currentState.fillTextureProvider <> nil then + begin + if currentState.globalAlpha <> 255 then + begin + tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); + if self.antialiasing then + BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, bfill, linearBlend) + else + BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, bfill, GetDrawMode); + tempScan.Free; + end else + begin + if self.antialiasing then + BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, bfill, linearBlend) + else + BGRAPolygon.FillPolyAliasedWithTexture(surface, points, currentState.fillTextureProvider.texture, bfill, GetDrawMode); + end + end + else + begin + if self.antialiasing then + BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, bfill, linearBlend) + else + BGRAPolygon.FillPolyAliased(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, bfill, GetDrawMode) + end + end; +end; + +procedure TBGRACanvas2D.FillStrokePoly(const points: array of TPointF; + fillOver: boolean); +var + tempScan,tempScan2: TBGRACustomScanner; + multi: TBGRAMultishapeFiller; + contour : array of TPointF; + texture: IBGRAScanner; + idxContour: Integer; +begin + if (length(points) = 0) or (surface = nil) then exit; + tempScan := nil; + tempScan2 := nil; + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := self.fillMode; + if currentState.clipMaskReadOnly <> nil then + begin + if currentState.fillTextureProvider <> nil then + tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) + else + tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); + multi.AddPolygon(points, tempScan); + end else + begin + if currentState.fillTextureProvider <> nil then + begin + if currentState.globalAlpha <> 255 then + begin + tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); + multi.AddPolygon(points, tempScan); + end else + multi.AddPolygon(points, currentState.fillTextureProvider.texture) + end + else + multi.AddPolygon(points, ApplyGlobalAlpha(currentState.fillColor)); + end; + + if currentState.lineWidth > 0 then + begin + contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth); + + if currentState.clipMaskReadOnly <> nil then + begin + if currentState.strokeTextureProvider <> nil then + tempScan2 := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha) + else + tempScan2 := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor)); + idxContour := multi.AddPolygon(contour,tempScan); + end else + begin + if currentState.strokeTextureProvider <> nil then + texture := currentState.strokeTextureProvider.texture else + texture := nil; + if texture = nil then + idxContour := multi.AddPolygon(contour,ApplyGlobalAlpha(currentState.strokeColor)) + else + idxContour := multi.AddPolygon(contour,texture); + end; + multi.OverrideFillMode(idxContour, fmWinding); + If hasShadow then DrawShadow(points,contour); + end else + If hasShadow then DrawShadow(points,[]); + + if fillOver then multi.PolygonOrder := poFirstOnTop else multi.PolygonOrder:= poLastOnTop; + multi.Antialiasing := self.antialiasing; + multi.Draw(surface); + tempScan.free; + tempScan2.free; + multi.Free; +end; + +procedure TBGRACanvas2D.FillTexts(AErase: boolean); +var + i,j: Integer; + hy,hx,h: single; + bmp,bmpTransf: TBGRACustomBitmap; + tempScan: TBGRACustomScanner; + m: TAffineMatrix; + s: TSize; + sourceBounds, usedSourceBounds, surfaceBounds, shadowBounds: TRect; + rf: TResampleFilter; + pad: TSize; + p: PBGRAPixel; +begin + for i := 0 to High(FTextPaths) do + with FTextPaths[i] do + begin + hx := VectLen(FontMatrix[1,1],FontMatrix[2,1]); + hy := VectLen(FontMatrix[1,2],FontMatrix[2,2]); + h := max(hx,hy); + if self.antialiasing then h := round(h); + if h<=0 then continue; + m := FontMatrix*AffineMatrixScale(1/h, 1/h); + if pixelCenteredCoordinates then m := AffineMatrixTranslation(0.5,0.5)*m; + bmp := BGRABitmapFactory.Create; + try + bmp.FontName := CSSFontNameToLCL(FontName); + bmp.FontStyle:= FontStyle; + bmp.FontHeight:= round(h); + bmp.FontBidiMode:= TextDirection; + if self.antialiasing then + bmp.FontQuality := fqFineAntialiasing + else + bmp.FontQuality:= fqSystem; + + bmp.FontVerticalAnchor:= FontAnchor; + m := m*AffineMatrixTranslation(0,-bmp.FontVerticalAnchorOffset); + bmp.FontVerticalAnchor:= fvaTop; + + s := bmp.TextSize(Text); + case FontAlign of + taCenter: m := m*AffineMatrixTranslation(-s.cx/2,0); + taRightJustify: m := m*AffineMatrixTranslation(-s.cx,0); + end; + + pad := Size(round(h/3), round(h/3)); + m := m*AffineMatrixTranslation(-pad.cx,-pad.cy); + sourceBounds := BGRAClasses.Rect(0,0,s.cx+pad.cx*2,s.cy+pad.cy*2); + surfaceBounds := surface.GetImageAffineBounds(m, sourceBounds); + if hasShadow then + begin + shadowBounds := surfaceBounds; + shadowBounds.Inflate(ceil(shadowBlur),ceil(shadowBlur)); + shadowBounds.Offset(round(shadowOffsetX),round(shadowOffsetY)); + shadowBounds.Intersect(surface.ClipRect); + if not shadowBounds.IsEmpty then + begin + shadowBounds.Offset(-round(shadowOffsetX),-round(shadowOffsetY)); + surfaceBounds.Union(shadowBounds); + end; + end; + if not surfaceBounds.IsEmpty and IsAffineMatrixInversible(m) then + begin + usedSourceBounds := (AffineMatrixInverse(m) * + TAffineBox.AffineBox(RectF(surfaceBounds))).RectBounds; + usedSourceBounds.Inflate(1,1); + sourceBounds.Intersect(usedSourceBounds); + m := m * AffineMatrixTranslation(sourceBounds.Left, sourceBounds.Top); + bmp.SetSize(sourceBounds.Width, sourceBounds.Height); + bmp.Fill(BGRABlack); + bmp.TextOut(pad.cx - sourceBounds.Left,pad.cy - sourceBounds.Top, Text, BGRAWhite); + if self.antialiasing then bmp.ConvertToLinearRGB else + begin + p := bmp.Data; + for j := bmp.NbPixels-1 downto 0 do + begin + if p^.green<128 then p^ := BGRABlack else p^ := BGRAWhite; + inc(p); + end; + end; + + bmpTransf := BGRABitmapFactory.Create(surfaceBounds.Width,surfaceBounds.Height,BGRABlack); + try + m := AffineMatrixTranslation(-surfaceBounds.Left-0.5,-surfaceBounds.Top-0.5)*m; + if self.antialiasing then rf:= rfCosine else rf := rfBox; + bmpTransf.PutImageAffine(m, bmp, rf, GetDrawMode); + FreeAndNil(bmp); + + if AErase then + surface.EraseMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf) else + begin + if hasShadow then + DrawShadowMask(surfaceBounds.Left+round(shadowOffsetX),surfaceBounds.Top+round(shadowOffsetY), bmpTransf, false); + + if currentState.clipMaskReadOnly <> nil then + begin + if currentState.fillTextureProvider <> nil then + tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) + else + tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); + surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, tempScan, GetDrawMode); + tempScan.free; + end else + begin + if currentState.fillTextureProvider <> nil then + begin + if currentState.globalAlpha <> 255 then + begin + tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); + surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, tempScan, GetDrawMode); + tempScan.Free; + end else + surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, currentState.fillTextureProvider.texture, GetDrawMode); + end + else + surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, ApplyGlobalAlpha(currentState.fillColor), GetDrawMode); + end; + end; + finally + bmpTransf.Free; + end; + end; + finally + bmp.Free; + end; + end; +end; + +procedure TBGRACanvas2D.SetLineJoinLCL(AValue: TPenJoinStyle); +begin + currentState.penStroker.JoinStyle := AValue; +end; + +procedure TBGRACanvas2D.lineStyle(const AValue: array of single); +var a: array of single; + i: Integer; +begin + if odd(length(AValue)) then + begin + setlength(a, length(AValue)*2); + for i := 0 to high(AValue) do + begin + a[i] := AValue[i]; + a[i + length(AValue)] := AValue[i]; + end; + end else + a := DuplicatePenStyle(AValue); + currentState.penStroker.CustomPenStyle := a; +end; + +procedure TBGRACanvas2D.lineStyle(AStyle: TPenStyle); +begin + if AStyle = psPattern then exit; + lineStyle(PenStyleToBGRA(AStyle)); +end; + +class function TBGRACanvas2D.StrToFontNameList(AText: string): ArrayOfString; +var + list: TStringList; + inQuote: Char; + nameStart, i: Integer; + + procedure SkipSpace; + begin + while (i < length(AText)) and (AText[i] in [#0..#32]) do inc(i); + end; + + procedure SkipComma; + begin + SkipSpace; + if (i < length(AText)) and (AText[i] = ',') then inc(i); + SkipSpace; + end; + +begin + list := TStringList.Create; + inQuote := ' '; + i := 1; + SkipSpace; + nameStart := -1; + while i <= length(AText) do + begin + if inQuote <> ' ' then + begin + if AText[i] = inQuote then + begin + list.Add(copy(AText, nameStart, i-nameStart)); + inQuote := ' '; + inc(i); + SkipComma; + nameStart := -1; + end else + inc(i); + end else + if nameStart = -1 then + begin + if AText[i] in ['''', '"'] then + begin + nameStart := i+1; + inQuote := AText[i]; + inc(i); + end else + begin + nameStart := i; + inc(i); + end; + end else + if AText[i] = ',' then + begin + list.Add(Trim(copy(AText, nameStart, i-nameStart))); + inc(i); + SkipComma; + nameStart := -1; + end else + inc(i); + end; + if nameStart <> -1 then list.Add(copy(AText, nameStart, length(AText)-nameStart+1)); + setlength(result, list.Count); + for i := 0 to list.Count-1 do + result[i] := list[i]; + list.Free; +end; + +class function TBGRACanvas2D.FontNameListToStr(AList: ArrayOfString): string; +var + i: Integer; +begin + result := ''; + for i := 0 to high(AList) do + begin + if i > 0 then AppendStr(result, ', '); + if pos(' ',AList[i]) <> -1 then + AppendStr(result, '''' + StringReplace(AList[i], '''', ''', [rfReplaceAll]) + '''') + else AppendStr(result, AList[i]); + end; +end; + +class function TBGRACanvas2D.CSSFontNameToLCL(AName: string): string; +begin + if AName = 'sans-serif' then result := 'sans' + else if AName = 'cursive' then result := {$IFDEF WINDOWS}'Segoe Script'{$ELSE} + {$IFDEF LINUX}'Z003'{$ELSE} + {$IFDEF DARWIN}'Brush Script MT'{$ELSE} + 'sans' + {$ENDIF}{$ENDIF}{$ENDIF} + else if AName = 'fantasy' then result := {$IFDEF WINDOWS}'Comic Sans MS'{$ELSE} + {$IFDEF DARWIN}'Papyrus'{$ELSE} + 'sans' + {$ENDIF}{$ENDIF} + else result := StringReplace(StringReplace(AName, ''', '''', [rfReplaceAll]), + ''', '''', [rfReplaceAll]); +end; + +function TBGRACanvas2D.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + if GetInterface(iid, obj) then + Result := S_OK + else + Result := longint(E_NOINTERFACE); +end; + +{ There is no automatic reference counting, but it is compulsory to define these functions } +function TBGRACanvas2D._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +function TBGRACanvas2D._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +procedure TBGRACanvas2D.SetLineWidth(const AValue: single); +begin + currentState.lineWidth := AValue; +end; + +procedure TBGRACanvas2D.SetMatrix(AValue: TAffineMatrix); +begin + currentState.matrix := AValue; +end; + +procedure TBGRACanvas2D.SetMiterLimit(const AValue: single); +begin + currentState.penStroker.MiterLimit := AValue; +end; + +procedure TBGRACanvas2D.SetPixelCenteredCoordinates(const AValue: boolean); +begin + FPixelCenteredCoordinates:= AValue; + if AValue then + FCanvasOffset := PointF(0,0) + else + FCanvasOffset := PointF(-0.5,-0.5); +end; + +procedure TBGRACanvas2D.SetShadowBlur(const AValue: single); +begin + currentState.shadowBlur := AValue; +end; + +procedure TBGRACanvas2D.SetShadowFastest(AValue: boolean); +begin + currentState.shadowFastest := AValue; +end; + +procedure TBGRACanvas2D.SetShadowOffset(const AValue: TPointF); +begin + shadowOffsetX := AValue.X; + shadowOffsetY := AValue.Y; +end; + +procedure TBGRACanvas2D.SetShadowOffsetX(const AValue: single); +begin + currentState.shadowOffsetX := AValue; +end; + +procedure TBGRACanvas2D.SetShadowOffsetY(const AValue: single); +begin + currentState.shadowOffsetY := AValue; +end; + +procedure TBGRACanvas2D.SetStrokeMatrix(AValue: TAffineMatrix); +begin + currentState.penStroker.strokeMatrix := AValue; +end; + +procedure TBGRACanvas2D.SetTextAlign(AValue: string); +begin + AValue := trim(LowerCase(AValue)); + if (AValue = 'left') or (AValue = 'start') then + textAlignLCL := taLeftJustify else + if (AValue = 'right') or (AValue = 'end') then + textAlignLCL := taRightJustify else + if AValue = 'center' then + textAlignLCL := taCenter; +end; + +procedure TBGRACanvas2D.SetTextAlignLCL(AValue: TAlignment); +begin + currentState.textAlign := AValue; +end; + +procedure TBGRACanvas2D.SetTextBaseline(AValue: string); +begin + currentState.textBaseline := trim(lowercase(AValue)); +end; + +procedure TBGRACanvas2D.StrokePoly(const points: array of TPointF); +var + texture: IBGRAScanner; + tempScan: TBGRACustomScanner; + contour: array of TPointF; +begin + if (length(points)= 0) or (currentState.lineWidth = 0) or (surface = nil) then exit; + contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth); + + If hasShadow then DrawShadow(contour,[]); + if currentState.clipMaskReadOnly <> nil then + begin + if currentState.strokeTextureProvider <> nil then + tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha) + else + tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor)); + if self.antialiasing then + BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True, linearBlend) + else + BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,tempScan,True,GetDrawMode); + tempScan.free; + end else + begin + if currentState.strokeTextureProvider <> nil then + texture := currentState.strokeTextureProvider.texture else + texture := nil; + if texture = nil then + begin + if self.antialiasing then + BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True, linearBlend) + else + BGRAPolygon.FillPolyAliased(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True,GetDrawMode) + end + else + begin + if self.antialiasing then + BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True, linearBlend) + else + BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,texture,True,GetDrawMode) + end; + end; +end; + +procedure TBGRACanvas2D.DrawShadow(const points, points2: array of TPointF; + AFillMode: TFillMode = fmWinding); +var ofsPts,ofsPts2: array of TPointF; + offset: TPointF; + i: Integer; + tempBmp: TGrayscaleMask; + maxRect: TRect; + foundRect: TRect; + firstFound: boolean; + + procedure AddPt(const coord: TPointF); + var pixRect: TRect; + begin + if isEmptyPointF(coord) then exit; + pixRect := BGRAClasses.Rect(round(floor(coord.x)),round(floor(coord.y)),round(ceil(coord.x+0.999))+1,round(ceil(coord.y+0.999))+1); + if firstFound then + begin + foundRect := pixRect; + firstFound := false + end + else + begin + if pixRect.left < foundRect.left then foundRect.left := pixRect.Left; + if pixRect.top < foundRect.top then foundRect.top := pixRect.top; + if pixRect.right > foundRect.right then foundRect.right := pixRect.right; + if pixRect.bottom > foundRect.bottom then foundRect.bottom := pixRect.bottom; + end; + end; + +begin + if not hasShadow or (surface = nil) then exit; + offset := PointF(shadowOffsetX,shadowOffsetY); + setlength(ofsPts, length(points)); + for i := 0 to high(ofsPts) do + ofsPts[i] := points[i]+offset; + setlength(ofsPts2, length(points2)); + for i := 0 to high(ofsPts2) do + ofsPts2[i] := points2[i]+offset; + + maxRect := BGRAClasses.Rect(0,0,width,height); + if currentState.clipMaskReadOnly <> nil then + foundRect := maxRect + else + begin + firstFound := true; + foundRect := EmptyRect; + for i := 0 to high(ofsPts) do + AddPt(ofsPts[i]); + for i := 0 to high(ofsPts2) do + AddPt(ofsPts2[i]); + if firstFound then exit; + foundRect.Inflate(ceil(shadowBlur), ceil(shadowBlur)); + foundRect.Intersect(maxRect); + if foundRect.IsEmpty then exit; + offset := PointF(-foundRect.Left,-foundRect.Top); + for i := 0 to high(ofsPts) do + ofsPts[i].Offset(offset); + for i := 0 to high(ofsPts2) do + ofsPts2[i].Offset(offset); + end; + + tempBmp := TGrayscaleMask.Create(foundRect.Right-foundRect.Left,foundRect.Bottom-foundRect.Top,BGRABlack); + tempBmp.FillMode := AFillMode; + tempBmp.FillPolyAntialias(ofsPts, BGRAWhite); + tempBmp.FillPolyAntialias(ofsPts2, BGRAWhite); + DrawShadowMask(foundRect.Left,foundRect.Top, tempBmp, true); +end; + +procedure TBGRACanvas2D.DrawShadowMask(X, Y: integer; AMask: TCustomUniversalBitmap; AMaskOwned: boolean); +const invSqrt2 = 1/sqrt(2); +var + bmp: TCustomUniversalBitmap; + gs: TGrayscaleMask; +begin + if AMask.Colorspace <> TByteMaskColorspace then + begin + gs := TGrayscaleMask.Create(AMask as TBGRACustomBitmap, cGreen); + if AMaskOwned then AMask.Free; + AMask := gs; + AMaskOwned:= true; + end; + bmp := AMask; + if shadowBlur > 0 then + begin + if shadowFastest then + begin + if shadowBlur*invSqrt2 >= 0.5 then + bmp := AMask.FilterBlurRadial(round(shadowBlur*invSqrt2),rbBox); + end + else + begin + if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then + bmp := AMask.FilterBlurRadial(round(shadowBlur*10),rbPrecise) + else + bmp := AMask.FilterBlurRadial(round(shadowBlur),rbFast); + end; + end; + if currentState.clipMaskReadOnly <> nil then + begin + if (bmp = AMask) and not AMaskOwned then bmp := AMask.Duplicate; + bmp.ApplyMask(currentState.clipMaskReadOnly); + end; + surface.FillMask(X,Y,bmp,ApplyGlobalAlpha(getShadowColor),GetDrawMode); + if bmp <> AMask then bmp.Free; + if AMaskOwned then AMask.Free; +end; + +procedure TBGRACanvas2D.ClearPoly(const points: array of TPointF); +begin + if surface = nil then exit; + if self.antialiasing then + BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true, linearBlend) + else + BGRAPolygon.FillPolyAliased(surface, points, BGRA(0,0,0,255), true, true, dmSet); +end; + +function TBGRACanvas2D.ApplyTransform(const points: array of TPointF; + matrix: TAffineMatrix): ArrayOfTPointF; +var + i: Integer; +begin + setlength(result,length(points)); + for i := 0 to high(result) do + if isEmptyPointF(points[i]) then + result[i] := EmptyPointF + else + result[i] := matrix*points[i]+FCanvasOffset; +end; + +function TBGRACanvas2D.ApplyTransform(const points: array of TPointF + ): ArrayOfTPointF; +var + i: Integer; +begin + setlength(result,length(points)); + for i := 0 to high(result) do + if isEmptyPointF(points[i]) then + result[i] := EmptyPointF + else + result[i] := currentState.matrix*points[i]+FCanvasOffset; +end; + +function TBGRACanvas2D.ApplyTransform(point: TPointF): TPointF; +begin + result := currentState.matrix*point+FCanvasOffset; +end; + +function TBGRACanvas2D.GetPenPos(defaultX,defaultY: single): TPointF; +begin + if isEmptyPointF(FLastCoord) then + result := PointF(defaultX,defaultY) + else + result := FLastCoord; +end; + +function TBGRACanvas2D.GetPenPos(defaultPt: TPointF): TPointF; +begin + result := GetPenPos(defaultPt.x,defaultPt.y); +end; + +procedure TBGRACanvas2D.AddPoint(point: TPointF); +begin + if FPathPointCount = length(FPathPoints) then + setlength(FPathPoints, (length(FPathPoints)+1)*2); + FPathPoints[FPathPointCount] := point; + inc(FPathPointCount); +end; + +procedure TBGRACanvas2D.AddPoints(const points: array of TPointF); +var i: integer; +begin + if FPathPointCount+length(points) > length(FPathPoints) then + setlength(FPathPoints, max( (length(FPathPoints)+1)*2, FPathPointCount+length(points) ) ); + for i := 0 to high(points) do + begin + FPathPoints[FPathPointCount] := points[i]; + inc(FPathPointCount); + end; +end; + +procedure TBGRACanvas2D.AddPointsRev(const points: array of TPointF); +var i: integer; +begin + if FPathPointCount+length(points) > length(FPathPoints) then + setlength(FPathPoints, max( (length(FPathPoints)+1)*2, FPathPointCount+length(points) ) ); + for i := high(points) downto 0 do + begin + FPathPoints[FPathPointCount] := points[i]; + inc(FPathPointCount); + end; +end; + +function TBGRACanvas2D.ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel; +begin + result := BGRA(color.red,color.green,color.blue,ApplyOpacity(color.alpha, currentState.globalAlpha)); +end; + +function TBGRACanvas2D.GetDrawMode: TDrawMode; +begin + if linearBlend then result := dmLinearBlend else result := dmDrawWithTransparency; +end; + +procedure TBGRACanvas2D.copyTo(dest: IBGRAPath); +begin + //nothing +end; + +function TBGRACanvas2D.getPoints: ArrayOfTPointF; +begin + result := GetCurrentPathAsPoints; +end; + +function TBGRACanvas2D.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; +begin + result := GetCurrentPathAsPoints; + if not IsAffineMatrixIdentity(AMatrix) then + result := AMatrix*result; +end; + +function TBGRACanvas2D.getCursor: TBGRACustomPathCursor; +begin + result := nil; +end; + +constructor TBGRACanvas2D.Create(ASurface: TBGRACustomBitmap); +begin + FSurface := ASurface; + StateStack := TList.Create; + FPathPointCount := 0; + FLastCoord := EmptyPointF; + FStartCoord := EmptyPointF; + currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil,true); + pixelCenteredCoordinates := false; + antialiasing := true; + gradientGammaCorrection := false; +end; + +destructor TBGRACanvas2D.Destroy; +var + i: Integer; +begin + for i := 0 to StateStack.Count-1 do + TObject(StateStack[i]).Free; + StateStack.Free; + currentState.Free; + FreeAndNil(FFontRenderer); + inherited Destroy; +end; + +function TBGRACanvas2D.toDataURL(mimeType: string): string; +var + stream: TMemoryStream; + jpegWriter: TFPWriterJPEG; + bmpWriter: TFPWriterBMP; + output: TStringStream; + encode64: TBase64EncodingStream; +begin + if surface = nil then exit(''); + stream := TMemoryStream.Create; + if mimeType='image/jpeg' then + begin + jpegWriter := TFPWriterJPEG.Create; + Surface.SaveToStream(stream,jpegWriter); + jpegWriter.Free; + end else + if mimeType='image/bmp' then + begin + bmpWriter := TFPWriterBMP.Create; + Surface.SaveToStream(stream,bmpWriter); + bmpWriter.Free; + end else + begin + mimeType := 'image/png'; + Surface.SaveToStreamAsPng(stream); + end; + output := TStringStream.Create('data:'+mimeType+';base64,'); + output.Position := output.size; + stream.Position := 0; + encode64 := TBase64EncodingStream.Create(output); + encode64.CopyFrom(stream,stream.size); + encode64.free; + stream.free; + result := output.DataString; + output.free; +end; + +procedure TBGRACanvas2D.save; +var cur: TBGRACanvasState2D; +begin + cur := currentState.Duplicate; + StateStack.Add(cur); +end; + +procedure TBGRACanvas2D.restore; +begin + if StateStack.Count > 0 then + begin + FreeAndNil(currentState); + currentState := TBGRACanvasState2D(StateStack[StateStack.Count-1]); + StateStack.Delete(StateStack.Count-1); + end; +end; + +procedure TBGRACanvas2D.scale(x, y: single); +begin + currentState.transform(AffineMatrixScale(x,y)); +end; + +procedure TBGRACanvas2D.scale(factor: single); +begin + currentState.transform( AffineMatrixScale(factor,factor) ); +end; + +procedure TBGRACanvas2D.rotate(angleRadCW: single); +begin + currentState.transform( AffineMatrixRotationRad(-angleRadCW) ); +end; + +procedure TBGRACanvas2D.translate(x, y: single); +begin + if (x = 0) and (y = 0) then exit; + currentState.transform( AffineMatrixTranslation(x,y) ); +end; + +procedure TBGRACanvas2D.skewx(angleRadCW: single); +begin + currentState.transform( AffineMatrixSkewXRad(-angleRadCW) ); +end; + +procedure TBGRACanvas2D.skewy(angleRadCW: single); +begin + currentState.transform( AffineMatrixSkewYRad(-angleRadCW) ); +end; + +procedure TBGRACanvas2D.transform(m11,m21, m12,m22, m13,m23: single); +begin + currentState.transform( AffineMatrix(m11,m12,m13, + m21,m22,m23) ); +end; + +procedure TBGRACanvas2D.transform(AMatrix: TAffineMatrix); +begin + currentState.transform( AMatrix ); +end; + +procedure TBGRACanvas2D.setTransform(m11,m21, m12,m22, m13,m23: single); +begin + currentState.matrix := AffineMatrix(m11,m12,m13, + m21,m22,m23); +end; + +procedure TBGRACanvas2D.resetTransform; +begin + currentState.matrix := AffineMatrixIdentity; +end; + +procedure TBGRACanvas2D.strokeScale(x, y: single); +begin + currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixScale(x,y); +end; + +procedure TBGRACanvas2D.strokeSkewx(angleRadCW: single); +begin + currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewXRad(-angleRadCW); +end; + +procedure TBGRACanvas2D.strokeSkewy(angleRadCW: single); +begin + currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewYRad(-angleRadCW); +end; + +procedure TBGRACanvas2D.strokeResetTransform; +begin + currentState.penStroker.strokeMatrix := AffineMatrixIdentity; +end; + +procedure TBGRACanvas2D.strokeStyle(color: TBGRAPixel); +begin + currentState.strokeColor := color; + currentState.strokeTextureProvider := nil; +end; + +procedure TBGRACanvas2D.strokeStyle(color: TColor); +begin + currentState.strokeColor := ColorToBGRA(color); + currentState.strokeTextureProvider := nil; +end; + +procedure TBGRACanvas2D.strokeStyle(color: string); +begin + currentState.strokeColor := StrToBGRA(color); + currentState.strokeTextureProvider := nil; +end; + +procedure TBGRACanvas2D.strokeStyle(texture: IBGRAScanner); +begin + strokeStyle(createPattern(texture)); +end; + +procedure TBGRACanvas2D.strokeStyle(provider: IBGRACanvasTextureProvider2D); +begin + currentState.strokeColor := BGRAPixelTransparent; + currentState.strokeTextureProvider := provider; +end; + +function TBGRACanvas2D.GetFillMode: TFillMode; +begin + result := currentState.fillMode; +end; + +procedure TBGRACanvas2D.SetFillMode(mode: TFillMode); +begin + currentState.fillMode := mode; +end; + +procedure TBGRACanvas2D.fillStyle(color: TBGRAPixel); +begin + currentState.fillColor := color; + currentState.fillTextureProvider := nil; +end; + +procedure TBGRACanvas2D.fillStyle(color: TColor); +begin + currentState.fillColor := ColorToBGRA(color); + currentState.fillTextureProvider := nil; +end; + +procedure TBGRACanvas2D.fillStyle(color: string); +begin + currentState.fillColor := StrToBGRA(color); + currentState.fillTextureProvider := nil; +end; + +procedure TBGRACanvas2D.fillStyle(texture: IBGRAScanner); +begin + fillStyle(createPattern(texture)); +end; + +procedure TBGRACanvas2D.fillStyle(provider: IBGRACanvasTextureProvider2D); +begin + currentState.fillColor := BGRAPixelTransparent; + currentState.fillTextureProvider := provider; +end; + +procedure TBGRACanvas2D.shadowColor(color: TBGRAPixel); +begin + currentState.shadowColor := color; +end; + +procedure TBGRACanvas2D.shadowColor(color: TColor); +begin + shadowColor(ColorToBGRA(color)); +end; + +procedure TBGRACanvas2D.shadowColor(color: string); +begin + shadowColor(StrToBGRA(color)); +end; + +procedure TBGRACanvas2D.shadowNone; +begin + shadowColor(BGRAPixelTransparent); +end; + +function TBGRACanvas2D.getShadowColor: TBGRAPixel; +begin + result := currentState.shadowColor; +end; + +function TBGRACanvas2D.createLinearGradient(x0, y0, x1, y1: single): IBGRACanvasGradient2D; +begin + result := createLinearGradient(PointF(x0,y0), PointF(x1,y1)); +end; + +function TBGRACanvas2D.createLinearGradient(p0, p1: TPointF): IBGRACanvasGradient2D; +begin + result := TBGRACanvasLinearGradient2D.Create(p0,p1, + AffineMatrixTranslation(FCanvasOffset.x,FCanvasOffset.y)*currentState.matrix); + result.gammaCorrection := gradientGammaCorrection; +end; + +function TBGRACanvas2D.createLinearGradient(x0, y0, x1, y1: single; + Colors: TBGRACustomGradient): IBGRACanvasGradient2D; +begin + result := createLinearGradient(x0,y0,x1,y1); + result.setColors(Colors); +end; + +function TBGRACanvas2D.createLinearGradient(p0, p1: TPointF; + Colors: TBGRACustomGradient): IBGRACanvasGradient2D; +begin + result := createLinearGradient(p0,p1); + result.setColors(Colors); +end; + +function TBGRACanvas2D.createRadialGradient(x0, y0, r0, x1, y1, r1: single; + flipGradient: boolean): IBGRACanvasGradient2D; +begin + result := createRadialGradient(PointF(x0,y0), r0, PointF(x1,y1), r1, flipGradient); +end; + +function TBGRACanvas2D.createRadialGradient(p0: TPointF; r0: single; + p1: TPointF; r1: single; flipGradient: boolean): IBGRACanvasGradient2D; +begin + result := TBGRACanvasRadialGradient2D.Create(p0,r0,p1,r1, + AffineMatrixTranslation(FCanvasOffset.x,FCanvasOffset.y)*currentState.matrix, + flipGradient); + result.gammaCorrection := gradientGammaCorrection; +end; + +function TBGRACanvas2D.createRadialGradient(x0, y0, r0, x1, y1, r1: single; + Colors: TBGRACustomGradient; flipGradient: boolean): IBGRACanvasGradient2D; +begin + result := createRadialGradient(x0,y0,r0,x1,y1,r1,flipGradient); + result.setColors(Colors); +end; + +function TBGRACanvas2D.createRadialGradient(p0: TPointF; r0: single; + p1: TPointF; r1: single; Colors: TBGRACustomGradient; flipGradient: boolean): IBGRACanvasGradient2D; +begin + result := createRadialGradient(p0,r0,p1,r1,flipGradient); + result.setColors(Colors); +end; + +function TBGRACanvas2D.createPattern(image: TBGRACustomBitmap; repetition: string + ): IBGRACanvasTextureProvider2D; +var + repeatX,repeatY: boolean; + origin: TPointF; +begin + repetition := lowercase(trim(repetition)); + repeatX := true; + repeatY := true; + if repetition = 'repeat-x' then repeatY := false else + if repetition = 'repeat-y' then repeatX := false else + if repetition = 'no-repeat' then + begin + repeatX := false; + repeatY := false; + end; + origin := ApplyTransform(PointF(0,0)); + result := TBGRACanvasPattern2D.Create(image,repeatX,repeatY, + origin, origin+PointF(currentState.matrix[1,1],currentState.matrix[2,1])*image.Width, + origin+PointF(currentState.matrix[1,2],currentState.matrix[2,2])*image.Height); +end; + +function TBGRACanvas2D.createPattern(texture: IBGRAScanner + ): IBGRACanvasTextureProvider2D; +var + tempTransform: TAffineMatrix; +begin + tempTransform := AffineMatrixTranslation(FCanvasOffset.X+0.5,FCanvasOffset.Y+0.5)*currentState.matrix; + result := TBGRACanvasPattern2D.Create(texture,tempTransform); +end; + +procedure TBGRACanvas2D.fillRect(x, y, w, h: single); +begin + if (w=0) or (h=0) then exit; + FillPoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h)])); +end; + +procedure TBGRACanvas2D.strokeRect(x, y, w, h: single); +begin + if (w=0) or (h=0) then exit; + StrokePoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h),PointF(x,y)])); +end; + +procedure TBGRACanvas2D.clearRect(x, y, w, h: single); +begin + if (w=0) or (h=0) then exit; + ClearPoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h)])); +end; + +procedure TBGRACanvas2D.addPath(APath: IBGRAPath); +begin + if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then + begin + AddPoint(EmptyPointF); + FLastCoord := EmptyPointF; + FStartCoord := EmptyPointF; + end; + APath.copyTo(self); +end; + +procedure TBGRACanvas2D.addPath(ASvgPath: string); +var p: TBGRAPath; +begin + p := TBGRAPath.Create(ASvgPath); + addPath(p); + p.Free; +end; + +procedure TBGRACanvas2D.path(APath: IBGRAPath); +begin + beginPath; + addPath(APath); +end; + +procedure TBGRACanvas2D.path(ASvgPath: string); +begin + beginPath; + addPath(ASvgPath); +end; + +procedure TBGRACanvas2D.beginPath; +begin + FPathPointCount := 0; + FLastCoord := EmptyPointF; + FStartCoord := EmptyPointF; + FTextPaths := nil; +end; + +procedure TBGRACanvas2D.closePath; +var i: integer; +begin + if FPathPointCount > 0 then + begin + i := FPathPointCount-1; + while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i); + AddPoint(FPathPoints[i]); + FLastCoord := FStartCoord; + end; +end; + +procedure TBGRACanvas2D.toSpline(closed: boolean; style: TSplineStyle); +var i,j: integer; + pts, splinePts: array of TPointF; + nb: integer; +begin + if FPathPointCount > 0 then + begin + i := FPathPointCount-1; + while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i); + nb := FPathPointCount - i; + setlength(pts,nb); + for j := 0 to nb-1 do + pts[j] := FPathPoints[i+j]; + if closed then + splinePts := BGRAPath.ComputeClosedSpline(pts,style) + else + splinePts := BGRAPath.ComputeOpenedSpline(pts,style); + dec(FPathPointCount,nb); + AddPoints(splinePts); + end; +end; + +procedure TBGRACanvas2D.moveTo(x, y: single); +begin + moveTo(PointF(x,y)); +end; + +procedure TBGRACanvas2D.lineTo(x, y: single); +begin + lineTo(PointF(x,y)); +end; + +procedure TBGRACanvas2D.moveTo(constref pt: TPointF); +begin + if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then + AddPoint(EmptyPointF); + AddPoint(ApplyTransform(pt)); + FStartCoord := pt; + FLastCoord := pt; +end; + +procedure TBGRACanvas2D.lineTo(constref pt: TPointF); +begin + AddPoint(ApplyTransform(pt)); + FLastCoord := pt; +end; + +procedure TBGRACanvas2D.polylineTo(const pts: array of TPointF); +begin + if length(pts)> 0 then + begin + AddPoints(ApplyTransform(pts)); + FLastCoord := pts[high(pts)]; + end; +end; + +procedure TBGRACanvas2D.quadraticCurveTo(cpx, cpy, x, y: single); +var + curve : TQuadraticBezierCurve; + pts : array of TPointF; +begin + curve := BezierCurve(ApplyTransform(GetPenPos(cpx,cpy)),ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y))); + pts := BGRAPath.ComputeBezierCurve(curve); + AddPoints(pts); + FLastCoord := PointF(x,y); +end; + +procedure TBGRACanvas2D.quadraticCurveTo(constref cp, pt: TPointF); +begin + quadraticCurveTo(cp.x,cp.y,pt.x,pt.y); +end; + +procedure TBGRACanvas2D.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single); +var + curve : TCubicBezierCurve; + pts : array of TPointF; +begin + curve := BezierCurve(ApplyTransform(GetPenPos(cp1x,cp1y)),ApplyTransform(PointF(cp1x,cp1y)), + ApplyTransform(PointF(cp2x,cp2y)),ApplyTransform(PointF(x,y))); + pts := BGRAPath.ComputeBezierCurve(curve); + AddPoints(pts); + FLastCoord := PointF(x,y); +end; + +procedure TBGRACanvas2D.bezierCurveTo(constref cp1, cp2, pt: TPointF); +begin + bezierCurveTo(cp1.x,cp1.y,cp2.x,cp2.y,pt.x,pt.y); +end; + +procedure TBGRACanvas2D.rect(x, y, w, h: single); +begin + MoveTo(x,y); + LineTo(x+w,y); + LineTo(x+w,y+h); + LineTo(x,y+h); + closePath; +end; + +procedure TBGRACanvas2D.roundRect(x, y, w, h, radius: single); +begin + if radius <= 0 then + begin + rect(x,y,w,h); + exit; + end; + if (w <= 0) or (h <= 0) then exit; + if radius*2 > w then radius := w/2; + if radius*2 > h then radius := h/2; + moveTo(x+radius,y); + arcTo(PointF(x+w,y),PointF(x+w,y+h), radius); + arcTo(PointF(x+w,y+h),PointF(x,y+h), radius); + arcTo(PointF(x,y+h),PointF(x,y), radius); + arcTo(PointF(x,y),PointF(x+w,y), radius); + closePath; +end; + +procedure TBGRACanvas2D.roundRect(x, y, w, h, rx, ry: single); +begin + if (w <= 0) or (h <= 0) then exit; + if rx < 0 then rx := 0; + if ry < 0 then ry := 0; + if (rx = 0) and (ry = 0) then + begin + rect(x,y,w,h); + exit; + end; + if rx*2 > w then rx := w/2; + if ry*2 > h then ry := h/2; + moveTo(x+rx,y); + lineTo(x+w-rx,y); + arcTo(rx,ry,0,false,false,x+w,y+ry); + lineTo(x+w,y+h-ry); + arcTo(rx,ry,0,false,false,x+w-rx,y+h); + lineTo(x+rx,y+h); + arcTo(rx,ry,0,false,false,x,y+h-ry); + lineTo(x,y+ry); + arcTo(rx,ry,0,false,false,x+rx,y); + closePath; +end; + +procedure TBGRACanvas2D.openedSpline(const pts: array of TPointF; + style: TSplineStyle); +var transf: array of TPointF; +begin + if length(pts)=0 then exit; + transf := ApplyTransform(pts); + transf := BGRAPath.ComputeOpenedSpline(transf,style); + AddPoints(transf); + FLastCoord := pts[high(pts)]; +end; + +procedure TBGRACanvas2D.closedSpline(const pts: array of TPointF; + style: TSplineStyle); +var transf: array of TPointF; +begin + if length(pts)=0 then exit; + transf := ApplyTransform(pts); + transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style); + AddPoints(transf); + FLastCoord := pts[high(pts)]; +end; + +procedure TBGRACanvas2D.spline(const pts: array of TPointF; style: TSplineStyle); +var transf: array of TPointF; +begin + if length(pts)=0 then exit; + transf := ApplyTransform(pts); + if (pts[0] = pts[high(pts)]) and (length(pts) > 1) then + transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style) + else + transf := BGRAPath.ComputeOpenedSpline(transf,style); + AddPoints(transf); + FLastCoord := pts[high(pts)]; +end; + +procedure TBGRACanvas2D.splineTo(const pts: array of TPointF; + style: TSplineStyle); +var transf: array of TPointF; + i: Integer; +begin + if length(pts) = 0 then exit; + transf := ApplyTransform(pts); + if FPathPointCount <> 0 then + begin + setlength(transf,length(transf)+1); + for i := high(transf) downto 1 do + transf[i]:= transf[i-1]; + transf[0] := ApplyTransform(GetPenPos(pts[0].x,pts[0].y)); + end; + transf := BGRAPath.ComputeOpenedSpline(transf,style); + AddPoints(transf); + FLastCoord := pts[high(pts)]; +end; + +procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; + anticlockwise: boolean); +var pts: array of TPointF; + temp: single; + pt: TPointF; + rx,ry: single; + len1,len2: single; + unitAffine: TAffineMatrix; + v1orig,v2orig,v1ortho,v2ortho: TPointF; + startRadCCW,endRadCCW: single; +begin + v1orig := PointF(currentState.matrix[1,1],currentState.matrix[2,1]); + v2orig := PointF(currentState.matrix[1,2],currentState.matrix[2,2]); + len1 := VectLen(v1orig); + len2 := VectLen(v2orig); + rx := len1*radius; + ry := len2*radius; + if len1 <> 0 then v1ortho := v1orig * (1/len1) else v1ortho := v1orig; + if len2 <> 0 then v2ortho := v2orig * (1/len2) else v2ortho := v2orig; + pt := currentState.matrix* PointF(x,y); + unitAffine := AffineMatrix(v1ortho.x, v2ortho.x, pt.x, + v1ortho.y, v2ortho.y, pt.y); + startRadCCW := -startAngleRadCW; + endRadCCW := -endAngleRadCW; + if not anticlockwise then + begin + temp := startRadCCW; + startRadCCW := endRadCCW; + endRadCCW:= temp; + pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); + pts := ApplyTransform(pts,unitAffine); + AddPointsRev(pts); + end else + begin + pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); + pts := ApplyTransform(pts,unitAffine); + AddPoints(pts); + end; + FLastCoord := ArcEndPoint(ArcDef(x,y,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise)); +end; + +procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); +begin + arc(x,y,radius,startAngleRadCW,endAngleRadCW,false); +end; + +procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; + anticlockwise: boolean); +begin + arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise)) +end; + +procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); +begin + arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false)) +end; + +procedure TBGRACanvas2D.arc(constref arcDef: TArcDef); +var previousMatrix: TAffineMatrix; +begin + if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then + lineTo(arcDef.center) else + begin + previousMatrix := currentState.matrix; + translate(arcDef.center.x,arcDef.center.y); + rotate(arcDef.xAngleRadCW); + scale(arcDef.radius.x,arcDef.radius.y); + arc(0,0,1,arcDef.startAngleRadCW,arcDef.endAngleRadCW,arcDef.anticlockwise); + currentState.matrix := previousMatrix; + FLastCoord := ArcEndPoint(arcDef); + end; +end; + +procedure TBGRACanvas2D.arcTo(x1, y1, x2, y2, radius: single); +var p0: TPointF; +begin + p0 := GetPenPos(x1,y1); + arc(Html5ArcTo(p0,PointF(x1,y1),PointF(x2,y2),radius)); +end; + +procedure TBGRACanvas2D.arcTo(p1, p2: TPointF; radius: single); +begin + arcTo(p1.x,p1.y,p2.x,p2.y,radius); +end; + +procedure TBGRACanvas2D.arcTo(rx, ry, xAngleRadCW: single; largeArc, + anticlockwise: boolean; x, y: single); +begin + arc(SvgArcTo(GetPenPos(x,y), rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y))); + FLastCoord := PointF(x,y); +end; + +procedure TBGRACanvas2D.circle(x, y, r: single); +begin + arc(x,y,r,0,0); +end; + +procedure TBGRACanvas2D.ellipse(x, y, rx, ry: single); +begin + arc(x,y,rx,ry,0,0,0); +end; + +procedure TBGRACanvas2D.text(AText: string; x, y: single); +var renderer : TBGRACustomFontRenderer; + previousMatrix: TAffineMatrix; + fva: TFontVerticalAnchor; +begin + renderer := fontRenderer; + if renderer = nil then exit; + if renderer.FontEmHeight <= 0 then exit; + + case currentState.textBaseline of + 'bottom': fva := fvaBottom; + 'middle': fva := fvaCenter; + 'alphabetic': fva := fvaBaseline; + else {'top','hanging'} + fva := fvaTop; + end; + + if renderer.HandlesTextPath then + begin + previousMatrix := currentState.matrix; + translate(x,y); + scale(currentState.fontEmHeight/renderer.FontEmHeight); + if fva <> fvaTop then + with renderer.GetFontPixelMetric do + case fva of + fvaBottom: translate(0,-Lineheight); + fvaCenter: translate(0,-Lineheight/2); + fvaBaseline: translate(0,-baseline); + end; + if direction=fbmAuto then + renderer.CopyTextPathTo(self, 0,0, AText, textAlignLCL) + else + renderer.CopyTextPathTo(self, 0,0, AText, textAlignLCL, direction=fbmRightToLeft); + currentState.matrix := previousMatrix; + end else + begin + setlength(FTextPaths, length(FTextPaths)+1); + FTextPaths[high(FTextPaths)].Text := AText; + FTextPaths[high(FTextPaths)].FontName := fontName; + FTextPaths[high(FTextPaths)].FontMatrix := currentState.matrix*AffineMatrixTranslation(x,y)*AffineMatrixScale(fontEmHeight,fontEmHeight); + FTextPaths[high(FTextPaths)].FontStyle := fontStyle; + FTextPaths[high(FTextPaths)].FontAlign := textAlignLCL; + FTextPaths[high(FTextPaths)].FontAnchor := fva; + FTextPaths[high(FTextPaths)].TextDirection := direction; + end; + + FLastCoord := EmptyPointF; + FStartCoord := EmptyPointF; +end; + +procedure TBGRACanvas2D.fillText(AText: string; x, y: single); +begin + beginPath; + text(AText,x,y); + fill; + beginPath; +end; + +procedure TBGRACanvas2D.strokeText(AText: string; x, y: single); +begin + beginPath; + text(AText,x,y); + stroke; + beginPath; +end; + +function TBGRACanvas2D.measureText(AText: string): TCanvas2dTextSize; +var renderer: TBGRACustomFontRenderer; + ratio: Single; +begin + renderer := fontRenderer; + if renderer <> nil then + begin + if renderer.FontEmHeight = 0 then + begin + result.width := 0; + result.height:= 0; + end else + with renderer.TextSize(AText) do + begin + ratio := currentState.fontEmHeight/renderer.FontEmHeight; + result.width := cx*ratio; + result.height:= cy*ratio; + end; + end + else + begin + result.width := 0; + result.height := 0; + end; +end; + +procedure TBGRACanvas2D.fill; +begin + if FPathPointCount > 0 then + FillPoly(slice(FPathPoints,FPathPointCount)); + FillTexts(false); +end; + +procedure TBGRACanvas2D.stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); +begin + stroke(ADrawProc, AffineMatrixIdentity, AData); +end; + +procedure TBGRACanvas2D.stroke(ADrawProc: TBGRAPathDrawProc; + const AMatrix: TAffineMatrix; AData: pointer); +var + startIndex: integer; + + procedure CallStrokeProc(AEndIndex: integer); + var + j: Integer; + subPts: array of TPointF; + closed: boolean; + begin + closed := false; + while (AEndIndex>startIndex) + and (FPathPoints[AEndIndex-1]=FPathPoints[startIndex]) do + begin + dec(AEndIndex); + closed := true; + end; + if AEndIndex > startIndex then + begin + setlength(subPts, AEndIndex-startIndex); + if IsAffineMatrixIdentity(AMatrix) then + begin + for j := 0 to high(subPts) do + subPts[j] := FPathPoints[startIndex+j]; + end else + for j := 0 to high(subPts) do + subPts[j] := AMatrix*FPathPoints[startIndex+j]; + ADrawProc(subPts, closed, AData); + end; + end; + +var i: integer; +begin + startIndex := 0; + for i := 0 to FPathPointCount-1 do + if isEmptyPointF(FPathPoints[i]) then + begin + CallStrokeProc(i); + startIndex := i+1; + end; + CallStrokeProc(FPathPointCount); +end; + +procedure TBGRACanvas2D.stroke; +begin + if FPathPointCount > 0 then + StrokePoly(slice(FPathPoints,FPathPointCount)); +end; + +procedure TBGRACanvas2D.fill(AFillProc: TBGRAPathFillProc; AData: pointer); +begin + fill(AFillProc, AffineMatrixIdentity, AData); +end; + +procedure TBGRACanvas2D.fill(AFillProc: TBGRAPathFillProc; + const AMatrix: TAffineMatrix; AData: pointer); +var + startIndex: integer; + + procedure CallFillProc(AEndIndex: integer); + var + j: Integer; + subPts: array of TPointF; + begin + if AEndIndex > startIndex then + begin + setlength(subPts, AEndIndex-startIndex); + if IsAffineMatrixIdentity(AMatrix) then + begin + for j := 0 to high(subPts) do + subPts[j] := FPathPoints[startIndex+j]; + end else + for j := 0 to high(subPts) do + subPts[j] := AMatrix*FPathPoints[startIndex+j]; + + AFillProc(subPts, AData); + end; + end; + +var i: integer; +begin + startIndex := 0; + for i := 0 to FPathPointCount-1 do + if isEmptyPointF(FPathPoints[i]) then + begin + CallFillProc(i); + startIndex := i+1; + end; + CallFillProc(FPathPointCount); +end; + +procedure TBGRACanvas2D.fillOverStroke; +begin + if FPathPointCount > 0 then + FillStrokePoly(slice(FPathPoints,FPathPointCount),true); + FillTexts(false); +end; + +procedure TBGRACanvas2D.strokeOverFill; +begin + FillTexts(false); + if FPathPointCount > 0 then + FillStrokePoly(slice(FPathPoints,FPathPointCount),false); +end; + +procedure TBGRACanvas2D.clearPath; +begin + if FPathPointCount > 0 then + ClearPoly(slice(FPathPoints,FPathPointCount)); + FillTexts(true); +end; + +procedure TBGRACanvas2D.clip; +var + tempBmp: TGrayscaleMask; +begin + if FPathPointCount = 0 then + begin + if currentState.clipMaskReadOnly <> nil then + currentState.clipMaskReadWrite.Fill(BGRABlack); + exit; + end; + if currentState.clipMaskReadOnly = nil then + currentState.SetClipMask(TGrayscaleMask.Create(width,height,BGRAWhite),True); + tempBmp := TGrayscaleMask.Create(width,height,BGRABlack); + if antialiasing then + tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) + else + tempBmp.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite); + currentState.clipMaskReadWrite.ApplyMask(tempBmp); + tempBmp.Free; +end; + +procedure TBGRACanvas2D.unclip; +begin + if FPathPointCount = 0 then exit; + if currentState.clipMaskReadOnly = nil then exit; + if antialiasing then + currentState.clipMaskReadWrite.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) + else + currentState.clipMaskReadWrite.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet); + if currentState.clipMaskReadOnly.Equals(BGRAWhite) then + currentState.SetClipMask(nil,true); +end; + +function TBGRACanvas2D.isPointInPath(x, y: single): boolean; +begin + result := isPointInPath(PointF(x,y)); +end; + +function TBGRACanvas2D.isPointInPath(pt: TPointF): boolean; +begin + if FPathPointCount <= 2 then + result := false + else + begin + setlength(FPathPoints,FPathPointCount); + result := IsPointInPolygon(FPathPoints,pt+FCanvasOffset, fillMode = fmWinding); + end; +end; + +procedure TBGRACanvas2D.drawImage(image: TBGRACustomBitmap; dx, dy: single; AFilter: TResampleFilter); +var + m: TAffineMatrix; +begin + if (image.Width = 0) or (image.Height = 0) then exit; + m := matrix*AffineMatrixTranslation(dx, dy); + if pixelCenteredCoordinates then + m := AffineMatrixTranslation(0.5, 0.5)*m; + Surface.PutImageAffine(m, image, AFilter, GetDrawMode, currentState.globalAlpha, false); +end; + +procedure TBGRACanvas2D.drawImage(image: TBGRACustomBitmap; dx, dy, dw, dh: single; AFilter: TResampleFilter); +var + m: TAffineMatrix; +begin + if (image.Width = 0) or (image.Height = 0) then exit; + m := matrix*AffineMatrixTranslation(dx, dy)*AffineMatrixScale(dw/image.Width,dh/image.Height); + if pixelCenteredCoordinates then + m := AffineMatrixTranslation(0.5, 0.5)*m; + Surface.PutImageAffine(m, image, AFilter, GetDrawMode, currentState.globalAlpha, false); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracanvasgl.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvasgl.pas new file mode 100644 index 0000000..b6ecd28 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracanvasgl.pas @@ -0,0 +1,1840 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACanvasGL; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, + BGRAOpenGLType, BGRATransform, BGRAPath, + BGRASSE, BGRAMatrix3D; + +type + TBGLPath = class; + TBGLCustomCanvas = class; + + TBGLCustomShader = class + protected + procedure StartUse; virtual; abstract; + procedure EndUse; virtual; abstract; + end; + + TBGLCustomArray = class + protected + FBuffer: LongWord; + function GetCount: integer; virtual; abstract; + function GetRecordSize: integer; virtual; abstract; + public + constructor Create(ABufferAddress: pointer; ACount: integer; ARecordSize: integer); virtual; abstract; + property Count: integer read GetCount; + property RecordSize: integer read GetRecordSize; + property Handle: LongWord read FBuffer; + end; + + { TAttributeVariable } + + TAttributeVariable = object + protected + FOwner: TObject; + FAttribute: LongWord; + FVectorSize: integer; + FArray: TBGLCustomArray; + FRecordOffset: integer; + FFloat: boolean; + procedure Init(AOwner: TObject; AAttribute: LongWord; AVectorSize: integer; + AFloat: boolean); + public + property Source: TBGLCustomArray read FArray write FArray; + property RecordOffset: integer read FRecordOffset write FRecordOffset; + property Handle: LongWord read FAttribute; + property VectorSize: integer read FVectorSize; + property IsFloat: boolean read FFloat; + property Owner: TObject read FOwner; + end; + + TBGLCustomElementArray = class + protected + function GetCount: integer; virtual; abstract; + public + constructor Create(const AElements: array of integer); virtual; abstract; + procedure Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); virtual; abstract; + property Count: integer read GetCount; + end; + + { TBGLCustomLighting } + + TBGLCustomLighting = class + private + FCurrentShader: TBGLCustomShader; + function GetActiveShader: TBGLCustomShader; + procedure SetActiveShader(AValue: TBGLCustomShader); + protected + function GetSupportShaders: boolean; virtual; + function GetShader(AName: string): TBGLCustomShader; + procedure SetShader(AName: string; AValue: TBGLCustomShader); + procedure SetAmbiantLightF(AAmbiantLight: TColorF); virtual; abstract; + function GetAmbiantLightF: TColorF; virtual; abstract; + function GetBuiltInLightingEnabled: boolean; virtual; abstract; + procedure SetBuiltInLightingEnabled(AValue: boolean); virtual; abstract; + public + ShaderList: TStringList; + destructor Destroy; override; + function AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; virtual; abstract; + function AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; virtual; abstract; + procedure ClearLights; virtual; abstract; + function RemoveLight(AIndex: integer): boolean; virtual; abstract; + procedure SetSpecularIndex(AIndex: integer); virtual; abstract; + + function MakeVertexShader(ASource: string): LongWord; virtual; abstract; + function MakeFragmentShader(ASource: string): LongWord; virtual; abstract; + function MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; virtual; abstract; + procedure DeleteShaderObject(AShader: LongWord); virtual; abstract; + procedure DeleteShaderProgram(AProgram: LongWord); virtual; abstract; + procedure UseProgram(AProgram: LongWord); virtual; abstract; + function GetUniformVariable(AProgram: LongWord; AName: string): LongWord; virtual; abstract; + function GetAttribVariable(AProgram: LongWord; AName: string): LongWord; virtual; abstract; + procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); virtual; abstract; + procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); virtual; abstract; + procedure BindAttribute(AAttribute: TAttributeVariable); virtual; abstract; + procedure UnbindAttribute(AAttribute: TAttributeVariable); virtual; abstract; + procedure FreeShaders; + property ActiveShader: TBGLCustomShader read GetActiveShader write SetActiveShader; + property Shader[AName: string]: TBGLCustomShader read GetShader write SetShader; + property SupportShaders: boolean read GetSupportShaders; + property AmbiantLightF: TColorF read GetAmbiantLightF write SetAmbiantLightF; + property BuiltInLightingEnabled: boolean read GetBuiltInLightingEnabled write SetBuiltInLightingEnabled; + end; + + { TBGLCustomCanvas } + + TBGLCustomCanvas = class + private + FActiveFrameBuffer: TBGLCustomFrameBuffer; + FHeight: integer; + FWidth: integer; + FNoClip: boolean; + FClipRect: TRect; + protected + procedure SwapRect(var r: TRect); overload; + procedure SwapRect(var x1,y1,x2,y2: single); overload; + procedure InternalArc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; + procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; + procedure InternalArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; + function ComputeEllipseC(r: TRect; AHasBorder: boolean; out cx,cy,rx,ry: single): boolean; + function GetHeight: integer; virtual; + function GetWidth: integer; virtual; + procedure SetWidth(AValue: integer); virtual; + procedure SetHeight(AValue: integer); virtual; + function GetClipRect: TRect; + procedure SetClipRect(AValue: TRect); + procedure EnableScissor(AValue: TRect); virtual; abstract; + procedure DisableScissor; virtual; abstract; + function GetMatrix: TAffineMatrix; virtual; abstract; + procedure SetMatrix(const AValue: TAffineMatrix); virtual; abstract; + function GetProjectionMatrix: TMatrix4D; virtual; + procedure SetProjectionMatrix(const {%H-}AValue: TMatrix4D); virtual; + procedure SetBlendMode(AValue: TOpenGLBlendMode); virtual; abstract; + function GetBlendMode: TOpenGLBlendMode; virtual; abstract; + function GetFaceCulling: TFaceCulling; virtual; abstract; + procedure SetFaceCulling(AValue: TFaceCulling); virtual; abstract; + procedure SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); virtual; + + function GetLighting: TBGLCustomLighting; virtual; + + procedure InternalStartPutPixel(const pt: TPointF); virtual; abstract; + procedure InternalStartPolyline(const pt: TPointF); virtual; abstract; + procedure InternalStartPolygon(const pt: TPointF); virtual; abstract; + procedure InternalStartTriangleFan(const pt: TPointF); virtual; abstract; + procedure InternalContinueShape(const pt: TPointF); overload; virtual; abstract; + + procedure InternalContinueShape(const {%H-}pt: TPoint3D); overload; virtual; + procedure InternalContinueShape(const {%H-}pt: TPoint3D_128); overload; virtual; + procedure InternalContinueShape(const {%H-}pt, {%H-}normal: TPoint3D_128); overload; virtual; + + procedure InternalEndShape; virtual; abstract; + procedure InternalSetColor(const AColor: TBGRAPixel); virtual; abstract; + procedure InternalSetColorF(const AColor: TColorF); virtual; abstract; + + procedure InternalStartBlend; virtual; abstract; + procedure InternalEndBlend; virtual; abstract; + + procedure InternalStartBlendTriangles; virtual; abstract; + procedure InternalStartBlendQuads; virtual; abstract; + procedure InternalEndBlendTriangles; virtual; abstract; + procedure InternalEndBlendQuads; virtual; abstract; + public + constructor Create; + procedure Fill(AColor: TBGRAPixel); virtual; abstract; + + procedure PutPixels(const APoints: array of TPointF; AColor: TBGRAPixel); overload; virtual; + procedure PutPixels(const APoints: array of TPointF; const AColors: array of TBGRAPixel); overload; virtual; + + procedure Line(x1,y1,x2,y2: single; AColor: TBGRAPixel; ADrawLastPoint: boolean = true); overload; + procedure Line(p1,p2: TPointF; AColor: TBGRAPixel; ADrawLastPoint: boolean = true); overload; + procedure Polylines(const APoints: array of TPointF; AColor: TBGRAPixel; ADrawLastPoints: boolean = true); virtual; + + procedure Polygons(const APoints: array of TPointF; AColor: TBGRAPixel); virtual; + procedure FillPolyConvex(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); + + procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure FillTriangles(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPointF; const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; + procedure FillTrianglesLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; + procedure FillTrianglesFan(const APoints: array of TPointF; ACenterColor, ABorderColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + + procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TColorF; APixelCenteredCoordinates: boolean = true); overload; + procedure FillTriangles(const APoints: array of TPointF; AColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPointF; const AColors: array of TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPoint3D; const AColors: array of TColorF); overload; virtual; + procedure FillTrianglesLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; + procedure FillTrianglesLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; + procedure FillTrianglesFan(const APoints: array of TPointF; ACenterColor, ABorderColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; + + procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure FillQuads(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPointF; const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; + procedure FillQuadsLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; + + procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TColorF; APixelCenteredCoordinates: boolean = true); overload; + procedure FillQuads(const APoints: array of TPointF; AColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPointF; const AColors: array of TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPoint3D; const AColors: array of TColorF); overload; virtual; + procedure FillQuadsLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; + procedure FillQuadsLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; + + procedure DrawPath(APath: TBGLPath; c: TBGRAPixel); + procedure FillPathConvex(APath: TBGLPath; c: TBGRAPixel; APixelCenteredCoordinates: boolean = true); + + procedure FillRectLinearColor(r: TRect; ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel); overload; virtual; + procedure FillRectLinearColor(x1,y1,x2,y2: single; + ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel; + APixelCenteredCoordinates: boolean = true); overload; virtual; + + procedure Ellipse(cx,cy,rx,ry: single; AColor: TBGRAPixel); overload; + procedure EllipseInRect(r: TRect; AColor: TBGRAPixel); overload; + procedure Ellipse(cx,cy,rx,ry: single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure EllipseInRect(r: TRect; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure EllipseLinearColor(cx,cy,rx,ry: single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure EllipseLinearColorInRect(r: TRect; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure FillEllipse(cx,cy,rx,ry: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); + procedure FillEllipseInRect(r: TRect; AColor: TBGRAPixel); + procedure FillEllipseLinearColor(cx, cy, rx, ry: single; AOuterColor, AInnerColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); + procedure FillEllipseLinearColorInRect(r: TRect; AOuterColor, AInnerColor: TBGRAPixel); + + procedure Arc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; + procedure Arc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; + procedure ArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); + procedure ArcLinearColor(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure ArcLinearColor(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure ArcLinearColorInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); + + procedure Pie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure Pie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure PieInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); + procedure PieLinearColor(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure PieLinearColor(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; + procedure PieLinearColorInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); + + procedure Rectangle(r: TRect; AColor: TBGRAPixel); overload; + procedure Rectangle(r: TRect; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel); overload; + procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; + procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; w: single; APixelCenteredCoordinates: boolean = true); overload; + procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure RectangleWithin(x1,y1,x2,y2: single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; + procedure FillRect(x1,y1,x2,y2: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure FillRect(r: TRect; AColor: TBGRAPixel); overload; + procedure FillRect(r: TRectF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = false); overload; + procedure FillRect(r: TRect; AScanner: IBGRAScanner); overload; virtual; + procedure RoundRect(x1,y1,x2,y2,rx,ry: single; ABorderColor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; + procedure RoundRect(x1,y1,x2,y2,rx,ry: single; ABorderColor,AFillColor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; + procedure FillRoundRect(x,y,x2,y2,rx,ry: single; AFillColor: TBGRAPixel; options: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); + + procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut); overload; + procedure Frame3D(var bounds: TRect; width: integer; + Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); overload; + + procedure PutImage(x,y: single; ATexture: IBGLTexture; AAlpha: byte = 255); overload; + procedure PutImage(x,y: single; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; + procedure StretchPutImage(x,y,w,h: single; ATexture: IBGLTexture; AAlpha: byte = 255); overload; + procedure StretchPutImage(x,y,w,h: single; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; + procedure StretchPutImage(r: TRect; ATexture: IBGLTexture; AAlpha: byte = 255); overload; + procedure StretchPutImage(r: TRect; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; + procedure PutImageAngle(x,y: single; ATexture: IBGLTexture; angleDeg: single; AAlpha: byte = 255); overload; + procedure PutImageAngle(x,y: single; ATexture: IBGLTexture; angleDeg: single; AColor: TBGRAPixel); overload; + procedure PutImageAffine(const Origin, HAxis, VAxis: TPointF; ATexture: IBGLTexture; AAlpha: byte = 255); overload; + procedure PutImageAffine(const Origin, HAxis, VAxis: TPointF; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; + procedure PutImageAffine(x,y: single; ATexture: IBGLTexture; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; + procedure PutImageAffine(x,y: single; ATexture: IBGLTexture; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; + + procedure Translate(x,y: single); virtual; + procedure Scale(sx,sy: single); virtual; + procedure RotateDeg(angleCW: single); virtual; + procedure RotateRad(angleCCW: single); virtual; + procedure ResetTransform; virtual; + + procedure UseOrthoProjection; overload; virtual; + procedure UseOrthoProjection(AMinX,AMinY,AMaxX,AMaxY: single); overload; virtual; + procedure StartZBuffer; virtual; + procedure EndZBuffer; virtual; + procedure WaitForGPU({%H-}AOption: TWaitForGPUOption); virtual; + + function GetImage({%H-}x,{%H-}y,{%H-}w,{%H-}h: integer): TBGRACustomBitmap; virtual; + function CreateFrameBuffer({%H-}AWidth,{%H-}AHeight: integer): TBGLCustomFrameBuffer; virtual; + + procedure NoClip; + property ActiveFrameBuffer: TBGLCustomFrameBuffer read FActiveFrameBuffer write SetActiveFrameBuffer; + property Width: integer read GetWidth write SetWidth; + property Height: integer read GetHeight write SetHeight; + property ClipRect: TRect read GetClipRect write SetClipRect; + property Matrix: TAffineMatrix read GetMatrix write SetMatrix; + property ProjectionMatrix: TMatrix4D read GetProjectionMatrix write SetProjectionMatrix; + property BlendMode: TOpenGLBlendMode read GetBlendMode write SetBlendMode; + property FaceCulling: TFaceCulling read GetFaceCulling write SetFaceCulling; + property Lighting: TBGLCustomLighting read GetLighting; + end; + + { TBGLPath } + + TBGLPath = class(TBGRAPath) + private + procedure GLDrawProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer); + procedure GLFillProc(const APoints: array of TPointF; AData: pointer); + public + procedure stroke(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1); overload; + procedure fillConvex(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1; APixelCenteredCoordinates: boolean = true); + end; + +implementation + +uses Math, BGRAGradientScanner; + +type + TGLStrokeData = record + Color: TBGRAPixel; + Canvas: TBGLCustomCanvas; + end; + TGLFillData = record + Color: TBGRAPixel; + Canvas: TBGLCustomCanvas; + PixelCenteredCoordinates: boolean; + end; + +{ TAttributeVariable } + +procedure TAttributeVariable.Init(AOwner: TObject; AAttribute: LongWord; + AVectorSize: integer; AFloat: boolean); +begin + FOwner := AOwner; + FAttribute:= AAttribute; + FVectorSize:= AVectorSize; + FFloat := AFloat; + FArray := nil; + FRecordOffset := 0; +end; + +{ TBGLCustomLighting } + +function TBGLCustomLighting.GetActiveShader: TBGLCustomShader; +begin + result := FCurrentShader; +end; + +function TBGLCustomLighting.GetSupportShaders: boolean; +begin + result := false; +end; + +function TBGLCustomLighting.GetShader(AName: string): TBGLCustomShader; +var index: integer; +begin + if ShaderList = nil then ShaderList := TStringList.Create; + index := ShaderList.IndexOf(AName); + if index = -1 then + result := nil + else + result := TBGLCustomShader(ShaderList.Objects[index]); +end; + +procedure TBGLCustomLighting.SetShader(AName: string; AValue: TBGLCustomShader); +var index: integer; +begin + if ShaderList = nil then ShaderList := TStringList.Create; + index := ShaderList.IndexOf(AName); + if AValue = nil then + begin + if index <> -1 then + ShaderList.Delete(index); + end else + begin + if index = -1 then + ShaderList.AddObject(AName,AValue) + else + ShaderList.Objects[index] := AValue; + end; +end; + +destructor TBGLCustomLighting.Destroy; +begin + FreeShaders; + FreeAndNil(ShaderList); + inherited Destroy; +end; + +procedure TBGLCustomLighting.FreeShaders; +var i: integer; +begin + if Assigned(ShaderList) then + begin + for i := 0 to ShaderList.Count-1 do + ShaderList.Objects[i].Free; + ShaderList.Clear; + end; +end; + +procedure TBGLCustomLighting.SetActiveShader(AValue: TBGLCustomShader); +begin + if AValue <> FCurrentShader then + begin + if Assigned(FCurrentShader) then FCurrentShader.EndUse; + FCurrentShader := AValue; + if Assigned(FCurrentShader) then FCurrentShader.StartUse; + end; +end; + +{ TBGLPath } + +procedure TBGLPath.GLDrawProc(const APoints: array of TPointF; + AClosed: boolean; AData: pointer); +begin + with TGLStrokeData(AData^) do + if AClosed then + Canvas.Polygons(APoints, Color) + else + Canvas.Polylines(APoints, Color); +end; + +procedure TBGLPath.GLFillProc(const APoints: array of TPointF; AData: pointer); +begin + with TGLFillData(AData^) do + Canvas.FillPolyConvex(APoints,Color,PixelCenteredCoordinates); +end; + +procedure TBGLPath.stroke(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single); +var data: TGLStrokeData; +begin + data.Color := AColor; + data.Canvas := ACanvas; + stroke(@GLDrawProc, AffineMatrixIdentity, AAcceptedDeviation, @data); +end; + +procedure TBGLPath.fillConvex(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single; APixelCenteredCoordinates: boolean); +var data: TGLFillData; +begin + data.Color := AColor; + data.Canvas := ACanvas; + data.PixelCenteredCoordinates := APixelCenteredCoordinates; + fill(@GLFillProc, AffineMatrixIdentity, AAcceptedDeviation, @data); +end; + +{ TBGLCustomCanvas } + +function TBGLCustomCanvas.ComputeEllipseC(r: TRect; AHasBorder: boolean; out + cx, cy, rx, ry: single): boolean; +begin + if (r.right = r.left) or (r.bottom = r.top) then + begin + cx := r.left; + cy := r.top; + rx := 0; + ry := 0; + exit; + end; + SwapRect(r); + cx := (r.left+r.right-1)*0.5; + cy := (r.top+r.bottom-1)*0.5; + rx := (r.right-r.left)*0.5; + ry := (r.bottom-r.top)*0.5; + if AHasBorder then + begin + DecF(rx, 0.5); + if rx < 0 then rx := 0; + DecF(ry, 0.5); + if ry < 0 then ry := 0; + end; + result := true; +end; + +function TBGLCustomCanvas.GetHeight: integer; +begin + if FActiveFrameBuffer = nil then + result := FHeight + else + result := FActiveFrameBuffer.Height; +end; + +function TBGLCustomCanvas.GetWidth: integer; +begin + if FActiveFrameBuffer = nil then + result := FWidth + else + result := FActiveFrameBuffer.Width; +end; + +procedure TBGLCustomCanvas.SetWidth(AValue: integer); +begin + if FWidth=AValue then Exit; + FWidth:=AValue; +end; + +procedure TBGLCustomCanvas.SetHeight(AValue: integer); +begin + if FHeight=AValue then Exit; + FHeight:=AValue; +end; + +function TBGLCustomCanvas.GetClipRect: TRect; +begin + if FNoClip then + result := rect(0,0,Width,Height) + else + result := FClipRect; +end; + +procedure TBGLCustomCanvas.SetClipRect(AValue: TRect); +begin + SwapRect(AValue); + with ClipRect do + if (AValue.left = left) and (AValue.top = top) and (AValue.bottom = bottom) + and (AValue.right = right) then exit; + + if (AValue.Left = 0) and (AValue.Top = 0) and + (AValue.Right = Width) and (AValue.Bottom = Height) then + NoClip + else + begin + FClipRect := AValue; + EnableScissor(FClipRect); + end; +end; + +function TBGLCustomCanvas.GetProjectionMatrix: TMatrix4D; +begin + result := MatrixIdentity4D; +end; + +procedure TBGLCustomCanvas.SetProjectionMatrix(const AValue: TMatrix4D); +begin + raise exception.Create('Not implemented'); +end; + +function TBGLCustomCanvas.GetLighting: TBGLCustomLighting; +begin + result := nil; + raise exception.Create('Not implemented'); +end; + +procedure TBGLCustomCanvas.InternalContinueShape(const pt: TPoint3D); +begin + raise exception.Create('Not available'); +end; + +procedure TBGLCustomCanvas.InternalContinueShape(const pt: TPoint3D_128); +begin + raise exception.Create('Not available'); +end; + +procedure TBGLCustomCanvas.InternalContinueShape(const pt, normal: TPoint3D_128); +begin + raise exception.Create('Not available'); +end; + +procedure TBGLCustomCanvas.NoClip; +begin + FClipRect := rect(0,0,Width,Height); + FNoClip := true; + DisableScissor; +end; + +constructor TBGLCustomCanvas.Create; +begin + FNoClip:= true; +end; + +procedure TBGLCustomCanvas.FillTriangles(const APoints: array of TPointF; + AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if (length(APoints) < 3) or (AColor.alpha = 0) then exit; + InternalStartBlendTriangles; + InternalSetColor(AColor); + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + InternalContinueShape(APoints[i]+ofs); + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints: array of TPointF; + const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]+ofs); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor( + const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor( + const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints, + ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); + if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i], ANormals[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillQuads(const APoints: array of TPointF; + AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if (length(APoints) < 4) or (AColor.alpha = 0) then exit; + InternalStartBlendQuads; + InternalSetColor(AColor); + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + InternalContinueShape(APoints[i]+ofs); + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints: array of TPointF; + const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]+ofs); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor( + const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor( + const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints, + ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); + if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i], ANormals[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, + c2, c3, c4: TColorF; APixelCenteredCoordinates: boolean); +begin + FillQuadsLinearColor([pt1,pt2,pt3,pt4],[c1,c2,c3,c4],APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillQuads(const APoints: array of TPointF; + AColor: TColorF; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if (length(APoints) < 4) or (AColor[4] = 0) then exit; + InternalStartBlendQuads; + InternalSetColorF(AColor); + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + InternalContinueShape(APoints[i]+ofs); + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor( + const APoints: array of TPointF; const AColors: array of TColorF; + APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]+ofs); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor( + const APoints: array of TPoint3D; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor( + const APoints: array of TPoint3D_128; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints, + ANormals: array of TPoint3D_128; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 4 then exit; + if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); + if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); + InternalStartBlendQuads; + for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i], ANormals[i]); + end; + InternalEndBlendQuads; +end; + +procedure TBGLCustomCanvas.PutPixels(const APoints: array of TPointF; + AColor: TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) = 0 then exit; + InternalStartBlend; + InternalSetColor(AColor); + InternalStartPutPixel(APoints[0]); + for i := 1 to high(APoints) do + InternalContinueShape(APoints[i]); + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.PutPixels(const APoints: array of TPointF; + const AColors: array of TBGRAPixel); +var + i: Int32or64; +begin + if length(APoints) = 0 then exit; + InternalStartBlend; + InternalSetColor(AColors[0]); + InternalStartPutPixel(APoints[0]); + for i := 1 to high(APoints) do + begin + InternalSetColor(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.FillTrianglesFan(const APoints: array of TPointF; + ACenterColor, ABorderColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + firstPoint: boolean; + ofs: TPointF; +begin + if (length(APoints) < 3) or ((ACenterColor.alpha = 0) and (ABorderColor.alpha = 0)) then exit; + InternalStartBlend; + firstPoint := true; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to high(APoints) do + begin + if isEmptyPointF(APoints[i]) then + begin + if not firstPoint then + begin + InternalEndShape; + firstPoint := true; + end; + end else + begin + if firstPoint then + begin + InternalSetColor(ACenterColor); + InternalStartTriangleFan(APoints[i]+ofs); + InternalSetColor(ABorderColor); + firstPoint := false; + end else + InternalContinueShape(APoints[i]+ofs); + end; + end; + if not firstPoint then InternalEndShape; + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, + c2, c3: TColorF; APixelCenteredCoordinates: boolean); +begin + FillTrianglesLinearColor([pt1,pt2,pt3],[c1,c2,c3],APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillTriangles(const APoints: array of TPointF; + AColor: TColorF; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if (length(APoints) < 3) or (AColor[4] = 0) then exit; + InternalStartBlendTriangles; + InternalSetColorF(AColor); + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + InternalContinueShape(APoints[i]+ofs); + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor( + const APoints: array of TPointF; const AColors: array of TColorF; + APixelCenteredCoordinates: boolean); +var + i: Int32or64; + ofs: TPointF; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]+ofs); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor( + const APoints: array of TPoint3D; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor( + const APoints: array of TPoint3D_128; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then + raise exception.Create('Length of APoints and AColors do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints, + ANormals: array of TPoint3D_128; const AColors: array of TColorF); +var + i: Int32or64; +begin + if length(APoints) < 3 then exit; + if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); + if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); + InternalStartBlendTriangles; + for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do + begin + InternalSetColorF(AColors[i]); + InternalContinueShape(APoints[i], ANormals[i]); + end; + InternalEndBlendTriangles; +end; + +procedure TBGLCustomCanvas.FillTrianglesFan(const APoints: array of TPointF; + ACenterColor, ABorderColor: TColorF; APixelCenteredCoordinates: boolean); +var + i: Int32or64; + firstPoint: boolean; + ofs: TPointF; +begin + if (length(APoints) < 3) or ((ACenterColor[4] = 0) and (ABorderColor[4] = 0)) then exit; + InternalStartBlend; + firstPoint := true; + if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); + for i := 0 to high(APoints) do + begin + if isEmptyPointF(APoints[i]) then + begin + if not firstPoint then + begin + InternalEndShape; + firstPoint := true; + end; + end else + begin + if firstPoint then + begin + InternalSetColorF(ACenterColor); + InternalStartTriangleFan(APoints[i]+ofs); + InternalSetColorF(ABorderColor); + firstPoint := false; + end else + InternalContinueShape(APoints[i]+ofs); + end; + end; + if not firstPoint then InternalEndShape; + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.Polylines(const APoints: array of TPointF; + AColor: TBGRAPixel; ADrawLastPoints: boolean); +const + STATE_START = 0; //nothing defined + STATE_SECOND = 1; //prevPoint defined and is the first point + STATE_AFTER = 2; //newPoint defined and is the lastest point, prevPoint is the point before that +var + i: Int32or64; + state: Int32or64; + prevPoint,newPoint,v,ofs: TPointF; + len: single; + + procedure Flush; + begin + case state of + STATE_SECOND: begin + InternalStartPutPixel(prevPoint); + InternalEndShape; + end; + STATE_AFTER: + begin + v := newPoint-prevPoint; + len := VectLen(v); + if len > 0 then + begin + v := v*(1/len); + if ADrawLastPoints then + InternalContinueShape(newPoint + v*0.5 + ofs) + else + InternalContinueShape(newPoint - v*0.5 + ofs); + end; + InternalEndShape; + end; + end; + state := STATE_START; + end; + +begin + if (length(APoints) = 0) or (AColor.alpha = 0) then exit; + InternalStartBlend; + InternalSetColor(AColor); + prevPoint := PointF(0,0); + newPoint := PointF(0,0); + state := STATE_START; + ofs := PointF(0.5,0.5); + for i := 0 to high(APoints) do + begin + if isEmptyPointF(APoints[i]) then + begin + Flush; + end else + begin + if state = STATE_START then + begin + state := STATE_SECOND; + prevPoint := APoints[i]; + end else + if APoints[i] <> prevPoint then + begin + if state = STATE_SECOND then + begin + newPoint := APoints[i]; + v := newPoint-prevPoint; + len := VectLen(v); + if len > 0 then + begin + v := v*(1/len); + InternalStartPolyline(prevPoint - v*0.5 + ofs); + state := STATE_AFTER; + end; + end else + begin + InternalContinueShape(newPoint + ofs); + prevPoint := newPoint; + newPoint := APoints[i]; + end; + end; + end; + end; + Flush; + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.Polygons(const APoints: array of TPointF; + AColor: TBGRAPixel); +const + STATE_START = 0; //nothing defined + STATE_SECOND = 1; //prevPoint defined and is the first point + STATE_AFTER = 2; //newPoint defined and is the lastest point, prevPoint is the point before that +var + i: Int32or64; + state: Int32or64; + prevPoint,newPoint: TPointF; + ofs: TPointF; + + procedure Flush; + begin + case state of + STATE_SECOND: begin + InternalStartPutPixel(prevPoint); + InternalEndShape; + end; + STATE_AFTER: + begin + InternalContinueShape(newPoint + ofs); + InternalEndShape; + end; + end; + state := STATE_START; + end; + +begin + if (length(APoints) = 0) or (AColor.alpha = 0) then exit; + InternalStartBlend; + InternalSetColor(AColor); + prevPoint := PointF(0,0); + newPoint := PointF(0,0); + state := STATE_START; + ofs := PointF(0.5,0.5); + for i := 0 to high(APoints) do + begin + if isEmptyPointF(APoints[i]) then + begin + Flush; + end else + begin + if state = STATE_START then + begin + state := STATE_SECOND; + prevPoint := APoints[i]; + end else + if APoints[i] <> prevPoint then + begin + if state = STATE_SECOND then + begin + InternalStartPolygon(prevPoint+ofs); + newPoint := APoints[i]; + state := STATE_AFTER; + end else + begin + InternalContinueShape(newPoint+ofs); + prevPoint := newPoint; + newPoint := APoints[i]; + end; + end; + end; + end; + Flush; + InternalEndBlend; +end; + +procedure TBGLCustomCanvas.FillRect(r: TRect; AScanner: IBGRAScanner); +var + bmp: TBGLCustomBitmap; + yb,bandHeight,bandY: Int32or64; + tx: integer; +begin + SwapRect(r); + if (r.right = r.left) or (r.bottom = r.top) then exit; + tx := r.right-r.left; + bandHeight := 65536 div tx; + if bandHeight <= 2 then bandHeight := 2; + bandHeight := GetPowerOfTwo(bandHeight); + bmp := BGLBitmapFactory.Create(tx,bandHeight); + bmp.Texture.ResampleFilter := orfBox; + bandY := (r.Bottom-1-r.top) mod bandHeight; + for yb := r.bottom-1 downto r.top do + begin + AScanner.ScanMoveTo(r.left,yb); + AScanner.ScanPutPixels(bmp.ScanLine[bandY],tx,dmSet); + bmp.InvalidateBitmap; + if bandY = 0 then + begin + bmp.Texture.Draw(r.left,yb); + bandY := bandHeight-1; + end else + dec(bandY); + end; + bmp.Free; +end; + +procedure TBGLCustomCanvas.DrawPath(APath: TBGLPath; c: TBGRAPixel); +begin + APath.stroke(self, c); +end; + +procedure TBGLCustomCanvas.FillPathConvex(APath: TBGLPath; c: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + APath.fillConvex(self, c, 0.1, APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); +begin + if FActiveFrameBuffer=AValue then Exit; + if FActiveFrameBuffer <> nil then + FActiveFrameBuffer.SetCanvas(nil); + FActiveFrameBuffer:=AValue; + if FActiveFrameBuffer <> nil then + FActiveFrameBuffer.SetCanvas(self); +end; + +procedure TBGLCustomCanvas.SwapRect(var r: TRect); +var + temp: LongInt; +begin + if (r.Right < r.left) then + begin + temp := r.Left; + r.left := r.right; + r.right := temp; + end; + if (r.bottom < r.top) then + begin + temp := r.top; + r.top:= r.bottom; + r.bottom:= temp; + end; +end; + +procedure TBGLCustomCanvas.SwapRect(var x1, y1, x2, y2: single); +var + temp: single; +begin + if (x2 < x1) then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if (y2 < y1) then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; +end; + +procedure TBGLCustomCanvas.InternalArc(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; ABorderColor, AOuterFillColor,ACenterFillColor: TBGRAPixel; + AOptions: TArcOptions; ADrawChord: boolean = false); +var angle1,angle2: single; +begin + if (rx = 0) or (ry = 0) then exit; + angle1 := arctan2(-(StartPoint.y-cy)/ry,(StartPoint.x-cx)/rx); + angle2 := arctan2(-(EndPoint.y-cy)/ry,(EndPoint.x-cx)/rx); + if angle1 = angle2 then angle2 := angle1+2*Pi; + InternalArc(cx,cy,rx,ry, angle1,angle2, + ABorderColor,AOuterFillColor,ACenterFillColor, AOptions, ADrawChord); +end; + +procedure TBGLCustomCanvas.InternalArc(cx, cy, rx, ry: single; + StartAngleRad, EndAngleRad: Single; ABorderColor, + AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; + ADrawChord: boolean = false); +var + pts,ptsFill: array of TPointF; + temp: single; +begin + if (rx = 0) or (ry = 0) then exit; + if ADrawChord then AOptions := AOptions+[aoClosePath]; + if not (aoFillPath in AOptions) then + begin + AOuterFillColor := BGRAPixelTransparent; + ACenterFillColor := BGRAPixelTransparent; + end; + + if (ABorderColor.alpha = 0) and (AOuterFillColor.alpha = 0) and (ACenterFillColor.alpha = 0) then exit; + + if abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6 then + begin + Ellipse(cx,cy,rx,ry,ABorderColor); + FillEllipseLinearColor(cx,cy,rx,ry,AOuterFillColor,ACenterFillColor); + if aoPie in AOptions then + Line(cx,cy,cx+cos(StartAngleRad)*rx,cy-sin(StartAngleRad)*ry,ABorderColor,False); + exit; + end; + + if EndAngleRad < StartAngleRad then + begin + temp := StartAngleRad; + StartAngleRad:= EndAngleRad; + EndAngleRad:= temp; + end; + + pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad); + if aoPie in AOptions then + pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]); + if (ACenterFillColor.alpha <> 0) or (AOuterFillColor.alpha <> 0) then + begin + if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts]) + else ptsFill := pts; + FillTrianglesFan(ptsFill, ACenterFillColor,AOuterFillColor); + end; + if ABorderColor.alpha <> 0 then + begin + if [aoPie,aoClosePath]*AOptions <> [] then + Polygons(pts, ABorderColor) + else + Polylines(pts, ABorderColor, true); + end; +end; + +procedure TBGLCustomCanvas.InternalArcInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; ABorderColor, AOuterFillColor,ACenterFillColor: TBGRAPixel; + AOptions: TArcOptions; ADrawChord: boolean = false); +begin + if r.right = r.left then exit; + if r.bottom = r.top then exit; + SwapRect(r); + InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, + (r.right-r.left-1)/2,(r.bottom-r.top-1)/2, + StartAngleRad,EndAngleRad, + ABorderColor,AOuterFillColor,ACenterFillColor, + AOptions, ADrawChord); +end; + +procedure TBGLCustomCanvas.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, + c2, c3: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + FillTrianglesLinearColor([pt1,pt2,pt3],[c1,c2,c3],APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, + c2, c3, c4: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + FillQuadsLinearColor([pt1,pt2,pt3,pt4],[c1,c2,c3,c4],APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillPolyConvex(const APoints: array of TPointF; + AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + FillTrianglesFan(APoints,AColor,AColor,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.Line(x1, y1, x2, y2: single; AColor: TBGRAPixel; ADrawLastPoint: boolean); +var pts: array of TPointF; +begin + setlength(pts,2); + pts[0] := PointF(x1,y1); + pts[1] := PointF(x2,y2); + Polylines(pts,AColor,ADrawLastPoint); +end; + +procedure TBGLCustomCanvas.Line(p1, p2: TPointF; AColor: TBGRAPixel; ADrawLastPoint: boolean); +var pts: array of TPointF; +begin + setlength(pts,2); + pts[0] := p1; + pts[1] := p2; + Polylines(pts,AColor,ADrawLastPoint); +end; + +procedure TBGLCustomCanvas.FillRectLinearColor(r: TRect; + ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel); +begin + FillRectLinearColor(r.left,r.top,r.right,r.bottom, + ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor, + False); +end; + +procedure TBGLCustomCanvas.FillRectLinearColor(x1, y1, x2, y2: single; + ATopLeftColor, ATopRightColor, ABottomRightColor, + ABottomLeftColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + FillQuadLinearColor(PointF(x1,y1),PointF(x2,y1), + PointF(x2,y2),PointF(x1,y2), + ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor, + APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.Ellipse(cx, cy, rx, ry: single; AColor: TBGRAPixel); +begin + if AColor.alpha = 0 then exit; + Polygons(ComputeEllipse(cx,cy,rx,ry),AColor); +end; + +procedure TBGLCustomCanvas.EllipseInRect(r: TRect; AColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + Ellipse(cx,cy,rx,ry, AColor); +end; + +procedure TBGLCustomCanvas.FillEllipse(cx, cy, rx, ry: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + if AColor.alpha = 0 then exit; + FillTrianglesFan(ComputeEllipse(cx,cy,rx,ry),AColor,AColor,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillEllipseInRect(r: TRect; AColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,False,cx,cy,rx,ry) then exit; + FillEllipse(cx,cy,rx,ry, AColor); +end; + +procedure TBGLCustomCanvas.FillEllipseLinearColor(cx, cy, rx, ry: single; + AOuterColor, AInnerColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + if (AOutercolor.alpha = 0) and (AInnercolor.alpha = 0) then exit; + FillTrianglesFan(ConcatPointsF([PointsF([PointF(cx,cy)]),ComputeEllipse(cx,cy,rx,ry)]),AInnercolor,AOutercolor,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillEllipseLinearColorInRect(r: TRect; AOuterColor, + AInnerColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,False,cx,cy,rx,ry) then exit; + FillEllipseLinearColor(cx,cy,rx,ry, AOutercolor,AInnercolor); +end; + +procedure TBGLCustomCanvas.Arc(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AFillColor,AFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGLCustomCanvas.Arc(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AFillColor,AFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGLCustomCanvas.ArcInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + Arc(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,ADrawChord, AFillColor); +end; + +procedure TBGLCustomCanvas.ArcLinearColor(cx, cy, rx, ry: single; + const StartPoint, EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGLCustomCanvas.ArcLinearColor(cx, cy, rx, ry: single; + StartAngleRad, EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGLCustomCanvas.ArcLinearColorInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + ArcLinearColor(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,ADrawChord, AOuterFillColor,AInnerFillColor); +end; + +procedure TBGLCustomCanvas.Pie(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AColor: TBGRAPixel; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AFillColor,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGLCustomCanvas.Pie(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AFillColor,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGLCustomCanvas.PieInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + Pie(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,AFillColor); +end; + +procedure TBGLCustomCanvas.PieLinearColor(cx, cy, rx, ry: single; + const StartPoint, EndPoint: TPointF; AColor: TBGRAPixel; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGLCustomCanvas.PieLinearColor(cx, cy, rx, ry: single; + StartAngleRad, EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGLCustomCanvas.PieLinearColorInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, + AInnerFillColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + PieLinearColor(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,AOuterFillColor,AInnerFillColor); +end; + +procedure TBGLCustomCanvas.EllipseLinearColor(cx, cy, rx, ry: single; AColor: TBGRAPixel; + AOuterFillColor, AInnerFillColor: TBGRAPixel); +begin + if (rx>1) and (ry>1) then + FillEllipseLinearColor(cx,cy,rx-0.5,ry-0.5,AOuterFillColor,AInnerFillColor); + Ellipse(cx,cy,rx,ry,AColor); +end; + +procedure TBGLCustomCanvas.EllipseLinearColorInRect(r: TRect; AColor: TBGRAPixel; + AOuterFillColor, AInnerFillColor: TBGRAPixel); +var cx,cy,rx,ry: single; +begin + if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; + FillEllipseLinearColor(cx,cy,rx,ry, AOuterFillColor,AInnerFillColor); + EllipseInRect(r,AColor); +end; + +procedure TBGLCustomCanvas.Ellipse(cx, cy, rx, ry: single; AColor: TBGRAPixel; + AFillColor: TBGRAPixel); +begin + EllipseLinearColor(cx,cy,rx,ry,AColor,AFillColor,AFillColor); +end; + +procedure TBGLCustomCanvas.EllipseInRect(r: TRect; AColor: TBGRAPixel; + AFillColor: TBGRAPixel); +begin + EllipseLinearColorInRect(r, AColor, AFillColor, AFillColor); +end; + +procedure TBGLCustomCanvas.Rectangle(r: TRect; AColor: TBGRAPixel); +begin + Rectangle(r,AColor,BGRAPixelTransparent); +end; + +procedure TBGLCustomCanvas.Rectangle(r: TRect; AColor: TBGRAPixel; + AFillColor: TBGRAPixel); +begin + SwapRect(r); + if r.left=r.right then exit; + if r.top=r.bottom then exit; + Rectangle(r.left,r.top,r.right-1,r.bottom-1,AColor,AFillColor); +end; + +procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel); +begin + Rectangle(x1,y1,x2,y2,AColor,1); +end; + +procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; + AColor: TBGRAPixel; AFillColor: TBGRAPixel); +begin + Rectangle(x1,y1,x2,y2,AColor,1,AFillColor); +end; + +procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; + AColor: TBGRAPixel; w: single; APixelCenteredCoordinates: boolean); +var hw: single; +begin + SwapRect(x1,y1,x2,y2); + hw := w*0.5; + if (x2-x1 > w) and (y2-y1 > w) then + FillQuads(PointsF([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y1+hw),PointF(x1-hw,y1+hw), + PointF(x1-hw,y2-hw),PointF(x2+hw,y2-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw), + PointF(x1-hw,y1+hw),PointF(x1+hw,y1+hw),PointF(x1+hw,y2-hw),PointF(x1-hw,y2-hw), + PointF(x2-hw,y1+hw),PointF(x2+hw,y1+hw),PointF(x2+hw,y2-hw),PointF(x2-hw,y2-hw)]), AColor, + APixelCenteredCoordinates) + else + FillQuads(PointsF([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw)]),AColor, + APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; + AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + SwapRect(x1,y1,x2,y2); + if (x2-x1 > w) and (y2-y1 > w) then + FillRect(x1+0.5*w,y1+0.5*w,x2-0.5*w,y2-0.5*w,AFillColor,APixelCenteredCoordinates); + Rectangle(x1,y1,x2,y2,AColor,w,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.RectangleWithin(x1, y1, x2, y2: single; + ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; + APixelCenteredCoordinates: boolean); +begin + Rectangle(x1+w*0.5,y1+w*0.5,x2-w*0.5,y2-w*0.5, ABorderColor, w, AFillColor, + APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; + w: single; AFillColor: TBGRAPixel); +begin + RectangleWithin(r.left,r.top,r.right,r.bottom,ABorderColor,w,AFillColor,false); +end; + +procedure TBGLCustomCanvas.RoundRect(x1, y1, x2, y2, rx, ry: single; + ABorderColor: TBGRAPixel; options: TRoundRectangleOptions); +begin + RoundRect(x1,y1,x2,y2,rx,ry,ABorderColor,options); +end; + +procedure TBGLCustomCanvas.RoundRect(x1, y1, x2, y2, rx, ry: single; + ABorderColor, AFillColor: TBGRAPixel; options: TRoundRectangleOptions); +const radiusReduction = 1; +begin + SwapRect(x1,y1,x2,y2); + rx := abs(rx); + ry := abs(ry); + if (AFillColor.alpha <> 0) and (y2-y1 > 1) and (x2-x1 > 1) then + begin + if (rx <= radiusReduction) or (ry <= radiusReduction) then + FillRect(x1+0.5,y1+0.5,x2-0.5,y2-0.5, AFillColor) + else + FillPolyConvex(ComputeRoundRect(x1+0.5,y1+0.5,x2-0.5,y2-0.5,rx-radiusReduction,ry-radiusReduction,options),AFillColor); + end; + Polygons(ComputeRoundRect(x1,y1,x2,y2,rx,ry,options),ABorderColor); +end; + +procedure TBGLCustomCanvas.FillRoundRect(x, y, x2, y2, rx, ry: single; + AFillColor: TBGRAPixel; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); +begin + if AFillColor.alpha <> 0 then + FillPolyConvex(ComputeRoundRect(x,y,x2,y2,rx,ry,options),AFillColor,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillRect(x1, y1, x2, y2: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); +begin + FillQuads(PointsF([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)]), AColor, APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.FillRect(r: TRect; AColor: TBGRAPixel); +begin + SwapRect(r); + if r.left=r.right then exit; + if r.top=r.bottom then exit; + FillRect(r.left,r.top,r.Right,r.bottom,AColor,False); +end; + +procedure TBGLCustomCanvas.FillRect(r: TRectF; AColor: TBGRAPixel; + APixelCenteredCoordinates: boolean); +begin + if r.left=r.right then exit; + if r.top=r.bottom then exit; + FillRect(r.left,r.top,r.Right,r.bottom,AColor,APixelCenteredCoordinates); +end; + +procedure TBGLCustomCanvas.Frame3D(var bounds: TRect; width: integer; + Style: TGraphicsBevelCut); +begin + Frame3D(bounds,width,style,ColorToBGRA(clRgbBtnHighlight),ColorToBGRA(clRgbBtnShadow)); +end; + +procedure TBGLCustomCanvas.Frame3D(var bounds: TRect; width: integer; + Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); +var temp: TBGRAPixel; + color1,color2: TBGRAPixel; +begin + if width <= 0 then exit; + color1 := LightColor; + color2 := ShadowColor; + if Style = bvLowered then + begin + temp := color1; + color1 := color2; + color2 := temp; + end; + if Style in [bvLowered,bvRaised] then + with bounds do + begin + FillTrianglesFan([PointF(Left,Top),PointF(Right,Top), + PointF(Right-width,Top+width),PointF(Left+width,Top+width), + PointF(Left+width,Bottom-width),PointF(Left,Bottom)],color1,color1, False); + FillTrianglesFan([PointF(Right,Bottom),PointF(Left,Bottom), + PointF(Left+width,Bottom-width),PointF(Right-width,Bottom-width), + PointF(Right-width,Top+width),PointF(Right,Top)],color2,color2, false); + end; + bounds.Inflate(-width, -width); +end; + +procedure TBGLCustomCanvas.PutImage(x, y: single; ATexture: IBGLTexture; + AAlpha: byte); +begin + ATexture.Draw(x,y,AAlpha); +end; + +procedure TBGLCustomCanvas.PutImage(x, y: single; ATexture: IBGLTexture; + AColor: TBGRAPixel); +begin + ATexture.Draw(x,y,AColor); +end; + +procedure TBGLCustomCanvas.StretchPutImage(x, y, w, h: single; + ATexture: IBGLTexture; AAlpha: byte); +begin + ATexture.StretchDraw(x,y,w,h, AAlpha); +end; + +procedure TBGLCustomCanvas.StretchPutImage(x, y, w, h: single; + ATexture: IBGLTexture; AColor: TBGRAPixel); +begin + ATexture.StretchDraw(x,y,w,h, AColor); +end; + +procedure TBGLCustomCanvas.StretchPutImage(r: TRect; ATexture: IBGLTexture; + AAlpha: byte); +begin + ATexture.StretchDraw(r.left,r.top,r.right-r.left,r.bottom-r.top, AAlpha); +end; + +procedure TBGLCustomCanvas.StretchPutImage(r: TRect; ATexture: IBGLTexture; + AColor: TBGRAPixel); +begin + ATexture.StretchDraw(r.left,r.top,r.right-r.left,r.bottom-r.top, AColor); +end; + +procedure TBGLCustomCanvas.PutImageAngle(x, y: single; ATexture: IBGLTexture; + angleDeg: single; AAlpha: byte); +begin + ATexture.DrawAngle(x,y,angleDeg,AAlpha); +end; + +procedure TBGLCustomCanvas.PutImageAngle(x, y: single; ATexture: IBGLTexture; + angleDeg: single; AColor: TBGRAPixel); +begin + ATexture.DrawAngle(x,y,angleDeg,AColor); +end; + +procedure TBGLCustomCanvas.PutImageAffine(const Origin, HAxis, VAxis: TPointF; + ATexture: IBGLTexture; AAlpha: byte); +begin + {$PUSH}{$OPTIMIZATION OFF} + ATexture.DrawAffine(Origin, HAxis, VAxis, AAlpha); + {$POP} +end; + +procedure TBGLCustomCanvas.PutImageAffine(const Origin, HAxis, VAxis: TPointF; + ATexture: IBGLTexture; AColor: TBGRAPixel); +begin + {$PUSH}{$OPTIMIZATION OFF} + ATexture.DrawAffine(Origin, HAxis, VAxis, AColor); + {$POP} +end; + +procedure TBGLCustomCanvas.PutImageAffine(x, y: single; ATexture: IBGLTexture; + const AMatrix: TAffineMatrix; AAlpha: byte); +begin + ATexture.DrawAffine(x,y,AMatrix,AAlpha); +end; + +procedure TBGLCustomCanvas.PutImageAffine(x, y: single; ATexture: IBGLTexture; + const AMatrix: TAffineMatrix; AColor: TBGRAPixel); +begin + ATexture.DrawAffine(x,y,AMatrix,AColor); +end; + +procedure TBGLCustomCanvas.Translate(x, y: single); +begin + Matrix := Matrix*AffineMatrixTranslation(x,y); +end; + +procedure TBGLCustomCanvas.Scale(sx, sy: single); +begin + Matrix := Matrix*AffineMatrixScale(sx,sy); +end; + +procedure TBGLCustomCanvas.RotateDeg(angleCW: single); +begin + Matrix := Matrix*AffineMatrixRotationDeg(angleCW); +end; + +procedure TBGLCustomCanvas.RotateRad(angleCCW: single); +begin + Matrix := Matrix*AffineMatrixRotationRad(angleCCW); +end; + +procedure TBGLCustomCanvas.ResetTransform; +begin + Matrix := AffineMatrixIdentity; +end; + +procedure TBGLCustomCanvas.UseOrthoProjection; +begin + ProjectionMatrix := OrthoProjectionToOpenGL(0,0,Width,Height); +end; + +procedure TBGLCustomCanvas.UseOrthoProjection(AMinX, AMinY, AMaxX, AMaxY: single); +begin + ProjectionMatrix := OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY); +end; + +procedure TBGLCustomCanvas.StartZBuffer; +begin + raise exception.Create('Not implemented'); +end; + +procedure TBGLCustomCanvas.EndZBuffer; +begin + raise exception.Create('Not implemented'); +end; + +procedure TBGLCustomCanvas.WaitForGPU(AOption: TWaitForGPUOption); +begin + raise exception.Create('Not implemented'); +end; + +function TBGLCustomCanvas.GetImage(x, y, w, h: integer): TBGRACustomBitmap; +begin + result := nil; +end; + +function TBGLCustomCanvas.CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; +begin + result := nil; + raise exception.Create('Not implemented'); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraclasses.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraclasses.pas new file mode 100644 index 0000000..8ba3343 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraclasses.pas @@ -0,0 +1,251 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAClasses; + +{$mode objfpc}{$H+} +{$modeswitch advancedrecords} + +interface + +uses + {$IFDEF BGRABITMAP_USE_MSEGUI}Types, Classes, mclasses, msegraphutils, mseguiglob{$ELSE}Types, Classes{$ENDIF}; + +type + Int32or64 = {$IFDEF CPU64}Int64{$ELSE}LongInt{$ENDIF}; + UInt32or64 = {$IFDEF CPU64}UInt64{$ELSE}LongWord{$ENDIF}; + + //types always imported from Classes + TFPList = Classes.TFPList; + TList = Classes.TList; + TNotifyEvent = Classes.TNotifyEvent; + EInvalidOperation = Classes.EInvalidOperation; + EFCreateError = Classes.EFCreateError; + EFOpenError = Classes.EFOpenError; + TAlignment = Classes.TAlignment; + TSeekOrigin = Classes.TSeekOrigin; + TStream = Classes.TStream; + TPersistent = Classes.TPersistent; + TStrings = Classes.TStrings; + TStringList = Classes.TStringList; + + TComponent = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TComponent; + TResourceStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TResourceStream; + TMemoryStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TMemoryStream; + THandleStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.THandleStream; + TStringStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TStringStream; + +type + {$IFDEF BGRABITMAP_USE_MSEGUI} + TPoint = msegraphutils.pointty; + TSize = msegraphutils.sizety; + TRect = Classes.TRect; + TClassesPoint = Classes.TPoint; + TMSERect = msegraphutils.rectty; + {$ELSE} + TPoint = Types.TPoint; + TSize = Types.TSize; + TRect = Types.TRect; + {$ENDIF} + PPoint = ^TPoint; + PSize = ^TSize; + PRect = ^TRect; + + {$IF FPC_FULLVERSION>=030001} + TPointF = Types.TPointF; + TRectF = Types.TRectF; + {$ELSE} + TPointF = record x : single; y : single; end; + + {$define BGRA_DEFINE_TRECTF} + TRectF = + {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed + {$endif FPC_REQUIRES_PROPER_ALIGNMENT} + record + private + function GetHeight: single; + function GetWidth: Single; + public + property Width: Single read GetWidth; + property Height: single read GetHeight; + procedure Offset (const dx,dy : Single); + case Integer of + 0: (Left, Top, Right, Bottom: Single); + 1: (TopLeft, BottomRight: TPointF); + end; + {$ENDIF} + +const + //types always imported from Classes + taLeftJustify = Classes.taLeftJustify; + taRightJustify = Classes.taRightJustify; + taCenter = Classes.taCenter; + +type + {$IFDEF BGRABITMAP_USE_MSEGUI} + TShiftState = mseguiglob.shiftstatesty; + {$ELSE} + TShiftState = Classes.TShiftState; + {$ENDIF} + +const + {$IFDEF BGRABITMAP_USE_MSEGUI} + ssShift = mseguiglob.ss_shift; + ssAlt = mseguiglob.ss_alt; + ssCtrl = mseguiglob.ss_ctrl; + ssLeft = mseguiglob.ss_left; + ssRight = mseguiglob.ss_right; + ssMiddle = mseguiglob.ss_middle; + ssDouble = mseguiglob.ss_double; + ssTriple = mseguiglob.ss_triple; + {$ELSE} + ssShift = Classes.ssShift; + ssAlt = Classes.ssAlt; + ssCtrl = Classes.ssCtrl; + ssLeft = Classes.ssLeft; + ssRight = Classes.ssRight; + ssMiddle = Classes.ssMiddle; + ssDouble = Classes.ssDouble; + ssTriple = Classes.ssTriple; + {$ENDIF} + + soBeginning = Classes.soBeginning; + soCurrent = Classes.soCurrent; + soEnd = Classes.soEnd; + + {$IFDEF BGRABITMAP_USE_MSEGUI} + fmCreate = $FF00; + fmOpenRead = 0; + fmOpenWrite = 1; + fmOpenReadWrite = 2; + + soFromBeginning = 0; + soFromCurrent = 1; + soFromEnd = 2; + {$ELSE} + fmCreate = Classes.fmCreate; + fmOpenRead = Classes.fmOpenRead; + fmOpenWrite = Classes.fmOpenWrite; + fmOpenReadWrite = Classes.fmOpenReadWrite; + soFromBeginning = Classes.soFromBeginning; + soFromCurrent = Classes.soFromCurrent; + soFromEnd = Classes.soFromEnd; + {$ENDIF} + +function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect; +function Point(AX, AY: Integer): TPoint; +function Size(AWidth, AHeight: Integer): TSize; +procedure IncF(var ADest: single; ADelta: single); overload; inline; +procedure IncF(var ADest: double; ADelta: double); overload; inline; +procedure DecF(var ADest: single; ADelta: single); overload; inline; +procedure DecF(var ADest: double; ADelta: double); overload; inline; +procedure Inc64(var AValue: int64; const ADelta: int64); overload; inline; +procedure Dec64(var AValue: int64; const ADelta: int64); overload; inline; +procedure Inc64(var AValue: uint64; const ADelta: uint64); overload; inline; +procedure Dec64(var AValue: uint64; const ADelta: uint64); overload; inline; + +implementation + +function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect; +begin + with Result do + begin + Left := ALeft; + Top := ATop; + Right := ARight; + Bottom := ABottom; + end; +end; + +{$IFDEF BGRA_DEFINE_TRECTF} +{ TRectF } + +function TRectF.GetHeight: single; +begin + result := Bottom-Top; +end; + +function TRectF.GetWidth: Single; +begin + result := Right-Left; +end; + +procedure TRectF.Offset(const dx, dy: Single); +begin + left:=left+dx; right:=right+dx; + bottom:=bottom+dy; top:=top+dy; +end; +{$ENDIF} + +function Point(AX, AY: Integer): TPoint; +begin + with Result do + begin + X := AX; + Y := AY; + end; +end; + +function Size(AWidth, AHeight: Integer): TSize; +begin + Result.cx := AWidth; + Result.cy := AHeight; +end; + +procedure IncF(var ADest: single; ADelta: single); +begin + ADest := ADest + ADelta; +end; + +procedure IncF(var ADest: double; ADelta: double); +begin + ADest := ADest + ADelta; +end; + +procedure DecF(var ADest: single; ADelta: single); +begin + ADest := ADest - ADelta; +end; + +procedure DecF(var ADest: double; ADelta: double); +begin + ADest := ADest - ADelta; +end; + +procedure Inc64(var AValue: int64; const ADelta: int64); +begin + {$IFDEF CPU64} + Inc(AValue, ADelta); + {$ELSE} + AValue := AValue + ADelta; + {$ENDIF} +end; + +procedure Dec64(var AValue: int64; const ADelta: int64); +begin + {$IFDEF CPU64} + Dec(AValue, ADelta); + {$ELSE} + AValue := AValue - ADelta; + {$ENDIF} +end; + +procedure Inc64(var AValue: uint64; const ADelta: uint64); +begin + {$IFDEF CPU64} + Inc(AValue, ADelta); + {$ELSE} + AValue := AValue + ADelta; + {$ENDIF} +end; + +procedure Dec64(var AValue: uint64; const ADelta: uint64); +begin + {$IFDEF CPU64} + Dec(AValue, ADelta); + {$ELSE} + AValue := AValue - ADelta; + {$ENDIF} +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracolorint.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracolorint.pas new file mode 100644 index 0000000..6551c68 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracolorint.pas @@ -0,0 +1,363 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAColorInt; + +{$mode objfpc}{$H+} +{$ifdef CPUI386} + {$define BGRACOLORINT_USEASM} +{$endif} +{$ifdef DARWIN} + {$undef BGRACOLORINT_USEASM} +{$endif} + +interface + +uses + BGRABitmapTypes; + +type + TColorInt65536 = packed record + r,g,b,a: integer; + end; + +function ColorInt65536(r,g,b,a: integer): TColorInt65536; inline; overload; +function ColorInt65536(r,g,b: integer): TColorInt65536; inline; overload; +function ColorFToColorInt65536(colorF: TColorF): TColorInt65536; inline; +function ColorInt65536ToColorF(color: TColorInt65536): TColorF; +operator +(const color1,color2: TColorInt65536): TColorInt65536; inline; +operator *(const color1,color2: TColorInt65536): TColorInt65536; +operator *(const color1: TColorInt65536; factor65536: integer): TColorInt65536; +function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean = false): TBGRAPixel; +function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean = false): TColorInt65536; +function BGRAToColorIntMultiply(const color1: TBGRAPixel; const color2: TColorInt65536): TColorInt65536; + +implementation + +function ColorInt65536(r, g, b, a: integer): TColorInt65536; +begin + result.r := r; + result.g := g; + result.b := b; + result.a := a; +end; + +function ColorInt65536(r, g, b: integer): TColorInt65536; +begin + result.r := r; + result.g := g; + result.b := b; + result.a := 65536; +end; + +function ColorFToColorInt65536(colorF: TColorF): TColorInt65536; +begin + result.r := round(colorF[1]*65536); + result.g := round(colorF[2]*65536); + result.b := round(colorF[3]*65536); + result.a := round(colorF[4]*65536); +end; + +function ColorInt65536ToColorF(color: TColorInt65536): TColorF; +const oneOver65536 = 1/65536; +begin + result[1] := color.r*oneOver65536; + result[2] := color.g*oneOver65536; + result[3] := color.b*oneOver65536; + result[4] := color.a*oneOver65536; +end; + +operator+(const color1, color2: TColorInt65536): TColorInt65536; +begin + result.r := color1.r+color2.r; + result.g := color1.g+color2.g; + result.b := color1.b+color2.b; + result.a := color1.a+color2.a; +end; + +operator*(const color1, color2: TColorInt65536): TColorInt65536; +{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; + asm + push edx + push ebx + push esi + mov ebx, Color1 + mov esi, Color2 + //ecx = @result + + mov eax, [ebx] //r + imul [esi] + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx], edx + + mov eax, [ebx+4] //g + imul [esi+4] + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+4], edx + + mov eax, [ebx+8] //b + imul [esi+8] + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+8], edx + + mov eax, [ebx+12] //a + imul [esi+12] + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+12], edx + + pop esi + pop ebx + pop edx + end; +{$ELSE} +begin + result.r := int64(color1.r)*color2.r shr 16; + result.g := int64(color1.g)*color2.g shr 16; + result.b := int64(color1.b)*color2.b shr 16; + result.a := int64(color1.a)*color2.a shr 16; +end; +{$ENDIF} + +operator*(const color1: TColorInt65536; factor65536: integer): TColorInt65536; +{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; + asm + push edx + push ebx + push esi + mov ebx, Color1 + mov esi, factor65536 + //ecx = @result + + mov eax, [ebx] //r + imul esi + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx], edx + + mov eax, [ebx+4] //g + imul esi + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+4], edx + + mov eax, [ebx+8] //b + imul esi + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+8], edx + + mov eax, [ebx+12] //a + imul esi + shl edx, 16 + shr eax, 16 + or edx, eax + mov [ecx+12], edx + + pop esi + pop ebx + pop edx + end; +{$else} +var prod: int64; +begin + prod := int64(color1.r)*factor65536; + if prod >= 0 then result.r := prod shr 16 + else result.r := -((-prod) shr 16); + prod := int64(color1.g)*factor65536; + if prod >= 0 then result.g := prod shr 16 + else result.g := -((-prod) shr 16); + prod := int64(color1.b)*factor65536; + if prod >= 0 then result.b := prod shr 16 + else result.b := -((-prod) shr 16); + prod := int64(color1.a)*factor65536; + if prod >= 0 then result.a := prod shr 16 + else result.a := -((-prod) shr 16); +end; +{$endif} + +function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean): TColorInt65536; +begin + if AGammaExpansion then + begin + result.r := GammaExpansionTab[AColor.red] + (AColor.red shr 7); + result.g := GammaExpansionTab[AColor.green] + (AColor.green shr 7); + result.b := GammaExpansionTab[AColor.blue] + (AColor.blue shr 7); + end else + begin + result.r := AColor.red shl 8 + AColor.red + (AColor.red shr 7); + result.g := AColor.green shl 8 + AColor.green + (AColor.green shr 7); + result.b := AColor.blue shl 8 + AColor.blue + (AColor.blue shr 7); + end; + result.a := AColor.alpha shl 8 + AColor.alpha+ (AColor.alpha shr 7); +end; + +function BGRAToColorIntMultiply(const color1: TBGRAPixel; + const color2: TColorInt65536): TColorInt65536; +{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; + asm + push ebx + push esi + + mov esi, Color2 + mov ebx, result + mov ecx, [Color1] + + mov eax, ecx + shr eax, TBGRAPixel_RedShift + and eax, 255 + mov edx, eax + shr edx, 7 + add eax, edx + imul [esi] + shl edx, 24 + shr eax, 8 + or edx, eax + mov [ebx], edx + + mov eax, ecx + shr eax, TBGRAPixel_GreenShift + and eax, 255 + mov edx, eax + shr edx, 7 + add eax, edx + imul [esi+4] + shl edx, 24 + shr eax, 8 + or edx, eax + mov [ebx+4], edx + + mov eax, ecx + shr eax, TBGRAPixel_BlueShift + and eax, 255 + mov edx, eax + shr edx, 7 + add eax, edx + imul [esi+8] + shl edx, 24 + shr eax, 8 + or edx, eax + mov [ebx+8], edx + + mov eax, ecx + shr eax, TBGRAPixel_AlphaShift + and eax, 255 + mov edx, eax + shr edx, 7 + add eax, edx + imul [esi+12] + shl edx, 24 + shr eax, 8 + or edx, eax + mov [ebx+12], edx + + pop esi + pop ebx + end; +{$ELSE} +begin + result.r := int64(color2.r)*(color1.red shr 7+color1.red) shr 8; + result.g := int64(color2.g)*(color1.green shr 7+color1.green) shr 8; + result.b := int64(color2.b)*(color1.blue shr 7+color1.blue) shr 8; + result.a := int64(color2.a)*(color1.alpha shr 7+color1.alpha) shr 8; +end; +{$ENDIF} + +function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean): TBGRAPixel; +var maxValue,invMaxValue,r,g,b: integer; +begin + if AColor.a <= 0 then + result.alpha := 0; + if AColor.a >= 65536 then + result.alpha := 255 + else + result.alpha := AColor.a shr 8 - (AColor.a shr 15); + + maxValue := AColor.r; + if AColor.g > maxValue then maxValue := AColor.g; + if AColor.b > maxValue then maxValue := AColor.b; + + if maxValue <= 0 then + begin + result.red := 0; + result.green := 0; + result.blue := 0; + exit; + end; + + if AGammaCompression then + begin + if maxValue <= 65535 then + begin + if AColor.r <= 0 then result.red := 0 else + result.red := GammaCompressionTab[AColor.r - (AColor.r shr 15)]; + + if AColor.g <= 0 then result.green := 0 else + result.green :=GammaCompressionTab[AColor.g - (AColor.g shr 15)]; + + if AColor.b <= 0 then result.blue := 0 else + result.blue := GammaCompressionTab[AColor.b - (AColor.b shr 15)]; + exit; + end; + + invMaxValue := (1073741824+maxValue-1) div maxValue; + + maxValue := (maxValue-65535) shr 1; + if AColor.r < 0 then r := maxValue else + r := AColor.r*invMaxValue shr 14 + maxValue; + if AColor.g < 0 then g := maxValue else + g := AColor.g*invMaxValue shr 14 + maxValue; + if AColor.b < 0 then b := maxValue else + b := AColor.b*invMaxValue shr 14 + maxValue; + + if r >= 65535 then result.red := 255 else + result.red := GammaCompressionTab[r]; + if g >= 65535 then result.green := 255 else + result.green := GammaCompressionTab[g]; + if b >= 65535 then result.blue := 255 else + result.blue := GammaCompressionTab[b]; + end else + begin + if maxValue <= 65535 then + begin + if AColor.r <= 0 then result.red := 0 else + result.red := AColor.r shr 8 - (AColor.r shr 15); + + if AColor.g <= 0 then result.green := 0 else + result.green := AColor.g shr 8 - (AColor.g shr 15); + + if AColor.b <= 0 then result.blue := 0 else + result.blue := AColor.b shr 8 - (AColor.b shr 15); + exit; + end; + + invMaxValue := (1073741824+maxValue-1) div maxValue; + + maxValue := (maxValue-65535) shr 9; + if AColor.r < 0 then r := maxValue else + r := AColor.r*invMaxValue shr 22 + maxValue; + if AColor.g < 0 then g := maxValue else + g := AColor.g*invMaxValue shr 22 + maxValue; + if AColor.b < 0 then b := maxValue else + b := AColor.b*invMaxValue shr 22 + maxValue; + + if r >= 255 then result.red := 255 else + result.red := r; + if g >= 255 then result.green := 255 else + result.green := g; + if b >= 255 then result.blue := 255 else + result.blue := b; + end; +end; + + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracolorquantization.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracolorquantization.pas new file mode 100644 index 0000000..4e130e0 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracolorquantization.pas @@ -0,0 +1,2037 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAColorQuantization; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAPalette, BGRABitmapTypes; + +type + TBGRAColorBox = class; + TBGRAColorTree = class; + TBGRAApproxPalette = class; + TBiggestLeafMethod = (blMix, blApparentInterval, blWeight); + + { TDimensionMinMax } + + TDimensionMinMax = object + Minimum: UInt32; + Maximum: UInt32; + function Size: UInt32; + function Contains(AValue: UInt32): boolean; + function PointLike: boolean; + procedure SetAsPoint(AValue: UInt32); + function GetCenter: UInt32; + procedure GrowToInclude(AValue: UInt32); + end; + + TColorDimension = (cdFast,cdRed,cdGreen,cdBlue,cdAlpha,cdRGB,cdRG,cdGB,cdRB,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG, + cdSaturation); + TColorDimensions = set of TColorDimension; + + { TBGRAColorQuantizer } + + TBGRAColorQuantizer = class(TBGRACustomColorQuantizer) + private + FColors: ArrayOfWeightedColor; + FPalette: TBGRAApproxPalette; + FReductionColorCount: Integer; + FReductionKeepContrast: boolean; + FSeparateAlphaChannel: boolean; + procedure Init(ABox: TBGRAColorBox); + procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, AAlphaBounds: TDimensionMinMax; AUniform: boolean); overload; + procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax); overload; + protected + function GetPalette: TBGRACustomApproxPalette; override; + function GetSourceColor(AIndex: integer): TBGRAPixel; override; + function GetSourceColorCount: Integer; override; + function GetReductionColorCount: integer; override; + procedure SetReductionColorCount(AValue: Integer); override; + public + constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); override; + constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); override; + constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); override; + constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); override; + destructor Destroy; override; + procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); override; + function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; override; + function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; override; + procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override; + end; + + { TBGRAApproxPalette } + + TBGRAApproxPalette = class(TBGRACustomApproxPalette) + private + FTree: TBGRAColorTree; + FColors: ArrayOfWeightedColor; + protected + function GetCount: integer; override; + function GetColorByIndex(AIndex: integer): TBGRAPixel; override; + function GetWeightByIndex(AIndex: Integer): UInt32; override; + procedure Init(const AColors: ArrayOfTBGRAPixel); + public + constructor Create(const AColors: ArrayOfTBGRAPixel); overload; + constructor Create(const AColors: ArrayOfWeightedColor); overload; + constructor Create(AOwnedSplitTree: TBGRAColorTree); overload; + destructor Destroy; override; + function ContainsColor(AValue: TBGRAPixel): boolean; override; + function IndexOfColor(AValue: TBGRAPixel): integer; override; + function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; + function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; + function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; + end; + + { TBGRAApproxPaletteViaLargerPalette } + + TBGRAApproxPaletteViaLargerPalette = class(TBGRAApproxPalette) + private + FLarger: TBGRACustomApproxPalette; + FLargerColors: array of record + approxColor: TBGRAPixel; + approxColorIndex: integer; + end; + FLargerOwned: boolean; + FTransparentColorIndex: integer; + protected + function FindNearestLargerColorIndex(AValue: TBGRAPixel): integer; virtual; + function SlowFindNearestColorIndex(AValue: TBGRAPixel): integer; + public + constructor Create(const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean); + destructor Destroy; override; + function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; + function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; + end; + + TIsChannelStrictlyGreaterFunc = TBGRAPixelComparer; + TIsChannelGreaterThanOrEqualToValueFunc = function (p : PBGRAPixel; v: UInt32): boolean; + + TColorBoxBounds = array[TColorDimension] of TDimensionMinMax; + + { TBGRAColorBox } + + TBGRAColorBox = class + private + FBounds: TColorBoxBounds; + FTotalWeight: UInt32; + FColors: ArrayOfWeightedColor; + FDimensions: TColorDimensions; + FPureTransparentColorCount: integer; + function GetApparentInterval(ADimension: TColorDimension): UInt32; + function GetAverageColor: TBGRAPixel; + function GetAverageColorOrMainColor: TBGRAPixel; + function GetBounds(ADimension: TColorDimension): TDimensionMinMax; + function GetColorCount(ACountPureTransparent: boolean): integer; + function GetHasPureTransparentColor: boolean; + function GetInferiorColor: TBGRAPixel; + function GetLargestApparentDimension: TColorDimension; + function GetLargestApparentInterval: UInt32; + function GetPointLike: boolean; + function GetSuperiorColor: TBGRAPixel; + procedure Init(AColors: ArrayOfWeightedColor; AOwner: boolean); + procedure SortBy(ADimension: TColorDimension); + function GetMedianIndex(ADimension : TColorDimension; AMinValue, AMaxValue: UInt32): integer; + public + constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); overload; + constructor Create(ADimensions: TColorDimensions; const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); overload; + constructor Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); overload; + constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload; + constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; + constructor Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); overload; + function BoundsContain(AColor: TBGRAPixel): boolean; + function MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32): TBGRAColorBox; + function Duplicate : TBGRAColorBox; + property Bounds[ADimension: TColorDimension]: TDimensionMinMax read GetBounds; + property ApparentInterval[AChannel: TColorDimension]: UInt32 read GetApparentInterval; + property LargestApparentDimension: TColorDimension read GetLargestApparentDimension; + property LargestApparentInterval: UInt32 read GetLargestApparentInterval; + property PointLike: boolean read GetPointLike; + property AverageColor: TBGRAPixel read GetAverageColor; + property SuperiorColor: TBGRAPixel read GetSuperiorColor; + property InferiorColor: TBGRAPixel read GetInferiorColor; + property AverageColorOrMainColor: TBGRAPixel read GetAverageColorOrMainColor; + function GetAsArrayOfColors(AIncludePureTransparent: boolean): ArrayOfTBGRAPixel; + property TotalWeight: UInt32 read FTotalWeight; + property ColorCount[ACountPureTransparent: boolean]: integer read GetColorCount; + property HasPureTransparentColor: boolean read GetHasPureTransparentColor; + property PureTransparentColorCount: integer read FPureTransparentColorCount; + end; + + TBGRALeafColorMode = (lcAverage, lcCenter, lcExtremum, lcMix); + + { TBGRAColorTree } + + TBGRAColorTree = class + private + FLeaf: TBGRAColorBox; + FIsLeaf: boolean; + FLargestApparentInterval: integer; + FWeight: UInt32; + + FLeafColor: TBGRAPixel; + FLeafColorIndex: integer; + FLeafColorComputed: boolean; + FMinBorder, FMaxBorder: array[TColorDimension] of boolean; + FCenterColor: TBGRAPixel; + FAverageColor: TBGRAPixel; + + FPureTransparentColorCount: integer; + FPureTransparentColorIndex: integer; + FDimension: TColorDimension; + FPixelValueComparer: TIsChannelGreaterThanOrEqualToValueFunc; + FSuperiorMiddle: UInt32; + FInferiorBranch, FSuperiorBranch: TBGRAColorTree; + function GetApproximatedColorCount: integer; + function GetHasPureTransparentColor: boolean; + function GetLeafCount: integer; + procedure Init(ALeaf: TBGRAColorBox; AOwned: boolean); + procedure InternalComputeLeavesColor(ALeafColor: TBGRALeafColorMode; var AStartIndex: integer); + procedure CheckColorComputed; + public + constructor Create(ABox: TBGRAColorBox; AOwned: boolean); overload; + constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload; + constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; + destructor Destroy; override; + procedure FreeLeaves; + function FindBiggestLeaf(AMethod: TBiggestLeafMethod): TBGRAColorTree; + property LargestApparentInterval: integer read FLargestApparentInterval; + property Weight: UInt32 read FWeight; + property IsLeaf: boolean read FIsLeaf; + function TrySplitLeaf: boolean; + procedure ComputeLeavesColor(ALeafColor: TBGRALeafColorMode); + function ApproximateColor(AColor: TBGRAPixel): TBGRAPixel; + function ApproximateColorIndex(AColor: TBGRAPixel): integer; + function GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel; + function GetAsArrayOfWeightedColors: ArrayOfWeightedColor; + procedure SplitIntoPalette(ACount: integer; AMethod: TBiggestLeafMethod; + ALeafColor: TBGRALeafColorMode); + function SplitIntoPaletteWithSubPalette(ACount: integer; AMethod: TBiggestLeafMethod; + ALeafColor: TBGRALeafColorMode; ASubPaletteCount: integer): ArrayOfTBGRAPixel; + property LeafCount: integer read GetLeafCount; + property ApproximatedColorCount: integer read GetApproximatedColorCount; + property HasPureTransparentColor: boolean read GetHasPureTransparentColor; + property PureTransparentColorCount: integer read FPureTransparentColorCount; + end; + +function GetPixelStrictComparer(ADimension: TColorDimension): TIsChannelStrictlyGreaterFunc; +function GetPixelValueComparer(ADimension: TColorDimension): TIsChannelGreaterThanOrEqualToValueFunc; +function BGRAColorCount(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; + +const AllColorDimensions = [cdRed,cdGreen,cdBlue,cdAlpha,cdRGB,cdRG,cdGB,cdRB,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG, + cdSaturation]; + +implementation + +uses BGRADithering, FPimage, FPWriteBMP, BGRAWritePNG, math; + +const MedianMinPercentage = 0.2; + +const RedShift = 1; + GreenShift = 2; + AlphaShift = 1; + SaturationShift = 2; + +function GetDimensionValue(APixel: TBGRAPixel; ADimension: TColorDimension): UInt32; +var v: UInt32; +begin + case ADimension of + cdFast: result := LongWord(APixel); + cdRed: result := GammaExpansionTab[APixel.red] shl RedShift; + cdGreen: result := GammaExpansionTab[APixel.green] shl GreenShift; + cdBlue: result := GammaExpansionTab[APixel.blue]; + cdAlpha: result := (APixel.alpha + (APixel.alpha shl 8)) shl AlphaShift; + cdRGB: result := GammaExpansionTab[APixel.blue] + (GammaExpansionTab[APixel.red] shl RedShift) + (GammaExpansionTab[APixel.green] shl GreenShift); + cdRG: result := (GammaExpansionTab[APixel.red] shl RedShift) + (GammaExpansionTab[APixel.green] shl GreenShift); + cdGB: result := GammaExpansionTab[APixel.blue] + (GammaExpansionTab[APixel.green] shl GreenShift); + cdRB: result := (GammaExpansionTab[APixel.red] shl RedShift) + GammaExpansionTab[APixel.blue]; + cdRInvG: result := (GammaExpansionTab[APixel.red] shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift); + cdGInvB: result := (GammaExpansionTab[APixel.green] shl GreenShift) + (not GammaExpansionTab[APixel.blue]); + cdRInvB: result := (GammaExpansionTab[APixel.red] shl RedShift) + (not GammaExpansionTab[APixel.blue]); + cdRInvGB: result := (GammaExpansionTab[APixel.red] shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift) + (not GammaExpansionTab[APixel.blue]); + cdGInvRB: result := (GammaExpansionTab[APixel.green] shl GreenShift) + ((not GammaExpansionTab[APixel.red]) shl RedShift) + (not GammaExpansionTab[APixel.blue]); + cdBInvRG: result := (GammaExpansionTab[APixel.blue]) + ((not GammaExpansionTab[APixel.red]) shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift); + cdSaturation: with GammaExpansion(APixel) do + begin + v := red; + if green>v then v := green; + if blue>v then v := blue; + result := v; + v := red; + if green + ((GammaExpansionTab[p2^.red] shl RedShift)+(GammaExpansionTab[p2^.green] shl GreenShift)+GammaExpansionTab[p2^.blue]); +end; + +function IsRGBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := ((GammaExpansionTab[red] shl RedShift)+(GammaExpansionTab[green] shl GreenShift)+GammaExpansionTab[blue]) >= v; +end; + +function IsRGGreater(p1, p2: PBGRAPixel): boolean; +begin + result := ((GammaExpansionTab[p1^.red] shl RedShift)+(GammaExpansionTab[p1^.green] shl GreenShift)) > + ((GammaExpansionTab[p2^.red] shl RedShift)+(GammaExpansionTab[p2^.green] shl GreenShift)); +end; + +function IsRGGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := ((GammaExpansionTab[red] shl RedShift)+(GammaExpansionTab[green] shl GreenShift)) >= v; +end; + +function IsGBGreater(p1, p2: PBGRAPixel): boolean; +begin + result := ((GammaExpansionTab[p1^.green] shl GreenShift)+GammaExpansionTab[p1^.blue]) > + ((GammaExpansionTab[p2^.green] shl GreenShift)+GammaExpansionTab[p2^.blue]); +end; + +function IsGBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := ((GammaExpansionTab[green] shl GreenShift)+GammaExpansionTab[blue]) >= v; +end; + +function IsRBGreater(p1, p2: PBGRAPixel): boolean; +begin + result := ((GammaExpansionTab[p1^.red] shl RedShift)+GammaExpansionTab[p1^.blue]) > + ((GammaExpansionTab[p2^.red] shl RedShift)+GammaExpansionTab[p2^.blue]); +end; + +function IsRBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := ((GammaExpansionTab[red] shl RedShift)+GammaExpansionTab[blue]) >= v; +end; + +function IsRInvGGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.red]+ ((not GammaExpansionTab[p1^.green]) shl GreenShift)) > + (GammaExpansionTab[p2^.red]+((not GammaExpansionTab[p2^.green]) shl GreenShift)); +end; + +function IsRInvGGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[red]+((not GammaExpansionTab[green]) shl GreenShift)) >= v; +end; + +function IsGInvBGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.green] shl GreenShift + not GammaExpansionTab[p1^.blue]) > + (GammaExpansionTab[p2^.green] shl GreenShift + not GammaExpansionTab[p2^.blue]); +end; + +function IsGInvBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[green] shl GreenShift + not GammaExpansionTab[blue]) >= v; +end; + +function IsRInvBGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.red] shl RedShift + not GammaExpansionTab[p1^.blue]) > + (GammaExpansionTab[p2^.red] shl RedShift + not GammaExpansionTab[p2^.blue]); +end; + +function IsRInvBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[red] shl RedShift + not GammaExpansionTab[blue]) >= v; +end; + +function IsRInvGBGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.red] shl RedShift + ((not GammaExpansionTab[p1^.green]) shl GreenShift) + not GammaExpansionTab[p1^.blue]) > + (GammaExpansionTab[p2^.red] shl RedShift + ((not GammaExpansionTab[p2^.green]) shl GreenShift) + not GammaExpansionTab[p2^.blue]); +end; + +function IsRInvGBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[red] shl RedShift + ((not GammaExpansionTab[green]) shl GreenShift) + not GammaExpansionTab[blue]) >= v; +end; + +function IsGInvRBGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.green] shl GreenShift + ((not GammaExpansionTab[p1^.red]) shl RedShift) + not GammaExpansionTab[p1^.blue]) > + (GammaExpansionTab[p2^.green] shl GreenShift + ((not GammaExpansionTab[p2^.red]) shl RedShift) + not GammaExpansionTab[p2^.blue]); +end; + +function IsGInvRBGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[green] shl GreenShift + ((not GammaExpansionTab[red]) shl RedShift) + not GammaExpansionTab[blue]) >= v; +end; + +function IsBInvRGGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := (GammaExpansionTab[p1^.blue] + ((not GammaExpansionTab[p1^.red]) shl RedShift) + ((not GammaExpansionTab[p1^.green]) shl GreenShift)) > + (GammaExpansionTab[p2^.blue] + ((not GammaExpansionTab[p2^.red]) shl RedShift) + ((not GammaExpansionTab[p2^.green]) shl GreenShift)); +end; + +function IsBInvRGGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + with p^ do + result := (GammaExpansionTab[blue] + ((not GammaExpansionTab[red]) shl RedShift) + ((not GammaExpansionTab[green]) shl GreenShift)) >= v; +end; + +function IsSaturationGreater(p1, p2: PBGRAPixel): boolean; +begin + result := GetDimensionValue(p1^,cdSaturation) > GetDimensionValue(p2^,cdSaturation); +end; + +function IsSaturationGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := GetDimensionValue(p^,cdSaturation) >= v; +end; + +function IsRedGreater(p1, p2: PBGRAPixel): boolean; +begin + result := p1^.red > p2^.red; +end; + +function IsRedGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := GammaExpansionTab[p^.red] shl RedShift >= v; +end; + +function IsGreenGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := p1^.green > p2^.green; +end; + +function IsGreenGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := GammaExpansionTab[p^.green] shl GreenShift >= v; +end; + +function IsBlueGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := p1^.blue > p2^.blue; +end; + +function IsBlueGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := GammaExpansionTab[p^.blue] >= v; +end; + +function IsAlphaGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := p1^.alpha > p2^.alpha; +end; + +function IsAlphaGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := (p^.alpha + p^.alpha shl 8) shl AlphaShift >= v; +end; + +function IsDWordGreater(p1, p2: PBGRAPixel + ): boolean; +begin + result := LongWord(p1^) > LongWord(p2^); +end; + +function IsDWordGreaterThanValue(p: PBGRAPixel; + v: UInt32): boolean; +begin + result := LongWord(p^) >= v; +end; + +function GetPixelStrictComparer(ADimension: TColorDimension + ): TIsChannelStrictlyGreaterFunc; +begin + case ADimension of + cdFast: result := @IsDWordGreater; + cdRed: result := @IsRedGreater; + cdGreen: result := @IsGreenGreater; + cdBlue: result := @IsBlueGreater; + cdAlpha: result := @IsAlphaGreater; + cdRGB: result := @IsRGBGreater; + cdRG: result := @IsRGGreater; + cdGB: result := @IsGBGreater; + cdRB: result := @IsRBGreater; + cdRInvG: result := @IsRInvGGreater; + cdGInvB: result := @IsGInvBGreater; + cdRInvB: result := @IsRInvBGreater; + cdRInvGB: result := @IsRInvGBGreater; + cdGInvRB: result := @IsGInvRBGreater; + cdBInvRG: result := @IsBInvRGGreater; + cdSaturation: result := @IsSaturationGreater; + else raise Exception.Create('Unknown dimension'); + end; +end; + +function GetPixelValueComparer(ADimension: TColorDimension + ): TIsChannelGreaterThanOrEqualToValueFunc; +begin + case ADimension of + cdFast: result := @IsDWordGreaterThanValue; + cdRed: result := @IsRedGreaterThanValue; + cdGreen: result := @IsGreenGreaterThanValue; + cdBlue: result := @IsBlueGreaterThanValue; + cdAlpha: result := @IsAlphaGreaterThanValue; + cdRGB: result := @IsRGBGreaterThanValue; + cdRG: result := @IsRGGreaterThanValue; + cdGB: result := @IsGBGreaterThanValue; + cdRB: result := @IsRBGreaterThanValue; + cdRInvG: result := @IsRInvGGreaterThanValue; + cdGInvB: result := @IsGInvBGreaterThanValue; + cdRInvB: result := @IsRInvBGreaterThanValue; + cdRInvGB: result := @IsRInvGBGreaterThanValue; + cdGInvRB: result := @IsGInvRBGreaterThanValue; + cdBInvRG: result := @IsBInvRGGreaterThanValue; + cdSaturation: result := @IsSaturationGreaterThanValue; + else raise Exception.Create('Unknown dimension'); + end; +end; + +function BGRAColorCount(ABitmap: TBGRACustomBitmap; + AAlpha: TAlphaChannelPaletteOption): integer; +var + box: TBGRAColorBox; +begin + box := TBGRAColorBox.Create(AllColorDimensions,ABitmap,AAlpha); + result := box.ColorCount[True]; + box.Free; +end; + +const + ApproxPaletteDimensions = [cdAlpha,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG,cdRGB]; + +{ TBGRAApproxPaletteViaLargerPalette } + +function TBGRAApproxPaletteViaLargerPalette.FindNearestLargerColorIndex( + AValue: TBGRAPixel): integer; +begin + result := FLarger.FindNearestColorIndex(AValue); +end; + +function TBGRAApproxPaletteViaLargerPalette.SlowFindNearestColorIndex( + AValue: TBGRAPixel): integer; +var diff,curDiff: Int32or64; + i: Int32or64; +begin + if AValue.alpha = 0 then + begin + result := FTransparentColorIndex; + exit; + end; + diff := BGRAWordDiff(AValue, FColors[0].Color); + result := 0; + for i := 0 to high(FColors) do + begin + curDiff := BGRAWordDiff(AValue, FColors[i].Color); + if curDiff < diff then + begin + result := i; + diff := curDiff; + end; + end; +end; + +constructor TBGRAApproxPaletteViaLargerPalette.Create( + const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean); +var i: integer; + largeWeighted: ArrayOfWeightedColor; +begin + inherited Create(AColors); + FTransparentColorIndex:= -1; + for i := 0 to high(FColors) do + begin + FColors[i].Weight := 0; + if FColors[i].Color.alpha = 0 then FTransparentColorIndex:= i; + end; + FLarger := ALarger; + FLargerOwned := ALargerOwned; + largeWeighted := FLarger.GetAsArrayOfWeightedColor; + setlength(FLargerColors, length(largeWeighted)); + for i := 0 to high(FLargerColors) do + with FLargerColors[i] do + begin + approxColorIndex := SlowFindNearestColorIndex(largeWeighted[i].Color); + if approxColorIndex = -1 then + approxColor := BGRAPixelTransparent + else + begin + approxColor := FColors[approxColorIndex].Color; + inc(FColors[approxColorIndex].Weight, largeWeighted[i].Weight); + end; + end; +end; + +destructor TBGRAApproxPaletteViaLargerPalette.Destroy; +begin + if FLargerOwned then FreeAndNil(FLarger); + inherited Destroy; +end; + +function TBGRAApproxPaletteViaLargerPalette.FindNearestColor(AValue: TBGRAPixel + ): TBGRAPixel; +var index: integer; +begin + index := FindNearestLargerColorIndex(AValue); + if index = -1 then + result := BGRAPixelTransparent + else + Result:= FLargerColors[index].approxColor; +end; + +function TBGRAApproxPaletteViaLargerPalette.FindNearestColorIndex( + AValue: TBGRAPixel): integer; +var index: integer; +begin + index := FindNearestLargerColorIndex(AValue); + if index = -1 then + result := -1 + else + Result:= FLargerColors[index].approxColorIndex; +end; + +function TBGRAApproxPaletteViaLargerPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; +var + i: Integer; +begin + setlength(result, length(FColors)); + for i := 0 to high(FColors) do + result[i] := FColors[i]; +end; + +{ TBGRAApproxPalette } + +function TBGRAApproxPalette.GetCount: integer; +begin + result := length(FColors); +end; + +function TBGRAApproxPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; +begin + if (AIndex < 0) or (AIndex >= length(FColors)) then + raise ERangeError.Create('Index out of bounds'); + result := FColors[AIndex].Color; +end; + +function TBGRAApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32; +begin + if (AIndex < 0) or (AIndex >= length(FColors)) then + raise ERangeError.Create('Index out of bounds'); + result := FColors[AIndex].Weight; +end; + +procedure TBGRAApproxPalette.Init(const AColors: ArrayOfTBGRAPixel); +var + weightedColors: ArrayOfWeightedColor; + i: Int32or64; +begin + setlength(weightedColors, length(AColors)); + for i := 0 to high(weightedColors) do + with weightedColors[i] do + begin + Color := AColors[i]; + Weight := 1; + end; + FTree := TBGRAColorTree.Create(TBGRAColorBox.Create(ApproxPaletteDimensions,weightedColors,True),True); + FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage); + + FColors := FTree.GetAsArrayOfWeightedColors; +end; + +constructor TBGRAApproxPalette.Create(const AColors: ArrayOfTBGRAPixel); +begin + Init(AColors); +end; + +constructor TBGRAApproxPalette.Create(const AColors: ArrayOfWeightedColor); +begin + FTree := TBGRAColorTree.Create(TBGRAColorBox.Create(ApproxPaletteDimensions,AColors,True),True); + FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage); + + FColors := FTree.GetAsArrayOfWeightedColors; +end; + +constructor TBGRAApproxPalette.Create(AOwnedSplitTree: TBGRAColorTree); +begin + FTree := AOwnedSplitTree; + FColors := FTree.GetAsArrayOfWeightedColors; +end; + +destructor TBGRAApproxPalette.Destroy; +begin + FreeAndNil(FTree); + inherited Destroy; +end; + +function TBGRAApproxPalette.ContainsColor(AValue: TBGRAPixel): boolean; +begin + result := (IndexOfColor(AValue)<>-1); +end; + +function TBGRAApproxPalette.IndexOfColor(AValue: TBGRAPixel): integer; +begin + result := FTree.ApproximateColorIndex(AValue); + if (result <> -1) and not (LongWord(FColors[result].Color) = LongWord(AValue)) then result := -1; +end; + +function TBGRAApproxPalette.FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; +begin + result := FTree.ApproximateColor(AValue); +end; + +function TBGRAApproxPalette.FindNearestColorIndex(AValue: TBGRAPixel): integer; +begin + result := FTree.ApproximateColorIndex(AValue); +end; + +function TBGRAApproxPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; +var + i: Int32or64; +begin + setlength(result, length(FColors)); + for i := 0 to high(result) do + result[i] := FColors[i].Color; +end; + +function TBGRAApproxPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; +var + i: Int32or64; +begin + if Assigned(FTree) then + result := FTree.GetAsArrayOfWeightedColors + else + begin + setlength(result, length(FColors)); + for i := 0 to high(result) do + result[i] := FColors[i]; + end; +end; + +{ TBGRAColorQuantizer } + +procedure TBGRAColorQuantizer.Init(ABox: TBGRAColorBox); +begin + FColors := ABox.FColors; + if ABox.HasPureTransparentColor then + begin + setlength(FColors,length(FColors)+1); + with FColors[high(FColors)] do + begin + Color := BGRAPixelTransparent; + Weight:= ABox.PureTransparentColorCount; + end; + end; + ABox.FColors := nil; + ABox.Free; + FReductionColorCount := 256; + FReductionKeepContrast := true; +end; + +procedure TBGRAColorQuantizer.SetReductionColorCount(AValue: Integer); +begin + if AValue < 1 then AValue := 1; + if FReductionColorCount=AValue then Exit; + FReductionColorCount:=AValue; + FreeAndNil(FPalette); +end; + +procedure TBGRAColorQuantizer.NormalizeArrayOfColors( + AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, + AAlphaBounds: TDimensionMinMax; AUniform: boolean); +var + curRedBounds, curGreenBounds, curBlueBounds, curAlphaBounds: TDimensionMinMax; + RedSub,RedMul,RedDiv,RedAdd: UInt32or64; + GreenSub,GreenMul,GreenDiv,GreenAdd: UInt32or64; + BlueSub,BlueMul,BlueDiv,BlueAdd: UInt32or64; + AlphaSub,AlphaMul,AlphaDiv,AlphaAdd: UInt32or64; + i: Int32or64; + colorBounds: TDimensionMinMax; +begin + if length(AColors)=0 then exit; + if AUniform then + begin + colorBounds := ABlueBounds; + colorBounds.GrowToInclude(AGreenBounds.Minimum shr GreenShift); + colorBounds.GrowToInclude(AGreenBounds.Maximum shr GreenShift); + colorBounds.GrowToInclude(ARedBounds.Minimum shr RedShift); + colorBounds.GrowToInclude(ARedBounds.Maximum shr RedShift); + NormalizeArrayOfColors(AColors, colorBounds, AAlphaBounds); + exit; + end; + curRedBounds.SetAsPoint(GetDimensionValue(AColors[0],cdRed)); + curGreenBounds.SetAsPoint(GetDimensionValue(AColors[0],cdGreen)); + curBlueBounds.SetAsPoint(GetDimensionValue(AColors[0],cdBlue)); + curAlphaBounds.SetAsPoint(GetDimensionValue(AColors[0],cdAlpha)); + for i := 1 to high(AColors) do + with AColors[i] do + begin + curRedBounds.GrowToInclude(GetDimensionValue(AColors[i],cdRed)); + curGreenBounds.GrowToInclude(GetDimensionValue(AColors[i],cdGreen)); + curBlueBounds.GrowToInclude(GetDimensionValue(AColors[i],cdBlue)); + curAlphaBounds.GrowToInclude(GetDimensionValue(AColors[i],cdAlpha)); + end; + RedSub := curRedBounds.Minimum shr RedShift; + RedMul := ARedBounds.Size shr RedShift; + RedDiv := curRedBounds.Size shr RedShift; + RedAdd := ARedBounds.Minimum shr RedShift; + if RedDiv = 0 then RedDiv := 1; + GreenSub := curGreenBounds.Minimum shr GreenShift; + GreenMul := AGreenBounds.Size shr GreenShift; + GreenDiv := curGreenBounds.Size shr GreenShift; + GreenAdd := AGreenBounds.Minimum shr GreenShift; + if GreenDiv = 0 then GreenDiv := 1; + BlueSub := curBlueBounds.Minimum; + BlueMul := ABlueBounds.Size; + BlueDiv := curBlueBounds.Size; + BlueAdd := ABlueBounds.Minimum; + if BlueDiv = 0 then BlueDiv := 1; + AlphaSub := curAlphaBounds.Minimum shr (AlphaShift+8); + AlphaMul := AAlphaBounds.Size shr (AlphaShift+8); + AlphaDiv := curAlphaBounds.Size shr (AlphaShift+8); + AlphaAdd := AAlphaBounds.Minimum shr (AlphaShift+8); + if AlphaDiv = 0 then AlphaDiv := 1; + for i := 0 to high(AColors) do + with AColors[i] do + begin + red := GammaCompressionTab[((GammaExpansionTab[red]-RedSub)*RedMul+(RedDiv shr 1)) div RedDiv + RedAdd]; + green := GammaCompressionTab[((GammaExpansionTab[green]-GreenSub)*GreenMul+(GreenDiv shr 1)) div GreenDiv + GreenAdd]; + blue := GammaCompressionTab[((GammaExpansionTab[blue]-BlueSub)*BlueMul+(BlueDiv shr 1)) div BlueDiv + BlueAdd]; + alpha := ((alpha-AlphaSub)*AlphaMul+(AlphaDiv shr 1)) div AlphaDiv + AlphaAdd; + end; +end; + +procedure TBGRAColorQuantizer.NormalizeArrayOfColors( + AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax); +var + curColorBounds, curAlphaBounds: TDimensionMinMax; + ColorSub,ColorMul,ColorDiv,ColorAdd: UInt32or64; + AlphaSub,AlphaMul,AlphaDiv,AlphaAdd: UInt32or64; + i: Int32or64; +begin + if length(AColors)=0 then exit; + curColorBounds.SetAsPoint(GammaExpansionTab[AColors[0].red]); + curColorBounds.GrowToInclude(GammaExpansionTab[AColors[0].green]); + curColorBounds.GrowToInclude(GammaExpansionTab[AColors[0].blue]); + curAlphaBounds.SetAsPoint(AColors[0].alpha); + for i := 1 to high(AColors) do + with AColors[i] do + begin + curColorBounds.GrowToInclude(GammaExpansionTab[red]); + curColorBounds.GrowToInclude(GammaExpansionTab[green]); + curColorBounds.GrowToInclude(GammaExpansionTab[blue]); + curAlphaBounds.GrowToInclude(alpha); + end; + ColorSub := curColorBounds.Minimum; + ColorMul := AColorBounds.Size; + ColorDiv := curColorBounds.Size; + ColorAdd := AColorBounds.Minimum; + if ColorDiv = 0 then ColorDiv := 1; + AlphaSub := curAlphaBounds.Minimum; + AlphaMul := AAlphaBounds.Size shr 8; + AlphaDiv := curAlphaBounds.Size; + AlphaAdd := AAlphaBounds.Minimum shr 8; + if AlphaDiv = 0 then AlphaDiv := 1; + for i := 0 to high(AColors) do + with AColors[i] do + begin + red := GammaCompressionTab[((GammaExpansionTab[red]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; + green := GammaCompressionTab[((GammaExpansionTab[green]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; + blue := GammaCompressionTab[((GammaExpansionTab[blue]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; + alpha := ((alpha-AlphaSub)*AlphaMul+(AlphaDiv shr 1)) div AlphaDiv + AlphaAdd; + end; +end; + +function TBGRAColorQuantizer.GetSourceColorCount: Integer; +begin + result := length(FColors); +end; + +function TBGRAColorQuantizer.GetReductionColorCount: integer; +begin + result := FReductionColorCount; +end; + +function TBGRAColorQuantizer.GetPalette: TBGRACustomApproxPalette; +var + tree: TBGRAColorTree; + + procedure MakeTreeErrorDiffusionFriendly; + var moreColors: ArrayOfWeightedColor; + box: TBGRAColorBox; + begin + moreColors := tree.GetAsArrayOfWeightedColors; + tree.free; + box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors,True); + tree := TBGRAColorTree.Create(box,True); + tree.SplitIntoPalette(box.ColorCount[true], blApparentInterval, lcAverage); + end; + +var + originalBox: TBGRAColorBox; + colors: ArrayOfTBGRAPixel; + bounds: array[TColorDimension] of TDimensionMinMax; + nbLarge,nbOriginal: integer; + +begin + if not Assigned(FPalette) then + if FReductionColorCount >= length(FColors) then + begin + originalBox := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],FColors, False); + tree := TBGRAColorTree.Create(originalBox,True); + tree.SplitIntoPalette(originalBox.ColorCount[true], blApparentInterval, lcAverage); + FPalette := TBGRAApproxPalette.Create(tree); + end else + begin + originalBox := TBGRAColorBox.Create(AllColorDimensions, FColors, False); + bounds[cdRed] := originalBox.Bounds[cdRed]; + bounds[cdGreen] := originalBox.Bounds[cdGreen]; + bounds[cdBlue] := originalBox.Bounds[cdBlue]; + bounds[cdAlpha] := originalBox.Bounds[cdAlpha]; + if originalBox.HasPureTransparentColor then bounds[cdAlpha].Minimum := 0; + if FReductionColorCount = 1 then + begin + setlength(colors,1); + colors[0] := originalBox.AverageColor; + originalBox.Free; + FPalette := TBGRAApproxPalette.Create(colors); + end else + begin + tree := TBGRAColorTree.Create(originalBox,True); + if FReductionColorCount <= 64 then + begin + nbLarge := 128; + nbOriginal := originalBox.ColorCount[True]; + if nbOriginal < 128 then nbLarge:= nbOriginal; + colors := tree.SplitIntoPaletteWithSubPalette(nbLarge, blMix,lcMix, FReductionColorCount); + MakeTreeErrorDiffusionFriendly; + if FReductionColorCount <= 4 then + NormalizeArrayOfColors(colors, bounds[cdRed],bounds[cdGreen],bounds[cdBlue],bounds[cdAlpha],true); + FPalette := TBGRAApproxPaletteViaLargerPalette.Create(colors, TBGRAApproxPalette.Create(tree), True); + end else + begin + tree.SplitIntoPalette(FReductionColorCount, blMix,lcMix); + MakeTreeErrorDiffusionFriendly; + FPalette := TBGRAApproxPalette.Create(tree); + end; + end; + end; + result := FPalette; +end; + +function TBGRAColorQuantizer.GetSourceColor(AIndex: integer): TBGRAPixel; +begin + if (AIndex < 0) or (AIndex >= length(FColors)) then + raise ERangeError.Create('Index out of bounds'); + result := FColors[AIndex].Color; +end; + +constructor TBGRAColorQuantizer.Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); +begin + FSeparateAlphaChannel:= ASeparateAlphaChannel; + Init(TBGRAColorBox.Create(AllColorDimensions, APalette)); +end; + +constructor TBGRAColorQuantizer.Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); +begin + FSeparateAlphaChannel:= (AAlpha = acIgnore); + Init(TBGRAColorBox.Create(AllColorDimensions, ABitmap, AAlpha)); +end; + +constructor TBGRAColorQuantizer.Create(APalette: TBGRACustomPalette; + ASeparateAlphaChannel: boolean; AReductionColorCount: integer); +begin + FSeparateAlphaChannel:= ASeparateAlphaChannel; + Init(TBGRAColorBox.Create(AllColorDimensions, APalette)); + ReductionColorCount := AReductionColorCount; +end; + +constructor TBGRAColorQuantizer.Create(ABitmap: TBGRACustomBitmap; + AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); +begin + FSeparateAlphaChannel:= (AAlpha = acIgnore); + Init(TBGRAColorBox.Create(AllColorDimensions, ABitmap, AAlpha)); + ReductionColorCount := AReductionColorCount; +end; + +destructor TBGRAColorQuantizer.Destroy; +begin + FreeAndNil(FPalette); + inherited Destroy; +end; + +procedure TBGRAColorQuantizer.ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + ABounds: TRect); +var task: TDitheringTask; +begin + task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel, ABounds); + task.Destination := ABitmap; + task.Execute; + task.Free; +end; + +function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; +var task: TDitheringTask; +begin + task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel, ABounds); + result := task.Execute; + task.Free; +end; + +function TBGRAColorQuantizer.GetDitheredBitmapIndexedData( + ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + out AScanlineSize: PtrInt): Pointer; +var + indexer: TDitheringToIndexedImage; +begin + indexer := TDitheringToIndexedImage.Create(ReducedPalette, FSeparateAlphaChannel, ABitDepth, AByteOrder); + indexer.DefaultTransparentColorIndex := ReducedPalette.IndexOfColor(BGRAPixelTransparent); + AScanlineSize:= indexer.ComputeMinimumScanlineSize(ABitmap.Width); + result := indexer.DitherImage(AAlgorithm, ABitmap, AScanlineSize); + indexer.Free; +end; + +procedure TBGRAColorQuantizer.SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + AStream: TStream; AFormat: TBGRAImageFormat); +var + dithered: TBGRACustomBitmap; + hasTransp: boolean; + writer: TFPCustomImageWriter; + depth: integer; +begin + dithered := GetDitheredBitmap(AAlgorithm, ABitmap); + try + ReducedPalette.AssignTo(dithered); + hasTransp := dithered.HasTransparentPixels; + writer := CreateBGRAImageWriter(AFormat, hasTransp); + try + if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).Indexed := true else + if writer is TFPWriterBMP then + begin + if not hasTransp then + begin + depth := BGRARequiredBitDepth(ReducedPalette); + if depth < 8 then + begin + if depth > 4 then + depth := 8 + else if depth > 1 then + depth := 4; + end; + TFPWriterBMP(writer).BitsPerPixel := depth; + end; + end; + dithered.SaveToStream(AStream, writer); + finally + writer.Free; + end; + finally + dithered.Free; + end; +end; + +{ TBGRAColorTree } + +function TBGRAColorTree.TrySplitLeaf: boolean; +var + dim: TColorDimension; + box2: TBGRAColorBox; + mid: UInt32; +begin + result := false; + if IsLeaf and Assigned(FLeaf) and not FLeaf.PointLike then + begin + dim := FLeaf.LargestApparentDimension; + box2 := FLeaf.MedianCut(dim,mid); + if box2 <> nil then + begin + FInferiorBranch := TBGRAColorTree.Create(FLeaf,True); + FSuperiorBranch := TBGRAColorTree.Create(box2,True); + + FInferiorBranch.FMinBorder := FMinBorder; + FInferiorBranch.FMaxBorder := FMaxBorder; + FSuperiorBranch.FMinBorder := FMinBorder; + FSuperiorBranch.FMaxBorder := FMaxBorder; + FInferiorBranch.FMaxBorder[dim] := false; + FSuperiorBranch.FMinBorder[dim] := false; + + FLeaf := nil; + FIsLeaf:= false; + FDimension := dim; + FPixelValueComparer := GetPixelValueComparer(FDimension); + FSuperiorMiddle := mid; + result := true; + end; + end; +end; + +procedure TBGRAColorTree.ComputeLeavesColor(ALeafColor: TBGRALeafColorMode); +var index: integer; +begin + index := 0; + if HasPureTransparentColor then + begin + FPureTransparentColorIndex:= index; + inc(index); + end; + InternalComputeLeavesColor(ALeafColor,{%H-}index); +end; + +procedure TBGRAColorTree.InternalComputeLeavesColor( + ALeafColor: TBGRALeafColorMode; var AStartIndex: integer); +var nbMin,nbMax: Int32or64; + c: TColorDimension; + extremumColor: TBGRAPixel; + extremumColorRelevant: Boolean; +begin + if IsLeaf then + begin + FLeafColorIndex := AStartIndex; + inc(AStartIndex); + if Assigned(FLeaf) then + begin + if not FLeafColorComputed then + begin + FLeafColorComputed := true; + FCenterColor.alpha:= min(FLeaf.FBounds[cdAlpha].GetCenter shr AlphaShift, 255); + FCenterColor.red:= GammaCompressionTab[min(FLeaf.FBounds[cdRed].GetCenter shr RedShift, 65535)]; + FCenterColor.green:= GammaCompressionTab[min(FLeaf.FBounds[cdGreen].GetCenter shr GreenShift, 65535)]; + FCenterColor.blue:= GammaCompressionTab[min(FLeaf.FBounds[cdBlue].GetCenter, 65535)]; + FAverageColor := FLeaf.AverageColorOrMainColor; + extremumColor := FAverageColor; + + if ALeafColor in [lcMix,lcExtremum] then + begin + nbMax := 0; + nbMin := 0; + for c := succ(low(TColorDimension)) to high(TColorDimension) do + begin + if FMinBorder[c] then inc(nbMin); + if FMaxBorder[c] then inc(nbMax); + end; + + if nbMin > nbMax then + extremumColor := FLeaf.InferiorColor + else if nbMax > nbMin then + extremumColor := FLeaf.SuperiorColor; + end; + + case ALeafColor of + lcAverage,lcMix: FLeafColor := FAverageColor; + lcExtremum: FLeafColor := extremumColor; + else FLeafColor := FCenterColor; + end; + + if ALeafColor = lcMix then + begin + extremumColorRelevant := false; + for c := succ(low(TColorDimension)) to high(TColorDimension) do + if UInt32(abs(GetDimensionValue(extremumColor,c) - GetDimensionValue(FLeafColor,c))) > + FLeaf.FBounds[c].Size div 7 then + begin + extremumColorRelevant := true; + break; + end; + if extremumColorRelevant then FLeafColor := extremumColor; + end; + end; + end else + begin + FLeafColor := BGRAPixelTransparent; + FCenterColor := BGRAPixelTransparent; + end; + end else + begin + if Assigned(FInferiorBranch) then FInferiorBranch.InternalComputeLeavesColor(ALeafColor, AStartIndex); + if Assigned(FSuperiorBranch) then FSuperiorBranch.InternalComputeLeavesColor(ALeafColor, AStartIndex); + end; +end; + +procedure TBGRAColorTree.CheckColorComputed; +begin + if not FLeafColorComputed then + raise exception.Create('Color not computed. Call ComputeLeavesColor first.'); +end; + +function TBGRAColorTree.ApproximateColor(AColor: TBGRAPixel): TBGRAPixel; +var branch: TBGRAColorTree; +begin + if AColor.alpha = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + if IsLeaf then + begin + CheckColorComputed; + result := FLeafColor; + end else + begin + if FPixelValueComparer(@AColor,FSuperiorMiddle) then + branch := FSuperiorBranch else branch := FInferiorBranch; + if Assigned(branch) then + result := branch.ApproximateColor(AColor) + else + result := BGRAPixelTransparent; + end; +end; + +function TBGRAColorTree.ApproximateColorIndex(AColor: TBGRAPixel): integer; +var branch: TBGRAColorTree; +begin + if AColor.alpha = 0 then + begin + result := FPureTransparentColorIndex; + exit; + end; + if IsLeaf then + begin + CheckColorComputed; + result := FLeafColorIndex; + end else + begin + if FPixelValueComparer(@AColor,FSuperiorMiddle) then + branch := FSuperiorBranch else branch := FInferiorBranch; + if Assigned(branch) then + result := branch.ApproximateColorIndex(AColor) + else + result := FPureTransparentColorIndex; + end; +end; + +function TBGRAColorTree.GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel; +var a,b: ArrayOfTBGRAPixel; + idx,i: integer; +begin + if IsLeaf then + begin + CheckColorComputed; + setlength(result,1+byte(HasPureTransparentColor)); + idx := 0; + if HasPureTransparentColor then + begin + result[idx] := BGRAPixelTransparent; + inc(idx); + end; + result[idx] := FLeafColor; + end else + begin + a := FInferiorBranch.GetAsArrayOfApproximatedColors; + b := FSuperiorBranch.GetAsArrayOfApproximatedColors; + setlength(result, length(a)+length(b)+byte(HasPureTransparentColor)); + idx := 0; + if HasPureTransparentColor then + begin + result[idx] := BGRAPixelTransparent; + inc(idx); + end; + for i := 0 to high(a) do + begin + result[idx] := a[i]; + inc(idx); + end; + for i := 0 to high(b) do + begin + result[idx] := b[i]; + inc(idx); + end; + end; +end; + +function TBGRAColorTree.GetAsArrayOfWeightedColors: ArrayOfWeightedColor; +var a,b: ArrayOfWeightedColor; + idx,i: integer; +begin + if IsLeaf then + begin + CheckColorComputed; + setlength(result,1+byte(HasPureTransparentColor)); + idx := 0; + if HasPureTransparentColor then + begin + result[idx].Color := BGRAPixelTransparent; + result[idx].Weight := PureTransparentColorCount; + inc(idx); + end; + result[idx].Color := FLeafColor; + result[idx].Weight := Weight; + end else + begin + a := FInferiorBranch.GetAsArrayOfWeightedColors; + b := FSuperiorBranch.GetAsArrayOfWeightedColors; + setlength(result, length(a)+length(b)+byte(HasPureTransparentColor)); + idx := 0; + if HasPureTransparentColor then + begin + result[idx].Color := BGRAPixelTransparent; + result[idx].Weight := PureTransparentColorCount; + inc(idx); + end; + for i := 0 to high(a) do + begin + result[idx] := a[i]; + inc(idx); + end; + for i := 0 to high(b) do + begin + result[idx] := b[i]; + inc(idx); + end; + end; +end; + +procedure TBGRAColorTree.SplitIntoPalette(ACount: integer; + AMethod: TBiggestLeafMethod; ALeafColor: TBGRALeafColorMode); +var nbColors: integer; + leaf: TBGRAColorTree; +begin + nbColors := ApproximatedColorCount; + while nbColors < ACount do + begin + leaf := FindBiggestLeaf(AMethod); + if not leaf.TrySplitLeaf then break; + inc(nbColors); + end; + ComputeLeavesColor(ALeafColor); + FreeLeaves; +end; + +function TBGRAColorTree.SplitIntoPaletteWithSubPalette(ACount: integer; + AMethod: TBiggestLeafMethod; ALeafColor: TBGRALeafColorMode; + ASubPaletteCount: integer): ArrayOfTBGRAPixel; +var nbColors: integer; + leaf: TBGRAColorTree; +begin + result := nil; + nbColors := ApproximatedColorCount; + if ASubPaletteCount > ACount then ASubPaletteCount:= ACount; + if nbColors = ASubPaletteCount then + begin + ComputeLeavesColor(ALeafColor); + result := GetAsArrayOfApproximatedColors; + end; + while nbColors < ACount do + begin + leaf := FindBiggestLeaf(AMethod); + if not leaf.TrySplitLeaf then break; + inc(nbColors); + if nbColors = ASubPaletteCount then + begin + ComputeLeavesColor(ALeafColor); + result := GetAsArrayOfApproximatedColors; + end; + end; + ComputeLeavesColor(ALeafColor); + FreeLeaves; +end; + +function TBGRAColorTree.GetLeafCount: integer; +begin + if IsLeaf then + result := 1 + else + begin + result := 0; + if Assigned(FInferiorBranch) then inc(result, FInferiorBranch.LeafCount); + if Assigned(FSuperiorBranch) then inc(result, FSuperiorBranch.LeafCount); + end; +end; + +function TBGRAColorTree.GetApproximatedColorCount: integer; +begin + if IsLeaf then + result := 1 + else + begin + result := 0; + if Assigned(FInferiorBranch) then inc(result, FInferiorBranch.ApproximatedColorCount); + if Assigned(FSuperiorBranch) then inc(result, FSuperiorBranch.ApproximatedColorCount); + end; + if HasPureTransparentColor then inc(result); +end; + +function TBGRAColorTree.GetHasPureTransparentColor: boolean; +begin + result := FPureTransparentColorCount > 0; +end; + +procedure TBGRAColorTree.Init(ALeaf: TBGRAColorBox; AOwned: boolean); +var + c: TColorDimension; +begin + if not AOwned then + FLeaf := ALeaf.Duplicate + else + FLeaf := ALeaf; + FLargestApparentInterval:= FLeaf.LargestApparentInterval; + FWeight := FLeaf.TotalWeight; + FIsLeaf:= true; + for c := low(TColorDimension) to high(TColorDimension) do + begin + FMinBorder[c] := true; + FMaxBorder[c] := true; + end; + FPureTransparentColorCount:= FLeaf.PureTransparentColorCount; + FPureTransparentColorIndex:= -1; +end; + +constructor TBGRAColorTree.Create(ABox: TBGRAColorBox; AOwned: boolean); +begin + Init(ABox,AOwned); +end; + +constructor TBGRAColorTree.Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); +begin + Init(TBGRAColorBox.Create(ADimensions, APalette),True); +end; + +constructor TBGRAColorTree.Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); +begin + Init(TBGRAColorBox.Create(ADimensions, ABitmap, AAlpha),True); +end; + +destructor TBGRAColorTree.Destroy; +begin + FreeAndNil(FInferiorBranch); + FreeAndNil(FSuperiorBranch); + FreeAndNil(FLeaf); + inherited Destroy; +end; + +procedure TBGRAColorTree.FreeLeaves; +begin + if IsLeaf then + FreeAndNil(FLeaf) + else + begin + if Assigned(FInferiorBranch) then FInferiorBranch.FreeLeaves; + if Assigned(FSuperiorBranch) then FSuperiorBranch.FreeLeaves; + end; +end; + +function TBGRAColorTree.FindBiggestLeaf(AMethod: TBiggestLeafMethod + ): TBGRAColorTree; +var infLeaf,supLeaf: TBGRAColorTree; +begin + if IsLeaf then + result := self + else + begin + infLeaf := FInferiorBranch.FindBiggestLeaf(AMethod); + supLeaf := FSuperiorBranch.FindBiggestLeaf(AMethod); + case AMethod of + blApparentInterval: + if infLeaf.LargestApparentInterval >= supLeaf.LargestApparentInterval then + result := infLeaf + else + result := supLeaf; + blWeight: + if (infLeaf.LargestApparentInterval > 0) and (infLeaf.Weight >= supLeaf.Weight) then + result := infLeaf + else + result := supLeaf; + else{blMix:} + if (sqrt(infLeaf.Weight/FWeight)*(infLeaf.LargestApparentInterval/LargestApparentInterval) >= + sqrt(supLeaf.Weight/FWeight)*(supLeaf.LargestApparentInterval/LargestApparentInterval) ) then + result := infLeaf + else + result := supLeaf; + end; + end; +end; + +{ TDimensionMinMax } + +function TDimensionMinMax.Size: UInt32; +begin + if Maximum>Minimum then + result := Maximum-Minimum + else + result := 0; +end; + +function TDimensionMinMax.Contains(AValue: UInt32): boolean; +begin + result := (AValue >= Minimum) and (AValue <= Maximum); +end; + +function TDimensionMinMax.PointLike: boolean; +begin + result := (Minimum = Maximum); +end; + +procedure TDimensionMinMax.SetAsPoint(AValue: UInt32); +begin + Minimum := AValue; + Maximum := AValue; +end; + +function TDimensionMinMax.GetCenter: UInt32; +begin + result := (Minimum+Maximum) shr 1; +end; + +procedure TDimensionMinMax.GrowToInclude(AValue: UInt32); +begin + if AValue < Minimum then Minimum := AValue + else if AValue > Maximum then Maximum := AValue; +end; + +{ TBGRAColorBox } + +function TBGRAColorBox.GetApparentInterval(ADimension: TColorDimension): UInt32; +var factor: single; +begin + if not (ADimension in FDimensions) then result := 0 + else + begin + factor := 1; + case ADimension of + cdRGB: factor := 0.7; + end; + result := round(FBounds[ADimension].Size*factor); + end; +end; + +function TBGRAColorBox.GetAverageColor: TBGRAPixel; +var + n: integer; + r, g, b, a: double; + cura: double; + w: UInt32; +begin + a := 0; + r := 0; + g := 0; + b := 0; + w := 0; + for n := 0 to high(FColors) do + with FColors[n].Color do + begin + cura := (alpha / 255)*FColors[n].Weight; + IncF(a, cura); + IncF(r, GammaExpansionTab[red] * cura); + IncF(g, GammaExpansionTab[green] * cura); + IncF(b, GammaExpansionTab[blue] * cura); + Inc(w, FColors[n].Weight); + end; + if w = 0 then + Result := BGRAPixelTransparent + else + begin + result.alpha := round(a*255/w); + if result.alpha = 0 then result := BGRAPixelTransparent + else + begin + result.red := GammaCompressionTab[round(r / a)]; + result.green := GammaCompressionTab[round(g / a)]; + result.blue := GammaCompressionTab[round(b / a)]; + end; + end; +end; + +function TBGRAColorBox.GetAverageColorOrMainColor: TBGRAPixel; +var i: integer; + maxWeight: UInt32; +begin + result := BGRAPixelTransparent; + maxWeight:= 0; + for i := 0 to high(FColors) do + with FColors[i] do + begin + if Weight > maxWeight then + begin + maxWeight:= Weight; + result := Color; + end; + end; + if maxWeight <= 3*FTotalWeight shr 2 then + result := GetAverageColor; +end; + +function TBGRAColorBox.GetBounds(ADimension: TColorDimension): TDimensionMinMax; +begin + result := FBounds[ADimension]; +end; + +function TBGRAColorBox.GetColorCount(ACountPureTransparent: boolean): integer; +begin + result := length(FColors); + if ACountPureTransparent and HasPureTransparentColor then inc(result); +end; + +function TBGRAColorBox.GetHasPureTransparentColor: boolean; +begin + result := FPureTransparentColorCount > 0; +end; + +function TBGRAColorBox.GetInferiorColor: TBGRAPixel; +var + n: integer; + r, g, b, a: double; + w: UInt32; + cura: double; + wantedWeight: UInt32; +begin + a := 0; + r := 0; + g := 0; + b := 0; + w := 0; + wantedWeight:= FTotalWeight div 10; + for n := 0 to high(FColors) do + with FColors[n].Color do + begin + cura := (alpha / 255)*FColors[n].Weight; + IncF(a, cura); + IncF(r, red * cura); + IncF(g, green * cura); + IncF(b, blue * cura); + Inc(w, FColors[n].Weight); + if w >= wantedWeight then break; + end; + if w = 0 then + Result := BGRAPixelTransparent + else + begin + result.alpha := round(a*255/w); + if result.alpha = 0 then result := BGRAPixelTransparent + else + begin + result.red := round(r / a); + result.green := round(g / a); + result.blue := round(b / a); + end; + end; +end; + +function TBGRAColorBox.GetLargestApparentDimension: TColorDimension; +var c: TColorDimension; + curApparentInterval, maxApparentInterval: UInt32; +begin + c := succ(low(TColorDimension)); + result := c; + maxApparentInterval:= ApparentInterval[c]; + while c < high(TColorDimension) do + begin + inc(c); + curApparentInterval:= ApparentInterval[c]; + if curApparentInterval > maxApparentInterval then + begin + maxApparentInterval:= curApparentInterval; + result := c; + end; + end; +end; + +function TBGRAColorBox.GetLargestApparentInterval: UInt32; +var + curApparentInterval: UInt32; + c: TColorDimension; +begin + result:= ApparentInterval[succ(low(TColorDimension))]; + for c := succ(succ(low(TColorDimension))) to high(TColorDimension) do + begin + curApparentInterval:= ApparentInterval[c]; + if curApparentInterval > result then + result := curApparentInterval; + end; +end; + +function TBGRAColorBox.GetPointLike: boolean; +var c: TColorDimension; +begin + for c := succ(low(TColorDimension)) to high(TColorDimension) do + if not FBounds[c].PointLike then + begin + result := false; + exit; + end; + result := true; +end; + +function TBGRAColorBox.GetSuperiorColor: TBGRAPixel; +var + n: integer; + r, g, b, a: double; + w: UInt32; + cura: double; + wantedWeight: UInt32; +begin + a := 0; + r := 0; + g := 0; + b := 0; + w := 0; + wantedWeight:= FTotalWeight div 10; + for n := high(FColors) downto 0 do + with FColors[n].Color do + begin + cura := (alpha / 255)*FColors[n].Weight; + IncF(a, cura); + IncF(r, red * cura); + IncF(g, green * cura); + IncF(b, blue * cura); + Inc(w, FColors[n].Weight); + if w >= wantedWeight then break; + end; + if w = 0 then + Result := BGRAPixelTransparent + else + begin + result.alpha := round(a*255/w); + if result.alpha = 0 then result := BGRAPixelTransparent + else + begin + result.red := round(r / a); + result.green := round(g / a); + result.blue := round(b / a); + end; + end; +end; + +procedure TBGRAColorBox.Init(AColors: ArrayOfWeightedColor; AOwner: boolean); +var + i,idx: Int32or64; + FirstColor: boolean; + c: TColorDimension; +begin + FPureTransparentColorCount:= 0; + FTotalWeight:= 0; + for c := low(TColorDimension) to high(TColorDimension) do + FBounds[c].SetAsPoint(0); + FirstColor := True; + if AOwner then + FColors := AColors + else + SetLength(FColors, length(AColors)); + idx := 0; + for i := 0 to high(AColors) do + with AColors[i] do + begin + if Color.alpha > 0 then + begin + if FirstColor then + begin + for c := low(TColorDimension) to high(TColorDimension) do + FBounds[c].SetAsPoint(GetDimensionValue(Color,c)); + FirstColor := false; + end else + begin + for c := low(TColorDimension) to high(TColorDimension) do + FBounds[c].GrowToInclude(GetDimensionValue(Color,c)); + end; + inc(FTotalWeight, Weight); + if not AOwner or (idx <> i) then + FColors[idx] := AColors[i]; + inc(idx); + end else + inc(FPureTransparentColorCount, Weight); + end; + setlength(FColors,idx); +end; + +procedure TBGRAColorBox.SortBy(ADimension: TColorDimension); +var comparer: TIsChannelStrictlyGreaterFunc; +begin + comparer := GetPixelStrictComparer(ADimension); + if comparer = nil then exit; + ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),comparer) +end; + +function TBGRAColorBox.GetMedianIndex(ADimension: TColorDimension; + AMinValue, AMaxValue: UInt32 + ): integer; +var i: integer; + sum,goal: UInt32; + valueComparer: TIsChannelGreaterThanOrEqualToValueFunc; + strictComparer: TIsChannelStrictlyGreaterFunc; + ofs: integer; +begin + if length(FColors) = 1 then + begin + result := 0; + exit; + end else + if length(FColors) = 0 then + begin + result := -1; + exit; + end; + valueComparer:= GetPixelValueComparer(ADimension); + sum := 0; + goal := (FTotalWeight+1) shr 1; + result := high(FColors) shr 1; + for i := 0 to high(FColors) do + begin + inc(sum, FColors[i].Weight); + if (sum>=goal) and (valueComparer(@FColors[i].Color, AMinValue)) then + begin + result := i; + while (result > 0) and (valueComparer(@FColors[result].Color, AMaxValue+1)) do dec(result); + break; + end; + end; + if result = 0 then inc(result); + //check that there it is not splitting consecutive colors with the same value + strictComparer := GetPixelStrictComparer(ADimension); + ofs := 0; + while true do + begin + if (result-ofs < 1) and (result+ofs > high(FColors)) then break; + if (result-ofs >= 1) and strictComparer(@FColors[result-ofs].Color,@FColors[result-ofs-1].Color) then + begin + result := result-ofs; + exit; + end; + if (result+ofs <= high(FColors)) and strictComparer(@FColors[result+ofs].Color,@FColors[result+ofs-1].Color) then + begin + result := result+ofs; + exit; + end; + inc(ofs); + end; +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); +begin + FDimensions:= ADimensions; + Init(AColors,AOwner); +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; + const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); +var weightedColors: ArrayOfWeightedColor; + i: Integer; +begin + if AAlpha = acFullChannelInPalette then + begin + FDimensions:= ADimensions; + setlength(weightedColors, length(AColors)); + for i := 0 to high(weightedColors) do + with weightedColors[i] do + begin + color := AColors[i]; + Weight:= 1; + end; + Init(weightedColors,True); + end else + Create(ADimensions, @AColors[0], length(AColors), AAlpha); +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); +begin + FDimensions:= ADimensions; + FBounds := ABounds; + FTotalWeight:= 0; + FPureTransparentColorCount:= 0; +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); +begin + FDimensions:= ADimensions; + Init(APalette.GetAsArrayOfWeightedColor,False); +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; + ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); +begin + Create(ADimensions, ABitmap.Data, ABitmap.NbPixels, AAlpha); +end; + +constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); +var i,j,prev,idx: integer; + p: PBGRAPixel; + skip: boolean; + alphaMask: LongWord; + transpIndex: integer; +begin + if AAlpha <> acFullChannelInPalette then + alphaMask := LEtoN($FF000000) + else + alphaMask := 0; + FDimensions:= ADimensions; + transpIndex := -1; + SetLength(FColors,ANbPixels); + if length(FColors)>0 then + begin + p := AColors; + idx := 0; + for i := 0 to ANbPixels-1 do + begin + if (p^.alpha = 0) or ((AAlpha = acTransparentEntry) and (p^.alpha < 128)) then + begin + skip := true; + if not (AAlpha = acIgnore) then + begin + if (transpIndex=-1) then + begin + transpIndex := idx; + with FColors[idx] do + begin + Color := BGRAPixelTransparent; + Weight:= 1; + end; + inc(idx); + end else + inc(FColors[transpIndex].Weight); + end; + if (p^.alpha = 0) then + begin + inc(p); + continue; + end; + end; + skip := false; + for j := idx-1 downto idx-10 do + if j < 0 then + break + else + with FColors[j] do + if LongWord(Color)=LongWord(p^) or alphaMask then + begin + skip := true; + inc(Weight); + break; + end; + if skip then + begin + inc(p); + continue; + end; + with FColors[idx] do + begin + Color := p^; + if AAlpha <> acFullChannelInPalette then Color.alpha := 255; + Weight := 1; + inc(p); + inc(idx); + end; + end; + setLength(FColors, idx); + + ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),@IsDWordGreater); + prev := 0; + for i := 1 to high(FColors) do + begin + if LongWord(FColors[i].Color)=LongWord(FColors[prev].Color) then + inc(FColors[prev].Weight, FColors[i].Weight) + else + begin + inc(prev); + if i <> prev then + FColors[prev] := FColors[i]; + end; + end; + setlength(FColors, prev+1); + end; + Init(FColors,True); +end; + +function TBGRAColorBox.BoundsContain(AColor: TBGRAPixel): boolean; +var c: TColorDimension; +begin + for c := succ(low(TColorDimension)) to high(TColorDimension) do + if not FBounds[c].Contains(GetDimensionValue(AColor,c)) then + begin + result := false; + exit; + end; + result := true; +end; + +function TBGRAColorBox.MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32 + ): TBGRAColorBox; +var idxSplit: Int32or64; + secondArray: ArrayOfWeightedColor; + i: Int32or64; +begin + result := nil; + SuperiorMiddle := 0; + if FBounds[ADimension].PointLike then exit; + if length(FColors) <= 1 then exit; + SortBy(ADimension); + idxSplit := GetMedianIndex(ADimension, + round(FBounds[ADimension].Minimum*(1-MedianMinPercentage)+FBounds[ADimension].Maximum*MedianMinPercentage), + round(FBounds[ADimension].Minimum*MedianMinPercentage+FBounds[ADimension].Maximum*(1-MedianMinPercentage))); + if idxSplit = -1 then exit; + setlength(secondArray, length(FColors)-idxSplit); + for i := idxSplit to high(FColors) do + secondArray[i-idxSplit] := FColors[i]; + result := TBGRAColorBox.Create(FDimensions, secondArray,True); + setlength(FColors, idxSplit); + Init(FColors,True); + SuperiorMiddle := (FBounds[ADimension].Maximum + result.FBounds[ADimension].Minimum + 1) shr 1; +end; + +function TBGRAColorBox.Duplicate: TBGRAColorBox; +var + i: Int32or64; +begin + result := TBGRAColorBox.Create(FDimensions, FBounds); + result.FTotalWeight := FTotalWeight; + setlength(result.FColors, length(FColors)); + for i := 0 to high(FColors) do + result.FColors[i] := FColors[i]; +end; + +function TBGRAColorBox.GetAsArrayOfColors(AIncludePureTransparent: boolean): ArrayOfTBGRAPixel; +var i,idx: integer; +begin + if AIncludePureTransparent and HasPureTransparentColor then + begin + setlength(result, length(FColors)+1); + result[0] := BGRAPixelTransparent; + idx := 1; + end else + begin + setlength(result, length(FColors)); + idx := 0; + end; + for i:= 0 to high(FColors) do + begin + result[idx] := FColors[i].Color; + inc(idx); + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracompressablebitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracompressablebitmap.pas new file mode 100644 index 0000000..65a5413 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracompressablebitmap.pas @@ -0,0 +1,317 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACompressableBitmap; + +{$mode objfpc}{$H+} + +interface + +{ This unit contains the TBGRACompressableBitmap class, which + can be used to temporarily compress bitmaps in memory. + To use it, create an instance with the bitmap you want + to compress. You can then free the original bitmap because + TBGRACompressableBitmap contains all information necessary + to build it again. To construct again your bitmap, call + the GetBitmap function. + + When you have your bitmap in TBGRACompressableBitmap, + you can call Compress function as many times as necessary + until all data is compressed. It does only a part of the + work at each call, so you can put it in a loop or in + a timer. When it's done, Compress returns false to + notify that it did nothing, which means you can + stop calling Compress. + + In this implementation, the memory usage grows during + the compression process and is lower only after it is + finished. So it is recommended to compress one bitmap + at a time. } + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, zstream; + +type + + { TBGRACompressableBitmap } + + TBGRACompressableBitmap = class + private + FWidth,FHeight: integer; + FCaption: String; + FBounds: TRect; + FCompressedDataArray: array of TMemoryStream; + FUncompressedData: TMemoryStream; + FLineOrder: TRawImageLineOrder; + FCompressionProgress: Int64; + procedure Decompress; + procedure FreeData; + procedure Init; + public + CompressionLevel: Tcompressionlevel; + constructor Create; overload; + constructor Create(Source: TBGRABitmap); overload; + function GetBitmap: TBGRABitmap; + + //call Compress as many times as necessary + //when it returns false, it means that + //the image compression is finished + function Compress: boolean; + procedure WriteToStream(AStream: TStream); + procedure ReadFromStream(AStream: TStream); + + function UsedMemory: Int64; + procedure Assign(Source: TBGRABitmap); + destructor Destroy; override; + property Width : Integer read FWidth; + property Height: Integer read FHeight; + property Caption : string read FCaption write FCaption; + + end; + +implementation + +uses BGRAUTF8; + +// size of each chunk treated by Compress function +const maxPartSize = 524288; + +{ TBGRACompressedBitmap } + +constructor TBGRACompressableBitmap.Create; +begin + Init; +end; + +constructor TBGRACompressableBitmap.Create(Source: TBGRABitmap); +begin + Init; + Assign(Source); +end; + +{ Constructs the bitmap again, decompressing if necessary. + After this, the image is not compressed anymore so the + memoy usage grows again and the access becomes fast + because there is no need to decompress anymore. } +function TBGRACompressableBitmap.GetBitmap: TBGRABitmap; +var UsedPart: TBGRABitmap; + UsedNbPixels: Integer; +begin + Decompress; + if FUncompressedData = nil then + begin + result := nil; + exit; + end; + result := TBGRABitmap.Create(FWidth,FHeight); + result.Caption := FCaption; + FUncompressedData.Position := 0; + if (FBounds.Left <> 0) or (FBounds.Top <> 0) + or (FBounds.Right <> FWidth) or (FBounds.Bottom <> FHeight) then + begin + UsedNbPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top); + if UsedNbPixels > 0 then + begin + UsedPart := TBGRABitmap.Create(FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top); + FUncompressedData.Read(UsedPart.Data^,UsedPart.NbPixels*Sizeof(TBGRAPixel)); + if UsedPart.LineOrder <> FLineOrder then UsedPart.VerticalFlip; + If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue; + result.PutImage(FBounds.Left,FBounds.Top,UsedPart,dmSet); + UsedPart.Free; + end; + end else + begin + FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel)); + if result.LineOrder <> FLineOrder then result.VerticalFlip; + If TBGRAPixel_RGBAOrder then result.SwapRedBlue; + end; +end; + +{ Returns the total memory used by this object for storing bitmap data } +function TBGRACompressableBitmap.UsedMemory: Int64; +var i: integer; +begin + result := 0; + for i := 0 to high(FCompressedDataArray) do + inc(result, FCompressedDataArray[i].Size); + if FUncompressedData <> nil then inc(result, FUncompressedData.Size); +end; + +{ Do one compress step or return false } +function TBGRACompressableBitmap.Compress: boolean; +var comp: Tcompressionstream; + partSize: integer; +begin + if FCompressedDataArray = nil then FCompressionProgress := 0; + if (FUncompressedData = nil) or (FUncompressedData.Size = 0) then + begin + result := false; + exit; + end; + if FCompressionProgress < FUncompressedData.Size then + begin + setlength(FCompressedDataArray, length(FCompressedDataArray)+1); + FCompressedDataArray[high(FCompressedDataArray)] := TMemoryStream.Create; + FUncompressedData.Position := FCompressionProgress; + if FUncompressedData.Size - FCompressionProgress > maxPartSize then + partSize := maxPartSize else + partSize := integer(FUncompressedData.Size - FCompressionProgress); + + comp := Tcompressionstream.Create(CompressionLevel,FCompressedDataArray[high(FCompressedDataArray)],true); + LEWriteLongint(comp, partSize); + comp.CopyFrom(FUncompressedData,partSize); + comp.Free; + inc(FCompressionProgress, partSize); + end; + if FCompressionProgress >= FUncompressedData.Size then + FreeAndNil(FUncompressedData); + result := true; +end; + +procedure TBGRACompressableBitmap.WriteToStream(AStream: TStream); +var i:integer; +begin + repeat + until not Compress; + LEWriteLongint(AStream,FWidth); + LEWriteLongint(AStream,FHeight); + LEWriteLongint(AStream,length(FCaption)); + AStream.Write(FCaption[1],length(FCaption)); + if (FWidth=0) or (FHeight = 0) then exit; + + LEWriteLongint(AStream,FBounds.Left); + LEWriteLongint(AStream,FBounds.Top); + LEWriteLongint(AStream,FBounds.Right); + LEWriteLongint(AStream,FBounds.Bottom); + LEWriteLongint(AStream,ord(FLineOrder)); + + LEWriteLongint(AStream,length(FCompressedDataArray)); + for i := 0 to high(FCompressedDataArray) do + begin + LEWriteLongint(AStream,FCompressedDataArray[i].Size); + FCompressedDataArray[i].Position := 0; + AStream.CopyFrom(FCompressedDataArray[i],FCompressedDataArray[i].Size); + end; +end; + +procedure TBGRACompressableBitmap.ReadFromStream(AStream: TStream); +var size,i: integer; +begin + FreeData; + FWidth := LEReadLongint(AStream); + FHeight := LEReadLongint(AStream); + setlength(FCaption,LEReadLongint(AStream)); + AStream.Read(FCaption[1],length(FCaption)); + if (FWidth=0) or (FHeight = 0) then + begin + FUncompressedData := TMemoryStream.Create; + exit; + end; + + FBounds.Left := LEReadLongint(AStream); + FBounds.Top := LEReadLongint(AStream); + FBounds.Right := LEReadLongint(AStream); + FBounds.Bottom := LEReadLongint(AStream); + FLineOrder := TRawImageLineOrder(LEReadLongint(AStream)); + + setlength(FCompressedDataArray,LEReadLongint(AStream)); + for i := 0 to high(FCompressedDataArray) do + begin + size := LEReadLongint(AStream); + FCompressedDataArray[i] := TMemoryStream.Create; + FCompressedDataArray[i].CopyFrom(AStream,size); + end; + + if FCompressedDataArray = nil then + FUncompressedData := TMemoryStream.Create; +end; + +procedure TBGRACompressableBitmap.Decompress; +var decomp: Tdecompressionstream; + i: integer; + partSize: integer; +begin + if (FUncompressedData <> nil) or (FCompressedDataArray = nil) then exit; + FUncompressedData := TMemoryStream.Create; + for i := 0 to high(FCompressedDataArray) do + begin + FCompressedDataArray[i].Position := 0; + decomp := Tdecompressionstream.Create(FCompressedDataArray[i],true); + partSize := LEReadLongint(decomp); + FUncompressedData.CopyFrom(decomp,partSize); + decomp.Free; + FreeAndNil(FCompressedDataArray[i]); + end; + FCompressedDataArray := nil; +end; + +{ Free all data } +procedure TBGRACompressableBitmap.FreeData; +var i: integer; +begin + if FCompressedDataArray <> nil then + begin + for i := 0 to high(FCompressedDataArray) do + FCompressedDataArray[I].Free; + FCompressedDataArray := nil; + end; + if FUncompressedData <> nil then FreeAndNil(FUncompressedData); +end; + +procedure TBGRACompressableBitmap.Init; +begin + FUncompressedData := nil; + FCompressedDataArray := nil; + FWidth := 0; + FHeight := 0; + FCaption := ''; + FCompressionProgress := 0; + CompressionLevel := clfastest; +end; + +{ Copy a bitmap into this object. As it is copied, you need not + keep a copy of the source } +procedure TBGRACompressableBitmap.Assign(Source: TBGRABitmap); +var + UsedPart: TBGRABitmap; + NbUsedPixels: integer; +begin + FreeData; + if Source = nil then + begin + FWidth := 0; + FHeight := 0; + FCaption := ''; + exit; + end; + FWidth := Source.Width; + FHeight := Source.Height; + FCaption := Source.Caption; + FBounds := Source.GetImageBounds([cRed,cGreen,cBlue,cAlpha]); + NbUsedPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top); + FUncompressedData := TMemoryStream.Create; + if NbUsedPixels = 0 then exit; + + if (FBounds.Left <> 0) or (FBounds.Top <> 0) + or (FBounds.Right <> Source.Width) or (FBounds.Bottom <> Source.Height) then + begin + UsedPart := Source.GetPart(FBounds); + If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue; + FUncompressedData.Write(UsedPart.Data^,NbUsedPixels*Sizeof(TBGRAPixel)); + FLineOrder := UsedPart.LineOrder; + UsedPart.Free; + end else + begin + If TBGRAPixel_RGBAOrder then Source.SwapRedBlue; + FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel)); + If TBGRAPixel_RGBAOrder then Source.SwapRedBlue; + FLineOrder := Source.LineOrder; + end; +end; + +destructor TBGRACompressableBitmap.Destroy; +begin + FreeData; + inherited Destroy; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracoordpool3d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracoordpool3d.pas new file mode 100644 index 0000000..ef79c7d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracoordpool3d.pas @@ -0,0 +1,435 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACoordPool3D; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRABitmapTypes, BGRASSE, BGRAMatrix3D; + +type + PBGRACoordData3D = ^TBGRACoordData3D; + TBGRACoordData3D = packed record + {0} sceneCoord: TPoint3D_128; + {16} viewCoord: TPoint3D_128; + {32} projectedCoord: TPointF; + {40} InvZ: single; + {44} used: wordbool; customNormalUsed: wordbool; + {48} viewNormal: TPoint3D_128; + {64} customNormal: TPoint3D_128; + end; {80} + + PBGRANormalData3D = ^TBGRANormalData3D; + TBGRANormalData3D = packed record + {0} customNormal: TPoint3D_128; + {16} viewNormal: TPoint3D_128; + {32} used: longbool; + {36} filler1,filler2,filler3: LongWord; + end; {48} + + { TBGRAGenericPool } + + TBGRAGenericPool = class + private + FFirstFree: integer; + FNbElements,FCapacity: integer; + FElementSize: PtrInt; + FUsedCapacity : integer; + function GetElement(AIndex: integer): Pointer; + procedure SetCapacity(ACapacity: integer); + protected + FPoolData: TMemoryBlockAlign128; + function GetUsed({%H-}AElement: integer): boolean; virtual; + procedure SetUsed({%H-}AElement: integer; {%H-}AUsed: boolean); virtual; + procedure Remove(AIndex: integer); //does not work if GetUsed/SetUsed are not implemented + public + constructor Create(ACapacity: integer; AElementSize: integer); + destructor Destroy; override; + function Add: integer; + property Element[AIndex: integer]: Pointer read GetElement; + property Capacity: integer read FCapacity; + property UsedCapacity: integer read FUsedCapacity; + end; + + { TBGRACoordPool3D } + + TBGRACoordPool3D = class(TBGRAGenericPool) + private + function GetCoordData(AIndex: integer): PBGRACoordData3D; + protected + function GetUsed(AElement: integer): boolean; override; + procedure SetUsed(AElement: integer; AUsed: boolean); override; + public + procedure Remove(AIndex: integer); + constructor Create(ACapacity: integer); + procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); + property CoordData[AIndex: integer]: PBGRACoordData3D read GetCoordData; + end; + + { TBGRANormalPool3D } + + TBGRANormalPool3D = class(TBGRAGenericPool) + private + function GetNormalData(AIndex: integer): PBGRANormalData3D; + protected + function GetUsed(AElement: integer): boolean; override; + procedure SetUsed(AElement: integer; AUsed: boolean); override; + public + procedure Remove(AIndex: integer); + constructor Create(ACapacity: integer); + procedure ComputeWithMatrix(const AMatrix: TMatrix3D); + property NormalData[AIndex: integer]: PBGRANormalData3D read GetNormalData; + end; + +implementation + +{ TBGRAGenericPool } + +function TBGRAGenericPool.GetElement(AIndex: integer): Pointer; +begin + result := Pointer(PByte(FPoolData.Data)+AIndex*FElementSize); +end; + +procedure TBGRAGenericPool.SetCapacity(ACapacity: integer); +var NewPoolData: TMemoryBlockAlign128; +begin + if FCapacity <> ACapacity then + begin + if ACapacity = 0 then + FreeAndNil(FPoolData) + else + begin + NewPoolData := TMemoryBlockAlign128.Create(ACapacity*FElementSize); + if FCapacity <> 0 then + begin + //previous block is smaller + if FCapacity < ACapacity then + begin + move(FPoolData.Data^, NewPoolData.Data^, FCapacity*FElementSize); + //pad with zeros + fillchar((pbyte(NewPoolData.Data)+FCapacity*FElementSize)^,(ACapacity-FCapacity)*FElementSize,0); + end + else //previous block is greater or equal + move(FPoolData.Data^, NewPoolData.Data^, ACapacity*FElementSize); + FreeAndNil(FPoolData); + end else + //clear new block + fillchar(pbyte(NewPoolData.Data)^,ACapacity*FElementSize,0); + + FPoolData := NewPoolData; + end; + FCapacity:= ACapacity; + end; +end; + +function TBGRAGenericPool.GetUsed(AElement: integer): boolean; +begin + result := false; +end; + +procedure TBGRAGenericPool.SetUsed(AElement: integer; AUsed: boolean); +begin + //nothing +end; + +constructor TBGRAGenericPool.Create(ACapacity: integer; AElementSize: integer); +begin + FCapacity := 0; + FPoolData := nil; + FNbElements:= 0; + FFirstFree := 0; + FUsedCapacity := 0; + FElementSize:= AElementSize; + SetCapacity(ACapacity); +end; + +destructor TBGRAGenericPool.Destroy; +begin + FreeAndNil(FPoolData); + FCapacity := 0; + FNbElements:= 0; + FFirstFree := 0; + FUsedCapacity := 0; + inherited Destroy; +end; + +procedure TBGRAGenericPool.Remove(AIndex: integer); +begin + if (AIndex < 0) or (AIndex >= FUsedCapacity) then + raise ERangeError.Create('Index out of bounds'); + if GetUsed(AIndex) then + begin + SetUsed(AIndex, false); + if AIndex < FFirstFree then FFirstFree := AIndex; + if AIndex = FUsedCapacity-1 then + begin + while (FUsedCapacity > 0) and not GetUsed(FUsedCapacity-1) do + dec(FUsedCapacity); + end; + end; +end; + +function TBGRAGenericPool.Add: integer; +begin + //check for free space + while FFirstFree < FCapacity do + begin + if not GetUsed(FFirstFree) then + begin + SetUsed(FFirstFree,True); + result := FFirstFree; + inc(FFirstFree); + if FFirstFree > FUsedCapacity then + FUsedCapacity := FFirstFree; + exit; + end; + inc(FFirstFree); + end; + + //no free space + SetCapacity(FCapacity*2+8); + SetUsed(FFirstFree, true); + result := FFirstFree; + inc(FFirstFree); + if FFirstFree > FUsedCapacity then + FUsedCapacity := FFirstFree; +end; + +{ TBGRACoordPool3D } + +constructor TBGRACoordPool3D.Create(ACapacity: integer); +begin + inherited Create(ACapacity,SizeOf(TBGRACoordData3D)); +end; + +procedure TBGRACoordPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D; + const AProjection: TProjection3D); +var + P: PBGRACoordData3D; + I: Int32or64; +begin + if UsedCapacity = 0 then exit; + P := PBGRACoordData3D(FPoolData.Data); + {$IFDEF CPUI386} + {$IFDEF BGRASSE_AVAILABLE} + {$asmmode intel} + if UseSSE then + begin + Matrix3D_SSE_Load(AMatrix); + asm + mov eax,[AProjection] + movups xmm4,[eax] + xorps xmm1,xmm1 + end; + i := UsedCapacity; + if UseSSE3 then + begin + while i > 0 do + with P^ do + begin + if used then + begin + MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord); + if viewCoord.z > 0 then + begin + asm + mov eax, P + movaps xmm3, [eax+16] //viewCoord + movaps xmm2,xmm3 + shufps xmm2,xmm3,2+8+32+128 + rcpps xmm2,xmm2 //xmm2 = InvZ + movss [eax+40],xmm2 //-> InvZ + + mulps xmm3,xmm4 //xmm3 *= Projection.Zoom + mulps xmm3,xmm2 //xmm3 *= InvZ + + movhlps xmm0,xmm4 //xmm0 = Projection.Center + addps xmm3,xmm0 //xmm3 += Projection.Center + + movlps [eax+32],xmm3 //->projectedCoord + movaps [eax+48],xmm1 //->normal + end; + end else + asm + mov eax, P + movlps [eax+32],xmm1 //0->projectedCoord + movaps [eax+48],xmm1 //->normal + end; + if customNormalUsed then + MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal); + end; + dec(i); + inc(p); + end; + end else + begin + while i > 0 do + with P^ do + begin + if used then + begin + MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord); + if viewCoord.z > 0 then + begin + asm + mov eax, P + movaps xmm3, [eax+16] //viewCoord + movaps xmm2,xmm3 + shufps xmm2,xmm3,2+8+32+128 + rcpps xmm2,xmm2 //xmm2 = InvZ + movss [eax+40],xmm2 //-> InvZ + + mulps xmm3,xmm4 //xmm3 *= Projection.Zoom + mulps xmm3,xmm2 //xmm3 *= InvZ + + movhlps xmm0,xmm4 //xmm0 = Projection.Center + addps xmm3,xmm0 //xmm3 += Projection.Center + + movlps [eax+32],xmm3 //->projectedCoord + movaps [eax+48],xmm1 //->normal + end; + end else + asm + mov eax, P + movlps [eax+32],xmm1 //0 ->projectedCoord + movaps [eax+48],xmm1 //->normal + end; + if customNormalUsed then + MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal); + end; + dec(i); + inc(p); + end; + end; + end + else + {$ENDIF} + {$ENDIF} + begin + i := UsedCapacity; + while i > 0 do + with P^ do + begin + if used then + begin + viewCoord := AMatrix*sceneCoord; + if customNormalUsed then + viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal) + else + ClearPoint3D_128(viewNormal); + if viewCoord.z > 0 then + begin + InvZ := 1/viewCoord.z; + projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, + viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); + end else + projectedCoord := PointF(0,0); + end; + dec(i); + inc(p); + end; + end; +end; + +function TBGRACoordPool3D.GetCoordData(AIndex: integer): PBGRACoordData3D; +begin + result := PBGRACoordData3D(FPoolData.Data)+AIndex; +end; + +function TBGRACoordPool3D.GetUsed(AElement: integer): boolean; +begin + Result:= CoordData[AElement]^.used; +end; + +procedure TBGRACoordPool3D.SetUsed(AElement: integer; AUsed: boolean); +begin + CoordData[AElement]^.used := AUsed; +end; + +procedure TBGRACoordPool3D.Remove(AIndex: integer); +begin + inherited Remove(AIndex); +end; + +{ TBGRANormalPool3D } + +function TBGRANormalPool3D.GetNormalData(AIndex: integer): PBGRANormalData3D; +begin + result := PBGRANormalData3D(FPoolData.Data)+AIndex; +end; + +function TBGRANormalPool3D.GetUsed(AElement: integer): boolean; +begin + Result:= NormalData[AElement]^.used; +end; + +procedure TBGRANormalPool3D.SetUsed(AElement: integer; AUsed: boolean); +begin + NormalData[AElement]^.used := AUsed; +end; + +procedure TBGRANormalPool3D.Remove(AIndex: integer); +begin + inherited Remove(AIndex); +end; + +constructor TBGRANormalPool3D.Create(ACapacity: integer); +begin + inherited Create(ACapacity,SizeOf(TBGRANormalData3D)); +end; + +procedure TBGRANormalPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D); +var + P: PBGRANormalData3D; + I: Int32or64; +begin + if UsedCapacity = 0 then exit; + P := PBGRANormalData3D(FPoolData.Data); + {$IFDEF CPUI386} + {$IFDEF BGRASSE_AVAILABLE} + {$asmmode intel} + if UseSSE then + begin + Matrix3D_SSE_Load(AMatrix); + i := UsedCapacity; + if UseSSE3 then + begin + while i > 0 do + with P^ do + begin + if used then + MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal); + dec(i); + inc(p); + end; + end else + begin + while i > 0 do + with P^ do + begin + if used then + MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal); + dec(i); + inc(p); + end; + end; + end + else + {$ENDIF} + {$ENDIF} + begin + i := UsedCapacity; + while i > 0 do + with P^ do + begin + if used then + viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal); + dec(i); + inc(p); + end; + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracustombitmap.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgracustombitmap.inc new file mode 100644 index 0000000..8ee8550 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracustombitmap.inc @@ -0,0 +1,1859 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type +{=== TBGRACustomBitmap ===} + + { TBGRACustomBitmap } + {* This is the base class for ''TBGRABitmap''. It is the direct parent of + ''TBGRADefaultBitmap'' class, which is the parent of the diverse + implementations. A bitmap can be used as a scanner using the interface + ''IBGRAScanner'' } + TBGRACustomBitmap = class(specialize TGenericUniversalBitmap,IBGRAScanner) + protected + FXorMask: TBGRACustomBitmap; + + { accessors to properies } + procedure SetXorMask(AValue: TBGRACustomBitmap); + + function GetAverageColor: TColor; virtual; abstract; + function GetAveragePixel: TBGRAPixel; virtual; abstract; + + //FreePascal drawing routines + {$IFDEF BGRABITMAP_USE_FPCANVAS}function GetCanvasFP: TFPImageCanvas; virtual; abstract;{$ENDIF} + function GetCanvasDrawModeFP: TDrawMode; virtual; abstract; + procedure SetCanvasDrawModeFP(const AValue: TDrawMode); virtual; abstract; + + //GUI bitmap object + function GetBitmap: TBitmap; virtual; abstract; + function GetCanvas: TCanvas; virtual; abstract; + function GetCanvasOpacity: byte; virtual; abstract; + procedure SetCanvasOpacity(AValue: byte); virtual; abstract; + function GetCanvasAlphaCorrection: boolean; virtual; abstract; + procedure SetCanvasAlphaCorrection(const AValue: boolean); virtual; abstract; + + procedure Init; override; + function InternalNew: TBGRACustomBitmap; override; + + procedure InternalArc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); overload; + procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); overload; virtual; abstract; + procedure InternalArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; ABorderColor : TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); + procedure InternalFillArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ATexture: IBGRAScanner = nil); + + public + {** Resample filter is used when resizing the bitmap. See [[BGRABitmap Miscellaneous types#Images and resampling|resampling types]] } + ResampleFilter : TResampleFilter; + + {** Scan interpolation filter is used when the bitmap is used + as a scanner (interface ''IBGRAScanner'') } + ScanInterpolationFilter: TResampleFilter; + ScanMaskChannel: TChannel; + + {** Cursor position for mouse pointer } + HotSpot: TPoint; + + { ** Free reference to xor mask } + procedure DiscardXorMask; virtual; + { ** Allocate xor mask } + procedure NeedXorMask; virtual; + {** Xor mask to be applied when image is drawn } + property XorMask: TBGRACustomBitmap read FXorMask write SetXorMask; + + {** Average color of the image } + property AverageColor: TColor Read GetAverageColor; + {** Average color (including alpha) of the image } + property AveragePixel: TBGRAPixel Read GetAveragePixel; + + {** Canvas compatible with FreePascal } + {$IFDEF BGRABITMAP_USE_FPCANVAS}property CanvasFP: TFPImageCanvas read GetCanvasFP;{$ENDIF} + + {** Draw mode to used when image is access using FreePascal functions + and ''Colors'' property } + property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP; + + {** Bitmap in a format compatible with the current GUI. + Don't forget to call ''InvalidateBitmap'' before using it + if you changed something with direct pixel access (''Scanline'' + and ''Data'') } + property Bitmap: TBitmap Read GetBitmap; + {** Canvas provided by the GUI } + property Canvas: TCanvas Read GetCanvas; + {** Opacity to apply to changes made using GUI functions, provided + ''CanvasAlphaCorrection'' is set to ''True'' } + property CanvasOpacity: byte Read GetCanvasOpacity Write SetCanvasOpacity; + {** Specifies if the alpha values must be corrected after GUI access + to the bitmap } + property CanvasAlphaCorrection: boolean Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection; + + protected {----------- pen style accessors ----------------} + function GetPenJoinStyle: TPenJoinStyle; virtual; abstract; + procedure SetPenJoinStyle(const AValue: TPenJoinStyle); virtual; abstract; + function GetPenMiterLimit: single; virtual; abstract; + procedure SetPenMiterLimit(const AValue: single); virtual; abstract; + function GetPenStyle: TPenStyle; virtual; abstract; + procedure SetPenStyle(const AValue: TPenStyle); virtual; abstract; + function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract; + procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); virtual; abstract; + + function GetArrowEndRepeat: integer; virtual; abstract; + function GetArrowStartRepeat: integer; virtual; abstract; + procedure SetArrowEndRepeat(AValue: integer); virtual; abstract; + procedure SetArrowStartRepeat(AValue: integer); virtual; abstract; + function GetArrowEndOffset: single; virtual; abstract; + function GetArrowStartOffset: single; virtual; abstract; + procedure SetArrowEndOffset(AValue: single); virtual; abstract; + procedure SetArrowStartOffset(AValue: single); virtual; abstract; + function GetArrowEndSize: TPointF; virtual; abstract; + function GetArrowStartSize: TPointF; virtual; abstract; + procedure SetArrowEndSize(AValue: TPointF); virtual; abstract; + procedure SetArrowStartSize(AValue: TPointF); virtual; abstract; + + public {----------- pen style ----------------} + {** How to join segments. See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } + property JoinStyle: TPenJoinStyle read GetPenJoinStyle Write SetPenJoinStyle; + {** Limit for the extension of the segments when joining them + with ''pjsMiter'' join style, expressed in multiples of the width + of the pen } + property JoinMiterLimit: single read GetPenMiterLimit Write SetPenMiterLimit; + {** Pen style. See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } + property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle; + {** Custom pen style. See [[BGRABitmap Geometry types|geometric types]] } + property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; + + {** Size of arrows at the start of the line } + property ArrowStartSize: TPointF read GetArrowStartSize write SetArrowStartSize; + {** Size of arrows at the end of the line } + property ArrowEndSize: TPointF read GetArrowEndSize write SetArrowEndSize; + {** Offset of the arrow from the start of the line } + property ArrowStartOffset: single read GetArrowStartOffset write SetArrowStartOffset; + {** Offset of the arrow from the end of the line } + property ArrowEndOffset: single read GetArrowEndOffset write SetArrowEndOffset; + {** Number of times to repeat the starting arrow } + property ArrowStartRepeat: integer read GetArrowStartRepeat write SetArrowStartRepeat; + {** Number of times to repeat the ending arrow } + property ArrowEndRepeat: integer read GetArrowEndRepeat write SetArrowEndRepeat; + + procedure ArrowStartAsNone; virtual; abstract; + procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; + procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; + procedure ArrowStartAsTail; virtual; abstract; + + procedure ArrowEndAsNone; virtual; abstract; + procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; + procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; + procedure ArrowEndAsTail; virtual; abstract; + + protected {-------------------font style accessors------------------------} + function GetFontAntialias: Boolean; + procedure SetFontAntialias(const AValue: Boolean); + function GetFontRenderer: TBGRACustomFontRenderer; virtual; abstract; + procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); virtual; abstract; + function GetFontHeight: integer; virtual; abstract; + procedure SetFontHeight(AHeight: integer); virtual; abstract; + function GetFontFullHeight: integer; virtual; abstract; + procedure SetFontFullHeight(AHeight: integer); virtual; abstract; + function GetFontVerticalAnchorOffset: single; virtual; abstract; + function GetFontPixelMetric: TFontPixelMetric; virtual; abstract; + + function GetFontRightToLeftFor(AText: string): boolean; + + public {-------------------font style------------------------} + {** Specifies the font to use. Unless the font renderer accept otherwise, + the name is in human readable form, like 'Arial', 'Times New Roman', ... } + FontName: string; + {** Specifies the set of styles to be applied to the font. + These can be ''fsBold'', ''fsItalic'', ''fsStrikeOut'', ''fsUnderline''. + So the value [''fsBold'',''fsItalic''] means that the font must be bold and italic. + See [[BGRABitmap Miscellaneous types|miscellaneous types]] } + FontStyle: TFontStyles; + + {** Specifies the quality of rendering. Default value is ''fqSystem''. + See [[BGRABitmap Miscellaneous types|miscellaneous types]] } + FontQuality : TBGRAFontQuality; + + {** Specifies the rotation of the text, for functions that support text rotation. + It is expressed in tenth of degrees, positive values going counter-clockwise. } + FontOrientation: integer; + + {** Specifies how the font is vertically aligned relative to the start coordinate. + See [[BGRABitmap Miscellaneous types|miscellaneous types]]} + FontVerticalAnchor: TFontVerticalAnchor; + + {** Specifies the base direction of the text (cf Unicode). By default, it is + automatically determined by the first strongly oriented character. + You can specify another base direction here however it is not taken + into account by the LCL on Linux. } + FontBidiMode: TFontBidiMode; + + {** Specifies the height of the font in pixels without taking into account + additional line spacing. A negative value means that it is the + full height instead (see below) } + property FontHeight: integer Read GetFontHeight Write SetFontHeight; + + {** Specifies the height of the font in pixels, taking into account the + additional line spacing defined for the font } + property FontFullHeight: integer read GetFontFullHeight write SetFontFullHeight; + + {** Simplified property to specify the quality (see ''FontQuality'') } + property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias; + + property FontVerticalAnchorOffset: single read GetFontVerticalAnchorOffset; + + {** Returns measurement for the current font in pixels } + property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric; + + {** Specifies the font renderer. When working with the LCL, + by default it is an instance of ''TLCLFontRenderer'' of + unit ''BGRAText''. Other renderers are provided in ''BGRATextFX'' + unit and ''BGRAVectorize'' unit. Additionally, ''BGRAFreeType'' + provides a renderer independent from the LCL. + * + * Once you assign a renderer, it will automatically be freed when + the bitmap is freed. The renderers may provide additional styling + for the font, not accessible with the properties in this class + * + * See [[BGRABitmap tutorial Font rendering|font rendering]]} + property FontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer; + + public + constructor Create(AFPImage: TFPCustomImage); overload; virtual; abstract; + constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; virtual; abstract; + constructor Create(AFilename: string); overload; virtual; abstract; + constructor Create(AFilename: string; AIsUtf8Filename: boolean); overload; virtual; abstract; + constructor Create(AFilename: string; AIsUtf8Filename: boolean; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + constructor Create(AStream: TStream); overload; virtual; abstract; + + function NewBitmap: TBGRACustomBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRACustomBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRACustomBitmap; overload; override; + function NewBitmap(Filename: string): TBGRACustomBitmap; overload; virtual; abstract; + function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; overload; virtual; abstract; + function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRACustomBitmap; overload; virtual; abstract; + function NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap; overload; virtual; abstract; + + procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); override; + + {==== Reference counting ====} + + {** Adds a reference (this reference count is not the same as + the reference count of an interface, it changes only by + explicit calls) } + function NewReference: TBGRACustomBitmap; override; + {** Returns an object with a reference count equal to 1. Duplicate + this bitmap if necessary } + function GetUnique: TBGRACustomBitmap; override; + function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; overload; override; + function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean): TBGRACustomBitmap; overload; virtual; + procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); override; + function GetPart(const ARect: TRect): TBGRACustomBitmap; override; + + function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; + AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override; + + {** Can only be called with an existing instance of ''TBGRACustomBitmap''. + Sets the dimensions of an existing ''TBGRACustomBitmap'' instance. } + procedure SetSize(AWidth, AHeight: integer); override; + + {==== Retrieve image from system ====} + + {** Gets the content of the specified device context } + procedure LoadFromDevice(DC: HDC); overload; virtual; abstract; + {** Gets the content from the specified rectangular area of a device context } + procedure LoadFromDevice(DC: HDC; ARect: TRect); overload; virtual; abstract; + {** Fills the content with a screenshot of the primary monitor } + procedure TakeScreenshotOfPrimaryMonitor; virtual; abstract; + {** Fills the content with a screenshot of the specified rectangular area of the desktop + (it can be from any screen) } + procedure TakeScreenshot(ARect: TRect); virtual; abstract; + {** For more methods, see derived class [[TBGRABitmap class|TBGRABitmap]] } + + {==== Drawing functions ====} + + {Pixel functions} + procedure SetPixel(x, y: int32or64; c: TColor); overload; virtual; abstract; + procedure XorPixel(x, y: int32or64; const c: TBGRAPixel); overload; virtual; abstract; + procedure DrawPixel(x, y: int32or64; const c: TBGRAPixel; ADrawMode: TDrawMode); overload; override; + procedure FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); virtual; abstract; + function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract; + function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; overload; virtual; abstract; + function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; virtual; abstract; + function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; virtual; abstract; + function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; virtual; abstract; + function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; virtual; abstract; + + {Line primitives} + procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; + procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); overload; virtual; abstract; + procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload; + procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; + procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; maxDiff: byte); virtual; abstract; + procedure HorizLineDiff(x, y, x2: int32or64; const ABrush: TUniversalBrush; ACompare: TBGRAPixel; AMaxDiffW: word); virtual; abstract; + + procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; + procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; + procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; + + {==== Rectangles, ellipses and path (floating point coordinates) ====} + {* These functions use the current pen style/cap/join. The parameter ''w'' + specifies the width of the line and the base unit for dashes + * The coordinates are pixel-centered, so that when filling a rectangle, + if the supplied values are integers, the border will be half transparent. + If you want the border to be completely filled, you can subtract/add + 0.5 to the coordinates to include the remaining thin border. + See [[BGRABitmap tutorial 13|coordinate system]]. } + + {==== Multi-shape fill ====} + + {** Draws and fill a polyline using current pen style/cap/join in one go. + The stroke is stricly over the fill even if partially transparent. + ''fillcolor'' specifies a color to fill the polygon formed by the points } + procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; virtual; abstract; + {** Draws a filled polygon using current pen style/cap/join in one go. + The stroke is stricly over the fill even if partially transparent. + The polygon is always closed. You don't need to set the last point + to be the same as the first point. } + procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; virtual; abstract; + + procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; + procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; + + procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; + + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; + + {==== Gradient/textured polygons ====} + + procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); overload; virtual; abstract; + procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); overload; virtual; abstract; + procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); overload; virtual; abstract; + procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); overload; virtual; abstract; + procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); overload; virtual; abstract; + + procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); overload; virtual; abstract; + procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); overload; virtual; abstract; + procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone; ACropToPolygon: boolean = true); overload; virtual; abstract; + procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); overload; virtual; abstract; + procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); overload; virtual; abstract; + procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; + procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; + procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); overload; virtual; abstract; + procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); overload; virtual; abstract; + procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); virtual; abstract; + procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); virtual; abstract; + + procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; virtual; abstract; + procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; virtual; abstract; + + procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); overload; virtual; abstract; + procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); overload; virtual; abstract; + procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); overload; virtual; abstract; + procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); overload; virtual; abstract; + procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); overload; virtual; abstract; + + procedure Arc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; w: single; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; + procedure Arc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; w: single; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; + procedure FillChord(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AFillColor: TBGRAPixel); overload; + procedure FillChord(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; + procedure FillChord(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; texture: IBGRAScanner); overload; + procedure FillChord(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; + procedure FillChordInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; + procedure FillChordInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; + + procedure Pie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; + procedure Pie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; + procedure FillPie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AFillColor: TBGRAPixel); overload; + procedure FillPie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; + procedure FillPie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; texture: IBGRAScanner); overload; + procedure FillPie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; + procedure FillPieInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; + procedure FillPieInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; + + procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; + procedure RectangleWithin(x1,y1,x2,y2: single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; + procedure RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; + + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; virtual; abstract; + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; virtual; abstract; + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; virtual; abstract; + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; virtual; abstract; + + procedure FillRect(r: TRect; texture: IBGRAScanner; mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; + procedure FillRect(r: TRect; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; + procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; + procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; abstract; + + procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; + procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; + procedure TextOutCurved(APath: IBGRAPath; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; + procedure TextOutCurved(APath: IBGRAPath; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; + procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; virtual; abstract; + procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; virtual; abstract; + procedure TextMultiline(x,y: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaLeftJustify; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; + procedure TextMultiline(x,y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaLeftJustify; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; + procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; virtual; abstract; + procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; virtual; abstract; + function TextSize(const sUTF8: string): TSize; overload; virtual; abstract; + function TextAffineBox(const sUTF8: string): TAffineBox; virtual; abstract; + function TextSize(const sUTF8: string; AMaxWidth: integer): TSize; overload; virtual; abstract; + function TextSize(const sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; overload; virtual; abstract; + function TextFitInfo(const sUTF8: string; AMaxWidth: integer): integer; virtual; abstract; + function TextSizeMultiline(const sUTF8: string; AMaxWidth: single = EmptySingle; AParagraphSpacing: single = 0): TSize; virtual; abstract; + + { Draw the UTF8 encoded string, (x,y) being the top-left corner by default. The color c or texture is used to fill the text. + The value of FontOrientation is taken into account, so that the text may be rotated. } + procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; ARightToLeft: boolean); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; c: TColor); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; c: TColor; ARightToLeft: boolean); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; ARightToLeft: boolean); overload; virtual; + procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; + procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; + procedure TextOut(x, y: single; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; + procedure TextOut(x, y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; + + { Overrides the font orientation with the parameter orientationTenthDegCCW } + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel); overload; virtual; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner); overload; virtual; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; + + { Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. + The position depends on the specified horizontal alignment halign and vertical alignement valign. + The color c or texture is used to fill the text. No rotation is applied. } + procedure TextRect(ARect: TRect; const sUTF8: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); overload; virtual; + procedure TextRect(ARect: TRect; const sUTF8: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); overload; virtual; + + //-------------------------- computing path ------------------------------------ + + {Spline} + function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract; + function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract; + function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload; virtual; abstract; + function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload; virtual; abstract; + function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; overload; virtual; abstract; + function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; virtual; abstract; + + {can be accessed via Pen property} + function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; virtual; abstract; + function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; virtual; abstract; + function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract; + + function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; overload; deprecated; + function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; overload; deprecated; + function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract; + function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract; + function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; + function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract; + function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract; + + {Filling} + + // compatibility: take into account ClipRect + procedure Fill(texture: IBGRAScanner); overload; virtual; + procedure Fill(texture: IBGRAScanner; mode: TDrawMode); overload; override; + + procedure Fill(c: TBGRAPixel; start, Count: integer); overload; virtual; abstract; + procedure DrawPixels(c: TBGRAPixel; start, Count: integer); virtual; abstract; + procedure AlphaFill(alpha: byte; start, Count: integer); overload; virtual; abstract; + procedure ReplaceColor(before, after: TColor); overload; virtual; abstract; + procedure ReplaceColor(ARect: TRect; before, after: TColor); overload; virtual; abstract; + procedure FloodFill(X, Y: integer; Color: TBGRAPixel; + mode: TFloodfillMode; Tolerance: byte = 0); overload; virtual; + procedure FloodFill(X, Y: integer; const Brush: TUniversalBrush; + Progressive: boolean; ToleranceW: Word = $00ff); overload; virtual; + procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; Color: TBGRAPixel; + mode: TFloodfillMode; Tolerance: byte = 0; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; virtual; abstract; + procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; + Progressive: boolean; ToleranceW: Word = $00ff; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; virtual; abstract; + procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean = True; Sinus: Boolean=False; + ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); overload; virtual; abstract; + procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + Sinus: Boolean=False; + ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); overload; virtual; abstract; + + {Canvas drawing functions} + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract; + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual; abstract; + procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; virtual; abstract; + procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; virtual; abstract; + procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); overload; virtual; + procedure DrawPart(ARect: TRect; ACanvas: TCanvas; ATargetRect: TRect; Opaque: boolean); overload; virtual; + function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; virtual; abstract; + function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract; + + {BGRA bitmap functions} + procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; + procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; + procedure PutImage(x, y: integer; Source: TBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; + procedure StretchPutImage(ARect: TRect; Source: TBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; + procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; virtual; abstract; + procedure StretchPutImageProportionally(ARect: TRect; AHorizAlign: TAlignment; AVertAlign: TTextLayout; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); + procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap; AOpacity: byte = 255); + procedure PutImagePart(x,y: integer; Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte = 255); + procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload; + procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255); overload; + procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); overload; + procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); overload; + procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false; APixelCenteredCoords: boolean = true); overload; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; virtual; abstract; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false; APixelCenteredCoords: boolean = true); overload; + function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap): TRect; overload; + function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; ASourceWidth, ASourceHeight: integer; const ASourceBounds: TRect; AClipOutput: boolean = true): TRect; overload; + function GetImageAffineBounds(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; APixelCenteredCoords: boolean = true): TRect; overload; + function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true; APixelCenteredCoords: boolean = true): TRect; overload; virtual; abstract; + class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; virtual; abstract; + procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload; + procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload; + procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload; + procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload; + procedure ComputeImageAngleAxes(x,y,w,h,angle: single; imageCenterX,imageCenterY: single; ARestoreOffsetAfterRotation: boolean; + out Origin,HAxis,VAxis: TPointF); + function GetImageAngleBounds(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; ARestoreOffsetAfterRotation: boolean = false): TRect; + procedure Blend(AColor: TBGRAPixel; AOperation: TBlendOperation; AIgnoreDestAlpha: boolean = false); virtual; + procedure BlendOver(AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false; AIgnoreDestAlpha: boolean = false); virtual; + procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AIgnoreDestAlpha: boolean = false); overload; + procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AExcludeChannels: TChannels); overload; virtual; abstract; + procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false; AIgnoreDestAlpha: boolean = false); overload; + procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AExcludeChannels: TChannels); overload; virtual; abstract; + procedure BlendImage(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation); overload; virtual; abstract; + procedure BlendImage(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); overload; virtual; abstract; + procedure BlendImageOver(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; virtual; abstract; + procedure BlendImageOver(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; virtual; abstract; + function Resample(newWidth, newHeight: integer; + mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract; + + //masks + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode); overload; override; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); overload; virtual; abstract; + procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); virtual; abstract; + procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); overload; virtual; abstract; + procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); overload; virtual; abstract; + function GetMaskFromAlpha: TBGRACustomBitmap; virtual; abstract; + function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; override; + function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; override; + + {inplace filters} + procedure Negative; virtual; abstract; + procedure NegativeRect(ABounds: TRect); virtual; abstract; + procedure LinearNegative; virtual; abstract; + procedure LinearNegativeRect(ABounds: TRect); virtual; abstract; + procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; virtual; abstract; + procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; virtual; abstract; + procedure InplaceNormalize(AEachChannel: boolean = True); overload; virtual; abstract; + procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; virtual; abstract; + procedure ConvertToLinearRGB; virtual; abstract; + procedure ConvertFromLinearRGB; virtual; abstract; + procedure SwapRedBlue; overload; virtual; abstract; + procedure SwapRedBlue(ARect: TRect); overload; virtual; abstract; + procedure GrayscaleToAlpha; virtual; abstract; + procedure AlphaToGrayscale; virtual; abstract; + procedure VerticalFlip(ARect: TRect); overload; override; + procedure HorizontalFlip(ARect: TRect); overload; override; + procedure RotateUDInplace(ARect: TRect); overload; override; + + {Filters} + function RotateCW: TBGRACustomBitmap; override; + function RotateCCW: TBGRACustomBitmap; override; + function RotateUD: TBGRACustomBitmap; override; + function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract; + function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract; + function FilterSmooth: TBGRACustomBitmap; virtual; abstract; + function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; overload; virtual; abstract; + function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; overload; virtual; abstract; + function FilterContour(AGammaCorrection: boolean = false): TBGRACustomBitmap; virtual; abstract; + function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract; + function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; + function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; + function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override; + function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override; + function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGRACustomBitmap; overload; override; + function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGRACustomBitmap; overload; override; + function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; virtual; abstract; + function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; virtual; abstract; + function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; overload; virtual; abstract; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; overload; virtual; abstract; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; overload; virtual; abstract; + function FilterGrayscale: TBGRACustomBitmap; overload; virtual; abstract; + function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; overload; virtual; abstract; + function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; overload; virtual; abstract; + function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; overload; virtual; abstract; + function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract; + function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract; + function FilterSphere: TBGRACustomBitmap; virtual; abstract; + function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; virtual; abstract; + function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; virtual; abstract; + function FilterCylinder: TBGRACustomBitmap; virtual; abstract; + function FilterPlane: TBGRACustomBitmap; virtual; abstract; + + //IBGRAScanner + function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; override; + function ScanNextExpandedPixel: TExpandedPixel; override; + function ScanAtExpanded(X,Y: Single): TExpandedPixel; override; + function ProvidesScanline(ARect: TRect): boolean; override; + function GetScanlineAt(X, Y: integer): PBGRAPixel; override; + procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); override; + function ScanAtIntegerMask(X,Y: integer): TByteMask; override; + function ScanAtMask(X,Y: Single): TByteMask; override; + end; + +type + TBGRABitmapAny = class of TBGRACustomBitmap; //used to create instances of the same type (see NewBitmap) + +var + BGRABitmapFactory : TBGRABitmapAny; +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +function InternalGetImageBoundsWithin(ASourceBitmap: TBGRACustomBitmap; ASourceTexture: IBGRAScanner; + const ARect: TRect; Channels: TChannels; ANothingValue: Byte): TRect; +var + minx, miny, maxx, maxy: integer; + xb, xb2, yb: integer; + p: PLongWord; + colorMask, colorZeros: LongWord; + actualRect: TRect; + pixelBuffer: TBGRAPixelBuffer; +begin + pixelBuffer := nil; + if ASourceBitmap <> nil then + begin + actualRect := TRect.Intersect(ARect, rect(0,0,ASourceBitmap.Width,ASourceBitmap.Height)); + end + else if ASourceTexture <> nil then + begin + actualRect := ARect; + AllocateBGRAPixelBuffer(pixelBuffer, ARect.Right-ARect.Left) + end + else + begin + result := EmptyRect; + exit; + end; + maxx := actualRect.Left-1; + maxy := actualRect.Top-1; + minx := actualRect.Right; + miny := actualRect.Bottom; + colorMask := 0; + colorZeros := 0; + if cBlue in Channels then + begin + colorMask := colorMask or LongWord(BGRA(0,0,255,0)); + colorZeros:= colorZeros or LongWord(BGRA(0,0,ANothingValue,0)); + end; + if cGreen in Channels then + begin + colorMask := colorMask or LongWord(BGRA(0,255,0,0)); + colorZeros:= colorZeros or LongWord(BGRA(0,ANothingValue,0,0)); + end; + if cRed in Channels then + begin + colorMask := colorMask or LongWord(BGRA(255,0,0,0)); + colorZeros:= colorZeros or LongWord(BGRA(ANothingValue,0,0,0)); + end; + if cAlpha in Channels then + begin + colorMask := colorMask or LongWord(BGRA(0,0,0,255)); + colorZeros:= colorZeros or LongWord(BGRA(0,0,0,ANothingValue)); + end; + colorMask := NtoLE(colorMask); + colorZeros := NtoLE(colorZeros); + for yb := actualRect.Top to actualRect.Bottom-1 do + begin + if ASourceBitmap <> nil then + p := PLongWord(ASourceBitmap.ScanLine[yb])+actualRect.Left + else + begin + p := @pixelBuffer[0]; + ASourceTexture.ScanMoveTo(actualRect.Left,actualRect.Top); + ASourceTexture.ScanPutPixels(PBGRAPixel(p),ARect.Right-ARect.Left, dmSet); + end; + for xb := actualRect.Left to actualRect.Right - 1 do + begin + if (p^ and colorMask) <> colorZeros then + begin + if xb < minx then + minx := xb; + if yb < miny then + miny := yb; + if xb > maxx then + maxx := xb; + if yb > maxy then + maxy := yb; + + inc(p, actualRect.Right-1-xb); + for xb2 := actualRect.Right-1 downto xb+1 do + begin + if (p^ and colorMask) <> colorZeros then + begin + if xb2 > maxx then + maxx := xb2; + break; + end; + dec(p); + end; + break; + end; + Inc(p); + end; + end; + if minx > maxx then + begin + Result.left := 0; + Result.top := 0; + Result.right := 0; + Result.bottom := 0; + end + else + begin + Result.left := minx; + Result.top := miny; + Result.right := maxx + 1; + Result.bottom := maxy + 1; + end; +end; + +{ TBGRACustomBitmap } + +function TBGRACustomBitmap.GetFontAntialias: Boolean; +begin + result := FontQuality <> fqSystem; +end; + +procedure TBGRACustomBitmap.SetFontAntialias(const AValue: Boolean); +begin + if AValue and not FontAntialias then + FontQuality := fqFineAntialiasing + else if not AValue and (FontQuality <> fqSystem) then + FontQuality := fqSystem; +end; + +procedure TBGRACustomBitmap.SetXorMask(AValue: TBGRACustomBitmap); +begin + if FXorMask=AValue then Exit; + if (AValue.Width <> Width) or (AValue.Height <> Height) then + raise exception.Create('Dimension mismatch'); + DiscardXorMask; + FXorMask:=AValue; +end; + +procedure TBGRACustomBitmap.Init; +begin + inherited Init; + ScanMaskChannel:= cGreen; +end; + +function TBGRACustomBitmap.GetFontRightToLeftFor(AText: string): boolean; +begin + case FontBidiMode of + fbmAuto: result := IsRightToLeftUTF8(AText); + fbmRightToLeft: result := true; + else + {fbmLeftToRight} + result := false; + end; +end; + +function TBGRACustomBitmap.NewBitmap: TBGRACustomBitmap; +begin + Result:=inherited NewBitmap as TBGRACustomBitmap; +end; + +function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight) as TBGRACustomBitmap; +end; + +function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer; + const Color: TBGRAPixel): TBGRACustomBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGRACustomBitmap; +end; + +function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer + ): TBGRACustomBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGRACustomBitmap; +end; + +function TBGRACustomBitmap.InternalNew: TBGRACustomBitmap; +begin + Result:= BGRABitmapFactory.Create; +end; + +procedure TBGRACustomBitmap.DiscardXorMask; +begin + if Assigned(FXorMask) then + begin + if FXorMask is TBGRACustomBitmap then + begin + TBGRACustomBitmap(FXorMask).FreeReference; + FXorMask := nil; + end else + FreeAndNil(FXorMask); + end; +end; + +procedure TBGRACustomBitmap.NeedXorMask; +begin + if FXorMask = nil then + FXorMask := BGRABitmapFactory.Create(Width,Height); +end; + +function TBGRACustomBitmap.NewReference: TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited NewReference); +end; + +function TBGRACustomBitmap.GetUnique: TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited GetUnique); +end; + +function TBGRACustomBitmap.Duplicate(DuplicateProperties: Boolean): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited Duplicate(DuplicateProperties)); +end; + +function TBGRACustomBitmap.Duplicate(DuplicateProperties, + DuplicateXorMask: Boolean): TBGRACustomBitmap; +begin + result := Duplicate(DuplicateProperties); + if DuplicateXorMask and Assigned(XorMask) then + result.XorMask := FXorMask.Duplicate(True); +end; + +procedure TBGRACustomBitmap.CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); +var + other: TBGRACustomBitmap; +begin + inherited CopyPropertiesTo(ABitmap); + if ABitmap is TBGRACustomBitmap then + begin + other := TBGRACustomBitmap(ABitmap); + other.CanvasOpacity := CanvasOpacity; + other.CanvasDrawModeFP := CanvasDrawModeFP; + other.PenStyle := PenStyle; + other.CustomPenStyle := CustomPenStyle; + other.FontName := FontName; + other.FontHeight := FontHeight; + other.FontStyle := FontStyle; + other.FontQuality := FontQuality; + other.FontOrientation := FontOrientation; + other.FontVerticalAnchor:= FontVerticalAnchor; + other.FontBidiMode:= FontBidiMode; + other.LineCap := LineCap; + other.JoinStyle := JoinStyle; + other.ResampleFilter := ResampleFilter; + other.ScanInterpolationFilter:= ScanInterpolationFilter; + other.HotSpot := HotSpot; + end; +end; + +function TBGRACustomBitmap.GetPart(const ARect: TRect): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited GetPart(ARect)); +end; + +function TBGRACustomBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; + APatternColor, ABackgroundColor: TBGRAPixel; AWidth: integer; + AHeight: integer; APenWidth: single): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited CreateBrushTexture(ABrushStyle, APatternColor, ABackgroundColor, AWidth,AHeight,APenWidth)); +end; + +procedure TBGRACustomBitmap.SetSize(AWidth, AHeight: integer); +begin + if (AWidth <> Width) or (AHeight <> Height) then + begin + inherited SetSize(AWidth, AHeight); + DiscardXorMask; + end; +end; + +procedure TBGRACustomBitmap.InternalArc(cx, cy, rx, ry: single; + const StartPoint, EndPoint: TPointF; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; + ADrawChord: boolean; ATexture: IBGRAScanner); +var angle1,angle2: single; +begin + if (rx = 0) or (ry = 0) then exit; + angle1 := arctan2(-(StartPoint.y-cy)/ry,(StartPoint.x-cx)/rx); + angle2 := arctan2(-(EndPoint.y-cy)/ry,(EndPoint.x-cx)/rx); + if angle1 = angle2 then angle2 := angle1+2*Pi; + InternalArc(cx,cy,rx,ry, angle1,angle2, + ABorderColor,w,AFillColor, AOptions, ADrawChord, ATexture); +end; + +procedure TBGRACustomBitmap.InternalArcInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; + ADrawChord: boolean; ATexture: IBGRAScanner); +var + temp: LongInt; +begin + if r.right = r.left then exit; + if r.bottom = r.top then exit; + if r.right < r.left then + begin + temp := r.left; + r.left := r.right; + r.right := temp; + end; + if r.Bottom < r.Top then + begin + temp := r.Top; + r.Top := r.Bottom; + r.Bottom := temp; + end; + InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, + (r.right-r.left-1)/2,(r.bottom-r.top-1)/2, + StartAngleRad,EndAngleRad, + ABorderColor,w,AFillColor, + AOptions, ADrawChord, ATexture); +end; + +procedure TBGRACustomBitmap.InternalFillArcInRect(r: TRect; StartAngleRad, + EndAngleRad: Single; AFillColor: TBGRAPixel; AOptions: TArcOptions; + ATexture: IBGRAScanner); +var + temp: LongInt; +begin + if r.right = r.left then exit; + if r.bottom = r.top then exit; + if r.right < r.left then + begin + temp := r.left; + r.left := r.right; + r.right := temp; + end; + if r.Bottom < r.Top then + begin + temp := r.Top; + r.Top := r.Bottom; + r.Bottom := temp; + end; + InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, + (r.right-r.left)/2,(r.bottom-r.top)/2, + StartAngleRad,EndAngleRad, + BGRAPixelTransparent,0,AFillColor, + AOptions, False, ATexture); +end; + +procedure TBGRACustomBitmap.DrawPixel(x, y: int32or64; const c: TBGRAPixel; + ADrawMode: TDrawMode); +begin + case ADrawMode of + dmSet: SetPixel(x,y,c); + dmSetExceptTransparent: if c.alpha = 255 then SetPixel(x,y,c); + dmLinearBlend: FastBlendPixel(x,y,c); + dmDrawWithTransparency: DrawPixel(x,y,c); + dmXor: XorPixel(x,y,c); + end; +end; + +procedure TBGRACustomBitmap.LoadFromStream(AStream: TStream; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +var + OldDrawMode: TDrawMode; +begin + { LoadFromStream uses TFPCustomImage routine, which uses + Colors property to access pixels. That's why the + FP drawing mode is temporarily changed to load + bitmaps properly } + OldDrawMode := CanvasDrawModeFP; + CanvasDrawModeFP := dmSet; + DiscardXorMask; + try + inherited LoadFromStream(AStream, AHandler, AOptions); + finally + CanvasDrawModeFP := OldDrawMode; + end; +end; + +{ Look for a pixel considering the bitmap is repeated in both directions } +procedure TBGRACustomBitmap.DrawHorizLine(x, y, x2: int32or64; + texture: IBGRAScanner); +begin + HorizLine(x,y,x2,texture,dmDrawWithTransparency); +end; + +procedure TBGRACustomBitmap.Arc(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AColor: TBGRAPixel; w: single; ADrawChord: boolean; + AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,w,AFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGRACustomBitmap.Arc(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; w: single; ADrawChord: boolean; + AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,w,AFillColor,[aoFillPath],ADrawChord); +end; + +procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,AFillColor,[aoFillPath]); +end; + +procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,AFillColor,[aoFillPath]); +end; + +procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; texture: IBGRAScanner); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath],False,texture); +end; + +procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; texture: IBGRAScanner); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath],False,texture); +end; + +procedure TBGRACustomBitmap.FillChordInRect(const ARect: TRect; StartAngleRad, + EndAngleRad: Single; AFillColor: TBGRAPixel); +begin + InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,AFillColor,[aoFillPath]); +end; + +procedure TBGRACustomBitmap.FillChordInRect(const ARect: TRect; StartAngleRad, + EndAngleRad: Single; texture: IBGRAScanner); +begin + InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,BGRAWhite,[aoFillPath],texture); +end; + +procedure TBGRACustomBitmap.Pie(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,w,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGRACustomBitmap.Pie(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,w,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; AFillColor: TBGRAPixel); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; const StartPoint, + EndPoint: TPointF; texture: IBGRAScanner); +begin + InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath,aoPie],False,texture); +end; + +procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; texture: IBGRAScanner); +begin + InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath,aoPie],False,texture); +end; + +procedure TBGRACustomBitmap.FillPieInRect(const ARect: TRect; StartAngleRad, + EndAngleRad: Single; AFillColor: TBGRAPixel); +begin + InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,AFillColor,[aoFillPath,aoPie]); +end; + +procedure TBGRACustomBitmap.FillPieInRect(const ARect: TRect; StartAngleRad, + EndAngleRad: Single; texture: IBGRAScanner); +begin + InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,BGRAWhite,[aoFillPath,aoPie],texture); +end; + +{ Following functions are defined for convenience } +procedure TBGRACustomBitmap.RectangleWithin(x1, y1, x2, y2: single; + ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; + APixelCenteredCoordinates: boolean); +begin + if not APixelCenteredCoordinates then + begin + DecF(x1, 0.5); + DecF(y1, 0.5); + DecF(x2, 0.5); + DecF(y2, 0.5); + end; + RectangleAntialias(x1+w*0.5,y1+w*0.5,x2-w*0.5,y2-w*0.5, ABorderColor, w, AFillColor); +end; + +procedure TBGRACustomBitmap.RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; + w: single; AFillColor: TBGRAPixel); +begin + RectangleWithin(r.left,r.top,r.right,r.bottom,ABorderColor,w,AFillColor,false); +end; + +procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner; + mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); +begin + FillRect(r.Left,r.Top,r.Right,r.Bottom, texture, mode, ditheringAlgorithm); +end; + +procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner; + mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); +begin + FillRect(r.Left,r.Top,r.Right,r.Bottom, texture, mode, AScanOffset, ditheringAlgorithm); +end; + +procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; + texture: IBGRAScanner; mode: TDrawMode; + ditheringAlgorithm: TDitheringAlgorithm); +begin + FillRect(x,y,x2,y2,texture,mode,Point(0,0),ditheringAlgorithm); +end; + +procedure TBGRACustomBitmap.TextOutCurved(APath: IBGRAPath; const sUTF8: string; + AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); +var cursor: TBGRACustomPathCursor; +begin + cursor := APath.getCursor; + if cursor = nil then exit; + case AAlign of + taCenter: cursor.Position := cursor.PathLength*0.5; + taRightJustify: cursor.Position:= cursor.PathLength; + end; + TextOutCurved(cursor, sUTF8, AColor, AAlign, ALetterSpacing); + cursor.free; +end; + +procedure TBGRACustomBitmap.TextOutCurved(APath: IBGRAPath; const sUTF8: string; + ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); +var cursor: TBGRACustomPathCursor; +begin + cursor := APath.getCursor; + if cursor = nil then exit; + case AAlign of + taCenter: cursor.Position := cursor.PathLength*0.5; + taRightJustify: cursor.Position:= cursor.PathLength; + end; + TextOutCurved(cursor, sUTF8, ATexture, AAlign, ALetterSpacing); + cursor.free; +end; + +procedure TBGRACustomBitmap.TextMultiline(x, y: single; const sUTF8: string; + c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); +begin + TextMultiline(x, y, EmptySingle, sUTF8, c, AAlign, AVertAlign, AParagraphSpacing); +end; + +procedure TBGRACustomBitmap.TextMultiline(x, y: single; const sUTF8: string; + ATexture: IBGRAScanner; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); +begin + TextMultiline(x, y, EmptySingle, sUTF8, ATexture, AAlign, AVertAlign, AParagraphSpacing); +end; + +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; + align: TAlignment); +begin + TextOut(x,y,sUTF8,c,align, GetFontRightToLeftFor(sUTF8)); +end; + +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; + texture: IBGRAScanner; align: TAlignment); +begin + TextOut(x,y,sUTF8,texture,align, GetFontRightToLeftFor(sUTF8)); +end; + +{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text. + The value of FontOrientation is taken into account, so that the text may be rotated. } +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel); +begin + TextOut(x, y, sUTF8, c, taLeftJustify); +end; + +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; + ARightToLeft: boolean); +begin + TextOut(x, y, sUTF8, c, taLeftJustify, ARightToLeft); +end; + +{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text. + The value of FontOrientation is taken into account, so that the text may be rotated. } +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TColor); +begin + TextOut(x, y, sUTF8, ColorToBGRA(c)); +end; + +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TColor; + ARightToLeft: boolean); +begin + TextOut(x, y, sUTF8, ColorToBGRA(c), ARightToLeft); +end; + +{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The texture is used to fill the text. + The value of FontOrientation is taken into account, so that the text may be rotated. } +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; + texture: IBGRAScanner); +begin + TextOut(x, y, sUTF8, texture, taLeftJustify); +end; + +procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; + texture: IBGRAScanner; ARightToLeft: boolean); +begin + TextOut(x, y, sUTF8, texture, taLeftJustify, ARightToLeft); +end; + +procedure TBGRACustomBitmap.TextOutAngle(x, y: single; + orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel); +begin + TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,c,taLeftJustify); +end; + +procedure TBGRACustomBitmap.TextOutAngle(x, y: single; + orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; + align: TAlignment); +begin + TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,c,align, GetFontRightToLeftFor(sUTF8)); +end; + +procedure TBGRACustomBitmap.TextOutAngle(x, y: single; + orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner); +begin + TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,texture,taLeftJustify); +end; + +procedure TBGRACustomBitmap.TextOutAngle(x, y: single; + orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; + align: TAlignment); +begin + TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,texture,align, GetFontRightToLeftFor(sUTF8)); +end; + +{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. + The position depends on the specified horizontal alignment halign and vertical alignement valign. + The color c is used to fill the text. No rotation is applied. } +procedure TBGRACustomBitmap.TextRect(ARect: TRect; const sUTF8: string; + halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); +var + style: TTextStyle; + sUTF8bidi: String; +begin + {$hints off} + FillChar(style,sizeof(style),0); + {$hints on} + style.Alignment := halign; + style.Layout := valign; + style.Wordbreak := true; + style.ShowPrefix := false; + style.Clipping := false; + style.RightToLeft := GetFontRightToLeftFor(sUTF8); + if FontBidiMode = fbmAuto then + sUTF8bidi := AddParagraphBidiUTF8(sUTF8, style.RightToLeft) + else sUTF8bidi := sUTF8; + TextRect(ARect, ARect.Left, ARect.Top, sUTF8bidi, style, c); +end; + +{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. + The position depends on the specified horizontal alignment halign and vertical alignement valign. + The texture is used to fill the text. No rotation is applied. } +procedure TBGRACustomBitmap.TextRect(ARect: TRect; const sUTF8: string; + halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); +var + style: TTextStyle; + sUTF8bidi: String; +begin + {$hints off} + FillChar(style,sizeof(style),0); + {$hints on} + style.Alignment := halign; + style.Layout := valign; + style.Wordbreak := true; + style.ShowPrefix := false; + style.Clipping := false; + style.RightToLeft := GetFontRightToLeftFor(sUTF8); + if FontBidiMode = fbmAuto then + sUTF8bidi := AddParagraphBidiUTF8(sUTF8, style.RightToLeft) + else sUTF8bidi := sUTF8; + TextRect(ARect,ARect.Left,ARect.Top,sUTF8bidi,style,texture); +end; + +function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry: single): ArrayOfTPointF; +begin + result := ComputeEllipseContour(x,y,rx,ry); +end; + +function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry, w: single + ): ArrayOfTPointF; +begin + result := ComputeEllipseBorder(x,y,rx,ry,w); +end; + +procedure TBGRACustomBitmap.Fill(texture: IBGRAScanner); +begin + FillRect(ClipRect, texture, dmSet); +end; + +procedure TBGRACustomBitmap.Fill(texture: IBGRAScanner; mode: TDrawMode); +begin + FillRect(ClipRect, texture, mode); +end; + +procedure TBGRACustomBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel; + mode: TFloodfillMode; Tolerance: byte); +begin + ParallelFloodFill(X,Y, Self, Color, mode, Tolerance); +end; + +procedure TBGRACustomBitmap.FloodFill(X, Y: integer; + const Brush: TUniversalBrush; Progressive: boolean; ToleranceW: Word); +begin + ParallelFloodFill(X,Y, Self, Brush, Progressive, ToleranceW); +end; + +procedure TBGRACustomBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x, + y: integer; Opaque: boolean); +var + partial: TBGRACustomBitmap; +begin + if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then + Draw(ACanvas, x,y, Opaque) + else + begin + partial := GetPart(ARect); + if partial <> nil then + begin + partial.Draw(ACanvas, x, y, Opaque); + partial.Free; + end; + end; +end; + +procedure TBGRACustomBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; + ATargetRect: TRect; Opaque: boolean); +var + partial: TBGRACustomBitmap; +begin + if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then + Draw(ACanvas, ATargetRect, Opaque) + else + begin + partial := GetPart(ARect); + if partial <> nil then + begin + partial.Draw(ACanvas, ATargetRect, Opaque); + partial.Free; + end; + end; +end; + +procedure TBGRACustomBitmap.PutImage(x, y: integer; Source: TBitmap; + mode: TDrawMode; AOpacity: byte); +var bgra: TBGRACustomBitmap; +begin + bgra := BGRABitmapFactory.create(Source); + PutImage(x,y, bgra, mode, AOpacity); + bgra.free; +end; + +procedure TBGRACustomBitmap.StretchPutImage(ARect: TRect; Source: TBitmap; + mode: TDrawMode; AOpacity: byte); +var bgra: TBGRACustomBitmap; +begin + bgra := BGRABitmapFactory.create(Source); + StretchPutImage(ARect, bgra, mode, AOpacity); + bgra.free; +end; + +procedure TBGRACustomBitmap.StretchPutImageProportionally(ARect: TRect; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; Source: TBGRACustomBitmap; + mode: TDrawMode; AOpacity: byte); +var + ratio: single; + imgRect: TRect; +begin + if (Source.Width = 0) or (Source.Height = 0) then exit; + if (ARect.Width <= 0) or (ARect.Height <= 0) then exit; + + ratio := min(ARect.Width/Source.Width, ARect.Height/Source.Height); + imgRect := RectWithSize(ARect.Left,ARect.Top, round(Source.Width*ratio), round(Source.Height*ratio)); + case AHorizAlign of + taCenter: imgRect.Offset((ARect.Width-imgRect.Width) div 2, 0); + taRightJustify: imgRect.Offset(ARect.Width-imgRect.Width, 0); + end; + case AVertAlign of + tlCenter: imgRect.Offset(0,(ARect.Height-imgRect.Height) div 2); + tlBottom: imgRect.Offset(0,ARect.Height-imgRect.Height); + end; + StretchPutImage(imgRect, Source, mode, AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap; AOpacity: byte); +begin + PutImageAngle(x,y,source,0,0,0,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImagePart(x, y: integer; + Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte); +var w,h,sourcex,sourcey,nx,ny,xb,yb,destx,desty: integer; + oldClip,newClip: TRect; +begin + if (Source = nil) or (AOpacity = 0) then exit; + w := SourceRect.Right-SourceRect.Left; + h := SourceRect.Bottom-SourceRect.Top; + if (w <= 0) or (h <= 0) or (Source.Width = 0) or (Source.Height = 0) then exit; + sourcex := PositiveMod(SourceRect.Left, Source.Width); + sourcey := PositiveMod(SourceRect.Top, Source.Height); + nx := (sourceX+w + Source.Width-1) div Source.Width; + ny := (sourceY+h + Source.Height-1) div Source.Height; + + oldClip := ClipRect; + newClip := rect(x,y,x+w,y+h); + newClip.Intersect(oldClip); + if newClip.IsEmpty then exit; + + ClipRect := newClip; + + desty := y-sourcey; + for yb := 0 to ny-1 do + begin + destx := x-sourcex; + for xb := 0 to nx-1 do + begin + self.PutImage(destx,desty,Source,mode,AOpacity); + inc(destx,Source.Width); + end; + inc(desty,Source.Height); + end; + + ClipRect := oldClip; +end; + +procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean); +begin + if ACorrectBlur then + PutImageAffine(Origin,HAxis,VAxis,Source,rfCosine,AOpacity) + else + PutImageAffine(Origin,HAxis,VAxis,Source,rfLinear,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte); +begin + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; + PutImageAffine(Origin,HAxis,VAxis,Source,GetImageAffineBounds(Origin,HAxis,VAxis,Source),AResampleFilter,dmDrawWithTransparency,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; + AMode: TDrawMode; AOpacity: Byte); +begin + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; + PutImageAffine(Origin,HAxis,VAxis,Source,GetImageAffineBounds(Origin,HAxis,VAxis,Source),AResampleFilter,AMode,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap; AOutputBounds: TRect; + AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte); +var m: TAffineMatrix; w,h: integer; +begin + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; + if Source.Width < 2 then w := 2 else w := Source.Width; //avoid actual size of zero + if Source.Height < 2 then h := 2 else h := Source.Height; + m[1,1] := (HAxis.x-Origin.x)/(w-1); m[1,2] := (VAxis.x-Origin.x)/(h-1); m[1,3] := Origin.x; + m[2,1] := (HAxis.y-Origin.y)/(w-1); m[2,2] := (VAxis.y-Origin.y)/(h-1); m[2,3] := Origin.y; + PutImageAffine(m,Source,AOutputBounds,AResampleFilter,AMode,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte; + ACorrectBlur: Boolean); +begin + if ACorrectBlur then + PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfCosine,dmDrawWithTransparency,AOpacity) + else + PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean; APixelCenteredCoords: boolean); +begin + if ACorrectBlur then + PutImageAffine(AMatrix,Source,rfCosine,AOpacity,APixelCenteredCoords) + else + PutImageAffine(AMatrix,Source,rfLinear,AOpacity,APixelCenteredCoords); +end; + +procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte; APixelCenteredCoords: boolean); +begin + PutImageAffine(AMatrix, Source, AResampleFilter, dmDrawWithTransparency, AOpacity, APixelCenteredCoords); +end; + +procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; + AMode: TDrawMode; AOpacity: Byte; APixelCenteredCoords: boolean); +begin + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; + PutImageAffine(AMatrix, Source, GetImageAffineBounds(AMatrix,Source), + AResampleFilter,AMode,AOpacity,APixelCenteredCoords); +end; + +procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte; + ACorrectBlur: Boolean; APixelCenteredCoords: boolean); +begin + if ACorrectBlur then + PutImageAffine(AMatrix,Source,AOutputBounds,rfCosine,dmDrawWithTransparency,AOpacity,APixelCenteredCoords) + else + PutImageAffine(AMatrix,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity,APixelCenteredCoords); +end; + +{ Returns the area that contains the affine transformed image } +function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF; + Source: TBGRACustomBitmap): TRect; +begin + if Source = nil then + result := EmptyRect + else + result := GetImageAffineBounds(Origin,HAxis,VAxis,Source.Width,Source.Height,Source.GetImageBounds); +end; + +function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF; + ASourceWidth, ASourceHeight: integer; const ASourceBounds: TRect; AClipOutput: boolean): TRect; +var m: TAffineMatrix; +begin + if (ASourceWidth = 0) or (ASourceHeight = 0) then + result := EmptyRect + else + begin + if ASourceWidth < 2 then ASourceWidth := 2; //avoid division by zero by supposing a pixel size of 2 + if ASourceHeight < 2 then ASourceHeight := 2; //i.e. an actual size of 1 (cf pixel centered coordinates) + m[1,1] := (HAxis.x-Origin.x)/(ASourceWidth-1); m[1,2] := (VAxis.x-Origin.x)/(ASourceHeight-1); m[1,3] := Origin.x; + m[2,1] := (HAxis.y-Origin.y)/(ASourceWidth-1); m[2,2] := (VAxis.y-Origin.y)/(ASourceHeight-1); m[2,3] := Origin.y; + result := GetImageAffineBounds(m, ASourceBounds, AClipOutput); + end; +end; + +function TBGRACustomBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; APixelCenteredCoords: boolean): TRect; +begin + result := GetImageAffineBounds(AMatrix, Source.GetImageBounds, true, APixelCenteredCoords); +end; + +procedure TBGRACustomBitmap.PutImageAngle(x, y: single; + Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; + imageCenterX: single; imageCenterY: single; AOpacity: Byte; + ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean); +begin + if ACorrectBlur then + PutImageAngle(x,y,Source,angle,AOutputBounds,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation) + else + PutImageAngle(x,y,Source,angle,AOutputBounds,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation); +end; + +procedure TBGRACustomBitmap.PutImageAngle(x, y: single; + Source: TBGRACustomBitmap; angle: single; imageCenterX: single; + imageCenterY: single; AOpacity: Byte; ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean); +begin + if ACorrectBlur then + PutImageAngle(x,y,Source,angle,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation) + else + PutImageAngle(x,y,Source,angle,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation); +end; + +procedure TBGRACustomBitmap.PutImageAngle(x, y: single; + Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; + AResampleFilter: TResampleFilter; imageCenterX: single; imageCenterY: single; AOpacity: Byte; + ARestoreOffsetAfterRotation: boolean); +var + Origin,HAxis,VAxis: TPointF; +begin + if (source = nil) or (AOpacity=0) then exit; + ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation, + Origin,HAxis,VAxis); + PutImageAffine(Origin,HAxis,VAxis,source,AOutputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity); +end; + +procedure TBGRACustomBitmap.PutImageAngle(x, y: single; + Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; + imageCenterX: single; imageCenterY: single; AOpacity: Byte; + ARestoreOffsetAfterRotation: boolean); +var + Origin,HAxis,VAxis: TPointF; +begin + if (source = nil) or (AOpacity=0) then exit; + ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation, + Origin,HAxis,VAxis); + PutImageAffine(Origin,HAxis,VAxis,source,AResampleFilter,AOpacity); +end; + +procedure TBGRACustomBitmap.ComputeImageAngleAxes(x, y, w, h, + angle: single; imageCenterX, imageCenterY: single; + ARestoreOffsetAfterRotation: boolean; out Origin, HAxis, VAxis: TPointF); +var + cosa,sina: single; + + { Compute rotated coordinates } + function Coord(relX,relY: single): TPointF; + begin + DecF(relX, imageCenterX); + DecF(relY, imageCenterY); + result.x := relX*cosa - relY*sina+ x; + result.y := relY*cosa + relX*sina+ y; + if ARestoreOffsetAfterRotation then + result.Offset(imageCenterX,imageCenterY); + end; + +begin + cosa := cos(-angle*Pi/180); + sina := -sin(-angle*Pi/180); + Origin := Coord(0,0); + if w < 2 then w := 2; //when pixel size is 1, actual size is zero, so avoid that + if h < 2 then h := 2; + HAxis := Coord(w-1,0); + VAxis := Coord(0,h-1); +end; + +function TBGRACustomBitmap.GetImageAngleBounds(x, y: single; + Source: TBGRACustomBitmap; angle: single; imageCenterX: single; + imageCenterY: single; ARestoreOffsetAfterRotation: boolean): TRect; +var + cosa,sina: single; + + { Compute rotated coordinates } + function Coord(relX,relY: single): TPointF; + begin + DecF(relX, imageCenterX); + DecF(relY, imageCenterY); + result.x := relX*cosa - relY*sina + x; + result.y := relY*cosa + relX*sina + y; + if ARestoreOffsetAfterRotation then + result.Offset(imageCenterX,imageCenterY); + end; + +begin + if (source = nil) then + begin + result := EmptyRect; + exit; + end; + cosa := cos(-angle*Pi/180); + sina := -sin(-angle*Pi/180); + result := GetImageAffineBounds(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source); +end; + +procedure TBGRACustomBitmap.Blend(AColor: TBGRAPixel; + AOperation: TBlendOperation; AIgnoreDestAlpha: boolean); +begin + BlendRect(ClipRect, AColor, AOperation, AIgnoreDestAlpha); +end; + +procedure TBGRACustomBitmap.BlendOver(AColor: TBGRAPixel; + AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AIgnoreDestAlpha: boolean); +begin + BlendRectOver(ClipRect, AColor, AOperation, AOpacity, ALinearBlend, AIgnoreDestAlpha); +end; + +procedure TBGRACustomBitmap.BlendRect(ADest: TRect; AColor: TBGRAPixel; + AOperation: TBlendOperation; AIgnoreDestAlpha: boolean); +begin + if AIgnoreDestAlpha then + BlendRect(ADest, AColor, AOperation, [cAlpha]) + else BlendRect(ADest, AColor, AOperation, []); +end; + +procedure TBGRACustomBitmap.BlendRectOver(ADest: TRect; AColor: TBGRAPixel; + AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; + AIgnoreDestAlpha: boolean); +begin + if AIgnoreDestAlpha then + BlendRectOver(ADest, AColor, AOperation, AOpacity, ALinearBlend,[cAlpha]) + else BlendRectOver(ADest, AColor, AOperation, AOpacity, ALinearBlend, []); +end; + +procedure TBGRACustomBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode); +begin + FillMask(x, y, AMask, ATexture, ADrawMode, 255); +end; + +procedure TBGRACustomBitmap.VerticalFlip(ARect: TRect); +begin + inherited VerticalFlip(ARect); + if Assigned(XorMask) then XorMask.VerticalFlip(ARect); +end; + +procedure TBGRACustomBitmap.HorizontalFlip(ARect: TRect); +begin + inherited HorizontalFlip(ARect); + if Assigned(XorMask) then XorMask.HorizontalFlip(ARect); +end; + +procedure TBGRACustomBitmap.RotateUDInplace(ARect: TRect); +begin + inherited RotateUDInplace(ARect); + if Assigned(XorMask) then XorMask.RotateUDInplace(ARect); +end; + +function TBGRACustomBitmap.RotateCW: TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(Inherited RotateCW); + if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateCW; +end; + +function TBGRACustomBitmap.RotateCCW: TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(Inherited RotateCCW); + if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateCCW; +end; + +function TBGRACustomBitmap.RotateUD: TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(Inherited RotateUD); + if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateUD; +end; + +function TBGRACustomBitmap.FilterBlurRadial(radius: single; + blurType: TRadialBlurType): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurRadial(radius, blurType)); +end; + +function TBGRACustomBitmap.FilterBlurRadial(const ABounds: TRect; radius: single; + blurType: TRadialBlurType): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurRadial(ABounds, radius, blurType)); +end; + +function TBGRACustomBitmap.FilterBlurRadial(radiusX, radiusY: single; + blurType: TRadialBlurType): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurRadial(radiusX,radiusY, blurType)); +end; + +function TBGRACustomBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, + radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurRadial(ABounds, radiusX,radiusY, blurType)); +end; + +function TBGRACustomBitmap.FilterBlurMotion(distance: single; angle: single; + oriented: boolean): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurMotion(distance, angle, oriented)); +end; + +function TBGRACustomBitmap.FilterBlurMotion(const ABounds: TRect; distance: single; + angle: single; oriented: boolean): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterBlurMotion(ABounds, distance, angle, oriented)); +end; + +function TBGRACustomBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap + ): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterCustomBlur(mask)); +end; + +function TBGRACustomBitmap.FilterCustomBlur(const ABounds: TRect; + mask: TCustomUniversalBitmap): TBGRACustomBitmap; +begin + result := TBGRACustomBitmap(inherited FilterCustomBlur(ABounds,mask)); +end; + +function TBGRACustomBitmap.GetImageBoundsWithin(const ARect: TRect; + Channel: TChannel; ANothingValue: Byte): TRect; +begin + result := InternalGetImageBoundsWithin(self,nil,ARect,[Channel],ANothingValue); +end; + +function TBGRACustomBitmap.GetImageBoundsWithin(const ARect: TRect; + Channels: TChannels; ANothingValue: Byte): TRect; +begin + result := InternalGetImageBoundsWithin(self,nil,ARect,Channels,ANothingValue); +end; + +function TBGRACustomBitmap.ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; +begin + result := GammaExpansion(ScanAtInteger(X,Y)); +end; + +function TBGRACustomBitmap.ScanNextExpandedPixel: TExpandedPixel; +begin + result := GammaExpansion(ScanNextPixel); +end; + +function TBGRACustomBitmap.ScanAtExpanded(X, Y: Single): TExpandedPixel; +begin + result := GammaExpansion(ScanAt(X,Y)); +end; + +function TBGRACustomBitmap.ProvidesScanline(ARect: TRect): boolean; +begin + result := (ARect.Left+ScanOffset.x >= 0) and (ARect.Top+ScanOffset.y >= 0) and + (ARect.Right+ScanOffset.x <= Width) and (ARect.Bottom+ScanOffset.y <= Height); +end; + +function TBGRACustomBitmap.GetScanlineAt(X, Y: integer): PBGRAPixel; +begin + result := ScanLine[y+ScanOffset.y]+x+ScanOffset.x; +end; + +procedure TBGRACustomBitmap.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); +var + PPixels: Pointer; +begin + ScanNextCustomChunk(ACount, PPixels); + AMask := (PByteMask(PPixels)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel]); + AStride := sizeof(TBGRAPixel); +end; + +function TBGRACustomBitmap.ScanAtIntegerMask(X,Y: integer): TByteMask; +var + c: TBGRAPixel; +begin + c := ScanAtInteger(X,Y); + result := (PByte(@c)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel])^; +end; + +function TBGRACustomBitmap.ScanAtMask(X,Y: Single): TByteMask; +var + c: TBGRAPixel; +begin + c := ScanAt(X,Y); + result := (PByte(@c)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel])^; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgracustomtextfx.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgracustomtextfx.pas new file mode 100644 index 0000000..f6c4c08 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgracustomtextfx.pas @@ -0,0 +1,600 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRACustomTextFX; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRAPhongTypes, BGRAGrayscaleMask; + +const DefaultOutlineWidth = 3; + +type + { TBGRACustomTextEffect } + + TBGRACustomTextEffect = class + private + function GetBounds: TRect; + function GetMaskHeight: integer; + class function GetOutlineWidth: integer; static; + function GetShadowBounds(ARadius: integer): TRect; + function GetMaskWidth: integer; + function GetTextHeight: integer; + function GetTextWidth: integer; + procedure SetShadowQuality(AValue: TRadialBlurType); + protected + FShadowQuality: TRadialBlurType; + FTextMask: TGrayscaleMask; + FShadowRadius: integer; + FOutlineMask, FShadowMask : TGrayscaleMask; + FShadingMask: TBGRACustomBitmap; + FShadingAltitude: integer; + FShadingRounded: boolean; + FTextSize: TSize; + FOffset: TPoint; + function DrawMaskMulticolored(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; const AColors: array of TBGRAPixel): TRect; + function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; AColor: TBGRAPixel): TRect; overload; + function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; ATexture: IBGRAScanner): TRect; overload; + function InternalDrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect; + procedure Init(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); + public + constructor Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); + constructor Create(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); + procedure ApplySphere; + procedure ApplyVerticalCylinder; + procedure ApplyHorizontalCylinder; + function Draw(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload; + function Draw(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload; + function Draw(ADest: TBGRACustomBitmap; X, Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; + function Draw(ADest: TBGRACustomBitmap; X, Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload; + + function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ARounded: Boolean = true): TRect; overload; + function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; ARounded: Boolean = true): TRect; overload; + function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload; + function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload; + + function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel): TRect; overload; + function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect; overload; + function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload; + function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload; + function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; + function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload; + function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel): TRect; overload; + function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; + destructor Destroy; override; + property TextMask: TGrayscaleMask read FTextMask; + property TextMaskOffset: TPoint read FOffset; + property Width: integer read GetTextWidth; deprecated; + property Height: integer read GetTextHeight; deprecated; + property MaskWidth: integer read GetMaskWidth; + property MaskHeight: integer read GetMaskHeight; + property TextSize: TSize read FTextSize; + property TextWidth: integer read GetTextWidth; + property TextHeight: integer read GetTextHeight; + property Bounds: TRect read GetBounds; + property ShadowBounds[ARadius: integer]: TRect read GetShadowBounds; + property ShadowQuality: TRadialBlurType read FShadowQuality write SetShadowQuality; + class property OutlineWidth: integer read GetOutlineWidth; + end; + +implementation + +uses Math, BGRAGradientScanner; + +procedure BGRACustomReplace(var Destination: TBGRACustomBitmap; Temp: TObject); overload; +begin + Destination.Free; + Destination := Temp as TBGRACustomBitmap; +end; + +procedure BGRACustomReplace(var Destination: TGrayscaleMask; Temp: TObject); overload; +begin + Destination.Free; + Destination := Temp as TGrayscaleMask; +end; + +{ TBGRACustomTextEffect } + +function TBGRACustomTextEffect.GetBounds: TRect; +begin + if FTextMask = nil then + result := EmptyRect else + with TextMaskOffset do + result := rect(X,Y,X+FTextMask.Width,Y+FTextMask.Height); +end; + +function TBGRACustomTextEffect.GetMaskHeight: integer; +begin + if FTextMask = nil then + result := 0 + else + result := FTextMask.Height; +end; + +class function TBGRACustomTextEffect.GetOutlineWidth: integer; static; +begin + result := DefaultOutlineWidth; +end; + +function TBGRACustomTextEffect.GetShadowBounds(ARadius: integer): TRect; +begin + result := Bounds; + if (ARadius > 0) and not result.IsEmpty then + result.Inflate(ARadius, ARadius); +end; + +function TBGRACustomTextEffect.GetMaskWidth: integer; +begin + if FTextMask = nil then + result := 0 + else + result := FTextMask.Width; +end; + +function TBGRACustomTextEffect.GetTextHeight: integer; +begin + result := FTextSize.cy; +end; + +function TBGRACustomTextEffect.GetTextWidth: integer; +begin + result := FTextSize.cx; +end; + +procedure TBGRACustomTextEffect.SetShadowQuality(AValue: TRadialBlurType); +begin + if FShadowQuality=AValue then Exit; + FShadowQuality:=AValue; + FreeAndNil(FShadowMask); +end; + +function TBGRACustomTextEffect.DrawMaskMulticolored(ADest: TBGRACustomBitmap; + AMask: TCustomUniversalBitmap; X, Y: Integer; const AColors: array of TBGRAPixel + ): TRect; +var + scan: TBGRASolidColorMaskScanner; + xb,yb,startX,numColor: integer; + p0,p: PByte; + emptyCol, nextCol: boolean; +begin + if (AMask = nil) or (length(AColors)=0) then + begin + result := EmptyRect; + exit; + end; + if (length(AColors)=0) then + begin + result := DrawMask(ADest,AMask,X,Y,AColors[0]); + exit; + end; + scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColors[0]); + numColor := 0; + startX := -1; + p0 := AMask.DataByte; + for xb := 0 to AMask.Width-1 do + begin + p := p0; + + if startX=-1 then + begin + emptyCol := true; + for yb := AMask.Height-1 downto 0 do + begin + if (p^ <> 0) then + begin + emptyCol := false; + break; + end; + inc(p, AMask.Width); + end; + + if not emptyCol then + begin + if startX=-1 then + startX := xb; + end else + begin + if startX<>-1 then + begin + ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency); + inc(numColor); + if numColor = length(AColors) then + numColor := 0; + scan.Color := AColors[numColor]; + startX := -1; + end; + end; + + end else + begin + emptyCol := true; + nextCol := true; + for yb := AMask.Height-1 downto 0 do + begin + if (p^ <> 0) then + begin + emptyCol := false; + if ((p-1)^ <> 0) then + begin + nextCol := false; + break; + end; + end; + inc(p, AMask.Width); + end; + if nextCol or emptyCol then + begin + ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency); + inc(numColor); + if numColor = length(AColors) then + numColor := 0; + scan.Color := AColors[numColor]; + if emptyCol then startX := -1 + else startX := xb; + end; + end; + + inc(p0); + end; + if startX<>-1 then + ADest.FillRect(X+startX,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); + scan.Free; + result := rect(X,Y,X+AMask.Width,Y+AMask.Height); +end; + +function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap; + AMask: TCustomUniversalBitmap; X, Y: Integer; AColor: TBGRAPixel): TRect; +var + scan: TBGRACustomScanner; +begin + if AMask = nil then + begin + result := EmptyRect; + exit; + end; + scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColor); + ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); + scan.Free; + result := rect(X,Y,X+AMask.Width,Y+AMask.Height); +end; + +function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap; + AMask: TCustomUniversalBitmap; X, Y: Integer; ATexture: IBGRAScanner): TRect; +var + scan: TBGRACustomScanner; +begin + if AMask = nil then + begin + result := EmptyRect; + exit; + end; + scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),ATexture); + ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); + scan.Free; + result := rect(X,Y,X+AMask.Width,Y+AMask.Height); +end; + +function TBGRACustomTextEffect.InternalDrawShaded(ADest: TBGRACustomBitmap; X, + Y: integer; Shader: TCustomPhongShading; Altitude: integer; + AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect; +var + WithMargin,GrayMap: TGrayscaleMask; + HeightMap: TBGRACustomBitmap; + p: PBGRAPixel; + n,maxv: integer; + v,blurRadius: single; + iBlurRadius: integer; +begin + if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then + begin + result := EmptyRect; + exit; + end; + + if (FShadingMask <> nil) and ((FShadingAltitude <> Altitude) or (FShadingRounded <> ARounded)) then + FreeAndNil(FShadingMask); + + if FShadingMask = nil then + begin + FShadingRounded := ARounded; + FShadingAltitude := Altitude; + + if ARounded then blurRadius := Altitude + else blurRadius := Altitude*0.5; + + iBlurRadius := ceil(blurRadius); + + WithMargin := TGrayscaleMask.Create(FTextMask.Width+iBlurRadius*2, FTextMask.Height+iBlurRadius*2,BGRABlack); + WithMargin.PutImage(iBlurRadius, iBlurRadius, FTextMask, dmSet); + if (iBlurRadius <> blurRadius) and (blurRadius < 3) then + GrayMap := WithMargin.FilterBlurRadial(round(blurRadius*10), rbPrecise) + else + GrayMap := WithMargin.FilterBlurRadial(iBlurRadius, rbFast); + HeightMap := BGRABitmapFactory.Create; + HeightMap.SetSize(GrayMap.Width, GrayMap.Height); + GrayMap.Draw(HeightMap, 0, 0); + GrayMap.Free; + + p := HeightMap.Data; + maxv := 0; + for n := HeightMap.NbPixels-1 downto 0 do + begin + if p^.green > maxv then + maxv := p^.green; + inc(p); + end; + + if maxv > 0 then + begin + p := HeightMap.Data; + for n := HeightMap.NbPixels-1 downto 0 do + begin + v := p^.green/maxv; + if ARounded then + begin + if v <= 0.5 then + v := v*v*2 else + v := 1-(1-v)*(1-v)*2; + end; + p^ := MapHeightToBGRA( v, p^.alpha); + inc(p); + end; + end; + + HeightMap.ApplyMask(WithMargin); + WithMargin.Free; + BGRACustomReplace(HeightMap, HeightMap.GetPart( rect(iBlurRadius, iBlurRadius, + HeightMap.Width-iBlurRadius, HeightMap.Height-iBlurRadius) ) ); + FShadingMask := HeightMap; + end; + + inc(X, FOffset.X); + Inc(Y, FOffset.Y); + if ATexture <> nil then + Shader.DrawScan(ADest,FShadingMask,Altitude,X,Y, ATexture) + else + Shader.Draw(ADest,FShadingMask,Altitude,X,Y, AColor); + result := rect(X,Y, X+FShadingMask.Width,Y+FShadingMask.Height); +end; + +procedure TBGRACustomTextEffect.Init(AMask: TGrayscaleMask; + AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint); +begin + FTextSize := Size(AWidth,AHeight); + FOffset := AOffset; + if not AMaskOwner then + FTextMask := AMask.Duplicate + else + FTextMask := AMask; + FShadowQuality:= rbFast; +end; + +function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; + AColor: TBGRAPixel; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,AColor); + taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,AColor); + else result := Draw(ADest,X,Y,AColor); + end; +end; + +function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; + ATexture: IBGRAScanner; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,ATexture); + taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,ATexture); + else result := Draw(ADest,X,Y,ATexture); + end; +end; + +function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; + Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; + ARounded: Boolean): TRect; +begin + result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,AColor,nil,ARounded); +end; + +function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; + Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; + ARounded: Boolean): TRect; +begin + result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,BGRAPixelTransparent,ATexture,ARounded); +end; + +function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; + Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; + AAlign: TAlignment; ARounded: Boolean): TRect; +begin + Case AAlign of + taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,AColor,ARounded); + taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,AColor,ARounded); + taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,AColor,ARounded); + else + result := EmptyRect; + end; +end; + +function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; + Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; + AAlign: TAlignment; ARounded: Boolean): TRect; +begin + Case AAlign of + taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,ATexture,ARounded); + taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,ATexture,ARounded); + taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,ATexture,ARounded); + else + result := EmptyRect; + end; +end; + +constructor TBGRACustomTextEffect.Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth, + AHeight: integer; AOffset: TPoint); +var + grayMask: TGrayscaleMask; +begin + grayMask := TGrayscaleMask.Create(AMask, cGreen); + if AMaskOwner then AMask.Free; + Init(grayMask, true, AWidth, AHeight, AOffset); +end; + +constructor TBGRACustomTextEffect.Create(AMask: TGrayscaleMask; + AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint); +begin + Init(AMask, AMaskOwner, AWidth, AHeight, AOffset); +end; + +procedure TBGRACustomTextEffect.ApplySphere; +begin + if FTextMask = nil then exit; + FreeAndNil(FOutlineMask); + FreeAndNil(FShadowMask); + FShadowRadius := 0; + BGRACustomReplace(FTextMask, FTextMask.FilterSphere); +end; + +procedure TBGRACustomTextEffect.ApplyVerticalCylinder; +begin + if FTextMask = nil then exit; + FreeAndNil(FOutlineMask); + FreeAndNil(FShadowMask); + FShadowRadius := 0; + BGRACustomReplace(FTextMask, FTextMask.FilterCylinder); +end; + +procedure TBGRACustomTextEffect.ApplyHorizontalCylinder; +begin + if FTextMask = nil then exit; + FreeAndNil(FOutlineMask); + FreeAndNil(FShadowMask); + FShadowRadius := 0; + BGRACustomReplace(FTextMask,FTextMask.RotateCW); + BGRACustomReplace(FTextMask,FTextMask.FilterCylinder); + BGRACustomReplace(FTextMask,FTextMask.RotateCCW); +end; + +function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; + AColor: TBGRAPixel): TRect; +begin + result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColor); +end; + +function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; + ATexture: IBGRAScanner): TRect; +begin + result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,ATexture); +end; + +function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X, + Y: integer; const AColors: array of TBGRAPixel): TRect; +begin + result := DrawMaskMulticolored(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColors); +end; + +function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X, + Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := DrawMulticolored(ADest,X-TextSize.cx,Y,AColors); + taCenter: result := DrawMulticolored(ADest,X-TextSize.cx div 2,Y,AColors); + else result := DrawMulticolored(ADest,X,Y,AColors); + end; +end; + +function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; + AColor: TBGRAPixel): TRect; +begin + if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then + begin + result := EmptyRect; + exit; + end; + if FOutlineMask = nil then + begin + FOutlineMask := FTextMask.FilterContour; + FOutlineMask.Negative; + end; + result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,AColor); +end; + +function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; + ATexture: IBGRAScanner): TRect; +begin + if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then + begin + result := EmptyRect; + exit; + end; + if FOutlineMask = nil then + begin + FOutlineMask := FTextMask.FilterContour; + FOutlineMask.Negative; + end; + result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,ATexture); +end; + +function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; + AColor: TBGRAPixel; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,AColor); + taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,AColor); + else result := DrawOutline(ADest,X,Y,AColor); + end; +end; + +function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; + ATexture: IBGRAScanner; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,ATexture); + taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,ATexture); + else result := DrawOutline(ADest,X,Y,ATexture); + end; +end; + +function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y, + Radius: integer; AColor: TBGRAPixel): TRect; +begin + if (Radius <= 0) or (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then + begin + result := Draw(ADest,X,Y,AColor); + exit; + end; + if (FShadowRadius <> Radius) or (FShadowMask = nil) then + begin + FShadowRadius := Radius; + FreeAndNil(FShadowMask); + FShadowMask := TGrayscaleMask.Create(FTextMask.Width+Radius*2,FTextMask.Height+Radius*2, 0); + FShadowMask.PutImage(Radius,Radius,FTextMask,dmSet); + BGRACustomReplace(FShadowMask, FShadowMask.FilterBlurRadial(Radius,ShadowQuality)); + end; + Inc(X,FOffset.X-Radius); + Inc(Y,FOffset.Y-Radius); + DrawMask(ADest,FShadowMask,X,Y,AColor); + result := rect(X,Y,X+FShadowMask.Width,Y+FShadowMask.Height); +end; + +function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y, + Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; +begin + Case AAlign of + taRightJustify: result := DrawShadow(ADest,X-TextSize.cx,Y,Radius,AColor); + taCenter: result := DrawShadow(ADest,X-TextSize.cx div 2,Y,Radius,AColor); + else result := DrawShadow(ADest,X,Y,Radius,AColor); + end; +end; + +destructor TBGRACustomTextEffect.Destroy; +begin + FShadowMask.free; + FTextMask.Free; + FOutlineMask.Free; + FShadingMask.Free; + inherited Destroy; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgradefaultbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgradefaultbitmap.pas new file mode 100644 index 0000000..3d015a4 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgradefaultbitmap.pas @@ -0,0 +1,4639 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgradefaultbitmap.pas + --------------------- + This unit defines basic operations on bitmaps. + It should NOT be added to the 'uses' clause. + Some operations may be slow, so there are + accelerated versions for some routines. +} + +unit BGRADefaultBitmap; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +{ This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines, + and call functions from other units to perform advanced drawing functions. } + +uses + SysUtils, BGRAClasses, FPImage, BGRAGraphics, BGRABitmapTypes, + {$IFDEF BGRABITMAP_USE_FPCANVAS}FPImgCanv,{$ENDIF} + BGRACanvas, BGRACanvas2D, BGRATransform, BGRATextBidi, + UniversalDrawer, BGRAGrayscaleMask; + +type + TBGRAPtrBitmap = class; + {=== TBGRABitmap reference ===} + { TBGRADefaultBitmap } + {* This class is the base for all ''TBGRABitmap'' classes. It implements most + function to the exception from implementations specific to the + widgetset }{ in the doc, it is presented as + TBGRABitmap = class(TBGRACustomBitmap) + } + TBGRADefaultBitmap = class(TBGRACustomBitmap) + private + { Bounds checking which are shared by drawing functions. These functions check + if the coordinates are visible and return true if it is the case, swap + coordinates if necessary and make them fit into the clipping rectangle } + function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline; + function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean; + function GetCanvasBGRA: TBGRACanvas; + function GetCanvas2D: TBGRACanvas2D; + procedure GradientFillDithered(x, y, x2, y2: integer; c1, c2: TBGRAPixel; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean = True; Sinus: Boolean=False; + ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload; + procedure GradientFillDithered(x, y, x2, y2: integer; gradient: TBGRACustomGradient; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + Sinus: Boolean=False; + ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload; + + protected + //Pixel data + FDataModified: boolean; //if data image has changed so TBitmap should be updated + + //GUI bitmap object + FBitmap: TBitmap; + FBitmapModified: boolean; //if TBitmap has changed so pixel data should be updated + FCanvasOpacity: byte; //opacity used with standard canvas functions + FAlphaCorrectionNeeded: boolean; //the alpha channel is not correct because standard functions do not + //take it into account + + //FreePascal drawing routines + {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP: TFPImageCanvas;{$ENDIF} + FCanvasDrawModeFP: TDrawMode; + FCanvasPixelProcFP: procedure(x, y: int32or64; const col: TBGRAPixel) of object; + + //canvas-like with antialiasing and texturing + FCanvasBGRA: TBGRACanvas; + FCanvas2D: TBGRACanvas2D; + + //drawing options + FFontHeight: integer; + FFontRenderer: TBGRACustomFontRenderer; + + //Pixel data + function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; + AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; virtual; abstract; + + //FreePascal drawing routines + {$IFDEF BGRABITMAP_USE_FPCANVAS}function GetCanvasFP: TFPImageCanvas; override;{$ENDIF} + procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override; + function GetCanvasDrawModeFP: TDrawMode; override; + + //GUI bitmap object + function GetBitmap: TBitmap; override; + function GetCanvas: TCanvas; override; + function GetCanvasOpacity: byte; override; + procedure SetCanvasOpacity(AValue: byte); override; + function GetCanvasAlphaCorrection: boolean; override; + procedure SetCanvasAlphaCorrection(const AValue: boolean); override; + procedure DoAlphaCorrection; + procedure DiscardBitmapChange; inline; + procedure DoLoadFromBitmap; virtual; + + function CreatePtrBitmap(AWidth,AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; virtual; + + procedure RebuildBitmap; virtual; abstract; + procedure FreeBitmap; virtual; + + procedure Init; override; + + {TFPCustomImage} + procedure SetInternalColor(x, y: integer; const Value: TFPColor); override; + function GetInternalColor(x, y: integer): TFPColor; override; + procedure SetInternalPixel(x, y: integer; Value: integer); override; + function GetInternalPixel(x, y: integer): integer; override; + + {Image functions} + function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap; + function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap; + function CheckEmpty: boolean; override; + function GetHasTransparentPixels: boolean; override; + function GetHasSemiTransparentPixels: boolean; override; + function GetAverageColor: TColor; override; + function GetAveragePixel: TBGRAPixel; override; + + protected //pen style accesors + function GetPenJoinStyle: TPenJoinStyle; override; + procedure SetPenJoinStyle(const AValue: TPenJoinStyle); override; + function GetPenMiterLimit: single; override; + procedure SetPenMiterLimit(const AValue: single); override; + function GetCustomPenStyle: TBGRAPenStyle; override; + procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override; + procedure SetPenStyle(const AValue: TPenStyle); override; + function GetPenStyle: TPenStyle; override; + + function GetArrowEndSize: TPointF; override; + function GetArrowStartSize: TPointF; override; + procedure SetArrowEndSize(AValue: TPointF); override; + procedure SetArrowStartSize(AValue: TPointF); override; + function GetArrowEndOffset: single; override; + function GetArrowStartOffset: single; override; + procedure SetArrowEndOffset(AValue: single); override; + procedure SetArrowStartOffset(AValue: single); override; + function GetArrowEndRepeat: integer; override; + function GetArrowStartRepeat: integer; override; + procedure SetArrowEndRepeat(AValue: integer); override; + procedure SetArrowStartRepeat(AValue: integer); override; + + protected //font accessors + function GetFontHeight: integer; override; + procedure SetFontHeight(AHeight: integer); override; + function GetFontFullHeight: integer; override; + procedure SetFontFullHeight(AHeight: integer); override; + function GetFontPixelMetric: TFontPixelMetric; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; virtual; abstract; + function GetFontVerticalAnchorOffset: single; override; + function GetFontAnchorRotatedOffset: TPointF; overload; + function GetFontAnchorRotatedOffset(ACustomOrientation: integer): TPointF; overload; + function GetFontRenderer: TBGRACustomFontRenderer; override; + procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override; + + function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TBGRAPixel; + function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TBGRAPixel; + procedure InternalTextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); + procedure InternalTextOutLetterSpacing(x,y: single; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); + procedure InternalCrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); + + procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; + AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); override; + function InternalNew: TBGRADefaultBitmap; override; + + public + {** Provides a canvas with opacity and antialiasing } + property CanvasBGRA: TBGRACanvas read GetCanvasBGRA; + {** Provides a canvas with 2d transformation and similar to HTML5. } + property Canvas2D: TBGRACanvas2D read GetCanvas2D; + {** For more properties, see parent class [[TBGRACustomBitmap and IBGRAScanner#TBGRACustomBitmap|TBGRACustomBitmap]] } + + procedure SetSize(AWidth, AHeight: integer); override; + + {==== Constructors ====} + + {------------------------- Constructors from TBGRACustomBitmap-------------} + + {** Creates an image by copying the content of a ''TFPCustomImage'' } + constructor Create(AFPImage: TFPCustomImage); overload; override; + {** Creates an image by copying the content of a ''TBitmap'' } + constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; override; + + {** Creates an image by loading its content from the file ''AFilename''. + The encoding of the string is the default one for the operating system. + It is recommended to use the next constructor and UTF8 encoding } + constructor Create(AFilename: string); overload; override; + + {** Creates an image by loading its content from the file ''AFilename''. + The boolean ''AIsUtf8Filename'' specifies if UTF8 encoding is assumed + for the filename } + constructor Create(AFilename: string; AIsUtf8: boolean); overload; override; + constructor Create(AFilename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions); overload; override; + + {** Creates an image by loading its content from the stream ''AStream'' } + constructor Create(AStream: TStream); overload; override; + {** Free the object and all its resources } + destructor Destroy; override; + + {** Clear all channels of transparent pixels } + procedure ClearTransparentPixels; override; + + {------------------------- Quasi-constructors -----------------------------} + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates a new instance with dimensions 0 x 0. } + function NewBitmap: TBGRADefaultBitmap; overload; override; + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates a new instance with dimensions ''AWidth'' and ''AHeight'', + containing transparent pixels. } + function NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap; overload; override; + + {* Example: + + * var bmp1, bmp2: TBGRABitmap; + * begin + * bmp1 := TBGRABitmap.Create(100,100); + * bmp2 := bmp1.NewBitmap(100,100); + * ... + * end; + See tutorial 2 on [[BGRABitmap_tutorial_2|how to load and display an image]]. + * See reference on [[TBGRACustomBitmap_and_IBGRAScanner#Load_and_save_files|loading and saving files]] } + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates a new instance with dimensions ''AWidth'' and ''AHeight'', + and fills it with Color } + function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRADefaultBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap; overload; override; + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates a new instance with by loading its content + from the file ''Filename''. The encoding of the string + is the default one for the operating system } + function NewBitmap(Filename: string): TBGRADefaultBitmap; overload; override; + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates a new instance with by loading its content + from the file ''Filename'' } + function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap; overload; override; + function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRADefaultBitmap; overload; override; + + {** Can only be called from an existing instance of ''TBGRABitmap''. + Creates an image by copying the content of a ''TFPCustomImage'' } + function NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap; overload; override; + + {** Assign the content of the specified ''Source''. It can be a ''TBGRACustomBitmap'' or + a ''TFPCustomImage'' } + procedure Assign(Source: TPersistent); overload; override; + procedure Assign(Source: TBitmap; AUseTransparent: boolean); overload; + + {** Stores the image in the stream without compression nor header } + procedure Serialize(AStream: TStream); override; + {** Reads the image in a stream that was previously serialized } + procedure Deserialize(AStream: TStream); override; + + // universal brushes + procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + + {==== Pixel functions ====} + {** Sets the pixel by replacing the content at (''x'',''y'') with the specified color. + Alpha value is set to 255 (opaque) } + procedure SetPixel(x, y: int32or64; c: TColor); overload; override; + {** Applies a logical '''xor''' to the content of the pixel with the specified value. + This includes the alpha channel, so if you want to preserve the opacity, provide + a color ''c'' with alpha channel equal to zero } + procedure XorPixel(x, y: int32or64; const c: TBGRAPixel); override; + {** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied + in sRGB colorspace } + procedure DrawPixel(x, y: int32or64; const c: TBGRAPixel); overload; override; + {** Draws a pixel without gamma correction at (''x'',''y''). Pixel is supplied + in sRGB colorspace } + procedure FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); override; + {** Erase the content of the pixel by reducing the value of the + alpha channel. ''alpha'' specifies how much to decrease. + If the resulting alpha reaches zero, the content + is replaced by ''BGRAPixelTransparent'' } + procedure ErasePixel(x, y: int32or64; alpha: byte); override; + {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the + pixel is replaced by ''BGRAPixelTransparent'' } + procedure AlphaPixel(x, y: int32or64; alpha: byte); override; + {** Computes the value of the pixel at a floating point coordiante + by interpolating the values of the pixels around it. + * There is a one pixel wide margin around the pixel where the pixels are + still considered inside. If ''smoothBorder'' is set to true, pixel fade + to transparent. + * If it is more out of the bounds, the result is ''BGRAPixelTransparent''. + * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted + values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } + function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; overload; override; + {** Similar to previous ''GetPixel'' function, but the fractional part of + the coordinate is supplied with a number from 0 to 255. The actual + coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } + function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override; + {** Computes the value of the pixel at a floating point coordiante + by interpolating the values of the pixels around it. If the pixel + is out of bounds, the image is repeated. + * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted + values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } + function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override; + {** Similar to previous ''GetPixel'' function, but the fractional part of + the coordinate is supplied with a number from 0 to 255. The actual + coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } + function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override; + {** Computes the value of the pixel at a floating point coordiante + by interpolating the values of the pixels around it. ''repeatX'' and + ''repeatY'' specifies if the image is to be repeated or not. + * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted + values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } + function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override; + {** Similar to previous ''GetPixel'' function, but the fractional part of + the coordinate is supplied with a number from 0 to 255. The actual + coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } + function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override; + + {==== Drawing lines and polylines (integer coordinates) ====} + {* These functions do not take into account current pen style/cap/join. + See [[BGRABitmap tutorial 13|coordinate system]]. } + + {** Applies xor to the pixels at line ''y'' and + at columns ''x'' to ''x2'' included, using specified color. + This includes the alpha channel, so if you want to preserve the + opacity, provide a color ''c'' with alpha channel equal to zero } + procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override; + {** Draws an horizontal line with gamma correction at line ''y'' and + at columns ''x'' to ''x2'' included, using specified color } + procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override; overload; + {** Draws an horizontal line without gamma correction at line ''y'' and + at columns ''x'' to ''x2'' included, using specified color } + procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override; + {** Replaces the alpha value of the pixels at line ''y'' and + at columns ''x'' to ''x2'' included } + procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); override; + {** Draws an horizontal line with gamma correction at line ''y'' and + at columns ''x'' to ''x2'' included, using specified color, + and with a transparency that increases with the color difference + with ''compare''. If the difference is greater than ''maxDiff'', + pixels are not changed } + procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; + maxDiff: byte); override; + procedure HorizLineDiff(x, y, x2: int32or64; const ABrush: TUniversalBrush; + ACompare: TBGRAPixel; AMaxDiffW: word); override; + + {** Xors a vertical line at column ''x'' and at row ''y'' to ''y2'' } + procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; + {** Draws a vertical line with gamma correction at column ''x'' and at row ''y'' to ''y2'' } + procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; + {** Draws a vertical line without gamma correction at column ''x'' and at row ''y'' to ''y2'' } + procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; + {** Replace alpha values in a vertical line at column ''x'' and at row ''y'' to ''y2'' } + procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override; + + {** Fills completely a rectangle, without any border, with the specified ''texture'' and + with the specified ''mode'' } + procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; override; + + {==== Rectangles, ellipses and path (floating point coordinates) ====} + {* These functions use the current pen style/cap/join. The parameter ''w'' + specifies the width of the line and the base unit for dashes + * The coordinates are pixel-centered, so that when filling a rectangle, + if the supplied values are integers, the border will be half transparent. + If you want the border to be completely filled, you can subtract/add + 0.5 to the coordinates to include the remaining thin border. + See [[BGRABitmap tutorial 13|coordinate system]]. } + + {==== Multi-shape fill ====} + + {** Draws and fill a polyline using current pen style/cap/join in one go. + The stroke is stricly over the fill even if partially transparent. + ''fillcolor'' specifies a color to fill the polygon formed by the points } + procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override; + {** Draws a filled polygon using current pen style/cap/join in one go. + The stroke is stricly over the fill even if partially transparent. + The polygon is always closed. You don't need to set the last point + to be the same as the first point. } + procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override; + + {** Draws and fills an ellipse } + procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; + procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; + + {** Draws and fills a path } + procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override; + procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override; + procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override; + procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override; + + {** Draws and fills a path with a matrix transform } + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override; + procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override; + + {** Draws a rectangle with antialiasing and fills it with color ''back''. + Note that the pixel (x2,y2) is included contrary to integer coordinates } + procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; + + {** Draws a rounded rectangle border with antialiasing. The corners have an + elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to + draw the corners. See [[BGRABitmap Geometry types|geometry types]] } + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; override; + {** Draws a rounded rectangle border with the specified texture. + The corners have an elliptical radius of ''rx'' and ''ry''. + ''options'' specifies how to draw the corners. + See [[BGRABitmap Geometry types|geometry types]] } + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; override; + {** Draws and fills a round rectangle } + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; override; + {** Draws and fills a round rectangle with textures } + procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; override; + + {==== Gradient polygons ====} + + procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override; + procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override; + procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override; + procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override; + procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override; + + procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override; + procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override; + procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone; ACropToPolygon: boolean = true); override; + procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override; + procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); override; + procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override; + procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); override; + procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); override; + procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); override; + + {** Fills an ellipse with a gradient of color. ''outercolor'' specifies + the end color of the gradient on the border of the ellipse and + ''innercolor'' the end color of the gradient at the center of the ellipse } + procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; override; + procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; override; + + procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override; + procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override; + procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override; + procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); override; + procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); override; + + procedure ArrowStartAsNone; override; + procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; + procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; + procedure ArrowStartAsTail; override; + + procedure ArrowEndAsNone; override; + procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; + procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; + procedure ArrowEndAsTail; override; + + { Draws the UTF8 encoded string, with color c. + If align is taLeftJustify, (x,y) is the top-left corner. + If align is taCenter, (x,y) is at the top and middle of the text. + If align is taRightJustify, (x,y) is the top-right corner. + The value of FontOrientation is taken into account, so that the text may be rotated. } + procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + + { Same as above functions, except that the text is filled using texture. + The value of FontOrientation is taken into account, so that the text may be rotated. } + procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + + procedure TextOut(x, y: single; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override; + procedure TextOut(x, y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override; + + { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. } + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + + procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override; + procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override; + + procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override; + procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override; + + { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect. + Additional style information is provided by the style parameter. + The color c or texture is used to fill the text. No rotation is applied. } + procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override; + procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override; + + { Returns the total size of the string provided using the current font. + Orientation is not taken into account, so that the width is along the text. End of lines are stripped from the string. } + function TextSize(const sUTF8: string): TSize; override; + function TextSizeMultiline(const sUTF8: string; AMaxWidth: single = EmptySingle; AParagraphSpacing: single = 0): TSize; override; + + { Returns the affine box of the string provided using the current font. + Orientation is taken into account. End of lines are stripped from the string. } + function TextAffineBox(const sUTF8: string): TAffineBox; override; + + { Returns the total size of a paragraph i.e. with word break } + function TextSize(const sUTF8: string; AMaxWidth: integer): TSize; override; + function TextSize(const sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; override; + function TextFitInfo(const sUTF8: string; AMaxWidth: integer): integer; override; + + {Spline} + function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override; + function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override; + + function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; overload; override; + function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; overload; override; + function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; overload; override; + function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; override; + + function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override; + function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; override; + function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override; + + function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override; + function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; override; + function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; override; + function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; override; overload; + function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override; + function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override; + function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override; + function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; override; + function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override; + function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override; + + {Filling} + procedure Fill(c: TBGRAPixel; start, Count: integer); overload; override; + procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override; + procedure AlphaFill(alpha: byte; start, Count: integer); overload; override; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TBGRAPixel; ADrawMode: TDrawMode); overload; override; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); overload; override; + procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); override; + procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override; + procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override; + procedure ReplaceColor(before, after: TColor); overload; override; + procedure ReplaceColor(ABounds: TRect; before, after: TColor); overload; override; + procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; Color: TBGRAPixel; + mode: TFloodfillMode; Tolerance: byte = 0; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override; + procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; + Progressive: boolean; ToleranceW: Word = $00ff; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override; + procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean = True; Sinus: Boolean=False; + ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override; + procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient; + gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + Sinus: Boolean=False; ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override; + + function ScanAtInteger(X,Y: integer): TBGRAPixel; override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X,Y: Single): TBGRAPixel; override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + + {Canvas drawing functions} + procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override; + procedure InvalidateBitmap; override; //call if you modify with Scanline + procedure LoadFromBitmapIfNeeded; override; //call to ensure that bitmap data is up to date + procedure NotifyBitmapChange; inline; + + {BGRA bitmap functions} + procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; override; + procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; override; + procedure PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte); overload; override; + procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; override; + function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true; APixelCenteredCoords: boolean = true): TRect; overload; override; + class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; override; + + procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override; + procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AExcludeChannels: TChannels); overload; override; + procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AExcludeChannels: TChannels); overload; override; + procedure BlendImage(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation); overload; override; + procedure BlendImage(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); overload; override; + procedure BlendImageOver(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override; + procedure BlendImageOver(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override; + + function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override; + function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override; + + function Resample(newWidth, newHeight: integer; + mode: TResampleMode = rmFineResample): TBGRADefaultBitmap; override; + procedure Negative; override; + procedure NegativeRect(ABounds: TRect); override; + procedure LinearNegative; override; + procedure LinearNegativeRect(ABounds: TRect); override; + procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; override; + procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; override; + procedure InplaceNormalize(AEachChannel: boolean = True); overload; override; + procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; override; + procedure SwapRedBlue; override; + procedure SwapRedBlue(ARect: TRect); override; + procedure GrayscaleToAlpha; override; + procedure AlphaToGrayscale; override; + function GetMaskFromAlpha: TBGRADefaultBitmap; override; + function GetGrayscaleMaskFromAlpha: TGrayscaleMask; + procedure ConvertToLinearRGB; override; + procedure ConvertFromLinearRGB; override; + + {Filters} + function FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap; override; + function FilterMedian(Option: TMedianOption): TBGRADefaultBitmap; override; + function FilterSmooth: TBGRADefaultBitmap; override; + function FilterSharpen(Amount: single = 1): TBGRADefaultBitmap; overload; override; + function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRADefaultBitmap; overload; override; + function FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap; override; + function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRADefaultBitmap; override; + function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override; + function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean): TBGRADefaultBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRADefaultBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap; overload; override; + function FilterGrayscale: TBGRADefaultBitmap; overload; override; + function FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap; overload; override; + function FilterNormalize(eachChannel: boolean = True): TBGRADefaultBitmap; overload; override; + function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRADefaultBitmap; overload; override; + function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRADefaultBitmap; override; + function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRADefaultBitmap; override; + function FilterSphere: TBGRADefaultBitmap; override; + function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override; + function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override; + function FilterCylinder: TBGRADefaultBitmap; override; + function FilterPlane: TBGRADefaultBitmap; override; + end; + + { TBGRAPtrBitmap } + + TBGRAPtrBitmap = class(TBGRADefaultBitmap) + protected + function GetLineOrder: TRawImageLineOrder; override; + procedure SetLineOrder(AValue: TRawImageLineOrder); override; + procedure ReallocData; override; + procedure FreeData; override; + procedure CannotResize; + procedure NotImplemented; + procedure RebuildBitmap; override; + + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; //to override + function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; + {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean + =True): boolean; override; //to override + public + constructor Create(AWidth, AHeight: integer; AData: Pointer); overload; + procedure SetDataPtr(AData: Pointer); + property LineOrder: TRawImageLineOrder Read GetLineOrder Write SetLineOrder; + + procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override + procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override + procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //to override + + procedure Assign({%H-}Source: TPersistent); override; + procedure TakeScreenshot({%H-}ARect: TRect); override; + procedure TakeScreenshotOfPrimaryMonitor; override; + procedure LoadFromDevice({%H-}DC: HDC); override; + procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; + end; + + { TBGRAMemoryStreamBitmap } + + TBGRAMemoryStreamBitmap = class(TBGRAPtrBitmap) + private + function GetOwnStream: boolean; + procedure SetOwnStream(AValue: boolean); + protected + FStream: TMemoryStream; + FStreamOffset: IntPtr; + FOwnStream: boolean; + public + constructor Create(AWidth, AHeight: integer; AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean); + constructor Create(AWidth, AHeight: integer); override; + constructor Create(AWidth, AHeight: integer; AColor: TBGRAPixel); + destructor Destroy; override; + property OwnStream: boolean read GetOwnStream write SetOwnStream; + property Stream: TMemoryStream read FStream; + end; + +var + DefaultTextStyle: TTextStyle; + +procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer; + c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean = True; Sinus: Boolean=False); + +implementation + +uses Math, BGRAUTF8, BGRABlend, BGRAFilters, BGRAGradientScanner, + BGRAResample, BGRAPolygon, BGRAPolygonAliased, + BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM, + BGRAReadBMP, BGRAReadJpeg, + BGRADithering, BGRAFilterScanner; + +{ TBGRAMemoryStreamBitmap } + +function TBGRAMemoryStreamBitmap.GetOwnStream: boolean; +begin + result := FOwnStream; +end; + +procedure TBGRAMemoryStreamBitmap.SetOwnStream(AValue: boolean); +begin + FOwnStream:= AValue; +end; + +constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer; + AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean); +begin + inherited Create(AWidth, AHeight, PByte(AStream.Memory) + AStreamOffset); + FStream := AStream; + FStreamOffset:= AStreamOffset; + FOwnStream := AOwnStream; +end; + +constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer); +begin + Create(AWidth, AHeight, BGRAPixelTransparent); +end; + +constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer; + AColor: TBGRAPixel); +begin + inherited Create(AWidth, AHeight); + FStream := TMemoryStream.Create; + FStreamOffset:= 0; + FStream.Size := RowSize * Height; + FOwnStream := true; + SetDataPtr(PByte(FStream.Memory) + FStreamOffset); + Fill(AColor, dmSet); +end; + +destructor TBGRAMemoryStreamBitmap.Destroy; +begin + if FOwnStream then FStream.Free; + inherited Destroy; +end; + +{ TBGRADefaultBitmap } + +function TBGRADefaultBitmap.CheckEmpty: boolean; +const + alphaMask = $ff shl TBGRAPixel_AlphaShift; +var + i: integer; + p: PBGRAPixel; +begin + p := Data; + for i := (NbPixels shr 1) - 1 downto 0 do + begin + if PInt64(p)^ and (alphaMask or (alphaMask shl 32)) <> 0 then + begin + Result := False; + exit; + end; + Inc(p,2); + end; + if Odd(NbPixels) and (p^.alpha <> 0) then + begin + Result := false; + exit; + end; + Result := True; +end; + +function TBGRADefaultBitmap.GetCanvasAlphaCorrection: boolean; +begin + Result := (FCanvasOpacity <> 0); +end; + +function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle; +begin + result := GetInternalPen.CustomPenStyle; +end; + +procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean); +begin + if AValue then + begin + if FCanvasOpacity = 0 then + FCanvasOpacity := 255; + end + else + FCanvasOpacity := 0; +end; + +procedure TBGRADefaultBitmap.DoLoadFromBitmap; +begin + //nothing +end; + +procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle); +begin + GetInternalPen.CustomPenStyle := AValue; +end; + +procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle); +begin + GetInternalPen.Style := AValue; +end; + +function TBGRADefaultBitmap.GetPenStyle: TPenStyle; +begin + Result:= GetInternalPen.Style; +end; + +function TBGRADefaultBitmap.GetArrowEndSize: TPointF; +begin + result := GetArrow.EndSize; +end; + +function TBGRADefaultBitmap.GetArrowStartSize: TPointF; +begin + result := GetArrow.StartSize; +end; + +procedure TBGRADefaultBitmap.SetArrowEndSize(AValue: TPointF); +begin + {$PUSH}{$OPTIMIZATION OFF} + GetArrow.EndSize := AValue; + {$POP} +end; + +procedure TBGRADefaultBitmap.SetArrowStartSize(AValue: TPointF); +begin + {$PUSH}{$OPTIMIZATION OFF} + GetArrow.StartSize := AValue; + {$POP} +end; + +function TBGRADefaultBitmap.GetArrowEndOffset: single; +begin + result := GetArrow.EndOffsetX; +end; + +function TBGRADefaultBitmap.GetArrowStartOffset: single; +begin + result := GetArrow.StartOffsetX; +end; + +procedure TBGRADefaultBitmap.SetArrowEndOffset(AValue: single); +begin + GetArrow.EndOffsetX := AValue; +end; + +procedure TBGRADefaultBitmap.SetArrowStartOffset(AValue: single); +begin + GetArrow.StartOffsetX := AValue; +end; + +function TBGRADefaultBitmap.GetArrowEndRepeat: integer; +begin + result := GetArrow.EndRepeatCount; +end; + +function TBGRADefaultBitmap.GetArrowStartRepeat: integer; +begin + result := GetArrow.StartRepeatCount; +end; + +procedure TBGRADefaultBitmap.SetArrowEndRepeat(AValue: integer); +begin + GetArrow.EndRepeatCount := AValue; +end; + +procedure TBGRADefaultBitmap.SetArrowStartRepeat(AValue: integer); +begin + GetArrow.StartRepeatCount := AValue; +end; + +procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer); +begin + FFontHeight := AHeight; +end; + +function TBGRADefaultBitmap.GetFontFullHeight: integer; +begin + if FontHeight < 0 then + result := -FontHeight + else + result := TextSize('Hg').cy; +end; + +procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer); +begin + if AHeight > 0 then + FontHeight := -AHeight + else + FontHeight := 1; +end; + +function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric; +begin + result := FontRenderer.GetFontPixelMetric; +end; + +function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer; +begin + if FFontRenderer = nil then FFontRenderer := CreateDefaultFontRenderer; + if FFontRenderer = nil then raise exception.Create('No font renderer'); + result := FFontRenderer; + result.FontName := FontName; + result.FontStyle := FontStyle; + result.FontQuality := FontQuality; + result.FontOrientation := FontOrientation; + result.FontEmHeight := FFontHeight; +end; + +procedure TBGRADefaultBitmap.SetFontRenderer(AValue: TBGRACustomFontRenderer); +begin + if AValue = FFontRenderer then exit; + FFontRenderer.Free; + FFontRenderer := AValue +end; + +function TBGRADefaultBitmap.GetFontVerticalAnchorOffset: single; +begin + case FontVerticalAnchor of + fvaTop: result := 0; + fvaCenter: result := FontFullHeight*0.5; + fvaCapLine: result := FontPixelMetric.CapLine; + fvaCapCenter: result := (FontPixelMetric.CapLine+FontPixelMetric.Baseline)*0.5; + fvaXLine: result := FontPixelMetric.xLine; + fvaXCenter: result := (FontPixelMetric.xLine+FontPixelMetric.Baseline)*0.5; + fvaBaseline: result := FontPixelMetric.Baseline; + fvaDescentLine: result := FontPixelMetric.DescentLine; + fvaBottom: result := FontFullHeight; + else + result := 0; + end; +end; + +function TBGRADefaultBitmap.GetFontAnchorRotatedOffset: TPointF; +begin + result := GetFontAnchorRotatedOffset(FontOrientation); +end; + +function TBGRADefaultBitmap.GetFontAnchorRotatedOffset( + ACustomOrientation: integer): TPointF; +begin + result := PointF(0, GetFontVerticalAnchorOffset); + if ACustomOrientation <> 0 then + result := AffineMatrixRotationDeg(-ACustomOrientation*0.1)*result; +end; + +{ Creates a new bitmap with dimensions 0 x 0 } +function TBGRADefaultBitmap.NewBitmap: TBGRADefaultBitmap; +begin + Result := inherited NewBitmap as TBGRADefaultBitmap; +end; + +{ Creates a new bitmap with dimensions AWidth and AHeight and filled with + transparent pixels. Internally, it uses the same type so that if you + use an optimized version, you get a new bitmap with the same optimizations } +function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap; +begin + result := inherited NewBitmap(AWidth, AHeight) as TBGRADefaultBitmap; +end; + +{ Can only be called from an existing instance of TBGRABitmap. + Creates a new instance with dimensions AWidth and AHeight, + and fills it with Color. } +function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer; + const Color: TBGRAPixel): TBGRADefaultBitmap; +begin + result := inherited NewBitmap(AWidth, AHeight, Color) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap; +begin + result := inherited NewBitmap(AWidth, AHeight, AColor) as TBGRADefaultBitmap; +end; + +{ Creates a new bitmap and loads it contents from a file. + The encoding of the string is the default one for the operating system. + It is recommended to use the next function and UTF8 encoding } +function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRADefaultBitmap; +var + BGRAClass: TBGRABitmapAny; +begin + BGRAClass := TBGRABitmapAny(self.ClassType); + Result := BGRAClass.Create(Filename) as TBGRADefaultBitmap; +end; + +{ Creates a new bitmap and loads it contents from a file. + It is recommended to use UTF8 encoding } +function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap; +var + BGRAClass: TBGRABitmapAny; +begin + BGRAClass := TBGRABitmapAny(self.ClassType); + Result := BGRAClass.Create(Filename,AIsUtf8) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean; + AOptions: TBGRALoadingOptions): TBGRADefaultBitmap; +var + BGRAClass: TBGRABitmapAny; +begin + BGRAClass := TBGRABitmapAny(self.ClassType); + Result := BGRAClass.Create(Filename,AIsUtf8,AOptions) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap; +var + BGRAClass: TBGRABitmapAny; +begin + BGRAClass := TBGRABitmapAny(self.ClassType); + Result := BGRAClass.Create(AFPImage) as TBGRADefaultBitmap; +end; + +{----------------------- TFPCustomImage override ------------------------------} + +{ Set the size of the current bitmap. All data is lost during the process } +procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer); +begin + if (Width <> AWidth) or (Height <> AHeight) then + begin + inherited SetSize(AWidth, AHeight); + FreeBitmap; + end; +end; + +{---------------------- Constructors ---------------------------------} + +constructor TBGRADefaultBitmap.Create(AFPImage: TFPCustomImage); +begin + inherited Create; + Assign(AFPImage); +end; + +{ Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. } +constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap; AUseTransparent: boolean); +begin + inherited Create; + Assign(ABitmap, AUseTransparent); +end; + +{ Creates an image by loading its content from the file AFilename. + The encoding of the string is the default one for the operating system. + It is recommended to use the next constructor and UTF8 encoding. } +constructor TBGRADefaultBitmap.Create(AFilename: string); +begin + inherited Create; + LoadFromFile(Afilename); +end; + +{ Free the object and all its resources } +destructor TBGRADefaultBitmap.Destroy; +begin + DiscardXorMask; + FFontRenderer.Free; + {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP.Free;{$ENDIF} + FCanvasBGRA.Free; + FCanvas2D.Free; + FreeBitmap; + inherited Destroy; +end; + +{------------------------- Loading functions ----------------------------------} + +{ Creates an image by loading its content from the file AFilename. + The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename. } +constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean); +begin + inherited Create; + if AIsUtf8 then + LoadFromFileUTF8(Afilename) + else + LoadFromFile(Afilename); +end; + +constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean; + AOptions: TBGRALoadingOptions); +begin + inherited Create; + if AIsUtf8 then + LoadFromFileUTF8(Afilename, AOptions) + else + LoadFromFile(Afilename, AOptions); +end; + +{ Creates an image by loading its content from the stream AStream. } +constructor TBGRADefaultBitmap.Create(AStream: TStream); +begin + inherited Create; + LoadFromStream(AStream); +end; + +procedure TBGRADefaultBitmap.Serialize(AStream: TStream); +begin + If TBGRAPixel_RGBAOrder then + begin + LoadFromBitmapIfNeeded; + TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); + end; + inherited Serialize(AStream); + If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); +end; + +procedure TBGRADefaultBitmap.Deserialize(AStream: TStream); +begin + inherited Deserialize(AStream); + If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.SolidBrushIndirect(out + ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode); +begin + BGRASolidBrushIndirect(ABrush, AColor, ADrawMode); +end; + +class procedure TBGRADefaultBitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TBGRAPixel; ADrawMode: TDrawMode); +begin + BGRASolidBrushIndirect(ABrush, @AColor, ADrawMode); +end; + +class procedure TBGRADefaultBitmap.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer; AOffsetY: integer); +begin + BGRAScannerBrush(ABrush, AScanner, ADrawMode, AOffsetX, AOffsetY); +end; + +class procedure TBGRADefaultBitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + BGRAMaskBrush(ABrush, AScanner, AOffsetX, AOffsetY); +end; + +class procedure TBGRADefaultBitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + BGRAEraseBrush(ABrush, AAlpha); +end; + +class procedure TBGRADefaultBitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + BGRAAlphaBrush(ABrush, AAlpha); +end; + +procedure TBGRADefaultBitmap.Assign(Source: TPersistent); +var pdest: PBGRAPixel; + x,y: Int32or64; +begin + if Source is TBGRACustomBitmap then + begin + DiscardBitmapChange; + SetSize(TBGRACustomBitmap(Source).Width, TBGRACustomBitmap(Source).Height); + PutImage(0, 0, TBGRACustomBitmap(Source), dmSet); + if Source is TBGRADefaultBitmap then + begin + HotSpot := TBGRADefaultBitmap(Source).HotSpot; + if XorMask <> TBGRADefaultBitmap(Source).XorMask then + begin + DiscardXorMask; + if TBGRADefaultBitmap(Source).XorMask is TBGRADefaultBitmap then + FXorMask := TBGRADefaultBitmap(TBGRADefaultBitmap(Source).XorMask).NewReference as TBGRADefaultBitmap + else + FXorMask := TBGRADefaultBitmap(Source).XorMask.Duplicate; + end; + end; + end else + if Source is TFPCustomImage then + begin + DiscardBitmapChange; + SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height); + for y := 0 to TFPCustomImage(Source).Height-1 do + begin + pdest := ScanLine[y]; + for x := 0 to TFPCustomImage(Source).Width-1 do + begin + pdest^ := FPColorToBGRA(TFPCustomImage(Source).Colors[x,y]); + inc(pdest); + end; + end; + end else + inherited Assign(Source); +end; + +procedure TBGRADefaultBitmap.Assign(Source: TBitmap; AUseTransparent: boolean); +var + transpColor: TBGRAPixel; +begin + Assign(Source); + if AUseTransparent and TBitmap(Source).Transparent then + begin + if TBitmap(Source).TransparentMode = tmFixed then + transpColor := ColorToBGRA(TBitmap(Source).TransparentColor) + else + transpColor := GetPixel(0,Height-1); + ReplaceColor(transpColor, BGRAPixelTransparent); + end; +end; + +{------------------------- Clipping -------------------------------} + +function TBGRADefaultBitmap.InternalGetPixelCycle256(ix, iy: int32or64; iFactX, + iFactY: int32or64): TBGRAPixel; +var + ixMod2: int32or64; + pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel; + scan: PBGRAPixel; +begin + scan := GetScanlineFast(iy); + + pUpLeft := (scan + ix); + ixMod2 := ix+1; + if ixMod2=Width then ixMod2 := 0; + pUpRight := (scan + ixMod2); + + Inc(iy); + if iy = Height then iy := 0; + scan := GetScanlineFast(iy); + pDownLeft := (scan + ix); + pDownRight := (scan + ixMod2); + + InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, + pDownRight, iFactX, iFactY, @result); +end; + +function TBGRADefaultBitmap.InternalGetPixel256(ix, iy: int32or64; iFactX, + iFactY: int32or64; smoothBorder: boolean): TBGRAPixel; +var + pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel; + scan: PBGRAPixel; +begin + if (iy >= 0) and (iy < FHeight) then + begin + scan := GetScanlineFast(iy); + + if (ix >= 0) and (ix < FWidth) then + pUpLeft := scan+ix + else if smoothBorder then + pUpLeft := @BGRAPixelTransparent + else + pUpLeft := nil; + + if (ix+1 >= 0) and (ix+1 < FWidth) then + pUpRight := scan+(ix+1) + else if smoothBorder then + pUpRight := @BGRAPixelTransparent + else + pUpRight := nil; + end else + if smoothBorder then + begin + pUpLeft := @BGRAPixelTransparent; + pUpRight := @BGRAPixelTransparent; + end else + begin + pUpLeft := nil; + pUpRight := nil; + end; + + if (iy+1 >= 0) and (iy+1 < FHeight) then + begin + scan := GetScanlineFast(iy+1); + + if (ix >= 0) and (ix < FWidth) then + pDownLeft := scan+ix + else if smoothBorder then + pDownLeft := @BGRAPixelTransparent + else + pDownLeft := nil; + + if (ix+1 >= 0) and (ix+1 < FWidth) then + pDownRight := scan+(ix+1) + else if smoothBorder then + pDownRight := @BGRAPixelTransparent + else + pDownRight := nil; + end else + if smoothBorder then + begin + pDownLeft := @BGRAPixelTransparent; + pDownRight := @BGRAPixelTransparent; + end else + begin + pDownLeft := nil; + pDownRight := nil; + end; + + InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, + pDownRight, iFactX, iFactY, @result); +end; + +{-------------------------- Pixel functions -----------------------------------} + +procedure TBGRADefaultBitmap.XorPixel(x, y: int32or64; const c: TBGRAPixel); +var + p : PLongWord; +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + p := PLongWord(GetScanlineFast(y) +x); + p^ := p^ xor LongWord(c); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor); +var + p: PBGRAPixel; +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + p := GetScanlineFast(y) + x; + RedGreenBlue(c, p^.red,p^.green,p^.blue); + p^.alpha := 255; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; const c: TBGRAPixel); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + FastBlendPixelInline(GetScanlineFast(y) + x, c); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.ErasePixel(x, y: int32or64; alpha: byte); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + ErasePixelInline(GetScanlineFast(y) + x, alpha); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.AlphaPixel(x, y: int32or64; alpha: byte); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + if alpha = 0 then + (GetScanlineFast(y) +x)^ := BGRAPixelTransparent + else + (GetScanlineFast(y) +x)^.alpha := alpha; + InvalidateBitmap; +end; + +function TBGRADefaultBitmap.GetPixel256(x, y, fracX256, fracY256: int32or64; + AResampleFilter: TResampleFilter; smoothBorder: boolean = true): TBGRAPixel; +begin + if (fracX256 = 0) and (fracY256 = 0) then + result := GetPixel(x,y) + else if AResampleFilter = rfBox then + begin + if fracX256 >= 128 then inc(x); + if fracY256 >= 128 then inc(y); + result := GetPixel(x,y); + end else + begin + LoadFromBitmapIfNeeded; + result := InternalGetPixel256(x,y,FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter),smoothBorder); + end; +end; + +{$hints off} +{ This function compute an interpolated pixel at floating point coordinates } +function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + ix := round(x*256); + if (ix<= -256) or (ix>=Width shl 8) then + begin + result := BGRAPixelTransparent; + exit; + end; + iy := round(y*256); + if (iy<= -256) or (iy>=Height shl 8) then + begin + result := BGRAPixelTransparent; + exit; + end; + + iFactX := ix and 255; //distance from integer coordinate + iFactY := iy and 255; + if ix<0 then ix := -1 else ix := ix shr 8; + if iy<0 then iy := -1 else iy := iy shr 8; + + //if the coordinate is integer, then call standard GetPixel function + if (iFactX = 0) and (iFactY = 0) then + begin + Result := (GetScanlineFast(iy)+ix)^; + exit; + end; + + LoadFromBitmapIfNeeded; + result := InternalGetPixel256(ix,iy,FineInterpolation256(iFactX,AResampleFilter),FineInterpolation256(iFactY,AResampleFilter),smoothBorder); +end; + +{ Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions } +function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + if FNbPixels = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + LoadFromBitmapIfNeeded; + ix := round(x*256); + iy := round(y*256); + iFactX := ix and 255; + iFactY := iy and 255; + ix := PositiveMod(ix, FWidth shl 8) shr 8; + iy := PositiveMod(iy, FHeight shl 8) shr 8; + if (iFactX = 0) and (iFactY = 0) then + begin + result := (GetScanlineFast(iy)+ix)^; + exit; + end; + if ScanInterpolationFilter <> rfLinear then + begin + iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); + iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); + end; + result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); +end; + +function TBGRADefaultBitmap.GetPixelCycle(x, y: single; + AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean + ): TBGRAPixel; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + if FNbPixels = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + ix := round(x*256); + iy := round(y*256); + iFactX := ix and 255; + iFactY := iy and 255; + if ix < 0 then ix := -((iFactX-ix) shr 8) + else ix := ix shr 8; + if iy < 0 then iy := -((iFactY-iy) shr 8) + else iy := iy shr 8; + result := GetPixelCycle256(ix,iy,iFactX,iFactY,AResampleFilter,repeatX,repeatY); +end; + +function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256, + fracY256: int32or64; AResampleFilter: TResampleFilter): TBGRAPixel; +begin + if (fracX256 = 0) and (fracY256 = 0) then + result := GetPixelCycle(x,y) + else if AResampleFilter = rfBox then + begin + if fracX256 >= 128 then inc(x); + if fracY256 >= 128 then inc(y); + result := GetPixelCycle(x,y); + end else + begin + LoadFromBitmapIfNeeded; + result := InternalGetPixelCycle256(PositiveMod(x,FWidth),PositiveMod(y,FHeight),FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter)); + end; +end; + +function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256, + fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; + repeatY: boolean): TBGRAPixel; +begin + if not repeatX and not repeatY then + result := GetPixel256(x,y,fracX256,fracY256,AResampleFilter) + else if repeatX and repeatY then + result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter) + else + begin + if not repeatX then + begin + if x < 0 then + begin + if x < -1 then + begin + result := BGRAPixelTransparent; + exit; + end; + result := GetPixelCycle256(0,y,0,fracY256,AResampleFilter); + result.alpha:= result.alpha*fracX256 shr 8; + if result.alpha = 0 then + result := BGRAPixelTransparent; + exit; + end; + if x >= FWidth-1 then + begin + if x >= FWidth then + begin + result := BGRAPixelTransparent; + exit; + end; + result := GetPixelCycle256(FWidth-1,y,0,fracY256,AResampleFilter); + result.alpha:= result.alpha*(256-fracX256) shr 8; + if result.alpha = 0 then + result := BGRAPixelTransparent; + exit; + end; + end else + begin + if y < 0 then + begin + if y < -1 then + begin + result := BGRAPixelTransparent; + exit; + end; + result := GetPixelCycle256(x,0,fracX256,0,AResampleFilter); + result.alpha:= result.alpha*fracY256 shr 8; + if result.alpha = 0 then + result := BGRAPixelTransparent; + exit; + end; + if y >= FHeight-1 then + begin + if y >= FHeight then + begin + result := BGRAPixelTransparent; + exit; + end; + result := GetPixelCycle256(x,FHeight-1,fracX256,0,AResampleFilter); + result.alpha:= result.alpha*(256-fracY256) shr 8; + if result.alpha = 0 then + result := BGRAPixelTransparent; + exit; + end; + end; + result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter); + end; +end; + +{$hints on} + +procedure TBGRADefaultBitmap.InvalidateBitmap; +begin + FDataModified := True; +end; + +function TBGRADefaultBitmap.GetBitmap: TBitmap; +begin + if FAlphaCorrectionNeeded then + begin + if CanvasAlphaCorrection then + LoadFromBitmapIfNeeded + else + FAlphaCorrectionNeeded := false; + end; + if FDataModified or (FBitmap = nil) then + begin + RebuildBitmap; + FBitmapModified := false; + FAlphaCorrectionNeeded:= false; + FDataModified := False; + end; + Result := FBitmap; +end; + +function TBGRADefaultBitmap.GetCanvas: TCanvas; +begin + if FDataModified or (FBitmap = nil) then + begin + RebuildBitmap; + FBitmapModified := false; + FAlphaCorrectionNeeded:= false; + FDataModified := False; + end; + Result := FBitmap.Canvas; +end; + +{$IFDEF BGRABITMAP_USE_FPCANVAS}function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas; +begin + {$warnings off} + if FCanvasFP = nil then + FCanvasFP := TFPImageCanvas.Create(self); + {$warnings on} + result := FCanvasFP; +end;{$ENDIF} + +procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode); +begin + FCanvasDrawModeFP := AValue; + Case AValue of + dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel; + dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel; + dmXor: FCanvasPixelProcFP:= @XorPixel; + else FCanvasPixelProcFP := @SetPixel; + end; +end; + +function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode; +begin + Result:= FCanvasDrawModeFP; +end; + +procedure TBGRADefaultBitmap.LoadFromBitmapIfNeeded; +begin + if FBitmapModified then + begin + DoLoadFromBitmap; + DiscardBitmapChange; + end; + if FAlphaCorrectionNeeded then + begin + DoAlphaCorrection; + end; +end; + +procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); +begin + if AFadePosition = 0 then + FillRect(ARect, Source1, mode) else + if AFadePosition = 255 then + FillRect(ARect, Source2, mode) else + InternalCrossFade(ARect, Source1,Source2, AFadePosition,nil, mode); +end; + +procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); +begin + InternalCrossFade(ARect, Source1,Source2, 0,AFadeMask, mode); +end; + +procedure TBGRADefaultBitmap.DiscardBitmapChange; inline; +begin + FBitmapModified := False; +end; + +procedure TBGRADefaultBitmap.NotifyBitmapChange; +begin + FBitmapModified := True; + FAlphaCorrectionNeeded := true; +end; + +{ Initialize properties } +procedure TBGRADefaultBitmap.Init; +begin + inherited Init; + FBitmap := nil; + {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP := nil;{$ENDIF} + FCanvasBGRA := nil; + CanvasDrawModeFP := dmDrawWithTransparency; + FCanvasOpacity := 255; + FAlphaCorrectionNeeded := False; + + FontName := 'Arial'; + FontStyle := []; + FontAntialias := False; + FontVerticalAnchor:= fvaTop; + FFontHeight := 20; + + ResampleFilter := rfHalfCosine; + ScanInterpolationFilter := rfLinear; +end; + +procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); +begin + FCanvasPixelProcFP(x,y, FPColorToBGRA(Value)); +end; + +function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor; +begin + if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then + result := colTransparent + else + begin + LoadFromBitmapIfNeeded; + result := BGRAToFPColor((Scanline[y] + x)^); + end; +end; + +procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer); +var + c: TFPColor; +begin + if not PtInClipRect(x,y) then exit; + c := Palette.Color[Value]; + (Scanline[y] + x)^ := FPColorToBGRA(c); + InvalidateBitmap; +end; + +function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer; +var + c: TFPColor; +begin + if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then + result := 0 + else + begin + LoadFromBitmapIfNeeded; + c := BGRAToFPColor((Scanline[y] + x)^); + Result := palette.IndexOf(c); + end; +end; + +procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + if (self = nil) or (Width = 0) or (Height = 0) then exit; + if Opaque then + DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, + FLineOrder, FWidth, FHeight) + else + begin + LoadFromBitmapIfNeeded; + if Empty then + exit; + ACanvas.Draw(X, Y, Bitmap); + end; +end; + +procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +begin + if (self = nil) or (Width = 0) or (Height = 0) then exit; + if Opaque then + DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight) + else + begin + LoadFromBitmapIfNeeded; + ACanvas.StretchDraw(Rect, Bitmap); + end; +end; + +{---------------------------- Line primitives ---------------------------------} + +procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); +begin + if not CheckHorizLineBounds(x,y,x2) then exit; + XorInline(scanline[y] + x, c, x2 - x + 1); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel + ); +begin + if not CheckHorizLineBounds(x,y,x2) then exit; + DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); +begin + if not CheckHorizLineBounds(x,y,x2) then exit; + FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte); +begin + if alpha = 0 then + begin + SetHorizLine(x, y, x2, BGRAPixelTransparent); + exit; + end; + if not CheckHorizLineBounds(x,y,x2) then exit; + AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); +var + n, delta: int32or64; + p: PBGRAPixel; +begin + if not CheckVertLineBounds(x,y,y2) then exit; + if LineOrder = riloTopToBottom then delta := Width else delta := -Width; + p := scanline[y] + x; + for n := y2 - y downto 0 do + begin + PLongWord(p)^ := PLongWord(p)^ xor LongWord(c); + Inc(p, delta); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); +var + n, delta: int32or64; + p: PBGRAPixel; +begin + if c.alpha = 255 then + begin + SetVertLine(x,y,y2,c); + exit; + end; + if not CheckVertLineBounds(x,y,y2) or (c.alpha=0) then exit; + p := scanline[y] + x; + if LineOrder = riloTopToBottom then delta := Width else delta := -Width; + for n := y2 - y downto 0 do + begin + DrawPixelInlineNoAlphaCheck(p, c); + Inc(p, delta); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte); +var + n, delta: int32or64; + p: PBGRAPixel; +begin + if alpha = 0 then + begin + SetVertLine(x, y, y2, BGRAPixelTransparent); + exit; + end; + if not CheckVertLineBounds(x,y,y2) then exit; + p := scanline[y] + x; + if LineOrder = riloTopToBottom then delta := Width else delta := -Width; + for n := y2 - y downto 0 do + begin + p^.alpha := alpha; + Inc(p, delta); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); +var + n, delta: int32or64; + p: PBGRAPixel; +begin + if not CheckVertLineBounds(x,y,y2) then exit; + p := scanline[y] + x; + if LineOrder = riloTopToBottom then delta := Width else delta := -Width; + for n := y2 - y downto 0 do + begin + FastBlendPixelInline(p, c); + Inc(p, delta); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: int32or64; + c, compare: TBGRAPixel; maxDiff: byte); +begin + if not CheckHorizLineBounds(x,y,x2) then exit; + DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.HorizLineDiff(x, y, x2: int32or64; + const ABrush: TUniversalBrush; ACompare: TBGRAPixel; AMaxDiffW: word); +var + pScan: PBGRAPixel; + ctx: TUniBrushContext; + sameCount, remain: Int32or64; + startAlpha, nextAlpha: Word; + compExpand: TExpandedPixel; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + if not CheckHorizLineBounds(x,y,x2) then exit; + LoadFromBitmapIfNeeded; + pScan := PBGRAPixel(GetPixelAddress(x,y)); + ABrush.MoveTo(@ctx, pScan,x,y); + remain := x2-x+1; + compExpand := ACompare.ToExpanded; + if pScan^ = ACompare then nextAlpha := 65535 + else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1); + inc(pScan); + while remain > 0 do + begin + startAlpha := nextAlpha; + sameCount := 1; + dec(remain); + while remain > 0 do + begin + if pScan^ = ACompare then nextAlpha := 65535 + else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1); + inc(pScan); + if nextAlpha = startAlpha then + begin + inc(sameCount); + dec(remain); + end else break; + end; + ABrush.PutNextPixels(@ctx, startAlpha, sameCount); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.InternalTextOutCurved( + ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; + ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); +var + glyphCursor: TGlyphCursorUtf8; + currentGlyph: TGlyphUtf8; + currentGlyphUtf8: string; + currentGlyphWidth: single; + angle, textLen: single; + + procedure NextGlyph; + begin + currentGlyph := glyphCursor.GetNextGlyph; + if currentGlyph.MirroredGlyphUtf8 <> '' then + currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8 + else currentGlyphUtf8 := currentGlyph.GlyphUtf8; + currentGlyphWidth := TextSize(currentGlyphUtf8).cx; + end; + +begin + if (ATexture = nil) and (AColor.alpha = 0) then exit; + sUTF8 := CleanTextOutString(sUTF8); + if sUTF8 = '' then exit; + glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode); + + if AAlign<> taLeftJustify then + begin + textLen := -ALetterSpacing; + while not glyphCursor.EndOfString do + begin + NextGlyph; + IncF(textLen, ALetterSpacing + currentGlyphWidth); + end; + case AAlign of + taCenter: ACursor.MoveBackward(textLen*0.5); + taRightJustify: ACursor.MoveBackward(textLen); + end; + glyphCursor.Rewind; + end; + + while not glyphCursor.EndOfString do + begin + NextGlyph; + ACursor.MoveForward(currentGlyphWidth); + ACursor.MoveBackward(currentGlyphWidth, false); + ACursor.MoveForward(currentGlyphWidth*0.5); + with ACursor.CurrentTangent do angle := arctan2(y,x); + with ACursor.CurrentCoordinate do + begin + if ATexture = nil then + TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, AColor, taCenter) + else + TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, ATexture, taCenter); + end; + ACursor.MoveForward(currentGlyphWidth*0.5 + ALetterSpacing); + end; +end; + +procedure TBGRADefaultBitmap.InternalTextOutLetterSpacing(x, y: single; + sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; + AAlign: TAlignment; ALetterSpacing: single); +var + glyphCursor: TGlyphCursorUtf8; + currentGlyph: TGlyphUtf8; + currentGlyphUtf8: string; + currentGlyphWidth: single; + angle, textLen: single; + m: TAffineMatrix; + ofs: TPointF; + + procedure NextGlyph; + begin + currentGlyph := glyphCursor.GetNextGlyph; + if currentGlyph.MirroredGlyphUtf8 <> '' then + currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8 + else currentGlyphUtf8 := currentGlyph.GlyphUtf8; + currentGlyphWidth := TextSize(currentGlyphUtf8).cx; + end; + +begin + if (ATexture = nil) and (AColor.alpha = 0) then exit; + sUTF8 := CleanTextOutString(sUTF8); + if sUTF8 = '' then exit; + glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode); + + ofs := PointF(0, 0); + if AAlign<> taLeftJustify then + begin + textLen := -ALetterSpacing; + while not glyphCursor.EndOfString do + begin + NextGlyph; + IncF(textLen, ALetterSpacing + currentGlyphWidth); + end; + case AAlign of + taCenter: DecF(ofs.x, 0.5*textLen); + taRightJustify: DecF(ofs.x, textLen); + end; + glyphCursor.Rewind; + end; + m := AffineMatrixRotationDeg(-FontOrientation*0.1); + ofs := m*ofs; + incF(x, ofs.x); + incF(y, ofs.y); + + while not glyphCursor.EndOfString do + begin + NextGlyph; + if ATexture = nil then + TextOut(x,y, currentGlyphUtf8, AColor, taLeftJustify, currentGlyph.RightToLeft) + else + TextOut(x,y, currentGlyphUtf8, ATexture, taLeftJustify, currentGlyph.RightToLeft); + ofs := m*PointF(currentGlyphWidth + ALetterSpacing, 0); + incF(x, ofs.x); + incF(y, ofs.y); + end; +end; + +procedure TBGRADefaultBitmap.InternalCrossFade(ARect: TRect; Source1, + Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode); +var xb,yb: Int32or64; + pdest: PBGRAPixel; + c: TBGRAPixel; + buf1,buf2: ArrayOfTBGRAPixel; +begin + ARect.Intersect(ClipRect); + if ARect.IsEmpty then exit; + setlength(buf1, ARect.Width); + setlength(buf2, ARect.Width); + for yb := ARect.top to ARect.Bottom-1 do + begin + pdest := GetScanlineFast(yb)+ARect.Left; + Source1.ScanMoveTo(ARect.left, yb); + Source1.ScanPutPixels(@buf1[0], length(buf1), dmSet); + Source2.ScanMoveTo(ARect.left, yb); + Source2.ScanPutPixels(@buf2[0], length(buf2), dmSet); + if AFadeMask<>nil then AFadeMask.ScanMoveTo(ARect.left, yb); + for xb := 0 to ARect.Right-ARect.left-1 do + begin + if AFadeMask<>nil then AFadePos := AFadeMask.ScanNextPixel.green; + c := MergeBGRAWithGammaCorrection(buf1[xb],not AFadePos,buf2[xb],AFadePos); + case mode of + dmSet: pdest^ := c; + dmDrawWithTransparency: DrawPixelInlineWithAlphaCheck(pdest, c); + dmLinearBlend: FastBlendPixelInline(pdest,c); + dmSetExceptTransparent: if c.alpha = 255 then pdest^ := c; + end; + inc(pdest); + end; + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.InternalArc(cx, cy, rx, ry: single; StartAngleRad, + EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; + ADrawChord: boolean; ATexture: IBGRAScanner); +var + pts, ptsFill: array of TPointF; + temp: single; + multi: TBGRAMultishapeFiller; +begin + if (rx = 0) or (ry = 0) then exit; + if ADrawChord then AOptions := AOptions+[aoClosePath]; + if not (aoFillPath in AOptions) then + AFillColor := BGRAPixelTransparent; + + if (ABorderColor.alpha = 0) and (AFillColor.alpha = 0) then exit; + + if (abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6) or (StartAngleRad = EndAngleRad) then + begin + if (aoPie in AOptions) or ((PenStyle <> psSolid) and (PenStyle <> psClear)) then + EndAngleRad:= StartAngleRad+2*PI + else + begin + EllipseAntialias(cx,cy,rx,ry,ABorderColor,w,AFillColor); + exit; + end; + end; + + if EndAngleRad < StartAngleRad then + begin + temp := StartAngleRad; + StartAngleRad:= EndAngleRad; + EndAngleRad:= temp; + end; + + pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad); + if aoPie in AOptions then pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]); + + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := fmWinding; + multi.PolygonOrder := poLastOnTop; + if AFillColor.alpha <> 0 then + begin + if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts]) + else ptsFill := pts; + if ATexture <> nil then + multi.AddPolygon(ptsFill, ATexture) + else + multi.AddPolygon(ptsFill, AFillColor); + end; + if ABorderColor.alpha <> 0 then + begin + if [aoPie,aoClosePath]*AOptions <> [] then + multi.AddPolygon(ComputeWidePolygon(pts,w), ABorderColor) + else + multi.AddPolygon(ComputeWidePolyline(pts,w), ABorderColor); + end; + multi.Antialiasing := true; + multi.Draw(self); + multi.Free; +end; + +function TBGRADefaultBitmap.InternalNew: TBGRADefaultBitmap; +var + BGRAClass: TBGRABitmapAny; +begin + BGRAClass := TBGRABitmapAny(self.ClassType); + if BGRAClass = TBGRAPtrBitmap then + BGRAClass := TBGRADefaultBitmap; + Result := BGRAClass.Create(0, 0) as TBGRADefaultBitmap; +end; + +class function TBGRADefaultBitmap.IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; +const oneOver512 = 1/512; +var Orig,HAxis,VAxis: TPointF; +begin + Orig := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Top); + if (abs(Orig.x-round(Orig.x)) > oneOver512) or + (abs(Orig.y-round(Orig.y)) > oneOver512) then + begin + result := false; + exit; + end; + HAxis := AMatrix*PointF(ASourceBounds.Right-1,ASourceBounds.Top); + if (abs(HAxis.x - (round(Orig.x)+ASourceBounds.Right-1 - ASourceBounds.Left)) > oneOver512) or + (abs(HAxis.y - round(Orig.y)) > oneOver512) then + begin + result := false; + exit; + end; + VAxis := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Bottom-1); + if (abs(VAxis.y - (round(Orig.y)+ASourceBounds.Bottom-1 - ASourceBounds.Top)) > oneOver512) or + (abs(VAxis.x - round(Orig.x)) > oneOver512) then + begin + result := false; + exit; + end; + result := true; +end; + +{---------------------------- Lines ---------------------------------} +{ Call appropriate functions } + +procedure TBGRADefaultBitmap.DrawPolyLineAntialias( + const points: array of TPointF; c: TBGRAPixel; w: single; + fillcolor: TBGRAPixel); +var multi: TBGRAMultishapeFiller; +begin + multi := TBGRAMultishapeFiller.Create; + multi.PolygonOrder := poLastOnTop; + multi.AddPolygon(points,fillcolor); + multi.AddPolygon(ComputeWidePolyline(points,w),c); + if LinearAntialiasing then + multi.Draw(self,dmLinearBlend) + else + multi.Draw(self,dmDrawWithTransparency); + multi.Free; +end; + +procedure TBGRADefaultBitmap.DrawPolygonAntialias( + const points: array of TPointF; c: TBGRAPixel; w: single; + fillcolor: TBGRAPixel); +var multi: TBGRAMultishapeFiller; +begin + multi := TBGRAMultishapeFiller.Create; + multi.PolygonOrder := poLastOnTop; + multi.AddPolygon(points,fillcolor); + multi.AddPolygon(ComputeWidePolygon(points,w),c); + if LinearAntialiasing then + multi.Draw(self,dmLinearBlend) + else + multi.Draw(self,dmDrawWithTransparency); + multi.Free; +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; + AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); +var tempPath: TBGRAPath; + multi: TBGRAMultishapeFiller; +begin + tempPath := TBGRAPath.Create(APath); + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := FillMode; + multi.PolygonOrder := poLastOnTop; + multi.AddPathFill(tempPath,AMatrix,AFillColor); + multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen); + multi.Draw(self); + multi.Free; + tempPath.Free; +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; + AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); +var tempPath: TBGRAPath; + multi: TBGRAMultishapeFiller; +begin + tempPath := TBGRAPath.Create(APath); + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := FillMode; + multi.PolygonOrder := poLastOnTop; + multi.AddPathFill(tempPath,AMatrix,AFillColor); + multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen); + multi.Draw(self); + multi.Free; + tempPath.Free; +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; + AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); +var tempPath: TBGRAPath; + multi: TBGRAMultishapeFiller; +begin + tempPath := TBGRAPath.Create(APath); + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := FillMode; + multi.PolygonOrder := poLastOnTop; + multi.AddPathFill(tempPath,AMatrix,AFillTexture); + multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen); + multi.Draw(self); + multi.Free; + tempPath.Free; +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; + AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); +var + tempPath: TBGRAPath; + multi: TBGRAMultishapeFiller; +begin + tempPath := TBGRAPath.Create(APath); + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := FillMode; + multi.PolygonOrder := poLastOnTop; + multi.AddPathFill(tempPath,AMatrix,AFillTexture); + multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen); + multi.Draw(self); + multi.Free; + tempPath.Free; +end; + +procedure TBGRADefaultBitmap.ArrowStartAsNone; +begin + GetArrow.StartAsNone; +end; + +procedure TBGRADefaultBitmap.ArrowStartAsClassic(AFlipped: boolean; + ACut: boolean; ARelativePenWidth: single); +begin + GetArrow.StartAsClassic(AFlipped,ACut,ARelativePenWidth); +end; + +procedure TBGRADefaultBitmap.ArrowStartAsTriangle(ABackOffset: single; + ARounded: boolean; AHollow: boolean; AHollowPenWidth: single); +begin + GetArrow.StartAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth); +end; + +procedure TBGRADefaultBitmap.ArrowStartAsTail; +begin + GetArrow.StartAsTail; +end; + +procedure TBGRADefaultBitmap.ArrowEndAsNone; +begin + GetArrow.EndAsNone; +end; + +procedure TBGRADefaultBitmap.ArrowEndAsClassic(AFlipped: boolean; + ACut: boolean; ARelativePenWidth: single); +begin + GetArrow.EndAsClassic(AFlipped,ACut,ARelativePenWidth); +end; + +procedure TBGRADefaultBitmap.ArrowEndAsTriangle(ABackOffset: single; + ARounded: boolean; AHollow: boolean; AHollowPenWidth: single); +begin + GetArrow.EndAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth); +end; + +procedure TBGRADefaultBitmap.ArrowEndAsTail; +begin + GetArrow.EndAsTail; +end; + +{------------------------ Shapes ----------------------------------------------} +{ Call appropriate functions } + +procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; + c1, c2, c3: TBGRAPixel); +begin + FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]); +end; + +procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2, + pt3: TPointF; c1, c2, c3: TBGRAPixel); +var + grad: TBGRAGradientTriangleScanner; +begin + grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3); + FillPolyAntialias([pt1,pt2,pt3],grad); + grad.Free; +end; + +procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF; + texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); +begin + FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation); +end; + +procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2, + pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1, + light2, light3: word; TextureInterpolation: Boolean); +begin + FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation); +end; + +procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2, + pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); +var + mapping: TBGRATriangleLinearMapping; +begin + mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3); + FillPolyAntialias([pt1,pt2,pt3],mapping); + mapping.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; + c1, c2, c3, c4: TBGRAPixel); +var + center: TPointF; + centerColor: TBGRAPixel; + multi: TBGRAMultishapeFiller; +begin + if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors + begin + multi := TBGRAMultishapeFiller.Create; + multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4); + multi.Antialiasing:= false; + multi.Draw(self); + multi.Free; + exit; + end; + center := (pt1+pt2+pt3+pt4)*(1/4); + centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)), + MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) ); + FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor); + FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor); + FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor); + FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor); +end; + +procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3, + pt4: TPointF; c1, c2, c3, c4: TBGRAPixel); +var multi : TBGRAMultishapeFiller; +begin + multi := TBGRAMultishapeFiller.Create; + multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4); + multi.Draw(self); + multi.free; +end; + +procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; + texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + TextureInterpolation: Boolean; ACulling: TFaceCulling; ACropToPolygon: boolean); +var + scan: TBGRAQuadLinearScanner; + r: TRect; +begin + if ((abs(pt1.y-pt2.y)<1e-6) and (abs(pt3.y-pt4.y)<1e-6)) or + ((abs(pt3.y-pt2.y)<1e-6) and (abs(pt1.y-pt4.y)<1e-6)) then + FillPolyLinearMapping([pt1,pt2,pt3,pt4], texture, + [tex1,tex2,tex3,tex4], TextureInterpolation) + else + begin + scan := TBGRAQuadLinearScanner.Create(texture, + [tex1,tex2,tex3,tex4], + [pt1,pt2,pt3,pt4],TextureInterpolation); + scan.Culling := ACulling; + if ACropToPolygon then + begin + scan.Padding := true; + FillPoly([pt1,pt2,pt3,pt4],scan,dmDrawWithTransparency); + end + else + begin + r := RectWithSize(floor(pt1.x),floor(pt1.y),1,1); + r.Union( RectWithSize(floor(pt2.x),floor(pt2.y),1,1) ); + r.Union( RectWithSize(floor(pt3.x),floor(pt3.y),1,1) ); + r.Union( RectWithSize(floor(pt4.x),floor(pt4.y),1,1) ); + FillRect(r,scan,dmDrawWithTransparency); + end; + scan.Free; + end; +end; + +procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1, + light2, light3, light4: word; TextureInterpolation: Boolean); +var + center: TPointF; + centerTex: TPointF; + centerLight: word; +begin + center := (pt1+pt2+pt3+pt4)*(1/4); + centerTex := (tex1+tex2+tex3+tex4)*(1/4); + centerLight := (light1+light2+light3+light4) div 4; + FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation); + FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation); + FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation); + FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation); +end; + +procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + ACulling: TFaceCulling); +var multi : TBGRAMultishapeFiller; +begin + multi := TBGRAMultishapeFiller.Create; + multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4, ACulling); + multi.Draw(self); + multi.free; +end; + +procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + ADrawMode: TDrawMode); +var + persp: TBGRAPerspectiveScannerTransform; +begin + persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); + FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode); + persp.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + ACleanBorders: TRect; ADrawMode: TDrawMode); +var + persp: TBGRAPerspectiveScannerTransform; + clean: TBGRAExtendedBorderScanner; +begin + clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders); + persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); + FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode); + persp.Free; + clean.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); +var + persp: TBGRAPerspectiveScannerTransform; +begin + persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); + FillPolyAntialias([pt1,pt2,pt3,pt4],persp); + persp.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + ACleanBorders: TRect); +var + persp: TBGRAPerspectiveScannerTransform; + clean: TBGRAExtendedBorderScanner; +begin + clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders); + persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); + FillPolyAntialias([pt1,pt2,pt3,pt4],persp); + persp.Free; + clean.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadAffineMapping(Orig, HAxis, VAxis: TPointF; + AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; ADrawMode: TDrawMode; AOpacity: byte); +var pts3: TPointF; + affine: TBGRAAffineBitmapTransform; +begin + if not APixelCenteredCoordinates then + begin + Orig.Offset(-0.5,-0.5); + HAxis.Offset(-0.5,-0.5); + VAxis.Offset(-0.5,-0.5); + end; + pts3 := HAxis+(VAxis-Orig); + affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates); + affine.GlobalOpacity:= AOpacity; + affine.Fit(Orig,HAxis,VAxis); + FillPoly([Orig,HAxis,pts3,VAxis],affine,ADrawMode); + affine.Free; +end; + +procedure TBGRADefaultBitmap.FillQuadAffineMappingAntialias(Orig, HAxis, + VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; AOpacity: byte); +var pts3: TPointF; + affine: TBGRAAffineBitmapTransform; +begin + if not APixelCenteredCoordinates then + begin + Orig.Offset(-0.5,-0.5); + HAxis.Offset(-0.5,-0.5); + VAxis.Offset(-0.5,-0.5); + end; + pts3 := HAxis+(VAxis-Orig); + affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates); + affine.GlobalOpacity:= AOpacity; + affine.Fit(Orig,HAxis,VAxis); + FillPolyAntialias([Orig,HAxis,pts3,VAxis],affine); + affine.Free; +end; + +procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF; + texture: IBGRAScanner; texCoords: array of TPointF; + TextureInterpolation: Boolean); +begin + PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding); +end; + +procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness( + const points: array of TPointF; texture: IBGRAScanner; + texCoords: array of TPointF; lightnesses: array of word; + TextureInterpolation: Boolean); +begin + PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding); +end; + +procedure TBGRADefaultBitmap.FillPolyLinearColor( + const points: array of TPointF; AColors: array of TBGRAPixel); +begin + PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding); +end; + +procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping( + const points: array of TPointF; const pointsZ: array of single; + texture: IBGRAScanner; texCoords: array of TPointF; + TextureInterpolation: Boolean; zbuffer: psingle); +begin + PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding, zbuffer); +end; + +procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness( + const points: array of TPointF; const pointsZ: array of single; + texture: IBGRAScanner; texCoords: array of TPointF; + lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle); +begin + PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding, zbuffer); +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; + AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); +begin + DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillColor); +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; + AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); +begin + DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillColor); +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; + AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); +begin + DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillTexture); +end; + +procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; + AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); +begin + DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillTexture); +end; + +procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single; + c: TBGRAPixel; w: single; back: TBGRAPixel); +var multi: TBGRAMultishapeFiller; + hw: single; +begin + if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then + begin + FillEllipseAntialias(x, y, rx, ry, back); + exit; + end; + rx := abs(rx); + ry := abs(ry); + hw := w/2; + if (rx <= hw) or (ry <= hw) then + begin + FillEllipseAntialias(x,y,rx+hw,ry+hw,c); + exit; + end; + { use multishape filler for fine junction between polygons } + multi := TBGRAMultishapeFiller.Create; + if (PenStyle = psSolid) then + begin + if back.alpha <> 0 then multi.AddEllipse(x,y,rx-hw,ry-hw,back); + multi.AddEllipseBorder(x,y,rx,ry,w,c) + end + else + begin + if back.alpha <> 0 then multi.AddEllipse(x,y,rx,ry,back); + multi.AddPolygon(ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry),w),c); + end; + multi.PolygonOrder := poLastOnTop; + multi.Draw(self); + multi.Free; +end; + +procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; + c: TBGRAPixel; w: single; back: TBGRAPixel); +var multi: TBGRAMultishapeFiller; + pts: ArrayOfTPointF; +begin + if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then + begin + FillEllipseAntialias(AOrigin, AXAxis, AYAxis, back); + exit; + end; + { use multishape filler for fine junction between polygons } + multi := TBGRAMultishapeFiller.Create; + pts := ComputeEllipseContour(AOrigin, AXAxis, AYAxis); + if back.alpha <> 0 then multi.AddPolygon(pts, back); + pts := ComputeWidePolygon(pts,w); + multi.AddPolygon(pts,c); + multi.PolygonOrder := poLastOnTop; + multi.Draw(self); + multi.Free; +end; + +procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx, + ry: single; outercolor, innercolor: TBGRAPixel); +var + grad: TBGRAGradientScanner; + affine: TBGRAAffineScannerTransform; +begin + if (rx=0) or (ry=0) then exit; + if rx=ry then + begin + grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True); + FillEllipseAntialias(x,y,rx,ry,grad); + grad.Free; + end else + begin + grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True); + affine := TBGRAAffineScannerTransform.Create(grad); + affine.Scale(rx,ry); + affine.Translate(x,y); + FillEllipseAntialias(x,y,rx,ry,affine); + affine.Free; + grad.Free; + end; +end; + +procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(AOrigin, AXAxis, + AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); +var + grad: TBGRAGradientScanner; + affine: TBGRAAffineScannerTransform; +begin + grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True); + affine := TBGRAAffineScannerTransform.Create(grad); + affine.Fit(AOrigin,AXAxis,AYAxis); + FillEllipseAntialias(AOrigin,AXAxis,AYAxis,affine); + affine.Free; + grad.Free; +end; + +procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single; + c: TBGRAPixel; w: single; back: TBGRAPixel); +var + bevel: single; + multi: TBGRAMultishapeFiller; + hw: single; +begin + if (PenStyle = psClear) or (c.alpha=0) or (w=0) then + begin + if back <> BGRAPixelTransparent then + FillRectAntialias(x,y,x2,y2,back); + exit; + end; + + hw := w/2; + if not CheckAntialiasRectBounds(x,y,x2,y2,w) then + begin + if JoinStyle = pjsBevel then + begin + bevel := (2-sqrt(2))*hw; + FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]); + end else + if JoinStyle = pjsRound then + FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c) + else + FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c); + exit; + end; + + { use multishape filler for fine junction between polygons } + multi := TBGRAMultishapeFiller.Create; + multi.FillMode := FillMode; + if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then + multi.AddRectangleBorder(x,y,x2,y2,w,c) + else + multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c); + + if (frac(x + hw) = 0.5) and (frac(y + hw)=0.5) and (frac(x2 - hw)=0.5) and (frac(y2 - hw)=0.5) then + FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency) + else + multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back); + multi.Draw(self); + multi.Free; +end; + +procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; + c: TBGRAPixel; w: single; options: TRoundRectangleOptions); +begin + if (PenStyle = psClear) or (c.alpha = 0) then exit; + if (PenStyle = psSolid) then + BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing) + else + DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w); +end; + +procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; + pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; + options: TRoundRectangleOptions); +var + multi: TBGRAMultishapeFiller; +begin + if (PenStyle = psClear) or (pencolor.alpha = 0) then + begin + FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options); + exit; + end; + if (PenStyle = psSolid) then + BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False) + else + begin + multi := TBGRAMultishapeFiller.Create; + multi.PolygonOrder := poLastOnTop; + multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options); + multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor); + multi.Draw(self); + multi.Free; + end; +end; + +procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; + penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; + options: TRoundRectangleOptions); +var + multi: TBGRAMultishapeFiller; +begin + if (PenStyle = psClear) then + begin + FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options); + exit; + end else + if (PenStyle = psSolid) then + BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False) + else + begin + multi := TBGRAMultishapeFiller.Create; + multi.PolygonOrder := poLastOnTop; + multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options); + multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture); + multi.Draw(self); + multi.Free; + end; +end; + +procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; + texture: IBGRAScanner; w: single; options: TRoundRectangleOptions); +begin + if (PenStyle = psClear) then exit; + if (PenStyle = psSolid) then + BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing) + else + DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w); +end; + +function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline; +var + temp: integer; +begin + //swap coordinates if needed + if (x > x2) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (y > y2) then + begin + temp := y; + y := y2; + y2 := temp; + end; + if (x2 - x <= minsize) or (y2 - y <= minsize) then + begin + result := false; + exit; + end else + result := true; +end; + +procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer; + texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); +var dither: TDitheringTask; +begin + if not CheckClippedRectBounds(x,y,x2,y2) then exit; + dither := CreateDitheringTask(ditheringAlgorithm, texture, self, rect(x,y,x2,y2)); + dither.ScanOffset := AScanOffset; + dither.DrawMode := mode; + dither.Execute; + dither.Free; +end; + +{------------------------- Text functions ---------------------------------------} + +procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer; + const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); +begin + with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do + FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align,ARightToLeft); +end; + +procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer; + const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); +begin + with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do + FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align,ARightToLeft); +end; + +procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); +begin + InternalTextOutCurved(ACursor, sUTF8, AColor, nil, AAlign, ALetterSpacing); +end; + +procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); +begin + InternalTextOutCurved(ACursor, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing); +end; + +procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; const sUTF8: string; + c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); +var + layout: TBidiTextLayout; + i: Integer; +begin + if FontBidiMode = fbmAuto then + layout := TBidiTextLayout.Create(FontRenderer, sUTF8) + else + layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); + for i := 0 to layout.ParagraphCount-1 do + layout.ParagraphAlignment[i] := AAlign; + layout.ParagraphSpacingBelow:= AParagraphSpacing; + layout.AvailableWidth := AWidth; + case AVertAlign of + tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight); + tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2); + else layout.TopLeft := PointF(ALeft,ATop); + end; + layout.DrawText(self, c); + layout.Free; +end; + +procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; + const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment; + AVertAlign: TTextLayout; AParagraphSpacing: single); +var + layout: TBidiTextLayout; + i: Integer; +begin + if FontBidiMode = fbmAuto then + layout := TBidiTextLayout.Create(FontRenderer, sUTF8) + else + layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); + for i := 0 to layout.ParagraphCount-1 do + layout.ParagraphAlignment[i] := AAlign; + layout.ParagraphSpacingBelow:= AParagraphSpacing; + layout.AvailableWidth := AWidth; + case AVertAlign of + tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight); + tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2); + else layout.TopLeft := PointF(ALeft,ATop); + end; + layout.DrawText(self, ATexture); + layout.Free; +end; + +procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; + texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); +begin + FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),texture,align, ARightToLeft); +end; + +procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; + AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); +begin + InternalTextOutLetterSpacing(x, y, sUTF8, AColor, nil, AAlign, ALetterSpacing); +end; + +procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; + ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); +begin + InternalTextOutLetterSpacing(x, y, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing); +end; + +procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; + c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); +begin + with (PointF(x,y)-GetFontAnchorRotatedOffset) do + FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align, ARightToLeft); +end; + +procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; + const sUTF8: string; style: TTextStyle; c: TBGRAPixel); +begin + with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do + FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,c); +end; + +procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; const sUTF8: string; + style: TTextStyle; texture: IBGRAScanner); +begin + with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do + FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,texture); +end; + +{ Returns the total size of the string provided using the current font. + Orientation is not taken into account, so that the width is along the text. } +function TBGRADefaultBitmap.TextSize(const sUTF8: string): TSize; +begin + result := FontRenderer.TextSize(CleanTextOutString(sUTF8)); +end; + +function TBGRADefaultBitmap.TextSizeMultiline(const sUTF8: string; AMaxWidth: single; + AParagraphSpacing: single): TSize; +var + layout: TBidiTextLayout; +begin + if FontBidiMode = fbmAuto then + layout := TBidiTextLayout.Create(FontRenderer, sUTF8) + else + layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); + layout.ParagraphSpacingBelow:= AParagraphSpacing; + layout.AvailableWidth := AMaxWidth; + result := size(ceil(layout.UsedWidth), ceil(layout.TotalTextHeight)); + layout.Free; +end; + +function TBGRADefaultBitmap.TextAffineBox(const sUTF8: string): TAffineBox; +var size: TSize; + m: TAffineMatrix; + dy: single; +begin + dy := GetFontVerticalAnchorOffset; + size := FontRenderer.TextSizeAngle(sUTF8, FontOrientation); + m := AffineMatrixRotationDeg(-FontOrientation*0.1); + result := TAffineBox.AffineBox(PointF(0,-dy), m*PointF(size.cx,-dy), m*PointF(0,size.cy-dy)); +end; + +function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer): TSize; +begin + result := FontRenderer.TextSize(sUTF8, AMaxWidth, GetFontRightToLeftFor(sUTF8)); +end; + +function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer; + ARightToLeft: boolean): TSize; +begin + result := FontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft); +end; + +function TBGRADefaultBitmap.TextFitInfo(const sUTF8: string; AMaxWidth: integer + ): integer; +begin + result := FontRenderer.TextFitInfo(sUTF8, AMaxWidth); +end; + +{---------------------------- Curves ----------------------------------------} + +function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; +begin + result := BGRAPath.ComputeClosedSpline(APoints, AStyle); +end; + +function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; +begin + result := BGRAPath.ComputeOpenedSpline(APoints, AStyle); +end; + +function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve + ): ArrayOfTPointF; +begin + Result:= BGRAPath.ComputeBezierCurve(ACurve); +end; + +function TBGRADefaultBitmap.ComputeBezierCurve( + const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; +begin + Result:= BGRAPath.ComputeBezierCurve(ACurve); +end; + +function TBGRADefaultBitmap.ComputeBezierSpline( + const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; +begin + Result:= BGRAPath.ComputeBezierSpline(ASpline); +end; + +function TBGRADefaultBitmap.ComputeBezierSpline( + const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; +begin + Result:= BGRAPath.ComputeBezierSpline(ASpline); +end; + +function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF; + w: single): ArrayOfTPointF; +begin + result := GetInternalPen.ComputePolyline(points,w); +end; + +function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF; + w: single; ClosedCap: boolean): ArrayOfTPointF; +begin + result := GetInternalPen.ComputePolyline(points,w,ClosedCap); +end; + +function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF; + w: single): ArrayOfTPointF; +begin + result := GetInternalPen.ComputePolygon(points,w); +end; + +function TBGRADefaultBitmap.ComputeEllipseContour(x, y, rx, ry: single; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeEllipse(x,y,rx,ry, quality); +end; + +function TBGRADefaultBitmap.ComputeEllipseContour(AOrigin, AXAxis, + AYAxis: TPointF; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis, quality); +end; + +function TBGRADefaultBitmap.ComputeEllipseBorder(x, y, rx, ry, w: single; quality: single): ArrayOfTPointF; +begin + result := ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry, quality),w); +end; + +function TBGRADefaultBitmap.ComputeEllipseBorder(AOrigin, AXAxis, + AYAxis: TPointF; w: single; quality: single): ArrayOfTPointF; +begin + result := ComputeWidePolygon(ComputeEllipseContour(AOrigin,AXAxis,AYAxis, quality),w); +end; + +function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536, + end65536: word; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality); +end; + +function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad, + endRad: single; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeArcRad(x,y,rx,ry,startRad,endRad,quality); +end; + +function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,quality); +end; + +function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; + options: TRoundRectangleOptions; quality: single): ArrayOfTPointF; +begin + Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options,quality); +end; + +function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536, + end65536: word; quality: single): ArrayOfTPointF; +begin + result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality); + if (start65536 <> end65536) then + begin + setlength(result,length(result)+1); + result[high(result)] := PointF(x,y); + end; +end; + +function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad, + endRad: single; quality: single): ArrayOfTPointF; +begin + result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi),quality); +end; + +{---------------------------------- Fill ---------------------------------} + +procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel; start, Count: integer); +begin + if start < 0 then + begin + inc(Count, start); + start := 0; + end; + if start >= nbPixels then + exit; + if start + Count > nbPixels then + Count := nbPixels - start; + + FillInline(Data + start, c, Count); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer); +begin + if alpha = 0 then + Fill(BGRAPixelTransparent, start, Count); + if start < 0 then + begin + inc(Count, start); + start := 0; + end; + if start >= nbPixels then + exit; + if start + Count > nbPixels then + Count := nbPixels - start; + + AlphaFillInline(Data + start, alpha, Count); + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap; + const AColor: TBGRAPixel; ADrawMode: TDrawMode); +var + scan: TBGRACustomScanner; +begin + if (AMask = nil) or (AColor.alpha = 0) then exit; + scan := TBGRASolidColorMaskScanner.Create(AMask, Point(-X,-Y), AColor); + self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode); + scan.Free; +end; + +procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap; + ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); +var + scan: TBGRACustomScanner; +begin + if AMask = nil then exit; + scan := TBGRATextureMaskScanner.Create(AMask, Point(-X,-Y), ATexture, AOpacity); + self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode); + scan.Free; +end; + +procedure TBGRADefaultBitmap.EraseMask(x, y: integer; AMask: TBGRACustomBitmap; + alpha: byte); +var + x0,y0,x2, y2, yb,xb, tx, delta: integer; + p, psrc: PBGRAPixel; +begin + if (AMask = nil) or (alpha = 0) then exit; + x0 := x; + y0 := y; + x2 := x+AMask.Width; + y2 := y+AMask.Height; + if not CheckClippedRectBounds(x,y,x2,y2) then exit; + tx := x2 - x; + Dec(x2); + Dec(y2); + + p := Scanline[y] + x; + if FLineOrder = riloBottomToTop then + delta := -Width + else + delta := Width; + + for yb := y to y2 do + begin + psrc := AMask.ScanLine[yb-y0]+(x-x0); + if alpha = 255 then + begin + for xb := tx-1 downto 0 do + begin + ErasePixelInline(p, psrc^.green); + inc(p); + inc(psrc); + end; + end else + begin + for xb := tx-1 downto 0 do + begin + ErasePixelInline(p, ApplyOpacity(psrc^.green,alpha)); + inc(p); + inc(psrc); + end; + end; + dec(p, tx); + Inc(p, delta); + end; + + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer; + AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean); +begin + BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder); +end; + +procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer; + AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean); +begin + BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder); +end; + +{ Replace color without taking alpha channel into account } +procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor); +var + p: PLongWord; + n: integer; + colorMask,beforeBGR, afterBGR: LongWord; + rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte; +begin + colorMask := LongWord(BGRA(255,255,255,0)); + RedGreenBlue(before, rBefore,gBefore,bBefore); + RedGreenBlue(after, rAfter,gAfter,bAfter); + beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0)); + afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0)); + + p := PLongWord(Data); + for n := NbPixels - 1 downto 0 do + begin + if p^ and colorMask = beforeBGR then + p^ := (p^ and not ColorMask) or afterBGR; + Inc(p); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before, after: TColor); +var p: PLongWord; + xb,yb,xcount: integer; + + colorMask,beforeBGR, afterBGR: LongWord; + rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte; +begin + colorMask := LongWord(BGRA(255,255,255,0)); + RedGreenBlue(before, rBefore,gBefore,bBefore); + RedGreenBlue(after, rAfter,gAfter,bAfter); + beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0)); + afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0)); + + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + xcount := ABounds.Right-ABounds.Left; + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + p := PLongWord(ScanLine[yb]+ABounds.Left); + for xb := xcount-1 downto 0 do + begin + if p^ and colorMask = beforeBGR then + p^ := (p^ and not ColorMask) or afterBGR; + Inc(p); + end; + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer; + Dest: TCustomUniversalBitmap; Color: TBGRAPixel; mode: TFloodfillMode; + Tolerance: byte; DestOfsX: integer; DestOfsY: integer); +var + b: TUniversalBrush; +begin + case mode of + fmSet: Dest.SolidBrushBGRA(b, Color, dmSet); + fmDrawWithTransparency: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency); + fmLinearBlend: Dest.SolidBrushBGRA(b, Color, dmLinearBlend); + fmXor: Dest.SolidBrushBGRA(b, Color, dmXor); + fmProgressive: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency); + end; + ParallelFloodFill(X,Y, Dest, b, mode=fmProgressive, (Tolerance shl 8)+$ff, DestOfsX, DestOfsY); +end; + +{ General purpose FloodFill. It can be used to fill inplace or to + fill a destination bitmap according to the content of the current bitmap. + + The first pixel encountered is taken as a reference, further pixels + are compared to this pixel. If the distance between next colors and + the first color is lower than the tolerance, then the floodfill continues. + + It uses an array of bits to store visited places to avoid filling twice + the same area. It also uses a stack of positions to remember where + to continue after a place is completely filled. + + The first direction to be checked is horizontal, then + it checks pixels on the line above and on the line below. } +procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer; + Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; Progressive: boolean; + ToleranceW: Word; DestOfsX: integer; DestOfsY: integer); +var + S: TBGRAPixel; + SExpand: TExpandedPixel; + SX, EX, I: integer; + Added: boolean; + + Visited: array of LongWord; + VisitedLineSize: integer; + + Stack: array of integer; + StackCount: integer; + pScan: PBGRAPixel; + + function CheckPixel(AX, AY: integer): boolean; inline; + begin + if Visited[AX shr 5 + AY * VisitedLineSize] and (1 shl (AX and 31)) <> 0 then + Result := False + else + begin + if (pScan+AX)^ = S then result := true else + Result := ExpandedDiff(GammaExpansion((pScan+AX)^), SExpand) <= ToleranceW; + end; + end; + + procedure SetVisited(X1, AY, X2: integer); + var + StartMask, EndMask: LongWord; + StartPos, EndPos: integer; + begin + if X2 < X1 then + exit; + StartMask := $FFFFFFFF shl (X1 and 31); + case X2 and 31 of + 31: EndMask := $FFFFFFFF; + 30: EndMask := $7FFFFFFF; + else + EndMask := 1 shl ((X2 and 31) + 1) - 1; + end; + StartPos := X1 shr 5 + AY * VisitedLineSize; + EndPos := X2 shr 5 + AY * VisitedLineSize; + if StartPos = EndPos then + Visited[StartPos] := Visited[StartPos] or (StartMask and EndMask) + else + begin + Visited[StartPos] := Visited[StartPos] or StartMask; + Visited[EndPos] := Visited[EndPos] or EndMask; + if EndPos - StartPos > 1 then + FillDWord(Visited[StartPos + 1], EndPos - StartPos - 1, $FFFFFFFF); + end; + end; + + procedure Push(AX, AY: integer); inline; + begin + if StackCount + 1 >= High(Stack) then + SetLength(Stack, Length(Stack) shl 1); + + Stack[StackCount] := AX; + Inc(StackCount); + Stack[StackCount] := AY; + Inc(StackCount); + end; + + procedure Pop(var AX, AY: integer); inline; + begin + Dec(StackCount); + AY := Stack[StackCount]; + Dec(StackCount); + AX := Stack[StackCount]; + end; + +begin + if Brush.DoesNothing then exit; + if Progressive and not (dest is TBGRACustomBitmap) then + raise exception.Create('Progressive mode only available on TBGRACustomBitmap and derived classes'); + if PtInClipRect(X,Y) then + begin + S := GetPixel(X, Y); + SExpand := s.ToExpanded; + + VisitedLineSize := (Width + 31) shr 5; + SetLength(Visited, VisitedLineSize * Height); + FillDWord(Visited[0], Length(Visited), 0); + + SetLength(Stack, 2); + StackCount := 0; + + Push(X, Y); + repeat + Pop(X, Y); + pScan := GetScanlineFast(Y); + if not CheckPixel(X, Y) then + Continue; + + SX := X; + while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do + Dec(SX); + EX := X; + while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do + Inc(EX); + + SetVisited(SX, Y, EX); + if Progressive then + TBGRACustomBitmap(dest).HorizLineDiff(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush, S, ToleranceW) + else + dest.HorizLine(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush); + + Added := False; + if Y > FClipRect.Top then + begin + pScan := GetScanlineFast(Pred(Y)); + for I := SX to EX do + if CheckPixel(I, Pred(Y)) then + begin + if Added then //do not add twice the same segment + Continue; + Push(I, Pred(Y)); + Added := True; + end + else + Added := False; + end; + + Added := False; + if Y < Pred(FClipRect.Bottom) then + begin + pScan := GetScanlineFast(Succ(Y)); + for I := SX to EX do + if CheckPixel(I, Succ(Y)) then + begin + if Added then //do not add twice the same segment + Continue; + Push(I, Succ(Y)); + Added := True; + end + else + Added := False; + end; + until StackCount <= 0; + end; +end; + +procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer; + c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); +var + scanner: TBGRAGradientScanner; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + FillRect(x, y, x2, y2, BGRAPixelTransparent, mode) + else + if ditherAlgo <> daNearestNeighbor then + GradientFillDithered(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus,ditherAlgo) + else + begin + scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus); + FillRect(x,y,x2,y2,scanner,mode); + scanner.Free; + end; +end; + +procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer; + gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF; + mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); +var + scanner: TBGRAGradientScanner; +begin + if ditherAlgo <> daNearestNeighbor then + GradientFillDithered(x,y,x2,y2,gradient,gtype,o1,o2,mode,sinus,ditherAlgo) + else + begin + scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus); + FillRect(x,y,x2,y2,scanner,mode); + scanner.Free; + end; +end; + +procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; c1, + c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; + mode: TDrawMode; gammaColorCorrection: boolean; Sinus: Boolean; + ditherAlgo: TDitheringAlgorithm); +var + scanner: TBGRAGradientScanner; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + begin + if mode = dmSet then + FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet); + end + else + begin + scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus); + FillRect(x,y,x2,y2,scanner,mode,ditherAlgo); + scanner.Free; + end; +end; + +procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; + gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF; + mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); +var + scanner: TBGRAGradientScanner; +begin + scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus); + FillRect(x,y,x2,y2,scanner,mode,ditherAlgo); + scanner.Free; +end; + +function TBGRADefaultBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FScanHeight))+PositiveMod(X+ScanOffset.X, FScanWidth))^ + else + result := BGRAPixelTransparent; +end; + +function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + begin + result := PBGRAPixel(FScanPtr)^; + inc(FScanCurX); + inc(FScanPtr, sizeof(TBGRAPixel)); + if FScanCurX = FScanWidth then //cycle + begin + FScanCurX := 0; + dec(FScanPtr, FRowSize); + end; + end + else + result := BGRAPixelTransparent; +end; + +function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + if (FScanWidth = 0) or (FScanHeight = 0) then + begin + result := BGRAPixelTransparent; + exit; + end; + LoadFromBitmapIfNeeded; + ix := round(x*256); + iy := round(y*256); + if ScanInterpolationFilter = rfBox then + begin + ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; + iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; + result := (GetScanlineFast(iy)+ix)^; + exit; + end; + iFactX := ix and 255; + iFactY := iy and 255; + ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; + iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; + if (iFactX = 0) and (iFactY = 0) then + begin + result := (GetScanlineFast(iy)+ix)^; + exit; + end; + if ScanInterpolationFilter <> rfLinear then + begin + iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); + iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); + end; + result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); +end; + +function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean; +begin + Result:= true; +end; + +procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +var + i,nbCopy: Integer; + c: TBGRAPixel; +begin + if (FScanWidth <= 0) or (FScanHeight <= 0) then + begin + if mode = dmSet then + FillDWord(pdest^, count, LongWord(BGRAPixelTransparent)); + exit; + end; + case mode of + dmLinearBlend: + for i := 0 to count-1 do + begin + FastBlendPixelInline(pdest, ScanNextPixel); + inc(pdest); + end; + dmDrawWithTransparency: + for i := 0 to count-1 do + begin + DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel); + inc(pdest); + end; + dmSet: + while count > 0 do + begin + nbCopy := FScanWidth-FScanCurX; + if count < nbCopy then nbCopy := count; + move(FScanPtr^,pdest^,nbCopy*sizeof(TBGRAPixel)); + inc(pdest,nbCopy); + inc(FScanCurX,nbCopy); + inc(FScanPtr,nbCopy*sizeof(TBGRAPixel)); + if FScanCurX = FScanWidth then + begin + FScanCurX := 0; + dec(FScanPtr, RowSize); + end; + dec(count,nbCopy); + end; + dmSetExceptTransparent: + for i := 0 to count-1 do + begin + c := ScanNextPixel; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + end; + dmXor: + for i := 0 to count-1 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(ScanNextPixel); + inc(pdest); + end; + end; +end; + +{ General purpose pixel drawing function } +procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer); +var + p: PBGRAPixel; +begin + if c.alpha = 0 then + exit; + if c.alpha = 255 then + begin + Fill(c,start,Count); + exit; + end; + + if start < 0 then + begin + inc(Count, start); + start := 0; + end; + if start >= nbPixels then + exit; + if start + Count > nbPixels then + Count := nbPixels - start; + + p := Data + start; + DrawPixelsInline(p,c,Count); + InvalidateBitmap; +end; + +{------------------------- End fill ------------------------------} + +procedure TBGRADefaultBitmap.DoAlphaCorrection; +var + p: PBGRAPixel; + n: integer; + colormask: LongWord; + changed: boolean; +begin + if CanvasAlphaCorrection then + begin + p := PBGRAPixel(FDataByte); // avoid Data to avoid reloading from bitmap and thus stack overflow + colormask := $ffffffff - (255 shl TBGRAPixel_AlphaShift); + changed := false; + for n := NbPixels - 1 downto 0 do + begin + if (plongword(p)^ and colormask <> 0) and (p^.alpha = 0) then + begin + p^.alpha := FCanvasOpacity; + changed := true; + end; + Inc(p); + end; + if changed then InvalidateBitmap; + end; + FAlphaCorrectionNeeded := False; +end; + +{ Ensure that transparent pixels have all channels to zero } +procedure TBGRADefaultBitmap.ClearTransparentPixels; +var + p: PBGRAPixel; + n: integer; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if (p^.alpha = 0) then + p^ := BGRAPixelTransparent; + Inc(p); + end; + InvalidateBitmap; +end; + +function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single; + w: single): boolean; +var + temp: Single; +begin + if (x > x2) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (y > y2) then + begin + temp := y; + y := y2; + y2 := temp; + end; + + result := (x2 - x > w) and (y2 - y > w); +end; + +function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas; +begin + if FCanvasBGRA = nil then + FCanvasBGRA := TBGRACanvas.Create(self); + result := FCanvasBGRA; +end; + +function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D; +begin + if FCanvas2D = nil then + FCanvas2D := TBGRACanvas2D.Create(self); + result := FCanvas2D; +end; + +procedure TBGRADefaultBitmap.PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; + AMode: TDrawMode; AOpacity: byte); +begin + inherited PutImage(X,Y, ASource, AMode, AOpacity); + if (AMode in [dmSetExceptTransparent,dmDrawWithTransparency,dmLinearBlend]) and + (ASource is TBGRACustomBitmap) and Assigned(TBGRACustomBitmap(ASource).XorMask) then + PutImage(X,Y,TBGRACustomBitmap(ASource).XorMask,dmXor,AOpacity); +end; + +procedure TBGRADefaultBitmap.BlendImage(x, y: integer; ASource: TBGRACustomBitmap; + AOperation: TBlendOperation); +begin + BlendImage(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y,AOperation); +end; + +procedure TBGRADefaultBitmap.BlendImage(ADest: TRect; ASource: IBGRAScanner; + AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); +const BufSize = 8; +var + yb, remain, i, delta_dest: integer; + psource, pdest: PBGRAPixel; + sourceRect: TRect; + sourceScanline, sourcePut: boolean; + buf: packed array[0..BufSize-1] of TBGRAPixel; +begin + if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; + + sourceRect := ADest; + sourceRect.Offset(AOffsetX, AOffsetY); + sourceScanline := ASource.ProvidesScanline(sourceRect); + sourcePut := ASource.IsScanPutPixelsDefined; + + pdest := Scanline[ADest.Top] + ADest.Left; + if LineOrder = riloBottomToTop then + delta_dest := -Width + else delta_dest := Width; + + for yb := sourceRect.Top to sourceRect.Bottom-1 do + begin + if sourceScanline then + begin + psource := ASource.GetScanlineAt(sourceRect.Left, yb); + BlendPixels(pdest, psource, AOperation, ADest.Width); + end else + begin + ASource.ScanMoveTo(sourceRect.Left, yb); + remain := ADest.Width; + if sourcePut then + while remain >= BufSize do + begin + ASource.ScanPutPixels(@buf, BufSize, dmSet); + BlendPixels(pdest, @buf, AOperation, BufSize); + inc(pdest, bufSize); + dec(remain, bufSize); + end; + if remain > 0 then + begin + for i := 0 to remain-1 do + buf[i] := ASource.ScanNextPixel; + BlendPixels(pdest, @buf, AOperation, remain); + inc(pdest, remain); + end; + dec(pdest, ADest.Width); + end; + Inc(pdest, delta_dest); + end; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.BlendImageOver(x, y: integer; + ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean); +begin + BlendImageOver(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y, + AOperation, AOpacity, ALinearBlend); +end; + +procedure TBGRADefaultBitmap.BlendImageOver(ADest: TRect; ASource: IBGRAScanner; + AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean); +const BufSize = 8; +var + yb, remain, i, delta_dest: integer; + psource, pdest: PBGRAPixel; + sourceRect: TRect; + sourceScanline, sourcePut: boolean; + buf: packed array[0..BufSize-1] of TBGRAPixel; +begin + if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; + + sourceRect := ADest; + sourceRect.Offset(AOffsetX, AOffsetY); + sourceScanline := ASource.ProvidesScanline(sourceRect); + sourcePut := ASource.IsScanPutPixelsDefined; + + pdest := Scanline[ADest.Top] + ADest.Left; + if LineOrder = riloBottomToTop then + delta_dest := -Width + else delta_dest := Width; + + for yb := sourceRect.Top to sourceRect.Bottom-1 do + begin + if sourceScanline then + begin + psource := ASource.GetScanlineAt(sourceRect.Left, yb); + BlendPixelsOver(pdest, psource, AOperation, ADest.Width, AOpacity, ALinearBlend); + end else + begin + ASource.ScanMoveTo(sourceRect.Left, yb); + remain := ADest.Width; + if sourcePut then + while remain >= BufSize do + begin + ASource.ScanPutPixels(@buf, BufSize, dmSet); + BlendPixelsOver(pdest, @buf, AOperation, BufSize, AOpacity, ALinearBlend); + inc(pdest, bufSize); + dec(remain, bufSize); + end; + if remain > 0 then + begin + for i := 0 to remain-1 do + buf[i] := ASource.ScanNextPixel; + BlendPixelsOver(pdest, @buf, AOperation, remain, AOpacity, ALinearBlend); + inc(pdest, remain); + end; + dec(pdest, ADest.Width); + end; + Inc(pdest, delta_dest); + end; + InvalidateBitmap; +end; + +{ Draw an image with an affine transformation (rotation, scale, translate). + Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis. + The output bounds correspond to the pixels that will be affected in the destination. } +procedure TBGRADefaultBitmap.PutImageAffine(AMatrix: TAffineMatrix; + Source: TBGRACustomBitmap; AOutputBounds: TRect; + AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte; APixelCenteredCoords: boolean); +var affine: TBGRAAffineBitmapTransform; + sourceBounds: TRect; +begin + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; + AOutputBounds.Intersect(ClipRect); + if AOutputBounds.IsEmpty then exit; + + if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); + if IsAffineRoughlyTranslation(AMatrix, rect(0,0,Source.Width,Source.Height)) then + begin + sourceBounds := AOutputBounds; + sourceBounds.Offset(-round(AMatrix[1,3]), -round(AMatrix[2,3])); + sourceBounds.Intersect( rect(0,0,Source.Width,Source.Height) ); + PutImagePart(round(AMatrix[1,3])+sourceBounds.Left,round(AMatrix[2,3])+sourceBounds.Top,Source,sourceBounds,AMode,AOpacity); + end else + begin + affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter); + affine.GlobalOpacity := AOpacity; + affine.ViewMatrix := AMatrix; + FillRect(AOutputBounds,affine,AMode); + affine.Free; + end; +end; + +function TBGRADefaultBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix; + ASourceBounds: TRect; AClipOutput: boolean; APixelCenteredCoords: boolean): TRect; +const pointMargin = 0.5 - 1/512; + + procedure FirstPoint(pt: TPointF); + begin + result.Left := round(pt.X); + result.Top := round(pt.Y); + result.Right := round(pt.X)+1; + result.Bottom := round(pt.Y)+1; + end; + + //include specified point in the bounds + procedure IncludePoint(pt: TPointF); + begin + if round(pt.X) < result.Left then result.Left := round(pt.X); + if round(pt.Y) < result.Top then result.Top := round(pt.Y); + if round(pt.X)+1 > result.Right then result.Right := round(pt.X)+1; + if round(pt.Y)+1 > result.Bottom then result.Bottom := round(pt.Y)+1; + end; + +begin + result := EmptyRect; + if ASourceBounds.IsEmpty then exit; + + if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); + if IsAffineRoughlyTranslation(AMatrix,ASourceBounds) then + begin + result := ASourceBounds; + result.Offset(round(AMatrix[1,3]), round(AMatrix[2,3])); + end else + begin + FirstPoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Top-pointMargin)); + IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Top-pointMargin)); + IncludePoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Bottom-1+pointMargin)); + IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Bottom-1+pointMargin)); + end; + if AClipOutput then result.Intersect(ClipRect); +end; + +procedure TBGRADefaultBitmap.StretchPutImage(ARect: TRect; + Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte); +var noTransition: boolean; +begin + If (Source = nil) or (AOpacity = 0) then exit; + if (ARect.Right-ARect.Left = Source.Width) and (ARect.Bottom-ARect.Top = Source.Height) then + PutImage(ARect.Left,ARect.Top,Source,mode,AOpacity) + else + begin + noTransition:= (mode = dmXor) or ((mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and + (Source is TBGRADefaultBitmap) and + Assigned(TBGRADefaultBitmap(Source).XorMask)); + BGRAResample.StretchPutImage(Source, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, mode, AOpacity, noTransition); + if (mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and Assigned(TBGRADefaultBitmap(Source).XorMask) then + BGRAResample.StretchPutImage(TBGRADefaultBitmap(Source).XorMask, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, dmXor, AOpacity, noTransition); + end; +end; + +procedure TBGRADefaultBitmap.BlendRect(ADest: TRect; AColor: TBGRAPixel; + AOperation: TBlendOperation; AExcludeChannels: TChannels); +const BufSize = 8; +var srcBuf: packed array[0..BufSize-1] of TBGRAPixel; + i, yb, remain: Integer; + p: PBGRAPixel; +begin + if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; + for i := 0 to BufSize-1 do + srcBuf[i] := AColor; + for yb := ADest.Top to ADest.Bottom-1 do + begin + remain := ADest.Width; + p := PBGRAPixel(GetPixelAddress(ADest.Left, yb)); + while remain >= BufSize do + begin + BlendPixels(p, @srcBuf, AOperation, BufSize, AExcludeChannels); + inc(p, BufSize); + dec(remain, BufSize); + end; + if remain > 0 then + BlendPixels(p, @srcBuf, AOperation, remain, AExcludeChannels); + end; +end; + +procedure TBGRADefaultBitmap.BlendRectOver(ADest: TRect; AColor: TBGRAPixel; + AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; + AExcludeChannels: TChannels); +const BufSize = 8; +var srcBuf: packed array[0..BufSize-1] of TBGRAPixel; + i, yb, remain: Integer; + p: PBGRAPixel; +begin + if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; + for i := 0 to BufSize-1 do + srcBuf[i] := AColor; + for yb := ADest.Top to ADest.Bottom-1 do + begin + remain := ADest.Width; + p := PBGRAPixel(GetPixelAddress(ADest.Left, yb)); + while remain >= BufSize do + begin + BlendPixelsOver(p, @srcBuf, AOperation, BufSize, AOpacity, ALinearBlend, AExcludeChannels); + inc(p, BufSize); + dec(remain, BufSize); + end; + if remain > 0 then + BlendPixelsOver(p, @srcBuf, AOperation, remain, AOpacity, ALinearBlend, AExcludeChannels); + end; +end; + +{----------------------------- Filters -----------------------------------------} +{ Call the appropriate function } + +function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterSmartZoom3(self, Option) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterMedian(self, option) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterSmooth: TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterBlurRadial(self, 3, rbPrecise) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterSphere: TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterSphere(self) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; + ARadius: Single; ATurn: Single; AExponent: Single): TBGRADefaultBitmap; +begin + result := BGRAFilters.FilterTwirl(self, ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterCylinder: TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterCylinder(self) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterPlane: TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterPlane(self) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterSharpen(Amount: single = 1): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterSharpen(self,round(Amount*256)) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterSharpen(ABounds: TRect; Amount: single + ): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterSharpen(self,ABounds,round(Amount*256)) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterContour(self, AGammaCorrection) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer; + useResample: boolean; filter: TResampleFilter): TBGRADefaultBitmap; +begin + Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterEmboss(angle: single; + AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterEmboss(self, angle, AStrength, AOptions) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect; + AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterEmboss(self, angle, ABounds, AStrength, AOptions) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean): +TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BGRAPixelTransparent) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BorderColor) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterEmbossHighlightOffset(self, FillSelection, BorderColor, Offset) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterGrayscale: TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterGrayscale(self) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterGrayscale(self, ABounds) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True): +TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterNormalize(self, eachChannel) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterNormalize(self, ABounds, eachChannel) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterRotate(origin: TPointF; + angle: single; correctBlur: boolean): TBGRADefaultBitmap; +begin + Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur) as TBGRADefaultBitmap; +end; + +function TBGRADefaultBitmap.FilterAffine(AMatrix: TAffineMatrix; + correctBlur: boolean): TBGRADefaultBitmap; +begin + Result := NewBitmap(Width,Height); + Result.PutImageAffine(AMatrix,self,255,correctBlur); +end; + +function TBGRADefaultBitmap.GetHasTransparentPixels: boolean; +var + p: PBGRAPixel; + n: integer; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if p^.alpha <> 255 then + begin + Result := True; + exit; + end; + Inc(p); + end; + Result := False; +end; + +function TBGRADefaultBitmap.GetHasSemiTransparentPixels: boolean; +var + n: integer; + p: PBGRAPixel; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if (p^.alpha > 0) and (p^.alpha < 255) then + begin + result := true; + exit; + end; + inc(p); + end; + result := false; +end; + +function TBGRADefaultBitmap.GetAverageColor: TColor; +var + pix: TBGRAPixel; +begin + pix := GetAveragePixel; + {$hints off} + if pix.alpha = 0 then + result := clNone else + result := RGBToColor(pix.red,pix.green,pix.blue); + {$hints on} +end; + +function TBGRADefaultBitmap.GetAveragePixel: TBGRAPixel; +var + n: integer; + p: PBGRAPixel; + r, g, b, sum: double; + alpha: double; +begin + sum := 0; + r := 0; + g := 0; + b := 0; + p := Data; + for n := NbPixels - 1 downto 0 do + begin + alpha := p^.alpha / 255; + incF(sum, alpha); + incF(r, p^.red * alpha); + incF(g, p^.green * alpha); + incF(b, p^.blue * alpha); + Inc(p); + end; + if sum = 0 then + Result := BGRAPixelTransparent + else + Result := BGRA(round(r / sum),round(g / sum),round(b / sum),round(sum*255/NbPixels)); +end; + +function TBGRADefaultBitmap.GetPenJoinStyle: TPenJoinStyle; +begin + result := GetInternalPen.JoinStyle; +end; + +procedure TBGRADefaultBitmap.SetPenJoinStyle(const AValue: TPenJoinStyle); +begin + GetInternalPen.JoinStyle := AValue; +end; + +function TBGRADefaultBitmap.GetPenMiterLimit: single; +begin + result := GetInternalPen.MiterLimit; +end; + +procedure TBGRADefaultBitmap.SetPenMiterLimit(const AValue: single); +begin + GetInternalPen.MiterLimit := AValue; +end; + +procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte); +begin + LoadFromBitmapIfNeeded; + FCanvasOpacity := AValue; +end; + +{----------------------------- Resample ---------------------------------------} + +function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer): +TBGRACustomBitmap; +begin + Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter); +end; + +function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer): +TBGRACustomBitmap; +begin + Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight); +end; + +function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer; + mode: TResampleMode): TBGRADefaultBitmap; +begin + case mode of + rmFineResample: Result := FineResample(newWidth, newHeight) as TBGRADefaultBitmap; + rmSimpleStretch: Result := SimpleStretch(newWidth, newHeight) as TBGRADefaultBitmap; + else + Result := nil; + end; +end; + +{-------------------------------- Data functions ------------------------} + +{ Compute negative with gamma correction. A negative contains + complentary colors (black becomes white etc.). + + It is NOT EXACTLY an involution, when applied twice, some color information is lost } +procedure TBGRADefaultBitmap.Negative; +begin + TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), True); +end; + +procedure TBGRADefaultBitmap.NegativeRect(ABounds: TRect); +begin + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, True); +end; + +{ Compute negative without gamma correction. + + It is an involution, i.e it does nothing when applied twice } +procedure TBGRADefaultBitmap.LinearNegative; +begin + TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False); +end; + +procedure TBGRADefaultBitmap.LinearNegativeRect(ABounds: TRect); +begin + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, False); +end; + +procedure TBGRADefaultBitmap.InplaceGrayscale(AGammaCorrection: boolean = true); +begin + TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), AGammaCorrection); +end; + +procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); +begin + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, ABounds, AGammaCorrection); +end; + +procedure TBGRADefaultBitmap.InplaceNormalize(AEachChannel: boolean); +begin + InplaceNormalize(rect(0,0,Width,Height),AEachChannel); +end; + +procedure TBGRADefaultBitmap.InplaceNormalize(ABounds: TRect; + AEachChannel: boolean); +var scanner: TBGRAFilterScannerNormalize; +begin + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + scanner := TBGRAFilterScannerNormalize.Create(self,Point(0,0),ABounds,AEachChannel); + FillRect(ABounds,scanner,dmSet); + scanner.Free; +end; + +{ Swap red and blue channels. Useful when RGB order is swapped. + + It is an involution, i.e it does nothing when applied twice } +procedure TBGRADefaultBitmap.SwapRedBlue; +begin + TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False); +end; + +procedure TBGRADefaultBitmap.SwapRedBlue(ARect: TRect); +begin + if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; + TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, ARect, False); +end; + +{ Convert a grayscale image into a black image with alpha value } +procedure TBGRADefaultBitmap.GrayscaleToAlpha; +var + n: integer; + p: PLongword; +begin + LoadFromBitmapIfNeeded; + p := PLongword(Data); + n := NbPixels; + if n = 0 then + exit; + repeat + p^ := (p^ shr TBGRAPixel_RedShift and $FF) shl TBGRAPixel_AlphaShift; + Inc(p); + Dec(n); + until n = 0; + InvalidateBitmap; +end; + +procedure TBGRADefaultBitmap.AlphaToGrayscale; +var + n: integer; + temp: LongWord; + p: PLongword; +begin + LoadFromBitmapIfNeeded; + p := PLongword(Data); + n := NbPixels; + if n = 0 then + exit; + repeat + temp := (p^ shr TBGRAPixel_AlphaShift) and $ff; + p^ := (temp shl TBGRAPixel_RedShift) or (temp shl TBGRAPixel_GreenShift) + or (temp shl TBGRAPixel_BlueShift) or ($ff shl TBGRAPixel_AlphaShift); + Inc(p); + Dec(n); + until n = 0; + InvalidateBitmap; +end; + +function TBGRADefaultBitmap.GetMaskFromAlpha: TBGRADefaultBitmap; +var y,x: integer; + psrc, pdest: PBGRAPixel; +begin + result := BGRABitmapFactory.Create(Width,Height) as TBGRADefaultBitmap; + for y := 0 to self.Height-1 do + begin + psrc := self.ScanLine[y]; + pdest := result.ScanLine[y]; + for x := 0 to self.Width-1 do + begin + pdest^ := BGRA(psrc^.alpha,psrc^.alpha,psrc^.alpha); + inc(psrc); + inc(pdest); + end; + end; +end; + +function TBGRADefaultBitmap.GetGrayscaleMaskFromAlpha: TGrayscaleMask; +var + psrc: PBGRAPixel; + pdest: PByte; + y, x: Integer; +begin + result := TGrayscaleMask.Create; + result.SetSize(Width,Height); + for y := 0 to self.Height-1 do + begin + psrc := self.ScanLine[y]; + pdest := result.ScanLine[y]; + for x := 0 to self.Width-1 do + begin + pdest^ := psrc^.alpha; + inc(psrc); + inc(pdest); + end; + end; +end; + +procedure TBGRADefaultBitmap.ConvertToLinearRGB; +var p: PBGRAPixel; + n: integer; +begin + p := Data; + for n := NbPixels-1 downto 0 do + begin + p^.red := GammaExpansionTab[p^.red] shr 8; + p^.green := GammaExpansionTab[p^.green] shr 8; + p^.blue := GammaExpansionTab[p^.blue] shr 8; + inc(p); + end; +end; + +procedure TBGRADefaultBitmap.ConvertFromLinearRGB; +var p: PBGRAPixel; + n: integer; +begin + p := Data; + for n := NbPixels-1 downto 0 do + begin + p^.red := GammaCompressionTab[p^.red shl 8 + p^.red]; + p^.green := GammaCompressionTab[p^.green shl 8 + p^.green]; + p^.blue := GammaCompressionTab[p^.blue shl 8 + p^.blue]; + inc(p); + end; +end; + +{ Make a copy of the transparent bitmap to a TBitmap with a background color + instead of transparency } +function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap; +var + opaqueCopy: TBGRACustomBitmap; +begin + Result := TBitmap.Create; + Result.Width := Width; + Result.Height := Height; + opaqueCopy := NewBitmap(Width, Height); + opaqueCopy.Fill(BackgroundColor); + opaqueCopy.PutImage(0, 0, self, dmDrawWithTransparency); + opaqueCopy.Draw(Result.canvas, 0, 0, True); + opaqueCopy.Free; +end; + +function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer + ): TBGRACustomBitmap; +var temp: integer; + ptrbmp: TBGRAPtrBitmap; +begin + if Top > Bottom then + begin + temp := Top; + Top := Bottom; + Bottom := Temp; + end; + if Top < 0 then Top := 0; + if Bottom > Height then Bottom := Height; + if Top >= Bottom then + result := nil + else + begin + if LineOrder = riloTopToBottom then + ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Top]) else + ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Bottom-1]); + ptrbmp.LineOrder := LineOrder; + result := ptrbmp; + end; +end; + +{-------------------------- Allocation routines -------------------------------} + +function TBGRADefaultBitmap.CreatePtrBitmap(AWidth, AHeight: integer; + AData: PBGRAPixel): TBGRAPtrBitmap; +begin + result := TBGRAPtrBitmap.Create(AWidth,AHeight,AData); +end; + +procedure TBGRADefaultBitmap.FreeBitmap; +begin + FreeAndNil(FBitmap); +end; + +function TBGRADefaultBitmap.GetCanvasOpacity: byte; +begin + result:= FCanvasOpacity; +end; + +function TBGRADefaultBitmap.GetFontHeight: integer; +begin + result := FFontHeight; +end; + +{ TBGRAPtrBitmap } + +function TBGRAPtrBitmap.GetLineOrder: TRawImageLineOrder; +begin + result := inherited GetLineOrder; +end; + +procedure TBGRAPtrBitmap.SetLineOrder(AValue: TRawImageLineOrder); +begin + inherited SetLineOrder(AValue); +end; + +procedure TBGRAPtrBitmap.ReallocData; +begin + //nothing +end; + +procedure TBGRAPtrBitmap.FreeData; +begin + FDataByte := nil; +end; + +procedure TBGRAPtrBitmap.CannotResize; +begin + raise exception.Create('A pointer bitmap cannot be resized'); +end; + +procedure TBGRAPtrBitmap.NotImplemented; +begin + raise exception.Create('Not implemented'); +end; + +procedure TBGRAPtrBitmap.RebuildBitmap; +begin + NotImplemented; +end; + +function TBGRAPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := nil; + NotImplemented; +end; + +function TBGRAPtrBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +begin + result := false; + NotImplemented; +end; + +constructor TBGRAPtrBitmap.Create(AWidth, AHeight: integer; AData: Pointer); +begin + inherited Create(AWidth, AHeight); + SetDataPtr(AData); +end; + +procedure TBGRAPtrBitmap.SetDataPtr(AData: Pointer); +begin + FDataByte := AData; +end; + +procedure TBGRAPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + NotImplemented; +end; + +procedure TBGRAPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + NotImplemented; +end; + +procedure TBGRAPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer + ); +begin + NotImplemented; +end; + +procedure TBGRAPtrBitmap.Assign(Source: TPersistent); +begin + CannotResize; +end; + +procedure TBGRAPtrBitmap.TakeScreenshot(ARect: TRect); +begin + CannotResize; +end; + +procedure TBGRAPtrBitmap.TakeScreenshotOfPrimaryMonitor; +begin + CannotResize; +end; + +procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC); +begin + NotImplemented; +end; + +procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC; ARect: TRect); +begin + NotImplemented; +end; + +procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer; + c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; + gammaColorCorrection: boolean = True; Sinus: Boolean=False); +begin + bmp.GradientFill(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus); +end; + +initialization + + with DefaultTextStyle do + begin + Alignment := taLeftJustify; + Layout := tlTop; + WordBreak := True; + SingleLine := True; + Clipping := True; + ShowPrefix := False; + Opaque := False; + end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgradithering.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgradithering.pas new file mode 100644 index 0000000..91b532f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgradithering.pas @@ -0,0 +1,761 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRADithering; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAFilterType, BGRAPalette, BGRABitmapTypes; + +type + TOutputPixelProc = procedure(X,Y: Int32or64; AColorIndex: Int32or64; AColor: TBGRAPixel) of object; + + { TDitheringTask } + + TDitheringTask = class(TFilterTask) + protected + FBounds: TRect; + FIgnoreAlpha: boolean; + FPalette: TBGRACustomApproxPalette; + FCurrentOutputScanline: PBGRAPixel; + FCurrentOutputY: Int32or64; + FOutputPixel : TOutputPixelProc; + FDrawMode: TDrawMode; + procedure UpdateCurrentLine(Y: Int32or64); inline; + procedure OutputPixel(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure OutputPixelSet(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure OutputPixelSetExceptTransparent(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure OutputPixelLinearBlend(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure OutputPixelDraw(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure OutputPixelXor(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; + procedure ApproximateColor(const AColor: TBGRAPixel; out AApproxColor: TBGRAPixel; out AIndex: integer); + procedure SetDrawMode(AValue: TDrawMode); + procedure UpdateOutputPixel; + public + constructor Create(ASource: IBGRAScanner; APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; AIgnoreAlpha: boolean; ABounds: TRect); overload; + constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; ABounds: TRect); overload; + constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); overload; + property OnOutputPixel: TOutputPixelProc read FOutputPixel write FOutputPixel; + property DrawMode: TDrawMode read FDrawMode write SetDrawMode; + end; + + { TNearestColorTask } + + TNearestColorTask = class(TDitheringTask) + protected + procedure DoExecute; override; + end; + + { TFloydSteinbergDitheringTask } + + TFloydSteinbergDitheringTask = class(TDitheringTask) + protected + procedure DoExecute; override; + end; + + { TDitheringToIndexedImage } + + TDitheringToIndexedImage = class + protected + FBitOrder: TRawImageBitOrder; + FByteOrder: TRawImageByteOrder; + FBitsPerPixel: integer; + FLineOrder: TRawImageLineOrder; + FPalette: TBGRACustomApproxPalette; + FIgnoreAlpha: boolean; + FTransparentColorIndex: Int32or64; + + //following variables are used during dithering + FCurrentScanlineSize: PtrInt; + FCurrentData: PByte; + FCurrentOutputY: Int32or64; + FCurrentOutputScanline: PByte; + FCurrentBitOrderMask: Int32or64; + FCurrentMaxY: Int32or64; + + procedure SetPalette(AValue: TBGRACustomApproxPalette); + procedure SetIgnoreAlpha(AValue: boolean); + procedure SetLineOrder(AValue: TRawImageLineOrder); + procedure SetBitOrder(AValue: TRawImageBitOrder); virtual; + procedure SetBitsPerPixel(AValue: integer); virtual; + procedure SetByteOrder(AValue: TRawImageByteOrder); virtual; + procedure OutputPixelSubByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual; + procedure OutputPixelFullByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual; + function GetScanline(Y: Int32or64): Pointer; virtual; + function GetTransparentColorIndex: integer; + procedure SetTransparentColorIndex(AValue: integer); + public + constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); overload; //use platform byte order + constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; AByteOrder: TRawImageByteOrder); overload; //maybe necessary if larger than 8 bits per pixel + + function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap): Pointer; overload; //use minimum scanline size + function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; overload; + procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer); overload; //use minimum scanline size + procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); overload; + function ComputeMinimumScanlineSize(AWidthInPixels: integer): PtrInt; + function AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): pointer; + + //optional customization of format + property BitsPerPixel: integer read FBitsPerPixel write SetBitsPerPixel; + property BitOrder: TRawImageBitOrder read FBitOrder write SetBitOrder; + property ByteOrder: TRawImageByteOrder read FByteOrder write SetByteOrder; + property LineOrder: TRawImageLineOrder read FLineOrder write SetLineOrder; + + property Palette: TBGRACustomApproxPalette read FPalette write SetPalette; + property IgnoreAlpha: boolean read FIgnoreAlpha write SetIgnoreAlpha; + + //when there is no transparent color in the palette, or that IgnoreAlpha is set to True, + //this allows to define the index for the fully transparent color + property DefaultTransparentColorIndex: integer read GetTransparentColorIndex write SetTransparentColorIndex; + end; + +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; + AIgnoreAlpha: boolean): TDitheringTask; overload; +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; + AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload; +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect): TDitheringTask; overload; +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; + AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload; + +function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; + +implementation + +uses BGRABlend; + +function AbsRGBADiff(const c1, c2: TExpandedPixel): Int32or64; +begin + result := abs(c1.alpha-c2.alpha); + inc(result, abs(c1.red-c2.red) ); + inc(result, abs(c1.green-c2.green) ); + inc(result, abs(c1.blue-c2.blue) ); +end; + +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; + AIgnoreAlpha: boolean): TDitheringTask; +begin + result := CreateDitheringTask(AAlgorithm, ABitmap, APalette, AIgnoreAlpha, rect(0,0,ABitmap.width, ABitmap.Height)); +end; + +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; + AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; +begin + result := nil; + case AAlgorithm of + daNearestNeighbor: result := TNearestColorTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds); + daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds); + else raise exception.Create('Unknown algorithm'); + end; +end; + +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; + ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect + ): TDitheringTask; +begin + result := CreateDitheringTask(AAlgorithm, ASource, ADestination, nil, true, ABounds); +end; + +function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; + ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; + APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABounds: TRect + ): TDitheringTask; +begin + result := nil; + case AAlgorithm of + daNearestNeighbor: result := TNearestColorTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds); + daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds); + else raise exception.Create('Unknown algorithm'); + end; +end; + +function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; +var + palette16bit: TBGRA16BitPalette; + dither: TDitheringTask; +begin + palette16bit := TBGRA16BitPalette.Create; + dither := CreateDitheringTask(AAlgorithm, ABitmap, palette16bit, false); + result := dither.Execute; + dither.Free; + palette16bit.Free; +end; + +{ TDitheringToIndexedImage } + +procedure TDitheringToIndexedImage.SetBitsPerPixel(AValue: integer); +begin + if not (AValue in [1,2,4,8,16,32]) then + raise exception.Create('Invalid value for bits per pixel. Allowed values: 1,2,4,8,16,32.'); + if FBitsPerPixel=AValue then Exit; + FBitsPerPixel:=AValue; +end; + +procedure TDitheringToIndexedImage.SetByteOrder(AValue: TRawImageByteOrder); +begin + if FByteOrder=AValue then Exit; + FByteOrder:=AValue; +end; + +procedure TDitheringToIndexedImage.OutputPixelSubByte(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +var p: PByte; +begin + if y <> FCurrentOutputY then + begin + FCurrentOutputY := y; + FCurrentOutputScanline := GetScanline(Y); + end; + if AColorIndex = -1 then AColorIndex := FTransparentColorIndex; + case FBitsPerPixel of + 1: begin + p := FCurrentOutputScanline+(x shr 3); + p^ := p^ or ((AColorIndex and 1) shl ((x xor FCurrentBitOrderMask) and 7)); + end; + 2: begin + p := FCurrentOutputScanline+(x shr 2); + p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 3) shl 1)); + end; + 4: begin + p := FCurrentOutputScanline+(x shr 1); + p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 1) shl 2)); + end; + end; +end; + +procedure TDitheringToIndexedImage.OutputPixelFullByte(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + if y <> FCurrentOutputY then + begin + FCurrentOutputY := y; + FCurrentOutputScanline := GetScanline(Y); + end; + if AColorIndex = -1 then AColorIndex := FTransparentColorIndex; + case FBitsPerPixel of + 8: (FCurrentOutputScanline+x)^ := AColorIndex; + 16: (PWord(FCurrentOutputScanline)+x)^ := AColorIndex; + 32: (PLongWord(FCurrentOutputScanline)+x)^ := AColorIndex; + end; +end; + +function TDitheringToIndexedImage.GetScanline(Y: Int32or64): Pointer; +begin + if FLineOrder = riloTopToBottom then + result := FCurrentData + Y*FCurrentScanlineSize + else + result := FCurrentData + (FCurrentMaxY-Y)*FCurrentScanlineSize +end; + +procedure TDitheringToIndexedImage.SetIgnoreAlpha(AValue: boolean); +begin + if FIgnoreAlpha=AValue then Exit; + FIgnoreAlpha:=AValue; +end; + +procedure TDitheringToIndexedImage.SetTransparentColorIndex(AValue: integer); +begin + if FTransparentColorIndex=AValue then Exit; + FTransparentColorIndex:=AValue; +end; + +function TDitheringToIndexedImage.GetTransparentColorIndex: integer; +begin + result := FTransparentColorIndex; +end; + +procedure TDitheringToIndexedImage.SetPalette(AValue: TBGRACustomApproxPalette); +begin + if FPalette=AValue then Exit; + FPalette:=AValue; +end; + +procedure TDitheringToIndexedImage.SetLineOrder(AValue: TRawImageLineOrder); +begin + if FLineOrder=AValue then Exit; + FLineOrder:=AValue; +end; + +procedure TDitheringToIndexedImage.SetBitOrder(AValue: TRawImageBitOrder); +begin + if FBitOrder=AValue then Exit; + FBitOrder:=AValue; +end; + +constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); +begin + BitsPerPixel:= ABitsPerPixelForIndices; + BitOrder := riboReversedBits; //convention in BMP format + {$IFDEF ENDIAN_LITTLE} + ByteOrder:= riboLSBFirst; + {$ELSE} + ByteOrder:= riboMSBFirst; + {$ENDIF} + Palette := APalette; + IgnoreAlpha:= AIgnoreAlpha; +end; + +constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; + AByteOrder: TRawImageByteOrder); +begin + BitsPerPixel:= ABitsPerPixelForIndices; + BitOrder := riboReversedBits; //convention in BMP format + ByteOrder:= AByteOrder; + Palette := APalette; + IgnoreAlpha:= AIgnoreAlpha; +end; + +function TDitheringToIndexedImage.ComputeMinimumScanlineSize( + AWidthInPixels: integer): PtrInt; +begin + result := (AWidthInPixels*FBitsPerPixel+7) shr 3; +end; + +function TDitheringToIndexedImage.AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; + AScanlineSize: PtrInt): pointer; +var size: integer; +begin + size := AScanlineSize * AImage.Height; + GetMem(result, size); + Fillchar(result^, size, 0); +end; + +function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm; + AImage: TBGRACustomBitmap): Pointer; +begin + result := DitherImage(AAlgorithm, AImage, ComputeMinimumScanlineSize(AImage.Width)); +end; + +procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm; + AImage: TBGRACustomBitmap; AData: Pointer); +begin + DitherImageTo(AAlgorithm, AImage, AData, ComputeMinimumScanlineSize(AImage.Width)); +end; + +function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm; + AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; +begin + result := AllocateSpaceForIndexedData(AImage, AScanlineSize); + DitherImageTo(AAlgorithm, AImage, result, AScanlineSize); +end; + +procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm; + AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); +var ditherTask: TDitheringTask; +begin + FCurrentOutputY := -1; + FCurrentOutputScanline := nil; + FCurrentData := AData; + FCurrentMaxY:= AImage.Height-1; + FCurrentScanlineSize:= AScanlineSize; + + ditherTask := CreateDitheringTask(AAlgorithm, AImage, FPalette, FIgnoreAlpha); + try + ditherTask.Inplace := True; //do not allocate destination + if BitsPerPixel >= 8 then + ditherTask.OnOutputPixel := @OutputPixelFullByte + else + begin + ditherTask.OnOutputPixel:= @OutputPixelSubByte; + if BitOrder = riboBitsInOrder then + FCurrentBitOrderMask := 0 + else + FCurrentBitOrderMask := $ff; + end; + ditherTask.Execute; + finally + ditherTask.Free; + end; +end; + +{ TDitheringTask } + +procedure TDitheringTask.SetDrawMode(AValue: TDrawMode); +begin + if FDrawMode=AValue then Exit; + FDrawMode:=AValue; + UpdateOutputPixel; +end; + +procedure TDitheringTask.UpdateOutputPixel; +begin + case FDrawMode of + dmSet: FOutputPixel := @OutputPixelSet; + dmSetExceptTransparent: FOutputPixel := @OutputPixelSetExceptTransparent; + dmLinearBlend: FOutputPixel := @OutputPixelLinearBlend; + dmXor: FOutputPixel := @OutputPixelXor; + else + {dmDrawWithTransparency} FOutputPixel := @OutputPixelDraw; + end; +end; + +procedure TDitheringTask.UpdateCurrentLine(Y: Int32or64); +begin + if Y <> FCurrentOutputY then + begin + FCurrentOutputY := Y; + FCurrentOutputScanline := Destination.ScanLine[y]; + end; +end; + +procedure TDitheringTask.OutputPixel(X, Y: Int32or64; AColorIndex: Int32or64; + AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + PutPixels(FCurrentOutputScanline+x, @AColor, 1, FDrawMode, 255); +end; + +procedure TDitheringTask.OutputPixelSet(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + (FCurrentOutputScanline+x)^ := AColor; +end; + +procedure TDitheringTask.OutputPixelSetExceptTransparent(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + if AColor.alpha = 255 then (FCurrentOutputScanline+x)^ := AColor; +end; + +procedure TDitheringTask.OutputPixelLinearBlend(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + FastBlendPixelInline(FCurrentOutputScanline+x, AColor); +end; + +procedure TDitheringTask.OutputPixelDraw(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + DrawPixelInlineWithAlphaCheck(FCurrentOutputScanline+x, AColor); +end; + +procedure TDitheringTask.OutputPixelXor(X, Y: Int32or64; + AColorIndex: Int32or64; AColor: TBGRAPixel); +begin + UpdateCurrentLine(y); + PLongWord(FCurrentOutputScanline+x)^ := PLongWord(FCurrentOutputScanline+x)^ xor PLongWord(@AColor)^; +end; + +procedure TDitheringTask.ApproximateColor(const AColor: TBGRAPixel; + out AApproxColor: TBGRAPixel; out AIndex: integer); +begin + if FPalette <> nil then + begin + AIndex := FPalette.FindNearestColorIndex(AColor, FIgnoreAlpha); + if AIndex = -1 then + AApproxColor := BGRAPixelTransparent + else + AApproxColor := FPalette.Color[AIndex]; + end else + begin + if AColor.alpha = 0 then + begin + AApproxColor := BGRAPixelTransparent; + AIndex := -1; + end else + begin + AApproxColor := AColor; + AIndex := 0; + end; + end; +end; + +constructor TDitheringTask.Create(ASource: IBGRAScanner; + APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; + AIgnoreAlpha: boolean; ABounds: TRect); +begin + FPalette := APalette; + SetSource(ASource); + FBounds := ABounds; + FIgnoreAlpha:= AIgnoreAlpha; + FCurrentOutputY := -1; + FCurrentOutputScanline:= nil; + Destination := ADestination; + FDrawMode:= dmSet; + UpdateOutputPixel; +end; + +constructor TDitheringTask.Create(bmp: TBGRACustomBitmap; + APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; + ABounds: TRect); +begin + FPalette := APalette; + SetSource(bmp); + FBounds := ABounds; + FIgnoreAlpha:= AIgnoreAlpha; + FCurrentOutputY := -1; + FCurrentOutputScanline:= nil; + InPlace := AInPlace; + FDrawMode:= dmSet; + UpdateOutputPixel; +end; + +constructor TDitheringTask.Create(bmp: TBGRACustomBitmap; + APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); +begin + FPalette := APalette; + SetSource(bmp); + FBounds := rect(0,0,bmp.Width,bmp.Height); + FIgnoreAlpha:= AIgnoreAlpha; + FCurrentOutputY := -1; + FCurrentOutputScanline:= nil; + InPlace := AInPlace; + FDrawMode:= dmSet; + UpdateOutputPixel; +end; + +{ TFloydSteinbergDitheringTask } + +procedure TFloydSteinbergDitheringTask.DoExecute; +const + ErrorPrecisionShift = 4; + MaxColorDiffForDiffusion = 4096; +type + TAccPixel = record + red,green,blue,alpha: Int32or64; + end; + TLine = array of TAccPixel; + + procedure AddError(var dest: TAccPixel; const src: TAccPixel; factor: Int32or64); inline; + const maxError = 65536 shl ErrorPrecisionShift; + minError = -(65536 shl ErrorPrecisionShift); + begin + inc(dest.alpha, src.alpha * factor); + if dest.alpha > maxError then dest.alpha := maxError; + if dest.alpha < minError then dest.alpha := minError; + inc(dest.red, src.red * factor); + if dest.red > maxError then dest.red := maxError; + if dest.red < minError then dest.red := minError; + inc(dest.green, src.green * factor); + if dest.green > maxError then dest.green := maxError; + if dest.green < minError then dest.green := minError; + inc(dest.blue, src.blue * factor); + if dest.blue > maxError then dest.blue := maxError; + if dest.blue < minError then dest.blue := minError; + end; + +var + w,h: Int32or64; + +var + p,pNext: PExpandedPixel; + destX,destY: Int32or64; + orig,cur,approxExp: TExpandedPixel; + approx: TBGRAPixel; + approxIndex: integer; + curPix,diff: TAccPixel; + i: Int32or64; + yWrite: Int32or64; + tempLine, currentLine, nextLine: TLine; + + nextScan,curScan: PExpandedPixel; + + function ClampWordDiv(AValue: Int32or64): Word; inline; + begin + if AValue < 0 then AValue := -((-AValue) shr ErrorPrecisionShift) else AValue := AValue shr ErrorPrecisionShift; + if AValue < 0 then + result := 0 + else if AValue > 65535 then + result := 65535 + else + result := AValue; + end; + + function Div16(AValue: Int32or64): Int32or64; inline; + begin + if AValue < 0 then + result := -((-AValue) shr 4) + else + result := AValue shr 4; + end; + +begin + w := FBounds.Right-FBounds.Left; + h := FBounds.Bottom-FBounds.Top; + if (w <= 0) or (h <= 0) then exit; + setlength(currentLine,w); + setlength(nextLine,w); + curScan := nil; + nextScan := RequestSourceExpandedScanLine(FBounds.Left, FBounds.Top, FBounds.Right-FBounds.Left); + for yWrite := 0 to h-1 do + begin + if GetShouldStop(yWrite) then break; + ReleaseSourceExpandedScanLine(curScan); + curScan := nextScan; + nextScan := nil; + p := curScan; + destX := FBounds.Left; + destY := yWrite+FBounds.Top; + if yWrite < h-1 then + nextScan := RequestSourceExpandedScanLine(FBounds.Left,yWrite+FBounds.Top+1, FBounds.Right-FBounds.Left); + pNext := nextScan; + if odd(yWrite) then + begin + inc(p, w); + inc(destX, w); + if pNext<>nil then inc(pNext, w); + for i := w-1 downto 0 do + begin + dec(p); + dec(destX); + if pNext<>nil then dec(pNext); + if p^.alpha <> 0 then + begin + orig := p^; + with currentLine[i] do + begin + curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift); + curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift); + curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift); + curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift); + cur.alpha := ClampWordDiv(curPix.alpha); + cur.red := ClampWordDiv(curPix.red); + cur.green := ClampWordDiv(curPix.green); + cur.blue := ClampWordDiv(curPix.blue); + end; + ApproximateColor(GammaCompression(cur), approx, approxIndex); + approxExp := GammaExpansion(approx); + diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift)); + if (approxExp.alpha = 0) or (cur.alpha = 0) then + begin + diff.red := 0; + diff.green := 0; + diff.blue := 0; + end else + begin + diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift)); + diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift)); + diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift)); + end; + if i > 0 then + begin + if AbsRGBADiff((p-1)^,orig) < MaxColorDiffForDiffusion then + AddError(currentLine[i-1], diff, 7); + end; + if nextLine <> nil then + begin + if i > 0 then + begin + if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i-1], diff, 1); + end; + if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i], diff, 5); + if i < w-1 then + begin + if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i+1], diff, 3); + end; + end; + OnOutputPixel(destX,destY,approxIndex,approx); + end else + begin + ApproximateColor(BGRAPixelTransparent, approx, approxIndex); + OnOutputPixel(destX,destY,approxIndex,approx); + end; + end + end + else + for i := 0 to w-1 do + begin + if p^.alpha <> 0 then + begin + orig := p^; + with currentLine[i] do + begin + curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift); + curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift); + curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift); + curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift); + cur.alpha := ClampWordDiv(curPix.alpha); + cur.red := ClampWordDiv(curPix.red); + cur.green := ClampWordDiv(curPix.green); + cur.blue := ClampWordDiv(curPix.blue); + end; + ApproximateColor(GammaCompression(cur), approx, approxIndex); + approxExp := GammaExpansion(approx); + diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift)); + if (approxExp.alpha = 0) or (cur.alpha = 0) then + begin + diff.red := 0; + diff.green := 0; + diff.blue := 0; + end else + begin + diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift)); + diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift)); + diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift)); + end; + if i < w-1 then + begin + if AbsRGBADiff((p+1)^,orig) < MaxColorDiffForDiffusion then + AddError(currentLine[i+1], diff, 7); + end; + if pNext <> nil then + begin + if i > 0 then + begin + if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i-1], diff, 3); + end; + if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i], diff, 5); + if i < w-1 then + begin + if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then + AddError(nextLine[i+1], diff, 1); + end; + end; + OnOutputPixel(destX,destY,approxIndex,approx); + end else + begin + ApproximateColor(BGRAPixelTransparent, approx, approxIndex); + OnOutputPixel(destX,destY,approxIndex,approx); + end; + inc(p); + inc(destX); + if pNext<>nil then inc(pNext); + end; + tempLine := currentLine; + currentLine := nextLine; + nextLine := tempLine; + if yWrite = h-2 then + nextLine := nil + else fillchar(nextLine[0], sizeof(nextLine[0])*w, 0); + end; + ReleaseSourceExpandedScanLine(curScan); + ReleaseSourceExpandedScanLine(nextScan); + Destination.InvalidateBitmap; +end; + +{ TNearestColorTask } + +procedure TNearestColorTask.DoExecute; +var yb,xb: Int32or64; + curScan,psrc: PBGRAPixel; + colorIndex: LongInt; + colorValue: TBGRAPixel; +begin + for yb := FBounds.Top to FBounds.Bottom - 1 do + begin + if GetShouldStop(yb) then break; + curScan := RequestSourceScanLine(FBounds.Left,yb,FBounds.Right-FBounds.Left); + psrc := curScan; + for xb := FBounds.Left to FBounds.Right-1 do + begin + ApproximateColor(psrc^, colorValue, colorIndex); + OnOutputPixel(xb,yb,colorIndex,colorValue); + inc(psrc); + end; + ReleaseSourceScanLine(curScan); + end; + Destination.InvalidateBitmap; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgradnetdeserial.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgradnetdeserial.pas new file mode 100644 index 0000000..afd79c7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgradnetdeserial.pas @@ -0,0 +1,1522 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRADNetDeserial; + +{$mode objfpc}{$H+} + +interface + +{ This unit allow to read .Net serialized classes with BinaryFormatter of + namespace System.Runtime.Serialization.Formatters.Binary. + + Serialization is a process by which objects in memory are saved according + to their structure. + + This unit is used by BGRAPaintNet to read Paint.NET images. } + +uses + BGRAClasses, SysUtils; + +type + arrayOfLongword = array of LongWord; + + TTypeCategory = (ftPrimitiveType = 0, ftString = 1, ftObjectType = + 2, ftRuntimeType = 3, + ftGenericType = 4, ftArrayOfObject = 5, ftArrayOfString = 6, + ftArrayOfPrimitiveType = 7); + + TPrimitiveType = (ptNone = 0, ptBoolean = 1, ptByte = 2, ptChar = 3, ptDecimal = 5, + ptDouble = 6, ptInt16 = 7, ptInt32 = 8, ptInt64 = 9, ptSByte = 10, ptSingle = 11, + ptDateTime = 13, ptUInt16 = 14, ptUInt32 = 15, ptUInt64 = 16, ptString = 18); + + TGenericArrayType = (gatSingleDimension, gatJagged, gatMultidimensional); + + TDotNetDeserialization = class; + + ArrayOfNameValue = array of record + Name: string; + Value, valueType: string; + end; + + TFieldType = record + category: TTypeCategory; + primitiveType: TPrimitiveType; + refAssembly: LongWord; + Name: string; + end; + + TSerializedType = record + ClassName: string; + nbFields: integer; + fieldNames: array of string; + fieldTypes: array of TFieldType; + refAssembly: LongWord; + end; + + TAssemblyReference = record + idAssembly: LongWord; + Name: string; + end; + + { TCustomSerializedObject } + + TCustomSerializedObject = class + protected + FContainer: TDotNetDeserialization; + function GetTypeAsString: string; virtual; abstract; + function GetFieldAsString(Index: LongWord): string; overload; virtual; abstract; + function GetFieldAsString(Name: string): string; overload; + function GetFieldCount: LongWord; virtual; abstract; + function GetFieldName(Index: LongWord): string; virtual; abstract; + function GetFieldTypeAsString(Index: LongWord): string; virtual; abstract; + function IsReferenceType(index: LongWord): boolean; virtual; abstract; + public + idObject: LongWord; + refCount: integer; + inToString: boolean; + constructor Create(container: TDotNetDeserialization); virtual; + property FieldCount: LongWord read GetFieldCount; + property FieldName[Index: LongWord]:string read GetFieldName; + property FieldAsString[Index: LongWord]: string read GetFieldAsString; + property FieldByNameAsString[Name: string]: string read GetFieldAsString; + property FieldTypeAsString[Index: LongWord]: string read GetFieldTypeAsString; + property TypeAsString: string read GetTypeAsString; + function GetFieldIndex(Name: string): integer; + end; + + { TSerializedClass } + + TSerializedClass = class(TCustomSerializedObject) + protected + function GetFieldAsString(Index: LongWord): string; override; + function GetFieldCount: LongWord; override; + function GetFieldName(Index: LongWord): string; override; + function GetFieldTypeAsString(Index: LongWord): string; override; + function IsReferenceType(index: LongWord): boolean; override; + function GetTypeAsString: string; override; + public + numType: integer; + fields: ArrayOfNameValue; + end; + + { TSerializedArray } + + TSerializedArray = class(TCustomSerializedObject) + private + data: pointer; + FItemSize: LongWord; + function GetItemPtr(Index: LongWord): pointer; + procedure InitData; + protected + FArrayType: TGenericArrayType; + function GetFieldAsString(Index: LongWord): string; override; + function GetFieldCount: LongWord; override; + function GetFieldName(Index: LongWord): string; override; + function GetFieldTypeAsString(Index: LongWord): string; override; + function IsReferenceType(index: LongWord): boolean; override; + function GetTypeAsString: string; override; + public + dimensions: array of LongWord; + itemType: TFieldType; + nbItems: LongWord; + constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: LongWord); overload; + constructor Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType; ADimensions: arrayOfLongword); overload; + destructor Destroy; override; + property ItemPtr[Index:LongWord]: pointer read GetItemPtr; + property ItemSize: LongWord read FItemSize; + end; + + { TSerializedValue } + + TSerializedValue = class(TSerializedArray) + protected + function GetIsReferenceType: boolean; + function GetValueAsString: string; + function GetTypeAsString: string; override; + public + constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType); overload; + property ValueAsString: string read GetValueAsString; + property IsReferenceType: boolean read GetIsReferenceType; + end; + + { TDotNetDeserialization } + TDotNetDeserialization = class + objectTypes: array of TSerializedType; + assemblies: array of TAssemblyReference; + objects: array of TCustomSerializedObject; + + function FindClass(typeName: string): TSerializedClass; + function FindObject(typeName: string): TCustomSerializedObject; + function GetSimpleField(obj: TCustomSerializedObject; Name: string): string; + function GetObjectField(obj: TCustomSerializedObject; Name: string): TCustomSerializedObject; overload; + function GetObjectField(obj: TCustomSerializedObject; index: integer): TCustomSerializedObject; overload; + function GetObject(id: string): TCustomSerializedObject; overload; + function GetObject(id: LongWord): TCustomSerializedObject; overload; + function IsBoxedValue(obj: TCustomSerializedObject; index: integer): boolean; + function GetBoxedValue(obj: TCustomSerializedObject; index: integer): string; + procedure LoadFromStream(Stream: TStream); + procedure LoadFromFile(filename: string); + procedure LoadFromFileUTF8(filenameUTF8: string); + function ToString: string; override; + constructor Create; + destructor Destroy; override; + function GetTypeOfClassObject(idObject: LongWord): integer; + private + EndOfStream: boolean; + ArrayFillerCount: Longword; + currentAutoObjectValue: LongWord; + function nextAutoObjectId: LongWord; + function LoadNextFromStream(Stream: TStream): LongWord; + function LoadStringFromStream(Stream: TStream): string; + function LoadDotNetCharFromStream(Stream: TStream): string; + function LoadTypeFromStream(Stream: TStream; IsRuntimeType: boolean): integer; + function LoadValuesFromStream(Stream: TStream; numType: integer): ArrayOfNameValue; + function LoadValueFromStream(Stream: TStream; const fieldType: TFieldType): string; + function LoadFieldType(Stream: TStream; category: TTypeCategory): TFieldType; + end; + +function WinReadByte(stream: TStream): byte; +function WinReadWord(Stream: TStream): word; +function WinReadSmallInt(Stream: TStream): smallint; +function WinReadLongint(Stream: TStream): longint; +function WinReadLongword(Stream: TStream): LongWord; +function WinReadInt64(Stream: TStream): int64; +function WinReadQWord(Stream: TStream): QWord; + +implementation + +uses BGRAUTF8; + +const + //block types + btRefTypeObject = 1; + btRuntimeObject = 4; + btExternalObject = 5; + btString = 6; + btGenericArray = 7; + btBoxedPrimitiveTypeValue = 8; + btObjectReference = 9; + btNullValue = 10; + btEndOfStream = 11; + btAssembly = 12; + btArrayFiller8b = 13; + btArrayFiller32b = 14; + btArrayOfPrimitiveType = 15; + btArrayOfObject = 16; + btArrayOfString = 17; + btMethodCall = 21; + btMethodResponse = 22; + + idArrayFiller = $80000000; + +{$hints off} + +function WinReadByte(stream: TStream): byte; +begin + stream.Read(Result, sizeof(Result)); +end; + +function WinReadWord(Stream: TStream): word; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +function WinReadSmallInt(Stream: TStream): smallint; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +function WinReadLongint(Stream: TStream): longint; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +function WinReadLongword(Stream: TStream): LongWord; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +function WinReadInt64(Stream: TStream): int64; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +function WinReadQWord(Stream: TStream): QWord; +begin + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +{$hints on} + +function GetFieldTypeSize(const fieldType: TFieldType): LongWord; +begin + case fieldType.category of + ftPrimitiveType: + case fieldType.primitiveType of + ptBoolean, ptByte,ptSByte: result := 1; + ptChar,ptString, ptDecimal: Result := sizeof(string); + ptSingle: result := sizeof(single); + ptDouble: result := sizeof(double); + ptInt16,ptUInt16: result := 2; + ptInt32,ptUInt32: result := 4; + ptInt64,ptUInt64,ptDateTime: result := 8; + else + raise Exception.Create('Unknown primitive type (' + IntToStr( + byte(fieldType.primitiveType)) + ')'); + end; + ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, + ftArrayOfString, ftArrayOfPrimitiveType: result := 4; + else + raise Exception.Create('Unknown field type (' + IntToStr( + byte(fieldType.category)) + ')'); + end; +end; + +function IsDotNetTypeStoredAsString(const fieldType: TFieldType): boolean; +begin + result := (fieldType.category = ftPrimitiveType) and + (fieldType.primitiveType in [ptChar,ptString,ptDecimal]); +end; + +function DotNetValueToString(var value; const fieldType: TFieldType): string; +var + tempByte: byte; + value2bytes: record + case byte of + 2: (tempWord: word); + 3: (tempInt16: smallint); + end; + value4bytes: record + case byte of + 1: (tempSingle: single); + 2: (tempLongWord: LongWord); + 3: (tempLongInt: longint); + end; + value8bytes: record + case byte of + 1: (tempDouble: double); + 2: (tempInt64: Int64); + 2: (tempUInt64: QWord); + end; + tempIdObject: LongWord; + +begin + if IsDotNetTypeStoredAsString(fieldType) then + begin + Result := pstring(@value)^; + exit; + end; + case fieldType.category of + ftPrimitiveType: case fieldType.primitiveType of + ptBoolean: + begin + {$hints off} + move(value,tempByte,sizeof(tempByte)); + {$hints on} + if tempByte = 0 then + Result := 'False' + else + if tempByte = 1 then + Result := 'True' + else + raise Exception.Create('Invalid boolean value (' + + IntToStr(tempByte) + ')'); + end; + ptByte: Result := inttostr(pbyte(@value)^); + ptSByte: Result := inttostr(pshortint(@value)^); + ptInt16,ptUInt16: + begin + {$hints off} + move(value, value2bytes.tempWord,sizeof(word)); + {$hints on} + value2bytes.tempWord := LEtoN(value2bytes.tempWord); + if fieldType.primitiveType = ptInt16 then + Result := IntToStr(value2bytes.tempInt16) + else + Result := IntToStr(value2bytes.tempWord); + end; + ptInt32,ptUInt32,ptSingle: + begin + {$hints off} + move(value, value4bytes.tempLongWord,sizeof(LongWord)); + {$hints on} + value4bytes.tempLongWord := LEtoN(value4bytes.tempLongWord); + if fieldType.primitiveType = ptInt32 then + Result := IntToStr(value4bytes.tempLongInt) + else if fieldType.primitiveType = ptUInt32 then + Result := IntToStr(value4bytes.tempLongWord) + else + result := FloatToStr(value4bytes.tempSingle); + end; + + ptInt64,ptUInt64,ptDouble,ptDateTime: + begin + {$hints off} + move(value, value8bytes.tempUInt64,8); + {$hints on} + value8bytes.tempUInt64 := LEtoN(value8bytes.tempUInt64); + if fieldType.primitiveType = ptInt64 then + Result := IntToStr(value8bytes.tempInt64) + else if fieldType.primitiveType = ptUInt64 then + Result := IntToStr(value8bytes.tempUInt64) + else if fieldType.primitiveType = ptDouble then + result := FloatToStr(value8bytes.tempDouble) + else + Result := DateTimeToStr( + (value8bytes.tempUInt64 and $7FFFFFFFFFFFFFFF - 599264352000000000) / 864000000000); + end; + else + raise Exception.Create('Unknown primitive type (' + IntToStr( + byte(fieldType.primitiveType)) + ')'); + end; + ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, + ftArrayOfString, ftArrayOfPrimitiveType: + begin + {$hints off} + move(value,tempIdObject,sizeof(tempIdObject)); + {$hints on} + result := '#' + IntToStr(tempIdObject); + end; + else + raise Exception.Create('Unknown field type (' + IntToStr( + byte(fieldType.category)) + ')'); + end; +end; + +function PrimitiveTypeName(pt: TPrimitiveType): string; +begin + case pt of + ptBoolean: Result := 'Boolean'; + ptByte: Result := 'Byte'; + ptChar: Result := 'Char'; + ptDecimal: Result := 'Decimal'; + ptDouble: Result := 'Double'; + ptInt16: Result := 'Int16'; + ptInt32: Result := 'Int32'; + ptInt64: Result := 'Int64'; + ptSByte: Result := 'SByte'; + ptSingle: Result := 'Single'; + ptDateTime: Result := 'DateTime'; + ptUInt16: Result := 'UInt16'; + ptUInt32: Result := 'UInt32'; + ptUInt64: Result := 'UInt64'; + ptString: Result := 'String'; + else + raise Exception.Create('Unknown primitive type (' + IntToStr(integer(pt)) + ')'); + end; +end; + +Function DotNetTypeToString(ft: TFieldType): string; +begin + if ft.category = ftPrimitiveType then + result := PrimitiveTypeName(ft.primitiveType) + else + case ft.category of + ftString: result := 'String'; + ftObjectType: result := 'Object'; + ftRuntimeType: result := 'RuntimeType'; + ftGenericType: result := 'GenericType'; + ftArrayOfObject: result := 'Object[]'; + ftArrayOfString: result := 'String[]'; + ftArrayOfPrimitiveType: result := 'PrimitiveType[]'; + else + raise Exception.Create('Unknown field type (' + IntToStr( + byte(ft.category)) + ')'); + end; +end; + +{ TCustomSerializedObject } + +function TCustomSerializedObject.GetFieldAsString(Name: string): string; +begin + result := GetFieldAsString(GetFieldIndex(Name)); +end; + +constructor TCustomSerializedObject.Create(container: TDotNetDeserialization); +begin + FContainer := container; + refCount := 0; +end; + +function TCustomSerializedObject.GetFieldIndex(Name: string): integer; +var + i: integer; + fn: string; +begin + if FieldCount = 0 then + begin + result := -1; + exit; + end; + //case sensitive + for i := 0 to FieldCount-1 do + if FieldName[i] = Name then + begin + Result := i; + exit; + end; + //case insensitive + for i := 0 to FieldCount-1 do + if compareText(FieldName[i], Name) = 0 then + begin + Result := i; + exit; + end; + //case sensitive inner member + for i := 0 to FieldCount-1 do + begin + fn := FieldName[i]; + if (length(Name) < length(fn)) and + (copy(fn, length(fn) - length(Name), + length(Name) + 1) = '+' + Name) then + begin + Result := i; + exit; + end; + end; + //case insensitive inner member + for i := 0 to FieldCount-1 do + begin + fn := FieldName[i]; + if (length(Name) < length(fn)) and + (compareText(copy(fn, length(fn) - + length(Name), length(Name) + 1), '+' + Name) = 0) then + begin + Result := i; + exit; + end; + end; + Result := -1; +end; + +{ TSerializedClass } + +function TSerializedClass.GetFieldAsString(Index: LongWord): string; +begin + result := fields[Index].Value; +end; + +function TSerializedClass.GetFieldCount: LongWord; +begin + Result:= length(fields); +end; + +function TSerializedClass.GetFieldName(Index: LongWord): string; +begin + result := fields[Index].Name; +end; + +function TSerializedClass.GetFieldTypeAsString(Index: LongWord): string; +begin + result := fields[Index].valueType; +end; + +function TSerializedClass.IsReferenceType(index: LongWord): boolean; +begin + Result:= FContainer.objectTypes[numType].fieldTypes[index].category <> ftPrimitiveType; +end; + +function TSerializedClass.GetTypeAsString: string; +begin + Result:= FContainer.objectTypes[numType].ClassName; +end; + +{ TSerializedArray } + +procedure TSerializedArray.InitData; +begin + FItemSize := GetFieldTypeSize(itemType); + getmem(data, itemSize*nbItems); + fillchar(data^, itemSize*nbItems, 0); +end; + +function TSerializedArray.GetItemPtr(Index: LongWord): pointer; +begin + if index >= nbItems then + raise exception.Create('Index out of bounds'); + result := pointer(pbyte(data)+Index*itemsize); +end; + +function TSerializedArray.GetFieldAsString(Index: LongWord): string; +begin + if data = nil then + result := '' + else + result := DotNetValueToString(ItemPtr[index]^, itemType); +end; + +function TSerializedArray.GetFieldCount: LongWord; +begin + Result:= nbItems; +end; + +function TSerializedArray.GetFieldName(Index: LongWord): string; +var + r: LongWord; +begin + result := '['; + for r := 1 to length(dimensions) do + begin + if r <> 1 then AppendStr(result, ','); + AppendStr(result, inttostr(index mod dimensions[r-1])); + index := index div dimensions[r-1]; + end; + AppendStr(result, ']'); +end; + +{$hints off} +function TSerializedArray.GetFieldTypeAsString(Index: LongWord): string; +begin + Result:= DotNetTypeToString(itemType); +end; +{$hints on} + +{$hints off} +function TSerializedArray.IsReferenceType(index: LongWord): boolean; +begin + Result:= itemType.category <> ftPrimitiveType; +end; +{$hints on} + +function TSerializedArray.GetTypeAsString: string; +var + i: Integer; +begin + Result:= DotNetTypeToString(itemType)+'['; + for i := 2 to length(dimensions) do + AppendStr(result, ','); + AppendStr(result, ']'); +end; + +constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: LongWord); +begin + inherited Create(AContainer); + setlength(dimensions,1); + dimensions[0] := ALength; + nbItems := ALength; + FArrayType := gatSingleDimension; + itemType := AItemType; + InitData; +end; + +constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType; + ADimensions: arrayOfLongword); +var n: LongWord; +begin + inherited Create(AContainer); + setlength(dimensions, length(ADimensions)); + nbItems := 1; + if length(ADimensions) <> 0 then + for n := 0 to length(ADimensions)-1 do + begin + dimensions[n] := ADimensions[n]; + nbItems := nbItems * ADimensions[n]; + end; + FArrayType := AArrayType; + itemType := AItemType; + InitData; +end; + +destructor TSerializedArray.Destroy; +var ps: PString; + n: LongWord; +begin + if IsDotNetTypeStoredAsString(itemType) and (nbItems <> 0) then + begin + ps := PString(data); + for n := 1 to nbItems do + begin + ps^ := ''; + inc(ps); + end; + end; + freemem(data); + inherited Destroy; +end; + +{ TSerializedValue } + +function TSerializedValue.GetIsReferenceType: boolean; +begin + result := inherited IsReferenceType(0); +end; + +function TSerializedValue.GetValueAsString: string; +begin + result := GetFieldAsString(0); +end; + +function TSerializedValue.GetTypeAsString: string; +begin + Result:= GetFieldTypeAsString(0); +end; + +constructor TSerializedValue.Create(AContainer: TDotNetDeserialization; + AItemType: TFieldType); +begin + inherited Create(AContainer,AItemType,1); +end; + +{ TDotNetDeserialization } + +function TDotNetDeserialization.FindClass(typeName: string): TSerializedClass; +var obj: TCustomSerializedObject; +begin + obj := FindObject(typeName); + if obj is TSerializedClass then + result := obj as TSerializedClass + else + raise exception.Create('FindClass: found object is not a class'); +end; + +function TDotNetDeserialization.FindObject(typeName: string): TCustomSerializedObject; +var + i: integer; + comparedType: string; +begin + for i := 0 to high(objects) do + begin + comparedType := objects[i].TypeAsString; + if (comparedType = typeName) or + ( (length(typeName) < length(comparedType) ) and + (copy(comparedType, length(comparedType) - length(typeName), + length(typeName) + 1) = '.' + typeName) ) then + begin + Result := objects[i]; + exit; + end; + end; + Result := nil; +end; + +function TDotNetDeserialization.GetSimpleField(obj: TCustomSerializedObject; + Name: string): string; +var + i,idxSlash: integer; + tempSub: TCustomSerializedObject; +begin + i := obj.GetFieldIndex(Name); + if i = -1 then + begin + idxSlash := pos('\',name); + if idxSlash <> 0 then + begin + tempSub := GetObjectField(obj,copy(name,1,idxSlash-1)); + if tempSub <> nil then + begin + result := GetSimpleField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash)); + exit; + end; + end; + Result := '' + end + else + begin + if IsBoxedValue(obj, i) then + Result := GetBoxedValue(obj, i) + else + Result := obj.FieldAsString[i]; + end; +end; + +function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject; + Name: string): TCustomSerializedObject; +var + i: integer; + idxSlash: LongInt; + tempSub: TCustomSerializedObject; +begin + i := obj.GetFieldIndex(Name); + if i = -1 then + begin + idxSlash := pos('\',name); + if idxSlash <> 0 then + begin + tempSub := GetObjectField(obj,copy(name,1,idxSlash-1)); + if tempSub <> nil then + begin + result := GetObjectField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash)); + exit; + end; + end; + Result := nil + end + else + begin + if not obj.IsReferenceType(i) then + raise Exception.Create('GetObjectField: Not a reference type'); + Result := GetObject(obj.FieldAsString[i]); + end; +end; + +function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject; + index: integer): TCustomSerializedObject; +begin + if not obj.IsReferenceType(index) then + raise Exception.Create('GetObjectField: Not a reference type'); + Result := GetObject(obj.FieldAsString[index]); +end; + +function TDotNetDeserialization.GetObject(id: string): TCustomSerializedObject; +var + idObj: LongWord; +begin + if copy(id, 1, 1) = '#' then + Delete(id, 1, 1); + idObj := StrToInt64(id); + Result := GetObject(idObj); +end; + +function TDotNetDeserialization.GetObject(id: LongWord): TCustomSerializedObject; +var + i: integer; +begin + for i := 0 to high(objects) do + if objects[i].idObject = id then + begin + Result := objects[i]; + exit; + end; + Result := nil; +end; + +function TDotNetDeserialization.IsBoxedValue(obj: TCustomSerializedObject; + index: integer): boolean; +var + subObj: TCustomSerializedObject; +begin + if not obj.IsReferenceType(index) then + begin + Result := False; + exit; + end; + subObj := GetObject(obj.FieldAsString[index]); + if subObj = nil then //suppose Nothing is a boxed value + begin + Result := True; + exit; + end; + Result := subObj is TSerializedValue; +end; + +function TDotNetDeserialization.GetBoxedValue(obj: TCustomSerializedObject; + index: integer): string; +var + subObj: TCustomSerializedObject; +begin + if not obj.IsReferenceType(index) then + raise Exception.Create('GetBoxedValue: Not a reference type'); + subObj := GetObject(obj.FieldAsString[index]); + if subObj = nil then + begin + Result := ''; //empty value + exit; + end; + if (subObj is TSerializedValue) and not (subObj as TSerializedValue).IsReferenceType then + Result := (subObj as TSerializedValue).ValueAsString + else + raise Exception.Create('GetBoxedValue: Not a primitive type'); +end; + +procedure TDotNetDeserialization.LoadFromStream(Stream: TStream); +var + header: packed record + blockId: byte; + value1, value2, value3, value4: longint; + end; + curStreamPosition, prevStreamPosition: int64; +begin + {$hints off} + if Stream.Read(header, sizeof(header)) <> sizeof(header) then + raise Exception.Create('Invalid header size'); + if (header.blockId <> 0) or (header.value1 <> 1) or (header.value2 <> -1) or + (header.value3 <> 1) or (header.value4 <> 0) then + raise Exception.Create('Invalid header format'); + {$hints on} + + EndOfStream := False; + curStreamPosition := Stream.Position; + try + while (Stream.Position < Stream.Size) and not EndOfStream do + begin + prevStreamPosition := curStreamPosition; + curStreamPosition := Stream.Position; + LoadNextFromStream(Stream); + end; + except + on ex: Exception do + raise Exception.Create('Error while loading serialized data at position ' + + IntToStr(stream.Position) + ' (block starting at ' + + IntToStr(curStreamPosition) + ', previous block at ' + + IntToStr(prevStreamPosition) + '). ' + ex.message); + end; +end; + +procedure TDotNetDeserialization.LoadFromFile(filename: string); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(SysToUTF8(filename), fmOpenRead); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TDotNetDeserialization.LoadFromFileUTF8(filenameUTF8: string); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +function TDotNetDeserialization.ToString: string; + + function ObjectToString(num: integer; expectedType: string; + tab: string; main: boolean): string; + var + j, k: integer; + subId: LongWord; + subNum: integer; + objType, subExpectedType: string; + fieldTypeStr: string; + begin + Result := ''; + if (num < 0) or (num > high(objects)) then + raise Exception.Create('Index out of bounds'); + with objects[num] do //here array is not changed so it won't move + begin + if inToString then + begin + if main then + Result := '' + else + Result := '#' + IntToStr(idObject) + LineEnding; + exit; + end; + inToString := True; + objType := TypeAsString; + if main then + begin + AppendStr(Result, tab + 'Object'); + AppendStr(Result, ' #' + IntToStr(idObject)); + if (objType = '') or (objType = expectedType) then + AppendStr(Result, ' = ') + else + AppendStr(Result, ' As ' + objType + ' = '); + end + else + begin + if (objType = '') or (objType = expectedType) then + Result := '' + else + Result := '(' + objType + ') '; + if (idObject < idArrayFiller) and (refCount > 0) then + AppendStr(Result, '#' + IntToStr(idObject) + ' = '); + end; + if (length(objType) > 2) and (copy(objType, length(objType) - 1, 2) = '[]') then + subExpectedType := copy(objType, 1, length(objType) - 2) + else + subExpectedType := ''; + + if not main and (objects[num] is TSerializedValue) then + begin + AppendStr(Result, (objects[num] as TSerializedValue).ValueAsString + LineEnding); + end + else + if (FieldCount = 0) then + begin + AppendStr(Result, '{}' + LineEnding); + end + else + begin + AppendStr(Result, '{' + LineEnding); + for j := 0 to FieldCount-1 do + begin + AppendStr(Result, tab + ' ' + FieldName[j]); + fieldTypeStr := FieldTypeAsString[j]; + if (fieldTypeStr <> '') and (fieldTypeStr <> subExpectedType) and + not ((subExpectedType = '') and ((fieldTypeStr = 'Int32') or + (fieldTypeStr = 'Boolean') or (fieldTypeStr = 'Double'))) then + AppendStr(Result, ' As ' + fieldTypeStr); + AppendStr(Result, ' = '); + if not IsReferenceType(j) then + AppendStr(Result, FieldAsString[j] + lineending) + else + begin + try + subId := StrToInt64(copy(fieldAsString[j], 2, length(fieldAsString[j]) - 1)); + if subId = 0 then AppendStr(Result, 'null'+LineEnding) else + begin + begin + subNum := -1; + for k := 0 to high(objects) do + if (objects[k].idObject = subId) then + begin + subNum := k; + break; + end; + end; + if subNum = -1 then + AppendStr(Result, '(Not found) #' + IntToStr(subId)+LineEnding) + else + AppendStr(Result, objectToString(subNum, fieldTypeStr, tab + ' ', False)); + end; + except + AppendStr(Result, '!' + fieldAsString[j]+'!' +LineEnding) + end; + end; + end; + AppendStr(Result, tab + '}' + LineEnding); + if main then + AppendStr(Result, LineEnding); + end; + end; + end; + +var + i: integer; +begin + Result := ''; + for i := 0 to high(assemblies) do + AppendStr(Result, 'Imports ' + assemblies[i].Name + LineEnding); + AppendStr(Result, lineEnding); + for i := 0 to high(objects) do + objects[i].inToString := False; + for i := 0 to high(objects) do + AppendStr(Result, ObjectToString(i, 'Object', '', True)); +end; + +constructor TDotNetDeserialization.Create; +begin + currentAutoObjectValue := idArrayFiller + 1; +end; + +destructor TDotNetDeserialization.Destroy; +var + i: Integer; +begin + for i := 0 to high(objects) do + objects[i].Free; + inherited Destroy; +end; + +function TDotNetDeserialization.GetTypeOfClassObject(idObject: LongWord + ): integer; +var + i: Integer; +begin + for i := 0 to high(objects) do + if objects[i].idObject = idObject then + begin + if objects[i] is TSerializedClass then + begin + result := (objects[i] as TSerializedClass).numType; + exit; + end + else + raise exception.Create('GetTypeOfClassObject: Specified object is not of class type'); + end; + raise exception.Create('GetTypeOfClassObject: Object not found'); +end; + +function TDotNetDeserialization.nextAutoObjectId: LongWord; +begin + Inc(currentAutoObjectValue); + Result := currentAutoObjectValue; +end; + +function TDotNetDeserialization.LoadNextFromStream(Stream: TStream): LongWord; +var + blockType: byte; + idRefObject, tempIdObject: LongWord; + tempType: TFieldType; + arrayCount, arrayIndex,FillZeroCount : LongWord; + tempAnyObj: TCustomSerializedObject; + newClassObj: TSerializedClass; + newValueObj: TSerializedValue; + newArrayObj: TSerializedArray; + genericArrayType: TGenericArrayType; + genericArrayRank: LongWord; + genericArrayDims: array of LongWord; + genericArrayItemType: TFieldType; + + function GetArrayCellNumber(index: LongWord): string; + var r: LongWord; + begin + result := ''; + for r := 1 to genericArrayRank do + begin + if r <> 1 then AppendStr(result, ','); + AppendStr(result, inttostr(index mod genericArrayDims[r-1])); + index := index div genericArrayDims[r-1]; + end; + end; + +begin + Result := 0; //idObject or zero + blockType := WinReadByte(Stream); + case blockType of + + btAssembly: + begin + setlength(assemblies, length(assemblies) + 1); + with assemblies[high(assemblies)] do + begin + idAssembly := WinReadLongword(Stream); + Name := LoadStringFromStream(Stream); + end; + end; + + btRuntimeObject, btExternalObject: + begin + newClassObj := TSerializedClass.Create(self); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newClassObj; + with newClassObj do + begin + idObject := WinReadLongword(Stream); + Result := idObject; + numType := LoadTypeFromStream(Stream, blockType = btRuntimeObject); + fields := LoadValuesFromStream(Stream, numType); + end; + end; + + btRefTypeObject: + begin + newClassObj := TSerializedClass.Create(self); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newClassObj; + with newClassObj do + begin + idObject := WinReadLongword(Stream); + Result := idObject; + idRefObject := WinReadLongword(Stream); + numType := GetTypeOfClassObject(idRefObject); + fields := LoadValuesFromStream(Stream, numType); + end; + end; + + btString: + begin + tempType.primitiveType := ptString; + tempType.category := ftPrimitiveType; + tempType.Name := PrimitiveTypeName(ptString); + tempType.refAssembly := 0; + + newValueObj := TSerializedValue.Create(self,tempType); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newValueObj; + with newValueObj do + begin + idObject := WinReadLongword(Stream); + Result := idObject; + pstring(data)^ := LoadStringFromStream(Stream); + end; + end; + + btBoxedPrimitiveTypeValue: + begin + try + tempType.category := ftPrimitiveType; + tempType.refAssembly := 0; + tempType.primitiveType := TPrimitiveType(WinReadByte(stream)); + tempType.Name := PrimitiveTypeName(tempType.primitiveType); + + newValueObj := TSerializedValue.Create(self,tempType); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newValueObj; + + with newValueObj do + begin + idObject := nextAutoObjectId; + Result := idObject; + + if IsDotNetTypeStoredAsString(tempType) then + pstring(data)^ := LoadValueFromStream(Stream, tempType) + else + Stream.Read(data^, itemSize); + end; + except + on ex: Exception do + raise Exception.Create('Error while reading boxed primitive values. ' + + ex.Message); + end; + end; + + btObjectReference: + begin + result := WinReadLongword(Stream); + tempAnyObj := GetObject(Result); + if tempAnyObj <> nil then + Inc(tempAnyObj.refCount); + end; + + btNullValue: Result := 0; + + btArrayOfPrimitiveType: + begin + try + result := WinReadLongword(Stream); + arrayCount := WinReadLongword(Stream); + + tempType.category := ftPrimitiveType; + tempType.refAssembly := 0; + tempType.primitiveType := TPrimitiveType(WinReadByte(stream)); + tempType.Name := PrimitiveTypeName(tempType.primitiveType); + + newArrayObj := TSerializedArray.Create(self,tempType,arrayCount); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newArrayObj; + with newArrayObj do + begin + idObject := result; + + if arrayCount <> 0 then + begin + if IsDotNetTypeStoredAsString(tempType) then + begin + for arrayIndex := 0 to arrayCount - 1 do + pstring(ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream, tempType); + end else + begin + for arrayIndex := 0 to arrayCount - 1 do + stream.Read(ItemPtr[arrayIndex]^, itemSize); + end; + end; + end; + except + on ex: Exception do + raise Exception.Create('Error while reading array of primitive values. ' + + ex.Message); + end; + end; + + btArrayOfObject,btArrayOfString: + begin + try + result := WinReadLongword(Stream); + arrayCount := WinReadLongword(Stream); + + if blockType = btArrayOfObject then + tempType.category := ftObjectType + else + tempType.category := ftString; + + tempType.refAssembly := 0; + tempType.primitiveType := ptNone; + tempType.Name := DotNetTypeToString(tempType); + + newArrayObj := TSerializedArray.Create(self,tempType,arrayCount); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newArrayObj; + + with newArrayObj do + begin + idObject:= result; + FillZeroCount := 0; + if arrayCount <> 0 then + for arrayIndex := 0 to arrayCount - 1 do + begin + if FillZeroCount > 0 then + Dec(FillZeroCount) + else + begin + tempIdObject := LoadNextFromStream(Stream); + if tempIdObject = idArrayFiller then + begin + tempIdObject := 0; + FillZeroCount := ArrayFillerCount; + ArrayFillerCount := 0; + end; + if FillZeroCount > 0 then + Dec(FillZeroCount) + else + plongword(ItemPtr[arrayIndex])^ := tempIdObject; + end; + end; + end; + except + on ex: Exception do + raise Exception.Create('Error while reading array of object. ' + ex.Message); + end; + end; + + btArrayFiller8b, btArrayFiller32b: + begin + Result := idArrayFiller; + arrayCount := 0; + if blockType = btArrayFiller8b then + arrayCount := WinReadByte(Stream) + else + arrayCount := WinReadLongWord(Stream); + ArrayFillerCount := arraycount; + end; + + btGenericArray: + begin + try + result := WinReadLongword(Stream); + genericArrayType := TGenericArrayType( WinReadByte(Stream) ); + genericArrayRank := WinReadLongword(Stream); + setlength(genericArrayDims,genericArrayRank); + arrayCount := 0; + if genericArrayRank <> 0 then + for arrayIndex := 0 to genericArrayRank-1 do + begin + genericArrayDims[arrayIndex] := WinReadLongword(Stream); + if arrayIndex=0 then + arrayCount := genericArrayDims[arrayIndex] + else + arrayCount := arrayCount * genericArrayDims[arrayIndex]; + end; + genericArrayItemType.category := TTypeCategory(WinReadByte(Stream)); + genericArrayItemType := LoadFieldType(stream,genericArrayItemType.category); + + newArrayObj := TSerializedArray.Create(self,genericArrayType,genericArrayItemType,genericArrayDims); + setlength(objects, length(objects) + 1); + objects[high(objects)] := newArrayObj; + newArrayObj.idObject := result; + + FillZeroCount := 0; + if arrayCount <> 0 then + for arrayIndex := 0 to arrayCount - 1 do + begin + if IsDotNetTypeStoredAsString(genericArrayItemType) then + PString(newArrayObj.ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream,genericArrayItemType) + else + if genericArrayItemType.category = ftPrimitiveType then + Stream.Read(newArrayObj.ItemPtr[arrayIndex]^, newArrayObj.ItemSize) + else + begin + if FillZeroCount > 0 then + Dec(FillZeroCount) + else + begin + tempIdObject := LoadNextFromStream(Stream); + if tempIdObject = idArrayFiller then + begin + tempIdObject := 0; + FillZeroCount := ArrayFillerCount; + ArrayFillerCount := 0; + end; + if FillZeroCount > 0 then + Dec(FillZeroCount) + else + plongword(newArrayObj.ItemPtr[arrayIndex])^ := tempIdObject; + end; + end; + end; + except + on ex: Exception do + raise Exception.Create('Error while reading array of object. ' + ex.Message); + end; + end; + + btMethodCall, btMethodResponse: + raise Exception.Create('Method or method response not supported'); + + btEndOfStream: EndOfStream := True; + + else + raise Exception.Create('Unknown block type (' + IntToStr(blockType) + ')'); + end; +end; + +function TDotNetDeserialization.LoadStringFromStream(Stream: TStream): string; +var + byteLength, shift: byte; + fullLength: integer; + utf8value: string; +begin + fullLength := 0; + shift := 0; + {$hints off} + repeat + Stream.Read(byteLength, 1); + Inc(fullLength, (byteLength and 127) shl shift); + shift := shift + 7; + until (byteLength < 128) or (shift > 24); + {$hints on} + setlength(utf8value, fullLength); + if Stream.Read(utf8value[1], fullLength) <> fullLength then + raise Exception.Create('String length error'); + Result := utf8value; +end; + +function TDotNetDeserialization.LoadDotNetCharFromStream(Stream: TStream + ): string; +var + tempByte: byte; + dataLen: Byte; + utf8value: string; +begin + tempByte:= WinReadByte(Stream); + + if tempByte and $80 = 0 then + dataLen := 1 + else + if tempByte and $E0 = $C0 then + dataLen := 2 + else + if tempByte and $F0 = $E0 then + dataLen := 3 + else + if tempByte and $F8 = $F0 then + dataLen := 4 + else + raise Exception.Create('Invalid UTF8 char'); + + setlength(utf8value, dataLen); + utf8value[1] := char(tempByte); + Stream.Read(utf8value[2], dataLen - 1); + Result := utf8value; +end; + +function TDotNetDeserialization.LoadTypeFromStream(Stream: TStream; + IsRuntimeType: boolean): integer; +var + i: integer; +begin + try + setlength(objectTypes, length(objectTypes) + 1); + Result := high(objectTypes); + with objectTypes[Result] do + begin + ClassName := LoadStringFromStream(Stream); + nbFields := WinReadLongword(Stream); + setlength(fieldNames, nbFields); + setlength(fieldTypes, nbFields); + for i := 0 to nbFields - 1 do + fieldNames[i] := LoadStringFromStream(Stream); + for i := 0 to nbFields - 1 do + fieldTypes[i].category := TTypeCategory(WinReadByte(Stream)); + for i := 0 to nbFields - 1 do + fieldTypes[i] := LoadFieldType(Stream,fieldTypes[i].category); + if isRuntimeType then + refAssembly := 0 + else + refAssembly := WinReadLongword(Stream); + end; + except + on ex: Exception do + raise Exception.Create('Error while reading object type definition. ' + + ex.Message); + end; +end; + +function TDotNetDeserialization.LoadValuesFromStream(Stream: TStream; + numType: integer): ArrayOfNameValue; +var + i: integer; + ot: TSerializedType; +begin + if (numType < 0) or (numType > high(objectTypes)) then + raise Exception.Create('Type number out of bounds (' + IntToStr(numType) + ')'); + ot := objectTypes[numType]; //use temp because array address may change + try + with ot do + begin + setlength(Result, nbFields); + for i := 0 to nbFields - 1 do + begin + Result[i].Name := fieldNames[i]; + Result[i].valueType := fieldTypes[i].Name; + Result[i].Value := LoadValueFromStream(Stream, fieldTypes[i]); + end; + end; + except + on ex: Exception do + raise Exception.Create('Error while reading values of object of type ' + + ot.ClassName + '. ' + ex.Message); + end; +end; + +function TDotNetDeserialization.LoadValueFromStream(Stream: TStream; + const fieldType: TFieldType): string; +var + data : record + case byte of + 1: (ptr: pointer); + 2: (bytes: array[0..7] of byte); + end; + dataLen: LongWord; + tempIdObject: LongWord; +begin + try + if fieldType.Category = ftPrimitiveType then + begin + case fieldType.primitiveType of + ptChar: Result := LoadDotNetCharFromStream(Stream); + ptString, ptDecimal: Result := LoadStringFromStream(Stream); + else + begin + dataLen := GetFieldTypeSize(fieldType); + {$hints off} + stream.read(data,dataLen); + {$hints on} + result := DotNetValueToString(data,fieldType); + end; + end; + end else + if fieldType.Category in [ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, + ftArrayOfString, ftArrayOfPrimitiveType] then + begin + tempIdObject := LoadNextFromStream(stream); + Result := '#' + IntToStr(tempIdObject); + end else + raise Exception.Create('Unknown field type (' + IntToStr( + byte(fieldType.category)) + ')'); + except + on ex: Exception do + raise Exception.Create('Error while reading object value. ' + ex.Message); + end; +end; + +function TDotNetDeserialization.LoadFieldType(Stream: TStream; category: TTypeCategory + ): TFieldType; +begin + result.category := category; + result.Name := ''; + result.refAssembly := 0; + result.primitiveType := ptNone; + case category of + ftPrimitiveType, ftArrayOfPrimitiveType: + begin + result.primitiveType := TPrimitiveType(WinReadByte(stream)); + result.Name := PrimitiveTypeName(result.primitiveType); + if result.category = ftArrayOfPrimitiveType then + AppendStr(result.Name, '[]'); + end; + ftString: result.Name := 'String'; + ftObjectType: result.Name := 'Object'; + ftRuntimeType: result.Name := LoadStringFromStream(Stream); + ftGenericType: + begin + result.Name := LoadStringFromStream(Stream); + result.refAssembly := WinReadLongword(Stream); + end; + ftArrayOfObject: result.Name := 'Object[]'; + ftArrayOfString: result.Name := 'String[]'; + else + raise Exception.Create('Unknown field type tag (' + IntToStr( + byte(result.category)) + ')'); + end; +end; + +initialization + + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafillinfo.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafillinfo.pas new file mode 100644 index 0000000..4f45d32 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafillinfo.pas @@ -0,0 +1,1758 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFillInfo; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes; + +const + AntialiasPrecision = 16; + AntialiasPrecisionShift = 4; + +type + TDensity = word; + PDensity = ^TDensity; + +type + { TFillShapeInfo } + + TFillShapeInfo = class(TBGRACustomFillInfo) + protected + FPointInsideInter : ArrayOfTIntersectionInfo; + //compute intersections. the array must be big enough + procedure ComputeIntersection(cury: single; var inter: ArrayOfTIntersectionInfo; var nbInter: integer); virtual; + //sort from left to right + procedure SortIntersection(var inter: ArrayOfTIntersectionInfo; nbInter: integer); virtual; + procedure InternalQuickSortIntersection(inter0: pointer; idxL, idxH: Integer); virtual; + //apply non-zero winding rule. it can change the number of intersections + procedure ConvertFromNonZeroWinding(var inter: ArrayOfTIntersectionInfo; var nbInter: integer); virtual; + //returns maximum of intersection per line + function NbMaxIntersection: integer; virtual; + + public + destructor Destroy; override; + + //returns true if the same segment number can be curved + function SegmentsCurved: boolean; override; + + //returns integer bounds + function GetBounds: TRect; override; + + //check if the point is inside the filling zone + function IsPointInside(x,y: single; windingMode: boolean): boolean; override; + + //create an array that will contain computed intersections. + //you may augment, in this case, use CreateIntersectionInfo for new items + function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; + function CreateIntersectionInfo: TIntersectionInfo; override; //creates a single info + procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); override; + + //fill a previously created array of intersections with actual intersections at the current y coordinate. + //nbInter gets the number of computed intersections + procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); override; + + //can be called after ComputeAndSort or ComputeIntersection to determine the current horizontal slice + //so that it can be checked if the intermediates scanlines can be skipped + function GetSliceIndex: integer; override; + + end; + + { TFillEllipseInfo } + + TFillEllipseInfo = class(TFillShapeInfo) + private + FX, FY, FRX, FRY: single; + FSliceIndex: integer; + function GetCenter: TPointF; + protected + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + WindingFactor: integer; + constructor Create(x, y, rx, ry: single); + function GetBounds: TRect; override; + function SegmentsCurved: boolean; override; + function GetSliceIndex: integer; override; + property Center: TPointF read GetCenter; + property RadiusX: single read FRX; + property RadiusY: single read FRY; + end; + + { TFillBorderEllipseInfo } + + TFillBorderEllipseInfo = class(TFillShapeInfo) + private + FInnerBorder, FOuterBorder: TFillEllipseInfo; + protected + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + constructor Create(x, y, rx, ry, w: single); + function GetBounds: TRect; override; + function SegmentsCurved: boolean; override; + destructor Destroy; override; + function GetSliceIndex: integer; override; + property InnerBorder: TFillEllipseInfo read FInnerBorder; + property OuterBorder: TFillEllipseInfo read FOuterBorder; + end; + + { TFillRoundRectangleInfo } + + TFillRoundRectangleInfo = class(TFillShapeInfo) + private + FX1, FY1, FX2, FY2, FRX, FRY: single; + FOptions: TRoundRectangleOptions; + function GetBottomRight: TPointF; + function GetTopLeft: TPointF; + protected + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + WindingFactor: integer; + constructor Create(x1, y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean = true); + function SegmentsCurved: boolean; override; + function GetBounds: TRect; override; + property TopLeft: TPointF read GetTopLeft; + property BottomRight: TPointF read GetBottomRight; + property RadiusX: single read FRX; + property RadiusY: single read FRY; + end; + + { TFillRectangleInfo } + + TFillRectangleInfo = class(TFillShapeInfo) + private + FX1, FY1, FX2, FY2: single; + function GetBottomRight: TPointF; + function GetTopLeft: TPointF; + protected + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + WindingFactor: integer; + constructor Create(x1, y1, x2, y2: single; APixelCenteredCoordinates: boolean = true); + function GetBounds: TRect; override; + property TopLeft: TPointF read GetTopLeft; + property BottomRight: TPointF read GetBottomRight; + end; + + { TFillBorderRoundRectInfo } + + TFillBorderRoundRectInfo = class(TFillShapeInfo) + protected + FInnerBorder, FOuterBorder: TFillRoundRectangleInfo; + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + constructor Create(x1, y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean = true); + function GetBounds: TRect; override; + function SegmentsCurved: boolean; override; + destructor Destroy; override; + property InnerBorder: TFillRoundRectangleInfo read FInnerBorder; + property OuterBorder: TFillRoundRectangleInfo read FOuterBorder; + end; + + PCustomPointRecord = ^TCustomPointRecord; + TCustomPointRecord = record + originalIndex: integer; + slope: single; + empty: boolean; + next: integer; + winding: integer; + includeStartingPoint,includeEndingPoint: boolean; + data: pointer; + case boolean of + false: (x,y,x2,y2: single); + true: (coord,coord2: TPointF); + end; + + { TCustomFillPolyInfo } + + TCustomFillPolyInfo = class(TFillShapeInfo) + private + function GetNbPoints: integer; + protected + FPoints: array of TCustomPointRecord; + FSegmentsDataCreated: boolean; + FBoundsF: TRectF; + function NbMaxIntersection: integer; override; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; {%H-}dy: single; {%H-}AData: pointer); virtual; + procedure InitPoints(const points: array of TPointF); + procedure CreateSegmentsData; virtual; + public + constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); + destructor Destroy; override; + function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; + function CreateSegmentData({%H-}numPt, {%H-}nextPt: integer; {%H-}ASeg: PCustomPointRecord): pointer; virtual; + procedure FreeSegmentData(data: pointer); virtual; + function GetBounds: TRect; override; + function GetBoundsF: TRectF; + property NbPoints: integer read GetNbPoints; + end; + + TPolySlice = record + y1,y2: single; + segments: array of record + id: integer; + custom: PCustomPointRecord; + end; + nbSegments: integer; + end; + + { TFillPolyInfo } + + TFillPolyInfo = class(TCustomFillPolyInfo) + protected + FSlices: array of TPolySlice; + FCurSlice: integer; + FMaxIntersection: integer; + function NbMaxIntersection: integer; override; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); + function GetSliceIndex: integer; override; + end; + + POnePassRecord = ^TOnePassRecord; + TOnePassRecord = record + id: integer; + custom: PCustomPointRecord; + next: POnePassRecord; + nextWaiting: POnePassRecord; + nextDrawing: POnePassRecord; + end; + + { TOnePassFillPolyInfo } + + TOnePassFillPolyInfo = class(TCustomFillPolyInfo) + private + procedure InsertionSortByY; + function PartitionByY(left, right: integer): integer; + procedure QuickSortByY(left, right: integer); + procedure SortByY; + protected + FOnePass: array of TOnePassRecord; + FSortedByY: array of POnePassRecord; + FFirstWaiting, FFirstDrawing: POnePassRecord; + FShouldInitializeDrawing: boolean; + FSliceIndex: integer; + procedure ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; + public + constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); + function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; + function GetSliceIndex: integer; override; + end; + + { TSimpleFillPolyInfo } + + TSimpleFillPolyInfo = class(TCustomFillPolyInfo) + protected + procedure ComputeIntersection(cury: single; var inter: ArrayOfTIntersectionInfo; + var nbInter: integer); override; + public + constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); + end; + +procedure AddDensity(dest: PDensity; start,count: integer; value : word); inline; +function DivByAntialiasPrecision(value: UInt32or64): UInt32or64; inline; +function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64; inline; +function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64; inline; +procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer); + +function IsPointInPolygon(const points: ArrayOfTPointF; point: TPointF; windingMode: boolean): boolean; +function IsPointInEllipse(x,y,rx,ry: single; point: TPointF): boolean; +function IsPointInRoundRectangle(x1, y1, x2, y2, rx, ry: single; point: TPointF): boolean; +function IsPointInRectangle(x1, y1, x2, y2: single; point: TPointF): boolean; + +function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; + bmpDest: TBGRACustomBitmap): boolean; overload; +function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; + clip: TRect): boolean; overload; + +implementation + +uses Math; + +function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; + bmpDest: TBGRACustomBitmap): boolean; +begin + result := BGRAShapeComputeMinMax(AShape, minx,miny,maxx,maxy, bmpDest.ClipRect); +end; + +function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; + clip: TRect): boolean; +var bounds: TRect; +begin + result := true; + bounds := AShape.GetBounds; + + if (bounds.Right <= bounds.left) or (bounds.bottom <= bounds.top) then + begin + result := false; + exit; + end; + + miny := bounds.top; + maxy := bounds.bottom - 1; + minx := bounds.left; + maxx := bounds.right - 1; + + if minx < clip.Left then + minx := clip.Left; + if maxx < clip.Left then + result := false; + + if maxx > clip.Right - 1 then + maxx := clip.Right- 1; + if minx > clip.Right - 1 then + result := false; + + if miny < clip.Top then + miny := clip.Top; + if maxy < clip.Top then + result := false; + + if maxy > clip.Bottom - 1 then + maxy := clip.Bottom - 1; + if miny > clip.Bottom - 1 then + result := false; +end; + +procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer); +begin + ix1 := trunc(x1); + if frac(x1)>0.5 then inc(ix1) + else if frac(x1)<=-0.5 then dec(ix1); + ix2 := trunc(x2)-1; + if frac(x2)>0.5 then inc(ix2) + else if frac(x2)<=-0.5 then dec(ix2); + if ix1 < minx then ix1 := minx; + if ix2 >= maxx then ix2 := maxx; +end; + +function IsPointInPolygon(const points: ArrayOfTPointF; point: TPointF + ; windingMode: boolean): boolean; +var info: TBGRACustomFillInfo; +begin + info := TSimpleFillPolyInfo.Create(points); + result := info.IsPointInside(point.x+0.5,point.y+0.5,windingMode); + info.free; +end; + +function IsPointInEllipse(x, y, rx, ry: single; point: TPointF): boolean; +var info: TBGRACustomFillInfo; +begin + info := TFillEllipseInfo.Create(x,y,rx,ry); + result := info.IsPointInside(point.x+0.5,point.y+0.5,false); + info.free; +end; + +function IsPointInRoundRectangle(x1, y1, x2, y2, rx, ry: single; point: TPointF + ): boolean; +var info: TBGRACustomFillInfo; +begin + info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,[]); + result := info.IsPointInside(point.x+0.5,point.y+0.5,false); + info.free; +end; + +function IsPointInRectangle(x1, y1, x2, y2: single; point: TPointF): boolean; +begin + with point do + result := (((x1x)) or ((x1>x) and (x2y)) or ((y1>y) and (y2 0 then + begin + valueValue := value+(value shl 16); + while count > 0 do + begin + inc(plongword(dest)^, valueValue); + inc(dest,2); + dec(count); + end; + end; + if lastAdd <> 0 then + inc(dest^, value); +end; + +function DivByAntialiasPrecision(value: UInt32or64): UInt32or64; +begin // + result := value shr AntialiasPrecisionShift;// div AntialiasPrecision; +end; + +function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64; +begin // + result := value shr (AntialiasPrecisionShift+8);// div (256*AntialiasPrecision); +end; + +function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64; +begin // + result := value shr (AntialiasPrecisionShift+16);//div (65536*AntialiasPrecision); +end; + +{ TFillRectangleInfo } + +function TFillRectangleInfo.GetBottomRight: TPointF; +begin + result := PointF(FX2-0.5,FY2-0.5); +end; + +function TFillRectangleInfo.GetTopLeft: TPointF; +begin + result := PointF(FX1-0.5,FY1-0.5); +end; + +function TFillRectangleInfo.NbMaxIntersection: integer; +begin + Result:= 2; +end; + +procedure TFillRectangleInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +begin + if (cury >= FY1) and (cury <= FY2) then + begin + inter[nbinter].interX := FX1; + inter[nbinter].winding := -windingFactor; + inter[nbinter].numSegment := 0; + Inc(nbinter); + inter[nbinter].interX := FX2; + inter[nbinter].winding := +windingFactor; + inter[nbinter].numSegment := 1; + Inc(nbinter); + end; +end; + +constructor TFillRectangleInfo.Create(x1, y1, x2, y2: single; + APixelCenteredCoordinates: boolean); +var + temp: Single; +begin + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if APixelCenteredCoordinates then + begin + FX1 := x1 + 0.5; + FY1 := y1 + 0.5; + FX2 := x2 + 0.5; + FY2 := y2 + 0.5; + end else + begin + FX1 := x1; + FY1 := y1; + FX2 := x2; + FY2 := y2; + end; + WindingFactor := 1; +end; + +function TFillRectangleInfo.GetBounds: TRect; +begin + result := rect(floor(fx1),floor(fy1),floor(fx2)+1,floor(fy2)+1); +end; + +{ TFillShapeInfo } + +function TFillShapeInfo.GetBounds: TRect; +begin + Result := rect(0, 0, 0, 0); +end; + + +function TFillShapeInfo.IsPointInside(x, y: single; windingMode: boolean + ): boolean; +var + i,nbInter: integer; +begin + if FPointInsideInter = nil then + FPointInsideInter := CreateIntersectionArray; + ComputeAndSort(y,FPointInsideInter,nbInter,windingMode); + i := 0; + while i+1 < nbInter do + begin + if (FPointInsideInter[i].interX < x) and (FPointInsideInter[i+1].interX > x) then + begin + result := true; + FreeIntersectionArray(FPointInsideInter); + exit; + end; + inc(i,2); + end; + result := false; +end; + +function TFillShapeInfo.NbMaxIntersection: integer; +begin + Result := 0; +end; + +destructor TFillShapeInfo.Destroy; +begin + FreeIntersectionArray(FPointInsideInter); + inherited Destroy; +end; + +function TFillShapeInfo.SegmentsCurved: boolean; +begin + result := false; +end; + +function TFillShapeInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + result := TIntersectionInfo.Create; +end; + +procedure TFillShapeInfo.FreeIntersectionArray( + var inter: ArrayOfTIntersectionInfo); +var + i: Integer; +begin + for i := 0 to high(inter) do + inter[i].free; + inter := nil; +end; + +{$hints off} +procedure TFillShapeInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +begin + +end; +{$hints on} + +procedure TFillShapeInfo.SortIntersection(var inter: ArrayOfTIntersectionInfo; nbInter: integer); +var + i,j,k: Integer; + tempInter: TIntersectionInfo; +begin + if nbInter > 10 then + InternalQuickSortIntersection(@inter[0], 0, nbInter-1); + for i := 1 to nbinter - 1 do + begin + j := i; + while (j > 0) and (inter[i].interX < inter[j-1].interX) do dec(j); + if j <> i then + begin + tempInter := inter[i]; + for k := i-1 downto j do + inter[k+1] := inter[k]; + inter[j] := tempInter; + end; + end; +end; + +procedure TFillShapeInfo.InternalQuickSortIntersection(inter0: pointer; + idxL, idxH: Integer); +const Stride = sizeof(pointer); + MinSub = 10; +type PIntersectionInfo = ^TIntersectionInfo; +var + ls,hs : Integer; + li,hi : Integer; + mi : Integer; + ms : Integer; + pb : PByte; + tempInfo: TIntersectionInfo; + m: Single; +begin + pb:=PByte(inter0); + li:=idxL; + hi:=idxH; + mi:=(li+hi) div 2; + ls:=li*Stride; + hs:=hi*Stride; + ms:=mi*Stride; + m := PIntersectionInfo(pb+ms)^.interX; + repeat + while PIntersectionInfo(pb+ls)^.interX < m do begin + inc(ls, Stride); + inc(li); + end; + while m < PIntersectionInfo(pb+hs)^.interX do begin + dec(hs, Stride); + dec(hi); + end; + if ls <= hs then begin + tempInfo := PIntersectionInfo(pb+ls)^; + PIntersectionInfo(pb+ls)^ := PIntersectionInfo(pb+hs)^; + PIntersectionInfo(pb+hs)^ := tempInfo; + inc(ls, Stride); inc(li); + dec(hs, Stride); dec(hi); + end; + until ls>hs; + if hi>=idxL+MinSub-1 then InternalQuickSortIntersection(inter0, idxL, hi); + if li+MinSub-1<=idxH then InternalQuickSortIntersection(inter0, li, idxH); +end; + +procedure TFillShapeInfo.ConvertFromNonZeroWinding(var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var windingSum,prevSum,i,nbAlternate: integer; + tempInfo: TIntersectionInfo; +begin + windingSum := 0; + nbAlternate := 0; + for i := 0 to nbInter-1 do + begin + prevSum := windingSum; + inc(windingSum, inter[i].winding); + if (windingSum = 0) xor (prevSum = 0) then + begin + if nbAlternate<>i then + begin + tempInfo := inter[nbAlternate]; + inter[nbAlternate] := inter[i]; + inter[i] := tempInfo; + end; + inc(nbAlternate); + end; + end; + nbInter := nbAlternate; +end; + +procedure TFillShapeInfo.ComputeAndSort(cury: single; + var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); +begin + nbInter := 0; + ComputeIntersection(cury,inter,nbInter); + if nbInter < 2 then exit; + SortIntersection(inter,nbInter); + if windingMode then ConvertFromNonZeroWinding(inter,nbInter); +end; + +function TFillShapeInfo.GetSliceIndex: integer; +begin + result := 0; +end; + +function TFillShapeInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; +var + i: Integer; +begin + setlength(result, NbMaxIntersection); + for i := 0 to high(result) do + result[i] := CreateIntersectionInfo; +end; + +function ComputeWinding(y1,y2: single): integer; +begin + if y2 > y1 then result := 1 else + if y2 < y1 then result := -1 else + result := 0; +end; + +type + arrayOfSingle = array of single; + +procedure InsertionSortSingles(var a: arrayOfSingle); +var i,j: integer; + temp: single; +begin + for i := 1 to high(a) do + begin + Temp := a[i]; + j := i; + while (j>0) and (a[j-1]> Temp) do + begin + a[j] := a[j-1]; + dec(j); + end; + a[j] := Temp; + end; +end; + +function PartitionSingles(var a: arrayOfSingle; left,right: integer): integer; + + procedure Swap(idx1,idx2: integer); inline; + var temp: single; + begin + temp := a[idx1]; + a[idx1] := a[idx2]; + a[idx2] := temp; + end; + +var pivotIndex: integer; + pivotValue: single; + storeIndex: integer; + i: integer; + +begin + pivotIndex := left + random(right-left+1); + pivotValue := a[pivotIndex]; + swap(pivotIndex,right); + storeIndex := left; + for i := left to right-1 do + if a[i] <= pivotValue then + begin + swap(i,storeIndex); + inc(storeIndex); + end; + swap(storeIndex,right); + result := storeIndex; +end; + +procedure QuickSortSingles(var a: arrayOfSingle; left,right: integer); +var pivotNewIndex: integer; +begin + if right > left+9 then + begin + pivotNewIndex := PartitionSingles(a,left,right); + QuickSortSingles(a,left,pivotNewIndex-1); + QuickSortSingles(a,pivotNewIndex+1,right); + end; +end; + +procedure SortSingles(var a: arrayOfSingle); +begin + if length(a) < 10 then InsertionSortSingles(a) else + begin + QuickSortSingles(a,0,high(a)); + InsertionSortSingles(a); + end; +end; + +procedure RemoveSingleDuplicates(var a: arrayOfSingle; var nb: integer); +var i,idx: integer; +begin + idx := 0; + for i := 1 to nb-1 do + begin + if a[i] <> a[idx] then + begin + inc(idx); + a[idx] := a[i]; + end; + end; + nb := idx+1; +end; + +function BinarySearchSingle(value: single; var a: arrayOfSingle; left,right: integer): integer; +var pivotIndex: integer; + pivotValue: single; +begin + pivotIndex := (left+right) div 2; + pivotValue := a[pivotIndex]; + if value = pivotValue then + result := pivotIndex else + if value < pivotValue then + begin + if pivotIndex = left then result := left else + result := BinarySearchSingle(value, a, left,pivotIndex-1); + end else + begin + if pivotIndex = right then result := right+1 else + result := BinarySearchSingle(value, a, pivotIndex+1, right); + end; +end; + +{ TCustomFillPolyInfo } + +constructor TCustomFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); +var + cur, first, i, j: integer; + p, pNext: PCustomPointRecord; + tempCoord: TPointF; + tempBool: Boolean; + +begin + InitPoints(points); + FSegmentsDataCreated:= false; + if FPoints=nil then + begin + FBoundsF := EmptyRectF; + exit; + end; + + //look for empty points, correct coordinate and successors + cur := -1; + first := -1; + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if not isEmptyPointF(p^.coord) then + begin + p^.empty := False; + if APixelCenteredCoordinates then + p^.coord.Offset(0.5,0.5); + if cur <> -1 then + FPoints[cur].next := i; + if first = -1 then + first := i; + cur := i; + end + else + begin + if (first <> -1) and (cur <> first) then + FPoints[cur].next := first; + + p^.empty := True; + p^.next := -1; + cur := -1; + first := -1; + end; + inc(p); + end; + if (first <> -1) and (cur <> first) then + FPoints[cur].next := first; + + FBoundsF := RectF(FPoints[0].coord,FPoints[0].coord); + + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if not p^.empty then + begin + if p^.x < FBoundsF.Left then FBoundsF.Left := p^.x else + if p^.x > FBoundsF.Right then FBoundsF.Right := p^.x; + if p^.y < FBoundsF.Top then FBoundsF.Top := p^.y else + if p^.y > FBoundsF.Bottom then FBoundsF.Bottom := p^.y; + end; + if p^.next <> -1 then + begin + pNext := @FPoints[p^.next]; + p^.coord2 := pNext^.coord; + end; + inc(p); + end; + + //compute slopes + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if not p^.empty then + begin + p^.winding := ComputeWinding(p^.y, p^.y2); + if p^.winding<>0 then + p^.slope := (p^.x2 - p^.x) / (p^.y2 - p^.y) + else + p^.slope := EmptySingle; + end + else + p^.slope := EmptySingle; + inc(p); + end; + + //check if end points are included + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if not p^.empty then + begin + j := p^.next; + pNext := @FPoints[j]; + if p^.winding > 0 then + p^.includeEndingPoint := pNext^.winding < 0 + else if p^.winding < 0 then + p^.includeEndingPoint := pNext^.winding >= 0 + else + p^.includeStartingPoint := false; + + if pNext^.winding > 0 then + pNext^.includeStartingPoint := true + else if pNext^.winding < 0 then + pNext^.includeStartingPoint := p^.winding <> 0; + end; + inc(p); + end; + + //flip vertically to have always top to bottom + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if p^.winding < 0 then + begin + tempCoord := p^.coord; + p^.coord := p^.coord2; + p^.coord2 := tempCoord; + tempBool := p^.includeStartingPoint; + p^.includeStartingPoint := p^.includeEndingPoint; + p^.includeEndingPoint := tempBool; + end; + inc(p); + end; +end; + +destructor TCustomFillPolyInfo.Destroy; +var + i: Integer; +begin + for i := 0 to high(FPoints) do + freemem(FPoints[i].data); + inherited Destroy; +end; + +function TCustomFillPolyInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; +var + i: Integer; +begin + CreateSegmentsData; + setlength(result, NbMaxIntersection); + for i := 0 to high(result) do + result[i] := nil; +end; + +function TCustomFillPolyInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +begin + result := nil; +end; + +procedure TCustomFillPolyInfo.FreeSegmentData(data: pointer); +begin + freemem(data); +end; + +function TCustomFillPolyInfo.GetBounds: TRect; +begin + with FBoundsF do + result := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); +end; + +function TCustomFillPolyInfo.GetBoundsF: TRectF; +begin + result := FBoundsF; +end; + +function TCustomFillPolyInfo.GetNbPoints: integer; +begin + result := length(FPoints); +end; + +function TCustomFillPolyInfo.NbMaxIntersection: integer; +begin + Result := length(FPoints); +end; + +procedure TCustomFillPolyInfo.SetIntersectionValues(AInter: TIntersectionInfo; + AInterX: Single; AWinding, ANumSegment: integer; dy: single; AData: pointer); +begin + AInter.SetValues( AInterX, AWinding, ANumSegment ); +end; + +procedure TCustomFillPolyInfo.InitPoints(const points: array of TPointF); +const + minDist = 0.00390625; //1 over 256 + +var + i, first, nbP: integer; + + function PointAlmostEqual(const p1,p2: TPointF): boolean; + begin + result := (abs(p1.x-p2.x) < minDist) and (abs(p1.y-p2.y) < minDist); + end; + + procedure EndOfSubPolygon; + begin + //if there is a subpolygon + if first<>-1 then + begin + //last point is the same as first point? + if (nbP >= first+2) and PointAlmostEqual(FPoints[nbP-1].coord,FPoints[first].coord) then + dec(nbP); //remove superfluous looping point + + if (nbP <= first+2) then //are there only one or two points? + begin + //remove subpolygon because we need at least a triangle + nbP := first; + first := -1; + end; + + end; + end; + +begin + setlength(FPoints, length(points)); + nbP := 0; + first := -1; + for i := 0 to high(points) do + if isEmptyPointF(points[i]) then + begin + EndOfSubPolygon; + if first<>-1 then + begin + FPoints[nbP].originalIndex := i; + FPoints[nbP].coord := EmptyPointF; + inc(nbP); + first := -1; + end; + end else + if (first=-1) or not PointAlmostEqual(FPoints[nbP-1].coord,points[i]) then + begin + if first = -1 then first := nbP; + FPoints[nbP].originalIndex := i; + FPoints[nbP].coord := points[i]; + inc(nbP); + end; + EndOfSubPolygon; + //if last point was a subpolygon delimiter (EmptyPointF) then removes it + if (nbP > 0) and isEmptyPointF(FPoints[nbP-1].coord) then dec(nbP); + + setlength(FPoints, nbP); +end; + +procedure TCustomFillPolyInfo.CreateSegmentsData; +var + i: Integer; + p: PCustomPointRecord; +begin + if FSegmentsDataCreated then exit; + FSegmentsDataCreated := true; + if FPoints<>nil then + begin + p := @FPoints[0]; + for i := 0 to high(FPoints) do + begin + if not p^.empty and (p^.slope <> EmptySingle) then + begin + if p^.winding < 0 then + p^.data := CreateSegmentData(p^.next,i, p) + else + p^.data := CreateSegmentData(i,p^.next, p); + end; + inc(p); + end; + end; +end; + +{ TFillPolyInfo } + +function TFillPolyInfo.NbMaxIntersection: integer; +begin + Result:= FMaxIntersection; +end; + +procedure TFillPolyInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var + j: integer; + cust: PCustomPointRecord; + pInter: PIntersectionInfo; +begin + if length(FSlices)=0 then exit; + + while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice); + while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice); + + pInter := @inter[nbInter]; + with FSlices[FCurSlice] do + if (cury >= y1) and (cury < y2) then + begin + for j := 0 to nbSegments-1 do + begin + cust := segments[j].custom; + if pInter^ = nil then pInter^ := CreateIntersectionInfo; + SetIntersectionValues(pInter^, (cury - cust^.y) * cust^.slope + cust^.x, + cust^.winding, segments[j].id, cury - cust^.y, cust^.data ); + Inc(nbinter); + inc(pInter); + end; + end; +end; + +constructor TFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); + function AddSeg(numSlice: integer): integer; + begin + result := FSlices[numSlice].nbSegments; + if length(FSlices[numSlice].segments)=FSlices[numSlice].nbSegments then + setlength(FSlices[numSlice].segments,FSlices[numSlice].nbSegments*2+2); + inc(FSlices[numSlice].nbSegments); + end; + +var + yList: array of single; + nbYList: integer; + ya,yb,temp: single; + sliceStart,sliceEnd,idxSeg: integer; + i,j,idSeg: integer; + +begin + inherited Create(points, APixelCenteredCoordinates); + + //slice + nbYList:= length(FPoints)*2; + setlength(YList, nbYList); + for i := 0 to high(FPoints) do + begin + YList[i*2] := FPoints[i].y; + YList[i*2+1] := FPoints[i].y2; + end; + + SortSingles(YList); + RemoveSingleDuplicates(YList, nbYList); + + setlength(FSlices, nbYList-1); + for i := 0 to high(FSlices) do + begin + FSlices[i].y1 := YList[i]; + FSlices[i].y2 := YList[i+1]; + FSlices[i].nbSegments := 0; + end; + + idSeg := 0; + for j := 0 to high(FPoints) do + begin + if FPoints[j].slope<>EmptySingle then + begin + ya := FPoints[j].y; + yb := FPoints[j].y2; + if yb < ya then + begin + temp := ya; + ya := yb; + yb := temp; + end; + sliceStart := BinarySearchSingle(ya,YList,0,nbYList-1); + sliceEnd := BinarySearchSingle(yb,YList,0,nbYList-1); + if sliceEnd > high(FSlices) then sliceEnd := high(FSlices); + for i := sliceStart to sliceEnd do + begin + if ((FPoints[j].y < FSlices[i].y2) and + (FPoints[j].y2 > FSlices[i].y1)) or + ((FPoints[j].y2 < FSlices[i].y2) and + (FPoints[j].y > FSlices[i].y1)) then + begin + idxSeg := AddSeg(i); + with FSlices[i].segments[idxSeg] do + begin + inc(idSeg); + id := idSeg; + custom:= @FPoints[j]; + end; + end; + end; + end; + end; + + FCurSlice := 0; + FMaxIntersection:= 0; + for i := 0 to high(FSlices) do + if FSlices[i].nbSegments > FMaxIntersection then + FMaxIntersection:= FSlices[i].nbSegments; +end; + +function TFillPolyInfo.GetSliceIndex: integer; +begin + Result:= FCurSlice; +end; + +{ TOnePassFillPolyInfo } + +function TOnePassFillPolyInfo.PartitionByY(left,right: integer): integer; + + procedure Swap(idx1,idx2: integer); inline; + var temp: POnePassRecord; + begin + temp := FSortedByY[idx1]; + FSortedByY[idx1] := FSortedByY[idx2]; + FSortedByY[idx2] := temp; + end; + +var pivotIndex: integer; + pivotValue: single; + storeIndex: integer; + i: integer; + +begin + pivotIndex := left + random(right-left+1); + pivotValue := FSortedByY[pivotIndex]^.custom^.y; + swap(pivotIndex,right); + storeIndex := left; + for i := left to right-1 do + if FSortedByY[i]^.custom^.y <= pivotValue then + begin + swap(i,storeIndex); + inc(storeIndex); + end; + swap(storeIndex,right); + result := storeIndex; +end; + +procedure TOnePassFillPolyInfo.QuickSortByY(left,right: integer); +var pivotNewIndex: integer; +begin + if right > left+9 then + begin + pivotNewIndex := PartitionByY(left,right); + QuickSortByY(left,pivotNewIndex-1); + QuickSortByY(pivotNewIndex+1,right); + end; +end; + +procedure TOnePassFillPolyInfo.InsertionSortByY; +var i,j: integer; + tempValue: single; + tempPtr: POnePassRecord; +begin + for i := 1 to high(FSortedByY) do + begin + tempPtr := FSortedByY[i]; + TempValue := tempPtr^.custom^.y; + j := i; + while (j>0) and (FSortedByY[j-1]^.custom^.y > TempValue) do + begin + FSortedByY[j] := FSortedByY[j-1]; + dec(j); + end; + FSortedByY[j] := tempPtr; + end; +end; + +procedure TOnePassFillPolyInfo.SortByY; +var i,nbSorted: integer; +begin + setlength(FSortedByY, length(FPoints)); + nbSorted := 0; + for i := 0 to high(FSortedByY) do + if not FPoints[i].empty then + begin + FSortedByY[nbSorted] := @FOnePass[i]; + inc(nbSorted); + end; + setlength(FSortedByY,nbSorted); + if length(FSortedByY) < 10 then InsertionSortByY else + begin + QuickSortByY(0,high(FSortedByY)); + InsertionSortByY; + end; +end; + +procedure TOnePassFillPolyInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var + p,pprev,pnext: POnePassRecord; +{ t: TextFile; + i: Integer; } + pCust: PCustomPointRecord; + pInter: PIntersectionInfo; +begin + FShouldInitializeDrawing := true; + + p := FFirstWaiting; + while p <> nil do + begin + if (cury >= p^.custom^.y) then + begin + if cury <= p^.custom^.y2+1 then + begin + p^.nextDrawing := FFirstDrawing; + FFirstDrawing := p; + inc(FSliceIndex); + end; + end + else break; + p := p^.nextWaiting; + end; + FFirstWaiting:= p; + + p := FFirstDrawing; + pprev := nil; + pInter := @inter[nbInter]; + while p <> nil do + begin + pnext := p^.nextDrawing; + pCust := p^.custom; + if (((cury > pCust^.y) and (cury < pCust^.y2)) or + (pCust^.includeStartingPoint and (cury = pCust^.y)) or + (pCust^.includeEndingPoint and (cury = pCust^.y2))) then + begin + if pInter^ = nil then pInter^ := CreateIntersectionInfo; + SetIntersectionValues(pInter^, (cury - pCust^.y)*pCust^.slope + pCust^.x, + pCust^.winding, p^.id, cury - pCust^.y, pCust^.data); + inc(nbinter); + inc(pInter); + end else + if (cury > pCust^.y2+1) then + begin + if pprev <> nil then + pprev^.nextDrawing := pnext + else + FFirstDrawing:= pnext; + p := pnext; + Inc(FSliceIndex); + continue; + end; + pprev := p; + p := pnext; + end; +{ if odd(nbInter) then + begin + assignfile(t, 'polygon.dump'); + rewrite(t); + writeln(t,'Polygon tested at ',cury); + for i := 0 to NbPoints-1 do + if isEmptyPointF(FPoints[i]) then write(t,'] [') else + write(t,FPoints[i].x, ',', FPoints[i].y,' '); + writeln(t); + writeln(t,'Drawing'); + p := FFirstDrawing; + while p <> nil do + begin + if ((p^.winding > 0) and + (((cury > p^.y1) and (cury < p^.y2)) or + (p^.includeStartingPoint and (cury = p^.y1)) or + (p^.includeEndingPoint and (cury = p^.y2)))) or + ((p^.winding < 0) and + (((cury > p^.y1) and (cury < p^.y2)) or + (p^.includeStartingPoint and (cury = p^.y2)) or + (p^.includeEndingPoint and (cury = p^.y1)))) then + write(t,'* ') else write(t,'- '); + + writeln(t,p^.x1,',',p^.y1,' ',p^.x2,',',p^.y2,' ',p^.winding,' ',BoolToStr(p^.includeEndingPoint,'end incl','end not incl')); + p := p^.nextDrawing; + end; + closefile(t); + + raise exception.Create('Even intersections expected'); + end; } +end; + +constructor TOnePassFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); +var i,j: integer; + p: POnePassRecord; +begin + inherited create(points, APixelCenteredCoordinates); + + FShouldInitializeDrawing := true; + setlength(FOnePass, length(FPoints)); + for i := 0 to high(FPoints) do + if not FPoints[i].empty then + begin + p := @FOnePass[i]; + p^.id := i; + j := FPoints[i].next; + p^.next := @FOnePass[j]; + p^.custom:= @FPoints[i]; + end; + + SortByY; + FSliceIndex := 0; +end; + +function TOnePassFillPolyInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; +var i: integer; + p,pprev: POnePassRecord; +begin + if FShouldInitializeDrawing then + begin + FShouldInitializeDrawing := false; + FFirstWaiting:= nil; + pprev := nil; + for i := 0 to high(FSortedByY) do + begin + p := FSortedByY[i]; + if p^.custom^.slope <> EmptySingle then + begin + if pprev <> nil then + pprev^.nextWaiting:= p + else + FFirstWaiting := p; + pprev := p; + end; + end; + end; + result := inherited CreateIntersectionArray; +end; + +function TOnePassFillPolyInfo.GetSliceIndex: integer; +begin + Result:= FSliceIndex; +end; + +{ TSimpleFillPolyInfo } + +procedure TSimpleFillPolyInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var i: integer; + p: PCustomPointRecord; + pInter: PIntersectionInfo; +begin + if FPoints = nil then exit; + p := @FPoints[0]; + pInter := @inter[nbInter]; + for i := 0 to high(FPoints) do + begin + if (p^.winding <> 0) and + ( ((cury > p^.y) and (cury < p^.y2)) or + (p^.includeStartingPoint and (cury = p^.y)) or + (p^.includeEndingPoint and (cury = p^.y2)) ) then + begin + if pInter^ = nil then pInter^ := CreateIntersectionInfo; + SetIntersectionValues(pInter^, (cury - p^.y)*p^.slope + p^.x, p^.winding, i, cury - p^.y, p^.data); + inc(nbinter); + inc(pInter); + end; + inc(p); + end; +end; + +constructor TSimpleFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); +begin + inherited Create(points, APixelCenteredCoordinates); +end; + +{ TFillEllipseInfo } + +constructor TFillEllipseInfo.Create(x, y, rx, ry: single); +begin + FX := x + 0.5; + FY := y + 0.5; + FRX := abs(rx); + FRY := abs(ry); + WindingFactor := 1; + FSliceIndex:= -1; +end; + +function TFillEllipseInfo.GetBounds: TRect; +begin + Result := rect(floor(fx - frx), floor(fy - fry), ceil(fx + frx), ceil(fy + fry)); +end; + +function TFillEllipseInfo.SegmentsCurved: boolean; +begin + Result:= true; +end; + +function TFillEllipseInfo.GetSliceIndex: integer; +begin + Result:= FSliceIndex; +end; + +function TFillEllipseInfo.GetCenter: TPointF; +begin + result := PointF(FX-0.5,FY-0.5); +end; + +function TFillEllipseInfo.NbMaxIntersection: integer; +begin + Result := 2; +end; + +procedure TFillEllipseInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var + d: single; +begin + if (FRY <= 0) or (FRX <= 0) then exit; + d := sqr((cury - FY) / FRY); + if d < 1 then + begin + d := sqrt(1 - d) * FRX; + inter[nbinter].SetValues( FX - d, -windingFactor, 0); + Inc(nbinter); + inter[nbinter].SetValues( FX + d, windingFactor, 1); + Inc(nbinter); + FSliceIndex := 0; + end else + begin + if cury < FY then + FSliceIndex:= -1 + else + FSliceIndex:= 1; + end; +end; + +{ TFillBorderEllipseInfo } + +constructor TFillBorderEllipseInfo.Create(x, y, rx, ry, w: single); +begin + if rx < 0 then + rx := -rx; + if ry < 0 then + ry := -ry; + FOuterBorder := TFillEllipseInfo.Create(x, y, rx + w / 2, ry + w / 2); + if (rx > w / 2) and (ry > w / 2) then + begin + FInnerBorder := TFillEllipseInfo.Create(x, y, rx - w / 2, ry - w / 2); + FInnerBorder.WindingFactor := -1; + end + else + FInnerBorder := nil; +end; + +function TFillBorderEllipseInfo.GetBounds: TRect; +begin + Result := FOuterBorder.GetBounds; +end; + +function TFillBorderEllipseInfo.SegmentsCurved: boolean; +begin + Result:= FOuterBorder.SegmentsCurved; + if FInnerBorder <> nil then result := result or FInnerBorder.SegmentsCurved; +end; + +function TFillBorderEllipseInfo.NbMaxIntersection: integer; +begin + Result := 4; +end; + +procedure TFillBorderEllipseInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +begin + FOuterBorder.ComputeIntersection(cury, inter, nbInter); + if FInnerBorder <> nil then + FInnerBorder.ComputeIntersection(cury, inter, nbInter); +end; + +destructor TFillBorderEllipseInfo.Destroy; +begin + FOuterBorder.Free; + if FInnerBorder <> nil then + FInnerBorder.Free; + inherited Destroy; +end; + +function TFillBorderEllipseInfo.GetSliceIndex: integer; +begin + Result:= FOuterBorder.GetSliceIndex; +end; + +{ TFillRoundRectangleInfo } + +constructor TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); +var + temp: Single; +begin + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if APixelCenteredCoordinates then + begin + FX1 := x1 + 0.5; + FY1 := y1 + 0.5; + FX2 := x2 + 0.5; + FY2 := y2 + 0.5; + end else + begin + FX1 := x1; + FY1 := y1; + FX2 := x2; + FY2 := y2; + end; + FRX := abs(rx); + FRY := abs(ry); + if 2*FRX > x2-x1 then FRX := (x2-x1)/2; + if 2*FRY > y2-y1 then FRY := (y2-y1)/2; + FOptions:= options; + WindingFactor := 1; +end; + +function TFillRoundRectangleInfo.SegmentsCurved: boolean; +begin + if (not (rrTopLeftSquare in FOptions) and not (rrTopLeftBevel in FOptions)) or + (not (rrTopRightSquare in FOptions) and not (rrTopRightBevel in FOptions)) or + (not (rrBottomRightSquare in FOptions) and not (rrBottomRightBevel in FOptions)) or + (not (rrBottomLeftSquare in FOptions) and not (rrBottomLeftBevel in FOptions)) then + result := true else result := false; +end; + +function TFillRoundRectangleInfo.GetBounds: TRect; +begin + result := rect(floor(fx1),floor(fy1),floor(fx2)+1,floor(fy2)+1); +end; + +function TFillRoundRectangleInfo.GetBottomRight: TPointF; +begin + result := PointF(FX2-0.5,FY2-0.5); +end; + +function TFillRoundRectangleInfo.GetTopLeft: TPointF; +begin + result := PointF(FX1-0.5,FY1-0.5); +end; + +function TFillRoundRectangleInfo.NbMaxIntersection: integer; +begin + result := 2; +end; + +procedure TFillRoundRectangleInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +var + d,d2: single; +begin + if (cury >= FY1) and (cury <= FY2) then + begin + if cury < FY1+FRY then + begin + d := abs((cury - (FY1+FRY)) / FRY); + if d > 1 then d2 := 0 + else d2 := sqrt(1 - sqr(d)) * FRX; + + if rrTopLeftSquare in FOptions then + inter[nbinter].interX := FX1 else + if rrTopLeftBevel in FOptions then + inter[nbinter].interX := FX1 + d*FRX + else + inter[nbinter].interX := FX1 + FRX - d2; + inter[nbinter].winding := -windingFactor; + inter[nbinter].numSegment := 0; + Inc(nbinter); + + if rrTopRightSquare in FOptions then + inter[nbinter].interX := FX2 else + if rrTopRightBevel in FOptions then + inter[nbinter].interX := FX2 - d*FRX + else + inter[nbinter].interX := FX2 - FRX + d2; + inter[nbinter].winding := +windingFactor; + inter[nbinter].numSegment := 1; + Inc(nbinter); + end else + if cury > FY2-FRY then + begin + d := abs((cury - (FY2-FRY)) / FRY); + if d > 1 then d2 := 0 + else d2 := sqrt(1 - sqr(d)) * FRX; + + if rrBottomLeftSquare in FOptions then + inter[nbinter].interX := FX1 else + if rrBottomLeftBevel in FOptions then + inter[nbinter].interX := FX1 + d*FRX + else + inter[nbinter].interX := FX1 + FRX - d2; + inter[nbinter].winding := -windingFactor; + inter[nbinter].numSegment := 0; + Inc(nbinter); + + if rrBottomRightSquare in FOptions then + inter[nbinter].interX := FX2 else + if rrBottomRightBevel in FOptions then + inter[nbinter].interX := FX2 - d*FRX + else + inter[nbinter].interX := FX2 - FRX + d2; + inter[nbinter].winding := +windingFactor; + inter[nbinter].numSegment := 1; + Inc(nbinter); + end else + begin + inter[nbinter].interX := FX1; + inter[nbinter].winding := -windingFactor; + inter[nbinter].numSegment := 0; + Inc(nbinter); + inter[nbinter].interX := FX2; + inter[nbinter].winding := +windingFactor; + inter[nbinter].numSegment := 1; + Inc(nbinter); + end; + end; +end; + +{ TFillBorderRoundRectInfo } + +constructor TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); +var rdiff: single; + temp: Single; +begin + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + + if rx < 0 then + rx := -rx; + if ry < 0 then + ry := -ry; + if 2*rx > x2-x1 then rx := (x2-x1)/2; + if 2*ry > y2-y1 then ry := (y2-y1)/2; + rdiff := w*(sqrt(2)-1); + FOuterBorder := TFillRoundRectangleInfo.Create(x1-w/2,y1-w/2,x2+w/2,y2+w/2, rx+rdiff, ry+rdiff, options, APixelCenteredCoordinates); + if (abs(x2-x1) > w) and (abs(y2-y1) > w) then + begin + if (rx-rdiff <= 0) or (ry-rdiff <= 0) then + FInnerBorder := TFillRoundRectangleInfo.Create(x1+w/2, y1+w/2, x2-w/2, y2-w/2, 0,0, options, APixelCenteredCoordinates) + else + FInnerBorder := TFillRoundRectangleInfo.Create(x1+w/2, y1+w/2, x2-w/2, y2-w/2, rx-rdiff, ry-rdiff, options, APixelCenteredCoordinates); + FInnerBorder.WindingFactor := -1; + end + else + FInnerBorder := nil; +end; + +function TFillBorderRoundRectInfo.GetBounds: TRect; +begin + result := FOuterBorder.GetBounds; +end; + +function TFillBorderRoundRectInfo.SegmentsCurved: boolean; +begin + Result:= FOuterBorder.SegmentsCurved; + if FInnerBorder <> nil then result := result or FInnerBorder.SegmentsCurved; +end; + +function TFillBorderRoundRectInfo.NbMaxIntersection: integer; +begin + Result := 4; +end; + +procedure TFillBorderRoundRectInfo.ComputeIntersection(cury: single; + var inter: ArrayOfTIntersectionInfo; var nbInter: integer); +begin + FOuterBorder.ComputeIntersection(cury, inter, nbInter); + if FInnerBorder <> nil then + FInnerBorder.ComputeIntersection(cury, inter, nbInter); +end; + +destructor TFillBorderRoundRectInfo.Destroy; +begin + FOuterBorder.Free; + FInnerBorder.Free; + inherited Destroy; +end; + +initialization + + Randomize; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterblur.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterblur.pas new file mode 100644 index 0000000..ecd712b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterblur.pas @@ -0,0 +1,1146 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFilterBlur; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, BGRABitmapTypes, BGRAFilterType; + +type + { TCustomBlurTask } + + TCustomBlurTask = class(TFilterTask) + private + FBounds: TRect; + FMask: TCustomUniversalBitmap; + FMaskOwned: boolean; + public + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false); + destructor Destroy; override; + protected + procedure DoExecute; override; + end; + + { TRadialBlurTask } + + TRadialBlurTask = class(TFilterTask) + private + FBounds: TRect; + FRadiusX,FRadiusY: single; + FBlurType: TRadialBlurType; + public + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single; + blurType: TRadialBlurType); overload; + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single; + blurType: TRadialBlurType); overload; + protected + procedure DoExecute; override; + end; + + { TMotionBlurTask } + + TMotionBlurTask = class(TFilterTask) + private + FBounds: TRect; + FDistance,FAngle: single; + FOriented: boolean; + public + constructor Create(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance, AAngle: single; AOriented: boolean); + protected + procedure DoExecute; override; + end; + +procedure FilterBlurCustom(bmp: TCustomUniversalBitmap; ABounds: TRect; + blurMask: TCustomUniversalBitmap; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +procedure FilterBlurMotion(bmp: TCustomUniversalBitmap; ABounds: TRect; distance: single; + angle: single; oriented: boolean; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +procedure FilterBlurRadial(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; + blurType: TRadialBlurType; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); + +implementation + +uses Math, SysUtils, BGRAGrayscaleMask, + BGRAGradientScanner; + +type + { TBoxBlurTask } + + TBoxBlurTask = class(TFilterTask) + private + FBounds: TRect; + FRadiusX,FRadiusY: single; + public + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single); overload; + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single); overload; + protected + procedure DoExecute; override; + end; + +{ TCustomBlurTask } + +constructor TCustomBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; + AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean); +begin + SetSource(bmp); + FBounds := ABounds; + if AMaskIsThreadSafe then + begin + FMask := AMask; + FMaskOwned := false; + end else + begin + FMask := AMask.Duplicate; + FMaskOwned := true; + end; +end; + +destructor TCustomBlurTask.Destroy; +begin + If FMaskOwned then FreeAndNil(FMask); + inherited Destroy; +end; + +procedure TCustomBlurTask.DoExecute; +begin + FilterBlurCustom(FSource,FBounds,FMask,Destination,@GetShouldStop); +end; + +{ TMotionBlurTask } + +constructor TMotionBlurTask.Create(ABmp: TBGRACustomBitmap; ABounds: TRect; + ADistance, AAngle: single; AOriented: boolean); +begin + SetSource(ABmp); + FBounds := ABounds; + FDistance := ADistance; + FAngle := AAngle; + FOriented:= AOriented; +end; + +procedure TMotionBlurTask.DoExecute; +begin + FilterBlurMotion(FSource,FBounds,FDistance,FAngle,FOriented,Destination,@GetShouldStop); +end; + +{ TRadialBlurTask } + +constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; + radius: single; blurType: TRadialBlurType); +begin + SetSource(bmp); + FBounds := ABounds; + FRadiusX := radius; + FRadiusY := radius; + FBlurType:= blurType; +end; + +constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; + radiusX, radiusY: single; blurType: TRadialBlurType); +begin + SetSource(bmp); + FBounds := ABounds; + FRadiusX := radiusX; + FRadiusY := radiusY; + FBlurType:= blurType; +end; + +procedure TRadialBlurTask.DoExecute; +begin + FilterBlurRadial(FSource,FBounds,FRadiusX,FRadiusY,FBlurType,Destination,@GetShouldStop); +end; + +procedure FilterBlurBoxRGBA(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; + ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); +var oldClip: TRect; +const + factMainX = 16; + factMainY = 16; +type + TAccumulator = LongWord; +{$i blurbox.inc} + +procedure FilterBlurBoxRGBA64(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; + ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); +var oldClip: TRect; +const + factMainX = 16; + factMainY = 16; +type + TAccumulator = UInt64; +{$DEFINE PARAM_USE_INC64} +{$i blurbox.inc} + +procedure FilterBlurBoxByte(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; + ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); +var oldClip: TRect; +const + factMainX = 16; + factMainY = 16; +type + TAccumulator = LongWord; +{$DEFINE PARAM_BYTEMASK} +{$i blurbox.inc} + +procedure FilterBlurBoxByte64(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; + ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); +var oldClip: TRect; +const + factMainX = 16; + factMainY = 16; +type + TAccumulator = UInt64; +{$DEFINE PARAM_BYTEMASK} +{$DEFINE PARAM_USE_INC64} +{$i blurbox.inc} + +procedure FilterBlurBox(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; + ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); +const + factMainX = 16; + factMainY = 16; +var + totalSum: UInt64; + factExtraX,factExtraY: UInt32or64; + {$IFNDEF CPU64}need64: Boolean;{$ENDIF} +begin + if ADestination.Colorspace <> ASource.Colorspace then + raise exception.Create('Colorspace mismatch'); + + totalSum := (2*ceil(ARadiusX)+1)*(2*ceil(ARadiusY)+1); + factExtraX := trunc(frac(ARadiusX+0.5/factMainX)*factMainX); + factExtraY := trunc(frac(ARadiusY+0.5/factMainY)*factMainY); + if factExtraX > 0 then totalSum := totalSum * factMainX; + if factExtraY > 0 then totalSum := totalSum * factMainY; + + if ASource.Colorspace = TBGRAPixelColorspace then + begin + {$IFNDEF CPU64} + need64 := totalSum > high(LongWord) div (256*256); + if not need64 then + FilterBlurBoxRGBA(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) else + {$ENDIF} + FilterBlurBoxRGBA64(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) + end + else if ASource.Colorspace = TByteMaskColorspace then + begin + {$IFNDEF CPU64} + need64 := totalSum > high(LongWord) div 256; + if not need64 then + FilterBlurBoxByte(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) else + {$ENDIF} + FilterBlurBoxByte64(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop); + end + else raise exception.Create('Unexpected colorspace: '+ASource.Colorspace.GetName); +end; + +{ This is a clever solution for fast computing of the blur + effect : it stores an array of vertical sums forming a square + around the pixel which moves with it. For each new pixel, + the vertical sums are kept except for the last column of + the square } +procedure FilterBlurFastRGBA(bmp: TCustomUniversalBitmap; ABounds: TRect; + radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); + {$IFDEF CPU64}{$DEFINE FASTBLUR_DOUBLE}{$ENDIF} + const BitMargin = 16; + type + PRowSum = ^TRowSum; + TRegularRowValue = UInt32or64; + TRowSum = record + sumR,sumG,sumB,rgbDiv,sumA,aDiv: TRegularRowValue; + end; + TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF}; + TExtendedRowSum = record + sumR,sumG,sumB,rgbDiv,sumA,aDiv: TExtendedRowValue; + end; + + procedure IncExt(var ADest: TExtendedRowValue; ADelta: TExtendedRowValue); + begin + ADest := ADest + ADelta; + end; + + procedure AccumulatePixel(psrc: Pointer; w: UInt32or64; var sums: TRowSum; verticalWeightShift: Int32or64); inline; + var + c: LongWord; + begin + with sums do + begin + c := PLongWord(psrc)^; + Inc(aDiv, w); + w := w * ((c shr TBGRAPixel_AlphaShift) and $ff); + inc(sumA, w); + w := w shr verticalWeightShift; + inc(rgbDiv, w); + {$hints off} + inc(sumR, ((c shr TBGRAPixel_RedShift) and $ff)*w ); + inc(sumG, ((c shr TBGRAPixel_GreenShift) and $ff)*w ); + inc(sumB, ((c shr TBGRAPixel_BlueShift) and $ff)*w ); + {$hints on} + end; + end; + + procedure AccumulateExtended(var ex: TExtendedRowSum; psum: PRowSum; w: UInt32or64); inline; + begin + with psum^ do + begin + IncExt(ex.sumA, TExtendedRowValue(sumA)*w); + IncExt(ex.aDiv, TExtendedRowValue(aDiv)*w); + IncExt(ex.sumR, TExtendedRowValue(sumR)*w); + IncExt(ex.sumG, TExtendedRowValue(sumG)*w); + IncExt(ex.sumB, TExtendedRowValue(sumB)*w); + IncExt(ex.rgbDiv, TExtendedRowValue(rgbDiv)*w); + end; + end; + + procedure AccumulateShr(var total: TRowSum; psum: PRowSum; w: UInt32or64; horizontalWeightShift: Int32or64); inline; + var + addDiv2: Int32or64; + begin + with psum^ do + begin + addDiv2 := 1 shl (horizontalWeightShift-1); + inc(total.sumA, (sumA*w+addDiv2) shr horizontalWeightShift ); + inc(total.aDiv, (aDiv*w+addDiv2) shr horizontalWeightShift ); + inc(total.sumR, (sumR*w+addDiv2) shr horizontalWeightShift ); + inc(total.sumG, (sumG*w+addDiv2) shr horizontalWeightShift ); + inc(total.sumB, (sumB*w+addDiv2) shr horizontalWeightShift ); + inc(total.rgbDiv, (rgbDiv*w+addDiv2) shr horizontalWeightShift ); + end; + end; + + procedure AccumulateNormal(var total: TRowSum; psum: PRowSum; w: UInt32or64); inline; + begin + with psum^ do + begin + inc(total.sumA, sumA*w ); + inc(total.aDiv, aDiv*w ); + inc(total.sumR, sumR*w ); + inc(total.sumG, sumG*w ); + inc(total.sumB, sumB*w ); + inc(total.rgbDiv, rgbDiv*w ); + end; + end; + + procedure ComputeExtendedAverage(const sum: TExtendedRowSum; pdest: pointer); inline; + {$IFDEF FASTBLUR_DOUBLE} + var v: uint32or64; + {$ELSE} + var rgbDivShr1: TExtendedRowValue; + {$ENDIF} + begin + if (sum.aDiv <= 0) or (sum.rgbDiv <= 0) then + begin + PBGRAPixel(pdest)^ := BGRAPixelTransparent; + exit; + end; + {$IFDEF FASTBLUR_DOUBLE} + v := round(sum.sumA/sum.aDiv); + if v > 255 then PBGRAPixel(pdest)^.alpha := 255 else PBGRAPixel(pdest)^.alpha := v; + v := round(sum.sumR/sum.rgbDiv); + if v > 255 then PBGRAPixel(pdest)^.red := 255 else PBGRAPixel(pdest)^.red := v; + v := round(sum.sumG/sum.rgbDiv); + if v > 255 then PBGRAPixel(pdest)^.green := 255 else PBGRAPixel(pdest)^.green := v; + v := round(sum.sumB/sum.rgbDiv); + if v > 255 then PBGRAPixel(pdest)^.blue := 255 else PBGRAPixel(pdest)^.blue := v; + {$ELSE} + rgbDivShr1:= sum.rgbDiv shr 1; + PLongWord(pdest)^ := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift) + or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift) + or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift) + or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift); + {$ENDIF} + end; + + procedure ComputeClampedAverage(const sum: TRowSum; pdest: pointer); inline; + var v: UInt32or64; + begin + if (sum.aDiv = 0) or (sum.rgbDiv = 0) then + begin + PBGRAPixel(pdest)^ := BGRAPixelTransparent; + exit; + end; + v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; + if v > 255 then PBGRAPixel(pdest)^.alpha := 255 else PBGRAPixel(pdest)^.alpha := v; + v := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv; + if v > 255 then PBGRAPixel(pdest)^.red := 255 else PBGRAPixel(pdest)^.red := v; + v := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv; + if v > 255 then PBGRAPixel(pdest)^.green := 255 else PBGRAPixel(pdest)^.green := v; + v := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv; + if v > 255 then PBGRAPixel(pdest)^.blue := 255 else PBGRAPixel(pdest)^.blue := v; + end; + + procedure ComputeAverage(const sum: TRowSum; pdest: pointer); inline; + var rgbDivShr1: UInt32or64; + begin + if (sum.aDiv = 0) or (sum.rgbDiv = 0) then + begin + PBGRAPixel(pdest)^ := BGRAPixelTransparent; + exit; + end; + rgbDivShr1:= sum.rgbDiv shr 1; + PLongWord(pdest)^ := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift) + or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift) + or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift) + or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift); + end; + + {$I blurfast.inc} + +procedure FilterBlurFastByte(bmp: TCustomUniversalBitmap; ABounds: TRect; +radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); + + const BitMargin = 8; + type + PRowSum = ^TRowSum; + TRegularRowValue = UInt32or64; + TRowSum = record + sumA,aDiv: TRegularRowValue; + end; + TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF}; + TExtendedRowSum = record + sumA,aDiv: TExtendedRowValue; + end; + + procedure IncExt(var ADest: TExtendedRowValue; ADelta: TExtendedRowValue); + begin + ADest := ADest + ADelta; + end; + + procedure AccumulatePixel(psrc: Pointer; w: UInt32or64; var sums: TRowSum; verticalWeightShift: Int32or64); inline; + begin + with sums do + begin + Inc(aDiv, w); + inc(sumA, w*PByte(psrc)^ shr verticalWeightShift); + end; + end; + + procedure AccumulateExtended(var ex: TExtendedRowSum; psum: PRowSum; w: UInt32or64); inline; + begin + with psum^ do + begin + IncExt(ex.sumA, TExtendedRowValue(sumA)*w); + IncExt(ex.aDiv, TExtendedRowValue(aDiv)*w); + end; + end; + + procedure AccumulateShr(var total: TRowSum; psum: PRowSum; w: UInt32or64; horizontalWeightShift: Int32or64); inline; + var + addDiv2: Int32or64; + begin + with psum^ do + begin + addDiv2 := 1 shl (horizontalWeightShift-1); + inc(total.sumA, (sumA*w+addDiv2) shr horizontalWeightShift ); + inc(total.aDiv, (aDiv*w+addDiv2) shr horizontalWeightShift ); + end; + end; + + procedure AccumulateNormal(var total: TRowSum; psum: PRowSum; w: UInt32or64); inline; + begin + with psum^ do + begin + inc(total.sumA, sumA*w ); + inc(total.aDiv, aDiv*w ); + end; + end; + + procedure ComputeExtendedAverage(const sum: TExtendedRowSum; pdest: pointer); inline; + {$IFDEF FASTBLUR_DOUBLE} + var v: uint32or64; + {$ENDIF} + begin + if sum.aDiv <= 0 then + begin + PByte(pdest)^ := 0; + exit; + end; + {$IFDEF FASTBLUR_DOUBLE} + v := round(sum.sumA/sum.aDiv); + if v > 255 then PByte(pdest)^ := 255 else PByte(pdest)^ := v; + {$ELSE} + PByte(pdest)^ := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; + {$ENDIF} + end; + + procedure ComputeClampedAverage(const sum: TRowSum; pdest: pointer); inline; + var v: UInt32or64; + begin + if sum.aDiv = 0 then + begin + PByte(pdest)^ := 0; + exit; + end; + v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; + if v > 255 then PByte(pdest)^ := 255 else PByte(pdest)^ := v; + end; + + procedure ComputeAverage(const sum: TRowSum; pdest: pointer); inline; + begin + if sum.aDiv = 0 then + begin + PByte(pdest)^ := 0; + exit; + end; + PByte(pdest)^ := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; + end; + + {$I blurfast.inc} + +procedure FilterBlurFast(bmp: TCustomUniversalBitmap; ABounds: TRect; + radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +begin + if ADestination.Colorspace <> bmp.Colorspace then + raise exception.Create('Colorspace mismatch'); + if bmp.Colorspace = TBGRAPixelColorspace then + FilterBlurFastRGBA(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop) + else if bmp.Colorspace = TByteMaskColorspace then + FilterBlurFastByte(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); +end; + +{ Normal radial blur compute a blur mask with a GradientFill and + then posterize to optimize general purpose blur } +procedure FilterBlurRadialNormal(bmp: TCustomUniversalBitmap; + ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + blurShape: TGrayscaleMask; + n: Int32or64; + p: PByte; + shift, addRound: LongWord; + grad: TBGRAGradientScanner; + minRadius,maxRadius: single; + oldClip: TRect; +begin + if (radiusX <= 0) and (radiusY <= 0) then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,bmp,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1); + grad := TBGRAGradientScanner.Create(BGRAWhite, BGRABlack, gtRadial, + pointF(ceil(radiusX), ceil(radiusY)), + pointF(ceil(radiusX)-radiusX-0.5, ceil(radiusY)), + pointF(ceil(radiusX), ceil(radiusY)-radiusY-0.5),false); + blurShape.Fill(grad, dmSet); + grad.Free; + minRadius := min(radiusX,radiusY); + maxRadius := max(radiusX,radiusY); + shift := max(0,min(ceil((maxRadius-8)/2), floor(minRadius))); + if shift > 0 then + begin + if shift > 5 then shift := 5; + addRound := 1 shl (shift-1); + p := blurShape.Data; + for n := 0 to blurShape.NbPixels-1 do + begin + p^ := (p^+addRound) shr shift; + inc(p); + end; + end; + FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); + blurShape.Free; +end; + +{ Blur disk creates a disk mask with a FillEllipse } +procedure FilterBlurDisk(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + blurShape: TGrayscaleMask; + oldClip: TRect; +begin + if (radiusX <= 0) and (radiusY <= 0) then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,bmp,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1, BGRABlack); + blurShape.FillEllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX + 0.5, radiusY + 0.5, BGRAWhite); + FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); + blurShape.Free; +end; + +{ Corona blur use a circle as mask } +procedure FilterBlurCorona(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + blurShape: TGrayscaleMask; + oldClip: TRect; +begin + if (radiusX <= 0) and (radiusY <= 0) then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,bmp,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1, BGRABlack); + blurShape.EllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX, radiusY, BGRAWhite, 1); + FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); + blurShape.Free; +end; + +procedure FilterBlurRadial(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; + blurType: TRadialBlurType; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + oldClip: TRect; +begin + if (radiusX <= 0) and (radiusY <= 0) then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,bmp,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + if radiusX < 0 then radiusX := 0; + if radiusY < 0 then radiusY := 0; + case blurType of + rbCorona: FilterBlurCorona(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); + rbDisk: FilterBlurDisk(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); + rbNormal: FilterBlurRadialNormal(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); + rbFast: FilterBlurFast(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); + rbPrecise: FilterBlurRadialNormal(bmp, ABounds, radiusX / 10 + 0.5, radiusY/10 + 0.5, ADestination, ACheckShouldStop); + rbBox: FilterBlurBox(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); + end; +end; + +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; + ABlurType: TRadialBlurType): TFilterTask; overload; +begin + if ABlurType = rbBox then + result := TBoxBlurTask.Create(ABmp,ABounds,ARadius) + else + result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType); +end; + +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + ARadiusX, ARadiusY: single; ABlurType: TRadialBlurType): TFilterTask; overload; +begin + if ABlurType = rbBox then + result := TBoxBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY) + else + result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType); +end; + +{ This filter draws an antialiased line to make the mask, and + if the motion blur is oriented, does a GradientFill to orient it } +procedure FilterBlurMotion(bmp: TCustomUniversalBitmap; ABounds: TRect; distance: single; + angle: single; oriented: boolean; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + blurShape: TBGRACustomBitmap; + intRadius: integer; + dx, dy, r: single; + oldClip: TRect; +begin + if distance < 1e-6 then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,bmp,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + dx := cos(angle * Pi / 180); + dy := sin(angle * Pi / 180); + if not oriented and (abs(dx)<1e-6) then + FilterBlurBox(bmp, ABounds,0,distance/2, ADestination, ACheckShouldStop) + else if not oriented and (abs(dy)<1e-6) then + FilterBlurBox(bmp, ABounds,distance/2,0, ADestination, ACheckShouldStop) + else + begin + r := distance / 2; + intRadius := ceil(r); + blurShape := BGRABitmapFactory.Create(2 * intRadius + 1, 2 * intRadius + 1, BGRABlack); + blurShape.DrawLineAntialias(intRadius - dx * r, intRadius - dy * + r, intRadius + dx * r, intRadius + dy * r, BGRAWhite, 1, True); + if oriented then + blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, + BGRAPixelTransparent, BGRABlack, gtRadial, pointF(intRadius - + dx * r, intRadius - dy * r), + pointF(intRadius + dx * (r + 0.5), intRadius + dy * (r + 0.5)), + dmFastBlend, False); + FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); + blurShape.Free; + end; +end; + +function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + ADistance, AAngle: single; AOriented: boolean): TFilterTask; +begin + result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented); +end; + +{ General purpose blur : compute pixel sum according to the mask and then + compute only difference while scanning from the left to the right } +procedure FilterBlurSmallMask(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; +procedure FilterBlurSmallMaskWithShift(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; maskShift: integer; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; +procedure FilterBlurBigMask(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; +procedure FilterBlurMask64(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; + +//make sure value is in the range 0..255 +function clampByte(value: Int32or64): UInt32or64; inline; +begin + if value <= 0 then result := 0 else + if value >= 255 then result := 255 else + result := value; +end; + +function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean): TFilterTask; +begin + result := TCustomBlurTask.Create(ABmp,ABounds,AMask,AMaskIsThreadSafe); +end; + +procedure FilterBlurCustom(bmp: TCustomUniversalBitmap; + ABounds: TRect; blurMask: TCustomUniversalBitmap; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var + maskSum: int64; + p: PByteMask; + y, count, qty, maskShift, pStride: integer; +begin + maskSum := 0; + for y:= 0 to blurMask.Height-1 do + begin + blurMask.ScanMoveTo(0,Y); + count := blurMask.Width; + while count > 0 do + begin + qty := count; + blurMask.ScanNextMaskChunk(qty, p, pStride); + dec(count, qty); + while qty > 0 do + begin + inc(maskSum,p^.gray); + inc(p, pStride); + dec(qty); + end; + end; + end; + if bmp.Colorspace = TBGRAPixelColorspace then + begin + maskShift := 0; + while maskSum > 32768 do + begin + inc(maskShift); + maskSum := maskSum shr 1; + end; + //check if sum can be stored in a 32-bit signed integer + if maskShift = 0 then + FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else + {$IFDEF CPU32} + if maskShift < 8 then + FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else + FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); + {$ELSE} + FilterBlurMask64(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); + {$ENDIF} + end else + if bmp.Colorspace = TByteMaskColorspace then + begin + if maskSum > 32768*255 then + FilterBlurMask64(bmp, blurMask, ABounds, Adestination, ACheckShouldStop) + else + FilterBlurSmallMask(bmp, blurMask, ABounds, Adestination, ACheckShouldStop) + end else + raise exception.Create('Unexpected source colorspace'); +end; + +type + TBlurClearSumProc = procedure(AData: Pointer); + TBlurAccumulateProc = procedure(AData: Pointer; pPix: pointer; maskAlpha: Int32or64); + TBlurComputeAverageProc = procedure(AData: Pointer; pPix: pointer); + +procedure FilterBlurGeneric(bmp: TCustomUniversalBitmap; blurMask: TCustomUniversalBitmap; + ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc; + AClearSum: TBlurClearSumProc; AAccumulate: TBlurAccumulateProc; + AComputeAverage: TBlurComputeAverageProc; AData: Pointer); + + {$I blurnormal.inc} + +//32-bit blur with shift +type + TFilterBlurSmallMaskWithShift_Sum = record + sumR, sumG, sumB, + sumA, Adiv, RGBdiv : Int32or64; + maskShift: integer; + end; + +procedure FilterBlurSmallMaskWithShift_ClearSum(AData: pointer); +begin + with TFilterBlurSmallMaskWithShift_Sum(AData^) do + begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + Adiv := 0; + RGBdiv := 0; + end; +end; + +procedure FilterBlurSmallMaskWithShift_ComputeAverage(AData: pointer; pPix: pointer); +var temp,rgbDivShr1: Int32or64; +begin + with TFilterBlurSmallMaskWithShift_Sum(AData^) do + if (Adiv <= 0) or (RGBdiv <= 0) then + PBGRAPixel(pPix)^ := BGRAPixelTransparent else + begin + temp := sumA + Adiv shr 1; + if temp < Adiv then + PBGRAPixel(pPix)^ := BGRAPixelTransparent + else + begin + rgbDivShr1 := RGBdiv shr 1; + PBGRAPixel(pPix)^.alpha := temp div Adiv; + PBGRAPixel(pPix)^.red := clampByte((sumR + rgbDivShr1) div RGBdiv); + PBGRAPixel(pPix)^.green := clampByte((sumG + rgbDivShr1) div RGBdiv); + PBGRAPixel(pPix)^.blue := clampByte((sumB + rgbDivShr1) div RGBdiv); + end; + end; +end; + +procedure FilterBlurSmallMaskWithShift_AccumulateSum(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +var + pixMaskAlpha: Int32or64; + tempPixel: TBGRAPixel; +begin + with TFilterBlurSmallMaskWithShift_Sum(AData^) do + begin + tempPixel := PBGRAPixel(pPix)^; + pixMaskAlpha := maskAlpha * tempPixel.alpha; + inc(sumA, pixMaskAlpha); + inc(Adiv, maskAlpha); + pixMaskAlpha := (LongWord(pixMaskAlpha)+$80000000) shr maskShift - ($80000000 shr maskShift); + inc(RGBdiv, pixMaskAlpha); + inc(sumR, Int32or64(tempPixel.red) * pixMaskAlpha); + inc(sumG, Int32or64(tempPixel.green) * pixMaskAlpha); + inc(sumB, Int32or64(tempPixel.blue) * pixMaskAlpha); + end; +end; + +procedure FilterBlurSmallMaskWithShift(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; maskShift: integer; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var Sum: TFilterBlurSmallMaskWithShift_Sum; +begin + if ADestination.Colorspace <> bmp.Colorspace then + raise exception.Create('Colorspace mismatch'); + if bmp.Colorspace <> TBGRAPixelColorspace then + raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); + Sum.maskShift:= maskShift; + FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, + @FilterBlurSmallMaskWithShift_ClearSum, + @FilterBlurSmallMaskWithShift_AccumulateSum, + @FilterBlurSmallMaskWithShift_ComputeAverage, @Sum); +end; + +//32-bit blur +type + TFilterBlurSmallMask_Sum= record + sumR, sumG, sumB, sumA, Adiv : integer; + end; + +procedure FilterBlurSmallMask_ClearSum(AData: pointer); +begin + with TFilterBlurSmallMask_Sum(AData^) do + begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + Adiv := 0; + end; +end; + +procedure FilterBlurSmallMask_ComputeAverageRGBA(AData: pointer; pPix: pointer); +var temp,sumAShr1: integer; +begin + with TFilterBlurSmallMask_Sum(AData^) do + if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else + begin + temp := sumA + Adiv shr 1; + if temp < Adiv then + PBGRAPixel(pPix)^ := BGRAPixelTransparent + else + begin + sumAShr1 := sumA shr 1; + PBGRAPixel(pPix)^.alpha := temp div Adiv; + PBGRAPixel(pPix)^.red := clampByte((sumR + sumAShr1) div sumA); + PBGRAPixel(pPix)^.green := clampByte((sumG + sumAShr1) div sumA); + PBGRAPixel(pPix)^.blue := clampByte((sumB + sumAShr1) div sumA); + end; + end; +end; + +procedure FilterBlurSmallMask_ComputeAverageByte(AData: pointer; pPix: pointer); +begin + with TFilterBlurSmallMask_Sum(AData^) do + begin + if Adiv <= 0 then PByte(pPix)^ := 0 else + PByte(pPix)^ := (sumA + Adiv shr 1) div Adiv; + end; +end; + +procedure FilterBlurSmallMask_AccumulateSumRGBA(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +var + pixMaskAlpha: integer; + tempPixel: TBGRAPixel; +begin + with TFilterBlurSmallMask_Sum(AData^) do + begin + tempPixel := PBGRAPixel(pPix)^; + pixMaskAlpha := integer(maskAlpha) * tempPixel.alpha; + inc(sumA, pixMaskAlpha); + inc(Adiv, maskAlpha); + inc(sumR, integer(tempPixel.red) * pixMaskAlpha); + inc(sumG, integer(tempPixel.green) * pixMaskAlpha); + inc(sumB, integer(tempPixel.blue) * pixMaskAlpha); + end; +end; + +procedure FilterBlurSmallMask_AccumulateSumByte(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +begin + with TFilterBlurSmallMask_Sum(AData^) do + begin + inc(sumA, maskAlpha * PByte(pPix)^); + inc(Adiv, maskAlpha); + end; +end; + +procedure FilterBlurSmallMask(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var Sum: TFilterBlurSmallMask_Sum; + accumulate: TBlurAccumulateProc; + computeAverage: TBlurComputeAverageProc; +begin + if ADestination.Colorspace <> bmp.Colorspace then + raise exception.Create('Colorspace mismatch'); + + if bmp.Colorspace = TBGRAPixelColorspace then + begin + accumulate := @FilterBlurSmallMask_AccumulateSumRGBA; + computeAverage := @FilterBlurSmallMask_ComputeAverageRGBA + end + else if bmp.Colorspace = TByteMaskColorspace then + begin + accumulate := @FilterBlurSmallMask_AccumulateSumByte; + computeAverage := @FilterBlurSmallMask_ComputeAverageByte + end else + raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); + + FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, + @FilterBlurSmallMask_ClearSum,accumulate,computeAverage, @Sum); +end; + +//64-bit blur +type + TFilterBlurMask64_Sum= record + sumR, sumG, sumB, sumA, Adiv : int64; + end; + +procedure FilterBlurMask64_ClearSum(AData: pointer); +begin + with TFilterBlurMask64_Sum(AData^) do + begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + Adiv := 0; + end; +end; + +procedure FilterBlurMask64_ComputeAverageRGBA(AData: pointer; pPix: pointer); +var + temp, sumAShr1: Int64; +begin + with TFilterBlurMask64_Sum(AData^) do + begin + if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else + begin + temp := sumA + Adiv shr 1; + if temp < Adiv then + PBGRAPixel(pPix)^ := BGRAPixelTransparent + else + begin + sumAShr1 := sumA shr 1; + PBGRAPixel(pPix)^.alpha := temp div Adiv; + PBGRAPixel(pPix)^.red := clampByte((sumR + sumAShr1) div sumA); + PBGRAPixel(pPix)^.green := clampByte((sumG + sumAShr1) div sumA); + PBGRAPixel(pPix)^.blue := clampByte((sumB + sumAShr1) div sumA); + end; + end; + end; +end; + +procedure FilterBlurMask64_ComputeAverageConvertRGBAToByteMask(AData: pointer; pPix: pointer); +var c: TBGRAPixel; +begin + FilterBlurMask64_ComputeAverageRGBA(AData, @c); + PByteMask(pPix)^ := BGRAToMask(c); +end; + +procedure FilterBlurMask64_ComputeAverageByte(AData: pointer; pPix: pointer); +begin + with TFilterBlurMask64_Sum(AData^) do + begin + if Adiv <= 0 then PByte(pPix)^ := 0 else + PByte(pPix)^ := (sumA + Adiv shr 1) div Adiv; + end; +end; + +procedure FilterBlurMask64_ComputeAverageConvertByteMaskToRGBA(AData: pointer; pPix: pointer); +begin + with TFilterBlurMask64_Sum(AData^) do + begin + if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else + PBGRAPixel(pPix)^ := MaskToBGRA(TByteMask.New((sumA + Adiv shr 1) div Adiv)); + end; +end; + +procedure FilterBlurMask64_AccumulateSumRGBA(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +var + pixMaskAlpha: Int32or64; + tempPixel: TBGRAPixel; +begin + with TFilterBlurMask64_Sum(AData^) do + begin + tempPixel := PBGRAPixel(pPix)^; + pixMaskAlpha := maskAlpha * tempPixel.alpha; + Inc64(sumA, pixMaskAlpha); + Inc64(Adiv, maskAlpha); + Inc64(sumR, tempPixel.red * pixMaskAlpha); + Inc64(sumG, tempPixel.green * pixMaskAlpha); + Inc64(sumB, tempPixel.blue * pixMaskAlpha); + end; +end; + +procedure FilterBlurMask64_AccumulateSumByte(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +begin + with TFilterBlurMask64_Sum(AData^) do + begin + Inc64(sumA, maskAlpha * PByte(pPix)^); + Inc64(Adiv, maskAlpha); + end; +end; + +procedure FilterBlurMask64(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var Sum: TFilterBlurMask64_Sum; + accumulate: TBlurAccumulateProc; + computeAverage: TBlurComputeAverageProc; +begin + if ADestination.Colorspace <> bmp.Colorspace then + raise exception.Create('Colorspace mismatch'); + + if bmp.Colorspace = TBGRAPixelColorspace then + begin + accumulate := @FilterBlurMask64_AccumulateSumRGBA; + computeAverage := @FilterBlurMask64_ComputeAverageRGBA + end + else if bmp.Colorspace = TByteMaskColorspace then + begin + accumulate := @FilterBlurMask64_AccumulateSumByte; + computeAverage := @FilterBlurMask64_ComputeAverageByte + end else + raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); + + FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, + @FilterBlurMask64_ClearSum,accumulate,computeAverage, @Sum); +end; + +//floating point blur +type + TFilterBlurBigMask_Sum= record + sumR, sumG, sumB, sumA, Adiv : single; + end; + +procedure FilterBlurBigMask_ClearSum(AData: pointer); +begin + with TFilterBlurBigMask_Sum(AData^) do + begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + Adiv := 0; + end; +end; + +procedure FilterBlurBigMask_ComputeAverage(AData: pointer; pPix: pointer); +begin + with TFilterBlurBigMask_Sum(AData^) do + if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else + begin + PBGRAPixel(pPix)^.alpha := round(sumA/Adiv); + if PBGRAPixel(pPix)^.alpha = 0 then + PBGRAPixel(pPix)^ := BGRAPixelTransparent + else + begin + PBGRAPixel(pPix)^.red := clampByte(round(sumR/sumA)); + PBGRAPixel(pPix)^.green := clampByte(round(sumG/sumA)); + PBGRAPixel(pPix)^.blue := clampByte(round(sumB/sumA)); + end; + end; +end; + +procedure FilterBlurBigMask_AccumulateSum(AData: pointer; pPix: pointer; maskAlpha: Int32or64); +var + pixMaskAlpha: Int32or64; + tempPixel: TBGRAPixel; +begin + with TFilterBlurBigMask_Sum(AData^) do + begin + tempPixel := PBGRAPixel(pPix)^; + pixMaskAlpha := maskAlpha * tempPixel.alpha; + IncF(sumA, pixMaskAlpha); + IncF(Adiv, maskAlpha); + IncF(sumR, tempPixel.red * pixMaskAlpha); + IncF(sumG, tempPixel.green * pixMaskAlpha); + IncF(sumB, tempPixel.blue * pixMaskAlpha); + end; +end; + +procedure FilterBlurBigMask(bmp: TCustomUniversalBitmap; + blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); +var Sum: TFilterBlurBigMask_Sum; +begin + if ADestination.Colorspace <> bmp.Colorspace then + raise exception.Create('Colorspace mismatch'); + if bmp.Colorspace <> TBGRAPixelColorspace then + raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); + FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, + @FilterBlurBigMask_ClearSum, + @FilterBlurBigMask_AccumulateSum, + @FilterBlurBigMask_ComputeAverage, @Sum); +end; + +constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; + radius: single); +begin + SetSource(bmp); + FBounds := ABounds; + FRadiusX := radius; + FRadiusY := radius; +end; + +constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; + radiusX, radiusY: single); +begin + SetSource(bmp); + FBounds := ABounds; + FRadiusX := max(radiusX,0); + FRadiusY := max(radiusY,0); +end; + +procedure TBoxBlurTask.DoExecute; +begin + FilterBlurBox(FSource,FBounds,FRadiusX,FRadiusY,Destination,@GetShouldStop); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafilters.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilters.pas new file mode 100644 index 0000000..e5531fe --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilters.pas @@ -0,0 +1,962 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFilters; + +{$mode objfpc}{$H+} + +interface + +{ Here are some filters that can be applied to a bitmap. The filters + take a source image as a parameter and gives a filtered image as + a result. } + +uses + BGRAClasses, BGRABitmapTypes, BGRAFilterType, BGRAFilterBlur; + +type + TFilterTask = BGRAFilterType.TFilterTask; + +/////////////////////// PIXELWISE FILTERS //////////////////////////////// +type + { TGrayscaleTask } + { Grayscale converts colored pixel into grayscale with same luminosity } + TGrayscaleTask = class(TFilterTask) + private + FBounds: TRect; + public + constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect); + protected + procedure DoExecute; override; + end; + +{ Grayscale converts colored pixel into grayscale with same luminosity } +function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; overload; +function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; +function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask; + +{ Normalize use the whole available range of values, making dark colors darkest possible + and light colors lightest possible } +function FilterNormalize(bmp: TBGRACustomBitmap; + eachChannel: boolean = True): TBGRACustomBitmap; overload; +function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; + eachChannel: boolean = True): TBGRACustomBitmap; overload; + +////////////////////// 3X3 FILTERS //////////////////////////////////////////// + +{ Sharpen filter add more contrast between pixels } +function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap; overload; +function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; overload; + +{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil } +function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap; + +{ Emboss filter compute a color difference in the angle direction } +function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; +function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; + +{ Emboss highlight computes a sort of emboss with 45 degrees angle and + with standard selection color (white/black and filled with blue) } +function FilterEmbossHighlight(bmp: TBGRACustomBitmap; + FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap; +function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap; + FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; + +{ The median filter consist in calculating the median value of pixels. Here + a square of 9x9 pixel is considered. The median allow to select the most + representative colors. The option parameter allow to choose to smooth the + result or not. } +function FilterMedian(bmp: TBGRACustomBitmap; Option: TMedianOption): TBGRACustomBitmap; + +//////////////////////// DEFORMATION FILTERS ///////////////////////////////// + +{ Distort the image as if it were on a sphere } +function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap; + +{ Twirl distortion, i.e. a progressive rotation } +function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; +function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; + +{ Distort the image as if it were on a vertical cylinder } +function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap; + +{ Compute a plane projection towards infinity (SLOW) } +function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap; + +{ Rotate filter rotate the image and clip it in the bounding rectangle } +function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; + angle: single; correctBlur: boolean = false): TBGRACustomBitmap; + +///////////////////////// BLUR FILTERS ////////////////////////////////////// + +{ A radial blur applies a blur with a circular influence, i.e, each pixel + is merged with pixels within the specified radius. There is an exception + with rbFast blur, the optimization entails a hyperbolic shape. } +type TRadialBlurTask = BGRAFilterBlur.TRadialBlurTask; +function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; +function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload; +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload; + +{ The precise blur allow to specify the blur radius with subpixel accuracy } +function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; deprecated 'Use FilterBlurRadial with blurType:=rbPrecise and radius multiplied by 10'; +function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; deprecated 'Use CreateRadialBlurTask with blurType:=rbPrecise and radius multiplied by 10'; + +{ Motion blur merge pixels in a direction. The oriented parameter specifies + if the weights of the pixels are the same along the line or not. } +type TMotionBlurTask = BGRAFilterBlur.TMotionBlurTask; +function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; +function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TMotionBlurTask; + +{ General purpose blur filter, with a blur mask as parameter to describe + how pixels influence each other } +function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap; +function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask; + +////////////////////////////// OTHER FILTERS ///////////////////////////////// + +{ SmartZoom x3 is a filter that upsizes 3 times the picture and add + pixels that could be logically expected (horizontal, vertical, diagonal lines) } +function FilterSmartZoom3(bmp: TBGRACustomBitmap; + Option: TMedianOption): TBGRACustomBitmap; + +function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; + +implementation + +uses Math, BGRATransform, SysUtils, BGRAFilterScanner; + +/////////////////////// PIXELWISE FILTERS //////////////////////////////// + +{ TGrayscaleTask } + +constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect); +begin + SetSource(bmp); + FBounds := ABounds; +end; + +procedure TGrayscaleTask.DoExecute; +var + yb: LongInt; +begin + if FBounds.IsEmpty then exit; + for yb := FBounds.Top to FBounds.bottom - 1 do + begin + if GetShouldStop(yb) then break; + TBGRAFilterScannerGrayscale.ComputeFilterAt(FSource.scanline[yb] + FBounds.left, + Destination.scanline[yb] + FBounds.left, FBounds.right-FBounds.left, true); + end; + Destination.InvalidateBitmap; +end; + +{ Filter grayscale applies BGRAToGrayscale function to all pixels } +function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; +begin + result := FilterGrayscale(bmp,rect(0,0,bmp.width,bmp.Height)); +end; + +function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; +var scanner: TBGRAFilterScannerGrayscale; +begin + result := bmp.NewBitmap(bmp.Width,bmp.Height); + scanner := TBGRAFilterScannerGrayscale.Create(bmp,Point(0,0),True); + result.FillRect(ABounds,scanner,dmSet); + scanner.Free; +end; + +function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask; +begin + result := TGrayscaleTask.Create(bmp,ABounds); +end; + +function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean + ): TBGRACustomBitmap; +begin + result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel); +end; + +{ Normalize compute min-max of specified channel and apply an affine transformation + to make it use the full range of values } +function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; + eachChannel: boolean = True): TBGRACustomBitmap; +var scanner: TBGRAFilterScannerNormalize; + remain: TRect; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + remain := TRect.Intersect(ABounds, rect(0,0,bmp.Width,bmp.Height)); + if remain.IsEmpty then exit; + scanner := TBGRAFilterScannerNormalize.Create(bmp,Point(0,0),remain,eachChannel); + result.FillRect(remain,scanner,dmSet); + scanner.Free; +end; + +////////////////////// 3X3 FILTERS //////////////////////////////////////////// + +{ This filter compute for each pixel the mean of the eight surrounding pixels, + then the difference between this average pixel and the pixel at the center + of the square. Finally the difference is added to the new pixel, exagerating + its difference with its neighbours. } +function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; +var scanner: TBGRAFilterScanner; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + if ABounds.IsEmpty then exit; + scanner := TBGRASharpenScanner.Create(bmp,ABounds,AAmount); + result.FillRect(ABounds,scanner,dmSet); + scanner.Free; +end; + +function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer + ): TBGRACustomBitmap; +begin + result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount); +end; + +{ Filter contour computes for each pixel + the grayscale difference with surrounding pixels (in intensity and alpha) + and draw black pixels when there is a difference } +function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap; +var scanner: TBGRAContourScanner; +begin + result := bmp.NewBitmap(bmp.Width, bmp.Height); + scanner := TBGRAContourScanner.Create(bmp,rect(0,0,bmp.width,bmp.height),AGammaCorrection); + result.Fill(scanner); + scanner.Free; +end; + +function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap; +begin + result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height), AStrength, AOptions); +end; + +{ Emboss filter computes the difference between each pixel and the surrounding pixels + in the specified direction. } +function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap; +var + yb, xb: Int32or64; + dx, dy: single; + idx, idy: Int32or64; + x256,y256: Int32or64; + cMiddle: TBGRAPixel; + hMiddle: THSLAPixel; + + tempPixel, refPixel: TBGRAPixel; + pdest: PBGRAPixel; + + bounds: TRect; + psrc: PBGRAPixel; + redDiff,greenDiff,blueDiff: UInt32or64; + diff: Int32or64; +begin + //compute pixel position and weight + dx := cos(angle * Pi / 180); + dy := sin(angle * Pi / 180); + idx := floor(dx); + idy := floor(dy); + x256 := trunc((dx-idx)*256); + y256 := trunc((dy-idy)*256); + + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + if ABounds.IsEmpty then exit; + + bounds := bmp.GetImageBounds; + bounds.Intersect(ABounds); + if bounds.IsEmpty then exit; + bounds.Left := max(0, bounds.Left - 1); + bounds.Top := max(0, bounds.Top - 1); + bounds.Right := min(bmp.Width, bounds.Right + 1); + bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); + + if not (eoTransparent in AOptions) then + begin + if eoPreserveHue in AOptions then + Result.PutImagePart(ABounds.left,ABounds.top,bmp,ABounds,dmSet) + else + Result.FillRect(ABounds,BGRA(128, 128, 128, 255),dmSet); + end; + + //loop through destination + for yb := bounds.Top to bounds.bottom - 1 do + begin + pdest := Result.scanline[yb] + bounds.Left; + psrc := bmp.ScanLine[yb]+bounds.Left; + + for xb := bounds.Left+idx to bounds.Right-1+idx do + begin + refPixel := bmp.GetPixel256(xb,yb+idy,x256,y256); + cMiddle := psrc^; + inc(psrc); + + if eoPreserveHue in AOptions then + begin + diff := (integer(refPixel.red * refPixel.alpha) - integer(cMiddle.red * cMiddle.alpha)+ + integer(refPixel.green * refPixel.alpha) - integer(cMiddle.green * cMiddle.alpha)+ + integer(refPixel.blue * refPixel.alpha) - integer(cMiddle.blue * cMiddle.alpha))* AStrength div 128; + if diff > 0 then + hMiddle := BGRAToHSLA(refPixel) + else + hMiddle := BGRAToHSLA(cMiddle); + hMiddle.lightness := min(65535,max(0,hMiddle.lightness+diff)); + if eoTransparent in AOptions then + hMiddle.alpha := min(65535,abs(diff)); + pdest^ := HSLAToBGRA(hMiddle); + end else + begin + {$push}{$hints off}{$r-} + redDiff := UInt32or64(max(0, 65536 + (refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha) * AStrength div 64)) shr 9; + greenDiff := UInt32or64(max(0, 65536 + (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha) * AStrength div 64)) shr 9; + blueDiff := UInt32or64(max(0, 65536 + (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha) * AStrength div 64)) shr 9; + {$pop} + if (redDiff <> 128) or (greenDiff <> 128) or (blueDiff <> 128) then + begin + tempPixel.red := min(255, redDiff); + tempPixel.green := min(255, greenDiff); + tempPixel.blue := min(255, blueDiff); + if eoTransparent in AOptions then + begin + tempPixel.alpha := min(255,abs(Int32or64(redDiff-128))+abs(Int32or64(greenDiff-128))+abs(Int32or64(blueDiff-128))); + pdest^ := tempPixel; + end else + begin + tempPixel.alpha := 255; + pdest^ := tempPixel; + end; + end; + end; + + Inc(pdest); + end; + end; + Result.InvalidateBitmap; +end; + +{ Like general emboss, but with fixed direction and automatic color with transparency } +function FilterEmbossHighlight(bmp: TBGRACustomBitmap; + FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap; +var + bounds: TRect; + borderColorOverride: boolean; + borderColorLevel: Int32or64; + scan: TBGRAEmbossHightlightScanner; +begin + borderColorOverride := DefineBorderColor.alpha <> 0; + borderColorLevel := DefineBorderColor.red; + + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + + if borderColorOverride then + bounds := bmp.GetImageBounds(cRed, borderColorLevel) + else + bounds := bmp.GetImageBounds(cRed); + if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then + exit; + bounds.Left := max(0, bounds.Left - 1); + bounds.Top := max(0, bounds.Top - 1); + bounds.Right := min(bmp.Width, bounds.Right + 1); + bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); + + scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride); + scan.AllowDirectRead := true; + scan.FillSelection := FillSelection; + if borderColorOverride then scan.SourceBorderColor := DefineBorderColor; + Result.FillRect(bounds, scan, dmSet); + scan.Free; +end; + +function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap; + FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; +var + bounds: TRect; + borderColorOverride: boolean; + borderColorLevel: int32or64; + scan: TBGRAEmbossHightlightScanner; +begin + borderColorOverride := DefineBorderColor.alpha <> 0; + borderColorLevel := DefineBorderColor.red; + + if borderColorOverride then + bounds := bmp.GetImageBounds(cRed, borderColorLevel) + else + bounds := bmp.GetImageBounds(cRed); + if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then + begin + Result := bmp.NewBitmap(0, 0); + exit; + end; + bounds.Left := max(0, bounds.Left - 1); + bounds.Top := max(0, bounds.Top - 1); + bounds.Right := min(bmp.Width, bounds.Right + 1); + bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); + + Result := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1); + inc(Offset.X, bounds.Left); + inc(Offset.Y, bounds.Top); + + scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride); + scan.AllowDirectRead := true; + scan.FillSelection := FillSelection; + if borderColorOverride then scan.SourceBorderColor := DefineBorderColor; + Result.FillRect(rect(0,0,result.Width,result.Height), scan, dmSet, Offset); + scan.Free; +end; + +{ For each component, sort values to get the median } +function FilterMedian(bmp: TBGRACustomBitmap; + Option: TMedianOption): TBGRACustomBitmap; + + function ComparePixLt(p1, p2: TBGRAPixel): boolean; + begin + if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then + Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) + + int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) + + int32or64(p2.blue) + else + Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue); + end; + +const + nbpix = 9; +var + yb, xb: int32or64; + dx, dy, n, i, j, k: int32or64; + a_pixels: array[0..nbpix - 1] of TBGRAPixel; + tempPixel, refPixel: TBGRAPixel; + tempValue: byte; + sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64; + tempAlpha: word; + bounds: TRect; + pdest: PBGRAPixel; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + + bounds := bmp.GetImageBounds; + if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then + exit; + bounds.Left := max(0, bounds.Left - 1); + bounds.Top := max(0, bounds.Top - 1); + bounds.Right := min(bmp.Width, bounds.Right + 1); + bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); + + for yb := bounds.Top to bounds.bottom - 1 do + begin + pdest := Result.scanline[yb] + bounds.left; + for xb := bounds.left to bounds.right - 1 do + begin + n := 0; + for dy := -1 to 1 do + for dx := -1 to 1 do + begin + a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy); + if a_pixels[n].alpha = 0 then + a_pixels[n] := BGRAPixelTransparent; + Inc(n); + end; + for i := 1 to n - 1 do + begin + j := i; + while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do + begin + tempValue := a_pixels[j].alpha; + a_pixels[j].alpha := a_pixels[j - 1].alpha; + a_pixels[j - 1].alpha := tempValue; + Dec(j); + end; + j := i; + while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do + begin + tempValue := a_pixels[j].red; + a_pixels[j].red := a_pixels[j - 1].red; + a_pixels[j - 1].red := tempValue; + Dec(j); + end; + j := i; + while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do + begin + tempValue := a_pixels[j].green; + a_pixels[j].green := a_pixels[j - 1].green; + a_pixels[j - 1].green := tempValue; + Dec(j); + end; + j := i; + while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do + begin + tempValue := a_pixels[j].blue; + a_pixels[j].blue := a_pixels[j - 1].blue; + a_pixels[j - 1].blue := tempValue; + Dec(j); + end; + end; + + refPixel := a_pixels[n div 2]; + + if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then + begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + BGRAdiv := 0; + nbA := 0; + + case option of + moHighSmooth, moMediumSmooth: + begin + j := 2; + k := 2; + end; + else + begin + j := 1; + k := 1; + end; + end; + + {$hints off} + for i := -k to j do + begin + tempPixel := a_pixels[n div 2 + i]; + tempAlpha := tempPixel.alpha; + if (option = moMediumSmooth) and ((i = -k) or (i = j)) then + tempAlpha := tempAlpha div 2; + + inc(sumR, tempPixel.red * tempAlpha ); + inc(sumG, tempPixel.green * tempAlpha ); + inc(sumB, tempPixel.blue * tempAlpha ); + inc(BGRAdiv, tempAlpha); + + inc(sumA, tempAlpha); + Inc(nbA); + end; + {$hints on} + if option = moMediumSmooth then + Dec(nbA); + + if (BGRAdiv = 0) then + refPixel := BGRAPixelTransparent + else + begin + refPixel.red := round(sumR / BGRAdiv); + refPixel.green := round(sumG / BGRAdiv); + refPixel.blue := round(sumB / BGRAdiv); + refPixel.alpha := round(sumA / nbA); + end; + end; + + pdest^ := refPixel; + Inc(pdest); + end; + end; +end; + +//////////////////////// DEFORMATION FILTERS ///////////////////////////////// + +{ Compute the distance for each pixel to the center of the bitmap, + calculate the corresponding angle with arcsin, use this angle + to determine a distance from the center in the source bitmap } +function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap; +var + cx, cy: single; + scanner: TBGRASphereDeformationScanner; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + cx := bmp.Width / 2 - 0.5; + cy := bmp.Height / 2 - 0.5; + scanner := TBGRASphereDeformationScanner.Create(bmp,PointF(cx,cy),bmp.Width/2,bmp.Height/2); + result.FillEllipseAntialias(cx,cy,bmp.Width/2-0.5,bmp.Height/2-0.5,scanner); + scanner.Free; +end; + +{ Applies twirl scanner. See TBGRATwirlScanner } +function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; +var twirl: TBGRATwirlScanner; +begin + twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent); + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + result.FillRect(ABounds, twirl, dmSet); + twirl.free; +end; + +function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; + ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap; +begin + result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent); +end; + +{ Compute the distance for each pixel to the vertical axis of the bitmap, + calculate the corresponding angle with arcsin, use this angle + to determine a distance from the vertical axis in the source bitmap } +function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap; +var + cx: single; + scanner: TBGRAVerticalCylinderDeformationScanner; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + cx := bmp.Width / 2 - 0.5; + scanner := TBGRAVerticalCylinderDeformationScanner.Create(bmp,cx,bmp.Width/2); + result.Fill(scanner); + scanner.Free; +end; + +function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap; +const resampleGap=0.6; +var + cy, x1, x2, y1, y2, z1, z2, h: single; + yb: int32or64; + resampledBmp: TBGRACustomBitmap; + resampledBmpWidth: int32or64; + resampledFactor,newResampleFactor: single; + sub,resampledSub: TBGRACustomBitmap; + partRect: TRect; + resampleSizeY : int32or64; +begin + resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch); + resampledBmpWidth := resampledBmp.Width; + resampledFactor := 2; + Result := bmp.NewBitmap(bmp.Width, bmp.Height*2); + cy := result.Height / 2 - 0.5; + h := 1; + for yb := 0 to ((Result.Height-1) div 2) do + begin + y1 := (cy - (yb-0.5)) / (cy+0.5); + y2 := (cy - (yb+0.5)) / (cy+0.5); + if y2 <= 0 then continue; + z1 := h/y1; + z2 := h/y2; + newResampleFactor := 1/(z2-z1)*1.5; + + x1 := (z1+1)/2; + x2 := (z2+1)/2; + if newResampleFactor <= resampledFactor*resampleGap then + begin + resampledFactor := newResampleFactor; + if resampledBmp <> bmp then resampledBmp.Free; + if (x2-x1 >= 1) then resampleSizeY := 1 else + resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1)); + resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch); + resampledBmpWidth := resampledBmp.Width; + end; + + partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height), + round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1); + if x2-x1 > 1 then + begin + partRect.Top := 0; + partRect.Bottom := 1; + end; + sub := resampledBmp.GetPart(partRect); + if sub <> nil then + begin + resampledSub := sub.Resample(bmp.Width,1,rmFineResample); + result.PutImage(0,yb,resampledSub,dmSet); + result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet); + resampledSub.free; + sub.free; + end; + end; + if resampledBmp <> bmp then resampledBmp.Free; + + if result.Height <> bmp.Height then + begin + resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch); + result.free; + result := resampledBmp; + end; +end; + +{ Rotates the image. To do this, loop through the destination and + calculates the position in the source bitmap with an affine transformation } +function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; + angle: single; correctBlur: boolean): TBGRACustomBitmap; +begin + Result := bmp.NewBitmap(bmp.Width, bmp.Height); + Result.PutImageAngle(0,0,bmp,angle,origin.x,origin.y,255,true,correctBlur); +end; + +///////////////////////// BLUR FILTERS ////////////////////////////////////// + +function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; +var task: TFilterTask; +begin + task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius,blurType); + result := task.Execute; + task.Free; +end; + +function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; +var task: TFilterTask; +begin + task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,blurType); + result := task.Execute; + task.Free; +end; + +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; +begin + result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType); +end; + +function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; +begin + result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType); +end; + +{ Precise blur } + +function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; +var task: TRadialBlurTask; +begin + task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius*10,rbPrecise); + result := task.Execute; + task.Free; +end; + +function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; +begin + result := TRadialBlurTask.Create(ABmp,ABounds,ARadius*10,rbPrecise); +end; + +function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; +var task: TFilterTask; +begin + task := CreateMotionBlurTask(bmp, rect(0,0,bmp.Width,bmp.Height), distance, angle, oriented); + result := task.Execute; + task.Free; +end; + +function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + ADistance, AAngle: single; AOriented: boolean): TMotionBlurTask; +begin + result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented); +end; + +function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap; +var task: TFilterTask; +begin + task := TCustomBlurTask.Create(bmp,rect(0,0,bmp.Width,bmp.Height), AMask, AMaskIsThreadSafe); + result := task.Execute; + task.Free; +end; + +function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; + AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask; +begin + result := TCustomBlurTask.Create(ABmp, ABounds, AMask, AMaskIsThreadSafe); +end; + +///////////////////////////////////// OTHER FILTERS /////////////////////////// + +function FilterSmartZoom3(bmp: TBGRACustomBitmap; + Option: TMedianOption): TBGRACustomBitmap; +type + TSmartDiff = record + d, cd, sd, b, a: single; + end; + +var + xb, yb: Int32or64; + diag1, diag2, h1, h2, v1, v2: TSmartDiff; + c,c1,c2: TBGRAPixel; + temp, median: TBGRACustomBitmap; + + function ColorDiff(c1, c2: TBGRAPixel): single; + var + max1, max2: Int32or64; + begin + if (c1.alpha = 0) and (c2.alpha = 0) then + begin + Result := 0; + exit; + end + else + if (c1.alpha = 0) or (c2.alpha = 0) then + begin + Result := 1; + exit; + end; + max1 := c1.red; + if c1.green > max1 then + max1 := c1.green; + if c1.blue > max1 then + max1 := c1.blue; + + max2 := c2.red; + if c2.green > max2 then + max2 := c2.green; + if c2.blue > max2 then + max2 := c2.blue; + + if (max1 = 0) or (max2 = 0) then + begin + Result := 0; + exit; + end; + Result := (abs(c1.red / max1 - c2.red / max2) + + abs(c1.green / max1 - c2.green / max2) + abs(c1.blue / max1 - c2.blue / max2)) / 3; + end; + + function RGBDiff(c1, c2: TBGRAPixel): single; + begin + if (c1.alpha = 0) and (c2.alpha = 0) then + begin + Result := 0; + exit; + end + else + if (c1.alpha = 0) or (c2.alpha = 0) then + begin + Result := 1; + exit; + end; + Result := (abs(c1.red - c2.red) + abs(c1.green - c2.green) + + abs(c1.blue - c2.blue)) / 3 / 255; + end; + + function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff; + var + c1, c2, c1m, c2m: TBGRAPixel; + begin + c1 := bmp.GetPixel(x1, y1); + c2 := bmp.GetPixel(x2, y2); + c1m := median.GetPixel(x1, y1); + c2m := median.GetPixel(x2, y2); + Result.d := RGBDiff(c1, c2); + Result.cd := ColorDiff(c1, c2); + Result.a := c1.alpha / 255 * c2.alpha / 255; + Result.d := Result.d * Result.a + (1 - Result.a) * + (1 + abs(c1.alpha - c2.alpha) / 255) / 5; + Result.b := RGBDiff(c1, c1m) * c1.alpha / 255 * c1m.alpha / 255 + + RGBDiff(c2, c2m) * c2.alpha / 255 * c2m.alpha / 255 + + (abs(c1.alpha - c1m.alpha) + abs(c2.alpha - c2m.alpha)) / 255 / 4; + Result.sd := Result.d + Result.cd * 3; + end; + +var + diff: single; + +begin + median := FilterMedian(bmp, moNone); + + temp := bmp.Resample(bmp.Width * 3, bmp.Height * 3, rmSimpleStretch); + Result := FilterMedian(temp, Option); + temp.Free; + + for yb := 0 to bmp.Height - 2 do + for xb := 0 to bmp.Width - 2 do + begin + diag1 := smartDiff(xb, yb, xb + 1, yb + 1); + diag2 := smartDiff(xb, yb + 1, xb + 1, yb); + + h1 := smartDiff(xb, yb, xb + 1, yb); + h2 := smartDiff(xb, yb + 1, xb + 1, yb + 1); + v1 := smartDiff(xb, yb, xb, yb + 1); + v2 := smartDiff(xb + 1, yb, xb + 1, yb + 1); + + diff := diag1.sd - diag2.sd; + if abs(diff) < 3 then + DecF(diff, (diag1.b - diag2.b) * (3 - abs(diff)) / 2); + //which diagonal to highlight? + if abs(diff) < 0.2 then + diff := 0; + + if diff < 0 then + begin + //same color? + if diag1.cd < 0.3 then + begin + c1 := bmp.GetPixel(xb, yb); + c2 := bmp.GetPixel(xb + 1, yb + 1); + c := MergeBGRA(c1, c2); + //restore + Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb)); + Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1)); + + if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then + Result.SetPixel(xb * 3 + 3, yb * 3 + 2, c); + if (diag1.sd < h2.sd) and (diag1.sd < v1.sd) then + Result.SetPixel(xb * 3 + 2, yb * 3 + 3, c); + end; + end + else + if diff > 0 then + begin + //same color? + if diag2.cd < 0.3 then + begin + c1 := bmp.GetPixel(xb, yb + 1); + c2 := bmp.GetPixel(xb + 1, yb); + c := MergeBGRA(c1, c2); + //restore + Result.SetPixel(xb * 3 + 3, yb * 3 + 2, bmp.GetPixel(xb + 1, yb)); + Result.SetPixel(xb * 3 + 2, yb * 3 + 3, bmp.GetPixel(xb, yb + 1)); + + if (diag2.sd < h1.sd) and (diag2.sd < v1.sd) then + Result.SetPixel(xb * 3 + 2, yb * 3 + 2, c); + if (diag2.sd < h2.sd) and (diag2.sd < v2.sd) then + Result.SetPixel(xb * 3 + 3, yb * 3 + 3, c); + + end; + end; + end; + + median.Free; +end; + +function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; + useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap; +var yb,xb, xs,ys, tx,ty: Int32or64; + psrc,pdest: PBGRAPixel; + temp,stretched: TBGRACustomBitmap; + oldfilter: TResampleFilter; +begin + if pixelSize < 1 then + begin + result := bmp.Duplicate; + exit; + end; + result := bmp.NewBitmap(bmp.Width,bmp.Height); + + tx := (bmp.Width+pixelSize-1) div pixelSize; + ty := (bmp.Height+pixelSize-1) div pixelSize; + if not useResample then + begin + temp := bmp.NewBitmap(tx,ty); + + xs := (bmp.Width mod pixelSize) div 2; + ys := (bmp.Height mod pixelSize) div 2; + + for yb := 0 to temp.height-1 do + begin + pdest := temp.ScanLine[yb]; + psrc := bmp.scanline[ys]+xs; + inc(ys,pixelSize); + for xb := temp.width-1 downto 0 do + begin + pdest^ := psrc^; + inc(pdest); + inc(psrc,pixelSize); + end; + end; + temp.InvalidateBitmap; + end else + begin + oldfilter := bmp.ResampleFilter; + bmp.ResampleFilter := filter; + temp := bmp.Resample(tx,ty,rmFineResample); + bmp.ResampleFilter := oldfilter; + end; + stretched := temp.Resample(temp.Width*pixelSize,temp.Height*pixelSize,rmSimpleStretch); + temp.free; + if bmp.Width mod pixelSize = 0 then + xs := 0 + else + xs := (-pixelSize+(bmp.Width mod pixelSize)) div 2; + if bmp.Height mod pixelSize = 0 then + ys := 0 + else + ys := (-pixelSize+(bmp.Height mod pixelSize)) div 2; + result.PutImage(xs,ys,stretched,dmSet); + stretched.Free; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterscanner.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterscanner.pas new file mode 100644 index 0000000..62d251e --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafilterscanner.pas @@ -0,0 +1,788 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFilterScanner; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, BGRABitmapTypes, BGRAFilterType; + +type + { TBGRAFilterScannerGrayscale } + { Grayscale converts colored pixel into grayscale with same luminosity } + TBGRAFilterScannerGrayscale = class(TBGRAFilterScannerPixelwise) + class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; AGammaCorrection: boolean); override; + end; + + { TBGRAFilterScannerNegative } + + TBGRAFilterScannerNegative = class(TBGRAFilterScannerPixelwise) + class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; AGammaCorrection: boolean); override; + end; + + { TBGRAFilterScannerSwapRedBlue } + + TBGRAFilterScannerSwapRedBlue = class(TBGRAFilterScannerPixelwise) + class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; {%H-}AGammaCorrection: boolean); override; + end; + + { TBGRAFilterScannerNormalize } + { Normalize compute min-max of specified channel and apply an affine transformation + to make it use the full range of values } + TBGRAFilterScannerNormalize = class(TBGRAFilterScannerPixelwise) + private + minValRed, maxValRed, minValGreen, maxValGreen, + minValBlue, maxValBlue, minAlpha, maxAlpha: word; + addValRed, addValGreen, addValBlue, addAlpha: word; + factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64; + procedure DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean); + protected + procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; {%H-}AGammaCorrection: boolean); override; + public + constructor Create(ASource: IBGRAScanner; AOffset: TPoint; ABounds: TRect; + AEachChannel: boolean); + class procedure ComputeFilterAt({%H-}ASource: PBGRAPixel; {%H-}ADest: PBGRAPixel; + {%H-}ACount: integer; {%H-}AGammaCorrection: boolean); override; + end; + + { TBGRA3X3FilterScanner } + + TBGRA3X3FilterScanner = class(TBGRAFilterScannerMultipixel) + protected + FSourceBorderColor,FDestinationBorderColor: TBGRAPixel; + FAutoSourceBorderColor: boolean; + function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; virtual; abstract; + procedure DoComputeFilter(BufferX: Integer; + const Buffers: array of PBGRAPixel; BufferWidth: integer; + ADest: PBGRAPixel; ACount: integer); override; + public + constructor Create(ASource: IBGRAScanner; ABounds: TRect); overload; + constructor Create(ASource: TBGRACustomBitmap); overload; + property SourceBorderColor: TBGRAPixel read FSourceBorderColor write FSourceBorderColor; + property DestinationBorderColor: TBGRAPixel read FDestinationBorderColor write FDestinationBorderColor; + property AutoSourceBorderColor: boolean read FAutoSourceBorderColor write FAutoSourceBorderColor; + end; + + { TBGRAContourScanner } + { Filter contour compute a grayscale image, then for each pixel + calculates the difference with surrounding pixels (in intensity and alpha) + and draw black pixels when there is a difference } + TBGRAContourScanner = class(TBGRA3X3FilterScanner) + protected + FGammaCorrection: boolean; + FOpacity: byte; + function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; + public + constructor Create(ASource: IBGRAScanner; ABounds: TRect; + AGammaCorrection: boolean = False); overload; + constructor Create(ASource: TBGRACustomBitmap; + AGammaCorrection: boolean = False); overload; + property Opacity: Byte read FOpacity write FOpacity; + end; + + { TBGRASharpenScanner } + + TBGRASharpenScanner = class(TBGRA3X3FilterScanner) + protected + FAmount: integer; + function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; + public + constructor Create(ASource: IBGRAScanner; ABounds: TRect; + AAmount: integer = 256); overload; + constructor Create(ASource: TBGRACustomBitmap; + AAmount: integer = 256); overload; + end; + + { TBGRAEmbossHightlightScanner } + + TBGRAEmbossHightlightScanner = class(TBGRA3X3FilterScanner) + protected + FFillSelection: boolean; + FSourceChannel: TChannel; + FChannelOffset: Byte; + function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; + procedure SetSourceChannel(AValue: TChannel); + public + constructor Create(ASource: IBGRAScanner; ABounds: TRect; ABoundsVisible: Boolean); overload; + constructor Create(ASource: TBGRACustomBitmap; ABoundsVisible: Boolean); overload; + property FillSelection: boolean read FFillSelection write FFillSelection; + property SourceChannel: TChannel read FSourceChannel write SetSourceChannel; + end; + +implementation + +uses BGRABlend, math, SysUtils; + +{ TBGRAEmbossHightlightScanner } + +procedure TBGRAEmbossHightlightScanner.SetSourceChannel(AValue: TChannel); +begin + FSourceChannel:=AValue; + FChannelOffset:= TBGRAPixel_ChannelByteOffset[FSourceChannel]; +end; + +function TBGRAEmbossHightlightScanner.DoFilter3X3(PTop, PMiddle, + PBottom: PBGRAPixel): TBGRAPixel; +var + sum: Int32or64; + slope,h: byte; + highlight: TBGRAPixel; +begin + sum := Int32or64((PByte(PTop)+FChannelOffset)^) + + Int32or64((PByte(PTop+1)+FChannelOffset)^) + + Int32or64((PByte(PMiddle)+FChannelOffset)^) - + Int32or64((PByte(PMiddle+2)+FChannelOffset)^) - + Int32or64((PByte(PBottom+1)+FChannelOffset)^) - + Int32or64((PByte(PBottom+2)+FChannelOffset)^); + sum := 128 - sum div 3; + if sum > 255 then + slope := 255 + else + if sum < 1 then + slope := 1 + else + slope := sum; + h := (PByte(PMiddle+1)+FChannelOffset)^; + + result.red := slope; + result.green := slope; + result.blue := slope; + result.alpha := abs(slope - 128) * 2; + + if FFillSelection then + begin + highlight := BGRA(h shr 2, h shr 1, h, h shr 1); + if result.red < highlight.red then + result.red := highlight.red; + if result.green < highlight.green then + result.green := highlight.green; + if result.blue < highlight.blue then + result.blue := highlight.blue; + if result.alpha < highlight.alpha then + result.alpha := highlight.alpha; + end; +end; + +constructor TBGRAEmbossHightlightScanner.Create(ASource: IBGRAScanner; + ABounds: TRect; ABoundsVisible: Boolean); +begin + inherited Create(ASource,ABounds); + SourceChannel := cGreen; + FillSelection:= true; + AutoSourceBorderColor := not ABoundsVisible; +end; + +constructor TBGRAEmbossHightlightScanner.Create(ASource: TBGRACustomBitmap; + ABoundsVisible: Boolean); +begin + inherited Create(ASource); + SourceChannel := cGreen; + FillSelection:= true; + AutoSourceBorderColor := not ABoundsVisible; +end; + +{ TBGRA3X3FilterScanner } + +procedure TBGRA3X3FilterScanner.DoComputeFilter(BufferX: Integer; + const Buffers: array of PBGRAPixel; BufferWidth: integer; ADest: PBGRAPixel; + ACount: integer); +var MiddleX: Integer; + TopLine,MiddleLine,BottomLine: array[0..2] of TBGRAPixel; + PTop,PMiddle,PBottom: PBGRAPixel; + borderColor: TBGRAPixel; +begin + if Buffers[1] = nil then + begin + FillDWord(ADest^, ACount, LongWord(FDestinationBorderColor)); + exit; + end; + MiddleX := BufferX+1; + while (ACount > 0) and (MiddleX < 0) do + begin + ADest^ := FDestinationBorderColor; + Dec(ACount); + Inc(ADest); + Inc(MiddleX); + end; + if (ACount > 0) and (MiddleX = 0) and (MiddleX < BufferWidth) then + begin + MiddleLine[1] := Buffers[1][MiddleX]; + if AutoSourceBorderColor then borderColor := MiddleLine[1] + else borderColor := FSourceBorderColor; + + TopLine[0] := borderColor; + MiddleLine[0] := borderColor; + BottomLine[0] := borderColor; + if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX]; + if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX]; + inc(MiddleX); + if MiddleX >= BufferWidth then + begin + TopLine[2] := borderColor; + MiddleLine[2] := borderColor; + BottomLine[2] := borderColor; + end else + begin + if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX]; + MiddleLine[2] := Buffers[1][MiddleX]; + if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX]; + end; + ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine); + Dec(ACount); + Inc(ADest); + end; + if (Buffers[0]<>nil) and (Buffers[2]<>nil) then + begin + while (ACount > 0) and (MiddleX+1 < BufferWidth) do + begin + ADest^ := DoFilter3X3(@Buffers[0][MiddleX-1],@Buffers[1][MiddleX-1],@Buffers[2][MiddleX-1]); + Inc(MiddleX); + Dec(ACount); + Inc(ADest); + end; + end else + begin + if not AutoSourceBorderColor then + begin + TopLine[0] := FSourceBorderColor; + TopLine[1] := FSourceBorderColor; + TopLine[2] := FSourceBorderColor; + BottomLine[0] := FSourceBorderColor; + BottomLine[1] := FSourceBorderColor; + BottomLine[2] := FSourceBorderColor; + end; + while (ACount > 0) and (MiddleX+1 < BufferWidth) do + begin + PMiddle:= @Buffers[1][MiddleX-1]; + if Buffers[0] = nil then + begin + if AutoSourceBorderColor then + begin + TopLine[0] := PMiddle[1]; + TopLine[1] := PMiddle[1]; + TopLine[2] := PMiddle[1]; + end; + PTop := @TopLine; + end + else PTop := @Buffers[0][MiddleX-1]; + if Buffers[2] = nil then + begin + if AutoSourceBorderColor then + begin + BottomLine[0] := PMiddle[1]; + BottomLine[1] := PMiddle[1]; + BottomLine[2] := PMiddle[1]; + end; + PBottom := @BottomLine; + end + else PBottom := @Buffers[2][MiddleX-1]; + ADest^ := DoFilter3X3(PTop,PMiddle,PBottom); + Inc(MiddleX); + Dec(ACount); + Inc(ADest); + end; + end; + if (ACount > 0) and (MiddleX < BufferWidth) then + begin + MiddleLine[1] := Buffers[1][MiddleX]; + if AutoSourceBorderColor then borderColor := MiddleLine[1] + else borderColor := FSourceBorderColor; + + if Buffers[0] = nil then TopLine[0] := borderColor else TopLine[0] := Buffers[0][MiddleX-1]; + MiddleLine[0] := Buffers[1][MiddleX-1]; + if Buffers[2] = nil then BottomLine[0] := borderColor else BottomLine[0] := Buffers[2][MiddleX-1]; + if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX]; + if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX]; + inc(MiddleX); + if MiddleX >= BufferWidth then + begin + TopLine[2] := borderColor; + MiddleLine[2] := borderColor; + BottomLine[2] := borderColor; + end else + begin + if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX]; + MiddleLine[2] := Buffers[1][MiddleX]; + if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX]; + end; + ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine); + Dec(ACount); + Inc(ADest); + end; + while (ACount > 0) do + begin + ADest^ := FDestinationBorderColor; + Dec(ACount); + Inc(ADest); + end; +end; + +constructor TBGRA3X3FilterScanner.Create(ASource: IBGRAScanner; + ABounds: TRect); +begin + inherited Create(ASource,ABounds,Point(-1,-1),3,3); + FSourceBorderColor := BGRAPixelTransparent; + FDestinationBorderColor := BGRAPixelTransparent; + FAutoSourceBorderColor := False; +end; + +constructor TBGRA3X3FilterScanner.Create(ASource: TBGRACustomBitmap); +begin + inherited Create(ASource,Rect(0,0,ASource.Width,ASource.Height),Point(-1,-1),3,3); + FSourceBorderColor := BGRAPixelTransparent; + FDestinationBorderColor := BGRAPixelTransparent; + FAutoSourceBorderColor := False; + AllowDirectRead := true; +end; + +{ TBGRASharpenScanner } + +function TBGRASharpenScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel; +var + sumR, sumG, sumB, sumA, nbA: UInt32or64; + refPixel: TBGRAPixel; + rgbDivShr1: UInt32or64; +begin + if FAmount = 0 then + begin + result := PMiddle[1]; + exit; + end; + //compute sum + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + //RGBdiv := 0; + nbA := 0; + + {$hints off} + with PTop[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PTop[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PTop[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PMiddle[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PMiddle[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PBottom[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PBottom[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + with PBottom[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; + {$hints on} + + //we finally have an average pixel + if (sumA = 0) then + refPixel := BGRAPixelTransparent + else + begin + rgbDivShr1:= sumA shr 1; + refPixel.red := (sumR + rgbDivShr1) div sumA; + refPixel.green := (sumG + rgbDivShr1) div sumA; + refPixel.blue := (sumB + rgbDivShr1) div sumA; + refPixel.alpha := (sumA + nbA shr 1) div nbA; + end; + + //read the pixel at the center of the square + if refPixel <> BGRAPixelTransparent then + begin + with PMiddle[1] do + begin + //compute sharpened pixel by adding the difference + if FAmount<>256 then + result := BGRA( max(0, min($FFFF, Int32or64(red shl 8) + + FAmount*(red - refPixel.red))) shr 8, + max(0, min($FFFF, Int32or64(green shl 8) + + FAmount*(green - refPixel.green))) shr 8, + max(0, min($FFFF, Int32or64(blue shl 8) + + FAmount*(blue - refPixel.blue))) shr 8, + max(0, min($FFFF, Int32or64(alpha shl 8) + + FAmount*(alpha - refPixel.alpha))) shr 8 ) + else + result := BGRA( max(0, min(255, (red shl 1) - refPixel.red)), + max(0, min(255, (green shl 1) - refPixel.green)), + max(0, min(255, (blue shl 1) - refPixel.blue)), + max(0, min(255, (alpha shl 1) - refPixel.alpha))); + end; + end else + result := PMiddle[1]; +end; + +constructor TBGRASharpenScanner.Create(ASource: IBGRAScanner; + ABounds: TRect; AAmount: integer); +begin + inherited Create(ASource,ABounds); + FAmount:= AAmount; +end; + +constructor TBGRASharpenScanner.Create(ASource: TBGRACustomBitmap; + AAmount: integer); +begin + inherited Create(ASource); + FAmount:= AAmount; +end; + +{ TBGRAContourScanner } + +function TBGRAContourScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel; +var + sum: Int32or64; + slope: byte; +begin + if FGammaCorrection then + begin + sum := (FastBGRAExpandedDiff(PTop[0],PBottom[2]) + FastBGRAExpandedDiff(PTop[1],PBottom[1]) + + FastBGRAExpandedDiff(PTop[2],PBottom[0]) + FastBGRAExpandedDiff(PMiddle[0],PMiddle[2])) div 3; + + if sum >= 65535 then + slope := 0 + else if sum <= 0 then + slope := 255 + else slope := GammaCompressionTab[65535-sum]; + end else + begin + sum := (FastBGRALinearDiff(PTop[0],PBottom[2]) + FastBGRALinearDiff(PTop[1],PBottom[1]) + + FastBGRALinearDiff(PTop[2],PBottom[0]) + FastBGRALinearDiff(PMiddle[0],PMiddle[2])) div 3; + + if sum >= 255 then + slope := 0 + else if sum < 0 then + slope := 255 + else slope := 255-sum; + end; + result.red := slope; + result.green := slope; + result.blue := slope; + result.alpha := FOpacity; +end; + +constructor TBGRAContourScanner.Create(ASource: IBGRAScanner; + ABounds: TRect; AGammaCorrection: boolean); +begin + inherited Create(ASource,ABounds); + FGammaCorrection := AGammaCorrection; + AutoSourceBorderColor:= True; + FOpacity:= 255; +end; + +constructor TBGRAContourScanner.Create(ASource: TBGRACustomBitmap; + AGammaCorrection: boolean); +begin + inherited Create(ASource); + FGammaCorrection := AGammaCorrection; + AutoSourceBorderColor:= True; + FOpacity:= 255; +end; + +{ TBGRAFilterScannerNormalize } + +procedure TBGRAFilterScannerNormalize.DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean); +var + buffer: TBGRAPixelBuffer; + p: PBGRAPixel; + c: TExpandedPixel; + yb, xb: LongInt; +begin + if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then + begin + addValRed := 0; + addValGreen := 0; + addValBlue := 0; + addAlpha := 0; + factorValRed := 4096; + factorValGreen := 4096; + factorValBlue := 4096; + factorAlpha := 4096; + exit; + end; + maxValRed := 0; + minValRed := 65535; + maxValGreen := 0; + minValGreen := 65535; + maxValBlue := 0; + minValBlue := 65535; + maxAlpha := 0; + minAlpha := 65535; + buffer := nil; + for yb := ABounds.Top to ABounds.Bottom do + begin + if Source.ProvidesScanline(rect(ABounds.Left,yb,ABounds.Right,yb+1)) then + p := Source.GetScanlineAt(ABounds.Left,yb) + else + begin + Source.ScanMoveTo(ABounds.Left,yb); + AllocateBGRAPixelBuffer(buffer, ABounds.Right-ABounds.Left); + p := @buffer[0]; + ScannerPutPixels(Source,p,ABounds.Right-ABounds.Left,dmSet); + end; + for xb := ABounds.Right-ABounds.Left-1 downto 0 do + begin + c := GammaExpansion(p[xb]); + if c.red > maxValRed then + maxValRed := c.red; + if c.green > maxValGreen then + maxValGreen := c.green; + if c.blue > maxValBlue then + maxValBlue := c.blue; + if c.red < minValRed then + minValRed := c.red; + if c.green < minValGreen then + minValGreen := c.green; + if c.blue < minValBlue then + minValBlue := c.blue; + if c.alpha > maxAlpha then + maxAlpha := c.alpha; + if c.alpha < minAlpha then + minAlpha := c.alpha; + end; + end; + if not AEachChannel then + begin + minValRed := min(min(minValRed, minValGreen), minValBlue); + maxValRed := max(max(maxValRed, maxValGreen), maxValBlue); + minValGreen := minValRed; + maxValGreen := maxValRed; + minValBlue := minValBlue; + maxValBlue := maxValBlue; + end; + if maxValRed > minValRed then + begin + factorValRed := 268431360 div (maxValRed - minValRed); + addValRed := 0; + end else + begin + factorValRed := 0; + if minValRed = 0 then + addValRed := 0 + else addValRed := 65535; + end; + if maxValGreen > minValGreen then + begin + factorValGreen := 268431360 div (maxValGreen - minValGreen); + addValGreen := 0; + end else + begin + factorValGreen := 0; + if minValGreen = 0 then + addValGreen := 0 + else addValGreen := 65535; + end; + if maxValBlue > minValBlue then + begin + factorValBlue := 268431360 div (maxValBlue - minValBlue); + addValBlue := 0; + end else + begin + factorValBlue := 0; + if minValBlue = 0 then + addValBlue := 0 else + addValBlue := 65535; + end; + if maxAlpha > minAlpha then + begin + factorAlpha := 268431360 div (maxAlpha - minAlpha); + addAlpha := 0; + end else + begin + factorAlpha := 0; + if minAlpha = 0 then + addAlpha := 0 else + addAlpha := 65535; + end; +end; + +procedure TBGRAFilterScannerNormalize.DoComputeFilterAt(ASource: PBGRAPixel; + ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean); +var + c: TExpandedPixel; +begin + While ACount > 0 do + begin + c := GammaExpansion(ASource^); + Inc(ASource); + c.red := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed; + c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen; + c.blue := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue; + c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha; + ADest^ := GammaCompression(c); + Inc(ADest); + dec(ACount); + end; +end; + +constructor TBGRAFilterScannerNormalize.Create(ASource: IBGRAScanner; + AOffset: TPoint; ABounds: TRect; AEachChannel: boolean); +begin + inherited Create(ASource,AOffset,True); + DetermineNormalizationFactors(ABounds, AEachChannel); +end; + +class procedure TBGRAFilterScannerNormalize.ComputeFilterAt( + ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; + AGammaCorrection: boolean); +begin + raise exception.Create('Normalize filter scanner cannot be called as a class procedure'); +end; + +{ TBGRAFilterScannerSwapRedBlue } + +class procedure TBGRAFilterScannerSwapRedBlue.ComputeFilterAt( + ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; + AGammaCorrection: boolean); +const RedMask = 255 shl TBGRAPixel_RedShift; + BlueMask = 255 shl TBGRAPixel_BlueShift; + GreenAndAlphaMask = (255 shl TBGRAPixel_GreenShift) or (255 shl TBGRAPixel_AlphaShift); + RedMask64 = RedMask or (RedMask shl 32); + BlueMask64 = BlueMask or (BlueMask shl 32); + GreenAndAlphaMask64 = GreenAndAlphaMask or (GreenAndAlphaMask shl 32); +var + temp: LongWord; + temp64: QWord; + oddN: boolean; +begin + {$PUSH}{$WARNINGS OFF} + if ACount <= 0 then exit; + oddN := odd(ACount); + ACount := ACount shr 1; + if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then + while ACount > 0 do + begin + temp64 := PQWord(ASource)^; + PQWord(ADest)^ := ((temp64 and BlueMask64) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or + ((temp64 and RedMask64) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or + (temp64 and GreenAndAlphaMask64); + dec(ACount); + inc(ASource,2); + inc(ADest,2); + end else + while ACount > 0 do + begin + temp64 := PQWord(ASource)^; + PQWord(ADest)^ := ((temp64 and BlueMask64) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or + ((temp64 and RedMask64) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or + (temp64 and GreenAndAlphaMask64); + dec(ACount); + inc(ASource,2); + inc(ADest,2); + end; + if oddN then + begin + if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then + begin + temp := PLongWord(ASource)^; + PLongWord(ADest)^ := ((temp and BlueMask) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or + ((temp and RedMask) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or + (temp and GreenAndAlphaMask); + end else + begin + temp := PLongWord(ASource)^; + PLongWord(ADest)^ := ((temp and BlueMask) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or + ((temp and RedMask) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or + (temp and GreenAndAlphaMask); + end; + end; + {$POP} +end; + +{ TBGRAFilterScannerNegative } + +class procedure TBGRAFilterScannerNegative.ComputeFilterAt( + ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; + AGammaCorrection: boolean); +begin + if ADest = ASource then + begin + if AGammaCorrection then + while ACount > 0 do + begin + with ADest^ do + if alpha <> 0 then + begin + ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]]; + ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]]; + ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]]; + end; + Inc(ADest); + dec(ACount); + end else + while ACount > 0 do + begin + if ADest^.alpha <> 0 then + LongWord(ADest^) := LongWord(ADest^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift)); + Inc(ADest); + dec(ACount); + end; + end else + if AGammaCorrection then + while ACount > 0 do + begin + with ASource^ do + if alpha = 0 then + ADest^ := BGRAPixelTransparent + else + begin + ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]]; + ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]]; + ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]]; + ADest^.alpha := alpha; + end; + inc(ASource); + Inc(ADest); + dec(ACount); + end else + while ACount > 0 do + begin + if ASource^.alpha = 0 then + ADest^ := BGRAPixelTransparent + else + LongWord(ADest^) := LongWord(ASource^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift)); + inc(ASource); + Inc(ADest); + dec(ACount); + end; +end; + +{ TBGRAFilterScannerGrayscale } + +class procedure TBGRAFilterScannerGrayscale.ComputeFilterAt( + ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; + AGammaCorrection: boolean); +begin + if ASource = ADest then + begin + if AGammaCorrection then + while ACount > 0 do + begin + if ADest^.alpha <> 0 then + ADest^ := BGRAToGrayscale(ADest^); + Inc(ADest); + dec(ACount); + end else + while ACount > 0 do + begin + if ADest^.alpha <> 0 then + ADest^ := BGRAToGrayscaleLinear(ADest^); + Inc(ADest); + dec(ACount); + end; + end else + if AGammaCorrection then + while ACount > 0 do + begin + ADest^ := BGRAToGrayscale(ASource^); + inc(ASource); + Inc(ADest); + dec(ACount); + end else + while ACount > 0 do + begin + ADest^ := BGRAToGrayscaleLinear(ASource^); + inc(ASource); + Inc(ADest); + dec(ACount); + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafiltertype.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafiltertype.pas new file mode 100644 index 0000000..9eed018 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafiltertype.pas @@ -0,0 +1,464 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFilterType; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, BGRABitmapTypes; + +const + FilterScannerChunkSize = 16; + +type + TCheckShouldStopFunc = function(ACurrentY: integer) : boolean of object; + + { TFilterTask } + + TFilterTask = class + private + FCheckShouldStop: TCheckShouldStopFunc; + FScanOffset: TPoint; + procedure SetDestination(AValue: TBGRACustomBitmap); + function GetInplace: boolean; + procedure SetInplace(AValue: boolean); + protected + FDestination: TBGRACustomBitmap; + FSource: TBGRACustomBitmap; + FSourceScanner: IBGRAScanner; + FCurrentY: integer; + function GetShouldStop(ACurrentY: integer): boolean; + procedure DoExecute; virtual; abstract; + function RequestSourceScanLine(X,Y,Count: Integer): PBGRAPixel; + procedure ReleaseSourceScanLine(P: PBGRAPixel); + function RequestSourceExpandedScanLine(X,Y,Count: Integer): PExpandedPixel; + procedure ReleaseSourceExpandedScanLine(P: PExpandedPixel); + procedure SetSource(ABitmap: TBGRACustomBitmap); overload; + procedure SetSource(AScanner: IBGRAScanner); overload; + public + function Execute: TBGRACustomBitmap; + property Destination: TBGRACustomBitmap read FDestination write SetDestination; + property CheckShouldStop: TCheckShouldStopFunc read FCheckShouldStop write FCheckShouldStop; + property CurrentY: integer read FCurrentY; + property ScanOffset: TPoint read FScanOffset write FScanOffset; + property Inplace: boolean read GetInplace write SetInplace; + end; + + { TBGRAFilterScanner } + + TBGRAFilterScanner = class(TBGRACustomScanner) + private + FAllowDirectRead: boolean; + FCurX,FCurY: integer; + FSource: IBGRAScanner; + FOffset: TPoint; + FVariablePixelBuffer: TBGRAPixelBuffer; + FOutputBuffer: packed array[0..FilterScannerChunkSize-1] of TBGRAPixel; + FOutputBufferPos: integer; + public + constructor Create(ASource: IBGRAScanner; AOffset: TPoint); + procedure ComputeFilter(ASource: IBGRAScanner; X,Y: Integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract; + function ScanAtInteger(X,Y: integer): TBGRAPixel; override; + procedure ScanMoveTo(X,Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + function IsScanPutPixelsDefined: boolean; override; + function ScanAt(X,Y: Single): TBGRAPixel; override; + property Source: IBGRAScanner read FSource; + property Offset: TPoint read FOffset; + property AllowDirectRead: boolean read FAllowDirectRead write FAllowDirectRead; + end; + + { TBGRAFilterScannerPixelwise } + + TBGRAFilterScannerPixelwise = class(TBGRAFilterScanner) + private + FBuffer: TBGRAPixelBuffer; + FGammaCorrection: boolean; + protected + procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; AGammaCorrection: boolean); virtual; + public + constructor Create(ASource: IBGRAScanner; AOffset: TPoint; AGammaCorrection: boolean = true); + procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel; + ACount: integer); override; + class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; + ACount: integer; AGammaCorrection: boolean); virtual; abstract; + class procedure ComputeFilterInplace(ABitmap: TBGRACustomBitmap; ABounds: TRect; + AGammaCorrection: boolean); virtual; + property GammaCorrection: boolean read FGammaCorrection write FGammaCorrection; + end; + + { TBGRAFilterScannerMultipixel } + + TBGRAFilterScannerMultipixel = class(TBGRAFilterScanner) + private + FSourceBounds: TRect; + FKernelWidth,FKernelHeight: integer; + FCurBufferY: integer; + FCurBufferYDefined: boolean; + FBuffers: array of TBGRAPixelBuffer; + FPBuffers: array of PBGRAPixel; + protected + procedure DoComputeFilter(BufferX: Integer; const Buffers: array of PBGRAPixel; + BufferWidth: integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract; + procedure LoadBuffer(ASource: IBGRAScanner; X,Y: Integer; BufferIndex: Integer; ACount: integer); virtual; + public + constructor Create(ASource: IBGRAScanner; ASourceBounds: TRect; AOffset: TPoint; + AKernelWidth,AKernelHeight: Integer); + procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel; + ACount: integer); override; + property KernelWidth: integer read FKernelWidth; + property KernelHeight: integer read FKernelHeight; + property SourceBounds: TRect read FSourceBounds; + end; + +implementation + +uses SysUtils, BGRABlend; + +{ TFilterTask } + +function TFilterTask.GetShouldStop(ACurrentY: integer): boolean; +begin + FCurrentY:= ACurrentY; + if Assigned(FCheckShouldStop) then + result := FCheckShouldStop(ACurrentY) + else + result := false; +end; + +function TFilterTask.RequestSourceScanLine(X, Y, Count: Integer): PBGRAPixel; +begin + if FSource <> nil then + result := FSource.ScanLine[y]+x + else + begin + getmem(result, sizeof(TBGRAPixel)*Count); + FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y); + FSourceScanner.ScanPutPixels(result,count,dmSet); + end; +end; + +procedure TFilterTask.ReleaseSourceScanLine(P: PBGRAPixel); +begin + if FSource = nil then + if p <> nil then freemem(p); +end; + +function TFilterTask.RequestSourceExpandedScanLine(X, Y, Count: Integer + ): PExpandedPixel; +var p: PBGRAPixel; + pexp: PExpandedPixel; +begin + getmem(result, sizeof(TExpandedPixel)*Count); + if FSource <> nil then + begin + p := FSource.ScanLine[Y]+x; + pexp := result; + while Count > 0 do + begin + pexp^ := GammaExpansion(p^); + inc(pexp); + inc(p); + dec(Count); + end; + end else + begin + FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y); + pexp := result; + while Count > 0 do + begin + pexp^ := FSourceScanner.ScanNextExpandedPixel; + inc(pexp); + dec(Count); + end; + end; +end; + +procedure TFilterTask.ReleaseSourceExpandedScanLine(P: PExpandedPixel); +begin + if p <> nil then freemem(p); +end; + +procedure TFilterTask.SetSource(ABitmap: TBGRACustomBitmap); +begin + FSource := ABitmap; + FSourceScanner := nil; +end; + +procedure TFilterTask.SetSource(AScanner: IBGRAScanner); +begin + FSource := nil; + FSourceScanner := AScanner; +end; + +function TFilterTask.Execute: TBGRACustomBitmap; +var DestinationOwned: boolean; +begin + FCurrentY := 0; + if Destination = nil then + begin + if FSource = nil then //using default factory + FDestination := BGRABitmapFactory.create(FSource.Width,FSource.Height) + else + FDestination := FSource.NewBitmap(FSource.Width,FSource.Height); + DestinationOwned:= true; + end else + DestinationOwned:= false; + try + DoExecute; + result := Destination; + FDestination := nil; + except + on ex: exception do + begin + if DestinationOwned then FreeAndNil(FDestination); + raise ex; + end; + end; +end; + +procedure TFilterTask.SetDestination(AValue: TBGRACustomBitmap); +begin + if FDestination <> nil then + raise exception.Create('Destination is already defined'); + FDestination := AValue; +end; + +function TFilterTask.GetInplace: boolean; +begin + result := (Destination = FSource) and (FSource <> nil); +end; + +procedure TFilterTask.SetInplace(AValue: boolean); +begin + if AValue = InPlace then exit; + if AValue and (FSource = nil) then + raise exception.Create('Inplace is valid only when source image is defined'); + Destination := FSource; +end; + +{ TBGRAFilterScanner } + +constructor TBGRAFilterScanner.Create(ASource: IBGRAScanner; AOffset: TPoint); +begin + FSource := ASource; + FOffset := AOffset; + FOutputBufferPos := FilterScannerChunkSize; +end; + +function TBGRAFilterScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + ScanMoveTo(X,Y); + result := ScanNextPixel; +end; + +procedure TBGRAFilterScanner.ScanMoveTo(X, Y: Integer); +begin + FCurX := X; + FCurY := Y; + FOutputBufferPos := FilterScannerChunkSize; +end; + +function TBGRAFilterScanner.ScanNextPixel: TBGRAPixel; +begin + if FOutputBufferPos >= FilterScannerChunkSize then + begin + ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FOutputBuffer[0],FilterScannerChunkSize); + FOutputBufferPos := 0; + end; + Result:= FOutputBuffer[FOutputBufferPos]; + inc(FOutputBufferPos); + inc(FCurX); +end; + +procedure TBGRAFilterScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +begin + if mode = dmSet then + begin + ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,pdest,count); + inc(FCurX,count); + end else + begin + AllocateBGRAPixelBuffer(FVariablePixelBuffer, count); + ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FVariablePixelBuffer[0],count); + inc(FCurX,count); + PutPixels(pdest, @FVariablePixelBuffer[0], count, mode, 255); + end; +end; + +procedure TBGRAFilterScanner.ScanSkipPixels(ACount: integer); +begin + inc(FOutputBufferPos, ACount); + inc(FCurX, ACount); +end; + +function TBGRAFilterScanner.IsScanPutPixelsDefined: boolean; +begin + Result:= true; +end; + +function TBGRAFilterScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + result := ScanAtInteger(round(X),round(Y)); +end; + +{ TBGRAFilterScannerPixelwise } + +procedure TBGRAFilterScannerPixelwise.DoComputeFilterAt(ASource: PBGRAPixel; + ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean); +begin + ComputeFilterAt(ASource,ADest,ACount,AGammaCorrection); +end; + +constructor TBGRAFilterScannerPixelwise.Create(ASource: IBGRAScanner; + AOffset: TPoint; AGammaCorrection: boolean); +begin + inherited Create(ASource,AOffset); + GammaCorrection := AGammaCorrection; + //it is most likely that direct read can be used, the only exception being + //that the destination would be equal to the source and that there would + //be an offset + AllowDirectRead := true; +end; + +procedure TBGRAFilterScannerPixelwise.ComputeFilter(ASource: IBGRAScanner; X, + Y: Integer; ADest: PBGRAPixel; ACount: integer); +var p: PBGRAPixel; +begin + if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then + begin + p := ASource.GetScanlineAt(x,y); + end else + begin + AllocateBGRAPixelBuffer(FBuffer, ACount); + ASource.ScanMoveTo(X,Y); + p := @FBuffer[0]; + ASource.ScanPutPixels(p, ACount, dmSet); + end; + DoComputeFilterAt(p,ADest,ACount,GammaCorrection); +end; + +class procedure TBGRAFilterScannerPixelwise.ComputeFilterInplace( + ABitmap: TBGRACustomBitmap; ABounds: TRect; AGammaCorrection: boolean); +var + yb: LongInt; + p: Pointer; +begin + ABitmap.LoadFromBitmapIfNeeded; + if (ABounds.Left = 0) and (ABounds.Top = 0) and + (ABounds.Right = ABitmap.Width) and (ABounds.Bottom = ABitmap.Height) then + ComputeFilterAt(ABitmap.Data,ABitmap.Data,ABitmap.NbPixels,AGammaCorrection) + else + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + p := ABitmap.ScanLine[yb]+ABounds.Left; + ComputeFilterAt(p,p,ABounds.Right-ABounds.Left,AGammaCorrection); + end; + ABitmap.InvalidateBitmap; +end; + +{ TBGRAFilterScannerMultipixel } + +procedure TBGRAFilterScannerMultipixel.LoadBuffer(ASource: IBGRAScanner; X, + Y: Integer; BufferIndex: Integer; ACount: integer); +begin + if (Y < FSourceBounds.Top) or (Y >= FSourceBounds.Bottom) then + FPBuffers[BufferIndex] := nil + else + if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then + begin + FPBuffers[BufferIndex] := ASource.GetScanlineAt(X,Y); + end else + begin + AllocateBGRAPixelBuffer(FBuffers[BufferIndex], ACount); + ASource.ScanMoveTo(X,Y); + FPBuffers[BufferIndex] := @(FBuffers[BufferIndex][0]); + ASource.ScanPutPixels(FPBuffers[BufferIndex], ACount, dmSet); + end; +end; + +constructor TBGRAFilterScannerMultipixel.Create(ASource: IBGRAScanner; + ASourceBounds: TRect; AOffset: TPoint; AKernelWidth, AKernelHeight: Integer); +var + temp: Integer; +begin + inherited Create(ASource,AOffset); + FSourceBounds := ASourceBounds; + if FSourceBounds.Left > FSourceBounds.Right then + begin + temp := FSourceBounds.Left; + FSourceBounds.Left := FSourceBounds.Right; + FSourceBounds.Right := temp; + end; + if FSourceBounds.Top > FSourceBounds.Bottom then + begin + temp := FSourceBounds.Top; + FSourceBounds.Top := FSourceBounds.Bottom; + FSourceBounds.Bottom := temp; + end; + FKernelWidth := AKernelWidth; + FKernelHeight:= AKernelHeight; + SetLength(FBuffers, FKernelHeight); + SetLength(FPBuffers, FKernelHeight); + FCurBufferYDefined := false; + //it is not sure that direct read can be used, because if the destination + //is equal to the source, the output will change the input buffers + AllowDirectRead := false; +end; + +procedure TBGRAFilterScannerMultipixel.ComputeFilter(ASource: IBGRAScanner; X, + Y: Integer; ADest: PBGRAPixel; ACount: integer); +var + yb,dy: Integer; + temp: TBGRAPixelBuffer; + p: PBGRAPixel; +begin + if not FCurBufferYDefined or (Abs(Y-FCurBufferY)>=FKernelHeight) then + begin + FCurBufferY := y; + FCurBufferYDefined := true; + for yb := 0 to FKernelHeight-1 do + LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,SourceBounds.Right-FSourceBounds.Left); + end else + if Y < FCurBufferY then + begin + dy := FCurBufferY-y; + for yb := FKernelHeight-1 downto dy do + begin + temp := FBuffers[yb]; + FBuffers[yb] := FBuffers[yb-dy]; + FBuffers[yb-dy] := temp; + p := FPBuffers[yb]; + FPBuffers[yb] := FPBuffers[yb-dy]; + FPBuffers[yb-dy] := p; + end; + for yb := 0 to dy-1 do + LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left); + FCurBufferY := y; + end else + if Y > FCurBufferY then + begin + dy := y-FCurBufferY; + for yb := 0 to FKernelHeight-1-dy do + begin + temp := FBuffers[yb]; + FBuffers[yb] := FBuffers[yb+dy]; + FBuffers[yb+dy] := temp; + p := FPBuffers[yb]; + FPBuffers[yb] := FPBuffers[yb+dy]; + FPBuffers[yb+dy] := p; + end; + for yb := FKernelHeight-1-dy+1 to FKernelHeight-1 do + LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left); + FCurBufferY := y; + end; + DoComputeFilter(X-FSourceBounds.Left,FPBuffers,FSourceBounds.Right-FSourceBounds.Left,ADest,ACount); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafontgl.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafontgl.pas new file mode 100644 index 0000000..1e21f0f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafontgl.pas @@ -0,0 +1,694 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFontGL; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRAOpenGLType, BGRABitmapTypes, + Avl_Tree; + +type + { TRenderedGlyph } + + TRenderedGlyph = class + private + FIdentifier: UTF8String; + FTexture: IBGLTexture; + FHorizontalOverflowPx, FVerticalOverflowPx, FAdvancePx: integer; + public + constructor Create(AIdentifier: UTF8String; ATexture: IBGLTexture; + AHorizontalOverflowPx, AVerticalOverflowPx: integer); + procedure Draw(x,y,Scale: single; AColor: TBGRAPixel); overload; + procedure Draw(x,y,Scale: single; AGradTopLeft, AGradTopRight, AGradBottomRight, AGradBottomLeft: TBGRAPixel); overload; + property Identifier: UTF8String read FIdentifier; + property AdvancePx: integer read FAdvancePx; + end; + + { IBGLRenderedFont } + + IBGLRenderedFont = interface(IBGLFont) + function GetBackgroundColor: TBGRAPixel; + function GetColor: TBGRAPixel; + function GetFontEmHeight: integer; + function GetFontFullHeight: integer; + function GetHorizontalOverflow: single; + function GetName: string; + function GetQuality: TBGRAFontQuality; + function GetStyle: TFontStyles; + function GetVerticalOverflow: single; + procedure SetBackgroundColor(AValue: TBGRAPixel); + procedure SetColor(AValue: TBGRAPixel); + procedure SetFontEmHeight(AValue: integer); + procedure SetFontFullHeight(AValue: integer); + procedure SetHorizontalOverflow(AValue: single); + procedure SetName(AValue: string); + procedure SetQuality(AValue: TBGRAFontQuality); + procedure SetStyle(AValue: TFontStyles); + procedure SetVerticalOverflow(AValue: single); + + property Name: string read GetName write SetName; + property Style: TFontStyles read GetStyle write SetStyle; + property Quality: TBGRAFontQuality read GetQuality write SetQuality; + property EmHeight: integer read GetFontEmHeight write SetFontEmHeight; + property FullHeight: integer read GetFontFullHeight write SetFontFullHeight; + property Color: TBGRAPixel read GetColor write SetColor; + property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow; + property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow; + property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor; + end; + + { TBGLRenderedFont } + + TBGLRenderedFont = class(TBGLCustomFont,IBGLRenderedFont) + private + FGlyphs: TAVLTree; + + FName: string; + FColor: TBGRAPixel; + FBackgroundColor: TBGRAPixel; + FEmHeight: integer; + FHorizontalOverflow: single; + FVerticalOverflow: single; + FQuality: TBGRAFontQuality; + FStyle: TFontStyles; + FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel; + FUseGradientColor: boolean; + FClipped: boolean; + FWordBreakHandler: TWordBreakHandler; + + function FindGlyph(AIdentifier: string): TAVLTreeNode; + function GetBackgroundColor: TBGRAPixel; + function GetColor: TBGRAPixel; + function GetFontEmHeight: integer; + function GetGlyph(AIdentifier: string): TRenderedGlyph; + function GetHorizontalOverflow: single; + function GetName: string; + function GetQuality: TBGRAFontQuality; + function GetStyle: TFontStyles; + function GetVerticalOverflow: single; + procedure SetGlyph(AIdentifier: string; AValue: TRenderedGlyph); + function GetFontFullHeight: integer; + procedure SetBackgroundColor(AValue: TBGRAPixel); + procedure SetColor(AValue: TBGRAPixel); + procedure SetFontEmHeight(AValue: integer); + procedure SetFontFullHeight(AValue: integer); + procedure SetHorizontalOverflow(AValue: single); + procedure SetName(AValue: string); + procedure SetQuality(AValue: TBGRAFontQuality); + procedure SetStyle(AValue: TFontStyles); + procedure SetVerticalOverflow(AValue: single); + protected + FRenderer: TBGRACustomFontRenderer; + FRendererOwned: boolean; + function LoadFromFile({%H-}AFilename: UTF8String): boolean; override; + procedure FreeMemoryOnDestroy; override; + function CreateGlyph(AIdentifier: string): TRenderedGlyph; virtual; + procedure CopyFontToRenderer; virtual; + procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); overload; virtual; + procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; override; + procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); override; + function GetClipped: boolean; override; + function GetUseGradientColors: boolean; override; + procedure SetClipped(AValue: boolean); override; + procedure SetUseGradientColors(AValue: boolean); override; + procedure DiscardGlyphs; virtual; + procedure DefaultWordBreakHandler(var ABefore, AAfter: string); + procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string); + function GetWrappedLines(ATextUTF8: string; AWidth: single): TStringList; + public + constructor Create(ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true); + procedure FreeMemory; override; + function TextWidth(const Text: UTF8String): single; override; + function TextHeight(const {%H-}Text: UTF8String): single; override; + function TextHeight(const Text: UTF8String; AWidth: single): single; override; + procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); override; + property Name: string read GetName write SetName; + property Style: TFontStyles read GetStyle write SetStyle; + property Quality: TBGRAFontQuality read GetQuality write SetQuality; + property EmHeight: integer read GetFontEmHeight write SetFontEmHeight; + property FullHeight: integer read GetFontFullHeight write SetFontFullHeight; + property Color: TBGRAPixel read GetColor write SetColor; + property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow; + property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow; + property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor; + property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; + property Glyph[AIdentifier: string]: TRenderedGlyph read GetGlyph; + end; + +implementation + +uses BGRAUTF8; + +{ TRenderedGlyph } + +constructor TRenderedGlyph.Create(AIdentifier: UTF8String; ATexture: IBGLTexture; + AHorizontalOverflowPx, AVerticalOverflowPx: integer); +begin + FIdentifier := AIdentifier; + FTexture := ATexture; + FHorizontalOverflowPx:= AHorizontalOverflowPx; + FVerticalOverflowPx:= AVerticalOverflowPx; + FAdvancePx := ATexture.Width - 2*FHorizontalOverflowPx; +end; + +procedure TRenderedGlyph.Draw(x, y, Scale: single; AColor: TBGRAPixel); +begin + FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale, AColor); +end; + +procedure TRenderedGlyph.Draw(x, y, Scale: single; AGradTopLeft, AGradTopRight, + AGradBottomRight, AGradBottomLeft: TBGRAPixel); +begin + FTexture.SetGradientColors(AGradTopLeft,AGradTopRight, AGradBottomRight,AGradBottomLeft); + FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale); + FTexture.GradientColors := false; +end; + +function CompareGlyphNode(Data1, Data2: Pointer): integer; +begin + result := CompareStr(TRenderedGlyph(Data1).Identifier,TRenderedGlyph(Data2).Identifier); +end; + +{ TBGLRenderedFont } + +function TBGLRenderedFont.FindGlyph(AIdentifier: string): TAVLTreeNode; +var Comp: integer; + Node: TAVLTreeNode; +begin + Node:=FGlyphs.Root; + while (Node<>nil) do begin + Comp:=CompareStr(AIdentifier,TRenderedGlyph(Node.Data).Identifier); + if Comp=0 then break; + if Comp<0 then begin + Node:=Node.Left + end else begin + Node:=Node.Right + end; + end; + result := Node; +end; + +function TBGLRenderedFont.GetBackgroundColor: TBGRAPixel; +begin + result := FBackgroundColor; +end; + +function TBGLRenderedFont.GetColor: TBGRAPixel; +begin + result := FColor; +end; + +function TBGLRenderedFont.GetFontEmHeight: integer; +begin + result := FEmHeight; +end; + +function TBGLRenderedFont.CreateGlyph(AIdentifier: string): TRenderedGlyph; +var b: TBGLCustomBitmap; + hOverflow, vOverflow: integer; +begin + CopyFontToRenderer; + with FRenderer.TextSize(AIdentifier) do + begin + hOverflow := round(cx*HorizontalOverflow)+1; + vOverflow:= round(cy*VerticalOverflow)+1; + b:= BGLBitmapFactory.Create(cx+2*hOverflow,cy+2*vOverflow,BackgroundColor); + FRenderer.TextOut(b, hOverflow,vOverflow, AIdentifier, Color, taLeftJustify); + result:= TRenderedGlyph.Create(AIdentifier,b.MakeTextureAndFree,hOverflow,vOverflow); + end; +end; + +procedure TBGLRenderedFont.CopyFontToRenderer; +begin + FRenderer.FontName := FName; + FRenderer.FontEmHeight := FEmHeight; + FRenderer.FontOrientation := 0; + FRenderer.FontQuality := FQuality; + FRenderer.FontStyle := FStyle; +end; + +procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String; + AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); +var + pstr: pchar; + left,charlen: integer; + nextchar: string; + g: TRenderedGlyph; +begin + if Text = '' then exit; + + pstr := @Text[1]; + left := length(Text); + case AHorizontalAlign of + taCenter: DecF(x, round(TextWidth(Text)/2)); + taRightJustify: DecF(x, TextWidth(Text)); + end; + case AVerticalAlign of + tlCenter: DecF(y, round(TextHeight(Text)/2)); + tlBottom: DecF(y, TextHeight(Text)*Scale); + end; + while left > 0 do + begin + charlen := UTF8CharacterLength(pstr); + setlength(nextchar, charlen); + move(pstr^, nextchar[1], charlen); + inc(pstr,charlen); + dec(left,charlen); + + g := GetGlyph(nextchar); + if g <> nil then + begin + if FUseGradientColor then + g.Draw(x,y,Scale,FGradTopLeft,FGradTopRight,FGradBottomRight,FGradBottomLeft) + else + g.Draw(x,y,Scale,AColor); + IncF(x, (g.AdvancePx + StepX) * Scale); + end; + end; +end; + +procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String; + AColor: TBGRAPixel); +begin + if Justify then + DoTextOut(X,Y,Text,AColor,taLeftJustify,VerticalAlign) + else + DoTextOut(X,Y,Text,AColor,HorizontalAlign,VerticalAlign); +end; + +procedure TBGLRenderedFont.DoTextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AColor: TBGRAPixel); + + procedure DoDrawTextLine(LineY, LineWidth: Single; ALine: string; AJustify: boolean); + var CurX: single; + words: TStringList; + wordStart: integer; + i: Integer; + begin + if AJustify then + begin + words := TStringList.Create; + wordStart := 1; + for i := 1 to length(ALine) do + begin + if ALine[i]=' ' then + begin + words.Add(copy(ALine,wordStart,i-wordStart)); + wordStart := i+1; + end; + end; + words.add(copy(ALine,wordStart,length(ALine)+1-wordStart)); + CurX := X; + LineWidth := 0; + for i := 0 to words.Count-1 do + IncF(LineWidth, TextWidth(words[i])); + + for i := 0 to words.Count-1 do + begin + DoTextOut(CurX+round((Width-LineWidth)/(words.Count-1)*i),LineY,words[i],AColor,taLeftJustify,tlTop); + IncF(CurX, TextWidth(words[i])); + end; + words.Free; + end else + begin + Case HorizontalAlign of + taCenter: CurX := round(X+(Width-LineWidth)/2); + taRightJustify: CurX := X+Width-LineWidth; + else + CurX := X; + end; + DoTextOut(CurX,LineY,ALine,AColor,taLeftJustify,tlTop); + end; + end; + +var CurY: Single; + lineHeight: Single; + lines: TStringList; + i,originalNbLines: Integer; + maxLineCount: int64; +begin + If Text='' then exit; + lines := GetWrappedLines(Text,Width); + lineHeight := FullHeight * Scale; + originalNbLines := lines.Count; + + if Clipped then + begin + if lineHeight = 0 then exit; + maxLineCount := trunc(Height/lineHeight); + if maxLineCount <= 0 then exit; + while lines.Count > maxLineCount do + lines.Delete(lines.Count-1); + end; + + case VerticalAlign of + tlCenter: CurY := round(Y+( Height - lines.Count*lineHeight )/2); + tlBottom: CurY := Y + Height - lines.Count*lineHeight; + else CurY := Y; + end; + + for i := 0 to lines.Count-1 do + begin + DoDrawTextLine(CurY,TextWidth(lines[i]),lines[i],Justify and (i<>originalNbLines-1)); + IncF(CurY, lineHeight); + end; + lines.Free; +end; + +function TBGLRenderedFont.GetGlyph(AIdentifier: string): TRenderedGlyph; +var Node: TAVLTreeNode; +begin + Node := FindGlyph(AIdentifier); + if Node = nil then + begin + if UTF8Length(AIdentifier)<>1 then + result := nil + else + begin + result := CreateGlyph(AIdentifier); + SetGlyph(AIdentifier, result); + end; + end + else + result := TRenderedGlyph(Node.Data); +end; + +function TBGLRenderedFont.GetHorizontalOverflow: single; +begin + result := FHorizontalOverflow; +end; + +function TBGLRenderedFont.GetName: string; +begin + result := FName; +end; + +function TBGLRenderedFont.GetQuality: TBGRAFontQuality; +begin + result := FQuality; +end; + +function TBGLRenderedFont.GetStyle: TFontStyles; +begin + result := FStyle; +end; + +function TBGLRenderedFont.GetVerticalOverflow: single; +begin + result := FVerticalOverflow; +end; + +procedure TBGLRenderedFont.SetGlyph(AIdentifier: string; AValue: TRenderedGlyph); +var Node: TAVLTreeNode; +begin + if AValue.Identifier <> AIdentifier then + raise exception.Create('Identifier mismatch'); + Node := FindGlyph(AIdentifier); + if Node <> nil then + begin + if pointer(AValue) <> Node.Data then + TRenderedGlyph(Node.Data).Free; + Node.Data := AValue; + end else + FGlyphs.Add(pointer(AValue)); +end; + +procedure TBGLRenderedFont.SetStyle(AValue: TFontStyles); +begin + if FStyle=AValue then Exit; + FStyle:=AValue; + DiscardGlyphs; +end; + +procedure TBGLRenderedFont.SetVerticalOverflow(AValue: single); +begin + if FVerticalOverflow=AValue then Exit; + FVerticalOverflow:=AValue; + DiscardGlyphs; +end; + +function TBGLRenderedFont.GetClipped: boolean; +begin + result := FClipped; +end; + +function TBGLRenderedFont.GetUseGradientColors: boolean; +begin + result := FUseGradientColor; +end; + +procedure TBGLRenderedFont.SetClipped(AValue: boolean); +begin + FClipped:= AValue; +end; + +procedure TBGLRenderedFont.SetUseGradientColors(AValue: boolean); +begin + FUseGradientColor:= AValue; +end; + +procedure TBGLRenderedFont.DiscardGlyphs; +begin + FGlyphs.FreeAndClear; +end; + +procedure TBGLRenderedFont.DefaultWordBreakHandler(var ABefore, AAfter: string); +begin + BGRADefaultWordBreakHandler(ABefore,AAfter); +end; + +function TBGLRenderedFont.GetWrappedLines(ATextUTF8: string; AWidth: single + ): TStringList; +var + ARemains: string; +begin + result := TStringList.Create; + repeat + SplitText(ATextUTF8, AWidth, ARemains); + result.Add(ATextUTF8); + ATextUTF8 := ARemains; + until ARemains = ''; +end; + +procedure TBGLRenderedFont.SplitText(var ATextUTF8: string; AMaxWidth: single; + out ARemainsUTF8: string); +var + pstr: pchar; + p,left,charlen: integer; + totalWidth: single; + firstChar: boolean; + nextchar: string; + g: TRenderedGlyph; +begin + totalWidth := 0; + if ATextUTF8 = '' then + begin + ARemainsUTF8 := ''; + exit; + end else + begin + p := 1; + pstr := @ATextUTF8[1]; + left := length(ATextUTF8); + firstChar := true; + while left > 0 do + begin + if RemoveLineEnding(ATextUTF8,p) then + begin + ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + exit; + end; + + charlen := UTF8CharacterLength(pstr); + setlength(nextchar, charlen); + move(pstr^, nextchar[1], charlen); + inc(pstr,charlen); + + g := GetGlyph(nextchar); + if g <> nil then + begin + if not firstChar then IncF(totalWidth, StepX*Scale); + IncF(totalWidth, g.AdvancePx*Scale); + if not firstChar and (totalWidth > AMaxWidth) then + begin + ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + if Assigned(FWordBreakHandler) then + FWordBreakHandler(ATextUTF8,ARemainsUTF8) else + DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8); + exit; + end; + end; + + dec(left,charlen); + inc(p,charlen); + firstChar := false; + end; + end; + ARemainsUTF8 := ''; //no split +end; + +procedure TBGLRenderedFont.SetName(AValue: string); +begin + if FName=AValue then Exit; + FName:=AValue; + DiscardGlyphs; +end; + +procedure TBGLRenderedFont.SetFontEmHeight(AValue: integer); +begin + if FEmHeight=AValue then Exit; + FEmHeight:=AValue; + DiscardGlyphs; +end; + +function TBGLRenderedFont.GetFontFullHeight: integer; +begin + if FEmHeight < 0 then + result := -EmHeight + else + result := FRenderer.TextSize('Hg').cy; +end; + +procedure TBGLRenderedFont.SetBackgroundColor(AValue: TBGRAPixel); +begin + if FBackgroundColor=AValue then Exit; + FBackgroundColor:=AValue; + DiscardGlyphs; +end; + +procedure TBGLRenderedFont.SetColor(AValue: TBGRAPixel); +begin + if FColor=AValue then Exit; + FColor:=AValue; + DiscardGlyphs; +end; + +procedure TBGLRenderedFont.SetFontFullHeight(AValue: integer); +begin + EmHeight:= -AValue; +end; + +procedure TBGLRenderedFont.SetHorizontalOverflow(AValue: single); +begin + if FHorizontalOverflow=AValue then Exit; + FHorizontalOverflow:=AValue; + DiscardGlyphs; +end; + +procedure TBGLRenderedFont.SetQuality(AValue: TBGRAFontQuality); +begin + if FQuality=AValue then Exit; + FQuality:=AValue; + DiscardGlyphs; +end; + +function TBGLRenderedFont.LoadFromFile(AFilename: UTF8String): boolean; +begin + result := false; +end; + +procedure TBGLRenderedFont.FreeMemoryOnDestroy; +begin + FreeMemory; + if FRendererOwned then FreeAndNil(FRenderer); + FreeAndNil(FGlyphs); +end; + +constructor TBGLRenderedFont.Create(ARenderer: TBGRACustomFontRenderer; + ARendererOwned: boolean); +begin + Init; + FRenderer := ARenderer; + FRendererOwned := ARendererOwned; + + FName := 'Arial'; + FColor := BGRAWhite; + FBackgroundColor := BGRAPixelTransparent; + FEmHeight := 20; + FStyle := []; + FHorizontalOverflow := 0.33; + FVerticalOverflow := 0; + FQuality := fqFineAntialiasing; + + FGradTopLeft := BGRAWhite; + FGradTopRight := BGRAWhite; + FGradBottomLeft := BGRAWhite; + FGradBottomRight := BGRAWhite; + FUseGradientColor:= false; + FClipped:= false; + + FGlyphs := TAVLTree.Create(@CompareGlyphNode); + FWordBreakHandler:= nil; +end; + +procedure TBGLRenderedFont.FreeMemory; +begin + DiscardGlyphs; + inherited FreeMemory; +end; + +function TBGLRenderedFont.TextWidth(const Text: UTF8String): single; +var + pstr: pchar; + left,charlen: integer; + nextchar: string; + g: TRenderedGlyph; + firstChar: boolean; +begin + result := 0; + if Text = '' then exit; + + firstChar := true; + pstr := @Text[1]; + left := length(Text); + while left > 0 do + begin + charlen := UTF8CharacterLength(pstr); + setlength(nextchar, charlen); + move(pstr^, nextchar[1], charlen); + inc(pstr,charlen); + dec(left,charlen); + + g := GetGlyph(nextchar); + if g <> nil then + begin + if firstChar then + firstchar := false + else + IncF(result, StepX * Scale); + IncF(result, g.AdvancePx * Scale); + end; + end; +end; + +function TBGLRenderedFont.TextHeight(const Text: UTF8String): single; +begin + result := FullHeight * Scale; +end; + +function TBGLRenderedFont.TextHeight(const Text: UTF8String; AWidth: single + ): single; +var + lines: TStringList; +begin + lines := GetWrappedLines(Text, AWidth); + result := lines.Count * (FullHeight * Scale); + lines.Free; +end; + +procedure TBGLRenderedFont.SetGradientColors(ATopLeft, ATopRight, ABottomRight, + ABottomLeft: TBGRAPixel); +begin + FGradTopLeft := ATopLeft; + FGradTopRight := ATopRight; + FGradBottomLeft := ABottomLeft; + FGradBottomRight := ABottomRight; + GradientColors := true; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafpcanvas.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpcanvas.inc new file mode 100644 index 0000000..c6e5edf --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpcanvas.inc @@ -0,0 +1,286 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} + +type + {* How to draw the end of line } + TPenEndCap = TFPPenEndCap; + +const + {** Draw a half-disk at the end of the line. The diameter of the disk is + equal to the pen width. } + pecRound = FPCanvas.pecRound; + {** Draw a half-square. The size of the square is equal to the pen width. + This is visually equivalent to extend the line of half the pen width } + pecSquare = FPCanvas.pecSquare; + {** The line ends exactly at the end point } + pecFlat = FPCanvas.pecFlat; + +type + {* How to join segments. This makes sense only for geometric pens (that + have a certain width) } + TPenJoinStyle = TFPPenJoinStyle; + +const + {** Segments are joined by filling the gap with an arc } + pjsRound = FPCanvas.pjsRound; + {** Segments are joind by filling the gap with an intermediary segment } + pjsBevel = FPCanvas.pjsBevel; + {** Segments are joined by extending them up to their intersection. + There is a miter limit so that if the intersection is too far, + an intermediary segment is used } + pjsMiter = FPCanvas.pjsMiter; + +type + {* Style to use for the pen. The unit for the pattern is the width of the + line } + TPenStyle = TFPPenStyle; + TPenMode = TFPPenMode; + +const + {** Pen is continuous } + psSolid = FPCanvas.psSolid; + {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit } + psDash = FPCanvas.psDash; + {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit } + psDot = FPCanvas.psDot; + {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 } + psDashDot = FPCanvas.psDashDot; + {** Dash of length 3, and two dots of length 1 } + psDashDotDot = FPCanvas.psDashDotDot; + {** Pen is not drawn } + psClear = FPCanvas.psClear; + {** Not used. Provided for compatibility } + psInsideframe = FPCanvas.psInsideframe; + {** Custom pattern used } + psPattern = FPCanvas.psPattern; + + pmBlack = FPCanvas.pmBlack; + pmWhite = FPCanvas.pmWhite; + pmNop = FPCanvas.pmNop; + pmNot = FPCanvas.pmNot; + pmCopy = FPCanvas.pmCopy; + pmNotCopy = FPCanvas.pmNotCopy; + pmMergePenNot = FPCanvas.pmMergePenNot; + pmMaskPenNot = FPCanvas.pmMaskPenNot; + pmMergeNotPen = FPCanvas.pmMergeNotPen; + pmMaskNotPen = FPCanvas.pmMaskNotPen; + pmMerge = FPCanvas.pmMerge; + pmNotMerge = FPCanvas.pmNotMerge; + pmMask = FPCanvas.pmMask; + pmNotMask = FPCanvas.pmNotMask; + pmXor = FPCanvas.pmXor; + pmNotXor = FPCanvas.pmNotXor; + +type + { TPen } + {* A class containing a pen } + TPen = class(TFPCustomPen) + private + function GetColor: TColor; + procedure SetColor(AValue: TColor); + public + constructor Create; override; + {** Color of the pen } + property Color: TColor read GetColor write SetColor; + {** Operation done on pixels } + property Mode; + {** End cap of the pen: how to draw the ends of the lines } + property EndCap; + {** Join style: how to join the segments of a polyline } + property JoinStyle; + {** Pen style: solid, dash, dot... } + property Style; + {** Pen width in pixels } + property Width; + end; + + {* Pattern when filling with a brush. It is used in BGRACanvas but can + also be created with TBGRABitmap.CreateBrushTexture function } + TBrushStyle = TFPBrushStyle; + +const + {** Fill with the current color } + bsSolid = FPCanvas.bsSolid; + {** Does not fill at all } + bsClear = FPCanvas.bsClear; + {** Draw horizontal lines } + bsHorizontal = FPCanvas.bsHorizontal; + {** Draw vertical lines } + bsVertical = FPCanvas.bsVertical; + {** Draw diagonal lines from top-left to bottom-right } + bsFDiagonal = FPCanvas.bsFDiagonal; + {** Draw diagonal lines from bottom-left to top-right } + bsBDiagonal = FPCanvas.bsBDiagonal; + {** Draw both horizontal and vertical lines } + bsCross = FPCanvas.bsCross; + {** Draw both diagonal lines } + bsDiagCross = FPCanvas.bsDiagCross; + {** Fills with an image } + bsImage = FPCanvas.bsImage; + +type + { TBrush } + {* A class describing a brush } + TBrush = class(TFPCustomBrush) + private + function GetColor: TColor; + procedure SetColor(AValue: TColor); + public + constructor Create; override; + {** Color of the brush } + property Color: TColor read GetColor write SetColor; + {** Style of the brush: solid, diagonal lines, horizontal lines... } + property Style; + end; + + { TFont } + {* Contains the description of a font } + TFont = class(TFPCustomFont) + private + FPixelsPerInch, FHeight: Integer; + FQuality: TFontQuality; + FStyle: TFontStyles; + function GetColor: TColor; + function GetHeight: Integer; + function GetSize: Integer; + function GetStyle: TFontStyles; + procedure SetColor(AValue: TColor); + procedure SetHeight(AValue: Integer); + procedure SetQuality(AValue: TFontQuality); + procedure SetStyle(AValue: TFontStyles); + protected + procedure SetSize(AValue: Integer); override; + public + constructor Create; override; + {** Pixels per inches } + property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch; + {** Color of the font } + property Color: TColor read GetColor write SetColor; + {** Height of the font in pixels. When the number is negative, it indicates a size in pixels } + property Height: Integer read GetHeight write SetHeight; + {** Size of the font in inches. When the number is negative, it indicates a height in inches } + property Size: Integer read GetSize write SetSize; + {** Quality of the font rendering } + property Quality: TFontQuality read FQuality write SetQuality; + {** Style to apply to the text } + property Style: TFontStyles read GetStyle write SetStyle; + end; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{ TPen } + +procedure TPen.SetColor(AValue: TColor); +begin + FPColor := TColorToFPColor(AValue); +end; + +function TPen.GetColor: TColor; +begin + result := FPColorToTColor(FPColor); +end; + +constructor TPen.Create; +begin + inherited Create; + Mode := pmCopy; + Style := psSolid; + Width := 1; + FPColor := colBlack; + EndCap:= pecRound; + JoinStyle:= pjsRound; +end; + +{ TBrush } + +function TBrush.GetColor: TColor; +begin + result := FPColorToTColor(FPColor); +end; + +procedure TBrush.SetColor(AValue: TColor); +begin + FPColor := TColorToFPColor(AValue); +end; + +constructor TBrush.Create; +begin + inherited Create; + FPColor := colWhite; +end; + +{ TFont } + +function TFont.GetColor: TColor; +begin + result := FPColorToTColor(FPColor); +end; + +function TFont.GetHeight: Integer; +begin + result := FHeight; +end; + +function TFont.GetSize: Integer; +begin + Result := inherited Size; +end; + +function TFont.GetStyle: TFontStyles; +begin + result := FStyle; +end; + +procedure TFont.SetColor(AValue: TColor); +begin + FPColor := TColorToFPColor(AValue); +end; + +procedure TFont.SetHeight(AValue: Integer); +begin + if Height <> AValue then + begin + FHeight := AValue; + inherited SetSize(-MulDiv(AValue, 72, FPixelsPerInch)); + end; +end; + +procedure TFont.SetQuality(AValue: TFontQuality); +begin + if FQuality=AValue then Exit; + FQuality:=AValue; +end; + +procedure TFont.SetSize(AValue: Integer); +begin + if Size <> AValue then + begin + inherited SetSize(AValue); + FHeight := -MulDiv(AValue, FPixelsPerInch, 72); + end; +end; + +procedure TFont.SetStyle(AValue: TFontStyles); +begin + if FStyle <> AValue then + begin + FStyle := AValue; + inherited SetFlags(5, fsBold in FStyle); + inherited SetFlags(6, fsItalic in FStyle); + inherited SetFlags(7, fsUnderline in FStyle); + inherited SetFlags(8, fsStrikeOut in FStyle); + end; +end; + +constructor TFont.Create; +begin + FPixelsPerInch := GetScreenDPIY; + FQuality := fqDefault; + FPColor := colBlack; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui.inc new file mode 100644 index 0000000..d6ec560 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui.inc @@ -0,0 +1,78 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + TColor = TfpgColor; + TRawImage = class(TfpgImage) + procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); + end; + TGUICanvas = TfpgCanvas; + +const + clNone = fpg_base.clNone; + clBlack = fpg_base.clBlack; + clWhite = fpg_base.clWhite; + +function clRgbBtnHighlight: TColor; +function clRgbBtnShadow: TColor; +function ColorToRGB(c: TColor): TColor; inline; +function GetScreenDPIX: integer; +function GetScreenDPIY: integer; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); +var + tempData: pointer; +begin + if (Width <> AWidth) or (Height <> AHeight) then + begin + AllocateImage(32,AWidth,AHeight); + if ATransparent then AllocateMask; + end else + begin + if ATransparent and not Masked then AllocateMask else + if not ATransparent and Masked then + begin + getmem(tempData, ImageDataSize); + if tempData <> nil then + begin + move(ImageData^, tempData^, ImageDataSize); + FreeImage; + AllocateImage(32,AWidth,AHeight); + move(tempData^, ImageData^, ImageDataSize); + freemem(tempData); + end; + end; + end; +end; + +function clRgbBtnHighlight: TColor; +begin + result := fpgColorToRGB(fpg_base.clHilite2); +end; + +function clRgbBtnShadow: TColor; +begin + result := fpgColorToRGB(fpg_base.clShadow2); +end; + +function ColorToRGB(c: TColor): TColor; inline; +begin + result := fpgColorToRGB(c); +end; + +function GetScreenDPIX: integer; +begin + result := fpgApplication.Screen_dpi_x; +end; + +function GetScreenDPIY: integer; +begin + result := fpgApplication.Screen_dpi_y; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui_uses.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui_uses.inc new file mode 100644 index 0000000..54b33a7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui_uses.inc @@ -0,0 +1 @@ +uses BGRAClasses, FPImage, FPCanvas, fpg_base, fpg_main; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafpguibitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpguibitmap.pas new file mode 100644 index 0000000..c6f0c90 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafpguibitmap.pas @@ -0,0 +1,268 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAfpGUIBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, + BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection, + BGRACanvas; + +type + + { TBGRAfpGUIBitmap } + + TBGRAfpGUIBitmap = class(TBGRADefaultBitmap) + private + FPseudoCanvas: TBGRACanvas; + function GetPseudoCanvas: TBGRACanvas; + function GetBitmapTransparent: boolean; + procedure SetBitmapTransparent(AValue: boolean); + protected + procedure RebuildBitmap; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; + function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; + AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean + =True): boolean; override; + procedure Init; override; + procedure FreeData; override; + procedure ReallocData; override; + procedure FreeBitmap; override; + procedure NotAvailable; + public + destructor Destroy; override; + class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static; + class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static; + procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override; + procedure Draw(ACanvas: TGUICanvas; x, y: integer; {%H-}Opaque: boolean=True); overload; + procedure Draw(ACanvas: TGUICanvas; Rect: TRect; {%H-}Opaque: boolean=True); overload; + procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure TakeScreenshot({%H-}ARect: TRect); override; //not available + procedure TakeScreenshotOfPrimaryMonitor; override; //not available + procedure LoadFromDevice({%H-}DC: HDC); override; //not available + procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available + property BitmapTransparent: boolean read GetBitmapTransparent write SetBitmapTransparent; + property Canvas: TBGRACanvas read GetPseudoCanvas; + end; + +implementation + +{ TBGRAfpGUIBitmap } + +function TBGRAfpGUIBitmap.GetBitmapTransparent: boolean; +begin + result := FBitmap.Transparent; +end; + +function TBGRAfpGUIBitmap.GetPseudoCanvas: TBGRACanvas; +begin + if FPseudoCanvas = nil then + begin + FPseudoCanvas := TBGRACanvas.Create(self); + FPseudoCanvas.AntialiasingMode := amOff; + end; + result := FPseudoCanvas; +end; + +procedure TBGRAfpGUIBitmap.SetBitmapTransparent(AValue: boolean); +begin + if FBitmap.Transparent <> AValue then + begin + FBitmap.Transparent:= AValue; + InvalidateBitmap; + end; +end; + +procedure TBGRAfpGUIBitmap.RebuildBitmap; +var pmask, pmaskline: PByte; + pdata: PBGRAPixel; + raw: TRawImage; + x,y,bit,masklinesize,curmaskbyte: UInt32or64; +begin + if FBitmap.Transparent then + begin + raw := FBitmap.RawImage; + masklinesize := ((Width+31) div 32)*4; + pmaskline := FBitmap.RawImage.MaskData; + pdata := raw.ImageData; + for y := 0 to Height-1 do + begin + pmask:= pmaskline; + bit := $80; + curmaskbyte := 0; + for x := Width-1 downto 0 do + begin + if pdata^.alpha >= $80 then + curmaskbyte := curmaskbyte or bit; + bit := bit shr 1; + if bit = 0 then + begin + bit := $80; + pmask^ := curmaskbyte; + inc(pmask); + curmaskbyte := 0; + end; + inc(pdata); + end; + if bit <> $80 then + pmask^ := curmaskbyte; + inc(pmaskline, masklinesize); + end; + end; + FBitmap.RawImage.UpdateImage; +end; + +function TBGRAfpGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := TBGRAFreeTypeFontRenderer.Create; +end; + +function TBGRAfpGUIBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +var + lineSize: integer; + y: Integer; +begin + if (ARawImage.Width <> Width) or + (ARawImage.Height <> Height) then + raise Exception.Create('Bitmap size is inconsistent'); + + lineSize := Width*sizeof(TBGRAPixel); + for y := 0 to Height-1 do + move(ARawImage.ScanLine[y]^, ScanLine[y]^, lineSize); + if AlwaysReplaceAlpha then AlphaFill(DefaultOpacity); + result := true; +end; + +procedure TBGRAfpGUIBitmap.Init; +begin + inherited Init; + FBitmap := TBitmap.Create; + FontAntialias:= true; +end; + +procedure TBGRAfpGUIBitmap.ReallocData; +begin + FBitmap.Width := Width; + FBitmap.Height:= Height; + FDataByte := PByte(FBitmap.RawImage.ImageData); + InvalidateBitmap; + FScanPtr := nil; +end; + +procedure TBGRAfpGUIBitmap.FreeData; +begin + //nothing +end; + +procedure TBGRAfpGUIBitmap.FreeBitmap; +begin + //nothing +end; + +procedure TBGRAfpGUIBitmap.NotAvailable; +begin + raise exception.Create('Function not available with fpGUI'); +end; + +destructor TBGRAfpGUIBitmap.Destroy; +begin + FreeAndNil(FBitmap); + FreeAndNil(FPseudoCanvas); + inherited Destroy; +end; + +class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean); +begin + if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory); + EasyLazFreeType.FontCollection.AddFolder(ADirectory); +end; + +class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean); +begin + if AUTF8 then AFilename:= Utf8ToAnsi(AFilename); + EasyLazFreeType.FontCollection.AddFile(AFilename); +end; + +procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + Draw(ACanvas.GUICanvas, x, y, Opaque); +end; + +procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +begin + Draw(ACanvas.GUICanvas, Rect, Opaque); +end; + +procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; x, y: integer; + Opaque: boolean); +begin + BitmapTransparent := not Opaque; + ACanvas.DrawImage(x,y, Bitmap.RawImage); +end; + +procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; Rect: TRect; + Opaque: boolean); +begin + BitmapTransparent := not Opaque; + ACanvas.StretchDraw(rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, FBitmap.RawImage); +end; + +procedure TBGRAfpGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, + y: integer); +begin + NotAvailable; +end; + +procedure TBGRAfpGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var temp: TBGRAfpGUIBitmap; +begin + temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight); + move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel)); + if ALineOrder <> temp.LineOrder then temp.VerticalFlip; + temp.Draw(ACanvas, Rect, False); + temp.Free; +end; + +procedure TBGRAfpGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var temp: TBGRAfpGUIBitmap; +begin + temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight); + move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel)); + if ALineOrder <> temp.LineOrder then temp.VerticalFlip; + temp.Draw(ACanvas, Rect, True); + temp.Free; +end; + +procedure TBGRAfpGUIBitmap.TakeScreenshot(ARect: TRect); +begin + NotAvailable; +end; + +procedure TBGRAfpGUIBitmap.TakeScreenshotOfPrimaryMonitor; +begin + NotAvailable; +end; + +procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC); +begin + NotAvailable; +end; + +procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect); +begin + NotAvailable; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrafreetype.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrafreetype.pas new file mode 100644 index 0000000..c95ecc7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrafreetype.pas @@ -0,0 +1,1606 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAFreeType; + +{$mode objfpc}{$H+} + +{ + Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType + + This units provide a font renderer with FreeType fonts, using the integrated FreeType font engine in Lazarus. + The simplest way to render effects is to use TBGRAFreeTypeFontRenderer class. + To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions + to draw text like TBGRABitmap.TextOut will use the chosen renderer. + + >> Note that you need to define the default FreeType font collection + >> using EasyLazFreeType unit. + + To set the effects, keep a variable containing + the TBGRAFreeTypeFontRenderer class and modify ShadowVisible and other effects parameters. The FontHinted property + allows you to choose if the font is snapped to pixels to make it more readable. + + TBGRAFreeTypeDrawer class is the class that provides basic FreeType drawing + by deriving the TFreeTypeDrawer type. You can use it directly, but it is not + recommended, because there are less text layout parameters. However, it is + necessary if you want to create TBGRATextEffect objects using FreeType fonts. +} + +interface + +{$i bgrabitmap.inc} + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, EasyLazFreeType, FPimage, + BGRACustomTextFX, BGRAPhongTypes, BGRATypewriter, LazVersion; + +{$IF laz_fullversion >= 2001000} + {$DEFINE LAZFREETYPE_GLYPH_BOX_FIXED} +{$ENDIF} + +{$IF laz_fullversion >= 2010000} + {$DEFINE LAZFREETYPE_PROVIDE_KERNING} +{$ENDIF} + +type + TBGRAFreeTypeDrawer = class; + + //this is the class to assign to FontRenderer property of TBGRABitmap + { TBGRAFreeTypeFontRenderer } + + TBGRAFreeTypeFontRenderer = class(TBGRACustomFontRenderer) + private + FDrawer: TBGRAFreeTypeDrawer; + FFont: TFreeTypeFont; + FLastFontSize: single; + function GetCollection: TCustomFreeTypeFontCollection; + function GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer; + function GetShaderLightPosition: TPoint; + function GetShaderLightPositionF: TPointF; + procedure SetShaderLightPosition(const AValue: TPoint); + procedure SetShaderLightPositionF(const AValue: TPointF); + protected + FShaderOwner: boolean; + FShader: TCustomPhongShading; + FTypeWriter: TBGRACustomTypeWriter; + function GetTypeWriter: TBGRACustomTypeWriter; + procedure UpdateFont(ADisableClearType: boolean = false); + procedure Init; + procedure TextOutAnglePatch(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; + c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment); + procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); + property TypeWriter: TBGRACustomTypeWriter read GetTypeWriter; + public + FontHinted: boolean; + + ShaderActive: boolean; + + ShadowVisible: boolean; + ShadowColor: TBGRAPixel; + ShadowRadius: integer; + ShadowOffset: TPoint; + ShadowQuality: TRadialBlurType; + + OutlineColor: TBGRAPixel; + OutlineVisible,OuterOutlineOnly: boolean; + OutlineTexture: IBGRAScanner; + + constructor Create; overload; + constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload; + function FontExists(AName: string): boolean; override; + function GetFontPixelMetric: TFontPixelMetric; override; + function GetFontPixelMetricF: TFontPixelMetricF; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); overload; override; + function TextSize(sUTF8: string): TSize; overload; override; + function TextSizeF(sUTF8: string): TPointF; overload; override; + function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; + function TextSizeF(sUTF8: string; AMaxWidthF: single; {%H-}ARightToLeft: boolean): TPointF; overload; override; + function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; + function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; override; + destructor Destroy; override; + property Collection: TCustomFreeTypeFontCollection read GetCollection; + property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition; + property ShaderLightPositionF: TPointF read GetShaderLightPositionF write SetShaderLightPositionF; + end; + + { TBGRAFreeTypeDrawer } + + TBGRAFreeTypeDrawer = class(TFreeTypeDrawer) + private + FMask: TBGRACustomBitmap; + FColor: TBGRAPixel; + FInCreateTextEffect: boolean; + procedure RenderDirectly(x, y, tx: integer; data: pointer); + procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer); + function ShadowActuallyVisible :boolean; + function OutlineActuallyVisible: boolean; + function ShaderActuallyActive : boolean; + public + Destination: TBGRACustomBitmap; + ClearTypeRGBOrder: boolean; + Texture: IBGRAScanner; + + Shader: TCustomPhongShading; + ShaderActive: boolean; + + ShadowVisible: boolean; + ShadowColor: TBGRAPixel; + ShadowRadius: integer; + ShadowOffset: TPoint; + ShadowQuality: TRadialBlurType; + + OutlineColor: TBGRAPixel; + OutlineVisible,OuterOutlineOnly: boolean; + OutlineTexture: IBGRAScanner; + + constructor Create(ADestination: TBGRACustomBitmap); + procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override; + procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload; + procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; + { If this code does not compile, you probably have an older version of Lazarus. To fix the problem, + go into "bgrabitmap.inc" and comment the compiler directives } + {$IFDEF BGRABITMAP_USE_LCL12} + procedure DrawTextWordBreak(AText: string; AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; + procedure DrawTextRect(AText: string; AFont: TFreeTypeRenderableFont; X1,Y1,X2,Y2: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; + {$ENDIF} + {$IFDEF BGRABITMAP_USE_LCL15} + procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override; + procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload; + procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; + {$ENDIF} + function CreateTextEffect(AText: string; AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect; + destructor Destroy; override; + end; + + +implementation + +uses BGRABlend, Math, BGRATransform, BGRAUnicode, BGRAUTF8; + +{$i generatedutf8.inc} + +procedure RecomposeUTF8(AFont: TFreeTypeFont; ADecomposed: string; out ARecomposed: string; out AMarks, AInnerMarks: string); +var + joinBefore, joinAfter: boolean; + lookFor: string; + + function FindChars(AText: string): boolean; + var + p, charLen: Integer; + u: LongWord; + begin + if AFont = nil then exit(true); + + p := 1; + while p <= length(AText) do + begin + charLen := UTF8CharacterLength(@AText[p]); + u := UTF8CodepointToUnicode(@AText[p], charLen); + if AFont.CharIndex[u] = 0 then exit(false); + inc(p, charLen); + end; + result := true; + end; + + function RecomposeRec(AMin,AMax: integer): boolean; + + procedure TryExactMatch; + var + i, extra: Integer; + newExtra: String; + begin + for i := AMin to AMax do + if UTF8Decomposition[i].de = ARecomposed then + begin + if UTF8Decomposition[i].join <> arNone then + if (joinBefore xor (UTF8Decomposition[i].join in[arMedial,arFinal])) or + (joinAfter xor (UTF8Decomposition[i].join in[arInitial,arMedial])) then continue; + if not FindChars(UTF8Decomposition[i].re) then continue; + ARecomposed := UTF8Decomposition[i].re; + result := true; + exit; + end; + for i := AMin to AMax do + if ARecomposed.StartsWith(UTF8Decomposition[i].de, true) then + begin + extra := length(ARecomposed) - length(UTF8Decomposition[i].de); + if UTF8Decomposition[i].join <> arNone then + if (joinBefore xor (UTF8Decomposition[i].join in[arMedial,arFinal])) or + (joinAfter xor (UTF8Decomposition[i].join in[arInitial,arMedial])) then continue; + if not FindChars(UTF8Decomposition[i].re) then continue; + newExtra := copy(ARecomposed, length(ARecomposed)+1-extra, extra); + if GetFirstStrongBidiClassUTF8(newExtra) <> ubcUnknown then continue; + AMarks := newExtra + AMarks; + ARecomposed := UTF8Decomposition[i].re; + result := true; + exit; + end; + result := false; + end; + + var i,j: integer; + begin + if AMax <= AMin+9 then + begin + TryExactMatch; + end else + begin + i := (AMin+AMax) div 2; + if UTF8Decomposition[i].de.StartsWith(lookFor, true) then + begin + j := i; + while (j > AMin) and UTF8Decomposition[j-1].de.StartsWith(lookFor, true) do dec(j); + AMin := j; + j := i; + while (j < AMax) and UTF8Decomposition[j+1].de.StartsWith(lookFor, true) do inc(j); + AMax := j; + TryExactMatch; + end else + if CompareStr(lookFor, UTF8Decomposition[i].de) > 0 then + result := RecomposeRec(i+1, AMax) + else + result := RecomposeRec(AMin, i-1); + end; + end; + + procedure ExtractInnerMarks; + var + p, charLen, pStart: Integer; + u: LongWord; + begin + if ARecomposed.StartsWith(UTF8_ARABIC_LAM, true) then + begin + pStart := length(UTF8_ARABIC_LAM)+1; + p := pStart; + while p <= length(ARecomposed) do + begin + charLen := UTF8CharacterLength(@ARecomposed[p]); + u := UTF8CodepointToUnicode(@ARecomposed[p], charLen); + if GetUnicodeBidiClass(u) = ubcNonSpacingMark then + inc(p, charLen) + else break; + end; + if p>pStart then + begin + AppendStr(AInnerMarks, copy(ARecomposed, pStart, p-pStart)); + delete(ARecomposed, pStart, p-pStart); + end; + end; + end; + + procedure ExtractFinalMarks; + var + p,pStart,pPrev: Integer; + begin + pStart := length(ARecomposed)+1; + p := pStart; + while p > 1 do + begin + pPrev := p; + dec(p); + while (p > 1) and (ARecomposed[p] in[#$80..#$BF]) do dec(p); + if (p = 1) or (ARecomposed[p] in [#$80..#$BF]) or + not (GetUnicodeBidiClassEx(UTF8CodepointToUnicode(@ARecomposed[p], pPrev-p)) + in [ubcNonSpacingMark, ubcCombiningLeftToRight]) then + begin + p := pPrev; + break; + end; + end; + if p < pStart then + begin + AMarks := copy(ARecomposed, p, pStart-p) + AMarks; + delete(ARecomposed, p, pStart-p); + end; + end; + +begin + joinBefore := ADecomposed.StartsWith(UTF8_ZERO_WIDTH_JOINER, true); + joinAfter := ADecomposed.EndsWith(UTF8_ZERO_WIDTH_JOINER, true); + if joinBefore and joinAfter then + ADecomposed := copy(ADecomposed, length(UTF8_ZERO_WIDTH_JOINER)+1, + length(ADecomposed) - (length(UTF8_ZERO_WIDTH_JOINER) shl 1)) else + if joinBefore then Delete(ADecomposed, 1, length(UTF8_ZERO_WIDTH_JOINER)) else + if joinAfter then Delete(ADecomposed, length(ADecomposed) - length(UTF8_ZERO_WIDTH_JOINER) + 1, length(UTF8_ZERO_WIDTH_JOINER)); + + ARecomposed := ADecomposed; + AMarks := ''; + AInnerMarks := ''; + ExtractInnerMarks; + repeat + if length(ADecomposed)<=1 then break; + lookFor := copy(ARecomposed, 1, UTF8CharacterLength(@ARecomposed[1])); + until not RecomposeRec(0, high(UTF8Decomposition)); + ExtractFinalMarks; +end; + +type + TMarkGlyph = record + FreeTypeGlyph: TFreeTypeGlyph; + Index: integer; + Bounds: TRect; + CombiningClass: Byte; + end; + + { TBGRAFreeTypeGlyph } + + TBGRAFreeTypeGlyph = class(TBGRAGlyph) + protected + FFont: TFreeTypeFont; + FCentralText: string; + FCentralTextWidth: Single; + FMarks, FInnerMarks: TUnicodeArray; + FBounds: TRect; + function RetrieveMarkGlyph(AMark: LongWord; out AMarkGlyph: TMarkGlyph; AAllowTranslate: boolean): boolean; + procedure DrawNonSpacingMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); + procedure DrawCentralGlyph(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel); + procedure DrawCombiningMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel; out ACentralLeft: single); + public + constructor Create(AFont: TFreeTypeFont; AIdentifier: string); + constructor Create({%H-}AIdentifier: string); override; + procedure Draw(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); + end; + + { TFreeTypeTypeWriter } + + TFreeTypeTypeWriter = class(TBGRACustomTypeWriter) + protected + FFont: TFreeTypeFont; + function GetGlyph(AIdentifier: string): TBGRAGlyph; override; + function GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; override; + function ComputeKerning({%H-}AIdLeft, {%H-}AIdRight: string): single; override; + public + constructor Create(AFont: TFreeTypeFont); + procedure DrawText(ADrawer: TBGRAFreeTypeDrawer; ATextUTF8: string; X,Y: Single; + AColor: TBGRAPixel; AAlign: TBGRATypeWriterAlignment = twaTopLeft); overload; + end; + +{ TFreeTypeGlyph } + +constructor TBGRAFreeTypeGlyph.Create(AFont: TFreeTypeFont; AIdentifier: string); + + procedure SortMarks(A: TUnicodeArray); + procedure MoveBefore(AFrom, ATo: integer); + var k: integer; + backU: LongWord; + begin + if ATo >= AFrom then exit; + backU := A[AFrom]; + for k := AFrom downto ATo+1 do + A[k] := A[k-1]; + A[ATo] := backU; + end; + + procedure SortByCombiningClass; + var + start, i, j: Integer; + newCC: Byte; + begin + start := 0; + i := start+1; + while i <= high(a) do + begin + //sequence is split + if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then + begin + start := i+1; + i := start+1; + continue; + end else + begin + newCC := GetUnicodeCombiningClass(A[i]); + j := i; + while (j > start) and (newCC < GetUnicodeCombiningClass(A[j-1])) do dec(j); + MoveBefore(i, j); + inc(i); + end; + end; + end; + + procedure PutShaddaFirst; + var + i, j: Integer; + begin + j := 0; + for i := 0 to high(A) do + if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then + j := i+1 else + if GetUnicodeCombiningClass(A[i]) = 33 then + begin + MoveBefore(i, j); + inc(j); + end; + end; + + procedure PutLeadingMCMFirst(ACombiningClass: byte); + var + i, j: Integer; + begin + j := 0; + i := 0; + while i <= high(A) do + begin + if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then + begin + j := i+1; + inc(i); + end else + if GetUnicodeCombiningClass(A[i]) = ACombiningClass then + begin + //put leading MCM first + while IsModifierCombiningMark(A[i]) do + begin + MoveBefore(i, j); + inc(j); + inc(i); + if (i >= length(A)) or + not (GetUnicodeCombiningClass(A[i]) = ACombiningClass) then + break; + end; + //skip rest of combining class + while (i <= high(A)) and (GetUnicodeCombiningClass(A[i]) = ACombiningClass) do + inc(i); + end else + inc(i); + end; + end; + + begin + if A = nil then exit; + SortByCombiningClass; + PutShaddaFirst; + PutLeadingMCMFirst(230); + PutLeadingMCMFirst(220); + end; + + //some marks are combined both from left and right, so they need to be split + procedure SplitMarks; + procedure SplitMark(AFrom: LongWord; ATo1, ATo2: LongWord); + var + i, j: Integer; + begin + for i := high(FMarks) downto 0 do + if FMarks[i] = AFrom then + begin + FMarks[i] := ATo1; + setlength(FMarks, length(FMarks)+1); + for j := high(FMarks) downto i+2 do + FMarks[j] := FMarks[j-1]; + FMarks[i+1] := ATo2; + end; + end; + + begin + {BENGALI} + SplitMark($09CB, $09C7, $09BE); + SplitMark($09CC, $09C7, $09D7); + {TAMIL} + SplitMark($0BCA, $0BC6, $0BBE); + SplitMark($0BCB, $0BC7, $0BBE); + SplitMark($0BCC, $0BC6, $0BD7); + {MALAYALAM} + SplitMark($0D4A, $0D46, $0D3E); + SplitMark($0D4B, $0D47, $0D3E); + SplitMark($0D4C, $0D46, $0D57); + {BALINESE} + SplitMark($1B3D, $1B3C, $1B35); + SplitMark($1B40, $1B3E, $1B35); + SplitMark($1B41, $1B3F, $1B35); + end; + +var + marksStr, innerMarksStr: string; + ofs: TIntegerArray; + u: LongWord; + glyphIndex: LongInt; + ftGlyph: TFreeTypeGlyph; + i: Integer; +begin + inherited Create(AIdentifier); + FFont := AFont; + RecomposeUTF8(FFont, AIdentifier, FCentralText, marksStr, innerMarksStr); + UTF8ToUnicodeArray(marksStr, FMarks, ofs); + SortMarks(FMarks); + UTF8ToUnicodeArray(innerMarksStr, FInnerMarks, ofs); + SortMarks(FInnerMarks); + SplitMarks; + FCentralTextWidth := AFont.TextWidth(FCentralText); + Width := FCentralTextWidth; + for i := 0 to high(FMarks) do + if GetUnicodeBidiClassEx(FMarks[i]) = ubcCombiningLeftToRight then + begin + glyphIndex := AFont.CharIndex[FMarks[i]]; + if glyphIndex <> 0 then + begin + if AFont.ClearType then + Width += AFont.Glyph[glyphIndex].Advance/3 + else Width += AFont.Glyph[glyphIndex].Advance; + end; + end; + Height := AFont.LineFullHeight; + FBounds := EmptyRect; + if length(FCentralText) <> 0 then + begin + u := UTF8CodepointToUnicode(@FCentralText[1], UTF8CharacterLength(@FCentralText[1])); + glyphIndex := AFont.CharIndex[u]; + if glyphIndex <> 0 then + begin + ftGlyph := AFont.Glyph[glyphIndex]; + FBounds := ftGlyph.Bounds; + end; + end; +end; + +constructor TBGRAFreeTypeGlyph.Create(AIdentifier: string); +begin + raise exception.Create('Requires a font'); +end; + +function TBGRAFreeTypeGlyph.RetrieveMarkGlyph(AMark: LongWord; out AMarkGlyph: TMarkGlyph; AAllowTranslate: boolean): boolean; + const + ArabicMarkAbove: array[0..10] of LongWord = + ($0618, $0619, $064B, $064C, $064E, $064F, + $0651, $0652, $0670, $08F0, $08F1); + + ArabicMarkBelow: array[0..3] of LongWord = + ($061A, $064D, $0650, $08F2); + + type + TMarkFallback = record + NonSpacing: LongWord; + Spacing: LongWord; + Moved: boolean; + end; + + const + MarkFallback: array[0..40] of TMarkFallback = ( + (NonSpacing: $300; Spacing: $2CA; Moved: false), + (NonSpacing: $301; Spacing: $B4; Moved: false), + (NonSpacing: $302; Spacing: $5E; Moved: false), + (NonSpacing: $303; Spacing: $2DC; Moved: false), + (NonSpacing: $304; Spacing: $AF; Moved: false), + (NonSpacing: $305; Spacing: $203E; Moved: false), + (NonSpacing: $306; Spacing: $2D8; Moved: false), + (NonSpacing: $307; Spacing: $2D9; Moved: false), + (NonSpacing: $308; Spacing: $A8; Moved: false), + (NonSpacing: $30A; Spacing: $2DA; Moved: false), + (NonSpacing: $30B; Spacing: $2DD; Moved: false), + (NonSpacing: $30E; Spacing: $22; Moved: false), + (NonSpacing: $313; Spacing: $1FBD; Moved: false), + (NonSpacing: $314; Spacing: $1FFE; Moved: false), + (NonSpacing: $316; Spacing: $2CA; Moved: true), + (NonSpacing: $317; Spacing: $B4; Moved: true), + (NonSpacing: $320; Spacing: $AF; Moved: true), + (NonSpacing: $324; Spacing: $A8; Moved: true), + (NonSpacing: $325; Spacing: $2DA; Moved: true), + (NonSpacing: $327; Spacing: $B8; Moved: false), + (NonSpacing: $328; Spacing: $2DB; Moved: false), + (NonSpacing: $32D; Spacing: $5E; Moved: true), + (NonSpacing: $32E; Spacing: $2D8; Moved: true), + (NonSpacing: $330; Spacing: $2DC; Moved: true), + (NonSpacing: $331; Spacing: $AF; Moved: true), + (NonSpacing: $332; Spacing: $203E; Moved: true), + (NonSpacing: $333; Spacing: $2017; Moved: false), + (NonSpacing: $336; Spacing: $2013; Moved: false), + (NonSpacing: $337; Spacing: $2F; Moved: false), + (NonSpacing: $338; Spacing: $2F; Moved: false), + (NonSpacing: $33F; Spacing: $2017; Moved: true), + (NonSpacing: $340; Spacing: $2CA; Moved: false), + (NonSpacing: $341; Spacing: $B4; Moved: false), + (NonSpacing: $342; Spacing: $1FC0; Moved: false), + (NonSpacing: $343; Spacing: $1FBD; Moved: false), + (NonSpacing: $345; Spacing: $37A; Moved: false), + (NonSpacing: $348; Spacing: $22; Moved: true), + (NonSpacing: $35E; Spacing: $203E; Moved: false), + (NonSpacing: $35F; Spacing: $5F; Moved: false), + (NonSpacing: $3099; Spacing: $309B; Moved: false), + (NonSpacing: $309A; Spacing: $309C; Moved: false)); + + function IsArabicMarkAbove(u: LongWord): boolean; + var + i: Integer; + begin + for i := 0 to high(ArabicMarkAbove) do + if ArabicMarkAbove[i] = u then exit(true); + result := false; + end; + + function IsArabicMarkBelow(u: LongWord): boolean; + var + i: Integer; + begin + for i := 0 to high(ArabicMarkBelow) do + if ArabicMarkBelow[i] = u then exit(true); + result := false; + end; + +var k: integer; +begin + AMarkGlyph.Index := FFont.CharIndex[AMark]; + if AMarkGlyph.Index = 0 then + begin + for k := 0 to high(MarkFallback) do + if (MarkFallback[k].NonSpacing = AMark) and + (not MarkFallback[k].Moved or AAllowTranslate) then + begin + AMarkGlyph.Index := FFont.CharIndex[MarkFallback[k].Spacing]; + if AMarkGlyph.Index = 0 then + begin + if MarkFallback[k].Spacing = $1FBD then AMarkGlyph.Index:= FFont.CharIndex[$27] else + if MarkFallback[k].Spacing = $1FC0 then AMarkGlyph.Index:= FFont.CharIndex[$2DC] else + if MarkFallback[k].Spacing = $2CA then AMarkGlyph.Index:= FFont.CharIndex[$60]; + end; + break; + end; + end; + if AMarkGlyph.Index <> 0 then + begin + AMarkGlyph.FreeTypeGlyph := FFont.Glyph[AMarkGlyph.Index]; + AMarkGlyph.Bounds := AMarkGlyph.FreeTypeGlyph.Bounds; + AMarkGlyph.CombiningClass := GetUnicodeCombiningClass(AMark); + if AMarkGlyph.CombiningClass in[27..35] then + begin + if IsArabicMarkAbove(AMark) then AMarkGlyph.CombiningClass := 230 else + if IsArabicMarkBelow(AMark) then AMarkGlyph.CombiningClass := 220; + end; + result := true; + end + else result := false; +end; + +procedure TBGRAFreeTypeGlyph.DrawNonSpacingMarks(ADrawer: TBGRAFreeTypeDrawer; + ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); +var + markGlyph: TMarkGlyph; + aboveOfs, belowOfs, xRef, xRefBelow, xAfter: Single; + justBelow, justAbove: boolean; + + procedure DoJustAbove(const ALetterBounds: TRect); + begin + if justAbove then + begin + {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} + DecF(aboveOfs, ALetterBounds.Top - markGlyph.Bounds.Bottom); + incF(aboveOfs, FFont.SizeInPixels/12); + {$ELSE} + DecF(aboveOfs, ALetterBounds.Top + FFont.Ascent/3); + {$ENDIF} + justAbove := false; + end; + end; + + procedure DoJustBelow(const ALetterBounds: TRect); + begin + if justBelow then + begin + {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} + incF(belowOfs, ALetterBounds.Bottom - markGlyph.Bounds.Top); + incF(belowOfs, FFont.SizeInPixels/12); + {$ELSE} + incF(belowOfs, ALetterBounds.Bottom); + {$ENDIF} + justBelow := false; + end; + end; + + function GetMarkOffsetY(AMark: LongWord): single; + begin + if (AMark = $304) or (AMark= $305) or (AMark= $33F) or + (AMark = $320) or (AMark = $331) or (AMark = $332) or (AMark = $333) then + begin + result := FFont.SizeInPixels/8; + end else + begin + {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} + result := markGlyph.Bounds.Height + FFont.SizeInPixels/20 + {$ELSE} + result := FFont.SizeInPixels/4; + {$ENDIF} + end; + end; + + procedure DrawMark(AMark: LongWord; const ALetterBounds: TRect); + var + ofsX, ofsY: Single; + begin + if GetUnicodeBidiClassEx(AMark) <> ubcNonSpacingMark then exit; + if RetrieveMarkGlyph(AMark, markGlyph, {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED}true{$ELSE}false{$ENDIF}) then + begin + if markGlyph.CombiningClass = 230 then + begin + DoJustAbove(ALetterBounds); + ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; + ofsY := -aboveOfs; + IncF(aboveOfs, GetMarkOffsetY(AMark)); + ADrawer.DrawGlyph(markGlyph.Index, FFont, + xRef + ofsX, ATop + ofsY, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + end else + if markGlyph.CombiningClass in[220,240] then + begin + if justBelow then incF(ofsX, xRefBelow - xRef); + DoJustBelow(ALetterBounds); + ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; + ofsY := belowOfs; + IncF(belowOfs, GetMarkOffsetY(AMark)); + ADrawer.DrawGlyph(markGlyph.Index, FFont, + xRefBelow + ofsX, ATop + ofsY, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + end else + if markGlyph.CombiningClass = 1 then //overlay + begin + ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; + ADrawer.DrawGlyph(markGlyph.Index, FFont, + xRef + ofsX, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + end else + ADrawer.DrawGlyph(markGlyph.Index, FFont, + xAfter, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + end; + end; + +var + j: integer; +begin + if RTL then xAfter := ALeft else xAfter := ALeft + FCentralTextWidth; + + if FMarks <> nil then + begin + justAbove := false; + if (FCentralText = 'ï»') or (FCentralText = 'ﻂ') or (FCentralText = 'ﻃ') or (FCentralText = 'ﻄ') or + (FCentralText = 'ï»…') or (FCentralText = 'ﻆ') or (FCentralText = 'ﻇ') or (FCentralText = 'ﻈ') then + begin + aboveOfs := 0; + xRef := ALeft + Width*3/4; + xRefBelow := xRef; + end else + if (FCentralText = 'ï»') or (FCentralText = 'ﻞ') or (FCentralText = 'ﻚ') or (FCentralText = 'ï»™') then + begin + aboveOfs := 0; + xRef := ALeft + Width/2; + xRefBelow := xRef; + end else + if (FCentralText = 'ﻵ') or (FCentralText = 'ﻶ') or (FCentralText = 'ï»·') or (FCentralText = 'ﻸ') or + (FCentralText = 'ﻹ') or (FCentralText = 'ﻺ') or (FCentralText = 'ï»»') or (FCentralText = 'ﻼ') then + begin + justAbove := true; + aboveOfs := - FFont.SizeInPixels/10; + xRef := ALeft + Width/6; + xRefBelow := ALeft + Width/4; + end else + begin + justAbove := true; + aboveOfs := 0; + xRef := ALeft + Width/2; + xRefBelow := xRef; + end; + if (FCentralText = 'ï»…') or (FCentralText = 'ﻆ') or (FCentralText = 'ﻇ') or (FCentralText = 'ﻈ') or + (FCentralText = 'ﻚ') or (FCentralText = 'ï»™') then + begin + IncF(aboveOfs, FFont.SizeInPixels/12); + end; + if (FCentralText = 'ïº') or (FCentralText = 'ïº') or (FCentralText = 'ï­’') or (FCentralText = 'ï­“') or + (FCentralText = 'ï­–') or (FCentralText = 'ï­—') or (FCentralText = 'ï­š') or (FCentralText = 'ï­›') or + (FCentralText = 'Ù®') then + begin + DecF(aboveOfs, FFont.SizeInPixels/16); + end; + + belowOfs := 0; + justBelow := true; + for j := 0 to high(FMarks) do + DrawMark(FMarks[j], FBounds); + end; + if FInnerMarks <> nil then + begin + xRef := ALeft + Width*3/4; + xRefBelow := xRef; + aboveOfs := 0; + justAbove := true; + belowOfs := 0; + justBelow := true; + for j := 0 to high(FInnerMarks) do + DrawMark(FInnerMarks[j], FBounds); + end; +end; + +procedure TBGRAFreeTypeGlyph.DrawCentralGlyph(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel); +begin + ADrawer.DrawText(FCentralText, FFont, ALeft, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); +end; + +procedure TBGRAFreeTypeGlyph.DrawCombiningMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel; out ACentralLeft: single); +var + xRight: Single; + widthFactor: single; + + procedure DrawCombiningMark(AMark: LongWord); + var + markGlyph: TMarkGlyph; + begin + if GetUnicodeBidiClassEx(AMark) <> ubcCombiningLeftToRight then exit; + if RetrieveMarkGlyph(AMark, markGlyph, false) then + begin + if markGlyph.CombiningClass in[208,224] then + begin + ADrawer.DrawGlyph(markGlyph.Index, FFont, ALeft, ATop, + BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + IncF(ALeft, markGlyph.FreeTypeGlyph.Advance*widthFactor); + IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); + end else + if markGlyph.CombiningClass in[210,226,9] then + begin + ADrawer.DrawGlyph(markGlyph.Index, FFont, xRight, ATop, + BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); + end else + begin + ADrawer.DrawGlyph(markGlyph.Index, FFont, ALeft, ATop, + BGRAToFPColor(AColor), [ftaTop,ftaLeft]); + IncF(ALeft, markGlyph.FreeTypeGlyph.Advance/2*widthFactor); + IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); + end; + end; + end; + +var + j: Integer; +begin + if FFont.ClearType then + widthFactor := 1/3 + else widthFactor:= 1; + xRight := ALeft + FCentralTextWidth; + for j := 0 to high(FMarks) do + DrawCombiningMark(FMarks[j]); + ACentralLeft:= ALeft; +end; + +procedure TBGRAFreeTypeGlyph.Draw(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); +var + xLeft: single; +begin + DrawCombiningMarks(ADrawer, ALeft, ATop, AColor, xLeft); + DrawCentralGlyph(ADrawer, xLeft, ATop, AColor); + DrawNonSpacingMarks(ADrawer, xLeft, ATop, RTL, AColor); +end; + +{ TFreeTypeTypeWriter } + +function TFreeTypeTypeWriter.GetGlyph(AIdentifier: string): TBGRAGlyph; +var + g: TBGRAFreeTypeGlyph; +begin + Result:= inherited GetGlyph(AIdentifier); + if result = nil then + begin + g := TBGRAFreeTypeGlyph.Create(FFont, AIdentifier); + SetGlyph(AIdentifier, g); + result := g; + end; +end; + +function TFreeTypeTypeWriter.GetKerningOffset(AIdBefore, AIdAfter: string; + ARightToLeft: boolean): single; +var + temp: String; +begin + //don't store kerning as it is stored in TFreeTypeFont font object + if ARightToLeft then + begin + temp := AIdBefore; + AIdBefore := AIdAfter; + AIdAfter := temp; + end; + result := ComputeKerning(AIdBefore, AIdAfter); +end; + +function TFreeTypeTypeWriter.ComputeKerning(AIdLeft, AIdRight: string): single; +{$IFDEF LAZFREETYPE_PROVIDE_KERNING} +var + uLeft, uRight: LongWord; +begin + if (AIdLeft = '') or (AIdRight = '') then exit(0); + uLeft := UTF8CodepointToUnicode(@AIdLeft[1], UTF8CharacterLength(@AIdLeft[1])); + uRight := UTF8CodepointToUnicode(@AIdRight[1], UTF8CharacterLength(@AIdRight[1])); + Result:= FFont.CharKerning[uLeft, uRight].Kerning.x; +end; +{$ELSE} +begin + result := 0; +end;{$ENDIF} + +constructor TFreeTypeTypeWriter.Create(AFont: TFreeTypeFont); +begin + inherited Create; + FFont := AFont; + SubstituteBidiBracket:= true; +end; + +procedure TFreeTypeTypeWriter.DrawText(ADrawer: TBGRAFreeTypeDrawer; + ATextUTF8: string; X, Y: Single; AColor: TBGRAPixel; AAlign: TBGRATypeWriterAlignment); +var + i : Integer; + ptGlyph: TPointF; + di: TBGRATextDisplayInfo; +begin + di := GetDisplayInfo(ATextUTF8, x, y, AAlign); + for i := 0 to high(di) do + begin + if di[i].Mirrored then + ptGlyph := di[i].Matrix * PointF(di[i].Glyph.Width, 0) + else ptGlyph := di[i].Matrix * PointF(0, 0); + TBGRAFreeTypeGlyph(di[i].Glyph).Draw(ADrawer, ptGlyph.x, ptGlyph.y, di[i].RTL, AColor); + end; +end; + +{ TBGRAFreeTypeFontRenderer } + +function TBGRAFreeTypeFontRenderer.GetCollection: TCustomFreeTypeFontCollection; +begin + result := EasyLazFreeType.FontCollection; +end; + +function TBGRAFreeTypeFontRenderer.GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer; +begin + result := FDrawer; + result.ShadowColor := ShadowColor; + result.ShadowOffset := ShadowOffset; + result.ShadowRadius := ShadowRadius; + result.ShadowVisible := ShadowVisible; + result.ShadowQuality := ShadowQuality; + result.ClearTypeRGBOrder := FontQuality <> fqFineClearTypeBGR; + result.Destination := ASurface; + result.OutlineColor := OutlineColor; + result.OutlineVisible := OutlineVisible; + result.OuterOutlineOnly := OuterOutlineOnly; + result.OutlineTexture := OutlineTexture; + if ShaderActive then result.Shader := FShader + else result.Shader := nil; +end; + +function TBGRAFreeTypeFontRenderer.GetShaderLightPosition: TPoint; +begin + if FShader = nil then + result := point(0,0) + else + result := FShader.LightPosition; +end; + +function TBGRAFreeTypeFontRenderer.GetShaderLightPositionF: TPointF; +begin + if FShader = nil then + result := pointF(0,0) + else + result := FShader.LightPositionF; +end; + +procedure TBGRAFreeTypeFontRenderer.SetShaderLightPosition(const AValue: TPoint); +begin + if FShader <> nil then + FShader.LightPosition := AValue; +end; + +procedure TBGRAFreeTypeFontRenderer.SetShaderLightPositionF( + const AValue: TPointF); +begin + if FShader <> nil then + FShader.LightPositionF := AValue; +end; + +function TBGRAFreeTypeFontRenderer.GetTypeWriter: TBGRACustomTypeWriter; +begin + if FTypeWriter = nil then + FTypeWriter := TFreeTypeTypeWriter.Create(FFont); + result := FTypeWriter; +end; + +procedure TBGRAFreeTypeFontRenderer.UpdateFont(ADisableClearType: boolean); +var fts: TFreeTypeStyles; + filename: string; + twChange, newClearType: boolean; + newSize: Single; +begin + twChange := false; + fts := []; + if fsBold in FontStyle then include(fts, ftsBold); + if fsItalic in FontStyle then include(fts, ftsItalic); + try + filename := FontName; + if (filename <> FFont.Name) or (fts <> FFont.Style) then + begin + twChange := true; + {$IFDEF BGRABITMAP_USE_LCL12} + FFont.SetNameAndStyle(filename,fts); + {$ELSE} + FFont.Name := filename; + FFont.Style := fts; + {$ENDIF} + end; + except + on ex: exception do + begin + end; + end; + newSize := FontEmHeightF; + if newSize <> FLastFontSize then + begin + twChange := true; + if FontEmHeightF >= 0 then + FFont.SizeInPixels := FontEmHeightF + else + FFont.LineFullHeight := -FontEmHeightF; + FLastFontSize := newSize; + end; + case FontQuality of + fqSystem: + begin + FFont.Quality := grqMonochrome; + newClearType := false; + end; + fqSystemClearType: + begin + FFont.Quality:= grqLowQuality; + newClearType:= true; + end; + fqFineAntialiasing: + begin + FFont.Quality:= grqHighQuality; + newClearType:= false; + end; + fqFineClearTypeRGB,fqFineClearTypeBGR: + begin + FFont.Quality:= grqHighQuality; + newClearType:= true; + end; + end; + if ADisableClearType then newClearType:= false; + if newClearType <> FFont.ClearType then + begin + twChange := true; + FFont.ClearType:= newClearType; + end; + if FFont.Hinted <> FontHinted then + begin + twChange := true; + FFont.Hinted := FontHinted; + end; + {$IFDEF BGRABITMAP_USE_LCL12} + FFont.StrikeOutDecoration := fsStrikeOut in FontStyle; + FFont.UnderlineDecoration := fsUnderline in FontStyle; + {$ENDIF} + if twChange then FreeAndNil(FTypeWriter); +end; + +procedure TBGRAFreeTypeFontRenderer.Init; +begin + ShaderActive := true; + + FDrawer := TBGRAFreeTypeDrawer.Create(nil); + FFont := TFreeTypeFont.Create; + FLastFontSize:= EmptySingle; + FontHinted:= True; + + ShadowColor := BGRABlack; + ShadowVisible := false; + ShadowOffset := Point(5,5); + ShadowRadius := 5; + ShadowQuality:= rbFast; +end; + +procedure TBGRAFreeTypeFontRenderer.TextOutAnglePatch(ADest: TBGRACustomBitmap; + x, y: single; orientation: integer; s: string; c: TBGRAPixel; + tex: IBGRAScanner; align: TAlignment); +const orientationToDeg = -0.1; +var + temp: TBGRACustomBitmap; + coord: TPointF; + angleDeg: single; + OldOrientation: integer; + filter: TResampleFilter; +begin + OldOrientation := FontOrientation; + FontOrientation:= 0; + UpdateFont(true); + + temp := BGRABitmapFactory.Create; + with TypeWriter.GetTextSizeBeforeTransform(s) do + temp.SetSize(ceil(x),ceil(y)); + temp.FillTransparent; + if tex<>nil then + begin + FDrawer.Texture := tex; + InternalTextOut(temp,0,0, s, BGRAWhite, taLeftJustify); + FDrawer.Texture := nil; + end + else + InternalTextOut(temp,0,0, s, c, taLeftJustify); + + orientation:= orientation mod 3600; + if orientation < 0 then inc(orientation, 3600); + + angleDeg := orientation * orientationToDeg; + coord := PointF(x,y); + case align of + taRightJustify: coord.Offset( AffineMatrixRotationDeg(angleDeg)*PointF(-temp.Width,0) ); + taCenter: coord.Offset( AffineMatrixRotationDeg(angleDeg)*PointF(-0.5*temp.Width,0) ); + end; + case orientation of + 0,900,1800,2700: filter := rfBox; + else filter := rfCosine; + end; + ADest.PutImageAngle(coord.x,coord.y, temp, angleDeg, filter); + temp.Free; + + FontOrientation:= OldOrientation; +end; + +procedure TBGRAFreeTypeFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap; + x, y: single; s: string; c: TBGRAPixel; align: TAlignment); +var + twAlign: TBGRATypeWriterAlignment; +begin + case align of + taCenter: twAlign:= twaTop; + taRightJustify: twAlign := twaTopRight + else + twAlign := twaTopLeft; + end; + TFreeTypeTypeWriter(TypeWriter).DrawText(GetDrawer(ADest), s, x,y, c, twAlign); +end; + +constructor TBGRAFreeTypeFontRenderer.Create; +begin + Init; +end; + +constructor TBGRAFreeTypeFontRenderer.Create(AShader: TCustomPhongShading; + AShaderOwner: boolean); +begin + Init; + FShader := AShader; + FShaderOwner := AShaderOwner; +end; + +function TBGRAFreeTypeFontRenderer.FontExists(AName: string): boolean; +var + enum: IFreeTypeFamilyEnumerator; +begin + if Assigned(Collection) then + begin + enum := Collection.FamilyEnumerator; + while enum.MoveNext do + if CompareText(enum.Current.FamilyName, AName) = 0 then exit(true); + result := false; + end else + result := true; +end; + +function TBGRAFreeTypeFontRenderer.GetFontPixelMetric: TFontPixelMetric; +begin + UpdateFont; + result.Baseline := round(FFont.Ascent); + result.CapLine:= round(FFont.Ascent*0.2); + result.DescentLine:= round(FFont.Ascent+FFont.Descent); + result.Lineheight := round(FFont.LineFullHeight); + result.xLine := round(FFont.Ascent*0.45); + result.Defined := True; +end; + +function TBGRAFreeTypeFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; +begin + UpdateFont; + result.Baseline := FFont.Ascent; + result.CapLine:= FFont.Ascent*0.2; + result.DescentLine:= FFont.Ascent+FFont.Descent; + result.Lineheight := FFont.LineFullHeight; + result.xLine := FFont.Ascent*0.45; + result.Defined := True; +end; + +procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); +begin + TextOutAnglePatch(ADest, x,y, orientation, s, c, nil, align); +end; + +procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; texture: IBGRAScanner; + align: TAlignment); +begin + TextOutAnglePatch(ADest, x,y, orientation, s, BGRAPixelTransparent, texture, align); +end; + +procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; texture: IBGRAScanner; align: TAlignment); +begin + if FontOrientation mod 3600 <> 0 then + TextOutAngle(ADest, x,y, FontOrientation, s, texture, align) + else + begin + FDrawer.Texture := texture; + TextOut(ADest,x,y,s,BGRAWhite,align); + FDrawer.Texture := nil; + end; +end; + +procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; c: TBGRAPixel; align: TAlignment); +begin + if FontOrientation mod 3600 <> 0 then + TextOutAngle(ADest, x,y, FontOrientation, s, c, align) + else + begin + UpdateFont; + InternalTextOut(ADest, x,y, s, c, align); + end; +end; + +procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap; + ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); +var align: TFreeTypeAlignments; + intersectedClip,previousClip: TRect; +begin + previousClip := ADest.ClipRect; + if style.Clipping then + begin + intersectedClip := TRect.Intersect(previousClip, ARect); + if intersectedClip.IsEmpty then exit; + ADest.ClipRect := intersectedClip; + end; + UpdateFont; + align := []; + case style.Alignment of + taCenter: begin ARect.Left := x; include(align, ftaCenter); end; + taRightJustify: begin ARect.Left := x; include(align, ftaRight); end; + else + include(align, ftaLeft); + end; + case style.Layout of + {$IFDEF BGRABITMAP_USE_LCL12} + tlCenter: begin ARect.Top := y; include(align, ftaVerticalCenter); end; + {$ENDIF} + tlBottom: begin ARect.top := y; include(align, ftaBottom); end; + else include(align, ftaTop); + end; + try + {$IFDEF BGRABITMAP_USE_LCL12} + if style.Wordbreak then + GetDrawer(ADest).DrawTextRect(s, FFont, ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,BGRAToFPColor(c),align) + else + {$ENDIF} + begin + case style.Layout of + tlCenter: y := (ARect.Top+ARect.Bottom) div 2; + tlBottom: y := ARect.Bottom; + else + y := ARect.Top; + end; + case style.Alignment of + taLeftJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Left,y,BGRAToFPColor(c),align); + taCenter: GetDrawer(ADest).DrawText(s,FFont,(ARect.Left+ARect.Right-1) div 2,y,BGRAToFPColor(c),align); + taRightJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Right,y,BGRAToFPColor(c),align); + end; + end; + finally + if style.Clipping then + ADest.ClipRect := previousClip; + end; +end; + +procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap; + ARect: TRect; x, y: integer; s: string; style: TTextStyle; + texture: IBGRAScanner); +begin + FDrawer.Texture := texture; + TextRect(ADest,ARect,x,y,s,style,BGRAWhite); + FDrawer.Texture := nil; +end; + +function TBGRAFreeTypeFontRenderer.TextSize(sUTF8: string): TSize; +begin + with TextSizeF(sUTF8) do + result := Size(System.Round(x),System.Round(y)); +end; + +function TBGRAFreeTypeFontRenderer.TextSizeF(sUTF8: string): TPointF; +begin + UpdateFont; + result := TypeWriter.GetTextSizeBeforeTransform(sUTF8); +end; + +function TBGRAFreeTypeFontRenderer.TextSize(sUTF8: string; AMaxWidth: integer; + ARightToLeft: boolean): TSize; +begin + with TextSizeF(sUTF8, AMaxWidth, ARightToLeft) do + result := Size(System.Round(x),System.Round(y)); +end; + +function TBGRAFreeTypeFontRenderer.TextSizeF(sUTF8: string; AMaxWidthF: single; + ARightToLeft: boolean): TPointF; +var + w,h: single; + charCount, byteCount: integer; +begin + UpdateFont; + result.x := 0; + result.y := 0; + h := FFont.LineFullHeight; + repeat + TypeWriter.TextFitInfoBeforeTransform(sUTF8, AMaxWidthF, charCount, byteCount, w); + if w>result.x then result.x := w; + IncF(result.y, h); + sUTF8 := copy(sUTF8, byteCount+1, length(sUTF8)-byteCount); + until sUTF8 = ''; +end; + +function TBGRAFreeTypeFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; +begin + result := TextFitInfoF(sUTF8, AMaxWidth); +end; + +function TBGRAFreeTypeFontRenderer.TextFitInfoF(sUTF8: string; + AMaxWidthF: single): integer; +var + byteCount: integer; + usedWidth: single; +begin + UpdateFont; + TypeWriter.TextFitInfoBeforeTransform(sUTF8, AMaxWidthF, result, byteCount, usedWidth); +end; + +destructor TBGRAFreeTypeFontRenderer.Destroy; +begin + FTypeWriter.Free; + FDrawer.Free; + FFont.Free; + if FShaderOwner then FShader.Free; + inherited Destroy; +end; + +{ TBGRAFreeTypeDrawer } + +procedure TBGRAFreeTypeDrawer.RenderDirectly( x,y,tx: integer; + data: pointer ); +var psrc: pbyte; + pdest: PBGRAPixel; + c: TBGRAPixel; +begin + if Destination <> nil then + begin + //ensure rendering in bounds + if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit; + + psrc := pbyte(data); + pdest := Destination.ScanLine[y]+x; + if Texture = nil then + begin + c := FColor; + while tx > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,c,psrc^); + inc(psrc); + inc(pdest); + dec(tx); + end; + end else + begin + Texture.ScanMoveTo(x,y); + while tx > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,Texture.ScanNextPixel,psrc^); + inc(psrc); + inc(pdest); + dec(tx); + end; + end; + end; +end; + +procedure TBGRAFreeTypeDrawer.RenderDirectlyClearType(x, y, tx: integer; data: pointer); +var xb: integer; + psrc: pbyte; + pdest: PBGRAPixel; +begin + if Destination <> nil then + begin + tx := tx div 3; + if tx=0 then exit; + if (FMask <> nil) and (FMask.Width <> tx) then + FMask.SetSize(tx,1) + else if FMask = nil then FMask := BGRABitmapFactory.create(tx,1); + + pdest := FMask.Data; + psrc := pbyte(data); + pdest^.red := (psrc^ + psrc^ + (psrc+1)^) div 3; + pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; + if tx > 1 then + pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3 + else + pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3; + inc(pdest); + inc(psrc,3); + for xb := 1 to tx-2 do + begin + pdest^.red := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3; + pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; + pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3; + inc(pdest); + inc(psrc,3); + end; + if tx > 1 then + begin + pdest^.red := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3; + pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; + pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3; + end; + BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,Texture,ClearTypeRGBOrder); + end; +end; + +function TBGRAFreeTypeDrawer.ShadowActuallyVisible: boolean; +begin + result := ShadowVisible and (ShadowColor.alpha <> 0); +end; + +function TBGRAFreeTypeDrawer.OutlineActuallyVisible: boolean; +begin + result := ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible; +end; + +function TBGRAFreeTypeDrawer.ShaderActuallyActive: boolean; +begin + result := (Shader <> nil) and ShaderActive; +end; + +constructor TBGRAFreeTypeDrawer.Create(ADestination: TBGRACustomBitmap); +begin + Destination := ADestination; + ClearTypeRGBOrder:= true; + ShaderActive := true; + ShadowQuality:= rbFast; +end; + +procedure TBGRAFreeTypeDrawer.DrawText(AText: string; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor); +var fx: TBGRACustomTextEffect; + procedure DoOutline; + begin + if OutlineActuallyVisible then + begin + if OutlineTexture <> nil then + fx.DrawOutline(Destination,round(x),round(y), OutlineTexture) + else + fx.DrawOutline(Destination,round(x),round(y), OutlineColor); + end; + end; +begin + if not FInCreateTextEffect and (ShadowActuallyVisible or OutlineActuallyVisible or ShaderActuallyActive) then + begin + fx := CreateTextEffect(AText, AFont); + fx.ShadowQuality := ShadowQuality; + DecF(y, AFont.Ascent); + if ShadowActuallyVisible then fx.DrawShadow(Destination, round(x+ShadowOffset.X),round(y+ShadowOffset.Y), ShadowRadius, ShadowColor); + if OuterOutlineOnly then DoOutline; + + if texture <> nil then + begin + if ShaderActuallyActive then + fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture) + else + fx.Draw(Destination,round(x),round(y), texture); + end else + begin + if ShaderActuallyActive then + fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), FPColorToBGRA(AColor)) + else + fx.Draw(Destination,round(x),round(y), FPColorToBGRA(AColor)); + end; + if not OuterOutlineOnly then DoOutline; + fx.Free; + end else + begin + FColor := FPColorToBGRA(AColor); + if AFont.ClearType then + AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType) + else + AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly); + end; +end; + +procedure TBGRAFreeTypeDrawer.DrawText(AText: string; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel); +begin + DrawText(AText, AFont, x,y, BGRAToFPColor(AColor)); +end; + +procedure TBGRAFreeTypeDrawer.DrawText(AText: string; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel; + AAlign: TFreeTypeAlignments); +begin + DrawText(AText, AFont, x,y, BGRAToFPColor(AColor), AAlign); +end; + +{$IFDEF BGRABITMAP_USE_LCL12} +procedure TBGRAFreeTypeDrawer.DrawTextWordBreak(AText: string; + AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel; + AAlign: TFreeTypeAlignments); +begin + DrawTextWordBreak(AText,AFont,x,y,AMaxWidth,BGRAToFPColor(AColor),AAlign); +end; + +procedure TBGRAFreeTypeDrawer.DrawTextRect(AText: string; + AFont: TFreeTypeRenderableFont; X1, Y1, X2, Y2: Single; AColor: TBGRAPixel; + AAlign: TFreeTypeAlignments); +begin + DrawTextRect(AText,AFont,X1,Y1,X2,Y2,BGRAToFPColor(AColor),AAlign); +end; +{$ENDIF} + +{$IFDEF BGRABITMAP_USE_LCL15} +procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor); +var f: TFreeTypeFont; +begin + if not (AFont is TFreeTypeFont) then exit; + f := TFreeTypeFont(Afont); + FColor := FPColorToBGRA(AColor); + if AFont.ClearType then + f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectlyClearType) + else + f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectly); +end; + +procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel); +begin + DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor)); +end; + +procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; + AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel; + AAlign: TFreeTypeAlignments); +begin + DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor), AAlign); +end; +{$ENDIF} + +function TBGRAFreeTypeDrawer.CreateTextEffect(AText: string; + AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect; +var + mask: TBGRACustomBitmap; + tx,ty,marginHoriz,marginVert: integer; + tempDest: TBGRACustomBitmap; + tempTex: IBGRAScanner; + tempClearType: boolean; +begin + FInCreateTextEffect:= True; + try + tx := ceil(AFont.TextWidth(AText)); + ty := ceil(AFont.TextHeight(AText)); + marginHoriz := ty div 2; + marginVert := 1; + mask := BGRABitmapFactory.Create(tx+2*marginHoriz,ty+2*marginVert,BGRABlack); + tempDest := Destination; + tempTex := Texture; + tempClearType:= AFont.ClearType; + Destination := mask; + Texture := nil; + AFont.ClearType := false; + DrawText(AText,AFont,marginHoriz,marginVert,BGRAWhite,[ftaTop,ftaLeft]); + Destination := tempDest; + Texture := tempTex; + AFont.ClearType := tempClearType; + mask.ConvertToLinearRGB; + result := TBGRACustomTextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert)); + finally + FInCreateTextEffect:= false; + end; +end; + +destructor TBGRAFreeTypeDrawer.Destroy; +begin + FMask.Free; + inherited Destroy; +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragifformat.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragifformat.pas new file mode 100644 index 0000000..dd32eed --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragifformat.pas @@ -0,0 +1,1219 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGifFormat; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, + BGRAPalette; + +type + //what to do when finishing a frame and starting the next one + TDisposeMode = (dmNone, //undefined value + dmKeep, //keep the changes done by the frame + dmErase, //clear everything after the frame + dmRestore); //restore to how it was before the frame + + //one image in the array + TGifSubImage = record + Image: TBGRABitmap; //image to draw at the beggining of the frame + Position: TPoint; //relative position of the image in the frame + DelayMs: integer; //time in milliseconds to wait before going to next frame + DisposeMode: TDisposeMode; //what do do when going to next frame + HasLocalPalette: boolean; //the image has its own palette + end; + TGifSubImageArray = array of TGifSubImage; + + TGIFSignature = packed array[1..6] of char; //'GIF87a' or 'GIF89a' + + TGIFScreenDescriptor = packed record + Width, Height: word; + flags, //screen bit depth = ((flags shr 4) and 7) + 1 + //palette bit depth = (flags and 7) + 1 + BackgroundColorIndex, //index of background color in global palette + AspectRatio64 : byte; //0 if not specified, otherwise aspect ratio is (AspectRatio64 + 15) / 64 + end; + + TGIFImageDescriptor = packed record + x, y, Width, Height: word; + flags: byte; + end; + + TGIFImageDescriptorWithHeader = packed record + ImageIntroducer: byte; + Image: TGIFImageDescriptor; + end; + + TGIFExtensionBlock = packed record + FunctionCode: byte; + end; + + TGIFGraphicControlExtension = packed record + flags: byte; + DelayHundredthSec: word; + TransparentColorIndex: byte; + end; + + TGIFGraphicControlExtensionWithHeader = packed record + ExtensionIntroducer: byte; + FunctionCode: byte; + BlockSize: byte; + GraphicControl: TGIFGraphicControlExtension; + BlockTerminator: byte; + end; + + TPackedRGBTriple = packed record + r, g, b: byte; + end; + + TGIFData = record + Width, Height: integer; + AspectRatio: single; + BackgroundColor: TColor; + LoopCount: Word; + Images: array of TGifSubImage; + end; + + { EColorQuantizerMissing } + + EColorQuantizerMissing = class(Exception) + constructor Create; + constructor Create(AMessage: string); + end; + +const + GIFScreenDescriptor_GlobalColorTableFlag = $80; //global palette is present + GIFScreenDescriptor_GlobalColorSortFlag = $08; //global palette colors are sorted by importance + + GIFImageIntroducer = $2c; + GIFExtensionIntroducer = $21; + GIFBlockTerminator = $00; + GIFFileTerminator = $3B; + + GIFGraphicControlExtension_TransparentFlag = $01; //transparent color index is provided + GIFGraphicControlExtension_UserInputFlag = $02; //wait for user input at this frame (ignored) + GIFGraphicControlExtension_FunctionCode = $f9; + GIFGraphicControlExtension_DisposeModeShift = 2; + + GIFImageDescriptor_LocalColorTableFlag = $80; //local palette is present + GIFImageDescriptor_InterlacedFlag = $40; //image data is interlaced + GIFImageDescriptor_LocalColorSortFlag = $20; //local palette colors are sorted by importance + + GIFInterlacedStart: array[1..4] of longint = (0, 4, 2, 1); + GIFInterlacedStep: array[1..4] of longint = (8, 8, 4, 2); + + GIFCodeTableSize = 4096; + + NetscapeApplicationIdentifier = 'NETSCAPE2.0'; + NetscapeSubBlockIdLoopCount = 1; + NetscapeSubBlockIdBuffering = 2; + +function CeilLn2(AValue: Integer): integer; +function BGRAToPackedRgbTriple(color: TBGRAPixel): TPackedRGBTriple; +function PackedRgbTribleToBGRA(rgb: TPackedRGBTriple): TBGRAPixel; +function GIFLoadFromStream(stream: TStream; MaxImageCount: integer = maxLongint): TGIFData; +procedure GIFSaveToStream(AData: TGifData; Stream: TStream; AQuantizerFactory: TBGRAColorQuantizerAny; + ADitheringAlgorithm: TDitheringAlgorithm); +procedure GIFDecodeLZW(AStream: TStream; AImage: TBGRACustomBitmap; + const APalette: ArrayOfTBGRAPixel; transcolorIndex: integer; + interlaced: boolean); + +//Encode an image supplied as an sequence of bytes, from left to right and top to bottom. +//Adapted from the work of Udo Schmal, http://www.gocher.me/FPWriteGIF +procedure GIFEncodeLZW(AStream: TStream; AImageData: PByte; + AImageWidth, AImageHeight: integer; ABitDepth: byte); + +implementation + +function PackedRgbTribleToBGRA(rgb: TPackedRGBTriple): TBGRAPixel; +begin + Result.red := rgb.r; + Result.green := rgb.g; + Result.blue := rgb.b; + Result.alpha := 255; +end; + +function BGRAToPackedRgbTriple(color: TBGRAPixel): TPackedRGBTriple; +begin + result.r := color.red; + result.g := color.green; + result.b := color.blue; +end; + +function CeilLn2(AValue: Integer): integer; +var comp: integer; +begin + result := 0; + comp := 1; + while (comp < AValue) and (result < 30) do + begin + inc(result); + comp := comp shl 1; + end; +end; + +procedure GIFDecodeLZW(AStream: TStream; AImage: TBGRACustomBitmap; + const APalette: ArrayOfTBGRAPixel; transcolorIndex: integer; + interlaced: boolean); +var + xd, yd: longint; +type + Pstr = ^Tstr; + + Tstr = record + prefix: Pstr; + suffix: longint; + end; + Pstrtab = ^Tstrtab; + Tstrtab = array[0..GIFCodeTableSize-1] of Tstr; + +var + strtab: Pstrtab; + oldcode, curcode, clearcode, endcode: longint; + codesize, codelen, codemask: longint; + stridx: longint; + bitbuf, bitsinbuf: longint; + bytbuf: packed array[0..255] of byte; + bytinbuf, bytbufidx: byte; + endofsrc: boolean; + xcnt, ycnt, ystep, pass: longint; + pdest: PBGRAPixel; + + procedure InitStringTable; + var + i: longint; + begin + new(strtab); + clearcode := 1 shl codesize; + endcode := clearcode + 1; + stridx := endcode + 1; + codelen := CeilLn2(stridx+1); + codemask := (1 shl codelen) - 1; + for i := 0 to clearcode - 1 do + begin + strtab^[i].prefix := nil; + strtab^[i].suffix := i; + end; + for i := clearcode to GIFCodeTableSize-1 do + begin + strtab^[i].prefix := nil; + strtab^[i].suffix := 0; + end; + end; + + procedure ClearStringTable; + var + i: longint; + begin + clearcode := 1 shl codesize; + endcode := clearcode + 1; + stridx := endcode + 1; + codelen := CeilLn2(stridx+1); + codemask := (1 shl codelen) - 1; + for i := clearcode to GIFCodeTableSize-1 do + begin + strtab^[i].prefix := nil; + strtab^[i].suffix := 0; + end; + end; + + procedure DoneStringTable; + begin + dispose(strtab); + end; + + function GetNextCode: longint; + begin + while (bitsinbuf < codelen) do + begin + if (bytinbuf = 0) then + begin + if AStream.Read(bytinbuf, 1) <> 1 then + raise exception.Create('Unexpected end of stream'); + + if (bytinbuf = 0) then + begin + endofsrc := True; + result := endcode; + exit; + end; + AStream.Read(bytbuf, bytinbuf); + bytbufidx := 0; + end; + bitbuf := bitbuf or (longint(byte(bytbuf[bytbufidx])) shl bitsinbuf); + Inc(bytbufidx); + Dec(bytinbuf); + Inc(bitsinbuf, 8); + end; + Result := bitbuf and codemask; + bitbuf := bitbuf shr codelen; + Dec(bitsinbuf, codelen); + //write(inttostr(result)+'@'+inttostr(codelen)+' '); + end; + + procedure AddStr2Tab(prefix: Pstr; suffix: longint); + begin + if stridx >= GIFCodeTableSize then exit; + strtab^[stridx].prefix := prefix; + strtab^[stridx].suffix := suffix; + Inc(stridx); + if (stridx = 1 shl codelen) + and (stridx < GIFCodeTableSize) then + inc(codelen); + codemask := (1 shl codelen) - 1; + end; + + function Code2Str(code: longint): Pstr; + begin + Result := addr(strtab^[code]); + end; + + procedure WriteStr(s: Pstr); + var + colorIndex: integer; + begin + if (s^.prefix <> nil) then + begin + if s^.prefix = s then + raise exception.Create('Circular reference in prefix'); + WriteStr(s^.prefix); + end; + if (ycnt >= yd) then + begin + if interlaced then + begin + while ycnt >= yd do + begin + if pass >= 5 then exit; + + Inc(pass); + ycnt := GIFInterlacedStart[pass]; + ystep := GIFInterlacedStep[pass]; + end; + end else exit; + end; + + colorIndex := s^.suffix; + if xcnt = 0 then pdest := AImage.ScanLine[ycnt]; + + if (colorIndex <> transcolorIndex) and (colorIndex >= 0) and + (colorIndex < length(APalette)) then + pdest^ := APalette[colorIndex]; + + Inc(xcnt); + inc(pdest); + + if (xcnt >= xd) then + begin + pdest := nil; + xcnt := 0; + Inc(ycnt, ystep); + + if not interlaced then + if (ycnt >= yd) then + begin + Inc(pass); + end; + + end; + end; + + function firstchar(s: Pstr): byte; + begin + while (s^.prefix <> nil) do + s := s^.prefix; + Result := s^.suffix; + end; + +begin + endofsrc := False; + xd := AImage.Width; + yd := AImage.Height; + xcnt := 0; + pdest := nil; + if interlaced then + begin + pass := 1; + ycnt := GIFInterlacedStart[pass]; + ystep := GIFInterlacedStep[pass]; + end + else + begin + pass := 4; + ycnt := 0; + ystep := 1; + end; + oldcode := 0; + bitbuf := 0; + bitsinbuf := 0; + bytinbuf := 0; + bytbufidx := 0; + codesize := 0; + AStream.Read(codesize, 1); + InitStringTable; + try + curcode := getnextcode; + //Write('Reading '); + while (curcode <> endcode) and (pass < 5) and not endofsrc do + begin + if (curcode = clearcode) then + begin + ClearStringTable; + repeat + curcode := getnextcode; + until (curcode <> clearcode); + if (curcode = endcode) then + break; + WriteStr(code2str(curcode)); + oldcode := curcode; + end + else + begin + if (curcode < stridx) then + begin + WriteStr(Code2Str(curcode)); + AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(curcode))); + oldcode := curcode; + end + else + begin + if (curcode > stridx) then + begin + //write('!Invalid! '); + break; + end; + AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(oldcode))); + WriteStr(Code2Str(stridx - 1)); + oldcode := curcode; + end; + end; + curcode := getnextcode; + end; + finally + DoneStringTable; + end; + //Writeln; + if not endofsrc then + begin + bytinbuf:= 0; + AStream.ReadBuffer(bytinbuf, 1); + if bytinbuf <> 0 then + raise exception.Create('Invalid GIF format: expecting block terminator'); + end; +end; + +//Encode an image supplied as an sequence of bytes, from left to right and top to bottom. +//Adapted from the work of Udo Schmal, http://www.gocher.me/FPWriteGIF +procedure GIFEncodeLZW(AStream: TStream; AImageData: PByte; + AImageWidth, AImageHeight: integer; ABitDepth: byte); + +var //input position + PInput, PInputEnd: PByte; + + // get the next pixel from the bitmap + function ReadValue: byte; + begin + result := PInput^; + Inc(PInput); + end; + +var // GIF buffer can be up to 255 bytes long + OutputBufferSize: Int32or64; + OutputBuffer: packed array[0..255] of byte; + + procedure FlushByteOutput; + begin + if OutputBufferSize > 0 then + begin + OutputBuffer[0] := OutputBufferSize; + AStream.WriteBuffer(OutputBuffer, OutputBufferSize+1); + OutputBufferSize := 0; + end; + end; + + procedure OutputByte(AValue: byte); + begin + if OutputBufferSize = 255 then FlushByteOutput; + inc(OutputBufferSize); + OutputBuffer[OutputBufferSize] := AValue; + end; + +type TCode = Word; + +var + BitBuffer : LongWord; // steady stream of bit output + BitBufferLen : Byte; // number of bits in buffer + CurCodeSize : byte; // current code size + + // save the code in the output data stream + procedure WriteCode(Code: TCode); + begin + //Write(IntToStr(Code)+'@'+IntToStr(CurCodeSize)+' '); + + // append code to bit buffer + BitBuffer := BitBuffer or (Code shl BitBufferLen); + BitBufferLen := BitBufferLen + CurCodeSize; + // output whole bytes + while BitBufferLen >= 8 do + begin + OutputByte(BitBuffer and $ff); + BitBuffer := BitBuffer shr 8; + dec(BitBufferLen, 8); + end; + end; + + procedure CloseBitOutput; + begin + // write out the rest of the bit string + // and add padding bits if necessary + while BitBufferLen > 0 do + begin + OutputByte(BitBuffer and $ff); + BitBuffer := BitBuffer shr 8; + if BitBufferLen >= 8 then + dec(BitBufferLen, 8) + else + BitBufferLen := 0; + end; + end; + +type + PCodeTableEntry = ^TCodeTableEntry; + TCodeTableEntry = packed record + Prefix: TCode; + LongerFirst, LongerLast: TCode; + Suffix, Padding: Byte; + NextWithPrefix: TCode; + end; + +var + ClearCode : TCode; // reset decode params + EndStreamCode : TCode; // last code in input stream + FirstCodeSlot : TCode; // first slot when table is empty + NextCodeSlot : TCode; // next slot to be used + + PEntry: PCodeTableEntry; + CodeTable: array of TCodeTableEntry; + CurrentCode : TCode; // code representing current string + + procedure DoClearCode; + var + i: Word; + begin + for i := 0 to (1 shl ABitDepth)-1 do + with CodeTable[i] do + begin + LongerFirst:= 0; + LongerLast:= 0; + end; + + WriteCode(ClearCode); + CurCodeSize := CeilLn2(FirstCodeSlot+1); + NextCodeSlot := FirstCodeSlot; + end; + +var + CurValue: Byte; + i: TCode; + found: boolean; // decoded string in prefix table? +begin + if ABitDepth > 8 then + raise exception.Create('Maximum bit depth is 8'); + + //most readers won't handle less than 2 bits + if ABitDepth < 2 then ABitDepth := 2; + + //output + AStream.WriteByte(ABitDepth); + ClearCode := 1 shl ABitDepth; + EndStreamCode := ClearCode + 1; + FirstCodeSlot := ClearCode + 2; + CurCodeSize := CeilLn2(FirstCodeSlot+1); + + OutputBufferSize := 0; + BitBuffer := 0; + BitBufferLen := 0; + + //input + PInput := AImageData; + PInputEnd := AImageData + PtrInt(AImageWidth)*AImageHeight; + + setlength(CodeTable, GIFCodeTableSize); + DoClearCode; + //write('Writing '); + + while PInput < PInputEnd do + begin + CurrentCode := ReadValue; + if CurrentCode >= ClearCode then + raise exception.Create('Internal error'); + + //try to match the longest string + while PInput < PInputEnd do + begin + CurValue := ReadValue; + + found := false; + + i := CodeTable[CurrentCode].LongerFirst; + while i <> 0 do + begin + PEntry := @CodeTable[i]; + if PEntry^.Suffix = CurValue then + begin + found := true; + CurrentCode := i; + break; + end; + i := PEntry^.NextWithPrefix; + end; + + if not found then + begin + PEntry := @CodeTable[CurrentCode]; + if PEntry^.LongerFirst = 0 then + begin + //store the first and last code being longer + PEntry^.LongerFirst := NextCodeSlot; + PEntry^.LongerLast := NextCodeSlot; + end else + begin + //link next entry having the same prefix + CodeTable[PEntry^.LongerLast].NextWithPrefix:= NextCodeSlot; + PEntry^.LongerLast := NextCodeSlot; + end; + + // add new encode table entry + PEntry := @CodeTable[NextCodeSlot]; + PEntry^.Prefix := CurrentCode; + PEntry^.Suffix := CurValue; + PEntry^.LongerFirst := 0; + PEntry^.LongerLast := 0; + PEntry^.NextWithPrefix := 0; + inc(NextCodeSlot); + + Dec(PInput); + break; + end; + end; + + // write the code of the longest entry found + WriteCode(CurrentCode); + + if NextCodeSlot >= GIFCodeTableSize then + DoClearCode + else if NextCodeSlot > 1 shl CurCodeSize then + inc(CurCodeSize); + end; + + WriteCode(EndStreamCode); + CloseBitOutput; + FlushByteOutput; + + AStream.WriteByte(0); //GIF block terminator + //Writeln; +end; + +function GIFLoadFromStream(stream: TStream; MaxImageCount: integer = maxLongint): TGIFData; + + procedure DumpData; + var + Count: byte; + begin + repeat + Count := 0; + stream.Read(Count, 1); + stream.position := stream.position + Count; + until (Count = 0) or (stream.position >= stream.size); + end; + + function ReadString: string; + var Count: byte; + begin + Count := 0; + stream.Read(Count, 1); + setlength(result, Count); + if Count > 0 then + stream.ReadBuffer(result[1], length(result)); + end; + +var + NbImages: integer; + + GIFSignature: TGIFSignature; + GIFScreenDescriptor: TGIFScreenDescriptor; + GIFBlockID: char; + GIFImageDescriptor: TGIFImageDescriptor; + + globalPalette: ArrayOfTBGRAPixel; + localPalette: ArrayOfTBGRAPixel; + + transcolorIndex: integer; + DelayMs: integer; + disposeMode: TDisposeMode; + + procedure LoadGlobalPalette; + var + NbEntries, i: integer; + rgb: TPackedRGBTriple; + begin + NbEntries := 1 shl (GIFScreenDescriptor.flags and $07 + 1); + setlength(globalPalette, NbEntries); + for i := 0 to NbEntries - 1 do + begin + stream.ReadBuffer({%H-}rgb, 3); + globalPalette[i] := PackedRgbTribleToBGRA(rgb); + end; + end; + + procedure LoadLocalPalette; + var + NbEntries, i: integer; + rgb: TPackedRGBTriple; + begin + NbEntries := 1 shl (GIFImageDescriptor.flags and $07 + 1); + setlength(localPalette, NbEntries); + for i := 0 to NbEntries - 1 do + begin + stream.ReadBuffer({%H-}rgb, 3); + localPalette[i] := PackedRgbTribleToBGRA(rgb); + end; + end; + + procedure LoadImage; + var + imgWidth, imgHeight: integer; + img: TBGRABitmap; + Interlaced: boolean; + palette: ArrayOfTBGRAPixel; + begin + stream.Read(GIFImageDescriptor, sizeof(GIFImageDescriptor)); + GIFImageDescriptor.Width := LEtoN(GIFImageDescriptor.Width); + GIFImageDescriptor.Height := LEtoN(GIFImageDescriptor.Height); + GIFImageDescriptor.x := LEtoN(GIFImageDescriptor.x); + GIFImageDescriptor.y := LEtoN(GIFImageDescriptor.y); + if (GIFImageDescriptor.flags and GIFImageDescriptor_LocalColorTableFlag = + GIFImageDescriptor_LocalColorTableFlag) then + LoadLocalPalette + else + localPalette := nil; + + if localPalette <> nil then + palette := localPalette + else + palette := globalPalette; + imgWidth := GIFImageDescriptor.Width; + imgHeight := GIFImageDescriptor.Height; + + if length(result.Images) <= NbImages then + setlength(result.Images, length(result.Images) * 2 + 1); + img := TBGRABitmap.Create(imgWidth, imgHeight); + img.Fill(BGRAPixelTransparent); + result.Images[NbImages].Image := img; + result.Images[NbImages].Position := point(GIFImageDescriptor.x, GIFImageDescriptor.y); + result.Images[NbImages].DelayMs := DelayMs; + result.Images[NbImages].DisposeMode := disposeMode; + result.Images[NbImages].HasLocalPalette := localPalette <> nil; + Inc(NbImages); + + Interlaced := GIFImageDescriptor.flags and GIFImageDescriptor_InterlacedFlag = + GIFImageDescriptor_InterlacedFlag; + GIFDecodeLZW(stream, img, palette, transcolorIndex, Interlaced); + end; + + procedure ReadExtension; + var + GIFExtensionBlock: TGIFExtensionBlock; + GIFGraphicControlExtension: TGIFGraphicControlExtension; + mincount, Count, SubBlockId: byte; + app: String; + + begin + stream.ReadBuffer({%H-}GIFExtensionBlock, sizeof(GIFExtensionBlock)); + case GIFExtensionBlock.FunctionCode of + $F9: //graphic control extension + begin + Count := 0; + stream.Read(Count, 1); + if Count < sizeof(GIFGraphicControlExtension) then + mincount := 0 + else + begin + mincount := sizeof(GIFGraphicControlExtension); + stream.ReadBuffer({%H-}GIFGraphicControlExtension, mincount); + GIFGraphicControlExtension.DelayHundredthSec := LEtoN(GIFGraphicControlExtension.DelayHundredthSec); + + if GIFGraphicControlExtension.flags and + GIFGraphicControlExtension_TransparentFlag = + GIFGraphicControlExtension_TransparentFlag then + transcolorIndex := GIFGraphicControlExtension.TransparentColorIndex + else + transcolorIndex := -1; + if GIFGraphicControlExtension.DelayHundredthSec <> 0 then + DelayMs := GIFGraphicControlExtension.DelayHundredthSec * 10; + DisposeMode := TDisposeMode((GIFGraphicControlExtension.flags shr GIFGraphicControlExtension_DisposeModeShift) and 7); + end; + stream.Position := Stream.Position + Count - mincount; + DumpData; + end; + $ff: //application extension + begin + app := ReadString; + if app <> '' then + begin + if app = NetscapeApplicationIdentifier then + begin + repeat + Count := 0; + stream.Read(Count,1); + if Count = 0 then break; + stream.ReadBuffer({%H-}SubBlockId,1); + Dec(Count); + if (SubBlockId = NetscapeSubBlockIdLoopCount) and (Count >= 2) then + begin + stream.ReadBuffer(result.LoopCount, 2); + dec(Count,2); + result.LoopCount := LEtoN(result.LoopCount); + if result.LoopCount > 0 then inc(result.LoopCount); + end; + stream.Position:= stream.Position+Count; + until false; + end else + DumpData; + end; + end + else + begin + DumpData; + end; + end; + end; + + procedure DiscardImages; + var + i: Integer; + begin + for i := 0 to NbImages-1 do + FreeAndNil(result.Images[i].Image); + NbImages:= 0; + end; + +begin + result.Width := 0; + result.Height := 0; + result.BackgroundColor := clNone; + result.Images := nil; + result.AspectRatio := 1; + result.LoopCount := 1; + if stream = nil then exit; + + NbImages := 0; + transcolorIndex := -1; + DelayMs := 100; + disposeMode := dmErase; + + try + FillChar({%H-}GIFSignature,sizeof(GIFSignature),0); + stream.Read(GIFSignature, sizeof(GIFSignature)); + if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and (GIFSignature[3] = 'F') then + begin + stream.ReadBuffer({%H-}GIFScreenDescriptor, sizeof(GIFScreenDescriptor)); + GIFScreenDescriptor.Width := LEtoN(GIFScreenDescriptor.Width); + GIFScreenDescriptor.Height := LEtoN(GIFScreenDescriptor.Height); + result.Width := GIFScreenDescriptor.Width; + result.Height := GIFScreenDescriptor.Height; + if GIFScreenDescriptor.AspectRatio64 = 0 then + result.AspectRatio:= 1 + else + result.AspectRatio:= (GIFScreenDescriptor.AspectRatio64+15)/64; + if (GIFScreenDescriptor.flags and GIFScreenDescriptor_GlobalColorTableFlag = + GIFScreenDescriptor_GlobalColorTableFlag) then + begin + LoadGlobalPalette; + if GIFScreenDescriptor.BackgroundColorIndex < length(globalPalette) then + result.BackgroundColor := + BGRAToColor(globalPalette[GIFScreenDescriptor.BackgroundColorIndex]); + end; + repeat + stream.ReadBuffer({%H-}GIFBlockID, sizeof(GIFBlockID)); + case GIFBlockID of + ';': ; + ',': begin + if NbImages >= MaxImageCount then break; + LoadImage; + end; + '!': ReadExtension; + else + begin + raise Exception.Create('GIF format: unexpected block type'); + break; + end; + end; + until (GIFBlockID = ';') or (stream.Position >= stream.size); + end + else + raise Exception.Create('GIF format: invalid header'); + except + on ex: Exception do + begin + DiscardImages; + raise Exception.Create('GIF format: '+ ex.Message); + end; + end; + setlength(result.Images, NbImages); +end; + +procedure GIFSaveToStream(AData: TGifData; Stream: TStream; AQuantizerFactory: TBGRAColorQuantizerAny; + ADitheringAlgorithm: TDitheringAlgorithm); +var + signature: TGIFSignature; + screenDescriptor: TGIFScreenDescriptor; + globalPalette: TBGRAPalette; + globalQuantizer: TBGRACustomColorQuantizer; + globalTranspIndex: integer; + + procedure AddColorsToPalette(AImage: TBGRACustomBitmap; APalette: TBGRAPalette); + var n: integer; + p: PBGRAPixel; + c: TBGRAPixel; + begin + p := AImage.Data; + for n := AImage.NbPixels-1 downto 0 do + begin + if p^.alpha < 255 then //transparent color will be needed to dither properly + APalette.AddColor(BGRAPixelTransparent); + if p^.alpha > 0 then //color may be needed to dither properly + begin + c := p^; + c.alpha := 255; + APalette.AddColor(c); + end; + inc(p); + end; + end; + + function ImageCount: integer; + begin + result := length(AData.Images); + end; + + function NeedGlobalPalette: boolean; + var i: integer; + begin + for i := 0 to ImageCount-1 do + if not AData.Images[i].HasLocalPalette then + begin + result := true; + exit; + end; + end; + + function IndexOfGlobalColor(AColor: TBGRAPixel): integer; + begin + if Assigned(globalQuantizer) then + result := globalQuantizer.ReducedPalette.FindNearestColorIndex(AColor) + else + result := globalPalette.IndexOfColor(AColor); + end; + + procedure MakeGlobalPalette; + var i: integer; + indexed: TBGRAIndexedPalette; + bitDepth: integer; + begin + globalPalette := TBGRAPalette.Create; + for i := 0 to ImageCount-1 do + if not AData.Images[i].HasLocalPalette then + AddColorsToPalette(AData.Images[i].Image, globalPalette); + if AData.BackgroundColor <> clNone then + globalPalette.AddColor(ColorToBGRA(AData.BackgroundColor)); + + if globalPalette.Count > 256 then + begin + if Assigned(AQuantizerFactory) then + begin + globalQuantizer:= AQuantizerFactory.Create(globalPalette, False, 256); + globalPalette.Free; + globalPalette := TBGRAIndexedPalette.Create(globalQuantizer.ReducedPalette); + end + else + begin + globalPalette.Free; + raise EColorQuantizerMissing.Create; + end; + end else + begin + indexed := TBGRAIndexedPalette.Create(globalPalette); + globalPalette.Free; + globalPalette := indexed; + end; + + globalTranspIndex:= globalPalette.IndexOfColor(BGRAPixelTransparent); + if AData.BackgroundColor <> clNone then + screenDescriptor.BackgroundColorIndex:= IndexOfGlobalColor(ColorToBGRA(AData.BackgroundColor)) and 255; + + bitDepth := CeilLn2(globalPalette.Count); + if bitDepth > 8 then bitDepth:= 8; + if bitDepth < 1 then bitDepth:= 1; + screenDescriptor.flags := screenDescriptor.flags or GIFScreenDescriptor_GlobalColorTableFlag; + screenDescriptor.flags := screenDescriptor.flags or (bitDepth-1); + end; + + procedure WritePalette(pal: TBGRAPalette; bitDepth: integer); + var i: integer; + numberToWrite,numberFromPal: Integer; + rgbs: ^TPackedRGBTriple; + black: TPackedRGBTriple; + begin + if not Assigned(pal) then exit; + numberToWrite:= 1 shl bitDepth; + numberFromPal := pal.Count; + if numberFromPal > numberToWrite then numberFromPal:= numberToWrite; + getmem(rgbs, numberToWrite*sizeof(TPackedRGBTriple)); + try + for i := 0 to numberFromPal-1 do + rgbs[i] := BGRAToPackedRgbTriple(pal.Color[i]); + black := BGRAToPackedRgbTriple(BGRABlack); + for i := numberFromPal to numberToWrite-1 do + rgbs[i] := black; + Stream.WriteBuffer(rgbs^,sizeof(TPackedRGBTriple)*numberToWrite); + finally + freemem(rgbs); + end; + end; + + procedure WriteGlobalPalette; + begin + WritePalette(globalPalette, (screenDescriptor.flags and 7)+1); + end; + + procedure FreeGlobalPalette; + begin + FreeAndNil(globalPalette); + FreeAndNil(globalQuantizer); + end; + + procedure WriteImages; + var + localPalette: TBGRAPalette; + localQuantizer: TBGRACustomColorQuantizer; + localTranspIndex: integer; + imageDescriptor: TGIFImageDescriptorWithHeader; + + procedure MakeLocalPalette(AFrameIndex: integer); + var + indexed: TBGRAIndexedPalette; + bitDepth: integer; + begin + localPalette := TBGRAPalette.Create; + AddColorsToPalette(AData.Images[AFrameIndex].Image, localPalette); + if localPalette.Count > 256 then + begin + if Assigned(AQuantizerFactory) then + begin + localQuantizer:= AQuantizerFactory.Create(localPalette, False, 256); + localPalette.Free; + localPalette := TBGRAIndexedPalette.Create(localQuantizer.ReducedPalette); + end + else + begin + localPalette.Free; + raise EColorQuantizerMissing.Create; + end; + end else + begin + indexed := TBGRAIndexedPalette.Create(localPalette); + localPalette.Free; + localPalette := indexed; + end; + + localTranspIndex:= localPalette.IndexOfColor(BGRAPixelTransparent); + + bitDepth := CeilLn2(localPalette.Count); + if bitDepth > 8 then bitDepth:= 8; + if bitDepth < 1 then bitDepth:= 1; + imageDescriptor.Image.flags := imageDescriptor.Image.flags or GIFImageDescriptor_LocalColorTableFlag; + imageDescriptor.Image.flags := imageDescriptor.Image.flags or (bitDepth-1); + end; + + procedure WriteLocalPalette; + begin + WritePalette(localPalette, (imageDescriptor.Image.flags and 7)+1); + end; + + procedure FreeLocalPalette; + begin + FreeAndNil(localPalette); + FreeAndNil(localQuantizer); + localTranspIndex:= -1; + end; + + procedure DitherAndCompressImage(AFrame: integer; APalette: TBGRAPalette; AQuantizer: TBGRACustomColorQuantizer); + var ImageData: Pointer; + Image: TBGRABitmap; + y,x: Int32or64; + psource: PBGRAPixel; + pdest: PByte; + begin + Image := AData.Images[AFrame].Image; + if Assigned(AQuantizer) then + ImageData := AQuantizer.GetDitheredBitmapIndexedData(8, ADitheringAlgorithm, Image) + else + begin + GetMem(ImageData, Image.Width*Image.Height); + pdest := ImageData; + for y := 0 to Image.Height -1 do + begin + psource := Image.ScanLine[y]; + for x := 0 to Image.Width -1 do + begin + if psource^.alpha < 128 then + pdest^ := APalette.IndexOfColor(BGRAPixelTransparent) + else + pdest^ := APalette.IndexOfColor(BGRA(psource^.red,psource^.green,psource^.blue,255)); + inc(psource); + inc(pdest); + end; + end; + end; + try + GIFEncodeLZW(Stream, ImageData, Image.Width, Image.Height, CeilLn2(APalette.Count)); + finally + FreeMem(ImageData); + end; + end; + + procedure WriteImage(AFrame: integer); + var + ext: TGIFGraphicControlExtensionWithHeader; + transpIndex: integer; + begin + fillchar({%H-}ext, sizeof(ext), 0); + try + ext.ExtensionIntroducer := GIFExtensionIntroducer; + ext.FunctionCode := GIFGraphicControlExtension_FunctionCode; + ext.BlockSize := sizeof(ext.GraphicControl); + ext.GraphicControl.DelayHundredthSec := (AData.Images[AFrame].DelayMs+5) div 10; + ext.GraphicControl.TransparentColorIndex := 0; + ext.GraphicControl.flags := integer(AData.Images[AFrame].DisposeMode) shl GIFGraphicControlExtension_DisposeModeShift; + ext.BlockTerminator := GIFBlockTerminator; + with AData.Images[AFrame].Position do + begin + imageDescriptor.Image.x := x; + imageDescriptor.Image.y := y; + end; + with AData.Images[AFrame].Image do + begin + imageDescriptor.Image.Width := Width; + imageDescriptor.Image.Height := Height; + end; + imageDescriptor.Image.flags := 0; + + if AData.Images[AFrame].HasLocalPalette then MakeLocalPalette(AFrame); + + if AData.Images[AFrame].Image.HasTransparentPixels then + begin + if AData.Images[AFrame].HasLocalPalette then + transpIndex := localTranspIndex + else + transpIndex := globalTranspIndex; + end else + transpIndex := -1; + if (transpIndex >= 0) and (transpIndex <= 255) then + begin + ext.GraphicControl.flags := ext.GraphicControl.flags or GIFGraphicControlExtension_TransparentFlag; + ext.GraphicControl.TransparentColorIndex := transpIndex; + end; + + Stream.WriteBuffer(ext, sizeof(ext)); + Stream.WriteBuffer(imageDescriptor, sizeof(imageDescriptor)); + WriteLocalPalette; + + if AData.Images[AFrame].HasLocalPalette then + DitherAndCompressImage(AFrame, localPalette, localQuantizer) + else + DitherAndCompressImage(AFrame, globalPalette, globalQuantizer); + finally + FreeLocalPalette; + end; + end; + + var + i: integer; + begin + localPalette := nil; + localQuantizer := nil; + localTranspIndex:= -1; + fillchar({%H-}imageDescriptor, sizeof(imageDescriptor), 0); + imageDescriptor.ImageIntroducer := GIFImageIntroducer; + for i := 0 to ImageCount-1 do + WriteImage(i); + end; + + procedure WriteLoopExtension; + var + app: shortstring; + w: Word; + begin + if AData.LoopCount = 1 then exit; + + Stream.WriteByte(GIFExtensionIntroducer); + Stream.WriteByte($ff); + app := NetscapeApplicationIdentifier; + Stream.WriteBuffer(app[0], length(app)+1); + + Stream.WriteByte(3); + Stream.WriteByte(NetscapeSubBlockIdLoopCount); + if AData.LoopCount = 0 then + w := 0 + else + w := AData.LoopCount-1; + w := NtoLE(w); + Stream.WriteWord(w); + + Stream.WriteByte(0); + end; + +begin + globalPalette := nil; + globalQuantizer := nil; + globalTranspIndex:= -1; + try + signature := 'GIF89a'; + screenDescriptor.Width := NtoLE(AData.Width); + screenDescriptor.Height := NtoLE(AData.Height); + screenDescriptor.flags := $70; //suppose 8-bit screen + screenDescriptor.BackgroundColorIndex := 0; //not specified for now + screenDescriptor.AspectRatio64 := round(AData.AspectRatio*64)-15; + if NeedGlobalPalette then MakeGlobalPalette; + + Stream.WriteBuffer(signature, sizeof(signature)); + Stream.WriteBuffer(screenDescriptor, sizeof(screenDescriptor)); + WriteGlobalPalette; + + WriteLoopExtension; + + WriteImages; + Stream.WriteByte(GIFFileTerminator); //end of file + + finally + FreeGlobalPalette; + end; +end; + +{ EColorQuantizerMissing } + +constructor EColorQuantizerMissing.Create; +begin + inherited Create('Please provide a color quantizer class (one is provided in BGRAColorQuantization)') +end; + +constructor EColorQuantizerMissing.Create(AMessage: string); +begin + inherited Create(AMessage); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragradientoriginal.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragradientoriginal.pas new file mode 100644 index 0000000..246b8bb --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragradientoriginal.pas @@ -0,0 +1,945 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGradientOriginal; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALayerOriginal, BGRABitmap, BGRABitmapTypes, BGRAGradientScanner, + BGRASVG, BGRASVGShapes, BGRASVGType; + +type + TBGRAColorInterpolation = BGRAGradientScanner.TBGRAColorInterpolation; + TBGRAGradientRepetition = BGRAGradientScanner.TBGRAGradientRepetition; + TBGRALayerGradientOriginal = class; + + { TBGRAGradientOriginalDiff } + + TBGRAGradientOriginalDiff = class(TBGRAOriginalDiff) + protected + FStorageBefore, FStorageAfter: TBGRAMemOriginalStorage; + public + constructor Create(AOriginal: TBGRALayerGradientOriginal); + procedure ComputeDifference(AOriginal: TBGRALayerGradientOriginal); + destructor Destroy; override; + procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; + procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; + function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; + procedure Append(ADiff: TBGRAOriginalDiff); override; + function IsIdentity: boolean; override; + end; + + { TBGRALayerGradientOriginal } + + TBGRALayerGradientOriginal = class(TBGRALayerCustomOriginal) + private + function GetIsOpaque: boolean; + procedure SetColorInterpolation(AValue: TBGRAColorInterpolation); + procedure SetEndColor(AValue: TBGRAPixel); + procedure SetFocalPoint(AValue: TPointF); + procedure SetFocalRadius(AValue: Single); + procedure SetGradientType(AValue: TGradientType); + procedure SetOrigin(AValue: TPointF); + procedure SetRadius(AValue: Single); + procedure SetRepetition(AValue: TBGRAGradientRepetition); + procedure SetStartColor(AValue: TBGRAPixel); + procedure SetXAxis(AValue: TPointF); + procedure SetYAxis(AValue: TPointF); + protected + FStartColor,FEndColor: TBGRAPixel; + FGradientType: TGradientType; + FOrigin,FXAxis,FYAxis,FFocalPoint: TPointF; + FOriginBackup,FXAxisBackup, FYAxisBackup: TPointF; + FRadius,FFocalRadius: single; + FColorInterpolation: TBGRAColorInterpolation; + FRepetition: TBGRAGradientRepetition; + FUpdateCount: integer; + FUpdateDiff: TBGRAGradientOriginalDiff; + function GetAverageColor: TBGRAPixel; + function GetComputedRadius: single; + function GetComputedYAxis: TPointF; + function GetComputedFocalPoint: TPointF; + function GetComputedFocalRadius: single; + procedure OnMoveOrigin({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnMoveXAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnMoveXAxisNeg({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnMoveYAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnMoveFocalPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnMoveFocalRadius({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); + procedure OnStartMove({%H-}ASender: TObject; {%H-}AIndex: integer; {%H-}AShift: TShiftState); + procedure BeginUpdate; + procedure EndUpdate; + procedure NotifyChangeWithoutDiff; + public + constructor Create; override; + destructor Destroy; override; + function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override; + function AddToSVGDefs(const AMatrix: TAffineMatrix; ADefs: TSVGDefine): TObject; + function IsInfiniteSurface: boolean; override; + procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override; + procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode); overload; + function CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean = false): TBGRACustomScanner; + procedure ConfigureEditor(AEditor: TBGRAOriginalEditor); override; + function GetRenderBounds(ADestRect: TRect; {%H-}AMatrix: TAffineMatrix): TRect; override; + procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; + procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; + class function StorageClassName: RawByteString; override; + class function CanConvertToSVG: boolean; override; + property ComputedYAxis: TPointF read GetComputedYAxis; + property ComputedRadius: single read GetComputedRadius; + property ComputedFocalPoint: TPointF read GetComputedFocalPoint; + property ComputedFocalRadius: single read GetComputedFocalRadius; + procedure Transform(AMatrix: TAffineMatrix); + procedure AssignExceptGeometry(AOther: TBGRALayerGradientOriginal); + procedure FitGeometry(const ABox: TAffineBox); + procedure SetColors(AStartColor, AEndColor: TBGRAPixel); + procedure ApplyOpacity(AOpacity: byte); + function Equals(Obj: TObject): boolean; override; + + property StartColor: TBGRAPixel read FStartColor write SetStartColor; + property EndColor: TBGRAPixel read FEndColor write SetEndColor; + property AverageColor: TBGRAPixel read GetAverageColor; + property GradientType: TGradientType read FGradientType write SetGradientType; //default gtLinear + property Origin: TPointF read FOrigin write SetOrigin; + property XAxis: TPointF read FXAxis write SetXAxis; + property YAxis: TPointF read FYAxis write SetYAxis; + property FocalPoint: TPointF read FFocalPoint write SetFocalPoint; //default Origin + property Radius: Single read FRadius write SetRadius; //default 1 + property FocalRadius: Single read FFocalRadius write SetFocalRadius; //default 0 + property ColorInterpolation: TBGRAColorInterpolation read FColorInterpolation write SetColorInterpolation; + property Repetition: TBGRAGradientRepetition read FRepetition write SetRepetition; + property IsOpaque: boolean read GetIsOpaque; + + end; + +implementation + +uses BGRATransform, BGRABlend, math; + +{ TBGRAGradientOriginalDiff } + +constructor TBGRAGradientOriginalDiff.Create(AOriginal: TBGRALayerGradientOriginal); +begin + FStorageBefore := TBGRAMemOriginalStorage.Create; + AOriginal.SaveToStorage(FStorageBefore); +end; + +procedure TBGRAGradientOriginalDiff.ComputeDifference( + AOriginal: TBGRALayerGradientOriginal); +begin + if Assigned(FStorageAfter) then FreeAndNil(FStorageAfter); + FStorageAfter := TBGRAMemOriginalStorage.Create; + AOriginal.SaveToStorage(FStorageAfter); +end; + +destructor TBGRAGradientOriginalDiff.Destroy; +begin + FStorageBefore.Free; + FStorageAfter.Free; + inherited Destroy; +end; + +procedure TBGRAGradientOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); +begin + if not Assigned(FStorageAfter) then raise exception.Create('Undefined state after diff'); + AOriginal.LoadFromStorage(FStorageAfter); + (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff; +end; + +procedure TBGRAGradientOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); +begin + if not Assigned(FStorageBefore) then raise exception.Create('Undefined state before diff'); + AOriginal.LoadFromStorage(FStorageBefore); + (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff; +end; + +function TBGRAGradientOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; +begin + result := ADiff is TBGRAGradientOriginalDiff; +end; + +procedure TBGRAGradientOriginalDiff.Append(ADiff: TBGRAOriginalDiff); +var + next: TBGRAGradientOriginalDiff; +begin + next := ADiff as TBGRAGradientOriginalDiff; + FreeAndNil(FStorageAfter); + FStorageAfter := next.FStorageAfter.Duplicate as TBGRAMemOriginalStorage; +end; + +function TBGRAGradientOriginalDiff.IsIdentity: boolean; +begin + result := FStorageBefore.Equals(FStorageAfter); +end; + +{ TBGRALayerGradientOriginal } + +function TBGRALayerGradientOriginal.GetComputedRadius: single; +begin + if FRadius = EmptySingle then result := 1 else result := FRadius; +end; + +function TBGRALayerGradientOriginal.GetAverageColor: TBGRAPixel; +begin + result := MergeBGRAWithGammaCorrection(StartColor, 1, EndColor, 1); +end; + +function TBGRALayerGradientOriginal.GetIsOpaque: boolean; +var + xLen, yLen, focalLen: Single; + focalCoord, u, v: TPointF; +begin + result := (StartColor.alpha = 255) and (EndColor.alpha = 255); + if result and (GradientType = gtRadial) and not FocalPoint.IsEmpty and + not Origin.IsEmpty and not XAxis.IsEmpty then + begin + u := XAxis - Origin; + v := ComputedYAxis - Origin; + xLen := VectLen(u); + yLen := VectLen(v); + if (xLen = 0) or (yLen = 0) then + result := false + else + begin + focalCoord := PointF((FocalPoint - Origin)*u/sqr(xLen), + (FocalPoint - Origin)*v/sqr(yLen)); + focalLen := VectLen(focalCoord); + if (focalLen + ComputedFocalRadius + 0.01 >= ComputedRadius) and not + (ComputedFocalRadius > focalLen + ComputedRadius + 0.01) then + result := false; + end; + end; +end; + +procedure TBGRALayerGradientOriginal.SetColorInterpolation( + AValue: TBGRAColorInterpolation); +begin + if FColorInterpolation=AValue then Exit; + BeginUpdate; + FColorInterpolation:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetEndColor(AValue: TBGRAPixel); +begin + if FEndColor.EqualsExactly(AValue) then Exit; + BeginUpdate; + FEndColor:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetFocalPoint(AValue: TPointF); +begin + if FFocalPoint=AValue then Exit; + BeginUpdate; + FFocalPoint:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetFocalRadius(AValue: Single); +begin + if FFocalRadius=AValue then Exit; + BeginUpdate; + FFocalRadius:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetGradientType(AValue: TGradientType); +begin + if FGradientType=AValue then Exit; + BeginUpdate; + FGradientType:=AValue; + if FGradientType in [gtLinear,gtReflected] then FYAxis := EmptyPointF; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetOrigin(AValue: TPointF); +begin + if FOrigin=AValue then Exit; + BeginUpdate; + FOrigin:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetRadius(AValue: Single); +begin + if FRadius=AValue then Exit; + BeginUpdate; + FRadius:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetRepetition( + AValue: TBGRAGradientRepetition); +begin + if FRepetition=AValue then Exit; + BeginUpdate; + FRepetition:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetStartColor(AValue: TBGRAPixel); +begin + if FStartColor.EqualsExactly(AValue) then Exit; + BeginUpdate; + FStartColor:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetXAxis(AValue: TPointF); +begin + if FXAxis=AValue then Exit; + BeginUpdate; + FXAxis:=AValue; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetYAxis(AValue: TPointF); +begin + if FYAxis=AValue then Exit; + BeginUpdate; + FYAxis:=AValue; + EndUpdate; +end; + +function TBGRALayerGradientOriginal.GetComputedYAxis: TPointF; +var + u: TPointF; +begin + if isEmptyPointF(FYAxis) then + begin + u := FXAxis - FOrigin; + result := FOrigin + PointF(-u.y,u.x) + end + else + result := FYAxis; +end; + +function TBGRALayerGradientOriginal.GetComputedFocalPoint: TPointF; +begin + if isEmptyPointF(FFocalPoint) then result := FOrigin else result := FFocalPoint; +end; + +function TBGRALayerGradientOriginal.GetComputedFocalRadius: single; +begin + if FFocalRadius = EmptySingle then result := 0 else result := FFocalRadius; +end; + +procedure TBGRALayerGradientOriginal.OnMoveOrigin(ASender: TObject; APrevCoord, + ANewCoord: TPointF; AShift: TShiftState); +var + delta: TPointF; +begin + BeginUpdate; + delta := ANewCoord-APrevCoord; + FOrigin.Offset(delta); + FXAxis.Offset(delta); + FYAxis.Offset(delta); + FFocalPoint.Offset(delta); + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.OnMoveXAxis(ASender: TObject; APrevCoord, + ANewCoord: TPointF; AShift: TShiftState); +var + m: TAffineMatrix; + c: TPointF; +begin + BeginUpdate; + if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then + begin + if not isEmptyPointF(FYAxis) and not isEmptyPointF(FYAxisBackup) then + begin + m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, FOrigin); + FYAxis := m*FYAxisBackup; + end; + end else + if isEmptyPointF(FYAxis) then FYAxis := ComputedYAxis; + + if (GradientType = gtLinear) and (ssShift in AShift) then + begin + c := (FOriginBackup+FXAxisBackup)*0.5; + m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, c); + FOrigin := m*FOriginBackup; + end + else + FOrigin := FOriginBackup; + + FXAxis := ANewCoord; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.OnMoveXAxisNeg(ASender: TObject; + APrevCoord, ANewCoord: TPointF; AShift: TShiftState); +var + delta, c: TPointF; + m: TAffineMatrix; +begin + BeginUpdate; + delta := ANewCoord-APrevCoord; + + if (GradientType = gtLinear) and (ssShift in AShift) then + begin + c := (FOriginBackup+FXAxisBackup)*0.5; + m := AffineMatrixScaledRotation(FOriginBackup, (FOrigin+delta), c); + FXAxis := m*FXAxisBackup; + end + else + FXAxis := FXAxisBackup; + + FOrigin.Offset(delta); + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.OnMoveYAxis(ASender: TObject; APrevCoord, + ANewCoord: TPointF; AShift: TShiftState); +var + m: TAffineMatrix; +begin + BeginUpdate; + if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then + begin + if not isEmptyPointF(FXAxis) then + begin + m := AffineMatrixScaledRotation(FYAxisBackup, ANewCoord, FOrigin); + FXAxis := m*FXAxisBackup; + end; + end; + FYAxis := ANewCoord; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.OnMoveFocalPoint(ASender: TObject; + APrevCoord, ANewCoord: TPointF; AShift: TShiftState); +begin + FocalPoint := ANewCoord; +end; + +procedure TBGRALayerGradientOriginal.OnMoveFocalRadius(ASender: TObject; + APrevCoord, ANewCoord: TPointF; AShift: TShiftState); +var refLen: single; + u, focalOrig: TPointF; +begin + BeginUpdate; + focalOrig := ComputedFocalPoint; + if isEmptyPointF(focalOrig) or isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit; + refLen := VectLen(FOrigin-FXAxis); + if refLen = 0 then exit; + + u := (FOrigin-FXAxis)*(1/refLen); + FFocalRadius := u * (ANewCoord-focalOrig) / refLen - 0.1; + if FFocalRadius < 0 then FFocalRadius:= 0; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.OnStartMove(ASender: TObject; + AIndex: integer; AShift: TShiftState); +begin + FOriginBackup := FOrigin; + FXAxisBackup := FXAxis; + FYAxisBackup := ComputedYAxis; +end; + +procedure TBGRALayerGradientOriginal.BeginUpdate; +begin + if DiffExpected and (FUpdateCount = 0) then + FUpdateDiff := TBGRAGradientOriginalDiff.Create(self); + inc(FUpdateCount); +end; + +procedure TBGRALayerGradientOriginal.EndUpdate; +begin + if FUpdateCount > 0 then + begin + dec(FUpdateCount); + if FUpdateCount = 0 then + begin + if Assigned(FUpdateDiff) then + FUpdateDiff.ComputeDifference(self); + NotifyChange(FUpdateDiff); + FUpdateDiff := nil; + end; + end; +end; + +procedure TBGRALayerGradientOriginal.NotifyChangeWithoutDiff; +begin + NotifyChange; +end; + +constructor TBGRALayerGradientOriginal.Create; +begin + inherited Create; + FStartColor := BGRABlack; + FEndColor := BGRAWhite; + FGradientType := gtLinear; + FColorInterpolation:= ciStdRGB; + FRepetition := grPad; + FRadius := EmptySingle; + FFocalRadius := EmptySingle; + FFocalPoint := EmptyPointF; + FOrigin := PointF(0,0); + FXAxis := EmptyPointF; + FYAxis := EmptyPointF; +end; + +destructor TBGRALayerGradientOriginal.Destroy; +begin + FUpdateDiff.Free; + inherited Destroy; +end; + +function TBGRALayerGradientOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; +var + svg: TBGRASVG; + def: TSVGDefine; + grad: TSVGGradient; + r: TSVGRectangle; +begin + AOffset:= Point(0, 0); + svg := TBGRASVG.Create(640, 480, cuPixel); // potentially infinite + result := svg; + def := svg.Content.AppendDefine; + grad := AddToSVGDefs(AMatrix, def) as TSVGGradient; + r := svg.Content.AppendRect(0, 0, 100, 100, cuPercent); + if Assigned(grad) then + begin + grad.ID := 'grad1'; + r.fill:= 'url(#grad1)'; + end else + r.fillColor := AverageColor; +end; + +function TBGRALayerGradientOriginal.AddToSVGDefs(const AMatrix: TAffineMatrix; + ADefs: TSVGDefine): TObject; +const ApproxCount = 16; + MaxReflectRepeatCount = 8; +var + grad: TSVGGradient; + colors: TBGRASimpleGradient; + tOrigin, tXAxis, tYAxis, tFocalPoint, reflectedXAxis, repeatedXAxis: TPointF; + gt: TGradientType; + + procedure AddColorStops(AOffset, AFactor: single; AIncludeStart: boolean); + var i, i0: integer; + begin + if (Repetition <> grSine) and (ColorInterpolation in [ciStdRGB, ciLinearRGB]) then + begin + if AFactor >= 0 then + begin + if AIncludeStart then + grad.Content.AppendStop(StartColor, AOffset, false); + grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false); + end else + begin + grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false); + if AIncludeStart then + grad.Content.AppendStop(StartColor, AOffset, false); + end; + end else + begin + colors := TBGRASimpleGradient.CreateAny(ColorInterpolation, StartColor,EndColor, Repetition); + try + if AIncludeStart then i0 := 0 else i0 := 1; + if AFactor >= 0 then + begin + for i := i0 to ApproxCount do + grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false); + end else + for i := ApproxCount downto i0 do + grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false); + finally + colors.Free; + end; + end; + end; + +var j: integer; + m: TAffineMatrix; + radialScale: Single; + fp, u, v: TPointF; + lenU, lenV: Single; + +begin + m := AffineMatrixTranslation(0.5, 0.5) * AMatrix; + tOrigin := m * Origin; + tXAxis := m * XAxis; + tYAxis := m * ComputedYAxis; + tFocalPoint := m * ComputedFocalPoint; + gt := GradientType; + if (GradientType = gtReflected) and (Repetition = grReflect) then + gt := gtLinear; // same as linear in this case + case gt of + gtLinear: + grad := ADefs.Content.AppendLinearGradient(tOrigin.X,tOrigin.Y,tXAxis.X,tXAxis.Y,cuCustom); + gtReflected: + begin + if Repetition <> grPad then j := MaxReflectRepeatCount else j := 1; + reflectedXAxis := tOrigin - j*(tXAxis - tOrigin); + repeatedXAxis := tOrigin + j*(tXAxis - tOrigin); + grad := ADefs.Content.AppendLinearGradient(reflectedXAxis.X,reflectedXAxis.Y, + repeatedXAxis.X,repeatedXAxis.Y,cuCustom); + end; + gtDiamond, gtRadial: // diamond approximated by radial + begin + u := tXAxis - tOrigin; + v := tYAxis - tOrigin; + lenU := u.Length; + lenV := v.Length; + radialScale := (lenU + lenV)/2; + if radialScale = 0 then + grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,0, + tOrigin.X,tOrigin.Y,0, cuCustom) + else if (lenU = lenV) and (u*v = 0) then + grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius, + tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom) + else + begin + if lenU = 0 then lenU := 1; + if lenV = 0 then lenV := 1; + fp := PointF((tFocalPoint - tOrigin) * u / sqr(lenU), + (tFocalPoint - tOrigin)*v / sqr(lenV)); + tFocalPoint := tOrigin + (fp.x * radialScale / lenU) * u + (fp.y * radialScale / lenV) * v; + grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius, + tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom); + grad.gradientMatrix[cuPixel] := + AffineMatrix((1 / radialScale)*u, (1 / radialScale)*v, tOrigin) * + AffineMatrixTranslation(-tOrigin.X, -tOrigin.Y); + end; + end; + gtAngular: exit(nil); // not implemented + end; + case Repetition of + grPad: grad.spreadMethod := ssmPad; + grReflect: grad.spreadMethod := ssmReflect; + grRepeat, grSine: grad.spreadMethod := ssmRepeat; + end; + if gt = gtReflected then + begin + if Repetition <> grPad then + begin + for j := -MaxReflectRepeatCount+1 to 0 do + AddColorStops(0.5 + j/MaxReflectRepeatCount*0.5, -0.5/MaxReflectRepeatCount, true); + for j := 0 to MaxReflectRepeatCount-1 do + AddColorStops(0.5 + j*0.5/MaxReflectRepeatCount, 0.5/MaxReflectRepeatCount, j > 0); + end else + begin + AddColorStops(0.5, -0.5, true); + AddColorStops(0.5, 0.5, false); + end; + end else + AddColorStops(0, 1, true); + if ColorInterpolation = ciStdRGB then + grad.colorInterpolation := sciStdRGB + else grad.colorInterpolation := sciLinearRGB; + result := grad; +end; + +function TBGRALayerGradientOriginal.IsInfiniteSurface: boolean; +begin + Result:= true; +end; + +procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap; + AMatrix: TAffineMatrix; ADraft: boolean); +begin + Render(ADest,AMatrix,ADraft,dmSet); +end; + +procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap; + AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode); +var + grad: TBGRACustomScanner; + temp: TBGRABitmap; +begin + if (ADrawMode in[dmDrawWithTransparency, dmLinearBlend, dmSetExceptTransparent]) and + IsOpaque then ADrawMode := dmSet; + + if ADraft and (ADest.ClipRect.Width*ADest.ClipRect.Height > 512*512) then + begin + temp := TBGRABitmap.Create(0,0); + temp.SetSize(min(400,ADest.Width),min(400,ADest.Height)); + Render(temp, AffineMatrixScale(temp.Width/ADest.Width, + temp.Height/ADest.Height)*AMatrix, ADraft); + ADest.StretchPutImage(rect(0,0,ADest.Width,Adest.Height),temp, ADrawMode); + temp.Free; + end else + begin + grad := CreateScanner(AMatrix, ADraft); + if ADraft then + ADest.FillRect(ADest.ClipRect, grad,ADrawMode) + else ADest.FillRect(ADest.ClipRect, grad,ADrawMode, daFloydSteinberg); + grad.Free; + end; +end; + +function TBGRALayerGradientOriginal.CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean): TBGRACustomScanner; +var + colors: TBGRACustomGradient; + grad: TBGRAGradientScanner; +begin + if isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit(nil); + + colors := TBGRASimpleGradient.CreateAny(FColorInterpolation, FStartColor,FEndColor, FRepetition); + if ADraft then + colors := TBGRABufferedGradient.Create(colors, true, FRepetition = grPad, 1024); + + if FGradientType = gtRadial then + begin + grad := TBGRAGradientScanner.Create(FOrigin,FXAxis,ComputedYAxis,ComputedFocalPoint,ComputedRadius,ComputedFocalRadius); + end else + grad := TBGRAGradientScanner.Create(FGradientType, FOrigin,FXAxis,ComputedYAxis); + + grad.SetGradient(colors, true); + grad.Transform := AMatrix; + + exit(grad); +end; + +procedure TBGRALayerGradientOriginal.ConfigureEditor( + AEditor: TBGRAOriginalEditor); +var + originPoint: Integer; +begin + if not isEmptyPointF(FOrigin) then + begin + AEditor.AddStartMoveHandler(@OnStartMove); + + if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then + originPoint := AEditor.AddPoint((FOrigin + FXAxis)*0.5, @OnMoveOrigin, true) + else originPoint := AEditor.AddPoint(FOrigin, @OnMoveOrigin, true); + + if not isEmptyPointF(FXAxis) then + begin + if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then + begin + AEditor.AddArrow((FOrigin + FXAxis)*0.5, FXAxis, @OnMoveXAxis); + AEditor.AddArrow((FOrigin + FXAxis)*0.5, FOrigin, @OnMoveXAxisNeg); + end + else AEditor.AddArrow(FOrigin, FXAxis, @OnMoveXAxis); + + if FGradientType in[gtDiamond, gtRadial, gtAngular] then + AEditor.AddArrow(FOrigin, ComputedYAxis, @OnMoveYAxis); + end; + if FGradientType = gtRadial then + begin + AEditor.AddPoint(ComputedFocalPoint, @OnMoveFocalPoint, false, originPoint); + AEditor.AddArrow(ComputedFocalPoint, ComputedFocalPoint - (FXAxis - FOrigin) * (ComputedFocalRadius + 0.1), @OnMoveFocalRadius, false); + end; + end; +end; + +function TBGRALayerGradientOriginal.GetRenderBounds(ADestRect: TRect; + AMatrix: TAffineMatrix): TRect; +begin + result := ADestRect; +end; + +procedure TBGRALayerGradientOriginal.LoadFromStorage( + AStorage: TBGRACustomOriginalStorage); +var + colorArray: ArrayOfTBGRAPixel; +begin + colorArray := AStorage.ColorArray['colors']; + + FStartColor := colorArray[0]; + FEndColor := colorArray[high(colorArray)]; + + case AStorage.RawString['gradient-type'] of + 'reflected': FGradientType := gtReflected; + 'radial': FGradientType := gtRadial; + 'diamond': FGradientType := gtDiamond; + 'angular': FGradientType := gtAngular; + else {'linear'} FGradientType := gtLinear; + end; + + FOrigin := AStorage.PointF['origin']; + FXAxis := AStorage.PointF['x-axis']; + FYAxis := AStorage.PointF['y-axis']; + FFocalPoint := AStorage.PointF['focal-point']; + + FRadius := AStorage.Float['radial']; + FFocalRadius := AStorage.Float['focal-radius']; + + case AStorage.RawString['color-interpolation'] of + 'RGB': FColorInterpolation:= ciLinearRGB; + 'HSL+': FColorInterpolation:= ciLinearHSLPositive; + 'HSL-': FColorInterpolation:= ciLinearHSLNegative; + 'GSB+': FColorInterpolation:= ciGSBPositive; + 'GSB-': FColorInterpolation:= ciGSBNegative; + else {'sRGB'} FColorInterpolation:= ciStdRGB; + end; + + case AStorage.RawString['repetition'] of + 'repeat': FRepetition:= grRepeat; + 'reflect': FRepetition:= grReflect; + 'sine': FRepetition := grSine; + else {'pad'} FRepetition:= grPad; + end; +end; + +procedure TBGRALayerGradientOriginal.SaveToStorage( + AStorage: TBGRACustomOriginalStorage); +var + gtStr, ciStr: String; + colorArray: ArrayOfTBGRAPixel; +begin + setlength(colorArray,2); + colorArray[0] := FStartColor; + colorArray[1] := FEndColor; + AStorage.ColorArray['colors'] := colorArray; + + case FGradientType of + gtReflected: gtStr := 'reflected'; + gtRadial: gtStr := 'radial'; + gtDiamond: gtStr := 'diamond'; + gtAngular: gtStr := 'angular'; + else {gtLinear} gtStr := 'linear'; + end; + AStorage.RawString['gradient-type'] := gtStr; + + AStorage.PointF['origin'] := FOrigin; + AStorage.PointF['x-axis'] := FXAxis; + + if FGradientType in[gtRadial,gtDiamond,gtAngular] then + AStorage.PointF['y-axis'] := FYAxis + else + AStorage.RemoveAttribute('y-axis'); + + if FGradientType = gtRadial then + begin + AStorage.Float['radius'] := FRadius; + AStorage.Float['focal-radius'] := FFocalRadius; + AStorage.PointF['focal-point'] := FFocalPoint; + end else + begin + AStorage.RemoveAttribute('radius'); + AStorage.RemoveAttribute('focal-radius'); + end; + + case FColorInterpolation of + ciLinearRGB: ciStr := 'RGB'; + ciLinearHSLPositive: ciStr := 'HSL+'; + ciLinearHSLNegative: ciStr := 'HSL-'; + ciGSBPositive: ciStr := 'GSB+'; + ciGSBNegative: ciStr := 'GSB-'; + else {ciStdRGB} ciStr := 'sRGB'; + end; + AStorage.RawString['color-interpolation'] := ciStr; + + case FRepetition of + grRepeat: AStorage.RawString['repetition'] := 'repeat'; + grReflect: AStorage.RawString['repetition'] := 'reflect'; + grSine: AStorage.RawString['repetition'] := 'sine'; + else {grPad} AStorage.RawString['repetition'] := 'pad'; + end; +end; + +class function TBGRALayerGradientOriginal.StorageClassName: RawByteString; +begin + result := 'gradient'; +end; + +class function TBGRALayerGradientOriginal.CanConvertToSVG: boolean; +begin + Result:= true; +end; + +procedure TBGRALayerGradientOriginal.Transform(AMatrix: TAffineMatrix); +begin + BeginUpdate; + if not isEmptyPointF(FOrigin) then FOrigin := AMatrix*FOrigin; + if not isEmptyPointF(FXAxis) then FXAxis := AMatrix*FXAxis; + if not isEmptyPointF(FYAxis) then FYAxis := AMatrix*FYAxis; + if not isEmptyPointF(FFocalPoint) then FFocalPoint := AMatrix*FFocalPoint; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.AssignExceptGeometry( + AOther: TBGRALayerGradientOriginal); +begin + if (GradientType = AOther.GradientType) and + (StartColor.EqualsExactly(AOther.StartColor)) and + (EndColor.EqualsExactly(AOther.EndColor)) and + (ColorInterpolation = AOther.ColorInterpolation) and + (Repetition = AOther.Repetition) then exit; + BeginUpdate; + GradientType := AOther.GradientType; + StartColor:= AOther.StartColor; + EndColor:= AOther.EndColor; + ColorInterpolation:= AOther.ColorInterpolation; + Repetition:= AOther.Repetition; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.FitGeometry(const ABox: TAffineBox); +begin + BeginUpdate; + if GradientType = gtLinear then + begin + Origin := ABox.TopLeft; + XAxis := ABox.BottomRight; + end else + begin + Origin := (ABox.TopLeft + ABox.BottomRight)*0.5; + if GradientType = gtReflected then + XAxis := ABox.BottomRight + else + begin + XAxis := (ABox.TopRight + ABox.BottomRight)*0.5; + YAxis := (ABox.BottomLeft + ABox.BottomRight)*0.5; + end; + end; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.SetColors(AStartColor, + AEndColor: TBGRAPixel); +begin + if (AStartColor = StartColor) and (AEndColor = EndColor) then exit; + BeginUpdate; + StartColor := AStartColor; + EndColor := AEndColor; + EndUpdate; +end; + +procedure TBGRALayerGradientOriginal.ApplyOpacity(AOpacity: byte); +var + cStart, cEnd: TBGRAPixel; +begin + cStart := StartColor; + cStart.alpha := BGRABlend.ApplyOpacity(cStart.alpha, AOpacity); + cEnd := EndColor; + cEnd.alpha := BGRABlend.ApplyOpacity(cEnd.alpha, AOpacity); + SetColors(cStart, cEnd); +end; + +function TBGRALayerGradientOriginal.Equals(Obj: TObject): boolean; +var + other: TBGRALayerGradientOriginal; +begin + if Obj is TBGRALayerGradientOriginal then + begin + other := TBGRALayerGradientOriginal(Obj); + result := StartColor.EqualsExactly(other.StartColor) and + EndColor.EqualsExactly(other.EndColor) and + (GradientType = other.GradientType) and + (Origin = other.Origin) and + (XAxis = other.XAxis) and + ((GradientType in[gtLinear, gtReflected]) or + (YAxis = other.YAxis)) and + ((GradientType <> gtRadial) or + ((FocalPoint = other.FocalPoint) and + (FocalRadius = other.FocalRadius))) and + (ColorInterpolation = other.ColorInterpolation) and + (Repetition = other.Repetition); + end else + Result:=inherited Equals(Obj); +end; + +initialization + + RegisterLayerOriginal(TBGRALayerGradientOriginal); + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragradients.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragradients.pas new file mode 100644 index 0000000..b6d5fb7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragradients.pas @@ -0,0 +1,1215 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGradients; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} +{$i bgrasse.inc} + +interface + +{ Here are various functions that draw gradients, shadow and lighting } + +uses + BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRABitmap, BGRABlend, BGRAPhongTypes, + BGRASSE, BGRAGrayscaleMask; + +{$IFDEF BGRABITMAP_USE_LCL}{ Creates a bitmap with the specified text horizontally centered and with a shadow } +function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; + AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True): TBGRABitmap; +{$ENDIF} + +{----------------------------------------------------------------------} +{ Functions to draw multiple gradients. + See : http://wiki.lazarus.freepascal.org/Double_Gradient#nGradient } +type + TnGradientInfo = record + StartColor,StopColor: TBGRAPixel; + Direction: TGradientDirection; + EndPercent : single; // Position from 0 to 1 + end; + +function nGradientInfo(StartColor, StopColor: TBGRAPixel; Direction: TGradientDirection; EndPercent: Single): TnGradientInfo; + +function nGradientAlphaFill(ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo): TBGRABitmap; overload; +function nGradientAlphaFill(AWidth, AHeight: Integer; ADir: TGradientDirection; const AGradient: array of TnGradientInfo): TBGRABitmap; overload; +procedure nGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo); overload; +procedure nGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo); overload; + +function DoubleGradientAlphaFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; + ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; overload; +function DoubleGradientAlphaFill(AWidth,AHeight: Integer; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; + ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; overload; +procedure DoubleGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; + ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single); overload; +procedure DoubleGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; + ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single); overload; + +{----------------------------------------------------------------------} +{ Phong shading functions. Use a height map (grayscale image or a precise map filled with MapHeightToBGRA) + to determine orientation and position of the surface. + + Phong shading consist in adding an ambiant light, a diffuse light (angle between light and object), + and a specular light (angle between light, object and observer, i.e. reflected light) } + +type + TRectangleMapOption = (rmoNoLeftBorder,rmoNoTopBorder,rmoNoRightBorder,rmoNoBottomBorder,rmoLinearBorder); + TRectangleMapOptions = set of TRectangleMapOption; + + { TPhongShading } + + TPhongShading = class(TCustomPhongShading) + public + LightSourceIntensity : Single; //global intensity of the light + + LightSourceDistanceTerm, //minimum distance always added (positive value) + LightSourceDistanceFactor, //how much actual distance is taken into account (usually 0 or 1) + LightDestFactor : Single; //how much the location of the lightened pixel is taken into account (usually 0 or 1) + + LightColor: TBGRAPixel; //color of the light reflection + + SpecularFactor, //how much light is reflected (0..1) + SpecularIndex : Single; //how concentrated reflected light is (positive value) + + AmbientFactor, //ambiant lighting whereever the point is (0..1) + DiffusionFactor, //diffusion, i.e. how much pixels are lightened by light source (0..1) + NegativeDiffusionFactor : Single; //how much hidden surface are darkened (0..1) + DiffuseSaturation: Boolean; //when diffusion saturates, use light color to show it + + constructor Create; + + { Render the specified map on the destination bitmap with one solid color. Map altitude + indicate the global height of the map. } + procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + Color : TBGRAPixel); override; + + { Render with a color map of the same size as the height map. Map altitude + indicate the global height of the map. } + procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorMap : TBGRACustomBitmap); override; + + { Render with a color scanner. Map altitude + indicate the global height of the map. } + procedure DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorScan : IBGRAScanner); override; + + { Draw a cone of the specified color } + procedure DrawCone(dest: TBGRACustomBitmap; X,Y,Size: Integer; Altitude: Single; Color: TBGRAPixel); overload; + procedure DrawCone(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); overload; + + { Draw a vertical cone of the specified color } + procedure DrawVerticalCone(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); + + { Draw an horizontal cylinder of the specified color } + procedure DrawHorizontalCylinder(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); + + { Draw a vertical cylinder of the specified color } + procedure DrawVerticalCylinder(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); + + { Draw a hemisphere of the specified color } + procedure DrawSphere(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); + + { Draw a rectangle of the specified color } + procedure DrawRectangle(dest: TBGRACustomBitmap; bounds: TRect; Border: Integer; Altitude: Single; Color: TBGRAPixel; RoundCorners: Boolean; Options: TRectangleMapOptions); + + protected + + procedure DrawMapNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorMap : TBGRACustomBitmap); + procedure DrawScannerNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorScan : IBGRAScanner); + procedure DrawColorNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + Color : TBGRAPixel); + + {$ifdef BGRASSE_AVAILABLE} + procedure DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorMap : TBGRACustomBitmap); + procedure DrawScannerSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorScan : IBGRAScanner); + procedure DrawColorSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + Color : TBGRAPixel); + {$endif} + end; + +{ Create a grayscale height map for a cone (may not be precise enough) } +function CreateConeMap(size: integer): TBGRABitmap; + +{ Create a precise height map for a cone (not grayscale anymore but more precise) } +function CreateConePreciseMap(width,height: integer): TBGRABitmap; + +{ Create a precise height map for a vertical cone (not grayscale anymore but more precise) } +function CreateVerticalConePreciseMap(width,height: integer): TBGRABitmap; + +{ Create a precise height map for a vertical cylinder (not grayscale anymore but more precise) } +function CreateVerticalCylinderPreciseMap(width,height: integer): TBGRABitmap; + +{ Create a precise height map for an horizontal cylinder (not grayscale anymore but more precise) } +function CreateHorizontalCylinderPreciseMap(width,height: integer): TBGRABitmap; + +{ Create a grayscale height map for a sphere (may not be precise enough) } +function CreateSphereMap(width,height: integer): TBGRABitmap; + +{ Create a precise height map for a sphere (not grayscale anymore but more precise) } +function CreateSpherePreciseMap(width,height: integer): TBGRABitmap; + +{ Create a rectangle height map with a border } +function CreateRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; + +{ Create a precise height map for a rectangle height map with a border (not grayscale anymore but more precise) } +function CreateRectanglePreciseMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; +function CreateRectanglePreciseMap(width, height, borderWidth, borderHeight: integer; options: TRectangleMapOptions): TBGRABitmap; + +{ Create a round rectangle height map with a border } +function CreateRoundRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; + +{ Create a precise height map for a round rectangle height map with a border (not grayscale anymore but more precise) } +function CreateRoundRectanglePreciseMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; +function CreateRoundRectanglePreciseMap(width,height,borderWidth,borderHeight: integer; options: TRectangleMapOptions = []): TBGRABitmap; + +{---------- Perlin Noise -------------} +{ Random image using a superposition of interpolated random values. + See : http://wiki.lazarus.freepascal.org/Perlin_Noise + http://freespace.virgin.net/hugo.elias/models/m_perlin.htm } + +{ Creates a non-tilable random grayscale image } +function CreatePerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; + VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; + +{ Creates a tilable random grayscale image } +function CreateCyclicPerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; + VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; + +implementation + +uses Math, SysUtils{$IFDEF BGRABITMAP_USE_LCL}, BGRATextFX{$ENDIF}; {GraphType unit used by phongdraw.inc} + +{$IFDEF BGRABITMAP_USE_LCL}function TextShadow(AWidth, AHeight: Integer; AText: String; + AFontHeight: Integer; ATextColor, AShadowColor: TBGRAPixel; AOffSetX, + AOffSetY: Integer; ARadius: Integer; AFontStyle: TFontStyles; + AFontName: String; AShowText: Boolean): TBGRABitmap; +begin + result := BGRATextFX.TextShadow(AWidth,AHeight,AText,AFontHeight,ATextColor,AShadowColor,AOffsetX,AOffsetY,ARadius,AFontStyle,AFontName,AShowText) as TBGRABitmap; +end;{$ENDIF} + +function nGradientInfo(StartColor, StopColor: TBGRAPixel; + Direction: TGradientDirection; EndPercent: Single): TnGradientInfo; +begin + result.StartColor := StartColor; + result.StopColor := StopColor; + result.Direction := Direction; + result.EndPercent := EndPercent; +end; + +function DoubleGradientAlphaFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; + ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; +var + ABitmap: TBGRABitmap; + ARect1,ARect2: TRect; + APoint1,APoint2,APoint3,APoint4: TPointF; +begin + Dec(ARect.Right, ARect.Left); + ARect.Left := 0; + Dec(ARect.Bottom,ARect.Top); + ARect.Top := 0; + + ABitmap := TBGRABitmap.Create(ARect.Right,ARect.Bottom); + + if AValue <> 0 then ARect1:=ARect; + if AValue <> 1 then ARect2:=ARect; + + if ADir = gdVertical then begin + ARect1.Bottom:=Round(ARect1.Bottom * AValue); + ARect2.Top:=ARect1.Bottom; + end + else if ADir = gdHorizontal then begin + ARect1.Right:=Round(ARect1.Right * AValue); + ARect2.Left:=ARect1.Right; + end; + if ADirection1 = gdVertical then begin + APoint1:=PointF(ARect1.Left,ARect1.Top); + APoint2:=PointF(ARect1.Left,ARect1.Bottom); + end + else if ADirection1 = gdHorizontal then begin + APoint1:=PointF(ARect1.Left,ARect1.Top); + APoint2:=PointF(ARect1.Right,ARect1.Top); + end; + if ADirection2 = gdVertical then begin + APoint3:=PointF(ARect2.Left,ARect2.Top); + APoint4:=PointF(ARect2.Left,ARect2.Bottom); + end + else if ADirection2 = gdHorizontal then begin + APoint3:=PointF(ARect2.Left,ARect2.Top); + APoint4:=PointF(ARect2.Right,ARect2.Top); + end; + + if AValue <> 0 then + ABitmap.GradientFill(ARect1.Left,ARect1.Top,ARect1.Right,ARect1.Bottom, + AStart1,AStop1,gtLinear,APoint1,APoint2,dmSet,True); + if AValue <> 1 then + ABitmap.GradientFill( ARect2.Left,ARect2.Top,ARect2.Right,ARect2.Bottom, + AStart2,AStop2,gtLinear,APoint3,APoint4,dmSet,True); + + Result:=ABitmap; +end; + +function DoubleGradientAlphaFill(AWidth, AHeight: Integer; AStart1, AStop1, + AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, + ADir: TGradientDirection; AValue: Single): TBGRABitmap; +begin + result := DoubleGradientAlphaFill(Rect(0,0,AWidth,AHeight), + AStart1,AStop1,AStart2,AStop2, + ADirection1,ADirection2, ADir, AValue); +end; + +procedure DoubleGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; AStart1, + AStop1, AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, + ADir: TGradientDirection; AValue: Single); +var + bmp: TBGRABitmap; +begin + bmp := DoubleGradientAlphaFill(ARect,AStart1,AStop1,AStart2,AStop2,ADirection1,ADirection2,ADir,AValue); + bmp.Draw(ACanvas,ARect.Left,ARect.Top,not bmp.HasTransparentPixels); + bmp.Free; +end; + +procedure DoubleGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; AStart1, + AStop1, AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, + ADir: TGradientDirection; AValue: Single); +var + bmp: TBGRABitmap; +begin + bmp := DoubleGradientAlphaFill(ARect,AStart1,AStop1,AStart2,AStop2,ADirection1,ADirection2,ADir,AValue); + ABitmap.PutImage(ARect.Left,ARect.Top,bmp,dmDrawWithTransparency); + bmp.Free; +end; + +function nGradientAlphaFill(ARect: TRect; ADir: TGradientDirection; + const AGradient: array of TnGradientInfo): TBGRABitmap; +var + i:integer; + AnRect, OldRect: TRect; + Point1, Point2: TPointF; +begin + Result := TBGRABitmap.Create(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + Dec(ARect.Right, ARect.Left); + ARect.Left := 0; + Dec(ARect.Bottom,ARect.Top); + ARect.Top := 0; + + OldRect := ARect; + + if ADir = gdVertical then + OldRect.Bottom := ARect.Top + else + OldRect.Right := ARect.Left; + + for i := 0 to high(AGradient) do + begin + AnRect:=OldRect; + if ADir = gdVertical then + begin + AnRect.Bottom:=Round((ARect.Bottom-ARect.Top) * AGradient[i].endPercent + ARect.Top); + AnRect.Top:=OldRect.Bottom; + Point1:=PointF(AnRect.Left,AnRect.Top); + Point2:=PointF(AnRect.Left,AnRect.Bottom); + end + else + begin + AnRect.Right:=Round((ARect.Right-ARect.Left) * AGradient[i].endPercent + ARect.Left); + AnRect.Left:=OldRect.Right; + Point1:=PointF(AnRect.Left,AnRect.Top); + Point2:=PointF(AnRect.Right,AnRect.Top); + end; + Result.GradientFill(AnRect.Left,AnRect.Top,AnRect.Right,AnRect.Bottom, + AGradient[i].StartColor,AGradient[i].StopColor,gtLinear,Point1,Point2,dmSet,True); + OldRect := AnRect; + end; +end; + +function nGradientAlphaFill(AWidth, AHeight: Integer; ADir: TGradientDirection; + const AGradient: array of TnGradientInfo): TBGRABitmap; +begin + result := nGradientAlphaFill(Rect(0,0,AWidth,AHeight),ADir,AGradient); +end; + +procedure nGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; + ADir: TGradientDirection; const AGradient: array of TnGradientInfo); +var + bmp: TBGRABitmap; +begin + bmp := nGradientAlphaFill(ARect, ADir, AGradient); + bmp.Draw(ACanvas,ARect.Left,ARect.Top,not bmp.HasTransparentPixels); + bmp.Free; +end; + +procedure nGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; + ADir: TGradientDirection; const AGradient: array of TnGradientInfo); +var + bmp: TBGRABitmap; +begin + bmp := nGradientAlphaFill(ARect, ADir, AGradient); + ABitmap.PutImage(ARect.Left,ARect.Top,bmp,dmDrawWithTransparency); + bmp.Free; +end; + +{ TPhongShading } + +constructor TPhongShading.Create; +begin + //set default values + LightSourceIntensity := 500; + LightSourceDistanceTerm := 150; + LightSourceDistanceFactor := 1; + LightDestFactor := 1; + LightColor := BGRAWhite; + AmbientFactor := 0.3; + DiffusionFactor := 0.9; + DiffuseSaturation:= False; + NegativeDiffusionFactor := 0.1; + SpecularFactor := 0.6; + SpecularIndex := 10; + LightPosition3D := Point3D(-100,-100,100); +end; + +Const + PhongLightPrecisionSh = 12; + PhongLightPrecision = 1 shl PhongLightPrecisionSh; + PhongLightPrecisionDiv2 = PhongLightPrecision shr 1; + +{------------------ Phong drawing ----------------} +{ Look for the fastest method available } +procedure TPhongShading.Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + Color : TBGRAPixel); +begin + {$ifdef BGRASSE_AVAILABLE} + if UseSSE then + DrawColorSSE(dest,map,mapAltitude,ofsX,ofsY,Color) + else + {$endif} + DrawColorNormal(dest,map,mapAltitude,ofsX,ofsY,Color); +end; + +procedure TPhongShading.Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); +begin + {$ifdef BGRASSE_AVAILABLE} + if UseSSE then + DrawMapSSE(dest,map,mapAltitude,ofsX,ofsY,ColorMap) + else + {$endif} + DrawMapNormal(dest,map,mapAltitude,ofsX,ofsY,ColorMap); +end; + +procedure TPhongShading.DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; ColorScan: IBGRAScanner); +begin + {$ifdef BGRASSE_AVAILABLE} + if UseSSE then + DrawScannerSSE(dest,map,mapAltitude,ofsX,ofsY,ColorScan) + else + {$endif} + DrawScannerNormal(dest,map,mapAltitude,ofsX,ofsY,ColorScan); +end; + + {------------------ End of phong drawing ----------------} + +procedure TPhongShading.DrawCone(dest: TBGRACustomBitmap; X, Y, Size: Integer; + Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; +begin + map := CreateConePreciseMap(Size,Size); + Draw(dest,map,Altitude,X,Y,Color); + map.Free; +end; + +procedure TPhongShading.DrawCone(dest: TBGRACustomBitmap; bounds: TRect; + Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + map := CreateConePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawVerticalCone(dest: TBGRACustomBitmap; + bounds: TRect; Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + map := CreateVerticalConePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawHorizontalCylinder(dest: TBGRACustomBitmap; + bounds: TRect; Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + map := CreateHorizontalCylinderPreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawVerticalCylinder(dest: TBGRACustomBitmap; + bounds: TRect; Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + map := CreateVerticalCylinderPreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawSphere(dest: TBGRACustomBitmap; bounds: TRect; + Altitude: Single; Color: TBGRAPixel); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + map := CreateSpherePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawRectangle(dest: TBGRACustomBitmap; bounds: TRect; + Border: Integer; Altitude: Single; Color: TBGRAPixel; RoundCorners: Boolean; Options: TRectangleMapOptions); +var map: TBGRABitmap; + temp: integer; +begin + if Bounds.Right < Bounds.Left then + begin + temp := Bounds.Left; + bounds.Left := bounds.Right; + Bounds.Right := temp; + end; + if Bounds.Bottom < Bounds.Top then + begin + temp := Bounds.Bottom; + bounds.Bottom := bounds.Top; + Bounds.Top := temp; + end; + if border > 10 then + begin + if RoundCorners then + map := CreateRoundRectanglePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options) + else + map := CreateRectanglePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options); + end else + begin + if RoundCorners then + map := CreateRoundRectangleMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options) + else + map := CreateRectangleMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options); + end; + Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); + map.Free; +end; + +procedure TPhongShading.DrawMapNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); + {$I phongdraw.inc } + +procedure TPhongShading.DrawColorNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; Color: TBGRAPixel); + {$define PARAM_SIMPLECOLOR} + {$I phongdraw.inc } + +procedure TPhongShading.DrawScannerNormal(dest: TBGRACustomBitmap; + map: TBGRACustomBitmap; mapAltitude: single; ofsX, ofsY: integer; + ColorScan: IBGRAScanner); + {$define PARAM_SCANNER} + {$I phongdraw.inc } + +{$ifdef BGRASSE_AVAILABLE} +procedure TPhongShading.DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); + {$define PARAM_PHONGSSE} + {$I phongdraw.inc } + +procedure TPhongShading.DrawColorSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; + mapAltitude: single; ofsX, ofsY: integer; Color: TBGRAPixel); + {$define PARAM_PHONGSSE} + {$define PARAM_SIMPLECOLOR} + {$I phongdraw.inc } + +procedure TPhongShading.DrawScannerSSE(dest: TBGRACustomBitmap; + map: TBGRACustomBitmap; mapAltitude: single; ofsX, ofsY: integer; + ColorScan: IBGRAScanner); + {$define PARAM_PHONGSSE} + {$define PARAM_SCANNER} + {$I phongdraw.inc } + +{$endif} + +{************************ maps ***********************************} + +function CreateConeMap(size: integer): TBGRABitmap; +var cx,cy,r: single; + mask: TGrayscaleMask; +begin + cx := (size-1)/2; + cy := (size-1)/2; + r := (size-1)/2; + result := TBGRABitmap.Create(size,size); + result.GradientFill(0,0,size,size,BGRAWhite,BGRABlack,gtRadial,PointF(cx,cy),PointF(cx+r,cy),dmSet,False); + + mask := TGrayscaleMask.Create(size,size,BGRABlack); + mask.FillEllipseAntialias(cx,cy,r,r,BGRAWhite); + result.ApplyMask(mask); + mask.Free; +end; + +function CreateConePreciseMap(width,height: integer): TBGRABitmap; +var cx,cy,rx,ry,d: single; + xb,yb: integer; + p: PBGRAPixel; + mask: TGrayscaleMask; +begin + result := TBGRABitmap.Create(width,height); + cx := (width-1)/2; + cy := (height-1)/2; + rx := (width-1)/2; + ry := (height-1)/2; + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); + if d >= 1 then + p^ := BGRAPixelTransparent else + p^ := MapHeightToBGRA(1-sqrt(d),255); + inc(p); + end; + end; + //antialiased border + mask := TGrayscaleMask.Create(width,height,BGRABlack); + mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); + result.ApplyMask(mask); + mask.Free; +end; + +function CreateVerticalConePreciseMap(width, height: integer): TBGRABitmap; +var cx,rx,d,vpos: single; + xb,yb: integer; + p: PBGRAPixel; + mask: TGrayscaleMask; +begin + result := TBGRABitmap.Create(width,height); + if (height=0) or (width=0) then exit; + cx := (width-1)/2; + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + vpos := (yb+1)/height; + rx := width/2*vpos; + for xb := 0 to width-1 do + begin + d := sqr((xb-cx)/(rx+1)); + if d >= 1 then + p^ := BGRAPixelTransparent else + p^ := MapHeightToBGRA(sqrt(1-d)*vpos,255); + inc(p); + end; + end; + //antialiased border + mask := TGrayscaleMask.Create(width,height,BGRABlack); + mask.FillPolyAntialias([PointF(width/2,-0.5),PointF(0,height-0.5),PointF(width-0.5,height-0.5)],BGRAWhite); + result.ApplyMask(mask); + mask.Free; +end; + +function CreateVerticalCylinderPreciseMap(width, height: integer): TBGRABitmap; +var cx,rx,d: single; + xb: integer; +begin + result := TBGRABitmap.Create(width,height); + if (height=0) or (width=0) then exit; + rx := width/2; + cx := (width-1)/2; + for xb := 0 to width-1 do + begin + d := sqr((xb-cx)/(rx+1)); + result.SetVertLine(xb,0,height-1,MapHeightToBGRA(sqrt(1-d),255)); + end; +end; + +function CreateHorizontalCylinderPreciseMap(width, height: integer + ): TBGRABitmap; +var cy,ry,d: single; + xb,yb: integer; + p: PBGRAPixel; + c: TBGRAPixel; +begin + result := TBGRABitmap.Create(width,height); + if (height=0) or (width=0) then exit; + ry := height/2; + cy := (height-1)/2; + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + d := sqr((yb-cy)/(ry+1)); + c := MapHeightToBGRA(sqrt(1-d),255); + for xb := 0 to width-1 do + begin + p^ := c; + inc(p); + end; + end; +end; + +function CreateSphereMap(width,height: integer): TBGRABitmap; +var cx,cy,rx,ry,d: single; + xb,yb: integer; + p: PBGRAPixel; + h: integer; + mask: TGrayscaleMask; +begin + result := TBGRABitmap.Create(width,height); + cx := (width-1)/2; + cy := (height-1)/2; + rx := (width-1)/2; + ry := (height-1)/2; + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); + if d >= 1 then + p^ := BGRAPixelTransparent else + begin + h := round(sqrt(1-d)*255); + p^.red := h; + p^.green := h; + p^.blue := h; + p^.alpha := 255; + end; + inc(p); + end; + end; + //antialiased border + mask := TGrayscaleMask.Create(width,height,BGRABlack); + mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); + result.ApplyMask(mask); + mask.Free; +end; + +procedure MapBorderLimit(width,height: integer; options: TRectangleMapOptions; var border: integer); +var maxHoriz,maxVert: integer; +begin + if [rmoNoLeftBorder,rmoNoRightBorder] <= options then maxHoriz := border else + if [rmoNoLeftBorder,rmoNoRightBorder] * options = [] then maxHoriz := width div 2 else + maxHoriz := width; + if border > maxHoriz then border := maxHoriz; + + if [rmoNoTopBorder,rmoNoBottomBorder] <= options then maxVert := border else + if [rmoNoTopBorder,rmoNoBottomBorder] * options = [] then maxVert := height div 2 else + maxVert := height; + if border > maxVert then border := maxVert; +end; + +procedure MapBorderLimit(width,height: integer; options: TRectangleMapOptions; var borderHoriz,borderVert: integer); +var maxHoriz,maxVert: integer; +begin + if [rmoNoLeftBorder,rmoNoRightBorder] <= options then maxHoriz := borderHoriz else + if [rmoNoLeftBorder,rmoNoRightBorder] * options = [] then maxHoriz := width div 2 else + maxHoriz := width; + if borderHoriz > maxHoriz then borderHoriz := maxHoriz; + + if [rmoNoTopBorder,rmoNoBottomBorder] <= options then maxVert := borderVert else + if [rmoNoTopBorder,rmoNoBottomBorder] * options = [] then maxVert := height div 2 else + maxVert := height; + if borderVert > maxVert then borderVert := maxVert; +end; + +function CreateSpherePreciseMap(width, height: integer): TBGRABitmap; +var cx,cy,rx,ry,d: single; + xb,yb: integer; + p: PBGRAPixel; + mask: TGrayscaleMask; +begin + result := TBGRABitmap.Create(width,height); + cx := (width-1)/2; + cy := (height-1)/2; + rx := (width-1)/2; + ry := (height-1)/2; + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); + if d >= 1 then + p^ := BGRAPixelTransparent else + p^ := MapHeightToBGRA(sqrt(1-d),255); + inc(p); + end; + end; + //antialiased border + mask := TGrayscaleMask.Create(width,height,BGRABlack); + mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); + result.ApplyMask(mask); + mask.Free; +end; + +procedure RectangleMapRemoveCorners(dest: TBGRABitmap; options: TRectangleMapOptions); +begin + if [rmoNoLeftBorder,rmoNoTopBorder]*Options = [] then + begin + dest.SetPixel(0,0,BGRAPixelTransparent); + dest.ErasePixel(1,0,128); + dest.ErasePixel(0,1,128); + end; + + if [rmoNoRightBorder,rmoNoTopBorder]*Options = [] then + begin + dest.SetPixel(dest.width-1,0,BGRAPixelTransparent); + dest.ErasePixel(dest.width-2,0,128); + dest.ErasePixel(dest.width-1,1,128); + end; + + if [rmoNoRightBorder,rmoNoBottomBorder]*Options = [] then + begin + dest.SetPixel(dest.width-1,dest.height-1,BGRAPixelTransparent); + dest.ErasePixel(dest.width-2,dest.height-1,128); + dest.ErasePixel(dest.width-1,dest.height-2,128); + end; + + if [rmoNoLeftBorder,rmoNoBottomBorder]*Options = [] then + begin + dest.SetPixel(0,dest.height-1,BGRAPixelTransparent); + dest.ErasePixel(1,dest.height-1,128); + dest.ErasePixel(0,dest.height-2,128); + end; +end; + +function CreateRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; +var xb,yb: integer; + p: PBGRAPixel; + h: integer; +begin + MapBorderLimit(width,height,options,border); + + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and (xb < border) and (yb > xb) and (yb < height-1-xb) then h := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) and (yb > width-1-xb) and (yb < height-1-(width-1-xb)) then h := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) and (xb > yb) and (xb < width-1-yb) then h := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) and (xb > height-1-yb) and (xb < width-1-(height-1-yb)) then h := height-1-yb else + if not (rmoNoLeftBorder in options) and (xb < border) then h := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) then h := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) then h := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) then h := height-1-yb else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + if rmoLinearBorder in options then h := h*256 div border else + h := round(sin((h+1/2)/border*Pi/2)*255); + p^.red := h; + p^.green := h; + p^.blue := h; + p^.alpha := 255; + inc(p); + end; + end; + + RectangleMapRemoveCorners(result,options); +end; + +function CreateRectanglePreciseMap(width, height, border: integer; + options: TRectangleMapOptions): TBGRABitmap; +var xb,yb: integer; + p: PBGRAPixel; + h: single; +begin + MapBorderLimit(width,height,options,border); + + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and (xb < border) and (yb > xb) and (yb < height-1-xb) then h := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) and (yb > width-1-xb) and (yb < height-1-(width-1-xb)) then h := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) and (xb > yb) and (xb < width-1-yb) then h := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) and (xb > height-1-yb) and (xb < width-1-(height-1-yb)) then h := height-1-yb else + if not (rmoNoLeftBorder in options) and (xb < border) then h := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) then h := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) then h := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) then h := height-1-yb else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + if rmoLinearBorder in options then h := h/border else + h := sin((h+1/2)/border*Pi/2); + + p^ := MapHeightToBGRA(h,255); + + inc(p); + end; + end; + + RectangleMapRemoveCorners(result,options); +end; + +function CreateRectanglePreciseMap(width, height, borderWidth, borderHeight: integer; + options: TRectangleMapOptions): TBGRABitmap; +var xb,yb, minBorder: integer; + p: PBGRAPixel; + h: single; + smallStep: single; +begin + MapBorderLimit(width,height,options,borderWidth,borderHeight); + + minBorder := min(borderWidth,borderHeight); + if minBorder > 0 then smallStep := 1/minBorder else smallStep:= 0; + + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and (xb < borderWidth) and (yb < borderHeight) then + h := min(xb/borderWidth, yb/borderHeight) else + if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) and (yb < borderHeight) then + h := min((width-1-xb)/borderWidth, yb/borderHeight) else + if not (rmoNoTopBorder in options) and (xb < borderWidth) and (yb > height-1-borderHeight) then + h := min(xb/borderWidth, (height-1-yb)/borderHeight) else + if not (rmoNoBottomBorder in options) and (xb > width-1-borderWidth) and (yb > height-1-borderHeight) then + h := min((width-1-xb)/borderWidth, (height-1-yb)/borderHeight) else + if not (rmoNoLeftBorder in options) and (xb < borderWidth) then h := xb/borderWidth else + if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) then h := (width-1-xb)/borderWidth else + if not (rmoNoTopBorder in options) and (yb < borderHeight) then h := yb/borderHeight else + if not (rmoNoBottomBorder in options) and (yb > height-1-borderHeight) then h := (height-1-yb)/borderHeight else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + if not (rmoLinearBorder in options) then + h := sin((h+smallStep*0.5)*Pi*0.5); + + p^ := MapHeightToBGRA(h,255); + + inc(p); + end; + end; + + RectangleMapRemoveCorners(result,options); +end; + +function CreateRoundRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; +var d: single; + xb,yb: integer; + p: PBGRAPixel; + h: integer; +begin + MapBorderLimit(width,height,options,border); + + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < border) and (yb < border) then d := border-sqrt(sqr(border-xb)+sqr(border-yb)) else + if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < border) and (yb > height-1-border) then d := border-sqrt(sqr(border-xb)+sqr(border-(height-1-yb))) else + if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-border) and (yb < border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-yb)) else + if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-border) and (yb > height-1-border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-(height-1-yb))) else + if not (rmoNoLeftBorder in options) and (xb < border) then d := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) then d := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) then d := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) then d := height-1-yb else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + d := (d+1)*border/(border+1); + + if d < 0 then + p^ := BGRAPixelTransparent else + begin + if rmoLinearBorder in options then h := trunc(d*256/border) else + h := round(sin((d+1/2)/border*Pi/2)*255); + + p^.red := h; + p^.green := h; + p^.blue := h; + if d < 1 then p^.alpha := round(d*255) else + p^.alpha := 255; + end; + inc(p); + end; + end; +end; + +function CreatePerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single; + VerticalPeriod: Single; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; + + procedure AddNoise(frequencyH, frequencyV: integer; amplitude: byte; dest: TBGRABitmap); + var small,resampled: TBGRABitmap; + p: PBGRAPixel; + i: Integer; + begin + if (frequencyH = 0) or (frequencyV = 0) then exit; + small := TBGRABitmap.Create(frequencyH,frequencyV); + p := small.data; + for i := 0 to small.NbPixels-1 do + begin + p^.red := random(amplitude); + p^.green := p^.red; + p^.blue := p^.green; + p^.alpha := 255; + inc(p); + end; + small.ResampleFilter := ResampleFilter; + resampled := small.Resample(dest.Width,dest.Height); + dest.BlendImage(0,0,resampled,boAdditive); + resampled.Free; + small.Free; + end; + +var + i: Integer; + temp: TBGRABitmap; + +begin + result := TBGRABitmap.Create(AWidth,AHeight); + for i := 0 to 5 do + AddNoise(round(AWidth / HorizontalPeriod / (32 shr i)),round(AHeight / VerticalPeriod / (32 shr i)), round(exp(ln((128 shr i)/128)*Exponent)*128),result); + + temp := result.FilterNormalize(False); + result.Free; + result := temp; + + temp := result.FilterBlurRadial(1,rbNormal); + result.Free; + result := temp; +end; + +function CreateCyclicPerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; + VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; + + procedure AddNoise(frequencyH, frequencyV: integer; amplitude: byte; dest: TBGRABitmap); + var small,cycled,resampled: TBGRABitmap; + p: PBGRAPixel; + i: Integer; + begin + if (frequencyH = 0) or (frequencyV = 0) then exit; + small := TBGRABitmap.Create(frequencyH,frequencyV); + p := small.data; + for i := 0 to small.NbPixels-1 do + begin + p^.red := random(amplitude); + p^.green := p^.red; + p^.blue := p^.green; + p^.alpha := 255; + inc(p); + end; + cycled := small.GetPart(rect(-2,-2,small.Width+2,small.Height+2)); + cycled.ResampleFilter := ResampleFilter; + resampled := cycled.Resample(round((cycled.Width-1)*(dest.Width/frequencyH)),round((cycled.Height-1)*(dest.Height/frequencyV))); + dest.BlendImage(round(-2*(dest.Width/frequencyH)),round(-2*(dest.Height/frequencyV)),resampled,boAdditive); + resampled.Free; + cycled.Free; + small.Free; + end; + +var + i: Integer; + temp: TBGRABitmap; + +begin + result := TBGRABitmap.Create(AWidth,AHeight); + for i := 0 to 5 do + AddNoise(round(AWidth / HorizontalPeriod / (32 shr i)),round(AHeight / VerticalPeriod / (32 shr i)), round(exp(ln((128 shr i)/128)*Exponent)*128),result); + + temp := result.FilterNormalize(False); + result.Free; + result := temp; + + temp := result.FilterBlurRadial(1,rbNormal); + result.Free; + result := temp; +end; + +function CreateRoundRectanglePreciseMap(width, height, border: integer; + options: TRectangleMapOptions): TBGRABitmap; +var d: single; + xb,yb: integer; + p: PBGRAPixel; + h: single; +begin + MapBorderLimit(width,height,options,border); + + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < border) and (yb < border) then d := border-sqrt(sqr(border-xb)+sqr(border-yb)) else + if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < border) and (yb > height-1-border) then d := border-sqrt(sqr(border-xb)+sqr(border-(height-1-yb))) else + if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-border) and (yb < border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-yb)) else + if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-border) and (yb > height-1-border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-(height-1-yb))) else + if not (rmoNoLeftBorder in options) and (xb < border) then d := xb else + if not (rmoNoRightBorder in options) and (xb > width-1-border) then d := width-1-xb else + if not (rmoNoTopBorder in options) and (yb < border) then d := yb else + if not (rmoNoBottomBorder in options) and (yb > height-1-border) then d := height-1-yb else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + d := (d+1)*border/(border+1); + + if d < 0 then + p^ := BGRAPixelTransparent else + begin + if rmoLinearBorder in options then h := d/border else + h := sin((d+1/2)/border*Pi/2); + + if d < 1 then p^:= MapHeightToBGRA(h,round(d*255)) else + p^ := MapHeightToBGRA(h,255); + end; + inc(p); + end; + end; +end; + +function CreateRoundRectanglePreciseMap(width, height, borderWidth, + borderHeight: integer; options: TRectangleMapOptions): TBGRABitmap; +var d: single; + xb,yb: integer; + p: PBGRAPixel; + h,smallStep,factor: single; + minBorder: integer; +begin + MapBorderLimit(width,height,options,borderWidth,borderHeight); + + minBorder := min(borderWidth,borderHeight); + if minBorder > 0 then smallStep := 1/minBorder else smallStep:= 0; + factor := minBorder/(minBorder+1); + result := TBGRABitmap.Create(width,height); + for yb := 0 to height-1 do + begin + p := result.scanline[yb]; + for xb := 0 to width-1 do + begin + if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < borderWidth) and (yb < borderHeight) then + d := 1-sqrt(sqr((borderWidth-xb)/borderWidth)+sqr((borderHeight-yb)/borderHeight)) else + if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < borderWidth) and (yb > height-1-borderHeight) then + d := 1-sqrt(sqr((borderWidth-xb)/borderWidth)+sqr((borderHeight-(height-1-yb))/borderHeight)) else + if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-borderWidth) and (yb < borderHeight) then + d := 1-sqrt(sqr((borderWidth-(width-1-xb))/borderWidth)+sqr((borderHeight-yb)/borderHeight)) else + if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-borderWidth) and (yb > height-1-borderHeight) then + d := 1-sqrt(sqr((borderWidth-(width-1-xb))/borderWidth)+sqr((borderHeight-(height-1-yb))/borderHeight)) else + if not (rmoNoLeftBorder in options) and (xb < borderWidth) then d := xb/borderWidth else + if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) then d := (width-1-xb)/borderWidth else + if not (rmoNoTopBorder in options) and (yb < borderHeight) then d := yb/borderHeight else + if not (rmoNoBottomBorder in options) and (yb > height-1-borderHeight) then d := (height-1-yb)/borderHeight else + begin + p^ := BGRAWhite; + inc(p); + Continue; + end; + + d := (d + smallStep)*factor; + + if d < 0 then + p^ := BGRAPixelTransparent else + begin + if rmoLinearBorder in options then h := d else + h := sin((d+smallStep*0.5)*Pi*0.5); + + if d < smallStep then p^:= MapHeightToBGRA(h,round(d/smallStep*255)) else + p^ := MapHeightToBGRA(h,255); + end; + inc(p); + end; + end; +end; + +initialization + + Randomize; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragradientscanner.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragradientscanner.pas new file mode 100644 index 0000000..31bbdd4 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragradientscanner.pas @@ -0,0 +1,2192 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGradientScanner; + +{$mode objfpc}{$H+} + +interface + +{ This unit contains scanners that generate gradients } + +uses + SysUtils, BGRABitmapTypes, BGRATransform; + +type + TBGRAColorInterpolation = (ciStdRGB, ciLinearRGB, ciLinearHSLPositive, ciLinearHSLNegative, ciGSBPositive, ciGSBNegative); + TBGRAGradientRepetition = (grPad, grRepeat, grReflect, grSine); + + { TBGRASimpleGradient } + + TBGRASimpleGradient = class(TBGRACustomGradient) + protected + FColor1,FColor2: TBGRAPixel; + ec1,ec2: TExpandedPixel; + FRepetition: TBGRAGradientRepetition; + function InterpolateToBGRA(position: word): TBGRAPixel; virtual; abstract; + function InterpolateToExpanded(position: word): TExpandedPixel; virtual; abstract; + public + class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload; static; + class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload; static; + constructor Create(AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); overload; //do not call directly + constructor Create(AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); overload; //do not call directly + function GetColorAt(position: integer): TBGRAPixel; override; + function GetColorAtF(position: single): TBGRAPixel; override; + function GetExpandedColorAt(position: integer): TExpandedPixel; override; + function GetExpandedColorAtF(position: single): TExpandedPixel; override; + function GetAverageColor: TBGRAPixel; override; + function GetAverageExpandedColor: TExpandedPixel; override; + function GetMonochrome: boolean; override; + property Repetition: TBGRAGradientRepetition read FRepetition write FRepetition; + end; + + { TBGRASimpleGradientWithoutGammaCorrection } + + TBGRASimpleGradientWithoutGammaCorrection = class(TBGRASimpleGradient) + protected + function InterpolateToBGRA(position: word): TBGRAPixel; override; + function InterpolateToExpanded(position: word): TExpandedPixel; override; + public + constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; + constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; + end; + + { TBGRASimpleGradientWithGammaCorrection } + + TBGRASimpleGradientWithGammaCorrection = class(TBGRASimpleGradient) + protected + function InterpolateToBGRA(position: word): TBGRAPixel; override; + function InterpolateToExpanded(position: word): TExpandedPixel; override; + public + constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; + constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; + end; + + THueGradientOption = (hgoRepeat, hgoReflect, //repetition + hgoPositiveDirection, hgoNegativeDirection, //hue orientation + hgoHueCorrection, hgoLightnessCorrection); //color interpolation + THueGradientOptions = set of THueGradientOption; + + { TBGRAHueGradient } + + TBGRAHueGradient = class(TBGRASimpleGradient) + private + hsla1,hsla2: THSLAPixel; + hue1,hue2: LongWord; + FOptions: THueGradientOptions; + procedure Init(c1,c2: THSLAPixel; AOptions: THueGradientOptions); + function InterpolateToHSLA(position: word): THSLAPixel; + protected + function InterpolateToBGRA(position: word): TBGRAPixel; override; + function InterpolateToExpanded(position: word): TExpandedPixel; override; + public + constructor Create(Color1,Color2: TBGRAPixel; options: THueGradientOptions); overload; + constructor Create(Color1,Color2: TExpandedPixel; options: THueGradientOptions); overload; + constructor Create(Color1,Color2: THSLAPixel; options: THueGradientOptions); overload; + constructor Create(AHue1,AHue2: Word; Saturation,Lightness: Word; options: THueGradientOptions); overload; + function GetMonochrome: boolean; override; + end; + + TGradientInterpolationFunction = function(t: single): single of object; + + { TBGRAMultiGradient } + + TBGRAMultiGradient = class(TBGRACustomGradient) + private + FColors: array of TBGRAPixel; + FPositions: array of integer; + FPositionsF: array of single; + FEColors: array of TExpandedPixel; + FCycle: Boolean; + FInterpolationFunction: TGradientInterpolationFunction; + procedure Init(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection, ACycle: boolean); + public + GammaCorrection: boolean; + function CosineInterpolation(t: single): single; + function HalfCosineInterpolation(t: single): single; + constructor Create(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean = false); + function GetColorAt(position: integer): TBGRAPixel; override; + function GetExpandedColorAt(position: integer): TExpandedPixel; override; + function GetAverageColor: TBGRAPixel; override; + function GetMonochrome: boolean; override; + property InterpolationFunction: TGradientInterpolationFunction read FInterpolationFunction write FInterpolationFunction; + end; + + { TBGRABufferedGradient } + + TBGRABufferedGradient = class(TBGRACustomGradient) + protected + FGradient: TBGRACustomGradient; + FGradientOwned: boolean; + FPadded: boolean; + FAverageColorComputed: boolean; + FAverageColorExpanded: TExpandedPixel; + FMonochromeComputed: boolean; + FMonochrome: boolean; + FBufferSize, FBufferShift: integer; + FColorTab: array of TBGRAPixel; + FColorComputed: bitpacked array[0..65535] of boolean; + FRepetition: TBGRAGradientRepetition; + public + constructor Create(AGradient: TBGRACustomGradient; AOwner: boolean; APadded: boolean; + ABufferSize: integer); + destructor Destroy; override; + {** Returns the color at a given ''position''. The reference range is + from 0 to 65535, however values beyond are possible as well } + function GetColorAt(position: integer): TBGRAPixel; override; + {** Returns the average color of the gradient } + function GetAverageColor: TBGRAPixel; override; + function GetAverageExpandedColor: TExpandedPixel; override; + function GetMonochrome: boolean; override; + end; + + TBGRAGradientScannerInternalScanNextFunc = function():single of object; + TBGRAGradientScannerInternalScanAtFunc = function(const p: TPointF):single of object; + + { TBGRAGradientScanner } + + TBGRAGradientScanner = class(TBGRACustomScanner) + protected + FGradientType: TGradientType; + FOrigin,FDir1,FDir2: TPointF; + FRelativeFocal: TPointF; + FRadius, FFocalRadius: single; + FTransform, FHiddenTransform: TAffineMatrix; + FSinus: Boolean; + FGradient: TBGRACustomGradient; + FGradientOwner: boolean; + FFlipGradient: boolean; + + FMatrix: TAffineMatrix; + FRepeatHoriz, FIsAverage: boolean; + FAverageColor: TBGRAPixel; + FAverageExpandedColor: TExpandedPixel; + FScanNextFunc: TBGRAGradientScannerInternalScanNextFunc; + FScanAtFunc: TBGRAGradientScannerInternalScanAtFunc; + FGetGradientColor: TBGRAGradientGetColorAtFloatFunc; + FGetGradientExpandedColor: TBGRAGradientGetExpandedColorAtFloatFunc; + FFocalDistance: single; + FFocalDirection, FFocalNormal: TPointF; + FRadialDenominator, FRadialDeltaSign, maxW1, maxW2: single; + + FPosition: TPointF; + FHorizColor: TBGRAPixel; + FHorizExpandedColor: TExpandedPixel; + + procedure Init(AGradientType: TGradientType; AOrigin, d1: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload; + procedure Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload; + procedure Init(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix); overload; + + procedure InitGradientType; + procedure InitTransform; + procedure InitGradient; + + function ComputeRadialFocal(const p: TPointF): single; + + function ScanNextLinear: single; + function ScanNextReflected: single; + function ScanNextDiamond: single; + function ScanNextRadial: single; + function ScanNextRadial2: single; + function ScanNextRadialFocal: single; + function ScanNextAngular: single; + + function ScanAtLinear(const p: TPointF): single; + function ScanAtReflected(const p: TPointF): single; + function ScanAtDiamond(const p: TPointF): single; + function ScanAtRadial(const p: TPointF): single; + function ScanAtRadial2(const p: TPointF): single; + function ScanAtRadialFocal(const p: TPointF): single; + function ScanAtAngular(const p: TPointF): single; + + function ScanNextInline: TBGRAPixel; inline; + function ScanNextExpandedInline: TExpandedPixel; inline; + procedure SetTransform(AValue: TAffineMatrix); + procedure SetFlipGradient(AValue: boolean); + procedure SetSinus(AValue: boolean); + function GetGradientColor(a: single): TBGRAPixel; + function GetGradientExpandedColor(a: single): TExpandedPixel; + function GetGradientColorFlipped(a: single): TBGRAPixel; + function GetGradientExpandedColorFlipped(a: single): TExpandedPixel; + function GetGradientColorSinus(a: single): TBGRAPixel; + function GetGradientExpandedColorSinus(a: single): TExpandedPixel; + procedure UpdateGetGradientColorFunctions; + public + constructor Create(AGradientType: TGradientType; AOrigin, d1: TPointF); overload; + constructor Create(AGradientType: TGradientType; AOrigin, d1, d2: TPointF); overload; + constructor Create(AOrigin, d1, d2, AFocal: TPointF; ARadiusRatio: single = 1; AFocalRadiusRatio: single = 0); overload; + constructor Create(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single); overload; + + constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1: TPointF; + gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload; + constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1, d2: TPointF; + gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload; + + constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1: TPointF; + Sinus: Boolean=False; AGradientOwner: Boolean=False); overload; + constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1, d2: TPointF; + Sinus: Boolean=False; AGradientOwner: Boolean=False); overload; + constructor Create(gradient: TBGRACustomGradient; AOrigin: TPointF; ARadius: single; AFocal: TPointF; + AFocalRadius: single; AGradientOwner: Boolean=False); overload; + + procedure SetGradient(c1,c2: TBGRAPixel; AGammaCorrection: boolean = true); overload; + procedure SetGradient(AGradient: TBGRACustomGradient; AOwner: boolean); overload; + destructor Destroy; override; + procedure ScanMoveTo(X, Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanNextExpandedPixel: TExpandedPixel; override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + function ScanAtExpanded(X, Y: Single): TExpandedPixel; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + function IsScanPutPixelsDefined: boolean; override; + property Transform: TAffineMatrix read FTransform write SetTransform; + property Gradient: TBGRACustomGradient read FGradient; + property FlipGradient: boolean read FFlipGradient write SetFlipGradient; + property Sinus: boolean Read FSinus write SetSinus; + end; + + { TBGRAConstantScanner } + + TBGRAConstantScanner = class(TBGRAGradientScanner) + constructor Create(c: TBGRAPixel); + end; + + { TBGRARandomScanner } + + TBGRARandomScanner = class(TBGRACustomScanner) + private + FOpacity: byte; + FGrayscale: boolean; + FRandomBuffer, FRandomBufferCount: integer; + public + constructor Create(AGrayscale: Boolean; AOpacity: byte); + function ScanAtInteger({%H-}X, {%H-}Y: integer): TBGRAPixel; override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt({%H-}X, {%H-}Y: Single): TBGRAPixel; override; + end; + + { TBGRAGradientTriangleScanner } + + TBGRAGradientTriangleScanner= class(TBGRACustomScanner) + protected + FMatrix: TAffineMatrix; + FColor1,FDiff2,FDiff3,FStep: TColorF; + FCurColor: TColorF; + public + constructor Create(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); + procedure ScanMoveTo(X,Y: Integer); override; + procedure ScanMoveToF(X,Y: Single); + function ScanAt(X,Y: Single): TBGRAPixel; override; + function ScanNextPixel: TBGRAPixel; override; + function ScanNextExpandedPixel: TExpandedPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + end; + + { TBGRASolidColorMaskScanner } + + TBGRASolidColorMaskScanner = class(TBGRACustomScanner) + private + FOffset: TPoint; + FMask: IBGRAScanner; + FSolidColor: TBGRAPixel; + public + constructor Create(AMask: IBGRAScanner; AOffset: TPoint; ASolidColor: TBGRAPixel); + destructor Destroy; override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + procedure ScanMoveTo(X,Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X,Y: Single): TBGRAPixel; override; + property Color: TBGRAPixel read FSolidColor write FSolidColor; + end; + + { TBGRATextureMaskScanner } + + TBGRATextureMaskScanner = class(TBGRACustomScanner) + private + FOffset: TPoint; + FMask: IBGRAScanner; + FTexture: IBGRAScanner; + FTextureScanNext : TScanNextPixelFunction; + FTextureScanAt : TScanAtFunction; + FGlobalOpacity: Byte; + FMemTex: packed array of TBGRAPixel; + public + constructor Create(AMask: IBGRAScanner; AOffset: TPoint; ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255); + destructor Destroy; override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + procedure ScanMoveTo(X,Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X,Y: Single): TBGRAPixel; override; + end; + + { TBGRAOpacityScanner } + + TBGRAOpacityScanner = class(TBGRACustomScanner) + private + FTexture: IBGRAScanner; + FOwnedScanner: TBGRACustomScanner; + FGlobalOpacity: Byte; + FScanNext : TScanNextPixelFunction; + FScanAt : TScanAtFunction; + FMemTex: packed array of TBGRAPixel; + public + constructor Create(ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255); + constructor Create(ATexture: TBGRACustomScanner; AGlobalOpacity: Byte; AOwned: boolean); + destructor Destroy; override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + procedure ScanMoveTo(X,Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X,Y: Single): TBGRAPixel; override; + end; + +implementation + +uses BGRABlend, Math; + +{ TBGRABufferedGradient } + +constructor TBGRABufferedGradient.Create(AGradient: TBGRACustomGradient; + AOwner: boolean; APadded: boolean; ABufferSize: integer); +var + bufferPowSize: integer; +begin + FGradient := AGradient; + FGradientOwned:= AOwner; + FPadded := APadded; + bufferPowSize := 0; + while ABufferSize > 1 do + begin + ABufferSize := ABufferSize shr 1; + inc(bufferPowSize); + end; + if bufferPowSize > 16 then bufferPowSize := 16; + FBufferSize:= 1 shl bufferPowSize; + setlength(FColorTab, FBufferSize); + FBufferShift := 16-bufferPowSize; +end; + +destructor TBGRABufferedGradient.Destroy; +begin + if FGradientOwned then FGradient.Free; + inherited Destroy; +end; + +function TBGRABufferedGradient.GetColorAt(position: integer): TBGRAPixel; +var + posBuf: Integer; +begin + if FPadded then + begin + if position < 0 then + position := 0 else + if position >= 65536 then + position := 65536; + posBuf := position shr FBufferShift; + if posBuf > FBufferSize shr 1 then dec(posBuf); + end else + begin + position := position and 131071; + posBuf := position shr (FBufferShift+1); + end; + + if not FColorComputed[posBuf] then + begin + result := FGradient.GetColorAt(position); + FColorTab[posBuf] := result; + FColorComputed[posBuf] := true; + end else + result := FColorTab[posBuf]; +end; + +function TBGRABufferedGradient.GetAverageColor: TBGRAPixel; +begin + result := GammaCompression(GetAverageExpandedColor); +end; + +function TBGRABufferedGradient.GetAverageExpandedColor: TExpandedPixel; +begin + if not FAverageColorComputed then + begin + FAverageColorExpanded := FGradient.GetAverageExpandedColor; + FAverageColorComputed := true; + end; + result := FAverageColorExpanded; +end; + +function TBGRABufferedGradient.GetMonochrome: boolean; +begin + if not FMonochromeComputed then + begin + FMonochrome:= FGradient.Monochrome; + FMonochromeComputed:= true; + end; + result := FMonochrome; +end; + +{ TBGRASimpleGradient } + +constructor TBGRASimpleGradient.Create(AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); +begin + FColor1 := AColor1; + FColor2 := AColor2; + ec1 := GammaExpansion(AColor1); + ec2 := GammaExpansion(AColor2); + FRepetition:= ARepetition; +end; + +constructor TBGRASimpleGradient.Create(AColor1, AColor2: TExpandedPixel; + ARepetition: TBGRAGradientRepetition); +begin + FColor1 := GammaCompression(AColor1); + FColor2 := GammaCompression(AColor2); + ec1 := AColor1; + ec2 := AColor2; + FRepetition:= ARepetition; +end; + +class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation; + AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; +begin + case AInterpolation of + ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2); + ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2); + ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]); + ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]); + ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]); + ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]); + end; + result.Repetition := ARepetition; +end; + +class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation; + AColor1, AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; +begin + case AInterpolation of + ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2); + ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2); + ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]); + ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]); + ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]); + ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]); + end; + result.Repetition := ARepetition; +end; + +function TBGRASimpleGradient.GetAverageColor: TBGRAPixel; +begin + result := InterpolateToBGRA(32768); +end; + +function TBGRASimpleGradient.GetAverageExpandedColor: TExpandedPixel; +begin + Result:= InterpolateToExpanded(32768); +end; + +function TBGRASimpleGradient.GetColorAt(position: integer): TBGRAPixel; +begin + case FRepetition of + grSine: begin + position := Sin65536(position and $ffff); + if position = 65536 then + result := FColor2 + else + result := InterpolateToBGRA(position); + end; + grRepeat: result := InterpolateToBGRA(position and $ffff); + grReflect: + begin + position := position and $1ffff; + if position >= $10000 then + begin + if position = $10000 then + result := FColor2 + else + result := InterpolateToBGRA($20000 - position); + end + else + result := InterpolateToBGRA(position); + end; + else + begin + if position <= 0 then + result := FColor1 else + if position >= 65536 then + result := FColor2 else + result := InterpolateToBGRA(position); + end; + end; +end; + +function TBGRASimpleGradient.GetColorAtF(position: single): TBGRAPixel; +begin + if position = EmptySingle then result := BGRAPixelTransparent else + if FRepetition <> grPad then + result := GetColorAt(round(frac(position*0.5)*131072)) else //divided by 2 for reflected repetition + begin + if position <= 0 then + result := FColor1 else + if position >= 1 then + result := FColor2 else + result := GetColorAt(round(position*65536)); + end; +end; + +function TBGRASimpleGradient.GetExpandedColorAt(position: integer + ): TExpandedPixel; +begin + case FRepetition of + grSine: begin + position := Sin65536(position and $ffff); + if position = 65536 then + result := ec2 + else + result := InterpolateToExpanded(position); + end; + grRepeat: result := InterpolateToExpanded(position and $ffff); + grReflect: + begin + position := position and $1ffff; + if position >= $10000 then + begin + if position = $10000 then + result := ec2 + else + result := InterpolateToExpanded($20000 - position); + end + else + result := InterpolateToExpanded(position); + end; + else + begin + if position <= 0 then + result := ec1 else + if position >= 65536 then + result := ec2 else + result := InterpolateToExpanded(position); + end; + end; +end; + +function TBGRASimpleGradient.GetExpandedColorAtF(position: single + ): TExpandedPixel; +begin + if position = EmptySingle then result := BGRAPixelTransparent else + if FRepetition <> grPad then + result := GetExpandedColorAt(round(frac(position*0.5)*131072)) else //divided by 2 for reflected repetition + begin + if position <= 0 then + result := ec1 else + if position >= 1 then + result := ec2 else + result := GetExpandedColorAt(round(position*65536)); + end; +end; + +function TBGRASimpleGradient.GetMonochrome: boolean; +begin + Result:= (FColor1 = FColor2); +end; + +{ TBGRAConstantScanner } + +constructor TBGRAConstantScanner.Create(c: TBGRAPixel); +begin + inherited Create(c,c,gtLinear,PointF(0,0),PointF(0,0),false); +end; + +{ TBGRARandomScanner } + +constructor TBGRARandomScanner.Create(AGrayscale: Boolean; AOpacity: byte); +begin + FGrayscale:= AGrayscale; + FOpacity:= AOpacity; + FRandomBufferCount := 0; +end; + +function TBGRARandomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + Result:=ScanNextPixel; +end; + +function TBGRARandomScanner.ScanNextPixel: TBGRAPixel; +var rgb: integer; +begin + if FGrayscale then + begin + if FRandomBufferCount = 0 then + begin + FRandomBuffer := random(256*256*256); + FRandomBufferCount := 3; + end; + result.red := FRandomBuffer and 255; + FRandomBuffer:= FRandomBuffer shr 8; + dec(FRandomBufferCount); + result.green := result.red; + result.blue := result.red; + result.alpha:= FOpacity; + end else + begin + rgb := random(256*256*256); + Result:= BGRA(rgb and 255,(rgb shr 8) and 255,(rgb shr 16) and 255,FOpacity); + end; +end; + +function TBGRARandomScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + Result:=ScanNextPixel; +end; + +{ TBGRAHueGradient } + +procedure TBGRAHueGradient.Init(c1, c2: THSLAPixel; AOptions: THueGradientOptions); +begin + FOptions:= AOptions; + if (hgoLightnessCorrection in AOptions) then + begin + hsla1 := ExpandedToGSBA(ec1); + hsla2 := ExpandedToGSBA(ec2); + end else + begin + hsla1 := c1; + hsla2 := c2; + end; + if not (hgoHueCorrection in AOptions) then + begin + hue1 := c1.hue; + hue2 := c2.hue; + end else + begin + hue1 := HtoG(c1.hue); + hue2 := HtoG(c2.hue); + end; + if (hgoPositiveDirection in AOptions) and not (hgoNegativeDirection in AOptions) then + begin + if c2.hue <= c1.hue then inc(hue2, 65536); + end else + if not (hgoPositiveDirection in AOptions) and (hgoNegativeDirection in AOptions) then + begin + if c2.hue >= c1.hue then inc(hue1, 65536); + end; +end; + +function TBGRAHueGradient.InterpolateToHSLA(position: word): THSLAPixel; +var b,b2: LongWord; +begin + b := position shr 2; + b2 := 16384-b; + result.hue := ((hue1 * b2 + hue2 * b + 8191) shr 14) and $ffff; + result.saturation := (hsla1.saturation * b2 + hsla2.saturation * b + 8191) shr 14; + result.lightness := (hsla1.lightness * b2 + hsla2.lightness * b + 8191) shr 14; + result.alpha := (hsla1.alpha * b2 + hsla2.alpha * b + 8191) shr 14; + if hgoLightnessCorrection in FOptions then + begin + if not (hgoHueCorrection in FOptions) then + result.hue := HtoG(result.hue); + end else + begin + if hgoHueCorrection in FOptions then + result.hue := GtoH(result.hue); + end; +end; + +function TBGRAHueGradient.InterpolateToBGRA(position: word): TBGRAPixel; +begin + if hgoLightnessCorrection in FOptions then + result := GSBAToBGRA(InterpolateToHSLA(position)) + else + result := HSLAToBGRA(InterpolateToHSLA(position)); +end; + +function TBGRAHueGradient.InterpolateToExpanded(position: word): TExpandedPixel; +begin + if hgoLightnessCorrection in FOptions then + result := GSBAToExpanded(InterpolateToHSLA(position)) + else + result := HSLAToExpanded(InterpolateToHSLA(position)); +end; + +constructor TBGRAHueGradient.Create(Color1, Color2: TBGRAPixel;options: THueGradientOptions); +begin + if hgoReflect in options then + inherited Create(Color1,Color2,grReflect) + else if hgoRepeat in options then + inherited Create(Color1,Color2,grRepeat) + else + inherited Create(Color1,Color2,grPad); + + Init(BGRAToHSLA(Color1),BGRAToHSLA(Color2),options); +end; + +constructor TBGRAHueGradient.Create(Color1, Color2: TExpandedPixel; + options: THueGradientOptions); +begin + if hgoReflect in options then + inherited Create(Color1,Color2,grReflect) + else if hgoRepeat in options then + inherited Create(Color1,Color2,grRepeat) + else + inherited Create(Color1,Color2,grPad); + + Init(ExpandedToHSLA(Color1),ExpandedToHSLA(Color2),options); +end; + +constructor TBGRAHueGradient.Create(Color1, Color2: THSLAPixel; options: THueGradientOptions); +begin + if hgoReflect in options then + inherited Create(Color1.ToExpanded,Color2.ToExpanded,grReflect) + else if hgoRepeat in options then + inherited Create(Color1.ToExpanded,Color2.ToExpanded,grRepeat) + else + inherited Create(Color1.ToExpanded,Color2.ToExpanded,grPad); + + Init(Color1,Color2, options); +end; + +constructor TBGRAHueGradient.Create(AHue1, AHue2: Word; Saturation, + Lightness: Word; options: THueGradientOptions); +begin + Create(HSLA(AHue1,saturation,lightness), HSLA(AHue2,saturation,lightness), options); +end; + +function TBGRAHueGradient.GetMonochrome: boolean; +begin + Result:= false; +end; + +{ TBGRAMultiGradient } + +procedure TBGRAMultiGradient.Init(Colors: array of TBGRAPixel; + Positions0To1: array of single; AGammaCorrection, ACycle: boolean); +var + i: Integer; +begin + if length(Positions0To1) <> length(colors) then + raise Exception.Create('Dimension mismatch'); + if length(Positions0To1) = 0 then + raise Exception.Create('Empty gradient'); + setlength(FColors,length(Colors)); + setlength(FPositions,length(Positions0To1)); + setlength(FPositionsF,length(Positions0To1)); + setlength(FEColors,length(Colors)); + for i := 0 to high(colors) do + begin + FColors[i]:= colors[i]; + FPositions[i]:= round(Positions0To1[i]*65536); + FPositionsF[i]:= Positions0To1[i]; + FEColors[i]:= GammaExpansion(colors[i]); + end; + GammaCorrection := AGammaCorrection; + FCycle := ACycle; + if FPositions[high(FPositions)] = FPositions[0] then FCycle := false; +end; + +function TBGRAMultiGradient.CosineInterpolation(t: single): single; +begin + result := (1-cos(t*Pi))*0.5; +end; + +function TBGRAMultiGradient.HalfCosineInterpolation(t: single): single; +begin + result := (1-cos(t*Pi))*0.25 + t*0.5; +end; + +constructor TBGRAMultiGradient.Create(Colors: array of TBGRAPixel; + Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean); +begin + Init(Colors,Positions0To1,AGammaCorrection, ACycle); +end; + +function TBGRAMultiGradient.GetColorAt(position: integer): TBGRAPixel; +var i: Int32or64; + ec: TExpandedPixel; + curPos,posDiff: Int32or64; +begin + if FCycle then + position := (position-FPositions[0]) mod (FPositions[high(FPositions)] - FPositions[0]) + FPositions[0]; + if position <= FPositions[0] then + result := FColors[0] else + if position >= FPositions[high(FPositions)] then + result := FColors[high(FColors)] else + begin + i := 0; + while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do + inc(i); + + if Position = FPositions[i] then + result := FColors[i] + else + begin + curPos := position-FPositions[i]; + posDiff := FPositions[i+1]-FPositions[i]; + if FInterpolationFunction <> nil then + begin + curPos := round(FInterpolationFunction(curPos/posDiff)*65536); + posDiff := 65536; + end; + if GammaCorrection then + begin + if FEColors[i+1].red < FEColors[i].red then + ec.red := FEColors[i].red - UInt32or64(curPos)*UInt32or64(FEColors[i].red-FEColors[i+1].red) div UInt32or64(posDiff) else + ec.red := FEColors[i].red + UInt32or64(curPos)*UInt32or64(FEColors[i+1].red-FEColors[i].red) div UInt32or64(posDiff); + if FEColors[i+1].green < FEColors[i].green then + ec.green := FEColors[i].green - UInt32or64(curPos)*UInt32or64(FEColors[i].green-FEColors[i+1].green) div UInt32or64(posDiff) else + ec.green := FEColors[i].green + UInt32or64(curPos)*UInt32or64(FEColors[i+1].green-FEColors[i].green) div UInt32or64(posDiff); + if FEColors[i+1].blue < FEColors[i].blue then + ec.blue := FEColors[i].blue - UInt32or64(curPos)*UInt32or64(FEColors[i].blue-FEColors[i+1].blue) div UInt32or64(posDiff) else + ec.blue := FEColors[i].blue + UInt32or64(curPos)*UInt32or64(FEColors[i+1].blue-FEColors[i].blue) div UInt32or64(posDiff); + if FEColors[i+1].alpha < FEColors[i].alpha then + ec.alpha := FEColors[i].alpha - UInt32or64(curPos)*UInt32or64(FEColors[i].alpha-FEColors[i+1].alpha) div UInt32or64(posDiff) else + ec.alpha := FEColors[i].alpha + UInt32or64(curPos)*UInt32or64(FEColors[i+1].alpha-FEColors[i].alpha) div UInt32or64(posDiff); + result := GammaCompression(ec); + end else + begin + result.red := FColors[i].red + (curPos)*(FColors[i+1].red-FColors[i].red) div (posDiff); + result.green := FColors[i].green + (curPos)*(FColors[i+1].green-FColors[i].green) div (posDiff); + result.blue := FColors[i].blue + (curPos)*(FColors[i+1].blue-FColors[i].blue) div (posDiff); + result.alpha := FColors[i].alpha + (curPos)*(FColors[i+1].alpha-FColors[i].alpha) div (posDiff); + end; + end; + end; +end; + +function TBGRAMultiGradient.GetExpandedColorAt(position: integer + ): TExpandedPixel; +var i: Int32or64; + curPos,posDiff: Int32or64; + rw,gw,bw: UInt32or64; +begin + if FCycle then + position := (position-FPositions[0]) mod (FPositions[high(FPositions)] - FPositions[0]) + FPositions[0]; + if position <= FPositions[0] then + result := FEColors[0] else + if position >= FPositions[high(FPositions)] then + result := FEColors[high(FColors)] else + begin + i := 0; + while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do + inc(i); + + if Position = FPositions[i] then + result := FEColors[i] + else + begin + curPos := position-FPositions[i]; + posDiff := FPositions[i+1]-FPositions[i]; + if FInterpolationFunction <> nil then + begin + curPos := round(FInterpolationFunction(curPos/posDiff)*65536); + posDiff := 65536; + end; + if GammaCorrection then + begin + if FEColors[i+1].red < FEColors[i].red then + result.red := FEColors[i].red - UInt32or64(curPos)*UInt32or64(FEColors[i].red-FEColors[i+1].red) div UInt32or64(posDiff) else + result.red := FEColors[i].red + UInt32or64(curPos)*UInt32or64(FEColors[i+1].red-FEColors[i].red) div UInt32or64(posDiff); + if FEColors[i+1].green < FEColors[i].green then + result.green := FEColors[i].green - UInt32or64(curPos)*UInt32or64(FEColors[i].green-FEColors[i+1].green) div UInt32or64(posDiff) else + result.green := FEColors[i].green + UInt32or64(curPos)*UInt32or64(FEColors[i+1].green-FEColors[i].green) div UInt32or64(posDiff); + if FEColors[i+1].blue < FEColors[i].blue then + result.blue := FEColors[i].blue - UInt32or64(curPos)*UInt32or64(FEColors[i].blue-FEColors[i+1].blue) div UInt32or64(posDiff) else + result.blue := FEColors[i].blue + UInt32or64(curPos)*UInt32or64(FEColors[i+1].blue-FEColors[i].blue) div UInt32or64(posDiff); + if FEColors[i+1].alpha < FEColors[i].alpha then + result.alpha := FEColors[i].alpha - UInt32or64(curPos)*UInt32or64(FEColors[i].alpha-FEColors[i+1].alpha) div UInt32or64(posDiff) else + result.alpha := FEColors[i].alpha + UInt32or64(curPos)*UInt32or64(FEColors[i+1].alpha-FEColors[i].alpha) div UInt32or64(posDiff); + end else + begin + rw := Int32or64(FColors[i].red shl 8) + (((curPos) shl 8)*(FColors[i+1].red-FColors[i].red)) div (posDiff); + gw := Int32or64(FColors[i].green shl 8) + (((curPos) shl 8)*(FColors[i+1].green-FColors[i].green)) div (posDiff); + bw := Int32or64(FColors[i].blue shl 8) + (((curPos) shl 8)*(FColors[i+1].blue-FColors[i].blue)) div (posDiff); + + if rw >= $ff00 then result.red := $ffff + else result.red := (GammaExpansionTab[rw shr 8]*UInt32or64(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*UInt32or64(rw and 255)) shr 8; + if gw >= $ff00 then result.green := $ffff + else result.green := (GammaExpansionTab[gw shr 8]*UInt32or64(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*UInt32or64(gw and 255)) shr 8; + if bw >= $ff00 then result.blue := $ffff + else result.blue := (GammaExpansionTab[bw shr 8]*UInt32or64(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*UInt32or64(bw and 255)) shr 8; + result.alpha := Int32or64(FColors[i].alpha shl 8) + (((curPos) shl 8)*(FColors[i+1].alpha-FColors[i].alpha)) div (posDiff); + result.alpha := result.alpha + (result.alpha shr 8); + end; + end; + end; +end; + +function TBGRAMultiGradient.GetAverageColor: TBGRAPixel; +var sumR,sumG,sumB,sumA: integer; + i: Integer; +begin + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + for i := 0 to high(FColors) do + begin + inc(sumR, FColors[i].red); + inc(sumG, FColors[i].green); + inc(sumB, FColors[i].blue); + inc(sumA, FColors[i].alpha); + end; + result := BGRA(sumR div length(FColors),sumG div length(FColors), + sumB div length(FColors),sumA div length(FColors)); +end; + +function TBGRAMultiGradient.GetMonochrome: boolean; +var i: integer; +begin + for i := 1 to high(FColors) do + if FColors[i] <> FColors[0] then + begin + result := false; + exit; + end; + Result:= true; +end; + +{ TBGRASimpleGradientWithGammaCorrection } + +function TBGRASimpleGradientWithGammaCorrection.InterpolateToBGRA(position: word + ): TBGRAPixel; +var b,b2: LongWord; + ec: TExpandedPixel; +begin + b := position; + b2 := 65536-b; + ec.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16; + ec.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16; + ec.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16; + ec.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16; + result := GammaCompression(ec); +end; + +function TBGRASimpleGradientWithGammaCorrection.InterpolateToExpanded( + position: word): TExpandedPixel; +var b,b2: LongWord; +begin + b := position; + b2 := 65536-b; + result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16; + result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16; + result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16; + result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16; +end; + +constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1, + Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); +begin + inherited Create(Color1,Color2,ARepetition); +end; + +constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1, + Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); +begin + inherited Create(Color1,Color2,ARepetition); +end; + +{ TBGRASimpleGradientWithoutGammaCorrection } + +function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToBGRA( + position: word): TBGRAPixel; +var b,b2: LongWord; +begin + b := position shr 6; + b2 := 1024-b; + result.red := (FColor1.red * b2 + FColor2.red * b + 511) shr 10; + result.green := (FColor1.green * b2 + FColor2.green * b + 511) shr 10; + result.blue := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 10; + result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 10; +end; + +function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToExpanded( + position: word): TExpandedPixel; +var b,b2: LongWord; + rw,gw,bw: word; +begin + b := position shr 6; + b2 := 1024-b; + rw := (FColor1.red * b2 + FColor2.red * b + 511) shr 2; + gw := (FColor1.green * b2 + FColor2.green * b + 511) shr 2; + bw := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 2; + + if rw >= $ff00 then + result.red := 65535 + else + result.red := (GammaExpansionTab[rw shr 8]*UInt32or64(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*UInt32or64(rw and 255)) shr 8; + + if gw >= $ff00 then + result.green := 65535 + else + result.green := (GammaExpansionTab[gw shr 8]*UInt32or64(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*UInt32or64(gw and 255)) shr 8; + + if bw >= $ff00 then + result.blue := 65535 + else + result.blue := (GammaExpansionTab[bw shr 8]*UInt32or64(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*UInt32or64(bw and 255)) shr 8; + + result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 2; +end; + +constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1, + Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); +begin + inherited Create(Color1,Color2,ARepetition); +end; + +constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1, + Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); +begin + inherited Create(Color1,Color2,ARepetition); +end; + +{ TBGRAGradientTriangleScanner } + +constructor TBGRAGradientTriangleScanner.Create(pt1, pt2, pt3: TPointF; c1, c2, + c3: TBGRAPixel); +var ec1,ec2,ec3: TExpandedPixel; +begin + FMatrix := AffineMatrix(pt2.X-pt1.X, pt3.X-pt1.X, 0, + pt2.Y-pt1.Y, pt3.Y-pt1.Y, 0); + if not IsAffineMatrixInversible(FMatrix) then + FMatrix := AffineMatrix(0,0,0,0,0,0) + else + FMatrix := AffineMatrixInverse(FMatrix) * AffineMatrixTranslation(-pt1.x,-pt1.y); + + ec1 := GammaExpansion(c1); + ec2 := GammaExpansion(c2); + ec3 := GammaExpansion(c3); + FColor1[1] := ec1.red; + FColor1[2] := ec1.green; + FColor1[3] := ec1.blue; + FColor1[4] := ec1.alpha; + FDiff2[1] := ec2.red - ec1.red; + FDiff2[2] := ec2.green - ec1.green; + FDiff2[3] := ec2.blue - ec1.blue; + FDiff2[4] := ec2.alpha - ec1.alpha; + FDiff3[1] := ec3.red - ec1.red; + FDiff3[2] := ec3.green - ec1.green; + FDiff3[3] := ec3.blue - ec1.blue; + FDiff3[4] := ec3.alpha - ec1.alpha; + FStep := FDiff2*FMatrix[1,1]+FDiff3*FMatrix[2,1]; +end; + +procedure TBGRAGradientTriangleScanner.ScanMoveTo(X, Y: Integer); +begin + ScanMoveToF(X, Y); +end; + +procedure TBGRAGradientTriangleScanner.ScanMoveToF(X, Y: Single); +var + Cur: TPointF; +begin + Cur := FMatrix*PointF(X,Y); + FCurColor := FColor1+FDiff2*Cur.X+FDiff3*Cur.Y; +end; + +function TBGRAGradientTriangleScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + ScanMoveToF(X,Y); + result := ScanNextPixel; +end; + +function TBGRAGradientTriangleScanner.ScanNextPixel: TBGRAPixel; +var r,g,b,a: int64; +begin + r := round(FCurColor[1]); + g := round(FCurColor[2]); + b := round(FCurColor[3]); + a := round(FCurColor[4]); + if r > 65535 then r := 65535 else + if r < 0 then r := 0; + if g > 65535 then g := 65535 else + if g < 0 then g := 0; + if b > 65535 then b := 65535 else + if b < 0 then b := 0; + if a > 65535 then a := 65535 else + if a < 0 then a := 0; + result.red := GammaCompressionTab[r]; + result.green := GammaCompressionTab[g]; + result.blue := GammaCompressionTab[b]; + result.alpha := a shr 8; + FCurColor := FCurColor + FStep; +end; + +function TBGRAGradientTriangleScanner.ScanNextExpandedPixel: TExpandedPixel; +var r,g,b,a: int64; +begin + r := round(FCurColor[1]); + g := round(FCurColor[2]); + b := round(FCurColor[3]); + a := round(FCurColor[4]); + if r > 65535 then r := 65535 else + if r < 0 then r := 0; + if g > 65535 then g := 65535 else + if g < 0 then g := 0; + if b > 65535 then b := 65535 else + if b < 0 then b := 0; + if a > 65535 then a := 65535 else + if a < 0 then a := 0; + result.red := r; + result.green := g; + result.blue := b; + result.alpha := a; + FCurColor := FCurColor + FStep; +end; + +procedure TBGRAGradientTriangleScanner.ScanSkipPixels(ACount: integer); +begin + FCurColor := FCurColor + FStep*ACount; +end; + +{ TBGRAGradientScanner } + +procedure TBGRAGradientScanner.SetTransform(AValue: TAffineMatrix); +begin + if FTransform=AValue then Exit; + FTransform:=AValue; + InitTransform; +end; + +constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1: TPointF); +begin + FGradient := nil; + SetGradient(BGRABlack,BGRAWhite,False); + Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,False); +end; + +constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1,d2: TPointF); +begin + FGradient := nil; + SetGradient(BGRABlack,BGRAWhite,False); + Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,False); +end; + +constructor TBGRAGradientScanner.Create(AOrigin, + d1, d2, AFocal: TPointF; ARadiusRatio: single; AFocalRadiusRatio: single); +var + m, mInv: TAffineMatrix; + focalInv: TPointF; +begin + FGradient := nil; + SetGradient(BGRABlack,BGRAWhite,False); + + m := AffineMatrix((d1-AOrigin).x, (d2-AOrigin).x, AOrigin.x, + (d1-AOrigin).y, (d2-AOrigin).y, AOrigin.y); + if IsAffineMatrixInversible(m) then + begin + mInv := AffineMatrixInverse(m); + focalInv := mInv*AFocal; + end else + focalInv := PointF(0,0); + + Init(PointF(0,0), ARadiusRatio, focalInv, AFocalRadiusRatio, AffineMatrixIdentity, m); +end; + +constructor TBGRAGradientScanner.Create(AOrigin: TPointF; ARadius: single; + AFocal: TPointF; AFocalRadius: single); +begin + FGradient := nil; + SetGradient(BGRABlack,BGRAWhite,False); + + Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity); +end; + +procedure TBGRAGradientScanner.SetFlipGradient(AValue: boolean); +begin + if FFlipGradient=AValue then Exit; + FFlipGradient:=AValue; + UpdateGetGradientColorFunctions; +end; + +function TBGRAGradientScanner.GetGradientColor(a: single): TBGRAPixel; +begin + if a = EmptySingle then + result := BGRAPixelTransparent + else + begin + if FFlipGradient then a := 1-a; + if FSinus then + begin + a := a*65536; + if (a <= low(int64)) or (a >= high(int64)) then + result := FAverageColor + else + result := FGradient.GetColorAt(Sin65536(round(a) and 65535)); + end else + result := FGradient.GetColorAtF(a); + end; +end; + +function TBGRAGradientScanner.GetGradientExpandedColor(a: single): TExpandedPixel; +begin + if a = EmptySingle then + QWord(result) := 0 + else + begin + if FFlipGradient then a := 1-a; + if FSinus then + begin + a := a * 65536; + if (a <= low(int64)) or (a >= high(int64)) then + result := FAverageExpandedColor + else + result := FGradient.GetExpandedColorAt(Sin65536(round(a) and 65535)); + end else + result := FGradient.GetExpandedColorAtF(a); + end; +end; + +function TBGRAGradientScanner.GetGradientColorFlipped(a: single): TBGRAPixel; +begin + result := FGradient.GetColorAtF(1 - a); +end; + +function TBGRAGradientScanner.GetGradientExpandedColorFlipped(a: single): TExpandedPixel; +begin + result := FGradient.GetExpandedColorAtF(1 - a); +end; + +function TBGRAGradientScanner.GetGradientColorSinus(a: single): TBGRAPixel; +begin + if FFlipGradient then a := 1-a; + a := a * 65536; + if (a <= low(int64)) or (a >= high(int64)) then + result := FAverageColor + else result := FGradient.GetColorAt(Sin65536(round(a) and 65535)); +end; + +function TBGRAGradientScanner.GetGradientExpandedColorSinus(a: single): TExpandedPixel; +begin + if FFlipGradient then a := 1-a; + a := a * 65536; + if (a <= low(int64)) or (a >= high(int64)) then + result := FAverageExpandedColor + else result := FGradient.GetExpandedColorAt(Sin65536(round(a) and 65535)); +end; + +procedure TBGRAGradientScanner.UpdateGetGradientColorFunctions; +begin + if FSinus then + begin + FGetGradientColor:= @GetGradientColorSinus; + FGetGradientExpandedColor:= @GetGradientExpandedColorSinus; + end else + if FFlipGradient then + begin + FGetGradientColor:= @GetGradientColorFlipped; + FGetGradientExpandedColor:= @GetGradientExpandedColorFlipped; + end else + begin + FGetGradientColor:= @FGradient.GetColorAtF; + FGetGradientExpandedColor:= @FGradient.GetExpandedColorAtF; + end; +end; + +procedure TBGRAGradientScanner.SetSinus(AValue: boolean); +begin + if FSinus=AValue then Exit; + FSinus:=AValue; + UpdateGetGradientColorFunctions; +end; + +procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1: TPointF; + ATransform: TAffineMatrix; Sinus: Boolean); +var d2: TPointF; +begin + with (d1-AOrigin) do + d2 := PointF(AOrigin.x+y,AOrigin.y-x); + Init(AGradientType,AOrigin,d1,d2,ATransform,Sinus); +end; + +procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF; + ATransform: TAffineMatrix; Sinus: Boolean); +begin + FGradientType:= AGradientType; + FFlipGradient:= false; + FOrigin := AOrigin; + FDir1 := d1; + FDir2 := d2; + FSinus := Sinus; + FTransform := ATransform; + FHiddenTransform := AffineMatrixIdentity; + + FRadius := 1; + FRelativeFocal := PointF(0,0); + FFocalRadius := 0; + + InitGradientType; + InitTransform; + UpdateGetGradientColorFunctions; +end; + +procedure TBGRAGradientScanner.Init(AOrigin: TPointF; ARadius: single; + AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix); +var maxRadius: single; +begin + FGradientType:= gtRadial; + FFlipGradient:= false; + FOrigin := AOrigin; + ARadius := abs(ARadius); + AFocalRadius := abs(AFocalRadius); + maxRadius := max(ARadius,AFocalRadius); + FDir1 := AOrigin+PointF(maxRadius,0); + FDir2 := AOrigin+PointF(0,maxRadius); + FSinus := False; + FTransform := ATransform; + FHiddenTransform := AHiddenTransform; + + FRadius := ARadius/maxRadius; + FRelativeFocal := (AFocal - AOrigin)*(1/maxRadius); + FFocalRadius := AFocalRadius/maxRadius; + + InitGradientType; + InitTransform; + UpdateGetGradientColorFunctions; +end; + +procedure TBGRAGradientScanner.InitGradientType; +begin + case FGradientType of + gtReflected: begin + FScanNextFunc:= @ScanNextReflected; + FScanAtFunc:= @ScanAtReflected; + end; + gtDiamond: begin + FScanNextFunc:= @ScanNextDiamond; + FScanAtFunc:= @ScanAtDiamond; + end; + gtRadial: if (FRelativeFocal.x = 0) and (FRelativeFocal.y = 0) then + begin + if (FFocalRadius = 0) and (FRadius = 1) then + begin + FScanNextFunc:= @ScanNextRadial; + FScanAtFunc:= @ScanAtRadial; + end else + begin + FScanNextFunc:= @ScanNextRadial2; + FScanAtFunc:= @ScanAtRadial2; + end; + end else + begin + FScanNextFunc:= @ScanNextRadialFocal; + FScanAtFunc:= @ScanAtRadialFocal; + + FFocalDirection := FRelativeFocal; + FFocalDistance := VectLen(FFocalDirection); + if FFocalDistance > 0 then FFocalDirection := FFocalDirection * (1/FFocalDistance); + FFocalNormal := PointF(-FFocalDirection.y,FFocalDirection.x); + FRadialDenominator := sqr(FRadius-FFocalRadius)-sqr(FFocalDistance); + + //case in which the second circle is bigger and the first circle is within the second + if (FRadius < FFocalRadius) and (FFocalDistance <= FFocalRadius-FRadius) then + FRadialDeltaSign := -1 + else + FRadialDeltaSign := 1; + + //clipping afer the apex + if (FFocalRadius < FRadius) and (FFocalDistance > FRadius-FFocalRadius) then + begin + maxW1 := FRadius/(FRadius-FFocalRadius)*FFocalDistance; + maxW2 := MaxSingle; + end else + if (FRadius < FFocalRadius) and (FFocalDistance > FFocalRadius-FRadius) then + begin + maxW1 := MaxSingle; + maxW2 := FFocalRadius/(FFocalRadius-FRadius)*FFocalDistance; + end else + begin + maxW1 := MaxSingle; + maxW2 := MaxSingle; + end; + end; + gtAngular: begin + FScanNextFunc:= @ScanNextAngular; + FScanAtFunc:= @ScanAtAngular; + end; + else + {gtLinear:} begin + FScanNextFunc:= @ScanNextLinear; + FScanAtFunc:= @ScanAtLinear; + end; + end; +end; + +procedure TBGRAGradientScanner.SetGradient(c1, c2: TBGRAPixel; + AGammaCorrection: boolean); +begin + if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient); + + //transparent pixels have no color so + //take it from other color + if c1.alpha = 0 then c1 := BGRA(c2.red,c2.green,c2.blue,0); + if c2.alpha = 0 then c2 := BGRA(c1.red,c1.green,c1.blue,0); + + if AGammaCorrection then + FGradient := TBGRASimpleGradientWithGammaCorrection.Create(c1,c2) + else + FGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(c1,c2); + FGradientOwner := true; + InitGradient; +end; + +procedure TBGRAGradientScanner.SetGradient(AGradient: TBGRACustomGradient; + AOwner: boolean); +begin + if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient); + FGradient := AGradient; + FGradientOwner := AOwner; + InitGradient; +end; + +procedure TBGRAGradientScanner.InitTransform; +var u,v: TPointF; +begin + u := FDir1-FOrigin; + if FGradientType in[gtLinear,gtReflected] then + v := PointF(u.y, -u.x) + else + v := FDir2-FOrigin; + + FMatrix := FTransform * FHiddenTransform * AffineMatrix(u.x, v.x, FOrigin.x, + u.y, v.y, FOrigin.y); + if IsAffineMatrixInversible(FMatrix) then + begin + FMatrix := AffineMatrixInverse(FMatrix); + FIsAverage:= false; + end else + begin + FMatrix := AffineMatrixIdentity; + FIsAverage:= true; + end; + + case FGradientType of + gtReflected: FRepeatHoriz := (FMatrix[1,1]=0); + gtDiamond,gtAngular: FRepeatHoriz:= false; + gtRadial: begin + FRepeatHoriz:= false; + if FFocalRadius = FRadius then FIsAverage:= true; + end + else + {gtLinear:} FRepeatHoriz := (FMatrix[1,1]=0); + end; + + if FGradient.Monochrome then + FIsAverage:= true; + + if FIsAverage then + FRepeatHoriz:= true; + + FPosition := PointF(0,0); +end; + +procedure TBGRAGradientScanner.InitGradient; +begin + FAverageColor := FGradient.GetAverageColor; + FAverageExpandedColor := FGradient.GetAverageExpandedColor; + UpdateGetGradientColorFunctions; +end; + +function TBGRAGradientScanner.ComputeRadialFocal(const p: TPointF): single; +var + w1,w2,num: single; + h,d1,d2,delta: double; +begin + w1 := p*FFocalDirection; + w2 := FFocalDistance-w1; + if (w1 < maxW1) and (w2 < maxW2) then + begin + //vertical position and distances + h := sqr(p*FFocalNormal); + d1 := sqr(w1)+h; + d2 := sqr(w2)+h; + //finding t + delta := sqr(FFocalRadius)*d1 + 2*FRadius*FFocalRadius*(p*(FRelativeFocal-p))+ + sqr(FRadius)*d2 - sqr(VectDet(p,FRelativeFocal)); + if delta >= 0 then + begin + num := -FFocalRadius*(FRadius-FFocalRadius)-(FRelativeFocal*(FRelativeFocal-p)); + result := (num+FRadialDeltaSign*sqrt(delta))/FRadialDenominator; + end else + result := EmptySingle; + end else + result := EmptySingle; +end; + +function TBGRAGradientScanner.ScanNextLinear: single; +begin + result := FPosition.x; +end; + +function TBGRAGradientScanner.ScanNextReflected: single; +begin + result := abs(FPosition.x); +end; + +function TBGRAGradientScanner.ScanNextDiamond: single; +begin + result := max(abs(FPosition.x), abs(FPosition.y)); +end; + +function TBGRAGradientScanner.ScanNextRadial: single; +begin + result := sqrt(sqr(FPosition.x) + sqr(FPosition.y)); +end; + +function TBGRAGradientScanner.ScanNextRadial2: single; +begin + result := (sqrt(sqr(FPosition.x) + sqr(FPosition.y))-FFocalRadius)/(FRadius-FFocalRadius); +end; + +function TBGRAGradientScanner.ScanNextRadialFocal: single; +begin + result := ComputeRadialFocal(FPosition); +end; + +function TBGRAGradientScanner.ScanNextAngular: single; +begin + if FPosition.y >= 0 then + result := arctan2(FPosition.y,FPosition.x)/(2*Pi) + else + result := 1-arctan2(-FPosition.y,FPosition.x)/(2*Pi) +end; + +function TBGRAGradientScanner.ScanAtLinear(const p: TPointF): single; +begin + with (FMatrix*p) do + result := x; +end; + +function TBGRAGradientScanner.ScanAtReflected(const p: TPointF): single; +begin + with (FMatrix*p) do + result := abs(x); +end; + +function TBGRAGradientScanner.ScanAtDiamond(const p: TPointF): single; +begin + with (FMatrix*p) do + result := max(abs(x), abs(y)); +end; + +function TBGRAGradientScanner.ScanAtRadial(const p: TPointF): single; +begin + with (FMatrix*p) do + result := sqrt(sqr(x) + sqr(y)); +end; + +function TBGRAGradientScanner.ScanAtRadial2(const p: TPointF): single; +begin + with (FMatrix*p) do + result := (sqrt(sqr(x) + sqr(y))-FFocalRadius)/(FRadius-FFocalRadius); +end; + +function TBGRAGradientScanner.ScanAtRadialFocal(const p: TPointF): single; +begin + result := ComputeRadialFocal(FMatrix*p); +end; + +function TBGRAGradientScanner.ScanAtAngular(const p: TPointF): single; +begin + with (FMatrix*p) do + begin + if y >= 0 then + result := arctan2(y,x)/(2*Pi) + else + result := 1-arctan2(-y,x)/(2*Pi) + end; +end; + +function TBGRAGradientScanner.ScanNextInline: TBGRAPixel; +begin + result := FGetGradientColor(FScanNextFunc()); + FPosition.x := FPosition.x + FMatrix[1,1]; + FPosition.y := FPosition.y + FMatrix[2,1]; +end; + +function TBGRAGradientScanner.ScanNextExpandedInline: TExpandedPixel; +begin + result := FGetGradientExpandedColor(FScanNextFunc()); + FPosition.x := FPosition.x + FMatrix[1,1]; + FPosition.y := FPosition.y + FMatrix[2,1]; +end; + +constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel; + AGradientType: TGradientType; AOrigin, d1: TPointF; gammaColorCorrection: boolean; + Sinus: Boolean); +begin + FGradient := nil; + SetGradient(c1,c2,gammaColorCorrection); + Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus); +end; + +constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel; + AGradientType: TGradientType; AOrigin, d1, d2: TPointF; gammaColorCorrection: boolean; + Sinus: Boolean); +begin + FGradient := nil; + if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients'); + SetGradient(c1,c2,gammaColorCorrection); + Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus); +end; + +constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; + AGradientType: TGradientType; AOrigin, d1: TPointF; Sinus: Boolean; AGradientOwner: Boolean=False); +begin + FGradient := gradient; + FGradientOwner := AGradientOwner; + InitGradient; + Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus); +end; + +constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; + AGradientType: TGradientType; AOrigin, d1, d2: TPointF; Sinus: Boolean; + AGradientOwner: Boolean); +begin + if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients'); + FGradient := gradient; + FGradientOwner := AGradientOwner; + InitGradient; + Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus); +end; + +constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; + AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single; + AGradientOwner: Boolean); +begin + FGradient := gradient; + FGradientOwner := AGradientOwner; + InitGradient; + Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity); +end; + +destructor TBGRAGradientScanner.Destroy; +begin + if FGradientOwner then + FGradient.Free; + inherited Destroy; +end; + +procedure TBGRAGradientScanner.ScanMoveTo(X, Y: Integer); +begin + FPosition := FMatrix*PointF(x,y); + if FRepeatHoriz then + begin + if FIsAverage then + begin + FHorizColor := FAverageColor; + FHorizExpandedColor := FAverageExpandedColor; + end else + begin + FHorizColor := ScanNextInline; + FHorizExpandedColor := ScanNextExpandedInline; + end; + end; +end; + +function TBGRAGradientScanner.ScanNextPixel: TBGRAPixel; +begin + if FRepeatHoriz then + result := FHorizColor + else + result := ScanNextInline; +end; + +function TBGRAGradientScanner.ScanNextExpandedPixel: TExpandedPixel; +begin + if FRepeatHoriz then + result := FHorizExpandedColor + else + result := ScanNextExpandedInline; +end; + +function TBGRAGradientScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + if FIsAverage then + result := FAverageColor + else + result := GetGradientColor(FScanAtFunc(PointF(X,Y))); +end; + +function TBGRAGradientScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel; +begin + if FIsAverage then + result := FAverageExpandedColor + else + result := GetGradientExpandedColor(FScanAtFunc(PointF(X,Y))); +end; + +procedure TBGRAGradientScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +var c: TBGRAPixel; +begin + if FRepeatHoriz then + begin + c := FHorizColor; + case mode of + dmDrawWithTransparency: DrawPixelsInline(pdest,c,count); + dmLinearBlend: FastBlendPixelsInline(pdest,c,count); + dmSet: FillDWord(pdest^,count,Longword(c)); + dmXor: XorInline(pdest,c,count); + dmSetExceptTransparent: if c.alpha = 255 then FillDWord(pdest^,count,Longword(c)); + end; + exit; + end; + + case mode of + dmDrawWithTransparency: + while count > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,ScanNextInline); + inc(pdest); + dec(count); + end; + dmLinearBlend: + while count > 0 do + begin + FastBlendPixelInline(pdest,ScanNextInline); + inc(pdest); + dec(count); + end; + dmXor: + while count > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(ScanNextInline); + inc(pdest); + dec(count); + end; + dmSet: + while count > 0 do + begin + pdest^ := ScanNextInline; + inc(pdest); + dec(count); + end; + dmSetExceptTransparent: + while count > 0 do + begin + c := ScanNextInline; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + dec(count); + end; + end; +end; + +procedure TBGRAGradientScanner.ScanSkipPixels(ACount: integer); +begin + if not FRepeatHoriz and not FIsAverage then + FPosition.Offset(FMatrix[1,1]*ACount,FMatrix[2,1]*ACount); +end; + +function TBGRAGradientScanner.IsScanPutPixelsDefined: boolean; +begin + result := true; +end; + +{ TBGRATextureMaskScanner } + +constructor TBGRATextureMaskScanner.Create(AMask: IBGRAScanner; + AOffset: TPoint; ATexture: IBGRAScanner; AGlobalOpacity: Byte); +begin + FMask := AMask; + FOffset := AOffset; + FTexture := ATexture; + FTextureScanNext := @FTexture.ScanNextPixel; + FTextureScanAt := @FTexture.ScanAt; + FGlobalOpacity:= AGlobalOpacity; +end; + +destructor TBGRATextureMaskScanner.Destroy; +begin + fillchar(FMask,sizeof(FMask),0); //avoids interface deref + fillchar(FTexture,sizeof(FTexture),0); + inherited Destroy; +end; + +function TBGRATextureMaskScanner.IsScanPutPixelsDefined: boolean; +begin + Result:= true; +end; + +procedure TBGRATextureMaskScanner.ScanPutPixels(pdest: PBGRAPixel; + count: integer; mode: TDrawMode); +var c: TBGRAPixel; + ptex: pbgrapixel; + pmask: PByteMask; + stride, qty: integer; + + function GetNext: TBGRAPixel; inline; + begin + result := ptex^; + inc(ptex); + result.alpha := ApplyOpacity(result.alpha, pmask^.gray); + inc(pmask, stride); + end; + + function GetNextWithGlobal: TBGRAPixel; inline; + begin + result := ptex^; + inc(ptex); + result.alpha := ApplyOpacity( ApplyOpacity(result.alpha, pmask^.gray), FGlobalOpacity ); + inc(pmask, stride); + end; + +begin + if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count)); + ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet); + ptex := @FMemTex[0]; + while count > 0 do + begin + qty := count; + FMask.ScanNextMaskChunk(qty, pMask, stride); + dec(count, qty); + if FGlobalOpacity <> 255 then + begin + case mode of + dmDrawWithTransparency: + while qty > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,GetNextWithGlobal); + inc(pdest); + dec(qty); + end; + dmLinearBlend: + while qty > 0 do + begin + FastBlendPixelInline(pdest,GetNextWithGlobal); + inc(pdest); + dec(qty); + end; + dmXor: + while qty > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNextWithGlobal); + inc(pdest); + dec(qty); + end; + dmSet: + while qty > 0 do + begin + pdest^ := GetNextWithGlobal; + inc(pdest); + dec(qty); + end; + dmSetExceptTransparent: + while qty > 0 do + begin + c := GetNextWithGlobal; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + dec(qty); + end; + end; + end else + begin + case mode of + dmDrawWithTransparency: + while qty > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,GetNext); + inc(pdest); + dec(qty); + end; + dmLinearBlend: + while qty > 0 do + begin + FastBlendPixelInline(pdest,GetNext); + inc(pdest); + dec(qty); + end; + dmXor: + while qty > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); + inc(pdest); + dec(qty); + end; + dmSet: + while qty > 0 do + begin + pdest^ := GetNext; + inc(pdest); + dec(qty); + end; + dmSetExceptTransparent: + while qty > 0 do + begin + c := GetNext; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + dec(qty); + end; + end; + end; + end; +end; + +procedure TBGRATextureMaskScanner.ScanSkipPixels(ACount: integer); +begin + FMask.ScanSkipPixels(ACount); + FTexture.ScanSkipPixels(ACount); +end; + +procedure TBGRATextureMaskScanner.ScanMoveTo(X, Y: Integer); +begin + FMask.ScanMoveTo(X+FOffset.X,Y+FOffset.Y); + FTexture.ScanMoveTo(X,Y); +end; + +function TBGRATextureMaskScanner.ScanNextPixel: TBGRAPixel; +var + pMask: PByteMask; + stride, qty: integer; +begin + qty := 1; + FMask.ScanNextMaskChunk(qty,pMask,stride); + result := FTextureScanNext(); + result.alpha := ApplyOpacity( ApplyOpacity(result.alpha,pMask^.gray), FGlobalOpacity ); +end; + +function TBGRATextureMaskScanner.ScanAt(X, Y: Single): TBGRAPixel; +var alpha: byte; +begin + alpha := FMask.ScanAtMask(X+FOffset.X,Y+FOffset.Y).gray; + result := FTextureScanAt(X,Y); + result.alpha := ApplyOpacity( ApplyOpacity(result.alpha,alpha), FGlobalOpacity ); +end; + +{ TBGRASolidColorMaskScanner } + +constructor TBGRASolidColorMaskScanner.Create(AMask: IBGRAScanner; + AOffset: TPoint; ASolidColor: TBGRAPixel); +begin + FMask := AMask; + FOffset := AOffset; + FSolidColor := ASolidColor; +end; + +destructor TBGRASolidColorMaskScanner.Destroy; +begin + fillchar(FMask,sizeof(FMask),0); //avoids interface deref + inherited Destroy; +end; + +function TBGRASolidColorMaskScanner.IsScanPutPixelsDefined: boolean; +begin + Result:= true; +end; + +procedure TBGRASolidColorMaskScanner.ScanPutPixels(pdest: PBGRAPixel; + count: integer; mode: TDrawMode); +var c: TBGRAPixel; + pmask: PByteMask; + stride, qty: integer; + + function GetNext: TBGRAPixel; inline; + begin + result := FSolidColor; + result.alpha := ApplyOpacity(result.alpha,pmask^.gray); + inc(pmask, stride); + end; + +begin + while count > 0 do + begin + qty := count; + FMask.ScanNextMaskChunk(qty, pMask, stride); + dec(count, qty); + case mode of + dmDrawWithTransparency: + while qty > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,GetNext); + inc(pdest); + dec(qty); + end; + dmLinearBlend: + while qty > 0 do + begin + FastBlendPixelInline(pdest,GetNext); + inc(pdest); + dec(qty); + end; + dmXor: + while qty > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); + inc(pdest); + dec(qty); + end; + dmSet: + while qty > 0 do + begin + pdest^ := GetNext; + inc(pdest); + dec(qty); + end; + dmSetExceptTransparent: + while qty > 0 do + begin + c := GetNext; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + dec(qty); + end; + end; + end; +end; + +procedure TBGRASolidColorMaskScanner.ScanSkipPixels(ACount: integer); +begin + FMask.ScanSkipPixels(ACount); +end; + +procedure TBGRASolidColorMaskScanner.ScanMoveTo(X, Y: Integer); +begin + FMask.ScanMoveTo(X+FOffset.X,Y+FOffset.Y); +end; + +function TBGRASolidColorMaskScanner.ScanNextPixel: TBGRAPixel; +var + pMask: PByteMask; + stride, qty: integer; +begin + qty := 1; + FMask.ScanNextMaskChunk(qty,pMask,stride); + result := FSolidColor; + result.alpha := ApplyOpacity(result.alpha,pMask^.gray); +end; + +function TBGRASolidColorMaskScanner.ScanAt(X, Y: Single): TBGRAPixel; +var alpha: byte; +begin + alpha := FMask.ScanAtMask(X,Y).gray; + result := FSolidColor; + result.alpha := ApplyOpacity(result.alpha,alpha); +end; + +{ TBGRAOpacityScanner } + +constructor TBGRAOpacityScanner.Create(ATexture: IBGRAScanner; + AGlobalOpacity: Byte); +begin + FTexture := ATexture; + FScanNext := @FTexture.ScanNextPixel; + FScanAt := @FTexture.ScanAt; + FGlobalOpacity:= AGlobalOpacity; + FOwnedScanner := nil; +end; + +constructor TBGRAOpacityScanner.Create(ATexture: TBGRACustomScanner; + AGlobalOpacity: Byte; AOwned: boolean); +begin + FTexture := ATexture; + FScanNext := @FTexture.ScanNextPixel; + FScanAt := @FTexture.ScanAt; + FGlobalOpacity:= AGlobalOpacity; + if AOwned then + FOwnedScanner := ATexture + else + FOwnedScanner := nil; +end; + +destructor TBGRAOpacityScanner.Destroy; +begin + fillchar(FTexture,sizeof(FTexture),0); + FOwnedScanner.Free; + inherited Destroy; +end; + +function TBGRAOpacityScanner.IsScanPutPixelsDefined: boolean; +begin + Result:= true; +end; + +procedure TBGRAOpacityScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +var c: TBGRAPixel; + ptex: pbgrapixel; + + function GetNext: TBGRAPixel; inline; + begin + result := ptex^; + inc(ptex); + result.alpha := ApplyOpacity(result.alpha,FGlobalOpacity); + end; + +begin + if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count)); + ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet); + + ptex := @FMemTex[0]; + + case mode of + dmDrawWithTransparency: + while count > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest,GetNext); + inc(pdest); + dec(count); + end; + dmLinearBlend: + while count > 0 do + begin + FastBlendPixelInline(pdest,GetNext); + inc(pdest); + dec(count); + end; + dmXor: + while count > 0 do + begin + PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); + inc(pdest); + dec(count); + end; + dmSet: + while count > 0 do + begin + pdest^ := GetNext; + inc(pdest); + dec(count); + end; + dmSetExceptTransparent: + while count > 0 do + begin + c := GetNext; + if c.alpha = 255 then pdest^ := c; + inc(pdest); + dec(count); + end; + end; +end; + +procedure TBGRAOpacityScanner.ScanSkipPixels(ACount: integer); +begin + FTexture.ScanSkipPixels(ACount); +end; + +procedure TBGRAOpacityScanner.ScanMoveTo(X, Y: Integer); +begin + FTexture.ScanMoveTo(X,Y); +end; + +function TBGRAOpacityScanner.ScanNextPixel: TBGRAPixel; +begin + result := FScanNext(); + result.alpha := ApplyOpacity(result.alpha, FGlobalOpacity ); +end; + +function TBGRAOpacityScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + result := FScanAt(X,Y); + result.alpha := ApplyOpacity(result.alpha, FGlobalOpacity ); +end; + +initialization + + Randomize; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragraphics.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragraphics.pas new file mode 100644 index 0000000..8628bf0 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragraphics.pas @@ -0,0 +1,724 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGraphics; +{=== Types imported from Graphics ===} +{$mode objfpc}{$H+} +{$I bgrabitmap.inc} + +interface + +{$IFDEF BGRABITMAP_USE_LCL} +uses Graphics, GraphType, FPImage, FPCanvas; + +type + PColor = Graphics.PColor; + TColor = Graphics.TColor; + TAntialiasingMode = Graphics.TAntialiasingMode; + TGradientDirection = Graphics.TGradientDirection; + TPenEndCap = Graphics.TPenEndCap; + TPenJoinStyle = Graphics.TPenJoinStyle; + TPenStyle = Graphics.TPenStyle; + TPenMode = Graphics.TPenMode; + +const + amDontCare = Graphics.amDontCare; + amOn = Graphics.amOn; + amOff = Graphics.amOff; + + gdVertical = Graphics.gdVertical; + gdHorizontal = Graphics.gdHorizontal; + + pecRound = Graphics.pecRound; + pecSquare = Graphics.pecSquare; + pecFlat = Graphics.pecFlat; + + pjsRound = Graphics.pjsRound; + pjsBevel = Graphics.pjsBevel; + pjsMiter = Graphics.pjsMiter; + + psSolid = Graphics.psSolid; + psDash = Graphics.psDash; + psDot = Graphics.psDot; + psDashDot = Graphics.psDashDot; + psDashDotDot = Graphics.psDashDotDot; + psClear = Graphics.psClear; + psInsideframe = Graphics.psInsideframe; + psPattern = Graphics.psPattern; + + pmBlack = Graphics.pmBlack; + pmWhite = Graphics.pmWhite; + pmNop = Graphics.pmNop; + pmNot = Graphics.pmNot; + pmCopy = Graphics.pmCopy; + pmNotCopy = Graphics.pmNotCopy; + pmMergePenNot = Graphics.pmMergePenNot; + pmMaskPenNot = Graphics.pmMaskPenNot; + pmMergeNotPen = Graphics.pmMergeNotPen; + pmMaskNotPen = Graphics.pmMaskNotPen; + pmMerge = Graphics.pmMerge; + pmNotMerge = Graphics.pmNotMerge; + pmMask = Graphics.pmMask; + pmNotMask = Graphics.pmNotMask; + pmXor = Graphics.pmXor; + pmNotXor = Graphics.pmNotXor; + + tmAuto = Graphics.tmAuto; + tmFixed = Graphics.tmFixed; + +type + TPen = Graphics.TPen; + TTextLayout = Graphics.TTextLayout; + TTextStyle = Graphics.TTextStyle; + + TFillStyle = Graphics.TFillStyle; + TFillMode = Graphics.TFillMode; + TBrushStyle = Graphics.TBrushStyle; + +const + tlTop = Graphics.tlTop; + tlCenter = Graphics.tlCenter; + tlBottom = Graphics.tlBottom; + + fsSurface = GraphType.fsSurface; + fsBorder = GraphType.fsBorder; + + fmAlternate = Graphics.fmAlternate; + fmWinding = Graphics.fmWinding; + + bsSolid = Graphics.bsSolid; + bsClear = Graphics.bsClear; + bsHorizontal = Graphics.bsHorizontal; + bsVertical = Graphics.bsVertical; + bsFDiagonal = Graphics.bsFDiagonal; + bsBDiagonal = Graphics.bsBDiagonal; + bsCross = Graphics.bsCross; + bsDiagCross = Graphics.bsDiagCross; + bsImage = FPCanvas.bsImage; + +type + TBrush = Graphics.TBrush; + TCanvas = Graphics.TCanvas; + TGraphic = Graphics.TGraphic; + TRawImage = GraphType.TRawImage; + TBitmap = Graphics.TBitmap; + + TRasterImage = Graphics.TRasterImage; + + TFontStyle = Graphics.TFontStyle; + TFontStyles = Graphics.TFontStyles; + TFontQuality = Graphics.TFontQuality; + +type + TFont = Graphics.TFont; + +const + fsBold = Graphics.fsBold; + fsItalic = Graphics.fsItalic; + fsStrikeOut = Graphics.fsStrikeOut; + fsUnderline = Graphics.fsUnderline; + + fqDefault = Graphics.fqDefault; + fqDraft = Graphics.fqDraft; + fqProof = Graphics.fqProof; + fqNonAntialiased = Graphics.fqNonAntialiased; + fqAntialiased = Graphics.fqAntialiased; + fqCleartype = Graphics.fqCleartype; + fqCleartypeNatural = Graphics.fqCleartypeNatural; + + clNone = Graphics.clNone; + + clBlack = Graphics.clBlack; + clMaroon = Graphics.clMaroon; + clGreen = Graphics.clGreen; + clOlive = Graphics.clOlive; + clNavy = Graphics.clNavy; + clPurple = Graphics.clPurple; + clTeal = Graphics.clTeal; + clGray = Graphics.clGray; + clSilver = Graphics.clSilver; + clRed = Graphics.clRed; + clLime = Graphics.clLime; + clYellow = Graphics.clYellow; + clBlue = Graphics.clBlue; + clFuchsia = Graphics.clFuchsia; + clAqua = Graphics.clAqua; + clLtGray = Graphics.clLtGray; // clSilver alias + clDkGray = Graphics.clDkGray; // clGray alias + clWhite = Graphics.clWhite; + +function FPColorToTColor(const FPColor: TFPColor): TColor; inline; +function TColorToFPColor(const c: TColor): TFPColor; inline; +function ColorToRGB(c: TColor): TColor; inline; +function RGBToColor(R, G, B: Byte): TColor; inline; +procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); inline;// does not work on system color +function clRgbBtnHighlight: TColor; +function clRgbBtnShadow: TColor; + +implementation + +function FPColorToTColor(const FPColor: TFPColor): TColor; +begin + result := Graphics.FPColorToTColor(FPColor); +end; + +function TColorToFPColor(const c: TColor): TFPColor; +begin + result := Graphics.TColorToFPColor(c); +end; + +function ColorToRGB(c: TColor): TColor; +begin + result := Graphics.ColorToRGB(c); +end; + +function RGBToColor(R, G, B: Byte): TColor; +begin + result := Graphics.RGBToColor(R, G, B); +end; + +procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); +begin + Graphics.RedGreenBlue(rgb, Red, Green, Blue); +end; + +function clRgbBtnHighlight: TColor; +begin + result := Graphics.ColorToRGB(clBtnHighlight); +end; + +function clRgbBtnShadow: TColor; +begin + result := Graphics.ColorToRGB(clBtnShadow); +end; + +{$ELSE} + +{$IFDEF BGRABITMAP_USE_MSEGUI} + {$i bgramsegui_uses.inc} +{$ELSE} + {$IFDEF BGRABITMAP_USE_FPGUI} + {$i bgrafpgui_uses.inc} + {$ELSE} + {$i bgranogui_uses.inc} + {$ENDIF} +{$ENDIF} + +type + TTransparentMode = (tmAuto, tmFixed); + TGraphic = class; + +{$DEFINE INCLUDE_INTERFACE} +{$IFDEF BGRABITMAP_USE_MSEGUI} + {$i bgramsegui.inc} +{$ELSE} + {$IFDEF BGRABITMAP_USE_FPGUI} + {$i bgrafpgui.inc} + {$ELSE} + {$i bgranogui.inc} + {$ENDIF} +{$ENDIF} + +type + {* Pointer to a ''TColor'' value } + PColor = ^TColor; + {* Contains a color stored as RGB. The red/green/blue values + range from 0 to 255. The formula to get the color value is: + * ''color'' = ''red'' + (''green'' '''shl''' 8) + (''blue'' '''shl''' 16) + *except with fpGUI where it is: + * ''color'' = (''red'' '''shl''' 16) + (''green'' '''shl''' 8) + ''blue'' }{import + TColor = Int32; + } + {** Converts a ''TFPColor'' into a ''TColor'' value } + function FPColorToTColor(const FPColor: TFPColor): TColor; + {** Converts a ''TColor'' into a ''TFPColor'' value } + function TColorToFPColor(const c: TColor): TFPColor; + + function RGBToColor(R, G, B: Byte): TColor; inline; + procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); // does not work on system color + +type + {* Direction of change in a gradient } + TGradientDirection = ( + {** Color changes vertically } + gdVertical, + {** Color changes horizontally } + gdHorizontal); + + {* Antialiasing mode for a Canvas } + TAntialiasingMode = ( + {** It does not matter if there is antialiasing or not } + amDontCare, + {** Antialiasing is required (BGRACanvas provide it) } + amOn, + {** Antialiasing is disabled } + amOff); + +type + {* Vertical position of a text } + TTextLayout = (tlTop, tlCenter, tlBottom); + {* Styles to describe how a text is drawn in a rectangle } + TTextStyle = packed record + {** Horizontal alignment } + Alignment : TAlignment; + + {** Vertical alignment } + Layout : TTextLayout; + + {** If WordBreak is false then process #13, #10 as + standard chars and perform no Line breaking } + SingleLine: boolean; + + {** Clip Text to passed Rectangle } + Clipping : boolean; + + {** Replace #9 by apropriate amount of spaces (default is usually 8) } + ExpandTabs: boolean; + + {** Process first single '&' per line as an underscore and draw '&&' as '&' } + ShowPrefix: boolean; + + {** If line of text is too long too fit between left and right boundaries + try to break into multiple lines between words. See also ''EndEllipsis'' } + Wordbreak : boolean; + + {** Fills background with current brush } + Opaque : boolean; + + {** Use the system font instead of canvas font } + SystemFont: Boolean; + + {** For RightToLeft text reading (Text Direction) } + RightToLeft: Boolean; + + {** If line of text is too long to fit between left and right boundaries + truncates the text and adds "...". If Wordbreak is set as well, + Workbreak will dominate } + EndEllipsis: Boolean; + end; + + {* Option for floodfill (used in BGRACanvas) } + TFillStyle = + ( + {** Fill up to the color (it fills all except the specified color) } + fsSurface, + {** Fill the specified color (it fills only connected pixels of this color) } + fsBorder + ); + {* How to handle polygons that intersect with themselves and + overlapping polygons } + TFillMode = ( + {** Each time a boundary is found, it enters or exit the filling zone } + fmAlternate, + {** Adds or subtract 1 depending on the order of the points of the + polygons (clockwise or counter clockwise) and fill when the + result is non-zero. So, to draw a hole, you must specify the points + of the hole in the opposite order } + fmWinding); + +type + {$IFNDEF TFontStyle} + {* Available font styles } + TFontStyle = ( + {** Font is bold } + fsBold, + {** Font is italic } + fsItalic, + {** An horizontal line is drawn in the middle of the text } + fsStrikeOut, + {** Text is underlined } + fsUnderline); + {** A combination of font styles } + TFontStyles = set of TFontStyle; + {$ENDIF} + {$IFNDEF TFontQuality} + {* Quality to use when font is rendered by the system } + TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqCleartype, fqCleartypeNatural); + {$ENDIF} + + {$IFNDEF TCanvas} + { TCanvas } + {* A surface on which to draw } + TCanvas = class + protected + FCanvas: TGUICanvas; + public + constructor Create(ACanvas: TGUICanvas); + {** Draw an image with top-left corner at (''x'',''y'') } + procedure Draw(x,y: integer; AImage: TGraphic); + {** Draw and stretch an image within the rectangle ''ARect'' } + procedure StretchDraw(ARect: TRect; AImage: TGraphic); + property GUICanvas: TGUICanvas read FCanvas; + end; + {$ENDIF} + + { TGraphic } + {* A class containing any element that can be drawn within rectangular bounds } + TGraphic = class(TPersistent) + protected + procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract; + function GetEmpty: Boolean; virtual; abstract; + function GetHeight: Integer; virtual; abstract; + function GetWidth: Integer; virtual; abstract; + function GetTransparent: Boolean; virtual; abstract; + procedure SetTransparent(Value: Boolean); virtual; abstract; + procedure SetHeight(Value: Integer); virtual; abstract; + procedure SetWidth(Value: Integer); virtual; abstract; + function GetMimeType: string; virtual; + public + constructor Create; virtual; + {** Load the content from a given file } + procedure LoadFromFile({%H-}const Filename: string); virtual; + {** Load the content from a given stream } + procedure LoadFromStream(Stream: TStream); virtual; abstract; + {** Saves the content to a file } + procedure SaveToFile({%H-}const Filename: string); virtual; + {** Saves the content into a given stream } + procedure SaveToStream(Stream: TStream); virtual; abstract; + {** Returns the list of possible file extensions } + class function GetFileExtensions: string; virtual; + {** Clears the content } + procedure Clear; virtual; + public + {** Returns if the content is completely empty } + property Empty: Boolean read GetEmpty; + {** Returns the height of the bounding rectangle } + property Height: Integer read GetHeight write SetHeight; + {** Returns the width of the bounding rectangle } + property Width: Integer read GetWidth write SetWidth; + {** Gets or sets if it is drawn with transparency } + property Transparent: Boolean read GetTransparent write SetTransparent; + end; + + {$IFNDEF TBitmap} + { TBitmap } + {* Contains a bitmap } + TBitmap = class(TGraphic) + private + FHeight: integer; + FWidth: integer; + FInDraw: boolean; + FTransparent: boolean; + FTransparentColor: TColor; + FTransparentMode: TTransparentMode; + function GetCanvas: TCanvas; + function GetRawImage: TRawImage; + procedure SetTransparentColor(AValue: TColor); + procedure SetTransparentMode(AValue: TTransparentMode); + protected + FRawImage: TRawImage; + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; + procedure Changed(Sender: TObject); virtual; + function GetHeight: Integer; override; + function GetWidth: Integer; override; + procedure SetHeight(Value: Integer); override; + procedure SetWidth(Value: Integer); override; + function GetEmpty: Boolean; override; + function GetTransparent: Boolean; override; + procedure SetTransparent({%H-}Value: Boolean); override; + function GetMimeType: string; override; + public + constructor Create; override; + destructor Destroy; override; + procedure LoadFromStream({%H-}Stream: TStream); override; + procedure SaveToStream({%H-}Stream: TStream); override; + {** Width of the bitmap in pixels } + property Width: integer read GetWidth write SetWidth; + {** Height of the bitmap in pixels } + property Height: integer read GetHeight write SetHeight; + property RawImage: TRawImage read GetRawImage; + property Canvas: TCanvas read GetCanvas; + property TransparentColor: TColor read FTransparentColor + write SetTransparentColor default clDefault; + property TransparentMode: TTransparentMode read FTransparentMode + write SetTransparentMode default tmAuto; + end; + {$ENDIF} + +{* Multiply and divide the number allowing big intermediate number and rounding the result } +function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; +{* Round the number using math convention } +function MathRound(AValue: ValReal): Int64; inline; + +{$IFDEF BGRABITMAP_USE_FPCANVAS} +{$DEFINE INCLUDE_INTERFACE} +{$i bgrafpcanvas.inc} +{$ENDIF} + +implementation + +uses sysutils, BGRAUTF8; + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$IFDEF BGRABITMAP_USE_MSEGUI} + {$i bgramsegui.inc} +{$ELSE} + {$IFDEF BGRABITMAP_USE_FPGUI} + {$i bgrafpgui.inc} + {$ELSE} + {$i bgranogui.inc} + {$ENDIF} +{$ENDIF} + +function MathRound(AValue: ValReal): Int64; inline; +begin + if AValue >= 0 then + Result := Trunc(AValue + 0.5) + else + Result := Trunc(AValue - 0.5); +end; + +function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; +begin + if nDenominator = 0 then + Result := -1 + else + Result := MathRound(int64(nNumber) * int64(nNumerator) / nDenominator); +end; + +function FPColorToTColor(const FPColor: TFPColor): TColor; +begin + {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} + Result:=((FPColor.Blue shr 8) and $ff) + or (FPColor.Green and $ff00) + or ((FPColor.Red shl 8) and $ff0000); + {$ELSE} + Result:=((FPColor.Red shr 8) and $ff) + or (FPColor.Green and $ff00) + or ((FPColor.Blue shl 8) and $ff0000); + {$ENDIF} +end; + +function TColorToFPColor(const c: TColor): TFPColor; +begin + {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} + Result.Blue:=(c and $ff); + Result.Blue:=Result.Blue+(Result.Blue shl 8); + Result.Green:=(c and $ff00); + Result.Green:=Result.Green+(Result.Green shr 8); + Result.Red:=(c and $ff0000) shr 8; + Result.Red:=Result.Red+(Result.Red shr 8); + {$ELSE} + Result.Red:=(c and $ff); + Result.Red:=Result.Red+(Result.Red shl 8); + Result.Green:=(c and $ff00); + Result.Green:=Result.Green+(Result.Green shr 8); + Result.Blue:=(c and $ff0000) shr 8; + Result.Blue:=Result.Blue+(Result.Blue shr 8); + {$ENDIF} + Result.Alpha:=FPImage.alphaOpaque; +end; + +procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); +begin + {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} + Blue := rgb and $000000ff; + Green := (rgb shr 8) and $000000ff; + Red := (rgb shr 16) and $000000ff; + {$ELSE} + Red := rgb and $000000ff; + Green := (rgb shr 8) and $000000ff; + Blue := (rgb shr 16) and $000000ff; + {$ENDIF} +end; + +function RGBToColor(R, G, B: Byte): TColor; +begin + {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} + Result := (R shl 16) or (G shl 8) or B; + {$ELSE} + Result := (B shl 16) or (G shl 8) or R; + {$ENDIF} +end; + +{ TGraphic } + +function TGraphic.GetMimeType: string; +begin + result := ''; +end; + +constructor TGraphic.Create; +begin + //nothing +end; + +procedure TGraphic.LoadFromFile(const Filename: string); +var + Stream: TStream; +begin + Stream := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TGraphic.SaveToFile(const Filename: string); +var + Stream: TStream; +begin + Stream := TFileStreamUTF8.Create(Filename, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +class function TGraphic.GetFileExtensions: string; +begin + result := ''; +end; + +procedure TGraphic.Clear; +begin + //nothing +end; + +{$IFNDEF TCanvas} +{ TCanvas } + +constructor TCanvas.Create(ACanvas: TGUICanvas); +begin + FCanvas := ACanvas; +end; + +procedure TCanvas.Draw(x, y: integer; AImage: TGraphic); +begin + if AImage is TBitmap then + FCanvas.DrawImage(x,y, TBitmap(AImage).RawImage) + else + AImage.Draw(self, rect(x,y,x+AImage.Width,y+AImage.Height)); +end; + +procedure TCanvas.StretchDraw(ARect: TRect; AImage: TGraphic); +begin + if AImage is TBitmap then + FCanvas.StretchDraw(ARect.Left,ARect.Top,ARect.Right-ARect.Left,ARect.Bottom-ARect.Top, TBitmap(AImage).RawImage) + else + AImage.Draw(self, ARect); +end; +{$ENDIF} + +{$IFNDEF TBitmap} +{ TBitmap } + +procedure TBitmap.SetWidth(Value: Integer); +begin + if FWidth=Value then Exit; + FWidth:=Value; +end; + +function TBitmap.GetEmpty: Boolean; +begin + result := (Width = 0) or (Height = 0); +end; + +function TBitmap.GetTransparent: Boolean; +begin + result := FTransparent; +end; + +procedure TBitmap.SetTransparent(Value: Boolean); +begin + if Value = FTransparent then exit; + FTransparent:= Value; +end; + +procedure TBitmap.SetTransparentColor(AValue: TColor); +begin + if FTransparentColor = AValue then exit; + FTransparentColor := AValue; + + if AValue = clDefault + then FTransparentMode := tmAuto + else FTransparentMode := tmFixed; +end; + +procedure TBitmap.SetTransparentMode(AValue: TTransparentMode); +begin + if AValue = TransparentMode then exit; + FTransparentMode := AValue; + + if AValue = tmAuto + then TransparentColor := clDefault +end; + +function TBitmap.GetMimeType: string; +begin + Result:= 'image/bmp'; +end; + +procedure TBitmap.Changed(Sender: TObject); +begin + //nothing +end; + +procedure TBitmap.LoadFromStream(Stream: TStream); +begin + raise exception.Create('Not implemented'); +end; + +procedure TBitmap.SaveToStream(Stream: TStream); +begin + raise exception.Create('Not implemented'); +end; + +procedure TBitmap.SetHeight(Value: Integer); +begin + if FHeight=Value then Exit; + FHeight:=Value; +end; + +function TBitmap.GetRawImage: TRawImage; +begin + FRawImage.BGRASetSizeAndTransparency(FWidth, FHeight, FTransparent); + result := FRawImage; +end; + +procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect); +begin + if FInDraw then exit; + FInDraw := true; + ACanvas.StretchDraw(Rect, self); + FInDraw := false; +end; + +function TBitmap.GetHeight: Integer; +begin + result := FHeight; +end; + +function TBitmap.GetWidth: Integer; +begin + result := FWidth; +end; + +function TBitmap.GetCanvas: TCanvas; +begin + result := nil; + raise exception.Create('Canvas not available'); +end; + +constructor TBitmap.Create; +begin + FRawImage := TRawImage.Create; + FTransparent:= false; +end; + +destructor TBitmap.Destroy; +begin + FRawImage.Free; + inherited Destroy; +end; +{$ENDIF} + +{$IFDEF BGRABITMAP_USE_FPCANVAS} +{$DEFINE INCLUDE_IMPLEMENTATION} +{$i bgrafpcanvas.inc} +{$ENDIF} + +{$ENDIF} + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragrayscalemask.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragrayscalemask.pas new file mode 100644 index 0000000..15ce756 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragrayscalemask.pas @@ -0,0 +1,1450 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAGrayscaleMask; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, BGRAGraphics, SysUtils, BGRABitmapTypes, BGRAResample, {%H-}UniversalDrawer; + +type + { TGrayscaleMask } + + TGrayscaleMask = class(specialize TGenericUniversalBitmap) + private + function GetScanLine(Y: Integer): PByte; inline; + protected + function InternalNew: TCustomUniversalBitmap; override; + procedure AssignTransparentPixel(out ADest); override; + function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TByteMask; + function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TByteMask; + procedure Init; override; + public + ScanInterpolationFilter: TResampleFilter; + + constructor Create(AWidth,AHeight: Integer; AValue: byte); overload; + constructor Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload; + constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer); + constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer); + constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ASourceRect: TRect); + constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer; ASourceRect: TRect); + procedure CopyFrom(ABitmap: TGrayscaleMask); overload; + procedure CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload; + procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); override; + function GetImageBounds: TRect; overload; override; + function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; override; + function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; override; + + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TByteMask; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + + procedure Draw(ABitmap: TBGRACustomBitmap; X,Y: Integer; AGammaCorrection: boolean = false); + procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; const c: TBGRAPixel); overload; + procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; texture: IBGRAScanner); overload; + function GetPixel(X,Y: integer): byte; overload; + procedure SetPixel(X,Y: integer; AValue: byte); + property ScanLine[Y: Integer]: PByte read GetScanLine; + property Data: PByte read FDataByte; + + function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask; overload; + function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask; + + procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); override; + function ScanAtIntegerMask(X,Y: integer): TByteMask; override; + function ScanAtMask(X,Y: Single): TByteMask; override; + function ScanAtInteger(X, Y: integer): TBGRAPixel; override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + + {inplace filters} + procedure Negative; + procedure NegativeRect(ABounds: TRect); + procedure InplaceNormalize; overload; + procedure InplaceNormalize(ABounds: TRect); overload; + + //return type helpers + function NewBitmap: TGrayscaleMask; overload; override; + function NewBitmap(AWidth, AHeight: integer): TGrayscaleMask; overload; override; + function NewBitmap(AWidth, AHeight: integer; const Color: TByteMask): TGrayscaleMask; overload; override; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TGrayscaleMask; overload; override; + function NewReference: TGrayscaleMask; override; + function GetUnique: TGrayscaleMask; override; + function Duplicate(DuplicateProperties: Boolean = False): TGrayscaleMask; overload; override; + function GetPart(const ARect: TRect): TGrayscaleMask; override; + function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TByteMask; + AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TGrayscaleMask; override; + function RotateCW: TGrayscaleMask; override; + function RotateCCW: TGrayscaleMask; override; + function RotateUD: TGrayscaleMask; override; + function FilterContour(ABorderValue: byte = 0): TGrayscaleMask; + function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; + function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; + function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; + function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; + function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override; + function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override; + function FilterCustomBlur(mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override; + function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override; + function FilterSphere: TGrayscaleMask; + function FilterCylinder: TGrayscaleMask; + end; + +procedure DownSamplePutImageGrayscale(sourceData: PByte; sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth, sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect); overload; +procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect); overload; +procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload; +procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload; +procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload; + +procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, + y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; + texture: IBGRAScanner; RGBOrder: boolean); + +const + ByteMaskBlack : TByteMask = (gray:0); + ByteMaskWhite : TByteMask = (gray:255); + +operator = (const c1, c2: TByteMask): boolean; inline; + +implementation + +uses BGRABlend, BGRATransform; + +operator = (const c1, c2: TByteMask): boolean; +begin + result := c1.gray = c2.gray; +end; + +procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, + y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; + texture: IBGRAScanner; RGBOrder: boolean); +var delta: Int32or64; +begin + delta := mask.Width; + BGRABlend.BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLineByte[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder); +end; + +procedure ByteMaskSolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PByteMask(AContextData^.Dest), ACount); +end; + +procedure ByteMaskChunkSetPixels( + ASource: PByteMask; ADest: PByteMask; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + if ASourceStride = 1 then + begin + move(ASource^, ADest^, ACount); + inc(ASource, ACount); + end else + while ACount > 0 do + begin + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + ASource^.gray*alphaOver + 32768) shr 16; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure ByteMaskChunkXorPixels( + ASource: PByteMask; ADest: PByteMask; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + temp: Byte; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + if ASourceStride = 1 then + begin + move(ASource^, ADest^, ACount); + inc(ASource, ACount); + end else + while ACount > 0 do + begin + ADest^.gray := ADest^.gray xor ASource^.gray; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + temp := ADest^.gray xor ASource^.gray; + ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + temp*alphaOver + 32768) shr 16; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure ByteMaskSolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PByteMask; +begin + pDest := PByteMask(AContextData^.Dest); + ByteMaskChunkSetPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure ByteMaskSolidBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PByteMask; +begin + pDest := PByteMask(AContextData^.Dest); + ByteMaskChunkXorPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +type + PByteMaskScannerBrushFixedData = ^TByteMaskScannerBrushFixedData; + TByteMaskScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + Conversion: TBridgedConversion; + end; + +procedure ByteMaskScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure ByteMaskScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PByteMask; + qty, pixSize: Integer; + buf: packed array[0..31] of TByteMask; +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PByteMask(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PByteMask(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil); + ByteMaskChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ByteMaskScannerConvertBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PByteMask; + qty, pixSize: Integer; + buf: packed array[0..31] of TByteMask; +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PByteMask(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PByteMask(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil); + ByteMaskChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ByteMaskScannerChunkBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PByteMask; + qty: Integer; +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PByteMask(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PByteMask(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ByteMaskChunkSetPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ByteMaskScannerChunkBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PByteMask; + qty: Integer; +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PByteMask(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PByteMask(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ByteMaskChunkXorPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ByteMaskMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PByteMask; + qty, maskStride: Integer; + pMask: PByteMask; + factor: UInt32or64; +begin + with PByteMaskScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PByteMask(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PByteMask(AContextData^.Dest); + if AAlpha = 65535 then + begin + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.gray := ApplyOpacity(pDest^.gray, pMask^.gray); + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end else + begin + factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.gray := (pDest^.gray*((factor*pMask^.gray+128) shr 8)) shr 16; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end; + PByteMask(AContextData^.Dest) := pDest; + end; +end; + +procedure ByteMaskBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PByteMask; + alphaMul,eraseMul: UInt32or64; +begin + pDest := PByteMask(AContextData^.Dest); + if AAlpha>=32768 then alphaMul := AAlpha+1 else alphaMul := AAlpha; + eraseMul := PWord(AFixedData)^; + if eraseMul>=32768 then inc(eraseMul); + eraseMul := 65536 - (eraseMul*alphaMul shr 16); + while ACount > 0 do + begin + pDest^.gray:= pDest^.gray*eraseMul shr 16; + dec(ACount); + inc(pDest); + end; + AContextData^.Dest := pDest; +end; + +{ TGrayscaleMask } + +function TGrayscaleMask.InternalNew: TCustomUniversalBitmap; +begin + Result:= TGrayscaleMask.Create; +end; + +procedure TGrayscaleMask.AssignTransparentPixel(out ADest); +begin + TByteMask(ADest).gray := 0; +end; + +function TGrayscaleMask.InternalGetPixelCycle256(ix, iy: int32or64; iFactX, + iFactY: int32or64): TByteMask; +var + ixMod2: int32or64; + pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask; + scan: PByteMask; +begin + scan := GetScanlineFast(iy); + + pUpLeft := (scan + ix); + ixMod2 := ix+1; + if ixMod2=Width then ixMod2 := 0; + pUpRight := (scan + ixMod2); + + Inc(iy); + if iy = Height then iy := 0; + scan := GetScanlineFast(iy); + pDownLeft := (scan + ix); + pDownRight := (scan + ixMod2); + + InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, + pDownRight, iFactX, iFactY, @result); +end; + +function TGrayscaleMask.InternalGetPixel256(ix, iy: int32or64; iFactX, + iFactY: int32or64; smoothBorder: boolean): TByteMask; +var + pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask; + scan: PByteMask; +begin + if (iy >= 0) and (iy < FHeight) then + begin + scan := GetScanlineFast(iy); + + if (ix >= 0) and (ix < FWidth) then + pUpLeft := scan+ix + else if smoothBorder then + pUpLeft := @ByteMaskBlack + else + pUpLeft := nil; + + if (ix+1 >= 0) and (ix+1 < FWidth) then + pUpRight := scan+(ix+1) + else if smoothBorder then + pUpRight := @ByteMaskBlack + else + pUpRight := nil; + end else + if smoothBorder then + begin + pUpLeft := @ByteMaskBlack; + pUpRight := @ByteMaskBlack; + end else + begin + pUpLeft := nil; + pUpRight := nil; + end; + + if (iy+1 >= 0) and (iy+1 < FHeight) then + begin + scan := GetScanlineFast(iy+1); + + if (ix >= 0) and (ix < FWidth) then + pDownLeft := scan+ix + else if smoothBorder then + pDownLeft := @ByteMaskBlack + else + pDownLeft := nil; + + if (ix+1 >= 0) and (ix+1 < FWidth) then + pDownRight := scan+(ix+1) + else if smoothBorder then + pDownRight := @ByteMaskBlack + else + pDownRight := nil; + end else + if smoothBorder then + begin + pDownLeft := @ByteMaskBlack; + pDownRight := @ByteMaskBlack; + end else + begin + pDownLeft := nil; + pDownRight := nil; + end; + + InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, + pDownRight, iFactX, iFactY, @result); +end; + +procedure TGrayscaleMask.Init; +begin + inherited Init; + ScanInterpolationFilter := rfLinear; +end; + +function TGrayscaleMask.GetScanLine(Y: Integer): PByte; +begin + result := PByte(GetScanLineByte(y)); +end; + +procedure TGrayscaleMask.CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel); +var psrc: PByte; + pdest: PByte; + x,y: integer; + ofs: Int32or64; +begin + SetSize(ABitmap.Width, ABitmap.Height); + if NbPixels > 0 then + begin + pdest := DataByte; + ofs := TBGRAPixel_ChannelByteOffset[AChannel]; + for y := 0 to FHeight-1 do + begin + psrc := PByte(ABitmap.ScanLine[y])+ofs; + for x := FWidth-1 downto 0 do + begin + pdest^ := psrc^; + inc(pdest); + inc(psrc,sizeof(TBGRAPixel)); + end; + end; + end; +end; + +procedure TGrayscaleMask.CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); +begin + inherited CopyPropertiesTo(ABitmap); + if ABitmap is TGrayscaleMask then + begin + TGrayscaleMask(ABitmap).ScanInterpolationFilter:= self.ScanInterpolationFilter; + end; +end; + +function TGrayscaleMask.GetImageBounds: TRect; +begin + Result:= GetImageBounds(cGreen); +end; + +function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect; + Channel: TChannel; ANothingValue: Byte): TRect; +var + minx, miny, maxx, maxy: integer; + xb, xb2, yb: integer; + p: PByte; + actualRect: TRect; +begin + if Channel = cAlpha then raise exception.Create('Channel not found'); + actualRect := TRect.Intersect(ARect,rect(0,0,self.Width,self.Height)); + maxx := actualRect.Left-1; + maxy := actualRect.Top-1; + minx := actualRect.Right; + miny := actualRect.Bottom; + for yb := actualRect.Top to actualRect.Bottom-1 do + begin + p := GetPixelAddress(actualRect.Left,yb); + for xb := actualRect.Left to actualRect.Right - 1 do + begin + if p^<>ANothingValue then + begin + if xb < minx then minx := xb; + if yb < miny then miny := yb; + if xb > maxx then maxx := xb; + if yb > maxy then maxy := yb; + + inc(p, actualRect.Right-1-xb); + for xb2 := actualRect.Right-1 downto xb+1 do + begin + if p^ <> ANothingValue then + begin + if xb2 > maxx then maxx := xb2; + break; + end; + dec(p); + end; + break; + end; + Inc(p); + end; + end; + if minx > maxx then + begin + Result.left := 0; + Result.top := 0; + Result.right := 0; + Result.bottom := 0; + end + else + begin + Result.left := minx; + Result.top := miny; + Result.right := maxx + 1; + Result.bottom := maxy + 1; + end; +end; + +function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect; + Channels: TChannels; ANothingValue: Byte): TRect; +begin + if cAlpha in Channels then raise exception.Create('Channel not found') + else if Channels = [] then result := EmptyRect + else result := GetImageBoundsWithin(ARect, cGreen, ANothingValue); +end; + +class procedure TGrayscaleMask.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TByteMask; ADrawMode: TDrawMode); +begin + ABrush.Colorspace := TByteMaskColorspace; + PByteMask(@ABrush.FixedData)^ := AColor; + if ADrawMode <> dmXor then + ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushSetPixels + else + ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushXorPixels; +end; + +class procedure TGrayscaleMask.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; AOffsetX: integer; + AOffsetY: integer); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TByteMaskColorspace; + with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if sourceSpace = TByteMaskColorspace then + begin + if ADrawMode <> dmXor then + ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushSetPixels + else + ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushXorPixels; + end else + begin + with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TByteMaskColorspace); + if ADrawMode <> dmXor then + ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushSetPixels + else + ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushXorPixels; + end; +end; + +class procedure TGrayscaleMask.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TByteMaskColorspace; + with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @ByteMaskMaskBrushApply; +end; + +class procedure TGrayscaleMask.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + ABrush.Colorspace := TByteMaskColorspace; + PWord(@ABrush.FixedData)^ := AAlpha; + ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels; +end; + +class procedure TGrayscaleMask.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + ABrush.Colorspace := TByteMaskColorspace; + PWord(@ABrush.FixedData)^ := not AAlpha; + ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels; +end; + +constructor TGrayscaleMask.Create(AWidth, AHeight: Integer; AValue: byte); +begin + inherited Create(AWidth, AHeight, TByteMask.New(AValue)); +end; + +constructor TGrayscaleMask.Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel); +begin + inherited Create(0,0); + CopyFrom(ABitmap, AChannel); +end; + +constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth, + AHeight: integer); +begin + CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height)); +end; + +constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth, + AHeight: integer); +begin + CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height)); +end; + +constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth, + AHeight: integer; ASourceRect: TRect); +begin + inherited Create(0,0); + if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then + CopyFrom(ABitmap,cGreen) + else + begin + if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then + raise exception.Create('Original size smaller'); + SetSize(AWidth,AHeight); + if NbPixels > 0 then + DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect); + end; +end; + +constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth, + AHeight: integer; ASourceRect: TRect); +begin + inherited Create(0,0); + if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then + CopyFrom(ABitmap) + else + begin + if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then + raise exception.Create('Original size smaller'); + SetSize(AWidth,AHeight); + if NbPixels > 0 then + DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect); + end; +end; + +procedure TGrayscaleMask.CopyFrom(ABitmap: TGrayscaleMask); +begin + SetSize(ABitmap.Width, ABitmap.Height); + if NbPixels > 0 then + move(ABitmap.Data^, Data^, NbPixels); +end; + +procedure TGrayscaleMask.Draw(ABitmap: TBGRACustomBitmap; X, Y: Integer; AGammaCorrection: boolean = false); +var + yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, + i, delta_source, delta_dest: integer; + pdest: PBGRAPixel; + psource: PByte; + value: byte; +begin + if not CheckPutImageBounds(x,y,FWidth,Fheight,minxb,minyb,maxxb,maxyb,ignoreleft,ABitmap.ClipRect) then exit; + copycount := maxxb - minxb + 1; + + psource := ScanLineByte[minyb - y] + ignoreleft; + delta_source := FWidth; + + pdest := ABitmap.Scanline[minyb] + minxb; + if ABitmap.LineOrder = riloBottomToTop then + delta_dest := -ABitmap.Width + else + delta_dest := ABitmap.Width; + + Dec(delta_source, copycount); + Dec(delta_dest, copycount); + for yb := minyb to maxyb do + begin + if AGammaCorrection then + begin + for i := copycount -1 downto 0 do + begin + value := GammaCompressionTab[psource^ + (psource^ shl 8)]; + pdest^ := BGRA(value,value,value,255); + inc(psource); + inc(pdest); + end; + end else + begin + for i := copycount -1 downto 0 do + begin + value := psource^; + pdest^ := BGRA(value,value,value,255); + inc(psource); + inc(pdest); + end; + end; + Inc(psource, delta_source); + Inc(pdest, delta_dest); + end; + ABitmap.InvalidateBitmap; +end; + +procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; const c: TBGRAPixel); +begin + ABitmap.FillMask(x,y, self, c, dmDrawWithTransparency); +end; + +procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; texture: IBGRAScanner); +begin + ABitmap.FillMask(x,y, self, texture, dmDrawWithTransparency); +end; + +function TGrayscaleMask.GetPixel(X, Y: integer): byte; +begin + if (x < 0) or (x >= FWidth) then + raise ERangeError.Create('GetPixel: out of bounds'); + result := (ScanLineByte[Y]+X)^; +end; + +procedure TGrayscaleMask.SetPixel(X, Y: integer; AValue: byte); +begin + if (x < 0) or (x >= FWidth) then + raise ERangeError.Create('SetPixel: out of bounds'); + (ScanLineByte[Y]+X)^ := AValue; +end; + +function TGrayscaleMask.GetPixel(x, y: single; + AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + ix := round(x*256); + if (ix<= -256) or (ix>=Width shl 8) then + begin + result := ByteMaskBlack; + exit; + end; + iy := round(y*256); + if (iy<= -256) or (iy>=Height shl 8) then + begin + result := ByteMaskBlack; + exit; + end; + + iFactX := ix and 255; //distance from integer coordinate + iFactY := iy and 255; + if ix<0 then ix := -1 else ix := ix shr 8; + if iy<0 then iy := -1 else iy := iy shr 8; + + //if the coordinate is integer, then call standard GetPixel function + if (iFactX = 0) and (iFactY = 0) then + begin + Result := (GetScanlineFast(iy)+ix)^; + exit; + end; + + result := InternalGetPixel256(ix,iy, FineInterpolation256(iFactX, AResampleFilter), + FineInterpolation256(iFactY, AResampleFilter), smoothBorder); +end; + +function TGrayscaleMask.GetPixel256(x, y, fracX256, fracY256: int32or64; + AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask; +begin + if (fracX256 = 0) and (fracY256 = 0) then + result := GetPixel(x,y) + else if AResampleFilter = rfBox then + begin + if fracX256 >= 128 then inc(x); + if fracY256 >= 128 then inc(y); + result := GetPixel(x,y); + end else + result := InternalGetPixel256(x,y, FineInterpolation256(fracX256,AResampleFilter), + FineInterpolation256(fracY256,AResampleFilter), smoothBorder); +end; + +procedure TGrayscaleMask.ScanNextMaskChunk(var ACount: integer; out + AMask: PByteMask; out AStride: integer); +var + pPixels: Pointer; +begin + ScanNextCustomChunk(ACount, pPixels); + AMask := PByteMask(pPixels); + AStride := sizeof(TByteMask); +end; + +function TGrayscaleMask.ScanAtIntegerMask(X, Y: integer): TByteMask; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + result := GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), + PositiveMod(Y+ScanOffset.Y, FScanHeight))^ + else + result := ByteMaskBlack; +end; + +function TGrayscaleMask.ScanAtMask(X, Y: Single): TByteMask; +var + ix, iy: Int32or64; + iFactX,iFactY: Int32or64; +begin + if (FScanWidth = 0) or (FScanHeight = 0) then + begin + result := BGRAPixelTransparent; + exit; + end; + LoadFromBitmapIfNeeded; + ix := round(x*256); + iy := round(y*256); + if ScanInterpolationFilter = rfBox then + begin + ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; + iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; + result := (GetScanlineFast(iy)+ix)^; + exit; + end; + iFactX := ix and 255; + iFactY := iy and 255; + ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; + iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; + if (iFactX = 0) and (iFactY = 0) then + begin + result := (GetScanlineFast(iy)+ix)^; + exit; + end; + if ScanInterpolationFilter <> rfLinear then + begin + iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); + iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); + end; + result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); +end; + +function TGrayscaleMask.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + Result:= MaskToBGRA(ScanAtIntegerMask(X, Y)); +end; + +function TGrayscaleMask.ScanAt(X, Y: Single): TBGRAPixel; +begin + Result:= MaskToBGRA(ScanAtMask(X, Y)); +end; + +procedure TGrayscaleMask.Negative; +begin + NegativeRect(rect(0, 0, Width, Height)); +end; + +procedure TGrayscaleMask.NegativeRect(ABounds: TRect); +var + yb, w, xb: LongInt; + p: PByte; +begin + ABounds.Intersect(ClipRect); + w := ABounds.Width; + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + p := GetPixelAddress(ABounds.Left, yb); + for xb := w-1 downto 0 do + begin + p^ := not p^; + inc(p); + end; + end; +end; + +procedure TGrayscaleMask.InplaceNormalize; +begin + InplaceNormalize(rect(0, 0, Width, Height)); +end; + +procedure TGrayscaleMask.InplaceNormalize(ABounds: TRect); +var + yb, w, xb: LongInt; + p: PByte; + minVal, maxVal, spread: byte; +begin + ABounds.Intersect(ClipRect); + if ABounds.IsEmpty then exit; + minVal := 255; + maxVal := 0; + w := ABounds.Width; + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + p := GetPixelAddress(ABounds.Left, yb); + for xb := w-1 downto 0 do + begin + if p^ < minVal then minVal := p^; + if p^ > maxVal then maxVal := p^; + inc(p); + end; + end; + if (minVal > 0) or (maxVal < 255) then + begin + if minVal = maxVal then + begin + if (minVal > 0) and (minVal < 255) then + FillRect(ABounds, TByteMask.New(255)); + end else + begin + spread := maxVal - minVal; + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + p := GetPixelAddress(ABounds.Left, yb); + for xb := w-1 downto 0 do + begin + p^ := (p^ - minVal) * 255 div spread; + inc(p); + end; + end; + end; + end; +end; + +function TGrayscaleMask.NewBitmap: TGrayscaleMask; +begin + Result:=inherited NewBitmap as TGrayscaleMask; +end; + +function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer): TGrayscaleMask; +begin + Result:=inherited NewBitmap(AWidth, AHeight) as TGrayscaleMask; +end; + +function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer; + const Color: TByteMask): TGrayscaleMask; +begin + Result:=inherited NewBitmap(AWidth, AHeight, Color) as TGrayscaleMask; +end; + +function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer; AColor: Pointer + ): TGrayscaleMask; +begin + Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TGrayscaleMask; +end; + +function TGrayscaleMask.NewReference: TGrayscaleMask; +begin + Result:=inherited NewReference as TGrayscaleMask; +end; + +function TGrayscaleMask.GetUnique: TGrayscaleMask; +begin + Result:=inherited GetUnique as TGrayscaleMask; +end; + +function TGrayscaleMask.Duplicate(DuplicateProperties: Boolean): TGrayscaleMask; +begin + Result:=inherited Duplicate(DuplicateProperties) as TGrayscaleMask; +end; + +function TGrayscaleMask.GetPart(const ARect: TRect): TGrayscaleMask; +begin + Result:=inherited GetPart(ARect) as TGrayscaleMask; +end; + +function TGrayscaleMask.CreateBrushTexture(ABrushStyle: TBrushStyle; + APatternColor, ABackgroundColor: TByteMask; AWidth: integer; + AHeight: integer; APenWidth: single): TGrayscaleMask; +begin + Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, + ABackgroundColor, AWidth, AHeight, APenWidth) as TGrayscaleMask; +end; + +function TGrayscaleMask.RotateCW: TGrayscaleMask; +begin + Result:=inherited RotateCW as TGrayscaleMask; +end; + +function TGrayscaleMask.RotateCCW: TGrayscaleMask; +begin + Result:=inherited RotateCCW as TGrayscaleMask; +end; + +function TGrayscaleMask.RotateUD: TGrayscaleMask; +begin + Result:=inherited RotateUD as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterContour(ABorderValue: byte = 0): TGrayscaleMask; +var + pDest: PByte; + + procedure ComputeDiff(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; + var diff: Integer; + begin + diff := (abs((pCurRow+x+1)^ - (pCurRow+x-1)^) + + abs((pPrevRow+x-1)^ - (pNextRow+x+1)^) + + abs((pPrevRow+x)^ - (pNextRow+x)^) + + abs((pPrevRow+x+1)^ - (pNextRow+x-1)^)) div 3; + if diff > 255 then + (pDest+x)^ := 0 + else (pDest+x)^ := not Byte(diff); + end; + + procedure ComputeDiffLeft(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; + var diff: Integer; + begin + diff := (abs((pCurRow+x+1)^ - ABorderValue) + + abs(ABorderValue - (pNextRow+x+1)^) + + abs((pPrevRow+x)^ - (pNextRow+x)^) + + abs((pPrevRow+x+1)^ - ABorderValue)) div 3; + if diff > 255 then + (pDest+x)^ := 0 + else (pDest+x)^ := not Byte(diff); + end; + + procedure ComputeDiffRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; + var diff: Integer; + begin + diff := (abs(ABorderValue - (pCurRow+x-1)^) + + abs((pPrevRow+x-1)^ - ABorderValue) + + abs((pPrevRow+x)^ - (pNextRow+x)^) + + abs(ABorderValue - (pNextRow+x-1)^)) div 3; + if diff > 255 then + (pDest+x)^ := 0 + else (pDest+x)^ := not Byte(diff); + end; + + procedure ComputeDiffLeftRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; + var diff: Integer; + begin + diff := abs((pPrevRow+x)^ - (pNextRow+x)^) div 3; + if diff > 255 then + (pDest+x)^ := 0 + else (pDest+x)^ := not Byte(diff); + end; + +var + pPrevRow, pCurRow, pNextRow, pBorder: PByte; + border: packed array of byte; + yb, xb: Integer; + +begin + if NbPixels = 0 then exit; + result := TGrayscaleMask.Create; + result.SetSize(Width, Height); + setlength(border, Width); + for xb := 0 to Width-1 do + border[xb] := ABorderValue; + pBorder := @border[0]; + pPrevRow := nil; + pCurRow := nil; + pNextRow := ScanLine[0]; + for yb := 0 to Height-1 do + begin + pPrevRow := pCurRow; + pCurRow := pNextRow; + if yb < Height-1 then + pNextRow := ScanLine[yb+1] + else pNextRow := nil; + pDest := result.ScanLine[yb]; + + if pPrevRow = nil then + begin + if pNextRow = nil then + begin + if Width = 1 then + ComputeDiffLeftRight(0, pBorder, pCurRow, pBorder) else + begin + ComputeDiffLeft(0, pBorder, pCurRow, pBorder); + for xb := 1 to Width-2 do + ComputeDiff(xb, pBorder, pCurRow, pBorder); + ComputeDiffRight(Width-1, pBorder, pCurRow, pBorder); + end; + end else + begin + if Width = 1 then + ComputeDiffLeftRight(0, pBorder, pCurRow, pNextRow) else + begin + ComputeDiffLeft(0, pBorder, pCurRow, pNextRow); + for xb := 1 to Width-2 do + ComputeDiff(xb, pBorder, pCurRow, pNextRow); + ComputeDiffRight(Width-1, pBorder, pCurRow, pNextRow); + end; + end; + end else + if pNextRow = nil then + begin + if Width = 1 then + ComputeDiffLeftRight(0, pPrevRow, pCurRow, pBorder) else + begin + ComputeDiffLeft(0, pPrevRow, pCurRow, pBorder); + for xb := 1 to Width-2 do + ComputeDiff(xb, pPrevRow, pCurRow, pBorder); + ComputeDiffRight(Width-1, pPrevRow, pCurRow, pBorder); + end; + end else + begin + if Width = 1 then + ComputeDiffLeftRight(0, pPrevRow, pCurRow, pNextRow) else + begin + ComputeDiffLeft(0, pPrevRow, pCurRow, pNextRow); + for xb := 1 to Width-2 do + ComputeDiff(xb, pPrevRow, pCurRow, pNextRow); + ComputeDiffRight(Width-1, pPrevRow, pCurRow, pNextRow); + end; + end; + end; +end; + +function TGrayscaleMask.FilterBlurRadial(radius: single; + blurType: TRadialBlurType): TGrayscaleMask; +begin + Result:=inherited FilterBlurRadial(radius, blurType) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radius: single; + blurType: TRadialBlurType): TGrayscaleMask; +begin + Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterBlurRadial(radiusX, radiusY: single; + blurType: TRadialBlurType): TGrayscaleMask; +begin + Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radiusX, + radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; +begin + Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterBlurMotion(distance: single; angle: single; + oriented: boolean): TGrayscaleMask; +begin + Result:=inherited FilterBlurMotion(distance, angle, oriented) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterBlurMotion(const ABounds: TRect; + distance: single; angle: single; oriented: boolean): TGrayscaleMask; +begin + Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterCustomBlur(mask: TCustomUniversalBitmap + ): TGrayscaleMask; +begin + Result:=inherited FilterCustomBlur(mask) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterCustomBlur(const ABounds: TRect; + mask: TCustomUniversalBitmap): TGrayscaleMask; +begin + Result:=inherited FilterCustomBlur(ABounds, mask) as TGrayscaleMask; +end; + +function TGrayscaleMask.FilterSphere: TGrayscaleMask; +var + cx, cy: single; + scanner: TBGRASphereDeformationScanner; +begin + Result := NewBitmap(Width, Height); + cx := Width / 2 - 0.5; + cy := Height / 2 - 0.5; + scanner := TBGRASphereDeformationScanner.Create(self, PointF(cx,cy), Width/2, Height/2); + result.FillEllipseAntialias(cx, cy, Width/2-0.5, Height/2-0.5, scanner); + scanner.Free; +end; + +function TGrayscaleMask.FilterCylinder: TGrayscaleMask; +var + cx: single; + scanner: TBGRAVerticalCylinderDeformationScanner; +begin + Result := NewBitmap(Width, Height); + cx := Width / 2 - 0.5; + scanner := TBGRAVerticalCylinderDeformationScanner.Create(self, cx, Width/2); + result.Fill(scanner, dmSet); + scanner.Free; +end; + +procedure DownSamplePutImageGrayscale(sourceData: PByte; + sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth, + sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect); +var + x_dest,y_dest: integer; + pdest: PByte; + nbPix,sum: UInt32or64; + prev_x_src,x_src,x_src_nb,xb: Int32or64; + x_src_inc,x_src_acc,x_src_div,x_src_rest: Int32or64; + prev_y_src,y_src,y_src_nb,yb: Int32or64; + y_src_inc,y_src_acc,y_src_div,y_src_rest: Int32or64; + psrc,psrc2,psrc3: PByte; +begin + y_src_div := ADestRect.Bottom-ADestRect.Top; + y_src_inc := sourceHeight div y_src_div; + y_src_rest := sourceHeight mod y_src_div; + x_src_div := ADestRect.Right-ADestRect.Left; + x_src_inc := sourceWidth div x_src_div; + x_src_rest := sourceWidth mod x_src_div; + + if (x_src_rest = 0) and (y_src_rest = 0) then + begin + x_src_nb := x_src_inc; + y_src_nb := y_src_inc; + nbPix := x_src_nb*y_src_nb; + y_src := 0; + for y_dest := ADestRect.Top to ADestRect.Bottom-1 do + begin + pdest := dest.GetPixelAddress(ADestRect.Left, y_dest); + psrc := sourceData + y_src*sourceRowDelta; + inc(y_src,y_src_inc); + + for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do + begin + sum := 0; + psrc2 := psrc; + for xb := x_src_nb-1 downto 0 do + begin + psrc3 := psrc2; + for yb := y_src_nb-1 downto 0 do + begin + inc(sum, psrc3^); + inc(psrc3, sourceRowDelta); + end; + inc(psrc2, sourcePixelSize); + end; + pdest^ := sum div nbPix; + + psrc := psrc2; + inc(pdest); + end; + end; + end else + begin + y_src := 0; + y_src_acc := 0; + for y_dest := ADestRect.Top to ADestRect.Bottom-1 do + begin + pdest := dest.GetPixelAddress(ADestRect.Left, y_dest); + psrc := sourceData + y_src*sourceRowDelta; + + prev_y_src := y_src; + inc(y_src,y_src_inc); + inc(y_src_acc,y_src_rest); + if y_src_acc >= y_src_div then + begin + dec(y_src_acc,y_src_div); + inc(y_src); + end; + y_src_nb := y_src-prev_y_src; + + x_src := 0; + x_src_acc := 0; + for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do + begin + prev_x_src := x_src; + inc(x_src,x_src_inc); + inc(x_src_acc,x_src_rest); + if x_src_acc >= x_src_div then + begin + dec(x_src_acc,x_src_div); + inc(x_src); + end; + x_src_nb := x_src-prev_x_src; + + sum := 0; + nbPix := 0; + psrc2 := psrc; + for xb := x_src_nb-1 downto 0 do + begin + psrc3 := psrc2; + for yb := y_src_nb-1 downto 0 do + begin + inc(nbPix); + inc(sum, psrc3^); + inc(psrc3, sourceRowDelta); + end; + inc(psrc2, sourcePixelSize); + end; + pdest^ := sum div nbPix; + + psrc := psrc2; + inc(pdest); + end; + end; + end; +end; + +procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; + dest: TGrayscaleMask; ADestRect: TRect); +begin + DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height)); +end; + +procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload; +begin + DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height)); +end; + +procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; + dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); +var delta: Int32or64; +begin + delta := source.Width*sizeof(TBGRAPixel); + if source.LineOrder = riloBottomToTop then + delta := -delta; + DownSamplePutImageGrayscale( + source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top) + TBGRAPixel_GreenByteOffset, + sizeof(TBGRAPixel), delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect); +end; + +procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; + dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); +var delta: Int32or64; +begin + delta := source.Width; + if source.LineOrder = riloBottomToTop then + delta := -delta; + DownSamplePutImageGrayscale(source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top), 1, + delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgragtkbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgragtkbitmap.pas new file mode 100644 index 0000000..d8f8750 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgragtkbitmap.pas @@ -0,0 +1,339 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgragtkbitmap.pas + ----------------- + This unit should NOT be added to the 'uses' clause. + It contains patches for Gtk. +} + +unit BGRAGtkBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALCLBitmap, Graphics, + GraphType; + +type + { TBGRAGtkBitmap } + + TBGRAGtkBitmap = class(TBGRALCLBitmap) + private + FPixBuf: Pointer; + procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect); + procedure DrawOpaque(ACanvas: TCanvas; ARect: TRect); + protected + procedure ReallocData; override; + procedure FreeData; override; + public + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); + override; + procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); override; + procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); overload; override; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; ADataFirstRow: Pointer; + ARowStride: integer; AWidth, AHeight: integer); overload; + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; + end; + +implementation + +uses BGRABitmapTypes, BGRADefaultBitmap, BGRAFilterScanner, LCLType, + LCLIntf, IntfGraphics, + {$IFDEF LCLgtk2} + gdk2, gtk2def, gdk2pixbuf, glib2, + {$ENDIF} + {$IFDEF LCLgtk} + gdk, gtkdef, gtkProc, gdkpixbuf, glib, + {$ENDIF} + FPImage, Dialogs; + +procedure TBGRAGtkBitmap.ReallocData; +begin + {$IFDEF LCLgtk2} + If FPixBuf <> nil then g_object_unref(FPixBuf); + {$ELSE} + If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf); + {$ENDIF} + FPixBuf := nil; + inherited ReallocData; + if (FWidth <> 0) and (FHeight <> 0) then + begin + FPixbuf := gdk_pixbuf_new_from_data(pguchar(FDataByte), + GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil); + if FPixbuf = nil then + raise Exception.Create('Error initializing Pixbuf'); + end; +end; + +procedure TBGRAGtkBitmap.FreeData; +begin + {$IFDEF LCLgtk2} + If FPixBuf <> nil then g_object_unref(FPixBuf); + {$ELSE} + If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf); + {$ENDIF} + FPixBuf := nil; + inherited FreeData; +end; + +procedure TBGRAGtkBitmap.DrawTransparent(ACanvas: TCanvas; Rect: TRect); +var DrawWidth,DrawHeight: integer; + stretched: TBGRAGtkBitmap; + P: TPoint; +begin + DrawWidth := Rect.Right-Rect.Left; + DrawHeight := Rect.Bottom-Rect.Top; + if (Height = 0) or (Width = 0) or (DrawWidth <= 0) or (DrawHeight <= 0) then + exit; + + if (DrawWidth <> Width) or (DrawHeight <> Height) then + begin + stretched := Resample(DrawWidth,DrawHeight,rmSimpleStretch) as TBGRAGtkBitmap; + stretched.DrawTransparent(ACanvas,Rect); + stretched.Free; + exit; + end; + + LoadFromBitmapIfNeeded; + + {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} + + P := Rect.TopLeft; + LPToDP(ACanvas.Handle, P, 1); + gdk_pixbuf_render_to_drawable(FPixBuf, + TGtkDeviceContext(ACanvas.Handle).Drawable, + TGtkDeviceContext(ACanvas.Handle).GC, + 0,0, P.X,P.Y, + Width,Height, + GDK_RGB_DITHER_NORMAL,0,0); + + {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} +end; + +procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; ARect: TRect); +begin + DataDrawOpaque(ACanvas,ARect,Data,LineOrder,Width,Height); +end; + +procedure TBGRAGtkBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + TempGtk: TBGRAGtkBitmap; + temp: integer; +begin + if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or + (Rect.Top = Rect.Bottom) then + exit; + + if Rect.Right < Rect.Left then + begin + temp := Rect.Left; + Rect.Left := Rect.Right; + Rect.Right := temp; + end; + + if Rect.Bottom < Rect.Top then + begin + temp := Rect.Top; + Rect.Top := Rect.Bottom; + Rect.Bottom := temp; + end; + + TempGtk := TBGRAGtkBitmap.Create(AWidth, AHeight); + Move(AData^,TempGtk.Data^,TempGtk.NbPixels*sizeof(TBGRAPixel)); + if ALineOrder <> TempGtk.LineOrder then TempGtk.VerticalFlip; + TempGtk.DrawTransparent(ACanvas,Rect); + TempGtk.Free; +end; + +procedure TBGRAGtkBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x, + y: integer; Opaque: boolean); +var + rowStride,w,h: Integer; +begin + if Opaque then + begin + if LineOrder = riloTopToBottom then + rowStride := Width*sizeof(TBGRAPixel) + else + rowStride := -Width*sizeof(TBGRAPixel); + w:= ARect.Right-ARect.Left; + h:= ARect.Bottom-ARect.Top; + DataDrawOpaque(ACanvas, rect(x,y,x+w,y+h), Scanline[ARect.Top]+ARect.Left, rowStride, w,h); + end + else + inherited DrawPart(ARect, ACanvas, x, y, Opaque); +end; + +procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + if self = nil then + exit; + if Opaque then + DrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height)) + else + DrawTransparent(ACanvas, Rect(X, Y, X + Width, Y + Height)); +end; + +procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +begin + if self = nil then + exit; + if Opaque then + DrawOpaque(ACanvas, Rect) + else + DrawTransparent(ACanvas, Rect); +end; + +procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + rowStride: Integer; + firstRow: Pointer; +begin + if ALineOrder = riloTopToBottom then + begin + rowStride := AWidth*sizeof(TBGRAPixel); + firstRow := AData; + end + else + begin + rowStride := -AWidth*sizeof(TBGRAPixel); + firstRow := PBGRAPixel(AData) + (AWidth*(AHeight-1)); + end; + + DataDrawOpaque(ACanvas, ARect, firstRow, rowStride, AWidth, AHeight); +end; + +procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; + ADataFirstRow: Pointer; ARowStride: integer; AWidth, AHeight: integer); + + procedure DataSwapRedBlue; + var + y: Integer; + p: PByte; + begin + p := PByte(ADataFirstRow); + for y := 0 to AHeight-1 do + begin + TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(PBGRAPixel(p),PBGRAPixel(p),AWidth,False); + inc(p, ARowStride); + end; + end; + + procedure DrawStretched; + var + dataStart: Pointer; + ptr: TBGRAPtrBitmap; + stretched: TBGRACustomBitmap; + begin + if ARowStride < 0 then + dataStart := PByte(ADataFirstRow) + ARowStride*(Height-1) + else + dataStart := ADataFirstRow; + + if ARowStride <> abs(AWidth*sizeof(TBGRAPixel)) then + raise exception.Create('DataDrawOpaque not supported when using custom row stride and resample'); + + ptr := TBGRAPtrBitmap.Create(AWidth,AHeight,dataStart); + if ARowStride < 0 then + ptr.LineOrder := riloBottomToTop + else + ptr.LineOrder := riloTopToBottom; + stretched := ptr.Resample(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + ptr.free; + DataDrawOpaque(ACanvas,ARect,stretched.Data,stretched.LineOrder,stretched.Width,stretched.Height); + stretched.Free; + end; + +var + temp: integer; + pos: TPoint; + dest: HDC; + +begin + if (AHeight = 0) or (AWidth = 0) or (ARect.Left = ARect.Right) or + (ARect.Top = ARect.Bottom) then exit; + + if ARect.Right < ARect.Left then + begin + temp := ARect.Left; + ARect.Left := ARect.Right; + ARect.Right := temp; + end; + + if ARect.Bottom < ARect.Top then + begin + temp := ARect.Top; + ARect.Top := ARect.Bottom; + ARect.Bottom := temp; + end; + + if (AWidth <> ARect.Right-ARect.Left) or (AHeight <> ARect.Bottom-ARect.Top) then + DrawStretched + else + begin + dest := ACanvas.Handle; + pos := ARect.TopLeft; + LPtoDP(dest, pos, 1); + {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP} + gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable, + TGtkDeviceContext(Dest).GC, pos.x,pos.y, + AWidth,AHeight, GDK_RGB_DITHER_NORMAL, + ADataFirstRow, ARowStride); + {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP} + ACanvas.Changed; + end; +end; + +procedure TBGRAGtkBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); +var + subBmp: TBGRACustomBitmap; + subRect: TRect; + cw,ch: integer; + P: TPoint; +begin + cw := CanvasSource.Width; + ch := CanvasSource.Height; + if (x < 0) or (y < 0) or (x+Width > cw) or + (y+Height > ch) then + begin + FillTransparent; + if (x+Width <= 0) or (y+Height <= 0) or + (x >= cw) or (y >= ch) then + exit; + + if (x > 0) then subRect.Left := x else subRect.Left := 0; + if (y > 0) then subRect.Top := y else subRect.Top := 0; + if (x+Width > cw) then subRect.Right := cw else + subRect.Right := x+Width; + if (y+Height > ch) then subRect.Bottom := ch else + subRect.Bottom := y+Height; + + subBmp := NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top); + subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top); + PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet); + subBmp.Free; + exit; + end; + + P := Point(x,y); + LPToDP(CanvasSource.Handle, P, 1); + gdk_pixbuf_get_from_drawable(FPixBuf, + TGtkDeviceContext(CanvasSource.Handle).Drawable, + nil, P.X,P.Y,0,0,Width,Height); + {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} + InvalidateBitmap; +end; + + +end. + + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraiconcursor.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraiconcursor.pas new file mode 100644 index 0000000..1976a85 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraiconcursor.pas @@ -0,0 +1,865 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAIconCursor; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, BGRAMultiFileType, BGRABitmapTypes; + +type + { TBGRAIconCursorEntry } + + TBGRAIconCursorEntry = class(TMultiFileEntry) + protected + FWidth,FHeight,FBitDepth: integer; + FExtension: string; + FContent: TStream; + FHotSpot: TPoint; + function GetName: utf8string; override; + procedure SetName({%H-}AValue: utf8string); override; + function GetExtension: utf8string; override; + function GetFileSize: int64; override; + public + constructor Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; AContent: TStream); + class function TryCreate(AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry; static; + destructor Destroy; override; + function CopyTo(ADestination: TStream): int64; override; + function GetStream: TStream; override; + function GetBitmap: TBGRACustomBitmap; + property Width: integer read FWidth; + property Height: integer read FHeight; + property BitDepth: integer read FBitDepth; + property HotSpot: TPoint read FHotSpot write FHotSpot; + end; + + { TBGRAIconCursor } + + TBGRAIconCursor = class(TMultiFileContainer) + private + function GetBitDepthAt(AIndex: integer): integer; + function GetHeightAt(AIndex: integer): integer; + function GetHotSpotAtAt(AIndex: integer): TPoint; + function GetWidthAt(AIndex: integer): integer; + procedure SetFileType(AValue: TBGRAImageFormat); + procedure SetHotSpotAt(AIndex: integer; AValue: TPoint); + protected + FFileType : TBGRAImageFormat; + FLoading : boolean; + function CreateEntry(AName: utf8string; AExtension: utf8string; + AContent: TStream): TMultiFileEntry; override; + function ExpectedMagic: Word; + procedure Init; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AFileType: TBGRAImageFormat); overload; + procedure Assign(Source: TPersistent); override; + function Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; AOverwrite: boolean = false): integer; overload; + function Add(AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; + procedure LoadFromStream(AStream: TStream); override; + procedure SaveToStream(ADestination: TStream); override; + function GetBitmap(AIndex: integer): TBGRACustomBitmap; + function GetBestFitBitmap(AWidth,AHeight: integer): TBGRACustomBitmap; + function IndexOf(AWidth,AHeight,ABitDepth: integer): integer; overload; + property FileType: TBGRAImageFormat read FFileType write SetFileType; + property Width[AIndex: integer]: integer read GetWidthAt; + property Height[AIndex: integer]: integer read GetHeightAt; + property BitDepth[AIndex: integer]: integer read GetBitDepthAt; + property HotSpot[AIndex: integer]: TPoint read GetHotSpotAtAt write SetHotSpotAt; + end; + +function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; ADithering: TDitheringAlgorithm): TBGRACustomBitmap; +function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer; + +implementation + +uses BGRAWinResource, BGRAUTF8, BGRAReadPng, BGRAReadBMP, FPWriteBMP, BGRAPalette, BGRAWritePNG, + BGRAColorQuantization{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; + +function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; + ADithering: TDitheringAlgorithm): TBGRACustomBitmap; +var + frameMask, temp: TBGRACustomBitmap; + quantizer: TBGRAColorQuantizer; + maskQuantizer: TBGRAColorQuantizer; + + x,y: integer; + psrc,pdest: PBGRAPixel; +begin + if ABitDepth <= 0 then + raise exception.Create('Invalid bit depth'); + + if ABitDepth <= 24 then + begin + if ABitDepth = 1 then + begin + quantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite,BGRAPixelTransparent],false,3); + result := quantizer.GetDitheredBitmap(ADithering, ABitmap); + quantizer.Free; + end + else + begin + frameMask := ABitmap.GetMaskFromAlpha; + maskQuantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite],false,2); + temp := maskQuantizer.GetDitheredBitmap(ADithering, frameMask); + frameMask.Free; + frameMask := temp; + maskQuantizer.Free; + + result := ABitmap.Duplicate; + result.ReplaceTransparent(BGRABlack); + result.AlphaFill(255); + + if ABitDepth <= 8 then + begin + quantizer := TBGRAColorQuantizer.Create(result,acFullChannelInPalette, 1 shl ABitDepth); + temp := quantizer.GetDitheredBitmap(daFloydSteinberg, result); + result.free; + result := temp; + quantizer.Free; + end; + + result.ApplyMask(frameMask); + frameMask.Free; + end; + end else + result := ABitmap.Duplicate; + + if Assigned(ABitmap.XorMask) then + begin + result.NeedXorMask; + for y := 0 to ABitmap.XorMask.Height-1 do + begin + psrc := ABitmap.XorMask.ScanLine[y]; + pdest := result.XorMask.ScanLine[y]; + for x := 0 to ABitmap.XorMask.Width-1 do + begin + if ((psrc^.red shl 1)+(psrc^.green shl 2)+psrc^.blue >= 128*(1+2+4)) then + pdest^ := BGRA(255,255,255,0); + inc(psrc); + inc(pdest); + end; + end; + end; +end; + +function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer; +var pal: TBGRAPalette; + p: PBGRAPixel; + n: integer; + + function BlackAndWhite: boolean; + var + i: Integer; + begin + if pal.Count > 2 then result := false + else + begin + for i := 0 to pal.Count-1 do + if (pal.Color[i] <> BGRAWhite) and (pal.Color[i] <> BGRABlack) then + exit(false); + result := true; + end; + end; + +begin + pal := TBGRAPalette.Create; + p := ABitmap.Data; + n := ABitmap.NbPixels; + while (n > 0) and (pal.Count < 257) do + begin + if p^.alpha = 0 then + begin + if pal.Count < 257 then pal.AddColor(BGRABlack); + end else + if p^.alpha = 255 then + begin + if pal.Count < 257 then pal.AddColor(p^); + end else + begin + pal.Free; + exit(32); + end; + inc(p); + dec(n); + end; + if pal.Count > 256 then result := 24 else + if pal.Count > 16 then result := 8 else + if (pal.Count > 2) or not BlackAndWhite then result := 4 else + result := 1; + pal.Free; +end; + +{ TBGRAIconCursorEntry } + +constructor TBGRAIconCursorEntry.Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; + AContent: TStream); +begin + inherited Create(AContainer); + FExtension:= AExtension; + FWidth := AInfo.Width; + FHeight:= AInfo.Height; + + // 16 bit per channel is not relevant for icon depth + if AInfo.ColorDepth >= 24 then + begin + if AInfo.AlphaDepth >= 8 then + FBitDepth := 32 + else + FBitDepth := 24; + end else + FBitDepth := AInfo.ColorDepth; + + FContent := AContent; +end; + +class function TBGRAIconCursorEntry.TryCreate( + AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry; +var + format: TBGRAImageFormat; + imageInfo: TQuickImageInfo; + tempStream: TMemoryStream; + reader: TBGRAImageReader; + bmp: TBGRACustomBitmap; + maskLine: packed array of byte; + maskStride: integer; + psrc: PBGRAPixel; + maskBit: byte; + maskPos,x,y: integer; + headerSize, dataSize: integer; +begin + AContent.Position:= 0; + format := DetectFileFormat(AContent); + case format of + ifBmp: + begin + reader := TBGRAReaderBMP.Create; + bmp := BGRABitmapFactory.Create; + try + AContent.Position := 0; + imageInfo := reader.GetQuickInfo(AContent); + if (imageInfo.width <= 0) or (imageInfo.height <= 0) or + (imageInfo.width > 256) or (imageInfo.height > 256) then + raise exception.Create('Invalid image size'); + AContent.Position := 0; + //load bitmap to build mask + bmp.LoadFromStream(AContent); + maskStride := ((bmp.Width+31) div 32)*4; + + tempStream := TMemoryStream.Create; + //BMP header is not stored in icon/cursor + AContent.Position:= sizeof(TBitMapFileHeader); + tempStream.CopyFrom(AContent, AContent.Size - sizeof(TBitMapFileHeader)); + AContent.Free; + + //fix height + tempStream.Position := 0; + headerSize := LEtoN(tempStream.ReadDWord); + if headerSize = sizeof(TOS2BitmapHeader) then // OS/2 1.x + begin + tempStream.Position := 6; + tempStream.WriteWord(NtoLE(word(bmp.Height*2))); //include mask size + end else + begin + tempStream.Position := 8; + tempStream.WriteDWord(NtoLE(LongWord(bmp.Height*2))); //include mask size + if headerSize >= 20+4 then + begin + tempStream.Position:= 20; + dataSize := LEtoN(tempStream.ReadDWord); + if dataSize <> 0 then + begin //if data size is supplied, include mask size + inc(dataSize, maskStride*bmp.Height); + tempStream.Position:= 20; + tempStream.WriteDWord(NtoLE(dataSize)); + end; + end; + end; + + //build mask + tempStream.Position := tempStream.Size; + setlength(maskLine, maskStride); + for y := bmp.Height-1 downto 0 do + begin + maskBit := $80; + maskPos := 0; + psrc := bmp.ScanLine[y]; + fillchar(maskLine[0], length(maskLine), 0); + for x := 0 to bmp.Width-1 do + begin + if psrc^.alpha = 0 then + maskLine[maskPos] := maskLine[maskPos] or maskBit; + maskBit := maskBit shr 1; + if maskBit = 0 then + begin + maskBit := $80; + inc(maskPos); + end; + inc(psrc); + end; + tempStream.WriteBuffer(maskLine[0], length(maskLine)); + end; + + result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, tempStream); + finally + bmp.Free; + reader.Free; + end; + end; + ifPng: + begin + reader := TBGRAReaderPNG.Create; + imageInfo := reader.GetQuickInfo(AContent); + reader.Free; + result := TBGRAIconCursorEntry.Create(AContainer, 'png', imageInfo, AContent); + + end; + ifUnknown, ifLazPaint {a headerless bmp can be confused for a headerless lzp}: + begin + //assume headerless BMP + AContent.Position := 0; + reader := TBGRAReaderBMP.Create; + imageInfo := reader.GetQuickInfo(AContent); + imageInfo.Height:= imageInfo.Height div 2; //mask size is included + reader.Free; + if (imageInfo.width <= 0) or (imageInfo.height <= 0) or + (imageInfo.width > 256) or (imageInfo.height > 256) then + raise exception.Create('Invalid image size'); + result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, AContent); + end; + else + raise exception.Create(SuggestImageExtension(format) + ' format is not handled'); + end; +end; + +destructor TBGRAIconCursorEntry.Destroy; +begin + FContent.Free; + inherited Destroy; +end; + +function TBGRAIconCursorEntry.CopyTo(ADestination: TStream): int64; +begin + if FContent.Size = 0 then + begin + result := 0; + exit; + end; + + FContent.Position := 0; + result := ADestination.CopyFrom(FContent, FContent.Size); +end; + +function TBGRAIconCursorEntry.GetStream: TStream; +begin + Result:= FContent; +end; + +function TBGRAIconCursorEntry.GetBitmap: TBGRACustomBitmap; +var reader: TBGRAImageReader; +begin + if Extension = 'dib' then + begin + reader := TBGRAReaderBMP.Create; + TBGRAReaderBMP(reader).Subformat := bsfHeaderlessWithMask; + end else + reader := TBGRAReaderPNG.create; + + result := BGRABitmapFactory.Create; + FContent.Position := 0; + try + result.LoadFromStream(FContent, reader); + except on ex: Exception do + begin + result.Free; + reader.Free; + raise ex; + end; + end; + reader.Free; + + result.HotSpot := HotSpot; +end; + +function TBGRAIconCursorEntry.GetName: utf8string; +begin + result := IntToStr(FWidth)+'x'+IntToStr(FHeight)+'x'+IntToStr(FBitDepth); +end; + +procedure TBGRAIconCursorEntry.SetName(AValue: utf8string); +begin + raise exception.Create('Name cannot be changed'); +end; + +function TBGRAIconCursorEntry.GetExtension: utf8string; +begin + result := FExtension; +end; + +function TBGRAIconCursorEntry.GetFileSize: int64; +begin + result := FContent.Size; +end; + +{ TBGRAIconCursor } + +function TBGRAIconCursor.GetBitDepthAt(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + result := TBGRAIconCursorEntry(Entry[AIndex]).BitDepth; +end; + +function TBGRAIconCursor.GetHeightAt(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + result := TBGRAIconCursorEntry(Entry[AIndex]).Height; +end; + +function TBGRAIconCursor.GetHotSpotAtAt(AIndex: integer): TPoint; +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + result := TBGRAIconCursorEntry(Entry[AIndex]).HotSpot; +end; + +function TBGRAIconCursor.GetWidthAt(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + result := TBGRAIconCursorEntry(Entry[AIndex]).Width; +end; + +procedure TBGRAIconCursor.SetFileType(AValue: TBGRAImageFormat); +begin + if FFileType=AValue then Exit; + if not (AValue in [ifIco,ifCur,ifUnknown]) then + raise exception.Create('Allowed formats: ICO, CUR or unknown'); + FFileType:=AValue; +end; + +procedure TBGRAIconCursor.SetHotSpotAt(AIndex: integer; AValue: TPoint); +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + TBGRAIconCursorEntry(Entry[AIndex]).HotSpot := AValue; +end; + +function TBGRAIconCursor.CreateEntry(AName: utf8string; + AExtension: utf8string; AContent: TStream): TMultiFileEntry; +begin + AExtension := UTF8LowerCase(AExtension); + if (AExtension <> 'png') and (AExtension <> 'dib') then + raise exception.Create('The only supported extensions are PNG and DIB'); + + result := TBGRAIconCursorEntry.TryCreate(self, AContent); + if result.Extension <> AExtension then + begin + result.Free; + raise exception.Create(AExtension + ' file extension expected but ' + result.Extension + ' found'); + end; + + if result.Name <> AName then + begin + result.Free; + raise exception.Create('"' + AName + '" dimension expected but "' + result.Name + '" found'); + end; +end; + +function TBGRAIconCursor.ExpectedMagic: Word; +begin + case FFileType of + ifIco: result := ICON_OR_CURSOR_FILE_ICON_TYPE; + ifCur: result := ICON_OR_CURSOR_FILE_CURSOR_TYPE; + else + raise exception.Create('Invalid icon/cursor type'); + end; +end; + +procedure TBGRAIconCursor.Init; +begin + inherited Init; + FFileType:= ifUnknown; +end; + +procedure TBGRAIconCursor.AssignTo(Dest: TPersistent); +{$IFDEF BGRABITMAP_USE_LCL} +var + temp: TMemoryStream; +{$ENDIF} +begin + {$IFDEF BGRABITMAP_USE_LCL} + if Dest is TCustomIcon then + begin + temp := TMemoryStream.Create; + try + SaveToStream(temp); + temp.Position:= 0; + TCustomIcon(Dest).LoadFromStream(temp); + finally + temp.Free; + end; + end else + {$ENDIF} + inherited AssignTo(Dest); +end; + +constructor TBGRAIconCursor.Create(AFileType: TBGRAImageFormat); +begin + if not (AFileType in [ifIco,ifCur,ifUnknown]) then + raise exception.Create('Allowed formats: ICO, CUR or unknown'); + + Init; + FFileType := AFileType; +end; + +function TBGRAIconCursor.Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; + AOverwrite: boolean): integer; +var stream, temp: TStream; + writer: TFPWriterBMP; + bmpXOR: TBGRACustomBitmap; + y: Integer; + psrcMask, pdest: PBGRAPixel; + bitAndMask: array of byte; + bitAndMaskPos: integer; + bitAndMaskBit: byte; + bitAndMaskRowSize, x: integer; + palette: TBGRAPalette; + writerPng: TBGRAWriterPNG; + +begin + stream := TMemoryStream.Create; + try + //PNG format is advised from 256 on but does not handle XOR + if ((ABitmap.Width >= 256) or (ABitmap.Height >= 256)) and (ABitDepth >= 8) and + ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) then + begin + writerPng := TBGRAWriterPNG.Create; + try + writerPng.WordSized := false; + if ABitDepth = 8 then + begin + writerPng.Indexed := true; + writerpng.UseAlpha := ABitmap.HasTransparentPixels; + end else + begin + writerPng.Indexed := false; + writerpng.UseAlpha := (ABitDepth = 32); + end; + ABitmap.SaveToStream(stream, writerPng); + finally + writerPng.Free; + end; + result := Add(stream, AOverwrite, true); + stream := nil; + end else + if ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) and + (not ABitmap.HasTransparentPixels or (ABitDepth = 32)) then + begin + writer := TFPWriterBMP.Create; + writer.BitsPerPixel := ABitDepth; + try + if not ABitmap.UsePalette and (ABitDepth < 24) then + begin + palette := TBGRAPalette.Create(ABitmap); + try + palette.AssignTo(ABitmap); + finally + palette.Free; + end; + ABitmap.SaveToStream(stream, writer); + ABitmap.UsePalette:= false; + end + else + ABitmap.SaveToStream(stream, writer); + finally + writer.Free; + end; + result := Add(stream, AOverwrite, true); + stream := nil; + end else + begin + bmpXOR := BGRABitmapFactory.Create(ABitmap); + try + bitAndMaskRowSize := ((bmpXOR.Width+31) div 32)*4; + setlength(bitAndMask, bitAndMaskRowSize*bmpXOR.Height); + for y := bmpXOR.Height-1 downto 0 do + begin + if assigned(ABitmap.XorMask) then + psrcMask := ABitmap.XorMask.ScanLine[y] + else + psrcMask := nil; + pdest := bmpXOR.ScanLine[y]; + bitAndMaskPos := (bmpXOR.Height-1-y)*bitAndMaskRowSize; + bitAndMaskBit:= $80; + for x := bmpXOR.Width-1 downto 0 do + begin + //xor mask is either 100% or 0% + if assigned(psrcMask) and ((psrcMask^.red <> 0) or (psrcMask^.green <> 0) or (psrcMask^.blue <> 0)) then + begin + pdest^ := psrcMask^; + pdest^.alpha := 255; + bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit; + end else + if pdest^.alpha = 0 then + begin + bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit; + if ABitDepth <= 24 then //if we cannot save alpha, replace with black. + begin //mask will task care of making it transparent + pdest^ := BGRABlack; + end; + end; + + bitAndMaskBit := bitAndMaskBit shr 1; + if bitAndMaskBit = 0 then + begin + bitAndMaskBit := $80; + inc(bitAndMaskPos); + end; + if assigned(psrcMask) then inc(psrcMask); + inc(pdest); + end; + end; + bmpXOR.InvalidateBitmap; + + if ABitDepth < 24 then + begin + palette := TBGRAPalette.Create(bmpXor); + palette.AssignTo(bmpXor); + palette.Free; + end; + + temp := TMemoryStream.Create; + try + writer := TFPWriterBMP.Create; + writer.BitsPerPixel := ABitDepth; + try + bmpXOR.SaveToStream(temp, writer); + //write double height to include mask + temp.Position := 22; + temp.WriteDWord(NtoLE(LongWord(bmpXOR.Height*2))); + //go after the file header + temp.Position := 14; + //copy bitmap without header + stream.CopyFrom(temp, temp.Size-temp.Position); + finally + writer.Free; + end; + finally + temp.Free; + end; + //write mask + stream.WriteBuffer(bitAndMask[0],length(bitAndMask)); + result := Add(stream, AOverwrite, true); + stream := nil; + finally + bmpXOR.Free; + end; + end; + + finally + stream.Free; + end; +end; + +function TBGRAIconCursor.Add(AContent: TStream; AOverwrite: boolean; + AOwnStream: boolean): integer; +var + index,i: Integer; + newEntry: TBGRAIconCursorEntry; + contentCopy: TMemoryStream; +begin + if not AOwnStream then + begin + AContent.Position:= 0; + contentCopy := TMemoryStream.Create; + contentCopy.CopyFrom(AContent, AContent.Size); + newEntry := TBGRAIconCursorEntry.TryCreate(self, contentCopy); + end else + newEntry := TBGRAIconCursorEntry.TryCreate(self, AContent); + + index := IndexOf(newEntry.Name, newEntry.Extension); + if index <> -1 then + begin + if AOverwrite then + Delete(index) + else + begin + newEntry.Free; + raise Exception.Create('Duplicate entry'); + end; + end else if not FLoading then + begin + for i := 0 to Count-1 do + if ((Width[i] < newEntry.Width) and (Height[i] < newEntry.Height)) or + ((Width[i] = newEntry.Width) and (Height[i] = newEntry.Height) and (BitDepth[i] < newEntry.BitDepth)) then + begin + index := i; + break; + end; + end; + result := AddEntry(newEntry, index); +end; + +procedure TBGRAIconCursor.LoadFromStream(AStream: TStream); +var header: TGroupIconHeader; + dir: packed array of TIconFileDirEntry; + startPos: int64; + entryContent: TMemoryStream; + entryIndex, i: integer; +begin + FLoading:= true; + try + startPos := AStream.Position; + AStream.ReadBuffer({%H-}header, sizeof(header)); + header.SwapIfNecessary; + if header.Reserved <> 0 then + raise exception.Create('Invalid file format'); + if FileType = ifUnknown then + begin + case header.ResourceType of + ICON_OR_CURSOR_FILE_ICON_TYPE: FFileType := ifIco; + ICON_OR_CURSOR_FILE_CURSOR_TYPE: FFileType := ifCur; + end; + end; + if header.ResourceType <> ExpectedMagic then + raise exception.Create('Invalid resource type'); + Clear; + setlength(dir, header.ImageCount); + AStream.ReadBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir)); + for i := 0 to high(dir) do + begin + AStream.Position:= LEtoN(dir[i].ImageOffset) + startPos; + entryContent := TMemoryStream.Create; + entryContent.CopyFrom(AStream, LEtoN(dir[i].ImageSize)); + entryIndex := Add(entryContent, false, true); + if ((dir[i].Width = 0) and (Width[entryIndex] < 256)) or + ((dir[i].Width > 0) and (Width[entryIndex] <> dir[i].Width)) or + ((dir[i].Height = 0) and (Height[entryIndex] < 256)) or + ((dir[i].Height > 0) and (Height[entryIndex] <> dir[i].Height)) then + raise Exception.Create('Inconsistent image size'); + if FFileType = ifCur then + TBGRAIconCursorEntry(Entry[entryIndex]).HotSpot := Point(LEtoN(dir[i].HotSpotX),LEtoN(dir[i].HotSpotY)); + end; + finally + FLoading:= false; + end; +end; + +procedure TBGRAIconCursor.SaveToStream(ADestination: TStream); +var header: TGroupIconHeader; + i: integer; + accSize: LongWord; + dir: packed array of TIconFileDirEntry; + contentSize: LongWord; +begin + if Count = 0 then + raise exception.Create('File cannot be empty'); + if FileType = ifUnknown then + raise exception.Create('You need to specify the file type'); + header.ImageCount:= Count; + header.Reserved := 0; + header.ResourceType:= ExpectedMagic; + header.SwapIfNecessary; + accSize := sizeof(header) + sizeof(TIconFileDirEntry)*Count; + setlength(dir, Count); + for i := 0 to Count-1 do + begin + if Width[i] >= 256 + then dir[i].Width := 0 + else dir[i].Width := Width[i]; + + if Height[i] >= 256 + then dir[i].Height := 0 + else dir[i].Height := Height[i]; + + if BitDepth[i] < 8 then + dir[i].Colors := 1 shl BitDepth[i] + else + dir[i].Colors := 0; + dir[i].Reserved := 0; + case FFileType of + ifCur: begin dir[i].HotSpotX:= NtoLE(Word(HotSpot[i].X)); dir[i].HotSpotY := NtoLE(Word(HotSpot[i].Y)); end; + ifIco: begin dir[i].BitsPerPixel:= NtoLE(Word(BitDepth[i])); dir[i].Planes := NtoLE(Word(1)); end; + else dir[i].Variable:= 0; + end; + dir[i].ImageOffset := LEtoN(accSize); + contentSize:= Entry[i].FileSize; + dir[i].ImageSize := NtoLE(contentSize); + inc(accSize,contentSize); + end; + + ADestination.WriteBuffer(header, sizeof(header)); + ADestination.WriteBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir)); + for i := 0 to Count-1 do + if Entry[i].CopyTo(ADestination) <> Entry[i].FileSize then + raise exception.Create('Unable to write data in stream'); +end; + +function TBGRAIconCursor.GetBitmap(AIndex: integer): TBGRACustomBitmap; +begin + if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); + result := TBGRAIconCursorEntry(Entry[AIndex]).GetBitmap; +end; + +function TBGRAIconCursor.GetBestFitBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; +var bestIndex: integer; + bestSizeDiff: integer; + bestBPP: integer; + sizeDiff, i: integer; +begin + bestBPP := 0; + bestSizeDiff := high(integer); + bestIndex := -1; + for i := 0 to Count-1 do + begin + sizeDiff := abs(AWidth-Width[i])+abs(AHeight-Height[i]); + if (sizeDiff < bestSizeDiff) or + ((sizeDiff = bestSizeDiff) and (BitDepth[i] > bestBPP)) then + begin + bestIndex := i; + bestSizeDiff:= sizeDiff; + bestBPP:= BitDepth[i]; + end; + end; + if bestIndex = -1 then + raise Exception.Create('No bitmap found') + else + result := GetBitmap(bestIndex); +end; + +function TBGRAIconCursor.IndexOf(AWidth, AHeight, ABitDepth: integer): integer; +var + i: Integer; +begin + for i := 0 to Count-1 do + if (Width[i] = AWidth) and (Height[i] = AHeight) and (BitDepth[i] = ABitDepth) then + begin + result := i; + exit; + end; + result := -1; +end; + +procedure TBGRAIconCursor.Assign(Source: TPersistent); +{$IFDEF BGRABITMAP_USE_LCL} +var + temp: TMemoryStream; +{$ENDIF} +begin + {$IFDEF BGRABITMAP_USE_LCL} + if Source is TCustomIcon then + begin + temp := TMemoryStream.Create; + try + TCustomIcon(Source).SaveToStream(temp); + temp.Position:= 0; + LoadFromStream(temp); + finally + temp.Free; + end; + end else + {$ENDIF} + inherited Assign(Source); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralayeroriginal.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralayeroriginal.pas new file mode 100644 index 0000000..7402128 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralayeroriginal.pas @@ -0,0 +1,2252 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALayerOriginal; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmap, BGRABitmapTypes, BGRATransform, BGRAMemDirectory, fgl + {$IFDEF BGRABITMAP_USE_LCL},LCLType{$ENDIF}; + +type + PRectF = BGRABitmapTypes.PRectF; + TAffineMatrix = BGRATransform.TAffineMatrix; + TBGRALayerCustomOriginal = class; + TBGRAOriginalDiff = class; + TBGRALayerOriginalAny = class of TBGRALayerCustomOriginal; + TOriginalMovePointEvent = procedure(ASender: TObject; APrevCoord, ANewCoord: TPointF; AShift: TShiftState) of object; + TOriginalStartMovePointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object; + TOriginalClickPointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object; + TOriginalHoverPointEvent = procedure(ASender: TObject; AIndex: integer) of object; + TOriginalChangeEvent = procedure(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff) of object; + TOriginalEditingChangeEvent = procedure(ASender: TObject) of object; + TOriginalEditorCursor = (oecDefault, oecMove, oecMoveW, oecMoveE, oecMoveN, oecMoveS, + oecMoveNE, oecMoveSW, oecMoveNW, oecMoveSE, oecHandPoint, oecText); + TSpecialKey = (skUnknown, skBackspace, skTab, skReturn, skEscape, + skPageUp, skPageDown, skHome, skEnd, + skLeft, skUp, skRight, skDown, + skInsert, skDelete, + skNum0, skNum1, skNum2, skNum3, skNum4, skNum5, skNum6, skNum7, skNum8, skNum9, + skF1, skF2, skF3, skF4, skF5, skF6, skF7, skF8, skF9, skF10, skF11, skF12, + skA, skB, skC, skD, skE, skF, skG, skH, skI, skJ, skK, skL, skM, skN, skO, skP, skQ, skR, skS, skT, skU, skV, skW, skX, skY, skZ, + sk0, sk1, sk2, sk3, sk4, sk5, sk6, sk7, sk8, sk9, + skShift, skCtrl, skAlt); + +const + SpecialKeyStr: array[TSpecialKey] of string = + ('Unknown', 'Backspace', 'Tab', 'Return', 'Escape', + 'PageUp', 'PageDown', 'Home', 'End', + 'Left', 'Up', 'Right', 'Down', + 'Insert', 'Delete', + 'Num0', 'Num1', 'Num2', 'Num3', 'Num4', 'Num5', 'Num6', 'Num7', 'Num8', 'Num9', + 'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12', + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', + '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', + 'Shift', 'Ctrl', 'Alt'); + +{$IFDEF BGRABITMAP_USE_LCL} +const + SpecialKeyToLCL: array[TSpecialKey] of Word = + (VK_UNKNOWN, VK_BACK,VK_TAB,VK_RETURN,VK_ESCAPE, + VK_PRIOR,VK_NEXT,VK_HOME,VK_END, + VK_LEFT,VK_UP,VK_RIGHT,VK_DOWN, + VK_INSERT,VK_DELETE, + VK_NUMPAD0,VK_NUMPAD1,VK_NUMPAD2,VK_NUMPAD3,VK_NUMPAD4,VK_NUMPAD5,VK_NUMPAD6,VK_NUMPAD7,VK_NUMPAD8,VK_NUMPAD9, + VK_F1,VK_F2,VK_F3,VK_F4,VK_F5,VK_F6,VK_F7,VK_F8,VK_F9,VK_F10,VK_F11,VK_F12, + VK_A, VK_B, VK_C, VK_D, VK_E, VK_F, VK_G, VK_H, VK_I, VK_J, VK_K, VK_L, VK_M, VK_N, VK_O, VK_P, VK_Q, VK_R, VK_S, VK_T, VK_U, VK_V, VK_W, VK_X, VK_Y, VK_Z, + VK_0, VK_1, VK_2, VK_3, VK_4, VK_5, VK_6, VK_7, VK_8, VK_9, + VK_SHIFT, VK_CONTROL, VK_MENU); + + function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey; +{$ENDIF} + +type + TStartMoveHandlers = specialize TFPGList; + TClickPointHandlers = specialize TFPGList; + THoverPointHandlers = specialize TFPGList; + TBGRAOriginalPolylineStyle = (opsNone, opsSolid, opsDash, opsDashWithShadow); + + { TBGRAOriginalEditor } + + TBGRAOriginalEditor = class + private + FFocused: boolean; + FOnFocusChanged: TNotifyEvent; + function GetIsMovingPoint: boolean; + function GetPointCoord(AIndex: integer): TPointF; + function GetPointCount: integer; + function GetPointHighlighted(AIndex: integer): boolean; + procedure SetFocused(AValue: boolean); + procedure SetPointHighlighted(AIndex: integer; AValue: boolean); + protected + FMatrix,FMatrixInverse: TAffineMatrix; //view matrix from original coord + FGridMatrix,FGridMatrixInverse: TAffineMatrix; //grid matrix in original coord + FGridActive: boolean; + FPoints: array of record + Origin, Coord: TPointF; + OnMove, OnAlternateMove: TOriginalMovePointEvent; + RightButton, Highlighted: boolean; + SnapToPoint: integer; + HitBox: TAffineBox; + end; + FPolylines: array of record + Coords: array of TPointF; + Closed: boolean; + Style: TBGRAOriginalPolylineStyle; + BackColor: TBGRAPixel; + end; + FPointSize: single; + FPointMoving: integer; + FPointWasMoved: boolean; + FPointCoordDelta: TPointF; + FMovingRightButton: boolean; + FPrevMousePos: TPointF; + FStartMoveHandlers: TStartMoveHandlers; + FCurHoverPoint: integer; + FHoverPointHandlers: THoverPointHandlers; + FClickPointHandlers: TClickPointHandlers; + function RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect; virtual; + function GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect; virtual; + function RenderArrow(ADest: TBGRABitmap; AOrigin, AEndCoord: TPointF): TRect; virtual; + function GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect; virtual; + function RenderPolygon(ADest: TBGRABitmap; ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect; virtual; + function GetRenderPolygonBounds(ACoords: array of TPointF): TRect; + procedure SetMatrix(AValue: TAffineMatrix); + procedure SetGridMatrix(AValue: TAffineMatrix); + procedure SetGridActive(AValue: boolean); + function GetMoveCursor(APointIndex: integer): TOriginalEditorCursor; virtual; + function GetFixedShiftForButton(AShift: TShiftState; ARightDown: boolean): TShiftState; + public + constructor Create; + destructor Destroy; override; + procedure Clear; virtual; + procedure AddStartMoveHandler(AOnStartMove: TOriginalStartMovePointEvent); + procedure AddClickPointHandler(AOnClickPoint: TOriginalClickPointEvent); + procedure AddHoverPointHandler(AOnHoverPoint: TOriginalHoverPointEvent); + function AddPoint(const ACoord: TPointF; AOnMove: TOriginalMovePointEvent; ARightButton: boolean = false; ASnapToPoint: integer = -1): integer; + procedure AddPointAlternateMove(AIndex: integer; AOnAlternateMove: TOriginalMovePointEvent); + function AddFixedPoint(const ACoord: TPointF; ARightButton: boolean = false): integer; + function AddArrow(const AOrigin, AEndCoord: TPointF; AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean = false): integer; + function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer; overload; + function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer; overload; + procedure SetHitBox(AIndex: integer; AHitBox: TAffineBox); + procedure MouseMove(Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; + procedure MouseDown(RightButton: boolean; Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; + procedure MouseUp(RightButton: boolean; {%H-}Shift: TShiftState; {%H-}ViewX, {%H-}ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; + procedure KeyDown({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual; + procedure KeyUp({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual; + procedure KeyPress({%H-}UTF8Key: string; out AHandled: boolean); virtual; + function GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer; + function Render(ADest: TBGRABitmap; const {%H-}ALayoutRect: TRect): TRect; virtual; + function GetRenderBounds(const {%H-}ALayoutRect: TRect): TRect; virtual; + function SnapToGrid(const ACoord: TPointF; AIsViewCoord: boolean): TPointF; + function OriginalCoordToView(const AImageCoord: TPointF): TPointF; + function ViewCoordToOriginal(const AViewCoord: TPointF): TPointF; + property Matrix: TAffineMatrix read FMatrix write SetMatrix; + property GridMatrix: TAffineMatrix read FGridMatrix write SetGridMatrix; + property GridActive: boolean read FGridActive write SetGridActive; + property Focused: boolean read FFocused write SetFocused; + property PointSize: single read FPointSize write FPointSize; + property PointCount: integer read GetPointCount; + property PointCoord[AIndex: integer]: TPointF read GetPointCoord; + property PointHighlighted[AIndex: integer]: boolean read GetPointHighlighted write SetPointHighlighted; + property OnFocusChanged: TNotifyEvent read FOnFocusChanged write FOnFocusChanged; + property IsMovingPoint: boolean read GetIsMovingPoint; + end; + + TBGRACustomOriginalStorage = class; + ArrayOfSingle = array of single; + + TBGRAOriginalDiff = class + procedure Apply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract; + procedure Unapply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract; + function CanAppend(ADiff: TBGRAOriginalDiff): boolean; virtual; abstract; + procedure Append(ADiff: TBGRAOriginalDiff); virtual; abstract; + function IsIdentity: boolean; virtual; abstract; + end; + + { TBGRALayerCustomOriginal } + + TBGRALayerCustomOriginal = class + private + FOnChange: TOriginalChangeEvent; + FOnEditingChange: TOriginalEditingChangeEvent; + FRenderStorage: TBGRACustomOriginalStorage; + function GetDiffExpected: boolean; + procedure SetOnChange(AValue: TOriginalChangeEvent); + procedure SetRenderStorage(AValue: TBGRACustomOriginalStorage); + protected + FGuid: TGuid; + function GetGuid: TGuid; + procedure SetGuid(AValue: TGuid); + procedure NotifyChange(ADiff: TBGRAOriginalDiff = nil); overload; + procedure NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff = nil); overload; + procedure NotifyEditorChange; + property DiffExpected: boolean read GetDiffExpected; + public + constructor Create; virtual; + destructor Destroy; override; + //one of the two Render functions must be overriden + procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); virtual; + procedure Render(ADest: TBGRABitmap; ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); virtual; + function GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix): TRect; virtual; abstract; + procedure ConfigureEditor({%H-}AEditor: TBGRAOriginalEditor); virtual; + procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract; + procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract; + procedure LoadFromFile(AFilenameUTF8: string); virtual; + procedure LoadFromStream(AStream: TStream); virtual; + procedure LoadFromResource(AFilename: string); + procedure SaveToFile(AFilenameUTF8: string); virtual; + procedure SaveToStream(AStream: TStream); virtual; + function CreateEditor: TBGRAOriginalEditor; virtual; + class function StorageClassName: RawByteString; virtual; abstract; + class function CanConvertToSVG: boolean; virtual; + function IsInfiniteSurface: boolean; virtual; + function ConvertToSVG(const {%H-}AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; virtual; + function Duplicate: TBGRALayerCustomOriginal; virtual; + property Guid: TGuid read GetGuid write SetGuid; + property OnChange: TOriginalChangeEvent read FOnChange write SetOnChange; + property OnEditingChange: TOriginalEditingChangeEvent read FOnEditingChange write FOnEditingChange; + property RenderStorage: TBGRACustomOriginalStorage read FRenderStorage write SetRenderStorage; + end; + + TBGRALayerImageOriginal = class; + + { TBGRAImageOriginalDiff } + + TBGRAImageOriginalDiff = class(TBGRAOriginalDiff) + protected + FContentVersionBefore,FContentVersionAfter: integer; + FImageBefore,FImageAfter: TBGRABitmap; + FJpegStreamBefore,FJpegStreamAfter: TMemoryStream; + public + constructor Create(AFromOriginal: TBGRALayerImageOriginal); + destructor Destroy; override; + procedure ComputeDiff(AToOriginal: TBGRALayerImageOriginal); + procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; + procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; + function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; + procedure Append(ADiff: TBGRAOriginalDiff); override; + function IsIdentity: boolean; override; + end; + + { TBGRALayerImageOriginal } + + TBGRALayerImageOriginal = class(TBGRALayerCustomOriginal) + private + function GetImageHeight: integer; + function GetImageWidth: integer; + protected + FImage: TBGRABitmap; + FJpegStream: TMemoryStream; + FContentVersion: integer; + FDiff: TBGRAImageOriginalDiff; + procedure BeginUpdate; + procedure EndUpdate; + procedure InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean); + procedure InternalClear; + public + constructor Create; override; + destructor Destroy; override; + function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override; + procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override; + function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override; + procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; + procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; + procedure LoadFromStream(AStream: TStream); override; + procedure Clear; + procedure LoadImageFromStream(AStream: TStream); + procedure SaveImageToStream(AStream: TStream); + procedure AssignImage(AImage: TBGRACustomBitmap); + function GetImageCopy: TBGRABitmap; + class function StorageClassName: RawByteString; override; + class function CanConvertToSVG: boolean; override; + property Width: integer read GetImageWidth; + property Height: integer read GetImageHeight; + end; + + { TBGRACustomOriginalStorage } + + TBGRACustomOriginalStorage = class + protected + FFormats: TFormatSettings; + function GetBool(AName: utf8string): boolean; + function GetBoolDef(AName: utf8string; ADefault: boolean): boolean; + function GetColorArray(AName: UTF8String): ArrayOfTBGRAPixel; + function GetInteger(AName: utf8string): integer; + function GetIntegerDef(AName: utf8string; ADefault: integer): integer; + function GetPointF(AName: utf8string): TPointF; + function GetRectF(AName: utf8string): TRectF; + function GetRect(AName: utf8string): TRect; + function GetAffineMatrix(AName: utf8string): TAffineMatrix; + function GetRawString(AName: utf8string): RawByteString; virtual; abstract; + function GetSingle(AName: utf8string): single; + function GetSingleArray(AName: utf8string): ArrayOfSingle; + function GetSingleDef(AName: utf8string; ADefault: single): single; + function GetColor(AName: UTF8String): TBGRAPixel; + procedure SetBool(AName: utf8string; AValue: boolean); + procedure SetColorArray(AName: UTF8String; AValue: ArrayOfTBGRAPixel); + procedure SetInteger(AName: utf8string; AValue: integer); + procedure SetPointF(AName: utf8string; AValue: TPointF); + procedure SetRectF(AName: utf8string; AValue: TRectF); + procedure SetRect(AName: utf8string; AValue: TRect); + procedure SetAffineMatrix(AName: utf8string; const AValue: TAffineMatrix); + procedure SetRawString(AName: utf8string; AValue: RawByteString); virtual; abstract; + procedure SetSingle(AName: utf8string; AValue: single); + procedure SetSingleArray(AName: utf8string; AValue: ArrayOfSingle); + procedure SetColor(AName: UTF8String; AValue: TBGRAPixel); + function GetDelimiter: char; + function GetEmpty: boolean; virtual; abstract; + public + constructor Create; + function Duplicate: TBGRACustomOriginalStorage; virtual; abstract; + procedure RemoveAttribute(AName: utf8string); virtual; abstract; + function HasAttribute(AName: utf8string): boolean; virtual; abstract; + procedure RemoveObject(AName: utf8string); virtual; abstract; + function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract; + function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract; + function ObjectExists(AName: utf8string): boolean; virtual; abstract; + procedure EnumerateObjects(AList: TStringList); virtual; abstract; + procedure EnumerateFiles(AList: TStringList); virtual; abstract; + procedure RemoveFile(AName: utf8string); virtual; abstract; + function GetFileStream(AName: UTF8String): TStream; virtual; abstract; + function ReadFile(AName: UTF8String; ADest: TStream): boolean; virtual; abstract; + function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; virtual; abstract; + procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); virtual; abstract; + function FileExists(AName: UTF8String): boolean; virtual; abstract; + function FloatEquals(AName: utf8string; AValue: single): boolean; + function PointFEquals(AName: utf8string; const AValue: TPointF): boolean; + function AffineMatrixEquals(AName: utf8string; const AValue: TAffineMatrix): boolean; + property RawString[AName: utf8string]: RawByteString read GetRawString write SetRawString; + property Int[AName: utf8string]: integer read GetInteger write SetInteger; + property IntDef[AName: utf8string; ADefault: integer]: integer read GetIntegerDef; + property Bool[AName: utf8string]: boolean read GetBool write SetBool; + property BoolDef[AName: utf8string; ADefault: boolean]: boolean read GetBoolDef; + property Float[AName: utf8string]: single read GetSingle write SetSingle; + property FloatArray[AName: utf8string]: ArrayOfSingle read GetSingleArray write SetSingleArray; + property FloatDef[AName: utf8string; ADefault: single]: single read GetSingleDef; + property PointF[AName: utf8string]: TPointF read GetPointF write SetPointF; + property RectangleF[AName: utf8string]: TRectF read GetRectF write SetRectF; + property Rectangle[AName: utf8string]: TRect read GetRect write SetRect; + property AffineMatrix[AName: utf8string]: TAffineMatrix read GetAffineMatrix write SetAffineMatrix; + property Color[AName: UTF8String]: TBGRAPixel read GetColor write SetColor; + property ColorArray[AName: UTF8String]: ArrayOfTBGRAPixel read GetColorArray write SetColorArray; + property Empty: boolean read GetEmpty; + end; + + { TBGRAMemOriginalStorage } + + TBGRAMemOriginalStorage = class(TBGRACustomOriginalStorage) + protected + FMemDir: TMemDirectory; + FMemDirOwned: boolean; + function GetRawString(AName: utf8string): RawByteString; override; + procedure SetRawString(AName: utf8string; AValue: RawByteString); override; + function GetEmpty: boolean; override; + public + destructor Destroy; override; + constructor Create; + constructor Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false); + function Equals(Obj: TObject): boolean; override; + function Duplicate: TBGRACustomOriginalStorage; override; + procedure RemoveAttribute(AName: utf8string); override; + function HasAttribute(AName: utf8string): boolean; override; + procedure RemoveObject(AName: utf8string); override; + function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; override; + function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; override; + function ObjectExists(AName: utf8string): boolean; override; + procedure EnumerateObjects(AList: TStringList); override; + procedure EnumerateFiles(AList: TStringList); override; + procedure RemoveFile(AName: utf8string); override; + function GetFileStream(AName: UTF8String): TStream; override; + function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; override; + function ReadFile(AName: UTF8String; ADest: TStream): boolean; override; + procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); override; + function FileExists(AName: UTF8String): boolean; override; + procedure SaveToStream(AStream: TStream); + procedure LoadFromStream(AStream: TStream); + procedure LoadFromResource(AFilename: string); + procedure CopyTo(AMemDir: TMemDirectory); + end; + +procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny); +function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny; + +implementation + +uses BGRAPolygon, math, BGRAMultiFileType, BGRAUTF8, BGRAGraphics, BGRASVG, BGRASVGShapes; + +{$IFDEF BGRABITMAP_USE_LCL} +function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey; +var + sk: TSpecialKey; +begin + if (((AKey >= VK_A) and (AKey <= VK_Z)) or + ((AKey >= VK_0) and (AKey <= VK_9))) and (AShift*[ssCtrl,ssAlt]=[]) then exit(skUnknown); + for sk := low(TSpecialKey) to high(TSpecialKey) do + if AKey = SpecialKeyToLCL[sk] then exit(sk); + exit(skUnknown); +end; +{$ENDIF} + +var + LayerOriginalClasses: array of TBGRALayerOriginalAny; + +procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny); +begin + setlength(LayerOriginalClasses, length(LayerOriginalClasses)+1); + LayerOriginalClasses[high(LayerOriginalClasses)] := AClass; +end; + +function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny; +var + i: Integer; +begin + for i := 0 to high(LayerOriginalClasses) do + if LayerOriginalClasses[i].StorageClassName = AStorageClassName then + exit(LayerOriginalClasses[i]); + exit(nil); +end; + +{ TBGRAImageOriginalDiff } + +constructor TBGRAImageOriginalDiff.Create(AFromOriginal: TBGRALayerImageOriginal); +begin + FImageBefore := AFromOriginal.FImage.NewReference; + if Assigned(AFromOriginal.FJpegStream) then + begin + FJpegStreamBefore := TMemoryStream.Create; + AFromOriginal.FJpegStream.Position:= 0; + FJpegStreamBefore.CopyFrom(AFromOriginal.FJpegStream, AFromOriginal.FJpegStream.Size); + end; + FContentVersionBefore:= AFromOriginal.FContentVersion; +end; + +procedure TBGRAImageOriginalDiff.ComputeDiff( + AToOriginal: TBGRALayerImageOriginal); +begin + if Assigned(FImageAfter) then FImageAfter.FreeReference; + FImageAfter := AToOriginal.FImage.NewReference; + FreeAndNil(FJpegStreamAfter); + if Assigned(AToOriginal.FJpegStream) then + begin + FJpegStreamAfter := TMemoryStream.Create; + AToOriginal.FJpegStream.Position:= 0; + FJpegStreamAfter.CopyFrom(AToOriginal.FJpegStream, AToOriginal.FJpegStream.Size); + end; + FContentVersionAfter:= AToOriginal.FContentVersion; +end; + +procedure TBGRAImageOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); +var + orig: TBGRALayerImageOriginal; +begin + orig := AOriginal as TBGRALayerImageOriginal; + orig.FImage.FreeReference; + orig.FImage := FImageAfter.NewReference; + FreeAndNil(orig.FJpegStream); + if Assigned(FJpegStreamAfter) then + begin + orig.FJpegStream := TMemoryStream.Create; + FJpegStreamAfter.Position := 0; + orig.FJpegStream.CopyFrom(FJpegStreamAfter, FJpegStreamAfter.Size); + end; + orig.FContentVersion := FContentVersionAfter; +end; + +procedure TBGRAImageOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); +var + orig: TBGRALayerImageOriginal; +begin + orig := AOriginal as TBGRALayerImageOriginal; + orig.FImage.FreeReference; + orig.FImage := FImageBefore.NewReference; + FreeAndNil(orig.FJpegStream); + if Assigned(FJpegStreamBefore) then + begin + orig.FJpegStream := TMemoryStream.Create; + FJpegStreamBefore.Position := 0; + orig.FJpegStream.CopyFrom(FJpegStreamBefore, FJpegStreamBefore.Size); + end; + orig.FContentVersion := FContentVersionBefore; +end; + +function TBGRAImageOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; +begin + result := (ADiff is TBGRAImageOriginalDiff) and + (TBGRAImageOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter); +end; + +procedure TBGRAImageOriginalDiff.Append(ADiff: TBGRAOriginalDiff); +var + next: TBGRAImageOriginalDiff; +begin + next := ADiff as TBGRAImageOriginalDiff; + if next.FContentVersionAfter < FContentVersionAfter then + raise exception.Create('Cannot append diff made before this one.'); + FImageAfter.FreeReference; + FImageAfter := next.FImageAfter.NewReference; + FreeAndNil(FJpegStreamAfter); + if Assigned(next.FJpegStreamAfter) then + begin + FJpegStreamAfter := TMemoryStream.Create; + next.FJpegStreamAfter.Position:= 0; + FJpegStreamAfter.CopyFrom(next.FJpegStreamAfter, next.FJpegStreamAfter.Size); + end; + FContentVersionAfter:= next.FContentVersionAfter; +end; + +function TBGRAImageOriginalDiff.IsIdentity: boolean; +begin + result := FImageBefore.Equals(FImageAfter) and + ( ((FJpegStreamBefore=nil) and (FJpegStreamAfter=nil)) or + (Assigned(FJpegStreamBefore) and Assigned(FJpegStreamAfter) and + (FJpegStreamBefore.Size = FJpegStreamAfter.Size) and + CompareMem(FJpegStreamBefore.Memory,FJpegStreamBefore.Memory,FJpegStreamBefore.Size)) ); + +end; + +destructor TBGRAImageOriginalDiff.Destroy; +begin + FImageBefore.FreeReference; + FImageAfter.FreeReference; + FJpegStreamBefore.Free; + FJpegStreamAfter.Free; + inherited Destroy; +end; + +{ TBGRAOriginalEditor } + +procedure TBGRAOriginalEditor.SetMatrix(AValue: TAffineMatrix); +begin + if FMatrix=AValue then Exit; + FMatrix:=AValue; + FMatrixInverse := AffineMatrixInverse(FMatrix); +end; + +function TBGRAOriginalEditor.GetMoveCursor(APointIndex: integer): TOriginalEditorCursor; +var + d: TPointF; + ratio: single; +begin + if (APointIndex < 0) or (APointIndex >= PointCount) then result := oecDefault else + if isEmptyPointF(FPoints[APointIndex].Origin) then + begin + if Assigned(FPoints[APointIndex].OnMove) then + result := oecMove + else + result := oecHandPoint; + end else + begin + d := AffineMatrixLinear(FMatrix)*(FPoints[APointIndex].Coord - FPoints[APointIndex].Origin); + ratio := sin(Pi/8); + if (d.x = 0) and (d.y = 0) then result := oecMove else + if abs(d.x)*ratio >= abs(d.y) then + begin + if d.x >= 0 then result := oecMoveE else result := oecMoveW + end else + if abs(d.y)*ratio >= abs(d.x) then + begin + if d.y >= 0 then result := oecMoveS else result := oecMoveN + end else + if (d.x > 0) and (d.y > 0) then result := oecMoveSE else + if (d.x < 0) and (d.y < 0) then result := oecMoveNW else + if (d.x > 0) and (d.y < 0) then result := oecMoveNE + else result := oecMoveSW; + end; +end; + +function TBGRAOriginalEditor.GetFixedShiftForButton(AShift: TShiftState; + ARightDown: boolean): TShiftState; +begin + result := AShift - [ssLeft,ssMiddle,ssRight]; + if ARightDown then include(result, ssRight) + else include(result, ssLeft); +end; + +function TBGRAOriginalEditor.GetPointCoord(AIndex: integer): TPointF; +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + result := FPoints[AIndex].Coord; +end; + +function TBGRAOriginalEditor.GetIsMovingPoint: boolean; +begin + result := FPointMoving <> -1; +end; + +function TBGRAOriginalEditor.GetPointCount: integer; +begin + result := length(FPoints); +end; + +function TBGRAOriginalEditor.GetPointHighlighted(AIndex: integer): boolean; +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + result := FPoints[AIndex].Highlighted; +end; + +procedure TBGRAOriginalEditor.SetFocused(AValue: boolean); +begin + if FFocused=AValue then Exit; + FFocused:=AValue; + if Assigned(FOnFocusChanged) then FOnFocusChanged(self); +end; + +procedure TBGRAOriginalEditor.SetPointHighlighted(AIndex: integer; + AValue: boolean); +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + FPoints[AIndex].Highlighted := AValue; +end; + +procedure TBGRAOriginalEditor.SetGridActive(AValue: boolean); +begin + if FGridActive=AValue then Exit; + FGridActive:=AValue; +end; + +procedure TBGRAOriginalEditor.SetGridMatrix(AValue: TAffineMatrix); +begin + if FGridMatrix=AValue then Exit; + FGridMatrix:=AValue; + FGridMatrixInverse := AffineMatrixInverse(FGridMatrix); +end; + +function TBGRAOriginalEditor.RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect; +const alpha = 192; +var filler: TBGRAMultishapeFiller; + c: TBGRAPixel; + penScale: Single; + oldClip: TRect; +begin + result := GetRenderPointBounds(ACoord, AHighlighted); + if not isEmptyPointF(ACoord) then + begin + oldClip := ADest.ClipRect; + ADest.IntersectClip(result); + if AAlternateColor then c := BGRA(255,128,128,alpha) + else if AHighlighted then c := BGRA(96,170,255,alpha) + else c := BGRA(255,255,255,alpha); + if AHighlighted then + ADest.GradientFill(result.Left, result.Top, result.Right, result.Bottom, + c, BGRAPixelTransparent, + gtRadial, PointF(ACoord.x,ACoord.y), PointF(result.right,ACoord.y), + dmDrawWithTransparency); + penScale := FPointSize / 6; + if penScale < 1 then penScale := 1; + filler := TBGRAMultishapeFiller.Create; + filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 3.5*penScale, BGRA(0,0,0,alpha)); + filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 1*penScale, c); + filler.PolygonOrder:= poLastOnTop; + filler.Draw(ADest); + filler.Free; + ADest.ClipRect := oldClip; + end; +end; + +function TBGRAOriginalEditor.GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect; +var + r, penScale: Single; +begin + if isEmptyPointF(ACoord) then + result := EmptyRect + else + begin + penScale := FPointSize / 6; + if penScale < 1 then penScale := 1; + r := FPointSize + (penScale-1)*4; + if AHighlighted then r := max(r, FPointSize*2); + result := rect(floor(ACoord.x - r + 0.5), floor(ACoord.y - r + 0.5), + ceil(ACoord.x + r + 0.5), ceil(ACoord.y + r + 0.5)); + end; +end; + +function TBGRAOriginalEditor.RenderArrow(ADest: TBGRABitmap; AOrigin, + AEndCoord: TPointF): TRect; +const alpha = 192; +var + pts, ptsContour: ArrayOfTPointF; + i: Integer; + rF: TRectF; + penScale: Single; +begin + if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then + result := EmptyRect + else + begin + penScale := FPointSize / 6; + if penScale < 1 then penScale := 1; + ADest.Pen.Arrow.EndAsClassic; + ADest.Pen.Arrow.EndSize := PointF(FPointSize/penScale,FPointSize/penScale); + pts := ADest.ComputeWidePolyline([AOrigin,AEndCoord],1*penScale); + ADest.Pen.Arrow.EndAsNone; + ptsContour := ADest.ComputeWidePolygon(pts, 2*penScale); + ADest.FillPolyAntialias(ptsContour, BGRA(0,0,0,alpha)); + ADest.FillPolyAntialias(pts, BGRA(255,255,255,alpha)); + rF := RectF(AOrigin,AEndCoord); + for i := 0 to high(ptsContour) do + if not isEmptyPointF(ptsContour[i]) then + begin + if ptsContour[i].x < rF.Left then rF.Left := ptsContour[i].x; + if ptsContour[i].x > rF.Right then rF.Right := ptsContour[i].x; + if ptsContour[i].y < rF.Top then rF.Top := ptsContour[i].y; + if ptsContour[i].y > rF.Bottom then rF.Bottom := ptsContour[i].y; + end; + result := rect(floor(rF.Left+0.5),floor(rF.Top+0.5),ceil(rF.Right+0.5),ceil(rF.Bottom+0.5)); + end; +end; + +function TBGRAOriginalEditor.GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect; +var + penScale, margin: Single; +begin + if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then + result := EmptyRect + else + begin + penScale := FPointSize / 6; + if penScale < 1 then penScale := 1; + margin := penScale * 1.5; + result := Rect(floor(AOrigin.x+0.5-margin),floor(AOrigin.y+0.5-margin), + ceil(AOrigin.x+0.5+margin),ceil(AOrigin.y+0.5+margin)); + result.Union( rect(floor(AEndCoord.x+0.5-FPointSize-margin), floor(AEndCoord.y+0.5-FPointSize-margin), + ceil(AEndCoord.x+0.5+FPointSize+margin), ceil(AEndCoord.y+0.5+FPointSize+margin)) ); + end; +end; + +function TBGRAOriginalEditor.RenderPolygon(ADest: TBGRABitmap; + ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect; +var + dashLen: integer; + i: integer; + ptsF: array of TPointF; + pts1,pts2: array of TPoint; +begin + dashLen := round(PointSize/2); + if dashLen < 1 then dashLen := 1; + + setlength(pts1, length(ACoords)); + for i := 0 to high(ACoords) do + pts1[i] := ACoords[i].Round; + + setlength(ptsF, length(pts1)); + for i := 0 to high(pts1) do + ptsF[i] := PointF(pts1[i]); + + if ABackColor.alpha <> 0 then + ADest.FillPolyAntialias(ptsF, ABackColor); + + case AStyle of + opsDash, opsDashWithShadow: + begin + if AStyle = opsDashWithShadow then + begin + //shadow + setlength(pts2,length(pts1)); + for i := 0 to high(pts1) do + if not isEmptyPoint(pts1[i]) then + pts2[i] := Point(pts1[i].x+1,pts1[i].y+1) + else pts2[i] := EmptyPoint; + if AClosed then + ADest.DrawPolygonAntialias(pts2, BGRA(0,0,0,96)) + else + ADest.DrawPolyLineAntialias(pts2, BGRA(0,0,0,96), true); + pts2:= nil; + end; + + //dotted line + if AClosed then + ADest.DrawPolygonAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen) + else + ADest.DrawPolyLineAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen, true); + end; + opsSolid: + begin + ADest.JoinStyle:= pjsRound; + ADest.LineCap:= pecRound; + //black outline + if AClosed then + ADest.DrawPolygonAntialias(ptsF, BGRA(0,0,0,192), 3) + else + ADest.DrawPolyLineAntialias(ptsF, BGRA(0,0,0,192), 3); + + if AClosed then + ADest.DrawPolygonAntialias(pts1, CSSIvory) + else + ADest.DrawPolyLineAntialias(pts1, CSSIvory, true); + end; + end; + + result := GetRenderPolygonBounds(ACoords); +end; + +function TBGRAOriginalEditor.GetRenderPolygonBounds(ACoords: array of TPointF): TRect; +var + first: Boolean; + rF: TRectF; + i: Integer; +begin + first:= true; + rF:= EmptyRectF; + for i := 0 to high(ACoords) do + if not isEmptyPointF(ACoords[i]) then + begin + if first then + begin + rF := RectF(Acoords[i],ACoords[i]); + first:= false; + end else + begin + if ACoords[i].x < rF.Left then rF.Left := ACoords[i].x; + if ACoords[i].x > rF.Right then rF.Right := ACoords[i].x; + if ACoords[i].y < rF.Top then rF.Top := ACoords[i].y; + if ACoords[i].y > rF.Bottom then rF.Bottom := ACoords[i].y; + end; + end; + if not first then + result := rect(floor(rF.Left-0.5),floor(rF.Top-0.5),ceil(rF.Right+1.5),ceil(rF.Bottom+1.5)) + else + result := EmptyRect; +end; + +constructor TBGRAOriginalEditor.Create; +begin + FPointSize:= 6; + FMatrix := AffineMatrixIdentity; + FMatrixInverse := AffineMatrixIdentity; + FGridMatrix := AffineMatrixIdentity; + FGridMatrixInverse := AffineMatrixIdentity; + FGridActive:= false; + FPointMoving:= -1; + FStartMoveHandlers := TStartMoveHandlers.Create; + FCurHoverPoint:= -1; + FHoverPointHandlers := THoverPointHandlers.Create; + FClickPointHandlers := TClickPointHandlers.Create; +end; + +destructor TBGRAOriginalEditor.Destroy; +begin + FreeAndNil(FStartMoveHandlers); + FreeAndNil(FHoverPointHandlers); + FreeAndNil(FClickPointHandlers); + inherited Destroy; +end; + +procedure TBGRAOriginalEditor.Clear; +begin + FPoints := nil; + FPolylines := nil; + FStartMoveHandlers.Clear; + FHoverPointHandlers.Clear; + FClickPointHandlers.Clear; +end; + +procedure TBGRAOriginalEditor.AddStartMoveHandler( + AOnStartMove: TOriginalStartMovePointEvent); +begin + FStartMoveHandlers.Add(AOnStartMove); +end; + +procedure TBGRAOriginalEditor.AddClickPointHandler( + AOnClickPoint: TOriginalClickPointEvent); +begin + FClickPointHandlers.Add(AOnClickPoint); +end; + +procedure TBGRAOriginalEditor.AddHoverPointHandler( + AOnHoverPoint: TOriginalHoverPointEvent); +begin + FHoverPointHandlers.Add(AOnHoverPoint); +end; + +function TBGRAOriginalEditor.AddPoint(const ACoord: TPointF; + AOnMove: TOriginalMovePointEvent; ARightButton: boolean; ASnapToPoint: integer): integer; +begin + setlength(FPoints, length(FPoints)+1); + result := High(FPoints); + with FPoints[result] do + begin + Origin := EmptyPointF; + Coord := ACoord; + OnMove := AOnMove; + OnAlternateMove:= nil; + RightButton:= ARightButton; + SnapToPoint:= ASnapToPoint; + HitBox := TAffineBox.EmptyBox; + end; +end; + +procedure TBGRAOriginalEditor.AddPointAlternateMove(AIndex: integer; + AOnAlternateMove: TOriginalMovePointEvent); +begin + if (AIndex >= 0) and (AIndex < PointCount) then + FPoints[AIndex].OnAlternateMove:= AOnAlternateMove; +end; + +function TBGRAOriginalEditor.AddFixedPoint(const ACoord: TPointF; + ARightButton: boolean): integer; +begin + setlength(FPoints, length(FPoints)+1); + result := High(FPoints); + with FPoints[result] do + begin + Origin := EmptyPointF; + Coord := ACoord; + OnMove := nil; + OnAlternateMove:= nil; + RightButton:= ARightButton; + Highlighted:= false; + SnapToPoint:= -1; + HitBox := TAffineBox.EmptyBox; + end; +end; + +function TBGRAOriginalEditor.AddArrow(const AOrigin, AEndCoord: TPointF; + AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean): integer; +begin + setlength(FPoints, length(FPoints)+1); + result := High(FPoints); + with FPoints[result] do + begin + Origin := AOrigin; + Coord := AEndCoord; + OnMove := AOnMoveEnd; + OnAlternateMove:= nil; + RightButton:= ARightButton; + Highlighted:= false; + SnapToPoint:= -1; + HitBox := TAffineBox.EmptyBox; + end; +end; + +function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF; + AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer; +begin + result := AddPolyline(ACoords, AClosed, AStyle, BGRAPixelTransparent); +end; + +function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF; + AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer; +var + i: Integer; +begin + setlength(FPolylines, length(FPolylines)+1); + result := high(FPolylines); + setlength(FPolylines[result].Coords, length(ACoords)); + for i := 0 to high(ACoords) do + FPolylines[result].Coords[i] := ACoords[i]; + FPolylines[result].Closed:= AClosed; + FPolylines[result].Style := AStyle; + FPolylines[result].BackColor := ABackColor; +end; + +procedure TBGRAOriginalEditor.SetHitBox(AIndex: integer; AHitBox: TAffineBox); +begin + if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); + FPoints[AIndex].HitBox := AHitBox; +end; + +procedure TBGRAOriginalEditor.MouseMove(Shift: TShiftState; ViewX, ViewY: single; out + ACursor: TOriginalEditorCursor; out AHandled: boolean); +var newMousePos, newCoord, snapCoord: TPointF; + hoverPoint, i: Integer; + subShift: TShiftState; +begin + AHandled := false; + newMousePos := ViewCoordToOriginal(PointF(ViewX,ViewY)); + if (FPointMoving <> -1) and (FPointMoving < length(FPoints)) then + begin + newCoord := newMousePos + FPointCoordDelta; + if GridActive then newCoord := SnapToGrid(newCoord, false); + if FPoints[FPointMoving].SnapToPoint <> -1 then + begin + snapCoord := FPoints[FPoints[FPointMoving].SnapToPoint].Coord; + if VectLen(AffineMatrixLinear(FMatrix)*(snapCoord - newCoord)) < FPointSize then + newCoord := snapCoord; + end; + if newCoord <> FPoints[FPointMoving].Coord then + begin + FPointWasMoved:= true; + subShift := GetFixedShiftForButton(Shift, FMovingRightButton); + if (FMovingRightButton xor FPoints[FPointMoving].RightButton) and + Assigned(FPoints[FPointMoving].OnAlternateMove) then + FPoints[FPointMoving].OnAlternateMove(self, FPoints[FPointMoving].Coord, newCoord, subShift) + else + FPoints[FPointMoving].OnMove(self, FPoints[FPointMoving].Coord, newCoord, subShift); + if (FPointMoving >= 0) and (FPointMoving < length(FPoints)) then + FPoints[FPointMoving].Coord := newCoord + else + FPointMoving := -1; + end; + ACursor := GetMoveCursor(FPointMoving); + AHandled:= true; + end else + begin + hoverPoint := GetPointAt(newMousePos, false); + if hoverPoint <> -1 then + ACursor := GetMoveCursor(hoverPoint) + else + ACursor:= oecDefault; + if hoverPoint <> FCurHoverPoint then + begin + FCurHoverPoint:= hoverPoint; + for i := 0 to FHoverPointHandlers.Count-1 do + FHoverPointHandlers[i](self, FCurHoverPoint); + end; + end; + FPrevMousePos:= newMousePos; +end; + +procedure TBGRAOriginalEditor.MouseDown(RightButton: boolean; + Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out + AHandled: boolean); +var + i, clickedPoint: Integer; + subShift: TShiftState; +begin + AHandled:= false; + FPrevMousePos:= ViewCoordToOriginal(PointF(ViewX,ViewY)); + if FPointMoving = -1 then + begin + clickedPoint := GetPointAt(FPrevMousePos, RightButton); + if clickedPoint <> -1 then + begin + subShift := GetFixedShiftForButton(Shift, RightButton); + if Assigned(FPoints[clickedPoint].OnMove) then + begin + FPointMoving:= clickedPoint; + FPointWasMoved:= false; + FMovingRightButton:= RightButton; + FPointCoordDelta := FPoints[FPointMoving].Coord - FPrevMousePos; + for i := 0 to FStartMoveHandlers.Count-1 do + FStartMoveHandlers[i](self, FPointMoving, subShift); + end else + begin + for i := 0 to FClickPointHandlers.Count-1 do + FClickPointHandlers[i](self, clickedPoint, subShift); + end; + AHandled:= true; + end; + end; + if FPointMoving <> -1 then + begin + ACursor := GetMoveCursor(FPointMoving); + AHandled:= true; + end + else + ACursor := oecDefault; +end; + +procedure TBGRAOriginalEditor.MouseUp(RightButton: boolean; Shift: TShiftState; + ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); +var + i: Integer; + subShift: TShiftState; +begin + AHandled:= false; + if (RightButton = FMovingRightButton) and (FPointMoving <> -1) then + begin + if not FPointWasMoved then + begin + subShift := GetFixedShiftForButton(Shift, RightButton); + for i := 0 to FClickPointHandlers.Count-1 do + FClickPointHandlers[i](self, FPointMoving, subShift); + end; + FPointMoving:= -1; + AHandled:= true; + end; + ACursor := oecDefault; +end; + +procedure TBGRAOriginalEditor.KeyDown(Shift: TShiftState; Key: TSpecialKey; out + AHandled: boolean); +begin + AHandled := false; +end; + +procedure TBGRAOriginalEditor.KeyUp(Shift: TShiftState; Key: TSpecialKey; out + AHandled: boolean); +begin + AHandled := false; +end; + +procedure TBGRAOriginalEditor.KeyPress(UTF8Key: string; out AHandled: boolean); +begin + AHandled := false; +end; + +function TBGRAOriginalEditor.GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer; +var v: TPointF; + curDist,newDist: single; + i: Integer; + transfCoord: TPointF; +begin + if ARightButton then + curDist := sqr(2.25*FPointSize) + else + curDist := sqr(1.25*FPointSize); + result := -1; + transfCoord:= Matrix*ACoord; + + for i := 0 to high(FPoints) do + if FPoints[i].RightButton = ARightButton then + begin + v := Matrix*FPoints[i].Coord - transfCoord; + newDist := v*v; + if newDist <= curDist then + begin + curDist:= newDist; + result := i; + end; + end; + if result <> -1 then exit; + + if not ARightButton then + curDist := sqr(2.25*FPointSize) + else + curDist := sqr(1.25*FPointSize); + for i := 0 to high(FPoints) do + if FPoints[i].RightButton <> ARightButton then + begin + v := Matrix*FPoints[i].Coord - transfCoord; + newDist := v*v; + if newDist <= curDist then + begin + curDist:= newDist; + result := i; + end; + end; + + for i := 0 to high(FPoints) do + if (FPoints[i].RightButton = ARightButton) + and FPoints[i].HitBox.Contains(ACoord) then exit(i); + + for i := 0 to high(FPoints) do + if (FPoints[i].RightButton <> ARightButton) + and FPoints[i].HitBox.Contains(ACoord) then exit(i); +end; + +function TBGRAOriginalEditor.Render(ADest: TBGRABitmap; const ALayoutRect: TRect): TRect; +var + i,j: Integer; + elemRect: TRect; + ptsF: array of TPointF; +begin + result := EmptyRect; + for i := 0 to high(FPoints) do + begin + if isEmptyPointF(FPoints[i].Origin) then + elemRect := RenderPoint(ADest, OriginalCoordToView(FPoints[i].Coord), FPoints[i].RightButton, FPoints[i].Highlighted) + else + elemRect := RenderArrow(ADest, OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord)); + if not elemRect.IsEmpty then + begin + if result.IsEmpty then + result := elemRect + else + result.Union(elemRect); + end; + end; + for i := 0 to high(FPolylines) do + begin + with FPolylines[i] do + begin + setlength(ptsF, length(Coords)); + for j := 0 to high(Coords) do + if IsEmptyPointF(Coords[j]) then + ptsF[j] := EmptyPointF + else + ptsF[j] := OriginalCoordToView(Coords[j]); + elemRect := RenderPolygon(ADest, ptsF, Closed, Style, BackColor); + end; + if not elemRect.IsEmpty then + begin + if result.IsEmpty then + result := elemRect + else + result.Union(elemRect); + end; + end; +end; + +function TBGRAOriginalEditor.GetRenderBounds(const ALayoutRect: TRect): TRect; +var + i,j: Integer; + elemRect: TRect; + ptsF: array of TPointF; +begin + result := EmptyRect; + for i := 0 to high(FPoints) do + begin + if isEmptyPointF(FPoints[i].Origin) then + elemRect := GetRenderPointBounds(OriginalCoordToView(FPoints[i].Coord), FPoints[i].Highlighted) + else + elemRect := GetRenderArrowBounds(OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord)); + if not elemRect.IsEmpty then + begin + if result.IsEmpty then + result := elemRect + else + result.Union(elemRect); + end; + end; + for i := 0 to high(FPolylines) do + begin + with FPolylines[i] do + begin + setlength(ptsF, length(Coords)); + for j := 0 to high(Coords) do + if IsEmptyPointF(Coords[j]) then + ptsF[j] := EmptyPointF + else + ptsF[j] := OriginalCoordToView(Coords[j]); + elemRect := GetRenderPolygonBounds(ptsF); + end; + if not elemRect.IsEmpty then + begin + if result.IsEmpty then + result := elemRect + else + result.Union(elemRect); + end; + end; +end; + +function TBGRAOriginalEditor.SnapToGrid(const ACoord: TPointF; + AIsViewCoord: boolean): TPointF; +var + gridCoord: TPointF; +begin + if AIsViewCoord then + gridCoord := FGridMatrixInverse*ViewCoordToOriginal(ACoord) + else + gridCoord := FGridMatrixInverse*ACoord; + gridCoord.x := round(gridCoord.x); + gridCoord.y := round(gridCoord.y); + result := FGridMatrix*gridCoord; + if AIsViewCoord then + result := OriginalCoordToView(result); +end; + +function TBGRAOriginalEditor.OriginalCoordToView(const AImageCoord: TPointF): TPointF; +begin + result := FMatrix*AImageCoord; +end; + +function TBGRAOriginalEditor.ViewCoordToOriginal(const AViewCoord: TPointF): TPointF; +begin + result := FMatrixInverse*AViewCoord; +end; + +{ TBGRAMemOriginalStorage } + +function TBGRAMemOriginalStorage.GetRawString(AName: utf8string): RawByteString; +var + idx: Integer; +begin + if pos('.',AName)<>0 then exit(''); + idx := FMemDir.IndexOf(AName,'',true); + if idx = -1 then + result := '' + else if FMemDir.IsDirectory[idx] then + raise exception.Create('This name refers to an object and not an attribute') + else + result := FMemDir.RawString[idx]; +end; + +procedure TBGRAMemOriginalStorage.SetRawString(AName: utf8string; + AValue: RawByteString); +var + idx: Integer; +begin + if pos('.',AName)<>0 then + raise exception.Create('Attribute name cannot contain "."'); + idx := FMemDir.IndexOf(AName,'',true); + if idx = -1 then + FMemDir.Add(AName,'',AValue) + else if FMemDir.IsDirectory[idx] then + raise exception.Create('This name refers to an existing object and so cannot be an attribute') + else + FMemDir.RawString[idx] := AValue; +end; + +function TBGRAMemOriginalStorage.GetEmpty: boolean; +begin + result := FMemDir.Count = 0; +end; + +destructor TBGRAMemOriginalStorage.Destroy; +begin + if FMemDirOwned then FreeAndNil(FMemDir); + inherited Destroy; +end; + +constructor TBGRAMemOriginalStorage.Create; +begin + inherited Create; + FMemDir := TMemDirectory.Create; + FMemDirOwned:= true; +end; + +constructor TBGRAMemOriginalStorage.Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false); +begin + inherited Create; + FMemDir := AMemDir; + FMemDirOwned:= AMemDirOwned; +end; + +function TBGRAMemOriginalStorage.Equals(Obj: TObject): boolean; +var + other: TBGRAMemOriginalStorage; +begin + if not (Obj is TBGRAMemOriginalStorage) then exit(false); + other := TBGRAMemOriginalStorage(obj); + result := FMemDir.Equals(other.FMemDir); +end; + +function TBGRAMemOriginalStorage.Duplicate: TBGRACustomOriginalStorage; +begin + result := TBGRAMemOriginalStorage.Create; + CopyTo(TBGRAMemOriginalStorage(result).FMemDir); +end; + +procedure TBGRAMemOriginalStorage.RemoveAttribute(AName: utf8string); +var + idx: Integer; +begin + if pos('.',AName)<>0 then exit; + idx := FMemDir.IndexOf(AName,'',true); + if idx = -1 then exit + else if FMemDir.IsDirectory[idx] then + raise exception.Create('This name refers to an object and not an attribute') + else + FMemDir.Delete(idx); +end; + +function TBGRAMemOriginalStorage.HasAttribute(AName: utf8string): boolean; +var + idx: Integer; +begin + if pos('.',AName)<>0 then exit(false); + idx := FMemDir.IndexOf(AName,'',true); + if idx = -1 then exit(false) + else exit(not FMemDir.IsDirectory[idx]); +end; + +procedure TBGRAMemOriginalStorage.RemoveObject(AName: utf8string); +var + idx: Integer; +begin + idx := FMemDir.IndexOf(EntryFilename(AName)); + if idx = -1 then exit + else if not FMemDir.IsDirectory[idx] then + raise exception.Create('This name refers to an attribute and not an object') + else + FMemDir.Delete(idx); +end; + +function TBGRAMemOriginalStorage.CreateObject(AName: utf8string): TBGRACustomOriginalStorage; +var + dirIdx: Integer; +begin + if pos('.',AName)<>0 then + raise exception.Create('An object cannot contain "."'); + RemoveObject(AName); + dirIdx := FMemDir.AddDirectory(AName,''); + result := TBGRAMemOriginalStorage.Create(FMemDir.Directory[dirIdx]); +end; + +function TBGRAMemOriginalStorage.OpenObject(AName: utf8string): TBGRACustomOriginalStorage; +var + dir: TMemDirectory; +begin + if pos('.',AName)<>0 then + raise exception.Create('An object cannot contain "."'); + dir := FMemDir.FindPath(AName); + if dir = nil then + result := nil + else + result := TBGRAMemOriginalStorage.Create(dir); +end; + +function TBGRAMemOriginalStorage.ObjectExists(AName: utf8string): boolean; +var + dir: TMemDirectory; +begin + if pos('.',AName)<>0 then exit(false); + dir := FMemDir.FindPath(AName); + result:= Assigned(dir); +end; + +procedure TBGRAMemOriginalStorage.EnumerateObjects(AList: TStringList); +var + i: Integer; +begin + for i := 0 to FMemDir.Count-1 do + if FMemDir.IsDirectory[i] then + AList.Add(FMemDir.Entry[i].Name); +end; + +procedure TBGRAMemOriginalStorage.EnumerateFiles(AList: TStringList); +var + i: Integer; +begin + for i := 0 to FMemDir.Count-1 do + if not FMemDir.IsDirectory[i] then + AList.Add(FMemDir.Entry[i].Name); +end; + +procedure TBGRAMemOriginalStorage.RemoveFile(AName: utf8string); +var + idx: Integer; +begin + idx := FMemDir.IndexOf(EntryFilename(AName)); + if idx = -1 then exit + else if FMemDir.IsDirectory[idx] then + raise exception.Create('This name refers to an object and not a file') + else + FMemDir.Delete(idx); +end; + +function TBGRAMemOriginalStorage.GetFileStream(AName: UTF8String): TStream; +var + entryId: Integer; +begin + entryId := FMemDir.IndexOf(EntryFilename(AName)); + if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then + begin + with FMemDir.Entry[entryId] do + result := GetStream; + end + else + result := nil; +end; + +function TBGRAMemOriginalStorage.ReadBitmap(AName: UTF8String; + ADest: TCustomUniversalBitmap): boolean; +var + entryId: Integer; + stream: TStream; +begin + entryId := FMemDir.IndexOf(EntryFilename(AName)); + if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then + begin + if FMemDir.IsEntryCompressed[entryId] then + begin + stream := TMemoryStream.Create; + try + with FMemDir.Entry[entryId] do + begin + if CopyTo(stream) <> FileSize then + result := false + else + begin + stream.Position:= 0; + ADest.LoadFromStream(stream); + result := true; + end; + end; + finally + stream.Free; + end; + end else + with FMemDir.Entry[entryId] do + begin + stream := GetStream; + stream.Position:= 0; + ADest.LoadFromStream(stream); + result := true; + end; + end + else + result := false; +end; + +function TBGRAMemOriginalStorage.ReadFile(AName: UTF8String; ADest: TStream): boolean; +var + entryId: Integer; +begin + entryId := FMemDir.IndexOf(EntryFilename(AName)); + if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then + begin + with FMemDir.Entry[entryId] do + result := CopyTo(ADest) = FileSize + end + else + result := false; +end; + +procedure TBGRAMemOriginalStorage.WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean); +var + idxEntry: Integer; +begin + idxEntry := FMemDir.Add(EntryFilename(AName), ASource, true, AOwnStream); + if ACompress then FMemDir.IsEntryCompressed[idxEntry] := true; +end; + +function TBGRAMemOriginalStorage.FileExists(AName: UTF8String): boolean; +var + entryId: Integer; +begin + entryId := FMemDir.IndexOf(EntryFilename(AName)); + result := (entryId <> -1) and not FMemDir.IsDirectory[entryId]; +end; + +procedure TBGRAMemOriginalStorage.SaveToStream(AStream: TStream); +begin + FMemDir.SaveToStream(AStream); +end; + +procedure TBGRAMemOriginalStorage.LoadFromStream(AStream: TStream); +begin + FMemDir.LoadFromStream(AStream); +end; + +procedure TBGRAMemOriginalStorage.LoadFromResource(AFilename: string); +begin + FMemDir.LoadFromResource(AFilename); +end; + +procedure TBGRAMemOriginalStorage.CopyTo(AMemDir: TMemDirectory); +begin + FMemDir.CopyTo(AMemDir, true); +end; + +{ TBGRACustomOriginalStorage } + +function TBGRACustomOriginalStorage.GetColor(AName: UTF8String): TBGRAPixel; +begin + result := StrToBGRA(RawString[AName], BGRAPixelTransparent); +end; + +procedure TBGRACustomOriginalStorage.SetColor(AName: UTF8String; + AValue: TBGRAPixel); +begin + RawString[AName] := LowerCase(BGRAToStr(AValue, CSSColors)); +end; + +function TBGRACustomOriginalStorage.GetDelimiter: char; +begin + if FFormats.DecimalSeparator = ',' then + result := ';' else result := ','; +end; + +function TBGRACustomOriginalStorage.GetRectF(AName: utf8string): TRectF; +var + a: array of Single; +begin + a := FloatArray[AName]; + if length(a)<4 then + result := EmptyRectF + else + begin + result.Left := a[0]; + result.Top := a[1]; + result.Right := a[2]; + result.Bottom := a[3]; + end; +end; + +procedure TBGRACustomOriginalStorage.SetRectF(AName: utf8string; AValue: TRectF); +var + a: array of Single; +begin + setlength(a,4); + a[0] := AValue.Left; + a[1] := AValue.Top; + a[2] := AValue.Right; + a[3] := AValue.Bottom; + FloatArray[AName] := a; +end; + +function TBGRACustomOriginalStorage.GetAffineMatrix(AName: utf8string): TAffineMatrix; +var + stream: TMemoryStream; +begin + stream:= TMemoryStream.Create; + if ReadFile(AName, stream) and (stream.Size >= sizeof(result)) then + begin + stream.Position:= 0; + {$PUSH}{$HINTS OFF}stream.ReadBuffer({%H-}result, sizeof({%H-}result));{$POP} + LongWord(result[1,1]) := NtoLE(LongWord(result[1,1])); + LongWord(result[2,1]) := NtoLE(LongWord(result[2,1])); + LongWord(result[1,2]) := NtoLE(LongWord(result[1,2])); + LongWord(result[2,2]) := NtoLE(LongWord(result[2,2])); + LongWord(result[1,3]) := NtoLE(LongWord(result[1,3])); + LongWord(result[2,3]) := NtoLE(LongWord(result[2,3])); + end else + result := AffineMatrixIdentity; + stream.Free; +end; + +procedure TBGRACustomOriginalStorage.SetAffineMatrix(AName: utf8string; + const AValue: TAffineMatrix); +var + stream: TMemoryStream; +begin + stream:= TMemoryStream.Create; + stream.WriteBuffer(AValue, sizeof(AValue)); + WriteFile(AName,stream,false,true); +end; + +function TBGRACustomOriginalStorage.GetRect(AName: utf8string): TRect; +var + rF: TRectF; +begin + rF := RectangleF[AName]; + result := rect(round(rF.Left),round(rF.Top),round(rF.Right),round(rF.Bottom)); +end; + +procedure TBGRACustomOriginalStorage.SetRect(AName: utf8string; AValue: TRect); +var + rF: TRectF; +begin + rF := rectF(AValue.Left,AValue.Top,AValue.Right,AValue.Bottom); + RectangleF[AName] := rF; +end; + +function TBGRACustomOriginalStorage.GetBoolDef(AName: utf8string; + ADefault: boolean): boolean; +begin + if RawString[AName] = 'true' then result := true + else if RawString[AName] = 'false' then result := false + else result := ADefault; +end; + +function TBGRACustomOriginalStorage.GetBool(AName: utf8string): boolean; +begin + result := GetBoolDef(AName, false); +end; + +function TBGRACustomOriginalStorage.GetSingleArray(AName: utf8string): ArrayOfSingle; +var + textVal: String; + values: TStringList; + i: Integer; +begin + textVal := Trim(RawString[AName]); + if textVal = '' then exit(nil); + values := TStringList.Create; + values.StrictDelimiter := true; + values.Delimiter:= GetDelimiter; + values.DelimitedText:= textVal; + setlength(result, values.Count); + for i := 0 to high(result) do + if CompareText(values[i],'none')=0 then + result[i] := EmptySingle + else + result[i] := StrToFloatDef(values[i], 0, FFormats); + values.Free; +end; + +function TBGRACustomOriginalStorage.GetColorArray(AName: UTF8String + ): ArrayOfTBGRAPixel; +var colorNames: TStringList; + i: Integer; +begin + colorNames := TStringList.Create; + colorNames.StrictDelimiter := true; + colorNames.Delimiter:= GetDelimiter; + colorNames.DelimitedText:= RawString[AName]; + setlength(result, colorNames.Count); + for i := 0 to high(result) do + result[i] := StrToBGRA(colorNames[i],BGRAPixelTransparent); + colorNames.Free; +end; + +function TBGRACustomOriginalStorage.GetIntegerDef(AName: utf8string; + ADefault: integer): integer; +begin + result := StrToIntDef(RawString[AName],ADefault); +end; + +function TBGRACustomOriginalStorage.GetSingleDef(AName: utf8string; + ADefault: single): single; +begin + result := StrToFloatDef(RawString[AName], ADefault, FFormats); +end; + +procedure TBGRACustomOriginalStorage.SetBool(AName: utf8string; AValue: boolean); +begin + RawString[AName] := BoolToStr(AValue,'true','false'); +end; + +procedure TBGRACustomOriginalStorage.SetSingleArray(AName: utf8string; + AValue: ArrayOfSingle); +var + values: TStringList; + i: Integer; +begin + values:= TStringList.Create; + values.StrictDelimiter:= true; + values.Delimiter:= GetDelimiter; + for i := 0 to high(AValue) do + if AValue[i] = EmptySingle then + values.Add('none') + else + values.Add(FloatToStr(AValue[i], FFormats)); + RawString[AName] := values.DelimitedText; + values.Free; +end; + +procedure TBGRACustomOriginalStorage.SetColorArray(AName: UTF8String; + AValue: ArrayOfTBGRAPixel); +var colorNames: TStringList; + i: Integer; +begin + colorNames := TStringList.Create; + colorNames.StrictDelimiter := true; + colorNames.Delimiter:= GetDelimiter; + for i := 0 to high(AValue) do + colorNames.Add(LowerCase(BGRAToStr(AValue[i], CSSColors))); + RawString[AName] := colorNames.DelimitedText; + colorNames.Free; +end; + +function TBGRACustomOriginalStorage.GetInteger(AName: utf8string): integer; +begin + result := GetIntegerDef(AName,0); +end; + +function TBGRACustomOriginalStorage.GetPointF(AName: utf8string): TPointF; +var + s: String; + posComma: integer; +begin + s := RawString[AName]; + posComma := pos(GetDelimiter,s); + if posComma = 0 then + exit(EmptyPointF); + + result.x := StrToFloat(copy(s,1,posComma-1), FFormats); + result.y := StrToFloat(copy(s,posComma+1,length(s)-posComma), FFormats); +end; + +function TBGRACustomOriginalStorage.GetSingle(AName: utf8string): single; +begin + result := GetSingleDef(AName, EmptySingle); +end; + +procedure TBGRACustomOriginalStorage.SetInteger(AName: utf8string; + AValue: integer); +begin + RawString[AName] := IntToStr(AValue); +end; + +procedure TBGRACustomOriginalStorage.SetPointF(AName: utf8string; + AValue: TPointF); +begin + if isEmptyPointF(AValue) then RemoveAttribute(AName) + else RawString[AName] := FloatToStrF(AValue.x, ffGeneral,7,3, FFormats)+GetDelimiter+FloatToStrF(AValue.y, ffGeneral,7,3, FFormats); +end; + +procedure TBGRACustomOriginalStorage.SetSingle(AName: utf8string; AValue: single); +begin + if AValue = EmptySingle then RemoveAttribute(AName) + else RawString[AName] := FloatToStrF(AValue, ffGeneral,7,3, FFormats); +end; + +constructor TBGRACustomOriginalStorage.Create; +begin + FFormats := DefaultFormatSettings; + FFormats.DecimalSeparator := '.'; +end; + +function TBGRACustomOriginalStorage.FloatEquals(AName: utf8string; + AValue: single): boolean; +var + curValue: Single; +begin + curValue := Float[AName]; + if curValue = EmptySingle then + result := (AValue = EmptySingle) else + if AValue = EmptySingle then + result := false else + result := (FloatToStrF(AValue, ffGeneral,7,3, FFormats) = + FloatToStrF(curValue, ffGeneral,7,3, FFormats)); +end; + +function TBGRACustomOriginalStorage.PointFEquals(AName: utf8string; + const AValue: TPointF): boolean; +var + curValue: TPointF; +begin + curValue := PointF[AName]; + if isEmptyPointF(curValue) then + result := isEmptyPointF(AValue) else + if isEmptyPointF(AValue) then + result := False else + result := (FloatToStrF(AValue.x, ffGeneral,7,3, FFormats) = + FloatToStrF(curValue.x, ffGeneral,7,3, FFormats)) and + (FloatToStrF(AValue.y, ffGeneral,7,3, FFormats) = + FloatToStrF(curValue.y, ffGeneral,7,3, FFormats)); +end; + +function TBGRACustomOriginalStorage.AffineMatrixEquals(AName: utf8string; + const AValue: TAffineMatrix): boolean; +begin + result := (AffineMatrix[AName] = AValue); +end; + +{ TBGRALayerCustomOriginal } + +procedure TBGRALayerCustomOriginal.SetOnChange(AValue: TOriginalChangeEvent); +begin + if FOnChange=AValue then Exit; + FOnChange:=AValue; +end; + +function TBGRALayerCustomOriginal.GetDiffExpected: boolean; +begin + result := Assigned(FOnChange); +end; + +procedure TBGRALayerCustomOriginal.SetRenderStorage(AValue: TBGRACustomOriginalStorage); +begin + if FRenderStorage=AValue then Exit; + FRenderStorage:=AValue; +end; + +function TBGRALayerCustomOriginal.GetGuid: TGuid; +begin + result := FGuid; +end; + +procedure TBGRALayerCustomOriginal.SetGuid(AValue: TGuid); +begin + FGuid := AValue; +end; + +procedure TBGRALayerCustomOriginal.NotifyChange(ADiff: TBGRAOriginalDiff); +begin + if Assigned(FOnChange) then + FOnChange(self, nil, ADiff); + ADiff.Free; +end; + +procedure TBGRALayerCustomOriginal.NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff); +begin + if Assigned(FOnChange) then + FOnChange(self, @ABounds, ADiff); + ADiff.Free; +end; + +procedure TBGRALayerCustomOriginal.NotifyEditorChange; +begin + if Assigned(FOnEditingChange) then + FOnEditingChange(self); +end; + +constructor TBGRALayerCustomOriginal.Create; +begin + FGuid := GUID_NULL; + FRenderStorage := nil; +end; + +destructor TBGRALayerCustomOriginal.Destroy; +begin + inherited Destroy; +end; + +procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap; + AMatrix: TAffineMatrix; ADraft: boolean); +begin + Render(ADest, Point(0,0), AMatrix, ADraft); +end; + +procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap; + ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); +begin + Render(ADest, AffineMatrixTranslation(ARenderOffset.X, ARenderOffset.Y)*AMatrix, ADraft); +end; + +procedure TBGRALayerCustomOriginal.ConfigureEditor(AEditor: TBGRAOriginalEditor); +begin + //nothing +end; + +procedure TBGRALayerCustomOriginal.LoadFromFile(AFilenameUTF8: string); +var + s: TFileStreamUTF8; +begin + s := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead, fmShareDenyWrite); + try + LoadFromStream(s); + finally + s.Free; + end; +end; + +procedure TBGRALayerCustomOriginal.LoadFromStream(AStream: TStream); +var storage: TBGRAMemOriginalStorage; + memDir: TMemDirectory; +begin + memDir := TMemDirectory.Create; + storage := nil; + try + memDir.LoadFromStream(AStream); + storage := TBGRAMemOriginalStorage.Create(memDir); + if storage.RawString['class'] <> StorageClassName then + raise exception.Create('Invalid class'); + LoadFromStorage(storage); + FreeAndNil(storage); + finally + storage.Free; + memDir.Free; + end; +end; + +procedure TBGRALayerCustomOriginal.LoadFromResource(AFilename: string); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TBGRALayerCustomOriginal.SaveToFile(AFilenameUTF8: string); +var + s: TFileStreamUTF8; +begin + s := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); + try + SaveToStream(s); + finally + s.Free; + end; +end; + +procedure TBGRALayerCustomOriginal.SaveToStream(AStream: TStream); +var storage: TBGRAMemOriginalStorage; + memDir: TMemDirectory; +begin + memDir := TMemDirectory.Create; + storage := nil; + try + storage := TBGRAMemOriginalStorage.Create(memDir); + storage.RawString['class'] := StorageClassName; + SaveToStorage(storage); + FreeAndNil(storage); + memDir.SaveToStream(AStream); + finally + storage.Free; + memDir.Free; + end; +end; + +function TBGRALayerCustomOriginal.CreateEditor: TBGRAOriginalEditor; +begin + result := TBGRAOriginalEditor.Create; +end; + +class function TBGRALayerCustomOriginal.CanConvertToSVG: boolean; +begin + result := false; +end; + +function TBGRALayerCustomOriginal.IsInfiniteSurface: boolean; +begin + result := false; +end; + +function TBGRALayerCustomOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; +begin + AOffset := Point(0,0); + raise exception.Create('Not implemented'); +end; + +function TBGRALayerCustomOriginal.Duplicate: TBGRALayerCustomOriginal; +var + storage: TBGRAMemOriginalStorage; + c: TBGRALayerOriginalAny; +begin + c := FindLayerOriginalClass(StorageClassName); + if c = nil then raise exception.Create('Original class is not registered'); + storage := TBGRAMemOriginalStorage.Create; + try + SaveToStorage(storage); + result := c.Create; + result.LoadFromStorage(storage); + finally + storage.Free; + end; +end; + +{ TBGRALayerImageOriginal } + +function TBGRALayerImageOriginal.GetImageHeight: integer; +begin + if Assigned(FImage) then + result := FImage.Height + else + result := 0; +end; + +function TBGRALayerImageOriginal.GetImageWidth: integer; +begin + if Assigned(FImage) then + result := FImage.Width + else + result := 0; +end; + +procedure TBGRALayerImageOriginal.BeginUpdate; +begin + if DiffExpected and (FDiff=nil) then + FDiff := TBGRAImageOriginalDiff.Create(self); +end; + +procedure TBGRALayerImageOriginal.EndUpdate; +begin + if Assigned(FDiff) then FDiff.ComputeDiff(self); + NotifyChange(FDiff); + FDiff := nil; +end; + +procedure TBGRALayerImageOriginal.InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean); +var + newJpegStream: TMemoryStream; + newImage: TBGRABitmap; +begin + if DetectFileFormat(AStream) = ifJpeg then + begin + newJpegStream := TMemoryStream.Create; + try + newJpegStream.CopyFrom(AStream, AStream.Size); + newJpegStream.Position := 0; + newImage := TBGRABitmap.Create(newJpegStream); + if AUpdate then BeginUpdate; + InternalClear; + FImage := newImage; + FJpegStream := newJpegStream; + newImage := nil; + newJpegStream := nil; + if AUpdate then + begin + Inc(FContentVersion); + EndUpdate; + end; + finally + newJpegStream.Free; + newImage.Free; + end; + end else + begin + newImage := TBGRABitmap.Create(AStream); + if AUpdate then BeginUpdate; + InternalClear; + FImage := newImage; + if AUpdate then + begin + Inc(FContentVersion); + EndUpdate; + end; + end; +end; + +procedure TBGRALayerImageOriginal.InternalClear; +begin + if Assigned(FImage) then + begin + FImage.FreeReference; + FImage := nil + end; + FreeAndNil(FJpegStream); +end; + +constructor TBGRALayerImageOriginal.Create; +begin + inherited Create; + FImage := nil; + FContentVersion := 0; + FJpegStream := nil; +end; + +destructor TBGRALayerImageOriginal.Destroy; +begin + FImage.FreeReference; + FJpegStream.Free; + FDiff.Free; + inherited Destroy; +end; + +function TBGRALayerImageOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; +var + svg: TBGRASVG; + img: TSVGImage; +begin + svg := TBGRASVG.Create(Width, Height, cuPixel); + Result:= svg; + AOffset := Point(0,0); + if Assigned(FJpegStream) then + img := svg.Content.AppendImage(0,0,Width,Height,FJpegStream,'image/jpeg') else + if Assigned(FImage) then + img := svg.Content.AppendImage(0,0,Width,Height,FImage,false); + img.matrix[cuCustom] := AMatrix; +end; + +procedure TBGRALayerImageOriginal.Render(ADest: TBGRABitmap; + AMatrix: TAffineMatrix; ADraft: boolean); +var resampleFilter: TResampleFilter; +begin + if ADraft then resampleFilter := rfBox else resampleFilter:= rfCosine; + if Assigned(FImage) then + ADest.PutImageAffine(AMatrix, FImage, resampleFilter, dmSet); +end; + +function TBGRALayerImageOriginal.GetRenderBounds(ADestRect: TRect; + AMatrix: TAffineMatrix): TRect; +var + aff: TAffineBox; +begin + if Assigned(FImage) then + begin + aff := AMatrix*TAffineBox.AffineBox(PointF(0,0),PointF(FImage.Width,0),PointF(0,FImage.Height)); + result := aff.RectBounds; + end else + result := EmptyRect; +end; + +procedure TBGRALayerImageOriginal.LoadFromStorage( + AStorage: TBGRACustomOriginalStorage); +var imgStream: TMemoryStream; + newImage: TBGRABitmap; +begin + imgStream := TMemoryStream.Create; + try + if AStorage.ReadFile('content.png', imgStream) then + begin + imgStream.Position:= 0; + newImage := TBGRABitmap.Create(imgStream); + InternalClear; + FImage := newImage; + end else + if AStorage.ReadFile('content.jpg', imgStream) then + begin + imgStream.Position:= 0; + newImage := TBGRABitmap.Create(imgStream); + InternalClear; + FImage := newImage; + FJpegStream := imgStream; + imgStream:= nil; + end else + InternalClear; + FContentVersion := AStorage.Int['content-version']; + finally + imgStream.Free; + end; +end; + +procedure TBGRALayerImageOriginal.SaveToStorage( + AStorage: TBGRACustomOriginalStorage); +var imgStream: TMemoryStream; +begin + if Assigned(FImage) then + begin + if FContentVersion > AStorage.Int['content-version'] then + begin + if Assigned(FJpegStream) then + begin + AStorage.WriteFile('content.jpg', FJpegStream, false); + AStorage.RemoveFile('content.png'); + AStorage.Int['content-version'] := FContentVersion; + end else + begin + imgStream := TMemoryStream.Create; + try + FImage.SaveToStreamAsPng(imgStream); + AStorage.RemoveFile('content.jpg'); + AStorage.WriteFile('content.png', imgStream, false); + AStorage.Int['content-version'] := FContentVersion; + finally + imgStream.Free; + end; + end; + end; + end else + begin + AStorage.RemoveFile('content.jpg'); + AStorage.RemoveFile('content.png'); + AStorage.Int['content-version'] := FContentVersion; + end; +end; + +procedure TBGRALayerImageOriginal.LoadFromStream(AStream: TStream); +begin + if TMemDirectory.CheckHeader(AStream) then + inherited LoadFromStream(AStream) + else + begin + InternalLoadImageFromStream(AStream, False); + inc(FContentVersion); + end; +end; + +procedure TBGRALayerImageOriginal.Clear; +begin + BeginUpdate; + InternalClear; + Inc(FContentVersion); + EndUpdate; +end; + +procedure TBGRALayerImageOriginal.LoadImageFromStream(AStream: TStream); +begin + InternalLoadImageFromStream(AStream, True); +end; + +procedure TBGRALayerImageOriginal.SaveImageToStream(AStream: TStream); +begin + if Assigned(FJpegStream) then + begin + FJpegStream.Position := 0; + if AStream.CopyFrom(FJpegStream, FJpegStream.Size)<>FJpegStream.Size then + raise exception.Create('Error while saving'); + end else + if Assigned(FImage) then + FImage.SaveToStreamAsPng(AStream) + else raise exception.Create('No image to be saved'); +end; + +procedure TBGRALayerImageOriginal.AssignImage(AImage: TBGRACustomBitmap); +var + newImage: TBGRABitmap; +begin + newImage := TBGRABitmap.Create; + newImage.Assign(AImage); + BeginUpdate; + InternalClear; + FImage := newImage; + Inc(FContentVersion); + EndUpdate; +end; + +function TBGRALayerImageOriginal.GetImageCopy: TBGRABitmap; +begin + if FImage = nil then result := nil + else result := FImage.Duplicate; +end; + +class function TBGRALayerImageOriginal.StorageClassName: RawByteString; +begin + result := 'image'; +end; + +class function TBGRALayerImageOriginal.CanConvertToSVG: boolean; +begin + Result:= true; +end; + +initialization + + RegisterLayerOriginal(TBGRALayerImageOriginal); + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralayers.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralayers.pas new file mode 100644 index 0000000..51a2def --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralayers.pas @@ -0,0 +1,3617 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALayers; + +{$mode objfpc}{$H+} +{$MODESWITCH ADVANCEDRECORDS} + +interface + +uses + BGRAGraphics, BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, + BGRAMemDirectory, BGRATransform, fgl, BGRALayerOriginal; + +type + TBGRACustomLayeredBitmap = class; + TBGRACustomLayeredBitmapClass = class of TBGRACustomLayeredBitmap; + + { TBGRALayerOriginalEntry } + + TBGRALayerOriginalEntry = record + Guid: TGuid; + Instance: TBGRALayerCustomOriginal; + class operator = (const AEntry1,AEntry2: TBGRALayerOriginalEntry): boolean; + end; + +function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry; +function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry; + +type + TBGRALayerOriginalList = specialize TFPGList; + + TBGRALayeredBitmap = class; + TBGRALayeredBitmapClass = class of TBGRALayeredBitmap; + + TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); + TBGRALayeredBitmapLoadFromStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); + TBGRALayeredBitmapCheckStreamProc = function(AStream: TStream): boolean; + TOriginalRenderStatus = (orsNone, orsDraft, orsPartialDraft, orsProof, orsPartialProof); + + { TBGRACustomLayeredBitmap } + + TBGRACustomLayeredBitmap = class(TGraphic) + private + FFrozenRange: array of record + firstLayer,lastLayer: integer; + image: TBGRABitmap; + linearBlend: boolean; + end; + FLinearBlend: boolean; + FMemDirectory: TMemDirectory; + FMemDirectoryOwned: boolean; + FSelectionDrawMode: TDrawMode; + FSelectionLayerIndex: integer; + FSelectionRect: TRect; + FSelectionScanner: IBGRAScanner; + FSelectionScannerOffset: TPoint; + function GetDefaultBlendingOperation: TBlendOperation; + function GetHasMemFiles: boolean; + function GetLinearBlend: boolean; + function GetSelectionVisible: boolean; + procedure SetLinearBlend(AValue: boolean); + + protected + function GetNbLayers: integer; virtual; abstract; + function GetMemDirectory: TMemDirectory; + function GetBlendOperation(Layer: integer): TBlendOperation; virtual; abstract; + function GetLayerVisible(layer: integer): boolean; virtual; abstract; + function GetLayerOpacity(layer: integer): byte; virtual; abstract; + function GetLayerName(layer: integer): string; virtual; + function GetLayerOffset(layer: integer): TPoint; virtual; + function GetLayerFrozenRange(layer: integer): integer; + function GetLayerFrozen(layer: integer): boolean; virtual; + function GetLayerUniqueId(layer: integer): integer; virtual; + function GetLayerOriginal({%H-}layer: integer): TBGRALayerCustomOriginal; virtual; + function GetLayerOriginalKnown({%H-}layer: integer): boolean; virtual; + function GetLayerOriginalMatrix({%H-}layer: integer): TAffineMatrix; virtual; + function GetLayerOriginalGuid({%H-}layer: integer): TGuid; virtual; + function GetLayerOriginalRenderStatus({%H-}layer: integer): TOriginalRenderStatus; virtual; + function GetOriginalCount: integer; virtual; + function GetOriginalByIndex({%H-}AIndex: integer): TBGRALayerCustomOriginal; virtual; + function GetOriginalByIndexKnown({%H-}AIndex: integer): boolean; virtual; + function GetOriginalByIndexLoaded({%H-}AIndex: integer): boolean; virtual; + function GetOriginalByIndexClass({%H-}AIndex: integer): TBGRALayerOriginalAny; virtual; + function GetTransparent: Boolean; override; + function GetEmpty: boolean; override; + + function IndexOfOriginal(const AGuid: TGuid): integer; overload; virtual; + function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; virtual; + + procedure SetWidth(Value: Integer); override; + procedure SetHeight(Value: Integer); override; + procedure SetMemDirectory(AValue: TMemDirectory); + procedure SetTransparent(Value: Boolean); override; + + procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual; + function RangeIntersect(first1,last1,first2,last2: integer): boolean; + procedure RemoveFrozenRange(index: integer); + function ContainsFrozenRange(first,last: integer): boolean; + function GetLayerDrawMode(AIndex: integer): TDrawMode; + + public + procedure SaveToFile(const filenameUTF8: string); override; + procedure SaveToStream(Stream: TStream); override; + procedure SaveToStreamAs(Stream: TStream; AExtension: string); + constructor Create; override; + destructor Destroy; override; + function ToString: ansistring; override; + procedure DiscardSelection; + function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual; + function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract; + function ComputeFlatImage(ASeparateXorMask: boolean = false): TBGRABitmap; overload; + function ComputeFlatImage(firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload; + function ComputeFlatImage(ARect: TRect; ASeparateXorMask: boolean = false): TBGRABitmap; overload; + function ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload; + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; overload; + procedure Draw(Canvas: TCanvas; x,y: integer); overload; + procedure Draw(Canvas: TCanvas; x,y: integer; firstLayer, lastLayer: integer); overload; + procedure Draw(Dest: TBGRABitmap; x,y: integer); overload; + procedure Draw(Dest: TBGRABitmap; x,y: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean = false); overload; + procedure Draw(Dest: TBGRABitmap; AX,AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false); overload; + function DrawLayer(Dest: TBGRABitmap; X,Y: Integer; AIndex: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false): boolean; + + procedure FreezeExceptOneLayer(layer: integer); overload; + procedure Freeze(firstLayer, lastLayer: integer); overload; + procedure Freeze; overload; + procedure Unfreeze; overload; + procedure Unfreeze(layer: integer); overload; + procedure Unfreeze(firstLayer, lastLayer: integer); overload; + + procedure NotifyLoaded; virtual; + procedure NotifySaving; virtual; + + property NbLayers: integer read GetNbLayers; + property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation; + property LayerVisible[layer: integer]: boolean read GetLayerVisible; + property LayerOpacity[layer: integer]: byte read GetLayerOpacity; + property LayerName[layer: integer]: string read GetLayerName; + property LayerOffset[layer: integer]: TPoint read GetLayerOffset; + property LayerFrozen[layer: integer]: boolean read GetLayerFrozen; + property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId; + property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal; + property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown; + property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid; + property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix; + property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus; + property SelectionScanner: IBGRAScanner read FSelectionScanner write FSelectionScanner; + property SelectionScannerOffset: TPoint read FSelectionScannerOffset write FSelectionScannerOffset; + property SelectionRect: TRect read FSelectionRect write FSelectionRect; + property SelectionLayerIndex: integer read FSelectionLayerIndex write FSelectionLayerIndex; + property SelectionDrawMode: TDrawMode read FSelectionDrawMode write FSelectionDrawMode; + property SelectionVisible: boolean read GetSelectionVisible; + property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified + property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation; + property MemDirectory: TMemDirectory read GetMemDirectory write SetMemDirectory; + property MemDirectoryOwned: boolean read FMemDirectoryOwned write FMemDirectoryOwned; + property HasMemFiles: boolean read GetHasMemFiles; + end; + + TEmbeddedOriginalChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal; + var ADiff: TBGRAOriginalDiff) of object; + TEmbeddedOriginalEditingChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal) of object; + TLayeredActionProgressEvent = procedure(ASender: TObject; AProgressPercent: integer) of object; + TEmbeddedOriginalLoadErrorEvent = procedure (ASender: TObject; AError: string; var ARaise: boolean) of object; + + TBGRALayerInfo = record + UniqueId: integer; + Name: string; + x, y: integer; + Source: TBGRABitmap; + blendOp: TBlendOperation; + Opacity: byte; + Visible: boolean; + Owner: boolean; + Frozen: boolean; + OriginalMatrix: TAffineMatrix; + OriginalRenderStatus: TOriginalRenderStatus; + OriginalGuid: TGuid; + OriginalInvalidatedBounds: TRectF; + end; + + { TBGRALayeredBitmap } + + TBGRALayeredBitmap = class(TBGRACustomLayeredBitmap) + private + FNbLayers: integer; + FLayers: array of TBGRALayerInfo; + FOnActionDone: TNotifyEvent; + FOnEditorFocusChanged: TNotifyEvent; + FEditorFocused: boolean; + FOnActionProgress: TLayeredActionProgressEvent; + FOnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent; + FOriginalChange: TEmbeddedOriginalChangeEvent; + FOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent; + FWidth,FHeight: integer; + FOriginals: TBGRALayerOriginalList; + FOriginalEditor: TBGRAOriginalEditor; + FOriginalEditorOriginal: TGuid; + FOriginalEditorViewMatrix: TAffineMatrix; + procedure EditorFocusedChanged({%H-}Sender: TObject); + function GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny; + function GetOriginalEditor: TBGRAOriginalEditor; + function GetOriginalGuid(AIndex: integer): TGUID; + procedure SetEditorFocused(AValue: boolean); + procedure SetOnActionDone(AValue: TNotifyEvent); + procedure SetOnActionProgress(AValue: TLayeredActionProgressEvent); + + protected + function GetWidth: integer; override; + function GetHeight: integer; override; + function GetNbLayers: integer; override; + function GetBlendOperation(Layer: integer): TBlendOperation; override; + function GetLayerVisible(layer: integer): boolean; override; + function GetLayerOpacity(layer: integer): byte; override; + function GetLayerOffset(layer: integer): TPoint; override; + function GetLayerName(layer: integer): string; override; + function GetLayerFrozen(layer: integer): boolean; override; + function GetLayerUniqueId(layer: integer): integer; override; + function GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; override; + function GetLayerOriginalKnown(layer: integer): boolean; override; + function GetLayerOriginalMatrix(layer: integer): TAffineMatrix; override; + function GetLayerOriginalGuid(layer: integer): TGuid; override; + function GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; override; + function GetOriginalCount: integer; override; + function GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; override; + function GetOriginalByIndexKnown(AIndex: integer): boolean; override; + function GetOriginalByIndexLoaded(AIndex: integer): boolean; override; + function GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; override; + procedure SetBlendOperation(Layer: integer; op: TBlendOperation); + procedure SetLayerVisible(layer: integer; AValue: boolean); + procedure SetLayerOpacity(layer: integer; AValue: byte); + procedure SetLayerOffset(layer: integer; AValue: TPoint); + procedure SetLayerName(layer: integer; AValue: string); + procedure SetLayerFrozen(layer: integer; AValue: boolean); override; + procedure SetLayerUniqueId(layer: integer; AValue: integer); + procedure SetLayerOriginalMatrix(layer: integer; AValue: TAffineMatrix); + procedure SetLayerOriginalGuid(layer: integer; const AValue: TGuid); + procedure SetLayerOriginalRenderStatus(layer: integer; AValue: TOriginalRenderStatus); + + procedure FindOriginal(AGuid: TGuid; + out ADir: TMemDirectory; + out AClass: TBGRALayerOriginalAny); + procedure StoreOriginal(AOriginal: TBGRALayerCustomOriginal); + procedure OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff); + procedure OriginalEditingChange(ASender: TObject); + function GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory; + procedure UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix; + APointSize: single); + + public + procedure LoadFromFile(const filenameUTF8: string); override; + procedure LoadFromStream(stream: TStream); override; + procedure LoadFromResource(AFilename: string); + procedure SetSize(AWidth, AHeight: integer); virtual; + procedure Clear; override; + procedure ClearOriginals; + procedure RemoveLayer(index: integer); + procedure InsertLayer(index: integer; fromIndex: integer); + procedure Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean = false; + ACopyAdditionalMemData: boolean = false); overload; + function MoveLayerUp(index: integer): integer; + function MoveLayerDown(index: integer): integer; + + function AddLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload; + function AddLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload; + function AddLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; + function AddLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayer(AName: string; Source: TBGRABitmap; Opacity: byte = 255): integer; overload; + function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload; + function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; + function AddLayer(AName: string; Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddSharedLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload; + function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; + function AddSharedLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromFile(AFileName: string; Opacity: byte = 255): integer; overload; + function AddLayerFromFile(AFileName: string; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromFile(AFileName: string; Position: TPoint; Opacity: byte = 255): integer; overload; + function AddLayerFromFile(AFileName: string; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte = 255): integer; overload; + function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; + function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromOriginal(const AGuid: TGuid; Opacity: byte = 255): integer; overload; + function AddLayerFromOriginal(const AGuid: TGuid; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload; + function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Opacity: byte = 255): integer; overload; + function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload; + function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; + + class function IsValidRegistryIndentifier(AIdentifier: string): boolean; + function GetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string): RawByteString; + procedure SetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string; AValue: RawByteString); + procedure SaveLayerRegistryToStream(ALayerIndex: integer; AStream: TStream); + procedure LoadLayerRegistryFromStream(ALayerIndex: integer; AStream: TStream); + function GetGlobalRegistry(ARegistryIdentifier: string): RawByteString; + procedure SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString); + + function AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean = true): integer; + function AddOriginalFromStream(AStream: TStream; ALateLoad: boolean = false): integer; overload; + function AddOriginalFromStream(AStream: TStream; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload; + function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean = false): integer; overload; + function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload; + procedure SaveOriginalToStream(AIndex: integer; AStream: TStream); overload; + procedure SaveOriginalToStream(const AGuid: TGuid; AStream: TStream); overload; + function RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean; + procedure DeleteOriginal(AIndex: integer); + procedure NotifyLoaded; override; + procedure NotifySaving; override; + procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean = false; AFullSizeLayer: boolean = false); overload; + procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); overload; + procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); overload; + procedure RenderLayerFromOriginalIfNecessary(layer: integer; ADraft: boolean; var ABounds: TRect); + function RenderOriginalsIfNecessary(ADraft: boolean = false): TRect; + function RenderOriginalIfNecessary(const AGuid: TGuid; ADraft: boolean = false): TRect; + procedure RemoveUnusedOriginals; + procedure UnloadOriginals; + procedure UnloadOriginal(AIndex: integer); overload; + procedure UnloadOriginal(const AGuid: TGuid); overload; + + destructor Destroy; override; + constructor Create; overload; override; + constructor Create(AWidth, AHeight: integer); overload; virtual; + function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override; + function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override; + function GetLayerIndexFromId(AIdentifier: integer): integer; + function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap; + function ProduceLayerUniqueId: integer; + + procedure RotateCW; + procedure RotateCCW; + procedure RotateUD; overload; + procedure RotateUD(ALayerIndex: integer); overload; + procedure HorizontalFlip; overload; + procedure HorizontalFlip(ALayerIndex: integer); overload; + procedure VerticalFlip; overload; + procedure VerticalFlip(ALayerIndex: integer); overload; + procedure Resample(AWidth, AHeight: integer; AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter = rfLinear); + procedure SetLayerBitmap(layer: integer; ABitmap: TBGRABitmap; AOwned: boolean); + function TakeLayerBitmap(layer: integer): TBGRABitmap; + procedure ApplyLayerOffset(ALayerIndex: integer; APadWithTranparentPixels: boolean); + + function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; + function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; + function GetEditorBounds(ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; + function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; + function GetEditorBounds(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; + function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; + procedure ClearEditor; + procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); + procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); + procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); + procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); + procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); + procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); + procedure KeyDown(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean); + procedure KeyUp(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean); + procedure KeyPress(UTF8Key: string; out AHandled: boolean); + + property Width : integer read GetWidth; + property Height: integer read GetHeight; + property NbLayers: integer read GetNbLayers; + property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation write SetBlendOperation; + property LayerVisible[layer: integer]: boolean read GetLayerVisible write SetLayerVisible; + property LayerOpacity[layer: integer]: byte read GetLayerOpacity write SetLayerOpacity; + property LayerName[layer: integer]: string read GetLayerName write SetLayerName; + property LayerBitmap[layer: integer]: TBGRABitmap read GetLayerBitmapDirectly; + property LayerOffset[layer: integer]: TPoint read GetLayerOffset write SetLayerOffset; + property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId write SetLayerUniqueId; + property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal; + property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown; + property LayerOriginalClass[layer: integer]: TBGRALayerOriginalAny read GetLayerOriginalClass; + property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid write SetLayerOriginalGuid; + property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix write SetLayerOriginalMatrix; + property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus write SetLayerOriginalRenderStatus; + + function IndexOfOriginal(const AGuid: TGuid): integer; overload; override; + function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; override; + property OriginalCount: integer read GetOriginalCount; + property Original[AIndex: integer]: TBGRALayerCustomOriginal read GetOriginalByIndex; + property OriginalGuid[AIndex: integer]: TGUID read GetOriginalGuid; + property OriginalKnown[AIndex: integer]: boolean read GetOriginalByIndexKnown; + property OriginalClass[AIndex: integer]: TBGRALayerOriginalAny read GetOriginalByIndexClass; + property OnOriginalChange: TEmbeddedOriginalChangeEvent read FOriginalChange write FOriginalChange; + property OnOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent read FOriginalEditingChange write FOriginalEditingChange; + property OnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent read FOnOriginalLoadError write FOnOriginalLoadError; + property EditorFocused: boolean read FEditorFocused write SetEditorFocused; + property OnEditorFocusChanged: TNotifyEvent read FOnEditorFocusChanged write FOnEditorFocusChanged; + property OriginalEditor: TBGRAOriginalEditor read GetOriginalEditor; + property OnActionProgress: TLayeredActionProgressEvent read FOnActionProgress write SetOnActionProgress; + property OnActionDone: TNotifyEvent read FOnActionDone write SetOnActionDone; + end; + + TAffineMatrix = BGRABitmapTypes.TAffineMatrix; + +procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass); +procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass); +function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap; +function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap; + +var + LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc; + LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc; + LayeredBitmapCheckStreamProc: TBGRALayeredBitmapCheckStreamProc; + +type + TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object; + TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object; + TOnLayeredBitmapLoadedProc = procedure() of object; + +procedure OnLayeredBitmapLoadFromStreamStart; +procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string); +procedure OnLayeredBitmapLoadProgress(APercentage: integer); +procedure OnLayeredBitmapLoaded; +procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc; + ADone: TOnLayeredBitmapLoadedProc); +procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc; + ADone: TOnLayeredBitmapLoadedProc); + +type + TOnLayeredBitmapSaveStartProc = procedure(AFilenameUTF8: string) of object; + TOnLayeredBitmapSaveProgressProc = procedure(APercentage: integer) of object; + TOnLayeredBitmapSavedProc = procedure() of object; + +procedure OnLayeredBitmapSaveToStreamStart; +procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string); +procedure OnLayeredBitmapSaveProgress(APercentage: integer); +procedure OnLayeredBitmapSaved; +procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc; + ADone: TOnLayeredBitmapSavedProc); +procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc; + ADone: TOnLayeredBitmapSavedProc); + +const + RenderTempSubDirectory = 'temp'; + +implementation + +uses BGRAUTF8, BGRABlend, BGRAMultiFileType, math; + +const + OriginalsDirectory = 'originals'; + LayersDirectory = 'layers'; + RenderSubDirectory = 'render'; + RegistrySubDirectory = 'registry'; + +type + TOnLayeredBitmapLoadStartProcList = specialize TFPGList; + TOnLayeredBitmapLoadProgressProcList = specialize TFPGList; + TOnLayeredBitmapLoadedProcList = specialize TFPGList; + TOnLayeredBitmapSaveStartProcList = specialize TFPGList; + TOnLayeredBitmapSaveProgressProcList = specialize TFPGList; + TOnLayeredBitmapSavedProcList = specialize TFPGList; + +var + LayeredBitmapLoadEvents: record + OnStart: TOnLayeredBitmapLoadStartProcList; + OnProgress: TOnLayeredBitmapLoadProgressProcList; + OnDone: TOnLayeredBitmapLoadedProcList; + end; + LayeredBitmapSaveEvents: record + OnStart: TOnLayeredBitmapSaveStartProcList; + OnProgress: TOnLayeredBitmapSaveProgressProcList; + OnDone: TOnLayeredBitmapSavedProcList; + end; + +var + NextLayerUniqueId: LongWord; + LayeredBitmapReaders: array of record + extension: string; + theClass: TBGRACustomLayeredBitmapClass; + end; + LayeredBitmapWriters: array of record + extension: string; + theClass: TBGRALayeredBitmapClass; + end; + +{ TBGRALayerOriginalEntry } + +class operator TBGRALayerOriginalEntry.=(const AEntry1, + AEntry2: TBGRALayerOriginalEntry): boolean; +begin + result := AEntry1.Guid = AEntry2.Guid; +end; + +function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry; +begin + result.Guid := AGuid; + result.Instance := nil; +end; + +function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry; +begin + result.Guid := AInstance.Guid; + result.Instance := AInstance; +end; + +{ TBGRALayeredBitmap } + +function TBGRALayeredBitmap.GetLayerUniqueId(layer: integer): integer; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + Result:= FLayers[layer].UniqueId; +end; + +function TBGRALayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; +var + idxOrig: Integer; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil); + idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); + if idxOrig = -1 then exit(nil); + result := Original[idxOrig]; + end; +end; + +function TBGRALayeredBitmap.GetLayerOriginalMatrix(layer: integer + ): TAffineMatrix; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + result := FLayers[layer].OriginalMatrix; +end; + +function TBGRALayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + result := FLayers[layer].OriginalGuid; +end; + +function TBGRALayeredBitmap.GetLayerOriginalRenderStatus(layer: integer + ): TOriginalRenderStatus; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + result := FLayers[layer].OriginalRenderStatus; +end; + +procedure TBGRALayeredBitmap.SetLayerUniqueId(layer: integer; AValue: integer); +var i: integer; + layerDir: TMemDirectory; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + for i := 0 to NbLayers-1 do + if (i <> layer) and (FLayers[i].UniqueId = AValue) then + raise Exception.Create('Another layer has the same identifier'); + layerDir := GetLayerDirectory(layer,false); + if Assigned(layerDir) then + layerDir.ParentDirectory.Rename(inttostr(FLayers[layer].UniqueId),'',inttostr(AValue)); + FLayers[layer].UniqueId := AValue; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerOriginalMatrix(layer: integer; + AValue: TAffineMatrix); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalMatrix = AValue then exit; + FLayers[layer].OriginalMatrix := AValue; + if FLayers[layer].OriginalGuid <> GUID_NULL then + begin + FLayers[layer].OriginalRenderStatus := orsNone; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerOriginalGuid(layer: integer; + const AValue: TGuid); +var + layerDir: TMemDirectory; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalGuid = AValue then exit; + FLayers[layer].OriginalGuid := AValue; + layerDir := GetLayerDirectory(layer, false); + if Assigned(layerDir) then + layerDir.Delete(RenderSubDirectory,''); + + if (AValue <> GUID_NULL) and (IndexOfOriginal(AValue) <> -1) then + begin + FLayers[layer].OriginalRenderStatus := orsNone; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerOriginalRenderStatus(layer: integer; + AValue: TOriginalRenderStatus); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalRenderStatus = AValue then exit; + FLayers[layer].OriginalRenderStatus := AValue; + Unfreeze(layer); + end; +end; + +procedure TBGRALayeredBitmap.FindOriginal(AGuid: TGuid; out + ADir: TMemDirectory; out AClass: TBGRALayerOriginalAny); +var + c: String; +begin + ADir := nil; + AClass := nil; + + if HasMemFiles then + begin + ADir := MemDirectory.FindPath(OriginalsDirectory+'/'+GUIDToString(AGuid)); + if ADir <> nil then + begin + c := ADir.RawStringByFilename['class']; + AClass := FindLayerOriginalClass(c); + end; + end; +end; + +procedure TBGRALayeredBitmap.StoreOriginal(AOriginal: TBGRALayerCustomOriginal); +var + dir, subdir: TMemDirectory; + storage: TBGRAMemOriginalStorage; +begin + if AOriginal.Guid = GUID_NULL then raise exception.Create('Original GUID undefined'); + dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; + subdir := dir.Directory[dir.AddDirectory(GUIDToString(AOriginal.Guid))]; + storage := TBGRAMemOriginalStorage.Create(subdir); + try + AOriginal.SaveToStorage(storage); + storage.RawString['class'] := AOriginal.StorageClassName; + finally + storage.Free; + end; +end; + +procedure TBGRALayeredBitmap.OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff); +var + i: Integer; + orig: TBGRALayerCustomOriginal; + transfBounds: TRectF; +begin + orig := TBGRALayerCustomOriginal(ASender); + if not (Assigned(ABounds) and IsEmptyRectF(ABounds^)) then + begin + for i := 0 to NbLayers-1 do + if LayerOriginalGuid[i] = orig.Guid then + begin + if ABounds = nil then + LayerOriginalRenderStatus[i] := orsNone + else + begin + transfBounds := (LayerOriginalMatrix[i]*TAffineBox.AffineBox(ABounds^)).RectBoundsF; + case LayerOriginalRenderStatus[i] of + orsDraft: begin + LayerOriginalRenderStatus[i] := orsPartialDraft; + FLayers[i].OriginalInvalidatedBounds := transfBounds; + end; + orsProof: begin + LayerOriginalRenderStatus[i] := orsPartialProof; + FLayers[i].OriginalInvalidatedBounds := transfBounds; + end; + orsPartialDraft: FLayers[i].OriginalInvalidatedBounds := + FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true); + orsPartialProof: FLayers[i].OriginalInvalidatedBounds := + FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true); + end; + end; + end; + end; + if Assigned(FOriginalChange) then + FOriginalChange(self, orig, ADiff); +end; + +procedure TBGRALayeredBitmap.OriginalEditingChange(ASender: TObject); +var + orig: TBGRALayerCustomOriginal; +begin + orig := TBGRALayerCustomOriginal(ASender); + if Assigned(FOriginalEditingChange) then + FOriginalEditingChange(self, orig); +end; + +function TBGRALayeredBitmap.GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory; +var + layersDir: TMemDirectory; + id: LongInt; +begin + if (MemDirectory.IndexOf(LayersDirectory,'')=-1) and not ACanCreate then exit(nil); + layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)]; + id := LayerUniqueId[ALayerIndex]; + if (layersDir.IndexOf(IntToStr(id),'')=-1) and not ACanCreate then exit(nil); + result := layersDir.Directory[layersDir.AddDirectory(IntToStr(id))]; +end; + +procedure TBGRALayeredBitmap.UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single); +var + orig: TBGRALayerCustomOriginal; + editMatrix: TAffineMatrix; +begin + orig := LayerOriginal[ALayerIndex]; + + if (orig = nil) or (orig.Guid <> FOriginalEditorOriginal) then + begin + FreeAndNil(FOriginalEditor); + if orig = nil then + FOriginalEditorOriginal := GUID_NULL + else FOriginalEditorOriginal := orig.Guid; + end; + + if Assigned(OriginalEditor) then + FOriginalEditor.Clear; + + if Assigned(orig) then + begin + if OriginalEditor = nil then + begin + FOriginalEditor := orig.CreateEditor; + if FOriginalEditor = nil then + raise exception.Create('Unexpected nil value'); + FOriginalEditor.Focused := FEditorFocused; + FOriginalEditor.OnFocusChanged:=@EditorFocusedChanged; + end; + + editMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*LayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5); + if IsAffineMatrixInversible(editMatrix) then + begin + orig.ConfigureEditor(FOriginalEditor); + FOriginalEditorViewMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); + FOriginalEditor.Matrix := editMatrix; + FOriginalEditor.PointSize := APointSize; + end; + end; +end; + +function TBGRALayeredBitmap.GetOriginalCount: integer; +begin + if Assigned(FOriginals) then + result := FOriginals.Count + else + result := 0; +end; + +function TBGRALayeredBitmap.GetOriginalByIndex(AIndex: integer + ): TBGRALayerCustomOriginal; +var + dir: TMemDirectory; + c: TBGRALayerOriginalAny; + guid: TGuid; + storage: TBGRAMemOriginalStorage; + raiseError: Boolean; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + result := FOriginals[AIndex].Instance; + guid := FOriginals[AIndex].Guid; + + // load original on the fly + if (result = nil) and (guid <> GUID_NULL) then + begin + FindOriginal(guid, dir, c); + if not Assigned(dir) then + raise exception.Create('Original directory not found'); + if not Assigned(c) then + raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)'); + + result := c.Create; + result.Guid := guid; + storage := TBGRAMemOriginalStorage.Create(dir); + try + try + result.LoadFromStorage(storage); + finally + FOriginals[AIndex] := BGRALayerOriginalEntry(result); + result.OnChange:= @OriginalChange; + result.OnEditingChange:= @OriginalEditingChange; + storage.Free; + end; + except + on ex: Exception do + begin + raiseError := true; + if Assigned(FOnOriginalLoadError) then + FOnOriginalLoadError(self, ex.Message, raiseError); + if raiseError then + raise ex; + end; + end; + end; +end; + +function TBGRALayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean; +var + idxOrig: Integer; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalGuid = GUID_NULL then exit(true); + idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); + if idxOrig = -1 then exit(false); + result := OriginalKnown[idxOrig]; + end; +end; + +function TBGRALayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean; +var + dir: TMemDirectory; + c: TBGRALayerOriginalAny; + guid: TGuid; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + if Assigned(FOriginals[AIndex].Instance) then exit(true); + guid := FOriginals[AIndex].Guid; + if guid = GUID_NULL then exit(true); + + FindOriginal(guid, dir, c); + result:= Assigned(dir) and Assigned(c); +end; + +function TBGRALayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + Result:= Assigned(FOriginals[AIndex].Instance); +end; + +function TBGRALayeredBitmap.GetOriginalGuid(AIndex: integer): TGUID; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + result := FOriginals[AIndex].Guid; +end; + +procedure TBGRALayeredBitmap.SetEditorFocused(AValue: boolean); +begin + if Assigned(OriginalEditor) then OriginalEditor.Focused := AValue + else + begin + if FEditorFocused=AValue then Exit; + FEditorFocused:=AValue; + if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self); + end; +end; + +procedure TBGRALayeredBitmap.SetOnActionDone(AValue: TNotifyEvent); +begin + if FOnActionDone=AValue then Exit; + FOnActionDone:=AValue; +end; + +procedure TBGRALayeredBitmap.SetOnActionProgress( + AValue: TLayeredActionProgressEvent); +begin + if FOnActionProgress=AValue then Exit; + FOnActionProgress:=AValue; +end; + +function TBGRALayeredBitmap.GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny; +var + idxOrig: Integer; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil); + idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); + if idxOrig = -1 then exit(nil); + result := OriginalClass[idxOrig]; + end; +end; + +function TBGRALayeredBitmap.GetOriginalEditor: TBGRAOriginalEditor; +begin + if Assigned(FOriginalEditor) and (IndexOfOriginal(FOriginalEditorOriginal)=-1) then + begin + FreeAndNil(FOriginalEditor); + FOriginalEditorOriginal := GUID_NULL; + end; + result := FOriginalEditor; +end; + +procedure TBGRALayeredBitmap.EditorFocusedChanged(Sender: TObject); +begin + if Assigned(OriginalEditor) then + begin + FEditorFocused := OriginalEditor.Focused; + if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self); + end; +end; + +function TBGRALayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; +var + dir: TMemDirectory; + c: TBGRALayerOriginalAny; + guid: TGuid; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + if Assigned(FOriginals[AIndex].Instance) then exit(TBGRALayerOriginalAny(FOriginals[AIndex].Instance.ClassType)); + guid := FOriginals[AIndex].Guid; + if guid = GUID_NULL then exit(nil); + + FindOriginal(guid, dir, c); + result:= c; +end; + +function TBGRALayeredBitmap.GetWidth: integer; +begin + Result:= FWidth; +end; + +function TBGRALayeredBitmap.GetHeight: integer; +begin + Result:= FHeight; +end; + +function TBGRALayeredBitmap.GetNbLayers: integer; +begin + Result:= FNbLayers; +end; + +function TBGRALayeredBitmap.GetBlendOperation(Layer: integer): TBlendOperation; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + Result:= FLayers[layer].blendOp; +end; + +function TBGRALayeredBitmap.GetLayerVisible(layer: integer): boolean; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + Result:= FLayers[layer].Visible; +end; + +function TBGRALayeredBitmap.GetLayerOpacity(layer: integer): byte; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + Result:= FLayers[layer].Opacity; +end; + +function TBGRALayeredBitmap.GetLayerOffset(layer: integer): TPoint; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + with FLayers[layer] do + Result:= Point(x,y); +end; + +function TBGRALayeredBitmap.GetLayerName(layer: integer): string; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then + Result := FLayers[layer].Source.Caption + else + Result:= FLayers[layer].Name; + if Result = '' then + result := inherited GetLayerName(layer); + end; +end; + +function TBGRALayeredBitmap.GetLayerFrozen(layer: integer): boolean; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + Result:= FLayers[layer].Frozen; +end; + +procedure TBGRALayeredBitmap.SetBlendOperation(Layer: integer; + op: TBlendOperation); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].blendOp <> op then + begin + FLayers[layer].blendOp := op; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerVisible(layer: integer; AValue: boolean); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].Visible <> AValue then + begin + FLayers[layer].Visible := AValue; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerOpacity(layer: integer; AValue: byte); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if FLayers[layer].Opacity <> AValue then + begin + FLayers[layer].Opacity := AValue; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerOffset(layer: integer; AValue: TPoint); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if (FLayers[layer].x <> AValue.x) or + (FLayers[layer].y <> AValue.y) then + begin + if FLayers[layer].OriginalGuid <> GUID_NULL then + raise exception.Create('The offset of the layer is computed from an original. You can change it by changing the layer original matrix.'); + + FLayers[layer].x := AValue.x; + FLayers[layer].y := AValue.y; + Unfreeze(layer); + end; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerName(layer: integer; AValue: string); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then + FLayers[layer].Source.Caption := AValue + else + FLayers[layer].Name := AValue; + end; +end; + +procedure TBGRALayeredBitmap.SetLayerFrozen(layer: integer; AValue: boolean); +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + FLayers[layer].Frozen := AValue; +end; + +function TBGRALayeredBitmap.GetLayerBitmapDirectly(layer: integer): TBGRABitmap; +begin + if (layer < 0) or (layer >= NbLayers) then + result := nil + else + begin + if FLayers[layer].OriginalRenderStatus = orsNone then + RenderLayerFromOriginal(layer, true) + else if FLayers[layer].OriginalRenderStatus in [orsPartialDraft,orsPartialProof] then + RenderLayerFromOriginal(layer, true, FLayers[layer].OriginalInvalidatedBounds); + Result:= FLayers[layer].Source; + end; +end; + +procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string); +var bmp: TBGRABitmap; + ext: string; + temp: TBGRACustomLayeredBitmap; + i: integer; + stream: TFileStreamUTF8; +begin + ext := UTF8LowerCase(ExtractFileExt(filenameUTF8)); + for i := 0 to high(LayeredBitmapReaders) do + if '.'+LayeredBitmapReaders[i].extension = ext then + begin + temp := LayeredBitmapReaders[i].theClass.Create; + try + temp.LoadFromFile(filenameUTF8); + Assign(temp); + finally + temp.Free; + end; + exit; + end; + + //when using "data" extension, simply deserialize + if (ext='.dat') or (ext='.data') then + begin + if Assigned(LayeredBitmapLoadFromStreamProc) then + begin + stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead, fmShareDenyWrite); + try + LayeredBitmapLoadFromStreamProc(stream, self); + finally + stream.Free; + end; + end else + raise exception.Create('Enable layer deserialization by calling BGRAStreamLayers.RegisterStreamLayers'); + end else + begin + bmp := TBGRABitmap.Create(filenameUTF8, True); + Clear; + SetSize(bmp.Width,bmp.Height); + AddOwnedLayer(bmp); + end; +end; + +procedure TBGRALayeredBitmap.LoadFromStream(stream: TStream); +var bmp: TBGRABitmap; +begin + if Assigned(LayeredBitmapLoadFromStreamProc) then + begin + if not Assigned(LayeredBitmapCheckStreamProc) or + LayeredBitmapCheckStreamProc(stream) then + begin + LayeredBitmapLoadFromStreamProc(Stream, self); + exit; + end; + end; + + bmp := TBGRABitmap.Create(stream); + Clear; + SetSize(bmp.Width,bmp.Height); + AddOwnedLayer(bmp); +end; + +procedure TBGRALayeredBitmap.LoadFromResource(AFilename: string); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TBGRALayeredBitmap.SetSize(AWidth, AHeight: integer); +begin + Unfreeze; + FWidth := AWidth; + FHeight := AHeight; +end; + +procedure TBGRALayeredBitmap.Clear; +var i: integer; +begin + Unfreeze; + for i := NbLayers-1 downto 0 do + RemoveLayer(i); + MemDirectory := nil; + ClearOriginals; +end; + +procedure TBGRALayeredBitmap.ClearOriginals; +var + i: Integer; +begin + if Assigned(FOriginals) then + begin + for i := 0 to OriginalCount-1 do + FOriginals[i].Instance.Free; + FreeAndNil(FOriginals); + end; +end; + +procedure TBGRALayeredBitmap.RemoveLayer(index: integer); +var i: integer; + id: LongInt; + layersDir: TMemDirectory; +begin + if (index < 0) or (index >= NbLayers) then exit; + Unfreeze; + if Assigned(FMemDirectory) then + begin + id := LayerUniqueId[index]; + if FMemDirectory.IndexOf(LayersDirectory,'')<>-1 then + begin + layersDir := FMemDirectory.Directory[FMemDirectory.AddDirectory(LayersDirectory)]; + layersDir.Delete(IntToStr(id),''); + end; + end; + if FLayers[index].Owner then FLayers[index].Source.Free; + for i := index to FNbLayers-2 do + FLayers[i] := FLayers[i+1]; + Dec(FNbLayers); +end; + +procedure TBGRALayeredBitmap.InsertLayer(index: integer; fromIndex: integer); +var info: TBGRALayerInfo; + i: integer; +begin + if (index < 0) or (index > NbLayers) or (index = fromIndex) then exit; + if (fromIndex < 0) or (fromIndex >= NbLayers) then exit; + Unfreeze; + info := FLayers[fromIndex]; + for i := fromIndex to FNbLayers-2 do + FLayers[i] := FLayers[i+1]; + for i := FNbLayers-1 downto index+1 do + FLayers[i] := FLayers[i-1]; + FLayers[index] := info; +end; + +procedure TBGRALayeredBitmap.Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean; + ACopyAdditionalMemData: boolean); +var i,idx,idxOrig,idxNewOrig: integer; + usedOriginals: array of record + used: boolean; + sourceGuid,newGuid: TGuid; + end; + orig: TBGRALayerCustomOriginal; + stream: TMemoryStream; + targetDir, layerDir: TMemDirectory; + +begin + if ASource = nil then + raise exception.Create('Unexpected nil reference'); + Clear; + SetSize(ASource.Width,ASource.Height); + LinearBlend:= ASource.LinearBlend; + setlength(usedOriginals, ASource.GetOriginalCount); + for idxOrig := 0 to high(usedOriginals) do + with usedOriginals[idxOrig] do + begin + used:= false; + newGuid := GUID_NULL; + end; + for i := 0 to ASource.NbLayers-1 do + if (ASource.LayerOriginalGuid[i]<>GUID_NULL) and + (ASource.LayerOriginalKnown[i] or (ASource is TBGRALayeredBitmap)) then + begin + idxOrig := ASource.IndexOfOriginal(ASource.LayerOriginalGuid[i]); + if (idxOrig <> -1) and not usedOriginals[idxOrig].used then + begin + if ASource.GetOriginalByIndexLoaded(idxOrig) then + begin + orig := ASource.GetOriginalByIndex(idxOrig); + idxNewOrig := AddOriginal(orig, false); + usedOriginals[idxOrig].sourceGuid := orig.Guid; + end else + begin + stream := TMemoryStream.Create; + (ASource as TBGRALayeredBitmap).SaveOriginalToStream(idxOrig, stream); + stream.Position:= 0; + idxNewOrig := AddOriginalFromStream(stream,true); + stream.Free; + usedOriginals[idxOrig].sourceGuid := (ASource as TBGRALayeredBitmap).OriginalGuid[idxOrig]; + end; + usedOriginals[idxOrig].newGuid := OriginalGuid[idxNewOrig]; + usedOriginals[idxOrig].used := true; + end; + end; + for i := 0 to ASource.NbLayers-1 do + begin + idx := AddOwnedLayer(ASource.GetLayerBitmapCopy(i),ASource.LayerOffset[i],ASource.BlendOperation[i],ASource.LayerOpacity[i]); + LayerName[idx] := ASource.LayerName[i]; + LayerVisible[idx] := ASource.LayerVisible[i]; + if ASharedLayerIds and (ASource is TBGRALayeredBitmap) then + LayerUniqueId[idx] := TBGRALayeredBitmap(ASource).LayerUniqueId[i]; + for idxOrig := 0 to high(usedOriginals) do + if usedOriginals[idxOrig].sourceGuid = ASource.LayerOriginalGuid[i] then + begin + LayerOriginalGuid[idx] := usedOriginals[idxOrig].newGuid; + LayerOriginalMatrix[idx] := ASource.LayerOriginalMatrix[i]; + LayerOriginalRenderStatus[idx] := ASource.LayerOriginalRenderStatus[i]; + break; + end; + if ASource is TBGRALayeredBitmap then + begin + layerDir := TBGRALayeredBitmap(ASource).GetLayerDirectory(i,false); + if Assigned(layerDir) then + layerDir.CopyTo(GetLayerDirectory(idx,true), true); + end; + end; + if ACopyAdditionalMemData and ASource.HasMemFiles then + for i := 0 to ASource.GetMemDirectory.Count-1 do + if (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(OriginalsDirectory,'')<>0) and + (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(LayersDirectory,'')<>0) and + (ASource.GetMemDirectory.IsDirectory[i]) then + begin + with ASource.GetMemDirectory.Entry[i] do + targetDir := GetMemDirectory.Directory[GetMemDirectory.AddDirectory(Name,Extension)]; + ASource.GetMemDirectory.Directory[i].CopyTo(targetDir, true); + end; +end; + +function TBGRALayeredBitmap.MoveLayerUp(index: integer): integer; +begin + if (index >= 0) and (index <= NbLayers-2) then + begin + InsertLayer(index+1,index); + result := index+1; + end else + result := -1; +end; + +function TBGRALayeredBitmap.MoveLayerDown(index: integer): integer; +begin + if (index > 0) and (index <= NbLayers-1) then + begin + InsertLayer(index-1,index); + result := index-1; + end else + result := -1; +end; + +function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Opacity: byte + ): integer; +begin + result := AddLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity, False); +end; + +function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint; + BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer; +begin + result := AddLayer(Source.Caption,Source,Position,BlendOp,Opacity,Shared); +end; + +function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint; + Opacity: byte): integer; +begin + result := AddLayer(Source,Position,DefaultBlendingOperation,Opacity); +end; + +function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddLayer(Source,Point(0,0),BlendOp,Opacity); +end; + +function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; + Opacity: byte): integer; +begin + result := AddLayer(AName,Source,Point(0,0),Opacity); +end; + +function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; + Position: TPoint; BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer; +begin + if length(FLayers) = FNbLayers then + setlength(FLayers, length(FLayers)*2+1); + FLayers[FNbLayers].Name := AName; + FLayers[FNbLayers].X := Position.X; + FLayers[FNbLayers].Y := Position.Y; + FLayers[FNbLayers].blendOp := BlendOp; + FLayers[FNbLayers].Opacity := Opacity; + FLayers[FNbLayers].Visible := true; + FLayers[FNbLayers].Frozen := false; + FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId; + FLayers[FNbLayers].OriginalMatrix := AffineMatrixIdentity; + FLayers[FNbLayers].OriginalRenderStatus := orsNone; + FLayers[FNbLayers].OriginalGuid := GUID_NULL; + if Shared then + begin + FLayers[FNbLayers].Source := Source; + FLayers[FNbLayers].Owner := false; + end else + begin + FLayers[FNbLayers].Source := Source.Duplicate; + FLayers[FNbLayers].Owner := true; + end; + result := FNbLayers; + inc(FNbLayers); + if (FNbLayers = 1) and (FWidth = 0) and (FHeight = 0) and (Source <> nil) then + SetSize(Source.Width,Source.Height); +end; + +function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; + Position: TPoint; Opacity: byte): integer; +begin + result := AddLayer(AName, Source, Position, DefaultBlendingOperation, Opacity); +end; + +function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddLayer(AName, Source, Point(0,0), blendOp, Opacity); +end; + +function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; Opacity: byte + ): integer; +begin + result := AddSharedLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity); +end; + +function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; + Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddLayer(Source, Position, BlendOp, Opacity, True); +end; + +function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; + Position: TPoint; Opacity: byte): integer; +begin + result := AddSharedLayer(Source, Position, DefaultBlendingOperation, Opacity); +end; + +function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddSharedLayer(Source, Point(0,0), blendOp, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; Opacity: byte + ): integer; +begin + result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Opacity); + FLayers[result].Name := ExtractFileName(AFilename); +end; + +function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; + Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,BlendOp,Opacity); + FLayers[result].Name := ExtractFileName(AFilename); +end; + +function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; + Position: TPoint; Opacity: byte): integer; +begin + result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,Opacity); + FLayers[result].Name := ExtractFileName(AFilename); +end; + +function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddOwnedLayer(TBGRABitmap.Create(AFilename),BlendOp,Opacity); + FLayers[result].Name := ExtractFileName(AFilename); +end; + +function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte + ): integer; +begin + result := AddSharedLayer(ABitmap,Opacity); + FLayers[result].Owner := True; +end; + +function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; + Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddSharedLayer(ABitmap,Position,BlendOp,Opacity); + FLayers[result].Owner := True; +end; + +function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; + Position: TPoint; Opacity: byte): integer; +begin + result := AddSharedLayer(ABitmap,Position,Opacity); + FLayers[result].Owner := True; +end; + +function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddSharedLayer(ABitmap,BlendOp,Opacity); + FLayers[result].Owner := True; +end; + +function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; + Opacity: byte): integer; +begin + result := AddLayerFromOriginal(AGuid, DefaultBlendingOperation, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddLayerFromOriginal(AGuid, AffineMatrixIdentity, BlendOp, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; + Matrix: TAffineMatrix; Opacity: byte): integer; +begin + result := AddLayerFromOriginal(AGuid, Matrix, DefaultBlendingOperation, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; + Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte): integer; +begin + result := AddOwnedLayer(TBGRABitmap.Create, BlendOp, Opacity); + LayerOriginalGuid[result] := AGuid; + LayerOriginalMatrix[result] := Matrix; + if not Assigned(LayerOriginal[result]) then + raise exception.Create('Original data or class not found'); +end; + +function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( + AOriginal: TBGRALayerCustomOriginal; Opacity: byte): integer; +begin + if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); + result := AddLayerFromOriginal(AOriginal.Guid, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( + AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte): integer; +begin + if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); + result := AddLayerFromOriginal(AOriginal.Guid, BlendOp, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( + AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte): integer; +begin + if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); + result := AddLayerFromOriginal(AOriginal.Guid, Matrix, Opacity); +end; + +function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( + AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; + BlendOp: TBlendOperation; Opacity: byte): integer; +begin + if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); + result := AddLayerFromOriginal(AOriginal.Guid, Matrix, BlendOp, Opacity); +end; + +class function TBGRALayeredBitmap.IsValidRegistryIndentifier(AIdentifier: string): boolean; +var + i: Integer; +begin + if length(AIdentifier) = 0 then exit(false); + for i := 1 to length(AIdentifier) do + if not (AIdentifier[i] in ['A'..'Z','a'..'z','0'..'9','_','-']) then exit(false); + exit(true); +end; + +function TBGRALayeredBitmap.GetLayerRegistry(ALayerIndex: integer; + ARegistryIdentifier: string): RawByteString; +var + layerDir, registryDir: TMemDirectory; +begin + if not IsValidRegistryIndentifier(ARegistryIdentifier) then + raise exception.Create('Invalid registry identifier'); + layerDir := GetLayerDirectory(ALayerIndex, false); + if layerDir = nil then exit(''); + registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; + result := registryDir.RawStringByFilename[ARegistryIdentifier] +end; + +procedure TBGRALayeredBitmap.SetLayerRegistry(ALayerIndex: integer; + ARegistryIdentifier: string; AValue: RawByteString); +var + layerDir, registryDir: TMemDirectory; +begin + if not IsValidRegistryIndentifier(ARegistryIdentifier) then + raise exception.Create('Invalid registry identifier'); + layerDir := GetLayerDirectory(ALayerIndex, true); + registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; + if length(AValue) = 0 then + registryDir.Delete(ARegistryIdentifier,'') + else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue; +end; + +procedure TBGRALayeredBitmap.SaveLayerRegistryToStream(ALayerIndex: integer; + AStream: TStream); +var + layerDir, registryDir: TMemDirectory; +begin + layerDir := GetLayerDirectory(ALayerIndex, true); + registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; + registryDir.SaveToStream(AStream); +end; + +procedure TBGRALayeredBitmap.LoadLayerRegistryFromStream(ALayerIndex: integer; + AStream: TStream); +var + layerDir, registryDir: TMemDirectory; +begin + layerDir := GetLayerDirectory(ALayerIndex, true); + registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; + registryDir.LoadFromStream(AStream); +end; + +function TBGRALayeredBitmap.GetGlobalRegistry(ARegistryIdentifier: string): RawByteString; +var + registryDir: TMemDirectory; +begin + if not IsValidRegistryIndentifier(ARegistryIdentifier) then + raise exception.Create('Invalid registry identifier'); + registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')]; + result := registryDir.RawStringByFilename[ARegistryIdentifier] +end; + +procedure TBGRALayeredBitmap.SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString); +var + registryDir: TMemDirectory; +begin + if not IsValidRegistryIndentifier(ARegistryIdentifier) then + raise exception.Create('Invalid registry identifier'); + registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')]; + if length(AValue) = 0 then + registryDir.Delete(ARegistryIdentifier,'') + else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue; +end; + +function TBGRALayeredBitmap.AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean): integer; +var + newGuid: TGuid; +begin + if AOriginal = nil then + raise exception.Create('Unexpected nil reference');; + if AOriginal.Guid = GUID_NULL then + begin + if CreateGUID(newGuid)<> 0 then + begin + if AOwned then AOriginal.Free; + raise exception.Create('Error while creating GUID'); + end; + AOriginal.Guid := newGuid; + end else + begin + if IndexOfOriginal(AOriginal) <> -1 then + begin + if AOwned then AOriginal.Free; + raise exception.Create('Original already added'); + end; + if IndexOfOriginal(AOriginal.Guid) <> -1 then + begin + if AOwned then AOriginal.Free; + raise exception.Create('GUID is already in use'); + end; + end; + if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; + if AOwned then + begin + result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal)); + AOriginal.OnChange:= @OriginalChange; + AOriginal.OnEditingChange:= @OriginalEditingChange; + end + else + begin + StoreOriginal(AOriginal); + result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal.Guid)); + end; +end; + +function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream; + ALateLoad: boolean): integer; +var + newGuid: TGUID; +begin + if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID'); + result := AddOriginalFromStream(AStream, newGuid, ALateLoad); +end; + + +function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream; + const AGuid: TGuid; ALateLoad: boolean): integer; +var + storage: TBGRAMemOriginalStorage; +begin + storage:= TBGRAMemOriginalStorage.Create; + storage.LoadFromStream(AStream); + try + result := AddOriginalFromStorage(storage, AGuid, ALateLoad); + finally + storage.Free; + end; +end; + +function TBGRALayeredBitmap.AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean): integer; +var + newGuid: TGUID; +begin + if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID'); + result := AddOriginalFromStorage(AStorage, newGuid, ALateLoad); +end; + +function TBGRALayeredBitmap.AddOriginalFromStorage( + AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean): integer; +var + origClassName: String; + origClass: TBGRALayerOriginalAny; + orig: TBGRALayerCustomOriginal; + dir, subdir: TMemDirectory; + raiseError: Boolean; +begin + result := -1; + origClassName := AStorage.RawString['class']; + if origClassName = '' then raise Exception.Create('Original class name not defined'); + if ALateLoad then + begin + if IndexOfOriginal(AGuid)<>-1 then + raise exception.Create('Duplicate GUID'); + + dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; + subdir := dir.Directory[dir.AddDirectory(GUIDToString(AGuid))]; + AStorage.CopyTo(subdir); + + if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; + result := FOriginals.Add(BGRALayerOriginalEntry(AGuid)); + end else + begin + origClass := FindLayerOriginalClass(origClassName); + if origClass = nil then raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)'); + orig := origClass.Create; + try + orig.LoadFromStorage(AStorage); + orig.Guid := AGuid; + result := AddOriginal(orig, true); + except on ex:exception do + begin + orig.Free; + raiseError := true; + if Assigned(FOnOriginalLoadError) then + FOnOriginalLoadError(self, ex.Message, raiseError); + if raiseError then + raise ex; + end; + end; + end; +end; + +procedure TBGRALayeredBitmap.SaveOriginalToStream(AIndex: integer; + AStream: TStream); +var + dir: TMemDirectory; + c: TBGRALayerOriginalAny; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + if Assigned(FOriginals[AIndex].Instance) then + FOriginals[AIndex].Instance.SaveToStream(AStream) + else + begin + FindOriginal(FOriginals[AIndex].Guid, dir, c); + if dir = nil then + raise exception.Create('Original directory not found'); + dir.SaveToStream(AStream); + end; +end; + +procedure TBGRALayeredBitmap.SaveOriginalToStream(const AGuid: TGuid; + AStream: TStream); +var + idxOrig: Integer; +begin + idxOrig := IndexOfOriginal(AGuid); + if idxOrig = -1 then raise exception.Create('Original not found'); + SaveOriginalToStream(idxOrig, AStream); +end; + +function TBGRALayeredBitmap.RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean; +var + idx: Integer; +begin + idx := IndexOfOriginal(AOriginal); + if idx = -1 then exit(false); + DeleteOriginal(idx); + result := true; +end; + +procedure TBGRALayeredBitmap.DeleteOriginal(AIndex: integer); +var + dir: TMemDirectory; + i: Integer; + guid: TGuid; +begin + if (AIndex < 0) or (AIndex >= OriginalCount) then + raise ERangeError.Create('Index out of bounds'); + + guid := FOriginals[AIndex].Guid; + for i := 0 to NbLayers-1 do + if LayerOriginalGuid[i] = guid then + begin + LayerOriginalGuid[i] := GUID_NULL; + LayerOriginalMatrix[i] := AffineMatrixIdentity; + end; + + dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; + dir.Delete(GUIDToString(guid),''); + + FOriginals[AIndex].Instance.Free; + FOriginals.Delete(AIndex); //AOriginals freed +end; + +procedure TBGRALayeredBitmap.NotifyLoaded; +var + foundGuid: array of TGuid; + nbFoundGuid: integer; + + procedure AddGuid(const AGuid: TGuid); + begin + foundGuid[nbFoundGuid] := AGuid; + inc(nbFoundGuid); + end; + + function IndexOfGuid(AGuid: TGuid): integer; + var + i: Integer; + begin + for i := 0 to nbFoundGuid-1 do + if foundGuid[i] = AGuid then exit(i); + result := -1; + end; + +var + i: Integer; + dir: TMemDirectory; + newGuid: TGUID; + +begin + inherited NotifyLoaded; + + //if there are no files in memory, we are sure that there are no originals + if not HasMemFiles then + begin + ClearOriginals; + exit; + end; + + //determine list of GUID of originals + dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; + setlength(foundGuid, dir.Count); + nbFoundGuid:= 0; + for i := 0 to dir.Count-1 do + if dir.IsDirectory[i] and (dir.Entry[i].Extension = '') then + begin + if TryStringToGUID(dir.Entry[i].Name, newGuid) then + AddGuid(newGuid); + end; + + //remove originals that do not exist anymore + for i := OriginalCount-1 downto 0 do + if IndexOfGuid(FOriginals[i].Guid) = -1 then + DeleteOriginal(i); + + //add originals from memory directory + for i := 0 to nbFoundGuid-1 do + begin + if IndexOfOriginal(foundGuid[i]) = -1 then + begin + if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; + FOriginals.Add(BGRALayerOriginalEntry(foundGuid[i])); + end; + end; +end; + +procedure TBGRALayeredBitmap.NotifySaving; +var + i, j, id, ErrPos: Integer; + layersDir, renderDir: TMemDirectory; +begin + inherited NotifySaving; + + RenderOriginalsIfNecessary; + + for i := 0 to OriginalCount-1 do + if Assigned(FOriginals[i].Instance) then + StoreOriginal(FOriginals[i].Instance); + + //check layer storage + if MemDirectory.IndexOf(LayersDirectory,'')<>-1 then + begin + layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)]; + for i := layersDir.Count-1 downto 0 do + if layersDir.IsDirectory[i] then + begin + renderDir := layersDir.Directory[i].FindPath(RenderSubDirectory); + + if Assigned(renderDir) then + begin + //discard temporary files + renderDir.Delete(RenderTempSubDirectory,''); + + //compress significant files + for j := 0 to renderDir.Count-1 do + begin + if renderDir.Entry[j].FileSize > 128 then + renderDir.IsEntryCompressed[j] := true; + end; + end; + + //remove invalid layer references + val(layersDir.Entry[i].Name, id, errPos); + if (errPos <> 0) or (GetLayerIndexFromId(id)=-1) then + layersDir.Delete(i); + end; + if layersDir.Count = 0 then + MemDirectory.Delete(LayersDirectory,''); + end; +end; + +procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; + ADraft: boolean; AFullSizeLayer: boolean = false); +begin + RenderLayerFromOriginal(layer, ADraft, rectF(0,0,Width,Height), AFullSizeLayer); +end; + +procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; + ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); +var + orig: TBGRALayerCustomOriginal; + rAll, rNewBounds, rInterRender: TRect; + newSource: TBGRABitmap; + layerDir, renderDir: TMemDirectory; + j: integer; + + procedure FreeSource; + begin + if FLayers[layer].Owner then + FreeAndNil(FLayers[layer].Source) + else + FLayers[layer].Source := nil; + end; + +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds'); + + orig := LayerOriginal[layer]; + if Assigned(orig) then + begin + Unfreeze(layer); + layerDir := GetLayerDirectory(layer, true); + renderDir := layerDir.Directory[layerDir.AddDirectory(RenderSubDirectory)]; + //uncompress files for faster access + for j := 0 to renderDir.Count-1 do + renderDir.IsEntryCompressed[j] := false; + orig.RenderStorage := TBGRAMemOriginalStorage.Create(renderDir); + + rAll := rect(0,0,Width,Height); + if AFullSizeLayer then + rNewBounds := rAll + else + begin + rNewBounds := orig.GetRenderBounds(rAll,FLayers[layer].OriginalMatrix); + rNewBounds.Intersect(rAll); + end; + rInterRender := TRect.Intersect(ARenderBounds, rNewBounds); + if (FLayers[layer].x = rNewBounds.Left) and + (FLayers[layer].y = rNewBounds.Top) and + Assigned(FLayers[layer].Source) and + (FLayers[layer].Source.Width = rNewBounds.Width) and + (FLayers[layer].Source.Height = rNewBounds.Height) then + begin + rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top); + FLayers[layer].Source.FillRect(rInterRender, BGRAPixelTransparent, dmSet); + FLayers[layer].Source.ClipRect := rInterRender; + orig.Render(FLayers[layer].Source, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); + FLayers[layer].Source.NoClip; + end else + begin + if rInterRender = rNewBounds then + begin + FreeSource; + newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height); + orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); + end else + begin + newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height); + newSource.PutImage(FLayers[layer].x - rNewBounds.Left, FLayers[layer].y - rNewBounds.Top, FLayers[layer].Source, dmSet); + FreeSource; + rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top); + if not rInterRender.IsEmpty then + begin + newSource.FillRect(rInterRender, BGRAPixelTransparent, dmSet); + newSource.ClipRect := rInterRender; + orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); + newSource.NoClip; + end; + end; + FLayers[layer].Source := newSource; + FLayers[layer].x := rNewBounds.Left; + FLayers[layer].y := rNewBounds.Top; + end; + + orig.RenderStorage.AffineMatrix['last-matrix'] := FLayers[layer].OriginalMatrix; + orig.RenderStorage.Free; + orig.renderStorage := nil; + if renderDir.Count = 1 then //only matrix + layerDir.Delete(RenderSubDirectory,''); + end; + if ADraft then + FLayers[layer].OriginalRenderStatus := orsDraft + else + FLayers[layer].OriginalRenderStatus := orsProof; + FLayers[layer].OriginalInvalidatedBounds := EmptyRectF; +end; + +procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; + ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); +var + r: TRect; +begin + with ARenderBoundsF do + r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); + RenderLayerFromOriginal(layer, ADraft, r, AFullSizeLayer); +end; + +procedure TBGRALayeredBitmap.RenderLayerFromOriginalIfNecessary(layer: integer; + ADraft: boolean; var ABounds: TRect); + procedure UnionLayerArea(ALayer: integer); + var + r: TRect; + begin + if (FLayers[ALayer].Source = nil) or + (FLayers[ALayer].Source.Width = 0) or + (FLayers[ALayer].Source.Height = 0) then exit; + + r := RectWithSize(LayerOffset[ALayer].X, LayerOffset[ALayer].Y, + FLayers[ALayer].Source.Width, FLayers[ALayer].Source.Height); + if ABounds.IsEmpty then ABounds := r else + ABounds.Union(r); + end; + +var + r: TRect; + +begin + case LayerOriginalRenderStatus[layer] of + orsNone: + begin + UnionLayerArea(layer); + RenderLayerFromOriginal(layer, ADraft); + UnionLayerArea(layer); + end; + orsDraft: if not ADraft then + begin + UnionLayerArea(layer); + RenderLayerFromOriginal(layer, ADraft); + UnionLayerArea(layer); + end; + orsPartialDraft,orsPartialProof: + if not ADraft and (LayerOriginalRenderStatus[layer] = orsPartialDraft) then + begin + UnionLayerArea(layer); + RenderLayerFromOriginal(layer, ADraft, rect(0,0,Width,Height), true); + UnionLayerArea(layer); + end + else + begin + with FLayers[layer].OriginalInvalidatedBounds do + r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); + RenderLayerFromOriginal(layer, ADraft, r, true); + if not r.Isempty then + begin + if ABounds.IsEmpty then + ABounds := r + else + ABounds.Union(r); + end; + end; + end; +end; + +function TBGRALayeredBitmap.RenderOriginalsIfNecessary(ADraft: boolean): TRect; +var + i: Integer; +begin + result:= EmptyRect; + for i := 0 to NbLayers-1 do + RenderLayerFromOriginalIfNecessary(i, ADraft, result); +end; + +function TBGRALayeredBitmap.RenderOriginalIfNecessary(const AGuid: TGuid; + ADraft: boolean): TRect; +var + i: Integer; +begin + result:= EmptyRect; + for i := 0 to NbLayers-1 do + if LayerOriginalGuid[i] = AGuid then + RenderLayerFromOriginalIfNecessary(i, ADraft, result); +end; + +procedure TBGRALayeredBitmap.RemoveUnusedOriginals; +var useCount: array of integer; + i, idxOrig: Integer; +begin + if OriginalCount = 0 then exit; + setlength(useCount, OriginalCount); + for i := 0 to NbLayers-1 do + begin + idxOrig := IndexOfOriginal(LayerOriginalGuid[i]); + if idxOrig <> -1 then inc(useCount[idxOrig]); + end; + for i := high(useCount) downto 0 do + if useCount[i] = 0 then DeleteOriginal(i); +end; + +procedure TBGRALayeredBitmap.UnloadOriginals; +var + i: Integer; +begin + for i := 0 to OriginalCount-1 do + UnloadOriginal(i); +end; + +procedure TBGRALayeredBitmap.UnloadOriginal(AIndex: integer); +var + origInfo: TBGRALayerOriginalEntry; +begin + if (AIndex >= 0) and (AIndex < OriginalCount) then + begin + origInfo := FOriginals[AIndex]; + if Assigned(origInfo.Instance) then + begin + StoreOriginal(origInfo.Instance); + FreeAndNil(origInfo.Instance); + FOriginals[AIndex] := origInfo; + end; + end; +end; + +procedure TBGRALayeredBitmap.UnloadOriginal(const AGuid: TGuid); +begin + UnloadOriginal(IndexOfOriginal(AGuid)); +end; + +destructor TBGRALayeredBitmap.Destroy; +begin + FOriginalEditor.Free; + inherited Destroy; +end; + +constructor TBGRALayeredBitmap.Create; +begin + inherited Create; + FWidth := 0; + FHeight := 0; + FNbLayers:= 0; + FOriginals := nil; +end; + +constructor TBGRALayeredBitmap.Create(AWidth, AHeight: integer); +begin + inherited Create; + if AWidth < 0 then + FWidth := 0 + else + FWidth := AWidth; + if AHeight < 0 then + FHeight := 0 + else + FHeight := AHeight; + FNbLayers:= 0; +end; + +function TBGRALayeredBitmap.GetLayerBitmapCopy(layer: integer): TBGRABitmap; +begin + result := GetLayerBitmapDirectly(layer).Duplicate; +end; + +function TBGRALayeredBitmap.GetLayerIndexFromId(AIdentifier: integer): integer; +var i: integer; +begin + for i := 0 to NbLayers-1 do + if FLayers[i].UniqueId = AIdentifier then + begin + result := i; + exit; + end; + result := -1; //not found +end; + +function TBGRALayeredBitmap.Duplicate(ASharedLayerIds: boolean): TBGRALayeredBitmap; +begin + result := TBGRALayeredBitmap.Create; + result.Assign(self, ASharedLayerIds); +end; + +function TBGRALayeredBitmap.ProduceLayerUniqueId: integer; +begin + result := InterLockedIncrement(NextLayerUniqueId); +end; + +procedure TBGRALayeredBitmap.RotateCW; +var i: integer; + newBmp: TBGRABitmap; + newOfs: TPointF; + m: TAffineMatrix; +begin + SetSize(Height,Width); //unfreeze + m := AffineMatrixTranslation(Width,0)*AffineMatrixRotationDeg(90); + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + newOfs:= m*PointF(FLayers[i].x,FLayers[i].y+FLayers[i].Source.Height); + newBmp := FLayers[i].Source.RotateCW; + if FLayers[i].Owner then FreeAndNil(FLayers[i].Source); + FLayers[i].Source := newBmp; + FLayers[i].Owner := true; + FLayers[i].x := round(newOfs.x); + FLayers[i].y := round(newOfs.y); + FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix; + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.RotateCCW; +var i: integer; + newBmp: TBGRABitmap; + newOfs: TPointF; + m: TAffineMatrix; +begin + SetSize(Height,Width); //unfreeze + m := AffineMatrixTranslation(0,Height)*AffineMatrixRotationDeg(-90); + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + newOfs:= m*PointF(FLayers[i].x+FLayers[i].Source.Width,FLayers[i].y); + newBmp := FLayers[i].Source.RotateCCW; + if FLayers[i].Owner then FreeAndNil(FLayers[i].Source); + FLayers[i].Source := newBmp; + FLayers[i].Owner := true; + FLayers[i].x := round(newOfs.x); + FLayers[i].y := round(newOfs.y); + FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix; + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.RotateUD; +var i: integer; +begin + Unfreeze; + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + RotateUD(i); + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.RotateUD(ALayerIndex: integer); +begin + if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then + raise ERangeError.Create('Index out of bounds'); + Unfreeze(ALayerIndex); + if FLayers[ALayerIndex].Owner then + FLayers[ALayerIndex].Source.RotateUDInplace + else + begin + FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.RotateUD; + FLayers[ALayerIndex].Owner := true; + end; + FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width; + FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height; + FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,+Height/2)*AffineMatrixScale(-1,-1)*AffineMatrixTranslation(-Width/2,-Height/2)*FLayers[ALayerIndex].OriginalMatrix; +end; + +procedure TBGRALayeredBitmap.HorizontalFlip; +var i: integer; +begin + Unfreeze; + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + HorizontalFlip(i); + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.HorizontalFlip(ALayerIndex: integer); +begin + if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then + raise ERangeError.Create('Index out of bounds'); + Unfreeze(ALayerIndex); + if FLayers[ALayerIndex].Owner then + FLayers[ALayerIndex].Source.HorizontalFlip + else + begin + FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True); + FLayers[ALayerIndex].Source.HorizontalFlip; + FLayers[ALayerIndex].Owner := true; + end; + FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width; + FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,0)*AffineMatrixScale(-1,1)*AffineMatrixTranslation(-Width/2,0)*FLayers[ALayerIndex].OriginalMatrix; +end; + +procedure TBGRALayeredBitmap.VerticalFlip; +var i: integer; +begin + Unfreeze; + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + VerticalFlip(i); + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.VerticalFlip(ALayerIndex: integer); +begin + if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then + raise ERangeError.Create('Index out of bounds'); + Unfreeze(ALayerIndex); + if FLayers[ALayerIndex].Owner then + FLayers[ALayerIndex].Source.VerticalFlip + else + begin + FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True); + FLayers[ALayerIndex].Source.VerticalFlip; + FLayers[ALayerIndex].Owner := true; + end; + FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height; + FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(0,+Height/2)*AffineMatrixScale(1,-1)*AffineMatrixTranslation(0,-Height/2)*FLayers[ALayerIndex].OriginalMatrix; +end; + +procedure TBGRALayeredBitmap.Resample(AWidth, AHeight: integer; + AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter); +var i, prevWidth, prevHeight: integer; + resampled: TBGRABitmap; + oldFilter : TResampleFilter; + dummyRect: TRect; +begin + if (AWidth < 0) or (AHeight < 0) then + raise exception.Create('Invalid size'); + prevWidth := Width; + if prevWidth < 1 then prevWidth := AWidth; + prevHeight := Height; + if prevHeight < 1 then prevHeight := AHeight; + SetSize(AWidth, AHeight); //unfreeze + dummyRect := EmptyRect; + for i := 0 to NbLayers-1 do + begin + if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); + if (FLayers[i].OriginalGuid <> GUID_NULL) and LayerOriginalKnown[i] then + begin + LayerOriginalMatrix[i] := AffineMatrixScale(AWidth/prevWidth,AHeight/prevHeight)*LayerOriginalMatrix[i]; + if AResampleMode = rmFineResample then RenderLayerFromOriginalIfNecessary(i, false, dummyRect); + end else + begin + if LayerBitmap[i].NbPixels <> 0 then + begin + oldFilter := LayerBitmap[i].ResampleFilter; + LayerBitmap[i].ResampleFilter := AFineResampleFilter; + resampled := LayerBitmap[i].Resample(max(1,round(LayerBitmap[i].Width*AWidth/prevWidth)), + max(1,round(LayerBitmap[i].Height*AHeight/prevHeight)), AResampleMode); + LayerBitmap[i].ResampleFilter := oldFilter; + SetLayerBitmap(i, resampled, True); + end; + with LayerOffset[i] do + LayerOffset[i] := Point(round(X*AWidth/prevWidth),round(Y*AHeight/prevHeight)); + end; + end; + if Assigned(OnActionDone) then OnActionDone(self); +end; + +procedure TBGRALayeredBitmap.SetLayerBitmap(layer: integer; + ABitmap: TBGRABitmap; AOwned: boolean); +var + layerDir: TMemDirectory; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds') + else + begin + if ABitmap = FLayers[layer].Source then exit; + Unfreeze(layer); + if FLayers[layer].Owner then FLayers[layer].Source.Free; + FLayers[layer].Source := ABitmap; + FLayers[layer].Owner := AOwned; + FLayers[layer].OriginalGuid := GUID_NULL; + FLayers[layer].OriginalMatrix := AffineMatrixIdentity; + layerDir := GetLayerDirectory(layer, false); + if Assigned(layerDir) then + layerDir.Delete(RenderSubDirectory,''); + end; +end; + +function TBGRALayeredBitmap.TakeLayerBitmap(layer: integer): TBGRABitmap; +begin + result := GetLayerBitmapDirectly(layer); + if Assigned(result) then + begin + if FLayers[layer].Owner then FLayers[layer].Owner := false + else result := result.Duplicate; + end; +end; + +procedure TBGRALayeredBitmap.ApplyLayerOffset(ALayerIndex: integer; + APadWithTranparentPixels: boolean); +var + r: TRect; + newBmp: TBGRABitmap; +begin + if APadWithTranparentPixels then + begin + if (LayerOffset[ALayerIndex].X=0) and (LayerOffset[ALayerIndex].Y=0) and + (LayerBitmap[ALayerIndex].Width=Width) and (LayerBitmap[ALayerIndex].Height=Height) then exit; + newBmp := TBGRABitmap.Create(Width,Height); + newBmp.PutImage(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, LayerBitmap[ALayerIndex], dmSet); + if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free; + FLayers[ALayerIndex].Source := newBmp; + FLayers[ALayerIndex].Owner := true; + FLayers[ALayerIndex].x := 0; + FLayers[ALayerIndex].y := 0; + end else + begin + if (LayerOffset[ALayerIndex].X>=0) and (LayerOffset[ALayerIndex].Y>=0) and + (LayerOffset[ALayerIndex].X+LayerBitmap[ALayerIndex].Width <= Width) and + (LayerOffset[ALayerIndex].Y+LayerBitmap[ALayerIndex].Height <= Height) then exit; + r := RectWithSize(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, + LayerBitmap[ALayerIndex].Width, LayerBitmap[ALayerIndex].Height); + r.Intersect( rect(0,0,Width,Height) ); + newBmp := TBGRABitmap.Create(r.Width,r.Height); + newBmp.PutImage(LayerOffset[ALayerIndex].X - r.Left, LayerOffset[ALayerIndex].Y - r.Top, LayerBitmap[ALayerIndex], dmSet); + if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free; + FLayers[ALayerIndex].Source := newBmp; + FLayers[ALayerIndex].Owner := true; + FLayers[ALayerIndex].x := r.Left; + FLayers[ALayerIndex].y := r.Top; + end; +end; + +function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; + ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; +begin + result := DrawEditor(ADest, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); +end; + +function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; + AMatrix: TAffineMatrix; APointSize: single): TRect; +begin + UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize); + if Assigned(OriginalEditor) then + result := OriginalEditor.Render(ADest, rect(0,0,ADest.Width,ADest.Height)) + else result := EmptyRect; +end; + +function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; X, + Y: Integer; APointSize: single): TRect; +begin + result := GetEditorBounds(ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); +end; + +function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; + ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; +begin + result := GetEditorBounds(ADestRect, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); +end; + +function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; + AMatrix: TAffineMatrix; APointSize: single): TRect; +begin + result := GetEditorBounds(rect(-maxLongint,-maxLongint,maxLongint,maxLongint), ALayerIndex, AMatrix, APointSize); +end; + +function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; + AMatrix: TAffineMatrix; APointSize: single): TRect; +begin + UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize); + + if Assigned(OriginalEditor) then + result := OriginalEditor.GetRenderBounds(ADestRect) + else result := EmptyRect; +end; + +procedure TBGRALayeredBitmap.ClearEditor; +begin + if Assigned(FOriginalEditor) then FOriginalEditor.Clear; + FOriginalEditorOriginal := GUID_NULL; +end; + +procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out + ACursor: TOriginalEditorCursor); +var + handled: boolean; +begin + MouseMove(Shift, ImageX,ImageY, ACursor, handled); +end; + +procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean; + Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); +var + handled: boolean; +begin + MouseDown(RightButton, Shift, ImageX,ImageY, ACursor, handled); +end; + +procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState; + ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); +var + handled: boolean; +begin + MouseUp(RightButton, Shift, ImageX,ImageY, ACursor, handled); +end; + +procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out + ACursor: TOriginalEditorCursor; out AHandled: boolean); +var + viewPt: TPointF; +begin + if Assigned(OriginalEditor) then + begin + viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); + OriginalEditor.MouseMove(Shift, viewPt.X, viewPt.Y, ACursor, AHandled); + end + else + begin + ACursor:= oecDefault; + AHandled:= false; + end; +end; + +procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean; + Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out + AHandled: boolean); +var + viewPt: TPointF; +begin + if Assigned(OriginalEditor) then + begin + viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); + OriginalEditor.MouseDown(RightButton, Shift, viewPt.X, viewPt.Y, ACursor, AHandled); + end + else + begin + ACursor:= oecDefault; + AHandled:= false; + end; +end; + +procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState; + ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); +var + viewPt: TPointF; +begin + if Assigned(OriginalEditor) then + begin + viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); + OriginalEditor.MouseUp(RightButton, Shift, viewPt.X,viewPt.Y, ACursor, AHandled); + end + else + begin + ACursor:= oecDefault; + AHandled:= false; + end; +end; + +procedure TBGRALayeredBitmap.KeyDown(Shift: TShiftState; Key: TSpecialKey; out + AHandled: boolean); +begin + if Assigned(OriginalEditor) then + OriginalEditor.KeyDown(Shift, Key, AHandled) + else + AHandled := false; +end; + +procedure TBGRALayeredBitmap.KeyUp(Shift: TShiftState; Key: TSpecialKey; out + AHandled: boolean); +begin + if Assigned(OriginalEditor) then + OriginalEditor.KeyUp(Shift, Key, AHandled) + else + AHandled := false; +end; + +procedure TBGRALayeredBitmap.KeyPress(UTF8Key: string; out AHandled: boolean); +begin + if Assigned(OriginalEditor) then + OriginalEditor.KeyPress(UTF8Key, AHandled) + else + AHandled := false; +end; + +function TBGRALayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer; +var + i: Integer; +begin + for i := 0 to OriginalCount-1 do + if FOriginals[i].Guid = AGuid then + begin + result := i; + exit; + end; + result := -1 +end; + +function TBGRALayeredBitmap.IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; +begin + if Assigned(FOriginals) then + result := FOriginals.IndexOf(BGRALayerOriginalEntry(AOriginal)) + else + result := -1; +end; + +{ TBGRACustomLayeredBitmap } + +function TBGRACustomLayeredBitmap.GetLinearBlend: boolean; +begin + result := FLinearBlend; +end; + +function TBGRACustomLayeredBitmap.GetSelectionVisible: boolean; +begin + result := (FSelectionScanner <> nil) and (FSelectionLayerIndex >= 0) and + (FSelectionLayerIndex < NbLayers) and FSelectionRect.IntersectsWith(rect(0,0,Width,Height)); +end; + +function TBGRACustomLayeredBitmap.GetMemDirectory: TMemDirectory; +begin + if FMemDirectory = nil then + begin + FMemDirectory:= TMemDirectory.Create; + FMemDirectoryOwned := true; + end; + result := FMemDirectory; +end; + +function TBGRACustomLayeredBitmap.GetDefaultBlendingOperation: TBlendOperation; +begin + result := boTransparent; +end; + +function TBGRACustomLayeredBitmap.GetHasMemFiles: boolean; +begin + result := assigned(FMemDirectory) and (FMemDirectory.Count > 0); +end; + +function TBGRACustomLayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid; +begin + result := GUID_NULL; +end; + +function TBGRACustomLayeredBitmap.GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; +begin + result := orsProof; +end; + +function TBGRACustomLayeredBitmap.GetOriginalCount: integer; +begin + result := 0; +end; + +function TBGRACustomLayeredBitmap.GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; +begin + result := nil; + raise exception.Create('Not implemented'); +end; + +function TBGRACustomLayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean; +begin + result := true; +end; + +function TBGRACustomLayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean; +begin + result := true; +end; + +function TBGRACustomLayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; +begin + result := nil; +end; + +function TBGRACustomLayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; +begin + result := nil; +end; + +function TBGRACustomLayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean; +begin + result := true; +end; + +function TBGRACustomLayeredBitmap.GetLayerOriginalMatrix(layer: integer): TAffineMatrix; +begin + result := AffineMatrixIdentity; +end; + +procedure TBGRACustomLayeredBitmap.SetLinearBlend(AValue: boolean); +begin + Unfreeze; + FLinearBlend := AValue; +end; + +procedure TBGRACustomLayeredBitmap.SetMemDirectory(AValue: TMemDirectory); +begin + if AValue = FMemDirectory then exit; + if FMemDirectoryOwned then FMemDirectory.Free; + FMemDirectory := AValue; + FMemDirectoryOwned := false; +end; + +function TBGRACustomLayeredBitmap.GetLayerName(layer: integer): string; +begin + result := 'Layer' + inttostr(layer+1); +end; + +{$hints off} +function TBGRACustomLayeredBitmap.GetLayerOffset(layer: integer): TPoint; +begin + //optional function + result := Point(0,0); +end; +{$hints on} + +{$hints off} +function TBGRACustomLayeredBitmap.GetLayerBitmapDirectly(layer: integer + ): TBGRABitmap; +begin + //optional function + result:= nil; +end; + +function TBGRACustomLayeredBitmap.GetLayerFrozenRange(layer: integer): integer; +var i: integer; +begin + for i := 0 to high(FFrozenRange) do + if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then + begin + result := i; + exit; + end; + result := -1; +end; + +function TBGRACustomLayeredBitmap.GetLayerFrozen(layer: integer): boolean; +var i: integer; +begin + for i := 0 to high(FFrozenRange) do + if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then + begin + result := true; + exit; + end; + result := false; +end; + +function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer; +begin + result := layer; +end; + +procedure TBGRACustomLayeredBitmap.SetLayerFrozen(layer: integer; + AValue: boolean); +begin + //nothing +end; + +function TBGRACustomLayeredBitmap.RangeIntersect(first1, last1, first2, + last2: integer): boolean; +begin + result := (first1 <= last2) and (last1 >= first2); +end; + +procedure TBGRACustomLayeredBitmap.RemoveFrozenRange(index: integer); +var j,i: integer; +begin + for j := FFrozenRange[index].firstLayer to FFrozenRange[index].lastLayer do + SetLayerFrozen(j,False); + FFrozenRange[index].image.Free; + for i := index to high(FFrozenRange)-1 do + FFrozenRange[i] := FFrozenRange[i+1]; + setlength(FFrozenRange,length(FFrozenRange)-1); +end; + +function TBGRACustomLayeredBitmap.ContainsFrozenRange(first, last: integer): boolean; +var i: integer; +begin + for i := 0 to high(FFrozenRange) do + if (FFrozenRange[i].firstLayer = first) and (FFrozenRange[i].lastLayer = last) then + begin + result := true; + exit; + end; + result := false; +end; + +function TBGRACustomLayeredBitmap.GetLayerDrawMode(AIndex: integer): TDrawMode; +begin + if (BlendOperation[AIndex] = boTransparent) and not LinearBlend then + result := dmDrawWithTransparency + else result := dmLinearBlend; +end; + +function TBGRACustomLayeredBitmap.GetEmpty: boolean; +begin + result := (NbLayers = 0) and (Width = 0) and (Height = 0); +end; + +function TBGRACustomLayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer; +begin + result := -1; +end; + +function TBGRACustomLayeredBitmap.IndexOfOriginal( + AOriginal: TBGRALayerCustomOriginal): integer; +begin + result := -1; +end; + +procedure TBGRACustomLayeredBitmap.SetWidth(Value: Integer); +begin + //nothing +end; + +procedure TBGRACustomLayeredBitmap.SetHeight(Value: Integer); +begin + //nothing +end; + +function TBGRACustomLayeredBitmap.GetTransparent: Boolean; +begin + result := true; +end; + +procedure TBGRACustomLayeredBitmap.SetTransparent(Value: Boolean); +begin + //nothing +end; + +procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string); +var bmp: TBGRABitmap; + ext: string; + temp: TBGRALayeredBitmap; + i: integer; + stream: TFileStreamUTF8; +begin + ext := UTF8LowerCase(ExtractFileExt(filenameUTF8)); + for i := 0 to high(LayeredBitmapWriters) do + if '.'+LayeredBitmapWriters[i].extension = ext then + begin + temp := LayeredBitmapWriters[i].theClass.Create; + try + temp.Assign(self); + temp.SaveToFile(filenameUTF8); + finally + temp.Free; + end; + exit; + end; + + //when using "data" extension, simply serialize + if (ext='.dat') or (ext='.data') then + begin + if Assigned(LayeredBitmapLoadFromStreamProc) then + begin + stream := TFileStreamUTF8.Create(filenameUTF8, fmCreate); + try + LayeredBitmapSaveToStreamProc(stream, self); + finally + stream.Free; + end; + end else + raise exception.Create('Enable layer serialization by calling BGRAStreamLayers.RegisterStreamLayers'); + end else + begin + bmp := ComputeFlatImage; + try + bmp.SaveToFileUTF8(filenameUTF8); + finally + bmp.Free; + end; + end; +end; + +procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream); +begin + if Assigned(LayeredBitmapSaveToStreamProc) then + LayeredBitmapSaveToStreamProc(Stream, self) + else + raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first'); +end; + +procedure TBGRACustomLayeredBitmap.SaveToStreamAs(Stream: TStream; + AExtension: string); +var bmp: TBGRABitmap; + ext: string; + format: TBGRAImageFormat; + temp: TBGRALayeredBitmap; + i: integer; +begin + ext := UTF8LowerCase(AExtension); + if ext[1] <> '.' then ext := '.'+ext; + + for i := 0 to high(LayeredBitmapWriters) do + if '.'+LayeredBitmapWriters[i].extension = ext then + begin + temp := LayeredBitmapWriters[i].theClass.Create; + try + temp.Assign(self, true, true); + temp.SaveToStream(Stream); + finally + temp.Free; + end; + exit; + end; + + format := SuggestImageFormat(ext); + bmp := ComputeFlatImage; + try + bmp.SaveToStreamAs(Stream, format); + finally + bmp.Free; + end; +end; + +constructor TBGRACustomLayeredBitmap.Create; +begin + FFrozenRange := nil; + FLinearBlend:= True; + FMemDirectory := nil; + FMemDirectoryOwned:= false; + FSelectionDrawMode:= dmDrawWithTransparency; + FSelectionLayerIndex:= -1; + FSelectionRect:= EmptyRect; + FSelectionScanner:= nil; + FSelectionScannerOffset:= Point(0,0); +end; + +{$hints on} + +function TBGRACustomLayeredBitmap.ToString: ansistring; +var + i: integer; +begin + Result := 'LayeredBitmap' + LineEnding + LineEnding; + for i := 0 to NbLayers - 1 do + begin + AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding); + end; +end; + +procedure TBGRACustomLayeredBitmap.DiscardSelection; +begin + fillchar(FSelectionScanner, sizeof(FSelectionScanner), 0); + FSelectionRect := EmptyRect; + FSelectionLayerIndex := -1; + FSelectionScannerOffset:= Point(0,0); +end; + +function TBGRACustomLayeredBitmap.ComputeFlatImage(ASeparateXorMask: boolean): TBGRABitmap; +begin + result := ComputeFlatImage(rect(0,0,Width,Height), 0, NbLayers - 1, ASeparateXorMask); +end; + +function TBGRACustomLayeredBitmap.ComputeFlatImage(firstLayer, + lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap; +begin + result := ComputeFlatImage(rect(0,0,Width,Height), firstLayer,LastLayer,ASeparateXorMask); +end; + +function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; + ASeparateXorMask: boolean): TBGRABitmap; +begin + result := ComputeFlatImage(ARect,0, NbLayers - 1, ASeparateXorMask); +end; + +destructor TBGRACustomLayeredBitmap.Destroy; +begin + DiscardSelection; + Clear; +end; + +function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap; +var + i,j: integer; + destEmpty: boolean; + +begin + if (firstLayer < 0) or (lastLayer > NbLayers-1) then + raise ERangeError.Create('Layer index out of bounds'); + If (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then + begin + result := TBGRABitmap.Create(0,0); + exit; + end; + Result := TBGRABitmap.Create(ARect.Right-ARect.Left, ARect.Bottom-ARect.Top); + destEmpty := true; + if SelectionVisible then Unfreeze(SelectionLayerIndex); + i := firstLayer; + while i <= lastLayer do + begin + if LayerFrozen[i] then + begin + j := GetLayerFrozenRange(i); + if j <> -1 then + begin + if i = 0 then + Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmSet) else + if not FFrozenRange[j].linearBlend then + Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmDrawWithTransparency) + else + Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmLinearBlend); + i := FFrozenRange[j].lastLayer+1; + destEmpty := false; + continue; + end; + end; + if DrawLayer(result, -ARect.Left, -ARect.Top, i, ASeparateXorMask, destEmpty) then + destEmpty := false; + inc(i); + end; + if result.XorMask <> nil then + AlphaFillInline(result.XorMask.Data, 0, result.XorMask.NbPixels); +end; + +procedure TBGRACustomLayeredBitmap.Draw(ACanvas: TCanvas; const Rect: TRect); +var temp: TBGRABitmap; +begin + if (Rect.Right <= Rect.Left) or (Rect.Bottom <= Rect.Top) then exit; + if (Rect.Right-Rect.Left = Width) and (Rect.Bottom-Rect.Top = Height) then + Draw(ACanvas, Rect.Left,Rect.Top) else + begin + temp := ComputeFlatImage; + BGRAReplace(temp,temp.Resample(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top)); + temp.Draw(ACanvas, Rect.Left,Rect.Top, False); + temp.Free; + end; +end; + +procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer); +begin + Draw(Canvas,x,y,0,NbLayers-1); +end; + +procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer; firstLayer, lastLayer: integer); +var temp: TBGRABitmap; +begin + temp := ComputeFlatImage(firstLayer,lastLayer); + temp.Draw(Canvas,x,y,False); + temp.Free; +end; + +procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer); +begin + Draw(Dest, x, y, 0, NbLayers-1); +end; + +procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer; + ASeparateXorMask: boolean; ADestinationEmpty: boolean); +begin + Draw(Dest, x, y, 0, NbLayers-1, ASeparateXorMask, ADestinationEmpty); +end; + +procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; AX, AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean); +var + temp: TBGRABitmap; + i,j: integer; + NewClipRect: TRect; +begin + NewClipRect := TRect.Intersect(rect(AX,AY,AX+Width,AY+Height), Dest.ClipRect); + if NewClipRect.IsEmpty then exit; + + for i := firstLayer to lastLayer do + if LayerVisible[i] and + (not (BlendOperation[i] in[boTransparent,boLinearBlend]) or + ( (SelectionLayerIndex = i) and SelectionVisible + and (SelectionDrawMode <> GetLayerDrawMode(i)) ) ) then + begin + temp := ComputeFlatImage(rect(NewClipRect.Left-AX,NewClipRect.Top-AY,NewClipRect.Right-AX,NewClipRect.Bottom-AY), ASeparateXorMask); + if ADestinationEmpty then + Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmSet) else + if self.LinearBlend then + Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmLinearBlend) + else Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmDrawWithTransparency); + temp.Free; + exit; + end; + + i := firstLayer; + while i <= lastLayer do + begin + if LayerFrozen[i] then + begin + j := GetLayerFrozenRange(i); + if j <> -1 then + begin + if ADestinationEmpty then + Dest.PutImage(AX, AY, FFrozenRange[j].image, dmSet) else + if not FFrozenRange[j].linearBlend then + Dest.PutImage(AX, AY, FFrozenRange[j].image, dmDrawWithTransparency) + else Dest.PutImage(AX, AY, FFrozenRange[j].image, dmLinearBlend); + i := FFrozenRange[j].lastLayer+1; + ADestinationEmpty := false; + continue; + end; + end; + if DrawLayer(Dest, AX,AY, i, ASeparateXorMask, ADestinationEmpty) then + ADestinationEmpty := false; + inc(i); + end; +end; + +function TBGRACustomLayeredBitmap.DrawLayer(Dest: TBGRABitmap; X, Y: Integer; + AIndex: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean): boolean; +type IntArray4 = array[1..4] of integer; + + function MergeSort(const ATab: IntArray4): IntArray4; + var + posA, posB, pos: Integer; + begin + posA := 1; + posB := 3; + pos := 1; + while (posA <= 2) and (posB <= 4) do + begin + if ATab[posA] <= ATab[posB] then + begin + result[pos] := ATab[posA]; + inc(posA); + end else + begin + result[pos] := ATab[posB]; + inc(posB); + end; + inc(pos); + end; + while posA <= 2 do + begin + result[pos] := ATab[posA]; + inc(posA); inc(pos); + end; + while posB <= 4 do + begin + result[pos] := ATab[posB]; + inc(posB); inc(pos); + end; + end; + +var + opacity: Byte; + + procedure Blend(ADestRect: TRect; AScan: IBGRAScanner; AScanOfsX, AScanOfsY: integer; ABlendOp: TBlendOperation); + begin + //XOR mask + if (ABlendOp = boXor) and ASeparateXorMask then + begin + Dest.NeedXorMask; + Dest.XorMask.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend); + end else + //first layer is simply the background + if ADestinationEmpty and (ABlendOp <> boMask) then + begin + Dest.FillRect(ADestRect, AScan, dmSet, Point(AScanOfsX, AScanOfsY)); + Dest.ApplyGlobalOpacity(ADestRect, opacity); + end + else + Dest.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend); + end; + +var + tempLayer: TBGRABitmap; + tempLayerScanOfs, selScanOfs: TPoint; + blendOp: TBlendOperation; + + procedure BlendBoth(ATile: TRect); + var + mergeBuf: PByte; + pTemp: PByte; + tempStride, rowSize, destStride: PtrInt; + tileWidth, yb: LongInt; + pDest: PByte; + begin + tileWidth := ATile.Width; + rowSize := tileWidth * sizeof(TBGRAPixel); + if not ADestinationEmpty then + getmem(mergeBuf, rowSize) + else mergeBuf := nil; + try + if tempLayer.LineOrder = riloTopToBottom then + tempStride := tempLayer.RowSize else tempStride := -tempLayer.RowSize; + pTemp := tempLayer.GetPixelAddress(ATile.Left + tempLayerScanOfs.X, + ATile.Top + tempLayerScanOfs.Y); + pDest := Dest.GetPixelAddress(ATile.Left, ATile.Top); + if Dest.LineOrder = riloTopToBottom then + destStride := Dest.RowSize else destStride := -Dest.RowSize; + if ADestinationEmpty then + begin + for yb := ATile.Top to ATile.Bottom-1 do + begin + move(pTemp^, pDest^, rowSize); + SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y); + ScannerPutPixels(SelectionScanner, PBGRAPixel(pDest), tileWidth, SelectionDrawMode); + inc(pTemp, tempStride); + inc(pDest, destStride); + end; + Dest.ApplyGlobalOpacity(ATile, opacity); + end else + begin + for yb := ATile.Top to ATile.Bottom-1 do + begin + move(pTemp^, mergeBuf^, rowSize); + SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y); + ScannerPutPixels(SelectionScanner, PBGRAPixel(mergeBuf), tileWidth, SelectionDrawMode); + BlendPixelsOver(PBGRAPixel(pDest), PBGRAPixel(mergeBuf), + blendOp, tileWidth, opacity, LinearBlend); + inc(pTemp, tempStride); + inc(pDest, destStride); + end; + end; + finally + freemem(mergeBuf); + end; + end; + +var + mustFreeCopy, containsSel, containsLayer: Boolean; + ofs: TPoint; + rSel, oldClip, rLayer, rTile: TRect; + xTab,yTab: IntArray4; + xb, yb: Integer; +begin + if not LayerVisible[AIndex] then exit(false); + opacity := LayerOpacity[AIndex]; + if opacity = 0 then exit(false); + + tempLayer := GetLayerBitmapDirectly(AIndex); + if tempLayer <> nil then mustFreeCopy := false else + begin + mustFreeCopy := true; + tempLayer := GetLayerBitmapCopy(AIndex); + end; + + ofs := LayerOffset[AIndex]; + oldClip := Dest.IntersectClip(rect(X,Y,X+self.Width,Y+self.Height)); + + if (SelectionLayerIndex = AIndex) and SelectionVisible then + begin + rSel := SelectionRect; + rSel.Offset(X, Y); + rSel.Intersect(Dest.ClipRect); + end else + rSel := EmptyRect; + + if Assigned(tempLayer) then + begin + rLayer := RectWithSize(ofs.x + X, ofs.y + Y, tempLayer.Width, tempLayer.Height); + rLayer.Intersect(Dest.ClipRect); + end else + rLayer := EmptyRect; + + if (tempLayer <> nil) and (not rLayer.IsEmpty or not rSel.IsEmpty) then + begin + if AIndex = 0 then blendOp := boTransparent else blendOp := BlendOperation[AIndex]; + tempLayerScanOfs := Point(-(ofs.X+X), -(ofs.Y+Y)); + + if rSel.IsEmpty then + Blend(rLayer, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp) + else + begin + selScanOfs := Point(SelectionScannerOffset.X - X, SelectionScannerOffset.Y - Y); + + xTab[1] := rSel.Left; yTab[1] := rSel.Top; + xTab[2] := rSel.Right; yTab[2] := rSel.Bottom; + xTab[3] := rLayer.Left; yTab[3] := rLayer.Top; + xTab[4] := rLayer.Right; yTab[4] := rLayer.Bottom; + xTab := MergeSort(xTab); yTab := MergeSort(yTab); + + for yb := 1 to 3 do + begin + rTile.Top := yTab[yb]; + rTile.Bottom := yTab[yb+1]; + if rTile.Bottom > rTile.Top then + for xb := 1 to 3 do + begin + rTile.Left := xTab[xb]; + rTile.Right := xTab[xb+1]; + if rTile.Right > rTile.Left then + begin + containsSel := rTile.IntersectsWith(rSel); + containsLayer := rTile.IntersectsWith(rLayer); + if containsLayer then + begin + if not containsSel then + Blend(rTile, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp) + else + BlendBoth(rTile); + end else + if containsSel then + Blend(rTile, SelectionScanner, selScanOfs.X, selScanOfs.Y, blendOp) + end; + end; + end; + end; + + result := true; + end else + result := false; + + Dest.ClipRect := oldClip; + if mustFreeCopy then tempLayer.Free; +end; + +procedure TBGRACustomLayeredBitmap.FreezeExceptOneLayer(layer: integer); +begin + if (layer < 0) or (layer >= NbLayers) then + begin + Freeze; + exit; + end; + Unfreeze(layer,layer); + if layer > 1 then + Freeze(0,layer-1); + if layer < NbLayers-2 then + Freeze(layer+1,NbLayers-1); +end; + +procedure TBGRACustomLayeredBitmap.Freeze(firstLayer, lastLayer: integer); + + procedure DoFreeze(first,last: integer; linear: boolean); + var i,nbVisible: integer; + computedImage: TBGRABitmap; + begin + if last <= first then exit; //at least 2 frozen layers + nbVisible := 0; + for i := first to last do + if LayerVisible[i] and (LayerOpacity[i] > 0) then inc(nbVisible); + if nbvisible < 2 then exit; //at least 2 frozen layers + + if ContainsFrozenRange(first,last) then exit; //already frozen + Unfreeze(first,last); + + computedImage := ComputeFlatImage(first,last); //must compute before layers are considered as frozen + setlength(FFrozenRange, length(FFrozenRange)+1); + with FFrozenRange[high(FFrozenRange)] do + begin + firstLayer := first; + lastLayer:= last; + image := computedImage; + linearBlend := linear; + end; + for i := first to last do + SetLayerFrozen(i,True); + end; + +var j: integer; + start: integer; + linear,nextLinear: boolean; +begin + start := -1; + linear := false; //to avoid hint + for j := firstlayer to lastLayer do + if ((BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0))) + and (not SelectionVisible or (j <> SelectionLayerIndex)) then + begin + nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend; + if start = -1 then + begin + start := j; + linear := nextLinear; + end else + begin + if linear <> nextLinear then + begin + DoFreeze(start,j-1,linear); + start := j; + linear := nextLinear; + end; + end; + end else + begin + if start <> -1 then + begin + DoFreeze(start,j-1,linear); + start := -1; + end; + end; + if start <> -1 then + DoFreeze(start,lastLayer,linear); +end; + +procedure TBGRACustomLayeredBitmap.Freeze; +begin + Freeze(0,NbLayers-1); +end; + +procedure TBGRACustomLayeredBitmap.Unfreeze; +begin + Unfreeze(0,NbLayers-1); +end; + +procedure TBGRACustomLayeredBitmap.Unfreeze(layer: integer); +begin + Unfreeze(layer,layer); +end; + +procedure TBGRACustomLayeredBitmap.Unfreeze(firstLayer, lastLayer: integer); +var i: integer; +begin + for i := high(FFrozenRange) downto 0 do + if RangeIntersect(firstLayer,lastLayer,FFrozenRange[i].firstLayer,FFrozenRange[i].lastLayer) then + RemoveFrozenRange(i); +end; + +procedure TBGRACustomLayeredBitmap.NotifyLoaded; +begin + //nothing +end; + +procedure TBGRACustomLayeredBitmap.NotifySaving; +begin + //nothing +end; + +procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass); +begin + setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1); + with LayeredBitmapReaders[high(LayeredBitmapReaders)] do + begin + extension:= UTF8LowerCase(AExtensionUTF8); + theClass := AReader; + end; +end; + +function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap; +var + i: Integer; +begin + AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8); + if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then + AExtensionUTF8:= '.'+AExtensionUTF8; + for i := 0 to high(LayeredBitmapWriters) do + if '.'+LayeredBitmapWriters[i].extension = AExtensionUTF8 then + begin + result := LayeredBitmapWriters[i].theClass.Create; + exit; + end; + result := nil; +end; + +function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap; +var + i: Integer; +begin + AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8); + if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then + AExtensionUTF8:= '.'+AExtensionUTF8; + for i := 0 to high(LayeredBitmapReaders) do + if '.'+LayeredBitmapReaders[i].extension = AExtensionUTF8 then + begin + result := LayeredBitmapReaders[i].theClass.Create; + exit; + end; + result := nil; +end; + +procedure OnLayeredBitmapLoadFromStreamStart; +begin + OnLayeredBitmapLoadStart(''); +end; + +procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string); +var i: Integer; +begin + with LayeredBitmapLoadEvents do if Assigned(OnStart) then + for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8); +end; + +procedure OnLayeredBitmapLoadProgress(APercentage: integer); +var i: Integer; +begin + with LayeredBitmapLoadEvents do if Assigned(OnProgress) then + for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage); +end; + +procedure OnLayeredBitmapLoaded; +var i: Integer; +begin + with LayeredBitmapLoadEvents do if Assigned(OnDone) then + for i := 0 to OnDone.Count-1 do OnDone[i]; +end; + +procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; + AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc); +begin + with LayeredBitmapLoadEvents do begin + if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then + begin + if OnStart = nil then OnStart := TOnLayeredBitmapLoadStartProcList.Create; + OnStart.Add(AStart); + end; + if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then + begin + if OnProgress = nil then OnProgress := TOnLayeredBitmapLoadProgressProcList.Create; + OnProgress.Add(AProgress); + end; + if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then + begin + if OnDone = nil then OnDone := TOnLayeredBitmapLoadedProcList.Create; + OnDone.Add(ADone); + end; + end; +end; + +procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; + AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc); +begin + with LayeredBitmapLoadEvents do begin + if Assigned(OnStart) then OnStart.Remove(AStart); + if Assigned(OnProgress) then OnProgress.Remove(AProgress); + if Assigned(OnDone) then OnDone.Remove(ADone); + end; +end; + +procedure OnLayeredBitmapSaveToStreamStart; +begin + OnLayeredBitmapSaveStart(''); +end; + +procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string); +var i: Integer; +begin + with LayeredBitmapSaveEvents do if Assigned(OnStart) then + for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8); +end; + +procedure OnLayeredBitmapSaveProgress(APercentage: integer); +var i: Integer; +begin + with LayeredBitmapSaveEvents do if Assigned(OnProgress) then + for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage); +end; + +procedure OnLayeredBitmapSaved; +var i: Integer; +begin + with LayeredBitmapSaveEvents do if Assigned(OnDone) then + for i := 0 to OnDone.Count-1 do OnDone[i]; +end; + +procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; + AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc); +begin + with LayeredBitmapSaveEvents do begin + if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then + begin + if OnStart = nil then OnStart := TOnLayeredBitmapSaveStartProcList.Create; + OnStart.Add(AStart); + end; + if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then + begin + if OnProgress = nil then OnProgress := TOnLayeredBitmapSaveProgressProcList.Create; + OnProgress.Add(AProgress); + end; + if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then + begin + if OnDone = nil then OnDone := TOnLayeredBitmapSavedProcList.Create; + OnDone.Add(ADone); + end; + end; +end; + +procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; + AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc); +begin + with LayeredBitmapSaveEvents do begin + if Assigned(OnStart) then OnStart.Remove(AStart); + if Assigned(OnProgress) then OnProgress.Remove(AProgress); + if Assigned(OnDone) then OnDone.Remove(ADone); + end; +end; + +procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass); +begin + while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1); + setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1); + with LayeredBitmapWriters[high(LayeredBitmapWriters)] do + begin + extension:= UTF8LowerCase(AExtensionUTF8); + theClass := AWriter; + end; +end; + +initialization + + NextLayerUniqueId := 1; + +finalization + + with LayeredBitmapLoadEvents do begin + OnStart.Free; + OnProgress.Free; + OnDone.Free; + end; + with LayeredBitmapSaveEvents do begin + OnStart.Free; + OnProgress.Free; + OnDone.Free; + end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralazpaint.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralazpaint.pas new file mode 100644 index 0000000..ac99c45 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralazpaint.pas @@ -0,0 +1,264 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALazPaint; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALayers, BGRABitmapTypes, BGRAReadLzp, BGRAWriteLzp, + BGRALzpCommon, FPimage; + +type + TLzpCompression = BGRALzpCommon.TLzpCompression; + + { TBGRALazPaintImage } + + TBGRALazPaintImage = class(TBGRALayeredBitmap) + private + FSelectedLayerIndex: integer; + protected + procedure InternalLoadFromStream(AStream: TStream); + procedure InternalSaveToStream(AStream: TStream); + public + constructor Create; overload; override; + constructor Create(AWidth, AHeight: integer); overload; override; + procedure LoadFromStream(AStream: TStream); override; + procedure LoadFromFile(const filenameUTF8: string); override; + procedure SaveToStream(AStream: TStream); override; + procedure SaveToFile(const filenameUTF8: string); override; + property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex; + end; + + { TBGRAWriterLazPaintWithLayers } + + TBGRAWriterLazPaintWithLayers = class(TBGRAWriterLazPaint) + protected + FLayers: TBGRALayeredBitmap; + FSelectedLayerIndex: integer; + FCompression: TLzpCompression; + function GetNbLayers: integer; override; + function InternalWriteLayers(Str: TStream; {%H-}Img: TFPCustomImage): boolean; override; + public + constructor Create(ALayers: TBGRALayeredBitmap); overload; + property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex; + property Compression: TLzpCompression read FCompression write FCompression; + end; + + { TBGRAReaderLazPaintWithLayers } + + TBGRAReaderLazPaintWithLayers = class(TBGRAReaderLazPaint) + protected + FLayers: TBGRALayeredBitmap; + FLayersLoaded: boolean; + FSelectedLayerIndex: integer; + procedure InternalReadLayers(str: TStream; {%H-}Img: TFPCustomImage); override; + public + constructor Create(ALayers: TBGRALayeredBitmap); overload; + property LayersLoaded: boolean read FLayersLoaded; + property SelectedLayerIndex: integer read FSelectedLayerIndex; + end; + +procedure RegisterLazPaintFormat; + +implementation + +uses BGRAStreamLayers, BGRABitmap, BGRAUTF8; + +{ TBGRALazPaintImage } + +constructor TBGRALazPaintImage.Create; +begin + inherited Create; + RegisterLazPaintFormat; + FSelectedLayerIndex:= 0; +end; + +constructor TBGRALazPaintImage.Create(AWidth, AHeight: integer); +begin + inherited Create(AWidth, AHeight); + RegisterLazPaintFormat; + FSelectedLayerIndex:= 0; +end; + +procedure TBGRALazPaintImage.LoadFromStream(AStream: TStream); +begin + OnLayeredBitmapLoadFromStreamStart; + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + end; +end; + +procedure TBGRALazPaintImage.InternalLoadFromStream(AStream: TStream); +var + {%H-}header: TLazPaintImageHeader; + bmp: TBGRACustomBitmap; + reader: TBGRAReaderLazPaintWithLayers; +begin + AStream.ReadBuffer({%H-}header, sizeof(header)); + LazPaintImageHeader_SwapEndianIfNeeded(header); + AStream.Position:= AStream.Position-sizeof(header); + + //use shortcut if possible + if (header.magic = LAZPAINT_MAGIC_HEADER) and (header.zero1 = 0) + and (header.layersOffset >= sizeof(header)) then + begin + AStream.Position:= AStream.Position+header.layersOffset; + LoadLayersFromStream(AStream, FSelectedLayerIndex, false, self, True); + end else + begin + reader := TBGRAReaderLazPaintWithLayers.Create(self); + try + bmp := BGRABitmapFactory.Create; + bmp.LoadFromStream(AStream, reader); + if reader.LayersLoaded then + begin + bmp.Free; + end else + begin + Clear; + SetSize(bmp.Width,bmp.Height); + AddOwnedLayer(bmp as TBGRABitmap); + LayerName[0] := reader.Caption; + end; + SelectedLayerIndex:= reader.SelectedLayerIndex; + finally + reader.Free; + end; + end; +end; + +procedure TBGRALazPaintImage.LoadFromFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); + OnLayeredBitmapLoadStart(filenameUTF8); + try + LoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + AStream.Free; + end; +end; + +procedure TBGRALazPaintImage.SaveToFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite); + OnLayeredBitmapSaveStart(filenameUTF8); + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + AStream.Free; + end; +end; + +procedure TBGRALazPaintImage.SaveToStream(AStream: TStream); +begin + OnLayeredBitmapSaveToStreamStart; + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + end; +end; + +procedure TBGRALazPaintImage.InternalSaveToStream(AStream: TStream); +var + writer: TBGRAWriterLazPaint; + flat: TBGRACustomBitmap; +begin + if NbLayers = 0 then + raise exception.Create('File cannot be empty'); + + writer := nil; + flat := nil; + try + if (NbLayers > 1) or (LayerOpacity[0] <> 255) or not LayerVisible[0] or (BlendOperation[0]<>boTransparent) + or (OriginalCount <> 0) then + begin + writer := TBGRAWriterLazPaintWithLayers.Create(self); + writer.Caption := 'Preview'; + TBGRAWriterLazPaintWithLayers(writer).SelectedLayerIndex := self.SelectedLayerIndex; + end else + begin + writer := TBGRAWriterLazPaint.Create; + writer.Caption := LayerName[0]; + end; + + writer.IncludeThumbnail:= true; + flat := ComputeFlatImage; + flat.SaveToStream(AStream, writer); + finally + writer.Free; + flat.Free; + end; +end; + +{ TBGRAReaderLazPaintWithLayers } + +procedure TBGRAReaderLazPaintWithLayers.InternalReadLayers(str: TStream; + Img: TFPCustomImage); +begin + if Assigned(FLayers) then + begin + if CheckStreamForLayers(str) then + begin + LoadLayersFromStream(str, FSelectedLayerIndex, false, FLayers, True); + FLayersLoaded := true; + end; + end; +end; + +constructor TBGRAReaderLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap); +begin + FLayersLoaded := false; + FLayers := ALayers; + FSelectedLayerIndex:= -1; +end; + +{ TBGRAWriterLazPaintWithLayers } + +function TBGRAWriterLazPaintWithLayers.GetNbLayers: integer; +begin + if Assigned(FLayers) then + Result:= FLayers.NbLayers + else + Result := 1; +end; + +function TBGRAWriterLazPaintWithLayers.InternalWriteLayers(Str: TStream; + Img: TFPCustomImage): boolean; +begin + If Assigned(FLayers) then + begin + SaveLayersToStream(str, FLayers, FSelectedLayerIndex, FCompression, True); + Result:=true; + end + else result := False; +end; + +constructor TBGRAWriterLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap); +begin + inherited Create; + FLayers := ALayers; + FSelectedLayerIndex:= 0; + FCompression:= lzpRLE; + IncludeThumbnail:= true; +end; + +var AlreadyRegistered: boolean; + +procedure RegisterLazPaintFormat; +begin + if AlreadyRegistered then exit; + RegisterLayeredBitmapReader('lzp', TBGRALazPaintImage); + RegisterLayeredBitmapWriter('lzp', TBGRALazPaintImage); + AlreadyRegistered:= True; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralazresource.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralazresource.pas new file mode 100644 index 0000000..c552b33 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralazresource.pas @@ -0,0 +1,416 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALazResource; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAMultiFileType; + +type + { TLazResourceEntry } + + TLazResourceEntry = class(TMultiFileEntry) + private + procedure Serialize(ADestination: TStream); + protected + FName: utf8string; + FValueType: utf8string; + FContent: TStream; + function GetName: utf8string; override; + procedure SetName(AValue: utf8string); override; + function GetExtension: utf8string; override; + function GetFileSize: int64; override; + public + constructor Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; AContent: TStream); + destructor Destroy; override; + function CopyTo(ADestination: TStream): int64; override; + function GetStream: TStream; override; + end; + + { TFormDataEntry } + + TFormDataEntry = class(TLazResourceEntry) + protected + FTextContent: TStream; + procedure RequireTextContent; + function GetExtension: utf8string; override; + function GetFileSize: int64; override; + public + constructor Create(AContainer: TMultiFileContainer; AName: utf8string; ABinaryContent: TStream); + destructor Destroy; override; + function CopyTo(ADestination: TStream): int64; override; + end; + + { TLazResourceContainer } + + TLazResourceContainer = class(TMultiFileContainer) + protected + function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; + public + procedure LoadFromStream(AStream: TStream); override; + procedure SaveToStream(ADestination: TStream); override; + end; + +implementation + +uses LResources, BGRAUTF8; + +{ TFormDataEntry } + +procedure TFormDataEntry.RequireTextContent; +begin + if FTextContent = nil then + begin + FTextContent:= TMemoryStream.Create; + FContent.Position:= 0; + LRSObjectBinaryToText(FContent, FTextContent); + end; +end; + +function TFormDataEntry.GetExtension: utf8string; +begin + Result:= 'lfm'; +end; + +function TFormDataEntry.GetFileSize: int64; +begin + RequireTextContent; + Result:= FTextContent.Size; +end; + +constructor TFormDataEntry.Create(AContainer: TMultiFileContainer; + AName: utf8string; ABinaryContent: TStream); +begin + inherited Create(AContainer,AName,'FORMDATA',ABinaryContent); +end; + +destructor TFormDataEntry.Destroy; +begin + FreeAndNil(FTextContent); + inherited Destroy; +end; + +function TFormDataEntry.CopyTo(ADestination: TStream): int64; +begin + RequireTextContent; + if FTextContent.Size = 0 then + result := 0 + else + begin + FTextContent.Position:= 0; + result := ADestination.CopyFrom(FTextContent,FTextContent.Size); + end; +end; + +{ TLazResourceEntry } + +procedure TLazResourceEntry.Serialize(ADestination: TStream); +begin + FContent.Position := 0; + BinaryToLazarusResourceCode(FContent, ADestination, Name, FValueType); +end; + +function TLazResourceEntry.GetName: utf8string; +begin + Result:= FName; +end; + +procedure TLazResourceEntry.SetName(AValue: utf8string); +begin + if AValue = FName then exit; + if Container.IndexOf(AVAlue, Extension) <> -1 then + raise Exception.Create('Name is already used for this extension'); + FName := AValue; +end; + +function TLazResourceEntry.GetExtension: utf8string; +begin + Result:= FValueType; +end; + +function TLazResourceEntry.GetFileSize: int64; +begin + Result:= FContent.Size; +end; + +destructor TLazResourceEntry.Destroy; +begin + FreeAndNil(FContent); + inherited Destroy; +end; + +constructor TLazResourceEntry.Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; + AContent: TStream); +begin + inherited Create(AContainer); + FName := AName; + FValueType := UTF8UpperCase(AValueType); + FContent := AContent; +end; + +function TLazResourceEntry.CopyTo(ADestination: TStream): int64; +begin + if FContent.Size = 0 then + result := 0 + else + begin + FContent.Position:= 0; + result := ADestination.CopyFrom(FContent, FContent.Size); + end; +end; + +function TLazResourceEntry.GetStream: TStream; +begin + Result:= FContent; +end; + +{ TLazResourceContainer } + +procedure TLazResourceContainer.LoadFromStream(AStream: TStream); +const + entryStart = 'LazarusResources.Add('; + entryEnd = ');'; + whiteSpace = [' ',#9,#10,#13,#26]; +var + fileContent: String; + filePos : integer; + + procedure SkipWhitespace; + begin + while (filePos <= length(fileContent)) and (fileContent[filePos] in whiteSpace) do inc(filePos); + end; + + procedure SkipComma; + begin + SkipWhitespace; + if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then + inc(filePos) + else + raise Exception.Create('Comma expected'); + end; + + function ParseString(ignoreCommas: boolean): TStream; + var + expectPlus: boolean; + + procedure AppendChar(c: char); + begin + result.WriteByte(ord(c)); + end; + + function ParseNumber: integer; + var numberStart, errPos: integer; + s: String; + begin + numberStart:= filePos; + if (filePos <= length(fileContent)) and (fileContent[filePos] = '$') then + begin + inc(filePos); + while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9','a'..'f','A'..'F']) do inc(filePos); + end else + begin + while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9']) do inc(filePos); + end; + s := copy(fileContent,numberStart,filePos-numberStart); + val(s, result, errPos); + if errPos <> 0 then + raise exception.Create('Invalid number "' + s + '"'); + end; + + function ParseStringPart: boolean; + var charCode: integer; + begin + SkipWhitespace; + if filePos <= length(fileContent) then + begin + if expectPlus then + if fileContent[filePos] <> '+' then + begin + result := false; + expectPlus := false; + exit; + end else + inc(filePos); + + case fileContent[filePos] of + '+': raise exception.Create('Unexpected "+"'); + '''': begin + inc(filePos); + while (filePos <= length(fileContent)) do + begin + if fileContent[filePos] = '''' then + begin + inc(filePos); + if (filePos <= length(fileContent)) and (fileContent[filePos] = '''') then + begin + AppendChar(''''); + inc(filePos); + end + else break; + end else + if fileContent[filePos] in[#10,#13] then + raise Exception.Create('Unexpected end of line') + else + begin + AppendChar(fileContent[filePos]); + inc(filePos); + end; + end; + if (filePos <= length(fileContent)) and (fileContent[filePos] = '#') then + expectPlus := false + else + expectPlus := true; + result := true; + end; + '#': begin + inc(filePos); + charCode := ParseNumber; + if (charCode < 0) or (charCode > 255) then + raise exception.Create('Character code out of bounds'); + AppendChar(chr(charCode)); + if (filePos <= length(fileContent)) and (fileContent[filePos] in['#','''']) then + expectPlus := false + else + expectPlus := true; + result := true; + end; + else + begin + result := false; + expectPlus := false; + end; + end; + end + else + begin + result := false; + expectPlus := false; + end; + end; + + begin + result := TMemoryStream.Create; + expectPlus := false; + if not ParseStringPart then raise exception.Create('Expecting string'); + repeat + if ignoreCommas then + begin + SkipWhitespace; + if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then + begin + inc(filePos); + expectPlus := false; + end; + end; + until not ParseStringPart; + end; + + procedure ReadContent; + var + bytesRead: integer; + begin + setlength(fileContent,AStream.Size-AStream.Position); + bytesRead := AStream.Read(fileContent[1],length(fileContent)); + setlength(fileContent, bytesRead); + filePos := 1; + end; + + function StreamToUTF8String(AStream: TStream): utf8String; + begin + setlength(result, AStream.Size); + AStream.Position := 0; + AStream.Read(result[1], length(result)); + AStream.Free; + end; + +var + entryName: utf8string; + entryType: utf8string; + entryContent: TStream; + inArray: boolean; + +begin + Clear; + ReadContent; + while filePos <= length(fileContent) do + begin + if (upcase(fileContent[filePos]) = upcase(entryStart[1])) and + (CompareText(copy(fileContent,filePos,length(entryStart)),entryStart)=0) then + begin + inc(filePos, length(entryStart)); + entryName := StreamToUTF8String(ParseString(false)); + SkipComma; + entryType := StreamToUTF8String(ParseString(false)); + SkipComma; + + SkipWhitespace; + if (filePos <= length(fileContent)) and (fileContent[filePos] = '[') then + begin + inArray := true; + inc(filePos); + end else + inArray := false; + entryContent := ParseString(inArray); + SkipWhitespace; + if inArray then + begin + if (filePos <= length(fileContent)) and (fileContent[filePos] = ']') then + inc(filePos) + else + raise exception.Create('Expecting "]"'); + end; + + if entryType = 'FORMDATA' then + AddEntry(TFormDataEntry.Create(self,entryName,entryContent)) + else + AddEntry(TLazResourceEntry.Create(self,entryName,entryType,entryContent)); + + if (filePos+length(entryEnd)-1 <= length(fileContent)) and (CompareText(copy(fileContent,filePos,length(entryEnd)),entryEnd)=0) then + inc(filePos,length(entryEnd)) + else + raise exception.Create('Expecting "'+entryEnd+'"'); + end else + if fileContent[filePos] in whiteSpace then + inc(filePos) + else + raise exception.Create('Unexpected character "'+fileContent[filePos]+'"'); + end; +end; + +function TLazResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; + AContent: TStream): TMultiFileEntry; +var + binContent: TMemoryStream; +begin + if UTF8CompareText(AExtension,'lfm')=0 then + begin + binContent := TMemoryStream.Create; + try + AContent.Position:= 0; + LRSObjectTextToBinary(AContent, binContent); + result := TFormDataEntry.Create(self,AName,binContent); + except + on ex:Exception do + begin + binContent.Free; + result := nil; + end; + end; + AContent.Free; + end + else + result := TLazResourceEntry.Create(self,AName,UTF8UpperCase(AExtension),AContent); +end; + +procedure TLazResourceContainer.SaveToStream(ADestination: TStream); +var + i: Integer; +begin + for i := 0 to Count-1 do + TLazResourceEntry(Entry[i]).Serialize(ADestination); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralclbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralclbitmap.pas new file mode 100644 index 0000000..2f8b909 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralclbitmap.pas @@ -0,0 +1,997 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALCLBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, Graphics, GraphType, BGRABitmapTypes, BGRADefaultBitmap; + +type + { TBGRALCLBitmap } + + TBGRALCLBitmap = class(TBGRADefaultBitmap) + protected + function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; + AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; + procedure DoLoadFromBitmap; override; + procedure RebuildBitmap; override; + function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel + ): TBGRAPtrBitmap; override; + procedure AssignRasterImage(ARaster: TRasterImage); virtual; + procedure ExtractXorMask; + public + procedure Assign(Source: TPersistent); override; + procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; override; + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; + procedure LoadFromDevice({%H-}DC: HDC); override; + procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; + procedure TakeScreenshotOfPrimaryMonitor; override; + procedure TakeScreenshot({%H-}ARect: TRect); override; + end; + + { TBGRALCLPtrBitmap } + + TBGRALCLPtrBitmap = class(TBGRAPtrBitmap) + + procedure RebuildBitmap; override; + function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; + function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; + AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean + =True): boolean; override; + public + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + end; + +type + + { TBitmapTracker } + + TBitmapTracker = class(TBitmap) + protected + FUser: TBGRADefaultBitmap; + procedure Changed(Sender: TObject); override; + public + constructor Create(AUser: TBGRADefaultBitmap); overload; + end; + +implementation + +uses BGRAText, LCLType, LCLIntf, FPimage; + +{ TBitmapTracker } + +constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap); +begin + FUser := AUser; + inherited Create; +end; + +procedure TBitmapTracker.Changed(Sender: TObject); +begin + if FUser <> nil then + FUser.NotifyBitmapChange; + inherited Changed(Sender); +end; + +type + TCopyPixelProc = procedure (psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); + +procedure ApplyMask1bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); +var currentBit: byte; +begin + currentBit := 1; + while count > 0 do + begin + if psrc^ and currentBit <> 0 then pdest^.alpha := 0; + inc(pdest); + if currentBit = 128 then + begin + currentBit := 1; + inc(psrc); + end else + currentBit := currentBit shl 1; + dec(count); + end; +end; + +procedure ApplyMask1bitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); +var currentBit: byte; +begin + currentBit := 128; + while count > 0 do + begin + if psrc^ and currentBit <> 0 then pdest^.alpha := 0; + inc(pdest); + if currentBit = 1 then + begin + currentBit := 128; + inc(psrc); + end else + currentBit := currentBit shr 1; + dec(count); + end; +end; + +procedure CopyFromBW_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte); +var currentBit: byte; +begin + currentBit := 1; + while count > 0 do + begin + if psrc^ and currentBit <> 0 then + pdest^ := BGRAWhite + else + pdest^ := BGRABlack; + pdest^.alpha := DefaultOpacity; + inc(pdest); + if currentBit = 128 then + begin + currentBit := 1; + inc(psrc); + end else + currentBit := currentBit shl 1; + dec(count); + end; +end; + +procedure CopyFromBW_SetAlphaBitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte); +var currentBit: byte; +begin + currentBit := 128; + while count > 0 do + begin + if psrc^ and currentBit <> 0 then + pdest^ := BGRAWhite + else + pdest^ := BGRABlack; + pdest^.alpha := DefaultOpacity; + inc(pdest); + if currentBit = 1 then + begin + currentBit := 128; + inc(psrc); + end else + currentBit := currentBit shr 1; + dec(count); + end; +end; + +procedure CopyFrom24Bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +begin + while count > 0 do + begin + PWord(pdest)^ := PWord(psrc)^; + (PByte(pdest)+2)^ := (psrc+2)^; + pdest^.alpha := DefaultOpacity; + inc(psrc,sourcePixelSize); + inc(pdest); + dec(count); + end; +end; + +procedure CopyFrom24Bit_SwapRedBlue(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +begin + while count > 0 do + begin + PByte(pdest)^ := (psrc+2)^; + (PByte(pdest)+1)^ := (psrc+1)^; + (PByte(pdest)+2)^ := psrc^; + pdest^.alpha := DefaultOpacity; + inc(psrc,sourcePixelSize); + inc(pdest); + dec(count); + end; +end; + +procedure CopyFromARGB_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); +begin + while count > 0 do + begin + PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or + ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or + ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or + (PByte(psrc)^ shl TBGRAPixel_AlphaShift); + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; +end; + +procedure CopyFromARGB_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +begin + while count > 0 do + begin + PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or + ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or + ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or + (DefaultOpacity shl TBGRAPixel_AlphaShift); + inc(psrc, sourcePixelSize); + inc(pdest); + dec(count); + end; +end; + +procedure CopyFromARGB_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +const ARGB_ColorMask = {$IFDEF ENDIAN_LITTLE}$FFFFFF00{$ELSE}$00FFFFFF{$ENDIF}; + ARGB_RedShift = {$IFDEF ENDIAN_LITTLE}8{$ELSE}16{$ENDIF}; + ARGB_GreenShift = {$IFDEF ENDIAN_LITTLE}16{$ELSE}8{$ENDIF}; + ARGB_BlueShift = {$IFDEF ENDIAN_LITTLE}24{$ELSE}0{$ENDIF}; +var + sourceval: UInt32or64; + alphaValue: UInt32or64; + OpacityOrMask: UInt32or64; +begin + OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; + while count > 0 do + begin + sourceval := plongword(psrc)^; + alphaValue := {$IFDEF ENDIAN_LITTLE}sourceval and $ff{$ELSE}sourceval shr 24{$ENDIF}; + if (alphaValue = 0) and ((sourceval and ARGB_ColorMask) <> 0) then //if not black but transparent + begin + PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or + (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or + (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or + OpacityOrMask; + end else + begin + PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or + (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or + (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or + (alphaValue shl TBGRAPixel_AlphaShift); + end; + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; +end; + +const + BGRA_AlphaMask = 255 shl TBGRAPixel_AlphaShift; + BGRA_RedMask = 255 shl TBGRAPixel_RedShift; + BGRA_GreenMask = 255 shl TBGRAPixel_GreenShift; + BGRA_BlueMask = 255 shl TBGRAPixel_BlueShift; + BGRA_ColorMask = BGRA_RedMask or BGRA_GreenMask or BGRA_BlueMask; + +procedure CopyFrom32Bit_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); +begin + if sourcePixelSize = 4 then + move(psrc^,pdest^,count*sizeof(TBGRAPixel)) + else + begin + while count > 0 do + begin + PLongWord(pdest)^ := PLongWord(psrc)^; + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; + end; +end; + +procedure CopyFrom32Bit_SwapRedBlue_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); +var srcValue: UInt32or64; +begin + while count > 0 do + begin + srcValue := PLongWord(psrc)^; + PLongWord(pdest)^ := (srcValue and not (BGRA_RedMask or BGRA_BlueMask)) + or (((srcValue and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) + or (((srcValue and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift); + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; +end; + +procedure CopyFrom32Bit_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +var + OpacityOrMask: UInt32or64; +begin + OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; + while count > 0 do + begin + PLongWord(pdest)^ := (PLongWord(psrc)^ and not BGRA_AlphaMask) or OpacityOrMask; + inc(psrc, sourcePixelSize); + inc(pdest); + dec(count); + end; +end; + +procedure CopyFrom32Bit_SwapRedBlue_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +begin + while count > 0 do + begin + pdest^.red := PBGRAPixel(psrc)^.blue; + pdest^.green := PBGRAPixel(psrc)^.green; + pdest^.blue := PBGRAPixel(psrc)^.red; + pdest^.alpha := DefaultOpacity; //use default opacity + inc(psrc, sourcePixelSize); + inc(pdest); + dec(count); + end; +end; + +procedure CopyFrom32Bit_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +var sourceval: UInt32or64; + OpacityOrMask : UInt32or64; +begin + OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; + while count > 0 do + begin + sourceval := plongword(psrc)^; + if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent + plongword(pdest)^ := (sourceval and BGRA_ColorMask) or OpacityOrMask //use default opacity + else + plongword(pdest)^ := plongword(psrc)^; + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; +end; + +procedure CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); +var sourceval: UInt32or64; + OpacityOrMask : UInt32or64; +begin + OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; + while count > 0 do + begin + sourceval := plongword(psrc)^; + if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent + plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) + or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift) + or (sourceval and BGRA_GreenMask) + or OpacityOrMask + else + plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) + or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift) + or (sourceval and (BGRA_GreenMask or BGRA_AlphaMask)); + dec(count); + inc(pdest); + inc(psrc, sourcePixelSize); + end; +end; + +procedure DoCopyProc(ADestination: TBGRACustomBitmap; ACopyProc: TCopyPixelProc; AData: PByte; ABytesPerLine, ABitsPerPixel: integer; ALineOrder: TRawImageLineOrder; ADefaultOpacity: byte); +var + n: integer; + psource_byte, pdest_byte, + psource_first, pdest_first: PByte; + psource_delta, pdest_delta: integer; +begin + if (ALineOrder = ADestination.LineOrder) and + (ABytesPerLine = (ABitsPerPixel shr 3) * LongWord(ADestination.Width)) then + ACopyProc(AData, ADestination.Data, ADestination.NbPixels, ABitsPerPixel shr 3, ADefaultOpacity) + else + begin + if ALineOrder = riloTopToBottom then + begin + psource_first := AData; + psource_delta := ABytesPerLine; + end else + begin + psource_first := AData + (ADestination.Height-1) * ABytesPerLine; + psource_delta := -ABytesPerLine; + end; + + if ADestination.LineOrder = riloTopToBottom then + begin + pdest_first := PByte(ADestination.Data); + pdest_delta := ADestination.Width*sizeof(TBGRAPixel); + end else + begin + pdest_first := PByte(ADestination.Data) + (ADestination.Height-1)*ADestination.Width*sizeof(TBGRAPixel); + pdest_delta := -ADestination.Width*sizeof(TBGRAPixel); + end; + + psource_byte := psource_first; + pdest_byte := pdest_first; + for n := ADestination.Height-1 downto 0 do + begin + ACopyProc(psource_byte, PBGRAPixel(pdest_byte), ADestination.Width, ABitsPerPixel shr 3, ADefaultOpacity); + inc(psource_byte, psource_delta); + inc(pdest_byte, pdest_delta); + end; + end; +end; + +procedure ApplyRawImageMask(ADestination: TBGRACustomBitmap; const ARawImage: TRawImage); +var + copyProc: TCopyPixelProc; +begin + if (ARawImage.Description.MaskBitsPerPixel = 1) and (ARawImage.Mask <> nil) then + begin + if ARawImage.Description.BitOrder = riboBitsInOrder then + copyProc := @ApplyMask1bit + else + copyProc := @ApplyMask1bitRev; + DoCopyProc(ADestination, copyProc, ARawImage.Mask, ARawImage.Description.MaskBytesPerLine, ARawImage.Description.MaskBitsPerPixel, ARawImage.Description.LineOrder, 0); + ADestination.InvalidateBitmap; + end; +end; + +{ Load raw image data. It must be 32bit, 24 bits or 1bit per pixel} +function LoadFromRawImageImplementation(ADestination: TBGRADefaultBitmap; const ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean; +var + mustSwapRedBlue: boolean; + copyProc: TCopyPixelProc; + nbColorChannels: integer; + + function FormatError(message: string): boolean; + begin + if RaiseErrorOnInvalidPixelFormat then + raise Exception.Create('Invalid raw image format. ' + message) + else + result := false; + end; + +begin + if (ARawImage.Description.Width <> LongWord(ADestination.Width)) or + (ARawImage.Description.Height <> LongWord(ADestination.Height)) then + raise Exception.Create('Bitmap size is inconsistent'); + + if (ADestination.Height=0) or (ADestination.Width=0) then + begin + result := true; + exit; + end; + + if ARawImage.Description.BitsPerPixel = 1 then + begin + if ARawImage.Description.BitOrder = riboBitsInOrder then + copyProc := @CopyFromBW_SetAlpha + else + copyProc := @CopyFromBW_SetAlphaBitRev; + DefaultOpacity := 255; + end else + begin + if ((ARawImage.Description.BitsPerPixel and 7) <> 0) then + begin + result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but multiple of 8bit expected'); + exit; + end; + + if (ARawImage.Description.BitsPerPixel < 24) then + begin + result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but at least 24bit expected'); + exit; + end; + + nbColorChannels := 0; + if (ARawImage.Description.RedPrec > 0) then inc(nbColorChannels); + if (ARawImage.Description.GreenPrec > 0) then inc(nbColorChannels); + if (ARawImage.Description.BluePrec > 0) then inc(nbColorChannels); + + if (nbColorChannels < 3) then + begin + result := FormatError('One or more color channel is missing (RGB expected)'); + exit; + end; + + //channels are in ARGB order + if (ARawImage.Description.BitsPerPixel >= 32) and + (ARawImage.Description.AlphaPrec = 8) and + (((ARawImage.Description.AlphaShift = 0) and + (ARawImage.Description.RedShift = 8) and + (ARawImage.Description.GreenShift = 16) and + (ARawImage.Description.BlueShift = 24) and + (ARawImage.Description.ByteOrder = riboLSBFirst)) or + ((ARawImage.Description.AlphaShift = ARawImage.Description.BitsPerPixel - 8) and + (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and + (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and + (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and + (ARawImage.Description.ByteOrder = riboMSBFirst))) then + begin + if AlwaysReplaceAlpha then + copyProc := @CopyFromARGB_SetAlpha + else if DefaultOpacity = 0 then + copyProc := @CopyFromARGB_KeepAlpha + else + copyProc := @CopyFromARGB_ReplaceZeroAlpha; + end + else //channels are in ARGB order but alpha is not used + if (ARawImage.Description.BitsPerPixel >= 32) and + (ARawImage.Description.AlphaPrec = 0) and + (((ARawImage.Description.RedShift = 8) and + (ARawImage.Description.GreenShift = 16) and + (ARawImage.Description.BlueShift = 24) and + (ARawImage.Description.ByteOrder = riboLSBFirst)) or + ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and + (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and + (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and + (ARawImage.Description.ByteOrder = riboMSBFirst))) then + begin + DefaultOpacity := 255; + copyProc := @CopyFromARGB_SetAlpha; + end + else + begin + //channels are in RGB order (alpha channel may follow) + if (ARawImage.Description.BitsPerPixel >= 24) and + (((ARawImage.Description.RedShift = 0) and + (ARawImage.Description.GreenShift = 8) and + (ARawImage.Description.BlueShift = 16) and + (ARawImage.Description.ByteOrder = riboLSBFirst)) or + ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 8) and + (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and + (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 24) and + (ARawImage.Description.ByteOrder = riboMSBFirst))) then + begin + mustSwapRedBlue:= not TBGRAPixel_RGBAOrder; + end + else + //channels are in BGR order (alpha channel may follow) + if (ARawImage.Description.BitsPerPixel >= 24) and + (((ARawImage.Description.BlueShift = 0) and + (ARawImage.Description.GreenShift = 8) and + (ARawImage.Description.RedShift = 16) and + (ARawImage.Description.ByteOrder = riboLSBFirst)) or + ((ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 8) and + (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and + (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 24) and + (ARawImage.Description.ByteOrder = riboMSBFirst))) then + begin + mustSwapRedBlue:= TBGRAPixel_RGBAOrder; + end + else + begin + result := FormatError('BitsPerPixel: ' + IntToStr(ARawImage.Description.BitsPerPixel) + ', ' + + 'RedShit: ' + IntToStr(ARawImage.Description.RedShift) + ', Prec: ' + IntToStr(ARawImage.Description.RedPrec)+ ', ' + + 'GreenShit: ' + IntToStr(ARawImage.Description.GreenShift) + ', Prec: ' + IntToStr(ARawImage.Description.GreenPrec)+ ', ' + + 'BlueShift: ' + IntToStr(ARawImage.Description.BlueShift) + ', Prec: ' + IntToStr(ARawImage.Description.BluePrec)+ ', ' + + 'AlphaShift: ' + IntToStr(ARawImage.Description.AlphaShift) + ', Prec: ' + IntToStr(ARawImage.Description.AlphaPrec) ); + exit; + end; + + if not mustSwapRedBlue then + begin + if ARawImage.Description.BitsPerPixel = 24 then + copyProc := @CopyFrom24Bit + else + if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then + copyProc := @CopyFrom32Bit_SetAlpha + else if DefaultOpacity = 0 then + copyProc := @CopyFrom32Bit_KeepAlpha + else + copyProc := @CopyFrom32Bit_ReplaceZeroAlpha; + end else + begin + if ARawImage.Description.BitsPerPixel = 24 then + copyProc := @CopyFrom24Bit_SwapRedBlue + else + if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then + copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha + else if DefaultOpacity = 0 then + copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha + else + copyProc := @CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha; + end; + end; + end; + + DoCopyProc(ADestination, copyProc, ARawImage.Data, ARawImage.Description.BytesPerLine, ARawImage.Description.BitsPerPixel, ARawImage.Description.LineOrder, DefaultOpacity); + ADestination.InvalidateBitmap; + + ApplyRawImageMask(ADestination, ARawImage); + result := true; +end; + +{ Draw BGRA data to a canvas with transparency } +procedure DataDrawTransparentImplementation(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + Temp: TBitmap; + RawImage: TRawImage; + BitmapHandle, MaskHandle: HBitmap; +begin + RawImage.Init; + RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight); + RawImage.Description.LineOrder := ALineOrder; + RawImage.Data := PByte(AData); + RawImage.DataSize := AWidth * AHeight * sizeof(TBGRAPixel); + if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then + raise FPImageException.Create('Failed to create bitmap handle'); + Temp := TBitmap.Create; + Temp.Handle := BitmapHandle; + Temp.MaskHandle := MaskHandle; + ACanvas.StretchDraw(Rect, Temp); + Temp.Free; +end; + +{ Draw BGRA data to a canvas without transparency } +procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + Temp: TBitmap; + RawImage: TRawImage; + BitmapHandle, MaskHandle: HBitmap; + CreateResult: boolean; + tempShift: byte; +begin + if (AHeight = 0) or (AWidth = 0) then + exit; + + RawImage.Init; + RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth,AHeight); + RawImage.Description.LineOrder := ALineOrder; + RawImage.Description.LineEnd := rileDWordBoundary; + RawImage.Data := PByte(AData); + RawImage.DataSize:= AWidth*AHeight*sizeof(TBGRAPixel); + if TBGRAPixel_RGBAOrder then + begin + tempShift := RawImage.Description.RedShift; + RawImage.Description.RedShift := RawImage.Description.BlueShift; + RawImage.Description.BlueShift := tempShift; + end; + CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False); + + if not CreateResult then + raise FPImageException.Create('Failed to create bitmap handle'); + + Temp := TBitmap.Create; + Temp.Handle := BitmapHandle; + Temp.MaskHandle := MaskHandle; + ACanvas.StretchDraw(Rect, Temp); + Temp.Free; +end; + +procedure GetImageFromCanvasImplementation(ADestination: TBGRADefaultBitmap; CanvasSource: TCanvas; x, y: integer); +var + bmp: TBitmap; + subBmp: TBGRACustomBitmap; + subRect: TRect; + cw,ch: integer; +begin + cw := CanvasSource.Width; + ch := CanvasSource.Height; + if (x < 0) or (y < 0) or (x+ADestination.Width > cw) or + (y+ADestination.Height > ch) then + begin + ADestination.FillTransparent; + if (x+ADestination.Width <= 0) or (y+ADestination.Height <= 0) or + (x >= cw) or (y >= ch) then + exit; + + if (x > 0) then subRect.Left := x else subRect.Left := 0; + if (y > 0) then subRect.Top := y else subRect.Top := 0; + if (x+ADestination.Width > cw) then subRect.Right := cw else + subRect.Right := x+ADestination.Width; + if (y+ADestination.Height > ch) then subRect.Bottom := ch else + subRect.Bottom := y+ADestination.Height; + + subBmp := ADestination.NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top); + subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top); + ADestination.PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet); + subBmp.Free; + exit; + end; + bmp := TBitmap.Create; + bmp.PixelFormat := pf24bit; + bmp.Width := ADestination.Width; + bmp.Height := ADestination.Height; + bmp.Canvas.CopyRect(rect(0, 0, ADestination.Width, ADestination.Height), CanvasSource, + rect(x, y, x + ADestination.Width, y + ADestination.Height)); + LoadFromRawImageImplementation(ADestination, bmp.RawImage, 255, True, False); + bmp.Free; + ADestination.InvalidateBitmap; +end; + +{ TBGRALCLPtrBitmap } + +procedure TBGRALCLPtrBitmap.RebuildBitmap; +var + RawImage: TRawImage; + BitmapHandle, MaskHandle: HBitmap; +begin + if FBitmap <> nil then + FBitmap.Free; + + FBitmap := TBitmapTracker.Create(self); + + if (FWidth > 0) and (FHeight > 0) then + begin + RawImage.Init; + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight) + else + RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight); + {$POP} + RawImage.Description.LineOrder := FLineOrder; + RawImage.Data := FDataByte; + RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel); + if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then + raise FPImageException.Create('Failed to create bitmap handle'); + FBitmap.Handle := BitmapHandle; + FBitmap.MaskHandle := MaskHandle; + end; + + FBitmap.Canvas.AntialiasingMode := amOff; +end; + +function TBGRALCLPtrBitmap.CreatePtrBitmap(AWidth, AHeight: integer; + AData: PBGRAPixel): TBGRAPtrBitmap; +begin + Result:= TBGRALCLPtrBitmap.Create(AWidth,AHeight,AData); +end; + +function TBGRALCLPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := TLCLFontRenderer.Create; +end; + +function TBGRALCLPtrBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +begin + DiscardBitmapChange; + result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat); +end; + +procedure TBGRALCLPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, + y: integer); +begin + DiscardBitmapChange; + GetImageFromCanvasImplementation(self,CanvasSource,x,y); +end; + +procedure TBGRALCLPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); +end; + +procedure TBGRALCLPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); +end; + +function TBGRALCLBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +begin + DiscardBitmapChange; + result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat); +end; + +function TBGRALCLBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := TLCLFontRenderer.Create; +end; + +procedure TBGRALCLBitmap.DoLoadFromBitmap; +begin + if FBitmap <> nil then + begin + LoadFromRawImage(FBitmap.RawImage, FCanvasOpacity); + if FAlphaCorrectionNeeded then DoAlphaCorrection; + end; +end; + +procedure TBGRALCLBitmap.RebuildBitmap; +var + RawImage: TRawImage; + BitmapHandle, MaskHandle: HBitmap; +begin + if FBitmap <> nil then + FBitmap.Free; + + FBitmap := TBitmapTracker.Create(self); + + if (FWidth > 0) and (FHeight > 0) then + begin + RawImage.Init; + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight) + else + RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight); + {$POP} + RawImage.Description.LineOrder := FLineOrder; + RawImage.Data := FDataByte; + RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel); + if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then + raise FPImageException.Create('Failed to create bitmap handle'); + FBitmap.Handle := BitmapHandle; + FBitmap.MaskHandle := MaskHandle; + end; + + FBitmap.Canvas.AntialiasingMode := amOff; +end; + +function TBGRALCLBitmap.CreatePtrBitmap(AWidth, AHeight: integer; + AData: PBGRAPixel): TBGRAPtrBitmap; +begin + Result:= TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData); +end; + +procedure TBGRALCLBitmap.Assign(Source: TPersistent); +begin + if Source is TRasterImage then + begin + AssignRasterImage(TRasterImage(Source)); + end else + inherited Assign(Source); + + if Source is TCursorImage then + begin + HotSpot := TCursorImage(Source).HotSpot; + ExtractXorMask; + end + else if Source is TIcon then + begin + HotSpot := Point(0,0); + ExtractXorMask; + end; +end; + +procedure TBGRALCLBitmap.LoadFromResource(AFilename: string; + AOptions: TBGRALoadingOptions); +var + icon: TCustomIcon; + ext: String; +begin + if BGRAResource.IsWinResource(AFilename) then + begin + ext:= Uppercase(ExtractFileExt(AFilename)); + if (ext = '.ICO') or (ext = '.CUR') then + begin + if ext= '.ICO' then icon := TIcon.Create + else icon := TCursorImage.Create; + try + icon.LoadFromResourceName(HInstance, ChangeFileExt(AFilename,'')); + icon.Current:= icon.GetBestIndexForSize(Size(65536,65536)); + self.AssignRasterImage(icon); + finally + icon.Free; + end; + exit; + end; + end; + + inherited LoadFromResource(AFilename, AOptions); +end; + +procedure TBGRALCLBitmap.AssignRasterImage(ARaster: TRasterImage); +var TempBmp: TBitmap; +begin + DiscardBitmapChange; + SetSize(ARaster.Width, ARaster.Height); + if LoadFromRawImage(ARaster.RawImage,0,False,False) then + begin + If Empty then + begin + AlphaFill(255); // if bitmap seems to be empty, assume + // it is an opaque bitmap without alpha channel + ApplyRawImageMask(self, ARaster.RawImage); + end; + end else + if (ARaster is TBitmap) or (ARaster is TCustomIcon) then + begin //try to convert + TempBmp := TBitmap.Create; + TempBmp.Width := ARaster.Width; + TempBmp.Height := ARaster.Height; + TempBmp.Canvas.Draw(0,0,ARaster); + try + LoadFromRawImage(TempBmp.RawImage,255,False,true); + ApplyRawImageMask(self, ARaster.RawImage); + finally + TempBmp.Free; + end; + end else + raise Exception.Create('Unable to convert image to 24 bit'); +end; + +procedure TBGRALCLBitmap.ExtractXorMask; +var + y, x: Integer; + p: PBGRAPixel; +begin + DiscardXorMask; + for y := 0 to Height-1 do + begin + p := ScanLine[y]; + for x := 0 to Width-1 do + begin + if (p^.alpha = 0) and (PLongWord(p)^<>0) then + begin + NeedXorMask; + XorMask.SetPixel(x,y, p^); + end; + inc(p); + end; + end; +end; + +procedure TBGRALCLBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); +end; + +procedure TBGRALCLBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + DataDrawOpaqueImplementation(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight); +end; + +procedure TBGRALCLBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer + ); +begin + DiscardBitmapChange; + GetImageFromCanvasImplementation(self,CanvasSource,x,y); +end; + +procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC); +var + rawImage: TRawImage; + sourceSize: TPoint; +begin + sourceSize := Point(0,0); + GetDeviceSize(DC, sourceSize); + if (sourceSize.x = 0) or (sourceSize.y = 0) then + begin + SetSize(0,0); + exit; + end; + try + if not RawImage_FromDevice(rawImage, DC, rect(0,0,sourceSize.x,sourceSize.y)) then + raise Exception.Create('Cannot get raw image from device'); + SetSize(rawImage.Description.Width, rawImage.Description.Height); + LoadFromRawImage(rawImage,255); + finally + rawImage.FreeData; + end; +end; + +procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC; ARect: TRect); +var + rawImage: TRawImage; +begin + if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then + begin + SetSize(0,0); + exit; + end; + try + if not RawImage_FromDevice(rawImage, DC, ARect) then + raise Exception.Create('Cannot get raw image from device'); + SetSize(rawImage.Description.Width, rawImage.Description.Height); + LoadFromRawImage(rawImage,255); + finally + rawImage.FreeData; + end; +end; + +procedure TBGRALCLBitmap.TakeScreenshotOfPrimaryMonitor; +var primaryDC: THandle; +begin + primaryDC := LCLIntf.GetDC(0); + LoadFromDevice(primaryDC); + LCLIntf.ReleaseDC(0, primaryDC); +end; + +procedure TBGRALCLBitmap.TakeScreenshot(ARect: TRect); +var primaryDC: THandle; +begin + primaryDC := LCLIntf.GetDC(0); + LoadFromDevice(primaryDC, ARect); + LCLIntf.ReleaseDC(0, primaryDC); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgralzpcommon.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgralzpcommon.pas new file mode 100644 index 0000000..4d991de --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgralzpcommon.pas @@ -0,0 +1,643 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRALzpCommon; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils; + +const + LAZPAINT_COMPRESSION_MODE_ZSTREAM = 1; + LAZPAINT_COMPRESSION_MODE_RLE = 2; + LAZPAINT_COMPRESSION_MASK = 255; + LAZPAINT_THUMBNAIL_PNG = 256; + LAZPAINT_MAGIC_HEADER : array[0..7] of char = 'LazPaint'; + + LazpaintChannelGreenFromRed = 1; + LazpaintChannelBlueFromRed = 2; + LazpaintChannelBlueFromGreen = 4; + LazpaintChannelNoAlpha = 8; + LazpaintPalettedRGB = 16; + + LazPaintThumbMaxWidth = 128; + LazPaintThumbMaxHeight = 128; + +type + TLzpCompression = (lzpZStream, //slower and not necessarily better + lzpRLE); //custom RLE for lzp files + + { TLazPaintImageHeader } + + TLazPaintImageHeader = packed record + magic: packed array[0..7] of char; + zero1, headerSize: LongWord; + width, height, nbLayers, previewOffset: LongWord; + zero2, compressionMode, reserved1, layersOffset: LongWord; + end; + +procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader); + +//routines to compress and uncompress byte-sized values (you need to +//separate the channels to obtain any compression) + +procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream); +function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt; + +implementation + +const //flag to distinguish ranges of opcodes + simpleRepetitionFlag = $00; // $01..$3f: normal repetition + packedRepetitionFlag = $40; // $41..$5f: packed repetition + repetitionOf0Flag = $60; // $60..$6f: repeat 1..16 zeros + repetitionOf255Flag = $70; // $70..$7f: repeat 1..16 values of 255 + simpleDumpFlag = $80; // $81: dump of size as byte+64, $82..$bf: simple dump (2..63) + packedDumpFlag = $c0; // $c3..$df: packed dump (3..31) + packedDumpFromLastFlag= $e0; // $e2..$fe: packed dump from last packed dump value (2..30) + + //special opcodes + wordRepetitionOpCode = $00; //followed by word and then a value to repeat + byteRepetitionOpCode = $40; //followed by byte (add 64 to it to get the repetition count) and then a value to repeat + previousWordSizeRepetitionOpCode = $80; //use the last value of opcode $00 so only followed by value to repeat + previousByteSizeRepetitionOpCode = $c0; //use the last value of opcode $80 so only followed by value to repeat + endOfStreamOpCode = $e0; //end of RLE stream (not necessarily the end of the image) + + //for future use but must not be accepted in the input stream + {%H-}reservedOpCode1 = $c1; + {%H-}reservedOpCode2 = $c2; + {%H-}reservedOpCode3 = $e1; + + {%H-}optionalOpCode = $ff; //for future use but should be ignored if not recognized + + //numeric information + maxNormalRepetition = 63; + maxSmallRepCount = 31 * 4; // sets of four packed repetition + maxDumpCount = 255+32; + + maxRepetition = 65535; // normal: 1..63, byte+64: 64..319, word-sized: 0..65535 + minSmallRep = 1; + maxSmallRep = minSmallRep+3; + + +procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream); +const BufferSize = 4096; +var + buffer: array[0..BufferSize-1] of byte; + bufferPos: integer; + smallRepetitions: array[0..maxSmallRepCount-1] of record + value: Int32or64; + count: Int32or64; //minSmallRep..maxSmallRep + end; + smallRepetitionsCount, smallRepTotal: Int32or64; + previousWordSizeRepetition, previousByteSizeRepetition: Int32or64; + lastPackedDumpValue: Int32or64; + + procedure FlushBuffer; + begin + ADest.WriteBuffer(buffer, BufferSize); + bufferPos := 0; + end; + + procedure WriteByte(b: byte); inline; + begin + buffer[bufferPos] := b; + inc(bufferPos); + if bufferPos = BufferSize then FlushBuffer; + end; + + procedure WriteBytes(p: PByte; ACount: integer); + var + writeCount: Integer; + begin + while bufferPos+ACount >= BufferSize do + begin + writeCount := BufferSize-bufferPos; + move(p^, buffer[bufferPos], writeCount); + inc(p, writeCount); + bufferPos := BufferSize; + dec(ACount, writeCount); + FlushBuffer; + end; + if ACount > 0 then + begin + move(p^, buffer[bufferPos], ACount); + inc(bufferPos, ACount); + end; + end; + + procedure OutputNormalRepetition(AValue,ACount: Int32or64); + begin + If (ACount < 1) or (ACount > maxNormalRepetition) then + raise exception.Create('Invalid count'); + + if (AValue = 0) and (ACount <= 16) then + begin + WriteByte((ACount-1) or repetitionOf0Flag); + end else + if (AValue = 255) and (ACount <= 16) then + begin + WriteByte((ACount-1) or repetitionOf255Flag); + end else + begin + WriteByte(ACount or simpleRepetitionFlag); + WriteByte(AValue); + end; + end; + + procedure FlushSmallRepetitions; + var i,j: Int32or64; + packedCount: Int32or64; + smallOutput: Int32or64; + begin + if smallRepetitionsCount = 0 then exit; + if smallRepetitionsCount >= 4 then + begin + smallOutput:= smallRepetitionsCount and not 3; + WriteByte(packedRepetitionFlag or (smallOutput shr 2)); + packedCount := 0; + for i := 0 to smallOutput-1 do + begin + packedCount := packedCount + ((smallRepetitions[i].count-minSmallRep) shl ((i and 3) shl 1)); + if (i and 3) = 3 then + begin + WriteByte(packedCount); + for j := i-3 to i do + WriteByte(smallRepetitions[j].value); + packedCount:= 0; + end; + end; + for i := smallOutput to smallRepetitionsCount-1 do + OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count); + end else + begin + for i := 0 to smallRepetitionsCount-1 do + OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count); + end; + smallRepetitionsCount := 0; + smallRepTotal := 0; + end; + + procedure OutputRepetition(AValue,ACount: Int32or64; AAccumulate: boolean = true); + begin + if AAccumulate and (ACount >= minSmallRep) and (ACount <= maxSmallRep) and (maxSmallRepCount>0) then + begin + if (smallRepetitionsCount> 0) and (smallRepetitions[smallRepetitionsCount-1].value = AValue) and + (smallRepetitions[smallRepetitionsCount-1].count+ACount <= maxSmallRepCount) then + begin + inc(smallRepetitions[smallRepetitionsCount-1].count, ACount); + exit; + end; + if smallRepetitionsCount = maxSmallRepCount then + FlushSmallRepetitions; + if smallRepetitionsCount and 3 = 0 then smallRepTotal := 0; + smallRepetitions[smallRepetitionsCount].value := AValue; + smallRepetitions[smallRepetitionsCount].count := ACount; + inc(smallRepetitionsCount); + inc(smallRepTotal, ACount); + end else + begin + flushSmallRepetitions; + if ACount <= maxNormalRepetition then + OutputNormalRepetition(AValue,ACount) else + begin + if ACount = previousWordSizeRepetition then + begin + WriteByte(previousWordSizeRepetitionOpCode); + WriteByte(AValue); + end else + if ACount = previousByteSizeRepetition then + begin + WriteByte(previousByteSizeRepetitionOpCode); + WriteByte(AValue); + end else + if ACount <= 64+255 then + begin + WriteByte(byteRepetitionOpCode); + WriteByte(ACount-64); + WriteByte(AValue); + previousByteSizeRepetition := ACount; + end else + if ACount <= 65535 then + begin + WriteByte(wordRepetitionOpCode); + WriteByte(ACount shr 8); + WriteByte(ACount and 255); + WriteByte(AValue); + previousWordSizeRepetition := ACount; + end else + raise exception.Create('Invalid count'); + end; + end; + end; + + procedure DumpNoPack(P: PByte; ACount: Int32or64); + begin + if ACount = 0 then exit; + if ACount = 1 then + begin + OutputNormalRepetition(p^,1); + exit; + end; + If (ACount < 0) or (ACount > maxDumpCount) then + raise exception.Create('Invalid count'); + + if ACount > 63 then + begin + if ACount > 255+64 then + raise exception.Create('Invalid count'); + WriteByte($01 or simpleDumpFlag); + WriteByte(ACount-64); + end else + WriteByte(ACount or simpleDumpFlag); + + WriteBytes(p, ACount); + end; + + procedure DumpPacked(p : PByte; ACount: Int32or64); + var diffLast: integer; + packedValues: array[0..31] of Int32or64; + nbPackedValues, idx: Int32or64; + + begin + if ACount = 0 then exit else + if ACount = 1 then + begin + OutputNormalRepetition(p^,1); + exit; + end else + if ACount = 2 then + begin + DumpNoPack(p, ACount); + exit; + end; + If (ACount < 3) or (ACount > maxDumpCount) then + raise exception.Create('Invalid count'); + + diffLast := p^ - lastPackedDumpValue; + if (diffLast < -7) or (diffLast > 7) then + begin + if ACount > 31 then + begin + DumpPacked(p, 31); + DumpPacked(p+31, ACount-31); + exit; + end; + WriteByte(ACount or packedDumpFlag); + lastPackedDumpValue:= p^; + WriteByte(lastPackedDumpValue); + dec(ACount); + inc(p); + end else + if ACount > 30 then + begin + while ACount > 30 do + begin + DumpPacked(p, 30); + inc(p,30); + dec(ACount,30); + end; + DumpPacked(p, ACount); + exit; + end else + WriteByte(ACount or packedDumpFromLastFlag); + + nbPackedValues := 0; + while ACount >0 do + begin + packedValues[nbPackedValues] := (p^ - lastPackedDumpValue + 8) and 15; + inc(nbPackedValues); + lastPackedDumpValue := p^; + inc(p); + dec(ACount); + end; + + idx := 0; + while idx < nbPackedValues do + begin + if idx+1 = nbPackedValues then + begin + WriteByte(packedValues[idx] shl 4); + break; + end; + WriteByte((packedValues[idx] shl 4) + packedValues[idx+1]); + inc(idx,2); + end; + end; + + procedure Dump(p: PByte; ACount: Int32or64); + const smallestPackedDump = 5; + smallestPackedDumpTail = 3; + var + diffVal,i: Int32or64; + fitPackStart: Int32or64; + p2: PByte; + begin + if ACount >= smallestPackedDump then + begin + p2 := p+1; + fitPackStart := -1; + for i := 1 to ACount-1 do + begin + diffVal := p2^ - (p2-1)^; + if diffVal > 128 then dec(diffVal,256) + else if diffVal < -128 then inc(diffVal,256); + if (diffVal > 7) or (diffVal < -7) then + begin + if (fitPackStart <> -1) and + ((i-fitPackStart+1 >= smallestPackedDump) or + ((i-fitPackStart+1 >= smallestPackedDumpTail) and + (fitPackStart = 1) )) then + begin + DumpNoPack(p, fitPackStart-1); + DumpPacked(p+(fitPackStart-1), i-fitPackStart+1); + Dump(p+i, ACount-i); + exit; + end; + fitPackStart := -1; + end else + if fitPackStart = -1 then fitPackStart := i; + inc(p2); + end; + if (fitPackStart <> -1) and (ACount-fitPackStart+1 >= smallestPackedDumpTail) then + begin + DumpNoPack(p,fitPackStart-1); + DumpPacked(p+(fitPackStart-1), ACount-fitPackStart+1); + exit; + end; + ACount := ACount; + end; + DumpNoPack(p, ACount); + end; + +var + psrc,psrcBefore: PByte; + curValue: Int32or64; + curCount: Int32or64; +begin + if size = 0 then exit; + psrc := @sourceBuffer; + if psrc = nil then + raise exception.Create('Source buffer not provided'); + bufferPos := 0; + curValue := psrc^; + curCount := 1; + inc(psrc); + dec(size); + smallRepetitionsCount := 0; + smallRepTotal := 0; + previousWordSizeRepetition := 0; + previousByteSizeRepetition := 0; + lastPackedDumpValue:= $80; + while size > 0 do + begin + if (psrc^ = curValue) and (curCount < maxRepetition) then + begin + inc(curCount); + dec(size); + inc(psrc); + end else + if (curCount > 1) or (((smallRepetitionsCount and 3) <> 0) and (smallRepTotal >= 5)) then + begin + outputRepetition(curValue,curCount); + curCount := 1; + curValue := psrc^; + dec(size); + inc(psrc); + end else //curCount = 1 + begin + psrcBefore := psrc-1; + inc(psrc); + inc(curCount); + dec(size); + while (curCount < maxDumpCount) and (size>0) and + ( (psrc^ <> (psrc-1)^) or ((size>1) and ((psrc+1)^ <> (psrc-1)^)) ) do //eat doubles too + begin + inc(psrc); + inc(curCount); + dec(size); + if (curCount > 12) and ((psrc-1)^ = (psrc-2)^) and + ((psrc-3)^ = (psrc-4)^) and ((psrc-5)^ = (psrc-6)^) then //three doubles + begin + dec(psrc,6); + dec(curCount,6); + inc(size,6); + break; + end; + end; + if (size > 1) and (psrc^ = (psrc-1)^) and ((psrc+1)^ = psrc^) then //repetition coming + begin + dec(psrc); + dec(curCount); + inc(size); + end; + FlushSmallRepetitions; + if curCount = 1 then OutputRepetition(psrcBefore^,1) else + if curCount > 1 then Dump(psrcBefore, curCount); + if size > 0 then + begin + curValue := psrc^; + curCount := 1; + inc(psrc); + dec(size); + end else + begin + curCount := 0; + break; + end; + end; + end; + if curCount > 0 then OutputRepetition(curValue,curCount); + FlushSmallRepetitions; + WriteByte(endOfStreamOpCode); + FlushBuffer; +end; + +function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt; +const MaxBufferSize = 1024; +var + opCode: Int32or64; + pdest: PByte; + lastRepeatWordSize, lastRepeatByteSize: Int32or64; + lastPackedDumpValue: Int32or64; + + Buffer: packed array of byte; + BufferPos, BufferSize: Int32or64; + BufferStartLocation: Int64; + + procedure OutputOverflow(AWanted: PtrInt; AFunctionName: string); + var position: int64; + begin + position := ASource.Position - BufferSize + BufferPos; + raise exception.Create('Output buffer overflow. Current position is ' + IntToStr(result)+' out of '+ IntToStr(availableOutputSize)+ + ' and '+IntToStr(AWanted)+' is required by '+AFunctionName+'. ' + + 'The absolute input position is '+IntToStr(position)+' which is ' + inttostr(position-BufferStartLocation) + ' from start.'); + end; + + function ReduceAvailableInputSize(AWanted: PtrInt): PtrInt; + begin + if availableInputSize <> -1 then + begin + if AWanted>availableInputSize then + result := availableInputSize + else + result := AWanted; + dec(availableInputSize, result); + end else + result := AWanted; + end; + + function GetByteFromNextBuffer: byte; + begin + if BufferSize = 0 then + result := $e0 + else + begin + BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer))); + BufferPos := 0; + if BufferPos < BufferSize then + begin + result := Buffer[BufferPos]; + inc(BufferPos); + end else + result := $e0; + end; + end; + + function GetNextBufferByte: byte; inline; + begin + if BufferPos < BufferSize then + begin + result := Buffer[BufferPos]; + inc(BufferPos); + end else + result := GetByteFromNextBuffer; + end; + + procedure RepeatValue(AValue: Int32or64; ACount: Int32or64); + begin + if result+ACount > availableOutputSize then OutputOverflow(ACount,'RepeatValue'); + fillchar(pdest^, ACount, AValue); + inc(pdest, ACount); + inc(result, ACount); + end; + + procedure PackedRepeatValues(ACount: Int32or64); + var packedCount: Int32or64; + begin + while ACount > 0 do + begin + packedCount := GetNextBufferByte; + RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); + packedCount:= packedCount shr 2; + RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); + packedCount:= packedCount shr 2; + RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); + packedCount:= packedCount shr 2; + RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); + dec(ACount); + end; + end; + + procedure DumpValues(ACount: Int32or64); + begin + if result+ACount > availableOutputSize then OutputOverflow(ACount, 'DumpValues'); + inc(result, ACount); + while ACount > 0 do + begin + pdest^ := GetNextBufferByte; + inc(pdest); + dec(ACount); + end; + end; + + procedure PackedDumpValues(ACount: Int32or64); + var packedData: Int32or64; + begin + if result+ACount > availableOutputSize then OutputOverflow(ACount, 'PackedDumpValues'); + inc(result, ACount); + while ACount > 0 do + begin + packedData := GetNextBufferByte; + lastPackedDumpValue := (lastPackedDumpValue + (packedData shr 4) - 8) and 255; + pdest^ := lastPackedDumpValue; + if ACount >= 2 then + begin + lastPackedDumpValue := (lastPackedDumpValue + (packedData and 15) - 8) and 255; + (pdest+1)^ := lastPackedDumpValue; + inc(pdest,2); + dec(ACount,2); + end else + begin + inc(pdest); + dec(ACount); + end; + lastPackedDumpValue:= (pdest-1)^; + end; + end; +begin + BufferStartLocation:= ASource.Position; + setLength(Buffer,MaxBufferSize); + BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer))); + BufferPos := 0; + + pdest := @destBuffer; + result := 0; + lastPackedDumpValue:= $80; + try + repeat + opCode := GetNextBufferByte; + case opCode of + wordRepetitionOpCode: begin + lastRepeatWordSize:= GetNextBufferByte shl 8; + inc(lastRepeatWordSize, GetNextBufferByte); + RepeatValue(GetNextBufferByte, lastRepeatWordSize); + end; + previousWordSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatWordSize); + byteRepetitionOpCode: begin + lastRepeatByteSize:= GetNextBufferByte + 64; + RepeatValue(GetNextBufferByte, lastRepeatByteSize); + end; + previousByteSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatByteSize); + + $01..$3f: RepeatValue(GetNextBufferByte, opCode); + $41..$5f: PackedRepeatValues(opCode - $40); + $60..$6f: RepeatValue($00, opCode - $60 + 1); + $70..$7f: RepeatValue($FF, opCode - $70 + 1); + $81: DumpValues(GetNextBufferByte+64); + $82..$bf: DumpValues(opCode - $80); + $c3..$df: begin + lastPackedDumpValue := GetNextBufferByte; + RepeatValue(lastPackedDumpValue, 1); + PackedDumpValues(opCode - $c0 - 1); + end; + $e2..$fe: PackedDumpValues(opCode - $e0); + + reservedOpCode1, reservedOpCode2, reservedOpCode3: raise exception.Create('Unexpected opcode'); + endOfStreamOpCode, optionalOpCode: ; + end; + until opCode = endOfStreamOpCode; + finally + ASource.Position:= ASource.Position-BufferSize+BufferPos; + end; +end; + +{ TLazPaintImageHeader } + +procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader); +begin + with AHeader do + begin + headerSize := LEtoN(headerSize); + width := LEtoN(width); + height := LEtoN(height); + nbLayers := LEtoN(nbLayers); + height := LEtoN(height); + previewOffset := LEtoN(previewOffset); + compressionMode := LEtoN(compressionMode); + layersOffset := LEtoN(layersOffset); + end; +end; + + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramacbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgramacbitmap.pas new file mode 100644 index 0000000..d0a90f3 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramacbitmap.pas @@ -0,0 +1,84 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAMacBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALCLBitmap, BGRAGraphics, BGRABitmapTypes; + +type + + { TBGRAMacBitmap } + + TBGRAMacBitmap = class(TBGRALCLBitmap) + procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + end; + +implementation + +uses LCLType, GraphType, LCLIntf, FPimage; + +procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +type + PARGB = ^TARGB; + TARGB = packed record + alpha,red,green,blue: byte; + end; + +var + Temp: TBitmap; + RawImage: TRawImage; + BitmapHandle, MaskHandle: HBitmap; + CreateResult: boolean; + psrc: PBGRAPixel; + pdest: PARGB; + n: Integer; +begin + if (AHeight = 0) or (AWidth = 0) then + exit; + + RawImage.Init; + RawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth,AHeight); + RawImage.Description.Depth := 24; + RawImage.Description.AlphaPrec := 0; + RawImage.Description.LineOrder := ALineOrder; + RawImage.Description.LineEnd := rileDWordBoundary; + RawImage.CreateData(False); + psrc := PBGRAPixel(AData); + pdest := PARGB(RawImage.Data); + for n := AWidth*AHeight-1 downto 0 do + begin + pdest^.alpha := 255; + pdest^.red := psrc^.red; + pdest^.green := psrc^.green; + pdest^.blue := psrc^.blue; + inc(pdest); + inc(psrc); + end; + CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False); + RawImage.FreeData; + + if not CreateResult then + raise FPImageException.Create('Failed to create bitmap handle'); + + Temp := TBitmap.Create; + Temp.Handle := BitmapHandle; + Temp.MaskHandle := MaskHandle; + ACanvas.StretchDraw(Rect, Temp); + Temp.Free; +end; + +{ TBGRAMacBitmap } + +procedure TBGRAMacBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramatrix3d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgramatrix3d.pas new file mode 100644 index 0000000..f0ddc70 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramatrix3d.pas @@ -0,0 +1,900 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAMatrix3D; + +{$mode objfpc}{$H+} + +{$i bgrasse.inc} + +{$ifdef CPUI386} + {$asmmode intel} +{$ENDIF} +{$ifdef cpux86_64} + {$asmmode intel} +{$ENDIF} + +interface + +uses + BGRABitmapTypes, BGRASSE, + BGRATransform; + +type + TMatrix3D = packed array[1..3,1..4] of single; + TMatrix4D = packed array[1..4,1..4] of single; + TProjection3D = packed record + Zoom, Center: TPointF; + end; + TComputeProjectionFunc = function(AViewCoord: TPoint3D_128): TPointF of object; + +operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D; +operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128; +function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128; +operator*(A,B: TMatrix3D): TMatrix3D; + +function Matrix3D(m11,m12,m13,m14, m21,m22,m23,m24, m31,m32,m33,m34: single): TMatrix3D; overload; +function Matrix3D(vx,vy,vz,ofs: TPoint3D): TMatrix3D; overload; +function Matrix3D(vx,vy,vz,ofs: TPoint3D_128): TMatrix3D; overload; +function MatrixIdentity3D: TMatrix3D; +function MatrixInverse3D(A: TMatrix3D): TMatrix3D; +function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D; +function MatrixScale3D(size: TPoint3D): TMatrix3D; +function MatrixRotateX(angle: single): TMatrix3D; +function MatrixRotateY(angle: single): TMatrix3D; +function MatrixRotateZ(angle: single): TMatrix3D; + +operator *(const A, B: TMatrix4D): TMatrix4D; +function MatrixIdentity4D: TMatrix4D; +function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D; + +{$IFDEF BGRASSE_AVAILABLE} +procedure Matrix3D_SSE_Load(const A: TMatrix3D); +procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +{$ENDIF} + +implementation + +procedure multiplyVect3(const A : TMatrix3D; const vx,vy,vz,vt: single; out outx,outy,outz: single); +begin + outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4]; + outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4]; + outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4]; +end; + +procedure multiplyVect4(const A : TMatrix4D; const vx,vy,vz,vt: single; out outx,outy,outz,outt: single); +begin + outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4]; + outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4]; + outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4]; + outt := vx * A[4,1] + vy * A[4,2] + vz * A[4,3] + vt * A[4,4]; +end; + +operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D; +begin + result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4]; + result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4]; + result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4]; +end; + +operator*(const A, B: TMatrix4D): TMatrix4D; +begin + multiplyVect4(A, B[1,1],B[2,1],B[3,1],B[4,1], result[1,1],result[2,1],result[3,1],result[4,1]); + multiplyVect4(A, B[1,2],B[2,2],B[3,2],B[4,2], result[1,2],result[2,2],result[3,2],result[4,2]); + multiplyVect4(A, B[1,3],B[2,3],B[3,3],B[4,3], result[1,3],result[2,3],result[3,3],result[4,3]); + multiplyVect4(A, B[1,4],B[2,4],B[3,4],B[4,4], result[1,4],result[2,4],result[3,4],result[4,4]); +end; + +function MatrixIdentity4D: TMatrix4D; +begin + result[1,1] := 1; result[2,1] := 0; result[3,1] := 0; result[4,1] := 0; + result[1,2] := 0; result[2,2] := 1; result[3,2] := 0; result[4,2] := 0; + result[1,3] := 0; result[2,3] := 0; result[3,3] := 1; result[4,3] := 0; + result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; +end; + +function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D; +begin + result[1,1] := AValue[1,1]; result[2,1] := AValue[1,2]; result[3,1] := 0; result[4,1] := AValue[1,3]; + result[1,2] := AValue[2,1]; result[2,2] := AValue[2,2]; result[3,2] := 0; result[4,2] := AValue[2,3]; + result[1,3] := 0; result[2,3] := 0; result[3,3] := 1; result[4,3] := 0; + result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; +end; + +{$IFDEF BGRASSE_AVAILABLE} +var SingleConst1 : single = 1; + + procedure Matrix3D_SSE_Load(const A: TMatrix3D); + begin + {$IFDEF cpux86_64} + asm + mov rax, A + movups xmm5, [rax] + movups xmm6, [rax+16] + movups xmm7, [rax+32] + end; + {$ELSE} + asm + mov eax, A + movups xmm5, [eax] + movups xmm6, [eax+16] + movups xmm7, [eax+32] + end; + {$ENDIF} + end; + +procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +var oldMt: single; +begin + oldMt := M.t; + M.t := SingleConst1; + {$IFDEF cpux86_64} + asm + mov rax, M + movaps xmm0, [rax] + + mov rax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [rax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [rax+4], xmm2 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [rax+8], xmm0 + end; + {$ELSE} + asm + mov eax, M + movaps xmm0, [eax] + + mov eax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [eax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [eax+4], xmm2 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [eax+8], xmm0 + end; + {$ENDIF} + M.t := oldMt; + N.t := 0; +end; + +procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); +var oldMt: single; +begin + oldMt := M.t; + M.t := SingleConst1; + {$IFDEF cpux86_64} + asm + mov rax, M + movaps xmm0, [rax] + + mov rax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [rax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [rax+4], xmm2 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [rax+8], xmm0 + end; + {$ELSE} + asm + mov eax, M + movaps xmm0, [eax] + + mov eax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [eax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [eax+4], xmm2 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [eax+8], xmm0 + end; + {$ENDIF} + M.t := oldMt; +end; + +procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned( + var M: TPoint3D_128; out N: TPoint3D_128); +begin + {$IFDEF cpux86_64} + asm + mov rax, M + movaps xmm0, [rax] + + mov rax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [rax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [rax+4], xmm2 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [rax+8], xmm0 + end; + {$ELSE} + asm + mov eax, M + movaps xmm0, [eax] + + mov eax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [eax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + //mix1 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $4e + addps xmm2, xmm3 + //mix2 + movaps xmm3, xmm2 + shufps xmm3, xmm3, $11 + addps xmm2, xmm3 + + movss [eax+4], xmm2 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [eax+8], xmm0 + end; + {$ENDIF} +end; + +procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned( + var M: TPoint3D_128; out N: TPoint3D_128); +begin + {$IFDEF cpux86_64} + asm + mov rax, M + movaps xmm0, [rax] + + mov rax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [rax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [rax+4], xmm2 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [rax+8], xmm0 + end; + {$ELSE} + asm + mov eax, M + movaps xmm0, [eax] + + mov eax, N + + movaps xmm2,xmm0 + mulps xmm2,xmm5 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [eax], xmm2 + + movaps xmm2,xmm0 + mulps xmm2,xmm6 + haddps xmm2,xmm2 + haddps xmm2,xmm2 + movss [eax+4], xmm2 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [eax+8], xmm0 + end; + {$ENDIF} +end; + +{$ENDIF} + +operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128; +{$IFDEF BGRASSE_AVAILABLE}var oldMt: single; + resultAddr: pointer;{$ENDIF} +begin + {$IFDEF BGRASSE_AVAILABLE} + if UseSSE then + begin + oldMt := M.t; + M.t := SingleConst1; + resultAddr := @result; + {$IFDEF cpux86_64} + if UseSSE3 then + asm + mov rax, A + movups xmm5, [rax] + movups xmm6, [rax+16] + movups xmm7, [rax+32] + + mov rax, M + movups xmm0, [rax] + + mov rax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [rax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [rax+4], xmm4 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [rax+8], xmm0 + end else + asm + mov rax, A + movups xmm5, [rax] + movups xmm6, [rax+16] + movups xmm7, [rax+32] + + mov rax, M + movups xmm0, [rax] + + mov rax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [rax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [rax+4], xmm4 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [rax+8], xmm0 + end; + {$ELSE} + if UseSSE3 then + asm + mov eax, A + movups xmm5, [eax] + movups xmm6, [eax+16] + movups xmm7, [eax+32] + + mov eax, M + movups xmm0, [eax] + + mov eax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [eax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [eax+4], xmm4 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [eax+8], xmm0 + end else + asm + mov eax, A + movups xmm5, [eax] + movups xmm6, [eax+16] + movups xmm7, [eax+32] + + mov eax, M + movups xmm0, [eax] + + mov eax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [eax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [eax+4], xmm4 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [eax+8], xmm0 + end; + {$ENDIF} + M.t := oldMt; + result.t := 0; + end else + {$ENDIF} + begin + result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4]; + result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4]; + result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4]; + result.t := 0; + end; +end; + +function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128; +{$IFDEF BGRASSE_AVAILABLE}var resultAddr: pointer;{$ENDIF} +begin + {$IFDEF BGRASSE_AVAILABLE} + if UseSSE then + begin + resultAddr := @result; + {$IFDEF cpux86_64} + if UseSSE3 then + asm + mov rax, A + movups xmm5, [rax] + movups xmm6, [rax+16] + movups xmm7, [rax+32] + + mov rax, M + movups xmm0, [rax] + + mov rax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [rax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [rax+4], xmm4 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [rax+8], xmm0 + end else + asm + mov rax, A + movups xmm5, [rax] + movups xmm6, [rax+16] + movups xmm7, [rax+32] + + mov rax, M + movups xmm0, [rax] + + mov rax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [rax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [rax+4], xmm4 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [rax+8], xmm0 + end; + {$ELSE} + if UseSSE3 then + asm + mov eax, A + movups xmm5, [eax] + movups xmm6, [eax+16] + movups xmm7, [eax+32] + + mov eax, M + movups xmm0, [eax] + + mov eax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [eax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + haddps xmm4,xmm4 + haddps xmm4,xmm4 + movss [eax+4], xmm4 + + mulps xmm0,xmm7 + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [eax+8], xmm0 + end else + asm + mov eax, A + movups xmm5, [eax] + movups xmm6, [eax+16] + movups xmm7, [eax+32] + + mov eax, M + movups xmm0, [eax] + + mov eax, resultAddr + + movaps xmm4,xmm0 + mulps xmm4,xmm5 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [eax], xmm4 + + movaps xmm4,xmm0 + mulps xmm4,xmm6 + //mix1 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $4e + addps xmm4, xmm3 + //mix2 + movaps xmm3, xmm4 + shufps xmm3, xmm3, $11 + addps xmm4, xmm3 + + movss [eax+4], xmm4 + + mulps xmm0,xmm7 + //mix1 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $4e + addps xmm0, xmm3 + //mix2 + movaps xmm3, xmm0 + shufps xmm3, xmm3, $11 + addps xmm0, xmm3 + + movss [eax+8], xmm0 + end; + {$ENDIF} + end else + {$ENDIF} + begin + result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3]; + result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3]; + result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3]; + result.t := 0; + end; +end; + +operator*(A,B: TMatrix3D): TMatrix3D; +begin + multiplyVect3(A, B[1,1],B[2,1],B[3,1],0, result[1,1],result[2,1],result[3,1]); + multiplyVect3(A, B[1,2],B[2,2],B[3,2],0, result[1,2],result[2,2],result[3,2]); + multiplyVect3(A, B[1,3],B[2,3],B[3,3],0, result[1,3],result[2,3],result[3,3]); + multiplyVect3(A, B[1,4],B[2,4],B[3,4],1, result[1,4],result[2,4],result[3,4]); +end; + +function MatrixIdentity3D: TMatrix3D; +begin + result := Matrix3D( 1,0,0,0, + 0,1,0,0, + 0,0,1,0); +end; + +function Matrix3D(m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, + m34: single): TMatrix3D; +begin + result[1,1] := m11; + result[1,2] := m12; + result[1,3] := m13; + result[1,4] := m14; + + result[2,1] := m21; + result[2,2] := m22; + result[2,3] := m23; + result[2,4] := m24; + + result[3,1] := m31; + result[3,2] := m32; + result[3,3] := m33; + result[3,4] := m34; +end; + +function MatrixInverse3D(A: TMatrix3D): TMatrix3D; +var ofs: TPoint3D; +begin + ofs := Point3D(A[1,4],A[2,4],A[3,4]); + + result[1,1] := A[1,1]; + result[1,2] := A[2,1]; + result[1,3] := A[3,1]; + result[1,4] := 0; + + result[2,1] := A[1,2]; + result[2,2] := A[2,2]; + result[2,3] := A[3,2]; + result[2,4] := 0; + + result[3,1] := A[1,3]; + result[3,2] := A[2,3]; + result[3,3] := A[3,3]; + result[3,4] := 0; + + result := result*MatrixTranslation3D(-ofs); +end; + +function Matrix3D(vx, vy, vz, ofs: TPoint3D): TMatrix3D; +begin + result := Matrix3D(vx.x, vy.x, vz.x, ofs.x, + vx.y, vy.y, vz.y, ofs.y, + vx.z, vy.z, vz.z, ofs.z); +end; + +function Matrix3D(vx, vy, vz, ofs: TPoint3D_128): TMatrix3D; +begin + result := Matrix3D(vx.x, vy.x, vz.x, ofs.x, + vx.y, vy.y, vz.y, ofs.y, + vx.z, vy.z, vz.z, ofs.z); +end; + +function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D; +begin + result := Matrix3D(1,0,0,ofs.x, + 0,1,0,ofs.Y, + 0,0,1,ofs.z); +end; + +function MatrixScale3D(size: TPoint3D): TMatrix3D; +begin + result := Matrix3D(size.x,0,0,0, + 0,size.y,0,0, + 0,0,size.z,0); +end; + +function MatrixRotateX(angle: single): TMatrix3D; +begin + result := Matrix3D( 1, 0, 0, 0, + 0, cos(angle), sin(angle), 0, + 0, -sin(angle), cos(angle), 0); +end; + +function MatrixRotateY(angle: single): TMatrix3D; +begin + result := Matrix3D( cos(angle), 0, -sin(angle), 0, + 0, 1, 0, 0, + sin(angle), 0, cos(angle), 0); +end; + +function MatrixRotateZ(angle: single): TMatrix3D; +begin + result := Matrix3D( cos(angle), sin(angle), 0, 0, + -sin(angle), cos(angle), 0, 0, + 0, 0, 1, 0); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramemdirectory.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgramemdirectory.pas new file mode 100644 index 0000000..045b1e3 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramemdirectory.pas @@ -0,0 +1,697 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAMemDirectory; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAMultiFileType, fgl; + +const + MemDirectoryFileHeader = 'TMemDirectory'#26#0#0; + MemDirectoryEntry_FlagDirectory = 1; //entry is a directory + MemDirectoryEntry_FlagCompressed = 2; //the stream is compressed + MemDirectoryEntry_FlagSmallEntryPacked = $8000; //name and size <= 255 + +type + TMemDirectory = class; + TEntryFilename = BGRAMultiFileType.TEntryFilename; + +type + TMemDirectoryPath = specialize TFPGList; + + { TMemDirectoryEntry } + + TMemDirectoryEntry = class(TMultiFileEntry) + private + FStream: TStream; + function GetIsCompressed: boolean; + function GetCompressedSize: int64; + function GetIsDirectory: boolean; + procedure SetIsCompressed(AValue: boolean); + procedure LoadExtraFromEmbeddedStream(ADataStream: TStream; AStartPos: int64); + procedure SaveToEmbeddedStream(AEntryStream, ADataStream: TStream; AStartPos: int64; out uncompressedSize: int64); + protected + FFlags: Word; + FName,FExtension: utf8String; + FUncompressedSize: int64; + FEmbeddedStreamPos: int64; + FMemDirectory: TMemDirectory; + function GetName: utf8string; override; + procedure SetName(AValue: utf8string); override; + function GetFileSize: int64; override; + function GetExtension: utf8string; override; + function InternalCopyTo({%H-}ADestination: TStream): int64; + public + function CopyTo({%H-}ADestination: TStream): int64; override; + function GetStream: TStream; override; + constructor Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AUncompressedStream: TStream; AOwnStream: boolean); overload; + constructor CreateDirectory(AContainer: TMultiFileContainer; AFilename: TEntryFilename); + constructor CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AStream: TStream; AOwnStream: boolean; AUncompressedSize: int64; AFlags: Word); + destructor Destroy; override; + property EmbeddedStreamPos: int64 read FEmbeddedStreamPos write FEmbeddedStreamPos; + property IsCompressed: boolean read GetIsCompressed write SetIsCompressed; + property IsDirectory: boolean read GetIsDirectory; + property CompressedSize: int64 read GetCompressedSize; + property Flags: Word read FFlags; + property MemDirectory: TMemDirectory read FMemDirectory; + end; + + TMemDirectory = class(TMultiFileContainer) + private + FParentDirectory: TMemDirectory; + function GetEntryCompressed(AIndex: integer): boolean; + function GetIsDirectory(AIndex: integer): boolean; + function GetDirectory(AIndex: integer): TMemDirectory; + procedure SetEntryCompressed(AIndex: integer; AValue: boolean); + protected + function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; + function SplitPath(APath: utf8string): TMemDirectoryPath; + public + constructor Create(AParentDirectory: TMemDirectory = nil); + function Equals(Obj: TObject): boolean; override; + procedure LoadFromStream(AStream: TStream); override; + class function CheckHeader(AStream: TStream): boolean; static; + procedure LoadFromEmbeddedStream(ARootStream, ADataStream: TStream; AStartPos: int64); + procedure SaveToStream(ADestination: TStream); override; + procedure SaveToEmbeddedStream(ARootDest, ADataDest: TStream; AStartPos: int64); + function AddDirectory(AName: utf8string; AExtension: utf8string= ''; ACaseSensitive: boolean= true): integer; + function Rename(AName: utf8string; AExtension: utf8string; ANewName: utf8string; ACaseSensitive: boolean= true): boolean; + function FindPath(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectory; + function FindEntry(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectoryEntry; + procedure CopyTo(ADest: TMemDirectory; ARecursive: boolean); + property IsEntryCompressed[AIndex: integer]: boolean read GetEntryCompressed write SetEntryCompressed; + property Directory[AIndex: integer]: TMemDirectory read GetDirectory; + property IsDirectory[AIndex: integer]: boolean read GetIsDirectory; + property ParentDirectory: TMemDirectory read FParentDirectory; + end; + +implementation + +uses zstream, BGRAUTF8, strutils; + +type + TDirEntryRecord = packed record + Flags: Word; + FilenameSize: Word; + Offset: int64; + end; + +{ TMemDirectory } + +function TMemDirectory.GetEntryCompressed(AIndex: integer): boolean; +begin + result := (Entry[AIndex] as TMemDirectoryEntry).IsCompressed; +end; + +function TMemDirectory.GetIsDirectory(AIndex: integer): boolean; +begin + result := (Entry[AIndex] as TMemDirectoryEntry).IsDirectory; +end; + +function TMemDirectory.GetDirectory(AIndex: integer): TMemDirectory; +begin + result := (Entry[AIndex] as TMemDirectoryEntry).MemDirectory; +end; + +procedure TMemDirectory.SetEntryCompressed(AIndex: integer; AValue: boolean); +begin + (Entry[AIndex] as TMemDirectoryEntry).IsCompressed := AValue; +end; + +function TMemDirectory.CreateEntry(AName: utf8string; AExtension: utf8string; + AContent: TStream): TMultiFileEntry; +begin + result := TMemDirectoryEntry.Create(self, EntryFilename(AName, AExtension), AContent, true); +end; + +procedure TMemDirectory.LoadFromStream(AStream: TStream); +var rootPos, rootSize: integer; + header: string; + rootStream: TStream; + startPos: Int64; +begin + startPos := AStream.Position; + setlength(header, length(MemDirectoryFileHeader)); + AStream.ReadBuffer(header[1], length(header)); + if header<>MemDirectoryFileHeader then + raise exception.Create('Invalid header'); + rootPos := LEReadInt64(AStream); + if rootPos = 0 then + raise exception.Create('Invalid root offset'); + rootSize := LEReadInt64(AStream); + if rootSize < 4 then + raise exception.Create('Invalid root size'); + AStream.Position:= rootPos + startPos; + rootStream:= TMemoryStream.Create; + try + rootStream.CopyFrom(AStream, rootSize); + LoadFromEmbeddedStream(rootStream, AStream, startPos); + finally + rootStream.Free; + end; +end; + +class function TMemDirectory.CheckHeader(AStream: TStream): boolean; +var + startPos: Int64; + header: string; +begin + startPos := AStream.Position; + setlength(header, length(MemDirectoryFileHeader)); + AStream.Read(header[1], length(header)); + result := (header=MemDirectoryFileHeader); + AStream.Position:= startPos; +end; + +procedure TMemDirectory.LoadFromEmbeddedStream(ARootStream, ADataStream: TStream; + AStartPos: int64); +var + nbEntries,i: LongInt; + entryRec: TDirEntryRecord; + filename: string; + entryData: TStream; + newEntry: TMemDirectoryEntry; + compressedSize, uncompressedSize: Int64; + +begin + Clear; + ARootStream.Position := 0; + nbEntries := LEReadLongint(ARootStream); + for i := 1 to nbEntries do + begin + ARootStream.ReadBuffer({%H-}entryRec, sizeof(entryRec)); + entryRec.Offset:= LEtoN(entryRec.Offset); + entryRec.Flags:= LEtoN(entryRec.Flags); + entryRec.FilenameSize:= LEtoN(entryRec.FilenameSize); + + if (entryRec.Flags and MemDirectoryEntry_FlagSmallEntryPacked) <> 0 then + begin + entryRec.Flags := entryRec.Flags xor MemDirectoryEntry_FlagSmallEntryPacked; + compressedSize := entryRec.FilenameSize shr 8; + uncompressedSize := compressedSize; + entryRec.FilenameSize := entryRec.FilenameSize and 255; + end else + begin + compressedSize := LEReadInt64(ARootStream); + uncompressedSize := LEReadInt64(ARootStream); + end; + + setlength(filename, entryRec.FilenameSize); + if length(filename)> 0 then + ARootStream.ReadBuffer(filename[1], entryRec.FilenameSize); + + ADataStream.Position:= entryRec.Offset + AStartPos; + entryData := TMemoryStream.Create; + try + if compressedSize <> 0 then + entryData.CopyFrom(ADataStream, compressedSize); + newEntry := TMemDirectoryEntry.CreateFromData(self, EntryFilename(filename), entryData, true, + uncompressedSize, entryRec.Flags); + newEntry.LoadExtraFromEmbeddedStream(ADataStream, AStartPos); + AddEntry(newEntry); + entryData := nil; + finally + entryData.Free; + end; + end; +end; + +procedure TMemDirectory.SaveToStream(ADestination: TStream); +var rootPos,rootSize: integer; + header: string; + rootRecPos, startPos, endPos: int64; + rootStream: TStream; +begin + startPos := ADestination.Position; + header := MemDirectoryFileHeader; + ADestination.WriteBuffer(header[1], length(header)); + + rootRecPos := ADestination.Position; + LEWriteInt64(ADestination,0); //root pos + LEWriteInt64(ADestination,0); //root size + + rootStream := TMemoryStream.Create; + try + SaveToEmbeddedStream(rootStream, ADestination, startPos); + rootStream.Position := 0; + rootPos := ADestination.Position - startPos; + rootSize := rootStream.Size; + ADestination.CopyFrom(rootStream, rootStream.Size); + FreeAndNil(rootStream); + endPos := ADestination.Position; + ADestination.Position := rootRecPos; + LEWriteInt64(ADestination, rootPos); + LEWriteInt64(ADestination, rootSize); + ADestination.Position := endPos; + finally + rootStream.Free; + end; +end; + +procedure TMemDirectory.SaveToEmbeddedStream(ARootDest, ADataDest: TStream; + AStartPos: int64); +var + entryRec: TDirEntryRecord; + entryStream: TMemoryStream; + curEntry: TMemDirectoryEntry; + filename: string; + i: Integer; + uncompressedSize: int64; +begin + LEWriteLongint(ARootDest, Count); + entryStream := TMemoryStream.Create; + try + for i := 0 to Count-1 do + begin + curEntry := Entry[i] as TMemDirectoryEntry; + entryStream.Clear; + curEntry.SaveToEmbeddedStream(entryStream, ADataDest, AStartPos, uncompressedSize); + + entryRec.Offset:= ADataDest.Position - AStartPos; + entryRec.Offset:= NtoLE(entryRec.Offset); + if curEntry.Extension <> '' then + filename := curEntry.Name+'.'+curEntry.Extension + else + filename := curEntry.Name; + + if ((curEntry.Flags and MemDirectoryEntry_FlagCompressed)=0) and + (Length(filename)<=255) and (entryStream.Size<=255) then + begin + entryRec.Flags:= curEntry.Flags or MemDirectoryEntry_FlagSmallEntryPacked; + entryRec.Flags:= NtoLE(entryRec.Flags); + entryRec.FilenameSize:= length(filename) + (entryStream.Size shl 8); + entryRec.FilenameSize := NtoLE(entryRec.FilenameSize); + ARootDest.WriteBuffer(entryRec, sizeof(entryRec)); + end else + begin + entryRec.Flags:= curEntry.Flags; + entryRec.Flags:= NtoLE(entryRec.Flags); + entryRec.FilenameSize:= length(filename); + entryRec.FilenameSize := NtoLE(entryRec.FilenameSize); + ARootDest.WriteBuffer(entryRec, sizeof(entryRec)); + LEWriteInt64(ARootDest, entryStream.Size); + LEWriteInt64(ARootDest, uncompressedSize); + end; + + if filename <> '' then + ARootDest.WriteBuffer(filename[1], length(filename)); + + entryStream.Position:= 0; + ADataDest.CopyFrom(entryStream, entryStream.Size); + end; + finally + entryStream.Free; + end; +end; + +function TMemDirectory.AddDirectory(AName: utf8string; AExtension: utf8string; + ACaseSensitive: boolean): integer; +var + newEntry: TMemDirectoryEntry; +begin + result := IndexOf(AName,AExtension,ACaseSensitive); + if result <> -1 then + begin + if not IsDirectory[result] then + raise exception.Create('There is already a file with this name and extension'); + exit; + end; + newEntry := TMemDirectoryEntry.CreateDirectory(self, EntryFilename(AName, AExtension)); + result := AddEntry(newEntry); +end; + +function TMemDirectory.Rename(AName: utf8string; AExtension: utf8string; + ANewName: utf8string; ACaseSensitive: boolean): boolean; +var + idx, i: Integer; +begin + idx := IndexOf(AName, AExtension, ACaseSensitive); + if idx = -1 then exit(false); + for i := 0 to Count-1 do + if i <> idx then + begin + if Entry[i].CompareNameAndExtension(ANewName,AExtension,ACaseSensitive) = 0 then + raise exception.Create('Name with extension already in use'); + end; + Entry[idx].Name := ANewName; + exit(true); +end; + +function TMemDirectory.FindPath(APath: utf8String; ACaseSensitive: boolean): TMemDirectory; +var + path: TMemDirectoryPath; + idxPath: integer; + idxSub: LongInt; +begin + path := SplitPath(APath); + result := self; + if path.Items[0].IsEmpty then + begin + idxPath := 1; + while Assigned(result.ParentDirectory) do result := result.ParentDirectory; + end + else + idxPath := 0; + + while idxPath < path.Count do + begin + idxSub := result.IndexOf(path[idxPath], ACaseSensitive); + if idxSub= -1 then + begin + result := nil; + break; + end; + result := result.Directory[idxSub]; + inc(idxPath); + end; + + path.Free; +end; + +function TMemDirectory.FindEntry(APath: utf8String; ACaseSensitive: boolean): TMemDirectoryEntry; +var + path: TMemDirectoryPath; + idxPath: integer; + idxSub, idxEntry: LongInt; + curDir: TMemDirectory; +begin + path := SplitPath(APath); + curDir := self; + if path.Items[0].IsEmpty then + begin + idxPath := 1; + while Assigned(curDir.ParentDirectory) do curDir := curDir.ParentDirectory; + end + else + idxPath := 0; + + while idxPath < path.Count-1 do + begin + idxSub := curDir.IndexOf(path[idxPath], ACaseSensitive); + if idxSub= -1 then + begin + curDir := nil; + break; + end; + curDir := curDir.Directory[idxSub]; + inc(idxPath); + end; + + if Assigned(curDir) and (idxPath < path.Count) then + begin + idxEntry := curDir.IndexOf(path[idxPath], ACaseSensitive); + if idxEntry = -1 then + result := nil + else + result := curDir.Entry[idxEntry] as TMemDirectoryEntry; + end + else + result := nil; + + path.Free; +end; + +procedure TMemDirectory.CopyTo(ADest: TMemDirectory; ARecursive: boolean); +var + i, idxDir: Integer; + entryContent: TMemoryStream; +begin + for i := 0 to Count-1 do + if IsDirectory[i] and ARecursive then + begin + idxDir := ADest.AddDirectory(Entry[i].Name,Entry[i].Extension); + Directory[i].CopyTo(ADest.Directory[idxDir], true); + end else + begin + entryContent := TMemoryStream.Create; + Entry[i].CopyTo(entryContent); + ADest.Add(Entry[i].Name,Entry[i].Extension,entryContent,false,true); + end; +end; + +function TMemDirectory.SplitPath(APath: utf8string): TMemDirectoryPath; +var idx,idxSlash: integer; +begin + result := TMemDirectoryPath.Create; + idx := 1; + repeat + idxSlash := PosEx('/',APath,idx); + if idxSlash = 0 then + begin + result.Add(EntryFilename(copy(APath, idx, length(APath)-idx+1))); + break; + end else + begin + result.Add(EntryFilename(copy(APath, idx, idxSlash-idx))); + idx := idxSlash+1; + end; + until false; +end; + +constructor TMemDirectory.Create(AParentDirectory: TMemDirectory); +begin + inherited Create; + FParentDirectory := AParentDirectory; +end; + +function TMemDirectory.Equals(Obj: TObject): boolean; +var + other: TMemDirectory; + i, j: Integer; + data,otherData: TMemoryStream; + different: Boolean; +begin + if Obj = self then exit(true); + if not (Obj is TMemDirectory) then exit(false); + other := TMemDirectory(Obj); + if other.Count <> Count then exit(false); + for i := 0 to Count-1 do + begin + j := other.IndexOf(Entry[i].Name,Entry[i].Extension,true); + if j = -1 then exit(false); + if IsDirectory[i] then + begin + if not other.IsDirectory[j] then exit(false); + if not other.Directory[j].Equals(Directory[i]) then exit(false); + end else + if Entry[i].FileSize <> other.Entry[j].FileSize then exit(false) + else + begin + data := TMemoryStream.Create; + otherData := TMemoryStream.Create; + Entry[i].CopyTo(data); + other.Entry[j].CopyTo(otherData); + different := not CompareMem(data.Memory, otherData.Memory, data.Size); + data.Free; + otherData.Free; + if different then exit(false); + end; + end; + result := true; +end; + +{ TMemDirectoryEntry } + +function TMemDirectoryEntry.GetIsCompressed: boolean; +begin + result := (FFlags and MemDirectoryEntry_FlagCompressed) <> 0; +end; + +function TMemDirectoryEntry.GetCompressedSize: int64; +begin + if not IsDirectory and Assigned(FStream) then + result := FStream.Size + else + result := 0; +end; + +function TMemDirectoryEntry.GetIsDirectory: boolean; +begin + result := (FFlags and MemDirectoryEntry_FlagDirectory) <> 0; +end; + +procedure TMemDirectoryEntry.SetIsCompressed(AValue: boolean); +var compressedStream,decompressed: TMemoryStream; + compression: Tcompressionstream; +begin + if AValue = IsCompressed then exit; + + if Assigned(FStream) then + begin + if AValue then //compress + begin + compressedStream := TMemoryStream.Create; + compression := nil; + try + compression := Tcompressionstream.create(cldefault, compressedStream, true); + FStream.Position := 0; + compression.CopyFrom(FStream,FStream.Size); + FStream.Free; + FStream := compressedStream; + compressedStream := nil; + FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; + finally + compression.Free; + compressedStream.Free; + end; + end else + begin //decompress + decompressed := TMemoryStream.Create; + try + InternalCopyTo(decompressed); + FStream.Free; + FStream := decompressed; + decompressed := nil; + FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; + finally + decompressed.Free; + end; + end; + end else + FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; +end; + +function TMemDirectoryEntry.GetName: utf8string; +begin + result := FName; +end; + +procedure TMemDirectoryEntry.SetName(AValue: utf8string); +begin + while AValue[length(AValue)] = '.' do delete(AValue, length(AValue), 1); + FName := AValue; +end; + +function TMemDirectoryEntry.GetFileSize: int64; +begin + if IsDirectory then + result := 0 + else + Result:= FUncompressedSize; +end; + +function TMemDirectoryEntry.GetExtension: utf8string; +begin + Result:= FExtension; +end; + +function TMemDirectoryEntry.InternalCopyTo(ADestination: TStream): int64; +var + decomp: Tdecompressionstream; +begin + if not Assigned(FStream) then exit(0); + if IsCompressed then + begin + FStream.Position := 0; + decomp := Tdecompressionstream.Create(FStream,true); + try + result := ADestination.CopyFrom(decomp,FUncompressedSize); + finally + decomp.Free; + end; + end else + begin + FStream.Position := 0; + result := ADestination.CopyFrom(FStream, FStream.Size); + end; +end; + +function TMemDirectoryEntry.CopyTo(ADestination: TStream): int64; +begin + if IsDirectory then exit(0); + result := InternalCopyTo(ADestination); +end; + +function TMemDirectoryEntry.GetStream: TStream; +begin + if IsCompressed then + raise exception.Create('Stream cannot be accessed directly because it is compressed') + else + result := FStream; +end; + +constructor TMemDirectoryEntry.Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename; + AUncompressedStream: TStream; AOwnStream: boolean); +begin + CreateFromData(AContainer, AFilename, AUncompressedStream, AOwnStream, AUncompressedStream.Size, 0); +end; + +constructor TMemDirectoryEntry.CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename; + AStream: TStream; AOwnStream: boolean; + AUncompressedSize: int64; AFlags: Word); +begin + inherited Create(AContainer); + Name := AFilename.Name; + FExtension:= AFilename.Extension; + if AOwnStream then + FStream := AStream + else + begin + FStream := TMemoryStream.Create; + AStream.Position:= 0; + FStream.CopyFrom(AStream, AStream.Size); + end; + FUncompressedSize:= AUncompressedSize; + FFlags:= AFlags; + FMemDirectory := nil; +end; + +procedure TMemDirectoryEntry.SaveToEmbeddedStream(AEntryStream, ADataStream: TStream; + AStartPos: int64; out uncompressedSize: int64); +var + entryStartPos: Int64; +begin + if IsDirectory then + begin + if not Assigned(FMemDirectory) then + raise exception.Create('Directory not allocated'); + FreeAndNil(FStream); + IsCompressed:= false; + entryStartPos := AEntryStream.Position; + FMemDirectory.SaveToEmbeddedStream(AEntryStream, ADataStream, AStartPos); + uncompressedSize:= AEntryStream.Position - entryStartPos; + end else + if Assigned(FStream) then + begin + FStream.Position:= 0; + AEntryStream.CopyFrom(FStream, FStream.Size); + uncompressedSize:= FUncompressedSize; + end; +end; + +procedure TMemDirectoryEntry.LoadExtraFromEmbeddedStream(ADataStream: TStream; + AStartPos: int64); +begin + if IsDirectory and Assigned(FStream) then + begin + IsCompressed:= false; + if not Assigned(FMemDirectory) then + FMemDirectory := TMemDirectory.Create(Container as TMemDirectory); + FMemDirectory.LoadFromEmbeddedStream(FStream, ADataStream, AStartPos); + FreeAndNil(FStream); + end; +end; + +constructor TMemDirectoryEntry.CreateDirectory(AContainer: TMultiFileContainer; + AFilename: TEntryFilename); +begin + Name := AFilename.Name; + FExtension:= AFilename.Extension; + FStream := nil; + FUncompressedSize:= 0; + FFlags := MemDirectoryEntry_FlagDirectory; + FContainer := AContainer; + FMemDirectory := TMemDirectory.Create(Container as TMemDirectory); +end; + +destructor TMemDirectoryEntry.Destroy; +begin + FStream.Free; + FMemDirectory.Free; + inherited Destroy; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui.inc new file mode 100644 index 0000000..ad59c8e --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui.inc @@ -0,0 +1,349 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + TColor = msegraphutils.colorty; + +const + clNone = msegraphutils.cl_none; + clDefault = msegraphutils.cl_default; + clBlack = msegraphutils.cl_black; + clWhite = msegraphutils.cl_white; + +function ColorToRGB(c: TColor): TColor; +function clRgbBtnHighlight: TColor; +function clRgbBtnShadow: TColor; +function GetScreenDPIX: integer; +function GetScreenDPIY: integer; + +type + {* How to draw the end of line } + TPenEndCap = msegraphics.capstylety; + +const + {** Draw a half-disk at the end of the line. The diameter of the disk is + equal to the pen width. } + pecRound = msegraphics.cs_round; + {** Draw a half-square. The size of the square is equal to the pen width. + This is visually equivalent to extend the line of half the pen width } + pecSquare = msegraphics.cs_projecting; + {** The line ends exactly at the end point } + pecFlat = msegraphics.cs_butt; + +type + {* How to join segments. This makes sense only for geometric pens (that + have a certain width) } + TPenJoinStyle = msegraphics.joinstylety; + +const + {** Segments are joined by filling the gap with an arc } + pjsRound = msegraphics.js_round; + {** Segments are joind by filling the gap with an intermediary segment } + pjsBevel = msegraphics.js_bevel; + {** Segments are joined by extending them up to their intersection. + There is a miter limit so that if the intersection is too far, + an intermediary segment is used } + pjsMiter = msegraphics.js_miter; + +type + {* Style to use for the pen. The unit for the pattern is the width of the + line } + TPenStyle = msegraphics.dashesstringty; + TPenMode = msegraphics.rasteropty; + +const + {** Pen is continuous } + psSolid = TPenStyle(''); + {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit } + psDash = TPenStyle(#3#1); + {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit } + psDot = TPenStyle(#1#1); + {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 } + psDashDot = TPenStyle(#3#1#1#1); + {** Dash of length 3, and two dots of length 1 } + psDashDotDot = TPenStyle(#3#1#1#1#1#1); + + //the following are not directly compatible with mseGUI + {** Pen is not drawn } + psClear = TPenStyle(#0#0); + {** Custom pattern used } + psPattern = TPenStyle(#0#0#0#0); + + pmBlack = msegraphics.rop_clear; + pmWhite = msegraphics.rop_set; + pmNop = msegraphics.rop_nop; + pmNot = msegraphics.rop_not; + pmCopy = msegraphics.rop_copy; + pmNotCopy = msegraphics.rop_notcopy; + pmMergePenNot = msegraphics.rop_notor; + pmMaskPenNot = msegraphics.rop_notand; + pmMergeNotPen = msegraphics.rop_ornot; + pmMaskNotPen = msegraphics.rop_andnot; + pmMerge = msegraphics.rop_or; + pmNotMerge = msegraphics.rop_nor; + pmMask = msegraphics.rop_and; + pmNotMask = msegraphics.rop_nand; + pmXor = msegraphics.rop_xor; + pmNotXor = msegraphics.rop_notxor; + +type + TPen = class + private + FColor: TColor; + FMode: TPenMode; + FEndCap: TPenEndCap; + FJoinStyle: TPenJoinStyle; + FStyle: TPenStyle; + FWidth: integer; + public + constructor Create; + {** Color of the pen } + property Color: TColor read FColor write FColor; + {** Operation done on pixels } + property Mode: TPenMode read FMode write FMode; + {** End cap of the pen: how to draw the ends of the lines } + property EndCap: TPenEndCap read FEndCap write FEndCap; + {** Join style: how to join the segments of a polyline } + property JoinStyle: TPenJoinStyle read FJoinStyle write FJoinStyle; + {** Pen style: solid, dash, dot... } + property Style : TPenStyle read FStyle write FStyle; + {** Pen width in pixels } + property Width : Integer read FWidth write FWidth; + end; + + TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal, + bsBDiagonal, bsCross, bsDiagCross, bsImage, bsPattern); + +type + { TBrush } + {* A class describing a brush } + TBrush = class + private + FColor: TColor; + FStyle: TBrushStyle; + public + constructor Create; + {** Color of the brush } + property Color: TColor read FColor write FColor; + {** Style of the brush: solid, diagonal lines, horizontal lines... } + property Style: TBrushStyle read FStyle write FStyle; + end; + +type + {$DEFINE TCanvas} + TCanvas = msegraphics.tcanvas; + {$DEFINE TBitmap} + TBitmap = msebitmap.tbitmap; + TRawImage = TBitmap; + TFont = msegraphics.tfont; + {$DEFINE TFontStyle} + TFontStyle = msegraphutils.fontstylety; + TFontStyles = msegraphutils.fontstylesty; + + TBitmapHelper = class helper for TBitmap + private + function GetTransparent: boolean; + function GetTransparentMode: TTransparentMode; + function GetTransparentColor: TColor; + public + class function Create: TBitmap; overload; + property Transparent: boolean read GetTransparent; + property TransparentMode: TTransparentMode read GetTransparentMode; + property TransparentColor: TColor read GetTransparentColor; + end; + + TCanvasHelper = class helper for TCanvas + procedure Draw(X,Y: integer; AGraphic: TGraphic); overload; + procedure StretchDraw(ARect: TRect; AGraphic: TGraphic); overload; + procedure Draw(X,Y: integer; ABitmap: TBitmap); overload; + procedure StretchDraw(ARect: TRect; ABitmap: TBitmap); overload; + end; + + {$DEFINE TFontQuality} + TFontQuality = (fqDefault, fqNonAntialiased, fqAntialiased, fqCleartype); + + TFontHelper = class helper for TFont + private + function GetOrientation: integer; + procedure SetOrientation(AOrientation: integer); + function GetFontQuality: TFontQuality; + procedure SetFontQuality(AQuality: TFontQuality); + function GetHeightHelper: integer; + procedure SetHeightHelper(AHeight: integer); + public + property Orientation: integer read GetOrientation write SetOrientation; + property Quality: TFontQuality read GetFontQuality write SetFontQuality; + property Height: integer read GetHeightHelper write SetHeightHelper; + end; + +const + fsBold = msegraphutils.fs_bold; + fsItalic = msegraphutils.fs_italic; + fsUnderline = msegraphutils.fs_underline; + fsStrikeOut = msegraphutils.fs_strikeout; + +operator :=(AClassesPoint: TClassesPoint): TPoint; +operator :=(AMSERect: TMSERect): TRect; +operator :=(ARect: TRect): TMSERect; +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +function ColorToRGB(c: TColor): TColor; +var triple: rgbtriplety; +begin + triple := msegraphics.colortorgb(c); + result := msegraphics.rgbtocolor(triple.red, triple.green, triple.blue); +end; + +function clRgbBtnHighlight: TColor; +begin + result := ColorToRGB(msegraphutils.cl_highlight); +end; + +function clRgbBtnShadow: TColor; +begin + result := ColorToRGB(msegraphutils.cl_shadow); +end; + +function GetScreenDPIX: integer; +begin + result := 96; +end; + +function GetScreenDPIY: integer; +begin + result := 96; +end; + +{ TPen } + +constructor TPen.Create; +begin + inherited Create; + Mode := pmCopy; + Style := psSolid; + Width := 1; + Color := cl_black; + EndCap:= pecRound; + JoinStyle:= pjsRound; +end; + +{ TBrush } + +constructor TBrush.Create; +begin + Color := cl_white; + Style := bsSolid; +end; + +operator :=(AClassesPoint: TClassesPoint): TPoint; +begin + result.x := AClassesPoint.X; + result.y := AClassesPoint.Y; +end; + +operator :=(AMSERect: TMSERect): TRect; +begin + result.Left := AMSERect.x; + result.Top := AMSERect.y; + result.Right:= AMSERect.x + AMSERect.cx; + result.Bottom:= AMSERect.y + AMSERect.cy; +end; + +operator :=(ARect: TRect): TMSERect; +begin + result.x := ARect.Left; + result.y := ARect.Top; + result.cx := ARect.Right - ARect.Left; + result.cy := ARect.Bottom - ARect.Top; +end; + +class function TBitmapHelper.Create: TBitmap; +begin + result := TBitmap.Create(bmk_rgb); +end; + +function TBitmapHelper.GetTransparent: boolean; +begin + result := TransparentColor <> clNone; +end; + +function TBitmapHelper.GetTransparentMode: TTransparentMode; +begin + if TMaskedBitmap(self).TransparentColor = clDefault then + result := tmAuto + else + result := tmFixed; +end; + +function TBitmapHelper.GetTransparentColor: TColor; +begin + if self is TMaskedBitmap then + result := TMaskedBitmap(self).TransparentColor + else result := clNone; +end; + +procedure TCanvasHelper.Draw(X,Y: integer; ABitmap: TBitmap); +begin + ABitmap.Paint(Self, Point(X,Y)); +End; + +procedure TCanvasHelper.StretchDraw(ARect: TRect; ABitmap: TBitmap); +begin + ABitmap.Paint(Self, ARect); +End; + +procedure TCanvasHelper.Draw(X,Y: integer; AGraphic: TGraphic); +begin + AGraphic.Draw(self, rect(x,y,x+AGraphic.Width,y+AGraphic.Height)); +End; + +procedure TCanvasHelper.StretchDraw(ARect: TRect; AGraphic: TGraphic); +begin + AGraphic.Draw(self, ARect); +End; + +function TFontHelper.GetOrientation: integer; +begin + result := 0; +end; + +procedure TFontHelper.SetOrientation(AOrientation: integer); +begin + if AOrientation <> 0 then + raise exception.Create('Only orientation 0 allowed at font level'); +end; + +function TFontHelper.GetFontQuality: TFontQuality; +begin + if foo_antialiased2 in options then result := fqClearType else + if foo_antialiased in options then result := fqAntialiased else + if foo_nonantialiased in options then result := fqNonAntialiased else + result := fqDefault; +end; + +procedure TFontHelper.SetFontQuality(AQuality: TFontQuality); +begin + options := options - [foo_nonantialiased, foo_antialiased, foo_antialiased2]; + case AQuality of + fqNonAntialiased: options := options + [foo_nonantialiased]; + fqAntialiased: options := options + [foo_antialiased]; + fqClearType: options := options + [foo_antialiased2]; + end; +end; + +function TFontHelper.GetHeightHelper: integer; +begin + result := round(inherited Height * 1.5); +end; + +procedure TFontHelper.SetHeightHelper(AHeight: integer); +begin + if AHeight < 0 then + inherited Height := -AHeight + else + inherited Height := round(AHeight/1.5); +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_text.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_text.inc new file mode 100644 index 0000000..d39fde7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_text.inc @@ -0,0 +1,80 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); +var sUTF16: UnicodeString; +begin + sUTF16 := UTF8ToUTF16(AText); + inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1); + ABitmap.Canvas.DrawString(sUTF16, ACoord); +end; + +procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); +var sUTF16: UnicodeString; + angleRad: single; + ofs, center: TPointF; +begin + angleRad := AOrientation*Pi/1800; + ofs := PointF(ACoord.X, ACoord.Y) + + PointF(sin(angleRad), cos(angleRad))*(ABitmap.Canvas.Font.GlyphHeight-1); + sUTF16 := UTF8ToUTF16(AText); + center := PointF(ABitmap.Canvas.GetStringWidth(sUTF16)/2, + ABitmap.Canvas.Font.Height/2); + ABitmap.Canvas.DrawString(sUTF16, Point(round(ofs.X), round(ofs.Y)), + nil, false, angleRad); +end; + +procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; + AText: string; const AStyle: TTextStyle); +var sUTF16: UnicodeString; +begin + sUTF16 := UTF8ToUTF16(AText); + case AStyle.Alignment of + taRightJustify: ACoord.X := ARect.Right - ABitmap.Canvas.GetStringWidth(sUTF16); + taCenter: ACoord.X := ARect.Left + (ARect.Width - ABitmap.Canvas.GetStringWidth(sUTF16)) div 2; + end; + case AStyle.Layout of + tlBottom: ACoord.Y := ARect.Bottom - ABitmap.Canvas.Font.Height; + tlCenter: ACoord.Y := ARect.Top + (ARect.Height - ABitmap.Canvas.Font.Height) div 2; + end; + inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1); + ABitmap.Canvas.DrawString(sUTF16, ACoord); +end; + +function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; +var sUTF16: UnicodeString; +begin + sUTF16 := UTF8ToUTF16(AText); + result := Size(ABitmap.Canvas.GetStringWidth(sUTF16), ABitmap.Canvas.Font.Height); +end; + +function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; +begin + result := BitmapTextExtent(ABitmap, AText); +end; + +function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; +var + bytePos, charLen: integer; + sUTF16: UnicodeString; +begin + result := 0; + bytePos := 1; + while bytePos <= length(AText) do + begin + charLen := UTF8CharacterLength(@AText[bytePos]); + sUTF16 := UTF8ToUTF16(copy(AText, 1, bytePos+charLen-1)); + if ABitmap.Canvas.GetStringWidth(sUTF16) > AMaxWidth then break; + inc(result); + inc(bytePos,charLen); + end; +end; + +function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; + AMaxWidth: integer; AOrientation: integer): integer; +begin + result := BitmapTextFitInfo(ABitmap, AText, AMaxWidth); +end; + +procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); +begin + ABitmap.Canvas.FillRect(ARect, AColor); +end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_uses.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_uses.inc new file mode 100644 index 0000000..c54e7af --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_uses.inc @@ -0,0 +1 @@ +uses BGRAClasses, FPimage, msegraphics, msegraphutils, msebitmap; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramseguibitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgramseguibitmap.pas new file mode 100644 index 0000000..06394f0 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramseguibitmap.pas @@ -0,0 +1,255 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAMSEguiBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, + BGRAText, msebitmap; + +type + + { TBGRAMSEguiBitmap } + + TBGRAMSEguiBitmap = class(TBGRADefaultBitmap) + protected + procedure CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap); + procedure RebuildBitmap; override; + procedure DoLoadFromBitmap; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; + function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; + {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean + =True): boolean; override; + procedure FreeBitmap; override; + procedure NotAvailable; + procedure InternalAssignBitmapPixels(ASource: TBitmap); + function GetCanvas: TCanvas; override; + public + procedure Assign(ASource: TPersistent); override; + destructor Destroy; override; + procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available + procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; + procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; + procedure TakeScreenshot({%H-}ARect: TRect); override; //not available + procedure TakeScreenshotOfPrimaryMonitor; override; //not available + procedure LoadFromDevice({%H-}DC: HDC); override; //not available + procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available + end; + +type + { TBitmapTracker } + + TBitmapTracker = class(TMaskedBitmap) + protected + FUser: TBGRADefaultBitmap; + procedure DoChange; override; + public + constructor Create(AUser: TBGRADefaultBitmap); overload; + end; + +implementation + +uses msegraphics, msegraphutils, math; + +{ TBitmapTracker } + +constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap); +begin + FUser := AUser; + inherited Create(bmk_rgb); +end; + +procedure TBitmapTracker.DoChange; +begin + if FUser <> nil then + FUser.NotifyBitmapChange; + inherited DoChange; +end; + +{ TBGRAMSEguiBitmap } + +procedure TBGRAMSEguiBitmap.CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap); +var + ppix: PLongword; + pbmp: PLongword; + pmask: PByte; + x,y,yBmp : integer; + setMask: boolean; +begin + ABitmap.Size := Size(AWidth, AHeight); + ppix := AData; + pmask := nil; + if ABitmap is TMaskedBitmap then + begin + setMask := true; + TMaskedBitmap(ABitmap).Masked := true; + TMaskedBitmap(ABitmap).MaskKind := bmk_gray; + end else + setMask := false; + for y := 0 to Height-1 do + begin + if ALineOrder = riloTopToBottom then + yBmp := y else yBmp := Height-1-y; + pbmp := ABitmap.Scanline[yBmp]; + if setMask then pmask := TMaskedBitmap(ABitmap).Mask.Scanline[yBmp]; + for x := 0 to Width-1 do + begin + pbmp^ := ppix^ and $ffffff; + if setMask then + begin + pmask^ := ppix^ shr 24; + inc(pmask); + end; + inc(ppix); + inc(pbmp); + end; + end; +end; + +procedure TBGRAMSEguiBitmap.RebuildBitmap; +begin + if FBitmap = nil then + FBitmap := TBitmapTracker.Create(self); + + CopyDataToBitmap(Data, Width, Height, LineOrder, FBitmap); +end; + +procedure TBGRAMSEguiBitmap.InternalAssignBitmapPixels(ASource: TBitmap); +var + ppix,pbmp: PLongword; + pmask: PByte; + getMask: boolean; + x,y,wm1: integer; +begin + if ASource is TMaskedBitmap then + getMask := TMaskedBitmap(ASource).Masked + else getMask := false; + wm1 := min(Width-1, ASource.Width-1); + for y := 0 to min(Height-1, ASource.Height-1) do + begin + ppix := plongword(GetScanlineFast(y)); + pbmp := ASource.Scanline[y]; + if getMask then pmask := TMaskedBitmap(ASource).Mask.Scanline[y]; + for x := 0 to wm1 do + begin + if getMask then + begin + ppix^ := (pbmp^ and $ffffff) or (pmask^ shl 24); + inc(pmask); + end else + ppix^ := (pbmp^ and $ffffff) or $ff000000; + inc(ppix); + inc(pbmp); + end; + end; +end; + +function TBGRAMSEguiBitmap.GetCanvas: TCanvas; +begin + result := inherited GetCanvas; + NotifyBitmapChange; +end; + +procedure TBGRAMSEguiBitmap.Assign(ASource: TPersistent); +var bmp: TBitmap; +begin + if ASource is TBitmap then + begin + bmp := TBitmap(ASource); + SetSize(bmp.Width, bmp.Height); + InternalAssignBitmapPixels(bmp); + InvalidateBitmap; + end else + inherited Assign(ASource); +end; + +procedure TBGRAMSEguiBitmap.DoLoadFromBitmap; +begin + if Assigned(FBitmap) then + InternalAssignBitmapPixels(FBitmap); +end; + +function TBGRAMSEguiBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := TMSEFontRenderer.Create; +end; + +function TBGRAMSEguiBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +begin + self.Assign(ARawImage); + result := true; +end; + +procedure TBGRAMSEguiBitmap.FreeBitmap; +begin + FreeAndNil(FBitmap); +end; + +procedure TBGRAMSEguiBitmap.NotAvailable; +begin + raise exception.Create('Function not available with MSEgui'); +end; + +destructor TBGRAMSEguiBitmap.Destroy; +begin + inherited Destroy; +end; + +procedure TBGRAMSEguiBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, + y: integer); +begin + (Bitmap as TMaskedBitmap).Masked := false; + Bitmap.Canvas.CopyArea(CanvasSource, MakeRect(x,y,Bitmap.Width,Bitmap.Height), + Point(0,0)); +end; + +procedure TBGRAMSEguiBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + bmp: TMaskedBitmap; +begin + bmp := TMaskedBitmap.Create(bmk_rgb); + CopyDataToBitmap(Data, Width, Height, ALineOrder, bmp); + bmp.Paint(ACanvas, Rect); + bmp.Free; +end; + +procedure TBGRAMSEguiBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + bmp: TBitmap; +begin + bmp := TBitmap.Create(bmk_rgb); + CopyDataToBitmap(AData, AWidth, AHeight, ALineOrder, bmp); + bmp.Paint(ACanvas, Rect); + bmp.Free; +end; + +procedure TBGRAMSEguiBitmap.TakeScreenshot(ARect: TRect); +begin + NotAvailable; +end; + +procedure TBGRAMSEguiBitmap.TakeScreenshotOfPrimaryMonitor; +begin + NotAvailable; +end; + +procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC); +begin + NotAvailable; +end; + +procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC; ARect: TRect); +begin + NotAvailable; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgramultifiletype.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgramultifiletype.pas new file mode 100644 index 0000000..faa5cb2 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgramultifiletype.pas @@ -0,0 +1,500 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAMultiFileType; + +{$mode objfpc}{$H+} +{$MODESWITCH ADVANCEDRECORDS} + +interface + +uses + BGRAClasses, SysUtils, fgl; + +type + + { TEntryFilename } + + TEntryFilename = record + private + FExtension: utf8string; + FName: utf8string; + function GetFilename: utf8string; + function GetIsEmpty: boolean; + procedure SetExtension(AValue: utf8string); + procedure SetFilename(AValue: utf8string); + procedure SetName(AValue: utf8string); + public + class operator =(const AValue1,AValue2: TEntryFilename): boolean; + property Filename: utf8string read GetFilename write SetFilename; + property Name: utf8string read FName write SetName; + property Extension: utf8string read FExtension write SetExtension; + property IsEmpty: boolean read GetIsEmpty; + end; + +function EntryFilename(AName,AExtension: string): TEntryFilename; overload; +function EntryFilename(AFilename: string): TEntryFilename; overload; + +type + TMultiFileContainer = class; + + { TMultiFileEntry } + + TMultiFileEntry = class + protected + FContainer: TMultiFileContainer; + function GetName: utf8string; virtual; abstract; + procedure SetName(AValue: utf8string); virtual; abstract; + function GetFileSize: int64; virtual; + function GetExtension: utf8string; virtual; + public + constructor Create(AContainer: TMultiFileContainer); + function CopyTo({%H-}ADestination: TStream): int64; virtual; + function GetStream: TStream; virtual; + function CompareNameAndExtension(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = true): integer; + property Name: utf8string read GetName write SetName; + property Extension: utf8string read GetExtension; + property FileSize: int64 read GetFileSize; + property Container: TMultiFileContainer read FContainer; + end; + + TMultiFileEntryList = specialize TFPGList; + + { TMultiFileContainer } + + TMultiFileContainer = class(TPersistent) + private + FEntries: TMultiFileEntryList; + protected + procedure Init; virtual; + function AddEntry(AEntry: TMultiFileEntry; AIndex: integer = -1): integer; + function GetCount: integer; + function GetEntry(AIndex: integer): TMultiFileEntry; + function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; virtual; abstract; + function GetRawString(AIndex: integer): RawByteString; + function GetRawStringByFilename(AFilename: string): RawByteString; + procedure SetRawString(AIndex: integer; AValue: RawByteString); + procedure SetRawStringByFilename(AFilename: string; AValue: RawByteString); + public + constructor Create; overload; + constructor Create(AFilename: utf8string); overload; + constructor Create(AStream: TStream); overload; + constructor Create(AStream: TStream; AStartPos: Int64); overload; + procedure Assign(Source: TPersistent); override; + function Add(AName: utf8string; AExtension: utf8string; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; + function Add(AName: utf8string; AExtension: utf8string; AContent: RawByteString; AOverwrite: boolean = false): integer; overload; + function Add(AFilename: TEntryFilename; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; + function Add(AFilename: TEntryFilename; AContent: RawByteString; AOverwrite: boolean = false): integer; overload; + procedure Clear; virtual; + destructor Destroy; override; + procedure LoadFromFile(AFilename: utf8string); + procedure LoadFromStream(AStream: TStream); virtual; abstract; + procedure LoadFromResource(AFilename: string); virtual; + procedure SaveToFile(AFilename: utf8string); + procedure SaveToStream(ADestination: TStream); virtual; abstract; + procedure Remove(AEntry: TMultiFileEntry); virtual; + procedure Delete(AIndex: integer); overload; virtual; + function Delete(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = True): boolean; overload; + function Delete(AFilename: TEntryFilename; ACaseSensitive: boolean = True): boolean; overload; + function IndexOf(AEntry: TMultiFileEntry): integer; overload; + function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; overload; virtual; + function IndexOf(AFilename: TEntryFilename; ACaseSensitive: boolean = True): integer; overload; + property Count: integer read GetCount; + property Entry[AIndex: integer]: TMultiFileEntry read GetEntry; + property RawString[AIndex: integer]: RawByteString read GetRawString write SetRawString; + property RawStringByFilename[AFilename: string]: RawByteString read GetRawStringByFilename write SetRawStringByFilename; + end; + +implementation + +uses BGRAUTF8, strutils, BGRABitmapTypes; + +{ TEntryFilename } + +function TEntryFilename.GetFilename: utf8string; +begin + if Extension = '' then + result := Name + else + result := Name+'.'+Extension; +end; + +function TEntryFilename.GetIsEmpty: boolean; +begin + result := (FName='') and (FExtension = ''); +end; + +procedure TEntryFilename.SetExtension(AValue: utf8string); +var + i: Integer; +begin + if FExtension=AValue then Exit; + for i := 1 to length(AValue) do + if AValue[i] in ['.','/'] then + raise Exception.Create('Invalid extension'); + FExtension:=AValue; +end; + +procedure TEntryFilename.SetFilename(AValue: utf8string); +var + idxDot: SizeInt; +begin + idxDot := RPos('.',AValue); + if idxDot = 0 then + begin + Name := AValue; + Extension := ''; + end + else + begin + Name := copy(AValue,1,idxDot-1); + Extension := copy(AValue,idxDot+1,length(AValue)-idxDot); + end; +end; + +procedure TEntryFilename.SetName(AValue: utf8string); +var + i: Integer; +begin + if FName=AValue then Exit; + for i := 1 to length(AValue) do + if AValue[i] = '/' then + raise Exception.Create('Invalid name'); + FName:=AValue; +end; + +function EntryFilename(AName, AExtension: string): TEntryFilename; +begin + result.Name := AName; + result.Extension:= AExtension; +end; + +function EntryFilename(AFilename: string): TEntryFilename; +begin + result.Filename:= AFilename; +end; + +class operator TEntryFilename.=(const AValue1, AValue2: TEntryFilename): boolean; +begin + result := (AValue1.Name = AValue2.Name) and (AValue1.Extension = AValue2.Extension); +end; + +{ TMultiFileEntry } + +function TMultiFileEntry.GetFileSize: int64; +begin + result := 0; +end; + +function TMultiFileEntry.GetExtension: utf8string; +begin + result := ''; +end; + +constructor TMultiFileEntry.Create(AContainer: TMultiFileContainer); +begin + FContainer := AContainer; +end; + +function TMultiFileEntry.CopyTo(ADestination: TStream): int64; +begin + result := 0; +end; + +function TMultiFileEntry.GetStream: TStream; +begin + result := nil; +end; + +function TMultiFileEntry.CompareNameAndExtension(AName: utf8string; + AExtension: utf8string; ACaseSensitive: boolean): integer; +begin + if ACaseSensitive then + result := CompareStr(AName, Name) + else + result := UTF8CompareText(AName, Name); + + if result = 0 then + result := UTF8CompareText(AExtension, Extension); +end; + +{ TMultiFileContainer } + +function TMultiFileContainer.GetCount: integer; +begin + if Assigned(FEntries) then + result := FEntries.Count + else + result := 0; +end; + +function TMultiFileContainer.GetEntry(AIndex: integer): TMultiFileEntry; +begin + result := FEntries[AIndex]; +end; + +function TMultiFileContainer.GetRawString(AIndex: integer): RawByteString; +var s: TMemoryStream; +begin + s := TMemoryStream.Create; + try + Entry[AIndex].CopyTo(s); + setlength(result, s.Size); + if length(result)>0 then + move(s.Memory^, result[1], length(result)); + finally + s.Free; + end; +end; + +function TMultiFileContainer.GetRawStringByFilename(AFilename: string + ): RawByteString; +var + idx: Integer; +begin + idx := IndexOf(EntryFilename(AFilename)); + if idx = -1 then + result := '' + else + result := GetRawString(idx); +end; + +procedure TMultiFileContainer.SetRawString(AIndex: integer; + AValue: RawByteString); +begin + with Entry[AIndex] do + Add(Name, Extension, AValue, true); +end; + +procedure TMultiFileContainer.SetRawStringByFilename(AFilename: string; + AValue: RawByteString); +var + f: TEntryFilename; +begin + f := EntryFilename(AFilename); + Add(f.Name,f.Extension,AValue,true); +end; + +procedure TMultiFileContainer.Init; +begin + FEntries := TMultiFileEntryList.Create; +end; + +function TMultiFileContainer.AddEntry(AEntry: TMultiFileEntry; AIndex: integer): integer; +begin + if not Assigned(FEntries) then + raise exception.Create('Entry list not created'); + if (AIndex >= 0) and (AIndex < FEntries.Count) then + begin + FEntries.Insert(AIndex, AEntry); + result := AIndex; + end + else + result := FEntries.Add(AEntry); +end; + +constructor TMultiFileContainer.Create; +begin + Init; +end; + +constructor TMultiFileContainer.Create(AFilename: utf8string); +begin + Init; + LoadFromFile(AFilename); +end; + +constructor TMultiFileContainer.Create(AStream: TStream); +begin + Init; + LoadFromStream(AStream); +end; + +constructor TMultiFileContainer.Create(AStream: TStream; AStartPos: Int64); +begin + Init; + AStream.Position := AStartPos; + LoadFromStream(AStream); +end; + +procedure TMultiFileContainer.Assign(Source: TPersistent); +var + other: TMultiFileContainer; + otherEntry, newEntry: TMultiFileEntry; + i: Integer; + content: TMemoryStream; +begin + if Source is TMultiFileContainer then + begin + Clear; + other := TMultiFileContainer(Source); + for i := 0 to other.Count-1 do + begin + content := TMemoryStream.Create; + otherEntry := other.Entry[i]; + otherEntry.CopyTo(content); + newEntry := CreateEntry(otherEntry.Name, otherEntry.Extension, content); + if not Assigned(newEntry) then + raise exception.Create('Unable to create entry'); + AddEntry(newEntry); + end; + end else + inherited Assign(Source); +end; + +function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string; + AContent: TStream; AOverwrite: boolean; AOwnStream: boolean): integer; +var + index: Integer; + newEntry: TMultiFileEntry; + contentCopy: TMemoryStream; +begin + index := IndexOf(AName,AExtension); + if index <> -1 then + begin + if AOverwrite then + Delete(index) + else + raise Exception.Create('Duplicate entry'); + end; + if not AOwnStream then + begin + AContent.Position:= 0; + contentCopy := TMemoryStream.Create; + contentCopy.CopyFrom(AContent, AContent.Size); + newEntry := CreateEntry(AName, AExtension, contentCopy); + end else + newEntry := CreateEntry(AName, AExtension, AContent); + if Assigned(newEntry) then + result := AddEntry(newEntry, index) + else + raise exception.Create('Unable to create entry'); +end; + +function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string; + AContent: RawByteString; AOverwrite: boolean): integer; +var stream: TMemoryStream; +begin + stream := TMemoryStream.Create; + if length(AContent) > 0 then stream.Write(AContent[1],length(AContent)); + result := Add(AName,AExtension,stream,AOverwrite); +end; + +function TMultiFileContainer.Add(AFilename: TEntryFilename; AContent: TStream; + AOverwrite: boolean; AOwnStream: boolean): integer; +begin + result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite, AOwnStream); +end; + +function TMultiFileContainer.Add(AFilename: TEntryFilename; + AContent: RawByteString; AOverwrite: boolean): integer; +begin + result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite); +end; + +destructor TMultiFileContainer.Destroy; +begin + Clear; + FreeAndNil(FEntries); + inherited Destroy; +end; + +procedure TMultiFileContainer.LoadFromFile(AFilename: utf8string); +var stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilename, fmOpenRead); + LoadFromStream(stream); + stream.Free; +end; + +procedure TMultiFileContainer.LoadFromResource(AFilename: string); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TMultiFileContainer.SaveToFile(AFilename: utf8string); +var stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilename, fmCreate); + SaveToStream(stream); + stream.Free; +end; + +procedure TMultiFileContainer.Remove(AEntry: TMultiFileEntry); +var + index: Integer; +begin + index := IndexOf(AEntry); + if index = -1 then + raise exception.Create('Entry not found'); + Delete(index); +end; + +procedure TMultiFileContainer.Delete(AIndex: integer); +begin + if (AIndex >= 0) and (AIndex < Count) then + begin + Entry[AIndex].Free; + FEntries.Delete(AIndex); + end else + raise ERangeError.Create('Index out of bounds'); +end; + +function TMultiFileContainer.Delete(AName: utf8string; AExtension: utf8string; + ACaseSensitive: boolean): boolean; +var + index: Integer; +begin + index := IndexOf(AName, AExtension, ACaseSensitive); + if index = -1 then + result := false + else + begin + Delete(index); + result := true; + end; +end; + +function TMultiFileContainer.Delete(AFilename: TEntryFilename; + ACaseSensitive: boolean): boolean; +begin + result := Delete(AFilename.Name,AFilename.Extension,ACaseSensitive); +end; + +function TMultiFileContainer.IndexOf(AEntry: TMultiFileEntry): integer; +begin + result := FEntries.IndexOf(AEntry); +end; + +function TMultiFileContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean): integer; +var + i: Integer; +begin + for i := 0 to Count-1 do + if Entry[i].CompareNameAndExtension(AName, AExtenstion, ACaseSensitive) = 0 then + exit(i); + result := -1; +end; + +function TMultiFileContainer.IndexOf(AFilename: TEntryFilename; + ACaseSensitive: boolean): integer; +begin + result := IndexOf(AFilename.Name,AFilename.Extension,ACaseSensitive); +end; + +procedure TMultiFileContainer.Clear; +var + i: Integer; +begin + for i := 0 to FEntries.Count-1 do + FEntries.Items[i].Free; + FEntries.Clear; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgranogui.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgranogui.inc new file mode 100644 index 0000000..eb1ef96 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgranogui.inc @@ -0,0 +1,80 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + TColor = type LongInt; + {$warnings off} + TRawImage = class(TFPMemoryImage) + procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; {%H-}ATransparent: boolean); + constructor Create; + end; + {$warnings on} + TGUICanvas = class(TFPImageCanvas) + procedure DrawImage(x,y: integer; AImage: TFPCustomImage); + end; + +const + clNone = TColor($1FFFFFFF); + clDefault = TColor($20000000); + clBlack = TColor($000000); + clMaroon = TColor($000080); + clGreen = TColor($008000); + clOlive = TColor($008080); + clNavy = TColor($800000); + clPurple = TColor($800080); + clTeal = TColor($808000); + clGray = TColor($808080); + clSilver = TColor($C0C0C0); + clRed = TColor($0000FF); + clLime = TColor($00FF00); + clYellow = TColor($00FFFF); + clBlue = TColor($FF0000); + clFuchsia = TColor($FF00FF); + clAqua = TColor($FFFF00); + clLtGray = TColor($C0C0C0); // clSilver alias + clDkGray = TColor($808080); // clGray alias + clWhite = TColor($FFFFFF); + + clRgbBtnHighlight = TColor($E0E0E0); + clRgbBtnShadow = TColor($808080); + +function ColorToRGB(c: TColor): TColor; inline; + +function GetScreenDPIX: integer; +function GetScreenDPIY: integer; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); +begin + SetSize(AWidth,AHeight); +end; + +constructor TRawImage.Create; +begin + inherited Create(0,0); +end; + +procedure TGUICanvas.DrawImage(x,y: integer; AImage: TFPCustomImage); +begin + Draw(x,y, AImage); +end; + +function ColorToRGB(c: TColor): TColor; inline; +begin + result := c; +end; + +function GetScreenDPIX: integer; +begin + result := 96; +end; + +function GetScreenDPIY: integer; +begin + result := 96; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgranogui_uses.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgranogui_uses.inc new file mode 100644 index 0000000..9c4e4fd --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgranogui_uses.inc @@ -0,0 +1 @@ +uses BGRAClasses, FPImage, FPCanvas, FPImgCanv; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgranoguibitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgranoguibitmap.pas new file mode 100644 index 0000000..e7b9218 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgranoguibitmap.pas @@ -0,0 +1,163 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRANoGUIBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, + BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection, + BGRACanvas; + +type + + { TBGRANoGUIBitmap } + + TBGRANoGUIBitmap = class(TBGRADefaultBitmap) + private + FPseudoCanvas: TBGRACanvas; + function GetPseudoCanvas: TBGRACanvas; + protected + procedure RebuildBitmap; override; + function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; + function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; + {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean + =True): boolean; override; + procedure Init; override; + procedure FreeBitmap; override; + procedure NotAvailable; + public + destructor Destroy; override; + class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static; + class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static; + procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override; + procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available + procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; + procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; + {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; + procedure TakeScreenshot({%H-}ARect: TRect); override; //not available + procedure TakeScreenshotOfPrimaryMonitor; override; //not available + procedure LoadFromDevice({%H-}DC: HDC); override; //not available + procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available + property Canvas: TBGRACanvas read GetPseudoCanvas; + end; + +implementation + +{ TBGRANoGUIBitmap } + +function TBGRANoGUIBitmap.GetPseudoCanvas: TBGRACanvas; +begin + if FPseudoCanvas = nil then + begin + FPseudoCanvas := TBGRACanvas.Create(self); + FPseudoCanvas.AntialiasingMode := amOff; + end; + result := FPseudoCanvas; +end; + +procedure TBGRANoGUIBitmap.RebuildBitmap; +begin + //nothing +end; + +function TBGRANoGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; +begin + result := TBGRAFreeTypeFontRenderer.Create; +end; + +function TBGRANoGUIBitmap.LoadFromRawImage(ARawImage: TRawImage; + DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; + RaiseErrorOnInvalidPixelFormat: boolean): boolean; +begin + NotAvailable; + result := false; +end; + +procedure TBGRANoGUIBitmap.Init; +begin + inherited Init; + FontAntialias:= true; +end; + +procedure TBGRANoGUIBitmap.FreeBitmap; +begin + //nothing +end; + +procedure TBGRANoGUIBitmap.NotAvailable; +begin + raise exception.Create('Function not available without GUI'); +end; + +destructor TBGRANoGUIBitmap.Destroy; +begin + FreeAndNil(FPseudoCanvas); + inherited Destroy; +end; + +class procedure TBGRANoGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean); +begin + if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory); + EasyLazFreeType.FontCollection.AddFolder(ADirectory); +end; + +class procedure TBGRANoGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean); +begin + if AUTF8 then AFilename:= Utf8ToAnsi(AFilename); + EasyLazFreeType.FontCollection.AddFile(AFilename); +end; + +procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + ACanvas.GUICanvas.Draw(x,y,self); +end; + +procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +begin + ACanvas.GUICanvas.StretchDraw(Rect.Left,Rect.Top,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,self); +end; + +procedure TBGRANoGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, + y: integer); +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.TakeScreenshot(ARect: TRect); +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.TakeScreenshotOfPrimaryMonitor; +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC); +begin + NotAvailable; +end; + +procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect); +begin + NotAvailable; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl.pas new file mode 100644 index 0000000..fc16c76 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl.pas @@ -0,0 +1,2006 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAOpenGL; + +{$mode objfpc}{$H+} +{$I bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, FPimage, BGRAGraphics, + BGRAOpenGLType, BGRASpriteGL, BGRACanvasGL, GL, GLext, GLU, BGRABitmapTypes, + BGRAFontGL, BGRASSE, BGRAMatrix3D; + +type + TBGLCustomCanvas = BGRACanvasGL.TBGLCustomCanvas; + TBGLSprite = TBGLDefaultSprite; + IBGLTexture = BGRAOpenGLType.IBGLTexture; + IBGLFont = BGRAOpenGLType.IBGLFont; + IBGLRenderedFont = BGRAFontGL.IBGLRenderedFont; + TOpenGLResampleFilter = BGRAOpenGLType.TOpenGLResampleFilter; + TOpenGLBlendMode = BGRAOpenGLType.TOpenGLBlendMode; + TBGLPath = BGRACanvasGL.TBGLPath; + TWaitForGPUOption = BGRAOpenGLType.TWaitForGPUOption; + TBGLCustomElementArray = BGRACanvasGL.TBGLCustomElementArray; + TBGLCustomArray = BGRACanvasGL.TBGLCustomArray; + TOpenGLPrimitive = BGRAOpenGLType.TOpenGLPrimitive; + TTextLayout = BGRAGraphics.TTextLayout; + +const + tlTop = BGRAGraphics.tlTop; + tlCenter = BGRAGraphics.tlCenter; + tlBottom = BGRAGraphics.tlBottom; + +type + { TBGLContext } + + TBGLContext = object + private + function GetHeight: integer; + function GetWidth: integer; + public + Canvas: TBGLCustomCanvas; + Sprites: TBGLCustomSpriteEngine; + property Width: integer read GetWidth; + property Height: integer read GetHeight; + end; + + { TBGLFrameBuffer } + + TBGLFrameBuffer = class(TBGLCustomFrameBuffer) + protected + FHeight: integer; + FMatrix: TAffineMatrix; + FProjectionMatrix: TMatrix4D; + FTexture: IBGLTexture; + FFrameBufferId, FRenderBufferId: GLuint; + FWidth: integer; + FSettingMatrices: boolean; + function GetTexture: IBGLTexture; override; + function GetHandle: pointer; override; + function GetHeight: integer; override; + function GetMatrix: TAffineMatrix; override; + function GetProjectionMatrix: TMatrix4D; override; + function GetWidth: integer; override; + procedure SetMatrix(AValue: TAffineMatrix); override; + procedure SetProjectionMatrix(AValue: TMatrix4D); override; + public + constructor Create(AWidth,AHeight: integer); + function MakeTextureAndFree: IBGLTexture; override; + destructor Destroy; override; + end; + +const + orfBox = BGRAOpenGLType.orfBox; + orfLinear = BGRAOpenGLType.orfLinear; + obmNormal = BGRAOpenGLType.obmNormal; + obmAdd = BGRAOpenGLType.obmAdd; + obmMultiply = BGRAOpenGLType.obmMultiply; + wfgQueueAllCommands = BGRAOpenGLType.wfgQueueAllCommands; + wfgFinishAllCommands = BGRAOpenGLType.wfgFinishAllCommands; + opPoints = BGRAOpenGLType.opPoints; + opLineStrip = BGRAOpenGLType.opLineStrip; + opLineLoop = BGRAOpenGLType.opLineLoop; + opLines = BGRAOpenGLType.opLines; + opTriangleStrip = BGRAOpenGLType.opTriangleStrip; + opTriangleFan = BGRAOpenGLType.opTriangleFan; + opTriangles = BGRAOpenGLType.opTriangles; + +type + { TBGLBitmap } + + TBGLBitmap = class(TBGLCustomBitmap) + protected + function GetOpenGLMaxTexSize: integer; override; + public + function NewBitmap: TBGLBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer): TBGLBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGLBitmap; overload; override; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGLBitmap; overload; override; + function NewBitmap(Filename: string): TBGLBitmap; overload; override; + function NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap; overload; override; + function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGLBitmap; overload; override; + function NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap; overload; override; + function NewReference: TBGLBitmap; override; + function GetUnique: TBGLBitmap; override; + function Duplicate(DuplicateProperties: Boolean = False): TBGLBitmap; overload; override; + function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGLBitmap; overload; override; + function GetPart(const ARect: TRect): TBGLBitmap; override; + function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; + AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGLBitmap; override; + function Resample(newWidth, newHeight: integer; + mode: TResampleMode = rmFineResample): TBGLBitmap; override; + function FilterSmartZoom3(Option: TMedianOption): TBGLBitmap; override; + function FilterMedian(Option: TMedianOption): TBGLBitmap; override; + function FilterSmooth: TBGLBitmap; override; + function FilterSharpen(Amount: single = 1): TBGLBitmap; overload; override; + function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGLBitmap; overload; override; + function FilterContour(AGammaCorrection: boolean = false): TBGLBitmap; override; + function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGLBitmap; override; + function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; + function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; + function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; + function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override; + function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override; + function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap; overload; override; + function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGLBitmap; overload; override; + function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override; + function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGLBitmap; overload; override; + function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap; overload; override; + function FilterGrayscale: TBGLBitmap; overload; override; + function FilterGrayscale(ABounds: TRect): TBGLBitmap; overload; override; + function FilterNormalize(eachChannel: boolean = True): TBGLBitmap; overload; override; + function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGLBitmap; overload; override; + function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGLBitmap; override; + function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGLBitmap; override; + function FilterSphere: TBGLBitmap; override; + function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override; + function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override; + function FilterCylinder: TBGLBitmap; override; + function FilterPlane: TBGLBitmap; override; + end; + +function BGLTexture(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer): IBGLTexture; overload; +function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; overload; +function BGLTexture(ABitmap: TBitmap): IBGLTexture; overload; +function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; overload; +function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; overload; +function BGLTexture(AFilenameUTF8: string): IBGLTexture; overload; +function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter = rfBox): IBGLTexture; overload; +function BGLTexture(AStream: TStream): IBGLTexture; overload; + +function BGLSpriteEngine: TBGLCustomSpriteEngine; + +function BGLCanvas: TBGLCustomCanvas; + +procedure BGLViewPort(AWidth,AHeight: integer); overload; +procedure BGLViewPort(AWidth,AHeight: integer; AColor: TBGRAPixel); overload; + +function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; +function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; +function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AOutlineColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; +function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true): IBGLRenderedFont; overload; + +type + { TBGLElementArray } + + TBGLElementArray = class(TBGLCustomElementArray) + protected + FElements: packed array of GLuint; + FBuffer: GLuint; + function GetCount: integer; override; + public + constructor Create(const AElements: array of integer); override; + procedure Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); override; + destructor Destroy; override; + end; + + { TBGLArray } + + TBGLArray = class(TBGLCustomArray) + protected + FBufferAddress: pointer; + FCount: integer; + FRecordSize: integer; + function GetCount: integer; override; + function GetRecordSize: integer; override; + public + constructor Create(ABufferAddress: Pointer; ACount: integer; ARecordSize: integer); override; + destructor Destroy; override; + end; + +implementation + +uses BGRABlurGL, BGRATransform{$IFDEF BGRABITMAP_USE_LCL}, BGRAText, BGRATextFX{$ENDIF}; + +type + TBlendFuncSeparateProc = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF Windows} stdcall; {$ELSE} cdecl; {$ENDIF} + +function PrimitiveToOpenGL(AValue: TOpenGLPrimitive): GLenum; +begin + case AValue of + opPoints: result := GL_POINTS; + opLineStrip: result := GL_LINE_STRIP; + opLineLoop: result := GL_LINE_LOOP; + opLines: result := GL_LINES; + opTriangleStrip: result := GL_TRIANGLE_STRIP; + opTriangleFan: result := GL_TRIANGLE_FAN; + opTriangles: result := GL_TRIANGLES; + else + raise exception.Create('Unknown primitive type'); + end; +end; + +procedure NeedOpenGL2_0; +begin + if glUseProgram = nil then + begin + if not Load_GL_version_2_0 then + raise exception.Create('Cannot load OpenGL 2.0'); + end; +end; + +function CheckOpenGL2_0: boolean; +begin + if glUseProgram = nil then + begin + result := Load_GL_version_2_0; + end + else + result := true; +end; + +var + BGLCanvasInstance: TBGLCustomCanvas; + glBlendFuncSeparate: TBlendFuncSeparateProc; + glBlendFuncSeparateFetched: boolean; + +const + GL_COMBINE_ARB = $8570; + GL_COMBINE_RGB_ARB = $8571; + GL_SOURCE0_RGB_ARB = $8580; + GL_PRIMARY_COLOR_ARB = $8577; + +type + { TBGLTexture } + + TBGLTexture = class(TBGLCustomTexture) + protected + FFlipX,FFlipY: Boolean; + + function GetOpenGLMaxTexSize: integer; override; + function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; override; + procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); override; + class function SupportsBGRAOrder: boolean; override; + procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); override; + procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); override; + function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; override; + function GetEmptyTexture: TBGLTextureHandle; override; + procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); override; + procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); override; + + procedure InternalSetColor(const AColor: TBGRAPixel); + procedure DoDrawTriangleOrQuad(const APoints: array of TPointF; + const APointsZ: array of Single; const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; + const AColors: array of TColorF); override; + procedure DoDraw(pt1,pt2,pt3,pt4: TPointF; AColor: TBGRAPixel); + procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); override; + procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); override; + procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); override; + procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); override; + procedure NotifyInvalidFrameSize; override; + procedure NotifyErrorLoadingFile(AFilenameUTF8: string); override; + + function NewEmpty: TBGLCustomTexture; override; + function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; override; + function Duplicate: TBGLCustomTexture; override; + + public + procedure ToggleFlipX; override; + procedure ToggleFlipY; override; + procedure Bind(ATextureNumber: integer); override; + function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; override; + function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; override; + + end; + + POpenGLTexture = ^TOpenGLTexture; + TOpenGLTexture = record + ID: GLuint; + AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight: integer; + FramesCoord: array of array[0..3] of TPointF; + end; + + { TBGLCanvas } + + TBGLCanvas = class(TBGLCustomCanvas) + protected + FMatrix: TAffineMatrix; + FProjectionMatrix: TMatrix4D; + FBlendMode: TOpenGLBlendMode; + FLighting: TBGLCustomLighting; + FFaceCulling: TFaceCulling; + + function GetLighting: TBGLCustomLighting; override; + + function GetMatrix: TAffineMatrix; override; + procedure SetMatrix(const AValue: TAffineMatrix); override; + function GetProjectionMatrix: TMatrix4D; override; + procedure SetProjectionMatrix(const AValue: TMatrix4D); override; + + function GetFaceCulling: TFaceCulling; override; + procedure SetFaceCulling(AValue: TFaceCulling); override; + + procedure InternalSetColor(const AColor: TBGRAPixel); override; + procedure InternalSetColorF(const AColor: TColorF); override; + + procedure InternalStartPutPixel(const pt: TPointF); override; + procedure InternalStartPolyline(const pt: TPointF); override; + procedure InternalStartPolygon(const pt: TPointF); override; + procedure InternalStartTriangleFan(const pt: TPointF); override; + procedure InternalContinueShape(const pt: TPointF); overload; override; + + procedure InternalContinueShape(const pt: TPoint3D); overload; override; + procedure InternalContinueShape(const pt: TPoint3D_128); overload; override; + procedure InternalContinueShape(const pt, normal: TPoint3D_128); overload; override; + + procedure InternalEndShape; override; + + procedure InternalStartBlend; override; + procedure InternalEndBlend; override; + + procedure InternalStartBlendTriangles; override; + procedure InternalStartBlendQuads; override; + procedure InternalEndBlendTriangles; override; + procedure InternalEndBlendQuads; override; + + procedure EnableScissor(AValue: TRect); override; + procedure DisableScissor; override; + + function GetBlendMode: TOpenGLBlendMode; override; + procedure SetBlendMode(AValue: TOpenGLBlendMode); override; + + procedure SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); override; + public + destructor Destroy; override; + procedure Fill(AColor: TBGRAPixel); override; + procedure StartZBuffer; override; + procedure EndZBuffer; override; + procedure WaitForGPU(AOption: TWaitForGPUOption); override; + function GetImage(x, y, w, h: integer): TBGRACustomBitmap; override; + function CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; override; + end; + + { TBGLLighting } + + TBGLLighting = class(TBGLCustomLighting) + protected + FLightUsage: array[0..7] of boolean; + FCurrentSpecularIndex: single; + FAmbiantLightF: TColorF; + FBuiltInLighting: boolean; + function MakeShaderObject(AShaderType: GLenum; ASource: string): GLuint; + function AddLight(AColor: TColorF): integer; + function GetSupportShaders: boolean; override; + procedure SetAmbiantLightF(AAmbiantLight: TColorF); override; + function GetAmbiantLightF: TColorF; override; + function GetBuiltInLightingEnabled: boolean; override; + procedure SetBuiltInLightingEnabled(AValue: boolean); override; + public + constructor Create; + function AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; override; + function AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; override; + procedure ClearLights; override; + function RemoveLight(AIndex: integer): boolean; override; + procedure SetSpecularIndex(AIndex: integer); override; + + function MakeVertexShader(ASource: string): LongWord; override; + function MakeFragmentShader(ASource: string): LongWord; override; + function MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; override; + procedure UseProgram(AProgram: LongWord); override; + procedure DeleteShaderObject(AShader: LongWord); override; + procedure DeleteShaderProgram(AProgram: LongWord); override; + function GetUniformVariable(AProgram: LongWord; AName: string): LongWord; override; + function GetAttribVariable(AProgram: LongWord; AName: string): LongWord; override; + procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override; + procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override; + procedure BindAttribute(AAttribute: TAttributeVariable); override; + procedure UnbindAttribute(AAttribute: TAttributeVariable); override; + end; + +{ TBGLFrameBuffer } + +procedure TBGLFrameBuffer.SetMatrix(AValue: TAffineMatrix); +begin + if FSettingMatrices then Exit; + FSettingMatrices := true; + FMatrix:=AValue; + if FCanvas <> nil then + TBGLCustomCanvas(FCanvas).Matrix := AValue; + FSettingMatrices := false; +end; + +function TBGLFrameBuffer.GetMatrix: TAffineMatrix; +begin + result := FMatrix; +end; + +function TBGLFrameBuffer.GetTexture: IBGLTexture; +begin + result := FTexture.FlipY; +end; + +function TBGLFrameBuffer.GetHandle: pointer; +begin + result := @FFrameBufferId; +end; + +function TBGLFrameBuffer.GetHeight: integer; +begin + result := FHeight; +end; + +function TBGLFrameBuffer.GetProjectionMatrix: TMatrix4D; +begin + result := FProjectionMatrix; +end; + +function TBGLFrameBuffer.GetWidth: integer; +begin + result := FWidth; +end; + +procedure TBGLFrameBuffer.SetProjectionMatrix(AValue: TMatrix4D); +begin + if FSettingMatrices then Exit; + FSettingMatrices := true; + FProjectionMatrix:= AValue; + if FCanvas <> nil then + TBGLCustomCanvas(FCanvas).ProjectionMatrix := AValue; + FSettingMatrices := false; +end; + +constructor TBGLFrameBuffer.Create(AWidth, AHeight: integer); +var frameBufferStatus: GLenum; +begin + if not Load_GL_version_3_0 then + raise exception.Create('Cannot load OpenGL 3.0'); + + FWidth := AWidth; + FHeight := AHeight; + + FTexture := BGLTextureFactory.Create(nil,AWidth,AHeight,AWidth,AHeight); + + //depth and stencil + glGenRenderbuffers(1, @FRenderBufferId); + glBindRenderbuffer(GL_RENDERBUFFER, FRenderBufferId); + glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH24_STENCIL8, AWidth,AHeight); + glBindRenderbuffer(GL_RENDERBUFFER, 0); + + glGenFramebuffers(1, @FFrameBufferId); + glBindFramebuffer(GL_FRAMEBUFFER, FFrameBufferId); + + glFramebufferTexture2D(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, PGLuint(FTexture.Handle)^, 0); + glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_STENCIL_ATTACHMENT, GL_RENDERBUFFER, FFrameBufferId); + + frameBufferStatus:= glCheckFramebufferStatus(GL_FRAMEBUFFER); + glBindFramebuffer(GL_FRAMEBUFFER, 0); + + if frameBufferStatus <> GL_FRAMEBUFFER_COMPLETE then + begin + glDeleteFramebuffers(1, @FFrameBufferId); + glDeleteRenderbuffers(1, @FRenderBufferId); + FTexture := nil; + raise exception.Create('Error ' + inttostr(frameBufferStatus) + ' while initializing frame buffer'); + end; + + UseOrthoProjection; + Matrix := AffineMatrixIdentity; +end; + +function TBGLFrameBuffer.MakeTextureAndFree: IBGLTexture; +begin + result := FTexture; + FTexture := nil; + Free; +end; + +destructor TBGLFrameBuffer.Destroy; +begin + glDeleteFramebuffers(1, @FFrameBufferId); + glDeleteRenderbuffers(1, @FRenderBufferId); + FTexture := nil; + + inherited Destroy; +end; + +procedure ApplyBlendMode(ABlendMode: TOpenGLBlendMode); +var + srcBlend : LongWord; + dstBlend : LongWord; +begin + case ABlendMode of + obmAdd: + begin + srcBlend := GL_SRC_ALPHA; + dstBlend := GL_ONE; + end; + obmMultiply: + begin + srcBlend := GL_ZERO; + dstBlend := GL_SRC_COLOR; + end + else + begin + srcBlend := GL_SRC_ALPHA; + dstBlend := GL_ONE_MINUS_SRC_ALPHA; + end; + end; + if not glBlendFuncSeparateFetched then + begin + glBlendFuncSeparate := TBlendFuncSeparateProc(wglGetProcAddress('glBlendFuncSeparate')); + glBlendFuncSeparateFetched := true; + end; + if Assigned(glBlendFuncSeparate) then + glBlendFuncSeparate( srcBlend, dstBlend, GL_ONE, GL_ONE_MINUS_SRC_ALPHA ) + else + glBlendFunc( srcBlend, dstBlend ); +end; + +function BGLTexture(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, + ActualWidth, ActualHeight: integer): IBGLTexture; +begin + result := TBGLTexture.Create(ARGBAData,AllocatedWidth, AllocatedHeight, + ActualWidth, ActualHeight); +end; + +function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; +begin + result := TBGLTexture.Create(AFPImage); +end; + +function BGLTexture(ABitmap: TBitmap): IBGLTexture; +begin + result := TBGLTexture.Create(ABitmap); +end; + +function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; +begin + result := TBGLTexture.Create(AWidth,AHeight,Color); +end; + +function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; +begin + result := TBGLTexture.Create(AWidth,AHeight,Color); +end; + +function BGLTexture(AFilenameUTF8: string): IBGLTexture; +begin + result := TBGLTexture.Create(AFilenameUTF8); +end; + +function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter): IBGLTexture; +begin + result := TBGLTexture.Create(AFilenameUTF8, AWidth, AHeight, AResampleFilter); +end; + +function BGLTexture(AStream: TStream): IBGLTexture; +begin + result := TBGLTexture.Create(AStream); +end; + +function BGLSpriteEngine: TBGLCustomSpriteEngine; +begin + result := BGRASpriteGL.BGLSpriteEngine; +end; + +procedure BGLViewPort(AWidth, AHeight: integer; AColor: TBGRAPixel); +begin + BGLViewPort(AWidth,AHeight); + BGLCanvas.Fill(AColor); +end; + +function BGLFont(AName: string; AEmHeight: integer; AStyle: TFontStyles = []): IBGLRenderedFont; +begin + {$IFDEF BGRABITMAP_USE_LCL} + result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create); + result.Style := AStyle; + {$ELSE} + result := nil; + raise exception.Create('LCL renderer not available'); + {$ENDIF} +end; + +function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel; + AStyle: TFontStyles): IBGLRenderedFont; +begin + {$IFDEF BGRABITMAP_USE_LCL} + result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create); + result.Color := AColor; + result.Style := AStyle; + {$ELSE} + result := nil; + raise exception.Create('LCL renderer not available'); + {$ENDIF} +end; + +function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel; + AOutlineColor: TBGRAPixel; AStyle: TFontStyles = []): IBGLRenderedFont; +{$IFDEF BGRABITMAP_USE_LCL} +var renderer: TBGRATextEffectFontRenderer; +begin + renderer := TBGRATextEffectFontRenderer.Create; + renderer.OuterOutlineOnly:= true; + renderer.OutlineColor := AOutlineColor; + renderer.OutlineVisible := true; + result := BGLFont(AName, AEmHeight, renderer, true); + result.Color := AColor; + result.Style := AStyle; +end; +{$ELSE} +begin + result := nil; + raise exception.Create('LCL renderer not available'); +end; +{$ENDIF} + +function BGLFont(AName: string; AEmHeight: integer; + ARenderer: TBGRACustomFontRenderer; + ARendererOwned: boolean): IBGLRenderedFont; +var f: TBGLRenderedFont; +begin + f:= TBGLRenderedFont.Create(ARenderer, ARendererOwned); + f.Name := AName; + f.EmHeight := AEmHeight; + result := f; +end; + +function BGLCanvas: TBGLCustomCanvas; +begin + result := BGLCanvasInstance; +end; + +procedure BGLViewPort(AWidth, AHeight: integer); +begin + BGLCanvas.Width := AWidth; + BGLCanvas.Height := AHeight; + BGLCanvas.UseOrthoProjection; + BGLCanvas.Matrix := AffineMatrixIdentity; + BGLCanvas.FaceCulling := fcNone; +end; + +{ TBGLArray } + +function TBGLArray.GetCount: integer; +begin + result := FCount; +end; + +function TBGLArray.GetRecordSize: integer; +begin + result := FRecordSize; +end; + +constructor TBGLArray.Create(ABufferAddress: pointer; ACount: integer; + ARecordSize: integer); +var b: GLuint; +begin + NeedOpenGL2_0; + FBufferAddress:= ABufferAddress; + FCount := ACount; + FRecordSize:= ARecordSize; + glGenBuffers(1, @b); + FBuffer := b; + glBindBuffer(GL_ARRAY_BUFFER, FBuffer); + glBufferData(GL_ARRAY_BUFFER, FCount*FRecordSize, FBufferAddress, GL_STATIC_DRAW); +end; + +destructor TBGLArray.Destroy; +var b: GLuint; +begin + b := FBuffer; + glDeleteBuffers(1, @b); + inherited Destroy; +end; + +{ TBGLElementArray } + +function TBGLElementArray.GetCount: integer; +begin + result := length(FElements); +end; + +constructor TBGLElementArray.Create(const AElements: array of integer); +var bufferSize: integer; + i: Int32or64; +begin + NeedOpenGL2_0; + setlength(FElements,length(AElements)); + bufferSize := length(FElements)*sizeof(integer); + for i := 0 to high(FElements) do + FElements[i] := AElements[i]; + glGenBuffers(1, @FBuffer); + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer); + glBufferData(GL_ELEMENT_ARRAY_BUFFER, bufferSize, @FElements[0], GL_STATIC_DRAW); +end; + +procedure TBGLElementArray.Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); +var + i: Int32or64; +begin + for i := 0 to high(AAttributes) do + ACanvas.Lighting.BindAttribute(AAttributes[i]); + + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer); + glDrawElements(PrimitiveToOpenGL(APrimitive), Count, GL_UNSIGNED_INT, nil); + + for i := 0 to high(AAttributes) do + ACanvas.Lighting.UnbindAttribute(AAttributes[i]); +end; + +destructor TBGLElementArray.Destroy; +begin + glDeleteBuffers(1, @FBuffer); + inherited Destroy; +end; + +{ TBGLLighting } + +procedure TBGLLighting.SetAmbiantLightF(AAmbiantLight: TColorF); +begin + FAmbiantLightF := AAmbiantLight; + glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @AAmbiantLight); +end; + +constructor TBGLLighting.Create; +begin + FAmbiantLightF := ColorF(1,1,1,1); +end; + +function TBGLLighting.AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; +var + v: TPoint3D_128; +begin + result := AddLight(AColor); + if result <> -1 then + begin + v := Point3D_128(APosition); + v.t := 1; + glLightfv(GL_LIGHT0 + result, GL_POSITION, @v); + glLightf(GL_LIGHT0 + result, GL_CONSTANT_ATTENUATION, 0); + glLightf(GL_LIGHT0 + result, GL_LINEAR_ATTENUATION, ALinearAttenuation); + glLightf(GL_LIGHT0 + result, GL_QUADRATIC_ATTENUATION, AQuadraticAttenuation); + end; +end; + +procedure TBGLLighting.ClearLights; +var + i: Integer; +begin + for i := 0 to High(FLightUsage) do + if FLightUsage[i] then + RemoveLight(i); +end; + +function TBGLLighting.AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; +var + v: TPoint3D_128; +begin + result := AddLight(AColor); + if result <> -1 then + begin + v := Point3D_128(ADirection); + Normalize3D_128(v); + v.t := 0; + glLightfv(GL_LIGHT0 + result, GL_POSITION, @v); + end; +end; + +procedure TBGLLighting.SetSpecularIndex(AIndex: integer); +var c: TColorF; + newIndex: single; +begin + newIndex := AIndex*0.5; + if newIndex < 0 then newIndex := 0; + if newIndex > 128 then newIndex := 128; + if newIndex <> FCurrentSpecularIndex then + begin + if newIndex = 0 then + c := ColorF(0,0,0,1) + else + c := ColorF(1,1,1,1); + glMaterialf(GL_FRONT_AND_BACK, GL_SHININESS, newIndex); + glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @c); + FCurrentSpecularIndex := newIndex; + end; +end; + +function TBGLLighting.MakeVertexShader(ASource: string): LongWord; +begin + result := MakeShaderObject(GL_VERTEX_SHADER, ASource); +end; + +function TBGLLighting.MakeFragmentShader(ASource: string): LongWord; +begin + result := MakeShaderObject(GL_FRAGMENT_SHADER, ASource); +end; + +function TBGLLighting.GetAmbiantLightF: TColorF; +begin + result := FAmbiantLightF; +end; + +function TBGLLighting.GetBuiltInLightingEnabled: boolean; +begin + result := FBuiltInLighting; +end; + +procedure TBGLLighting.SetBuiltInLightingEnabled(AValue: boolean); +begin + if AValue = FBuiltInLighting then exit; + FBuiltInLighting:= AValue; + if AValue then + begin + glEnable(GL_LIGHTING); + glShadeModel(GL_SMOOTH); + glEnable(GL_COLOR_MATERIAL); + glColorMaterial(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE); + glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @FAmbiantLightF); + glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER, 0); + glLightModelf(GL_LIGHT_MODEL_TWO_SIDE,1); + end else + begin + glDisable(GL_LIGHTING); + end; +end; + +function TBGLLighting.MakeShaderObject(AShaderType: GLenum; ASource: string + ): GLuint; +var + psource: pchar; + sourceLen: GLint; + shaderId: GLuint; + shaderOk: GLint; + log: string; + logLen: GLint; +begin + NeedOpenGL2_0; + + if ASource = '' then + raise exception.Create('Empty code file provided'); + + shaderId := glCreateShader(AShaderType); + psource := @ASource[1]; + sourceLen := length(ASource); + glShaderSource(shaderId, 1, @psource, @sourceLen); + glCompileShader(shaderId); + + glGetShaderiv(shaderId, GL_COMPILE_STATUS, @shaderOk); + if not (shaderOk <> 0) then + begin + //retrieve error log + glGetShaderiv(shaderId, GL_INFO_LOG_LENGTH, @logLen); + setlength(log, logLen); + if logLen > 0 then + glGetShaderInfoLog(shaderId, logLen, nil, @log[1]); + + glDeleteShader(shaderId); + raise exception.Create('Failed to compile shader: ' + log); + end; + result := shaderId; +end; + +function TBGLLighting.AddLight(AColor: TColorF): integer; +var + i: Integer; + black: TColorF; +begin + for i := 0 to high(FLightUsage) do + if not FLightUsage[i] then + begin + result := i; + FLightUsage[i] := true; + black := ColorF(0,0,0,1); + glLightfv(GL_LIGHT0 + i, GL_AMBIENT, @black); + glLightfv(GL_LIGHT0 + i, GL_DIFFUSE, @AColor); + glLightfv(GL_LIGHT0 + i, GL_SPECULAR, @AColor); + glEnable(GL_LIGHT0 + i); + exit; + end; + result := -1; +end; + +function TBGLLighting.GetSupportShaders: boolean; +begin + result := CheckOpenGL2_0; +end; + +function TBGLLighting.MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; +var + programOk: GLint; + shaderProgram: GLuint; + log: string; + logLen: GLint; +begin + NeedOpenGL2_0; + + shaderProgram := glCreateProgram(); + glAttachShader(shaderProgram, AVertexShader); + glAttachShader(shaderProgram, AFragmentShader); + glLinkProgram(shaderProgram); + + glGetProgramiv(shaderProgram, GL_LINK_STATUS, @programOk); + if not (programOk <> 0) then + begin + //retrieve error log + glGetProgramiv(shaderProgram, GL_INFO_LOG_LENGTH, @logLen); + setlength(log, logLen); + if logLen > 0 then + glGetProgramInfoLog(shaderProgram, logLen, nil, @log[1]); + + glDeleteProgram(shaderProgram); + raise exception.Create('Failed to link shader program: ' + log); + end; + result := shaderProgram; +end; + +procedure TBGLLighting.UseProgram(AProgram: LongWord); +begin + NeedOpenGL2_0; + glUseProgram(AProgram); +end; + +procedure TBGLLighting.DeleteShaderObject(AShader: LongWord); +begin + NeedOpenGL2_0; + if AShader<> 0 then + glDeleteShader(AShader); +end; + +procedure TBGLLighting.DeleteShaderProgram(AProgram: LongWord); +begin + NeedOpenGL2_0; + if AProgram<> 0 then + glDeleteProgram(AProgram); +end; + +function TBGLLighting.GetUniformVariable(AProgram: LongWord; AName: string): LongWord; +begin + NeedOpenGL2_0; + result := glGetUniformLocation(AProgram, @AName[1]); +end; + +function TBGLLighting.GetAttribVariable(AProgram: LongWord; AName: string): LongWord; +begin + NeedOpenGL2_0; + result := glGetAttribLocation(AProgram, @AName[1]); +end; + +procedure TBGLLighting.SetUniformSingle(AVariable: LongWord; + const AValue; AElementCount, AComponentCount: integer); +begin + NeedOpenGL2_0; + case AComponentCount of + 1: glUniform1fv(AVariable, AElementCount, @AValue); + 2: glUniform2fv(AVariable, AElementCount, @AValue); + 3: glUniform3fv(AVariable, AElementCount, @AValue); + 4: glUniform4fv(AVariable, AElementCount, @AValue); + 9: glUniformMatrix3fv(AVariable, AElementCount, GL_FALSE, @AValue); + 16: glUniformMatrix4fv(AVariable, AElementCount, GL_FALSE, @AValue); + else + raise exception.Create('Unexpected number of components'); + end; +end; + +procedure TBGLLighting.SetUniformInteger(AVariable: LongWord; + const AValue; AElementCount, AComponentCount: integer); +begin + NeedOpenGL2_0; + case AComponentCount of + 1: glUniform1iv(AVariable, AElementCount, @AValue); + 2: glUniform2iv(AVariable, AElementCount, @AValue); + 3: glUniform3iv(AVariable, AElementCount, @AValue); + 4: glUniform4iv(AVariable, AElementCount, @AValue); + else + raise exception.Create('Unexpected number of components'); + end; +end; + +procedure TBGLLighting.BindAttribute(AAttribute: TAttributeVariable); +var t: GLenum; +begin + glBindBuffer(GL_ARRAY_BUFFER, AAttribute.Source.Handle); + if AAttribute.IsFloat then + t := GL_FLOAT + else + t := GL_INT; + glVertexAttribPointer(AAttribute.Handle, AAttribute.VectorSize,t,GL_FALSE, + AAttribute.Source.RecordSize, {%H-}pointer(PtrInt(AAttribute.RecordOffset))); + glEnableVertexAttribArray(AAttribute.Handle); +end; + +procedure TBGLLighting.UnbindAttribute(AAttribute: TAttributeVariable); +begin + glDisableVertexAttribArray(AAttribute.Handle); +end; + +function TBGLLighting.RemoveLight(AIndex: integer): boolean; +begin + if (AIndex >= 0) and (AIndex <= high(FLightUsage)) and + FLightUsage[AIndex] then + begin + glDisable(GL_LIGHT0 + AIndex); + FLightUsage[AIndex] := false; + result := true; + end + else + result := false; +end; + +{ TBGLContext } + +function TBGLContext.GetHeight: integer; +begin + if Assigned(Canvas) then + result := Canvas.Height + else + result := 0; +end; + +function TBGLContext.GetWidth: integer; +begin + if Assigned(Canvas) then + result := Canvas.Width + else + result := 0; +end; + +{ TBGLCanvas } + +function TBGLCanvas.GetLighting: TBGLCustomLighting; +begin + if FLighting = nil then + FLighting := TBGLLighting.Create; + result := FLighting; +end; + +function TBGLCanvas.GetMatrix: TAffineMatrix; +begin + if ActiveFrameBuffer <> nil then + result := ActiveFrameBuffer.Matrix + else + result := FMatrix; +end; + +procedure TBGLCanvas.SetMatrix(const AValue: TAffineMatrix); +var m: TMatrix4D; +begin + glMatrixMode(GL_MODELVIEW); + m := AffineMatrixToMatrix4D(AValue); + glLoadMatrixf(@m); + + if ActiveFrameBuffer <> nil then + ActiveFrameBuffer.Matrix := AValue + else + FMatrix := AValue; +end; + +function TBGLCanvas.GetProjectionMatrix: TMatrix4D; +begin + if ActiveFrameBuffer <> nil then + result := ActiveFrameBuffer.ProjectionMatrix + else + result := FProjectionMatrix; +end; + +procedure TBGLCanvas.SetProjectionMatrix(const AValue: TMatrix4D); +begin + glMatrixMode(GL_PROJECTION); + glLoadMatrixf(@AValue); + glMatrixMode(GL_MODELVIEW); + + if ActiveFrameBuffer <> nil then + ActiveFrameBuffer.ProjectionMatrix := AValue + else + FProjectionMatrix := AValue; +end; + +function TBGLCanvas.GetFaceCulling: TFaceCulling; +begin + result := FFaceCulling; +end; + +procedure TBGLCanvas.SetFaceCulling(AValue: TFaceCulling); +begin + if AValue = FFaceCulling then exit; + if FFaceCulling = fcNone then + glEnable(GL_CULL_FACE); + case AValue of + fcNone: glDisable(GL_CULL_FACE); + fcKeepCW: glFrontFace(GL_CW); + fcKeepCCW: glFrontFace(GL_CCW); + end; + FFaceCulling:= AValue; +end; + +procedure TBGLCanvas.InternalStartPutPixel(const pt: TPointF); +begin + glBegin(GL_POINTS); + glVertex2fv(@pt); +end; + +procedure TBGLCanvas.InternalStartPolyline(const pt: TPointF); +begin + glBegin(GL_LINE_STRIP); + glVertex2fv(@pt); +end; + +procedure TBGLCanvas.InternalStartPolygon(const pt: TPointF); +begin + glBegin(GL_LINE_LOOP); + glVertex2fv(@pt); +end; + +procedure TBGLCanvas.InternalStartTriangleFan(const pt: TPointF); +begin + glBegin(GL_TRIANGLE_FAN); + glVertex2fv(@pt); +end; + +procedure TBGLCanvas.InternalContinueShape(const pt: TPointF); +begin + glVertex2fv(@pt); +end; + +procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D); +begin + glVertex3fv(@pt); +end; + +procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D_128); +begin + glVertex3fv(@pt); +end; + +procedure TBGLCanvas.InternalContinueShape(const pt, normal: TPoint3D_128); +begin + glNormal3fv(@normal); + glVertex3fv(@pt); +end; + +procedure TBGLCanvas.InternalEndShape; +begin + glEnd(); +end; + +procedure TBGLCanvas.InternalSetColor(const AColor: TBGRAPixel); +begin + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + glColor4ubv(@AColor) + else + glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha); + {$POP} +end; + +procedure TBGLCanvas.InternalSetColorF(const AColor: TColorF); +begin + glColor4fv(@AColor[1]); +end; + +procedure TBGLCanvas.InternalStartBlend; +begin + glEnable(GL_BLEND); + ApplyBlendMode(BlendMode); +end; + +procedure TBGLCanvas.InternalEndBlend; +begin + glDisable(GL_BLEND); +end; + +procedure TBGLCanvas.InternalStartBlendTriangles; +begin + InternalStartBlend; + glBegin(GL_TRIANGLES); +end; + +procedure TBGLCanvas.InternalStartBlendQuads; +begin + InternalStartBlend; + glBegin(GL_QUADS); +end; + +procedure TBGLCanvas.InternalEndBlendTriangles; +begin + InternalEndShape; + InternalEndBlend; +end; + +procedure TBGLCanvas.InternalEndBlendQuads; +begin + InternalEndShape; + InternalEndBlend; +end; + +procedure TBGLCanvas.Fill(AColor: TBGRAPixel); +begin + glClearColor(AColor.Red/255, AColor.green/255, AColor.blue/255, AColor.alpha/255); + glClear(GL_COLOR_BUFFER_BIT); +end; + +procedure TBGLCanvas.StartZBuffer; +begin + glEnable(GL_DEPTH_TEST); + glClear(GL_DEPTH_BUFFER_BIT); +end; + +procedure TBGLCanvas.EndZBuffer; +begin + glDisable(GL_DEPTH_TEST); +end; + +procedure TBGLCanvas.WaitForGPU(AOption: TWaitForGPUOption); +begin + case AOption of + wfgQueueAllCommands: glFlush; + wfgFinishAllCommands: glFinish; + end; +end; + +function TBGLCanvas.GetImage(x, y, w, h: integer): TBGRACustomBitmap; +begin + NeedOpenGL2_0; + result := BGRABitmapFactory.Create(w,h); + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + glReadPixels(x,self.Height-y-h, w,h, GL_RGBA, GL_UNSIGNED_BYTE, result.Data) + else + glReadPixels(x,self.Height-y-h, w,h, GL_BGRA, GL_UNSIGNED_BYTE, result.Data); + {$POP} +end; + +function TBGLCanvas.CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; +begin + Result:= TBGLFrameBuffer.Create(AWidth,AHeight); +end; + +procedure TBGLCanvas.EnableScissor(AValue: TRect); +begin + glScissor(AValue.left,Height-AValue.bottom,AValue.right-AValue.left,AValue.Bottom-AValue.Top); + glEnable(GL_SCISSOR_TEST); +end; + +procedure TBGLCanvas.DisableScissor; +begin + glDisable(GL_SCISSOR_TEST); +end; + +function TBGLCanvas.GetBlendMode: TOpenGLBlendMode; +begin + result := FBlendMode; +end; + +procedure TBGLCanvas.SetBlendMode(AValue: TOpenGLBlendMode); +begin + FBlendMode := AValue; +end; + +procedure TBGLCanvas.SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); +var + m: TMatrix4D; +begin + if AValue = ActiveFrameBuffer then exit; + inherited SetActiveFrameBuffer(AValue); + if AValue = nil then + glBindFramebuffer(GL_FRAMEBUFFER, 0) + else + glBindFramebuffer(GL_FRAMEBUFFER, PGLuint(AValue.Handle)^); + + glViewPort(0,0,Width,Height); + + glMatrixMode(GL_PROJECTION); + m := ProjectionMatrix; + glLoadMatrixf(@m); + + glMatrixMode(GL_MODELVIEW); + m := AffineMatrixToMatrix4D(Matrix); + glLoadMatrixf(@m); +end; + +destructor TBGLCanvas.Destroy; +begin + FLighting.Free; + inherited Destroy; +end; + +{ TBGLTexture } + +function TBGLTexture.GetOpenGLMaxTexSize: integer; +begin + result := 0; + glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result ); +end; + +function TBGLTexture.CreateOpenGLTexture(ARGBAData: PLongWord; + AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; + RGBAOrder: boolean): TBGLTextureHandle; +var p: POpenGLTexture; + providedFormat: GLenum; +begin + if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA; + New(p); + p^.AllocatedWidth := AAllocatedWidth; + p^.AllocatedHeight := AAllocatedHeight; + p^.ActualWidth := AActualWidth; + p^.ActualHeight := AActualHeight; + + glGenTextures( 1, @p^.ID ); + glBindTexture( GL_TEXTURE_2D, p^.ID ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); + glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData ); + result := p; +end; + +procedure TBGLTexture.UpdateOpenGLTexture(ATexture: TBGLTextureHandle; + ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, + AActualHeight: integer; RGBAOrder: boolean); +var providedFormat: GLenum; +begin + if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA; + SetOpenGLTextureSize(ATexture, AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight); + glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID ); + glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData ); +end; + +class function TBGLTexture.SupportsBGRAOrder: boolean; +begin + Result:= true; +end; + +procedure TBGLTexture.SetOpenGLTextureSize(ATexture: TBGLTextureHandle; + AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); +begin + with TOpenGLTexture(ATexture^) do + begin + ActualWidth := AActualWidth; + ActualHeight:= AActualHeight; + AllocatedWidth := AAllocatedWidth; + AllocatedHeight := AAllocatedHeight; + end; +end; + +procedure TBGLTexture.ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; + FramesX: Integer; FramesY: Integer); +var U,V: Single; + tX, tY, fU, fV : Single; + ix,iy,i: Integer; +begin + with TOpenGLTexture(ATexture^) do + begin + if AllocatedWidth = 0 then + U := 1 + else + U := ActualWidth/AllocatedWidth; + if AllocatedHeight = 0 then + V := 1 + else + V := ActualHeight/AllocatedHeight; + + if FramesX < 1 then FramesX := 1; + if FramesY < 1 then FramesY := 1; + + SetLength( FramesCoord, FramesX * FramesY + 1 ); + fU := U / FramesX; + fV := V / FramesY; + + FramesCoord[ 0, 0 ].X := 0; + FramesCoord[ 0, 0 ].Y := 0; + FramesCoord[ 0, 1 ].X := U; + FramesCoord[ 0, 1 ].Y := 0; + FramesCoord[ 0, 2 ].X := U; + FramesCoord[ 0, 2 ].Y := V; + FramesCoord[ 0, 3 ].X := 0; + FramesCoord[ 0, 3 ].Y := V; + + ix := 1; + iy := 1; + for i := 1 to FramesX * FramesY do + begin + tX := ix * fU; + tY := iy * fV; + + FramesCoord[ i, 0 ].X := tX - fU; + FramesCoord[ i, 0 ].Y := tY - fV; + + FramesCoord[ i, 1 ].X := tX; + FramesCoord[ i, 1 ].Y := tY - fV; + + FramesCoord[ i, 2 ].X := tX; + FramesCoord[ i, 2 ].Y := tY; + + FramesCoord[ i, 3 ].X := tX - fU; + FramesCoord[ i, 3 ].Y := tY; + + inc(ix); + if ix > FramesX then + begin + ix := 1; + inc(iy); + end; + end; + + end; +end; + +function TBGLTexture.GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; +begin + if ATexture = nil then + result := 0 + else + begin + result := Length(TOpenGLTexture(ATexture^).FramesCoord); + if result > 0 then dec(result); //first frame is whole picture + end; +end; + +function TBGLTexture.GetEmptyTexture: TBGLTextureHandle; +begin + result := nil; +end; + +procedure TBGLTexture.FreeOpenGLTexture(ATexture: TBGLTextureHandle); +begin + glDeleteTextures( 1, @TOpenGLTexture(ATexture^).ID ); + Dispose(POpenGLTexture(ATexture)); +end; + +procedure TBGLTexture.UpdateGLResampleFilter(ATexture: TBGLTextureHandle; + AFilter: TOpenGLResampleFilter); +begin + glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID ); + if AFilter = orfLinear then + begin + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); + end else + begin + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST ); + end; +end; + +procedure TBGLTexture.InternalSetColor(const AColor: TBGRAPixel); +begin + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + glColor4ubv(@AColor) + else + glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha); + {$POP} +end; + +procedure TBGLTexture.DoDrawTriangleOrQuad(const APoints: array of TPointF; + const APointsZ: array of Single; const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; + const AColors: array of TColorF); +var + i: Integer; + factorX,factorY: single; +begin + if (FOpenGLTexture = nil) or (Width = 0) or (Height = 0) then exit; + with TOpenGLTexture(FOpenGLTexture^) do + begin + glEnable( GL_BLEND ); + + glEnable( GL_TEXTURE_2D ); + glBindTexture( GL_TEXTURE_2D, ID ); + + if FIsMask then + begin + glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB ); + glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE ); + glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB ); + end else + glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE ); + + ApplyBlendMode(BlendMode); + + factorX := 1/Width; + factorY := 1/Height; + + if length(AColors) = 0 then + glColor4f(1,1,1,1); + + if length(APoints3D) <> 0 then + begin + if length(APoints3D) = 3 then + glBegin( GL_TRIANGLES ) + else + glBegin( GL_QUADS ); + + for i := 0 to high(APoints3D) do + begin + if length(AColors) <> 0 then glColor4fv( @AColors[i] ); + glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); + if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); + glVertex3fv( @APoints3D[i] ); + end; + end else + begin + if length(APoints) = 3 then + glBegin( GL_TRIANGLES ) + else + glBegin( GL_QUADS ); + + if length(APointsZ) <> 0 then + begin + for i := 0 to high(APoints) do + begin + if length(AColors) <> 0 then glColor4fv( @AColors[i] ); + glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); + if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); + glVertex3f( APoints[i].x, APoints[i].y, APointsZ[i] ); + end; + end else + begin + for i := 0 to high(APoints) do + begin + if length(AColors) <> 0 then glColor4fv( @AColors[i] ); + glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); + if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); + glVertex2fv( @APoints[i] ); + end; + end; + end; + + glEnd; + glDisable( GL_TEXTURE_2D ); + glDisable( GL_BLEND ); + end; +end; + +procedure TBGLTexture.DoDraw(pt1, pt2, pt3, pt4: TPointF; AColor: TBGRAPixel); +type + TTexCoordIndex = array[0..3] of integer; +const + FLIP_TEXCOORD : array[ 0..3 ] of TTexCoordIndex = ( ( 0, 1, 2, 3 ), ( 1, 0, 3, 2 ), ( 3, 2, 1, 0 ), ( 2, 3, 0, 1 ) ); +var + coordFlip: TTexCoordIndex; +begin + if (FOpenGLTexture = nil) or (FFrame < 0) or (FFrame > FrameCount) then exit; + with TOpenGLTexture(FOpenGLTexture^) do + begin + glEnable( GL_BLEND ); + glEnable( GL_TEXTURE_2D ); + glBindTexture( GL_TEXTURE_2D, ID ); + + if FIsMask then + begin + glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB ); + glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE ); + glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB ); + end else + glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE ); + + ApplyBlendMode(BlendMode); + + coordFlip := FLIP_TEXCOORD[ Integer(FFlipX) + Integer(FFlipY)*2 ]; + + glBegin( GL_QUADS ); + + if GradientColors then + InternalSetColor(FGradTopLeft) + else + InternalSetColor(AColor); + + glTexCoord2fv( @FramesCoord[FFrame,coordFlip[0]] ); + glVertex2fv( @pt1 ); + + if GradientColors then + InternalSetColor(FGradTopRight); + + glTexCoord2fv( @FramesCoord[FFrame,coordFlip[1]] ); + glVertex2fv( @pt2 ); + + if GradientColors then + InternalSetColor(FGradBottomRight); + + glTexCoord2fv( @FramesCoord[FFrame,coordFlip[2]] ); + glVertex2fv( @pt3 ); + + if GradientColors then + InternalSetColor(FGradBottomLeft); + + glTexCoord2fv( @FramesCoord[FFrame,coordFlip[3]] ); + glVertex2fv( @pt4 ); + + glEnd; + glDisable( GL_TEXTURE_2D ); + glDisable( GL_BLEND ); + end; +end; + +procedure TBGLTexture.DoStretchDraw(x, y, w, h: single; AColor: TBGRAPixel); +begin + DoDraw(PointF(x, y), PointF(x+w, y), PointF(x+w, y+h), PointF(x, y+h), AColor); +end; + +procedure TBGLTexture.DoStretchDrawAngle(x, y, w, h, angleDeg: single; + rotationCenter: TPointF; AColor: TBGRAPixel); +var + m : TAffineMatrix; +begin + m := AffineMatrixTranslation(rotationCenter.X,rotationCenter.Y)* + AffineMatrixRotationDeg(angleDeg)* + AffineMatrixTranslation(-rotationCenter.X,-rotationCenter.Y); + DoDraw(m*PointF(x, y), m*PointF(x+w, y), m*PointF(x+w, y+h), m*PointF(x, y+h), AColor); +end; + +procedure TBGLTexture.DoDrawAffine(Origin, HAxis, VAxis: TPointF; + AColor: TBGRAPixel); +begin + DoDraw(Origin, HAxis, HAxis+(VAxis-Origin), VAxis, AColor); +end; + +procedure TBGLTexture.ToggleFlipX; +begin + FFlipX := not FFlipX; +end; + +procedure TBGLTexture.ToggleFlipY; +begin + FFlipY := not FFlipY; +end; + +procedure TBGLTexture.Bind(ATextureNumber: integer); +begin + if (ATextureNumber < 0) or (ATextureNumber > 31) then + raise exception.Create('Texture number out of bounds'); + if (glActiveTexture = nil) then + begin + if not Load_GL_version_1_3 then + raise exception.Create('Cannot load OpenGL 1.3'); + end; + glActiveTexture(GL_TEXTURE0 + ATextureNumber); + glBindTexture(GL_TEXTURE_2D, POpenGLTexture(FOpenGLTexture)^.ID); + if ATextureNumber<>0 then + glActiveTexture(GL_TEXTURE0); +end; + +function TBGLTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; +var shader: TBGLCustomShader; + blurName: string; +begin + blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')'; + shader := BGLCanvas.Lighting.Shader[blurName]; + if shader = nil then + begin + shader := TBGLBlurShader.Create(BGLCanvas, ABlurType); + BGLCanvas.Lighting.Shader[blurName] := shader; + end; + with (shader as TBGLBlurShader) do + begin + Radius := ARadius; + Direction := ADirection; + result := FilterBlurMotion(self); + end; +end; + +function TBGLTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; +var shader: TBGLCustomShader; + blurName: String; +begin + blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')'; + shader := BGLCanvas.Lighting.Shader[blurName]; + if shader = nil then + begin + shader := TBGLBlurShader.Create(BGLCanvas, ABlurType); + BGLCanvas.Lighting.Shader[blurName] := shader; + end; + with (shader as TBGLBlurShader) do + begin + Radius := ARadius; + result := FilterBlurRadial(self); + end; +end; + +procedure TBGLTexture.Init(ATexture: TBGLTextureHandle; AWidth, + AHeight: integer; AOwned: boolean); +begin + inherited Init(ATexture, AWidth, AHeight, AOwned); + FFlipX := false; + FFlipY := false; + FBlendMode := obmNormal; +end; + +procedure TBGLTexture.NotifyInvalidFrameSize; +begin + raise exception.Create('Invalid frame size'); +end; + +procedure TBGLTexture.NotifyErrorLoadingFile(AFilenameUTF8: string); +begin + raise exception.Create('Error loading file "'+AFilenameUTF8+'"'); +end; + +function TBGLTexture.NewEmpty: TBGLCustomTexture; +begin + result := TBGLTexture.Create; +end; + +function TBGLTexture.NewFromTexture(ATexture: TBGLTextureHandle; AWidth, + AHeight: integer): TBGLCustomTexture; +begin + result := TBGLTexture.Create(ATexture,AWidth,AHeight); +end; + +function TBGLTexture.Duplicate: TBGLCustomTexture; +begin + Result:= inherited Duplicate; + TBGLTexture(result).FFlipX := FFlipX; + TBGLTexture(result).FFlipY := FFlipY; +end; + +{ TBGLBitmap } + +function TBGLBitmap.GetOpenGLMaxTexSize: integer; +begin + result := 0; + glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result ); +end; + +function TBGLBitmap.NewBitmap: TBGLBitmap; +begin + Result:=inherited NewBitmap as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(AWidth, AHeight: integer): TBGLBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel + ): TBGLBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer + ): TBGLBitmap; +begin + Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(Filename: string): TBGLBitmap; +begin + Result:=inherited NewBitmap(Filename) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap; +begin + Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean; + AOptions: TBGRALoadingOptions): TBGLBitmap; +begin + Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGLBitmap; +end; + +function TBGLBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap; +begin + Result:=inherited NewBitmap(AFPImage) as TBGLBitmap; +end; + +function TBGLBitmap.NewReference: TBGLBitmap; +begin + Result:=inherited NewReference as TBGLBitmap; +end; + +function TBGLBitmap.GetUnique: TBGLBitmap; +begin + Result:=inherited GetUnique as TBGLBitmap; +end; + +function TBGLBitmap.Duplicate(DuplicateProperties: Boolean): TBGLBitmap; +begin + Result:=inherited Duplicate(DuplicateProperties) as TBGLBitmap; +end; + +function TBGLBitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean): TBGLBitmap; +begin + Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGLBitmap; +end; + +function TBGLBitmap.GetPart(const ARect: TRect): TBGLBitmap; +begin + Result:=inherited GetPart(ARect) as TBGLBitmap; +end; + +function TBGLBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, + ABackgroundColor: TBGRAPixel; AWidth: integer; AHeight: integer; + APenWidth: single): TBGLBitmap; +begin + Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, + ABackgroundColor, AWidth, AHeight, APenWidth) as TBGLBitmap; +end; + +function TBGLBitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode + ): TBGLBitmap; +begin + Result:=inherited Resample(newWidth, newHeight, mode) as TBGLBitmap; +end; + +function TBGLBitmap.FilterSmartZoom3(Option: TMedianOption): TBGLBitmap; +begin + Result:=inherited FilterSmartZoom3(Option) as TBGLBitmap; +end; + +function TBGLBitmap.FilterMedian(Option: TMedianOption): TBGLBitmap; +begin + Result:=inherited FilterMedian(Option) as TBGLBitmap; +end; + +function TBGLBitmap.FilterSmooth: TBGLBitmap; +begin + Result:=inherited FilterSmooth as TBGLBitmap; +end; + +function TBGLBitmap.FilterSharpen(Amount: single): TBGLBitmap; +begin + Result:=inherited FilterSharpen(Amount) as TBGLBitmap; +end; + +function TBGLBitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGLBitmap; +begin + Result:=inherited FilterSharpen(ABounds, Amount) as TBGLBitmap; +end; + +function TBGLBitmap.FilterContour(AGammaCorrection: boolean = false): TBGLBitmap; +begin + Result:=inherited FilterContour(AGammaCorrection) as TBGLBitmap; +end; + +function TBGLBitmap.FilterPixelate(pixelSize: integer; useResample: boolean; + filter: TResampleFilter): TBGLBitmap; +begin + Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap; +begin + Result:=inherited FilterBlurRadial(radius, blurType) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radius: single; + blurType: TRadialBlurType): TBGLBitmap; +begin + Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurRadial(radiusX, radiusY: single; + blurType: TRadialBlurType): TBGLBitmap; +begin + Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, + radiusY: single; blurType: TRadialBlurType): TBGLBitmap; +begin + Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurMotion(distance: single; angle: single; + oriented: boolean): TBGLBitmap; +begin + Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGLBitmap; +end; + +function TBGLBitmap.FilterBlurMotion(const ABounds: TRect; distance: single; + angle: single; oriented: boolean): TBGLBitmap; +begin + Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGLBitmap; +end; + +function TBGLBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap; +begin + Result:=inherited FilterCustomBlur(mask) as TBGLBitmap; +end; + +function TBGLBitmap.FilterCustomBlur(const ABounds: TRect; + mask: TCustomUniversalBitmap): TBGLBitmap; +begin + Result:=inherited FilterCustomBlur(ABounds, mask) as TBGLBitmap; +end; + +function TBGLBitmap.FilterEmboss(angle: single; AStrength: integer; + AOptions: TEmbossOptions): TBGLBitmap; +begin + Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGLBitmap; +end; + +function TBGLBitmap.FilterEmboss(angle: single; ABounds: TRect; + AStrength: integer; AOptions: TEmbossOptions): TBGLBitmap; +begin + Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGLBitmap; +end; + +function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection) as TBGLBitmap; +end; + +function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel): TBGLBitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGLBitmap; +end; + +function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean; + BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap; +begin + Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGLBitmap; +end; + +function TBGLBitmap.FilterGrayscale: TBGLBitmap; +begin + Result:=inherited FilterGrayscale as TBGLBitmap; +end; + +function TBGLBitmap.FilterGrayscale(ABounds: TRect): TBGLBitmap; +begin + Result:=inherited FilterGrayscale(ABounds) as TBGLBitmap; +end; + +function TBGLBitmap.FilterNormalize(eachChannel: boolean): TBGLBitmap; +begin + Result:=inherited FilterNormalize(eachChannel) as TBGLBitmap; +end; + +function TBGLBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean + ): TBGLBitmap; +begin + Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGLBitmap; +end; + +function TBGLBitmap.FilterRotate(origin: TPointF; angle: single; + correctBlur: boolean): TBGLBitmap; +begin + Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGLBitmap; +end; + +function TBGLBitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean + ): TBGLBitmap; +begin + Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGLBitmap; +end; + +function TBGLBitmap.FilterSphere: TBGLBitmap; +begin + Result:=inherited FilterSphere as TBGLBitmap; +end; + +function TBGLBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; + ATurn: Single; AExponent: Single): TBGLBitmap; +begin + Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGLBitmap; +end; + +function TBGLBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; + ARadius: Single; ATurn: Single; AExponent: Single): TBGLBitmap; +begin + Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGLBitmap; +end; + +function TBGLBitmap.FilterCylinder: TBGLBitmap; +begin + Result:=inherited FilterCylinder as TBGLBitmap; +end; + +function TBGLBitmap.FilterPlane: TBGLBitmap; +begin + Result:=inherited FilterPlane as TBGLBitmap; +end; + +initialization + + BGLBitmapFactory := TBGLBitmap; + BGLTextureFactory := TBGLTexture; + BGRASpriteGL.BGLSpriteEngine := TBGLDefaultSpriteEngine.Create; + BGLCanvasInstance := TBGLCanvas.Create; + +finalization + + BGLCanvasInstance.Free; + BGLCanvasInstance := nil; + BGRASpriteGL.BGLSpriteEngine.Free; + BGRASpriteGL.BGLSpriteEngine := nil; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl3d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl3d.pas new file mode 100644 index 0000000..b25e5da --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengl3d.pas @@ -0,0 +1,1017 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAOpenGL3D; + +{$mode objfpc}{$H+} + +interface + +uses BGRABitmapTypes, + BGRASceneTypes, BGRASSE, + BGRAClasses, BGRAMatrix3D, + BGRACanvasGL, + BGRAScene3D, + BGRAOpenGLType, + BGRATransform, + BGRARenderer3D; + +type + TAttributeVariable = BGRACanvasGL.TAttributeVariable; + + TBGLShader3D = class; + + { TBGLLighting3D } + + TBGLLighting3D = class + private + procedure SetUseBuiltIn(AValue: boolean); + protected + FCanvas: TBGLCustomCanvas; + FLights: TList; + FAmbiantLight: TColorF; + FShaderLightingCode: string; + FUseBuiltIn: boolean; + procedure Init; + public + constructor Create(ACanvas: TBGLCustomCanvas; AAmbiantLight: TColorF; ALights: TList); + procedure SetSpecularIndex(AIndex: Integer); + destructor Destroy; override; + property ShaderLightingCode: string read FShaderLightingCode; + property UseOpenGLBuiltInLighting: boolean read FUseBuiltIn write SetUseBuiltIn; + end; + + { TBGLRenderer3D } + + TBGLRenderer3D = class(TCustomRenderer3D) + protected + FCanvas: TBGLCustomCanvas; + FHasZBuffer: Boolean; + FGlobalScale: single; + FOptions: TRenderingOptions; + FFactorZ, FAddZ: single; + FLightingGL: TBGLLighting3D; + FLights: TList; + FAmbiantLight: TColorF; + FFar: single; + FOldCulling: TFaceCulling; + FOldMatrix: TAffineMatrix; + FOldProjection, FProjectionMatrix: TMatrix4D; + FShader, FShaderWithTexture: TBGLCustomShader; + FBGRAShader: TBGRAShader3D; + FShadedColorsF: array of TColorF; + FShadedColors: array of TBGRAPixel; + function GetHasZBuffer: boolean; override; + function GetGlobalScale: single; override; + function GetSurfaceWidth: integer; override; + function GetSurfaceHeight: integer; override; + procedure SetProjection(const AValue: TProjection3D); override; + function GetHandlesNearClipping: boolean; override; + function GetHandlesFaceCulling: boolean; override; + procedure InitLighting(AUseOpenGLBuiltInLighting: boolean); + public + constructor Create(ACanvas: TBGLCustomCanvas; + AScene: TBGRAScene3D; AFar: single); + function RenderFace(var ADescription: TFaceRenderingDescription; + {%H-}AComputeCoordinate: TComputeProjectionFunc): boolean; override; + destructor Destroy; override; + property Canvas: TBGLCustomCanvas read FCanvas; + end; + + { TBGLScene3D } + + TBGLScene3D = class(TBGRAScene3D) + protected + function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; override; + public + procedure RenderGL(ACanvas: TBGLCustomCanvas; AMaxZ: single = 1000); virtual; + end; + + { TUniformVariable } + + TUniformVariable = object + private + FProgram: TBGLShader3D; + FVariable: LongWord; + procedure Init(AProgram: TBGLShader3D; AVariable: LongWord); + end; + + { TUniformVariableSingle } + + TUniformVariableSingle = object(TUniformVariable) + private + FValue: single; + procedure SetValue(const AValue: single); + public + procedure Update; + property Value: single read FValue write SetValue; + end; + + { TUniformVariablePointF } + + TUniformVariablePointF = object(TUniformVariable) + private + FValue: TPointF; + procedure SetValue(const AValue: TPointF); + public + procedure Update; + property Value: TPointF read FValue write SetValue; + end; + + { TUniformVariablePoint3D } + + TUniformVariablePoint3D = object(TUniformVariable) + private + FValue: TPoint3D; + procedure SetValue(const AValue: TPoint3D); + public + procedure Update; + property Value: TPoint3D read FValue write SetValue; + end; + + { TUniformVariableInteger } + + TUniformVariableInteger = object(TUniformVariable) + private + FValue: Integer; + procedure SetValue(const AValue: Integer); + public + procedure Update; + property Value: Integer read FValue write SetValue; + end; + + { TUniformVariablePoint } + + TUniformVariablePoint = object(TUniformVariable) + private + FValue: TPoint; + procedure SetValue(const AValue: TPoint); + public + procedure Update; + property Value: TPoint read FValue write SetValue; + end; + + { TUniformVariableMatrix4D } + + TUniformVariableMatrix4D = object(TUniformVariable) + private + FValue: TMatrix4D; + procedure SetValue(const AValue: TMatrix4D); + public + procedure Update; + property Value: TMatrix4D read FValue write SetValue; + end; + + { TAttributeVariableSingle } + + TAttributeVariableSingle = object(TAttributeVariable) + protected + procedure Init(AProgram: TObject; AAttribute: LongWord); + end; + + { TAttributeVariablePointF } + + TAttributeVariablePointF = object(TAttributeVariable) + protected + procedure Init(AProgram: TObject; AAttribute: LongWord); + end; + + { TAttributeVariablePoint3D } + + TAttributeVariablePoint3D = object(TAttributeVariable) + protected + procedure Init(AProgram: TObject; AAttribute: LongWord); + end; + + { TAttributeVariableInteger } + + TAttributeVariableInteger = object(TAttributeVariable) + protected + procedure Init(AProgram: TObject; AAttribute: LongWord); + end; + + { TAttributeVariablePoint } + + TAttributeVariablePoint = object(TAttributeVariable) + protected + procedure Init(AProgram: TObject; AAttribute: LongWord); + end; + + { TBGLShader3D } + + TBGLShader3D = class(TBGLCustomShader) + protected + FUsed: boolean; + FCanvas: TBGLCustomCanvas; + FLighting: TBGLCustomLighting; + FVertexShaderSource, + FFragmentShaderSource: string; + FVertexShader, + FFragmentShader, + FProgram: LongWord; + function GetUniformVariableSingle(AName: string): TUniformVariableSingle; + function GetUniformVariablePointF(AName: string): TUniformVariablePointF; + function GetUniformVariablePoint3D(AName: string): TUniformVariablePoint3D; + function GetUniformVariableInteger(AName: string): TUniformVariableInteger; + function GetUniformVariablePoint(AName: string): TUniformVariablePoint; + function GetUniformVariableMatrix4D(AName: string): TUniformVariableMatrix4D; + function GetAttributeVariableInteger(AName: string): TAttributeVariableInteger; + function GetAttributeVariablePoint(AName: string): TAttributeVariablePoint; + function GetAttributeVariableSingle(AName: string): TAttributeVariableSingle; + function GetAttributeVariablePointF(AName: string): TAttributeVariablePointF; + function GetAttributeVariablePoint3D(AName: string): TAttributeVariablePoint3D; + procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); + procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); + procedure CheckUsage(AUsing: boolean); + procedure StartUse; override; + procedure EndUse; override; + property Canvas: TBGLCustomCanvas read FCanvas; + public + constructor Create(ACanvas: TBGLCustomCanvas; AVertexShaderSource: string; + AFragmentShaderSource: string; AVaryingVariables: string = ''; + AVersion: string = '120'); + destructor Destroy; override; + property UniformSingle[AName: string]: TUniformVariableSingle read GetUniformVariableSingle; + property UniformPointF[AName: string]: TUniformVariablePointF read GetUniformVariablePointF; + property UniformPoint3D[AName: string]: TUniformVariablePoint3D read GetUniformVariablePoint3D; + property UniformInteger[AName: string]: TUniformVariableInteger read GetUniformVariableInteger; + property UniformPoint[AName: string]: TUniformVariablePoint read GetUniformVariablePoint; + property UniformMatrix4D[AName: string]: TUniformVariableMatrix4D read GetUniformVariableMatrix4D; + property AttributeSingle[AName: string]: TAttributeVariableSingle read GetAttributeVariableSingle; + property AttributePointF[AName: string]: TAttributeVariablePointF read GetAttributeVariablePointF; + property AttributePoint3D[AName: string]: TAttributeVariablePoint3D read GetAttributeVariablePoint3D; + property AttributeInteger[AName: string]: TAttributeVariableInteger read GetAttributeVariableInteger; + property AttributePoint[AName: string]: TAttributeVariablePoint read GetAttributeVariablePoint; + property IsUsed: boolean read FUsed; + end; + +function ProjectionToOpenGL(AProj: TProjection3D; ANear, AFar: Single): TMatrix4D; + +implementation + +uses SysUtils, BGRAColorInt; + +type + + { TShaderWithTexture } + + TShaderWithTexture = class(TBGLShader3D) + private + function GetTexture: integer; + procedure SetTexture(AValue: integer); + protected + FTextureUniform: TUniformVariableInteger; + procedure StartUse; override; + public + class function GetCodeForTextureColor: string; static; + constructor Create(ACanvas: TBGLCustomCanvas; AFragmentShader: string; ATexture: integer = 0); + property Texture: integer read GetTexture write SetTexture; + end; + +function ProjectionToOpenGL(AProj: TProjection3D; ANear, AFar: Single): TMatrix4D; +begin + result[1,1] := AProj.Zoom.X; result[2,1] := 0; result[3,1] := -(AProj.Center.x + 0.5); result[4,1] := 0; + result[1,2] := 0; result[2,2] := AProj.Zoom.Y; result[3,2] := -(AProj.Center.y + 0.5); result[4,2] := 0; + result[1,3] := 0; result[2,3] := 0; result[3,3] := -2/(AFar-ANear); result[4,3] := -1 - AFar*result[3,3]; + result[1,4] := 0; result[2,4] := 0; result[3,4] := -1; result[4,4] := 0; +end; + +{ TUniformVariableMatrix4D } + +procedure TUniformVariableMatrix4D.SetValue(const AValue: TMatrix4D); +begin + if CompareMem(@AValue, @FValue, sizeof(FValue)) then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariableMatrix4D.Update; +begin + FProgram.SetUniformSingle(FVariable, FValue, 1, 16); +end; + +{ TShaderWithTexture } + +function TShaderWithTexture.GetTexture: integer; +begin + result := FTextureUniform.Value; +end; + +procedure TShaderWithTexture.SetTexture(AValue: integer); +begin + FTextureUniform.Value := AValue; +end; + +procedure TShaderWithTexture.StartUse; +begin + inherited StartUse; + FTextureUniform.Update; +end; + +class function TShaderWithTexture.GetCodeForTextureColor: string; +begin + result := 'texture2D(texture, texture_coordinate)'; +end; + +constructor TShaderWithTexture.Create(ACanvas: TBGLCustomCanvas; + AFragmentShader: string; ATexture: integer); +begin + inherited Create(ACanvas, + 'void main(void) ' + + '{ ' + + ' gl_Position = gl_ProjectionMatrix * gl_Vertex; ' + + ' texture_coordinate = vec2(gl_MultiTexCoord0); ' + + ' N = gl_Normal; ' + + ' V = vec3(gl_Vertex); ' + + '} ', + + 'uniform sampler2D texture; ' + + AFragmentShader, + + 'varying vec2 texture_coordinate; ' + + 'varying vec3 N; ' + + 'varying vec3 V; '); + FTextureUniform := UniformInteger['texture']; + Texture := ATexture; +end; + +{ TAttributeVariablePoint3D } + +procedure TAttributeVariablePoint3D.Init(AProgram: TObject; AAttribute: LongWord); +begin + inherited Init(AProgram,AAttribute,3,True); +end; + +{ TAttributeVariablePointF } + +procedure TAttributeVariablePointF.Init(AProgram: TObject; AAttribute: LongWord); +begin + inherited Init(AProgram,AAttribute,2,True); +end; + +{ TAttributeVariableInteger } + +procedure TAttributeVariableInteger.Init(AProgram: TObject; AAttribute: LongWord); +begin + inherited Init(AProgram,AAttribute,1,False); +end; + +{ TAttributeVariablePoint } + +procedure TAttributeVariablePoint.Init(AProgram: TObject; AAttribute: LongWord); +begin + inherited Init(AProgram,AAttribute,2,False); +end; + +{ TAttributeVariableSingle } + +procedure TAttributeVariableSingle.Init(AProgram: TObject; AAttribute: LongWord); +begin + inherited Init(AProgram,AAttribute,1,True); +end; + +{ TUniformVariablePoint } + +procedure TUniformVariablePoint.SetValue(const AValue: TPoint); +begin + if (FValue.x=AValue.x) and (FValue.y=AValue.y) then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariablePoint.Update; +begin + FProgram.SetUniformInteger(FVariable, FValue, 1, 2); +end; + +{ TUniformVariableInteger } + +procedure TUniformVariableInteger.SetValue(const AValue: Integer); +begin + if FValue=AValue then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariableInteger.Update; +begin + FProgram.SetUniformInteger(FVariable, FValue, 1, 1); +end; + +{ TUniformVariablePoint3D } + +procedure TUniformVariablePoint3D.SetValue(const AValue: TPoint3D); +begin + if (FValue.x=AValue.x) and (FValue.y=AValue.y) and (FValue.z=AValue.z) then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariablePoint3D.Update; +begin + FProgram.SetUniformSingle(FVariable, FValue, 1, 3); +end; + +{ TUniformVariablePointF } + +procedure TUniformVariablePointF.SetValue(const AValue: TPointF); +begin + if (FValue.x=AValue.x) and (FValue.y=AValue.y) then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariablePointF.Update; +begin + FProgram.SetUniformSingle(FVariable, FValue, 1, 2); +end; + +{ TUniformVariableSingle } + +procedure TUniformVariableSingle.SetValue(const AValue: single); +begin + if FValue=AValue then Exit; + FValue:=AValue; + if FProgram.IsUsed then Update; +end; + +procedure TUniformVariableSingle.Update; +begin + FProgram.SetUniformSingle(FVariable, FValue, 1, 1); +end; + +{ TUniformVariable } + +procedure TUniformVariable.Init(AProgram: TBGLShader3D; AVariable: LongWord); +begin + FProgram := AProgram; + FVariable := AVariable; +end; + +{ TBGLShader3D } + +function TBGLShader3D.GetUniformVariableSingle(AName: string): TUniformVariableSingle; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetUniformVariablePointF(AName: string): TUniformVariablePointF; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetUniformVariablePoint3D(AName: string): TUniformVariablePoint3D; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetUniformVariableInteger(AName: string): TUniformVariableInteger; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetUniformVariablePoint(AName: string): TUniformVariablePoint; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetUniformVariableMatrix4D(AName: string): TUniformVariableMatrix4D; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); + {$pop} +end; + +procedure TBGLShader3D.CheckUsage(AUsing: boolean); +begin + if AUsing <> FUsed then + begin + if FUsed then raise exception.Create('Shader is in use') else + raise exception.Create('Shader is not in use'); + end; +end; + +function TBGLShader3D.GetAttributeVariableSingle(AName: string): TAttributeVariableSingle; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetAttributeVariablePointF(AName: string): TAttributeVariablePointF; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetAttributeVariablePoint3D(AName: string): TAttributeVariablePoint3D; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetAttributeVariableInteger(AName: string): TAttributeVariableInteger; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); + {$pop} +end; + +function TBGLShader3D.GetAttributeVariablePoint(AName: string): TAttributeVariablePoint; +begin + {$push}{$hints off} + fillchar(result,sizeof(result),0); + result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); + {$pop} +end; + +procedure TBGLShader3D.SetUniformSingle(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); +begin + CheckUsage(True); + FCanvas.Lighting.SetUniformSingle(AVariable, AValue, AElementCount, AComponentCount); +end; + +procedure TBGLShader3D.SetUniformInteger(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); +begin + CheckUsage(True); + FCanvas.Lighting.SetUniformInteger(AVariable, AValue, AElementCount, AComponentCount); +end; + +constructor TBGLShader3D.Create(ACanvas: TBGLCustomCanvas; + AVertexShaderSource: string; AFragmentShaderSource: string; + AVaryingVariables: string; AVersion: string); +begin + FCanvas := ACanvas; + FLighting := FCanvas.Lighting; + FVertexShaderSource:= '#version ' + AVersion + #10 + AVaryingVariables + #10 + AVertexShaderSource; + FFragmentShaderSource:= '#version ' + AVersion + #10 + AVaryingVariables + #10 + AFragmentShaderSource; + FVertexShader := 0; + FFragmentShader := 0; + FProgram := 0; + try + FVertexShader := FLighting.MakeVertexShader(FVertexShaderSource); + FFragmentShader := FLighting.MakeFragmentShader(FFragmentShaderSource); + FProgram := FLighting.MakeShaderProgram(FVertexShader,FFragmentShader); + except on ex:Exception do + begin + FLighting.DeleteShaderProgram(FProgram); + FLighting.DeleteShaderObject(FFragmentShader); + FLighting.DeleteShaderObject(FVertexShader); + raise ex; + end; + end; +end; + +destructor TBGLShader3D.Destroy; +begin + if IsUsed then raise exception.Create('Shader is still in use'); + inherited Destroy; +end; + +procedure TBGLShader3D.StartUse; +begin + CheckUsage(False); + FLighting.UseProgram(FProgram); + FUsed:= True; +end; + +procedure TBGLShader3D.EndUse; +begin + CheckUsage(True); + FLighting.UseProgram(0); + FUsed:= False; +end; + +{ TBGLLighting3D } + +procedure TBGLLighting3D.SetUseBuiltIn(AValue: boolean); +begin + if FUseBuiltIn=AValue then Exit; + FUseBuiltIn:=AValue; + FCanvas.Lighting.BuiltInLightingEnabled := FUseBuiltIn; +end; + +procedure TBGLLighting3D.Init; +var + i: Integer; + v: TPoint3D; + int: single; + num: string; + minInt: string; + colorMult: TColorF; +begin + FShaderLightingCode:= + 'void main(void) ' + + '{ ' + + ' vec3 L, H; float d; float sat, sumUnsat; vec4 color, clampedColor; vec4 unsat; ' + + ' vec3 Idiff = vec3(gl_LightModel.ambient); ' + + ' vec4 Ispec = vec4(0,0,0,0); ' + + ' vec3 NN = normalize(N); '; + with FCanvas.Lighting do + begin + AmbiantLightF := FAmbiantLight; + for i := 0 to FLights.Count-1 do + with TBGRALight3D(FLights[i]) do + begin + str(GetMinIntensity,minInt); + if IsDirectional then + begin + v := -GetDirection; + v.z := -v.z; + num := IntToStr(AddDirectionalLight(GetColorF, v)); + str(GetMinIntensity,minInt); + AppendStr(FShaderLightingCode, + ' L = gl_LightSource['+num+'].position.xyz; ' + + ' Idiff += vec3(gl_LightSource['+num+'].diffuse * max(dot(NN,L), '+minInt+') ); ' + + ' if (gl_FrontMaterial.shininess > 0) { ' + + ' H = normalize(L + vec3(0,0,1)); ' + + ' Ispec += gl_LightSource['+num+'].specular * pow(abs(dot(NN,H)), gl_FrontMaterial.shininess*2); ' + + ' } '); + end + else + begin + int := GetIntensity*0.75; + if int > 0 then + begin + v := GetPosition; + v.z := -v.z; + colorMult := GetColorF * ColorF(int,int,int,1); + num := IntToStr(AddPointLight(colorMult, v, 0,1)); + str(GetMinIntensity/int,minInt); + AppendStr(FShaderLightingCode, + ' L = (gl_LightSource['+num+'].position.xyz - V).xyz; ' + + ' d = length(L); ' + + ' L *= 1/d; ' + + ' Idiff += vec3(gl_LightSource['+num+'].diffuse * max(dot(NN,L)/(d*d), '+minInt+') ); ' + + ' if (gl_FrontMaterial.shininess > 0) { ' + + ' H = normalize(L + vec3(0,0,1)); ' + + ' Ispec += gl_LightSource['+num+'].specular * pow(abs(dot(NN,H))/(d*d), gl_FrontMaterial.shininess*2); ' + + ' } '); + end; + end; + + end; + end; + AppendStr(FShaderLightingCode, + ' color = #color# * vec4(Idiff,1) + Ispec; ' + + ' clampedColor = clamp(color,0,1); ' + + ' sat = dot( color - clampedColor, vec4(1) ); ' + + ' if (sat > 0) { ' + + ' unsat = vec4(1) - clampedColor; ' + + ' sumUnsat = unsat[0]+unsat[1]+unsat[2]; ' + + ' if (sumUnsat > 0) { ' + + ' sat *= max(max(unsat[0],unsat[1]),unsat[2]) / sumUnsat; ' + + ' gl_FragColor = clamp(color + vec4(sat,sat,sat,0),0,1); ' + + ' } ' + + ' else gl_FragColor = clampedColor; ' + + ' } ' + + ' else gl_FragColor = clampedColor; ' + + '} '); +end; + +constructor TBGLLighting3D.Create(ACanvas: TBGLCustomCanvas; AAmbiantLight: TColorF; ALights: TList); +begin + FCanvas := ACanvas; + FLights := ALights; + FAmbiantLight := AAmbiantLight; + Init; +end; + +procedure TBGLLighting3D.SetSpecularIndex(AIndex: Integer); +begin + FCanvas.Lighting.SetSpecularIndex(AIndex); +end; + +destructor TBGLLighting3D.Destroy; +begin + FCanvas.Lighting.SetSpecularIndex(0); + FCanvas.Lighting.ClearLights; + UseOpenGLBuiltInLighting := false; + inherited Destroy; +end; + +{ TBGLScene3D } + +function TBGLScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string + ): TBGRACustomBitmap; +begin + if BGLBitmapFactory <> nil then + Result:= BGLBitmapFactory.Create(AFilenameUTF8,True) + else + result := inherited LoadBitmapFromFileUTF8(AFilenameUTF8); +end; + +procedure TBGLScene3D.RenderGL(ACanvas: TBGLCustomCanvas; AMaxZ: single); +var + renderer: TBGLRenderer3D; +begin + renderer := TBGLRenderer3D.Create(ACanvas, self, AMaxZ); + Render(renderer); + renderer.Free; +end; + +{ TBGLRenderer3D } + +function TBGLRenderer3D.GetHasZBuffer: boolean; +begin + result := FHasZBuffer; +end; + +function TBGLRenderer3D.GetGlobalScale: single; +begin + result := FGlobalScale; +end; + +function TBGLRenderer3D.GetSurfaceWidth: integer; +begin + result := FCanvas.Width; +end; + +function TBGLRenderer3D.GetSurfaceHeight: integer; +begin + result := FCanvas.Height; +end; + +{$PUSH}{$OPTIMIZATION OFF} //avoid internal error 2012090607 +procedure TBGLRenderer3D.SetProjection(const AValue: TProjection3D); +begin + inherited SetProjection(AValue); + FProjectionMatrix := ProjectionToOpenGL(AValue, FOptions.MinZ, FFar) * + OrthoProjectionToOpenGL(0,0,FCanvas.Width,FCanvas.Height); + FCanvas.ProjectionMatrix := FProjectionMatrix; +end; +{$POP} + +function TBGLRenderer3D.GetHandlesNearClipping: boolean; +begin + result := true; +end; + +function TBGLRenderer3D.GetHandlesFaceCulling: boolean; +begin + result := FShader <> nil; +end; + +procedure TBGLRenderer3D.InitLighting(AUseOpenGLBuiltInLighting: boolean); +var + fragmentShaderCode: string; +begin + if not Assigned(FLightingGL) then + begin + FLightingGL := TBGLLighting3D.Create(FCanvas, FAmbiantLight, FLights); + + if (FOptions.LightingInterpolation <> liLowQuality) and FCanvas.Lighting.SupportShaders then + begin + fragmentShaderCode := StringReplace(FLightingGL.ShaderLightingCode, '#color#', 'gl_Color', []); + FShader := FCanvas.Lighting.Shader[fragmentShaderCode]; + if (FShader = nil) and FCanvas.Lighting.SupportShaders then + begin + FShader := TBGLShader3D.Create(FCanvas, + 'void main(void) ' + + '{ ' + + ' gl_Position = gl_ProjectionMatrix * gl_Vertex; ' + + ' gl_FrontColor = gl_Color; ' + + ' gl_BackColor = gl_Color; ' + + ' N = gl_Normal; ' + + ' V = vec3(gl_Vertex); ' + + '} ', + + fragmentShaderCode, + + 'varying vec3 N; ' + + 'varying vec3 V; '); + FCanvas.Lighting.Shader[fragmentShaderCode] := FShader; + end; + + fragmentShaderCode := StringReplace(FLightingGL.ShaderLightingCode, '#color#', TShaderWithTexture.GetCodeForTextureColor, []); + FShaderWithTexture := FCanvas.Lighting.Shader[fragmentShaderCode]; + if (FShaderWithTexture = nil) and FCanvas.Lighting.SupportShaders then + begin + FShaderWithTexture := TShaderWithTexture.Create(FCanvas, fragmentShaderCode, 0); + FCanvas.Lighting.Shader[fragmentShaderCode] := FShaderWithTexture; + end; + end else + begin + FLightingGL.UseOpenGLBuiltInLighting := AUseOpenGLBuiltInLighting; + if not AUseOpenGLBuiltInLighting then + FBGRAShader := TBGRAShader3D.Create(FAmbiantLight, FLights); + end; + end; +end; + +constructor TBGLRenderer3D.Create(ACanvas: TBGLCustomCanvas; + AScene: TBGRAScene3D; AFar: single); +begin + FCanvas := ACanvas; + FOptions := AScene.RenderingOptions; + FLights := AScene.MakeLightList; + FAmbiantLight := AScene.AmbiantLightColorF; + FGlobalScale:= 1; + FHasZBuffer := FOptions.PerspectiveMode = pmZBuffer; + FFactorZ := -2/(FFar-FOptions.MinZ); + FAddZ := -1 - FFar*FFactorZ; + FFar := AFar; + if FHasZBuffer then ACanvas.StartZBuffer; + FOldCulling:= FCanvas.FaceCulling; + FOldMatrix := FCanvas.Matrix; + FCanvas.ResetTransform; + FOldProjection := FCanvas.ProjectionMatrix; + FCanvas.ProjectionMatrix := MatrixIdentity4D; + + FShader := nil; + FShaderWithTexture := nil; + + InitLighting(False); +end; + +function TBGLRenderer3D.RenderFace(var ADescription: TFaceRenderingDescription; + AComputeCoordinate: TComputeProjectionFunc): boolean; +var + NormalCenter3D,PtCenter3D: TPoint3D_128; + ColorCenter: TBGRAPixel; + + procedure ComputeCenter; + var j: Int32or64; + begin + with ADescription do + begin + PtCenter3D := Point3D_128_Zero; + NormalCenter3D := Point3D_128_Zero; + for j := 0 to NbVertices-1 do + begin + PtCenter3D.Offset(Positions3D[j]); + NormalCenter3D.Offset(Normals3D[j]); + end; + PtCenter3D.Scale(1/NbVertices); + Normalize3D_128(NormalCenter3D); + ColorCenter := MergeBGRA(slice(Colors,NbVertices)); + end; + end; + +var tex: IBGLTexture; + i,j: Int32or64; +begin + result := true; + + if not ProjectionDefined then + raise exception.Create('Projection must be defined before drawing faces'); + + If ADescription.Texture <> nil then + tex := ADescription.Texture.GetTextureGL as IBGLTexture + else + tex := nil; + + with ADescription do + begin + if ADescription.Biface then + FCanvas.FaceCulling := fcNone + else + FCanvas.FaceCulling := fcKeepCW; + + if ADescription.Material.GetSpecularOn then + FLightingGL.SetSpecularIndex(ADescription.Material.GetSpecularIndex) + else + FLightingGL.SetSpecularIndex(0); + + if tex <> nil then + begin + FCanvas.Lighting.ActiveShader := FShaderWithTexture; + + if Assigned(FBGRAShader) then + begin + FBGRAShader.Prepare(ADescription); + + if length(FShadedColorsF) < NbVertices then + setlength(FShadedColorsF, NbVertices); + for i := 0 to NbVertices-1 do + FShadedColorsF[i] := BGRAToColorF(ColorIntToBGRA(FBGRAShader.Int65536Apply(Positions3D[i],Normals3D[i],BGRAWhite), true), false); + + for i := 0 to NbVertices-1 do + Positions3D[i].z := -Positions3D[i].z; + + if NbVertices = 3 then + tex.DrawTriangle(slice(Positions3D,3),slice(TexCoords,3),slice(FShadedColorsF,3)) + else if NbVertices = 4 then + tex.DrawQuad(slice(Positions3D,4),slice(TexCoords,4),slice(FShadedColorsF,4)); + end else + begin + for i := 0 to NbVertices-1 do + begin + Positions3D[i].z := -Positions3D[i].z; + Normals3D[i].z := -Normals3D[i].z; + end; + + if NbVertices = 3 then + tex.DrawTriangle(slice(Positions3D,3),slice(Normals3D,3),slice(TexCoords,3)) + else if NbVertices = 4 then + tex.DrawQuad(slice(Positions3D,4),slice(Normals3D,4),slice(TexCoords,4)); + end; + end + else + begin + FCanvas.Lighting.ActiveShader := FShader; + + if Assigned(FBGRAShader) then + begin + FBGRAShader.Prepare(ADescription); + + if length(FShadedColors) < NbVertices then + setlength(FShadedColors, NbVertices); + for i := 0 to NbVertices-1 do + FShadedColors[i] := FBGRAShader.Apply(Positions3D[i],Normals3D[i],Colors[i]); + + if NbVertices > 4 then + begin + ComputeCenter; + ColorCenter := FBGRAShader.Apply(PtCenter3D,NormalCenter3D,MergeBGRA(slice(Colors,NbVertices))); + + for i := 0 to NbVertices-1 do + Positions3D[i].z := -Positions3D[i].z; + PtCenter3D.z := -PtCenter3D.z; + + i := NbVertices-1; + for j := 0 to NbVertices-1 do + begin + FCanvas.FillTrianglesLinearColor( + [Positions3D[i],Positions3D[j],PtCenter3D], + [FShadedColors[i],FShadedColors[j],ColorCenter]); + i := j; + end; + end else + begin + for i := 0 to NbVertices-1 do + Positions3D[i].z := -Positions3D[i].z; + + if NbVertices = 3 then + FCanvas.FillTrianglesLinearColor(slice(Positions3D,3),slice(FShadedColors,3)) + else if NbVertices = 4 then + FCanvas.FillQuadsLinearColor(slice(Positions3D,4),slice(FShadedColors,4)); + end; + end else + begin + for i := 0 to NbVertices-1 do + begin + Positions3D[i].z := -Positions3D[i].z; + Normals3D[i].z := -Normals3D[i].z; + end; + + if NbVertices > 4 then + begin + ComputeCenter; + + i := NbVertices-1; + for j := 0 to NbVertices-1 do + begin + FCanvas.FillTrianglesLinearColor( + [Positions3D[i],Positions3D[j],PtCenter3D], + [Normals3D[i],Normals3D[j],NormalCenter3D], + [Colors[i],Colors[j],ColorCenter]); + i := j; + end; + end else + begin + if NbVertices = 3 then + FCanvas.FillTrianglesLinearColor(slice(Positions3D,3),slice(Normals3D,3),slice(Colors,3)) + else if NbVertices = 4 then + FCanvas.FillQuadsLinearColor(slice(Positions3D,4),slice(Normals3D,4),slice(Colors,4)); + end; + end; + end; + end; +end; + +destructor TBGLRenderer3D.Destroy; +begin + FreeAndNil(FBGRAShader); + FCanvas.Lighting.ActiveShader := nil; + FCanvas.ProjectionMatrix := FOldProjection; + FCanvas.Matrix := FOldMatrix; + FCanvas.FaceCulling := FOldCulling; + FreeAndNil(FLightingGL); + if FHasZBuffer then FCanvas.EndZBuffer; + FLights.Free; + inherited Destroy; +end; + + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraopengltype.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengltype.pas new file mode 100644 index 0000000..668b0b2 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraopengltype.pas @@ -0,0 +1,1753 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAOpenGLType; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAGraphics, BGRABitmap, BGRABitmapTypes, + FPimage, BGRAClasses, SysUtils, BGRATransform, + BGRASSE, BGRAMatrix3D; + +type + TBGLTextureHandle = type Pointer; + TOpenGLResampleFilter = (orfBox,orfLinear); + TOpenGLBlendMode = (obmNormal, obmAdd, obmMultiply); + TWaitForGPUOption = (wfgQueueAllCommands, wfgFinishAllCommands); + TFaceCulling = BGRABitmapTypes.TFaceCulling; + TOpenGLPrimitive = (opPoints,opLineStrip,opLineLoop,opLines, + opTriangleStrip,opTriangleFan,opTriangles); + +const + fcNone = BGRABitmapTypes.fcNone; + fcKeepCW = BGRABitmapTypes.fcKeepCW; + fcKeepCCW = BGRABitmapTypes.fcKeepCCW; + +type + + { IBGLFont } + + IBGLFont = interface + function GetClipped: boolean; + function GetPadding: TRectF; + function GetUseGradientColors: boolean; + function GetHorizontalAlign: TAlignment; + function GetJustify: boolean; + function GetScale: single; + function GetStepX: single; + function GetVerticalAlign: TTextLayout; + procedure SetClipped(AValue: boolean); + procedure SetPadding(AValue: TRectF); + procedure SetUseGradientColors(AValue: boolean); + procedure SetHorizontalAlign(AValue: TAlignment); + procedure SetJustify(AValue: boolean); + procedure SetScale(AValue: single); + procedure SetStepX(AValue: single); + procedure SetVerticalAlign(AValue: TTextLayout); + procedure TextOut(X, Y: Single; const Text : UTF8String); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + function TextWidth(const Text: UTF8String): single; + function TextHeight(const Text: UTF8String): single; overload; + function TextHeight(const Text: UTF8String; AWidth: single): single; overload; + procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); + + property Scale: single read GetScale write SetScale; + property StepX: single read GetStepX write SetStepX; + property Justify: boolean read GetJustify write SetJustify; + property Clipped: boolean read GetClipped write SetClipped; + property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; + property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; + property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; + property Padding: TRectF read GetPadding write SetPadding; + end; + + { TBGLCustomFont } + + TBGLCustomFont = class(TInterfacedObject, IBGLFont) + protected + FScale, FStepX: single; + FPadding: TRectF; + FFlags: LongWord; + FHorizontalAlign: TAlignment; + FVerticalAlign: TTextLayout; + FJustify: boolean; + procedure Init; virtual; + function LoadFromFile(AFilename: UTF8String): boolean; virtual; abstract; + procedure FreeMemoryOnDestroy; virtual; + + function GetScale: single; virtual; + function GetStepX: single; virtual; + procedure SetScale(AValue: single); virtual; + procedure SetStepX(AValue: single); virtual; + function GetPadding: TRectF; + procedure SetPadding(AValue: TRectF); virtual; + + function GetHorizontalAlign: TAlignment; virtual; + function GetJustify: boolean; virtual; + function GetVerticalAlign: TTextLayout; virtual; + procedure SetHorizontalAlign(AValue: TAlignment); virtual; + procedure SetJustify(AValue: boolean); virtual; + procedure SetVerticalAlign(AValue: TTextLayout); virtual; + + function GetClipped: boolean; virtual; abstract; + function GetUseGradientColors: boolean; virtual; abstract; + procedure SetClipped(AValue: boolean); virtual; abstract; + procedure SetUseGradientColors(AValue: boolean); virtual; abstract; + + procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract; + procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract; + + function GetDefaultColor: TBGRAPixel; virtual; + procedure SwapRectIfNeeded(var ARect: TRectF); overload; + procedure SwapRectIfNeeded(var ARect: TRect); overload; + public + constructor Create(AFilename: UTF8String); + procedure FreeMemory; virtual; + destructor Destroy; override; + procedure TextOut(X, Y: Single; const Text : UTF8String); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; + procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + function TextWidth(const Text: UTF8String): single; virtual; abstract; + function TextHeight(const Text: UTF8String): single; overload; virtual; abstract; + function TextHeight(const Text: UTF8String; AWidth: single): single; overload; virtual; abstract; + procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); virtual; abstract; + + property Scale: single read GetScale write SetScale; + property StepX: single read GetStepX write SetStepX; + property Justify: boolean read GetJustify write SetJustify; + property Clipped: boolean read GetClipped write SetClipped; + property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; + property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; + property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; + property Padding: TRectF read GetPadding write SetPadding; + end; + + { IBGLTexture } + + IBGLTexture = interface ['{BF2FF051-EBC6-4102-8268-37A9D0297B92}'] + function GetFlipX: IBGLTexture; + function GetFlipY: IBGLTexture; + function GetFrame(AIndex: integer): IBGLTexture; + function GetFrameCount: integer; + function GetFrameHeight: integer; + function GetFrameWidth: integer; + function GetHeight: integer; + function GetImageCenter: TPointF; + function GetMask: IBGLTexture; + function GetOpenGLBlendMode: TOpenGLBlendMode; + function GetOpenGLTexture: TBGLTextureHandle; + function GetResampleFilter: TOpenGLResampleFilter; + function GetUseGradientColors: boolean; + function GetWidth: integer; + + procedure SetFrameSize(x,y: integer); + procedure SetImageCenter(const AValue: TPointF); + procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode); + procedure SetResampleFilter(AValue: TOpenGLResampleFilter); + procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); + procedure SetUseGradientColors(AValue: boolean); + procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); + procedure ToggleFlipX; + procedure ToggleFlipY; + procedure ToggleMask; + function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; + function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; + procedure SetFrame(AIndex: integer); + procedure FreeMemory; + procedure Bind(ATextureNumber: integer); + + procedure Draw(x,y: single; AAlpha: byte = 255); overload; + procedure Draw(x,y: single; AColor: TBGRAPixel); overload; + procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload; + procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload; + procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload; + procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload; + procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; + procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; + procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + + property Width: integer read GetWidth; + property Height: integer read GetHeight; + property FrameCount: integer read GetFrameCount; + property Frame[AIndex: integer]: IBGLTexture read GetFrame; + property FrameWidth: integer read GetFrameWidth; + property FrameHeight: integer read GetFrameHeight; + property FlipX: IBGLTexture read GetFlipX; + property FlipY: IBGLTexture read GetFlipY; + property Mask: IBGLTexture read GetMask; + property Handle: TBGLTextureHandle read GetOpenGLTexture; + property ImageCenter: TPointF read GetImageCenter write SetImageCenter; + property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter; + property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode; + property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; + end; + + { TBGLCustomBitmap } + + TBGLCustomBitmap = class(TBGRABitmap) + protected + FActualWidth,FActualHeight, + FAllocatedWidth,FAllocatedHeight: integer; + FTextureInvalidated: boolean; + FActualRect: TRect; + FTexture: IBGLTexture; + procedure Init; override; + function GetTexture: IBGLTexture; virtual; + function GetOpenGLMaxTexSize: integer; virtual; abstract; + procedure NotifySizeTooBigForOpenGL; virtual; + procedure NotifyOpenGLContextNotCreatedYet; virtual; + function GetTextureGL: IUnknown; override; + procedure SwapRedBlueWithoutInvalidate(ARect: TRect); + procedure SetClipRect(const AValue: TRect); override; + public + procedure InvalidateBitmap; override; + procedure Fill(const c: TBGRAPixel); override; + procedure NoClip; override; + destructor Destroy; override; + procedure SwapRedBlue; overload; override; + function Resample(newWidth, newHeight: integer; mode: TResampleMode=rmFineResample): TBGLCustomBitmap; override; + procedure ApplyGlobalOpacity(alpha: byte); overload; override; + procedure ReplaceColor(before, after: TColor); overload; override; + procedure ReplaceColor(const ABefore, AAfter: TBGRAPixel); overload; override; + procedure ReplaceTransparent(const AAfter: TBGRAPixel); overload; override; + procedure SetSize(AWidth, AHeight: integer); override; + property Width: integer read FActualWidth; + property Height: integer read FActualHeight; + property AllocatedWidth: integer read FAllocatedWidth; + property AllocatedHeight: integer read FAllocatedHeight; + function MakeTextureAndFree: IBGLTexture; + property Texture: IBGLTexture read GetTexture; + property MaxTextureSize: integer read GetOpenGLMaxTexSize; + end; + + { TBGLCustomTexture } + + TBGLCustomTexture = class(TInterfacedObject, IBGLTexture) + private + function GetFlipX: IBGLTexture; + function GetFlipY: IBGLTexture; + function GetFrame(AIndex: integer): IBGLTexture; + function GetFrameCount: integer; + function GetFrameHeight: integer; + function GetFrameWidth: integer; + function GetHeight: integer; + function GetMask: IBGLTexture; + function GetOpenGLBlendMode: TOpenGLBlendMode; + function GetOpenGLTexture: TBGLTextureHandle; + function GetWidth: integer; + function GetImageCenter: TPointF; + procedure SetImageCenter(const AValue: TPointF); + function GetResampleFilter: TOpenGLResampleFilter; + procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode); + procedure SetResampleFilter(AValue: TOpenGLResampleFilter); + protected + FOpenGLTexture: TBGLTextureHandle; + FOpenGLTextureOwned: boolean; + FResampleFilter: TOpenGLResampleFilter; + FWidth,FHeight: integer; + FImageCenter: TPointF; + FFrame: integer; + FFrameWidth,FFrameHeight: integer; + FIsMask: boolean; + FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel; + FUseGradientColor: boolean; + FBlendMode: TOpenGLBlendMode; + + function GetOpenGLMaxTexSize: integer; virtual; abstract; + function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; virtual; abstract; + procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); virtual; abstract; + class function SupportsBGRAOrder: boolean; virtual; + procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); virtual; abstract; + procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); virtual; abstract; + function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; virtual; abstract; + function GetEmptyTexture: TBGLTextureHandle; virtual; abstract; + procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); virtual; abstract; + procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); virtual; abstract; + function GetUseGradientColors: boolean; virtual; + procedure SetUseGradientColors(AValue: boolean); virtual; + + procedure DoDrawTriangleOrQuad(const {%H-}Points: array of TPointF; + const {%H-}APointsZ: array of Single; const {%H-}APoints3D: array of TPoint3D_128; + const {%H-}ANormals3D: array of TPoint3D_128; const {%H-}TexCoords: array of TPointF; + const {%H-}AColors: array of TColorF); virtual; + procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); virtual; abstract; + procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); virtual; abstract; + procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); virtual; abstract; + function NewEmpty: TBGLCustomTexture; virtual; abstract; + function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; virtual; abstract; + procedure NotifyInvalidFrameSize; virtual; + procedure NotifyErrorLoadingFile({%H-}AFilename: string); virtual; + + procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); virtual; + function Duplicate: TBGLCustomTexture; virtual; + procedure FreeMemoryOnDestroy; virtual; + + procedure InitEmpty; + procedure InitFromData(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean); + procedure InitFromStream(AStream: TStream); + public + destructor Destroy; override; + constructor Create; overload; + constructor Create(ATexture: TBGLTextureHandle; AWidth,AHeight: integer); overload; + constructor Create(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); overload; + constructor Create(AFPImage: TFPCustomImage); overload; + constructor Create(ABitmap: TBitmap); overload; + constructor Create(AWidth, AHeight: integer; Color: TColor); overload; + constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); overload; + constructor Create(AFilenameUTF8: string); overload; + constructor Create(AFilenameUTF8: string; AWidth,AHeight: integer; AResampleFilter: TResampleFilter); overload; + constructor Create(AStream: TStream); overload; + procedure ToggleFlipX; virtual; abstract; + procedure ToggleFlipY; virtual; abstract; + procedure ToggleMask; virtual; + function FilterBlurMotion({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType; {%H-}ADirection: TPointF): IBGLTexture; virtual; + function FilterBlurRadial({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType): IBGLTexture; virtual; + + procedure SetFrameSize(x,y: integer); + procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); + procedure SetFrame(AIndex: integer); + procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); + procedure FreeMemory; + procedure Bind({%H-}ATextureNumber: integer); virtual; + + procedure Draw(x,y: single; AAlpha: byte = 255); overload; + procedure Draw(x,y: single; AColor: TBGRAPixel); overload; + procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload; + procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload; + procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload; + procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; + procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; + procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload; + procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload; + procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; + procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; + procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; + procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; + + property Width: integer read GetWidth; + property Height: integer read GetHeight; + property FrameCount: integer read GetFrameCount; + property Frame[AIndex: integer]: IBGLTexture read GetFrame; + property FrameWidth: integer read GetFrameWidth; + property FrameHeight: integer read GetFrameHeight; + property FlipX: IBGLTexture read GetFlipX; + property FlipY: IBGLTexture read GetFlipY; + property Mask: IBGLTexture read GetMask; + property Handle: TBGLTextureHandle read GetOpenGLTexture; + property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter; + property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode; + property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; + end; + + { TBGLCustomFrameBuffer } + + TBGLCustomFrameBuffer = class + protected + FCanvas: pointer; + function GetTexture: IBGLTexture; virtual; abstract; + function GetHandle: pointer; virtual; abstract; + function GetMatrix: TAffineMatrix; virtual; abstract; + function GetHeight: integer; virtual; abstract; + function GetProjectionMatrix: TMatrix4D; virtual; abstract; + function GetWidth: integer; virtual; abstract; + procedure SetMatrix(AValue: TAffineMatrix); virtual; abstract; + procedure SetProjectionMatrix(AValue: TMatrix4D); virtual; abstract; + + public + procedure UseOrthoProjection; overload; virtual; + procedure UseOrthoProjection(AMinX,AMinY,AMaxX,AMaxY: single); overload; virtual; + function MakeTextureAndFree: IBGLTexture; virtual; + + procedure SetCanvas(ACanvas: Pointer); //for internal use + property Matrix: TAffineMatrix read GetMatrix write SetMatrix; + property ProjectionMatrix: TMatrix4D read GetProjectionMatrix write SetProjectionMatrix; + property Width: integer read GetWidth; + property Height: integer read GetHeight; + property Handle: pointer read GetHandle; + property Texture: IBGLTexture read GetTexture; + end; + +type + TBGLBitmapAny = class of TBGLCustomBitmap; + TBGLTextureAny = class of TBGLCustomTexture; + +var + BGLBitmapFactory : TBGLBitmapAny; + BGLTextureFactory: TBGLTextureAny; + +function OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY: Single): TMatrix4D; +function GetPowerOfTwo( Value : Integer ) : Integer; + +implementation + +uses BGRAFilterScanner; + +procedure TBGLCustomFrameBuffer.UseOrthoProjection; +begin + ProjectionMatrix := OrthoProjectionToOpenGL(0,0,Width,Height); +end; + +procedure TBGLCustomFrameBuffer.UseOrthoProjection(AMinX, AMinY, AMaxX, AMaxY: single); +begin + ProjectionMatrix := OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY); +end; + +function TBGLCustomFrameBuffer.MakeTextureAndFree: IBGLTexture; +begin + result := nil; + raise exception.create('Not implemented'); +end; + +procedure TBGLCustomFrameBuffer.SetCanvas(ACanvas: Pointer); +begin + FCanvas := ACanvas; +end; + +function OrthoProjectionToOpenGL(AMinX, AMinY, AMaxX, AMaxY: Single): TMatrix4D; +var sx,sy: single; +begin + sx := 2/(AMaxX-AMinX); + sy := 2/(AMaxY-AMinY); + result[1,1] := sx; result[2,1] := 0; result[3,1] := 0; result[4,1] := -1 - AMinX*sx; + result[1,2] := 0; result[2,2] := -sy; result[3,2] := 0; result[4,2] := 1 + AMinY*sy; + result[1,3] := 0; result[2,3] := 0; result[3,3] := -1; result[4,3] := 0; + result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; +end; + +function GetPowerOfTwo( Value : Integer ) : Integer; +begin + Result := Value - 1; + Result := Result or ( Result shr 1 ); + Result := Result or ( Result shr 2 ); + Result := Result or ( Result shr 4 ); + Result := Result or ( Result shr 8 ); + Result := Result or ( Result shr 16 ); + Result := Result + 1; +end; + +{ TBGLCustomTexture } + +function TBGLCustomTexture.GetFlipX: IBGLTexture; +begin + result := Duplicate; + result.ToggleFlipX; +end; + +function TBGLCustomTexture.GetFlipY: IBGLTexture; +begin + result := Duplicate; + result.ToggleFlipY; +end; + +function TBGLCustomTexture.GetFrame(AIndex: integer): IBGLTexture; +var fc: integer; +begin + fc := GetFrameCount; + if fc <= 1 then + result := self + else + begin + if (AIndex < 1) or (AIndex > fc) then + result := NewEmpty + else + begin + result := Duplicate; + result.SetFrame(AIndex); + end; + end; +end; + +function TBGLCustomTexture.GetFrameCount: integer; +begin + result := GetOpenGLFrameCount(FOpenGLTexture); +end; + +function TBGLCustomTexture.GetFrameHeight: integer; +begin + result := FFrameHeight; +end; + +function TBGLCustomTexture.GetFrameWidth: integer; +begin + result := FFrameWidth; +end; + +function TBGLCustomTexture.GetHeight: integer; +begin + result := FHeight; +end; + +function TBGLCustomTexture.GetMask: IBGLTexture; +begin + result := Duplicate; + result.ToggleMask; +end; + +function TBGLCustomTexture.GetOpenGLBlendMode: TOpenGLBlendMode; +begin + result := FBlendMode; +end; + +function TBGLCustomTexture.GetOpenGLTexture: TBGLTextureHandle; +begin + result := FOpenGLTexture; +end; + +function TBGLCustomTexture.GetUseGradientColors: boolean; +begin + result := FUseGradientColor; +end; + +function TBGLCustomTexture.GetWidth: integer; +begin + result := FWidth; +end; + +function TBGLCustomTexture.GetImageCenter: TPointF; +begin + result := FImageCenter; +end; + +procedure TBGLCustomTexture.SetImageCenter(const AValue: TPointF); +begin + FImageCenter := AValue; +end; + +function TBGLCustomTexture.GetResampleFilter: TOpenGLResampleFilter; +begin + result := FResampleFilter; +end; + +procedure TBGLCustomTexture.SetOpenGLBlendMode(AValue: TOpenGLBlendMode); +begin + FBlendMode := AValue; +end; + +procedure TBGLCustomTexture.SetResampleFilter(AValue: TOpenGLResampleFilter); +begin + if AValue <> FResampleFilter then + begin + FResampleFilter:= AValue; + UpdateGLResampleFilter(FOpenGLTexture, AValue); + end; +end; + +class function TBGLCustomTexture.SupportsBGRAOrder: boolean; +begin + result := false; +end; + +procedure TBGLCustomTexture.SetUseGradientColors(AValue: boolean); +begin + FUseGradientColor := AValue; +end; + +procedure TBGLCustomTexture.DoDrawTriangleOrQuad( + const Points: array of TPointF; const APointsZ: array of Single; + const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; const TexCoords: array of TPointF; + const AColors: array of TColorF); +begin + raise Exception.Create('Not implemented'); +end; + +procedure TBGLCustomTexture.ToggleMask; +begin + FIsMask := not FIsMask; +end; + +function TBGLCustomTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; + ADirection: TPointF): IBGLTexture; +begin + result := nil; + raise exception.Create('Not implemented'); +end; + +function TBGLCustomTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; +begin + result := nil; + raise exception.Create('Not implemented'); +end; + +procedure TBGLCustomTexture.Update(ARGBAData: PLongWord; AllocatedWidth, + AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean); +begin + UpdateOpenGLTexture(FOpenGLTexture, ARGBAData, AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight,RGBAOrder); + ComputeOpenGLFramesCoord(FOpenGLTexture, round(FWidth/FFrameWidth),round(FWidth/FFrameHeight)); + FWidth := ActualWidth; + FHeight := ActualHeight; + FImageCenter := PointF(FWidth*0.5,FHeight*0.5); +end; + +procedure TBGLCustomTexture.SetFrame(AIndex: integer); +begin + if (AIndex >= 1) and (AIndex <= GetFrameCount) then + begin + FFrame := AIndex; + FWidth := FFrameWidth; + FHeight:= FFrameHeight; + FImageCenter := PointF(FWidth*0.5,FHeight*0.5); + end; +end; + +procedure TBGLCustomTexture.SetGradientColors(ATopLeft, ATopRight, + ABottomRight, ABottomLeft: TBGRAPixel); +begin + FGradTopLeft := ATopLeft; + FGradTopRight := ATopRight; + FGradBottomLeft := ABottomLeft; + FGradBottomRight := ABottomRight; + GradientColors := true; +end; + +procedure TBGLCustomTexture.FreeMemory; +begin + if FOpenGLTextureOwned then + begin + FreeOpenGLTexture(FOpenGLTexture); + FOpenGLTexture := GetEmptyTexture; + FOpenGLTextureOwned := false; + end; +end; + +procedure TBGLCustomTexture.Bind(ATextureNumber: integer); +begin + raise Exception.Create('Not implemented'); +end; + +procedure TBGLCustomTexture.NotifyInvalidFrameSize; +begin + // +end; + +procedure TBGLCustomTexture.NotifyErrorLoadingFile(AFilename: string); +begin + // +end; + +procedure TBGLCustomTexture.Init(ATexture: TBGLTextureHandle; AWidth, + AHeight: integer; AOwned: boolean); +begin + FOpenGLTexture:= ATexture; + FWidth := AWidth; + FHeight := AHeight; + FImageCenter := PointF(FWidth*0.5,FHeight*0.5); + FFrame:= 0; + FFrameWidth := AWidth; + FFrameHeight := AHeight; + FIsMask:= false; + FOpenGLTextureOwned := AOwned; +end; + +function TBGLCustomTexture.Duplicate: TBGLCustomTexture; +begin + result := NewFromTexture(FOpenGLTexture, FWidth, FHeight); + result.FFrame := FFrame; + result.FFrameWidth := FFrameWidth; + result.FFrameHeight := FFrameHeight; + result.FIsMask := FIsMask; + result.FResampleFilter := FResampleFilter; + result.FGradTopLeft := FGradTopLeft; + result.FGradTopRight := FGradTopRight; + result.FGradBottomRight := FGradBottomRight; + result.FGradBottomLeft := FGradBottomLeft; + result.FUseGradientColor := FUseGradientColor; + result.FBlendMode := FBlendMode; +end; + +procedure TBGLCustomTexture.FreeMemoryOnDestroy; +begin + FreeMemory; +end; + +procedure TBGLCustomTexture.InitEmpty; +begin + Init(GetEmptyTexture,0,0,False); +end; + +procedure TBGLCustomTexture.InitFromData(ARGBAData: PLongWord; + AllocatedWidth, AllocatedHeight, ActualWidth, ActualHeight: integer; + RGBAOrder: boolean); +var tex: TBGLTextureHandle; + MaxTexSize: integer; +begin + MaxTexSize := GetOpenGLMaxTexSize; + if ( AllocatedWidth > MaxTexSize ) or ( AllocatedHeight > MaxTexSize ) or + (AllocatedWidth <= 0) or (AllocatedHeight <= 0) then + InitEmpty + else + begin + tex := CreateOpenGLTexture(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder); + FResampleFilter := orfLinear; + ComputeOpenGLFramesCoord(tex); + Init(tex,ActualWidth,ActualHeight,True); + end; +end; + +procedure TBGLCustomTexture.InitFromStream(AStream: TStream); +var bmp: TBGLCustomBitmap; +begin + bmp := nil; + try + bmp := BGLBitmapFactory.Create(AStream); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height,TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + except + InitEmpty; + end; + bmp.Free; +end; + +destructor TBGLCustomTexture.Destroy; +begin + FreeMemoryOnDestroy; + inherited Destroy; +end; + +constructor TBGLCustomTexture.Create; +begin + InitEmpty; +end; + +constructor TBGLCustomTexture.Create(ATexture: TBGLTextureHandle; AWidth, + AHeight: integer); +begin + Init(ATexture, AWidth,AHeight, False); +end; + +constructor TBGLCustomTexture.Create(ARGBAData: PLongWord; AllocatedWidth, + AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean); +begin + InitFromData(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder); +end; + +constructor TBGLCustomTexture.Create(AFPImage: TFPCustomImage); +var bmp: TBGLCustomBitmap; +begin + if (AFPImage is TBGRACustomBitmap) and + (AFPImage.Width = GetPowerOfTwo(AFPImage.Width)) and + (AFPImage.Height = GetPowerOfTwo(AFPImage.Height)) then + begin + with TBGRACustomBitmap(AFPImage) do + begin + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue; + if LineOrder = riloBottomToTop then VerticalFlip; + InitFromData(PLongWord(Data), Width,Height, Width,Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + if LineOrder = riloBottomToTop then VerticalFlip; + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue; + end; + end else + begin + bmp := BGLBitmapFactory.Create(AFPImage); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + bmp.Free; + end; +end; + +constructor TBGLCustomTexture.Create(ABitmap: TBitmap); +var bmp: TBGLCustomBitmap; +begin + bmp := BGLBitmapFactory.Create(ABitmap); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + bmp.Free; +end; + +constructor TBGLCustomTexture.Create(AWidth, AHeight: integer; Color: TColor); +var bmp: TBGLCustomBitmap; +begin + bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + bmp.Free; +end; + +constructor TBGLCustomTexture.Create(AWidth, AHeight: integer; + Color: TBGRAPixel); +var bmp: TBGLCustomBitmap; +begin + bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + bmp.Free; +end; + +constructor TBGLCustomTexture.Create(AFilenameUTF8: string); +var bmp: TBGLCustomBitmap; +begin + bmp := nil; + try + bmp := BGLBitmapFactory.Create(AFilenameUTF8, True); + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); + except + InitEmpty; + NotifyErrorLoadingFile(AFilenameUTF8); + end; + bmp.Free; +end; + +constructor TBGLCustomTexture.Create(AFilenameUTF8: string; AWidth, + AHeight: integer; AResampleFilter: TResampleFilter); +var bmp, temp: TBGLCustomBitmap; +begin + bmp := nil; + try + bmp := BGLBitmapFactory.Create(AFilenameUTF8, True); + if (bmp.Width <> AWidth) or (bmp.Height <> AHeight) then + begin + if AResampleFilter = rfBox then + temp := bmp.Resample(AWidth,AHeight,rmSimpleStretch) as TBGLCustomBitmap + else + begin + bmp.ResampleFilter := AResampleFilter; + temp := bmp.Resample(AWidth,AHeight) as TBGLCustomBitmap; + end; + bmp.Free; + bmp := temp; + temp := nil; + end; + if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; + InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder); + except + InitEmpty; + NotifyErrorLoadingFile(AFilenameUTF8); + end; + bmp.Free; +end; + +constructor TBGLCustomTexture.Create(AStream: TStream); +begin + InitFromStream(AStream); +end; + +procedure TBGLCustomTexture.SetFrameSize(x, y: integer); +begin + if (FWidth = 0) or (FHeight = 0) then exit; + if (x <= 0) or (y <= 0) or (x > FWidth) or (y > FHeight) then + begin + NotifyInvalidFrameSize; + exit; + end; + ComputeOpenGLFramesCoord(FOpenGLTexture, FWidth div x,FHeight div y); + FFrameWidth:= x; + FFrameHeight:= y; +end; + +procedure TBGLCustomTexture.Draw(x, y: single; AAlpha: byte); +begin + DoStretchDraw(x,y,FWidth,FHeight,BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.Draw(x, y: single; AColor: TBGRAPixel); +begin + DoStretchDraw(x,y,FWidth,FHeight,AColor); +end; + +procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; AAlpha: byte); +begin + Draw(x,y, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + StretchDraw(x,y, FWidth,FHeight, AHorizAlign,AVertAlign, AColor); +end; + +procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; AAlpha: byte); +begin + DoStretchDraw(x,y,w,h, BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; + AColor: TBGRAPixel); +begin + DoStretchDraw(x,y,w,h,AColor); +end; + +procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); +begin + StretchDraw(x,y,w,h, AHorizAlign,AVertAlign, BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + case AHorizAlign of + taCenter: DecF(x, w*0.5); + taRightJustify: DecF(x, w-1); + end; + case AVertAlign of + tlCenter: DecF(y, h*0.5); + tlBottom: DecF(y, h); + end; + DoStretchDraw(x,y,w,h,AColor); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; + const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte); +begin + StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; + const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); +begin + StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,AColor); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AAlpha: byte); +begin + StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AAlpha); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AColor: TBGRAPixel); +begin + StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AColor); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); +begin + StretchDrawAngle(x,y,FWidth,FHeight,angleDeg, AHorizAlign, AVertAlign, AAlpha); +end; + +procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + StretchDrawAngle(x,y,FWidth,FHeight, angleDeg, AHorizAlign, AVertAlign, AColor); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; + const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte); +begin + StretchDrawAngle(x,y,w,h,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; + const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); +var + rotationCenter: TPointF; +begin + if (FWidth=0) or (FHeight = 0) then exit; + rotationCenter := PointF(imageCenter.x*w/FWidth, imageCenter.y*h/FHeight); + if not ARestoreOffsetAfterRotation then + begin + DecF(x, rotationCenter.x); + DecF(y, rotationCenter.y); + end; + DoStretchDrawAngle(x,y,w,h,angleDeg,rotationCenter+PointF(x,y),AColor); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; AAlpha: byte); +begin + StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; + AColor: TBGRAPixel); +begin + StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, AColor); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); +begin + StretchDrawAngle(x,y,w,h,angleDeg, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +var imageCenter: TPointF; +begin + case AHorizAlign of + taCenter: imageCenter.x := FWidth*0.5; + taRightJustify: imageCenter.x := FWidth; + else imageCenter.x := 0; + end; + case AVertAlign of + tlCenter: imageCenter.y := FHeight*0.5; + tlBottom: imageCenter.y := FHeight; + else imageCenter.y := 0; + end; + StretchDrawAngle(x,y,w,h, angleDeg, imageCenter, False, AColor); +end; + +procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF; + AAlpha: byte); +begin + {$PUSH}{$OPTIMIZATION OFF} + DoDrawAffine(Origin,HAxis,VAxis, BGRA(255,255,255,AAlpha)); + {$POP} +end; + +procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF; + AColor: TBGRAPixel); +begin + {$PUSH}{$OPTIMIZATION OFF} + DoDrawAffine(Origin,HAxis,VAxis, AColor); + {$POP} +end; + +procedure TBGLCustomTexture.DrawAffine(x, y: single; + const AMatrix: TAffineMatrix; AAlpha: byte); +begin + DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y), + AMatrix*PointF(0,Height) + PointF(x,y), BGRA(255,255,255,AAlpha)); +end; + +procedure TBGLCustomTexture.DrawAffine(x, y: single; + const AMatrix: TAffineMatrix; AColor: TBGRAPixel); +begin + DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y), + AMatrix*PointF(0,Height) + PointF(x,y), AColor); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; + const ATexCoords: array of TPointF); +begin + if (length(APoints) = 3) and (length(ATexCoords) = 3) then + DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; + const ATexCoords: array of TPointF; const AColors: array of TColorF); +begin + if (length(APoints) = 3) and (length(ATexCoords) = 3) + and (length(AColors) = 3) then + DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; + const APointsZ: array of Single; const ATexCoords: array of TPointF); +begin + if (length(APoints) = 3) and (length(ATexCoords) = 3) + and (length(APointsZ) = 3) then + DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; + const APointsZ: array of Single; const ATexCoords: array of TPointF; + const AColors: array of TColorF); +begin + if (length(APoints) = 3) and (length(ATexCoords) = 3) + and (length(APointsZ) = 3) and (length(AColors) = 3) then + DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawTriangle( + const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); +begin + if (length(APoints3D) = 3) and (length(ATexCoords) = 3) then + DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawTriangle( + const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; + const AColors: array of TColorF); +begin + if (length(APoints3D) = 3) and (length(ATexCoords) = 3) + and (length(AColors) = 3) then + DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; + const ATexCoords: array of TPointF); +begin + if (length(APoints3D) = 3) and (length(ATexCoords) = 3) + and (length(ANormals3D) = 3) then + DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; + const ATexCoords: array of TPointF; const AColors: array of TColorF); +begin + if (length(APoints3D) = 3) and (length(ATexCoords) = 3) + and (length(ANormals3D) = 3) + and (length(AColors) = 3) then + DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; + const ATexCoords: array of TPointF); +begin + if (length(APoints) = 4) and (length(ATexCoords) = 4) then + DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; + const ATexCoords: array of TPointF; const AColors: array of TColorF); +begin + if (length(APoints) = 4) and (length(ATexCoords) = 4) + and (length(AColors) = 4) then + DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords, AColors); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; + const APointsZ: array of Single; const ATexCoords: array of TPointF); +begin + if (length(APoints) = 4) and (length(ATexCoords) = 4) + and (length(APointsZ) = 4) then + DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; + const APointsZ: array of Single; const ATexCoords: array of TPointF; + const AColors: array of TColorF); +begin + if (length(APoints) = 4) and (length(ATexCoords) = 4) + and (length(APointsZ) = 4) and (length(AColors) = 4) then + DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; + const ATexCoords: array of TPointF); +begin + if (length(APoints3D) = 4) and (length(ATexCoords) = 4) then + DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; + const ATexCoords: array of TPointF; const AColors: array of TColorF); +begin + if (length(APoints3D) = 4) and (length(ATexCoords) = 4) + and (length(AColors) = 4) then + DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; + const ATexCoords: array of TPointF); +begin + if (length(APoints3D) = 4) and (length(ATexCoords) = 4) + and (length(ANormals3D) = 4) then + DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]); +end; + +procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; + const ANormals3D: array of TPoint3D_128; + const ATexCoords: array of TPointF; const AColors: array of TColorF); +begin + if (length(APoints3D) = 4) and (length(ATexCoords) = 4) + and (length(ANormals3D) = 4) + and (length(AColors) = 4) then + DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors); +end; + +{ TBGLCustomFont } + +function TBGLCustomFont.GetScale: single; +begin + result := FScale; +end; + +function TBGLCustomFont.GetStepX: single; +begin + result := FStepX; +end; + +procedure TBGLCustomFont.SetScale(AValue: single); +begin + FScale:= AValue; +end; + +procedure TBGLCustomFont.SetStepX(AValue: single); +begin + FStepX:= AValue; +end; + +function TBGLCustomFont.GetHorizontalAlign: TAlignment; +begin + result := FHorizontalAlign; +end; + +function TBGLCustomFont.GetJustify: boolean; +begin + result := FJustify; +end; + +function TBGLCustomFont.GetVerticalAlign: TTextLayout; +begin + result := FVerticalAlign; +end; + +procedure TBGLCustomFont.SetHorizontalAlign(AValue: TAlignment); +begin + FHorizontalAlign:= AValue; +end; + +procedure TBGLCustomFont.SetJustify(AValue: boolean); +begin + FJustify:= AValue; +end; + +procedure TBGLCustomFont.SetVerticalAlign(AValue: TTextLayout); +begin + FVerticalAlign := AValue; +end; + +function TBGLCustomFont.GetDefaultColor: TBGRAPixel; +begin + result := BGRAWhite; +end; + +procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRectF); +var temp: single; +begin + if ARect.Right < ARect.Left then + begin + temp := ARect.Left; + ARect.Left := ARect.Right; + ARect.Right := temp; + end; + if ARect.Bottom < ARect.Top then + begin + temp := ARect.Top; + ARect.Top := ARect.Bottom; + ARect.Bottom := temp; + end; +end; + +procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRect); +var temp: integer; +begin + if ARect.Right < ARect.Left then + begin + temp := ARect.Left; + ARect.Left := ARect.Right; + ARect.Right := temp; + end; + if ARect.Bottom < ARect.Top then + begin + temp := ARect.Top; + ARect.Top := ARect.Bottom; + ARect.Bottom := temp; + end; +end; + +procedure TBGLCustomFont.SetPadding(AValue: TRectF); +begin + FPadding:=AValue; +end; + +function TBGLCustomFont.GetPadding: TRectF; +begin + result := FPadding; +end; + +procedure TBGLCustomFont.Init; +begin + FScale:= 1; + FStepX:= 0; + FHorizontalAlign:= taLeftJustify; + FVerticalAlign:= tlTop; + FJustify:= false; + FPadding := RectF(1,1,1,1); +end; + +procedure TBGLCustomFont.FreeMemoryOnDestroy; +begin + FreeMemory; +end; + +procedure TBGLCustomFont.FreeMemory; +begin + +end; + +constructor TBGLCustomFont.Create(AFilename: UTF8String); +begin + Init; + LoadFromFile(AFilename); +end; + +destructor TBGLCustomFont.Destroy; +begin + FreeMemoryOnDestroy; + inherited Destroy; +end; + +procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String); +begin + DoTextOut(X,Y,Text,GetDefaultColor); +end; + +procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; + AColor: TBGRAPixel); +begin + DoTextOut(X,Y,Text,AColor); +end; + +procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout); +begin + TextOut(X,Y,Text,AHorizAlign,AVertAlign,GetDefaultColor); +end; + +procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +var PrevHorizAlign: TAlignment; + PrevVertAlign: TTextLayout; +begin + PrevHorizAlign:= GetHorizontalAlign; + PrevVertAlign:= GetVerticalAlign; + SetHorizontalAlign(AHorizAlign); + SetVerticalAlign(AVertAlign); + DoTextOut(X,Y,Text,AColor); + SetHorizontalAlign(PrevHorizAlign); + SetVerticalAlign(PrevVertAlign); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String); +begin + DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,GetDefaultColor); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AColor: TBGRAPixel); +begin + DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AVertAlign: TTextLayout); +begin + TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AVertAlign,GetDefaultColor); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); +var PrevVertAlign: TTextLayout; +begin + PrevVertAlign:= GetVerticalAlign; + SetVerticalAlign(AVertAlign); + DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); + SetVerticalAlign(PrevVertAlign); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout); +begin + TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AHorizAlign,AVertAlign,GetDefaultColor); +end; + +procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; + const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; + AColor: TBGRAPixel); +var PrevHorizAlign: TAlignment; + PrevVertAlign: TTextLayout; + PrevJustify: boolean; +begin + PrevHorizAlign:= GetHorizontalAlign; + PrevVertAlign:= GetVerticalAlign; + PrevJustify := GetJustify; + SetHorizontalAlign(AHorizAlign); + SetVerticalAlign(AVertAlign); + SetJustify(False); + DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); + SetHorizontalAlign(PrevHorizAlign); + SetVerticalAlign(PrevVertAlign); + SetJustify(PrevJustify); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; + AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AColor); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; + AVertAlign: TTextLayout); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AVertAlign); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; + AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AVertAlign, AColor); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AHorizAlign, AVertAlign); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AHorizAlign, AVertAlign, AColor); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; + AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AColor); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; + AVertAlign: TTextLayout); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AVertAlign); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; + AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AVertAlign, AColor); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AHorizAlign, AVertAlign); +end; + +procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); +begin + SwapRectIfNeeded(ARect); + with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, + AHorizAlign, AVertAlign, AColor); +end; + +{ TBGLCustomBitmap } + +procedure TBGLCustomBitmap.Init; +begin + inherited Init; + FTextureInvalidated := true; + FActualRect := rect(0,0,0,0); + FScanWidth := 0; + FScanHeight:= 0; + FTexture := nil; + FLineOrder := riloTopToBottom; +end; + +function TBGLCustomBitmap.GetTexture: IBGLTexture; +begin + if (Width = 0) or (Height = 0) then + result := BGLTextureFactory.Create + else + begin + if FTextureInvalidated then + begin + FTextureInvalidated := false; + if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height)); + if FTexture = nil then + FTexture := BGLTextureFactory.Create(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder) + else + FTexture.Update(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder); + if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height)); + end; + result := FTexture; + end; +end; + +procedure TBGLCustomBitmap.NotifySizeTooBigForOpenGL; +begin + raise exception.Create('Size too big for OpenGL'); +end; + +procedure TBGLCustomBitmap.NotifyOpenGLContextNotCreatedYet; +begin + raise exception.Create('OpenGL context has not been created yet'); +end; + +function TBGLCustomBitmap.GetTextureGL: IUnknown; +begin + Result:=GetTexture; +end; + +procedure TBGLCustomBitmap.SwapRedBlueWithoutInvalidate(ARect: TRect); +var y: Int32or64; + p: PBGRAPixel; +begin + if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; + for y := ARect.Top to ARect.Bottom-1 do + begin + p := GetScanlineFast(y)+ARect.Left; + TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(p,p, ARect.Right-ARect.Left, False); + end; +end; + +procedure TBGLCustomBitmap.InvalidateBitmap; +begin + inherited InvalidateBitmap; + FTextureInvalidated := true; +end; + +procedure TBGLCustomBitmap.Fill(const c: TBGRAPixel); +var oldClip: TRect; +begin + oldClip := ClipRect; + NoClip; + FillRect(ClipRect, c, dmSet); + ClipRect := oldClip; +end; + +procedure TBGLCustomBitmap.NoClip; +begin + ClipRect := FActualRect; +end; + +destructor TBGLCustomBitmap.Destroy; +begin + if FTexture <> nil then + begin + //always free the memory of the texture + FTexture.FreeMemory; + FTexture := nil; + end; + inherited Destroy; +end; + +procedure TBGLCustomBitmap.SwapRedBlue; +var previousClip : TRect; +begin + previousClip := ClipRect; + NoClip; + SwapRedBlue(rect(0,0,Width,Height)); + ClipRect := previousClip; +end; + +function TBGLCustomBitmap.Resample(newWidth, newHeight: integer; + mode: TResampleMode): TBGLCustomBitmap; +var temp,resampled: TBGRACustomBitmap; +begin + temp := TBGRABitmap.Create(FActualWidth,FActualHeight); + temp.PutImage(-FActualRect.Left,-FActualRect.Top, self, dmSet); + temp.ResampleFilter := ResampleFilter; + resampled := temp.Resample(NewWidth,NewHeight,mode); + temp.Free; + Result:= NewBitmap(resampled) as TBGLCustomBitmap; + resampled.Free; +end; + +procedure TBGLCustomBitmap.ApplyGlobalOpacity(alpha: byte); +var oldClip: TRect; +begin + oldClip := ClipRect; + NoClip; + ApplyGlobalOpacity(FActualRect,alpha); + ClipRect := oldClip; +end; + +procedure TBGLCustomBitmap.ReplaceColor(before, after: TColor); +var oldClip: TRect; +begin + oldClip := ClipRect; + NoClip; + ReplaceColor(FActualRect, before, after); + ClipRect := oldClip; +end; + +procedure TBGLCustomBitmap.ReplaceColor(const ABefore, AAfter: TBGRAPixel); +var oldClip: TRect; +begin + oldClip := ClipRect; + NoClip; + ReplaceColor(FActualRect, ABefore, AAfter); + ClipRect := oldClip; +end; + +procedure TBGLCustomBitmap.ReplaceTransparent(const AAfter: TBGRAPixel); +var oldClip: TRect; +begin + oldClip := ClipRect; + NoClip; + ReplaceTransparent(FActualRect,AAfter); + ClipRect := oldClip; +end; + +procedure TBGLCustomBitmap.SetClipRect(const AValue: TRect); +var r: TRect; +begin + r := TRect.Intersect(AValue, FActualRect); + inherited SetClipRect(r); +end; + +procedure TBGLCustomBitmap.SetSize(AWidth, AHeight: integer); +var AllocatedWidthNeeded,AllocatedHeightNeeded, + MaxTexSize: Integer; +begin + if AWidth < 0 then AWidth := 0; + if AHeight < 0 then AHeight := 0; + if (AWidth = Width) and (AHeight = Height) then exit; + AllocatedWidthNeeded := GetPowerOfTwo(AWidth); + AllocatedHeightNeeded := GetPowerOfTwo(AHeight); + MaxTexSize := GetOpenGLMaxTexSize; + if (AllocatedWidthNeeded > MaxTexSize) or + (AllocatedHeightNeeded > MaxTexSize) then + begin + if MaxTexSize = 0 then + NotifyOpenGLContextNotCreatedYet + else + NotifySizeTooBigForOpenGL; + if AllocatedWidthNeeded > MaxTexSize then + begin + AllocatedWidthNeeded := MaxTexSize; + AWidth := MaxTexSize; + end; + if AllocatedHeightNeeded > MaxTexSize then + begin + AllocatedHeightNeeded := MaxTexSize; + AHeight := MaxTexSize; + end; + end; + FActualWidth := AWidth; + FActualHeight := AHeight; + FAllocatedWidth := AllocatedWidthNeeded; + FAllocatedHeight := AllocatedHeightNeeded; + FActualRect := rect(0,0,FActualWidth,FActualHeight); + if (FAllocatedWidth <> inherited Width) or + (FAllocatedHeight <> inherited Height) then + inherited SetSize(FAllocatedWidth, FAllocatedHeight); + inherited NoClip; + inherited FillRect(Width,0,FAllocatedWidth,Height, BGRAPixelTransparent, dmSet); + inherited FillRect(0,Height,FAllocatedWidth,FAllocatedHeight, BGRAPixelTransparent, dmSet); + NoClip; + FScanWidth := Width; + FScanHeight:= Height; + FTextureInvalidated:= true; +end; + +function TBGLCustomBitmap.MakeTextureAndFree: IBGLTexture; +begin + result := Texture; + FTexture := nil; + Free; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraopenraster.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraopenraster.pas new file mode 100644 index 0000000..0a25221 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraopenraster.pas @@ -0,0 +1,1139 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAOpenRaster; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALayers, zipper, DOM, BGRABitmap, BGRALayerOriginal, + BGRASVGShapes, FPImage, BGRASVG; + +const + OpenRasterMimeType = 'image/openraster'; //do not change, it's part of the file format + OpenRasterSVGDefaultDPI = 90; + +type + + { TBGRAOpenRasterDocument } + + TBGRAOpenRasterDocument = class(TBGRALayeredBitmap) + private + FFiles: array of record + Filename: string; + Stream: TMemoryStream; + end; + FStackXML: TXMLDocument; + FZipInputStream: TStream; + procedure SetMimeType(AValue: string); + protected + Procedure ZipOnCreateStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); + Procedure ZipOnDoneStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); + Procedure ZipOnOpenInputStream(Sender : TObject; var AStream : TStream); + Procedure ZipOnCloseInputStream(Sender : TObject; var AStream : TStream); + procedure ClearFiles; + function GetMemoryStream(AFilename: string): TMemoryStream; + procedure SetMemoryStream(AFilename: string; AStream: TMemoryStream); + function AddLayerFromMemoryStream(ALayerFilename: string): integer; + function CopyRasterLayerToMemoryStream(ALayerIndex: integer; ALayerFilename: string): boolean; + procedure CopySVGToMemoryStream(ASVG: TBGRASVG; ASVGMatrix: TAffineMatrix; AOutFilename: string; out AOffset: TPoint); + function CopyBitmapToMemoryStream(ABitmap: TBGRABitmap; AFilename: string): boolean; + procedure SetMemoryStreamAsString(AFilename: string; AContent: string); + function GetMemoryStreamAsString(AFilename: string): string; + procedure UnzipFromStream(AStream: TStream; AFileList: TStrings = nil); + procedure UnzipFromFile(AFilenameUTF8: string); + procedure ZipToFile(AFilenameUTF8: string); + procedure ZipToStream(AStream: TStream); + procedure CopyThumbnailToMemoryStream(AMaxWidth, AMaxHeight: integer); + procedure AnalyzeZip; virtual; + procedure PrepareZipToSave; virtual; + function GetMimeType: string; override; + procedure InternalLoadFromStream(AStream: TStream); + procedure InternalSaveToStream(AStream: TStream); + + public + constructor Create; overload; override; + constructor Create(AWidth, AHeight: integer); overload; override; + procedure Clear; override; + function CheckMimeType(AStream: TStream): boolean; + procedure LoadFlatImageFromStream(AStream: TStream; + out ANbLayers: integer; + out ABitmap: TBGRABitmap); + procedure LoadFromStream(AStream: TStream); override; + procedure LoadFromFile(const filenameUTF8: string); override; + procedure SaveToStream(AStream: TStream); override; + procedure SaveToFile(const filenameUTF8: string); override; + property MimeType : string read GetMimeType write SetMimeType; + property StackXML : TXMLDocument read FStackXML; + end; + + { TFPReaderOpenRaster } + + TFPReaderOpenRaster = class(TFPCustomImageReader) + private + FWidth,FHeight,FNbLayers: integer; + protected + function InternalCheck(Stream: TStream): boolean; override; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + public + property Width: integer read FWidth; + property Height: integer read FHeight; + property NbLayers: integer read FNbLayers; + end; + + { TFPWriterOpenRaster } + + TFPWriterOpenRaster = class(TFPCustomImageWriter) + protected + procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override; + end; + +procedure RegisterOpenRasterFormat; + +implementation + +uses XMLRead, XMLWrite, BGRABitmapTypes, zstream, BGRAUTF8, + UnzipperExt, BGRASVGOriginal, BGRATransform, BGRASVGType, math; + +const + MergedImageFilename = 'mergedimage.png'; + LayerStackFilename = 'stack.xml'; + +function IsZipStream(stream: TStream): boolean; +var + header: packed array[0..1] of char; + SavePos: int64; +begin + Result := False; + try + if stream.Position + 2 < Stream.Size then + begin + header := #0#0; + SavePos := stream.Position; + stream.Read(header, 2); + stream.Position := SavePos; + if (header[0] = 'P') and (header[1] = 'K') then + Result := True; + end; + except + on ex: Exception do ; + end; +end; + +{ TFPWriterOpenRaster } + +procedure TFPWriterOpenRaster.InternalWrite(Str: TStream; Img: TFPCustomImage); +var doc: TBGRAOpenRasterDocument; + tempBmp: TBGRABitmap; + x,y: integer; + +begin + doc := TBGRAOpenRasterDocument.Create; + if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else + begin + tempBmp := TBGRABitmap.Create(img.Width,img.Height); + for y := 0 to Img.Height-1 do + for x := 0 to img.Width-1 do + tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y])); + doc.AddOwnedLayer(tempBmp); + end; + doc.SaveToStream(Str); + doc.Free; +end; + +{ TFPReaderOpenRaster } + +function TFPReaderOpenRaster.InternalCheck(Stream: TStream): boolean; +var magic: packed array[0..3] of byte; + OldPos,BytesRead: Int64; + doc : TBGRAOpenRasterDocument; +begin + Result:=false; + if Stream=nil then exit; + oldPos := stream.Position; + {$PUSH}{$HINTS OFF} + BytesRead := Stream.Read({%H-}magic,sizeof(magic)); + {$POP} + stream.Position:= OldPos; + if BytesRead<>sizeof(magic) then exit; + if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then + begin + doc := TBGRAOpenRasterDocument.Create; + result := doc.CheckMimeType(Stream); + doc.Free; + end; +end; + +procedure TFPReaderOpenRaster.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + layeredImage: TBGRAOpenRasterDocument; + flat: TBGRABitmap; + x,y: integer; +begin + FWidth := 0; + FHeight:= 0; + FNbLayers:= 0; + layeredImage := TBGRAOpenRasterDocument.Create; + try + layeredImage.LoadFlatImageFromStream(Stream, FNbLayers, flat); + if Assigned(flat) then + begin + FWidth := flat.Width; + FHeight := flat.Height; + end else + begin + layeredImage.LoadFromStream(Stream); + flat := layeredImage.ComputeFlatImage; + FWidth:= layeredImage.Width; + FHeight:= layeredImage.Height; + FNbLayers:= layeredImage.NbLayers; + end; + try + if Img is TBGRACustomBitmap then + TBGRACustomBitmap(img).Assign(flat) + else + begin + Img.SetSize(flat.Width,flat.Height); + for y := 0 to flat.Height-1 do + for x := 0 to flat.Width-1 do + Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); + end; + finally + flat.free; + end; + FreeAndNil(layeredImage); + except + on ex: Exception do + begin + layeredImage.Free; + raise Exception.Create('Error while loading OpenRaster file. ' + ex.Message); + end; + end; +end; + +{ TBGRAOpenRasterDocument } + +procedure TBGRAOpenRasterDocument.AnalyzeZip; + + function CountLayersRec(stackNode: TDOMNode): integer; + var i: integer; + layerNode: TDOMNode; + begin + result := 0; + for i := stackNode.ChildNodes.Length-1 downto 0 do + begin + layerNode:= stackNode.ChildNodes[i]; + if (layerNode.NodeName = 'layer') and Assigned(layerNode.Attributes) then + inc(result) else + if (layerNode.NodeName = 'stack') then + inc(result, CountLayersRec(layerNode)); + end; + end; + +var + totalLayerCount, doneLayerCount: integer; + + procedure AddLayersRec(stackNode: TDOMNode); + var i,j : integer; + layerNode, attr: TDOMNode; + idx,x,y: integer; + float: double; + errPos: integer; + opstr : string; + gammastr: string; + begin + for i := stackNode.ChildNodes.Length-1 downto 0 do + begin + OnLayeredBitmapLoadProgress(doneLayerCount*100 div totalLayerCount); + layerNode:= stackNode.ChildNodes[i]; + if layerNode.NodeName = 'stack' then + AddLayersRec(layerNode) else + if (layerNode.NodeName = 'layer') and Assigned(layerNode.Attributes) then + begin + attr := layerNode.Attributes.GetNamedItem('src'); + idx := AddLayerFromMemoryStream(UTF8Encode(attr.NodeValue)); + if idx <> -1 then + begin + x := 0; + y := 0; + gammastr := ''; + for j := 0 to layerNode.Attributes.Length-1 do + begin + attr := layerNode.Attributes[j]; + if lowercase(attr.NodeName) = 'opacity' then + begin + val(attr.NodeValue, float, errPos); + if errPos = 0 then + begin + if float < 0 then float := 0; + if float > 1 then float := 1; + LayerOpacity[idx] := round(float*255); + end; + end else + if lowercase(attr.NodeName) = 'gamma-correction' then + gammastr := string(attr.NodeValue) else + if lowercase(attr.NodeName) = 'visibility' then + LayerVisible[idx] := (attr.NodeValue = 'visible') or (attr.NodeValue = 'yes') or (attr.NodeValue = '1') else + if (lowercase(attr.NodeName) = 'x') or (lowercase(attr.NodeName) = 'y') then + begin + val(attr.NodeValue, float, errPos); + if errPos = 0 then + begin + if float < -(MaxInt shr 1) then float := -(MaxInt shr 1); + if float > (MaxInt shr 1) then float := (MaxInt shr 1); + if (lowercase(attr.NodeName) = 'x') then x := round(float); + if (lowercase(attr.NodeName) = 'y') then y := round(float); + end; + end else + if lowercase(attr.NodeName) = 'name' then + LayerName[idx] := UTF8Encode(attr.NodeValue) else + if lowercase(attr.NodeName) = 'composite-op' then + begin + opstr := StringReplace(lowercase(string(attr.NodeValue)),'_','-',[rfReplaceAll]); + if (pos(':',opstr) = 0) and (opstr <> 'xor') then opstr := 'svg:'+opstr; + //parse composite op + if (opstr = 'svg:src-over') or (opstr = 'krita:dissolve') then + BlendOperation[idx] := boTransparent else + if opstr = 'svg:lighten' then + BlendOperation[idx] := boLighten else + if opstr = 'svg:screen' then + BlendOperation[idx] := boScreen else + if opstr = 'svg:color-dodge' then + BlendOperation[idx] := boColorDodge else + if (opstr = 'svg:color-burn') or (opstr = 'krita:gamma_dark'){approx} then + BlendOperation[idx] := boColorBurn else + if opstr = 'svg:darken' then + BlendOperation[idx] := boDarken else + if (opstr = 'svg:plus') or (opstr = 'svg:add') or (opstr = 'krita:linear_dodge') then + BlendOperation[idx] := boLinearAdd else + if (opstr = 'svg:multiply') or (opstr = 'krita:bumpmap') then + BlendOperation[idx] := boMultiply else + if opstr = 'svg:overlay' then + BlendOperation[idx] := boOverlay else + if opstr = 'svg:soft-light' then + BlendOperation[idx] := boSvgSoftLight else + if opstr = 'svg:hard-light' then + BlendOperation[idx] := boHardLight else + if opstr = 'svg:difference' then + BlendOperation[idx] := boLinearDifference else + if (opstr = 'krita:inverse-subtract') or (opstr = 'krita:linear-burn') then + BlendOperation[idx] := boLinearSubtractInverse else + if opstr = 'krita:subtract' then + BlendOperation[idx] := boLinearSubtract else + if (opstr = 'svg:difference') or + (opstr = 'krita:equivalence') then + BlendOperation[idx] := boLinearDifference else + if (opstr = 'svg:exclusion') or + (opstr = 'krita:exclusion') then + BlendOperation[idx] := boLinearExclusion else + if opstr = 'krita:divide' then + BlendOperation[idx] := boDivide else + if opstr = 'bgra:soft-light' then + BlendOperation[idx] := boSoftLight else + if opstr = 'bgra:nice-glow' then + BlendOperation[idx] := boNiceGlow else + if opstr = 'bgra:glow' then + BlendOperation[idx] := boGlow else + if opstr = 'bgra:reflect' then + BlendOperation[idx] := boReflect else + if opstr = 'bgra:negation' then + BlendOperation[idx] := boLinearNegation else + if (opstr = 'bgra:xor') or (opstr = 'xor') then + BlendOperation[idx] := boXor else + if opstr = 'bgra:mask' then + BlendOperation[idx] := boMask else + if opstr = 'bgra:linear-multiply-saturation' then + BlendOperation[idx] := boLinearMultiplySaturation else + if opstr = 'svg:hue' then + BlendOperation[idx] := boCorrectedHue else + if opstr = 'svg:color' then + BlendOperation[idx] := boCorrectedColor else + if opstr = 'svg:luminosity' then + BlendOperation[idx] := boCorrectedLightness else + if opstr = 'svg:saturation' then + BlendOperation[idx] := boCorrectedSaturation else + if opstr = 'krita:hue-hsl' then + BlendOperation[idx] := boLinearHue else + if opstr = 'krita:color-hsl' then + BlendOperation[idx] := boLinearColor else + if opstr = 'krita:lightness' then + BlendOperation[idx] := boLinearLightness else + if opstr = 'krita:saturation-hsl' then + BlendOperation[idx] := boLinearSaturation else + begin + //messagedlg('Unknown blend operation : ' + attr.NodeValue,mtInformation,[mbOk],0); + BlendOperation[idx] := boTransparent; + end; + end; + end; + if LayerOriginalGuid[idx] <> GUID_NULL then + begin + LayerOriginalMatrix[idx] := AffineMatrixTranslation(x,y)*LayerOriginalMatrix[idx]; + RenderLayerFromOriginal(idx); + end else LayerOffset[idx] := point(x,y); + if (gammastr = 'yes') or (gammastr = 'on') then + begin + case BlendOperation[idx] of + boLinearAdd: BlendOperation[idx] := boAdditive; + boOverlay: BlendOperation[idx] := boDarkOverlay; + boLinearDifference: BlendOperation[idx] := boDifference; + boLinearExclusion: BlendOperation[idx] := boExclusion; + boLinearSubtract: BlendOperation[idx] := boSubtract; + boLinearSubtractInverse: BlendOperation[idx] := boSubtractInverse; + boLinearNegation: BlendOperation[idx] := boNegation; + end; + end else + if (gammastr = 'no') or (gammastr = 'off') then + if BlendOperation[idx] = boTransparent then + BlendOperation[idx] := boLinearBlend; //explicit linear blending + end; + inc(doneLayerCount); + end; + end; + end; + +var StackStream: TMemoryStream; + imageNode, stackNode, attr: TDOMNode; + i,w,h: integer; + +begin + inherited Clear; + + if MimeType <> OpenRasterMimeType then + raise Exception.Create('Invalid mime type'); + + StackStream := GetMemoryStream(LayerStackFilename); + if StackStream = nil then + raise Exception.Create('Layer stack not found'); + + ReadXMLFile(FStackXML, StackStream); + + imageNode := StackXML.FindNode('image'); + if imagenode = nil then + raise Exception.Create('Image node not found'); + + w := 0; + h := 0; + LinearBlend := true; + + if Assigned(imageNode.Attributes) then + for i:=0 to imageNode.Attributes.Length-1 do + begin + attr := imagenode.Attributes[i]; + if lowercase(attr.NodeName) = 'w' then + w := strToInt(string(attr.NodeValue)) else + if lowercase(attr.NodeName) = 'h' then + h := strToInt(string(attr.NodeValue)) else + if lowercase(attr.NodeName) = 'gamma-correction' then + linearBlend := (attr.NodeValue = 'no') or (attr.NodeValue = '0'); + end; + + SetSize(w,h); + + stackNode := imageNode.FindNode('stack'); + if stackNode = nil then + raise Exception.Create('Stack node not found'); + + totalLayerCount := CountLayersRec(stackNode); + doneLayerCount := 0; + AddLayersRec(stackNode); +end; + +procedure TBGRAOpenRasterDocument.PrepareZipToSave; + +var i: integer; + imageNode,stackNode,layerNode: TDOMElement; + layerFilename,strval: string; + stackStream: TMemoryStream; + ofs, wantedOfs: TPoint; + fileAdded: Boolean; + svg: TBGRASVG; + m: TAffineMatrix; +begin + ClearFiles; + MimeType := OpenRasterMimeType; + FStackXML := TXMLDocument.Create; + imageNode := TDOMElement(StackXML.CreateElement('image')); + StackXML.AppendChild(imageNode); + imageNode.SetAttribute('w',widestring(inttostr(Width))); + imageNode.SetAttribute('h',widestring(inttostr(Height))); + if LinearBlend then + imageNode.SetAttribute('gamma-correction','no') + else + imageNode.SetAttribute('gamma-correction','yes'); + + stackNode := TDOMElement(StackXML.CreateElement('stack')); + imageNode.AppendChild(stackNode); + SetMemoryStreamAsString('stack.xml',''); //to put it before image data + + CopyThumbnailToMemoryStream(256,256); + + for i := NbLayers-1 downto 0 do + begin + OnLayeredBitmapSaveProgress(round((NbLayers-1-i) * 100 / NbLayers)); + if (LayerOriginalGuid[i] <> GUID_NULL) and LayerOriginalKnown[i] and + LayerOriginalClass[i].CanConvertToSVG then + begin + layerFilename := 'data/layer'+inttostr(i)+'.svg'; + if LayerOriginal[i].IsInfiniteSurface then + begin + svg := LayerOriginal[i].ConvertToSVG(LayerOriginalMatrix[i], wantedOfs) as TBGRASVG; + m := AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); + svg.WidthAsPixel := self.Width; + svg.HeightAsPixel := self.Height; + end else + begin + svg := LayerOriginal[i].ConvertToSVG(AffineMatrixIdentity, wantedOfs) as TBGRASVG; + m := LayerOriginalMatrix[i] + * AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); + end; + try + CopySVGToMemoryStream(svg, m, layerFilename, ofs); + fileAdded := true; + finally + svg.Free; + end; + end else + begin + layerFilename := 'data/layer'+inttostr(i)+'.png'; + ofs := LayerOffset[i]; + fileAdded := CopyRasterLayerToMemoryStream(i, layerFilename); + end; + + if fileAdded then + begin + layerNode := StackXML.CreateElement('layer'); + stackNode.AppendChild(layerNode); + layerNode.SetAttribute('name', UTF8Decode(LayerName[i])); + str(LayerOpacity[i]/255:0:3,strval); + layerNode.SetAttribute('opacity',widestring(strval)); + layerNode.SetAttribute('src',widestring(layerFilename)); + if LayerVisible[i] then + layerNode.SetAttribute('visibility','visible') + else + layerNode.SetAttribute('visibility','hidden'); + layerNode.SetAttribute('x',widestring(inttostr(ofs.x))); + layerNode.SetAttribute('y',widestring(inttostr(ofs.y))); + strval := ''; + case BlendOperation[i] of + boLighten: strval := 'svg:lighten'; + boScreen: strval := 'svg:screen'; + boAdditive, boLinearAdd: strval := 'svg:add'; + boColorDodge: strval := 'svg:color-dodge'; + boColorBurn : strval := 'svg:color-burn'; + boDarken: strval := 'svg:darken'; + boMultiply: strval := 'svg:multiply'; + boOverlay, boDarkOverlay: strval := 'svg:overlay'; + boSoftLight: strval := 'bgra:soft-light'; + boHardLight: strval := 'svg:hard-light'; + boDifference,boLinearDifference: strval := 'svg:difference'; + boLinearSubtractInverse, boSubtractInverse: strval := 'krita:inverse_subtract'; + boLinearSubtract, boSubtract: strval := 'krita:subtract'; + boExclusion, boLinearExclusion: strval := 'svg:exclusion'; + boDivide: strval := 'krita:divide'; + boNiceGlow: strval := 'bgra:nice-glow'; + boGlow: strval := 'bgra:glow'; + boReflect: strval := 'bgra:reflect'; + boLinearNegation,boNegation: strval := 'bgra:negation'; + boXor: strval := 'bgra:xor'; + boSvgSoftLight: strval := 'svg:soft-light'; + boMask: strval := 'bgra:mask'; + boLinearMultiplySaturation: strval := 'bgra:linear-multiply-saturation'; + boCorrectedHue: strval := 'svg:hue'; + boCorrectedColor: strval := 'svg:color'; + boCorrectedLightness: strval := 'svg:luminosity'; + boCorrectedSaturation: strval := 'svg:saturation'; + boLinearHue: strval := 'krita:hue_hsl'; + boLinearColor: strval := 'krita:color_hsl'; + boLinearLightness: strval := 'krita:lightness'; + boLinearSaturation: strval := 'krita:saturation_hsl'; + else strval := 'svg:src-over'; + end; + layerNode.SetAttribute('composite-op',widestring(strval)); + if BlendOperation[i] <> boTransparent then //in 'transparent' case, linear blending depends on general setting + begin + if BlendOperation[i] in[boAdditive,boDarkOverlay,boDifference,boSubtractInverse, + boSubtract,boExclusion,boNegation] then + strval := 'yes' else strval := 'no'; + layerNode.SetAttribute('gamma-correction',widestring(strval)); + end; + end; + end; + OnLayeredBitmapSaveProgress(100); + StackStream := TMemoryStream.Create; + WriteXMLFile(StackXML, StackStream); + SetMemoryStream('stack.xml',StackStream); +end; + +procedure TBGRAOpenRasterDocument.LoadFromFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); + OnLayeredBitmapLoadStart(filenameUTF8); + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + AStream.Free; + end; +end; + +procedure TBGRAOpenRasterDocument.SaveToStream(AStream: TStream); +begin + OnLayeredBitmapSaveToStreamStart; + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + end; +end; + +procedure TBGRAOpenRasterDocument.SaveToFile(const filenameUTF8: string); +begin + OnLayeredBitmapSaveStart(filenameUTF8); + try + PrepareZipToSave; + ZipToFile(filenameUTF8); + finally + OnLayeredBitmapSaved; + ClearFiles; + end; +end; + +procedure TBGRAOpenRasterDocument.InternalSaveToStream(AStream: TStream); +begin + try + PrepareZipToSave; + ZipToStream(AStream); + finally + ClearFiles; + end; +end; + +function TBGRAOpenRasterDocument.GetMimeType: string; +begin + if length(FFiles)=0 then + result := OpenRasterMimeType + else + result := GetMemoryStreamAsString('mimetype'); +end; + +procedure TBGRAOpenRasterDocument.InternalLoadFromStream(AStream: TStream); +begin + try + UnzipFromStream(AStream); + AnalyzeZip; + finally + ClearFiles; + end; +end; + +constructor TBGRAOpenRasterDocument.Create; +begin + inherited Create; + RegisterOpenRasterFormat; +end; + +constructor TBGRAOpenRasterDocument.Create(AWidth, AHeight: integer); +begin + inherited Create(AWidth, AHeight); + RegisterOpenRasterFormat; +end; + +function TBGRAOpenRasterDocument.AddLayerFromMemoryStream(ALayerFilename: string): integer; +var stream: TMemoryStream; + bmp: TBGRABitmap; + orig: TBGRALayerSVGOriginal; + svg: TBGRASVG; + g: TSVGGroup; + i, svgElemCount: Integer; + origViewBox: TSVGViewBox; + elemToMove: TList; + m: TAffineMatrix; +begin + stream := GetMemoryStream(ALayerFilename); + if stream = nil then raise Exception.Create('Layer not found'); + + if SuggestImageFormat(ALayerFilename) = ifSvg then + begin + svg := TBGRASVG.Create; + svg.DefaultDpi:= OpenRasterSVGDefaultDPI; + try + svg.LoadFromStream(stream); + except + on ex:exception do + begin + svg.Free; + raise exception.Create('SVG layer format error'); + end; + end; + g := nil; + svgElemCount := 0; + for i := 0 to svg.Content.ElementCount-1 do + if svg.Content.IsSVGElement[i] then + begin + inc(svgElemCount); + if svg.Content.ElementObject[i] is TSVGGroup then + g := TSVGGroup(svg.Content.ElementObject[i]); + end; + + if (svgElemCount = 1) and Assigned(g) and + g.DOMElement.hasAttribute('bgra:originalViewBox') then + begin + svg.ContainerWidthAsPixel:= Width; + svg.ContainerHeightAsPixel:= Height; + origViewBox := TSVGViewBox.Parse(g.DOMElement.GetAttribute('bgra:originalViewBox')); + m := svg.GetStretchPresentationMatrix(cuPixel) * g.matrix[cuPixel] * + AffineMatrixTranslation(origViewBox.min.x, origViewBox.min.y); + g.DOMElement.RemoveAttribute('bgra:originalViewBox'); + for i := svg.Content.ElementCount-1 downto 0 do + if svg.Content.ElementObject[i] <> g then + svg.Content.RemoveElement(svg.Content.ElementObject[i]); + elemToMove := TList.Create; + for i := 0 to g.Content.ElementCount-1 do + elemToMove.Add(g.Content.ElementObject[i]); + for i := 0 to elemToMove.Count-1 do + svg.Content.BringElement(TObject(elemToMove[i]), g.Content); + elemToMove.Free; + svg.Content.RemoveElement(g); + svg.ViewBox := origViewBox; + svg.WidthAsPixel:= origViewBox.size.x; + svg.HeightAsPixel:= origViewBox.size.y; + end else + m := AffineMatrixIdentity; + orig := TBGRALayerSVGOriginal.Create; + orig.SetSVG(svg, Width, Height); + result := AddLayerFromOwnedOriginal(orig); + LayerOriginalMatrix[result] := m; + end else + begin + bmp := TBGRABitmap.Create; + try + bmp.LoadFromStream(stream); + except + on ex: exception do + begin + bmp.Free; + raise exception.Create('Raster layer format error'); + end; + end; + result := AddOwnedLayer(bmp); + end; + LayerName[result] := ExtractFileName(ALayerFilename); +end; + +function TBGRAOpenRasterDocument.CopyRasterLayerToMemoryStream(ALayerIndex: integer; + ALayerFilename: string): boolean; +var + bmp: TBGRABitmap; + mustFreeBmp: boolean; +begin + result := false; + bmp := LayerBitmap[ALayerIndex]; + if bmp <> nil then mustFreeBmp := false + else + begin + bmp := GetLayerBitmapCopy(ALayerIndex); + if bmp = nil then exit; + mustFreeBmp:= true; + end; + + result := CopyBitmapToMemoryStream(bmp,ALayerFilename); + if mustFreeBmp then bmp.Free; +end; + +procedure TBGRAOpenRasterDocument.CopySVGToMemoryStream( + ASVG: TBGRASVG; ASVGMatrix: TAffineMatrix; AOutFilename: string; out AOffset: TPoint); + + function IsIntegerTranslation(m: TAffineMatrix; out ofs: TPoint): boolean; + begin + ofs := Point(round(m[1,3]), round(m[2,3])); + result := IsAffineMatrixTranslation(m) and + (abs(round(m[1,3]) - ofs.x) < 1e-4) and + (abs(round(m[2,3]) - ofs.y) < 1e-4); + end; + + procedure StoreSVG(ASVG: TBGRASVG); + var + memStream: TMemoryStream; + w, h: Single; + begin + memStream := TMemoryStream.Create; + try + w := ASVG.WidthAsPixel; + h := ASVG.HeightAsPixel; + //ensure we are not using units affected by DPI + ASVG.ConvertToUnit(cuCustom); + ASVG.WidthAsPixel := w; + ASVG.HeightAsPixel := h; + ASVG.SaveToStream(memStream); + SetMemoryStream(AOutFilename,memstream); + except + on ex: Exception do + begin + memStream.Free; + raise exception.Create(ex.Message); + end; + end; + end; + + procedure StoreTransformedSVG(out AOffset: TPoint); + var + box, transfBox: TAffineBox; + newSvg: TBGRASVG; + newBounds: TRectF; + rootElems: TList; + i: Integer; + g: TSVGGroup; + newViewBox, origViewBox: TSVGViewBox; + presentMatrix: TAffineMatrix; + begin + newSvg := ASVG.Duplicate; + presentMatrix := ASVGMatrix * newSvg.GetStretchPresentationMatrix(cuPixel); + rootElems := TList.Create; + try + origViewBox := newSvg.ViewBox; + with origViewBox do + box := TAffineBox.AffineBox(RectWithSizeF(min.x, min.y, size.x, size.y)); + transfBox := presentMatrix * box; + newBounds := RectF(transfBox.RectBounds); + AOffset := Point(round(newBounds.Left), round(newBounds.Top)); + newBounds.Offset(-AOffset.X, -AOffset.Y); + presentMatrix := AffineMatrixTranslation(-AOffset.X, -AOffset.Y) * presentMatrix; + for i := 0 to newSvg.Content.ElementCount-1 do + rootElems.Add(newSvg.Content.ElementObject[i]); + g := newSvg.Content.AppendGroup; + for i := 0 to rootElems.Count-1 do + g.Content.BringElement(TObject(rootElems[i]), newSvg.Content); + g.matrix[cuPixel] := presentMatrix; + g.DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); + g.DOMElement.SetAttribute('bgra:originalViewBox', origViewBox.ToString); + newSvg.WidthAsPixel:= newBounds.Width; + newSvg.HeightAsPixel:= newBounds.Height; + newViewBox.min := newBounds.TopLeft; + newViewBox.size := PointF(newBounds.Width, newBounds.Height); + newSvg.ViewBox := newViewBox; + StoreSVG(newSvg); + finally + rootElems.Free; + newSvg.Free; + end; + end; + +begin + if IsIntegerTranslation(ASVGMatrix, AOffset) then + StoreSVG(ASVG) + else StoreTransformedSVG(AOffset); +end; + +function TBGRAOpenRasterDocument.CopyBitmapToMemoryStream(ABitmap: TBGRABitmap; + AFilename: string): boolean; +var + memStream: TMemoryStream; +begin + result := false; + memstream := TMemoryStream.Create; + try + ABitmap.SaveToStreamAsPng(memStream); + SetMemoryStream(AFilename,memstream); + result := true; + except + on ex: Exception do + begin + memStream.Free; + end; + end; +end; + +procedure TBGRAOpenRasterDocument.SetMemoryStreamAsString(AFilename: string; + AContent: string); +var strstream: TStringStream; + memstream: TMemoryStream; +begin + strstream:= TStringStream.Create(AContent); + memstream := TMemoryStream.Create; + strstream.Position := 0; + memstream.CopyFrom(strstream, strstream.Size); + strstream.Free; + SetMemoryStream(AFilename, memstream); +end; + +function TBGRAOpenRasterDocument.GetMemoryStreamAsString(AFilename: string): string; +var stream: TMemoryStream; + str: TStringStream; +begin + stream := GetMemoryStream(AFilename); + str := TStringStream.Create(''); + str.CopyFrom(stream,stream.Size); + result := str.DataString; + str.Free; +end; + +procedure TBGRAOpenRasterDocument.UnzipFromStream(AStream: TStream; + AFileList: TStrings = nil); +var unzip: TUnZipper; +begin + ClearFiles; + unzip := TUnZipper.Create; + try + unzip.OnCreateStream := @ZipOnCreateStream; + unzip.OnDoneStream := @ZipOnDoneStream; + unzip.OnOpenInputStream := @ZipOnOpenInputStream; + unzip.OnCloseInputStream := @ZipOnCloseInputStream; + FZipInputStream := AStream; + if Assigned(AFileList) then + begin + if AFileList.Count > 0 then + unzip.UnZipFiles(AFileList); + end else + unzip.UnZipAllFiles; + finally + FZipInputStream := nil; + unzip.Free; + end; +end; + +procedure TBGRAOpenRasterDocument.UnzipFromFile(AFilenameUTF8: string); +var unzip: TUnZipper; +begin + ClearFiles; + unzip := TUnZipper.Create; + try + unzip.FileName := Utf8ToAnsi(AFilenameUTF8); + unzip.OnCreateStream := @ZipOnCreateStream; + unzip.OnDoneStream := @ZipOnDoneStream; + unzip.UnZipAllFiles; + finally + unzip.Free; + end; +end; + +procedure TBGRAOpenRasterDocument.ZipToFile(AFilenameUTF8: string); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); + try + ZipToStream(stream); + finally + stream.Free; + end; +end; + +procedure TBGRAOpenRasterDocument.ZipToStream(AStream: TStream); +var zip: TZipper; + i: integer; + tempFile: String; +begin + zip := TZipper.Create; + tempFile := ChangeFileExt(GetTempFileName, ''); + if ExtractFileExt(tempFile) = '.tmp' then + tempFile := ChangeFileExt(tempFile, ''); + zip.FileName:= tempFile; + try + for i := 0 to high(FFiles) do + begin + FFiles[i].Stream.Position:= 0; + zip.Entries.AddFileEntry(FFiles[i].Stream,FFiles[i].Filename).CompressionLevel := clnone; + end; + zip.SaveToStream(AStream); + finally + zip.Free; + end; +end; + +procedure TBGRAOpenRasterDocument.CopyThumbnailToMemoryStream(AMaxWidth,AMaxHeight: integer); +var thumbnail: TBGRABitmap; + w,h: integer; +begin + if (Width = 0) or (Height = 0) then exit; + thumbnail := ComputeFlatImage; + CopyBitmapToMemoryStream(thumbnail,MergedImageFilename); + if (thumbnail.Width > AMaxWidth) or + (thumbnail.Height > AMaxHeight) then + begin + if thumbnail.Width > AMaxWidth then + begin + w := AMaxWidth; + h := round(thumbnail.Height* (w/thumbnail.Width)); + end else + begin + w := thumbnail.Width; + h := thumbnail.Height; + end; + if h > AMaxHeight then + begin + h := AMaxHeight; + w := round(thumbnail.Width* (h/thumbnail.Height)); + end; + BGRAReplace(thumbnail, thumbnail.Resample(w,h)); + end; + CopyBitmapToMemoryStream(thumbnail,'Thumbnails/thumbnail.png'); + thumbnail.Free; +end; + +procedure TBGRAOpenRasterDocument.Clear; +begin + ClearFiles; + inherited Clear; +end; + +function TBGRAOpenRasterDocument.CheckMimeType(AStream: TStream): boolean; +var unzip: TUnzipperStreamUtf8; + mimeTypeFound: string; + oldPos: int64; +begin + result := false; + unzip := TUnzipperStreamUtf8.Create; + oldPos := AStream.Position; + try + unzip.InputStream := AStream; + mimeTypeFound := unzip.UnzipFileToString('mimetype'); + if mimeTypeFound = OpenRasterMimeType then result := true; + except + end; + unzip.Free; + astream.Position:= OldPos; +end; + +procedure TBGRAOpenRasterDocument.LoadFlatImageFromStream(AStream: TStream; out + ANbLayers: integer; out ABitmap: TBGRABitmap); +var fileList: TStringList; + imgStream, stackStream: TMemoryStream; + imageNode, stackNode: TDOMNode; + i: integer; +begin + fileList := TStringList.Create; + fileList.Add(MergedImageFilename); + fileList.Add(LayerStackFilename); + imgStream := nil; + try + UnzipFromStream(AStream, fileList); + imgStream := GetMemoryStream(MergedImageFilename); + if imgStream = nil then + ABitmap := nil + else + ABitmap := TBGRABitmap.Create(imgStream); + ANbLayers := 1; + + stackStream := GetMemoryStream(LayerStackFilename); + ReadXMLFile(FStackXML, StackStream); + imageNode := StackXML.FindNode('image'); + if Assigned(imagenode) then + begin + stackNode := imageNode.FindNode('stack'); + if Assigned(stackNode) then + begin + ANbLayers:= 0; + for i := stackNode.ChildNodes.Length-1 downto 0 do + begin + if stackNode.ChildNodes[i].NodeName = 'layer' then + inc(ANbLayers); + end; + end; + end; + + finally + fileList.Free; + ClearFiles; + end; +end; + +procedure TBGRAOpenRasterDocument.LoadFromStream(AStream: TStream); +begin + OnLayeredBitmapLoadFromStreamStart; + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + end; +end; + +procedure TBGRAOpenRasterDocument.SetMimeType(AValue: string); +begin + SetMemoryStreamAsString('mimetype',AValue); +end; + +procedure TBGRAOpenRasterDocument.ZipOnCreateStream(Sender: TObject; var AStream: TStream; + AItem: TFullZipFileEntry); +var MemStream: TMemoryStream; +begin + MemStream := TMemoryStream.Create; + SetMemoryStream(AItem.ArchiveFileName, MemStream); + AStream := MemStream; +end; + +{$hints off} +procedure TBGRAOpenRasterDocument.ZipOnDoneStream(Sender: TObject; var AStream: TStream; + AItem: TFullZipFileEntry); +begin + //do nothing, files stay in memory +end; +{$hints on} + +procedure TBGRAOpenRasterDocument.ZipOnOpenInputStream(Sender: TObject; + var AStream: TStream); +begin + AStream := FZipInputStream; +end; + +procedure TBGRAOpenRasterDocument.ZipOnCloseInputStream(Sender: TObject; + var AStream: TStream); +begin + AStream := nil; //avoid freeing +end; + +procedure TBGRAOpenRasterDocument.ClearFiles; +var i: integer; +begin + for i := 0 to high(FFiles) do + ffiles[i].Stream.Free; + FFiles := nil; + FreeAndNil(FStackXML); +end; + +function TBGRAOpenRasterDocument.GetMemoryStream(AFilename: string): TMemoryStream; +var i: integer; +begin + for i := 0 to high(FFiles) do + if ffiles[i].Filename = AFilename then + begin + result := FFiles[i].Stream; + result.Position:= 0; + exit; + end; + result := nil; +end; + +procedure TBGRAOpenRasterDocument.SetMemoryStream(AFilename: string; + AStream: TMemoryStream); +var i: integer; +begin + for i := 0 to high(FFiles) do + if ffiles[i].Filename = AFilename then + begin + FreeAndNil(FFiles[i].Stream); + FFiles[i].Stream := AStream; + exit; + end; + setlength(FFiles, length(FFiles)+1); + FFiles[high(FFiles)].Filename := AFilename; + FFiles[high(FFiles)].Stream := AStream; +end; + +var AlreadyRegistered: boolean; + +procedure RegisterOpenRasterFormat; +begin + if AlreadyRegistered then exit; + ImageHandlers.RegisterImageReader ('OpenRaster', 'ora', TFPReaderOpenRaster); + RegisterLayeredBitmapReader('ora', TBGRAOpenRasterDocument); + RegisterLayeredBitmapWriter('ora', TBGRAOpenRasterDocument); + //TPicture.RegisterFileFormat('ora', 'OpenRaster', TBGRAOpenRasterDocument); + DefaultBGRAImageReader[ifOpenRaster] := TFPReaderOpenRaster; + DefaultBGRAImageWriter[ifOpenRaster] := TFPWriterOpenRaster; + AlreadyRegistered:= True; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapaintnet.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapaintnet.pas new file mode 100644 index 0000000..f205689 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapaintnet.pas @@ -0,0 +1,660 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPaintNet; + +{$mode objfpc}{$H+} + +interface + +{ This unit reads Paint.NET files. It needs BGRADNetDeserial to deserialize binary .Net objects. + + A Paint.NET image consists in three parts : + - Xml header + - Binary serialized information (contains layer information) + - Compressed data (pixel data) + + The class TPaintDotNetFile do not read the Xml header. ComputeFlatImage builds the resulting image + by using blending operations to merge layers. + + The unit registers a TFPCustomImageReader so that it can be read by any image reading function of FreePascal, + and also registers a reader for BGRALayers } + +uses + BGRAClasses, SysUtils, BGRADNetDeserial, FPImage, BGRABitmapTypes, BGRABitmap, BGRALayers; + +type + + { TPaintDotNetFile } + + TPaintDotNetFile = class(TBGRACustomLayeredBitmap) + public + procedure LoadFromFile(const filenameUTF8: string); override; + procedure LoadFromStream(stream: TStream); override; + procedure Clear; override; + function ToString: ansistring; override; + function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override; + constructor Create; override; + protected + procedure InternalLoadFromStream(stream: TStream); + function GetWidth: integer; override; + function GetHeight: integer; override; + function GetNbLayers: integer; override; + function GetBlendOperation(Layer: integer): TBlendOperation; override; + function GetLayerVisible(layer: integer): boolean; override; + function GetLayerOpacity(layer: integer): byte; override; + function GetLayerName(layer: integer): string; override; + private + Content: TDotNetDeserialization; + Document: TSerializedClass; + Layers: TSerializedClass; + LayerData: array of TMemoryStream; + function InternalGetLayer(num: integer): TSerializedClass; + function InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation; + function InternalGetLayerName(layer: TSerializedClass): string; + function InternalGetLayerVisible(layer: TSerializedClass): boolean; + function InternalGetLayerOpacity(layer: TSerializedClass): byte; + function LayerDataSize(numLayer: integer): int64; + procedure LoadLayer(dest: TMemoryStream; src: TStream; uncompressedSize: int64); + end; + + { TFPReaderPaintDotNet } + + TFPReaderPaintDotNet = class(TFPCustomImageReader) + private + FWidth,FHeight,FNbLayers: integer; + protected + function InternalCheck(Stream: TStream): boolean; override; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + public + property Width: integer read FWidth; + property Height: integer read FHeight; + property NbLayers: integer read FNbLayers; + end; + +function IsPaintDotNetFile(filename: string): boolean; +function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean; +function IsPaintDotNetStream(stream: TStream): boolean; +function LoadPaintDotNetFile(filename: string): TBGRABitmap; +function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap; + +procedure RegisterPaintNetFormat; + +implementation + +uses zstream, Math, BGRAUTF8; + +{$hints off} +function BEReadLongword(Stream: TStream): LongWord; +begin + Stream.Read(Result, sizeof(Result)); + Result := BEtoN(Result); +end; + +{$hints on} + +{$hints off} +function BEReadLongint(Stream: TStream): longint; +begin + Stream.Read(Result, sizeof(Result)); + Result := BEtoN(Result); +end; + +function IsPaintDotNetFile(filename: string): boolean; +var + stream: TFileStreamUTF8; +begin + Result := False; + if FileExists(filename) then + begin + stream := TFileStreamUTF8.Create(SysToUTF8(filename), fmOpenRead); + Result := IsPaintDotNetStream(stream); + stream.Free; + end; +end; + +function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean; +var + stream: TFileStreamUTF8; +begin + Result := False; + if FileExistsUTF8(filenameUTF8) then + begin + stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); + Result := IsPaintDotNetStream(stream); + stream.Free; + end; +end; + +function IsPaintDotNetStream(stream: TStream): boolean; +var + header: packed array[0..3] of char; + SavePos: int64; +begin + Result := False; + try + if stream.Position + 4 < Stream.Size then + begin + header := #0#0#0#0; + SavePos := stream.Position; + stream.Read(header, 4); + stream.Position := SavePos; + if (header[0] = 'P') and (header[1] = 'D') and (header[2] = 'N') and + (header[3] = '3') then + Result := True; + end; + except + on ex: Exception do ; + end; +end; + +function LoadPaintDotNetFile(filename: string): TBGRABitmap; +begin + result := LoadPaintDotNetFileUTF8(SysToUTF8(filename)); +end; + +function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap; +var + pdn: TPaintDotNetFile; +begin + pdn := TPaintDotNetFile.Create; + Result := nil; + try + pdn.LoadFromFile(filenameUTF8); + Result := pdn.ComputeFlatImage; + pdn.Free; + except + on ex: Exception do + begin + FreeAndNil(Result); + pdn.Free; + raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message); + end; + end; +end; + +function LoadPaintDotNetStream(stream: TStream): TBGRABitmap; +var + pdn: TPaintDotNetFile; +begin + pdn := TPaintDotNetFile.Create; + Result := nil; + try + pdn.LoadFromStream(stream); + Result := pdn.ComputeFlatImage; + pdn.Free; + except + on ex: Exception do + begin + FreeAndNil(Result); + pdn.Free; + raise Exception.Create('Error while loading Paint.NET stream. ' + ex.Message); + end; + end; +end; + +{$hints on} + +{ TFPReaderPaintDotNet } + +function TFPReaderPaintDotNet.InternalCheck(Stream: TStream): boolean; +begin + result := IsPaintDotNetStream(stream); +end; + +procedure TFPReaderPaintDotNet.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + pdn: TPaintDotNetFile; + flat: TBGRABitmap; + x,y: integer; +begin + FWidth := 0; + FHeight:= 0; + FNbLayers:= 0; + pdn := TPaintDotNetFile.Create; + try + pdn.LoadFromStream(Stream); + flat := pdn.ComputeFlatImage; + try + FWidth:= pdn.Width; + FHeight:= pdn.Height; + FNbLayers:= pdn.NbLayers; + + if Img is TBGRACustomBitmap then + TBGRACustomBitmap(Img).Assign(flat) else + begin + Img.SetSize(pdn.Width,pdn.Height); + for y := 0 to pdn.Height-1 do + for x := 0 to pdn.Width-1 do + Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); + end; + finally + flat.free; + end; + pdn.Free; + except + on ex: Exception do + begin + pdn.Free; + raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message); + end; + end; +end; + +{ TPaintDotNetFile } + +procedure TPaintDotNetFile.LoadFromFile(const filenameUTF8: string); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); + OnLayeredBitmapLoadStart(filenameUTF8); + try + InternalLoadFromStream(stream); + finally + OnLayeredBitmapLoaded; + stream.Free; + end; +end; + +procedure TPaintDotNetFile.LoadFromStream(stream: TStream); +begin + OnLayeredBitmapLoadFromStreamStart; + try + InternalLoadFromStream(stream); + finally + OnLayeredBitmapLoaded; + end; +end; + +procedure TPaintDotNetFile.InternalLoadFromStream(stream: TStream); +var + header: packed array[0..3] of char; + XmlHeaderSize: integer; + CompressionFormat: word; + i: integer; +begin + Clear; + header := #0#0#0#0; + stream.Read(header, 4); + if (header[0] <> 'P') or (header[1] <> 'D') or (header[2] <> 'N') or + (header[3] <> '3') then + raise Exception.Create('Invalid header'); + XmlHeaderSize := 0; + stream.Read(XmlHeaderSize, 3); + XmlheaderSize := LEtoN(XmlheaderSize); + if Stream.Position + XmlHeaderSize > stream.Size then + raise Exception.Create('Xml header size error'); + Stream.Position:= Stream.Position + XmlHeaderSize; + {$hints off} + stream.ReadBuffer(CompressionFormat, sizeof(CompressionFormat)); + {$hints on} + CompressionFormat := LEToN(CompressionFormat); + Content := TDotNetDeserialization.Create; + case Compressionformat of + $0100: Content.LoadFromStream(Stream); + $8b1f: raise Exception.Create('Serialized data decompression not handled'); + else + raise Exception.Create('Unknown compression format (' + + IntToStr(Compressionformat) + ')'); + end; + Document := Content.FindClass('Document'); + if Document <> nil then + Layers := Content.GetObjectField(Document, 'layers') as TSerializedClass; + SetLength(LayerData, NbLayers); + for i := 0 to NbLayers - 1 do + begin + OnLayeredBitmapLoadProgress((i+1)*100 div NbLayers); + LayerData[i] := TMemoryStream.Create; + LoadLayer(LayerData[i], Stream, LayerDataSize(i)); + end; + OnLayeredBitmapLoadProgress(100); +end; + +function TPaintDotNetFile.ToString: ansistring; +var + i, j, nbbytes: integer; + b: byte; +begin + Result := 'Paint.Net document' + LineEnding + LineEnding; + AppendStr(Result, Content.ToString); + for i := 0 to NbLayers - 1 do + begin + AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding); + AppendStr(Result, '[ '); + LayerData[i].Position := 0; + if LayerData[i].Size > 256 then + nbbytes := 256 + else + nbbytes := LayerData[i].Size; + for j := 0 to nbbytes - 1 do + begin + {$hints off} + LayerData[i].ReadBuffer(b, 1); + {$hints on} + AppendStr(Result, IntToHex(b, 2) + ' '); + end; + if LayerData[i].Size > nbbytes then + AppendStr(Result, '...'); + AppendStr(Result, ']' + lineending); + end; +end; + +constructor TPaintDotNetFile.Create; +begin + inherited Create; + Content := nil; + Document := nil; + Layers := nil; + LinearBlend := True; + RegisterPaintNetFormat; +end; + +procedure TPaintDotNetFile.Clear; +var + i: integer; +begin + FreeAndNil(content); + document := nil; + Layers := nil; + for i := 0 to high(LayerData) do + LayerData[i].Free; + setLength(LayerData, 0); +end; + +function TPaintDotNetFile.GetWidth: integer; +begin + if Document = nil then + Result := 0 + else + Result := StrToInt(Content.GetSimpleField(Document, 'width')); +end; + +function TPaintDotNetFile.GetHeight: integer; +begin + if Document = nil then + Result := 0 + else + Result := StrToInt(Content.GetSimpleField(Document, 'height')); +end; + +function TPaintDotNetFile.GetNbLayers: integer; +begin + if Layers = nil then + Result := 0 + else + Result := StrToInt(Content.GetSimpleField(Layers, '_size')); +end; + +function TPaintDotNetFile.GetBlendOperation(Layer: integer): TBlendOperation; +begin + Result := InternalGetBlendOperation(InternalGetLayer(layer)); +end; + +function TPaintDotNetFile.GetLayerVisible(layer: integer): boolean; +begin + Result := InternalGetLayerVisible(InternalGetLayer(layer)); +end; + +function TPaintDotNetFile.GetLayerOpacity(layer: integer): byte; +begin + Result := InternalGetLayerOpacity(InternalGetLayer(layer)); +end; + +function TPaintDotNetFile.GetLayerName(layer: integer): string; +begin + Result := InternalGetLayerName(InternalGetLayer(layer)); +end; + +function TPaintDotNetFile.GetLayerBitmapCopy(layer: integer): TBGRABitmap; +begin + if (layer < 0) or (layer >= NbLayers) then + raise Exception.Create('Index out of bounds'); + + Result := TBGRABitmap.Create(Width, Height); + if int64(Result.NbPixels) * 4 <> LayerData[layer].Size then + begin + Result.Free; + raise Exception.Create('Inconsistent layer data size'); + end + else + begin + layerData[layer].Position := 0; + layerData[layer].Read(Result.Data^, LayerData[layer].Size); + if TBGRAPixel_RGBAOrder then result.SwapRedBlue; + Result.InvalidateBitmap; + + if Result.LineOrder = riloBottomToTop then + Result.VerticalFlip; + end; +end; + +function TPaintDotNetFile.InternalGetLayerName(layer: TSerializedClass): string; +var + prop: TCustomSerializedObject; +begin + if layer = nil then + Result := '' + else + begin + prop := Content.GetObjectField(layer, 'Layer+properties'); + if prop = nil then + Result := '' + else + begin + Result := Content.GetSimpleField(prop, 'name'); + end; + end; +end; + +function TPaintDotNetFile.LayerDataSize(numLayer: integer): int64; +var + layer, surface, scan0: TCustomSerializedObject; +begin + layer := InternalGetLayer(numLayer); + if layer = nil then + Result := 0 + else + begin + surface := Content.GetObjectField(layer, 'surface'); + if surface = nil then + Result := 0 + else + begin + scan0 := Content.GetObjectField(surface, 'scan0'); + Result := StrToInt64(Content.GetSimpleField(scan0, 'length64')); + end; + end; +end; + +procedure TPaintDotNetFile.LoadLayer(dest: TMemoryStream; src: TStream; + uncompressedSize: int64); +var + CompressionFlag: byte; + maxChunkSize, decompressedChunkSize, compressedChunkSize: LongWord; + chunks: array of TMemoryStream; + numChunk: integer; + chunkCount, i: integer; + decomp: Tdecompressionstream; + nextPos: int64; + +begin + {$hints off} + src.ReadBuffer(CompressionFlag, 1); + {$hints on} + if CompressionFlag = 1 then + dest.CopyFrom(src, uncompressedSize) + else + if CompressionFlag = 0 then + begin + maxChunkSize := BEReadLongword(src); + if maxChunkSize < 4 then + raise Exception.Create('Invalid max chunk size'); + chunkCount := (uncompressedSize + maxChunkSize - 1) div maxChunkSize; + setlength(chunks, chunkCount); + for i := 0 to ChunkCount - 1 do + begin + numChunk := BEReadLongint(src); + if (numChunk < 0) or (numChunk >= chunkCount) then + raise Exception.Create('Chunk number out of bounds'); + compressedChunkSize := BEReadLongword(src); + nextPos := src.Position + compressedChunkSize; + src.Position := src.Position + 10; //skip gzip header + decompressedChunkSize := + min(maxChunkSize, uncompressedSize - int64(numChunk) * int64(maxChunkSize)); + decomp := Tdecompressionstream.Create(src, True); + chunks[numChunk] := TMemoryStream.Create; + chunks[numChunk].CopyFrom(decomp, decompressedChunkSize); + FreeAndNil(decomp); + src.Position := nextPos; + end; + for i := 0 to ChunkCount - 1 do + begin + chunks[i].Position := 0; + dest.CopyFrom(chunks[i], chunks[i].size); + chunks[i].Free; + end; + setlength(chunks, 0); + end + else + raise Exception('Unknown compression flag (' + IntToStr(CompressionFlag) + ')'); +end; + +function TPaintDotNetFile.InternalGetLayer(num: integer): TSerializedClass; +var + layerList: TCustomSerializedObject; +begin + if Layers = nil then + raise Exception.Create('No layers available') + else + if (num < 0) or (num >= NbLayers) then + raise Exception.Create('Layer index out of bounds') + else + begin + layerList := Content.GetObjectField(Layers, '_items'); + Result := Content.GetObject(layerList.FieldAsString[num]) as TSerializedClass; + end; +end; + +function TPaintDotNetFile.InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation; +var + prop, blendOp: TCustomSerializedObject; + blendName: string; +begin + if layer = nil then + Result := boTransparent + else + begin + prop := Content.GetObjectField(layer, 'properties'); + if prop = nil then + Result := boTransparent + else + begin + blendOp := Content.GetObjectField(prop, 'blendOp'); + if blendOp = nil then + Result := boTransparent + else + begin + blendName := blendOp.TypeAsString; + if (pos('+', blendName) <> 0) then + Delete(blendName, 1, pos('+', blendName)); + if copy(blendName, length(blendName) - length('BlendOp') + + 1, length('BlendOp')) = 'BlendOp' then + Delete(blendName, length(blendName) - length('BlendOp') + + 1, length('BlendOp')); + + if blendName = 'Normal' then + Result := boTransparent + else + if blendName = 'Multiply' then + Result := boLinearMultiply + else + if blendName = 'Additive' then + Result := boLinearAdd + else + if blendName = 'ColorBurn' then + Result := boColorBurn + else + if blendName = 'ColorDodge' then + Result := boColorDodge + else + if blendName = 'Reflect' then + Result := boReflect + else + if blendName = 'Glow' then + Result := boGlow + else + if blendName = 'Overlay' then + Result := boOverlay + else + if blendName = 'Difference' then + Result := boLinearDifference + else + if blendName = 'Negation' then + Result := boLinearNegation + else + if blendName = 'Lighten' then + Result := boLighten + else + if blendName = 'Darken' then + Result := boDarken + else + if blendName = 'Screen' then + Result := boScreen + else + if blendName = 'Xor' then + Result := boXor + else + Result := boTransparent; + end; + end; + end; +end; + +function TPaintDotNetFile.InternalGetLayerVisible(layer: TSerializedClass): boolean; +var + prop: TCustomSerializedObject; +begin + if layer = nil then + Result := False + else + begin + prop := Content.GetObjectField(layer, 'Layer+properties'); + if prop = nil then + Result := False + else + begin + Result := (Content.GetSimpleField(prop, 'visible') = 'True'); + end; + end; +end; + +function TPaintDotNetFile.InternalGetLayerOpacity(layer: TSerializedClass): byte; +var + prop: TCustomSerializedObject; +begin + if layer = nil then + Result := 0 + else + begin + prop := Content.GetObjectField(layer, 'Layer+properties'); + if prop = nil then + Result := 0 + else + begin + Result := StrToInt(Content.GetSimpleField(prop, 'opacity')); + end; + end; +end; + +var AlreadyRegistered: boolean; + +procedure RegisterPaintNetFormat; +begin + if AlreadyRegistered then exit; + ImageHandlers.RegisterImageReader ('Paint.NET image', 'pdn', TFPReaderPaintDotNet); + RegisterLayeredBitmapReader('pdn', TPaintDotNetFile); + //TPicture.RegisterFileFormat('pdn', 'Paint.NET image', TPaintDotNetFile); + DefaultBGRAImageReader[ifPaintDotNet] := TFPReaderPaintDotNet; + AlreadyRegistered := true; +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapalette.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapalette.pas new file mode 100644 index 0000000..d083627 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapalette.pas @@ -0,0 +1,1408 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPalette; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, Avl_Tree, BGRABitmapTypes, FPimage; + +const + MaxLastAddedColors = 10; + +type + TBGRAPaletteFormat = integer; + +const + palUnknown : TBGRAPaletteFormat = 0; + palPaintDotNet : TBGRAPaletteFormat = 1; + palGimp : TBGRAPaletteFormat = 2; + palAdobeSwatchExchange : TBGRAPaletteFormat = 3; + palKOffice : TBGRAPaletteFormat = 4; + palJascPSP : TBGRAPaletteFormat = 5; + palCustom : TBGRAPaletteFormat = 100; + +type + TBGRAIndexedPaletteEntry = packed record + Color: TBGRAPixel; + Index: UInt32; + end; + PBGRAIndexedPaletteEntry = ^TBGRAIndexedPaletteEntry; + TBGRAWeightedPaletteEntry = packed record + Color: TBGRAPixel; + Weight: UInt32; + end; + PBGRAWeightedPaletteEntry = ^TBGRAWeightedPaletteEntry; + ArrayOfWeightedColor = array of TBGRAWeightedPaletteEntry; + + TBGRAPixelComparer = function (p1,p2 : PBGRAPixel): boolean; + + { TBGRACustomPalette } + + TBGRACustomPalette = class + private + function GetDominantColor: TBGRAPixel; + protected + function GetCount: integer; virtual; abstract; + function GetColorByIndex(AIndex: integer): TBGRAPixel; virtual; abstract; + public + function ContainsColor(AValue: TBGRAPixel): boolean; virtual; abstract; + function IndexOfColor(AValue: TBGRAPixel): integer; virtual; abstract; + function GetAsArrayOfColor: ArrayOfTBGRAPixel; virtual; abstract; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; virtual; abstract; + procedure AssignTo(AImage: TFPCustomImage); overload; + procedure AssignTo(APalette: TFPPalette); overload; + property DominantColor: TBGRAPixel read GetDominantColor; + property Count: integer read GetCount; + property Color[AIndex: integer]: TBGRAPixel read GetColorByIndex; + end; + +type + { TBGRAAvgLvlPalette } + + TBGRAAvgLvlPalette = class(TBGRACustomPalette) + protected + FTree: TAVLTree; + FArray: array of PBGRAPixel; + FLastAddedColors: packed array[0..MaxLastAddedColors-1] of PBGRAPixel; + FLastAddedColorCount: integer; + function GetCount: integer; override; + function GetColorByIndex(AIndex: integer): TBGRAPixel; override; + procedure FreeEntry(AEntry: PBGRAPixel); virtual; abstract; + procedure NeedArray; virtual; + procedure ClearArray; virtual; + procedure AddLastColor(AColor: PBGRAPixel); + function GetLastColor(AValue: TBGRAPixel): PBGRAPixel; + procedure ClearLastColors; + public + constructor Create; overload; + function ContainsColor(AValue: TBGRAPixel): boolean; override; + function IndexOfColor(AValue: TBGRAPixel): integer; override; + procedure Clear; virtual; + destructor Destroy; override; + function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; + end; + + { TBGRAPalette } + + TBGRAPalette = class(TBGRAAvgLvlPalette) + protected + function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; virtual; + procedure FreeEntry(AEntry: PBGRAPixel); override; + procedure IncludePixel(PPixel: PBGRAPixel); virtual; + procedure ExceptionUnknownPaletteFormat; + procedure ExceptionInvalidPaletteFormat; + public + constructor Create(ABitmap: TBGRACustomBitmap); overload; virtual; + constructor Create(APalette: TBGRACustomPalette); overload; virtual; + constructor Create(AColors: ArrayOfTBGRAPixel); overload; virtual; + constructor Create(AColors: ArrayOfWeightedColor); overload; virtual; + function AddColor(AValue: TBGRAPixel): boolean; virtual; + procedure AddColors(ABitmap: TBGRACustomBitmap); overload; virtual; + procedure AddColors(APalette: TBGRACustomPalette); overload; virtual; + function RemoveColor(AValue: TBGRAPixel): boolean; virtual; + procedure LoadFromFile(AFilenameUTF8: string); virtual; + procedure LoadFromStream(AStream: TStream; AFormat: TBGRAPaletteFormat); virtual; + procedure LoadFromResource(AFilename: string; AFormat: TBGRAPaletteFormat); + procedure SaveToFile(AFilenameUTF8: string); virtual; + procedure SaveToStream(AStream: TStream; AFormat: TBGRAPaletteFormat); virtual; + function DetectPaletteFormat(AStream: TStream): TBGRAPaletteFormat; overload; virtual; + function DetectPaletteFormat(AFilenameUTF8: string): TBGRAPaletteFormat; overload; + function SuggestPaletteFormat(AFilenameUTF8: string): TBGRAPaletteFormat; virtual; + end; + + { TBGRAIndexedPalette } + + TBGRAIndexedPalette = class(TBGRAPalette) + private + FCurrentIndex: UInt32; + protected + procedure NeedArray; override; + function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; override; + procedure FreeEntry(AEntry: PBGRAPixel); override; + public + function RemoveColor({%H-}AValue: TBGRAPixel): boolean; override; + function IndexOfColor(AValue: TBGRAPixel): integer; override; + procedure Clear; override; + end; + + { TBGRAWeightedPalette } + + TBGRAWeightedPalette = class(TBGRAPalette) + private + protected + function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; override; + procedure FreeEntry(AEntry: PBGRAPixel); override; + function GetWeightByIndex(AIndex: Integer): UInt32; virtual; + procedure IncludePixel(PPixel: PBGRAPixel); override; + public + constructor Create(AColors: ArrayOfWeightedColor); override; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; + function IncColor(AValue: TBGRAPixel; out NewWeight: UInt32): boolean; + function DecColor(AValue: TBGRAPixel; out NewWeight: UInt32): boolean; + property Weight[AIndex: Integer]: UInt32 read GetWeightByIndex; + end; + + { TBGRAReferencePalette } + + TBGRAReferencePalette = class(TBGRAAvgLvlPalette) + protected + procedure FreeEntry({%H-}AEntry: PBGRAPixel); override; + public + function AddColor(AValue: PBGRAPixel): boolean; + function RemoveColor(AValue: PBGRAPixel): boolean; + end; + + { TBGRACustomApproxPalette } + + TBGRACustomApproxPalette = class(TBGRACustomPalette) + private + function FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel; inline; + function FindNearestColorIndexIgnoreAlpha(AValue: TBGRAPixel): integer; inline; + protected + function GetWeightByIndex({%H-}AIndex: Integer): UInt32; virtual; + public + function FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel; overload; + function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; overload; virtual; abstract; + function FindNearestColorIndex(AValue: TBGRAPixel; AIgnoreAlpha: boolean): integer; overload; + function FindNearestColorIndex(AValue: TBGRAPixel): integer; overload; virtual; abstract; + property Weight[AIndex: Integer]: UInt32 read GetWeightByIndex; + end; + + { TBGRA16BitPalette } + + TBGRA16BitPalette = class(TBGRACustomApproxPalette) + protected + function GetCount: integer; override; + function GetColorByIndex(AIndex: integer): TBGRAPixel; override; + public + function ContainsColor(AValue: TBGRAPixel): boolean; override; + function IndexOfColor(AValue: TBGRAPixel): integer; override; + function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; + function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; + function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; + function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; + end; + + { TBGRACustomColorQuantizer } + + TBGRACustomColorQuantizer = class + protected + function GetDominantColor: TBGRAPixel; virtual; + function GetPalette: TBGRACustomApproxPalette; virtual; abstract; + function GetSourceColor(AIndex: integer): TBGRAPixel; virtual; abstract; + function GetSourceColorCount: Integer; virtual; abstract; + function GetReductionColorCount: integer; virtual; abstract; + procedure SetReductionColorCount(AValue: Integer); virtual; abstract; + public + constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); overload; virtual; abstract; + constructor Create(AColors: array of TBGRAPixel; ASeparateAlphaChannel: boolean); overload; + constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; virtual; abstract; + constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload; virtual; abstract; + constructor Create(AColors: array of TBGRAPixel; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload; + constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); overload; virtual; abstract; + procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); overload; virtual; abstract; + procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap); overload; + function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; virtual; abstract; + function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; overload; + procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string); overload; + procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string; AFormat: TBGRAImageFormat); overload; + procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); virtual; abstract; + function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; + function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): Pointer; overload; + function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; virtual; abstract; + property SourceColorCount: Integer read GetSourceColorCount; + property SourceColor[AIndex: integer]: TBGRAPixel read GetSourceColor; + property ReductionColorCount: Integer read GetReductionColorCount write SetReductionColorCount; + property ReducedPalette: TBGRACustomApproxPalette read GetPalette; + property DominantColor: TBGRAPixel read GetDominantColor; + end; + + TBGRAColorQuantizerAny = class of TBGRACustomColorQuantizer; + +var + BGRAColorQuantizerFactory: TBGRAColorQuantizerAny; + +function BGRARequiredBitDepth(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; overload; +function BGRARequiredBitDepth(APalette: TBGRACustomPalette): integer; overload; + +type + TPaletteReaderProc = function(APalette: TBGRAPalette; AStream: TStream): boolean; + TPaletteWriterProc = procedure(APalette: TBGRAPalette; AStream: TStream); + TCheckPaletteFormatProc = function(ABuf256: string): boolean; + +procedure BGRARegisterPaletteFormat(AFormatIndex: TBGRAPaletteFormat; AExtension: string; ADescription: string; + AReadProc: TPaletteReaderProc; AWriteProc: TPaletteWriterProc; ACheckFormatProc: TCheckPaletteFormatProc); +function BGRARegisteredPaletteFormatFilter(AAllSupportedDescription: string) : string; + +procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); + +procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); + +procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); + +procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); + +implementation + +uses BGRAUTF8, bufstream; + +function IsDWordGreater(p1, p2: PBGRAPixel): boolean; +begin + result := LongWord(p1^) > LongWord(p2^); +end; + +const + InsertionSortLimit = 10; + +procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); +var i,j,insertPos: Int32or64; + compared: TBGRAWeightedPaletteEntry; +begin + if AComparer = nil then AComparer := @IsDWordGreater; + for i := AMinIndex+1 to AMaxIndex do + begin + insertPos := i; + compared := AColors[i]; + while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1].Color,@compared.Color) do + dec(insertPos); + if insertPos <> i then + begin + for j := i downto insertPos+1 do + AColors[j] := AColors[j-1]; + AColors[insertPos] := compared; + end; + end; +end; + +procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); +var Pivot: TBGRAPixel; + CurMin,CurMax,i : Int32or64; + + procedure Swap(a,b: Int32or64); + var Temp: TBGRAWeightedPaletteEntry; + begin + if a = b then exit; + Temp := AColors[a]; + AColors[a] := AColors[b]; + AColors[b] := Temp; + end; +begin + if AComparer = nil then AComparer := @IsDWordGreater; + if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then + begin + ArrayOfWeightedColor_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer); + exit; + end; + Pivot := AColors[(AMinIndex+AMaxIndex) shr 1].Color; + CurMin := AMinIndex; + CurMax := AMaxIndex; + i := CurMin; + while i < CurMax do + begin + if AComparer(@AColors[i].Color, @Pivot) then + begin + Swap(i, CurMax); + dec(CurMax); + end else + begin + if AComparer(@Pivot, @AColors[i].Color) then + begin + Swap(i, CurMin); + inc(CurMin); + end; + inc(i); + end; + end; + if AComparer(@Pivot, @AColors[i].Color) then + begin + Swap(i, CurMin); + inc(CurMin); + end; + if CurMin > AMinIndex then ArrayOfWeightedColor_QuickSort(AColors,AMinIndex,CurMin,AComparer); + if CurMax < AMaxIndex then ArrayOfWeightedColor_QuickSort(AColors,CurMax,AMaxIndex,AComparer); +end; + +procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); +var i,j,insertPos: Int32or64; + compared: TBGRAPixel; +begin + if AComparer = nil then AComparer := @IsDWordGreater; + for i := AMinIndex+1 to AMaxIndex do + begin + insertPos := i; + compared := AColors[i]; + while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1],@compared) do + dec(insertPos); + if insertPos <> i then + begin + for j := i downto insertPos+1 do + AColors[j] := AColors[j-1]; + AColors[insertPos] := compared; + end; + end; +end; + +procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex, + AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); +var Pivot: TBGRAPixel; + CurMin,CurMax,i : Int32or64; + + procedure Swap(a,b: Int32or64); + var Temp: TBGRAPixel; + begin + if a = b then exit; + Temp := AColors[a]; + AColors[a] := AColors[b]; + AColors[b] := Temp; + end; +begin + if AComparer = nil then AComparer := @IsDWordGreater; + if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then + begin + ArrayOfTBGRAPixel_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer); + exit; + end; + Pivot := AColors[(AMinIndex+AMaxIndex) shr 1]; + CurMin := AMinIndex; + CurMax := AMaxIndex; + i := CurMin; + while i < CurMax do + begin + if AComparer(@AColors[i], @Pivot) then + begin + Swap(i, CurMax); + dec(CurMax); + end else + begin + if AComparer(@Pivot, @AColors[i]) then + begin + Swap(i, CurMin); + inc(CurMin); + end; + inc(i); + end; + end; + if AComparer(@Pivot, @AColors[i]) then + begin + Swap(i, CurMin); + inc(CurMin); + end; + if CurMin > AMinIndex then ArrayOfTBGRAPixel_QuickSort(AColors,AMinIndex,CurMin,AComparer); + if CurMax < AMaxIndex then ArrayOfTBGRAPixel_QuickSort(AColors,CurMax,AMaxIndex,AComparer); +end; + +{$i paletteformats.inc} + +function BGRARequiredBitDepth(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; +var + palette: TBGRAPalette; + p: PBGRAPixel; + i: Int32or64; + transparentEntry: boolean; +begin + palette := TBGRAPalette.Create; + p := ABitmap.Data; + transparentEntry := false; + if AAlpha = acIgnore then + begin + for i := ABitmap.NbPixels-1 downto 0 do + begin + palette.AddColor(BGRA(p^.red,p^.green,p^.blue)); + inc(p); + if palette.Count > 256 then break; + end; + end else + if AAlpha = acTransparentEntry then + begin + for i := ABitmap.NbPixels-1 downto 0 do + begin + if p^.alpha < 128 then + transparentEntry:= true + else + palette.AddColor(BGRA(p^.red,p^.green,p^.blue)); + inc(p); + if palette.Count > 256 then break; + end; + end else + begin + for i := ABitmap.NbPixels-1 downto 0 do + begin + palette.AddColor(p^); + inc(p); + if palette.Count > 256 then break; + end; + end; + + if palette.Count+byte(transparentEntry) > 256 then + begin + if (AAlpha = acFullChannelInPalette) and ABitmap.HasTransparentPixels then + result := 32 + else + if (AAlpha = acTransparentEntry) and ABitmap.HasTransparentPixels then + result := 25 + else + result := 24; + end else + begin + result := 8; + while (result > 0) and (1 shl (result shr 1) >= palette.Count) do result := result shr 1; + end; + palette.Free; +end; + +function BGRARequiredBitDepth(APalette: TBGRACustomPalette): integer; +var i: integer; + hasTransp: boolean; +begin + if APalette.Count > 256 then + begin + hasTransp := false; + for i := 0 to APalette.Count-1 do + if APalette.Color[i].alpha <> 255 then + begin + hasTransp:= true; + break; + end; + if hasTransp then + result := 32 + else + result := 24; + end else + begin + result := 8; + while (result > 0) and (1 shl (result shr 1) >= APalette.Count) do result := result shr 1; + end; +end; + +{ TBGRA16BitPalette } + +function TBGRA16BitPalette.GetCount: integer; +begin + result := 65537; +end; + +function TBGRA16BitPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; +begin + if (AIndex >= 65536) or (AIndex < 0) then + result := BGRAPixelTransparent + else + result := Color16BitToBGRA(AIndex); +end; + +function TBGRA16BitPalette.ContainsColor(AValue: TBGRAPixel): boolean; +begin + if AValue.alpha = 0 then + result := true + else + result := (AValue.alpha = 255) and (FindNearestColor(AValue)=AValue); +end; + +function TBGRA16BitPalette.IndexOfColor(AValue: TBGRAPixel): integer; +var idx: integer; +begin + if AValue.Alpha = 0 then + result := 65536 + else + begin + idx := BGRAToColor16Bit(AValue); + if Color16BitToBGRA(idx)=AValue then + result := idx + else + result := -1; + end; +end; + +function TBGRA16BitPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; +begin + result := nil; + raise exception.Create('Palette too big'); +end; + +function TBGRA16BitPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; +begin + result := nil; + raise exception.Create('Palette too big'); +end; + +function TBGRA16BitPalette.FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; +begin + if AValue.alpha = 0 then result := BGRAPixelTransparent + else + result := GetColorByIndex(BGRAToColor16Bit(AValue)); +end; + +function TBGRA16BitPalette.FindNearestColorIndex(AValue: TBGRAPixel): integer; +begin + result := BGRAToColor16Bit(AValue); +end; + +{ TBGRAIndexedPalette } + +procedure TBGRAIndexedPalette.NeedArray; +var Node: TAVLTreeNode; + n: UInt32; +begin + n := Count; + if UInt32(length(FArray)) <> n then + begin + setLength(FArray,n); + for Node in FTree do + with PBGRAIndexedPaletteEntry(Node.Data)^ do + begin + if Index < n then //index is unsigned so always >= 0 + FArray[Index] := @Color; + end; + end; +end; + +function TBGRAIndexedPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; +begin + result := PBGRAPixel(GetMem(sizeOf(TBGRAIndexedPaletteEntry))); + result^ := AColor; + PBGRAIndexedPaletteEntry(result)^.Index := FCurrentIndex; + Inc(FCurrentIndex); +end; + +procedure TBGRAIndexedPalette.FreeEntry(AEntry: PBGRAPixel); +begin + FreeMem(AEntry); +end; + +function TBGRAIndexedPalette.RemoveColor(AValue: TBGRAPixel): boolean; +begin + Result:= false; + raise exception.Create('It is not possible to remove a color from an indexed palette'); +end; + +function TBGRAIndexedPalette.IndexOfColor(AValue: TBGRAPixel): integer; +Var Node: TAVLTreeNode; +begin + Node := FTree.Find(@AValue); + if Assigned(Node) then + result := PBGRAIndexedPaletteEntry(Node.Data)^.Index + else + result := -1; +end; + +procedure TBGRAIndexedPalette.Clear; +begin + inherited Clear; + FCurrentIndex := 0; +end; + +{ TBGRACustomColorQuantizer } + +function TBGRACustomColorQuantizer.GetDominantColor: TBGRAPixel; +begin + result := ReducedPalette.DominantColor; +end; + +constructor TBGRACustomColorQuantizer.Create(AColors: array of TBGRAPixel; + ASeparateAlphaChannel: boolean); +var palette: TBGRAPalette; + i: Integer; +begin + palette := TBGRAPalette.Create; + for i := 0 to high(AColors) do + palette.AddColor(AColors[i]); + Create(palette, ASeparateAlphaChannel); + palette.Free; +end; + +constructor TBGRACustomColorQuantizer.Create(AColors: array of TBGRAPixel; + ASeparateAlphaChannel: boolean; AReductionColorCount: integer); +var palette: TBGRAPalette; + i: Integer; +begin + palette := TBGRAPalette.Create; + for i := 0 to high(AColors) do + palette.AddColor(AColors[i]); + Create(palette, ASeparateAlphaChannel, AReductionColorCount); + palette.Free; +end; + +procedure TBGRACustomColorQuantizer.ApplyDitheringInplace( + AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap); +begin + ApplyDitheringInplace(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height)); +end; + +function TBGRACustomColorQuantizer.GetDitheredBitmap( + AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap + ): TBGRACustomBitmap; +begin + result := GetDitheredBitmap(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height)); +end; + +procedure TBGRACustomColorQuantizer.SaveBitmapToFile( + AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + AFilenameUTF8: string); +begin + SaveBitmapToFile(AAlgorithm, ABitmap, AFilenameUTF8, SuggestImageFormat(AFilenameUTF8)); +end; + +procedure TBGRACustomColorQuantizer.SaveBitmapToFile( + AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + AFilenameUTF8: string; AFormat: TBGRAImageFormat); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); + try + SaveBitmapToStream(AAlgorithm, ABitmap, stream, AFormat); + finally + stream.Free; + end; +end; + +function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData( + ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; + out AScanlineSize: PtrInt): Pointer; +begin + result := GetDitheredBitmapIndexedData(ABitDepth, + {$IFDEF ENDIAN_LITTLE}riboLSBFirst{$ELSE}riboMSBFirst{$endif}, + AAlgorithm, ABitmap, AScanlineSize); +end; + +function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData( + ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; + ABitmap: TBGRACustomBitmap): Pointer; +var dummy: PtrInt; +begin + result := GetDitheredBitmapIndexedData(ABitDepth, AAlgorithm, ABitmap, dummy); +end; + +{ TBGRACustomPalette } + +function TBGRACustomPalette.GetDominantColor: TBGRAPixel; +var + w: ArrayOfWeightedColor; + i: Integer; + maxWeight, totalWeight: UInt32; +begin + result := BGRAWhite; + maxWeight := 0; + w := GetAsArrayOfWeightedColor; + totalWeight:= 0; + for i := 0 to high(w) do + inc(totalWeight, w[i].Weight); + for i := 0 to high(w) do + if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).saturation > 16000) then + begin + maxWeight:= w[i].Weight; + result := w[i].Color; + end; + if maxWeight > totalWeight div 20 then exit; + for i := 0 to high(w) do + if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).lightness < 56000) and (BGRAToGSBA(w[i].Color).lightness > 16000) then + begin + maxWeight:= w[i].Weight; + result := w[i].Color; + end; + if maxWeight > 0 then exit; + for i := 0 to high(w) do + if (w[i].Weight > maxWeight) then + begin + maxWeight:= w[i].Weight; + result := w[i].Color; + end; +end; + +procedure TBGRACustomPalette.AssignTo(AImage: TFPCustomImage); +begin + AImage.UsePalette := true; + AssignTo(AImage.Palette); +end; + +procedure TBGRACustomPalette.AssignTo(APalette: TFPPalette); +var i: integer; +begin + APalette.Clear; + APalette.Capacity := Count; + for i := 0 to Count-1 do + APalette.Color[i] := BGRAToFPColor(Color[i]); +end; + +{ TBGRACustomApproxPalette } + +function TBGRACustomApproxPalette.FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel; +var saveAlpha: byte; +begin + if AValue.alpha = 0 then + result := BGRAPixelTransparent + else + begin + saveAlpha := AValue.alpha; + AValue.alpha := 255; + result := FindNearestColor(AValue); + result.alpha := saveAlpha; + end; +end; + +function TBGRACustomApproxPalette.FindNearestColorIndexIgnoreAlpha( + AValue: TBGRAPixel): integer; +begin + if AValue.alpha = 0 then + result := -1 + else + begin + AValue.alpha := 255; + result := FindNearestColorIndex(AValue); + end; +end; + +function TBGRACustomApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32; +begin + result := 1; +end; + +function TBGRACustomApproxPalette.FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel; +begin + if AIgnoreAlpha then + result := FindNearestColorIgnoreAlpha(AValue) + else + result := FindNearestColor(AValue); +end; + +function TBGRACustomApproxPalette.FindNearestColorIndex(AValue: TBGRAPixel; + AIgnoreAlpha: boolean): integer; +begin + if AIgnoreAlpha then + result := FindNearestColorIndexIgnoreAlpha(AValue) + else + result := FindNearestColorIndex(AValue); +end; + +{ TBGRAWeightedPalette } + +function TBGRAWeightedPalette.GetWeightByIndex(AIndex: Integer): UInt32; +begin + NeedArray; + if (AIndex >= 0) and (AIndex < length(FArray)) then + result := PBGRAWeightedPaletteEntry(FArray[AIndex])^.Weight + else + raise ERangeError.Create('Index out of bounds'); +end; + +procedure TBGRAWeightedPalette.IncludePixel(PPixel: PBGRAPixel); +var dummy: UInt32; +begin + IncColor(PPixel^,dummy); +end; + +constructor TBGRAWeightedPalette.Create(AColors: ArrayOfWeightedColor); +var + i: Integer; +begin + inherited Create; + for i := 0 to high(AColors) do + with AColors[i] do IncColor(Color,Weight); +end; + +function TBGRAWeightedPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; +var + i: Int32or64; +begin + NeedArray; + setlength(result, length(FArray)); + for i := 0 to high(result) do + result[i] := PBGRAWeightedPaletteEntry(FArray[i])^; +end; + +function TBGRAWeightedPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; +begin + result := PBGRAPixel(GetMem(sizeOf(TBGRAWeightedPaletteEntry))); + result^ := AColor; + PBGRAWeightedPaletteEntry(result)^.Weight := 1; +end; + +procedure TBGRAWeightedPalette.FreeEntry(AEntry: PBGRAPixel); +begin + FreeMem(AEntry); +end; + +function TBGRAWeightedPalette.IncColor(AValue: TBGRAPixel; out NewWeight: UInt32 + ): boolean; +Var Node: TAVLTreeNode; + Entry: PBGRAPixel; +begin + Entry := GetLastColor(AValue); + if Entry <> nil then + begin + NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight+1; + PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; + result := false; + exit; + end; + Node := FTree.Find(@AValue); + if Assigned(Node) then + begin + Entry := PBGRAPixel(Node.Data); + NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight+1; + PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; + AddLastColor(Entry); + result := false; + end + else + begin + Entry := CreateEntry(AValue); + FTree.Add(Entry); + ClearArray; + NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight; + AddLastColor(Entry); + result := true; + end; +end; + +function TBGRAWeightedPalette.DecColor(AValue: TBGRAPixel; out NewWeight: UInt32 + ): boolean; +var + Node : TAVLTreeNode; + Entry: PBGRAPixel; +begin + Node := FTree.Find(@AValue); + if Assigned(Node) then + begin + Entry := PBGRAPixel(Node.Data); + NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight; + if NewWeight >= 2 then + begin + dec(NewWeight); + PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; + end + else + begin + NewWeight := 0; + FreeEntry(Entry); + FTree.Delete(Node); + ClearArray; + ClearLastColors; + end; + result := true; + end else + begin + result := false; + NewWeight := 0; + end; +end; + +{ TBGRAReferencePalette } + +procedure TBGRAReferencePalette.FreeEntry(AEntry: PBGRAPixel); +begin + //nothing +end; + +function TBGRAReferencePalette.AddColor(AValue: PBGRAPixel): boolean; +begin + if Assigned(GetLastColor(AValue^)) then + begin + result := false; + exit; + end; + AddLastColor(AValue); + if Assigned(FTree.Find(AValue)) then + begin + result := false; + end + else + begin + result := true; + FTree.Add(AValue); + ClearArray; + end; +end; + +function TBGRAReferencePalette.RemoveColor(AValue: PBGRAPixel): boolean; +var + Node : TAVLTreeNode; +begin + Node := FTree.Find(AValue); + if Assigned(Node) then + begin + FTree.Delete(Node); + result := true; + ClearArray; + ClearLastColors; + end else + result := false; +end; + +function PaletteOnCompareItems(Data1, Data2: Pointer): integer; +var gray1, gray2: UInt32or64; + c1, c2: TBGRAPixel; +begin + c1 := PBGRAPixel(Data1)^; + c2 := PBGRAPixel(Data2)^; + if c1.alpha < c2.alpha then + result := -1 + else if c1.alpha > c2.alpha then + result := 1 + else + begin + gray1 := (GammaExpansionTab[c1.red] shl 8)+(GammaExpansionTab[c1.green] shl 9)+(GammaExpansionTab[c1.blue] shl 7); + gray2 := (GammaExpansionTab[c2.red] shl 8)+(GammaExpansionTab[c2.green] shl 9)+(GammaExpansionTab[c2.blue] shl 7); + if gray1gray2 then + result := 1 + else + begin + if c1.green > c2.green then + result := 1 + else if c1.green < c2.green then + result := -1 + else if c1.red > c2.red then + result := 1 + else if c1.red < c2.red then + result := -1 + else if c1.blue > c2.blue then + result := 1 + else if c1.blue < c2.blue then + result := -1 + else + result := 0; + end; + end; +end; + +{ TBGRAAvgLvlPalette } + +constructor TBGRAAvgLvlPalette.Create; +begin + FTree := TAVLTree.Create; + FTree.OnCompare := @PaletteOnCompareItems; +end; + +destructor TBGRAAvgLvlPalette.Destroy; +begin + Clear; + FreeAndNil(FTree); + inherited Destroy; +end; + +function TBGRAAvgLvlPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; +var i: Int32or64; +begin + NeedArray; + setlength(result, Length(FArray)); + for i := 0 to high(result) do + result[i] := FArray[i]^; +end; + +function TBGRAAvgLvlPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; +var i: Int32or64; +begin + NeedArray; + setlength(result, Length(FArray)); + for i := 0 to high(result) do + with result[i] do + begin + Color := FArray[i]^; + Weight:= 1; + end; +end; + +procedure TBGRAAvgLvlPalette.Clear; +var Node: TAVLTreeNode; +begin + For Node in FTree do + FreeEntry(PBGRAPixel(Node.Data)); + FTree.Clear; + ClearArray; + FLastAddedColorCount := 0; +end; + +function TBGRAAvgLvlPalette.GetCount: integer; +begin + result := FTree.Count; +end; + +function TBGRAAvgLvlPalette.ContainsColor(AValue: TBGRAPixel): boolean; +Var Node: TAVLTreeNode; +begin + if Assigned(GetLastColor(AValue)) then + begin + result := true; + exit; + end; + Node := FTree.Find(@AValue); + result := Assigned(Node); + if result then AddLastColor(PBGRAPixel(Node.Data)); +end; + +function TBGRAAvgLvlPalette.IndexOfColor(AValue: TBGRAPixel): integer; +Var Node: TAVLTreeNode; +begin + Node := FTree.Find(@AValue); + if Assigned(Node) then + begin + result := 0; + Node := Node.Left; + while Assigned(Node) do + begin + inc(result); + Node := Node.Left; + end; + end else + result := -1; +end; + +function TBGRAAvgLvlPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; +begin + NeedArray; + if (AIndex >= 0) and (AIndex < length(FArray)) then + result := FArray[AIndex]^ + else + raise ERangeError.Create('Index out of bounds'); +end; + +procedure TBGRAAvgLvlPalette.NeedArray; +var Node: TAVLTreeNode; + i,n: integer; +begin + n := Count; + if length(FArray) <> n then + begin + setLength(FArray,n); + i := 0; + for Node in FTree do + begin + if i >= n then break; + FArray[i] := PBGRAPixel(Node.Data); + inc(i); + end; + end; +end; + +procedure TBGRAAvgLvlPalette.ClearArray; +begin + FArray := nil; +end; + +procedure TBGRAAvgLvlPalette.AddLastColor(AColor: PBGRAPixel); +begin + if FLastAddedColorCount < MaxLastAddedColors then + begin + FLastAddedColors[FLastAddedColorCount] := AColor; + inc(FLastAddedColorCount); + end else + begin + move(FLastAddedColors[1],FLastAddedColors[0],(FLastAddedColorCount-1)*sizeof(PBGRAPixel)); + FLastAddedColors[FLastAddedColorCount-1] := AColor; + end; +end; + +function TBGRAAvgLvlPalette.GetLastColor(AValue: TBGRAPixel): PBGRAPixel; +var + i: Int32or64; +begin + for i := FLastAddedColorCount-1 downto 0 do + if PLongWord(FLastAddedColors[i])^ = LongWord(AValue) then + begin + result := FLastAddedColors[i]; + exit; + end; + result := nil; +end; + +procedure TBGRAAvgLvlPalette.ClearLastColors; +begin + FLastAddedColorCount := 0; +end; + +{ TBGRAPalette } + +function TBGRAPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; +begin + result := PBGRAPixel(GetMem(sizeOf(TBGRAPixel))); + result^ := AColor; +end; + +procedure TBGRAPalette.FreeEntry(AEntry: PBGRAPixel); +begin + FreeMem(AEntry); +end; + +procedure TBGRAPalette.IncludePixel(PPixel: PBGRAPixel); +begin + AddColor(PPixel^); +end; + +procedure TBGRAPalette.ExceptionUnknownPaletteFormat; +begin + raise Exception.Create('Unknown palette format'); +end; + +procedure TBGRAPalette.ExceptionInvalidPaletteFormat; +begin + raise Exception.Create('Invalid palette format'); +end; + +constructor TBGRAPalette.Create(ABitmap: TBGRACustomBitmap); +var p: PBGRAPixel; + n: integer; +begin + inherited Create; + n:= ABitmap.NbPixels; + p := ABitmap.Data; + while n > 0 do + begin + IncludePixel(p); + inc(p); + dec(n); + end; +end; + +constructor TBGRAPalette.Create(APalette: TBGRACustomPalette); +begin + inherited Create; + AddColors(APalette); +end; + +constructor TBGRAPalette.Create(AColors: ArrayOfTBGRAPixel); +var + i: Integer; +begin + inherited Create; + for i := 0 to high(AColors) do + AddColor(AColors[i]); +end; + +constructor TBGRAPalette.Create(AColors: ArrayOfWeightedColor); +var + i: Integer; +begin + inherited Create; + for i := 0 to high(AColors) do + AddColor(AColors[i].Color); +end; + +function TBGRAPalette.AddColor(AValue: TBGRAPixel): boolean; +Var Node: TAVLTreeNode; + Entry: PBGRAPixel; +begin + if Assigned(GetLastColor(AValue)) then + begin + result := false; + exit; + end; + Node := FTree.Find(@AValue); + if Assigned(Node) then + begin + AddLastColor(PBGRAPixel(Node.Data)); + result := false; + end + else + begin + result := true; + Entry := CreateEntry(AValue); + FTree.Add(Entry); + ClearArray; + AddLastColor(Entry); + end; +end; + +procedure TBGRAPalette.AddColors(ABitmap: TBGRACustomBitmap); +var p: PBGRAPixel; + n: integer; +begin + n := ABitmap.NbPixels; + p := ABitmap.Data; + while n > 0 do + begin + AddColor(p^); + inc(p); + dec(n); + end; +end; + +procedure TBGRAPalette.AddColors(APalette: TBGRACustomPalette); +var i: Int32or64; +begin + for i := 0 to APalette.Count- 1 do + AddColor(APalette.Color[i]); +end; + +function TBGRAPalette.RemoveColor(AValue: TBGRAPixel): boolean; +var + Node : TAVLTreeNode; +begin + Node := FTree.Find(@AValue); + if Assigned(Node) then + begin + FreeEntry(Node.Data); + FTree.Delete(Node); + result := true; + ClearArray; + ClearLastColors; + end else + result := false; +end; + +procedure TBGRAPalette.LoadFromFile(AFilenameUTF8: string); +var + stream: TFileStreamUTF8; + format: TBGRAPaletteFormat; +begin + format := DetectPaletteFormat(AFilenameUTF8); + if format = palUnknown then + begin + ExceptionUnknownPaletteFormat; + exit; + end; + stream:= TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead); + try + LoadFromStream(stream, format); + finally + stream.Free; + end; +end; + +procedure TBGRAPalette.LoadFromStream(AStream: TStream; + AFormat: TBGRAPaletteFormat); +var buf: TReadBufStream; + handled: boolean; + i: Integer; +begin + RegisterDefaultPaletteFormats; + Clear; + buf := TReadBufStream.Create(AStream); + try + handled := false; + for i := 0 to High(PaletteFormats) do + if PaletteFormats[i].formatIndex = AFormat then + begin + if not PaletteFormats[i].reader(self, AStream) then + ExceptionInvalidPaletteFormat; + handled := true; + break; + end; + if not handled then ExceptionUnknownPaletteFormat; + finally + buf.Free; + end; +end; + +procedure TBGRAPalette.LoadFromResource(AFilename: string; AFormat: TBGRAPaletteFormat); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream, AFormat); + finally + stream.Free; + end; +end; + +procedure TBGRAPalette.SaveToFile(AFilenameUTF8: string); +var + stream: TFileStreamUTF8; +begin + stream:= TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); + try + SaveToStream(stream, SuggestPaletteFormat(AFilenameUTF8)); + finally + stream.Free; + end; +end; + +procedure TBGRAPalette.SaveToStream(AStream: TStream; + AFormat: TBGRAPaletteFormat); +var buf: TWriteBufStream; + handled: boolean; + i: Integer; +begin + RegisterDefaultPaletteFormats; + buf := TWriteBufStream.Create(AStream); + try + handled := false; + for i := 0 to High(PaletteFormats) do + if PaletteFormats[i].formatIndex = AFormat then + begin + PaletteFormats[i].writer(self, AStream); + handled := true; + break; + end; + if not handled then ExceptionUnknownPaletteFormat; + finally + buf.Free; + end; +end; + +function TBGRAPalette.DetectPaletteFormat(AStream: TStream): TBGRAPaletteFormat; +var buf: string; + oldPos: int64; + i: Integer; +begin + result := palUnknown; + setlength(buf,256); + fillchar(buf[1],length(buf),#0); + oldPos := AStream.Position; + AStream.Read(buf[1],length(buf)); + AStream.Position := oldPos; + if length(buf)>0 then + begin + RegisterDefaultPaletteFormats; + for i := 0 to high(PaletteFormats) do + if PaletteFormats[i].checkFormat(buf) then + begin + result := PaletteFormats[i].formatIndex; + exit; + end; + end; +end; + +function TBGRAPalette.DetectPaletteFormat(AFilenameUTF8: string + ): TBGRAPaletteFormat; +var stream: TFileStreamUTF8; +begin + result := SuggestPaletteFormat(AFilenameUTF8); + if not FileExists(AFilenameUTF8) then exit; + try + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); + except + exit; + end; + try + result := DetectPaletteFormat(stream); + if result = palUnknown then + result := SuggestPaletteFormat(AFilenameUTF8); + finally + stream.Free; + end; +end; + +function TBGRAPalette.SuggestPaletteFormat(AFilenameUTF8: string + ): TBGRAPaletteFormat; +var ext: string; + i: Integer; +begin + RegisterDefaultPaletteFormats; + ext := ExtractFileExt(AFilenameUTF8); + if ext <> '' then + begin + for i := 0 to high(PaletteFormats) do + if CompareText(PaletteFormats[i].ext,ext) = 0 then + begin + result := PaletteFormats[i].formatIndex; + exit; + end; + end; + result := palUnknown; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapath.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapath.pas new file mode 100644 index 0000000..07bd687 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapath.pas @@ -0,0 +1,3118 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPath; + +{$mode objfpc}{$H+} + +interface + +//todo: tangent interpolation + +{ There are different conventions for angles. + + First is about the unit. It can be one of the following: + - degrees (0..360) + - radian (0..2*Pi) + - tenth of degrees (0..3600) + - from 0 to 65536 + + Second is about the origin. It can be one of the following: + - right-most position (this is the default origin for radian and 65536) + - top-most position (this is the default origin for degrees) + + Third is about the sign. It can be one of the following: + - positive is clockwise (this is the default for degrees) + - positive is counterclockwise (this is the default for radian and 65536) + + TBGRAPath and TBGRACanvas2D follow HTML5 convention which is: + (radian, right-most, clockwise) that can be shortened to (radian, clockwise) + because right-most is the default for radian. This is abbreviated as "radCW". + + When radian are CCW, it is also specified in order to make it clear, even + if it is the default convention in mathematics. + + In order to make things easier, there are some functions that accept angles + in degrees. The convention used here is the usual degree convention: + (degrees, top-most, clockwise) that can be shortened to (degree) + because top-most and clockwise is the default for degrees. + + } + +uses + BGRABitmapTypes, BGRATransform; + +const + DefaultDeviation = 0.1; + +type + TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath, + peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, + peClosedSpline); + + TBGRAPathDrawProc = BGRABitmapTypes.TBGRAPathDrawProc; + TBGRAPathFillProc = BGRABitmapTypes.TBGRAPathFillProc; + + TBGRAPath = class; + + { TBGRAPathCursor } + + TBGRAPathCursor = class(TBGRACustomPathCursor) + protected + FPath: TBGRAPath; + FDataPos: IntPtr; + FAcceptedDeviation: single; + FPathLength: single; + FPathLengthComputed: boolean; + FBounds: TRectF; + FBoundsComputed: boolean; + FArcPos: Single; + + FStartCoordinate: TPointF; + FEndCoordinate: TPointF; + FLoopClosedShapes,FLoopPath: boolean; + + FCurrentElementType: TBGRAPathElementType; + FCurrentElement: Pointer; + FCurrentElementArcPos, + FCurrentElementArcPosScale: single; + FCurrentElementStartCoord, + FCurrentElementEndCoord: TPointF; + FCurrentElementLength: single; + FCurrentElementPoints: array of TPointF; + FCurrentSegment: Int32or64; + FCurrentSegmentPos: single; + function GoToNextElement(ACanJump: boolean): boolean; + function GoToPreviousElement(ACanJump: boolean): boolean; + procedure MoveToEndOfElement; + procedure MoveForwardInElement(ADistance: single); + procedure MoveBackwardInElement(ADistance: single); + function NeedPolygonalApprox: boolean; + procedure OnPathFree; virtual; + + function GetLoopClosedShapes: boolean; override; + function GetLoopPath: boolean; override; + function GetStartCoordinate: TPointF; override; + procedure SetLoopClosedShapes(AValue: boolean); override; + procedure SetLoopPath(AValue: boolean); override; + + function GetArcPos: single; override; + function GetCurrentTangent: TPointF; override; + procedure SetArcPos(AValue: single); override; + function GetBounds: TRectF; override; + function GetPathLength: single; override; + procedure PrepareCurrentElement; virtual; + function GetCurrentCoord: TPointF; override; + function GetPath: TBGRAPath; virtual; + public + constructor Create(APath: TBGRAPath; AAcceptedDeviation: single = DefaultDeviation); + function MoveForward(ADistance: single; ACanJump: boolean = true): single; override; + function MoveBackward(ADistance: single; ACanJump: boolean = true): single; override; + destructor Destroy; override; + property CurrentCoordinate: TPointF read GetCurrentCoord; + property CurrentTangent: TPointF read GetCurrentTangent; + property Position: single read GetArcPos write SetArcPos; + property PathLength: single read GetPathLength; + property Path: TBGRAPath read GetPath; + property Bounds: TRectF read GetBounds; + property StartCoordinate: TPointF read GetStartCoordinate; + property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes; + property LoopPath: boolean read GetLoopPath write SetLoopPath; + property AcceptedDeviation: single read FAcceptedDeviation; + end; + + { TBGRAPath } + + TBGRAPath = class(TBGRACustomPath) + protected + FData: PByte; + FDataCapacity: PtrInt; + FDataPos: PtrInt; + FLastSubPathElementType, FLastStoredElementType: TBGRAPathElementType; + FLastMoveToDataPos: PtrInt; + FLastCoord,FLastTransformedCoord, + FSubPathStartCoord, FSubPathTransformedStartCoord: TPointF; + FExpectedTransformedControlPoint: TPointF; + FMatrix: TAffineMatrix; //this matrix must have a base of vectors + //orthogonal, of same length and with positive + //orientation in order to preserve arcs + FScale,FAngleRadCW: single; + FCursors: array of TBGRAPathCursor; + FInternalDrawOffset: TPointF; + procedure OnModify; + procedure OnMatrixChange; + procedure NeedSpace(count: integer); + function AllocateElement(AElementType: TBGRAPathElementType; + AExtraBytes: PtrInt = 0): Pointer; + procedure Init; + procedure DoClear; + function CheckElementType(AElementType: TBGRAPathElementType): boolean; + function GoToNextElement(var APos: PtrInt): boolean; + function GoToPreviousElement(var APos: PtrInt): boolean; + function PeekNextElement(APos: PtrInt): TBGRAPathElementType; + function GetElementStartCoord(APos: PtrInt): TPointF; + function GetElementEndCoord(APos: PtrInt): TPointF; + function GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single; + procedure GetElementAt(APos: PtrInt; + out AElementType: TBGRAPathElementType; out AElement: pointer); + function GetSvgString: string; virtual; + procedure SetSvgString(const AValue: string); virtual; + procedure RegisterCursor(ACursor: TBGRAPathCursor); + procedure UnregisterCursor(ACursor: TBGRAPathCursor); + function SetLastCoord(ACoord: TPointF): TPointF; inline; + procedure ClearLastCoord; + procedure BezierCurveFromTransformed(tcp1, cp2, pt:TPointF); + procedure QuadraticCurveFromTransformed(tcp, pt: TPointF); + function LastCoordDefined: boolean; inline; + function GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; + function getPoints: ArrayOfTPointF; overload;override; + function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload;override; + function getLength: single; override; + function getCursor: TBGRACustomPathCursor; override; + procedure InternalDraw(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); + procedure BitmapDrawSubPathProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer); + function CorrectAcceptedDeviation(AAcceptedDeviation: single; const AMatrix: TAffineMatrix): single; + public + constructor Create; overload; override; + constructor Create(ASvgString: string); overload; + constructor Create(const APoints: ArrayOfTPointF); overload; + constructor Create(APath: IBGRAPath); overload; + destructor Destroy; override; + procedure beginPath; override; + procedure beginSubPath; + procedure closePath; override; + procedure translate(x,y: single); + procedure resetTransform; + procedure rotate(angleRadCW: single); overload; + procedure rotateDeg(angleDeg: single); overload; + procedure rotate(angleRadCW: single; center: TPointF); overload; + procedure rotateDeg(angleDeg: single; center: TPointF); overload; + procedure scale(factor: single); + procedure moveTo(x,y: single); overload; + procedure lineTo(x,y: single); overload; + procedure moveTo(constref pt: TPointF); overload; override; + procedure lineTo(constref pt: TPointF); overload; override; + procedure polyline(const pts: array of TPointF); + procedure polylineTo(const pts: array of TPointF); override; + procedure polygon(const pts: array of TPointF); + procedure quadraticCurveTo(cpx,cpy,x,y: single); overload; + procedure quadraticCurveTo(constref cp,pt: TPointF); overload; override; + procedure quadraticCurve(const curve: TQuadraticBezierCurve); overload; + procedure quadraticCurve(p1,cp,p2: TPointF); overload; + procedure smoothQuadraticCurveTo(x,y: single); overload; + procedure smoothQuadraticCurveTo(const pt: TPointF); overload; + procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload; + procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); overload; override; + procedure bezierCurve(const curve: TCubicBezierCurve); overload; + procedure bezierCurve(p1,cp1,cp2,p2: TPointF); overload; + procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload; + procedure smoothBezierCurveTo(const cp2,pt: TPointF); overload; + procedure rect(x,y,w,h: single); + procedure roundRect(x,y,w,h,radius: single); + procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; + procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); overload; + procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; anticlockwise: boolean); overload; + procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); overload; + procedure arcTo(x1, y1, x2, y2, radius: single); overload; + procedure arcTo(const p1,p2: TPointF; radius: single); overload; + procedure arc(constref arcDef: TArcDef); overload; override; + procedure arc(cx, cy, rx,ry: single; xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload; + procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; + procedure arcTo(rx,ry, xAngleRadCW: single; largeArc, anticlockwise: boolean; x,y:single); overload; + procedure copyTo(dest: IBGRAPath); override; + procedure addPath(const AValue: string); overload; + procedure addPath(source: IBGRAPath); overload; + procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); override; + procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); override; + property SvgString: string read GetSvgString write SetSvgString; + function ComputeLength(AAcceptedDeviation: single = DefaultDeviation): single; + function ToPoints(AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; + function ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; + function IsEmpty: boolean; + function GetBounds(AAcceptedDeviation: single = DefaultDeviation): TRectF; + procedure SetPoints(const APoints: ArrayOfTPointF); + procedure stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; override; + procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override; + procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload; + procedure fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; + procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; override; + procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override; + procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload; + function CreateCursor(AAcceptedDeviation: single = DefaultDeviation): TBGRAPathCursor; + procedure Fit(ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation); + procedure FitInto(ADest: TBGRAPath; ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation); + end; + +{----------------------- Spline ------------------} + +function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single; +function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +function ComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +function ComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +function ClosedSplineStartPoint(const points: array of TPointF; Style: TSplineStyle): TPointF; +function ComputeEasyBezier(const curve: TEasyBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; + +{ Compute points to draw an antialiased ellipse } +function ComputeEllipse(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; +function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; +function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload; +function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload; +function ComputeArcRad(x, y, rx, ry: single; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload; +function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload; +function ComputeArc(const arc: TArcDef; quality: single = 1): ArrayOfTPointF; +function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; +function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; + +function Html5ArcTo(const p0, p1, p2: TPointF; radius: single): TArcDef; +function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc, + anticlockwise: boolean; const p1: TPointF): TArcDef; +function ArcStartPoint(const arc: TArcDef): TPointF; +function ArcEndPoint(const arc: TArcDef): TPointF; +function IsLargeArc(const arc: TArcDef): boolean; + +implementation + +uses Math, BGRAClasses, BGRAResample, SysUtils; + +type + TStrokeData = record + Bitmap: TBGRACustomBitmap; + Texture: IBGRAScanner; + Color: TBGRAPixel; + Width: Single; + end; + + PPathElementHeader = ^TPathElementHeader; + TPathElementHeader = record + ElementType: TBGRAPathElementType; + PreviousElementType: TBGRAPathElementType; + end; + PMoveToElement = ^TMoveToElement; + TMoveToElement = record + StartCoordinate: TPointF; + LoopDataPos: PtrInt; //if the path is closed + end; + PClosePathElement = ^TClosePathElement; + TClosePathElement = type TMoveToElement; + PQuadraticBezierToElement = ^TQuadraticBezierToElement; + TQuadraticBezierToElement = record + ControlPoint, Destination: TPointF; + end; + PCubicBezierToElement = ^TCubicBezierToElement; + TCubicBezierToElement = record + ControlPoint1, ControlPoint2, Destination: TPointF; + end; + PArcElement = ^TArcElement; + TArcElement = TArcDef; + + PSplineElement = ^TSplineElement; + TSplineElement = record + SplineStyle: TSplineStyle; + NbControlPoints: integer; + end; + +const + PathElementSize : array[TBGRAPathElementType] of PtrInt = + (0, Sizeof(TMoveToElement), Sizeof(TClosePathElement), sizeof(TPointF), + sizeof(TQuadraticBezierToElement), sizeof(TCubicBezierToElement), + sizeof(TArcElement), sizeof(TSplineElement)+sizeof(integer), + sizeof(TSplineElement)+sizeof(integer)); + +function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single; +var + a0, a1, a2, a3: single; + t2: single; +begin + t2 := t * t; + a0 := y3 - y2 - y0 + y1; + a1 := y0 - y1 - a0; + a2 := y2 - y0; + a3 := y1; + Result := a0 * t * t2 + a1 * t2 + a2 * t + a3; +end; + +function ComputeCurvePartPrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = DefaultDeviation): integer; +var + len: single; +begin + len := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y); + len := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)); + len := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)); + Result := round(sqrt(sqrt(len)/AAcceptedDeviation) * 0.9); + if Result<=0 then Result:=1; +end; + +function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +begin + result := curve.ToPoints(AAcceptedDeviation); +end; + +function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; +begin + result := curve.ToPoints(AAcceptedDeviation); +end; + +function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + curves: array of array of TPointF; + nb: integer; + lastPt: TPointF; + i: Integer; + j: Integer; + + procedure AddPt(pt: TPointF); inline; + begin + result[nb]:= pt; + inc(nb); + lastPt := pt; + end; + + function EqLast(pt: TPointF): boolean; + begin + result := (pt.x = lastPt.x) and (pt.y = lastPt.y); + end; + +begin + if length(spline)= 0 then + begin + setlength(result,0); + exit; + end; + setlength(curves, length(spline)); + for i := 0 to high(spline) do + curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation); + nb := length(curves[0]); + lastPt := curves[0][high(curves[0])]; + for i := 1 to high(curves) do + begin + inc(nb,length(curves[i])); + if EqLast(curves[i][0]) then dec(nb); + lastPt := curves[i][high(curves[i])]; + end; + setlength(result,nb); + nb := 0; + for j := 0 to high(curves[0]) do + AddPt(curves[0][j]); + for i := 1 to high(curves) do + begin + if not EqLast(curves[i][0]) then AddPt(curves[i][0]); + for j := 1 to high(curves[i]) do + AddPt(curves[i][j]); + end; +end; + +function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; + AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + curves: array of array of TPointF; + nb: integer; + lastPt: TPointF; + i: Integer; + j: Integer; + + procedure AddPt(pt: TPointF); inline; + begin + result[nb]:= pt; + inc(nb); + lastPt := pt; + end; + + function EqLast(pt: TPointF): boolean; + begin + result := (pt.x = lastPt.x) and (pt.y = lastPt.y); + end; + +begin + if length(spline)= 0 then + begin + setlength(result,0); + exit; + end; + setlength(curves, length(spline)); + for i := 0 to high(spline) do + curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation); + nb := length(curves[0]); + lastPt := curves[0][high(curves[0])]; + for i := 1 to high(curves) do + begin + inc(nb,length(curves[i])); + if EqLast(curves[i][0]) then dec(nb); + lastPt := curves[i][high(curves[i])]; + end; + setlength(result,nb); + nb := 0; + for j := 0 to high(curves[0]) do + AddPt(curves[0][j]); + for i := 1 to high(curves) do + begin + if not EqLast(curves[i][0]) then AddPt(curves[i][0]); + for j := 1 to high(curves[i]) do + AddPt(curves[i][j]); + end; +end; + +function InternalComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + i, j, nb, idx, pre: integer; + ptPrev, ptPrev2, ptNext, ptNext2: TPointF; + t: single; + kernel: TWideKernelFilter; + +begin + if AStyle = ssEasyBezier then + begin + result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, true, cmCurve)); + exit; + end; + + if ACount <= 2 then + begin + setlength(result, ACount); + for i := 0 to high(result) do + result[i] := APoints[AStart + i]; + exit; + end; + + nb := 1; + for i := 0 to ACount-1 do + begin + ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart]; + ptPrev := APoints[i + AStart]; + ptNext := APoints[(i + 1) mod ACount + AStart]; + ptNext2 := APoints[(i + 2) mod ACount + AStart]; + inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) ); + end; + + kernel := CreateInterpolator(AStyle); + setlength(Result, nb); + idx := 0; + for i := 0 to ACount-1 do + begin + ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart]; + ptPrev := APoints[i+ AStart]; + ptNext := APoints[(i + 1) mod ACount + AStart]; + ptNext2 := APoints[(i + 2) mod ACount + AStart]; + pre := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation); + if i=0 then + j := 0 + else + j := 1; + while j <= pre do + begin + t := j/pre; + result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) + + ptNext*kernel.Interpolation(t-1) + ptNext2*kernel.Interpolation(t-2); + Inc(idx); + inc(j); + end; + end; + kernel.Free; +end; + +function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + nbParts, partIndex, start, i: integer; + parts: array of array of TPointF; +begin + nbParts := 1; + for i := 0 to high(APoints) do + if isEmptyPointF(APoints[i]) then inc(nbParts); + if nbParts = 1 then + exit(InternalComputeClosedSpline(APoints, 0, length(APoints), AStyle, AAcceptedDeviation)); + setlength(parts, nbParts); + partIndex := 0; + start := 0; + for i := 0 to high(APoints) do + if isEmptyPointF(APoints[i]) then + begin + parts[partIndex] := InternalComputeClosedSpline(APoints, start, i-start, AStyle, AAcceptedDeviation); + inc(partIndex); + start := i+1; + end; + parts[partIndex] := InternalComputeClosedSpline(APoints, start, length(APoints)-start, AStyle, AAcceptedDeviation); + result := ConcatPointsF(parts, true); +end; + +function InternalComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + i, j, nb, idx, pre: integer; + ptPrev, ptPrev2, ptNext, ptNext2: TPointF; + t: single; + kernel: TWideKernelFilter; +begin + if AStyle = ssEasyBezier then + begin + result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, false, cmCurve)); + exit; + end; + + if ACount <= 2 then + begin + setlength(result, ACount); + for i := 0 to high(result) do + result[i] := APoints[AStart + i]; + exit; + end; + if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then AEndCoeff := 0; + if AEndCoeff < -0.3 then AEndCoeff := -0.3; + + nb := 1; + for i := 0 to ACount - 2 do + begin + ptPrev := APoints[AStart + i]; + ptNext := APoints[AStart + i + 1]; + if i=0 then + ptPrev2 := (ptPrev+(ptNext+APoints[AStart + i + 2])*AEndCoeff)*(1/(1+2*AEndCoeff)) + else + ptPrev2 := APoints[AStart + i - 1]; + if i = ACount - 2 then + ptNext2 := (ptNext+(ptPrev+APoints[AStart + i - 1])*AEndCoeff)*(1/(1+2*AEndCoeff)) + else + ptNext2 := APoints[AStart + i + 2]; + inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) ); + end; + + kernel := CreateInterpolator(AStyle); + if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then + begin + inc(nb,2); + setlength(Result, nb); + result[0] := APoints[AStart]; + idx := 1; + end else + begin + idx := 0; + setlength(Result, nb); + end; + for i := 0 to ACount - 2 do + begin + ptPrev := APoints[AStart + i]; + ptNext := APoints[AStart + i + 1]; + if i=0 then + ptPrev2 := (ptPrev+(ptNext+APoints[i + 2 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff)) + else + ptPrev2 := APoints[AStart + i - 1]; + if i = ACount - 2 then + ptNext2 := (ptNext+(ptPrev+APoints[i - 1 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff)) + else + ptNext2 := APoints[AStart + i + 2]; + pre := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation); + if i=0 then + begin + j := 0; + end else j := 1; + while j <= pre do + begin + t := j/pre; + result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) + + ptNext*kernel.Interpolation(t-1) + ptNext2*kernel.Interpolation(t-2); + Inc(idx); + inc(j); + end; + end; + kernel.Free; + if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then + result[idx] := APoints[AStart + ACount - 1]; +end; + +function ComputeClosedSpline(const APoints: array of TPointF; AStart, + ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single): ArrayOfTPointF; +var + i: Integer; +begin + if (AStart < 0) or (AStart + ACount > length(APoints)) then + raise exception.Create('Index out of bounds'); + for i := 0 to ACount-1 do + if IsEmptyPointF(APoints[AStart + i]) then + raise exception.Create('Unexpected empty point'); + result := InternalComputeClosedSpline(APoints, AStart, ACount, AStyle, AAcceptedDeviation); +end; + +function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; +var + nbParts, partIndex, start, i: integer; + parts: array of array of TPointF; +begin + nbParts := 1; + for i := 0 to high(APoints) do + if isEmptyPointF(APoints[i]) then inc(nbParts); + if nbParts = 1 then + exit(InternalComputeOpenedSpline(APoints, 0, length(APoints), AStyle, AEndCoeff, AAcceptedDeviation)); + setlength(parts, nbParts); + partIndex := 0; + start := 0; + for i := 0 to high(APoints) do + if isEmptyPointF(APoints[i]) then + begin + parts[partIndex] := InternalComputeOpenedSpline(APoints, start, i-start, AStyle, AEndCoeff, AAcceptedDeviation); + inc(partIndex); + start := i+1; + end; + parts[partIndex] := InternalComputeOpenedSpline(APoints, start, length(APoints)-start, AStyle, AEndCoeff, AAcceptedDeviation); + result := ConcatPointsF(parts, true); +end; + +function ComputeOpenedSpline(const APoints: array of TPointF; AStart, + ACount: integer; AStyle: TSplineStyle; AEndCoeff: single; + AAcceptedDeviation: single): ArrayOfTPointF; +var + i: Integer; +begin + if (AStart < 0) or (AStart + ACount > length(APoints)) then + raise exception.Create('Index out of bounds'); + for i := 0 to ACount-1 do + if IsEmptyPointF(APoints[AStart + i]) then + raise exception.Create('Unexpected empty point'); + result := InternalComputeOpenedSpline(APoints, AStart, ACount, AStyle, AEndCoeff, AAcceptedDeviation); +end; + +function ClosedSplineStartPoint(const points: array of TPointF; + Style: TSplineStyle): TPointF; +var + kernel: TWideKernelFilter; + ptPrev2: TPointF; + ptPrev: TPointF; + ptNext: TPointF; + ptNext2: TPointF; +begin + if Style = ssEasyBezier then + begin + result := EasyBezierCurve(points, true, cmCurve).CurveStartPoint; + end else + begin + if length(points) = 0 then + result := EmptyPointF + else + if length(points)<=2 then + result := points[0] + else + begin + kernel := CreateInterpolator(style); + ptPrev2 := points[high(points)]; + ptPrev := points[0]; + ptNext := points[1]; + ptNext2 := points[2]; + result := ptPrev2*kernel.Interpolation(1) + ptPrev*kernel.Interpolation(0) + + ptNext*kernel.Interpolation(-1) + ptNext2*kernel.Interpolation(-2); + kernel.free; + end; + end; +end; + +function ComputeEasyBezier(const curve: TEasyBezierCurve; + AAcceptedDeviation: single): ArrayOfTPointF; +var + path: TBGRAPath; +begin + path := TBGRAPath.Create; + curve.CopyToPath(path); + result := path.ToPoints(AAcceptedDeviation); + path.Free; +end; + +function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single): ArrayOfTPointF; +var i,nb: integer; + arclen: integer; + pos: word; +begin + if end65536 > start65536 then + arclen := end65536-start65536 else + arclen := 65536-(start65536-end65536); + + if quality < 0 then quality := 0; + + nb := round(((rx+ry)*2*quality+8)*arclen/65536) and not 3; + if arclen <= 16384 then + begin + if nb < 2 then nb := 2; + end else + if arclen <= 32768 then + begin + if nb < 3 then nb := 3; + end else + if arclen <= 32768+16384 then + begin + if nb < 4 then nb := 4; + end else + if nb < 5 then nb := 5; + + if nb > arclen+1 then nb := arclen+1; + + setlength(result,nb); + for i := 0 to nb-1 do + begin + {$PUSH}{$R-} + pos := start65536+int64(i)*arclen div (int64(nb)-1); + {$POP} + result[i] := PointF(x+rx*(Cos65536(pos)-32768)/32768, + y-ry*(Sin65536(pos)-32768)/32768); + end; +end; + +function ComputeEllipse(x, y, rx, ry: single; quality: single): ArrayOfTPointF; +begin + result := ComputeArc65536(x,y,rx,ry,0,0,quality); +end; + +function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single): ArrayOfTPointF; +begin + result := ComputeArcRad(AOrigin, AXAxis, AYAxis, 0,0, quality); +end; + +function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536, + end65536: word; quality: single): ArrayOfTPointF; +begin + //go back temporarily to radians + result := ComputeArcRad(AOrigin,AXAxis,AYAxis, start65536*Pi/326768, end65536*Pi/326768, quality); +end; + +function ComputeArcRad(x, y, rx, ry: single; startRadCCW, endRadCCW: single; + quality: single): ArrayOfTPointF; +var + start65536, end65536: Int64; +begin + start65536 := round(startRadCCW*32768/Pi); + end65536 := round(endRadCCW*32768/Pi); + //if arc is very small but non zero, it is not a circle + if (start65536 = end65536) and (startRadCCW <> endRadCCW) then + setlength(result,2) else + result := ComputeArc65536(x,y,rx,ry,start65536 and $ffff,end65536 and $ffff,quality); + result[0] := PointF(x+cos(startRadCCW)*rx,y-sin(startRadCCW)*ry); + result[high(result)] := PointF(x+cos(endRadCCW)*rx,y-sin(endRadCCW)*ry); +end; + +function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single): ArrayOfTPointF; +var + u, v: TPointF; + lenU, lenV: Single; + m: TAffineMatrix; + i: Integer; +begin + u := AXAxis-AOrigin; + lenU := VectLen(u); + v := AYAxis-AOrigin; + lenV := VectLen(v); + if (lenU = 0) and (lenV = 0) then exit(PointsF([AOrigin])); + + result := ComputeArcRad(0, 0, lenU, lenV, startRadCCW, endRadCCW, quality); + + if lenU <> 0 then u.Scale(1/lenU); + if lenV <> 0 then v.Scale(1/lenV); + m := AffineMatrix(u, v, AOrigin); + for i := 0 to high(result) do + result[i] := m*result[i]; +end; + +function ComputeArc(const arc: TArcDef; quality: single): ArrayOfTPointF; +var startAngle,endAngle: single; + i,n: integer; + temp: TPointF; + m: TAffineMatrix; +begin + startAngle := -arc.startAngleRadCW; + endAngle:= -arc.endAngleRadCW; + if not arc.anticlockwise then + begin + result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,endAngle,startAngle,quality); + n := length(result); + if n>1 then + for i := 0 to (n-2) div 2 do + begin + temp := result[i]; + result[i] := result[n-1-i]; + result[n-1-i] := temp; + end; + end else + result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,startAngle,endAngle,quality); + if arc.xAngleRadCW <> 0 then + begin + m := AffineMatrixTranslation(arc.center.x,arc.center.y)*AffineMatrixRotationRad(-arc.xAngleRadCW)*AffineMatrixTranslation(-arc.center.x,-arc.center.y); + for i := 0 to high(result) do + result[i] := m*result[i]; + end; +end; + +function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single): ArrayOfTPointF; +begin + result := ComputeRoundRect(x1,y1,x2,y2,rx,ry,[],quality); +end; + +function ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; + options: TRoundRectangleOptions; quality: single): ArrayOfTPointF; +var q0,q1,q2,q3,q4: array of TPointF; + temp: Single; +begin + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + rx := abs(rx); + ry := abs(ry); + if 2*rx > x2-x1 then + rx := (x2-x1)/2; + if 2*ry > y2-y1 then + ry := (y2-y1)/2; + + q0 := PointsF([PointF(x2,(y1+y2)/2)]); + + if rrTopRightBevel in options then + q1 := PointsF([PointF(x2,y1+ry),PointF(x2-rx,y1)]) else + if rrTopRightSquare in options then + q1 := PointsF([PointF(x2,y1)]) + else + q1 := ComputeArc65536(x2-rx,y1+ry,rx,ry,0,16384,quality); + + if rrTopLeftBevel in options then + q2 := PointsF([PointF(x1+rx,y1),PointF(x1,y1+ry)]) else + if rrTopLeftSquare in options then + q2 := PointsF([PointF(x1,y1)]) + else + q2 := ComputeArc65536(x1+rx,y1+ry,rx,ry,16384,32768,quality); + + if rrBottomLeftBevel in options then + q3 := PointsF([PointF(x1,y2-ry),PointF(x1+rx,y2)]) else + if rrBottomLeftSquare in options then + q3 := PointsF([PointF(x1,y2)]) + else + q3 := ComputeArc65536(x1+rx,y2-ry,rx,ry,32768,32768+16384,quality); + + if rrBottomRightBevel in options then + q4 := PointsF([PointF(x2-rx,y2),PointF(x2,y2-ry)]) else + if rrBottomRightSquare in options then + q4 := PointsF([PointF(x2,y2)]) + else + q4 := ComputeArc65536(x2-rx,y2-ry,rx,ry,32768+16384,0,quality); + + result := ConcatPointsF([q0,q1,q2,q3,q4]); +end; + +function Html5ArcTo(const p0, p1, p2: TPointF; radius: single + ): TArcDef; +var p3,p4,an,bn,cn,c: TPointF; + dir, a2, b2, c2, cosx, sinx, d: single; + anticlockwise: boolean; +begin + result.center := p1; + result.radius := PointF(0,0); + result.xAngleRadCW:= 0; + result.startAngleRadCW := 0; + result.endAngleRadCW:= 0; + result.anticlockwise:= false; + + radius := abs(radius); + if (p0 = p1) or (p1 = p2) or (radius = 0) then exit; + + dir := (p2.x-p1.x)*(p0.y-p1.y) + (p2.y-p1.y)*(p1.x-p0.x); + if dir = 0 then exit; + + a2 := (p0.x-p1.x)*(p0.x-p1.x) + (p0.y-p1.y)*(p0.y-p1.y); + b2 := (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y); + c2 := (p0.x-p2.x)*(p0.x-p2.x) + (p0.y-p2.y)*(p0.y-p2.y); + cosx := (a2+b2-c2)/(2*sqrt(a2*b2)); + + sinx := sqrt(1 - cosx*cosx); + if (sinx = 0) or (cosx = 1) then exit; + d := radius / ((1 - cosx) / sinx); + + an := (p1-p0)*(1/sqrt(a2)); + bn := (p1-p2)*(1/sqrt(b2)); + p3 := p1 - an*d; + p4 := p1 - bn*d; + anticlockwise := (dir < 0); + + cn := PointF(an.y,-an.x)*radius; + if not anticlockwise then cn := -cn; + c := p3 + cn; + + result.center := c; + result.radius:= PointF(radius,radius); + result.startAngleRadCW := arctan2((p3.y-c.y), (p3.x-c.x)); + result.endAngleRadCW := arctan2((p4.y-c.y), (p4.x-c.x)); + result.anticlockwise:= anticlockwise; +end; + +function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc, + anticlockwise: boolean; const p1: TPointF): TArcDef; +var + p0p,cp: TPointF; + cross1,cross2,lambda: single; +begin + if (rx=0) or (ry=0) or (p0 = p1) then + begin + result.radius := PointF(0,0); + result.xAngleRadCW:= 0; + result.anticlockwise := false; + result.endAngleRadCW := 0; + result.startAngleRadCW:= 0; + result.center := p1; + exit; + end; + result.xAngleRadCW := xAngleRadCW; + result.anticlockwise := anticlockwise; + p0p := AffineMatrixRotationRad(xAngleRadCW)*( (p0-p1)*0.5 ); + + //ensure radius is big enough + lambda := sqr(p0p.x/rx) + sqr(p0p.y/ry); + if lambda > 1 then + begin + lambda := sqrt(lambda); + rx := rx * lambda; + ry := ry * lambda; + end; + result.radius := PointF(rx,ry); + + //compute center + cross2 := sqr(rx*p0p.y) + sqr(ry*p0p.x); + cross1 := sqr(rx*ry); + if cross1 <= cross2 then + cp := PointF(0,0) + else + cp := sqrt((cross1-cross2)/cross2)* + PointF(rx*p0p.y/ry, -ry*p0p.x/rx); + if largeArc <> anticlockwise then cp := -cp; + + result.center := AffineMatrixRotationRad(-xAngleRadCW)*cp + + (p0+p1)*0.5; + result.startAngleRadCW := arctan2((p0p.y-cp.y)/ry,(p0p.x-cp.x)/rx); + result.endAngleRadCW := arctan2((-p0p.y-cp.y)/ry,(-p0p.x-cp.x)/rx); +end; + +function ArcStartPoint(const arc: TArcDef): TPointF; +begin + result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.startAngleRadCW)*arc.radius.x, + sin(arc.startAngleRadCW)*arc.radius.y) + arc.center; +end; + +function ArcEndPoint(const arc: TArcDef): TPointF; +begin + result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.endAngleRadCW)*arc.radius.x, + sin(arc.endAngleRadCW)*arc.radius.y) + arc.center; +end; + +function IsLargeArc(const arc: TArcDef): boolean; +var diff,a1,a2: single; +begin + a1 := arc.startAngleRadCW - floor(arc.startAngleRadCW/(2*Pi))*(2*Pi); + a2 := arc.endAngleRadCW - floor(arc.endAngleRadCW/(2*Pi))*(2*Pi); + if not arc.anticlockwise then + diff := a2 - a1 + else + diff := a1 - a2; + result := (diff < 0) or (diff >= Pi); +end; + +{ TBGRAPathCursor } + +function TBGRAPathCursor.GetCurrentCoord: TPointF; +begin + case FCurrentElementType of + peNone: result := EmptyPointF; + peMoveTo,peLineTo,peCloseSubPath: + if FCurrentElementLength <= 0 then + result := FCurrentElementStartCoord + else + result := FCurrentElementStartCoord + (FCurrentElementEndCoord-FCurrentElementStartCoord)*(FCurrentElementArcPos/FCurrentElementLength); + peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline: + begin + NeedPolygonalApprox; + if FCurrentSegment >= high(FCurrentElementPoints) then + result := FCurrentElementEndCoord + else + result := FCurrentElementPoints[FCurrentSegment]+ + (FCurrentElementPoints[FCurrentSegment+1]- + FCurrentElementPoints[FCurrentSegment])*FCurrentSegmentPos; + end; + else + raise Exception.Create('Unknown element type'); + end; +end; + +function TBGRAPathCursor.GetPath: TBGRAPath; +begin + if not Assigned(FPath) then + raise exception.Create('Path does not exist'); + result := FPath; +end; + +procedure TBGRAPathCursor.MoveToEndOfElement; +begin + FCurrentElementArcPos := FCurrentElementLength; + if not NeedPolygonalApprox then exit; + if length(FCurrentElementPoints) > 1 then + begin + FCurrentSegment := high(FCurrentElementPoints)-1; + FCurrentSegmentPos := 1; + end else + begin + FCurrentSegment := high(FCurrentElementPoints); + FCurrentSegmentPos := 0; + end; +end; + +procedure TBGRAPathCursor.MoveForwardInElement(ADistance: single); +var segLen,rightSpace,remaining: single; +begin + if not NeedPolygonalApprox then exit; + ADistance := ADistance * FCurrentElementArcPosScale; + remaining := ADistance; + while remaining > 0 do + begin + if FCurrentSegment < high(FCurrentElementPoints) then + segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment]) + else + segLen := 0; + rightSpace := segLen*(1-FCurrentSegmentPos); + if (segLen > 0) and (remaining <= rightSpace) then + begin + IncF(FCurrentSegmentPos, remaining/segLen); + exit; + end else + begin + DecF(remaining, rightSpace); + if FCurrentSegment < high(FCurrentElementPoints)-1 then + begin + inc(FCurrentSegment); + FCurrentSegmentPos := 0; + end else + begin + FCurrentSegmentPos := 1; + exit; + end; + end; + end; +end; + +procedure TBGRAPathCursor.MoveBackwardInElement(ADistance: single); +var + segLen,leftSpace,remaining: Single; +begin + if not NeedPolygonalApprox then exit; + ADistance := ADistance * FCurrentElementArcPosScale; + remaining := ADistance; + while remaining > 0 do + begin + if FCurrentSegment < high(FCurrentElementPoints) then + segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment]) + else + segLen := 0; + leftSpace := segLen*FCurrentSegmentPos; + if (segLen > 0) and (remaining <= leftSpace) then + begin + DecF(FCurrentSegmentPos, remaining/segLen); + exit; + end else + begin + DecF(remaining, leftSpace); + if FCurrentSegment > 0 then + begin + dec(FCurrentSegment); + FCurrentSegmentPos := 1; + end else + begin + FCurrentSegmentPos := 0; + exit; + end; + end; + end; +end; + +function TBGRAPathCursor.NeedPolygonalApprox: boolean; +begin + if not (FCurrentElementType in[peQuadraticBezierTo,peCubicBezierTo,peArc, + peOpenedSpline,peClosedSpline]) + then + begin + result := false; + exit; + end; + result := true; + if FCurrentElementPoints = nil then + begin + FCurrentElementPoints := Path.GetPolygonalApprox(FDataPos, FAcceptedDeviation, True); + if FCurrentElementType = peQuadraticBezierTo then + begin + if FCurrentElementLength <> 0 then + FCurrentElementArcPosScale := PolylineLen(FCurrentElementPoints)/FCurrentElementLength; + end; + end; +end; + +function TBGRAPathCursor.GetArcPos: single; +var pos: PtrInt; +begin + if FArcPos = EmptySingle then + begin + FArcPos := FCurrentElementArcPos; + pos := FDataPos; + while Path.GoToPreviousElement(pos) do + IncF(FArcPos, Path.GetElementLength(pos, FAcceptedDeviation)); + end; + result := FArcPos; +end; + +function TBGRAPathCursor.GetCurrentTangent: TPointF; +var idxStart,idxEnd: integer; + seg: TPointF; +begin + while FCurrentElementLength <= 0 do + begin + if not GoToNextElement(False) then + begin + result := EmptyPointF; + exit; + end; + end; + case FCurrentElementType of + peMoveTo,peLineTo,peCloseSubPath: + result := (FCurrentElementEndCoord-FCurrentElementStartCoord)*(1/FCurrentElementLength); + peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline: + begin + NeedPolygonalApprox; + idxStart := FCurrentSegment; + if idxStart >= high(FCurrentElementPoints) then + idxStart:= high(FCurrentElementPoints)-1; + idxEnd := idxStart+1; + if idxStart < 0 then + begin + result := EmptyPointF; + exit; + end; + seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; + while (seg.x = 0) and (seg.y = 0) and (idxEnd < high(FCurrentElementPoints)) do + begin + inc(idxEnd); + seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; + end; + while (seg.x = 0) and (seg.y = 0) and (idxStart > 0) do + begin + dec(idxStart); + seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; + end; + if (seg.x = 0) and (seg.y = 0) then + result := EmptyPointF + else + result := seg*(1/VectLen(seg)); + end; + else result := EmptyPointF; + end; +end; + +procedure TBGRAPathCursor.SetArcPos(AValue: single); +var oldLoopClosedShapes,oldLoopPath: boolean; +begin + if GetArcPos=AValue then Exit; + if (AValue > PathLength) and (PathLength <> 0) then + AValue := AValue - trunc(AValue/PathLength)*PathLength + else if (AValue < 0) then + AValue := AValue + (trunc(-AValue/PathLength)+1)*PathLength; + oldLoopClosedShapes:= LoopClosedShapes; + oldLoopPath:= LoopPath; + LoopClosedShapes:= false; + LoopPath:= false; + MoveForward(AValue-GetArcPos, True); + LoopClosedShapes:= oldLoopClosedShapes; + LoopPath:= oldLoopPath; +end; + +function TBGRAPathCursor.GetPathLength: single; +begin + if not FPathLengthComputed then + begin + FPathLength := Path.ComputeLength(FAcceptedDeviation); + FPathLengthComputed := true; + end; + result := FPathLength; +end; + +procedure TBGRAPathCursor.OnPathFree; +begin + FPath := nil; +end; + +function TBGRAPathCursor.GetLoopClosedShapes: boolean; +begin + result := FLoopClosedShapes; +end; + +function TBGRAPathCursor.GetLoopPath: boolean; +begin + result := FLoopPath; +end; + +function TBGRAPathCursor.GetStartCoordinate: TPointF; +begin + result := FStartCoordinate; +end; + +procedure TBGRAPathCursor.SetLoopClosedShapes(AValue: boolean); +begin + FLoopClosedShapes := AValue; +end; + +procedure TBGRAPathCursor.SetLoopPath(AValue: boolean); +begin + FLoopPath := AValue; +end; + +procedure TBGRAPathCursor.PrepareCurrentElement; +begin + Path.GetElementAt(FDataPos, FCurrentElementType, FCurrentElement); + FCurrentElementLength := 0; + FCurrentElementArcPos := 0; + FCurrentElementPoints := nil; + FCurrentSegment := 0; + FCurrentSegmentPos := 0; + FCurrentElementArcPosScale := 1; + if FCurrentElementType = peNone then + begin + FCurrentElementStartCoord := EmptyPointF; + FCurrentElementEndCoord := EmptyPointF; + end + else + begin + FCurrentElementStartCoord := Path.GetElementStartCoord(FDataPos); + case FCurrentElementType of + peLineTo, peCloseSubPath: + begin + FCurrentElementEndCoord := PPointF(FCurrentElement)^; + FCurrentElementLength := VectLen(FCurrentElementEndCoord - FCurrentElementStartCoord); + end; + peQuadraticBezierTo: with PQuadraticBezierToElement(FCurrentElement)^ do + begin + FCurrentElementEndCoord := Destination; + FCurrentElementLength := BGRABitmapTypes.BezierCurve(FCurrentElementStartCoord,ControlPoint,Destination).ComputeLength; + end; + peCubicBezierTo,peArc,peOpenedSpline,peClosedSpline: + begin + NeedPolygonalApprox; + FCurrentElementEndCoord := FCurrentElementPoints[high(FCurrentElementPoints)]; + FCurrentElementLength := PolylineLen(FCurrentElementPoints); + end; + else + FCurrentElementEndCoord := FCurrentElementStartCoord; + end; + end; +end; + +function TBGRAPathCursor.GetBounds: TRectF; +begin + if not FBoundsComputed then + begin + FBounds:= Path.GetBounds(FAcceptedDeviation); + FBoundsComputed := true; + end; + result := FBounds; +end; + +function TBGRAPathCursor.GoToNextElement(ACanJump: boolean): boolean; +begin + if (FCurrentElementType = peCloseSubPath) and + (PClosePathElement(FCurrentElement)^.LoopDataPos <> -1) and + ( FLoopClosedShapes or + (FLoopPath and (PClosePathElement(FCurrentElement)^.LoopDataPos = 0)) + ) then + begin + if PClosePathElement(FCurrentElement)^.LoopDataPos <> FDataPos then + begin + result := true; + FDataPos := PClosePathElement(FCurrentElement)^.LoopDataPos; + FArcPos := EmptySingle; + PrepareCurrentElement; + end else + result := false; + end; + if not ACanJump and ((FCurrentElementType = peCloseSubPath) + or (Path.PeekNextElement(FDataPos) = peMoveTo)) then + begin + result := false; + exit; + end; + if Path.GoToNextElement(FDataPos) then + begin + result := true; + PrepareCurrentElement; + end + else + begin + if ACanJump and FLoopPath and (FDataPos > 0) then + begin + result := true; + FDataPos := 0; + FArcPos := EmptySingle; + PrepareCurrentElement; + end else + result := false; + end; +end; + +function TBGRAPathCursor.GoToPreviousElement(ACanJump: boolean): boolean; +var lastElemPos: IntPtr; +begin + if (FCurrentElementType = peMoveTo) and (PMoveToElement(FCurrentElement)^.LoopDataPos <> -1) and + ( FLoopClosedShapes or + (FLoopPath and (FDataPos = 0)) + ) then + with PMoveToElement(FCurrentElement)^ do + begin + if LoopDataPos <> -1 then + begin + result := true; + FDataPos := LoopDataPos; + FArcPos := EmptySingle; + PrepareCurrentElement; + end; + end; + if not ACanJump and (FCurrentElementType = peMoveTo) then + begin + result := false; + exit; + end; + if Path.GoToPreviousElement(FDataPos) then + begin + result := true; + PrepareCurrentElement; + end + else + begin + if FLoopPath then + begin + lastElemPos := FPath.FDataPos; + if (lastElemPos > 0) and FPath.GoToPreviousElement(lastElemPos) then + begin + if lastElemPos > 0 then + begin + result := true; + FDataPos := lastElemPos; + PrepareCurrentElement; + FArcPos := EmptySingle; + exit; + end; + end; + end; + result := false; + end; +end; + +constructor TBGRAPathCursor.Create(APath: TBGRAPath; AAcceptedDeviation: single); +begin + FPath := APath; + FPathLengthComputed := false; + FBoundsComputed:= false; + FDataPos := 0; + FArcPos:= 0; + FAcceptedDeviation:= AAcceptedDeviation; + Path.RegisterCursor(self); + PrepareCurrentElement; + + FStartCoordinate := FCurrentElementStartCoord; + if isEmptyPointF(FStartCoordinate) then + raise exception.Create('Path does not has a starting coordinate'); + FEndCoordinate := Path.FLastTransformedCoord; + if isEmptyPointF(FEndCoordinate) then + raise exception.Create('Path does not has an ending coordinate'); +end; + +function TBGRAPathCursor.MoveForward(ADistance: single; ACanJump: boolean): single; +var newArcPos,step,remaining: single; +begin + if ADistance < 0 then + begin + result := -MoveBackward(-ADistance, ACanJump); + exit; + end; + result := 0; + remaining := ADistance; + while remaining > 0 do + begin + newArcPos := FCurrentElementArcPos + remaining; + if newArcPos > FCurrentElementLength then + begin + step := FCurrentElementLength - FCurrentElementArcPos; + IncF(result, step); + DecF(remaining, step); + if not GoToNextElement(ACanJump) then + begin + MoveForwardInElement(step); + FCurrentElementArcPos := FCurrentElementLength; + FArcPos := PathLength; + exit; + end; + end else + begin + MoveForwardInElement(remaining); + FCurrentElementArcPos := newArcPos; + result := ADistance; + break; + end; + end; + if FArcPos <> EmptySingle then + IncF(FArcPos, result); +end; + +function TBGRAPathCursor.MoveBackward(ADistance: single; ACanJump: boolean = true): single; +var + remaining: Single; + newArcPos: Single; + step: Single; +begin + if ADistance = 0 then + begin + result := 0; + exit; + end; + if ADistance < 0 then + begin + result := -MoveForward(-ADistance, ACanJump); + exit; + end; + result := 0; + remaining := ADistance; + while remaining > 0 do + begin + newArcPos := FCurrentElementArcPos - remaining; + if newArcPos < 0 then + begin + step := FCurrentElementArcPos; + IncF(result, step); + DecF(remaining, step); + if not GoToPreviousElement(ACanJump) then + begin + MoveBackwardInElement(step); + FCurrentElementArcPos := 0; + FArcPos := 0; + exit; + end else + MoveToEndOfElement; + end else + begin + MoveBackwardInElement(remaining); + FCurrentElementArcPos := newArcPos; + result := ADistance; + break; + end; + end; + if FArcPos <> EmptySingle then + DecF(FArcPos, result); +end; + +destructor TBGRAPathCursor.Destroy; +begin + if Assigned(FPath) then + begin + FPath.UnregisterCursor(self); + end; + inherited Destroy; +end; + +{ TBGRAPath } + +function TBGRAPath.ComputeLength(AAcceptedDeviation: single): single; +var pos: PtrInt; +begin + pos := 0; + result := 0; + repeat + IncF(result, GetElementLength(pos, AAcceptedDeviation)); + until not GoToNextElement(pos); +end; + +function TBGRAPath.ToPoints(AAcceptedDeviation: single): ArrayOfTPointF; +var sub: array of ArrayOfTPointF; + temp: ArrayOfTPointF; + nbSub,nbPts,curPt,curSub: Int32or64; + startPos,pos: PtrInt; + elemType: TBGRAPathElementType; + elem: pointer; +begin + pos := 0; + nbSub := 0; + repeat + GetElementAt(pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo,peLineTo,peCloseSubPath: begin + inc(nbSub); + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + GoToNextElement(pos); + end; + peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub); + end; + until not GoToNextElement(pos); + + pos := 0; + setlength(sub, nbSub); + curSub := 0; + repeat + GetElementAt(pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo,peLineTo,peCloseSubPath: begin + startPos := pos; + if (elemType = peMoveTo) and (curSub > 0) then + nbPts := 2 + else + nbPts := 1; + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + begin + GoToNextElement(pos); + inc(nbPts); + end; + setlength(temp, nbPts); + pos := startPos; + if (elemType = peMoveTo) and (curSub > 0) then + begin + temp[0] := EmptyPointF; + temp[1] := PPointF(elem)^; + curPt := 2; + end else + begin + temp[0] := PPointF(elem)^; + curPt := 1; + end; + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + begin + GoToNextElement(pos); + GetElementAt(pos, elemType, elem); + temp[curPt] := PPointF(elem)^; + inc(curPt); + end; + sub[curSub] := temp; + inc(curSub); + temp := nil; + end; + peQuadraticBezierTo,peCubicBezierTo,peArc, + peOpenedSpline, peClosedSpline: + begin + sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False); + inc(curSub); + end; + end; + until not GoToNextElement(pos) or (curSub = nbSub); + result := ConcatPointsF(sub); +end; + +function TBGRAPath.ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single): ArrayOfTPointF; +begin + AAcceptedDeviation:= CorrectAcceptedDeviation(AAcceptedDeviation,AMatrix); + result := ToPoints(AAcceptedDeviation); + if not IsAffineMatrixIdentity(AMatrix) then + result := AMatrix*result; +end; + +function TBGRAPath.IsEmpty: boolean; +begin + result := FDataPos = 0; +end; + +function TBGRAPath.GetBounds(AAcceptedDeviation: single): TRectF; +var empty: boolean; + pos: PtrInt; + elemType: TBGRAPathElementType; + elem: pointer; + temp: array of TPointF; + i: integer; + + procedure Include(pt: TPointF); + begin + if empty then + begin + result.TopLeft := pt; + result.BottomRight := pt; + empty := false; + end else + begin + if pt.x < result.Left then result.Left := pt.x + else if pt.x > result.Right then result.Right := pt.x; + if pt.y < result.Top then result.Top := pt.y + else if pt.y > result.Bottom then result.Bottom := pt.y; + end; + end; + + procedure IncludeRect(r: TRectF); + begin + Include(r.TopLeft); + Include(r.BottomRight); + end; + +begin + empty := true; + result := RectF(0,0,0,0); + pos := 0; + repeat + GetElementAt(pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo,peLineTo,peCloseSubPath: begin + Include(PPointF(elem)^); + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + begin + GoToNextElement(pos); + GetElementAt(pos, elemType, elem); + Include(PPointF(elem)^); + end; + end; + peCubicBezierTo: + with PCubicBezierToElement(elem)^ do + IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint1,ControlPoint2,Destination).GetBounds); + peQuadraticBezierTo: + with PQuadraticBezierToElement(elem)^ do + IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint,Destination).GetBounds); + peArc, peOpenedSpline, peClosedSpline: + begin + temp := GetPolygonalApprox(pos, AAcceptedDeviation, False); + for i := 0 to high(temp) do + Include(temp[i]); + end; + end; + until not GoToNextElement(pos); + if empty then raise exception.Create('Path is empty'); +end; + +procedure TBGRAPath.SetPoints(const APoints: ArrayOfTPointF); +var i: integer; + nextIsMoveTo: boolean; + startPoint: TPointF; +begin + beginPath; + if length(APoints) = 0 then exit; + NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(APoints)); + nextIsMoveTo:= true; + startPoint := EmptyPointF; + for i := 0 to high(APoints) do + begin + if isEmptyPointF(APoints[i]) then + nextIsMoveTo:= true + else + if nextIsMoveTo then + begin + startPoint := APoints[i]; + moveTo(startPoint); + nextIsMoveTo:= false; + end + else + begin + with APoints[i] do + if (x = startPoint.x) and (y = startPoint.y) then + closePath + else + lineTo(APoints[i]); + end; + end; +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; + AWidth: single; AAcceptedDeviation: single); +begin + stroke(ABitmap,AffineMatrixIdentity,AColor,AWidth,AAcceptedDeviation); +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; + AWidth: single; AAcceptedDeviation: single); +begin + stroke(ABitmap,AffineMatrixIdentity,ATexture,AWidth,AAcceptedDeviation); +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single; + AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single); +begin + stroke(ABitmap,AffineMatrixTranslation(x,y),AColor,AWidth,AAcceptedDeviation); +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single; + ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single); +begin + stroke(ABitmap,AffineMatrixTranslation(x,y),ATexture,AWidth,AAcceptedDeviation); +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; + AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single); +var data: TStrokeData; +begin + data.Bitmap := ABitmap; + data.Texture := nil; + data.Color := AColor; + data.Width := AWidth; + InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data); +end; + +procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; + ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single); +var data: TStrokeData; +begin + data.Bitmap := ABitmap; + data.Texture := ATexture; + data.Color := BGRAPixelTransparent; + data.Width := AWidth; + InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data); +end; + +procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); +begin + stroke(ADrawProc, AffineMatrixIdentity, DefaultDeviation, AData); +end; + +procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; + const AMatrix: TAffineMatrix; AData: pointer); +begin + stroke(ADrawProc, AMatrix, DefaultDeviation, AData); +end; + +procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; + const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); +begin + InternalDraw(ADrawProc,AMatrix,AAcceptedDeviation,AData); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; + AAcceptedDeviation: single); +begin + fill(ABitmap,AffineMatrixIdentity,AColor,AAcceptedDeviation); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; + AAcceptedDeviation: single); +begin + fill(ABitmap,AffineMatrixIdentity,ATexture,AAcceptedDeviation); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single; + AColor: TBGRAPixel; AAcceptedDeviation: single); +begin + fill(ABitmap,AffineMatrixTranslation(x,y),AColor,AAcceptedDeviation); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single; + ATexture: IBGRAScanner; AAcceptedDeviation: single); +begin + fill(ABitmap,AffineMatrixTranslation(x,y),ATexture,AAcceptedDeviation); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; + AColor: TBGRAPixel; AAcceptedDeviation: single); +begin + ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), AColor); +end; + +procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; + ATexture: IBGRAScanner; AAcceptedDeviation: single); +begin + ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), ATexture); +end; + +procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; AData: pointer); +begin + fill(AFillProc, AffineMatrixIdentity, DefaultDeviation, AData); +end; + +procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; + const AMatrix: TAffineMatrix; AData: pointer); +begin + fill(AFillProc, AMatrix, DefaultDeviation, AData); +end; + +procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; + AAcceptedDeviation: single; AData: pointer); +begin + AFillProc(ToPoints(AMatrix,AAcceptedDeviation), AData); +end; + +function TBGRAPath.CreateCursor(AAcceptedDeviation: single): TBGRAPathCursor; +begin + result := TBGRAPathCursor.Create(self, AAcceptedDeviation); +end; + +procedure TBGRAPath.Fit(ARect: TRectF; AAcceptedDeviation: single); +var + temp: TBGRAPath; +begin + temp := TBGRAPath.Create; + copyTo(temp); + temp.FitInto(self, ARect, AAcceptedDeviation); + temp.Free; +end; + +procedure TBGRAPath.FitInto(ADest: TBGRAPath; ARect: TRectF; + AAcceptedDeviation: single); +var bounds: TRectF; + zoomX,zoomY: single; +begin + bounds := GetBounds(AAcceptedDeviation); + ADest.beginPath; + ADest.translate((ARect.Left+ARect.Right)*0.5, (ARect.Bottom+ARect.Top)*0.5); + if bounds.Right-bounds.Left <> 0 then + begin + zoomX := (ARect.Right-ARect.Left)/(bounds.Right-bounds.Left); + if bounds.Bottom-bounds.Top > 0 then + begin + zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top); + if zoomY < zoomX then ADest.scale(zoomY) else ADest.scale(zoomX); + end else + ADest.scale(zoomX); + end else + if bounds.Bottom-bounds.Top > 0 then + begin + zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top); + ADest.scale(zoomY); + end; + ADest.translate(-(bounds.Left+bounds.Right)*0.5, -(bounds.Bottom+bounds.Top)*0.5); + copyTo(ADest); + ADest.resetTransform; +end; + +function TBGRAPath.GetSvgString: string; +const RadToDeg = 180/Pi; +var + formats: TFormatSettings; + lastPosF: TPointF; + implicitCommand: char; + + function FloatToString(value: single): string; + begin + result := FloatToStrF(value,ffGeneral,7,0,formats)+' '; + end; + + function CoordToString(const pt: TPointF): string; + begin + lastPosF := pt; + result := FloatToString(pt.x)+FloatToString(pt.y); + end; + + function BoolToString(value: boolean): string; + begin + if value then + result := '1 ' else result := '0 '; + end; + + procedure addCommand(command: char; parameters: string); + begin + if result <> '' then AppendStr(Result, ' '); //optional whitespace + if command <> implicitCommand then AppendStr(Result, command); + AppendStr(Result, trim(parameters)); + if command = 'M' then implicitCommand:= 'L' + else if command = 'm' then implicitCommand:= 'l' + else if command in['z','Z'] then implicitCommand:= #0 + else implicitCommand := command; + end; + +var elemType: TBGRAPathElementType; + elem: pointer; + a: PArcElement; + Pos: PtrInt; + p1: TPointF; + pts: array of TPointF; + i: integer; +begin + formats := DefaultFormatSettings; + formats.DecimalSeparator := '.'; + + result := ''; + Pos := 0; + lastPosF := EmptyPointF; + implicitCommand := #0; + repeat + GetElementAt(Pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo: addCommand('M',CoordToString(PPointF(elem)^)); + peLineTo: addCommand('L',CoordToString(PPointF(elem)^)); + peCloseSubPath: addCommand('z',''); + peQuadraticBezierTo: + with PQuadraticBezierToElement(elem)^ do + addCommand('Q',CoordToString(ControlPoint)+CoordToString(Destination)); + peCubicBezierTo: + with PCubicBezierToElement(elem)^ do + addCommand('C',CoordToString(ControlPoint1)+ + CoordToString(ControlPoint2)+CoordToString(Destination)); + peArc: + begin + a := PArcElement(elem); + p1 := ArcStartPoint(a^); + if isEmptyPointF(lastPosF) or (p1 <> lastPosF) then + addCommand('L',CoordToString(p1)); + addCommand('A',CoordToString(a^.radius)+ + FloatToString(a^.xAngleRadCW*RadToDeg)+ + BoolToString(IsLargeArc(a^))+ + BoolToString(not a^.anticlockwise)+ + CoordToString(ArcEndPoint(a^))); + end; + peOpenedSpline, peClosedSpline: + begin + pts := GetPolygonalApprox(Pos, DefaultDeviation,True); + for i := 0 to high(pts) do + begin + if isEmptyPointF(lastPosF) then + addCommand('M',CoordToString(pts[i])) + else + addCommand('L',CoordToString(pts[i])); + end; + end; + end; + until not GoToNextElement(Pos); +end; + +procedure TBGRAPath.SetSvgString(const AValue: string); +begin + resetTransform; + beginPath; + addPath(AValue); +end; + +procedure TBGRAPath.RegisterCursor(ACursor: TBGRAPathCursor); +begin + setlength(FCursors, length(FCursors)+1); + FCursors[high(FCursors)] := ACursor; +end; + +procedure TBGRAPath.UnregisterCursor(ACursor: TBGRAPathCursor); +var + i,j: Integer; +begin + for i := high(FCursors) downto 0 do + if FCursors[i] = ACursor then + begin + for j := i to high(FCursors)-1 do + FCursors[j] := FCursors[j+1]; + setlength(FCursors, length(FCursors)-1); + exit; + end; +end; + +function TBGRAPath.SetLastCoord(ACoord: TPointF): TPointF; +begin + FLastCoord := ACoord; + FLastTransformedCoord := FMatrix*ACoord; + result := FLastTransformedCoord; +end; + +procedure TBGRAPath.ClearLastCoord; +begin + FLastCoord := EmptyPointF; + FLastTransformedCoord := EmptyPointF; +end; + +procedure TBGRAPath.BezierCurveFromTransformed(tcp1, cp2, pt: TPointF); +begin + with PCubicBezierToElement(AllocateElement(peCubicBezierTo))^ do + begin + ControlPoint1 := tcp1; + ControlPoint2 := FMatrix*cp2; + Destination := SetLastCoord(pt); + FExpectedTransformedControlPoint := Destination + (Destination-ControlPoint2); + end; +end; + +procedure TBGRAPath.QuadraticCurveFromTransformed(tcp, pt: TPointF); +begin + with PQuadraticBezierToElement(AllocateElement(peQuadraticBezierTo))^ do + begin + ControlPoint := tcp; + Destination := SetLastCoord(pt); + FExpectedTransformedControlPoint := Destination+(Destination-ControlPoint); + end; +end; + +function TBGRAPath.LastCoordDefined: boolean; +begin + result := not isEmptyPointF(FLastTransformedCoord); +end; + +function TBGRAPath.GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; +var pts: ArrayOfTPointF; + elemType: TBGRAPathElementType; + elem: pointer; + pt : TPointF; + i: Int32or64; +begin + GetElementAt(APos, elemType, elem); + case elemType of + peQuadraticBezierTo: + with PQuadraticBezierToElement(elem)^ do + result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint); + peCubicBezierTo: + with PCubicBezierToElement(elem)^ do + result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint); + peArc: + begin + result := ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation); + pt := GetElementStartCoord(APos); + if pt <> result[0] then + begin + setlength(result, length(result)+1); + for i := high(result) downto 1 do + result[i] := result[i-1]; + result[0] := pt; + end; + end; + peOpenedSpline, peClosedSpline: + with PSplineElement(elem)^ do + begin + setlength(pts, NbControlPoints); + move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF)); + if elemType = peOpenedSpline then + result := ComputeOpenedSpline(pts, SplineStyle, 0.25, AAcceptedDeviation) + else + result := ComputeClosedSpline(pts, SplineStyle, AAcceptedDeviation); + end; + end; +end; + +function TBGRAPath.getPoints: ArrayOfTPointF; +begin + result := ToPoints; +end; + +function TBGRAPath.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; +begin + result := ToPoints(AMatrix); +end; + +function TBGRAPath.getLength: single; +begin + result := ComputeLength; +end; + +function TBGRAPath.getCursor: TBGRACustomPathCursor; +begin + result := CreateCursor; +end; + +procedure TBGRAPath.InternalDraw(ADrawProc: TBGRAPathDrawProc; + const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); +var + nbSub: Int32or64; + + procedure OutputSub(subPathStartPos, subPathEndPos: IntPtr); + var + sub: array of ArrayOfTPointF; + temp: ArrayOfTPointF; + startPos,pos,nbPts,curPt,curSub: Int32or64; + elemType: TBGRAPathElementType; + elem: pointer; + begin + pos := subPathStartPos; + setlength(sub, nbSub); + curSub := 0; + while (pos <= subPathEndPos) and (curSub < nbSub) do + begin + GetElementAt(pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo,peLineTo,peCloseSubPath: begin + startPos := pos; + if (elemType = peMoveTo) and (curSub > 0) then + nbPts := 2 + else + nbPts := 1; + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + begin + GoToNextElement(pos); + inc(nbPts); + end; + setlength(temp, nbPts); + pos := startPos; + if (elemType = peMoveTo) and (curSub > 0) then + begin + temp[0] := EmptyPointF; + temp[1] := PPointF(elem)^; + curPt := 2; + end else + begin + temp[0] := PPointF(elem)^; + curPt := 1; + end; + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + begin + GoToNextElement(pos); + GetElementAt(pos, elemType, elem); + temp[curPt] := PPointF(elem)^; + inc(curPt); + end; + sub[curSub] := temp; + inc(curSub); + temp := nil; + end; + peQuadraticBezierTo,peCubicBezierTo,peArc, + peOpenedSpline, peClosedSpline: + begin + sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False); + inc(curSub); + end; + end; + GoToNextElement(pos); + end; + temp := ConcatPointsF(sub); + if not IsAffineMatrixIdentity(AMatrix) then + temp := AMatrix*temp; + if (elemType = peCloseSubPath) or ((curSub = 2) and (elemType = peClosedSpline)) then + ADrawProc(temp, True, AData) + else + ADrawProc(temp, False, AData); + end; + +var + subPathStartPos: IntPtr; + prevPos,pos: PtrInt; + elemType: TBGRAPathElementType; + elem: pointer; +begin + AAcceptedDeviation := CorrectAcceptedDeviation(AAcceptedDeviation, AMatrix); + pos := 0; + nbSub := 0; + subPathStartPos := pos; + repeat + prevPos := pos; + GetElementAt(pos, elemType, elem); + if elem = nil then + begin + pos := prevPos; + break; + end; + if (elemType = peMoveTo) and (nbSub > 0) then + begin + OutputSub(subPathStartPos,prevPos); + nbSub := 0; + subPathStartPos := pos; + end; + case elemType of + peMoveTo,peLineTo,peCloseSubPath: begin + inc(nbSub); + while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do + GoToNextElement(pos); + end; + peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub); + end; + until not GoToNextElement(pos); + if nbSub > 0 then OutputSub(subPathStartPos,pos); +end; + +procedure TBGRAPath.addPath(const AValue: string); +var p: integer; + numberError: boolean; + startCoord,lastCoord: TPointF; + + function parseFloat: single; + var numberStart: integer; + errPos: integer; + decimalFind: boolean; + + procedure parseFloatInternal; + begin + if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p); + decimalFind:= false; + while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do + begin + if AValue[p] = '.' then + if decimalFind then + Break + else + decimalFind:= true; + inc(p); + end; + end; + + begin + while (p <= length(AValue)) and (AValue[p] in[#0..#32,',']) do inc(p); + numberStart:= p; + parseFloatInternal; + if (p <= length(AValue)) and (AValue[p] in['e','E']) then + begin + inc(p); + parseFloatInternal; + end; + val(copy(AValue,numberStart,p-numberStart),result,errPos); + if errPos <> 0 then numberError := true; + end; + + function parseCoord(relative: boolean): TPointF; + begin + result.x := parseFloat; + result.y := parseFloat; + if relative and not isEmptyPointF(lastCoord) then result.Offset(lastCoord); + if isEmptyPointF(lastCoord) then startCoord := result; + end; + +var + command,implicitCommand: char; + relative: boolean; + c1,c2,p1: TPointF; + a: TArcDef; + largeArc: boolean; +begin + BeginSubPath; + lastCoord := EmptyPointF; + startCoord := EmptyPointF; + p := 1; + implicitCommand:= #0; + while p <= length(AValue) do + begin + command := AValue[p]; + if (command in['0'..'9','.','+','-']) and (implicitCommand <> #0) then + command := implicitCommand + else + begin + inc(p); + end; + relative := (command = lowerCase(command)); + numberError := false; + if upcase(command) in ['L','H','V','C','S','Q','T','A'] then + implicitCommand:= command; //by default the command repeats + case upcase(command) of + 'Z': begin + closePath; + implicitCommand:= #0; + lastCoord := startCoord; + end; + 'M': begin + p1 := parseCoord(relative); + if not numberError then + begin + moveTo(p1); + lastCoord := p1; + startCoord := p1; + end; + if relative then implicitCommand:= 'l' else + implicitCommand:= 'L'; + end; + 'L': begin + p1 := parseCoord(relative); + if not numberError then + begin + lineTo(p1); + lastCoord := p1; + end; + end; + 'H': begin + if not isEmptyPointF(lastCoord) then + begin + p1 := lastCoord; + if relative then IncF(p1.x, parseFloat) + else p1.x := parseFloat; + end else + begin + p1 := PointF(parseFloat,0); + lastCoord := p1; + startCoord := p1; + end; + if not numberError then + begin + lineTo(p1); + lastCoord := p1; + end; + end; + 'V': begin + if not isEmptyPointF(lastCoord) then + begin + p1 := lastCoord; + if relative then IncF(p1.y, parseFloat) + else p1.y := parseFloat; + end else + begin + p1 := PointF(0,parseFloat); + lastCoord := p1; + startCoord := p1; + end; + if not numberError then + begin + lineTo(p1); + lastCoord := p1; + end; + end; + 'C': begin + c1 := parseCoord(relative); + c2 := parseCoord(relative); + p1 := parseCoord(relative); + if not numberError then + begin + bezierCurveTo(c1,c2,p1); + lastCoord := p1; + end; + end; + 'S': begin + c2 := parseCoord(relative); + p1 := parseCoord(relative); + if not numberError then + begin + smoothBezierCurveTo(c2,p1); + lastCoord := p1; + end; + end; + 'Q': begin + c1 := parseCoord(relative); + p1 := parseCoord(relative); + if not numberError then + begin + quadraticCurveTo(c1,p1); + lastCoord := p1; + end; + end; + 'T': begin + p1 := parseCoord(relative); + if not numberError then + begin + smoothQuadraticCurveTo(p1); + lastCoord := p1; + end; + end; + 'A': + begin + a.radius.x := parseFloat; + a.radius.y := parseFloat; + a.xAngleRadCW := parseFloat*Pi/180; + largeArc := parseFloat<>0; + a.anticlockwise:= parseFloat=0; + p1 := parseCoord(relative); + if not numberError then + begin + arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y); + lastCoord := p1; + end; + end; + end; + end; +end; + +procedure TBGRAPath.addPath(source: IBGRAPath); +begin + source.copyTo(self); +end; + +procedure TBGRAPath.openedSpline(const pts: array of TPointF; + style: TSplineStyle); +var elem: PSplineElement; + i: Int32or64; + p: PPointF; +begin + if length(pts) = 0 then exit; + for i := 0 to high(pts) do + if isEmptyPointF(pts[i]) then + raise exception.Create('Unexpected empty point'); + if length(pts) <= 2 then + begin + polyline(pts); + exit; + end; + if not LastCoordDefined then moveTo(pts[0]); + elem := AllocateElement(peOpenedSpline, length(pts)*sizeof(TPointF)); + elem^.NbControlPoints := length(pts); + elem^.SplineStyle := style; + p := PPointF(elem+1); + for i := 0 to high(pts)-1 do + begin + p^ := FMatrix*pts[i]; + inc(p); + end; + p^ := SetLastCoord(pts[high(pts)]); + inc(p); + PInteger(p)^ := length(pts); +end; + +procedure TBGRAPath.closedSpline(const pts: array of TPointF; + style: TSplineStyle); +var elem: PSplineElement; + i: Int32or64; + p: PPointF; +begin + if length(pts) = 0 then exit; + for i := 0 to high(pts) do + if isEmptyPointF(pts[i]) then + raise exception.Create('Unexpected empty point'); + if not LastCoordDefined then moveTo(ClosedSplineStartPoint(pts, style)); + if length(pts) <= 2 then exit; + elem := AllocateElement(peClosedSpline, length(pts)*sizeof(TPointF)); + elem^.NbControlPoints := length(pts); + elem^.SplineStyle := style; + p := PPointF(elem+1); + for i := 0 to high(pts) do + begin + p^ := FMatrix*pts[i]; + inc(p); + end; + PInteger(p)^ := length(pts); +end; + +procedure TBGRAPath.BitmapDrawSubPathProc(const APoints: array of TPointF; + AClosed: boolean; AData: pointer); +begin + with TStrokeData(AData^) do + if AClosed then + begin + if Texture <> nil then + Bitmap.DrawPolygonAntialias(APoints, Texture, Width) + else + Bitmap.DrawPolygonAntialias(APoints, Color, Width); + end else + begin + if Texture <> nil then + Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Texture, Width) + else + Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Color, Width); + end; +end; + +function TBGRAPath.CorrectAcceptedDeviation(AAcceptedDeviation: single; + const AMatrix: TAffineMatrix): single; +var maxZoom: single; +begin + //determine the zoom of the matrix + maxZoom := Max(VectLen(PointF(AMatrix[1,1],AMatrix[2,1])), + VectLen(PointF(AMatrix[1,2],AMatrix[2,2]))); + //make the accepted deviation smaller if the matrix zooms to avoid that + // curves would look angular + if maxZoom = 0 then + result:= 1e10 + else + result := AAcceptedDeviation / maxZoom; +end; + +procedure TBGRAPath.OnModify; +begin + if length(FCursors)> 0 then + raise Exception.Create('You cannot modify the path when there are cursors'); +end; + +procedure TBGRAPath.OnMatrixChange; +begin + //transformed coord are not changed, + //but original coords are lost in the process. + //this has a consequence when using + //arc functions that rely on the previous + //coordinate + FLastCoord := EmptyPointF; + FSubPathStartCoord := EmptyPointF; +end; + +procedure TBGRAPath.NeedSpace(count: integer); +begin + OnModify; + inc(count, 4); //avoid memory error + if FDataPos + count > FDataCapacity then + begin + FDataCapacity := (FDataCapacity shl 1)+8; + if FDataPos + count + 8 > FDataCapacity then + FDataCapacity := FDataPos + count + 8; + ReAllocMem(FData, FDataCapacity); + end; +end; + +function TBGRAPath.AllocateElement(AElementType: TBGRAPathElementType; + AExtraBytes: PtrInt): Pointer; +var t: PtrInt; +begin + if not (AElementType in [succ(peNone)..high(TBGRAPathElementType)]) then + raise exception.Create('Invalid element type'); + OnModify; + t := PathElementSize[AElementType]+AExtraBytes; + NeedSpace(SizeOf(TPathElementHeader)+t); + with PPathElementHeader(FData+FDataPos)^ do + begin + ElementType:= AElementType; + PreviousElementType := FLastStoredElementType; + end; + result := FData+(FDataPos+SizeOf(TPathElementHeader)); + FLastSubPathElementType:= AElementType; + FLastStoredElementType:= AElementType; + Inc(FDataPos, sizeof(TPathElementHeader)+t); +end; + +procedure TBGRAPath.Init; +begin + FData := nil; + FDataCapacity := 0; + FLastMoveToDataPos := -1; + beginPath; + resetTransform; +end; + +function TBGRAPath.GoToNextElement(var APos: PtrInt): boolean; +var newPos: PtrInt; + p: PSplineElement; + elemType: TBGRAPathElementType; +begin + if APos >= FDataPos then + result := false + else + begin + elemType := PPathElementHeader(FData+APos)^.ElementType; + newPos := APos + sizeof(TPathElementHeader) + PathElementSize[elemType]; + if elemType in[peOpenedSpline,peClosedSpline] then + begin + p := PSplineElement(FData+(APos+sizeof(TPathElementHeader))); + inc(newPos, p^.NbControlPoints * sizeof(TPointF) ); //extra + end; + if newPos < FDataPos then + begin + result := true; + APos := newPos; + if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or + not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then + raise exception.Create('Internal structure error'); + end + else + result := false; + end; +end; + +function TBGRAPath.GoToPreviousElement(var APos: PtrInt): boolean; +var lastElemType: TBGRAPathElementType; +begin + if APos <= 0 then + result := false + else + begin + result := true; + if (APos = FDataPos) then + lastElemType := FLastStoredElementType + else + lastElemType := PPathElementHeader(FData+APos)^.PreviousElementType; + + if lastElemType in [peOpenedSpline,peClosedSpline] then + dec(APos, (PInteger(FData+APos)-1)^ *sizeof(TPointF)); //extra + dec(APos, sizeof(TPathElementHeader) + PathElementSize[lastElemType]); + + if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or + not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then + raise exception.Create('Internal structure error'); + end; +end; + +function TBGRAPath.PeekNextElement(APos: PtrInt): TBGRAPathElementType; +begin + if not GoToNextElement(APos) then + result := peNone + else + result := PPathElementHeader(FData+APos)^.ElementType; +end; + +function TBGRAPath.GetElementStartCoord(APos: PtrInt): TPointF; +var + elemType: TBGRAPathElementType; + elem: pointer; +begin + GetElementAt(APos, elemType, elem); + case elemType of + peNone: raise exception.Create('No element'); + peMoveTo: result := PPointF(elem)^; + else + begin + if not GoToPreviousElement(APos) then + raise exception.Create('No previous element') + else + begin + result := GetElementEndCoord(APos); + end; + end; + end; +end; + +function TBGRAPath.GetElementEndCoord(APos: PtrInt): TPointF; +var elemType: TBGRAPathElementType; + elem: pointer; +begin + GetElementAt(APos, elemType, elem); + case elemType of + peMoveTo,peLineTo,peCloseSubPath: result := PPointF(elem)^; + peQuadraticBezierTo: result := PQuadraticBezierToElement(elem)^.Destination; + peCubicBezierTo: result := PCubicBezierToElement(elem)^.Destination; + peArc: result := ArcEndPoint(PArcElement(elem)^); + peClosedSpline: result := PPointF(PSplineElement(elem)+1)^; + peOpenedSpline: result := (PPointF(PSplineElement(elem)+1)+(PSplineElement(elem)^.NbControlPoints-1))^; + else + result := EmptyPointF; + end; +end; + +function TBGRAPath.GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single; +var elemType: TBGRAPathElementType; + elem: pointer; + pts: array of TPointF; +begin + GetElementAt(APos, elemType, elem); + case elemType of + peMoveTo: result := 0; + peLineTo,peCloseSubPath: result := VectLen(PPointF(elem)^ - GetElementStartCoord(APos))*FScale; + peQuadraticBezierTo: with PQuadraticBezierToElement(elem)^ do + result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ComputeLength; + peCubicBezierTo: with PCubicBezierToElement(elem)^ do + result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ComputeLength(AAcceptedDeviation); + peArc: begin + result := VectLen(ArcStartPoint(PArcElement(elem)^) - GetElementStartCoord(APos)); + IncF(result, PolylineLen(ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation))); + end; + peClosedSpline,peOpenedSpline: + begin + pts := GetPolygonalApprox(APos, AAcceptedDeviation, true); + result := PolylineLen(pts) + VectLen(pts[0]-GetElementStartCoord(APos)); + end + else + result := 0; + end; +end; + +procedure TBGRAPath.GetElementAt(APos: PtrInt; out + AElementType: TBGRAPathElementType; out AElement: pointer); +begin + if APos >= FDataPos then + begin + AElementType := peNone; + AElement := nil; + end else + begin + AElementType:= PPathElementHeader(FData+APos)^.ElementType; + AElement := FData+(APos+sizeof(TPathElementHeader)); + end; +end; + +constructor TBGRAPath.Create; +begin + Init; +end; + +constructor TBGRAPath.Create(ASvgString: string); +begin + Init; + SvgString:= ASvgString; +end; + +constructor TBGRAPath.Create(const APoints: ArrayOfTPointF); +begin + Init; + SetPoints(APoints); +end; + +constructor TBGRAPath.Create(APath: IBGRAPath); +begin + Init; + APath.copyTo(self); +end; + +destructor TBGRAPath.Destroy; +var i: integer; +begin + for I := 0 to high(FCursors) do + FCursors[i].OnPathFree; + if Assigned(FData) then + begin + FreeMem(FData); + FData := nil; + end; + inherited Destroy; +end; + +procedure TBGRAPath.beginPath; +begin + DoClear; +end; + +procedure TBGRAPath.beginSubPath; +begin + OnModify; + FLastSubPathElementType := peNone; + ClearLastCoord; + FSubPathStartCoord := EmptyPointF; + FExpectedTransformedControlPoint := EmptyPointF; +end; + +procedure TBGRAPath.DoClear; +begin + OnModify; + FDataPos := 0; + BeginSubPath; +end; + +function TBGRAPath.CheckElementType(AElementType: TBGRAPathElementType): boolean; +begin + result := AElementType <= high(TBGRAPathElementType); +end; + +procedure TBGRAPath.closePath; +var + moveToType: TBGRAPathElementType; + moveToElem: pointer; +begin + if (FLastSubPathElementType <> peNone) and (FLastSubPathElementType <> peCloseSubPath) then + begin + with PClosePathElement(AllocateElement(peCloseSubPath))^ do + begin + StartCoordinate := FSubPathTransformedStartCoord; + LoopDataPos := FLastMoveToDataPos; + end; + if FLastMoveToDataPos <> -1 then + begin + GetElementAt(FLastMoveToDataPos,moveToType,moveToElem); + PMoveToElement(moveToElem)^.LoopDataPos := FDataPos; + FLastMoveToDataPos:= -1; + end; + FLastCoord := FSubPathStartCoord; + FLastTransformedCoord := FSubPathTransformedStartCoord; + end; +end; + +procedure TBGRAPath.translate(x, y: single); +begin + OnMatrixChange; + FMatrix := FMatrix * AffineMatrixTranslation(x,y); +end; + +procedure TBGRAPath.resetTransform; +begin + OnMatrixChange; + FMatrix := AffineMatrixIdentity; + FAngleRadCW := 0; + FScale:= 1; +end; + +procedure TBGRAPath.rotate(angleRadCW: single); +begin + OnMatrixChange; + FMatrix := FMatrix * AffineMatrixRotationRad(-angleRadCW); + IncF(FAngleRadCW, angleRadCW); +end; + +procedure TBGRAPath.rotateDeg(angleDeg: single); +const degToRad = Pi/180; +begin + rotate(angleDeg*degToRad); +end; + +procedure TBGRAPath.rotate(angleRadCW: single; center: TPointF); +begin + translate(center.x,center.y); + rotate(angleRadCW); + translate(-center.x,-center.y); +end; + +procedure TBGRAPath.rotateDeg(angleDeg: single; center: TPointF); +begin + translate(center.x,center.y); + rotateDeg(angleDeg); + translate(-center.x,-center.y); +end; + +procedure TBGRAPath.scale(factor: single); +begin + OnMatrixChange; + FMatrix := FMatrix * AffineMatrixScale(factor,factor); + FScale := FScale * factor; +end; + +procedure TBGRAPath.moveTo(x, y: single); +begin + moveTo(PointF(x,y)); +end; + +procedure TBGRAPath.lineTo(x, y: single); +begin + lineTo(PointF(x,y)); +end; + +procedure TBGRAPath.moveTo(constref pt: TPointF); +begin + if FLastSubPathElementType <> peMoveTo then + begin + FLastMoveToDataPos:= FDataPos; + with PMoveToElement(AllocateElement(peMoveTo))^ do + begin + StartCoordinate := SetLastCoord(pt); + LoopDataPos := -1; + end + end else + PMoveToElement(FData+(FDataPos-Sizeof(TMoveToElement)))^.StartCoordinate := SetLastCoord(pt); + FSubPathStartCoord := FLastCoord; + FSubPathTransformedStartCoord := FLastTransformedCoord; +end; + +procedure TBGRAPath.lineTo(constref pt: TPointF); +var lastTransfCoord, newTransfCoord: TPointF; +begin + if LastCoordDefined then + begin + lastTransfCoord := FLastTransformedCoord; + newTransfCoord := SetLastCoord(pt); + if newTransfCoord <> lastTransfCoord then + PPointF(AllocateElement(peLineTo))^ := newTransfCoord; + end else + moveTo(pt); +end; + +procedure TBGRAPath.polyline(const pts: array of TPointF); +var i: integer; +begin + if length(pts) = 0 then exit; + NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts)); + moveTo(pts[0]); + for i := 1 to high(pts) do lineTo(pts[i]); +end; + +procedure TBGRAPath.polylineTo(const pts: array of TPointF); +var i: integer; +begin + NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts)); + for i := 0 to high(pts) do lineTo(pts[i]); +end; + +procedure TBGRAPath.polygon(const pts: array of TPointF); +var lastPt: integer; +begin + if length(pts) = 0 then exit; + lastPt := high(pts); + while (lastPt > 1) and (pts[lastPt] = pts[0]) do dec(lastPt); + if lastPt <> high(pts) then + polyline(slice(pts,lastPt+1)) + else + polyline(pts); + closePath; +end; + +procedure TBGRAPath.quadraticCurveTo(cpx, cpy, x, y: single); +begin + quadraticCurveTo(PointF(cpx,cpy),PointF(x,y)); +end; + +procedure TBGRAPath.quadraticCurveTo(constref cp, pt: TPointF); +begin + if LastCoordDefined then + QuadraticCurveFromTransformed(FMatrix*cp, pt) else + begin + lineTo(pt); + FExpectedTransformedControlPoint := FMatrix*(pt+(pt-cp)); + end; +end; + +procedure TBGRAPath.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single); +begin + bezierCurveTo(PointF(cp1x,cp1y),PointF(cp2x,cp2y),PointF(x,y)); +end; + +procedure TBGRAPath.bezierCurveTo(constref cp1, cp2, pt: TPointF); +begin + if not LastCoordDefined then moveTo(cp1); + BezierCurveFromTransformed(FMatrix*cp1, cp2, pt); +end; + +procedure TBGRAPath.bezierCurve(const curve: TCubicBezierCurve); +begin + moveTo(curve.p1); + bezierCurveTo(curve.c1,curve.c2,curve.p2); +end; + +procedure TBGRAPath.bezierCurve(p1, cp1, cp2, p2: TPointF); +begin + moveTo(p1); + bezierCurveTo(cp1,cp2,p2); +end; + +procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single); +begin + smoothBezierCurveTo(PointF(cp2x,cp2y),PointF(x,y)); +end; + +procedure TBGRAPath.smoothBezierCurveTo(const cp2, pt: TPointF); +begin + if (FLastSubPathElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then + BezierCurveFromTransformed(FExpectedTransformedControlPoint,cp2,pt) + else if LastCoordDefined then + BezierCurveFromTransformed(FLastTransformedCoord,cp2,pt) + else + bezierCurveTo(cp2,cp2,pt); +end; + +procedure TBGRAPath.quadraticCurve(const curve: TQuadraticBezierCurve); +begin + moveTo(curve.p1); + quadraticCurveTo(curve.c,curve.p2); +end; + +procedure TBGRAPath.quadraticCurve(p1, cp, p2: TPointF); +begin + moveTo(p1); + quadraticCurveTo(cp,p2); +end; + +procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single); +begin + smoothQuadraticCurveTo(PointF(x,y)); +end; + +procedure TBGRAPath.smoothQuadraticCurveTo(const pt: TPointF); +begin + if (FLastSubPathElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then + QuadraticCurveFromTransformed(FExpectedTransformedControlPoint,pt) + else if LastCoordDefined then + QuadraticCurveFromTransformed(FLastTransformedCoord,pt) + else + quadraticCurveTo(pt,pt); +end; + +procedure TBGRAPath.rect(x, y, w, h: single); +begin + moveTo(x,y); + lineTo(x+w,y); + lineTo(x+w,y+h); + lineTo(x,y+h); + closePath; +end; + +procedure TBGRAPath.roundRect(x, y, w, h, radius: single); +begin + if radius <= 0 then + begin + rect(x,y,w,h); + exit; + end; + if (w <= 0) or (h <= 0) then exit; + if radius*2 > w then radius := w/2; + if radius*2 > h then radius := h/2; + moveTo(x+radius,y); + arcTo(PointF(x+w,y),PointF(x+w,y+h), radius); + arcTo(PointF(x+w,y+h),PointF(x,y+h), radius); + arcTo(PointF(x,y+h),PointF(x,y), radius); + arcTo(PointF(x,y),PointF(x+w,y), radius); + closePath; +end; + +procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; + anticlockwise: boolean); +begin + arc(cx,cy,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise); +end; + +procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); +begin + arc(cx,cy,radius,startAngleRadCW,endAngleRadCW,false); +end; + +procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; + anticlockwise: boolean); +const degToRad = Pi/180; +begin + arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad,anticlockwise); +end; + +procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); +const degToRad = Pi/180; +begin + arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad); +end; + +procedure TBGRAPath.arcTo(x1, y1, x2, y2, radius: single); +begin + arcTo(PointF(x1,y1), PointF(x2,y2), radius); +end; + +procedure TBGRAPath.arcTo(const p1, p2: TPointF; radius: single); +var p0 : TPointF; +begin + if IsEmptyPointF(FLastCoord) then + p0 := p1 else p0 := FLastCoord; + arc(Html5ArcTo(p0,p1,p2,radius)); +end; + +procedure TBGRAPath.arc(constref arcDef: TArcDef); +var transformedArc: TArcElement; +begin + if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then + lineTo(arcDef.center) + else + begin + if not LastCoordDefined then + moveTo(ArcStartPoint(arcDef)); + transformedArc.anticlockwise := arcDef.anticlockwise; + transformedArc.startAngleRadCW := arcDef.startAngleRadCW; + transformedArc.endAngleRadCW := arcDef.endAngleRadCW; + transformedArc.center := FMatrix*arcDef.center; + transformedArc.radius := arcDef.radius*FScale; + transformedArc.xAngleRadCW := arcDef.xAngleRadCW+FAngleRadCW; + PArcElement(AllocateElement(peArc))^ := transformedArc; + {$PUSH}{$OPTIMIZATION OFF} + SetLastCoord(ArcEndPoint(arcDef)); + {$POP} + end; +end; + +procedure TBGRAPath.arc(cx, cy, rx, ry: single; xAngleRadCW, startAngleRadCW, + endAngleRadCW: single); +begin + arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false)); +end; + +procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; + anticlockwise: boolean); +begin + arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise)); +end; + +procedure TBGRAPath.arcTo(rx, ry, xAngleRadCW: single; largeArc, + anticlockwise: boolean; x, y: single); +begin + if IsEmptyPointF(FLastCoord) then + moveTo(x,y) + else + arc(SvgArcTo(FLastCoord, rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y))); +end; + +procedure TBGRAPath.copyTo(dest: IBGRAPath); +var pos: IntPtr; + elemType: TBGRAPathElementType; + elem: Pointer; + pts: array of TPointF; +begin + pos := 0; + repeat + GetElementAt(pos, elemType, elem); + if elem = nil then break; + case elemType of + peMoveTo: dest.moveTo(PPointF(elem)^); + peLineTo: dest.lineTo(PPointF(elem)^); + peCloseSubPath: dest.closePath; + peQuadraticBezierTo: + with PQuadraticBezierToElement(elem)^ do + dest.quadraticCurveTo(ControlPoint,Destination); + peCubicBezierTo: + with PCubicBezierToElement(elem)^ do + dest.bezierCurveTo(ControlPoint1,ControlPoint2,Destination); + peArc: dest.arc(PArcElement(elem)^); + peOpenedSpline, peClosedSpline: + begin + with PSplineElement(elem)^ do + begin + setlength(pts, NbControlPoints); + move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF)); + if elemType = peOpenedSpline then + dest.openedSpline(pts, SplineStyle) + else + dest.closedSpline(pts, SplineStyle); + pts := nil; + end; + end; + end; + until not GoToNextElement(pos); +end; + +initialization + + BGRAPathFactory := TBGRAPath; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapen.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapen.pas new file mode 100644 index 0000000..2d07d84 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapen.pas @@ -0,0 +1,1324 @@ +unit BGRAPen; + +{$mode objfpc}{$H+} + +interface + +{ This unit handles pen style and width, as well as line caps and join styles. + + A line consists in two points. + A polyline consists in one or more lines, defined by two points or more than two points + A poly-polyline consists in a series of polylines, defined by polyline points separated by empty points (see EmptyPointF) } + +uses + SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform; + +var //predefined pen styles + SolidPenStyle, DashPenStyle, DotPenStyle, DashDotPenStyle, DashDotDotPenStyle, ClearPenStyle: TBGRAPenStyle; + +type + TPenJoinStyle = BGRAGraphics.TPenJoinStyle; + TPenEndCap = BGRAGraphics.TPenEndCap; + + { TBGRAPenStroker } + + TBGRAPenStroker = class(TBGRACustomPenStroker) + protected + { Pen style can be defined by PenStyle property of by CustomPenStyle property. + When PenStyle property is assigned, CustomPenStyle property is assigned the actual + pen pattern. } + FCustomPenStyle: TBGRAPenStyle; + FPenStyle: TPenStyle; + FArrow: TBGRACustomArrow; + FArrowOwned: boolean; + FOriginalStrokeMatrix,FStrokeMatrix,FStrokeMatrixInverse: TAffineMatrix; + FStrokeZoom: single; + FStrokeMatrixIdentity: boolean; + FLineCap: TPenEndCap; + FJoinStyle: TPenJoinStyle; + FMiterLimit: single; + + function GetArrow: TBGRACustomArrow; override; + function GetArrowOwned: boolean; override; + function GetCustomPenStyle: TBGRAPenStyle; override; + function GetJoinStyle: TPenJoinStyle; override; + function GetLineCap: TPenEndCap; override; + function GetMiterLimit: single; override; + function GetPenStyle: TPenStyle; override; + function GetStrokeMatrix: TAffineMatrix; override; + procedure SetArrow(AValue: TBGRACustomArrow); override; + procedure SetArrowOwned(AValue: boolean); override; + procedure SetCustomPenStyle(AValue: TBGRAPenStyle); override; + procedure SetJoinStyle(AValue: TPenJoinStyle); override; + procedure SetLineCap(AValue: TPenEndCap); override; + procedure SetMiterLimit(AValue: single); override; + procedure SetPenStyle(AValue: TPenStyle); override; + procedure SetStrokeMatrix(const AValue: TAffineMatrix); override; + public + constructor Create; + destructor Destroy; override; + function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; overload; override; + function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; overload; override; + function ComputePolylineAutocycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override; + function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override; + + end; + + TBGRAPolyLineOption = (plRoundCapOpen, //specifies that the line ending is opened + plCycle, //specifies that it is a polygon + plAutoCycle, //specifies that a cycle must be used if the last point is the first point + plNoStartCap, + plNoEndCap); + TBGRAPolyLineOptions = set of TBGRAPolyLineOption; + TComputeArrowHeadProc = function(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF of object; + +{ Compute the path for a polyline } +function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single; + pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; + options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): ArrayOfTPointF; + +{ Compute the path for a poly-polyline } +function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; width: single; + pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; + options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): ArrayOfTPointF; + +{--------------------- Pixel line procedures --------------------------} +{ These procedures take integer coordinates as parameters and do not handle pen styles and width. + They are faster and can be useful for drawing a simple frame } + +//aliased version +procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency); deprecated; +procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); deprecated; + +//antialiased version +procedure BGRADrawLineAntialias({%H-}dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean = false); overload; deprecated; +procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + calpha: byte; DrawLastPixel: boolean); overload; deprecated; + +//antialiased version with bicolor dashes (to draw a frame) +procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean = false); overload; deprecated; + +//length added to ensure accepable alpha join (using TBGRAMultishapeFiller is still better) +function GetAlphaJoinFactor(alpha: byte): single; + +//create standard brush texture +function CreateBrushTexture(prototype: TBGRACustomBitmap; brushstyle: TBrushStyle; PatternColor, BackgroundColor: TBGRAPixel; + width: integer = 8; height: integer = 8; penwidth: single = 1): TBGRACustomBitmap; + +//check special pen styles +function IsSolidPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; +function IsClearPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; +function DuplicatePenStyle(ACustomPenStyle: array of single): TBGRAPenStyle; +function PenStyleEqual(AStyle1, AStyle2: TBGRAPenStyle): boolean; +function BGRAToPenStyle(ACustomPenStyle: TBGRAPenStyle): TPenStyle; +function PenStyleToBGRA(APenStyle: TPenStyle): TBGRAPenStyle; + +implementation + +uses math, BGRAClasses, BGRAPath; + +procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode); +begin + dest.DrawLine(x1,y1,x2,y2, c,DrawLastPixel, ADrawMode); +end; + +procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, + y2: integer; alpha: byte; DrawLastPixel: boolean); +begin + dest.EraseLine(x1,y1,x2,y2,alpha,DrawLastPixel); +end; + +procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean); +var + b: TUniversalBrush; +begin + if c.alpha = 0 then exit; + if LinearBlend then + dest.SolidBrush(b, c,dmLinearBlend) + else + dest.SolidBrush(b, c,dmDrawWithTransparency); + dest.DrawLineAntialias(x1,y1,x2,y2, b,DrawLastPixel); +end; + +procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, + y2: integer; calpha: byte; DrawLastPixel: boolean); +begin + dest.EraseLineAntialias(x1,y1,x2,y2,calpha,DrawLastPixel); +end; + +procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; + c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean); +var + b1, b2: TUniversalBrush; +begin + if (c1.alpha=0) and (c2.alpha=0) then exit; + if LinearBlend then + begin + dest.SolidBrush(b1, c1,dmLinearBlend); + dest.SolidBrush(b2, c2,dmLinearBlend); + end + else + begin + dest.SolidBrush(b1, c1,dmDrawWithTransparency); + dest.SolidBrush(b2, c2,dmDrawWithTransparency); + end; + dest.DrawLineAntialias(x1,y1,x2,y2, b1,b2, dashLen,dashPos,DrawLastPixel); +end; + +function GetAlphaJoinFactor(alpha: byte): single; +var t: single; +begin + if alpha = 255 then result := 1 else + begin + result := (power(20,alpha/255)-1)/19*0.5; + t := power(alpha/255,40); + result := result*(1-t)+t*0.82; + end; +end; + +function CreateBrushTexture(prototype: TBGRACustomBitmap; brushstyle: TBrushStyle; + PatternColor, BackgroundColor: TBGRAPixel; width: integer = 8; height: integer = 8; penwidth: single = 1): TBGRACustomBitmap; +begin + result := prototype.CreateBrushTexture(brushstyle, PatternColor, BackgroundColor, width,height, penwidth); +end; + +function IsSolidPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; +begin + result := ACustomPenStyle = nil; +end; + +function IsClearPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; +begin + if (length(ACustomPenStyle)=1) and (ACustomPenStyle[0]=0) then + result := true + else + result := false; +end; + +function DuplicatePenStyle(ACustomPenStyle: array of single): TBGRAPenStyle; +var + i: Integer; +begin + setlength(result,length(ACustomPenStyle)); + for i := 0 to high(result) do + result[i]:= ACustomPenStyle[i]; +end; + +function BGRAToPenStyle(ACustomPenStyle: TBGRAPenStyle): TPenStyle; +begin + if IsSolidPenStyle(ACustomPenStyle) then exit(psSolid); + if IsClearPenStyle(ACustomPenStyle) then exit(psClear); + if PenStyleEqual(ACustomPenStyle, DashPenStyle) then exit(psDash); + if PenStyleEqual(ACustomPenStyle, DotPenStyle) then exit(psDot); + if PenStyleEqual(ACustomPenStyle, DashDotPenStyle) then exit(psDashDot); + if PenStyleEqual(ACustomPenStyle, DashDotDotPenStyle) then exit(psDashDotDot); + exit(psPattern); +end; + +function PenStyleToBGRA(APenStyle: TPenStyle): TBGRAPenStyle; +begin + Case APenStyle of + psSolid: result := SolidPenStyle; + psDash: result := DashPenStyle; + psDot: result := DotPenStyle; + psDashDot: result := DashDotPenStyle; + psDashDotDot: result := DashDotDotPenStyle; + else result := ClearPenStyle; + end; +end; + +function PenStyleEqual(AStyle1, AStyle2: TBGRAPenStyle): boolean; +var + i: Integer; +begin + if length(AStyle1)<>length(AStyle2) then exit(false); + for i := 0 to high(AStyle1) do + if AStyle1[i] <> AStyle2[i] then exit(false); + exit(true); +end; + +procedure ApplyPenStyle(const leftPts, rightPts: array of TPointF; const penstyle: TBGRAPenStyle; + width: single; var posstyle: single; out styledPts: ArrayOfTPointF); +var + styleIndex :integer; + remainingDash: single; + + procedure NextStyleIndex; + begin + inc(styleIndex); + if styleIndex = length(penstyle) then + styleIndex := 0; + IncF(remainingDash, penstyle[styleindex]); + end; + +var + dashStartIndex: integer; + dashLeftStartPos,dashRightStartPos : TPointF; + betweenDash: boolean; + + procedure StartDash(index: integer; t: single); + begin + dashStartIndex := index; + if t = 0 then + begin + dashLeftStartPos := leftPts[index]; + dashRightStartPos := rightPts[index]; + end else + begin + dashLeftStartPos := leftPts[index] + (leftPts[index+1]-leftPts[index])*t; + dashRightStartPos := rightPts[index] + (rightPts[index+1]-rightPts[index])*t; + end; + betweenDash := false; + end; + +var + nbStyled: integer; + + procedure AddPt(pt: TPointF); + begin + if (nbStyled = 0) or (pt <> styledPts[nbStyled-1]) then + begin + if nbStyled = length(styledPts) then + setlength(styledPts,nbStyled*2+4); + styledPts[nbStyled] := pt; + inc(nbStyled); + end; + end; + + procedure StartPolygon; + begin + if nbStyled > 0 then AddPt(EmptyPointF); + end; + + procedure EndDash(index: integer; t: single); + var dashLeftEndPos,dashRightEndPos: TPointF; + i: Integer; + begin + if t=0 then + begin + dashLeftEndPos := leftPts[index]; + dashRightEndPos := rightPts[index]; + end else + begin + dashLeftEndPos := leftPts[index] + (leftPts[index+1]-leftPts[index])*t; + dashRightEndPos := rightPts[index] + (rightPts[index+1]-rightPts[index])*t; + end; + StartPolygon; + AddPt(dashLeftStartPos); + for i := dashStartIndex+1 to index do + AddPt(leftPts[i]); + AddPt(dashLeftEndPos); + AddPt(dashRightEndPos); + for i := index downto dashStartIndex+1 do + AddPt(rightPts[i]); + AddPt(dashRightStartPos); + betweenDash := true; + end; + +var + i,nb: integer; + styleLength: single; + len,lenDone: single; + +begin + nbStyled := 0; + styledPts := nil; + if IsClearPenStyle(penstyle) then exit; + if IsSolidPenStyle(penstyle) then + begin + for i := 0 to high(leftPts) do AddPt(leftPts[i]); + for i := high(rightPts) downto 0 do AddPt(rightPts[i]); + setlength(styledPts,nbStyled); + exit; + end; + if length(leftPts) <> length(rightPts) then + raise Exception.Create('Dimension mismatch'); + nb := length(leftPts); + if length(penstyle) mod 2 <> 0 then + raise Exception.Create('Pen style must contain an even number of values'); + styleLength := 0; + styleIndex := -1; + remainingDash := 0; + betweenDash := false; + for i := 0 to high(penstyle) do + if penstyle[i] <= 0 then + raise Exception.Create('Invalid pen dash length') + else + begin + IncF(styleLength, penstyle[i]); + if styleLength >= posstyle then + begin + styleIndex := i; + remainingDash := styleLength-posstyle; + break; + end; + end; + if styleIndex = -1 then + begin + styleIndex := 0; + remainingDash := penstyle[0]; + end; + + if styleIndex mod 2 = 0 then + StartDash(0, 0) else + betweenDash := true; + for i := 0 to nb-2 do + begin + len := (sqrt(sqr(leftPts[i+1].x-leftPts[i].x) + sqr(leftPts[i+1].y-leftPts[i].y))+ + sqrt(sqr(rightPts[i+1].x-rightPts[i].x) + sqr(rightPts[i+1].y-rightPts[i].y)))/(2*width); + lenDone := 0; + while lenDone < len do + begin + if len-lenDone < remainingDash then + begin + DecF(remainingDash, len-lenDone); + if remainingDash = 0 then NextStyleIndex; + lenDone := len; + end else + if betweenDash then + begin + IncF(lenDone, remainingDash); + StartDash(i, lenDone/len); + remainingDash := 0; + NextStyleIndex; + end else + begin + IncF(lenDone, remainingDash); + EndDash(i, lenDone/len); + remainingDash := 0; + NextStyleIndex; + end; + end; + end; + if not betweenDash then + EndDash(nb-1,0); + setlength(styledPts,nbStyled); +end; + +function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single; + pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; + options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF; +const oneOver512 = 1/512; +var + startArrowPos, startArrowDir, endArrowPos, endArrowDir: TPointF; + startArrowLinePos, endArrowLinePos: single; + borders : array of record + leftSide,rightSide: TLineDef; + len: single; + leftDir: TPointF; + end; + compPts: array of TPointF; + nbCompPts: integer; + revCompPts: array of TPointF; + nbRevCompPts: integer; + pts: array of TPointF; + roundPrecision: integer; + hw: single; //half-width + + procedure AddPt(normal,rev: TPointF); overload; + begin + if (nbCompPts > 0) and (compPts[nbCompPts-1]=normal) and + (nbRevCompPts > 0) and (revCompPts[nbRevCompPts-1]=rev) then exit; + + if nbCompPts = length(compPts) then + setlength(compPts, length(compPts)*2); + compPts[nbCompPts] := normal; + inc(nbCompPts); + + if nbRevCompPts = length(revCompPts) then + setlength(revCompPts, length(revCompPts)*2); + revCompPts[nbRevCompPts] := rev; + inc(nbRevCompPts); + end; + + procedure AddPt(xnormal,ynormal: single; xrev,yrev: single); overload; + begin + AddPt(PointF(xnormal,ynormal),PointF(xrev,yrev)); + end; + + procedure AddRoundCap(origin: TPointF; dir: TPointF; fromCenter: boolean; flipped: boolean= false); + var i: integer; + a,s,c: single; + offset,flipvalue: single; + begin + if fromCenter then offset := 0 else offset := -Pi/2; + if flipped then flipvalue := -1 else flipvalue := 1; + for i := 1 to RoundPrecision do + begin + a := i/(RoundPrecision+1)*Pi/2 + offset; + s := sin(a)*hw*flipvalue; + c := cos(a)*hw; + AddPt( PointF(origin.x+ dir.x*c - dir.y*s, origin.y + dir.y*c + dir.x*s), + PointF(origin.x+ dir.x*c + dir.y*s, origin.y + dir.y*c - dir.x*s) ); + end; + end; + + procedure AddRoundCapAlphaJoin(origin: TPointF; dir: TPointF; fromCenter: boolean; flipped: boolean= false); + var i: integer; + a,s,c: single; + offset,flipvalue: single; + t,alphaFactor: single; //antialiasing join + begin + if fromCenter then offset := 0 else offset := -Pi/2; + if flipped then flipvalue := -1 else flipvalue := 1; + + alphaFactor := GetAlphaJoinFactor(pencolor.alpha); + + for i := 1 to RoundPrecision do + begin + a := i/(RoundPrecision+1)*Pi/2 + offset; + s := sin(a)*hw*flipvalue; + c := cos(a); + t := (1 - c) * (0.2 + alphaFactor*0.3) + alphaFactor; + c := c * hw; + AddPt( PointF(origin.x+ dir.x*(c-t) - dir.y*s, origin.y + dir.y*(c-t) + dir.x*s), + PointF(origin.x+ dir.x*(c-t) + dir.y*s, origin.y + dir.y*(c-t) - dir.x*s) ); + end; + end; + + function ComputeRoundJoin(origin, pt1,pt2: TPointF): ArrayOfTPointF; + var a1,a2: single; + da: single; + precision,i: integer; + begin + a1 := arctan2(pt1.y-origin.y,pt1.x-origin.x); + a2 := arctan2(pt2.y-origin.y,pt2.x-origin.x); + if a2-a1 > Pi then DecF(a2, 2*Pi); + if a1-a2 > Pi then DecF(a1, 2*Pi); + if a2=a1 then + begin + setlength(result,1); + result[0] := pt1; + exit; + end; + da := a2-a1; + precision := round( sqrt( sqr(pt2.x-pt1.x)+sqr(pt2.y-pt1.y) ) ) +2; + setlength(result,precision); + for i := 0 to precision-1 do + result[i] := origin + PointF( cos(a1+i/(precision-1)*da)*hw, + sin(a1+i/(precision-1)*da)*hw ); + end; + +var + joinLeft,joinRight: array of TPointF; + nbJoinLeft,nbJoinRight: integer; + + procedure SetJoinLeft(joinpts: array of TPointF); + var i: integer; + begin + nbJoinLeft := length(joinpts); + if length(joinLeft) < nbJoinLeft then setlength(joinLeft,length(joinLeft)+nbJoinLeft+2); + for i := 0 to nbJoinLeft-1 do + joinLeft[i] := joinpts[i]; + end; + + procedure SetJoinRight(joinpts: array of TPointF); + var i: integer; + begin + nbJoinRight := length(joinpts); + if length(joinRight) < nbJoinRight then setlength(joinRight,length(joinRight)+nbJoinRight+2); + for i := 0 to nbJoinRight-1 do + joinRight[i] := joinpts[i]; + end; + + procedure AddJoin(index: integer); + var len,i: integer; + begin + len := nbJoinLeft; + if nbJoinRight > len then + len := nbJoinRight; + if len = 0 then exit; + if (len > 1) and (index <> -1) then + begin + if nbJoinLeft=1 then + AddPt(joinLeft[0], joinLeft[0] - 2*borders[Index].leftDir) else + if nbJoinRight=1 then + AddPt( joinRight[0] + 2* borders[index].leftDir, joinRight[0]); + end; + for i := 0 to len-1 do + begin + AddPt(joinLeft[i*nbJoinLeft div len], + joinRight[i*nbJoinRight div len]); + end; + if (len > 1) and (index <> -1) then + begin + if nbJoinLeft=1 then + AddPt(joinLeft[0], joinLeft[0] - 2*borders[index+1].leftDir) else + if nbJoinRight=1 then + AddPt(joinRight[0]+2*borders[index+1].leftDir, joinRight[0]); + end; + end; + +var + NbPolyAcc: integer; + + procedure FlushLine(lastPointIndex: integer); + var + enveloppe: arrayOfTPointF; + posstyle: single; + i,idxInsert: Integer; + begin + if lastPointIndex <> -1 then + AddPt( pts[lastPointIndex] + borders[lastPointIndex-1].leftDir, + pts[lastPointIndex] - borders[lastPointIndex-1].leftDir); + + if (lastPointIndex = high(pts)) and (linecap = pecRound) and not (plNoEndCap in options) then + begin + if not (plRoundCapOpen in options) then + AddRoundCap(pts[high(pts)],borders[high(pts)-1].leftSide.dir,false) + else + AddRoundCapAlphaJoin(pts[high(pts)], + -borders[high(pts)-1].leftSide.dir, false,true); + end; + posstyle := 0; + ApplyPenStyle(slice(compPts,nbCompPts),slice(revCompPts,nbRevCompPts),penstyle,width,posstyle,enveloppe); + + if Result=nil then + begin + Result := enveloppe; + NbPolyAcc := length(enveloppe); + end + else + if enveloppe <> nil then + begin + if NbPolyAcc +1+length(enveloppe) > length(Result) then + setlength(Result, length(Result)*2+1+length(enveloppe)); + + idxInsert := NbPolyAcc+1; + Result[idxInsert-1] := EmptyPointF; + for i := 0 to high(enveloppe) do + Result[idxInsert+i]:= enveloppe[i]; + inc(NbPolyAcc, length(enveloppe)+1); + end; + + nbCompPts := 0; + nbRevCompPts := 0; + end; + + procedure CycleFlush; + var idx: integer; + begin + if Result = nil then + begin + if (nbCompPts > 1) and (nbRevCompPts > 1) then + begin + compPts[0] := compPts[nbCompPts-1]; + revCompPts[0] := revCompPts[nbRevCompPts-1]; + end; + FlushLine(-1); + end else + begin + if (nbCompPts >= 1) and (nbRevCompPts >= 1) and (NbPolyAcc >= 2) then + begin + Result[0] := compPts[nbCompPts-1]; + idx := 0; + while (idx < high(Result)) and (not isEmptyPointF(Result[idx+1])) do inc(idx); + Result[idx] := revCompPts[nbRevCompPts-1]; + end; + FlushLine(-1); + end; + end; + + procedure FinalizeArray; + var arrowStartData, arrowEndData: ArrayOfTPointF; + finalNb,i,delta: integer; + hasStart,hasEnd: boolean; + begin + if assigned(arrow) and not isEmptyPointF(startArrowPos) then + arrowStartData := arrow.ComputeStartAt(startArrowPos, startArrowDir, width, startArrowLinePos) + else + arrowStartData := nil; + if assigned(arrow) and not isEmptyPointF(endArrowPos) then + arrowEndData := arrow.ComputeEndAt(endArrowPos, endArrowDir, width, endArrowLinePos) + else + arrowEndData := nil; + hasStart := length(arrowStartData)>0; + hasEnd := length(arrowEndData)>0; + finalNb := NbPolyAcc; + if hasStart then + begin + delta := length(arrowStartData)+1; + inc(finalNb, delta); + end else delta := 0; + if hasEnd then inc(finalNb, length(arrowEndData)+1); + SetLength(Result, finalNb); + if hasStart then + begin + for i := NbPolyAcc-1 downto 0 do + result[i+delta] := result[i]; + result[delta-1] := EmptyPointF; + for i := 0 to high(arrowStartData) do + result[i] := arrowStartData[i]; + end; + if hasEnd then + begin + inc(delta, NbPolyAcc+1); + result[delta-1] := EmptyPointF; + for i := 0 to high(arrowEndData) do + result[i+delta] := arrowEndData[i]; + end; + end; + +var + i: integer; + dir: TPointF; + leftInter,rightInter,diff: TPointF; + len,maxMiter: single; + littleBorder: TLineDef; + turn,maxDiff: single; + nbPts: integer; + ShouldFlushLine, HasLittleBorder, NormalRestart: Boolean; + pt1,pt2,pt3,pt4: TPointF; + linePos: single; + startArrowDone,endArrowDone: boolean; + wantedStartArrowPos,wantedEndArrowPos: single; + +begin + Result := nil; + + if (length(linepts)=0) or (width = 0) then exit; + if IsClearPenStyle(penstyle) then exit; + for i := 0 to high(linepts) do + if isEmptyPointF(linepts[i]) then + begin + result := ComputeWidePolyPolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow); + exit; + end; + + if (plAutoCycle in options) and (length(linepts) >= 2) and (linepts[0]=linepts[high(linepts)]) then + options := options + [plCycle]; + if plNoEndCap in options then options := options - [plRoundCapOpen]; + + hw := width / 2; + case joinstyle of + pjsBevel,pjsRound: maxMiter := hw*1.001; + pjsMiter: if miterLimit < 1.001 then maxMiter := hw*1.001 else + maxMiter := hw*miterLimit; + else + raise Exception.Create('Unknown join style'); + end; + + roundPrecision := round(hw)+2; + + nbPts := 0; + setlength(pts, length(linepts)+2); + for i := 0 to high(linepts) do + if (nbPts = 0) or (abs(linepts[i].x-pts[nbPts-1].x)>oneOver512) or (abs(linepts[i].y-pts[nbPts-1].y)>oneOver512) then + begin + pts[nbPts]:= linePts[i]; + inc(nbPts); + end; + if (nbPts > 1) and (plCycle in options) and + (abs(pts[0].x-pts[nbPts-1].x)<=oneOver512) and + (abs(pts[0].y-pts[nbPts-1].y)<=oneOver512) then dec(nbPts); + if (plCycle in options) and (nbPts > 2) then + begin + if (pts[nbPts-1] <> pts[0]) then + begin + pts[nbPts] := pts[0]; + inc(nbPts); + end; + pts[nbPts] := pts[1]; + inc(nbPts); + end else + exclude(options, plCycle); + + setlength(pts,nbPts); + + if nbPts = 1 then + begin + if (linecap <> pecFlat) and ((linecap <> pecRound) or not (plRoundCapOpen in options)) then + result := ComputeEllipse(pts[0].x,pts[0].y,hw,hw); + exit; + end; + + startArrowDir := EmptyPointF; + startArrowPos := EmptyPointF; + endArrowDir := EmptyPointF; + endArrowPos := EmptyPointF; + if Assigned(arrow) then + begin + wantedStartArrowPos:= arrow.StartOffsetX; + wantedEndArrowPos:= arrow.EndOffsetX; + startArrowDone := not arrow.IsStartDefined; + endArrowDone := not arrow.IsEndDefined; + end + else + begin + wantedStartArrowPos:= 0; + wantedEndArrowPos:= 0; + startArrowDone := true; + endArrowDone := true; + end; + + //init computed points arrays + setlength(compPts, length(pts)*2+4); + setlength(revCompPts, length(pts)*2+4); //reverse order array + nbCompPts := 0; + nbRevCompPts := 0; + NbPolyAcc := 0; + + if not endArrowDone then + begin + wantedEndArrowPos:= -wantedEndArrowPos*width; + linePos := 0; + for i := high(pts) downto 1 do + begin + dir := pts[i-1]-pts[i]; + len := VectLen(dir); + dir.Scale(1/len); + if not endArrowDone and (linePos+len >= wantedEndArrowPos) then + begin + endArrowPos := pts[i]; + endArrowDir := -dir; + endArrowLinePos := -linePos/width; + endArrowDone := true; + break; + end; + IncF(linePos, len); + end; + end; + + wantedStartArrowPos:= -wantedStartArrowPos*width; + linePos := 0; + //compute borders + setlength(borders, length(pts)-1); + for i := 0 to high(pts)-1 do + begin + dir := pts[i+1]-pts[i]; + len := VectLen(dir); + dir.Scale(1/len); + if not startArrowDone and (linePos+len >= wantedStartArrowPos) then + begin + startArrowPos := pts[i]; + startArrowDir := -dir; + startArrowLinePos := -linePos/width; + startArrowDone := true; + end; + if (linecap = pecSquare) and ((not (plNoStartCap in options) and (i=0)) or + (not (plNoEndCap in options) and (i=high(pts)-1))) then //for square cap, just start and end further + begin + if i=0 then + pts[0].Offset(dir*(-hw)); + + if (i=high(pts)-1) then + pts[high(pts)].Offset(dir*hw); + + //length changed + dir := pts[i+1]-pts[i]; + len := VectLen(dir); + dir.Scale(1/len); + end else + if not (plNoStartCap in options) and (linecap = pecRound) and (i=0) and not (plCycle in options) then + AddRoundCap(pts[0], -dir ,true); + + borders[i].len := len; + borders[i].leftDir := PointF(dir.y*hw,-dir.x*hw); + borders[i].leftSide.origin := pts[i] + borders[i].leftDir; + borders[i].leftSide.dir := dir; + borders[i].rightSide.origin := pts[i] - borders[i].leftDir; + borders[i].rightSide.dir := dir; + IncF(linePos, len); + end; + + //first points + AddPt( pts[0] + borders[0].leftDir, + pts[0] - borders[0].leftDir ); + + setlength(joinLeft,1); + setlength(joinRight,1); + ShouldFlushLine := False; + //between first and last points + for i := 0 to high(pts)-2 do + begin + HasLittleBorder := false; + + //determine u-turn + turn := borders[i].leftSide.dir * borders[i+1].leftSide.dir; + if turn < -0.99999 then + begin + if joinstyle <> pjsRound then + begin + littleBorder.origin := pts[i+1] + borders[i].leftSide.dir*maxMiter; + littleBorder.dir := borders[i].leftDir; + HasLittleBorder := true; + nbJoinLeft := 0; + nbJoinRight:= 0; + ShouldFlushLine := True; + end else + begin + pt1 := pts[i+1] + borders[i].leftDir; + pt2 := pts[i+1] + borders[i].leftSide.dir*hw; + SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); + pt1 := pts[i+1] - borders[i].leftDir; + SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); + AddJoin(-1); + FlushLine(-1); + nbJoinLeft := 0; + nbJoinRight:= 0; + AddPt(pts[i+1]+borders[i+1].leftDir, + pts[i+1]-borders[i+1].leftDir); + end; + end else + if turn > 0.99999 then //straight line + begin + pt1 := pts[i+1] + borders[i].leftDir; + pt2 := pts[i+2] + borders[i+1].leftDir; + SetJoinLeft([pt1, (pt1+pt2)*(1/2),pt2]); + + pt1 := pts[i+1] - borders[i].leftDir; + pt2 := pts[i+2] - borders[i+1].leftDir; + SetJoinRight([pt1,(pt1+pt2)*(1/2),pt2]); + end else + begin + //determine turning left or right + turn := borders[i].leftSide.dir.x*borders[i+1].leftSide.dir.y - borders[i].leftSide.dir.y*borders[i+1].leftSide.dir.x; + + maxDiff := borders[i].len; + if borders[i+1].len < maxDiff then + maxDiff := borders[i+1].len; + if penstyle <> nil then + if maxDiff > 2*width then maxDiff := 2*width; + maxDiff := sqrt(sqr(maxDiff)+sqr(hw)); + + //leftside join + leftInter := IntersectLine( borders[i].leftSide, borders[i+1].leftSide ); + diff := leftInter-pts[i+1]; + len := sqrt(diff*diff); + if (len > maxMiter) and (turn >= 0) then //if miter too far + begin + diff.Scale(1/len); + if joinstyle <> pjsRound then + begin + //compute little border + littleBorder.origin := pts[i+1]+diff*maxMiter; + littleBorder.dir := PointF(diff.y,-diff.x); + HasLittleBorder := true; + + //intersect with each border + pt1 := IntersectLine(borders[i].leftSide, littleBorder); + pt2 := IntersectLine(borders[i+1].leftSide, littleBorder); + SetJoinLeft( [pt1, pt2] ); + end else + begin + //perpendicular + pt1 := PointF(pts[i+1].x+borders[i].leftSide.dir.y*hw, + pts[i+1].y-borders[i].leftSide.dir.x*hw); + pt2 := PointF(pts[i+1].x+borders[i+1].leftSide.dir.y*hw, + pts[i+1].y-borders[i+1].leftSide.dir.x*hw); + SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); + end; + end else + if (len > maxDiff) and (turn <= 0) then //if inner intersection too far + begin + ShouldFlushLine := True; + nbJoinLeft := 0; + end else + begin + if (turn > 0) and (len > 1.0001*hw) then + SetJoinLeft([leftInter,leftInter]) else + begin + nbJoinLeft := 1; + joinLeft[0] := leftInter; + end; + end; + + //rightside join + rightInter := IntersectLine( borders[i].rightSide, borders[i+1].rightSide ); + diff := rightInter-pts[i+1]; + len := VectLen(diff); + if (len > maxMiter) and (turn <= 0) then //if miter too far + begin + diff.Scale(1/len); + + if joinstyle <> pjsRound then + begin + //compute little border + littleBorder.origin := pts[i+1] + diff*maxMiter; + littleBorder.dir := PointF(diff.y, -diff.x); + HasLittleBorder := true; + + //intersect with each border + pt1 := IntersectLine(borders[i].rightSide, littleBorder); + pt2 := IntersectLine(borders[i+1].rightSide, littleBorder); + SetJoinRight( [pt1, pt2] ); + end else + begin + //perpendicular + pt1 := PointF(pts[i+1].x-borders[i].rightSide.dir.y*hw, + pts[i+1].y+borders[i].rightSide.dir.x*hw); + pt2 := PointF(pts[i+1].x-borders[i+1].rightSide.dir.y*hw, + pts[i+1].y+borders[i+1].rightSide.dir.x*hw); + SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); + end; + end else + if (len > maxDiff) and (turn >= 0) then //if inner intersection too far + begin + ShouldFlushLine := True; + nbJoinRight := 0; + end else + begin + if (turn < 0) and (len > 1.0001*hw) then + SetJoinRight([rightInter,rightInter]) else + begin + nbJoinRight := 1; + joinRight[0] := rightInter; + end; + end; + end; + + if ShouldFlushLine then + begin + NormalRestart := True; + if HasLittleBorder then + begin + if turn >= 0 then + begin + //intersect with each border + pt1 := IntersectLine(borders[i].leftSide, littleBorder); + pt2 := IntersectLine(borders[i+1].leftSide, littleBorder); + pt3 := pts[i+1] - borders[i].leftDir; + pt4 := pts[i+1] + borders[i].leftDir; + + AddPt(pt4,pt3); + AddPt(pt1,pt2); + end else + begin + //intersect with each border + pt1 := IntersectLine(borders[i+1].rightSide, littleBorder); + pt2 := IntersectLine(borders[i].rightSide, littleBorder); + pt3 := pts[i+1] + borders[i].leftDir; + pt4 := pts[i+1] - borders[i].leftDir; + + AddPt(pt3,pt4); + AddPt(pt1,pt2); + end; + + FlushLine(-1); + + AddPt(pt2,pt1); + end else + if joinstyle = pjsRound then + begin + + if {(penstyle= nil) and} (turn > 0) then + begin + pt1 := pts[i+1] + borders[i].leftDir; + pt2 := pts[i+1] + borders[i+1].leftDir; + pt3 := pts[i+1] - borders[i].leftDir; + pt4 := pts[i+1]; + + SetJoinLeft([pt1,pt1]); + SetJoinRight([pt3,pt4]); + AddJoin(-1); + + SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); + nbJoinRight := 1; + joinRight[0] := pt4; + AddJoin(-1); + FlushLine(-1); + end else + if {(penstyle= nil) and} (turn < 0) then + begin + pt1 := pts[i+1] - borders[i].leftDir; + pt2 := pts[i+1] - borders[i+1].leftDir; + pt3 := pts[i+1] + borders[i].leftDir; + pt4 := pts[i+1]; + + SetJoinRight([pt1,pt1]); + SetJoinLeft([pt3,pt4]); + AddJoin(-1); + + SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); + nbJoinLeft := 1; + joinLeft[0] := pt4; + AddJoin(-1); + FlushLine(-1); + end else + if (nbCompPts > 1) and (nbRevCompPts > 1) then + begin + pt1 := pts[i+1]+borders[i].leftDir; + pt2 := pts[i+1]-borders[i].leftDir; + AddPt( pt1, pt2 ); + FlushLine(-1); + end else + begin + FlushLine(i+1); + end; + end else + begin + FlushLine(i+1); + if turn > 0 then + AddPt( leftInter, pts[i+1]+borders[i].leftDir ) else + if turn < 0 then + AddPt( pts[i+1] - borders[i].leftDir, rightInter ); + end; + + If NormalRestart then + AddPt(pts[i+1]+borders[i+1].leftDir, + pts[i+1]-borders[i+1].leftDir); + + ShouldFlushLine := false; + end else + AddJoin(i); + end; + + if plCycle in options then + CycleFlush + else + FlushLine(high(pts)); + + FinalizeArray; +end; + +function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; + width: single; pencolor: TBGRAPixel; linecap: TPenEndCap; + joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; + options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF; + +var + results: array of array of TPointF; + nbResults,nbTotalPts: integer; + + procedure AddWidePolyline(startIndex,endIndexP1: integer); + var + tempWidePolyline: array of TPointF; + subPts: array of TPointF; + j : integer; + begin + if endIndexP1 > startIndex then + begin + setlength(subPts,endIndexP1-startIndex); + for j := startIndex to endIndexP1-1 do + subPts[j-startIndex] := linepts[j]; + tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow); + if length(results) = nbresults then + setlength(results,(nbresults+1)*2); + results[nbResults] := tempWidePolyline; + if nbResults <> 0 then inc(nbTotalPts); + inc(nbResults); + inc(nbTotalPts,length(tempWidePolyline)); + end; + end; + +var + start,i,j: integer; + +begin + start := 0; + nbResults := 0; + nbTotalPts := 0; + for i := 0 to high(linepts) do + if isEmptyPointF(linepts[i]) then + begin + AddWidePolyline(start,i); + start := i+1; + end; + AddWidePolyline(start,length(linepts)); + + setlength(result, nbTotalPts); + start := 0; + for i := 0 to nbResults-1 do + begin + if i <> 0 then + begin + result[start] := EmptyPointF; + inc(start); + end; + for j := 0 to high(results[i]) do + begin + result[start] := results[i][j]; + inc(start); + end; + end; +end; + +{ TBGRAPenStroker } + +function TBGRAPenStroker.GetArrow: TBGRACustomArrow; +begin + result := FArrow; +end; + +function TBGRAPenStroker.GetArrowOwned: boolean; +begin + result := FArrowOwned; +end; + +function TBGRAPenStroker.GetCustomPenStyle: TBGRAPenStyle; +begin + result := DuplicatePenStyle(FCustomPenStyle); +end; + +function TBGRAPenStroker.GetJoinStyle: TPenJoinStyle; +begin + result := FJoinStyle; +end; + +function TBGRAPenStroker.GetLineCap: TPenEndCap; +begin + result := FLineCap; +end; + +function TBGRAPenStroker.GetMiterLimit: single; +begin + result := FMiterLimit; +end; + +function TBGRAPenStroker.GetPenStyle: TPenStyle; +begin + result := FPenStyle; +end; + +function TBGRAPenStroker.GetStrokeMatrix: TAffineMatrix; +begin + result := FOriginalStrokeMatrix; +end; + +procedure TBGRAPenStroker.SetArrow(AValue: TBGRACustomArrow); +begin + FArrow := AValue; +end; + +procedure TBGRAPenStroker.SetArrowOwned(AValue: boolean); +begin + FArrowOwned := AValue; +end; + +procedure TBGRAPenStroker.SetCustomPenStyle(AValue: TBGRAPenStyle); +begin + if PenStyleEqual(FCustomPenStyle,AValue) then Exit; + FCustomPenStyle:= DuplicatePenStyle(AValue); + FPenStyle:= BGRAToPenStyle(AValue); +end; + +procedure TBGRAPenStroker.SetJoinStyle(AValue: TPenJoinStyle); +begin + FJoinStyle:= AValue; +end; + +procedure TBGRAPenStroker.SetLineCap(AValue: TPenEndCap); +begin + FLineCap:= AValue; +end; + +procedure TBGRAPenStroker.SetMiterLimit(AValue: single); +begin + FMiterLimit := AValue; +end; + +procedure TBGRAPenStroker.SetStrokeMatrix(const AValue: TAffineMatrix); +begin + if FOriginalStrokeMatrix=AValue then Exit; + FOriginalStrokeMatrix:=AValue; + FStrokeMatrix := AValue; + FStrokeMatrix[1,3] := 0; + FStrokeMatrix[2,3] := 0; + FStrokeZoom := max(VectLen(PointF(FStrokeMatrix[1,1],FStrokeMatrix[2,1])), + VectLen(PointF(FStrokeMatrix[1,2],FStrokeMatrix[2,2]))); + if FStrokeZoom > 0 then + FStrokeMatrix := FStrokeMatrix * AffineMatrixScale(1/FStrokeZoom,1/FStrokeZoom); + if IsAffineMatrixInversible(FStrokeMatrix) then + FStrokeMatrixInverse := AffineMatrixInverse(FStrokeMatrix) + else + begin + FStrokeMatrixInverse := AffineMatrixIdentity; + FStrokeMatrix := AffineMatrixIdentity; + end; + FStrokeMatrixIdentity := IsAffineMatrixIdentity(FStrokeMatrix); +end; + +procedure TBGRAPenStroker.SetPenStyle(AValue: TPenStyle); +begin + if (FPenStyle=AValue) or (AValue=psPattern) then Exit; + FCustomPenStyle := PenStyleToBGRA(AValue); + FPenStyle := AValue; +end; + +constructor TBGRAPenStroker.Create; +begin + Style := psSolid; + LineCap := pecRound; + JoinStyle := pjsBevel; + MiterLimit := 2; + fillchar(FOriginalStrokeMatrix,sizeof(FOriginalStrokeMatrix),0); + StrokeMatrix := AffineMatrixIdentity; +end; + +destructor TBGRAPenStroker.Destroy; +begin + if ArrowOwned then FreeAndNil(FArrow); + inherited Destroy; +end; + +function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF; + AWidth: single; AClosedCap: boolean): ArrayOfTPointF; +var + c: TBGRAPixel; +begin + if not AClosedCap then + c := BGRAWhite //needed for alpha junction + else + c := BGRAPixelTransparent; + + if FStrokeMatrixIdentity then + result := ComputePolyline(APoints,AWidth*FStrokeZoom,c,AClosedCap) + else + result := FStrokeMatrix*ComputePolyline(FStrokeMatrixInverse*APoints,AWidth*FStrokeZoom,c,AClosedCap); +end; + +function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF; + AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean): ArrayOfTPointF; +var options: TBGRAPolyLineOptions; +begin + options := []; + if Assigned(Arrow) and Arrow.IsStartDefined then include(options, plNoStartCap); + if Assigned(Arrow) and Arrow.IsEndDefined then include(options, plNoEndCap); + if not AClosedCap then include(options, plRoundCapOpen); + if FStrokeMatrixIdentity then + result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) + else + result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow); +end; + +function TBGRAPenStroker.ComputePolylineAutocycle( + const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; +var options: TBGRAPolyLineOptions; +begin + options := [plAutoCycle]; + if Assigned(Arrow) and Arrow.IsStartDefined then include(options, plNoStartCap); + if Assigned(Arrow) and Arrow.IsEndDefined then include(options, plNoEndCap); + if FStrokeMatrixIdentity then + result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) + else + result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) +end; + +function TBGRAPenStroker.ComputePolygon(const APoints: array of TPointF; + AWidth: single): ArrayOfTPointF; +begin + if FStrokeMatrixIdentity then + result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit) + else + result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit); +end; + +initialization + + //special pen styles + SolidPenStyle := nil; + + setlength(ClearPenStyle,1); + ClearPenStyle[0] := 0; + + DashPenStyle := BGRAPenStyle(3,1); + DotPenStyle := BGRAPenStyle(1,1); + DashDotPenStyle := BGRAPenStyle(3,1,1,1); + DashDotDotPenStyle := BGRAPenStyle(3,1,1,1,1,1); + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraphongtypes.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraphongtypes.pas new file mode 100644 index 0000000..e5e86ea --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraphongtypes.pas @@ -0,0 +1,85 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPhongTypes; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes; + +type + +{ TCustomPhongShading } + + TCustomPhongShading = class + protected + FLightPosition3D: TPoint3D; + function GetLightPosition: TPoint; + procedure SetLightPosition(AValue: TPoint); + function GetLightPositionF: TPointF; + procedure SetLightPositionF(AValue: TPointF); + function GetLightPositionZ: integer; + procedure SetLightPositionZ(AValue: integer); + + public + + { Render the specified map on the destination bitmap with one solid color. Map altitude + indicate the global height of the map. } + procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + Color : TBGRAPixel); overload; virtual; abstract; + + { Render with a color map of the same size as the height map. Map altitude + indicate the global height of the map. } + procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorMap : TBGRACustomBitmap); overload; virtual; abstract; + + { Render with a scanner. Map altitude + indicate the global height of the map. } + procedure DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; + ColorScan : IBGRAScanner); virtual; abstract; + + property LightPosition: TPoint read GetLightPosition write SetLightPosition; + property LightPositionZ: integer read GetLightPositionZ write SetLightPositionZ; + property LightPositionF: TPointF read GetLightPositionF write SetLightPositionF; + property LightPosition3D: TPoint3D read FLightPosition3D write FLightPosition3D; + end; + +implementation + +{ TCustomPhongShading } + +function TCustomPhongShading.GetLightPositionF: TPointF; +begin + result := PointF(FLightPosition3D.X,FLightPosition3D.Y); +end; + +procedure TCustomPhongShading.SetLightPositionF(AValue: TPointF); +begin + FLightPosition3D.X := AValue.X; + FLightPosition3D.Y := AValue.Y; +end; + +function TCustomPhongShading.GetLightPosition: TPoint; +begin + result := Point(round(FLightPosition3D.X),round(FLightPosition3D.Y)); +end; + +procedure TCustomPhongShading.SetLightPosition(AValue: TPoint); +begin + FLightPosition3D.X := AValue.X; + FLightPosition3D.Y := AValue.Y; +end; + +function TCustomPhongShading.GetLightPositionZ: integer; +begin + result := round(FLightPosition3D.Z); +end; + +procedure TCustomPhongShading.SetLightPositionZ(AValue: integer); +begin + FLightPosition3D.Z := AValue; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraphoxo.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraphoxo.pas new file mode 100644 index 0000000..b9a51f7 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraphoxo.pas @@ -0,0 +1,602 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPhoxo; + +{$mode objfpc}{$H+} + +interface + +uses + BGRABitmapTypes, FPImage, BGRALayers, BGRABitmap, BGRAClasses, SysUtils, BMPcomn; + +const + PhoxoHeaderMagic : packed array[1..4] of char = 'oXo '; + PhoxoBlock_CanvasSize = 1; + PhoxoBlock_Layer = 2; + PhoxoBlock_TextLayer = 3; + PhoxoBlock_DPI = 4; + PhoxoBlock_LayerCaption = 5; + PhoxoBlock_LazPaintBlendMode = 128; + PhoxoBlock_EndOfFile = 255; + +type + TPhoxoHeader = packed record + magic: packed array[1..4] of char; + version: LongWord; + end; + + TPhoxoBlockHeader = packed record + blockType : LongWord; + blockSize : LongWord; + end; + + TPhoxoLayerHeader = packed record + layerVisible: LongWord; + layerLimited: LongWord; + opacityPercent: LongWord; + bmpHeader: TBitMapInfoHeader; + redMask,greenMask,blueMask: LongWord; + end; + + { TBGRAPhoxoDocument } + + TBGRAPhoxoDocument = class(TBGRALayeredBitmap) + private + FDPIX,FDPIY: integer; + protected + function GetMimeType: string; override; + procedure AddLayerFromPhoxoData(const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte); + procedure InternalLoadFromStream(AStream: TStream); + procedure InternalSaveToStream(AStream: TStream); + public + constructor Create; overload; override; + constructor Create(AWidth, AHeight: integer); overload; override; + procedure LoadFromStream(AStream: TStream); override; + procedure LoadFromFile(const filenameUTF8: string); override; + procedure SaveToStream(AStream: TStream); override; + procedure SaveToFile(const filenameUTF8: string); override; + class function CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean; static; + class function ReadBlock(Stream: TStream; out AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean; static; + property DPIX: integer read FDPIX; + property DPIY: integer read FDPIY; + end; + + { TBGRAReaderOXO } + + TBGRAReaderOXO = class(TFPCustomImageReader) + private + FWidth,FHeight,FNbLayers: integer; + FDPIX,FDPIY: integer; + protected + function InternalCheck(Stream: TStream): boolean; override; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + public + property Width: integer read FWidth; + property Height: integer read FHeight; + property NbLayers: integer read FNbLayers; + property DPIX: integer read FDPIX; + property DPIY: integer read FDPIY; + end; + + { TBGRAWriterOXO } + + TBGRAWriterOXO = class(TFPCustomImageWriter) + protected + procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override; + end; + +procedure RegisterPhoxoFormat; + +implementation + +uses BGRAUTF8; + +var AlreadyRegistered: boolean; + +function ComputeRowStride(AWidth,ABitsPerPixel: Longword): Longword; +begin + result := ((AWidth * ABitsPerPixel + 31) div 32)*4; +end; + +procedure SwapLayerHeaderIfNeeded(var ALayerHeader: TPhoxoLayerHeader); +begin + with ALayerHeader do + begin + layerVisible := LEtoN(layerVisible); + layerLimited := LEtoN(layerLimited); + opacityPercent := LEtoN(opacityPercent); + {$IFNDEF ENDIAN_LITTLE}SwapBMPInfoHeader(bmpHeader);{$ENDIF} + end; +end; + +procedure RegisterPhoxoFormat; +begin + if AlreadyRegistered then exit; + ImageHandlers.RegisterImageReader ('PhoXo', 'oXo', TBGRAReaderOXO); + RegisterLayeredBitmapReader('oXo', TBGRAPhoxoDocument); + RegisterLayeredBitmapWriter('oXo', TBGRAPhoxoDocument); + DefaultBGRAImageReader[ifPhoxo] := TBGRAReaderOXO; + DefaultBGRAImageWriter[ifPhoxo] := TBGRAWriterOXO; + AlreadyRegistered:= True; +end; + +{ TBGRAWriterOXO } + +procedure TBGRAWriterOXO.InternalWrite(Str: TStream; Img: TFPCustomImage); +var doc: TBGRAPhoxoDocument; + tempBmp: TBGRABitmap; + x,y: integer; +begin + doc := TBGRAPhoxoDocument.Create; + if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else + begin + tempBmp := TBGRABitmap.Create(img.Width,img.Height); + for y := 0 to Img.Height-1 do + for x := 0 to img.Width-1 do + tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y])); + doc.AddOwnedLayer(tempBmp); + end; + doc.SaveToStream(Str); + doc.Free; +end; + +{ TBGRAReaderOXO } + +function TBGRAReaderOXO.InternalCheck(Stream: TStream): boolean; +begin + result := TBGRAPhoxoDocument.CheckFormat(Stream,True); +end; + +procedure TBGRAReaderOXO.InternalRead(Stream: TStream; Img: TFPCustomImage); +var layeredImage: TBGRAPhoxoDocument; + flat: TBGRABitmap; + x,y: integer; +begin + FWidth := 0; + FHeight:= 0; + FNbLayers:= 0; + FDPIX := 0; + FDPIY := 0; + layeredImage := TBGRAPhoxoDocument.Create; + try + layeredImage.LoadFromStream(Stream); + flat := layeredImage.ComputeFlatImage; + try + FWidth:= layeredImage.Width; + FHeight:= layeredImage.Height; + FNbLayers:= layeredImage.NbLayers; + FDPIX := layeredImage.DPIX; + FDPIY := layeredImage.DPIY; + if Img is TBGRACustomBitmap then + TBGRACustomBitmap(img).Assign(flat) + else + begin + Img.SetSize(flat.Width,flat.Height); + for y := 0 to flat.Height-1 do + for x := 0 to flat.Width-1 do + Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); + end; + finally + flat.free; + end; + finally + layeredImage.Free; + end; +end; + +{ TBGRAPhoxoDocument } + +function TBGRAPhoxoDocument.GetMimeType: string; +begin + Result:= 'image/phoxo'; +end; + +procedure TBGRAPhoxoDocument.AddLayerFromPhoxoData( + const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte); +var + layerHeader: TPhoxoLayerHeader; + rawImageSize: LongWord; + rowStride: LongWord; + remaining: LongWord; + bmp: TBGRABitmap; + layerIndex,y,x: integer; + pSrc: PByte; + pDest: PBGRAPixel; +begin + remaining := ABlockHeader.blockSize; + if remaining < sizeof(TPhoxoLayerHeader) then raise EFormatError.Create('Block too small'); + move(ABlockData^, {%H-}layerHeader, sizeof(layerHeader)); + inc(ABlockData, sizeof(layerHeader)); + dec(remaining, sizeof(layerHeader)); + SwapLayerHeaderIfNeeded(layerHeader); + + if layerHeader.bmpHeader.Compression <> BI_RGB then raise EFormatError.Create('Compression not supported'); + if (layerHeader.bmpHeader.Width < 0) or (layerHeader.bmpHeader.Height < 0) then + raise EFormatError.Create('Invalid image size'); + if int64(layerHeader.bmpHeader.Width)*layerHeader.bmpHeader.Height > maxLongint div 4 then + raise EOutOfMemory.Create('Image too big'); + rowStride := ComputeRowStride(layerHeader.bmpHeader.Width,layerHeader.bmpHeader.BitCount); + rawImageSize := rowStride * layerHeader.bmpHeader.Height; + + if rawImageSize > remaining then + raise EFormatError.Create('Invalid image size'); + + bmp := TBGRABitmap.Create(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.Height); + layerIndex := AddOwnedLayer(bmp, (layerHeader.opacityPercent*255 + 50) div 100); + LayerVisible[layerIndex] := (layerHeader.layerVisible = 1); + + case layerHeader.bmpHeader.BitCount of + 8: begin + for y := bmp.Height-1 downto 0 do + begin + pSrc := ABlockData + (bmp.Height-1 - y)*rowStride; + pDest := bmp.ScanLine[y]; + for x := bmp.Width-1 downto 0 do + begin + pDest^ := BGRA(pSrc^,pSrc^,pSrc^); + inc(pDest); + inc(pSrc,3); + end; + end; + end; + 24: begin + for y := bmp.Height-1 downto 0 do + begin + pSrc := ABlockData + (bmp.Height-1 - y)*rowStride; + pDest := bmp.ScanLine[y]; + for x := bmp.Width-1 downto 0 do + begin + pDest^ := BGRA((pSrc+2)^,(pSrc+1)^,pSrc^); + inc(pDest); + inc(pSrc,3); + end; + end; + end; + 32: begin + move(ABlockData^, bmp.Data^, sizeof(TBGRAPixel)*bmp.NbPixels); + if bmp.LineOrder = riloTopToBottom then bmp.VerticalFlip; + if TBGRAPixel_RGBAOrder then bmp.SwapRedBlue; + end; + else + raise EFormatError.Create('Unsupported bit depth'); + end; + + inc(ABlockData, rawImageSize); + dec(remaining, rawImageSize); + if remaining >= 8 then + begin + LayerOffset[layerIndex] := Point(LEtoN(PLongInt(ABlockData)^),LEtoN((PLongInt(ABlockData)+1)^)); + inc(ABlockData, 8); + dec(remaining, 8); + end; +end; + +constructor TBGRAPhoxoDocument.Create; +begin + inherited Create; + RegisterPhoxoFormat; +end; + +constructor TBGRAPhoxoDocument.Create(AWidth, AHeight: integer); +begin + inherited Create(AWidth, AHeight); + RegisterPhoxoFormat; +end; + +procedure TBGRAPhoxoDocument.LoadFromStream(AStream: TStream); +begin + OnLayeredBitmapLoadFromStreamStart; + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + end; +end; + +procedure TBGRAPhoxoDocument.InternalLoadFromStream(AStream: TStream); +var blockHeader: TPhoxoBlockHeader; + blockData: PByte; + wCaption: widestring; + i: Integer; +begin + if not CheckFormat(AStream,False) then + raise EFormatError.Create('File header is invalid'); + Clear; + FDPIX := 0; + FDPIY := 0; + blockData := nil; + repeat + if not ReadBlock(AStream, blockHeader,blockData) then + begin + if NbLayers = 0 then + raise EFormatError.Create('Error reading block from file') + else + break; + end; + try + case blockHeader.blockType of + PhoxoBlock_CanvasSize: + begin + if blockHeader.blockSize < 8 then raise EFormatError.Create('Block too small'); + SetSize(LEtoN(PLongWord(blockData)^),LEtoN((PLongWord(blockData)+1)^)); + end; + PhoxoBlock_DPI: + begin + if blockHeader.blockSize >= 8 then + begin + FDPIX := LEtoN(PLongWord(blockData)^); + FDPIY := LEtoN((PLongWord(blockData)+1)^); + end; + end; + PhoxoBlock_Layer, PhoxoBlock_TextLayer: + AddLayerFromPhoxoData(blockHeader,blockData); + PhoxoBlock_LayerCaption: + begin + if (blockHeader.blockSize >= 2) and (NbLayers > 0) then + begin + setlength(wCaption, blockHeader.blockSize div 2); + for i := 1 to length(wCaption) do + Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^); + if wCaption[1] = #1 then Delete(wCaption,1,1); + LayerName[NbLayers-1] := UTF8Encode(wCaption); + + end; + end; + PhoxoBlock_LazPaintBlendMode: + begin + if (blockHeader.blockSize >= 2) and (NbLayers > 0) then + begin + setlength(wCaption, blockHeader.blockSize div 2); + for i := 1 to length(wCaption) do + Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^); + BlendOperation[NbLayers-1] := StrToBlendOperation(UTF8Encode(wCaption)); + end; + end; + end; + finally + FreeMem(blockData); + end; + until blockHeader.blockType = PhoxoBlock_EndOfFile; +end; + +procedure TBGRAPhoxoDocument.LoadFromFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); + OnLayeredBitmapLoadStart(filenameUTF8); + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + AStream.Free; + end; +end; + +procedure TBGRAPhoxoDocument.SaveToStream(AStream: TStream); +begin + OnLayeredBitmapSaveToStreamStart; + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + end; +end; + +procedure TBGRAPhoxoDocument.SaveToFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite); + OnLayeredBitmapSaveStart(filenameUTF8); + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + AStream.Free; + end; +end; + +procedure TBGRAPhoxoDocument.InternalSaveToStream(AStream: TStream); + + procedure WriteFileHeader; + var fileHeader: TPhoxoHeader; + begin + fileHeader.magic := PhoxoHeaderMagic; + fileHeader.version := 1; + fileHeader.version := NtoLE(fileHeader.version); + AStream.WriteBuffer(fileHeader, sizeof(fileHeader)); + end; + + procedure WriteBlockHeader(blockType: LongWord; blockSize: LongWord); + var blockHeader: TPhoxoBlockHeader; + begin + blockHeader.blockType := NtoLE(blockType); + blockHeader.blockSize := NtoLE(blockSize); + AStream.WriteBuffer(blockHeader, sizeof(blockHeader)); + end; + + procedure WriteLongInt(value: longint); + begin + value := NtoLE(value); + AStream.WriteBuffer(value, sizeof(value)); + end; + + procedure WriteLayer(index: integer); + var wCaption: widestring; + pCaption: PWord; + + layerHeader: TPhoxoLayerHeader; + rowStride: LongWord; + + temp,pdest: PByte; + i,x,y: integer; + psrc: PBGRAPixel; + begin + if LayerVisible[index] then + layerHeader.layerVisible := 1 + else + layerHeader.layerVisible := 0; + layerHeader.layerLimited:= 0; + layerHeader.opacityPercent := (LayerOpacity[index]*100 + 127) div 255; + with layerHeader.bmpHeader do + begin + Size := $28; + Width := self.LayerBitmap[index].Width; + Height := self.LayerBitmap[index].Height; + Planes := 1; + BitCount := 32; //24-bit does not seem to be supported + Compression := BI_RGB; + SizeImage := 0; + XPelsPerMeter := 0; + YPelsPerMeter := 0; + ClrUsed := 0; + ClrImportant := 0; + end; + layerHeader.redMask := 0; + layerHeader.greenMask := 0; + layerHeader.blueMask := 0; + + rowStride := ComputeRowStride(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.BitCount); + + WriteBlockHeader(PhoxoBlock_Layer, sizeof(layerHeader) + rowStride*layerHeader.bmpHeader.Height + sizeof(TPoint)); + SwapLayerHeaderIfNeeded(layerHeader); + AStream.WriteBuffer(layerHeader,sizeof(layerHeader)); + SwapLayerHeaderIfNeeded(layerHeader); + + case layerHeader.bmpHeader.BitCount of + 32: begin + if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue; + for y := self.LayerBitmap[index].Height-1 downto 0 do + AStream.WriteBuffer(self.LayerBitmap[index].ScanLine[y]^, rowStride); + if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue; + end; + 24: begin + GetMem(temp, rowStride); + fillchar(temp^, rowStride, 0); + try + for y := self.LayerBitmap[index].Height-1 downto 0 do + begin + psrc := self.LayerBitmap[index].ScanLine[y]; + pdest := temp; + for x := self.LayerBitmap[index].Width-1 downto 0 do + begin + pdest^ := psrc^.blue; inc(pdest); + pdest^ := psrc^.green; inc(pdest); + pdest^ := psrc^.red; inc(pdest); + inc(psrc); + end; + AStream.WriteBuffer(temp^, rowstride); + end; + finally + FreeMem(temp); + end; + end + else + raise exception.Create('Internal error'); + end; + + WriteLongInt(LayerOffset[index].X); + WriteLongInt(LayerOffset[index].Y); + + if LayerName[index]<>'' then + begin + wCaption := UTF8ToUTF16(LayerName[index]); + WriteBlockHeader(PhoxoBlock_LayerCaption, length(wCaption)*2); + getmem(pCaption, length(wCaption)*2); + try + for i := 1 to length(wCaption) do + (pCaption+i-1)^ := NtoLE(Word(wCaption[i])); + AStream.WriteBuffer(pCaption^, length(wCaption)*2); + finally + freemem(pCaption); + end; + end; + + if BlendOperation[index] <> boTransparent then + begin + wCaption := UTF8ToUTF16(BlendOperationStr[BlendOperation[index]]); + WriteBlockHeader(PhoxoBlock_LazPaintBlendMode, length(wCaption)*2); + getmem(pCaption, length(wCaption)*2); + try + for i := 1 to length(wCaption) do + (pCaption+i-1)^ := NtoLE(Word(wCaption[i])); + AStream.WriteBuffer(pCaption^, length(wCaption)*2); + finally + freemem(pCaption); + end; + end; + end; + +var + i: Integer; +begin + WriteFileHeader; + + WriteBlockHeader(PhoxoBlock_CanvasSize, 8); + WriteLongInt(Width); + WriteLongInt(Height); + + if (DPIX <> 0) and (DPIY <> 0) then + begin + WriteBlockHeader(PhoxoBlock_DPI, 8); + WriteLongInt(DPIX); + WriteLongInt(DPIY); + end; + + for i := 0 to NbLayers-1 do + begin + OnLayeredBitmapSaveProgress(round(i*100/NbLayers)); + WriteLayer(i); + end; + OnLayeredBitmapSaveProgress(100); + + WriteBlockHeader(PhoxoBlock_EndOfFile,0); +end; + +class function TBGRAPhoxoDocument.CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean; +var header: TPhoxoHeader; + oldPos: int64; +begin + oldPos := Stream.Position; + if Stream.Read({%H-}header,sizeof(header))<>sizeof(header) then + result := false else + begin + header.version:= LEtoN(header.version); + if (header.magic <> PhoxoHeaderMagic) or (header.version <> 1) then + result := false + else + result := true; + end; + if ARestorePosition then Stream.Position:= oldPos; +end; + +class function TBGRAPhoxoDocument.ReadBlock(Stream: TStream; out + AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean; +begin + ABlockData := nil; + if Stream.Read({%H-}AHeader,sizeof(AHeader)) <> sizeof(AHeader) then + begin + AHeader.blockType := 0; + AHeader.blockSize := 0; + result := false; + exit; + end; + AHeader.blockType := LEtoN(AHeader.blockType); + AHeader.blockSize := LEtoN(AHeader.blockSize); + if Stream.Position + AHeader.blockSize > Stream.Size then + begin + AHeader.blockSize := 0; + result := false; + exit; + end; + GetMem(ABlockData, AHeader.blockSize); + if Stream.Read(ABlockData^, AHeader.blockSize) <> AHeader.blockSize then + begin + FreeMem(ABlockData); + AHeader.blockSize := 0; + result := false; + exit; + end; + result := true; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapixel.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrapixel.inc new file mode 100644 index 0000000..82a48f6 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapixel.inc @@ -0,0 +1,744 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{=== Pixel types and functions ===} + +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + {* Pointer for direct pixel access. Data is stored as a sequence of ''TBGRAPixel''. + See [[BGRABitmap tutorial 4]] } + PBGRAPixel = ^TBGRAPixel; + + {$IFNDEF BGRABITMAP_BGRAPIXEL} + {$IFDEF BGRABITMAP_USE_LCL} + {$IFDEF LCLgtk} + {$DEFINE BGRABITMAP_RGBAPIXEL} + {$ENDIF} + {$IFDEF LCLgtk2} + {$DEFINE BGRABITMAP_RGBAPIXEL} + {$ENDIF} + {$IFDEF DARWIN} + {$IFNDEF LCLQt} + {$DEFINE BGRABITMAP_RGBAPIXEL} + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$ENDIF} + + {* Each pixel is a sequence of 4 bytes containing blue, green, red and alpha channel. + Values range from 0 to 255, color is in sRGB colorspace. The alpha value of 0 + is transparent and 255 is opaque. In the bitmap data, when the pixel is fully transparent, + the RGB values are supposed to be set to zero. } + + { TBGRAPixel } + + TBGRAPixel = packed record + private + function GetClassIntensity: word; + function GetClassLightness: word; + procedure SetClassIntensity(AValue: word); + procedure SetClassLightness(AValue: word); + public + {$IFDEF BGRABITMAP_RGBAPIXEL} + red, green, blue, alpha: byte; + {$ELSE} + blue, green, red, alpha: byte; + {$ENDIF} + procedure FromRGB(ARed,AGreen,ABlue: Byte; AAlpha: Byte = 255); + procedure FromColor(AColor: TColor; AAlpha: Byte = 255); + procedure FromString(AStr: string); + procedure FromFPColor(AColor: TFPColor); + procedure ToRGB(out ARed,AGreen,ABlue,AAlpha: Byte); overload; + procedure ToRGB(out ARed,AGreen,ABlue: Byte); overload; + function ToColor: TColor; + function ToString: string; + function ToGrayscale(AGammaCorrection: boolean = true): TBGRAPixel; + function ToFPColor: TFPColor; + function EqualsExactly(constref AColor: TBGRAPixel): boolean; + class Operator := (Source: TBGRAPixel): TColor; + class Operator := (Source: TColor): TBGRAPixel; + property Intensity: word read GetClassIntensity write SetClassIntensity; + property Lightness: word read GetClassLightness write SetClassLightness; + end; + TBGRAPixelBuffer = packed array of TBGRAPixel; + +procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer); + +const + {$IFDEF BGRABITMAP_RGBAPIXEL} + TBGRAPixel_RGBAOrder = True; + TBGRAPixel_RedByteOffset = 0; + TBGRAPixel_GreenByteOffset = 1; + TBGRAPixel_BlueByteOffset = 2; + {$ELSE} + TBGRAPixel_RGBAOrder = False; + TBGRAPixel_BlueByteOffset = 0; + TBGRAPixel_GreenByteOffset = 1; + TBGRAPixel_RedByteOffset = 2; + {$ENDIF} + TBGRAPixel_AlphaByteOffset = 3; + {$IFDEF ENDIAN_LITTLE} + TBGRAPixel_RedShift = TBGRAPixel_RedByteOffset*8; + TBGRAPixel_GreenShift = TBGRAPixel_GreenByteOffset*8; + TBGRAPixel_BlueShift = TBGRAPixel_BlueByteOffset*8; + TBGRAPixel_AlphaShift = TBGRAPixel_AlphaByteOffset*8; + {$ELSE} + TBGRAPixel_RedShift = 24 - TBGRAPixel_RedByteOffset*8; + TBGRAPixel_GreenShift = 24 - TBGRAPixel_GreenByteOffset*8; + TBGRAPixel_BlueShift = 24 - TBGRAPixel_BlueByteOffset*8; + TBGRAPixel_AlphaShift = 24 - TBGRAPixel_AlphaByteOffset*8; + {$ENDIF} + + {** Creates a pixel with given RGBA values } + function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline; + {** Creates a opaque pixel with given RGB values } + function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline; + {** Checks if two pixels are equal. If they are both transparent, + RGB values are ignored } + operator = (const c1, c2: TBGRAPixel): boolean; inline; + {** Returns the intensity of a pixel. The intensity is the + maximum value reached by any component } + function GetIntensity(c: TBGRAPixel): word; inline; + {** Sets the intensity of a pixel } + function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel; + {** Returns the lightness of a pixel. The lightness is the + perceived brightness, 0 being black and 65535 being white } + function GetLightness(c: TBGRAPixel): word; overload; + {** Sets the lightness of a pixel } + function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel; overload; + {** Sets the lightness quickly, by fading towards black if ''lightness'' is + less than 32768, and fading towards white if ''lightness'' is more + than 32768 } + function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline; + {** Sets the intensity quickly, by fading towards black if ''lightness'' is + less than 32768, and multiplying all components if ''lightness'' is more + than 32768. In case of saturation, it fades towards white } + function ApplyIntensityFast(color: TBGRAPixel; lightness: LongWord): TBGRAPixel; + {** Combines two lightnesses together. A value of 32768 is neutral. The + result may exceed 65535 } + function CombineLightness(lightness1,lightness2: Int32or64): Int32or64; + {** Converts a color into grayscale } + function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel; + function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel; + {** Create a gray color with the given ''lightness'' } + function GrayscaleToBGRA(lightness: word): TBGRAPixel; + {** Merge two colors without gamma correction } + function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload; + {** Merge two colors without gamma correction. ''weight1'' and ''weight2'' + indicates the weight of the color barycentre } + function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload; + {** Merge two colors with gamma correction. ''weight1'' and ''weight2'' + indicates the weight of the color barycentre } + function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; weight2: byte): TBGRAPixel; + {** Converts a ''TColor'' value into an opaque pixel } + function ColorToBGRA(color: TColor): TBGRAPixel; overload; + {** Converts a ''TColor'' value into a pixel with given ''opacity'' } + function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload; + {** Converts a pixel into a TColor value, discarding the alpha value } + function BGRAToColor(c: TBGRAPixel): TColor; + function FastRoundDiv257(valueWord: LongWord): byte; inline; + {** Converts a ''TFPColor'' value into a pixel. Note that even if + ''TFPColor'' have 16-bit values, they are not considered as + gamma expanded } + function FPColorToBGRA(AValue: TFPColor): TBGRAPixel; + {** Converts a pixel into a ''TFPColor'' } + function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline; + function Color16BitToBGRA(AColor: Word): TBGRAPixel; + function BGRAToColor16Bit(const AColor: TBGRAPixel): Word; + {** Computes the difference (with gamma correction) between two pixels, + taking into account all dimensions, including transparency. The + result ranges from 0 to 65535 } + function BGRAWordDiff(c1, c2: TBGRAPixel): word; + {** Computes the difference (with gamma correction) between two pixels, + taking into account all dimensions, including transparency. The + result ranges from 0 to 255 } + function BGRADiff(c1, c2: TBGRAPixel): byte; + function FastBGRALinearDiff(c1,c2: TBGRAPixel): byte; + function FastBGRAExpandedDiff(c1,c2: TBGRAPixel): word; + +type + {* Array of pixels } + ArrayOfTBGRAPixel = array of TBGRAPixel; + {** Merge given colors without gamma correction } + function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; overload; + +{ Get height [0..1] stored in a TBGRAPixel } +function MapHeight(Color: TBGRAPixel): Single; + +{ Get TBGRAPixel to store height [0..1] } +function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel; + +type + {* Possible modes when drawing a pixel over another one } + TDrawMode = ( + {** The pixel is replaced } + dmSet, + {** The pixel is replaced if the pixel over has an alpha value of 255 } + dmSetExceptTransparent, + {** The pixel is blend over the other one according to alpha values, + however no gamma correction is applied. In other words, the color + space is assumed to be linear } + dmLinearBlend, + {** The pixel is blend over the other one according to alpha values, + and a gamma correction is applied. In other word, the color + space is assumed to be sRGB } + dmDrawWithTransparency, + {** Values of all channels are combined with Xor. This is useful to + compute the binary difference, however it is not something that makes + much sense to display on the screen } + dmXor); + +const + {** An alias for the linear blend, because it is faster than blending + with gamma correction } + dmFastBlend = dmLinearBlend; + +type + {* Advanced blending modes. See [http://www.brighthub.com/multimedia/photography/articles/18301.aspx Paint.NET blend modes] + and [http://www.pegtop.net/delphi/articles/blendmodes/ Formulas]. Blending layers has two steps. The first one is + to apply the blend operations listed below, and the second is the actual merging of the colors } + TBlendOperation = ( + {** Simple blend, except that it forces a linear merge so it is equivalent to ''dmLinearBlend'' } + boLinearBlend, + {** Simple blend. It is equivalent to ''dmLinearBlend'' or ''dmDrawWithTransparency'' } + boTransparent, + {** Lighting blend modes (tends to increase the luminosity) } + boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boDivide, boNiceGlow, boSoftLight, boHardLight, + {** Masking blend modes (tends to decrease the luminosity) } + boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn, + {** Difference blend modes } + boDifference, boLinearDifference, boExclusion, boLinearExclusion, boSubtract, boLinearSubtract, boSubtractInverse, boLinearSubtractInverse, + {** Negation blend modes } + boNegation, boLinearNegation, + {** Xor blend mode. It is sightly different from ''dmXor'' because the alpha value is used like in other blends modes } + boXor, + {** SVG implementation of soft light **} + boSvgSoftLight, + {** Apply mask **} + boMask, + {** Standard HSL colorspace } + boLinearMultiplySaturation, boLinearHue, boLinearColor, boLinearLightness, boLinearSaturation, + {** Corrected HSL colorspace (GSB) } + boCorrectedHue, boCorrectedColor, boCorrectedLightness, boCorrectedSaturation + ); + +const + {** Alias to glow that express that this blend mode masks the part where the top layer is black } + boGlowMask = boGlow; + {** Alias because linear or non linear multiply modes are identical } + boLinearMultiply = boMultiply; + {** Alias to express that dark overlay is simply an overlay with gamma correction } + boNonLinearOverlay = boDarkOverlay; + +const + {** String constants for blend modes } + BlendOperationStr : array[TBlendOperation] of string + = ('LinearBlend', 'Transparent', + 'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'Divide', 'NiceGlow', 'SoftLight', 'HardLight', + 'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn', + 'Difference', 'LinearDifference', 'Exclusion', 'LinearExclusion', 'Subtract', 'LinearSubtract', 'SubtractInverse', 'LinearSubtractInverse', + 'Negation', 'LinearNegation', 'Xor', 'SvgSoftLight', 'Mask', 'LinearMultiplySaturation', + 'LinearHue', 'LinearColor', 'LinearLightness', 'LinearSaturation', + 'CorrectedHue', 'CorrectedColor', 'CorrectedLightness', 'CorrectedSaturation'); + + {** Returns the blend mode expressed by the string } + function StrToBlendOperation(str: string): TBlendOperation; + +type + {* Specifies how a palette handles the alpha channel } + TAlphaChannelPaletteOption = ( + {** The alpha channel is ignored. The alpha channel is considered to be stored elsewhere } + acIgnore, + {** One entry is allocated the fully transparent color } + acTransparentEntry, + {** The alpha channel is fully embedded in the palette so that a color is identified by its four RGBA channels } + acFullChannelInPalette); + + {* Dithering algorithms that specifies how to handle colors that are not found in the palette } + TDitheringAlgorithm = ( + {** The nearest color is to be used instead } + daNearestNeighbor, + {** The nearest color may be used however another color may be used to compensate for the error, + following Floyd-Steinberg algorithm } + daFloydSteinberg); + +{$DEFINE INCLUDE_INTERFACE} +{$i basiccolorspace.inc} + +{$DEFINE INCLUDE_INTERFACE} +{$i extendedcolorspace.inc} + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$i basiccolorspace.inc} + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$i extendedcolorspace.inc} + +function StrToBlendOperation(str: string): TBlendOperation; +var op: TBlendOperation; +begin + result := boTransparent; + str := LowerCase(str); + for op := low(TBlendOperation) to high(TBlendOperation) do + if str = LowerCase(BlendOperationStr[op]) then + begin + result := op; + exit; + end; +end; + +{************************** Color functions **************************} + +procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer); +begin + if ASize > length(ABuffer) then + setlength(ABuffer, max(length(ABuffer)*2,ASize)); +end; + +function BGRA(red, green, blue, alpha: byte): TBGRAPixel; +begin + LongWord(result) := (red shl TBGRAPixel_RedShift) or + (green shl TBGRAPixel_GreenShift) or + (blue shl TBGRAPixel_BlueShift) or + (alpha shl TBGRAPixel_AlphaShift); +end; + +function BGRA(red, green, blue: byte): TBGRAPixel; overload; +begin + LongWord(result) := (red shl TBGRAPixel_RedShift) or + (green shl TBGRAPixel_GreenShift) or + (blue shl TBGRAPixel_BlueShift) or + (255 shl TBGRAPixel_AlphaShift); +end; + +operator = (const c1, c2: TBGRAPixel): boolean; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + Result := True + else + Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and + (c1.green = c2.green) and (c1.blue = c2.blue); +end; + +function GetIntensity(c: TBGRAPixel): word; +begin + Result := c.red; + if c.green > Result then + Result := c.green; + if c.blue > Result then + Result := c.blue; + result := GammaExpansionTab[Result]; +end; + +function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel; +begin + result := GammaCompression(SetIntensity(GammaExpansion(c),intensity)); +end; + +function GetLightness(c: TBGRAPixel): word; +begin + result := GetLightness(GammaExpansion(c)); +end; + +function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel; +begin + result := GammaCompression(SetLightness(GammaExpansion(c),lightness)); +end; + +function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; +var + r,g,b: word; + lightness256: byte; +begin + if lightness <= 32768 then + begin + if lightness = 32768 then + result := color else + begin + lightness256 := GammaCompressionTab[lightness shl 1]; + result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8, + color.blue * lightness256 shr 8, color.alpha); + end; + end else + begin + if lightness = 65535 then + result := BGRA(255,255,255,color.alpha) else + begin + dec(lightness, 32767); + r := GammaExpansionTab[color.red]; + g := GammaExpansionTab[color.green]; + b := GammaExpansionTab[color.blue]; + result := BGRA(GammaCompressionTab[ r + (not r)*lightness shr 15 ], + GammaCompressionTab[ g + (not g)*lightness shr 15 ], + GammaCompressionTab[ b + (not b)*lightness shr 15 ], + color.alpha); + end; + end; +end; + +function ApplyIntensityFast(color: TBGRAPixel; lightness: LongWord): TBGRAPixel; +var + maxValue,invMaxValue,r,g,b: LongWord; + lightness256: byte; +begin + if lightness <= 32768 then + begin + if lightness = 32768 then + result := color else + begin + lightness256 := GammaCompressionTab[lightness shl 1]; + result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8, + color.blue * lightness256 shr 8, color.alpha); + end; + end else + begin + r := CombineLightness(GammaExpansionTab[color.red], lightness); + g := CombineLightness(GammaExpansionTab[color.green], lightness); + b := CombineLightness(GammaExpansionTab[color.blue], lightness); + maxValue := r; + if g > maxValue then maxValue := g; + if b > maxValue then maxValue := b; + if maxValue <= 65535 then + result := BGRA(GammaCompressionTab[r], + GammaCompressionTab[g], + GammaCompressionTab[b], + color.alpha) + else + begin + invMaxValue := (LongWord(2147483647)+LongWord(maxValue-1)) div maxValue; + maxValue := (maxValue-65535) shr 1; + r := r*invMaxValue shr 15 + maxValue; + g := g*invMaxValue shr 15 + maxValue; + b := b*invMaxValue shr 15 + maxValue; + if r >= 65535 then result.red := 255 else + result.red := GammaCompressionTab[r]; + if g >= 65535 then result.green := 255 else + result.green := GammaCompressionTab[g]; + if b >= 65535 then result.blue := 255 else + result.blue := GammaCompressionTab[b]; + result.alpha := color.alpha; + end; + end; +end; + +function CombineLightness(lightness1,lightness2: Int32or64): Int32or64; +{$ifdef CPUI386} {$asmmode intel} assembler; + asm + imul edx + shl edx, 17 + shr eax, 15 + or edx, eax + mov result, edx + end; +{$ELSE} +begin + if (lightness1 < 0) xor (lightness2 < 0) then + result := -(int64(-lightness1)*lightness2 shr 15) + else + result := int64(lightness1)*lightness2 shr 15; +end; +{$ENDIF} + +// Conversion to grayscale by taking into account +// different color weights +function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel; +var + ec: TExpandedPixel; + gray: word; + cgray: byte; +begin + if c.alpha = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + //gamma expansion + ec := GammaExpansion(c); + //gray composition + gray := (ec.red * redWeightShl10 + ec.green * greenWeightShl10 + + ec.blue * blueWeightShl10 + 512) shr 10; + //gamma compression + cgray := GammaCompressionTab[gray]; + Result.red := cgray; + Result.green := cgray; + Result.blue := cgray; + Result.alpha := c.alpha; +end; + +function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel; +var + gray: byte; +begin + if c.alpha = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + //gray composition + gray := (c.red * redWeightShl10 + c.green * greenWeightShl10 + + c.blue * blueWeightShl10 + 512) shr 10; + //gamma compression + Result.red := gray; + Result.green := gray; + Result.blue := gray; + Result.alpha := c.alpha; +end; + +function GrayscaleToBGRA(lightness: word): TBGRAPixel; +begin + result.red := GammaCompressionTab[lightness]; + result.green := result.red; + result.blue := result.red; + result.alpha := $ff; +end; + +{ Merge linearly two colors of same importance } +function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; +var c12: LongWord; +begin + if (c1.alpha = 0) then + Result := c2 + else + if (c2.alpha = 0) then + Result := c1 + else + begin + c12 := c1.alpha + c2.alpha; + Result.red := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12; + Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12; + Result.blue := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12; + Result.alpha := (c12 + 1) shr 1; + end; +end; + +function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; + weight2: integer): TBGRAPixel; +var + f1,f2,f12: int64; +begin + if (weight1 = 0) or (c1.alpha = 0) then + begin + if (weight2 = 0) or (c2.alpha = 0) then + result := BGRAPixelTransparent + else + Result := c2 + end + else + if (weight2 = 0) or (c2.alpha = 0) then + Result := c1 + else + if (weight1+weight2 = 0) then + Result := BGRAPixelTransparent + else + begin + f1 := int64(c1.alpha)*weight1; + f2 := int64(c2.alpha)*weight2; + f12 := f1+f2; + if f12 = 0 then + result := BGRAPixelTransparent + else + begin + Result.red := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12; + Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12; + Result.blue := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12; + {$hints off} + Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2); + {$hints on} + end; + end; +end; + +function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; + weight2: byte): TBGRAPixel; +var + w1,w2,f1,f2,f12,a: UInt32or64; +begin + w1 := weight1; + w2 := weight2; + if (w1 = 0) or (c1.alpha = 0) then + begin + if (w2 = 0) or (c2.alpha = 0) then + result := BGRAPixelTransparent + else + Result := c2 + end + else + if (w2 = 0) or (c2.alpha = 0) then + Result := c1 + else + begin + f1 := c1.alpha*w1; + f2 := c2.alpha*w2; + a := (f1+f2 + ((w1+w2) shr 1)) div (w1+w2); + if a = 0 then + begin + result := BGRAPixelTransparent; + exit; + end else + Result.alpha := a; + {$IFNDEF CPU64} + if (f1 >= 32768) or (f2 >= 32768) then + begin + f1 := f1 shr 1; + f2 := f2 shr 1; + end; + {$ENDIF} + f12 := f1+f2; + Result.red := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12]; + Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12]; + Result.blue := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12]; + end; +end; + +{ Convert a TColor value to a TBGRAPixel value } +{$PUSH}{$R-} +function ColorToBGRA(color: TColor): TBGRAPixel; overload; +begin + if (color < 0) or (color > $ffffff) then color := ColorToRGB(color); + RedGreenBlue(color, Result.red,Result.green,Result.blue); + Result.alpha := 255; +end; + +function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload; +begin + if (color < 0) or (color > $ffffff) then color := ColorToRGB(color); + RedGreenBlue(color, Result.red,Result.green,Result.blue); + Result.alpha := opacity; +end; +{$POP} + +function BGRAToColor(c: TBGRAPixel): TColor; +begin + Result := RGBToColor(c.red, c.green, c.blue); +end; + +function FastRoundDiv257(valueWord: LongWord): byte; inline; +begin + result := LongWord(valueWord + 127 - (valueWord shr 8)) shr 8; +end; + +{ Conversion from TFPColor to TBGRAPixel assuming TFPColor + is already gamma compressed } +function FPColorToBGRA(AValue: TFPColor): TBGRAPixel; +begin + with AValue do + Result := BGRA(FastRoundDiv257(red), FastRoundDiv257(green), FastRoundDiv257(blue), alpha shr 8); +end; + +function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline; +begin + result.red := AValue.red shl 8 + AValue.red; + result.green := AValue.green shl 8 + AValue.green; + result.blue := AValue.blue shl 8 + AValue.blue; + result.alpha := AValue.alpha shl 8 + AValue.alpha; +end; + +function Color16BitToBGRA(AColor: Word): TBGRAPixel; +begin + result := BGRA( ((AColor and $F800) shr 11)*255 div 31, + ((AColor and $07e0) shr 5)*255 div 63, + (AColor and $001f)*255 div 31 ); +end; + +function BGRAToColor16Bit(const AColor: TBGRAPixel): Word; +begin + result := (((AColor.Red * 31 + 64) div 255) shl 11) + + (((AColor.green * 63 + 64) div 255) shl 5) + + ((AColor.blue * 31 + 64) div 255); +end; + +function BGRAWordDiff(c1, c2: TBGRAPixel): word; +begin + if c1 = c2 then result := 0 + else result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)); +end; + +function BGRADiff(c1,c2: TBGRAPixel): byte; +begin + if c1 = c2 then result := 0 + else result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8; +end; + +function FastBGRALinearDiff(c1, c2: TBGRAPixel): byte; +begin + result := max(min((abs(c1.red-c2.red)+(abs(c1.green-c2.green) shl 1)+abs(c1.blue-c2.blue)) shr 2, + min(c1.alpha,c2.alpha)), abs(c1.alpha-c2.alpha)); +end; + +function FastBGRAExpandedDiff(c1, c2: TBGRAPixel): word; +var wa1,wa2: word; +begin + wa1 := c1.alpha shl 8 + c1.alpha; + wa2 := (c2.alpha shl 8) + c2.alpha; + result := max(min((abs(GammaExpansionTab[c1.red]-GammaExpansionTab[c2.red])+ + (abs(GammaExpansionTab[c1.green]-GammaExpansionTab[c2.green]) shl 1)+ + abs(GammaExpansionTab[c1.blue]-GammaExpansionTab[c2.blue])) shr 2, + min(wa1,wa2)), + abs(wa1-wa2)); +end; + +function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; +var + sumR,sumG,sumB,sumA: UInt32or64; + i: integer; +begin + if length(colors)<=0 then + begin + result := BGRAPixelTransparent; + exit; + end; + sumR := 0; + sumG := 0; + sumB := 0; + sumA := 0; + for i := 0 to high(colors) do + with colors[i] do + begin + inc(sumR, red*alpha); + inc(sumG, green*alpha); + inc(sumB, blue*alpha); + inc(sumA, alpha); + end; + if sumA > 0 then + begin + result.red := (sumR + sumA shr 1) div sumA; + result.green := (sumG + sumA shr 1) div sumA; + result.blue := (sumB + sumA shr 1) div sumA; + result.alpha := sumA div LongWord(length(colors)); + end + else + result := BGRAPixelTransparent; +end; + +function MapHeight(Color: TBGRAPixel): Single; +var intval: integer; +begin + intval := color.Green shl 16 + color.red shl 8 + color.blue; + result := intval*5.960464832810452e-8; +end; + +function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel; +var intval: integer; +begin + if Height >= 1 then result := BGRA(255,255,255,alpha) else + if Height <= 0 then result := BGRA(0,0,0,alpha) else + begin + intval := round(Height*16777215); + {$PUSH}{$R-} + result := BGRA(intval shr 8,intval shr 16,intval,alpha); + {$POP} + end; +end; +{$ENDIF} + +{$IFDEF INCLUDE_INIT} +{$UNDEF INCLUDE_INIT} + BGRASetGamma(); + + {$DEFINE INCLUDE_INITIALIZATION} + {$i extendedcolorspace.inc} +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygon.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygon.pas new file mode 100644 index 0000000..7833465 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygon.pas @@ -0,0 +1,1585 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPolygon; + +{$mode objfpc}{$H+} + +{ This unit contains polygon drawing functions and spline functions. + + Shapes are drawn using a TBGRACustomFillInfo object, which calculates the + intersection of an horizontal line and the polygon. + + Various shapes are handled : + - TFillPolyInfo : polygon scanned in any order + - TSimpleFillPolyInfo : polygon with few points + - TOnePassFillPolyInfo : polygon scanned from top to bottom + - TFillEllipseInfo : ellipse + - TFillBorderEllipseInfo : ellipse border + - TFillRoundRectangleInfo : round rectangle (or other corners) + - TFillBorderRoundRectInfo : round rectangle border + + Various fill modes : + - Alternate : each time there is an intersection, it enters or go out of the polygon + - Winding : filled when the sum of ascending and descending intersection is non zero + - Color : fill with a color defined as a TBGRAPixel argument + - Erase : erase with an alpha in the TBGRAPixel argument + - Texture : draws a texture with the IBGRAScanner argument + + Various border handling : + - aliased : one horizontal line intersection is calculated per pixel in the vertical loop + - antialiased : more lines are calculated and a density is computed by adding them together + - multi-polygon antialiasing and superposition (TBGRAMultiShapeFiller) : same as above but + by combining multiple polygons at the same time, and optionally subtracting top polygons + } + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAFillInfo, BGRAPath; + +procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false); +procedure FillShapeAliased(bmp: TCustomUniversalBitmap; shapeInfo: TBGRACustomFillInfo; + brush: TUniversalBrush; Alpha: Word; NonZeroWinding: boolean; AliasingIncludeBottomRight: Boolean= false); +procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF; + c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); +procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; const points: array of TPointF; + scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); +procedure FillPolyAliased(bmp: TCustomUniversalBitmap; const points: array of TPointF; + brush: TUniversalBrush; Alpha: Word; NonZeroWinding: boolean; APixelCenteredCoordinates: boolean = true); + +procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); +procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode); +procedure FillShapeAntialias(bmp: TCustomUniversalBitmap; shapeInfo: TBGRACustomFillInfo; + brush: TUniversalBrush; NonZeroWinding: boolean); +procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); +procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF; + c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); +procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; const points: array of TPointF; + scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); +procedure FillPolyAntialias(bmp: TCustomUniversalBitmap; const points: array of TPointF; + brush: TUniversalBrush; NonZeroWinding: boolean; APixelCenteredCoordinates: boolean = true); + +type + + { TBGRAMultishapeFiller } + + TBGRAMultishapeFiller = class + protected + nbShapes: integer; + shapes: array of record + info: TBGRACustomFillInfo; + internalInfo: boolean; + texture: IBGRAScanner; + internalTexture: TObject; + color: TExpandedPixel; + bounds: TRect; + fillMode: TFillMode; + fillModeOverride: boolean; + end; + function AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer; overload; + function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean; + procedure InternalAddStroke(const APoints: array of TPointF; AClosed: boolean; AData: Pointer); + public + FillMode : TFillMode; + PolygonOrder: TPolygonOrder; + Antialiasing: Boolean; + AliasingIncludeBottomRight: Boolean; + constructor Create; + destructor Destroy; override; + function AddShape(AShape: TBGRACustomFillInfo; AColor: TBGRAPixel): integer; overload; + function AddShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner): integer; overload; + function AddPolygon(const points: array of TPointF; AColor: TBGRAPixel): integer; overload; + function AddPolygon(const points: array of TPointF; ATexture: IBGRAScanner): integer; overload; + procedure AddPathStroke(APath: TBGRAPath; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload; + procedure AddPathStroke(APath: TBGRAPath; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload; + procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload; + procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload; + function AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer; overload; + function AddPathFill(APath: TBGRAPath; ATexture: IBGRAScanner): integer; overload; + function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer; overload; + function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer; overload; + function AddPolylineStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; + function AddPolylineStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; + function AddPolygonStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; + function AddPolygonStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; + function AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2, c3: TBGRAPixel): integer; + function AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer; + procedure AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, c2, c3, c4: TBGRAPixel); + procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, {%H-}tex3, tex4: TPointF; + ACulling: TFaceCulling = fcNone); + procedure AddQuadPerspectiveMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); + function AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel): integer; overload; + function AddEllipse(x, y, rx, ry: single; ATexture: IBGRAScanner): integer; overload; + function AddEllipseBorder(x, y, rx, ry, w: single; AColor: TBGRAPixel): integer; overload; + function AddEllipseBorder(x, y, rx, ry, w: single; ATexture: IBGRAScanner): integer; overload; + function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload; + function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload; + function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload; + function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload; + function AddRectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel): integer; overload; + function AddRectangle(x1, y1, x2, y2: single; ATexture: IBGRAScanner): integer; overload; + function AddRectangleBorder(x1, y1, x2, y2, w: single; AColor: TBGRAPixel): integer; overload; + function AddRectangleBorder(x1, y1, x2, y2, w: single; ATexture: IBGRAScanner): integer; overload; + procedure OverrideFillMode(AShapeIndex: integer; AFillMode: TFillMode); + procedure Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency); + property ShapeCount: integer read nbShapes; + end; + +procedure FillEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry: single; ABrush: TUniversalBrush); +procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single; + c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false); +procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry: single; + scan: IBGRAScanner; LinearBlend: boolean = false); + +procedure BorderEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; ABrush: TUniversalBrush); +procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false); +procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + scan: IBGRAScanner; LinearBlend: boolean = false); + +procedure BorderEllipse(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; ABrush: TUniversalBrush; AAlpha: word = 65535); +procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode); +procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + scan: IBGRAScanner; drawmode: TDrawMode); + +procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single; + options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); +procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single; + options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); + +procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; + options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); +procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; + options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); + +procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; + options: TRoundRectangleOptions; bordercolor,fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean = true); + +implementation + +uses Math, BGRABlend, BGRAGradientScanner, BGRATransform; + +procedure AnyBrush(out ABrush: TUniversalBrush; ABmp: TBGRACustomBitmap; ACol: TBGRAPixel; + AEraseMode: boolean; AScan: IBGRAScanner; ADrawmode: TDrawMode); +begin + if AScan <> nil then + ABmp.ScannerBrush(ABrush, AScan, ADrawmode) + else + begin + if AEraseMode then ABmp.EraseBrush(ABrush, ACol.alpha + (ACol.alpha shl 8)) + else ABmp.SolidBrush(ABrush, ACol, ADrawmode);; + end; +end; + +procedure AnyBrush(out ABrush: TUniversalBrush; ABmp: TBGRACustomBitmap; ACol: TBGRAPixel; + AEraseMode: boolean; AScan: IBGRAScanner; ALinearBlend: boolean); +begin + if ALinearBlend then AnyBrush(ABrush,ABmp,ACol,AEraseMode,AScan,dmLinearBlend) + else AnyBrush(ABrush,ABmp,ACol,AEraseMode,AScan,dmDrawWithTransparency); +end; + +procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false); +var + bFill: TUniversalBrush; +begin + AnyBrush(bFill, bmp, c,EraseMode,scan,drawmode); + FillShapeAliased(bmp, shapeInfo, bFill,65535,NonZeroWinding,AliasingIncludeBottomRight); +end; + +procedure FillShapeAliased(bmp: TCustomUniversalBitmap; + shapeInfo: TBGRACustomFillInfo; brush: TUniversalBrush; Alpha: Word; + NonZeroWinding: boolean; AliasingIncludeBottomRight: Boolean); +var + inter: array of TIntersectionInfo; + nbInter: integer; + + miny, maxy, minx, maxx: integer; + yb, i: integer; + x1, x2: single; + ix1, ix2: integer; + pdest: PByte; + AliasingOfs: TPointF; + ctx: TUniBrushContext; + +begin + if brush.DoesNothing or (Alpha=0) then exit; + If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp.ClipRect) then exit; + inter := shapeInfo.CreateIntersectionArray; + + if AliasingIncludeBottomRight then + AliasingOfs := PointF(0.0001, 0.0001) else + AliasingOfs := PointF(0,0); + bmp.LoadFromBitmapIfNeeded; + + //vertical scan + for yb := miny to maxy do + begin + //find intersections + shapeInfo.ComputeAndSort( yb+0.5-AliasingOfs.Y, inter, nbInter, NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX+AliasingOfs.X; + x2 := inter[i + i+ 1].interX+AliasingOfs.X; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + begin + //render scanline + pdest := bmp.GetPixelAddress(ix1,yb); + brush.MoveTo(@ctx, pdest, ix1,yb); + brush.PutNextPixels(@ctx, Alpha, ix2-ix1+1); + end; + end; + end; + end; + + shapeInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; +end; + +procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF; + c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp, c,EraseMode,nil,drawmode); + FillPolyAliased(bmp, points, b, 65535, NonZeroWinding, APixelCenteredCoordinates); +end; + +procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; + const points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp, BGRAPixelTransparent,false,scan,drawmode); + FillPolyAliased(bmp, points, b, 65535, NonZeroWinding, APixelCenteredCoordinates); +end; + +procedure FillPolyAliased(bmp: TCustomUniversalBitmap; + const points: array of TPointF; brush: TUniversalBrush; Alpha: Word; + NonZeroWinding: boolean; APixelCenteredCoordinates: boolean); +var + info: TCustomFillPolyInfo; +begin + if brush.DoesNothing or (length(points) < 3) then exit; + if length(points)<=10 then + info := TSimpleFillPolyInfo.Create(points, APixelCenteredCoordinates) + else + info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates); + FillShapeAliased(bmp, info, brush, Alpha, NonZeroWinding); + info.Free; +end; + +////////////////////////////////////////////////////////////////////////////// + +procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; + c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); +var + drawMode: TDrawMode; +begin + if LinearBlend then drawMode := dmLinearBlend else drawMode := dmDrawWithTransparency; + FillShapeAntialias(bmp, shapeInfo, c, EraseMode, scan, NonZeroWinding, drawmode); +end; + +procedure FillShapeAntialias(bmp: TBGRACustomBitmap; + shapeInfo: TBGRACustomFillInfo; c: TBGRAPixel; EraseMode: boolean; + scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode); +var + bFill: TUniversalBrush; +begin + AnyBrush(bFill, bmp, c,EraseMode,scan,drawmode); + FillShapeAntialias(bmp, shapeInfo, bFill,NonZeroWinding); +end; + +procedure FillShapeAntialias(bmp: TCustomUniversalBitmap; + shapeInfo: TBGRACustomFillInfo; brush: TUniversalBrush; + NonZeroWinding: boolean); +const oneOver512 = 1/512; +var + inter: array of TIntersectionInfo; + nbInter: integer; + + firstScan, lastScan: record + inter: array of TIntersectionInfo; + nbInter: integer; + sliceIndex: integer; + end; + + miny, maxy, minx, maxx, + densMinX, densMaxX: integer; + joinDensity, nextJoinDensity: boolean; + + density: PDensity; + + xb, yb, yc, i: integer; + tempDensity: UInt32or64; + + x1, x2, x1b,x2b: single; + ix1, ix2, drawCount: integer; + pdens: PDensity; + + curvedSeg,optimised: boolean; + temp: Single; + pDest: PByte; + ctx: TUniBrushContext; + + function GetYScan(num: integer): single; inline; + begin + result := yb + (num * 2 + 1) / (AntialiasPrecision * 2); + end; + + procedure SubTriangleDensity(x1,density1, x2, density2: single); + var ix1,ix2,n: integer; + slope: single; + function densityAt(x: single): single; inline; + begin + result := (x-x1)*slope+density1; + end; + var + curdens: single; + pdens: pdensity; + newvalue: Int32or64; + begin + if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then + begin + slope := (density2-density1)/(x2-x1); + if x1 < minx then + begin + density1 := densityAt(minx); + x1 := minx; + end; + if x2 >= maxx + 1 then + begin + density2 := densityAt(maxx+1); + x2 := maxx + 1; + end; + ix1 := floor(x1); + ix2 := floor(x2); + + if ix1 = ix2 then + begin + newValue := (density + (ix1 - minx))^ - round((x2 - x1)*(density1+density2)/2); + if newValue < 0 then newValue := 0; + if newValue > 256 then newValue := 256; + (density + (ix1 - minx))^ := newValue + end + else + begin + newValue := (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) ; + if newValue < 0 then newValue := 0; + if newValue > 256 then newValue := 256; + (density + (ix1 - minx))^ := newValue; + if (ix2 <= maxx) then + begin + newValue := (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2); + if newValue < 0 then newValue := 0; + if newValue > 256 then newValue := 256; + (density + (ix2 - minx))^ := newValue; + end; + end; + if ix2 > ix1 + 1 then + begin + curdens := densityAt(ix1+1.5); + pdens := density + (ix1+1 - minx); + for n := ix2-1-(ix1+1) downto 0 do + begin + newValue := pdens^ - round(curdens); + if newValue < 0 then newValue := 0; + if newValue > 256 then newValue := 256; + pdens^ := newValue; + IncF(curdens, slope); + inc(pdens); + end; + end; + end; + end; + +begin + If brush.DoesNothing or not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp.ClipRect) then exit; + bmp.LoadFromBitmapIfNeeded; + + inter := shapeInfo.CreateIntersectionArray; + getmem(density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety + + curvedSeg := shapeInfo.SegmentsCurved; + if not curvedSeg then + begin + firstScan.inter := shapeInfo.CreateIntersectionArray; + lastScan.inter := shapeInfo.CreateIntersectionArray; + end; + + //vertical scan + for yb := miny to maxy do + begin + //mean density + fillchar(density^,(maxx-minx+1)*sizeof(TDensity),0); + + densMinX := maxx+1; + densMaxX := minx-1; + + if not curvedSeg then + begin + with firstScan do + begin + shapeInfo.ComputeAndSort(yb+1/256,inter,nbInter,NonZeroWinding); + sliceIndex:= shapeInfo.GetSliceIndex; + end; + with lastScan do + begin + shapeInfo.ComputeAndSort(yb+255/256,inter,nbInter,NonZeroWinding); + sliceIndex:= shapeInfo.GetSliceIndex; + end; + if (firstScan.sliceIndex = lastScan.sliceIndex) and (firstScan.nbInter = lastScan.nbInter) then + begin + optimised := true; + for i := 0 to firstScan.nbInter-1 do + if firstScan.inter[i].numSegment <> lastScan.inter[i].numSegment then + begin + optimised := false; + break; + end; + end else + optimised := false; + + if optimised then + begin + nextJoinDensity := false; + for i := 0 to firstScan.nbinter div 2 - 1 do + begin + joinDensity := nextJoinDensity; + x1 := firstScan.inter[i+i].interX; + x1b := lastScan.inter[i+i].interX; + x2 := firstScan.inter[i+i+1].interX; + x2b := lastScan.inter[i+i+1].interX; + nextJoinDensity := not ((i+i+2 >= firstScan.nbInter) or + ((firstScan.inter[i+i+2].interX >= x2+1) and + (lastScan.inter[i+i+2].interX >= x2b+1))); + if (abs(x1-x1b)= maxx+1 then + begin + x2 := maxx+1; + ix2 := maxx; + end else + ix2 := floor(x2); + if ix2 > maxx then ix2 := maxx; + + if ix1>ix2 then continue; + pDest := bmp.GetPixelAddress(ix1,yb); + brush.MoveTo(@ctx,pDest,ix1,yb); + if ix1=ix2 then + begin + tempDensity:= round((x2-x1)*65535); + brush.PutNextPixels(@ctx,tempDensity,1); + end else + begin + tempDensity:= round((ix1+1-x1)*65535); + brush.PutNextPixels(@ctx,tempDensity,1); + inc(ix1); + + tempDensity:= round((x2-ix2)*65535); + if tempDensity < 65535 then + begin + dec(ix2); + if ix2 >= ix1 then brush.PutNextPixels(@ctx,65535,ix2-ix1+1); + brush.PutNextPixels(@ctx,tempDensity,1); + end else + brush.PutNextPixels(@ctx,65535,ix2-ix1+1); + end; + continue; + end else + begin + if (x1 > x1b) then + begin + temp := x1; + x1 := x1b; + x1b := temp; + end; + if (x2 < x2b) then + begin + temp := x2; + x2 := x2b; + x2b := temp; + end; + + {$DEFINE INCLUDE_FILLDENSITY} + {$DEFINE PARAM_SINGLESEGMENT} + {$i density256.inc} + SubTriangleDensity(x1,256,x1b,0); + SubTriangleDensity(x2b,0,x2,256); + end; + end; + end else + begin + for yc := 0 to AntialiasPrecision - 1 do + begin + //find intersections + shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding); + + {$DEFINE INCLUDE_FILLDENSITY} + {$i density256.inc} + end; + end; + end else + begin + optimised := false; + //precision scan + for yc := 0 to AntialiasPrecision - 1 do + begin + //find intersections + shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding); + + {$DEFINE INCLUDE_FILLDENSITY} + {$i density256.inc} + end; + end; + + if optimised then + {$DEFINE INCLUDE_RENDERDENSITY} + {$i density256.inc} + else + {$DEFINE INCLUDE_RENDERDENSITY} + {$define PARAM_ANTIALIASINGFACTOR} + {$i density256.inc} + end; + + shapeInfo.FreeIntersectionArray(inter); + + if not curvedSeg then + begin + with firstScan do + begin + for i := 0 to high(inter) do + inter[i].free; + end; + with lastScan do + begin + for i := 0 to high(inter) do + inter[i].free; + end; + end; + freemem(density); + + bmp.InvalidateBitmap; +end; + +procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; + shapeInfo: TBGRACustomFillInfo; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean); +begin + FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding,LinearBlend); +end; + +procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF; + c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); + FillPolyAntialias(bmp, points, b, NonZeroWinding, APixelCenteredCoordinates); +end; + +procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; + const points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp,BGRAPixelTransparent,false,scan,LinearBlend); + FillPolyAntialias(bmp, points, b, NonZeroWinding, APixelCenteredCoordinates); +end; + +procedure FillPolyAntialias(bmp: TCustomUniversalBitmap; + const points: array of TPointF; brush: TUniversalBrush; + NonZeroWinding: boolean; APixelCenteredCoordinates: boolean); +var + info: TCustomFillPolyInfo; +begin + if brush.DoesNothing or (length(points) < 3) then exit; + info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates); + FillShapeAntialias(bmp, info, brush, NonZeroWinding); + info.Free; +end; + +//////////////////////////////////////////////////////////////////////// + +{ TBGRAMultishapeFiller } + +type + TPathStrokeData = record + Stroker: TBGRACustomPenStroker; + Texture: IBGRAScanner; + Color: TBGRAPixel; + Width: Single; + end; + +function TBGRAMultishapeFiller.AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer; +begin + if length(shapes) = nbShapes then + setlength(shapes, (length(shapes)+1)*2); + result := nbShapes; + inc(nbShapes); + + with shapes[result] do + begin + info := AInfo; + internalInfo:= AInternalInfo; + texture := ATexture; + internalTexture:= AInternalTexture; + color := GammaExpansion(AColor); + fillModeOverride:= false; + end; +end; + +function TBGRAMultishapeFiller.CheckRectangleBorderBounds(var x1, y1, x2, + y2: single; w: single): boolean; +var temp: single; +begin + if x1 > x2 then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if y1 > y2 then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + result := (x2-x1 > w) and (y2-y1 > w); +end; + +procedure TBGRAMultishapeFiller.InternalAddStroke( + const APoints: array of TPointF; AClosed: boolean; AData: Pointer); +var pts: ArrayOfTPointF; + idxShape: Integer; +begin + with TPathStrokeData(AData^) do + begin + if AClosed then + pts := Stroker.ComputePolygon(APoints, Width) + else + pts := Stroker.ComputePolylineAutoCycle(APoints, Width); + if Texture <> nil then + idxShape := AddPolygon(pts, Texture) + else + idxShape := AddPolygon(pts, Color); + OverrideFillMode(idxShape, fmWinding); + end; +end; + +constructor TBGRAMultishapeFiller.Create; +begin + nbShapes := 0; + shapes := nil; + PolygonOrder := poNone; + Antialiasing := True; + AliasingIncludeBottomRight := False; +end; + +destructor TBGRAMultishapeFiller.Destroy; +var + i: Integer; +begin + for i := 0 to nbShapes-1 do + begin + if shapes[i].internalInfo then shapes[i].info.free; + shapes[i].texture := nil; + if shapes[i].internalTexture <> nil then shapes[i].internalTexture.Free; + end; + shapes := nil; + inherited Destroy; +end; + +function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo; + AColor: TBGRAPixel): integer; +begin + result := AddShape(AShape,False,nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo; + ATexture: IBGRAScanner): integer; +begin + result := AddShape(AShape,False,ATexture,nil,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF; + AColor: TBGRAPixel): integer; +begin + if length(points) <= 2 then exit(-1); + result := AddShape(TOnePassFillPolyInfo.Create(points),True,nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF; + ATexture: IBGRAScanner): integer; +begin + if length(points) <= 2 then exit(-1); + result := AddShape(TOnePassFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent); +end; + +procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; + AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); +begin + AddPathStroke(APath,AffineMatrixIdentity,AColor,AWidth,AStroker); +end; + +procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; + ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); +begin + AddPathStroke(APath,AffineMatrixIdentity,ATexture,AWidth,AStroker); +end; + +procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; + AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; + AStroker: TBGRACustomPenStroker); +var data: TPathStrokeData; +begin + data.Stroker := AStroker; + data.Color := AColor; + data.Texture := nil; + data.Width := AWidth; + APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data); +end; + +procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; + AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; + AStroker: TBGRACustomPenStroker); +var data: TPathStrokeData; +begin + data.Stroker := AStroker; + data.Color := BGRAPixelTransparent; + data.Texture := ATexture; + data.Width := AWidth; + APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data); +end; + +function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer; +begin + result := AddPolygon(APath.ToPoints, AColor); +end; + +function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; + ATexture: IBGRAScanner): integer; +begin + result := AddPolygon(APath.ToPoints, ATexture); +end; + +function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; + AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer; +begin + result := AddPolygon(APath.ToPoints(AMatrix), AColor); +end; + +function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; + AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer; +begin + result := AddPolygon(APath.ToPoints(AMatrix), ATexture); +end; + +function TBGRAMultishapeFiller.AddPolylineStroke( + const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; + AStroker: TBGRACustomPenStroker): integer; +begin + result := AddPolygon(AStroker.ComputePolyline(points,AWidth,AColor), AColor); +end; + +function TBGRAMultishapeFiller.AddPolylineStroke( + const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; + AStroker: TBGRACustomPenStroker): integer; +begin + result := AddPolygon(AStroker.ComputePolyline(points,AWidth), ATexture); +end; + +function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF; + AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; +begin + result := AddPolygon(AStroker.ComputePolygon(points,AWidth), AColor); +end; + +function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF; + ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker + ): integer; +begin + result := AddPolygon(AStroker.ComputePolygon(points,AWidth), ATexture); +end; + +function TBGRAMultishapeFiller.AddTriangleLinearColor(pt1, pt2, pt3: TPointF; + c1, c2, c3: TBGRAPixel): integer; +var grad: TBGRAGradientTriangleScanner; +begin + if (c1 = c2) and (c2 = c3) then + result := AddPolygon([pt1,pt2,pt3],c1) + else + begin + grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3); + result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent); + end; +end; + +function TBGRAMultishapeFiller.AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; + texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer; +var + mapping: TBGRATriangleLinearMapping; +begin + mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3); + result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent); +end; + +procedure TBGRAMultishapeFiller.AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; + c1, c2, c3, c4: TBGRAPixel); +var + center: TPointF; + centerColor: TBGRAPixel; +begin + if (c1 = c2) and (c2 = c3) and (c3 = c4) then + AddPolygon([pt1,pt2,pt3,pt4],c1) + else + begin + center := (pt1+pt2+pt3+pt4)*(1/4); + centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)), + MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) ); + AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor); + AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor); + AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor); + AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor); + end; +end; + +procedure TBGRAMultishapeFiller.AddQuadLinearMapping(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; + ACulling: TFaceCulling); +var + mapping: TBGRAQuadLinearScanner; +begin + mapping := TBGRAQuadLinearScanner.Create(texture, + [tex1,tex2,tex3,tex4], + [pt1,pt2,pt3,pt4]); + mapping.Culling := ACulling; + mapping.Padding := true; + AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,mapping,mapping,BGRAPixelTransparent); +end; + +procedure TBGRAMultishapeFiller.AddQuadPerspectiveMapping(pt1, pt2, pt3, + pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); +var persp: TBGRAPerspectiveScannerTransform; +begin + persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); + AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single; + AColor: TBGRAPixel): integer; +begin + result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single; + ATexture: IBGRAScanner): integer; +begin + result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,ATexture,nil,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single; + AColor: TBGRAPixel): integer; +begin + result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single; + ATexture: IBGRAScanner): integer; +begin + result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,ATexture,nil,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, + ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer; +begin + result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, + ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer; +begin + result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True, + ATexture,nil,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, + w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer; +begin + result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True, + nil,nil,AColor); +end; + +function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, + w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer; +begin + result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True, + ATexture,nil,BGRAPixelTransparent); +end; + +function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single; + AColor: TBGRAPixel): integer; +begin + result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],AColor); +end; + +function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single; + ATexture: IBGRAScanner): integer; +begin + result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],ATexture); +end; + +function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single; + AColor: TBGRAPixel): integer; +var hw : single; +begin + hw := w/2; + if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then + result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,AColor) else + result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF, + PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],AColor); +end; + +function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single; + ATexture: IBGRAScanner): integer; +var hw : single; +begin + hw := w/2; + if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then + result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,ATexture) else + result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF, + PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],ATexture); +end; + +procedure TBGRAMultishapeFiller.OverrideFillMode(AShapeIndex: integer; + AFillMode: TFillMode); +begin + if AShapeIndex < 0 then exit; + if AShapeIndex >= nbShapes then raise exception.Create('Index out of bounds'); + shapes[AShapeIndex].fillMode := AFillMode; + shapes[AShapeIndex].fillModeOverride := true; +end; + +procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency); +var + shapeRow: array of record + density: PDensity; + densMinx,densMaxx: integer; + nbInter: integer; + inter: array of TIntersectionInfo; + end; + shapeRowsList: array of integer; + NbShapeRows: integer; + miny, maxy, minx, maxx, + rowminx, rowmaxx: integer; + + procedure SubstractScanlines(src,dest: integer); + var i: integer; + + procedure SubstractSegment(srcseg: integer); + var x1,x2, x3,x4: single; + j: integer; + + procedure AddSegment(xa,xb: single); + var nb: PInteger; + begin + nb := @shapeRow[dest].nbinter; + if length(shapeRow[dest].inter) < nb^+2 then + setlength(shapeRow[dest].inter, nb^*2+2); + with shapeRow[dest] do + begin + if inter[nb^] = nil then inter[nb^] := shapes[dest].info.CreateIntersectionInfo; + inter[nb^].interX := xa; + if inter[nb^+1] = nil then inter[nb^+1] := shapes[dest].info.CreateIntersectionInfo; + inter[nb^+1].interX := xb; + end; + inc(nb^,2); + end; + + begin + x1 := shapeRow[src].inter[(srcseg-1)*2].interX; + x2 := shapeRow[src].inter[srcseg*2-1].interX; + for j := shapeRow[dest].nbInter div 2 downto 1 do + begin + x3 := shapeRow[dest].inter[(j-1)*2].interX; + x4 := shapeRow[dest].inter[j*2-1].interX; + if (x2 <= x3) or (x1 >= x4) then continue; //not overlapping + if (x1 <= x3) and (x2 >= x4) then + shapeRow[dest].inter[j*2-1].interX := x3 //empty + else + if (x1 <= x3) and (x2 < x4) then + shapeRow[dest].inter[(j-1)*2].interX := x2 //remove left part + else + if (x1 > x3) and (x2 >= x4) then + shapeRow[dest].inter[j*2-1].interX := x1 else //remove right part + begin + //[x1,x2] is inside [x3,x4] + shapeRow[dest].inter[j*2-1].interX := x1; //left part + AddSegment(x2,x4); + end; + end; + end; + + begin + for i := 1 to shapeRow[src].nbInter div 2 do + SubstractSegment(i); + end; + +var + AliasingOfs: TPointF; + useAA: boolean; + + procedure AddOneLineDensity(cury: single); + var + i,k: integer; + ix1,ix2: integer; + x1,x2: single; + begin + for k := 0 to NbShapeRows-1 do + with shapeRow[shapeRowsList[k]], shapes[shapeRowsList[k]] do + begin + //find intersections + info.ComputeAndSort(cury, inter, nbInter, fillMode=fmWinding); + nbInter := nbInter and not 1; //even + end; + + case PolygonOrder of + poLastOnTop: begin + for k := 1 to NbShapeRows-1 do + if shapeRow[shapeRowsList[k]].nbInter > 0 then + for i := 0 to k-1 do + SubstractScanlines(shapeRowsList[k],shapeRowsList[i]); + end; + poFirstOnTop: begin + for k := 0 to NbShapeRows-2 do + if shapeRow[shapeRowsList[k]].nbInter > 0 then + for i := k+1 to NbShapeRows-1 do + SubstractScanlines(shapeRowsList[k],shapeRowsList[i]); + end; + end; + + for k := 0 to NbShapeRows-1 do + with shapeRow[shapeRowsList[k]] do + begin + //fill density + if not useAA then + begin + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i + 1].interX; + ComputeAliasedRowBounds(x1+AliasingOfs.X,x2+AliasingOfs.X,minx,maxx,ix1,ix2); + + if ix1 < densMinx then densMinx := ix1; + if ix2 > densMaxx then densMaxx := ix2; + + if ix2 >= ix1 then + FillWord(density[ix1-minx],ix2-ix1+1,256); + end; + end else + {$DEFINE INCLUDE_FILLDENSITY} + {$i density256.inc} + end; + + for k := 0 to NbShapeRows-1 do + with shapeRow[shapeRowsList[k]] do + begin + if densMinX < rowminx then rowminx := densMinX; + if densMaxX > rowmaxx then rowmaxx := densMaxX; + end; + end; + +type + TCardinalSum = record + sumR,sumG,sumB,sumA: LongWord; + end; + +var + MultiEmpty: boolean; + bounds: TRect; + + xb, yb, yc, k: integer; + pdest: PBGRAPixel; + + curSum,nextSum: ^TCardinalSum; + sums: array of TCardinalSum; + curAlpha: byte; + + pdens: PDensity; + w: UInt32or64; + ec: TExpandedPixel; + count: integer; + ScanNextFunc: function: TBGRAPixel of object; + +begin + if nbShapes = 0 then exit; + for k := 0 to nbShapes-1 do + if not shapes[k].fillModeOverride then shapes[k].fillMode:= fillMode; + + useAA := Antialiasing and (ADrawMode in [dmDrawWithTransparency,dmLinearBlend]); + if nbShapes = 1 then + begin + if useAA then + FillShapeAntialias(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode=dmLinearBlend) else + FillShapeAliased(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode, + AliasingIncludeBottomRight); + exit; + end; + bounds := Rect(0,0,0,0); + MultiEmpty := True; + for k := 0 to nbShapes-1 do + begin + If BGRAShapeComputeMinMax(shapes[k].info,minx,miny,maxx,maxy,dest) then + begin + shapes[k].bounds := rect(minx,miny,maxx+1,maxy+1); + if MultiEmpty then + begin + MultiEmpty := False; + bounds := shapes[k].bounds; + end else + begin + if minx < bounds.left then bounds.left := minx; + if miny < bounds.top then bounds.top := miny; + if maxx >= bounds.right then bounds.right := maxx+1; + if maxy >= bounds.bottom then bounds.bottom := maxy+1; + end; + end else + shapes[k].bounds := rect(0,0,0,0); + end; + if MultiEmpty then exit; + minx := bounds.left; + miny := bounds.top; + maxx := bounds.right-1; + maxy := bounds.bottom-1; + + setlength(shapeRow, nbShapes); + for k := 0 to nbShapes-1 do + begin + shapeRow[k].inter := shapes[k].info.CreateIntersectionArray; + getmem(shapeRow[k].density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety + end; + + if AliasingIncludeBottomRight then + AliasingOfs := PointF(0.0001,0.0001) else + AliasingOfs := PointF(0,0); + + setlength(sums,maxx-minx+1); + setlength(shapeRowsList, nbShapes); + + //vertical scan + for yb := miny to maxy do + begin + rowminx := maxx+1; + rowmaxx := minx-1; + + //init shape rows + NbShapeRows := 0; + for k := 0 to nbShapes-1 do + if (yb >= shapes[k].bounds.top) and (yb < shapes[k].bounds.Bottom) then + begin + shapeRowsList[NbShapeRows] := k; + inc(NbShapeRows); + + fillchar(shapeRow[k].density^,(maxx-minx+1)*sizeof(TDensity),0); + shapeRow[k].densMinx := maxx+1; + shapeRow[k].densMaxx := minx-1; + end; + + If useAA then + begin + //precision scan + for yc := 0 to AntialiasPrecision - 1 do + AddOneLineDensity( yb + (yc * 2 + 1) / (AntialiasPrecision * 2) ); + end else + begin + AddOneLineDensity( yb + 0.5 - AliasingOfs.Y ); + end; + + if rowminx < minx then rowminx := minx; + if rowmaxx > maxx then rowmaxx := maxx; + + if rowminx <= rowmaxx then + begin + FillChar(sums[rowminx-minx],(rowmaxx-rowminx+1)*sizeof(sums[0]),0); + + if useAA then + {$define PARAM_ANTIALIASINGFACTOR} + {$i multishapeline.inc} + else + {$i multishapeline.inc}; + + pdest := dest.ScanLine[yb] + rowminx; + xb := rowminx; + nextSum := @sums[xb-minx]; + case ADrawMode of + dmDrawWithTransparency: + while xb <= rowmaxx do + begin + curSum := nextSum; + inc(nextSum); + with curSum^ do + begin + if sumA <> 0 then + begin + ec.red := (sumR+sumA shr 1) div sumA; + ec.green := (sumG+sumA shr 1) div sumA; + ec.blue := (sumB+sumA shr 1) div sumA; + if sumA > 255 then curAlpha := 255 else curAlpha := sumA; + ec.alpha := curAlpha shl 8 + curAlpha; + count := 1; + while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) + and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do + begin + inc(xb); + inc(nextSum); + inc(count); + end; + if count = 1 then + DrawExpandedPixelInlineNoAlphaCheck(pdest,ec,curAlpha) else + DrawExpandedPixelsInline(pdest, ec, count ); + inc(pdest,count-1); + end; + end; + inc(xb); + inc(pdest); + end; + + dmLinearBlend: + while xb <= rowmaxx do + begin + curSum := nextSum; + inc(nextSum); + with curSum^ do + begin + if sumA <> 0 then + begin + ec.red := (sumR+sumA shr 1) div sumA; + ec.green := (sumG+sumA shr 1) div sumA; + ec.blue := (sumB+sumA shr 1) div sumA; + if sumA > 255 then curAlpha := 255 else curAlpha := sumA; + ec.alpha := curAlpha shl 8 + curAlpha; + count := 1; + while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) + and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do + begin + inc(xb); + inc(nextSum); + inc(count); + end; + if count = 1 then + DrawPixelInlineNoAlphaCheck(pdest,GammaCompression(ec)) else + begin + DrawPixelsInline(pdest, GammaCompression(ec), count ); + inc(pdest,count-1); + end; + end; + end; + inc(xb); + inc(pdest); + end; + + dmXor: + while xb <= rowmaxx do + begin + curSum := nextSum; + inc(nextSum); + with curSum^ do + begin + if sumA <> 0 then + begin + ec.red := (sumR+sumA shr 1) div sumA; + ec.green := (sumG+sumA shr 1) div sumA; + ec.blue := (sumB+sumA shr 1) div sumA; + if sumA > 255 then curAlpha := 255 else curAlpha := sumA; + ec.alpha := curAlpha shl 8 + curAlpha; + count := 1; + while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) + and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do + begin + inc(xb); + inc(nextSum); + inc(count); + end; + XorInline(pdest,GammaCompression(ec),count); + inc(pdest,count-1); + end; + end; + inc(xb); + inc(pdest); + end; + + dmSet: + while xb <= rowmaxx do + begin + curSum := nextSum; + inc(nextSum); + with curSum^ do + begin + if sumA <> 0 then + begin + ec.red := (sumR+sumA shr 1) div sumA; + ec.green := (sumG+sumA shr 1) div sumA; + ec.blue := (sumB+sumA shr 1) div sumA; + if sumA > 255 then curAlpha := 255 else curAlpha := sumA; + ec.alpha := curAlpha shl 8 + curAlpha; + count := 1; + while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) + and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do + begin + inc(xb); + inc(nextSum); + inc(count); + end; + FillInline(pdest,GammaCompression(ec),count); + inc(pdest,count-1); + end; + end; + inc(xb); + inc(pdest); + end; + + dmSetExceptTransparent: + while xb <= rowmaxx do + begin + curSum := nextSum; + inc(nextSum); + with curSum^ do + begin + if sumA >= 255 then + begin + ec.red := (sumR+sumA shr 1) div sumA; + ec.green := (sumG+sumA shr 1) div sumA; + ec.blue := (sumB+sumA shr 1) div sumA; + if sumA > 255 then curAlpha := 255 else curAlpha := sumA; + ec.alpha := curAlpha shl 8 + curAlpha; + count := 1; + while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) + and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do + begin + inc(xb); + inc(nextSum); + inc(count); + end; + FillInline(pdest,GammaCompression(ec),count); + inc(pdest,count-1); + end; + end; + inc(xb); + inc(pdest); + end; + + end; + end; + + end; + + for k := 0 to nbShapes-1 do + begin + freemem(shapeRow[k].density); + shapes[k].info.FreeIntersectionArray(shapeRow[k].inter); + end; + + dest.InvalidateBitmap; +end; + +////////////////////////////////////////////////////////////////////////////// + +procedure FillEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, + ry: single; ABrush: TUniversalBrush); +var + info: TFillEllipseInfo; +begin + if ABrush.DoesNothing or (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then exit; + info := TFillEllipseInfo.Create(x, y, rx, ry); + FillShapeAntialias(bmp, info, ABrush, False); + info.Free; +end; + +procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single; + c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); + FillEllipseAntialias(bmp, x,y,rx,ry, b); +end; + +procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, + ry: single; scan: IBGRAScanner; LinearBlend: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp, BGRAPixelTransparent,false,scan,LinearBlend); + FillEllipseAntialias(bmp, x,y,rx,ry, b); +end; + +procedure BorderEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry, + w: single; ABrush: TUniversalBrush); +var + info: TFillBorderEllipseInfo; +begin + if ABrush.DoesNothing or (w=0) or (x = EmptySingle) or (y = EmptySingle) then exit; + info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w); + FillShapeAntialias(bmp, info, ABrush, False); + info.Free; +end; + +procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); + BorderEllipseAntialias(bmp, x,y,rx,ry,w,b); +end; + +procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, + ry, w: single; scan: IBGRAScanner; LinearBlend: boolean); +var + b: TUniversalBrush; +begin + AnyBrush(b, bmp,BGRAPixelTransparent,false,scan,LinearBlend); + BorderEllipseAntialias(bmp, x,y,rx,ry,w,b); +end; + +procedure BorderEllipse(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; + ABrush: TUniversalBrush; AAlpha: word); +var + info: TFillBorderEllipseInfo; +begin + if ABrush.DoesNothing or ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then exit; + info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w); + FillShapeAliased(bmp, info, ABrush, AAlpha, False); + info.Free; +end; + +procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; + c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode); +var + bFill: TUniversalBrush; +begin + AnyBrush(bFill, bmp, c,EraseMode,nil,drawmode); + BorderEllipse(bmp, x,y,rx,ry,w,bFill); +end; + +procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, + w: single; scan: IBGRAScanner; drawmode: TDrawMode); +var + bFill: TUniversalBrush; +begin + bmp.ScannerBrush(bFill, scan,drawMode); + BorderEllipse(bmp, x,y,rx,ry,w,bFill); +end; + +procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, + rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + info: TFillRoundRectangleInfo; +begin + if (x1 = x2) or (y1 = y2) then exit; + info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates); + FillShapeAntialias(bmp, info, c, EraseMode,nil, False, LinearBlend); + info.Free; +end; + +procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, + y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; + scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + info: TFillRoundRectangleInfo; +begin + if (x1 = x2) or (y1 = y2) then exit; + info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates); + FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend); + info.Free; +end; + +procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, + y2, rx, ry, w: single; options: TRoundRectangleOptions; c: TBGRAPixel; + EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + info: TFillShapeInfo; + oldLinear: boolean; +begin + if w=0 then exit; + if ((rx=0) or (ry=0)) and not EraseMode then + begin + oldLinear := bmp.LinearAntialiasing; + bmp.LinearAntialiasing := LinearBlend; + bmp.RectangleAntialias(x1,y1,x2,y2,c,w); + bmp.LinearAntialiasing := oldLinear; + exit; + end; + info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); + FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend); + info.Free; +end; + +procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, + y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; + scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean); +var + info: TFillBorderRoundRectInfo; + oldLinear: Boolean; +begin + if w=0 then exit; + if (rx=0) or (ry=0) then + begin + oldLinear := bmp.LinearAntialiasing; + bmp.LinearAntialiasing := LinearBlend; + bmp.RectangleAntialias(x1,y1,x2,y2,scan,w); + bmp.LinearAntialiasing := oldLinear; + exit; + end; + info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); + FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend); + info.Free; +end; + +procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, + x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; bordercolor, + fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean); +var + info: TFillBorderRoundRectInfo; + multi: TBGRAMultishapeFiller; +begin + if (rx = 0) or (ry = 0) then exit; + info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); + if not EraseMode then + begin + multi := TBGRAMultishapeFiller.Create; + if filltexture <> nil then + multi.AddShape(info.innerBorder, filltexture) else + multi.AddShape(info.innerBorder, fillcolor); + if w<>0 then + begin + if bordertexture <> nil then + multi.AddShape(info, bordertexture) else + multi.AddShape(info, bordercolor); + end; + multi.Draw(bmp); + multi.Free; + end else + begin + FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False, False); + FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False, False); + end; + info.Free; +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygonaliased.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygonaliased.pas new file mode 100644 index 0000000..350b013 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrapolygonaliased.pas @@ -0,0 +1,982 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAPolygonAliased; + +{$mode objfpc}{$H+} + +{$i bgrasse.inc} + +interface + +{ This unit provides fast aliased polygon routines. + + To do aliased drawing, only one line is intersected with polygons for each output scanline. + Along with intersection coordinates, color and texture coordinates are computed using + linear interpolation. Inverse values are used for projective transform. } + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE; + +type + //segment information for linear color + TLinearColorInfo = record + Color, ColorSlopes: TColorF; + end; + PLinearColorInfo = ^TLinearColorInfo; + ArrayOfTColorF = array of TColorF; + + //add a color information to intersection info + TLinearColorGradientIntersectionInfo = class(TIntersectionInfo) + Color: TColorF; + end; + + { TPolygonLinearColorGradientInfo } + + TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo) + protected + FColors: array of TColorF; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, + ANumSegment: integer; dy: single; AData: pointer); override; + public + constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel); + function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; + function CreateIntersectionInfo: TIntersectionInfo; override; + end; + +procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearColorGradientInfo; + NonZeroWinding: boolean); overload; +procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; + const Colors: array of TBGRAPixel; NonZeroWinding: boolean); overload; + +type + //segment information for linear color + TPerspectiveColorInfo = record + ColorDivZ, ColorSlopesDivZ: TColorF; + InvZ, InvZSlope: single; + end; + PPerspectiveColorInfo = ^TPerspectiveColorInfo; + + //add a color information to intersection info + TPerspectiveColorGradientIntersectionInfo = class(TIntersectionInfo) + ColorDivZ: TColorF; + coordInvZ: single; + end; + + { TPolygonPerspectiveColorGradientInfo } + + TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo) + protected + FColors: array of TColorF; + FPointsZ: array of single; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, + ANumSegment: integer; dy: single; AData: pointer); override; + public + constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel); + function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; + function CreateIntersectionInfo: TIntersectionInfo; override; + end; + +procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveColorGradientInfo; + NonZeroWinding: boolean; zbuffer: psingle = nil); overload; +procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; + const pointsZ: array of single; const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; + +type + //segment information for linear texture + TLinearTextureInfo = record + TexCoord: TPointF; + TexCoordSlopes: TPointF; + lightness: single; + lightnessSlope: single; + end; + PLinearTextureInfo = ^TLinearTextureInfo; + + //add a texture coordinate to intersection info + TLinearTextureMappingIntersectionInfo = class(TIntersectionInfo) + texCoord: TPointF; + lightness: word; + end; + + { TPolygonLinearTextureMappingInfo } + + TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo) + protected + FTexCoords: array of TPointF; + FLightnesses: array of Word; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, + ANumSegment: integer; dy: single; AData: pointer); override; + public + constructor Create(const points: array of TPointF; const texCoords: array of TPointF); overload; + constructor Create(const points: array of TPointF; const texCoords: array of TPointF; const lightnesses: array of word); overload; + function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; + function CreateIntersectionInfo: TIntersectionInfo; override; + end; + +procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo; + texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload; + +procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload; +procedure PolygonLinearTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean); overload; + +type + //segment information for perspective texture. Use inverse Z and slopes. + TPerspectiveTextureInfo = record + InvZ,InvZSlope: Single; + TexCoordDivByZ: TPointF; + TexCoordDivByZSlopes: TPointF; + lightness: single; + lightnessSlope: single; + Position3D, Normal3D: TPoint3D_128; + Position3DSlope, Normal3DSlope: TPoint3D_128; + end; + PPerspectiveTextureInfo = ^TPerspectiveTextureInfo; + + //add a texture coordinate and depth to intersection info (stored as inverse) + TPerspectiveTextureMappingIntersectionInfo = class(TIntersectionInfo) + texCoordDivByZ: TPointF; + coordInvZ: single; + lightness: word; + Position3D, Normal3D: TPoint3D_128; + end; + + { TPolygonPerspectiveTextureMappingInfo } + + TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo) + protected + FTexCoords: array of TPointF; + FPointsZ: array of single; + FLightnesses: array of Word; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, + ANumSegment: integer; dy: single; AData: pointer); override; + public + constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF); overload; + constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF; const lightnesses: array of word); overload; + function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; + function CreateIntersectionInfo: TIntersectionInfo; override; + end; + + { TPolygonPerspectiveMappingShaderInfo } + + TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo) + protected + FTexCoords: array of TPointF; + FPositions3D, FNormals3D: array of TPoint3D_128; + procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, + ANumSegment: integer; dy: single; AData: pointer); override; + public + constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF); overload; + constructor Create(const points: array of TPointF; const points3D: array of TPoint3D_128; const normals: array of TPoint3D_128; const texCoords: array of TPointF); overload; + function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; + function CreateIntersectionInfo: TIntersectionInfo; override; + end; + + TShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TBGRAPixel of object; + +procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveTextureMappingInfo; + texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; +procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; +procedure PolygonPerspectiveTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; + +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveMappingShaderInfo; + texture: IBGRAScanner; TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; + solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D; + const normals: array of TPoint3D; texture: IBGRAScanner; const texCoords: array of TPointF; + TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; + solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D_128; + const normals: array of TPoint3D_128; texture: IBGRAScanner; const texCoords: array of TPointF; + TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; + solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; + +{ Aliased round rectangle } +procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; + DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency; + skipFill: boolean = false); overload; +procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; + DX, DY: integer; const BorderColor, FillColor: TUniversalBrush; AAlpha: Word; skipBorder: boolean = false; skipFill: boolean = false); overload; +procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; + DX, DY: integer; FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency); + +implementation + +uses Math, BGRABlend, BGRAPolygon; + +{ TPolygonPerspectiveColorGradientInfo } + +procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues( + AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; + dy: single; AData: pointer); +var + info: PPerspectiveColorInfo; +begin + AInter.SetValues(AInterX,AWinding,ANumSegment); + info := PPerspectiveColorInfo(AData); + TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; + TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy; +end; + +constructor TPolygonPerspectiveColorGradientInfo.Create( + const points: array of TPointF; const pointsZ: array of single; + const Colors: array of TBGRAPixel); +var + i: Integer; + ec: TExpandedPixel; +begin + if (length(Colors) <> length(points)) or (length(points) <> length(pointsZ)) then + raise Exception.Create('Dimensions mismatch'); + inherited Create(points); + + SetLength(FColors, length(FPoints)); + SetLength(FPointsZ, length(FPoints)); + for i := 0 to high(FPoints) do + begin + ec := GammaExpansion(Colors[FPoints[i].originalIndex]); + FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha); + FPointsZ[i] := pointsZ[FPoints[i].originalIndex]; + end; +end; + +function TPolygonPerspectiveColorGradientInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +var + info: PPerspectiveColorInfo; + InvTy: single; + CurColorDivByZ,NextColorDivByZ: TColorF; + CurInvZ,NextInvZ: single; +begin + New(info); + InvTy := 1/(ASeg^.y2-ASeg^.y); + CurInvZ := 1/FPointsZ[numPt]; + CurColorDivByZ := FColors[numPt]*CurInvZ; + NextInvZ := 1/FPointsZ[nextPt]; + NextColorDivByZ := FColors[nextPt]*NextInvZ; + + info^.ColorSlopesDivZ := (NextColorDivByZ - CurColorDivByZ)*InvTy; + info^.ColorDivZ := CurColorDivByZ; + + info^.InvZSlope := (NextInvZ-CurInvZ)*InvTy; + info^.InvZ := CurInvZ; + + Result:= info; +end; + +function TPolygonPerspectiveColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + Result:= TPerspectiveColorGradientIntersectionInfo.Create; +end; + +{ TPolygonLinearColorGradientInfo } + +procedure TPolygonLinearColorGradientInfo.SetIntersectionValues( + AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; + dy: single; AData: pointer); +var + info: PLinearColorInfo; +begin + AInter.SetValues(AInterX,AWinding,ANumSegment); + info := PLinearColorInfo(AData); + TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy; +end; + +constructor TPolygonLinearColorGradientInfo.Create( + const points: array of TPointF; const Colors: array of TBGRAPixel); +var + i: Integer; + ec: TExpandedPixel; +begin + if length(Colors) <> length(points) then + raise Exception.Create('Dimensions mismatch'); + + inherited Create(Points); + setlength(FColors, length(FPoints)); + for i := 0 to high(FColors) do + begin + ec := GammaExpansion(Colors[FPoints[i].originalIndex]); + FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha); + end; +end; + +function TPolygonLinearColorGradientInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +var + info: PLinearColorInfo; + ty: single; +begin + New(info); + ty := ASeg^.y2 - ASeg^.y; + info^.ColorSlopes := (FColors[nextPt] - FColors[numPt])*(1/ty); + info^.Color := FColors[numPt]; + Result:= info; +end; + +function TPolygonLinearColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + Result:= TLinearColorGradientIntersectionInfo.Create; +end; + +procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; + polyInfo: TPolygonLinearColorGradientInfo; NonZeroWinding: boolean); +var + inter: array of TIntersectionInfo; + nbInter: integer; + + procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer; + x1: Single; c1: TColorF; x2: Single; c2: TColorF); + var + colorPos: TColorF; + colorStep: TColorF; + t: single; + pdest: PBGRAPixel; + i: LongInt; + ec: TExpandedPixel; + {%H-}cInt: packed record + r,g,b,a: integer; + end; + {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF} + begin + t := ((ix1+0.5)-x1)/(x2-x1); + colorPos := c1 + (c2-c1)*t; + colorStep := (c2-c1)*(1/(x2-x1)); + pdest := bmp.ScanLine[yb]+ix1; + + {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel} + If UseSSE then + begin + asm + movups xmm4, colorPos + movups xmm5, colorStep + end; + If UseSSE2 then + begin + for i := ix1 to ix2 do + begin + asm + cvtps2dq xmm0,xmm4 + movups cInt, xmm0 + addps xmm4,xmm5 + end; + c.red := GammaCompressionTab[cInt.r]; + c.green := GammaCompressionTab[cInt.g]; + c.blue := GammaCompressionTab[cInt.b]; + c.alpha := GammaCompressionTab[cInt.a]; + DrawPixelInlineWithAlphaCheck(pdest, c); + inc(pdest); + end; + end else + begin + for i := ix1 to ix2 do + begin + asm + movups colorPos, xmm4 + addps xmm4,xmm5 + end; + ec.red := round(colorPos[1]); + ec.green := round(colorPos[2]); + ec.blue := round(colorPos[3]); + ec.alpha := round(colorPos[4]); + DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); + inc(pdest); + end; + end; + end else + {$ENDIF} + for i := ix1 to ix2 do + begin + ec.red := round(colorPos[1]); + ec.green := round(colorPos[2]); + ec.blue := round(colorPos[3]); + ec.alpha := round(colorPos[4]); + DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); + colorPos := colorPos + colorStep; + inc(pdest); + end; + end; + +var + miny, maxy, minx, maxx: integer; + + yb, i: integer; + x1, x2: single; + + ix1, ix2: integer; + +begin + If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; + inter := polyInfo.CreateIntersectionArray; + + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i+ 1].interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + DrawGradientLine(yb,ix1,ix2, + x1,TLinearColorGradientIntersectionInfo(inter[i+i]).Color, + x2,TLinearColorGradientIntersectionInfo(inter[i+i+1]).Color); + end; + end; + end; + + polyInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; +end; + +procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; const Colors: array of TBGRAPixel; + NonZeroWinding: boolean); +var polyInfo: TPolygonLinearColorGradientInfo; +begin + polyInfo := TPolygonLinearColorGradientInfo.Create(points,Colors); + PolygonLinearColorGradientAliased(bmp,polyInfo,NonZeroWinding); + polyInfo.Free; +end; + +{ TPolygonLinearTextureMappingInfo } + +procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues( + AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; + dy: single; AData: pointer); +var + info: PLinearTextureInfo; +begin + AInter.SetValues(AInterX,AWinding,ANumSegment); + info := PLinearTextureInfo(AData); + TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy; + if FLightnesses<>nil then + TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy) + else + TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768; +end; + +constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF; + const texCoords: array of TPointF); +var + i: Integer; +begin + if length(texCoords) <> length(points) then + raise Exception.Create('Dimensions mismatch'); + inherited Create(points); + SetLength(FTexCoords, length(FPoints)); + for i := 0 to high(FPoints) do + FTexCoords[i] := texCoords[FPoints[i].originalIndex]; +end; + +constructor TPolygonLinearTextureMappingInfo.Create( + const points: array of TPointF; const texCoords: array of TPointF; + const lightnesses: array of word); +var + i: Integer; +begin + if (length(texCoords) <> length(points)) or (length(lightnesses) <> length(points)) then + raise Exception.Create('Dimensions mismatch'); + inherited Create(points); + SetLength(FTexCoords, length(FPoints)); + setlength(FLightnesses, length(FPoints)); + for i := 0 to high(FPoints) do + begin + FTexCoords[i] := texCoords[FPoints[i].originalIndex]; + FLightnesses[i] := lightnesses[FPoints[i].originalIndex]; + end; +end; + +function TPolygonLinearTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +var + info: PLinearTextureInfo; + ty: single; +begin + New(info); + ty := ASeg^.y2-ASeg^.y; + info^.TexCoordSlopes := (FTexCoords[nextPt] - FTexCoords[numPt])*(1/ty); + info^.TexCoord := FTexCoords[numPt]; + if FLightnesses <> nil then + begin + info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty); + info^.lightness := FLightnesses[numPt]; + end else + begin + info^.lightness := 32768; + info^.lightnessSlope := 0; + end; + Result:= info; +end; + +function TPolygonLinearTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + result := TLinearTextureMappingIntersectionInfo.Create; +end; + +{$hints off} + +procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; + polyInfo: TPolygonPerspectiveColorGradientInfo; NonZeroWinding: boolean; zbuffer: psingle); +var + inter: array of TIntersectionInfo; + nbInter: integer; + + procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer; + x1: Single; info1: TPerspectiveColorGradientIntersectionInfo; x2: Single; info2: TPerspectiveColorGradientIntersectionInfo); + var + diff,colorPos,{%H-}colorPosByZ: TColorF; + colorStep: TColorF; + t: single; + pdest: PBGRAPixel; + i: LongInt; + ec: TExpandedPixel; + invDx: single; + z,invZ,InvZStep: single; + r,g,b,a: integer; + {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single; + cInt: packed record + r,g,b,a: integer; + end; + c: TBGRAPixel;{$ENDIF} + zbufferpos: psingle; + + begin + invDx := 1/(x2-x1); + t := ((ix1+0.5)-x1)*InvDx; + diff := info2.ColorDivZ-info1.ColorDivZ; + colorPos := info1.ColorDivZ + diff*t; + colorStep := diff*InvDx; + invZ := info1.coordInvZ + (info2.coordInvZ-info1.coordInvZ)*t; + InvZStep := (info2.coordInvZ-info1.coordInvZ)*InvDx; + pdest := bmp.ScanLine[yb]+ix1; + if zbuffer <> nil then + begin + {$DEFINE PARAM_USEZBUFFER} + zbufferpos := zbuffer + yb*bmp.Width + ix1; + {$IFDEF BGRASSE_AVAILABLE} + If UseSSE then + begin + {$DEFINE PARAM_USESSE} + If UseSSE2 then + begin + {$DEFINE PARAM_USESSE2} + {$i perspectivecolorscan.inc} + {$UNDEF PARAM_USESSE2} + end else + begin + {$i perspectivecolorscan.inc} + end; + {$UNDEF PARAM_USESSE} + end else + {$ENDIF} + begin + {$i perspectivecolorscan.inc} + end; + {$UNDEF PARAM_USEZBUFFER} + end else + begin + {$IFDEF BGRASSE_AVAILABLE} + If UseSSE then + begin + {$DEFINE PARAM_USESSE} + If UseSSE2 then + begin + {$DEFINE PARAM_USESSE2} + {$i perspectivecolorscan.inc} + {$UNDEF PARAM_USESSE2} + end else + begin + {$i perspectivecolorscan.inc} + end; + {$UNDEF PARAM_USESSE} + end else + {$ENDIF} + begin + {$i perspectivecolorscan.inc} + end; + end; + end; + +var + miny, maxy, minx, maxx: integer; + + yb, i: integer; + x1, x2: single; + + ix1, ix2: integer; + +begin + If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; + inter := polyInfo.CreateIntersectionArray; + + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i+ 1].interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + DrawGradientLine(yb,ix1,ix2, + x1,TPerspectiveColorGradientIntersectionInfo(inter[i+i]), + x2,TPerspectiveColorGradientIntersectionInfo(inter[i+i+1])); + end; + end; + end; + + polyInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; +end; + +procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; const pointsZ: array of single; + const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle); +var polyInfo: TPolygonPerspectiveColorGradientInfo; +begin + polyInfo := TPolygonPerspectiveColorGradientInfo.Create(points,pointsZ,Colors); + PolygonPerspectiveColorGradientAliased(bmp,polyInfo,NonZeroWinding,zbuffer); + polyInfo.Free; +end; + +procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo; + texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); +var + inter: array of TIntersectionInfo; + nbInter: integer; + scanAtFunc: function(X,Y: Single): TBGRAPixel of object; + scanAtIntegerFunc: function(X,Y: integer): TBGRAPixel of object; + + procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer; + info1,info2: TLinearTextureMappingIntersectionInfo; + WithInterpolation: boolean); + {$i lineartexscan.inc} + + procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer; + info1,info2: TLinearTextureMappingIntersectionInfo; + WithInterpolation: boolean); + {$define PARAM_USELIGHTING} + {$i lineartexscan.inc} + +var + miny, maxy, minx, maxx: integer; + + yb, i: integer; + x1, x2: single; + + ix1, ix2: integer; + +begin + If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; + + scanAtFunc := @texture.ScanAt; + scanAtIntegerFunc := @texture.ScanAtInteger; + + inter := polyInfo.CreateIntersectionArray; + + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i+ 1].interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + begin + if (TLinearTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and + (TLinearTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then + DrawTextureLineWithoutLight(yb,ix1,ix2, + TLinearTextureMappingIntersectionInfo(inter[i+i]), + TLinearTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation) + else + DrawTextureLineWithLight(yb,ix1,ix2, + TLinearTextureMappingIntersectionInfo(inter[i+i]), + TLinearTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation); + end; + end; + end; + end; + + polyInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; +end; +{$hints on} + +procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); +var polyInfo: TPolygonLinearTextureMappingInfo; +begin + polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords); + PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding); + polyInfo.Free; +end; + +procedure PolygonLinearTextureMappingAliasedWithLightness( + bmp: TBGRACustomBitmap; const points: array of TPointF; + texture: IBGRAScanner; const texCoords: array of TPointF; + TextureInterpolation: Boolean; lightnesses: array of word; + NonZeroWinding: boolean); +var polyInfo: TPolygonLinearTextureMappingInfo; +begin + polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords,lightnesses); + PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding); + polyInfo.Free; +end; + +{$i polyaliaspersp.inc} + +{From LazRGBGraphics} +procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; + DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency; + skipFill: boolean = false); +var + bBorder, bFill: TUniversalBrush; + skipBorder: Boolean; +begin + dest.SolidBrush(bBorder, BorderColor, ADrawMode); + skipBorder := ((ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (BorderColor.alpha=0)) + or ((ADrawMode = dmSetExceptTransparent) and (BorderColor.alpha<>255)) + or ((ADrawMode = dmXor) and (PLongWord(@BorderColor)^=0)); + + if FillTexture <> nil then + dest.ScannerBrush(bFill, FillTexture, ADrawMode) + else + begin + dest.SolidBrush(bFill, FillColor, ADrawMode); + skipFill := (skipFill or (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (FillColor.alpha=0)) + or ((ADrawMode = dmSetExceptTransparent) and (FillColor.alpha<>255)) + or ((ADrawMode = dmXor) and (PLongWord(@FillColor)^=0)); + end; + + BGRARoundRectAliased(dest, X1,Y1,X2,Y2, DX,DY, bBorder, bFill, 65535, skipBorder,skipFill); +end; + +procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2, + Y2: integer; DX, DY: integer; const BorderColor, FillColor: TUniversalBrush; + AAlpha: Word; skipBorder: boolean; skipFill: boolean); +var + CX, CY, CX1, CY1, A, B, NX, NY: single; + X, Y, EX, EY: integer; + LX1, LY1: integer; + LX2, LY2: integer; + DivSqrA, DivSqrB: single; + I, J, S: integer; + EdgeList: array of TPoint; + temp: integer; + LX, LY: integer; + RowStart,RowEnd: integer; + + procedure AddEdge(X, Y: integer); + begin + If (Y > High(EdgeList)) or (Y < 0) then exit; + if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then + EdgeList[Y].X := X; + if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then + EdgeList[Y].Y := X; + end; + +begin + if AAlpha = 0 then exit; + if BorderColor.DoesNothing then skipBorder:= true; + if FillColor.DoesNothing then skipFill:= true; + if skipBorder and skipFill then exit; + if (x1 > x2) then + begin + temp := x1; + x1 := x2; + x2 := temp; + end; + if (y1 > y2) then + begin + temp := y1; + y1 := y2; + y2 := temp; + end; + if (x2 - x1 <= 0) or (y2 - y1 <= 0) then exit; + LX := x2 - x1 - DX; + LY := y2 - y1 - DY; + if LX < 0 then LX := 0; + if LY < 0 then LY := 0; + Dec(x2); + Dec(y2); + + if (X1 = X2) and (Y1 = Y2) then + begin + if not skipBorder then + dest.DrawPixel(X1, Y1, BorderColor, AAlpha); + Exit; + end; + if (X2 - X1 = 1) or (Y2 - Y1 = 1) then + begin + if not skipBorder then + dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha); + Exit; + end; + if (LX > X2 - X1) or (LY > Y2 - Y1) then + begin + if not skipBorder then + dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha); + if not skipFill then + dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, AAlpha); + Exit; + end; + + SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2)); + for I := 0 to Pred(High(EdgeList)) do + EdgeList[I] := Point(-1, -1); + EdgeList[High(EdgeList)] := Point(0, 0); + + A := (X2 - X1 + 1 - LX) / 2; + B := (Y2 - Y1 + 1 - LY) / 2; + CX := (X2 + X1 + 1) / 2; + CY := (Y2 + Y1 + 1) / 2; + + CX1 := X2 + 1 - A - Floor(CX); + CY1 := Y2 + 1 - B - Floor(CY); + + EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A)); + EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B)); + + DivSqrA := 1 / Sqr(A); + DivSqrB := 1 / Sqr(B); + + NY := B; + AddEdge(Floor(CX1), Round(CY1 + B) - 1); + for X := 1 to Pred(EX) do + begin + NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA); + + AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1); + end; + + LX1 := Floor(CX1) + Pred(EX); + LY1 := Round(CY1 + NY) - 1; + + NX := A; + AddEdge(Round(CX1 + A) - 1, Floor(CY1)); + for Y := 1 to Pred(EY) do + begin + NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB); + + AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y); + end; + + LX2 := Round(CX1 + NX) - 1; + LY2 := Floor(CY1) + Pred(EY); + + if Abs(LX1 - LX2) > 1 then + begin + if Abs(LY1 - LY2) > 1 then + AddEdge(LX1 + 1, LY1 - 1) + else + AddEdge(LX1 + 1, LY1); + end + else + if Abs(LY1 - LY2) > 1 then + AddEdge(LX2, LY1 - 1); + + for I := 0 to High(EdgeList) do + begin + if EdgeList[I].X = -1 then + EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1) + else + Break; + end; + + J := 0; + while J < Length(EdgeList) do + begin + if (J = 0) and (Frac(CY) > 0) then + begin + if not skipBorder then + for I := EdgeList[J].X to EdgeList[J].Y do + begin + dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); + dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha); + end; + + if not SkipFill then + dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) + + Pred(EdgeList[J].X), FillColor, AAlpha); + end + else + if (J = High(EdgeList)) then + begin + if Frac(CX) > 0 then + S := -EdgeList[J].Y + else + S := -Succ(EdgeList[J].Y); + + if not skipBorder then + for I := S to EdgeList[J].Y do + begin + dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); + dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha); + end; + end + else + begin + if not skipBorder then + for I := EdgeList[J].X to EdgeList[J].Y do + begin + dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); + dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha); + if Floor(CX) + I <> Ceil(CX) - Succ(I) then + begin + dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha); + dest.DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor, AAlpha); + end; + end; + + if not SkipFill then + begin + RowStart := Ceil(CX) - EdgeList[J].X; + RowEnd := Floor(CX) + Pred(EdgeList[J].X); + if RowEnd >= RowStart then + begin + dest.HorizLine(RowStart, Floor(CY) + J, + RowEnd, FillColor, AAlpha); + dest.HorizLine(RowStart, Ceil(CY) - Succ(J), + RowEnd, FillColor, AAlpha); + end; + end; + + end; + Inc(J); + end; +end; + +procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, + Y2: integer; DX, DY: integer; FillColor: TBGRAPixel; + FillTexture: IBGRAScanner; ADrawMode: TDrawMode); +var + fi: TFillRoundRectangleInfo; +begin + fi := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,dx/2,dy/2,[rrDefault],false); + FillShapeAliased(dest, fi, FillColor, false, FillTexture, true, ADrawMode); + fi.Free; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraqtbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraqtbitmap.pas new file mode 100644 index 0000000..91d569d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraqtbitmap.pas @@ -0,0 +1,158 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgraqtbitmap.pas + ----------------- + This unit should NOT be added to the 'uses' clause. + It contains patches for Qt. +} + +unit BGRAQtBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALCLBitmap, Graphics, + GraphType, BGRABitmapTypes; + +type + { TBGRAQtBitmap } + + TBGRAQtBitmap = class(TBGRALCLBitmap) + private + procedure SlowDrawTransparent(ABitmap: TBGRACustomBitmap; + ACanvas: TCanvas; ARect: TRect); + public + procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override; + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; + end; + +implementation + +uses LCLType, + LCLIntf, IntfGraphics, + qtobjects, {$ifdef LCLqt5}qt5{$else}qt4{$endif}, + FPImage; + +procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRACustomBitmap; + ACanvas: TCanvas; ARect: TRect); +begin + ACanvas.StretchDraw(ARect, ABitmap.Bitmap); +end; + +procedure TBGRAQtBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + Temp: TBGRALCLPtrBitmap; +begin + Temp := TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData); + Temp.LineOrder := ALineOrder; + SlowDrawTransparent(Temp, ACanvas, Rect); + Temp.Free; +end; + +procedure TBGRAQtBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +{$IFDEF DARWIN} +var + psrc,pdest: PBGRAPixel; + bmp: TBGRAQtBitmap; + x, y: integer; +{$ENDIF} +begin + {$IFDEF DARWIN} + bmp := TBGRAQtBitmap.Create(AWidth,AHeight); + try + if ALineOrder = riloTopToBottom then psrc := AData + else psrc := PBGRAPixel(AData) + (AWidth*(AHeight-1)); + for y := 0 to AHeight-1 do + begin + pdest := bmp.ScanLine[y]; + for x := 0 to AWidth-1 do + begin + pdest^.red := psrc^.red; + pdest^.green:= psrc^.green; + pdest^.blue := psrc^.blue; + pdest^.alpha := 255; + inc(psrc); + inc(pdest); + end; + if ALineOrder = riloBottomToTop then dec(psrc, 2*AWidth); + end; + bmp.Draw(ACanvas, ARect, false); + finally + bmp.Free; + end; + {$ELSE} + inherited DataDrawOpaque(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight); + {$ENDIF} +end; + +procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + if self = nil then + exit; + if Opaque then + DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, FLineOrder, + FWidth, FHeight) + else + SlowDrawTransparent(Self, ACanvas, Rect(X, Y, X + Width, Y + Height)); +end; + +procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +begin + if self = nil then + exit; + if Opaque then + DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight) + else + SlowDrawTransparent(Self, ACanvas, Rect); +end; + +procedure TBGRAQtBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); +var + bmp: TBitmap; + Ofs: TPoint; + SrcX, SrcY: integer; + dcSource, dcDest: TQtDeviceContext; + B: Boolean; +begin + DiscardBitmapChange; + bmp := TBitmap.Create; + bmp.PixelFormat := pf24bit; + bmp.Width := Width; + bmp.Height := Height; + dcDest := TQtDeviceContext(bmp.Canvas.handle); + + dcSource := TQtDeviceContext(CanvasSource.Handle); + LCLIntf.GetWindowOrgEx(CanvasSource.Handle, @Ofs); + + SrcX := x + Ofs.X; + SrcY := y + Ofs.Y; + + if (dcSource.vImage <> nil) and (dcSource.vImage.Handle <> nil) then + begin + // we must stop painting on device + B := QPainter_isActive(dcDest.Widget); + if B then + QPainter_end(dcDest.Widget); + TQtImage(bmp.Handle).CopyFrom(dcSource.vImage.Handle, + SrcX, SrcY, Width, Height); + if B then + QPainter_begin(dcDest.Widget, TQtImage(bmp.Handle).Handle); + end; + + LoadFromRawImage(bmp.RawImage, 255, True); + bmp.Free; + InvalidateBitmap; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmp.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmp.pas new file mode 100644 index 0000000..49d0435 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmp.pas @@ -0,0 +1,1112 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{*****************************************************************************} +{ + This original file was part of the Free Pascal's "Free Components Library". + Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team + + BMP reader implementation modified by circular. +} +{*****************************************************************************} +{ 08/2005 by Giulio Bernardi: + - Added support for 16 and 15 bpp bitmaps. + - If we have bpp <= 8 make an indexed image instead of converting it to RGB + - Support for RLE4 and RLE8 decoding + - Support for top-down bitmaps + + 03/2014 by circular: + - RLE optimisation using a read buffer + - direct access to pixels with TBGRABitmap + - vertical shrink option with MinifyHeight,WantedHeight,OutputHeight (useful for thumbnails) + 01/2017 by circular: + - support for OS/2 1.x format + - support for headerless files +} + +{$mode objfpc} +{$h+} + +unit BGRAReadBMP; + +interface + +uses FPImage, BGRAClasses, SysUtils, BMPcomn, BGRABitmapTypes; + +type + TBMPTransparencyOption = (toAuto, toTransparent, toOpaque); + TBitMapInfoHeader = BMPcomn.TBitMapInfoHeader; + TBitMapFileHeader = BMPcomn.TBitMapFileHeader; + TOS2BitmapHeader = packed record + bcSize: LongWord; + bcWidth: Word; + bcHeight: Word; + bcPlanes: Word; + bcBitCount: Word; + end; + TMinimumBitmapHeader = packed record + Size:longint; + Width:longint; + Height:longint; + Planes:word; + BitCount:word; + end; + TBitmapSubFormat = (bsfWithFileHeader, bsfHeaderless, bsfHeaderlessWithMask); + TReadScanlineProc = procedure(Row : Integer; Stream : TStream) of object; + TWriteScanlineProc = procedure(Row : Integer; Img : TFPCustomImage) of object; + TProgressProc = procedure(Percent: integer; var ShouldContinue: boolean) of object; + + + { TBGRAReaderBMP } + + TBGRAReaderBMP = class (TBGRAImageReader) + Private + DeltaX, DeltaY : integer; // Used for the never-used delta option in RLE + TopDown : boolean; // If set, bitmap is stored top down instead of bottom up + Procedure FreeBufs; // Free (and nil) buffers. + protected + ReadSize : Integer; // Size (in bytes) of 1 scanline. + BFH: TBitMapFileHeader; // The file header + BFI: TBitMapInfoHeader; // The header as read from the stream. + FPaletteEntrySize: integer; // 4 for Windows, 3 for OS/2 1.x + FPalette : PFPcolor; // Buffer with Palette entries. (useless now) + FBGRAPalette : PBGRAPixel; + LineBuf : PByte; // Buffer for 1 scanline. Can be Byte, Word, TColorRGB or TColorRGBA + RedMask, GreenMask, BlueMask : LongWord; //Used if Compression=bi_bitfields + RedShift, GreenShift, BlueShift : shortint; + FOutputHeight: integer; + FOriginalHeight: Integer; + FTransparencyOption: TBMPTransparencyOption; + FBuffer: packed array of byte; + FBufferPos, FBufferSize: integer; + FBufferStream: TStream; + FHasAlphaValues: boolean; + FMaskData: PByte; + FMaskDataSize: integer; + // SetupRead will allocate the needed buffers, and read the colormap if needed. + procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual; + function CountBits(Value : byte) : shortint; + function ShiftCount(Mask : LongWord) : shortint; + function ExpandColor(value : LongWord) : TFPColor; + function ExpandColorBGRA(value : LongWord) : TBGRAPixel; + procedure ExpandRLE8ScanLine(Row : Integer; Stream : TStream); + procedure ExpandRLE4ScanLine(Row : Integer; Stream : TStream); + procedure ReadScanLine(Row : Integer; Stream : TStream); virtual; + procedure SkipScanLine(Row : Integer; Stream : TStream); virtual; + procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual; + procedure WriteScanLineBGRA(Row : Integer; Img : TFPCustomImage); virtual; + procedure ReadMaskLine({%H-}Row : Integer; Stream : TStream); virtual; + procedure SkipMaskLine({%H-}Row : Integer; Stream : TStream); virtual; + procedure WriteMaskLine(Row : Integer; Img : TFPCustomImage); virtual; + // required by TFPCustomImageReader + procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; + function InternalCheck (Stream:TStream) : boolean; override; + procedure InitReadBuffer(AStream: TStream; ASize: integer); + procedure CloseReadBuffer; + function GetNextBufferByte: byte; + procedure MakeOpaque(Img: TFPCustomImage); + procedure LoadMask(Stream:TStream; Img:TFPCustomImage; var ShouldContinue: boolean); + procedure MainProgressProc(Percent: integer; var ShouldContinue: boolean); + procedure ImageVerticalLoop(Stream:TStream; Img:TFPCustomImage; + ReadProc, SkipProc: TReadScanlineProc; WriteProc: TWriteScanlineProc; + ProgressProc: TProgressProc; var ShouldContinue: boolean); + public + MinifyHeight,WantedHeight: integer; + Hotspot: TPoint; + Subformat: TBitmapSubFormat; + constructor Create; override; + destructor Destroy; override; + property OriginalHeight: integer read FOriginalHeight; + property OutputHeight: integer read FOutputHeight; + property TransparencyOption: TBMPTransparencyOption read FTransparencyOption write FTransparencyOption; + function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; + function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; + end; + +function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader; + +implementation + +uses math; + +function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader; +var header: PBitMapInfoHeader; + headerSize: integer; + extraSize: integer; + os2header: TOS2BitmapHeader; +begin + AData.Position := 0; + headerSize := LEtoN(AData.ReadDWord); + if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x + begin + AData.ReadBuffer({%H-}os2header,sizeof(os2header)); + if LEtoN(os2header.bcBitCount) in [1,2,4,8] then + begin + extraSize := 3*(1 shl LEtoN(os2header.bcBitCount)); + end else + extraSize := 0; + result.bfType:= Word('BM'); + result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size)); + result.bfReserved:= 0; + result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize)); + end else + begin + if (headerSize < 16) or (headerSize > AData.Size) or (headerSize > 1024) then + raise exception.Create('Invalid header size'); + getmem(header, headerSize); + try + fillchar(header^, headerSize,0); + header^.Size := NtoLE(headerSize); + AData.ReadBuffer((PByte(header)+4)^, headerSize-4); + if LEtoN(header^.Compression) = BI_BITFIELDS then + extraSize := 4*3 + else if LEtoN(header^.BitCount) in [1,2,4,8] then + begin + if header^.ClrUsed > 0 then + extraSize := 4*header^.ClrUsed + else + extraSize := 4*(1 shl header^.BitCount); + end else + extraSize := 0; + result.bfType:= Word('BM'); + result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size)); + result.bfReserved:= 0; + result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize)); + finally + freemem(header); + end; + end; +end; + +function RGBAToFPColor(Const RGBA: TColorRGBA) : TFPcolor; +begin + with Result, RGBA do + begin + Red :=(R shl 8) or R; + Green :=(G shl 8) or G; + Blue :=(B shl 8) or B; + Alpha :=(A shl 8) or A + end; +end; + +Function RGBToFPColor(Const RGB : TColorRGB) : TFPColor; + +begin + with Result,RGB do + begin {Use only the high byte to convert the color} + Red := (R shl 8) + R; + Green := (G shl 8) + G; + Blue := (B shl 8) + B; + Alpha := AlphaOpaque; + end; +end; + +constructor TBGRAReaderBMP.Create; + +begin + inherited create; + FTransparencyOption := toTransparent; + Subformat:= bsfWithFileHeader; +end; + +destructor TBGRAReaderBMP.Destroy; + +begin + FreeBufs; + inherited destroy; +end; + +function TBGRAReaderBMP.GetQuickInfo(AStream: TStream): TQuickImageInfo; +var headerSize: LongWord; + os2header: TOS2BitmapHeader; + minHeader: TMinimumBitmapHeader; + totalDepth: integer; + headerPos: int64; +begin + {$PUSH}{$HINTS OFF}fillchar({%H-}result, sizeof({%H-}result), 0);{$POP} + headerPos := AStream.Position; + if AStream.Read({%H-}headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit; + headerSize := LEtoN(headerSize); + + //check presence of file header + if (headerSize and $ffff) = BMmagic then + begin + inc(headerPos, sizeof(TBitMapFileHeader)); + AStream.Position := headerPos; + if AStream.Read(headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit; + headerSize := LEtoN(headerSize); + end; + + AStream.Position := headerPos; + + if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x + begin + if AStream.Read({%H-}os2header, sizeof(os2header)) <> sizeof(os2header) then exit; + result.width := LEtoN(os2header.bcWidth); + result.height := LEtoN(os2header.bcHeight); + result.colorDepth := LEtoN(os2header.bcBitCount); + result.alphaDepth := 0; + end + else + if headerSize >= sizeof(minHeader) then + begin + if AStream.Read({%H-}minHeader, sizeof(minHeader)) <> sizeof(minHeader) then exit; + result.width := LEtoN(minHeader.Width); + result.height := LEtoN(minHeader.Height); + totalDepth := LEtoN(minHeader.BitCount); + if totalDepth > 24 then + begin + result.colorDepth:= 24; + result.alphaDepth:= 8; + end else + begin + result.colorDepth := totalDepth; + result.alphaDepth:= 0; + end; + end else + begin + result.width := 0; + result.height:= 0; + result.colorDepth:= 0; + result.alphaDepth:= 0; + end; +end; + +function TBGRAReaderBMP.GetBitmapDraft(AStream: TStream; AMaxWidth, + AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; +var + bmpFormat: TBGRAReaderBMP; + prevStreamPos: Int64; +begin + bmpFormat:= TBGRAReaderBMP.Create; + bmpFormat.Subformat:= Subformat; + bmpFormat.MinifyHeight := AMaxHeight*2; + result := BGRABitmapFactory.Create; + prevStreamPos := AStream.Position; + try + result.LoadFromStream(AStream, bmpFormat); + AOriginalWidth:= result.Width; + AOriginalHeight:= bmpFormat.OriginalHeight; + finally + bmpFormat.Free; + AStream.Position := prevStreamPos; + end; +end; + +procedure TBGRAReaderBMP.FreeBufs; +begin + If (LineBuf<>Nil) then + begin + FreeMem(LineBuf); + LineBuf:=Nil; + end; + If (FPalette<>Nil) then + begin + FreeMem(FPalette); + FPalette:=Nil; + end; + If (FBGRAPalette<>Nil) then + begin + FreeMem(FBGRAPalette); + FBGRAPalette:=Nil; + end; +end; + +{ Counts how many bits are set } +function TBGRAReaderBMP.CountBits(Value : byte) : shortint; +var i,bits : shortint; +begin + bits:=0; + for i:=0 to 7 do + begin + if (value mod 2)<>0 then inc(bits); + value:=value shr 1; + end; + Result:=bits; +end; + +{ If compression is bi_bitfields, there could be arbitrary masks for colors. + Although this is not compatible with windows9x it's better to know how to read these bitmaps + We must determine how to switch the value once masked + Example: 0000 0111 1110 0000, if we shr 5 we have 00XX XXXX for the color, but these bits must be the + highest in the color, so we must shr (5-(8-6))=3, and we have XXXX XX00. + A negative value means "shift left" } +function TBGRAReaderBMP.ShiftCount(Mask : LongWord) : shortint; +var tmp : shortint; +begin + tmp:=0; + if Mask=0 then + begin + Result:=0; + exit; + end; + + while (Mask mod 2)=0 do { rightmost bit is 0 } + begin + inc(tmp); + Mask:= Mask shr 1; + end; + tmp:=tmp-(8-CountBits(Mask and $FF)); + Result:=tmp; +end; + +function TBGRAReaderBMP.ExpandColor(value : LongWord) : TFPColor; +var tmpr, tmpg, tmpb : LongWord; + col : TColorRGB; +begin + {$IFDEF ENDIAN_BIG} + value:=swap(value); + {$ENDIF} + tmpr:=value and RedMask; + tmpg:=value and GreenMask; + tmpb:=value and BlueMask; + if RedShift < 0 then col.R:=byte(tmpr shl (-RedShift)) + else col.R:=byte(tmpr shr RedShift); + if GreenShift < 0 then col.G:=byte(tmpg shl (-GreenShift)) + else col.G:=byte(tmpg shr GreenShift); + if BlueShift < 0 then col.B:=byte(tmpb shl (-BlueShift)) + else col.B:=byte(tmpb shr BlueShift); + Result:=RGBToFPColor(col); +end; + +function TBGRAReaderBMP.ExpandColorBGRA(value: LongWord): TBGRAPixel; +var tmpr, tmpg, tmpb : LongWord; +begin + {$IFDEF ENDIAN_BIG} + value:=swap(value); + {$ENDIF} + tmpr:=value and RedMask; + tmpg:=value and GreenMask; + tmpb:=value and BlueMask; + if RedShift < 0 then result.red:=byte(tmpr shl (-RedShift)) + else result.red:=byte(tmpr shr RedShift); + if GreenShift < 0 then result.green:=byte(tmpg shl (-GreenShift)) + else result.green:=byte(tmpg shr GreenShift); + if BlueShift < 0 then result.blue:=byte(tmpb shl (-BlueShift)) + else result.blue:=byte(tmpb shr BlueShift); + result.alpha:= 255; +end; + +procedure TBGRAReaderBMP.SetupRead(nPalette, nRowBits: Integer; Stream : TStream); + +var + ColInfo: ARRAY OF TColorRGBA; + ColInfo3: packed array of TColorRGB; + i,colorPresent: Integer; + +begin + if ((BFI.Compression=BI_RGB) and (BFI.BitCount=16)) then { 5 bits per channel, fixed mask } + begin + RedMask:=$7C00; RedShift:=7; + GreenMask:=$03E0; GreenShift:=2; + BlueMask:=$001F; BlueShift:=-3; + end + else if ((BFI.Compression=BI_BITFIELDS) and (BFI.BitCount in [16,32])) then { arbitrary mask } + begin + Stream.Read(RedMask,4); + Stream.Read(GreenMask,4); + Stream.Read(BlueMask,4); + {$IFDEF ENDIAN_BIG} + RedMask:=swap(RedMask); + GreenMask:=swap(GreenMask); + BlueMask:=swap(BlueMask); + {$ENDIF} + RedShift:=ShiftCount(RedMask); + GreenShift:=ShiftCount(GreenMask); + BlueShift:=ShiftCount(BlueMask); + end + else if nPalette>0 then + begin + GetMem(FPalette, nPalette*SizeOf(TFPColor)); + GetMem(FBGRAPalette, nPalette*SizeOf(TBGRAPixel)); + SetLength(ColInfo, nPalette); + if BFI.ClrUsed>0 then + colorPresent:= min(BFI.ClrUsed,nPalette) + else + colorPresent:= nPalette; + if FPaletteEntrySize = 3 then + begin + setlength(ColInfo3, nPalette); + Stream.Read(ColInfo3[0],colorPresent*SizeOf(TColorRGB)); + for i := 0 to colorPresent-1 do + ColInfo[i].RGB := ColInfo3[i]; + end + else + begin + Stream.Read(ColInfo[0],colorPresent*SizeOf(TColorRGBA)); + end; + for i := 0 to High(ColInfo) do + begin + FPalette[i] := RGBToFPColor(ColInfo[i].RGB); + FBGRAPalette[i]:= FPColorToBGRA(FPalette[i]); + end + end + else if BFI.ClrUsed>0 then { Skip palette } + {$PUSH}{$HINTS OFF} + Stream.Position := Stream.Position + BFI.ClrUsed*SizeOf(TColorRGBA); + {$POP} + ReadSize:=((nRowBits + 31) div 32) shl 2; + GetMem(LineBuf,ReadSize); +end; + +procedure TBGRAReaderBMP.InternalRead(Stream:TStream; Img:TFPCustomImage); + +Var + i, pallen : Integer; + BadCompression : boolean; + WriteScanlineProc: TWriteScanlineProc; + headerSize: LongWord; + os2header: TOS2BitmapHeader; + shouldContinue: boolean; + +begin + shouldContinue:=true; + Progress(psStarting,0,false,EmptyRect,'',shouldContinue); + if not shouldContinue then exit; + + headerSize := LEtoN(Stream.ReadDWord); + fillchar({%H-}BFI,SizeOf(BFI),0); + if headerSize = sizeof(TOS2BitmapHeader) then + begin + fillchar({%H-}os2header,SizeOf(os2header),0); + Stream.Read(os2header.bcWidth,min(SizeOf(os2header),headerSize)-sizeof(LongWord)); + BFI.Size := 16; + BFI.Width := LEtoN(os2header.bcWidth); + BFI.Height := LEtoN(os2header.bcHeight); + BFI.Planes := LEtoN(os2header.bcPlanes); + BFI.BitCount := LEtoN(os2header.bcBitCount); + FPaletteEntrySize:= 3; + end else + begin + Stream.Read(BFI.Width,min(SizeOf(BFI),headerSize)-sizeof(LongWord)); + {$IFDEF ENDIAN_BIG} + SwapBMPInfoHeader(BFI); + {$ENDIF} + BFI.Size := headerSize; + FPaletteEntrySize:= 4; + end; + { This will move past any junk after the BFI header } + Stream.Position:=Stream.Position-SizeOf(BFI)+BFI.Size; + with BFI do + begin + BadCompression:=false; + if ((Compression=BI_RLE4) and (BitCount<>4)) then BadCompression:=true; + if ((Compression=BI_RLE8) and (BitCount<>8)) then BadCompression:=true; + if ((Compression=BI_BITFIELDS) and (not (BitCount in [16,32]))) then BadCompression:=true; + if not (Compression in [BI_RGB..BI_BITFIELDS]) then BadCompression:=true; + if BadCompression then + raise FPImageException.Create('Bad BMP compression mode'); + TopDown:=(Height<0); + Height:=abs(Height); + FOriginalHeight := Height; + if (TopDown and (not (Compression in [BI_RGB,BI_BITFIELDS]))) then + raise FPImageException.Create('Top-down bitmaps cannot be compressed'); + Img.SetSize(0,0); + if BitCount<=8 then + begin + Img.UsePalette:=true; + Img.Palette.Clear; + end + else Img.UsePalette:=false; + Case BFI.BitCount of + 1 : { Monochrome } + SetupRead(2,Width,Stream); + 4 : + SetupRead(16,Width*4,Stream); + 8 : + SetupRead(256,Width*8,Stream); + 16 : + SetupRead(0,Width*8*2,Stream); + 24: + SetupRead(0,Width*8*3,Stream); + 32: + SetupRead(0,Width*8*4,Stream); + else raise exception.Create('Invalid bit depth ('+inttostr(BFI.BitCount)+')'); + end; + end; + if Subformat = bsfHeaderlessWithMask then BFI.Height := BFI.Height div 2; + Try + { Note: it would be better to Fill the image palette in setupread instead of creating FPalette. + FPalette is indeed useless but we cannot remove it since it's not private :\ } + pallen:=0; + if BFI.BitCount<=8 then + if BFI.ClrUsed>0 then pallen:=BFI.ClrUsed + else pallen:=(1 shl BFI.BitCount); + if pallen>0 then + begin + if FPalette = nil then raise exception.Create('Internal error: palette object not initialized'); + Img.Palette.Count:=pallen; + for i:=0 to pallen-1 do + Img.Palette.Color[i]:=FPalette[i]; + end; + if (MinifyHeight > 0) and (MinifyHeight < BFI.Height) then FOutputHeight:= MinifyHeight else + if WantedHeight > 0 then FOutputHeight:= WantedHeight else + FOutputHeight:= BFI.Height; + + if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048); + FHasAlphaValues:= false; + + Img.SetSize(BFI.Width,FOutputHeight); + + if Img is TBGRACustomBitmap then + WriteScanlineProc := @WriteScanLineBGRA else + WriteScanlineProc := @WriteScanLine; + + ImageVerticalLoop(Stream, Img, @ReadScanLine, @SkipScanLine, WriteScanlineProc, + @MainProgressProc, shouldContinue); + + if shouldContinue then + begin + if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then + MakeOpaque(Img); + if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer; + + if Subformat = bsfHeaderlessWithMask then LoadMask(Stream,Img, shouldContinue); + + Progress(psEnding,100,false,EmptyRect,'',shouldContinue); + end; + + finally + FreeBufs; + end; +end; + +procedure TBGRAReaderBMP.ExpandRLE8ScanLine(Row : Integer; Stream : TStream); +var i,j,k : integer; + b0, b1 : byte; +begin + i:=0; + while true do + begin + { let's see if we must skip pixels because of delta... } + if DeltaY<>-1 then + begin + if Row=DeltaY then j:=DeltaX { If we are on the same line, skip till DeltaX } + else j:=ReadSize; { else skip up to the end of this line } + while (i0 then { number of repetitions } + begin + if b0+i>ReadSize then + raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); + j:=i+b0; + while (iReadSize then + raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); + for k := b1-1 downto 0 do + Begin + LineBuf[i] := GetNextBufferByte; + Inc(i); + end; + { aligned on 2 bytes boundary: every group starts on a 2 bytes boundary, but absolute group + could end on odd address if there is a odd number of elements, so we pad it } + if (b1 mod 2)<>0 then GetNextBufferByte; + end; + end; + end; +end; + +procedure TBGRAReaderBMP.ExpandRLE4ScanLine(Row : Integer; Stream : TStream); +var i,j,tmpsize : integer; + b0, b1 : byte; + nibline : pbyte; { temporary array of nibbles } + even : boolean; +begin + tmpsize:=ReadSize*2; { ReadSize is in bytes, while nibline is made of nibbles, so it's 2*readsize long } + getmem(nibline,tmpsize); + if nibline=nil then + raise FPImageException.Create('Out of memory'); + try + i:=0; + while true do + begin + { let's see if we must skip pixels because of delta... } + if DeltaY<>-1 then + begin + if Row=DeltaY then j:=DeltaX { If we are on the same line, skip till DeltaX } + else j:=tmpsize; { else skip up to the end of this line } + while (i0 then { number of repetitions } + begin + if b0+i>tmpsize then + raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); + even:=true; + j:=i+b0; + while (itmpsize then + raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); + j:=i+b1; + even:=true; + while (i0 then GetNextBufferByte; + end; + end; + end; + { pack the nibline into the linebuf } + for i:=0 to ReadSize-1 do + LineBuf[i]:=(NibLine[i*2] shl 4) or NibLine[i*2+1]; + finally + FreeMem(nibline) + end; +end; + +procedure TBGRAReaderBMP.ReadScanLine(Row : Integer; Stream : TStream); +begin + if BFI.Compression=BI_RLE8 then ExpandRLE8ScanLine(Row,Stream) + else if BFI.Compression=BI_RLE4 then ExpandRLE4ScanLine(Row,Stream) + else Stream.Read(LineBuf[0],ReadSize); +end; + +procedure TBGRAReaderBMP.SkipScanLine(Row: Integer; Stream: TStream); +begin + if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then ReadScanLine(Row,Stream) + else Stream.Position := Stream.Position+ReadSize; +end; + +procedure TBGRAReaderBMP.WriteScanLine(Row : Integer; Img : TFPCustomImage); + +Var + Column : Integer; + c: TFPColor; +begin + Case BFI.BitCount of + 1 : + for Column:=0 to Img.Width-1 do + if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then + img.Pixels[Column,Row]:=1 + else + img.Pixels[Column,Row]:=0; + 4 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f; + 8 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=LineBuf[Column]; + 16 : + for Column:=0 to img.Width-1 do + img.colors[Column,Row]:=ExpandColor(PWord(LineBuf)[Column]); + 24 : + for Column:=0 to img.Width-1 do + img.colors[Column,Row]:=RGBToFPColor(PColorRGB(LineBuf)[Column]); + 32 : + for Column:=0 to img.Width-1 do + if BFI.Compression=BI_BITFIELDS then + img.colors[Column,Row]:=ExpandColor(PLongWord(LineBuf)[Column]) + else + begin + if FTransparencyOption = toOpaque then + img.colors[Column,Row]:=RGBToFPColor(PColorRGB(PColorRGBA(LineBuf)+Column)^) + else + begin + c := RGBAToFPColor(PColorRGBA(LineBuf)[Column]); + if c.alpha <> 0 then FHasAlphaValues:= true; + img.colors[Column,Row]:= c; + end; + end; + end; +end; + +procedure TBGRAReaderBMP.WriteScanLineBGRA(Row: Integer; Img: TFPCustomImage); + +Var + Column : Integer; + PDest: PBGRAPixel; + PSrc: PByte; +begin + PDest := TBGRACustomBitmap(Img).ScanLine[Row]; + Case BFI.BitCount of + 1 : + for Column:=0 to Img.Width-1 do + begin + if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then + PDest^ := FBGRAPalette[1] + else + PDest^ := FBGRAPalette[0]; + inc(PDest); + end; + 4 : + for Column:=0 to img.Width-1 do + begin + PDest^ := FBGRAPalette[(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f]; + inc(PDest); + end; + 8 : + for Column:=0 to img.Width-1 do + begin + PDest^ := FBGRAPalette[LineBuf[Column]]; + inc(PDest); + end; + 16 : + for Column:=0 to img.Width-1 do + begin + PDest^ :=ExpandColorBGRA(PWord(LineBuf)[Column]); + inc(PDest); + end; + 24 : begin + PSrc := LineBuf; + for Column:=0 to img.Width-1 do + begin + PDest^ := BGRA((Psrc+2)^,(Psrc+1)^,(Psrc)^); + inc(PDest); + inc(PSrc,3); + end; + end; + 32 : + if BFI.Compression=BI_BITFIELDS then + begin + for Column:=0 to img.Width-1 do + begin + PDest^:=ExpandColorBGRA(PLongWord(LineBuf)[Column]); + inc(PDest); + end; + end else + if FTransparencyOption = toOpaque then + begin + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + begin + PSrc := LineBuf; + for Column:=0 to img.Width-1 do + begin + PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^); + inc(PDest); + Inc(PSrc,4); + end; + end + else + begin + PSrc := LineBuf; + for Column:=0 to img.Width-1 do + begin + PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc+1)^); + inc(PDest); + Inc(PSrc,4); + end; + end; + {$POP} + end else + begin + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + begin + PSrc := LineBuf; + for Column:=0 to img.Width-1 do + begin + PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc)^,(PSrc+3)^); + if PDest^.alpha <> 0 then FHasAlphaValues:= true; + inc(PDest); + Inc(PSrc,4); + end; + end + else + begin + PSrc := LineBuf; + for Column:=0 to img.Width-1 do + begin + PDest^ := PBGRAPixel(PSrc)^; + if PDest^.alpha <> 0 then FHasAlphaValues:= true; + inc(PDest); + Inc(PSrc,4); + end; + end; + {$POP} + end; + end; +end; + +procedure TBGRAReaderBMP.ReadMaskLine(Row: Integer; Stream: TStream); +begin + FillChar(FMaskData^, FMaskDataSize, 0); + Stream.Read(FMaskData^, FMaskDataSize); +end; + +procedure TBGRAReaderBMP.SkipMaskLine(Row: Integer; Stream: TStream); +begin + Stream.Position := Stream.Position+FMaskDataSize; +end; + +procedure TBGRAReaderBMP.WriteMaskLine(Row: Integer; Img: TFPCustomImage); +var x, maskPos: integer; + bit: byte; + bmp: TBGRACustomBitmap; + pimg: PBGRAPixel; +begin + if Img is TBGRACustomBitmap then + bmp := TBGRACustomBitmap(Img) + else + exit; + + maskPos := 0; + bit := $80; + pimg := bmp.ScanLine[Row]; + for x := 0 to bmp.Width-1 do + begin + if (FMaskData[maskPos] and bit) <> 0 then //if AND mask is non zero, value is kept + begin + if pimg^.alpha = 255 then + begin + pimg^.alpha := 0; + if LongWord(pimg^) <> 0 then + begin + bmp.NeedXorMask; + bmp.XorMask.SetPixel(x,Row,pimg^); + end; + end; + end; + inc(pimg); + bit := bit shr 1; + if bit = 0 then + begin + bit := $80; + inc(maskPos); + end; + end; +end; + +function TBGRAReaderBMP.InternalCheck (Stream:TStream) : boolean; +begin + fillchar(BFH, sizeof(BFH), 0); + if Subformat in [bsfHeaderless,bsfHeaderlessWithMask] then + begin + result := true; + Hotspot := Point(0,0); + end else + begin + if stream.Read(BFH,SizeOf(BFH)) <> sizeof(BFH) then + begin + result := false; + exit; + end; + Hotspot := Point(LEtoN(PWord(@BFH.bfReserved)^),LEtoN((PWord(@BFH.bfReserved)+1)^)); + {$IFDEF ENDIAN_BIG} + SwapBMPFileHeader(BFH); + {$ENDIF} + With BFH do + Result:=(bfType=BMmagic); // Just check magic number + end; +end; + +procedure TBGRAReaderBMP.InitReadBuffer(AStream: TStream; ASize: integer); +begin + setLength(FBuffer,ASize); + FBufferSize := AStream.Read(FBuffer[0],ASize); + FBufferPos := 0; + FBufferStream := AStream; +end; + +procedure TBGRAReaderBMP.CloseReadBuffer; +begin + FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; +end; + +function TBGRAReaderBMP.GetNextBufferByte: byte; +begin + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + if FBufferSize = 0 then + result := 0 + else + begin + FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); + FBufferPos := 0; + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + result := 0; + end; +end; + +procedure TBGRAReaderBMP.MakeOpaque(Img: TFPCustomImage); +var c: TFPColor; + x,y: Int32or64; +begin + if Img is TBGRACustomBitmap then + TBGRACustomBitmap(Img).AlphaFill(255) + else + for y := 0 to Img.Height-1 do + for x := 0 to Img.Width-1 do + begin + c := Img.Colors[x,y]; + c.alpha := alphaOpaque; + Img.Colors[x,y] := c; + end; +end; + +procedure TBGRAReaderBMP.LoadMask(Stream: TStream; Img: TFPCustomImage; var ShouldContinue: boolean); +begin + if Img is TBGRACustomBitmap then TBGRACustomBitmap(Img).DiscardXorMask; + FMaskDataSize := ((Img.Width+31) div 32)*4; //padded to LongWord + getmem(FMaskData, FMaskDataSize); + try + ImageVerticalLoop(Stream,Img, @ReadMaskLine, @SkipMaskLine, @WriteMaskLine, nil, ShouldContinue); + finally + freemem(FMaskData); + FMaskData := nil; + FMaskDataSize := 0; + end; +end; + +procedure TBGRAReaderBMP.MainProgressProc(Percent: integer; + var ShouldContinue: boolean); +begin + Progress(psRunning,Percent,false,EmptyRect,'',ShouldContinue); +end; + +procedure TBGRAReaderBMP.ImageVerticalLoop(Stream: TStream; + Img: TFPCustomImage; ReadProc, SkipProc: TReadScanlineProc; + WriteProc: TWriteScanlineProc; ProgressProc: TProgressProc; + var ShouldContinue: boolean); +var + prevPercent, percent, percentAdd : byte; + percentMod : LongWord; + percentAcc, percentAccAdd : LongWord; + PrevSourceRow,SourceRow, SourceRowDelta, SourceLastRow: integer; + SourceRowAdd: integer; + SourceRowAcc,SourceRowMod: integer; + SourceRowAccAdd: integer; + OutputLastRow, OutputRow, OutputRowDelta: integer; +begin + if OutputHeight <= 0 then exit; + + percent:=0; + percentMod:= OutputHeight; + percentAdd := 100 div percentMod; + percentAcc:= percentMod div 2; + percentAccAdd := 100 mod percentMod; + + DeltaX:=-1; DeltaY:=-1; + if TopDown then + begin + SourceRowDelta := 1; + SourceRow := 0; + SourceLastRow := BFI.Height-1; + end else + begin + SourceRowDelta := -1; + SourceRow := BFI.Height-1; + SourceLastRow := 0; + end; + OutputRowDelta:= SourceRowDelta; + + SourceRowMod := OutputHeight; + SourceRowAdd := (BFI.Height div SourceRowMod)*SourceRowDelta; + SourceRowAcc := SourceRowMod div 2; + SourceRowAccAdd := BFI.Height mod SourceRowMod; + If TopDown then + begin + OutputRow := 0; + OutputLastRow := OutputHeight-1; + end + else + begin + OutputRow := OutputHeight-1; + OutputLastRow := 0; + end; + + PrevSourceRow := SourceRow-SourceRowDelta; + + while ShouldContinue and (SourceRow <> SourceLastRow+SourceRowDelta) do + begin + while PrevSourceRow <> SourceRow do + begin + inc(PrevSourceRow, SourceRowDelta); + if PrevSourceRow = SourceRow then + ReadProc(PrevSourceRow,Stream) + else + SkipProc(PrevSourceRow,Stream); + end; + WriteProc(OutputRow,Img); + if OutputRow = OutputLastRow then break; + + inc(OutputRow,OutputRowDelta); + inc(SourceRow,SourceRowAdd); + inc(SourceRowAcc,SourceRowAccAdd); + if SourceRowAcc >= SourceRowMod then + begin + dec(SourceRowAcc,SourceRowMod); + Inc(SourceRow,SourceRowDelta); + end; + + prevPercent := percent; + inc(percent,percentAdd); + inc(percentAcc,percentAccAdd); + if percentAcc>=percentMod then + begin + dec(percentAcc, percentMod); + inc(percent); + end; + if (percent<>prevPercent) and Assigned(ProgressProc) then ProgressProc(percent, ShouldContinue); + end; +end; + +initialization + + DefaultBGRAImageReader[ifBmp] := TBGRAReaderBMP; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmpmiomap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmpmiomap.pas new file mode 100644 index 0000000..a4978cc --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmpmiomap.pas @@ -0,0 +1,260 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadBmpMioMap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, BGRABitmapTypes; + +const + MioMapMagicValue = 'RL'; + MioMapTransparentColor = $F81F; + +type + TMioHeader = packed record + magic: packed array[1..2] of char; + format: word; + width,height,nbColors,nbChunks: word; + end; + + TPixelArray = array of TBGRAPixel; + + { TBGRAReaderBmpMioMap } + + TBGRAReaderBmpMioMap = class(TFPCustomImageReader) + private + function ReadHeader(Stream: TStream; out header: TMioHeader): boolean; + function ReadPalette(Stream: TStream; nbColors: integer; alphaChannel: boolean): TPixelArray; + procedure UncompressChunks(Stream: TStream; nbChunks: integer; palette: TPixelArray; img: TFPCustomImage); + public + procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; + function InternalCheck (Stream:TStream) : boolean; override; + end; + +function MioMapToBGRA(AColor: Word): TBGRAPixel; +function BGRAToMioMap(const AColor: TBGRAPixel): Word; +function MioMapToAlpha(AValue: Byte): Byte; +function AlphaToMioMap(AValue: Byte): Byte; + +implementation + +uses bufstream; + +function MioMapToBGRA(AColor: Word): TBGRAPixel; +begin + if AColor = MioMapTransparentColor then + result := BGRAPixelTransparent + else + result := Color16BitToBGRA(AColor); +end; + +function BGRAToMioMap(const AColor: TBGRAPixel): Word; +begin + if AColor.alpha < 7 then + result := MioMapTransparentColor + else + begin + result := BGRAToColor16Bit(AColor); + if result = MioMapTransparentColor then dec(result); + end; +end; + +function MioMapToAlpha(AValue: Byte): Byte; +begin + result := AValue*255 div 32; +end; + +function AlphaToMioMap(AValue: Byte): Byte; +begin + result := (AValue*32 + 64) div 255; +end; + +{ TBGRAReaderBmpMioMap } + +function TBGRAReaderBmpMioMap.ReadHeader(Stream: TStream; out header: TMioHeader + ): boolean; +begin + result := false; + fillchar({%H-}header,sizeof(header),0); + if stream.Read(header, sizeof(header))<> sizeof(header) then exit; + if header.magic <> MioMapMagicValue then exit; + header.format:= LEtoN(header.format); + header.width:= LEtoN(header.width); + header.height:= LEtoN(header.height); + header.nbColors:= LEtoN(header.nbColors); + header.nbChunks:= LEtoN(header.nbChunks); + if header.format > 1 then exit; + result := true; +end; + +function TBGRAReaderBmpMioMap.ReadPalette(Stream: TStream; nbColors: integer; + alphaChannel: boolean): TPixelArray; +var mioPalette: packed array of word; + nbColorsRead,i: integer; + colorValue: word; + alphaPalette: packed array of byte; +begin + setlength(mioPalette, nbColors); + setlength(result,nbColors); + nbColorsRead:= Stream.Read({%H-}mioPalette[0], nbColors*2) div 2; + for i := 0 to nbColorsRead-1 do + begin + colorValue := LEtoN(mioPalette[i]); + result[i] := MioMapToBGRA(colorValue); + end; + for i := nbColorsRead to nbColors-1 do + result[i] := BGRAPixelTransparent; + if alphaChannel then + begin + setlength(alphaPalette,nbColors); + Stream.Read(alphaPalette[0],nbColors); + for i := 0 to nbColors-1 do + if mioPalette[i] <> MioMapTransparentColor then + result[i].alpha := MioMapToAlpha(alphaPalette[i]); + end; +end; + +procedure TBGRAReaderBmpMioMap.UncompressChunks(Stream: TStream; nbChunks: integer; + palette: TPixelArray; img: TFPCustomImage); +var i,maxChunkSize: integer; + chunkSizes: array of integer; + chunkData: packed array of byte; + pos,bytesRead: integer; + palLen: integer; + x,y: integer; + p: PBGRAPixel; + colorOffset: integer; + b: byte; + w,h: integer; + + procedure UncompressPixel(colorNumber, repeatCount: integer); + var + c: TBGRAPixel; + begin + if colorNumber >= palLen then + c := BGRAPixelTransparent + else + c := palette[colorNumber]; + while (repeatCount > 0) and (y < h) do + begin + if p <> nil then + begin + p^ := c; + inc(p); + end else + img.Colors[x,y] := BGRAToFPColor(c); + inc(x); + if x = w then + begin + x := 0; + inc(y); + if p <> nil then + begin + if y >= h then p := nil + else + p := TBGRACustomBitmap(Img).ScanLine[y]; + end; + end; + dec(repeatCount); + end; + end; + +begin + palLen := length(palette); + if (img.Width = 0) or (img.Height = 0) or (palLen = 0) then exit; + + maxChunkSize := 1; + setlength(chunkSizes, nbChunks); + for i := 0 to nbChunks-1 do + begin + if stream.read({%H-}b,1)=0 then b := 0; + if b < 255 then + begin + chunkSizes[i] := b; + end else + begin + if stream.read(b,1)=0 then b := 0; + chunkSizes[i] := b shl 8; + if stream.read(b,1)=0 then b := 0; + inc(chunkSizes[i], b); + end; + if chunkSizes[i]>maxChunkSize then + maxChunkSize := chunkSizes[i]; + end; + + setlength(chunkData, maxChunkSize); + x := 0; + y := 0; + w := img.Width; + h := img.Height; + colorOffset:= 0; + if Img is TBGRACustomBitmap then + begin + p := TBGRACustomBitmap(Img).ScanLine[y]; + TBGRACustomBitmap(Img).FillTransparent; + end + else + p := nil; + for i:= 0 to nbChunks-1 do + begin + bytesRead := Stream.Read(chunkData[0], chunkSizes[i]); + pos := 0; + while pos < bytesRead do + begin + if (chunkData[pos] = $FE) and (pos+2 < bytesRead) then + begin + UncompressPixel(chunkData[pos+1]+colorOffset,chunkData[pos+2]); + inc(pos,3); + end else + if (chunkData[pos] = $ff) and (pos+1 < bytesRead) then + begin + UncompressPixel(0,chunkData[pos+1]); + inc(pos,2); + end else + if (chunkData[pos] = $fd) and (pos+2 < bytesRead) then + begin + colorOffset:= chunkData[pos+1] + (chunkData[pos+2] shl 8); + inc(pos,3); + end else + if chunkData[pos] = 0 then + begin + UncompressPixel(0,1); + inc(pos); + end else + begin + UncompressPixel(chunkData[pos]+colorOffset,1); + inc(pos); + end; + end; + end; +end; + +procedure TBGRAReaderBmpMioMap.InternalRead(Stream: TStream; Img: TFPCustomImage); +var header: TMioHeader; + palette: TPixelArray; + buf: TReadBufStream; +begin + if not ReadHeader(stream, header) then exit; + buf := TReadBufStream.Create(Stream,1024); + Img.SetSize(header.width,header.height); + palette := ReadPalette(stream, header.nbColors, header.format = 1); + UncompressChunks(stream,header.nbChunks, palette, Img); + buf.Free; +end; + +function TBGRAReaderBmpMioMap.InternalCheck(Stream: TStream): boolean; +var OldPosition : int64; + dummy: TMioHeader; +begin + OldPosition:= stream.Position; + result := ReadHeader(stream, dummy); + stream.Position:= OldPosition; +end; + +initialization + + DefaultBGRAImageReader[ifBmpMioMap] := TBGRAReaderBmpMioMap; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadgif.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadgif.pas new file mode 100644 index 0000000..e14a03e --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadgif.pas @@ -0,0 +1,381 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ This unit provides some optimisations of TFPReaderGif: decompression algorithm and direct pixel access of TBGRABitmap. + Note: to read an animation use TBGRAAnimatedGif instead. } + +unit BGRAReadGif; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, FPReadGif; + +type + PGifRGB = ^TGifRGB; + + { TBGRAReaderGif } + + TBGRAReaderGif = class(TFPReaderGif) + protected + procedure ReadPaletteAtOnce(Stream: TStream; Size: integer); + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + function ReadScanLine(Stream: TStream): boolean; override; + function WriteScanLineBGRA(Img: TFPCustomImage): Boolean; virtual; + end; + +implementation + +uses BGRABitmapTypes; + +{ TBGRAReaderGif } + +procedure TBGRAReaderGif.ReadPaletteAtOnce(Stream: TStream; Size: integer); +Var + RGBEntries, RGBEntry : PGifRGB; + I : Integer; + c : TFPColor; +begin + FPalette.count := 0; + getmem(RGBEntries, sizeof(TGifRGB)*Size); + Stream.Read(RGBEntries^, sizeof(TGifRGB)*Size); + For I:=0 To Size-1 Do + Begin + RGBEntry := RGBEntries+I; + With c do + begin + Red:=RGBEntry^.Red or (RGBEntry^.Red shl 8); + Green:=RGBEntry^.Green or (RGBEntry^.Green shl 8); + Blue:=RGBEntry^.Blue or (RGBEntry^.Blue shl 8); + Alpha:=alphaOpaque; + end; + FPalette.Add(C); + End; + FreeMem(RGBEntries); +end; + +procedure TBGRAReaderGif.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + Introducer:byte; + ColorTableSize :Integer; + ContProgress: Boolean; +begin + FPalette:=nil; + FScanLine:=nil; + try + ContProgress:=true; + Progress(psStarting, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + + FPalette := TFPPalette.Create(0); + + Stream.Position:=0; + // header + Stream.Read(FHeader,SizeOf(FHeader)); + Progress(psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + + // Endian Fix Mantis 8541. Gif is always little endian + {$IFDEF ENDIAN_BIG} + with FHeader do + begin + ScreenWidth := LEtoN(ScreenWidth); + ScreenHeight := LEtoN(ScreenHeight); + end; + {$ENDIF} + // global palette + if (FHeader.Packedbit and $80) <> 0 then + begin + ColorTableSize := FHeader.Packedbit and 7 + 1; + ReadPaletteAtOnce(stream, 1 shl ColorTableSize); + end; + + // skip extensions + Repeat + Introducer:=SkipBlock(Stream); + until (Introducer = $2C) or (Introducer = $3B); + + // descriptor + Stream.Read(FDescriptor, SizeOf(FDescriptor)); + {$IFDEF ENDIAN_BIG} + with FDescriptor do + begin + Left := LEtoN(Left); + Top := LEtoN(Top); + Width := LEtoN(Width); + Height := LEtoN(Height); + end; + {$ENDIF} + // local palette + if (FDescriptor.Packedbit and $80) <> 0 then + begin + ColorTableSize := FDescriptor.Packedbit and 7 + 1; + ReadPaletteAtOnce(stream, 1 shl ColorTableSize); + end; + + // parse header + if not AnalyzeHeader then exit; + + // create image + if Assigned(OnCreateImage) then + OnCreateImage(Self,Img); + Img.SetSize(FWidth,FHeight); + + // read pixels + if not ReadScanLine(Stream) then exit; + if Img is TBGRACustomBitmap then + begin + if not WriteScanLineBGRA(Img) then exit; + end else + if not WriteScanLine(Img) then exit; + + // ToDo: read further images + finally + FreeAndNil(FPalette); + ReAllocMem(FScanLine,0); + end; + Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress); +end; + +function TBGRAReaderGif.ReadScanLine(Stream: TStream): Boolean; +var + OldPos, + UnpackedSize, + PackedSize:longint; + I: Integer; + Data, + Bits, + Code: LongWord; + SourcePtr: PByte; + InCode: LongWord; + + CodeSize: LongWord; + CodeMask: LongWord; + FreeCode: LongWord; + OldCode: LongWord; + Prefix: array[0..4095] of LongWord; + Suffix, + Stack: array [0..4095] of Byte; + StackPointer, StackTop: PByte; + StackSize: integer; + DataComp, + Target: PByte; + {%H-}B, + {%H-}FInitialCodeSize, + FirstChar: Byte; + ClearCode, + EOICode: Word; + ContProgress: Boolean; + +begin + DataComp:=nil; + ContProgress:=true; + try + // read dictionary size + Stream.read({%H-}FInitialCodeSize, 1); + + // search end of compressor table + OldPos:=Stream.Position; + PackedSize := 0; + Repeat + Stream.read({%H-}B, 1); + if B > 0 then + begin + inc(PackedSize, B); + Stream.Seek(B, soFromCurrent); + end; + until B = 0; + + Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), + False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit(false); + + Getmem(DataComp, PackedSize); + // read compressor table + SourcePtr:=DataComp; + Stream.Position:=OldPos; + Repeat + Stream.read(B, 1); + if B > 0 then + begin + Stream.ReadBuffer(SourcePtr^, B); + Inc(SourcePtr,B); + end; + until B = 0; + + Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), + False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit(false); + + SourcePtr:=DataComp; + Target := FScanLine; + CodeSize := FInitialCodeSize + 1; + ClearCode := 1 shl FInitialCodeSize; + EOICode := ClearCode + 1; + FreeCode := ClearCode + 2; + OldCode := 4096; + CodeMask := (1 shl CodeSize) - 1; + UnpackedSize:=FWidth * FHeight; + for I := 0 to ClearCode - 1 do + begin + Prefix[I] := 4096; + Suffix[I] := I; + end; + StackTop := @Stack[high(Stack)]; + StackPointer := StackTop; + FirstChar := 0; + Data := 0; + Bits := 0; + // LZW decompression gif + while (UnpackedSize > 0) and (PackedSize > 0) do + begin + Inc(Data, SourcePtr^ shl Bits); + Inc(Bits, 8); + while Bits >= CodeSize do + begin + Code := Data and CodeMask; + Data := Data shr CodeSize; + Dec(Bits, CodeSize); + if Code = EOICode then Break; + if Code = ClearCode then + begin + CodeSize := FInitialCodeSize + 1; + CodeMask := (1 shl CodeSize) - 1; + FreeCode := ClearCode + 2; + OldCode := 4096; + Continue; + end; + if Code > FreeCode then Break; + if OldCode = 4096 then + begin + FirstChar := Suffix[Code]; + Target^ := FirstChar; + Inc(Target); + Dec(UnpackedSize); + OldCode := Code; + Continue; + end; + InCode := Code; + if Code = FreeCode then + begin + StackPointer^ := FirstChar; + dec(StackPointer); + Code := OldCode; + end; + while Code > ClearCode do + begin + StackPointer^ := Suffix[Code]; + dec(StackPointer); + Code := Prefix[Code]; + end; + FirstChar := Suffix[Code]; + StackPointer^ := FirstChar; + dec(StackPointer); + Prefix[FreeCode] := OldCode; + Suffix[FreeCode] := FirstChar; + if (FreeCode = CodeMask) and + (CodeSize < 12) then + begin + Inc(CodeSize); + CodeMask := (1 shl CodeSize) - 1; + end; + if FreeCode < 4095 then Inc(FreeCode); + OldCode := InCode; + StackSize := StackTop-StackPointer; + if StackSize > 0 then + begin + Move((StackPointer+1)^, Target^, StackSize); + inc(Target, StackSize); + StackPointer:= StackTop; + dec(UnpackedSize, StackSize); + end; + end; + Inc(SourcePtr); + Dec(PackedSize); + end; + Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), + False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit(false); + finally + if DataComp<>nil then + FreeMem(DataComp); + end; + Result:=true; +end; + +function TBGRAReaderGif.WriteScanLineBGRA(Img: TFPCustomImage): Boolean; +Var + Row, Col,i : Integer; + Pass, Every : byte; + P : PByte; + PBGRAPalette: PBGRAPixel; + PDest: PBGRAPixel; + function IsMultiple(NumberA, NumberB: Integer): Boolean; + begin + Result := (NumberA >= NumberB) and + (NumberB > 0) and + (NumberA mod NumberB = 0); + end; +begin + Result:=false; + P:=FScanLine; + getmem(PBGRAPalette, (FPalette.Count)*sizeof(TBGRAPixel)); + for i := 0 to FPalette.Count-1 do PBGRAPalette[i] := FPColorToBGRA(FPalette.Color[i]); + If FInterlace then + begin + For Pass := 1 to 4 do + begin + Case Pass of + 1 : begin + Row := 0; + Every := 8; + end; + 2 : begin + Row := 4; + Every := 8; + end; + 3 : begin + Row := 2; + Every := 4; + end; + else{4} + begin + Row := 1; + Every := 2; + end; + end; + Repeat + PDest := TBGRACustomBitmap(Img).ScanLine[Row]; + for Col:=Img.Width-1 downto 0 do + begin + PDest^ := PBGRAPalette[P^]; + Inc(P); + Inc(PDest); + end; + Inc(Row, Every); + until Row >= Img.Height; + end; + end + else + begin + for Row:=0 to Img.Height-1 do + begin + PDest := TBGRACustomBitmap(Img).ScanLine[Row]; + for Col:=Img.Width-1 downto 0 do + begin + PDest^ := PBGRAPalette[P^]; + Inc(P); + Inc(PDest); + end; + end; + end; + FreeMem(PBGRAPalette); + Result:=true; +end; + + +initialization + + DefaultBGRAImageReader[ifGif] := TBGRAReaderGif; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadico.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadico.pas new file mode 100644 index 0000000..aaacce9 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadico.pas @@ -0,0 +1,149 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadIco; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, FPimage{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; + +type + {$IFDEF BGRABITMAP_USE_LCL}TCustomIconClass = class of TCustomIcon;{$ENDIF} + TByteSet = set of byte; + + { TBGRAReaderIcoOrCur } + + TBGRAReaderIcoOrCur = class(TFPCustomImageReader) + protected + procedure InternalRead({%H-}Str: TStream; {%H-}Img: TFPCustomImage); override; + function InternalCheck(Str: TStream): boolean; override; + function ExpectedMagic: TByteSet; virtual; abstract; + {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; virtual; abstract;{$ENDIF} + public + WantedWidth, WantedHeight : integer; + end; + + TBGRAReaderIco = class(TBGRAReaderIcoOrCur) + protected + function ExpectedMagic: TByteSet; override; + {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF} + end; + + { TBGRAReaderCur } + + TBGRAReaderCur = class(TBGRAReaderIcoOrCur) + protected + function ExpectedMagic: TByteSet; override; + {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF} + end; + +implementation + +uses BGRABitmapTypes{$IFNDEF BGRABITMAP_USE_LCL}, BGRAIconCursor{$ENDIF}; + +{ TBGRAReaderCur } + +function TBGRAReaderCur.ExpectedMagic: TByteSet; +begin + result := [2]; +end; + +{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderCur.LazClass: TCustomIconClass; +begin + result := TCursorImage; +end;{$ENDIF} + +{ TBGRAReaderIco } + +function TBGRAReaderIco.ExpectedMagic: TByteSet; +begin + result := [1,2]; +end; + +{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderIco.LazClass: TCustomIconClass; +begin + result := TIcon; +end;{$ENDIF} + +{ TBGRAReaderIcoOrCur } + +procedure TBGRAReaderIcoOrCur.InternalRead(Str: TStream; Img: TFPCustomImage); +{$IFDEF BGRABITMAP_USE_LCL} +var ico: TCustomIcon; i,bestIdx: integer; + height,width: word; format:TPixelFormat; + bestHeight,bestWidth: integer; maxFormat: TPixelFormat; + compWidth,compHeight: integer; +begin + if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536; + if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536; + ico := LazClass.Create; + try + ico.LoadFromStream(Str); + bestIdx := -1; + bestHeight := 0; + bestWidth := 0; + maxFormat := pfDevice; + for i := 0 to ico.Count-1 do + begin + ico.GetDescription(i,format,height,width); + if (bestIdx = -1) or (abs(height-compHeight)+abs(width-compWidth) < abs(bestHeight-compHeight)+abs(bestWidth-compWidth)) or + ((height = bestHeight) and (width = bestWidth) and (format > maxFormat)) then + begin + bestIdx := i; + bestHeight := height; + bestWidth := width; + maxFormat := format; + end; + end; + if (bestIdx = -1) or (bestWidth = 0) or (bestHeight = 0) then + raise exception.Create('No adequate icon found') else + begin + ico.Current := bestIdx; + Img.Assign(ico); + end; + finally + ico.free; + end; +end; +{$ELSE} +var icoCur: TBGRAIconCursor; + compWidth,compHeight: integer; + bmp: TBGRACustomBitmap; +begin + if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536; + if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536; + icoCur := TBGRAIconCursor.Create(Str); + try + bmp := icoCur.GetBestFitBitmap(compWidth,compHeight); + try + Img.Assign(bmp); + finally + bmp.Free; + end; + finally + icoCur.Free; + end; +end; +{$ENDIF} + +function TBGRAReaderIcoOrCur.InternalCheck(Str: TStream): boolean; +var {%H-}magic: packed array[0..5] of byte; + oldPos: int64; +begin + oldPos := str.Position; + result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic)); + str.Position:= oldPos; + if result then + result := (magic[0] = $00) and (magic[1] = $00) and (magic[2] in ExpectedMagic) and (magic[3] = $00) and + (magic[4] + (magic[5] shl 8) > 0); +end; + +initialization + + DefaultBGRAImageReader[ifIco] := TBGRAReaderIco; + DefaultBGRAImageReader[ifCur] := TBGRAReaderCur; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadjpeg.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadjpeg.pas new file mode 100644 index 0000000..40d8996 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadjpeg.pas @@ -0,0 +1,63 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadJpeg; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPReadJPEG; + +type + TJPEGScale = FPReadJPEG.TJPEGScale; + TJPEGReadPerformance = FPReadJPEG.TJPEGReadPerformance; + +const + jsFullSize = FPReadJPEG.jsFullSize; + jsHalf = FPReadJPEG.jsHalf; + jsQuarter = FPReadJPEG.jsQuarter; + jsEighth = FPReadJPEG.jsEighth; + + jpBestQuality = FPReadJPEG.jpBestQuality; + jpBestSpeed = FPReadJPEG.jpBestSpeed; + +type + { TBGRAReaderJpeg } + + TBGRAReaderJpeg = class(TFPReaderJPEG) + constructor Create; override; + protected + function InternalCheck(Str: TStream): boolean; override; + end; + +implementation + +uses BGRABitmapTypes; + +{ TBGRAReaderJpeg } + +constructor TBGRAReaderJpeg.Create; +begin + inherited Create; + Performance := jpBestQuality; +end; + +function TBGRAReaderJpeg.InternalCheck(Str: TStream): boolean; +var {%H-}magic: packed array[0..3] of byte; + OldPos,BytesRead:int64; +begin + Result:=false; + if Str=nil then exit; + OldPos:= str.Position; + BytesRead := str.Read({%H-}magic,sizeof(magic)); + str.Position:=OldPos; + if BytesRead<>sizeof(magic) then exit; + if (magic[0] = $ff) and (magic[1] = $d8) and (magic[2] = $ff) and (magic[3] >= $c0) then result := true; +end; + +initialization + + DefaultBGRAImageReader[ifJpeg] := TBGRAReaderJpeg; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadlzp.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadlzp.pas new file mode 100644 index 0000000..cc0eb80 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadlzp.pas @@ -0,0 +1,377 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadLzp; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap; + +type + + { TBGRAReaderLazPaint } + + TBGRAReaderLazPaint = class(TFPCustomImageReader) + private + FHeight: integer; + FNbLayers: integer; + FWidth: integer; + FCaption: string; + FDimensionsAlreadyFetched: boolean; + protected + procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; + procedure InternalReadLayers({%H-}str: TStream;{%H-}Img: TFPCustomImage); virtual; + procedure InternalReadCompressableBitmap(str: TStream; Img: TFPCustomImage); virtual; + function InternalCheck(Str: TStream): boolean; override; + public + WantThumbnail: boolean; + class procedure LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string); static; + property Width: integer read FWidth; + property Height: integer read FHeight; + property NbLayers: integer read FNbLayers; + property Caption: string read FCaption; + end; + +implementation + +uses BGRACompressableBitmap, BGRAReadPng; + +{ TBGRAReaderLazPaint } + +procedure TBGRAReaderLazPaint.InternalRead(Str: TStream; Img: TFPCustomImage); +var + {%H-}header: TLazPaintImageHeader; + oldPos: int64; + png: TBGRAReaderPNG; + +begin + FCaption := ''; + FWidth:= 0; + FHeight:= 0; + FNbLayers:= 0; + FDimensionsAlreadyFetched:= false; + oldPos := str.Position; + str.ReadBuffer({%H-}header.magic,sizeof(header.magic)); + if header.magic = LAZPAINT_MAGIC_HEADER then + begin + str.ReadBuffer(header.zero1, sizeof(header)-sizeof(header.magic)); + LazPaintImageHeader_SwapEndianIfNeeded(header); + if (header.zero1 <> 0) or (header.zero2 <> 0) or + (header.headerSize < $30) then raise exception.Create('Invalid file format'); + FWidth:= header.width; + FHeight:= header.height; + FNbLayers:= header.nbLayers; + FDimensionsAlreadyFetched:= true; + + if WantThumbnail and ((header.compressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0) then + begin + str.Position:= oldPos+header.headerSize; + png := TBGRAReaderPNG.create; + try + png.ImageRead(Str,Img); + except + png.Free; + raise exception.Create('Invalid file format'); + end; + png.free; + exit; + end; + + if ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_ZSTREAM) and + ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_RLE) then raise exception.Create('Compression mode not supported'); + + str.Position:= oldPos+header.previewOffset; + if (header.compressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_RLE then + LoadRLEImage(Str, Img, FCaption) + else + InternalReadCompressableBitmap(str,Img); + + if header.layersOffset > 0 then + begin + Str.Position:= oldPos+header.layersOffset; + InternalReadLayers(Str,Img); + end; + end else + begin + str.Position:= oldPos; + InternalReadCompressableBitmap(str,Img); + if (Str.Position < Str.Size) and (FCaption = 'Preview') then InternalReadLayers(Str,Img); + end; +end; + +procedure TBGRAReaderLazPaint.InternalReadLayers(str: TStream; + Img: TFPCustomImage); +begin + //not implemented here +end; + +procedure TBGRAReaderLazPaint.InternalReadCompressableBitmap(str: TStream; + Img: TFPCustomImage); +var + compressed: TBGRACompressableBitmap; + bmp: TBGRABitmap; +begin + compressed := TBGRACompressableBitmap.Create; + try + compressed.ReadFromStream(Str); + bmp := compressed.GetBitmap; + try + FCaption := compressed.Caption; + if (Img is TBGRACustomBitmap) then + TBGRACustomBitmap(Img).Assign(bmp) + else + Img.Assign(bmp); + if not FDimensionsAlreadyFetched then + begin + FDimensionsAlreadyFetched := true; + FWidth:= bmp.width; + FHeight:= bmp.height; + FNbLayers:= 1; + end; + finally + bmp.Free; + end; + finally + compressed.Free; + end; +end; + +function TBGRAReaderLazPaint.InternalCheck(Str: TStream): boolean; +var {%H-}magic: packed array[0..7] of byte; + magicAsText: string; + oldPos: int64; +begin + oldPos := str.Position; + result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic)); + str.Position:= oldPos; + setlength(magicAsText, sizeof(magic)); + move(magic[0], magicAsText[1], sizeof(magic)); + result := (copy(magicAsText,1,8) = 'LazPaint') or + (((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and + ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0)); +end; + +class procedure TBGRAReaderLazPaint.LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string); +var channelFlags: byte; + w,h,NbPixels,nameLen,channelStreamSize: LongWord; + nextPosition: int64; + PIndexed,PRed,PGreen,PBlue,PAlpha, + PCurRed, PCurGreen, PCurBlue, PCurAlpha: PByte; + PDest: PBGRAPixel; + x,y: LongWord; + c: TFPColor; + n,NbNonTransp: LongWord; + a,index: Int32or64; + ColorTab: packed array[0..256*3-1] of byte; +begin + w := LEtoN(str.ReadDWord); + h := LEtoN(str.ReadDWord); + nameLen := LEtoN(str.ReadDWord); + setlength(ACaption, nameLen); + {$PUSH}{$RANGECHECKS OFF} + str.ReadBuffer(ACaption[1], nameLen); + {$POP} + channelFlags := str.ReadByte; + NbPixels := w*h; + + PRed := nil; + PGreen := nil; + PBlue := nil; + PAlpha := nil; + + try + if (channelFlags and LazpaintChannelNoAlpha) = 0 then + begin + Getmem(PAlpha, NbPixels); + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + if (channelStreamSize > 0) and (NbPixels > 0) then DecodeLazRLE(Str, PAlpha^, NbPixels); + Str.Position:= nextPosition; + + NbNonTransp := 0; + PCurAlpha := PAlpha; + for n := NbPixels-1 downto 0 do + begin + if PCurAlpha^ <> 0 then inc(NbNonTransp); + inc(PCurAlpha); + end; + end else + NbNonTransp:= NbPixels; + + if NbNonTransp > 0 then + begin + if (channelFlags and LazpaintPalettedRGB) <> 0 then + begin + Getmem(PIndexed, NbNonTransp); + try + Getmem(PRed, NbNonTransp); + Getmem(PGreen, NbNonTransp); + Getmem(PBlue, NbNonTransp); + fillchar({%H-}ColorTab,sizeof(ColorTab),0); + + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, colorTab[0], 256); + Str.Position:= nextPosition; + + if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then + move(ColorTab[0],colorTab[256], 256) + else + begin + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, colorTab[256], 256); + Str.Position:= nextPosition; + end; + if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then + move(ColorTab[0],colorTab[512], 256) + else if (channelFlags and LazpaintChannelBlueFromGreen) <> 0 then + move(ColorTab[256],colorTab[512], 256) + else + begin + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, colorTab[512], 256); + Str.Position:= nextPosition; + end; + + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, PIndexed^, NbNonTransp); + Str.Position:= nextPosition; + + for n := 0 to NbNonTransp-1 do + begin + index := (PIndexed+n)^; + (PRed+n)^ := colorTab[index]; + (PGreen+n)^ := colorTab[index+256]; + (PBlue+n)^ := colorTab[index+512]; + end; + finally + FreeMem(PIndexed); + end; + end else + begin + Getmem(PRed, NbNonTransp); + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, PRed^, NbNonTransp); + Str.Position:= nextPosition; + + if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then PGreen := PRed else + begin + Getmem(PGreen, NbNonTransp); + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, PGreen^, NbNonTransp); + Str.Position:= nextPosition; + end; + + if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then PBlue := PRed else + if (channelFlags and LazPaintChannelBlueFromGreen) <> 0 then PBlue := PGreen else + begin + Getmem(PBlue, NbNonTransp); + channelStreamSize := LEtoN(str.ReadDWord); + nextPosition:= str.Position+channelStreamSize; + DecodeLazRLE(Str, PBlue^, NbNonTransp); + Str.Position:= nextPosition; + end; + end; + end; + + Img.SetSize(w,h); + + if NbNonTransp > 0 then + begin + PCurRed := PRed; + PCurGreen := PGreen; + PCurBlue := PBlue; + PCurAlpha := PAlpha; + + if Img is TBGRACustomBitmap then + begin + If PCurAlpha = nil then + begin + for y := 0 to h-1 do + begin + PDest := TBGRACustomBitmap(Img).ScanLine[y]; + for x := w-1 downto 0 do + begin + PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^); + inc(PCurBlue); + inc(PCurGreen); + inc(PCurRed); + inc(PDest); + end; + end; + end else + for y := 0 to h-1 do + begin + PDest := TBGRACustomBitmap(Img).ScanLine[y]; + for x := w-1 downto 0 do + begin + if PCurAlpha^ = 0 then + PDest^ := BGRAPixelTransparent + else + begin + PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^,PCurAlpha^); + inc(PCurBlue); + inc(PCurGreen); + inc(PCurRed); + end; + inc(PDest); + inc(PCurAlpha); + end; + end; + end else + begin + a := 255; + for y := 0 to h-1 do + for x := 0 to w-1 do + begin + if PCurAlpha <> nil then + begin + a := PCurAlpha^; + inc(PCurAlpha); + end; + if a = 0 then + begin + img.Colors[x,y] := colTransparent; + end else + begin + c.red := PCurRed^ + (PCurRed^ shl 8); + c.green := PCurGreen^ + (PCurGreen^ shl 8); + c.blue := PCurBlue^ + (PCurBlue^ shl 8); + c.alpha := a + (a shl 8); + Img.Colors[x,y] := c; + inc(PCurBlue); + inc(PCurGreen); + inc(PCurRed); + end; + end; + end; + end else + begin + if Img is TBGRACustomBitmap then + TBGRACustomBitmap(Img).FillTransparent else + begin + for y := 0 to h-1 do + for x := 0 to w-1 do + img.Colors[x,y] := colTransparent; + end; + end; + finally + If Assigned(PAlpha) then FreeMem(PAlpha); + if Assigned(PBlue) and (PBlue <> PGreen) and (PBlue <> PRed) then FreeMem(PBlue); + if Assigned(PGreen) and (PGreen <> PRed) then FreeMem(PGreen); + If Assigned(PRed) then FreeMem(PRed); + end; +end; + +initialization + + if DefaultBGRAImageReader[ifLazPaint] = nil then + DefaultBGRAImageReader[ifLazPaint] := TBGRAReaderLazPaint; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpcx.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpcx.pas new file mode 100644 index 0000000..1f84933 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpcx.pas @@ -0,0 +1,228 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ This unit provides some optimisations of TFPReaderPCX: decompression using a read buffer. + It also fixes the progress message and the InternalCheck. } + +unit BGRAReadPCX; + +{$mode objfpc}{$H+} + +interface + +uses FPImage, BGRAClasses, SysUtils, FPReadPCX; + +type + + { TBGRAReaderPCX } + + TBGRAReaderPCX = class(TFPReaderPCX) + protected + FBuffer: packed array of byte; + FBufferPos, FBufferSize: integer; + FBufferStream: TStream; + function InternalCheck(Stream: TStream): boolean; override; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + procedure ReadScanLine({%H-}Row: integer; Stream: TStream); override; + procedure WriteScanLine(Row: integer; Img: TFPCustomImage); override; + procedure InitReadBuffer(AStream: TStream; ASize: integer); + procedure CloseReadBuffer; + function GetNextBufferByte: byte; + end; + +implementation + +uses BGRABitmapTypes; + +procedure TBGRAReaderPCX.ReadScanLine(Row: integer; Stream: TStream); +var + P: PByte; + B: UInt32or64; + bytes, Count: UInt32or64; +begin + if FLineSize <= 0 then exit; + P := FScanLine; + bytes := FLineSize; + if Compressed then + begin + while bytes > 0 do + begin + B := GetNextBufferByte; + if (B < $c0) then + Count := 1 + else + begin + Count := B - $c0; + B := GetNextBufferByte; + end; + if Count = 0 then continue else + if Count = 1 then + begin + P^ := B; + Inc(P); + Dec(bytes); + end else + begin + if Count > bytes then Count := bytes; + fillchar(p^, count, B); + Inc(p, count); + dec(bytes, count); + end; + end; + end + else + Stream.ReadBuffer(FScanLine^, FLineSize); +end; + +procedure TBGRAReaderPCX.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + H, Row: integer; + continue: boolean; + emptyRect: TRect; +begin + emptyRect := rect(0,0,0,0); + continue := True; + Progress(psStarting, 0, False, emptyRect, '', continue); + Stream.Read(Header, SizeOf(Header)); + AnalyzeHeader(Img); + case BytesPerPixel of + 1: CreateBWPalette(Img); + 4: CreatePalette16(Img); + 8: ReadPalette(stream, Img); + else + if (Header.PaletteType = 2) then + CreateGrayPalette(Img); + end; + H := Img.Height; + if Compressed then InitReadBuffer(Stream,2048); + for Row := 0 to H - 1 do + begin + ReadScanLine(Row, Stream); + WriteScanLine(Row, Img); + Progress(psRunning, (Row+1) div H, False, emptyRect, '', continue); + end; + if Compressed then CloseReadBuffer; + Progress(psEnding, 100, False, emptyRect, '', continue); + freemem(FScanLine); +end; + +procedure TBGRAReaderPCX.WriteScanLine(Row: integer; Img: TFPCustomImage); +var + Col: integer; + C: TFPColor; + P, P1, P2, P3: PByte; + Z2: word; + color: byte; +begin + C.Alpha := AlphaOpaque; + P := FScanLine; + Z2 := Header.BytesPerLine; + begin + case BytesPerPixel of + 1: + begin + for Col := 0 to Img.Width - 1 do + begin + if (P[col div 8] and (128 shr (col mod 8))) <> 0 then + Img.Colors[Col, Row] := Img.Palette[1] + else + Img.Colors[Col, Row] := Img.Palette[0]; + end; + end; + 4: + begin + P1 := P; + Inc(P1, Z2); + P2 := P; + Inc(P2, Z2 * 2); + P3 := P; + Inc(P3, Z2 * 3); + for Col := 0 to Img.Width - 1 do + begin + color := 0; + if (P[col div 8] and (128 shr (col mod 8))) <> 0 then + Inc(color, 1); + if (P1[col div 8] and (128 shr (col mod 8))) <> 0 then + Inc(color, 1 shl 1); + if (P2[col div 8] and (128 shr (col mod 8))) <> 0 then + Inc(color, 1 shl 2); + if (P3[col div 8] and (128 shr (col mod 8))) <> 0 then + Inc(color, 1 shl 3); + Img.Colors[Col, Row] := Img.Palette[color]; + end; + end; + 8: + begin + for Col := 0 to Img.Width - 1 do + begin + Img.Colors[Col, Row] := Img.Palette[P[Col]]; + end; + end; + 24: + begin + for Col := 0 to Img.Width - 1 do + begin + with C do + begin + Red := P[col] or (P[col] shl 8); + Blue := P[col + Z2 * 2] or (P[col + Z2 * 2] shl 8); + Green := P[col + Z2] or (P[col + Z2] shl 8); + Alpha := alphaOpaque; + end; + Img[col, row] := C; + end; + end; + end; + end; +end; + +procedure TBGRAReaderPCX.InitReadBuffer(AStream: TStream; ASize: integer); +begin + setLength(FBuffer,ASize); + FBufferSize := AStream.Read(FBuffer[0],ASize); + FBufferPos := 0; + FBufferStream := AStream; +end; + +procedure TBGRAReaderPCX.CloseReadBuffer; +begin + FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; +end; + +function TBGRAReaderPCX.GetNextBufferByte: byte; +begin + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + if FBufferSize = 0 then + result := 0 + else + begin + FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); + FBufferPos := 0; + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + result := 0; + end; +end; + +function TBGRAReaderPCX.InternalCheck({%H-}Stream: TStream): boolean; +var + {%H-}magic: packed array[0..3] of byte; + oldPos: Int64; +begin + oldPos:= stream.Position; + result := stream.Read({%H-}magic,SizeOf(magic)) = sizeof(magic); + stream.Position:= oldPos; + if result then + result := (magic[0] in[$0a,$0c,$cd]) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) +end; + +initialization + + DefaultBGRAImageReader[ifPcx] := TBGRAReaderPCX; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpng.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpng.pas new file mode 100644 index 0000000..a65c61f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpng.pas @@ -0,0 +1,1452 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + This file is originally part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + PNG reader implementation modified by circular. + + ********************************************************************** + + Optimisations applied: + - using "const" parameter for TColorData + - direct pixel access with TBGRABitmap when possible + - some fixes of hints and of initializations + - vertical shrink option with MinifyHeight, OriginalHeight and VerticalShrinkFactor (useful for thumbnails) + } +{$mode objfpc}{$h+} +unit BGRAReadPng; + +interface + +uses + SysUtils,BGRAClasses, FPImage, FPImgCmn, PNGComn, ZStream, BGRABitmapTypes; + +Type + + TSetPixelProc = procedure (x,y:integer; const CD : TColordata) of object; + TConvertColorProc = function (const CD:TColorData) : TFPColor of object; + TBGRAConvertColorProc = function (const CD:TColorData) : TBGRAPixel of object; + THandleScanLineProc = procedure (const y : integer; const ScanLine : PByteArray) of object; + + { TBGRAReaderPNG } + + TBGRAReaderPNG = class (TBGRAImageReader) + private + FHeader : THeaderChunk; + ZData : TMemoryStream; // holds compressed data until all blocks are read + Decompress : TDeCompressionStream; // decompresses the data + FPltte : boolean; // if palette is used + FCountScanlines : EightLong; //Number of scanlines to process for each pass + FScanLineLength : EightLong; //Length of scanline for each pass + FCurrentPass : byte; + ByteWidth : byte; // number of bytes to read for pixel information + BitsUsed : EightLong; // bitmasks to use to split a byte into smaller parts + BitShift : byte; // shift right to do of the bits extracted with BitsUsed for 1 element + CountBitsUsed : byte; // number of bit groups (1 pixel) per byte (when bytewidth = 1) + //CFmt : TColorFormat; // format of the colors to convert from + StartX,StartY, DeltaX,DeltaY, StartPass,EndPass : integer; // number and format of passes + FPalette : TFPPalette; + FSetPixel : TSetPixelProc; + FConvertColor : TConvertColorProc; + FBGRAConvertColor : TBGRAConvertColorProc; + FHandleScanLine: THandleScanLineProc; + FVerticalShrinkMask: LongWord; + FVerticalShrinkShr: Integer; + FGammaCorrection: single; + FGammaCorrectionTable: packed array of word; + FGammaCorrectionTableComputed: boolean; + function GetOriginalHeight: integer; + function GetOriginalWidth: integer; + function GetVerticalShrinkFactor: integer; + function ReadChunk: boolean; + procedure HandleData; + procedure HandleUnknown; + function ColorGray1 (const CD:TColorData) : TFPColor; + function ColorGray2 (const CD:TColorData) : TFPColor; + function ColorGray4 (const CD:TColorData) : TFPColor; + function ColorGray8 (const CD:TColorData) : TFPColor; + function ColorGray16 (const CD:TColorData) : TFPColor; + function ColorGrayAlpha8 (const CD:TColorData) : TFPColor; + function ColorGrayAlpha16 (const CD:TColorData) : TFPColor; + function ColorColor8 (const CD:TColorData) : TFPColor; + function ColorColor16 (const CD:TColorData) : TFPColor; + function ColorColorAlpha8 (const CD:TColorData) : TFPColor; + function ColorColorAlpha16 (const CD:TColorData) : TFPColor; + function CheckGammaCorrection: boolean; + procedure ApplyGammaCorrection(var AColor: TFPColor); + + function BGRAColorGray1 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGray2 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGray4 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGray8 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGray16 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGrayAlpha8 (const CD:TColorData) : TBGRAPixel; + function BGRAColorGrayAlpha16 (const CD:TColorData) : TBGRAPixel; + function BGRAColorColor8 (const CD:TColorData) : TBGRAPixel; + function BGRAColorColor16 (const CD:TColorData) : TBGRAPixel; + function BGRAColorColorAlpha8 (const CD:TColorData) : TBGRAPixel; + function BGRAColorColorAlpha16 (const CD:TColorData) : TBGRAPixel; + protected + Chunk : TChunk; + UseTransparent, EndOfFile : boolean; + TransparentDataValue : TColorData; + UsingBitGroup : byte; + DataIndex : LongWord; + DataBytes : TColorData; + procedure HandleChunk; virtual; + procedure HandlePalette; virtual; + procedure HandleAlpha; virtual; + procedure HandleStdRGB; virtual; + procedure HandleGamma; virtual; + function CalcX (relX:integer) : integer; + function CalcY (relY:integer) : integer; + function CalcColor(const ScanLine : PByteArray): TColorData; + procedure HandleScanLine (const y : integer; const ScanLine : PByteArray); virtual; + procedure BGRAHandleScanLine(const y: integer; const ScanLine: PByteArray); + procedure BGRAHandleScanLineTr(const y: integer; const ScanLine: PByteArray); + procedure DoDecompress; virtual; + procedure SetPalettePixel (x,y:integer; const CD : TColordata); + procedure SetPalColPixel (x,y:integer; const CD : TColordata); + procedure SetColorPixel (x,y:integer; const CD : TColordata); + procedure SetColorTrPixel (x,y:integer; const CD : TColordata); + procedure SetBGRAColorPixel (x,y:integer; const CD : TColordata); + procedure SetBGRAColorTrPixel (x,y:integer; const CD : TColordata); + function DecideSetPixel : TSetPixelProc; virtual; + procedure InternalRead ({%H-}Str:TStream; Img:TFPCustomImage); override; + function InternalCheck (Str:TStream) : boolean; override; + //property ColorFormat : TColorformat read CFmt; + property ConvertColor : TConvertColorProc read FConvertColor; + property CurrentPass : byte read FCurrentPass; + property Pltte : boolean read FPltte; + property ThePalette : TFPPalette read FPalette; + property Header : THeaderChunk read FHeader; + property CountScanlines : EightLong read FCountScanlines; + property ScanLineLength : EightLong read FScanLineLength; + public + MinifyHeight: integer; + constructor create; override; + destructor destroy; override; + property VerticalShrinkFactor: integer read GetVerticalShrinkFactor; + property OriginalWidth: integer read GetOriginalWidth; + property OriginalHeight: integer read GetOriginalHeight; + function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; + function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; + end; + +implementation + +uses math; + +const StartPoints : array[0..7, 0..1] of word = + ((0,0),(0,0),(4,0),(0,4),(2,0),(0,2),(1,0),(0,1)); + Delta : array[0..7,0..1] of word = + ((1,1),(8,8),(8,8),(4,8),(4,4),(2,4),(2,2),(1,2)); + BitsUsed1Depth : EightLong = ($80,$40,$20,$10,$08,$04,$02,$01); + BitsUsed2Depth : EightLong = ($C0,$30,$0C,$03,0,0,0,0); + BitsUsed4Depth : EightLong = ($F0,$0F,0,0,0,0,0,0); + +constructor TBGRAReaderPNG.create; +begin + inherited; + chunk.acapacity := 0; + chunk.data := nil; + UseTransparent := False; +end; + +destructor TBGRAReaderPNG.destroy; +begin + with chunk do + if acapacity > 0 then + freemem (data); + inherited; +end; + +function TBGRAReaderPNG.GetQuickInfo(AStream: TStream): TQuickImageInfo; +const headerChunkSize = 13; +var + {%H-}FileHeader : packed array[0..7] of byte; + {%H-}ChunkHeader : TChunkHeader; + {%H-}HeaderChunk : THeaderChunk; +begin + {$PUSH}{$HINTS OFF}fillchar({%H-}result, sizeof({%H-}result), 0);{$POP} + if AStream.Read({%H-}FileHeader, sizeof(FileHeader))<> sizeof(FileHeader) then exit; + if QWord(FileHeader) <> QWord(PNGComn.Signature) then exit; + if AStream.Read({%H-}ChunkHeader, sizeof(ChunkHeader))<> sizeof(ChunkHeader) then exit; + if ChunkHeader.CType <> ChunkTypes[ctIHDR] then exit; + if BEtoN(ChunkHeader.CLength) < headerChunkSize then exit; + if AStream.Read({%H-}HeaderChunk, headerChunkSize) <> headerChunkSize then exit; + result.width:= BEtoN(HeaderChunk.Width); + result.height:= BEtoN(HeaderChunk.height); + case HeaderChunk.ColorType and 3 of + 0,3: {grayscale, palette} + if HeaderChunk.BitDepth > 8 then + result.colorDepth := 8 + else + result.colorDepth := HeaderChunk.BitDepth; + + 2: {color} result.colorDepth := HeaderChunk.BitDepth*3; + end; + if (HeaderChunk.ColorType and 4) = 4 then + result.alphaDepth := HeaderChunk.BitDepth + else + result.alphaDepth := 0; +end; + +function TBGRAReaderPNG.GetBitmapDraft(AStream: TStream; AMaxWidth, + AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; +var + png: TBGRAReaderPNG; +begin + png:= TBGRAReaderPNG.Create; + result := BGRABitmapFactory.Create; + try + png.MinifyHeight := AMaxHeight; + result.LoadFromStream(AStream, png); + AOriginalWidth:= result.Width; + AOriginalHeight:= png.OriginalHeight; + finally + png.Free; + end; +end; + +function TBGRAReaderPNG.ReadChunk: boolean; +var {%H-}ChunkHeader : TChunkHeader; + readCRC : LongWord; + l : LongWord; +begin + TheStream.Read ({%H-}ChunkHeader,sizeof(ChunkHeader)); + with chunk do + begin + // chunk header + with ChunkHeader do + begin + {$IFDEF ENDIAN_LITTLE} + alength := swap(CLength); + {$ELSE} + alength := CLength; + {$ENDIF} + ReadType := CType; + end; + aType := low(TChunkTypes); + while (aType < high(TChunkTypes)) and (ChunkTypes[aType] <> ReadType) do + inc (aType); + if alength > MaxChunkLength then + raise PNGImageException.Create ('Invalid chunklength'); + if alength > acapacity then + begin + if acapacity > 0 then + freemem (data); + GetMem (data, alength); + acapacity := alength; + end; + l := TheStream.read (data^, alength); + if l <> alength then + raise PNGImageException.Create ('Chunk length exceeds stream length'); + readCRC := 0; + TheStream.Read (readCRC, sizeof(ReadCRC)); + l := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType)); + l := CalculateCRC (l, data^, alength); + {$IFDEF ENDIAN_LITTLE} + l := swap(l xor All1Bits); + {$ELSE} + l := l xor All1Bits; + {$ENDIF} + if ReadCRC <> l then + begin + //if chunk is essential, then raise an error + if ReadType[0] = upcase(ReadType[0]) then + raise PNGImageException.Create ('CRC check failed') + else + result := false; + end + else result := true; + end; +end; + +function TBGRAReaderPNG.GetVerticalShrinkFactor: integer; +begin + result := 1 shl FVerticalShrinkShr; +end; + +function TBGRAReaderPNG.GetOriginalHeight: integer; +begin + result := Header.height; +end; + +function TBGRAReaderPNG.GetOriginalWidth: integer; +begin + result := header.Width; +end; + +procedure TBGRAReaderPNG.HandleData; +var OldSize : LongWord; +begin + OldSize := ZData.size; + ZData.Size := OldSize; + ZData.Size := ZData.Size + Chunk.aLength; + ZData.Write (chunk.Data^, chunk.aLength); +end; + +procedure TBGRAReaderPNG.HandleAlpha; + procedure PaletteAlpha; + var r : integer; + a : word; + c : TFPColor; + begin + with chunk do + begin + if alength > LongWord(ThePalette.count) then + raise PNGImageException.create ('To much alpha values for palette'); + for r := 0 to alength-1 do + begin + c := ThePalette[r]; + a := data^[r]; + c.alpha := (a shl 8) + a; + ThePalette[r] := c; + end; + end; + end; + procedure TransparentGray; + var {%H-}a : word; + begin + move (chunk.data^[0], {%H-}a, 2); + {$IFDEF ENDIAN_LITTLE} + a := swap (a); + {$ENDIF} + TransparentDataValue := a; + UseTransparent := True; + end; + procedure TransparentColor; + var d : byte; + {%H-}r,{%H-}g,{%H-}b : word; + a : TColorData; + begin + with chunk do + begin + move (data^[0], {%H-}r, 2); + move (data^[2], {%H-}g, 2); + move (data^[4], {%H-}b, 2); + end; + {$IFDEF ENDIAN_LITTLE} + r := swap (r); + g := swap (g); + b := swap (b); + {$ENDIF} + d := header.bitdepth; + a := (TColorData(b) shl d) shl d; + a := a + (TColorData(g) shl d) + r; + TransparentDataValue := a; + UseTransparent := True; + end; +begin + case header.ColorType of + 3 : PaletteAlpha; + 0 : TransparentGray; + 2 : TransparentColor; + end; +end; + +procedure TBGRAReaderPNG.HandleStdRGB; +begin + FGammaCorrection:= 1; + FGammaCorrectionTableComputed:= false; +end; + +procedure TBGRAReaderPNG.HandleGamma; +var + invGammaInt: Longword; +begin + invGammaInt := BEtoN(PLongword(chunk.data)^); + FGammaCorrection:= invGammaInt/45455; { 1/2.2 is default } + FGammaCorrectionTableComputed:= false; +end; + +procedure TBGRAReaderPNG.HandlePalette; +var r : LongWord; + c : TFPColor; + t : word; +begin + if header.colortype = 3 then + with chunk do + begin + if TheImage.UsePalette then + FPalette := TheImage.Palette + else + FPalette := TFPPalette.Create(0); + c.Alpha := AlphaOpaque; + if (aLength mod 3) > 0 then + raise PNGImageException.Create ('Impossible length for PLTE-chunk'); + r := 0; + ThePalette.count := 0; + while r < alength do + begin + t := data^[r]; + c.red := t + (t shl 8); + inc (r); + t := data^[r]; + c.green := t + (t shl 8); + inc (r); + t := data^[r]; + c.blue := t + (t shl 8); + inc (r); + ApplyGammaCorrection(c); + ThePalette.Add (c); + end; + end; +end; + +procedure TBGRAReaderPNG.SetPalettePixel (x,y:integer; const CD : TColordata); +begin // both PNG and Img have palette + TheImage.Pixels[x,y] := CD; +end; + +procedure TBGRAReaderPNG.SetPalColPixel (x,y:integer; const CD : TColordata); +begin // PNG with palette, Img without + TheImage.Colors[x,y] := ThePalette[CD]; +end; + +procedure TBGRAReaderPNG.SetColorPixel (x,y:integer; const CD : TColordata); +var c : TFPColor; +begin // both PNG and Img work without palette, and no transparency colordata + // c := ConvertColor (CD,CFmt); + c := ConvertColor (CD); + ApplyGammaCorrection(c); + TheImage.Colors[x,y] := c; +end; + +procedure TBGRAReaderPNG.SetColorTrPixel (x,y:integer; const CD : TColordata); +var c : TFPColor; +begin // both PNG and Img work without palette, and there is a transparency colordata + //c := ConvertColor (CD,CFmt); + c := ConvertColor (CD); + ApplyGammaCorrection(c); + if TransparentDataValue = CD then + c.alpha := alphaTransparent; + TheImage.Colors[x,y] := c; +end; + +procedure TBGRAReaderPNG.SetBGRAColorPixel(x, y: integer; const CD: TColordata); +var c: TBGRAPixel; +begin + c := FBGRAConvertColor(CD); + if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) + else TBGRACustomBitmap(TheImage).SetPixel(x,y,c); +end; + +procedure TBGRAReaderPNG.SetBGRAColorTrPixel(x, y: integer; const CD: TColordata); +var c: TBGRAPixel; +begin + if TransparentDataValue = CD then + TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) else + begin + c := FBGRAConvertColor(CD); + if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) + else TBGRACustomBitmap(TheImage).SetPixel(x,y,c); + end; +end; + +function TBGRAReaderPNG.DecideSetPixel : TSetPixelProc; +begin + if Pltte then + if TheImage.UsePalette then + result := @SetPalettePixel + else + result := @SetPalColPixel + else + if UseTransparent then + begin + if TheImage is TBGRACustomBitmap then + result := @SetBGRAColorTrPixel + else + result := @SetColorTrPixel + end + else + begin + if TheImage is TBGRACustomBitmap then + result := @SetBGRAColorPixel + else + result := @SetColorPixel + end; +end; + +function TBGRAReaderPNG.CalcX (relX:integer) : integer; +begin + result := StartX + (relX * deltaX); +end; + +function TBGRAReaderPNG.CalcY (relY:integer) : integer; +begin + result := StartY + (relY * deltaY); +end; + +function TBGRAReaderPNG.CalcColor(const ScanLine : PByteArray): TColorData; +var cd : LongWord; + r : word; + p : pbyte; +begin + if UsingBitGroup = 0 then + begin + Databytes := 0; + if Header.BitDepth = 16 then + begin + p := @Databytes; + for r:=0 to bytewidth shr 1 - 1 do + begin + p^ := ScanLine^[Dataindex+(r shl 1)+1]; + (p+1)^ := ScanLine^[Dataindex+(r shl 1)]; + inc(p,2); + end; + end + else move (ScanLine^[DataIndex], Databytes, bytewidth); + {$IFDEF ENDIAN_BIG} + Databytes:=swap(Databytes); + {$ENDIF} + inc (DataIndex,bytewidth); + end; + if bytewidth = 1 then + begin + cd := (Databytes and BitsUsed[UsingBitGroup]); + result := cd shr ((CountBitsUsed-UsingBitGroup-1) * BitShift); + inc (UsingBitgroup); + if UsingBitGroup >= CountBitsUsed then + UsingBitGroup := 0; + end + else + result := Databytes; +end; + +procedure TBGRAReaderPNG.HandleScanLine (const y : integer; const ScanLine : PByteArray); +var x, rx : integer; + c : TColorData; +begin + UsingBitGroup := 0; + DataIndex := 0; + X := StartX; + if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then + case ByteWidth of + 1: if BitsUsed[0] = $ff then + begin + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + FSetPixel (x,y,ScanLine^[DataIndex]); + Inc(X, deltaX); + inc(DataIndex); + end; + exit; + end; + 2: begin + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + {$IFDEF ENDIAN_BIG} + FSetPixel (x,y,swap(PWord(@ScanLine^[DataIndex])^)); + {$ELSE} + FSetPixel (x,y,PWord(@ScanLine^[DataIndex])^); + {$ENDIF} + Inc(X, deltaX); + inc(DataIndex,2); + end; + exit; + end; + 4: begin + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + {$IFDEF ENDIAN_BIG} + FSetPixel (x,y,swap(PLongWord(@ScanLine^[DataIndex])^)); + {$ELSE} + FSetPixel (x,y,PLongWord(@ScanLine^[DataIndex])^); + {$ENDIF} + Inc(X, deltaX); + inc(DataIndex,4); + end; + exit; + end; + 8: begin + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + {$IFDEF ENDIAN_BIG} + FSetPixel (x,y,swap(PQWord(@ScanLine^[DataIndex])^)); + {$ELSE} + FSetPixel (x,y,PQWord(@ScanLine^[DataIndex])^); + {$ENDIF} + Inc(X, deltaX); + inc(DataIndex,8); + end; + exit; + end; + end; + + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := CalcColor(ScanLine); + FSetPixel (x,y,c); + Inc(X, deltaX); + end +end; + +procedure TBGRAReaderPNG.BGRAHandleScanLine (const y : integer; const ScanLine : PByteArray); +var rx : integer; + pdest: PBGRAPixel; +begin + UsingBitGroup := 0; + DataIndex := 0; + {$PUSH}{$RANGECHECKS OFF} //because PByteArray is limited to 32767 + if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then + case ByteWidth of + 1: if BitsUsed[0] = $ff then + begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + pdest^ := FBGRAConvertColor(ScanLine^[DataIndex]); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + Inc(pdest, deltaX); + inc(DataIndex); + end; + exit; + end; + 2: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + pdest^ := FBGRAConvertColor( + {$IFDEF ENDIAN_BIG} + swap(PWord(@ScanLine^[DataIndex])^) + {$ELSE} + PWord(@ScanLine^[DataIndex])^ + {$ENDIF} ); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + Inc(pdest, deltaX); + inc(DataIndex,2); + end; + exit; + end; + 3: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + pdest^.red := ScanLine^[DataIndex]; + pdest^.green := ScanLine^[DataIndex+1]; + pdest^.blue := ScanLine^[DataIndex+2]; + pdest^.alpha := 255; + Inc(pdest, deltaX); + inc(DataIndex, 3); + end; + exit; + end; + 4: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + pdest^ := FBGRAConvertColor( + {$IFDEF ENDIAN_BIG} + swap(PLongWord(@ScanLine^[DataIndex])^) + {$ELSE} + PLongWord(@ScanLine^[DataIndex])^ + {$ENDIF} ); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + Inc(pdest, deltaX); + inc(DataIndex,4); + end; + exit; + end; + end; + {$POP} + + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + pdest^ := FBGRAConvertColor(CalcColor(ScanLine)); + Inc(pdest, deltaX); + end +end; + +procedure TBGRAReaderPNG.BGRAHandleScanLineTr(const y: integer; + const ScanLine: PByteArray); +var rx : integer; + c : TColorData; + pdest: PBGRAPixel; +begin + UsingBitGroup := 0; + DataIndex := 0; + if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then + case ByteWidth of + 1: if BitsUsed[0] = $ff then + begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := ScanLine^[DataIndex]; + if c = TransparentDataValue then + pdest^ := BGRAPixelTransparent else + begin + pdest^ := FBGRAConvertColor(c); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + end; + Inc(pdest, deltaX); + inc(DataIndex); + end; + exit; + end; + 2: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := + {$IFDEF ENDIAN_BIG} + swap(PWord(@ScanLine^[DataIndex])^) + {$ELSE} + PWord(@ScanLine^[DataIndex])^ + {$ENDIF} ; + if c = TransparentDataValue then + pdest^ := BGRAPixelTransparent else + begin + pdest^ := FBGRAConvertColor(c); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + end; + Inc(pdest, deltaX); + inc(DataIndex,2); + end; + exit; + end; + 4: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := + {$IFDEF ENDIAN_BIG} + swap(PLongWord(@ScanLine^[DataIndex])^) + {$ELSE} + PLongWord(@ScanLine^[DataIndex])^ + {$ENDIF} ; + if c = TransparentDataValue then + pdest^ := BGRAPixelTransparent else + begin + pdest^ := FBGRAConvertColor(c); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + end; + Inc(pdest, deltaX); + inc(DataIndex,4); + end; + exit; + end; + 8: begin + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := + {$IFDEF ENDIAN_BIG} + swap(PQWord(@ScanLine^[DataIndex])^) + {$ELSE} + PQWord(@ScanLine^[DataIndex])^ + {$ENDIF} ; + if c = TransparentDataValue then + pdest^ := BGRAPixelTransparent else + begin + pdest^ := FBGRAConvertColor(c); + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + end; + Inc(pdest, deltaX); + inc(DataIndex,8); + end; + exit; + end; + end; + + pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; + for rx := 0 to ScanlineLength[CurrentPass]-1 do + begin + c := CalcColor(ScanLine); + if c = TransparentDataValue then + pdest^ := BGRAPixelTransparent + else pdest^ := FBGRAConvertColor(c); + Inc(pdest, deltaX); + end +end; + +function TBGRAReaderPNG.ColorGray1(const CD: TColorData): TFPColor; +begin + if CD = 0 then + result := colBlack + else + result := colWhite; +end; + +function TBGRAReaderPNG.ColorGray2(const CD: TColorData): TFPColor; +var c : UInt32or64; +begin + c := CD and 3; + c := c + (c shl 2); + c := c + (c shl 4); + c := c + (c shl 8); + with result do + begin + red := c; + green := c; + blue := c; + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorGray4(const CD: TColorData): TFPColor; +var c : UInt32or64; +begin + c := CD and $F; + c := c + (c shl 4); + c := c + (c shl 8); + with result do + begin + red := c; + green := c; + blue := c; + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorGray8(const CD: TColorData): TFPColor; +var c : UInt32or64; +begin + c := CD and $FF; + c := c + (c shl 8); + with result do + begin + red := c; + green := c; + blue := c; + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorGray16(const CD: TColorData): TFPColor; +var c : UInt32or64; +begin + c := CD and $FFFF; + with result do + begin + red := c; + green := c; + blue := c; + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorGrayAlpha8 (const CD:TColorData) : TFPColor; +var c : UInt32or64; +begin + c := CD and $00FF; + c := c + (c shl 8); + with result do + begin + red := c; + green := c; + blue := c; + c := CD and $FF00; + alpha := c + (c shr 8); + end; +end; + +function TBGRAReaderPNG.ColorGrayAlpha16 (const CD:TColorData) : TFPColor; +var c : UInt32or64; +begin + c := CD and $FFFF; + with result do + begin + red := c; + green := c; + blue := c; + alpha := (CD shr 16) and $FFFF; + end; +end; + +function TBGRAReaderPNG.ColorColor8 (const CD:TColorData) : TFPColor; +var c : UInt32or64; +begin + with result do + begin + c := CD and $FF; + red := c + (c shl 8); + c := (CD shr 8) and $FF; + green := c + (c shl 8); + c := (CD shr 16) and $FF; + blue := c + (c shl 8); + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorColor16 (const CD:TColorData) : TFPColor; +begin + with result do + begin + red := CD and $FFFF; + green := (CD shr 16) and $FFFF; + blue := (CD shr 32) and $FFFF; + alpha := alphaOpaque; + end; +end; + +function TBGRAReaderPNG.ColorColorAlpha8 (const CD:TColorData) : TFPColor; +var c : UInt32or64; +begin + with result do + begin + c := CD and $FF; + red := c + (c shl 8); + c := (CD shr 8) and $FF; + green := c + (c shl 8); + c := (CD shr 16) and $FF; + blue := c + (c shl 8); + c := (CD shr 24) and $FF; + alpha := c + (c shl 8); + end; +end; + +function TBGRAReaderPNG.ColorColorAlpha16 (const CD:TColorData) : TFPColor; +begin + with result do + begin + red := CD and $FFFF; + green := (CD shr 16) and $FFFF; + blue := (CD shr 32) and $FFFF; + alpha := (CD shr 48) and $FFFF; + end; +end; + +function TBGRAReaderPNG.CheckGammaCorrection: boolean; +var + i: Integer; +begin + if not FGammaCorrectionTableComputed then + begin + if abs(FGammaCorrection-1) < 0.01 then + begin + FGammaCorrectionTable := nil; + end else + begin + setlength(FGammaCorrectionTable, 65536); + FGammaCorrectionTable[0] := 0; + i := 1; + while i <= 65535 do + begin + if i+3 <= 65535 then + begin + FGammaCorrectionTable[i+3] := Round(Power((i+3)/65535, FGammaCorrection)*65535); + FGammaCorrectionTable[i] := (FGammaCorrectionTable[i-1]*3+FGammaCorrectionTable[i+3]+2) shr 2; + FGammaCorrectionTable[i+1] := (FGammaCorrectionTable[i-1]+FGammaCorrectionTable[i+3]+1) shr 1; + FGammaCorrectionTable[i+2] := (FGammaCorrectionTable[i-1]+FGammaCorrectionTable[i+3]*3+2) shr 2; + inc(i,4); + end else + begin + FGammaCorrectionTable[i] := Round(Power(i/65535, FGammaCorrection)*65535); + inc(i); + end; + end; + end; + FGammaCorrectionTableComputed:= true; + end; + result := FGammaCorrectionTable<>nil; +end; + +procedure TBGRAReaderPNG.ApplyGammaCorrection(var AColor: TFPColor); +begin + if FGammaCorrectionTable<>nil then + begin + AColor.red := FGammaCorrectionTable[AColor.red]; + AColor.green := FGammaCorrectionTable[AColor.green]; + AColor.blue := FGammaCorrectionTable[AColor.blue]; + end; +end; + +function TBGRAReaderPNG.BGRAColorGray1(const CD: TColorData): TBGRAPixel; +begin + if CD = 0 then + result := BGRABlack + else + result := BGRAWhite; +end; + +function TBGRAReaderPNG.BGRAColorGray2(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := CD and 3; + c := c + (c shl 2); + c := c + (c shl 4); + result := BGRA(c,c,c); +end; + +function TBGRAReaderPNG.BGRAColorGray4(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := CD and $F; + c := c + (c shl 4); + result := BGRA(c,c,c); +end; + +function TBGRAReaderPNG.BGRAColorGray8(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := CD and $FF; + result := BGRA(c,c,c); +end; + +function TBGRAReaderPNG.BGRAColorGray16(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := (CD shr 8) and $FF; + result := BGRA(c,c,c); +end; + +function TBGRAReaderPNG.BGRAColorGrayAlpha8(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := CD and $00FF; + result := BGRA(c,c,c,(CD shr 8) and $FF); +end; + +function TBGRAReaderPNG.BGRAColorGrayAlpha16(const CD: TColorData): TBGRAPixel; +var c : UInt32or64; +begin + c := (CD shr 8) and $FF; + result := BGRA(c,c,c,(CD shr 24) and $FF); +end; + +function TBGRAReaderPNG.BGRAColorColor8(const CD: TColorData): TBGRAPixel; +var temp: LongWord; +begin + temp := CD; + result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff); +end; + +function TBGRAReaderPNG.BGRAColorColor16(const CD: TColorData): TBGRAPixel; +begin + result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF); +end; + +function TBGRAReaderPNG.BGRAColorColorAlpha8(const CD: TColorData): TBGRAPixel; +var temp: LongWord; +begin + temp := CD; + result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff, temp shr 24); +end; + +function TBGRAReaderPNG.BGRAColorColorAlpha16(const CD: TColorData): TBGRAPixel; +begin + result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF, CD shr 56); +end; + +procedure TBGRAReaderPNG.DoDecompress; + + procedure initVars; + var r,d : integer; + begin + with Header do + begin + if interlace=0 then + begin + StartPass := 0; + EndPass := 0; + FCountScanlines[0] := Height; + FScanLineLength[0] := Width; + end + else + begin + StartPass := 1; + EndPass := 7; + for r := 1 to 7 do + begin + d := Height div delta[r,1]; + if (height mod delta[r,1]) > startpoints[r,1] then + inc (d); + FCountScanlines[r] := d; + d := width div delta[r,0]; + if (width mod delta[r,0]) > startpoints[r,0] then + inc (d); + FScanLineLength[r] := d; + end; + end; + Fpltte := (ColorType = 3); + case colortype of + 0 : case Bitdepth of + 1 : begin + FConvertColor := @ColorGray1; //CFmt := cfMono; + FBGRAConvertColor := @BGRAColorGray1; //CFmt := cfMono; + ByteWidth := 1; + end; + 2 : begin + FConvertColor := @ColorGray2; //CFmt := cfGray2; + FBGRAConvertColor := @BGRAColorGray2; //CFmt := cfGray2; + ByteWidth := 1; + end; + 4 : begin + FConvertColor := @ColorGray4; //CFmt := cfGray4; + FBGRAConvertColor := @BGRAColorGray4; //CFmt := cfGray4; + ByteWidth := 1; + end; + 8 : begin + FConvertColor := @ColorGray8; //CFmt := cfGray8; + FBGRAConvertColor := @BGRAColorGray8; //CFmt := cfGray8; + ByteWidth := 1; + end; + 16 : begin + FConvertColor := @ColorGray16; //CFmt := cfGray16; + FBGRAConvertColor := @BGRAColorGray16; //CFmt := cfGray16; + ByteWidth := 2; + end; + end; + 2 : if BitDepth = 8 then + begin + FConvertColor := @ColorColor8; //CFmt := cfBGR24 + FBGRAConvertColor := @BGRAColorColor8; //CFmt := cfBGR24 + ByteWidth := 3; + end + else + begin + FConvertColor := @ColorColor16; //CFmt := cfBGR48; + FBGRAConvertColor := @BGRAColorColor16; //CFmt := cfBGR48; + ByteWidth := 6; + end; + 3 : if BitDepth = 16 then + ByteWidth := 2 + else + ByteWidth := 1; + 4 : if BitDepth = 8 then + begin + FConvertColor := @ColorGrayAlpha8; //CFmt := cfGrayA16 + FBGRAConvertColor := @BGRAColorGrayAlpha8; //CFmt := cfGrayA16 + ByteWidth := 2; + end + else + begin + FConvertColor := @ColorGrayAlpha16; //CFmt := cfGrayA32; + FBGRAConvertColor := @BGRAColorGrayAlpha16; //CFmt := cfGrayA32; + ByteWidth := 4; + end; + 6 : if BitDepth = 8 then + begin + FConvertColor := @ColorColorAlpha8; //CFmt := cfABGR32 + FBGRAConvertColor := @BGRAColorColorAlpha8; //CFmt := cfABGR32 + ByteWidth := 4; + end + else + begin + FConvertColor := @ColorColorAlpha16; //CFmt := cfABGR64; + FBGRAConvertColor := @BGRAColorColorAlpha16; //CFmt := cfABGR64; + ByteWidth := 8; + end; + end; + //ByteWidth := BytesNeeded[CFmt]; + case BitDepth of + 1 : begin + CountBitsUsed := 8; + BitShift := 1; + BitsUsed := BitsUsed1Depth; + end; + 2 : begin + CountBitsUsed := 4; + BitShift := 2; + BitsUsed := BitsUsed2Depth; + end; + 4 : begin + CountBitsUsed := 2; + BitShift := 4; + BitsUsed := BitsUsed4Depth; + end; + 8 : begin + CountBitsUsed := 1; + BitShift := 0; + BitsUsed[0] := $FF; + end; + end; + end; + end; + + procedure FilterSub(p: PByte; Count: Int32or64; bw: Int32or64); + begin + inc(p,bw); + dec(Count,bw); + while Count > 0 do + begin + {$push}{$r-} + inc(p^, (p-bw)^); + {$pop} + inc(p); + dec(Count); + end; + end; + + procedure FilterUp(p,pPrev: PByte; Count: UInt32or64); + var Count4: Int32or64; + begin + Count4 := Count shr 2; + dec(Count, Count4 shl 2); + while Count4 > 0 do + begin + {$push}{$r-}{$q-} + PLongWord(p)^ := (((PLongWord(pPrev)^ and $00FF00FF) + (PLongWord(p)^ and $00FF00FF)) and $00FF00FF) + or (((PLongWord(pPrev)^ and $FF00FF00) + (PLongWord(p)^ and $FF00FF00)) and $FF00FF00); + {$pop} + inc(p,4); + inc(pPrev,4); + dec(Count4); + end; + while Count > 0 do + begin + {$push}{$r-} + inc(p^, pPrev^); + {$pop} + + inc(p); + inc(pPrev); + dec(Count); + end; + end; + + procedure FilterAverage(p,pPrev: PByte; Count: UInt32or64; bw: Int32or64); + var CountBW: Int32or64; + begin + CountBW := bw; + dec(Count,CountBW); + while CountBW > 0 do + begin + {$push}{$r-} + inc(p^, pPrev^ shr 1); + {$pop} + inc(p); + inc(pPrev); + dec(CountBW); + end; + + while Count > 0 do + begin + {$push}{$r-} + inc(p^, (pPrev^+(p-bw)^) shr 1); + {$pop} + inc(p); + inc(pPrev); + dec(Count); + end; + end; + + procedure FilterPaeth(p,pPrev: PByte; Count: UInt32or64; bw: Int32or64); + var + rx, dl, dp, dlp : Int32or64; + diag,left: UInt32or64; + begin + for rx := 0 to bw-1 do + begin + {$push}{$r-} + inc(p^, pPrev^); + {$pop} + inc(p); + inc(pPrev); + end; + dec(Count,bw); + while Count > 0 do + begin + diag := (pPrev-bw)^; + left := (p - bw)^; + dl := pPrev^ - Int32or64(diag); + dp := Int32or64(left) - Int32or64(diag); + dlp := abs(dl+dp); + if dl < 0 then dl := -dl; + if dp < 0 then dp := -dp; + {$push}{$r-} + if dp <= dlp then + begin + if dl <= dp then + inc(p^, left) + else + inc(p^, pPrev^) + end + else + if dl <= dlp then + inc(p^, left) + else + inc(p^, diag); + {$pop} + inc(p); + inc(pPrev); + dec(Count); + end; + end; + + procedure Decode; + var y, rp, ry, l : Int32or64; + lf : byte; + switchLine, currentLine, previousLine : pByteArray; + begin + FSetPixel := DecideSetPixel; + if not Pltte and (TheImage is TBGRACustomBitmap) and + not CheckGammaCorrection then + begin + if UseTransparent then + FHandleScanLine := @BGRAHandleScanLineTr + else + FHandleScanLine := @BGRAHandleScanLine; + end else + FHandleScanLine := @HandleScanLine; + for rp := StartPass to EndPass do + begin + FCurrentPass := rp; + StartX := StartPoints[rp,0]; + StartY := StartPoints[rp,1]; + DeltaX := Delta[rp,0]; + DeltaY := Delta[rp,1]; + if bytewidth = 1 then + begin + l := (ScanLineLength[rp] div CountBitsUsed); + if (ScanLineLength[rp] mod CountBitsUsed) > 0 then + inc (l); + end + else + l := ScanLineLength[rp]*ByteWidth; + if (l>0) then + begin + GetMem (previousLine, l); + GetMem (currentLine, l); + fillchar (currentLine^,l,0); + try + for ry := 0 to CountScanlines[rp]-1 do + begin + switchLine := currentLine; + currentLine := previousLine; + previousLine := switchLine; + Y := StartY + (ry * deltaY); + lf := 0; + Decompress.Read (lf, sizeof(lf)); + Decompress.Read (currentLine^, l); + + case lf of + 1: FilterSub(PByte(currentLine), l, ByteWidth); + 2: FilterUp(PByte(currentLine), PByte(previousLine), l); + 3: FilterAverage(PByte(currentLine), PByte(previousLine), l, ByteWidth); + 4: FilterPaeth(PByte(currentLine), PByte(previousLine), l, ByteWidth); + end; + + if FVerticalShrinkShr <> 0 then + begin + if (y and FVerticalShrinkMask) = 0 then + FHandleScanLine (y shr FVerticalShrinkShr, currentLine); + end else + FHandleScanLine (y, currentLine); + end; + finally + freemem (previousLine); + freemem (currentLine); + end; + end; + end; + end; + +begin + InitVars; + DeCode; +end; + +procedure TBGRAReaderPNG.HandleChunk; +begin + case chunk.AType of + ctIHDR : raise PNGImageException.Create ('Second IHDR chunk found'); + ctPLTE : HandlePalette; + ctIDAT : HandleData; + ctIEND : EndOfFile := True; + cttRNS : HandleAlpha; + ctsRGB : HandleStdRGB; + ctgAMA : HandleGamma; + else HandleUnknown; + end; +end; + +procedure TBGRAReaderPNG.HandleUnknown; +begin + if (chunk.readtype[0] in ['A'..'Z']) then + raise PNGImageException.Create('Critical chunk '+chunk.readtype+' not recognized'); +end; + +procedure TBGRAReaderPNG.InternalRead (Str:TStream; Img:TFPCustomImage); +var outputHeight: integer; +begin + {$ifdef FPC_Debug_Image} + if Str<>TheStream then + writeln('WARNING: TBGRAReaderPNG.InternalRead Str<>TheStream'); + {$endif} + with Header do + begin + FVerticalShrinkShr := 0; + FVerticalShrinkMask := 0; + FGammaCorrection := 1; + FGammaCorrectionTableComputed:= false; + outputHeight := Height; + if MinifyHeight <> 0 then + begin + while (outputHeight shr 1 >= MinifyHeight) and (FVerticalShrinkShr < 8) do + begin + outputHeight:= outputHeight shr 1; + Inc(FVerticalShrinkShr); + end; + FVerticalShrinkMask:= (1 shl FVerticalShrinkShr)-1; + outputHeight := (Height+FVerticalShrinkMask) shr FVerticalShrinkShr; + end; + Img.SetSize (Width, outputHeight); + end; + ZData := TMemoryStream.Create; + try + EndOfFile := false; + while not EndOfFile do + begin + if ReadChunk then + HandleChunk; + end; + ZData.position:=0; + Decompress := TDecompressionStream.Create (ZData); + try + DoDecompress; + finally + Decompress.Free; + end; + finally + ZData.Free; + if not img.UsePalette and assigned(FPalette) then + begin + FPalette.Free; + end; + end; +end; + +function TBGRAReaderPNG.InternalCheck (Str:TStream) : boolean; +var {%H-}SigCheck : array[0..7] of byte; + r : integer; +begin + try + // Check Signature + if Str.Read({%H-}SigCheck, SizeOf(SigCheck)) <> SizeOf(SigCheck) then + raise PNGImageException.Create('This is not PNG-data'); + for r := 0 to 7 do + begin + If SigCheck[r] <> Signature[r] then + raise PNGImageException.Create('This is not PNG-data'); + end; + // Check IHDR + ReadChunk; + if chunk.aType <> ctIHDR then + raise PNGImageException.Create('Header chunk expected but '+chunk.ReadType+' found'); + fillchar(FHeader, sizeof(FHeader), 0); + move (chunk.data^, FHeader, min(sizeof(Header), chunk.alength)); + with header do + begin + {$IFDEF ENDIAN_LITTLE} + Width := swap(width); + height := swap (height); + {$ENDIF} + result := (width > 0) and (height > 0) and (compression = 0) + and (filter = 0) and (Interlace in [0,1]); + end; + except + result := false; + end; +end; + +initialization + + DefaultBGRAImageReader[ifPng] := TBGRAReaderPNG; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpsd.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpsd.pas new file mode 100644 index 0000000..97c2371 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadpsd.pas @@ -0,0 +1,620 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + The original file was part of the Free Pascal run time library. + Copyright (c) 2008 by the Free Pascal development team + + Psd reader for fpImage modified by circular. + + ********************************************************************** + + 03/2014 changes by circular : + - added MinifyHeight,WantedHeight and OutputHeight (useful for thumbnails) +} +unit BGRAReadPSD; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, FPReadPSD; + +type + { TBGRAReaderPSD } + + TBGRAReaderPSD = class(TFPReaderPSD) + private + FCompressed: boolean; + protected + FScanLines : array of PByte; + FInputLine : array of record + StreamOffset: Int64; + Size: PtrInt; + end; + FOutputHeight: integer; + function ReadPalette(Stream: TStream): boolean; + procedure AnalyzeHeader; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + function ReadScanLine(Stream: TStream; AInputSize: PtrInt; AChannel: integer): boolean; overload; + procedure WriteScanLine(Img: TFPCustomImage; Row: integer); overload; + function InternalCheck(Stream: TStream) : boolean; override; + public + MinifyHeight,WantedHeight: integer; + constructor Create; override; + property Compressed: Boolean read FCompressed; + property OutputHeight: integer read FOutputHeight; + end; + +implementation + +uses BGRABitmapTypes; + +function clamp(AValue, AMax: integer): integer; +begin + if AValue < 0 then result := 0 else + if AValue > AMax then result := AMax else + result := AValue;; +end; + +function CMYKtoRGB ( C : TFPColor): TFPColor; +var r,g,b: integer; +begin + r := $ffff - c.red + c.green div 10 + c.blue div 10 - c.alpha; + g := $ffff + c.red div 10 - c.green + c.blue div 10 - c.alpha; + b := $ffff + c.red div 10 + c.green div 10 - c.blue - c.alpha; + result.red := clamp(r, 65535); + result.green := clamp(g, 65535); + result.blue := clamp(b, 65535); + Result.alpha:=alphaOpaque; +end; + +function fInv(t: single): single; +begin + if t > 6/29 then result := t*t*t else + result := 3*(6/29)*(6/29)*(t-4/29); +end; + +function Csrgb(linear: single): single; +begin + if linear <= 0.0031308 then + result := 12.92*linear else + result := (1+0.055)*exp(ln(linear)*(1/2.4)) - 0.055; +end; + +function LabToRGB(L,a,b: single):TFPColor; overload; +var r,g,blue: single; +begin + if a < 0 then + r := L + a + 0.25*b + else + r := L + 0.75*a + 0.25*b; + g := L - 0.25*a; + blue := L - b; + Result.red:= clamp(round((r)*65535),65535); + Result.green:= clamp(round((g)*65535),65535); + Result.blue:= clamp(round((blue)*65535),65535); + result.alpha := 65535; +end; + +function LabToRGB(const Lab:TLab):TFPColor; overload; +var L: single; +begin + L := 1/255*Lab.L; + result := LabToRGB(L,(Lab.a-128)/127,(Lab.b-128)/127); +end; + +{ TBGRAReaderPSD } + +function TBGRAReaderPSD.ReadPalette(Stream: TStream): boolean; +Var + I : Integer; + c : TFPColor; + OldPos: Integer; + BufSize:Longint; + {%H-}PalBuf: array[0..767] of Byte; + ContProgress: Boolean; +begin + Result:=false; + ThePalette.count := 0; + OldPos := Stream.Position; + BufSize:=0; + Stream.Read(BufSize, SizeOf(BufSize)); + BufSize:=BEtoN(BufSize); + Stream.Read({%H-}PalBuf, BufSize); + ContProgress:=true; + Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + For I:=0 To BufSize div 3 Do + Begin + With c do + begin + Red:=PalBuf[I] shl 8; + Green:=PalBuf[I+(BufSize div 3)] shl 8; + Blue:=PalBuf[I+(BufSize div 3)* 2] shl 8; + Alpha:=alphaOpaque; + end; + ThePalette.Add(C); + End; + Stream.Position := OldPos; + Result:=true; +end; + +procedure TBGRAReaderPSD.AnalyzeHeader; +var channel: integer; +begin + With FHeader do + begin + Depth:=BEtoN(Depth); + if (Signature <> '8BPS') then + Raise Exception.Create('Unknown/Unsupported PSD image type'); + Channels:=BEtoN(Channels); + if Channels > 4 then + FBytesPerPixel:=Depth*4 + else + FBytesPerPixel:=Depth*Channels; + Mode:=BEtoN(Mode); + FWidth:=BEtoN(Columns); + FHeight:=BEtoN(Rows); + FChannelCount:=Channels; + FLineSize:=(PtrInt(FWidth)*Depth+7) div 8; + setlength(FScanLines, FChannelCount); + for channel := 0 to FChannelCount-1 do + GetMem(FScanLines[channel],FLineSize); + end; +end; + +procedure TBGRAReaderPSD.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + H,HOutput,InputLineIndex,LenOfLineIndex,channel: Integer; + LenOfLineFactor: PtrInt; + BufSize:LongWord; + Encoding:word; + ContProgress: Boolean; + CurOffset: int64; + PrevOutputRow, OutputRow, OutputRowAdd, OutputRowAcc, OutputRowAccAdd, OutputRowMod: integer; +begin + FScanLines:=nil; + FPalette:=nil; + try + Stream.Position:=0; + ContProgress:=true; + Progress(FPimage.psStarting, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + // read header + Stream.Read(FHeader, SizeOf(FHeader)); + Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + AnalyzeHeader; + Case FHeader.Mode of + 0:begin // Bitmap (monochrome) + FPalette := TFPPalette.Create(0); + CreateBWPalette; + end; + 1, 8:begin // Gray-scale + FPalette := TFPPalette.Create(0); + CreateGrayPalette; + end; + 2:begin // Indexed color (palette color) + FPalette := TFPPalette.Create(0); + if not ReadPalette(stream) then exit; + end; + end; + + if Assigned(OnCreateImage) then + OnCreateImage(Self,Img); + + if (MinifyHeight > 0) and (FHeight > MinifyHeight) then + FOutputHeight:= MinifyHeight + else + if WantedHeight > 0 then + FOutputHeight:= WantedHeight + else + FOutputHeight:= FHeight; + Img.SetSize(FWidth,FOutputHeight); + + // color palette + BufSize:=0; + Stream.Read(BufSize, SizeOf(BufSize)); + BufSize:=BEtoN(BufSize); + Stream.Seek(BufSize, soCurrent); + // color data block + Stream.Read(BufSize, SizeOf(BufSize)); + BufSize:=BEtoN(BufSize); + Stream.Read(FColorDataBlock, SizeOf(FColorDataBlock)); + Stream.Seek(BufSize-SizeOf(FColorDataBlock), soCurrent); + // mask + Stream.Read(BufSize, SizeOf(BufSize)); + BufSize:=BEtoN(BufSize); + Stream.Seek(BufSize, soCurrent); + // compression type + Encoding:=0; + Stream.Read(Encoding, SizeOf(Encoding)); + FCompressed:=BEtoN(Encoding) = 1; + if BEtoN(Encoding)>1 then + Raise Exception.Create('Unknown compression type'); + If FCompressed then + begin + SetLength(FLengthOfLine, FHeight * FChannelCount); + Stream.ReadBuffer(FLengthOfLine[0], 2 * Length(FLengthOfLine)); + Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + if not (FHeader.Mode in [0, 2]) then + LenOfLineFactor := FHeader.Depth div 8 + else + LenOfLineFactor := 1; + end else + begin + FLengthOfLine := nil; + end; + + setlength(FInputLine, FHeight * FChannelCount); + CurOffset := Stream.Position; + H := 0; + channel := 0; + InputLineIndex:= 0; + for LenOfLineIndex := 0 to FHeight * FChannelCount-1 do + begin + FInputLine[InputLineIndex].StreamOffset := CurOffset; + if FLengthOfLine <> nil then + FInputLine[InputLineIndex].Size := BEtoN(FLengthOfLine[LenOfLineIndex])*LenOfLineFactor else + FInputLine[InputLineIndex].Size := FLineSize; + inc(CurOffset, FInputLine[InputLineIndex].Size); + inc(H); + Inc(InputLineIndex, FChannelCount); + if H = FHeight then + begin + H := 0; + Inc(channel); + InputLineIndex:= channel; + end; + end; + + InputLineIndex := 0; + PrevOutputRow := -1; + OutputRow := 0; + OutputRowAdd := FOutputHeight div FHeight; + OutputRowMod:= FHeight; + OutputRowAccAdd := FOutputHeight mod FHeight; + OutputRowAcc:= 0; + + For H := 0 to FHeight - 1 do + begin + if OutputRow > PrevOutputRow then + begin + for channel := 0 to FChannelCount-1 do + begin + Stream.Position := FInputLine[InputLineIndex].StreamOffset; + ReadScanLine(Stream, FInputLine[InputLineIndex].Size, channel); + Inc(InputLineIndex); + end; + For HOutput:= PrevOutputRow+1 to OutputRow do WriteScanLine(Img, HOutput); + Progress(FPimage.psRunning, round((H+1)*99.0 / (FHeight * FChannelCount)), False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + end else inc(InputLineIndex, FChannelCount); + + PrevOutputRow:= OutputRow; + Inc(OutputRow, OutputRowAdd); + Inc(OutputRowAcc, OutputRowAccAdd); + if OutputRowAcc> OutputRowMod then + begin + dec(OutputRowAcc, OutputRowMod); + inc(OutputRow); + end; + end; + Progress(FPimage.psRunning, 100, False, Rect(0,0,0,0), '', ContProgress); + if not ContProgress then exit; + + {$ifdef FPC_Debug_Image} + WriteLn('TBGRAReaderPSD.InternalRead AAA1 ',Stream.position,' ',Stream.size); + {$endif} + finally + FreeAndNil(FPalette); + for channel := 0 to FChannelCount-1 do + ReAllocMem(FScanLines[channel],0); + end; + Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress); +end; + +function TBGRAReaderPSD.ReadScanLine(Stream: TStream; AInputSize: PtrInt; + AChannel: integer): boolean; +Var + P : PByte; + B : Byte; + I, left : PtrInt; + N : Shortint; + Count:integer; + buf, PBuf: PByte; +begin + Result:=false; + If Not Compressed then + Stream.ReadBuffer(FScanLines[AChannel]^,FLineSize) + else + begin + getmem(buf, AInputSize); + if stream.Read(buf^,AInputSize) <> AInputSize then + begin + freemem(buf); + result := false; + exit; + end; + P:=FScanLines[AChannel]; + left := FLineSize; + i:=AInputSize; + PBuf := buf; + repeat + Count:=0; + N:= PShortInt(PBuf)^; + inc(PBuf); + dec(i); + If N = -128 then + else + if N < 0 then + begin + Count:=-N+1; + if Count > left then Count := left; + dec(left,Count); + B:= PBuf^; + Inc(PBuf); + dec(i); + fillchar(p^,count,B); + inc(p,count); + end + else + begin + Count:=N+1; + if Count > left then Count := left; + dec(left,Count); + Move(PBuf^, P^, Count); + Inc(PBuf, Count); + inc(p, count); + dec(i, count); + end; + until (i <= 0) or (left <= 0); + freemem(buf); + end; + Result:=true; +end; + +function Value32To16(p: PLongWord; gamma: single): Word; +var v: single; +begin + v := (BEtoN(P^) - 1024000000)/40960000; + if v <= 0 then result := 0 else + if v >= 1 then result := 65535 else + result := round(exp(ln(v)*gamma)*65535); +end; + +procedure TBGRAReaderPSD.WriteScanLine(Img: TFPCustomImage; Row: integer); +Var + Col : Integer; + C : TFPColor; + P, P1, P2, P3 : PByte; + Lab : TLab; +begin + C.Alpha:=AlphaOpaque; + P:=FScanLines[0]; + begin + case FBytesPerPixel of + 1 : begin + for Col:=0 to Img.Width-1 do + if (P[col div 8] and (128 shr (col mod 8))) <> 0 then + Img.Colors[Col,Row]:=ThePalette[0] + else + Img.Colors[Col,Row]:=ThePalette[1]; + end; + 8 : begin + for Col:=0 to Img.Width-1 do + begin + Img.Colors[Col,Row]:=ThePalette[P[0]]; + inc(p); + end; + end; + 16 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then + begin + if FChannelCount = 1 then + for Col:=0 to Img.Width-1 do + begin + C.Red:=BEtoN(PWord(P)^); + C.green:=C.Red; + C.blue:=C.Red; + C.alpha:=65535; + Img[col, row] := C; + Inc(P,2); + end else + if FChannelCount = 2 then + begin + P1:=FScanLines[1]; + for Col:=0 to Img.Width-1 do + begin + C.Red:=P^ shl 8 + P^; + C.green:=C.Red; + C.blue:=C.Red; + C.alpha:=p1^ shl 8 + P1^; + Img[col, row] := C; + Inc(P); + Inc(P1); + end; + end; + end else + begin + for Col:=0 to Img.Width-1 do + begin + Img.Colors[Col,Row]:=ThePalette[BEtoN(PWord(P)^)]; + inc(p,2); + end; + end; + 24 : if FChannelCount>=3 then + begin + P1:=FScanLines[1]; + P2:=FScanLines[2]; + for Col:=0 to Img.Width-1 do + begin + if (FHeader.Mode =9) then + begin + Lab.L:=P[0]; + Lab.a:=P1[0]; + Lab.b:=P2[0]; + C:=LabToRGB(Lab); + end + else + With C do + begin + Red:=P[0] or (P[0] shl 8); + green:=P1[0] or (P1[0] shl 8); + blue:=P2[0] or (P2[0] shl 8); + alpha:=alphaOpaque; + end; + Inc(P); + Inc(P1); + Inc(P2); + Img[col, row] := C; + end; + end; + 32 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then + begin + if FChannelCount = 1 then + for Col:=0 to Img.Width-1 do + begin + C.Red:=Value32To16(PLongWord(P),1.3); + C.green:=C.Red; + C.blue:=C.Red; + C.alpha:=65535; + Img[col, row] := C; + Inc(P,4); + end else + if FChannelCount = 2 then + begin + P1:=FScanLines[1]; + for Col:=0 to Img.Width-1 do + begin + C.Red:=BEtoN(PWord(P)^); + C.green:=C.Red; + C.blue:=C.Red; + C.alpha:=BEtoN(PWord(p1)^); + Img[col, row] := C; + Inc(P,2); + Inc(P1,2); + end; + end; + end else + if FChannelCount >= 4 then + begin + P1:=FScanLines[1]; + P2:=FScanLines[2]; + P3:=FScanLines[3]; + for Col:=0 to Img.Width-1 do + begin + if (FHeader.Mode =4) then + begin + P^ := 255 - P^; + P1^ := 255 - P1^; + P2^ := 255 - P2^; + P3^ := 255 - P3^; + end; + C.Red:=P[0] or (P[0] shl 8); + C.green:=P1[0] or (P1[0] shl 8); + C.blue:=P2[0] or (P2[0] shl 8); + C.alpha:=P3[0] or (P3[0] shl 8); + if (FHeader.Mode =4) then C:=CMYKtoRGB(C); // CMYK to RGB + Img[col, row] := C; + Inc(P); + Inc(P1); + Inc(P2); + Inc(P3); + end; + end; + 48 :if FChannelCount = 3 then + begin + P1:=FScanLines[1]; + P2:=FScanLines[2]; + C.alpha:=alphaOpaque; + for Col:=0 to Img.Width-1 do + begin + if (FHeader.Mode =9) then + C := LabToRGB(BEtoN(PWord(P)^)/65535, (BEtoN(PWord(P1)^)-32768)/32767, (BEtoN(PWord(P2)^)-32768)/32767) + else + With C do + begin + Red:=BEtoN(PWord(P)^); + green:=BEtoN(PWord(P1)^); + blue:=BEtoN(PWord(P2)^); + end; + Inc(P,2); + Inc(P1,2); + Inc(P2,2); + Img[col, row] := C; + end; + end; + 64 : if FChannelCount = 4 then + begin + P1:=FScanLines[1]; + P2:=FScanLines[2]; + P3:=FScanLines[3]; + for Col:=0 to Img.Width-1 do + begin + C.Red:=BEtoN(PWord(P)^); + C.green:=BEtoN(PWord(P1)^); + C.blue:=BEtoN(PWord(P2)^); + C.alpha:=BEtoN(PWord(P3)^); + if (FHeader.Mode =4) then + begin + C.red:=$ffff-C.red; + C.green:=$ffff-C.green; + C.blue:=$ffff-C.blue; + C.alpha:=$ffff-C.alpha; + end; + if (FHeader.Mode =4) then C:=CMYKtoRGB(C); // CMYK to RGB + Img[col, row] := C; + Inc(P,2); + Inc(P1,2); + Inc(P2,2); + Inc(P3,2); + end; + end; + 96 :if FChannelCount = 3 then + begin + P1:=FScanLines[1]; + P2:=FScanLines[2]; + C.alpha:=alphaOpaque; + for Col:=0 to Img.Width-1 do + begin + With C do + begin + Red:=Value32To16(PLongWord(P),2.7); + green:=Value32To16(PLongWord(P1),2.7); + blue:=Value32To16(PLongWord(P2),2.7); + end; + Inc(P,4); + Inc(P1,4); + Inc(P2,4); + Img[col, row] := C; + end; + end; + end; + end; +end; + +function TBGRAReaderPSD.InternalCheck(Stream: TStream): boolean; +var + OldPos: Int64; +begin + try + OldPos:=Stream.Position; + Stream.Read(FHeader,SizeOf(FHeader)); + Result:=(FHeader.Signature = '8BPS'); + Stream.Position:=OldPos; + except + Result:=False; + end; +end; + +constructor TBGRAReaderPSD.Create; +begin + inherited Create; +end; + +initialization + + DefaultBGRAImageReader[ifPsd] := TBGRAReaderPSD; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtga.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtga.pas new file mode 100644 index 0000000..303b750 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtga.pas @@ -0,0 +1,192 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{*****************************************************************************} +{ + The original file is part of the Free Pascal's "Free Components Library". + Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team + + Targa reader implementation modified by circular. +} +{*****************************************************************************} + +{ - 22/11/2007 Modified by Laurent Jacques for support all format } + +{$mode objfpc} +{$h+} + +unit BGRAReadTGA; + +interface + +uses FPReadTGA, FPimage, BGRAClasses; + +type + { TBGRAReaderTarga } + + TBGRAReaderTarga = class (TFPReaderTarga) + protected + FBuffer: packed array of byte; + FBufferPos, FBufferSize: integer; + FBufferStream: TStream; + procedure ReadScanLine({%H-}Row: Integer; Stream: TStream); override; + procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); override; + procedure InitReadBuffer(AStream: TStream; ASize: integer); + procedure CloseReadBuffer; + function GetNextBufferByte: byte; + end; + +Implementation + +uses BGRABitmapTypes, targacmn; + +procedure TBGRAReaderTarga.ReadScanLine(Row: Integer; Stream: TStream); +Var + P : PByte; + B : Byte; + I,J : Integer; + PixelSizeInBytesMinus1: integer; + +begin + If Not Compressed then + Stream.ReadBuffer(FScanLine^,FLineSize) + else + begin + InitReadBuffer(Stream, 2048); + P:=FScanLine; + PixelSizeInBytesMinus1 := (BytesPerPixel shr 3)-1; + For I:=0 to ToWord(Header.Width)-1 do + begin + If (FPixelCount>0) then + Dec(FPixelCount) + else + begin + Dec(FBlockCount); + If (FBlockCount<0) then + begin + B := GetNextBufferByte; + If (B and $80)<>0 then + begin + FPixelCount:=B and $7F; + FblockCount:=0; + end + else + FBlockCount:=B and $7F + end; + For J:=0 to PixelSizeInBytesMinus1 do + FLastPixel[j] := GetNextBufferByte; + end; + For J:=0 to PixelSizeInBytesMinus1 do + begin + P[0]:=FLastPixel[j]; + Inc(P); + end; + end; + CloseReadBuffer; + end; +end; + +Procedure TBGRAReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage); +Var + Col : Integer; + Value : UInt32or64; + P : PByte; + PDest: PBGRAPixel; + +begin + P:=FScanLine; + PDest := TBGRACustomBitmap(img).ScanLine[Row]; + Case Header.ImgType of + TARGA_INDEXED_IMAGE + : for Col:=Img.width-1 downto 0 do + begin + PDest^ := FPColorToBGRA(FPalette[P^]); + Inc(PDest); + Inc(P); + end; + TARGA_TRUECOLOR_IMAGE + : if (BytesPerPixel = 32) and (AlphaBits = 8) then + Move(P^,PDest^,Img.Width*sizeof(TBGRAPixel)) else + if (BytesPerPixel = 24) then + begin + for Col:=Img.Width-1 downto 0 do + begin + PDest^ := BGRA((P+2)^,(P+1)^,P^); + inc(Pdest); + Inc(p,3); + end; + end + else if (BytesPerPixel in[8,16]) then + for Col:= Img.Width-1 to 0 do + begin + Value:=P[0]; + inc(P); + Value:=value or (P[0] shl 8); + PDest^ := BGRA(((value)shr 10) shl 3,((value)shr 5) shl 3,((value)) shl 3); + Inc(PDest); + Inc(P); + end; + TARGA_GRAY_IMAGE + : case BytesPerPixel of + 8 : for Col:=Img.width-1 downto 0 do + begin + PDest^ := FPColorToBGRA(FPalette[P^]); + Inc(PDest); + Inc(P); + end; + 16 : for Col:=0 to Img.width-1 do + begin + With PDest^ do + begin + blue:=FPalette[P^].blue shr 8; + green:=FPalette[P^].green shr 8; + red:=FPalette[P^].red shr 8; + Inc(P); + if alphaBits = 8 then alpha := P^ else + alpha:=255; + Inc(P); + end; + inc(PDest); + end; + end; + end; +end; + +procedure TBGRAReaderTarga.InitReadBuffer(AStream: TStream; ASize: integer); +begin + setLength(FBuffer,ASize); + FBufferSize := AStream.Read(FBuffer[0],ASize); + FBufferPos := 0; + FBufferStream := AStream; +end; + +procedure TBGRAReaderTarga.CloseReadBuffer; +begin + FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; +end; + +function TBGRAReaderTarga.GetNextBufferByte: byte; +begin + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + if FBufferSize = 0 then + result := 0 + else + begin + FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); + FBufferPos := 0; + if FBufferPos < FBufferSize then + begin + result := FBuffer[FBufferPos]; + inc(FBufferPos); + end else + result := 0; + end; +end; + +initialization + + DefaultBGRAImageReader[ifTarga] := TBGRAReaderTarga; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtiff.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtiff.pas new file mode 100644 index 0000000..9990364 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadtiff.pas @@ -0,0 +1,2863 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + The original file is part of the Free Pascal run time library. + Copyright (c) 2012-2013 by the Free Pascal development team + + Tiff reader for fpImage modified by circular. + + ********************************************************************** + + Working: + Sample bitdepth: 1, 4, 8, 12, 16 + Color format: black and white, grayscale, RGB, colormap, L*a*b* + Alpha channel: none, premultiplied, separated + Compression: packbits, LZW, deflate + Endian-ness: little endian and big endian + Orientation: any corner can be (0,0) and x/y can be flipped + Planar configuration: 1 (channels together) + Fill order: any (for 1 bit per sample images) + Skipping thumbnail by reading biggest image + Multiple images + Strips and tiles + + ToDo: + Compression: FAX, Jpeg... + Color format: YCbCr, ITU L*a*b* + PlanarConfiguration: 2 (one chunk for each channel) + bigtiff 64bit offsets + XMP tag 700 + ICC profile tag 34675 + + Not to do: + Separate mask (deprecated) + +} +unit BGRAReadTiff; + +{$mode objfpc}{$H+} + +{$inline on} + +interface + +uses + Math, BGRAClasses, SysUtils, ctypes, zinflate, zbase, FPimage, FPTiffCmn, + BGRABitmapTypes; + +type + TBGRAReaderTiff = class; + + TTiffCreateCompatibleImgEvent = procedure(Sender: TBGRAReaderTiff; + ImgFileDir: TTiffIFD) of object; + + TTiffCheckIFDOrder = ( + tcioSmart, + tcioAlways, + tcioNever + ); + + { TBGRAReaderTiff } + + TBGRAReaderTiff = class(TFPCustomImageReader) + private + FCheckIFDOrder: TTiffCheckIFDOrder; + FFirstIFDStart: LongWord; + FOnCreateImage: TTiffCreateCompatibleImgEvent; + {$ifdef FPC_Debug_Image} + FDebug: boolean; + {$endif} + FIFDList: TFPList; + FReverseEndian: Boolean; + fStartPos: int64; + s: TStream; + function GetImages(Index: integer): TTiffIFD; + procedure TiffError(Msg: string); + procedure SetStreamPos(p: LongWord); + function ReadTiffHeader(QuickTest: boolean; out IFDStart: LongWord): boolean; // returns IFD: offset to first IFD + function ReadIFD(Start: LongWord; IFD: TTiffIFD): LongWord;// Image File Directory + procedure ReadDirectoryEntry(var EntryTag: Word; IFD: TTiffIFD); + function ReadEntryUnsigned: LongWord; + function ReadEntrySigned: Cint32; + function ReadEntryRational: TTiffRational; + function ReadEntryString: string; + function ReadByte: Byte; + function ReadWord: Word; + function ReadDWord: LongWord; + procedure ReadValues(StreamPos: LongWord; + out EntryType: word; out EntryCount: LongWord; + out Buffer: Pointer; out ByteCount: PtrUInt); + procedure ReadShortOrLongValues(StreamPos: LongWord; + out Buffer: PLongWord; out Count: LongWord); + procedure ReadShortValues(StreamPos: LongWord; + out Buffer: PWord; out Count: LongWord); + procedure ReadImageSampleProperties(IFD: TTiffIFD; out AlphaChannel: integer; out PremultipliedAlpha: boolean; + out SampleCnt: LongWord; out SampleBits: PWord; out SampleBitsPerPixel: LongWord; + out PaletteCnt: LongWord; out PaletteValues: PWord); + procedure ReadImgValue(BitCount: Word; + var Run: Pointer; var BitPos: Byte; FillOrder: LongWord; + Predictor: word; var LastValue: word; out Value: Word); + function FixEndian(w: Word): Word; inline; + function FixEndian(d: LongWord): LongWord; inline; + procedure SetFPImgExtras(CurImg: TFPCustomImage; IFD: TTiffIFD); + procedure DecodePackBits(var Buffer: Pointer; var Count: PtrInt); + procedure DecodeLZW(var Buffer: Pointer; var Count: PtrInt); + procedure DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; ExpectedCount: PtrInt); + protected + procedure InternalRead(Str: TStream; AnImage: TFPCustomImage); override; + function InternalCheck(Str: TStream): boolean; override; + procedure DoCreateImage(ImgFileDir: TTiffIFD); virtual; + public + constructor Create; override; + destructor Destroy; override; + procedure Clear; + + procedure LoadFromStream(aStream: TStream; AutoClear: boolean = true); //load all images (you need to handle OnCreateImage event and assign ImgFileDir.Img) + {$ifdef FPC_Debug_Image} + property Debug: boolean read FDebug write FDebug; + {$endif} + property OnCreateImage: TTiffCreateCompatibleImgEvent read FOnCreateImage + write FOnCreateImage; + property CheckIFDOrder: TTiffCheckIFDOrder read FCheckIFDOrder write FCheckIFDOrder; //check order of IFD entries or not + function FirstImg: TTiffIFD; + function GetBiggestImage: TTiffIFD; + function ImageCount: integer; + property Images[Index: integer]: TTiffIFD read GetImages; default; + + public //advanced + ImageList: TFPList; // list of TTiffIFD + procedure LoadHeaderFromStream(aStream: TStream); + procedure LoadIFDsFromStream; // call LoadHeaderFromStream before + procedure LoadImageFromStream(Index: integer); // call LoadIFDsFromStream before + procedure LoadImageFromStream(IFD: TTiffIFD); // call LoadIFDsFromStream before + procedure ReleaseStream; + property StartPos: int64 read fStartPos; + property TheStream: TStream read s; + property FirstIFDStart: LongWord read FFirstIFDStart; + end; + +procedure DecompressPackBits(Buffer: Pointer; Count: PtrInt; + out NewBuffer: Pointer; out NewCount: PtrInt); +procedure DecompressLZW(Buffer: Pointer; Count: PtrInt; + out NewBuffer: PByte; out NewCount: PtrInt); +function DecompressDeflate(Compressed: PByte; CompressedCount: LongWord; + out Decompressed: PByte; var DecompressedCount: LongWord; + ErrorMsg: PAnsiString = nil): boolean; + +implementation + +function CMYKToFPColor(C,M,Y,K: Word): TFPColor; +var R, G, B : LongWord; +begin + R := $ffff - ((LongWord(C)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; + G := $ffff - ((LongWord(M)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; + B := $ffff - ((LongWord(Y)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; + Result := FPColor(R and $ffff,G and $ffff,B and $ffff); +end ; + +procedure TBGRAReaderTiff.TiffError(Msg: string); +begin + Msg:=Msg+' at position '+IntToStr(s.Position); + if fStartPos>0 then + Msg:=Msg+' (TiffPosition='+IntToStr(fStartPos)+')'; + raise Exception.Create(Msg); +end; + +function TBGRAReaderTiff.GetImages(Index: integer): TTiffIFD; +begin + Result:=TTiffIFD(ImageList[Index]); +end; + +procedure TBGRAReaderTiff.ReadImageSampleProperties(IFD: TTiffIFD; + out AlphaChannel: integer; out PremultipliedAlpha: boolean; + out SampleCnt: LongWord; out SampleBits: PWord; out SampleBitsPerPixel: LongWord; + out PaletteCnt: LongWord; out PaletteValues: PWord); +var + BytesPerPixel: Word; + i: Integer; + ExtraSampleCnt, RegularSampleCnt: LongWord; + ExtraSamples: PWord; +begin + ReadShortValues(IFD.BitsPerSample, SampleBits, SampleCnt); + if SampleCnt<>IFD.SamplesPerPixel then + begin + ReAllocMem(SampleBits, 0); + TiffError('Samples='+IntToStr(SampleCnt)+' <> SamplesPerPixel='+IntToStr(IFD + .SamplesPerPixel)); + end; + + BytesPerPixel:=0; + SampleBitsPerPixel:=0; + PaletteCnt:= 0; + PaletteValues:= nil; + + AlphaChannel:= -1; + PremultipliedAlpha:= false; + IFD.AlphaBits:= 0; + + //looking for alpha channel in extra samples + if IFD.ExtraSamples>0 then + ReadShortValues(IFD.ExtraSamples, ExtraSamples, ExtraSampleCnt) + else begin + ExtraSamples := nil; + ExtraSampleCnt:= 0; + end; + + if ExtraSampleCnt>=SampleCnt then + begin + ReAllocMem(SampleBits, 0); + ReAllocMem(ExtraSamples, 0); + TiffError('Samples='+IntToStr(SampleCnt)+' ExtraSampleCnt='+IntToStr( + ExtraSampleCnt)); + end; + + RegularSampleCnt := SampleCnt - ExtraSampleCnt; + + for i:=0 to ExtraSampleCnt-1 do begin + if ExtraSamples[i] in [1, 2] then begin + AlphaChannel := RegularSampleCnt+i; + PremultipliedAlpha:= ExtraSamples[i]=1; + IFD.AlphaBits:=SampleBits[AlphaChannel]; + end; + end; + + ReAllocMem(ExtraSamples, 0); //end of extra samples + + for i:=0 to SampleCnt-1 do begin + if SampleBits[i]>16 then + TiffError('Samples bigger than 16 bit not supported'); + if not (SampleBits[i] in [1, 4, 8, 12, 16]) then + TiffError('Only samples of 1, 4, 8, 12 and 16 bit are supported'); + if (i <> 0) and ((SampleBits[i] = 1) xor (SampleBits[0] = 1)) then + TiffError('Cannot mix 1 bit samples with other sample sizes'); + inc(SampleBitsPerPixel, SampleBits[i]); + end; + + BytesPerPixel:= SampleBitsPerPixel div 8; + IFD.BytesPerPixel:=BytesPerPixel; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('BytesPerPixel=', BytesPerPixel); + {$endif} + + case IFD.PhotoMetricInterpretation of + 0, 1: + begin + if RegularSampleCnt<>1 then + TiffError('gray images expect one sample per pixel, but found '+ + IntToStr(SampleCnt)); + + IFD.GrayBits:=SampleBits[0]; + end; + 2: + begin + if (RegularSampleCnt<>3) and (RegularSampleCnt<>4) then + TiffError('rgb(a) images expect three or four samples per pixel, but found '+ + IntToStr(SampleCnt)); + + IFD.RedBits:=SampleBits[0]; + IFD.GreenBits:=SampleBits[1]; + IFD.BlueBits:=SampleBits[2]; + if RegularSampleCnt=4 then begin + if (AlphaChannel <> -1) then + TiffError('Alpha channel specified twice'); + AlphaChannel:= 3; + PremultipliedAlpha:= false; + IFD.AlphaBits:=SampleBits[AlphaChannel]; + end; + end; + 3: + begin + if RegularSampleCnt<>1 then + TiffError('palette images expect one sample per pixel, but found '+ + IntToStr(SampleCnt)); + + if IFD.ColorMap > 0 then + begin + ReadShortValues(IFD.ColorMap, PaletteValues, PaletteCnt); + if PaletteCnt <> (1 shl SampleBits[0])*3 then + begin + ReAllocMem(PaletteValues, 0); + TiffError('Palette size mismatch'); + end; + end else + TiffError('Palette not supplied') + end; + 4: + begin + if RegularSampleCnt<>1 then + TiffError('mask images expect one sample per pixel, but found '+ + IntToStr(SampleCnt)); + TiffError('Mask images not handled'); + end; + 5: + begin + if RegularSampleCnt<>4 then + TiffError('cmyk images expect four samples per pixel, but found '+ + IntToStr(SampleCnt)); + + IFD.RedBits:=SampleBits[0]; //cyan + IFD.GreenBits:=SampleBits[1]; //magenta + IFD.BlueBits:=SampleBits[2]; //yellow + IFD.GrayBits:=SampleBits[3]; //black + PremultipliedAlpha:= false; + end; + 8,9: + begin + if (RegularSampleCnt<>1) and (RegularSampleCnt<>3) then + TiffError('L*a*b* colorspace needs either one component for grayscale or three components, but found '+inttostr(RegularSampleCnt)); + if RegularSampleCnt = 3 then + begin + IFD.GreenBits:=SampleBits[0]; + if (IFD.GreenBits <> 8) and (IFD.GreenBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component'); + IFD.RedBits:=SampleBits[1]; + IFD.BlueBits:=SampleBits[2]; //in fact inverse blue so more like yellow + if ((IFD.RedBits <> 8) and (IFD.RedBits <> 16)) + or ((IFD.BlueBits <> 8) and (IFD.BlueBits <> 16)) then TiffError('Only 8 bit and 16 bit depth allowed for a* and b* component'); + end else + begin + IFD.GrayBits:=SampleBits[0]; + if (IFD.GrayBits <> 8) and (IFD.GrayBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component'); + end; + PremultipliedAlpha:= false; + end + else + TiffError('Photometric interpretation not handled (' + inttostr(IFD.PhotoMetricInterpretation)+')'); + end; +end; + +procedure TBGRAReaderTiff.SetFPImgExtras(CurImg: TFPCustomImage; IFD: TTiffIFD); +begin + ClearTiffExtras(CurImg); + // set Tiff extra attributes + CurImg.Extra[TiffPhotoMetric]:=IntToStr(IFD.PhotoMetricInterpretation); + //writeln('TBGRAReaderTiff.SetFPImgExtras PhotoMetric=',CurImg.Extra[TiffPhotoMetric]); + if IFD.Artist<>'' then + CurImg.Extra[TiffArtist]:=IFD.Artist; + if IFD.Copyright<>'' then + CurImg.Extra[TiffCopyright]:=IFD.Copyright; + if IFD.DocumentName<>'' then + CurImg.Extra[TiffDocumentName]:=IFD.DocumentName; + if IFD.DateAndTime<>'' then + CurImg.Extra[TiffDateTime]:=IFD.DateAndTime; + if IFD.HostComputer<>'' then + CurImg.Extra[TiffHostComputer]:=IFD.HostComputer; + if IFD.ImageDescription<>'' then + CurImg.Extra[TiffImageDescription]:=IFD.ImageDescription; + if IFD.Make_ScannerManufacturer<>'' then + CurImg.Extra[TiffMake_ScannerManufacturer]:=IFD.Make_ScannerManufacturer; + if IFD.Model_Scanner<>'' then + CurImg.Extra[TiffModel_Scanner]:=IFD.Model_Scanner; + if IFD.Software<>'' then + CurImg.Extra[TiffSoftware]:=IFD.Software; + if not (IFD.Orientation in [1..8]) then + IFD.Orientation:=1; + CurImg.Extra[TiffOrientation]:=IntToStr(IFD.Orientation); + if IFD.ResolutionUnit<>0 then + CurImg.Extra[TiffResolutionUnit]:=IntToStr(IFD.ResolutionUnit); + if (IFD.XResolution.Numerator<>0) or (IFD.XResolution.Denominator<>0) then + CurImg.Extra[TiffXResolution]:=TiffRationalToStr(IFD.XResolution); + if (IFD.YResolution.Numerator<>0) or (IFD.YResolution.Denominator<>0) then + CurImg.Extra[TiffYResolution]:=TiffRationalToStr(IFD.YResolution); + CurImg.Extra[TiffRedBits]:=IntToStr(IFD.RedBits); + CurImg.Extra[TiffGreenBits]:=IntToStr(IFD.GreenBits); + CurImg.Extra[TiffBlueBits]:=IntToStr(IFD.BlueBits); + CurImg.Extra[TiffGrayBits]:=IntToStr(IFD.GrayBits); + CurImg.Extra[TiffAlphaBits]:=IntToStr(IFD.AlphaBits); + if IFD.PageCount>0 then begin + CurImg.Extra[TiffPageNumber]:=IntToStr(IFD.PageNumber); + CurImg.Extra[TiffPageCount]:=IntToStr(IFD.PageCount); + end; + if IFD.PageName<>'' then + CurImg.Extra[TiffPageName]:=IFD.PageName; + if IFD.ImageIsThumbNail then + CurImg.Extra[TiffIsThumbnail]:='1'; + if IFD.ImageIsMask then + CurImg.Extra[TiffIsMask]:='1'; + if IFD.Compression<>TiffCompressionNone then + CurImg.Extra[TiffCompression]:=IntToStr(IFD.Compression); + + {$ifdef FPC_Debug_Image} + if Debug then + WriteTiffExtras('SetFPImgExtras', CurImg); + {$endif} +end; + +procedure TBGRAReaderTiff.ReadImgValue(BitCount: Word; + var Run: Pointer; var BitPos: Byte; FillOrder: LongWord; + Predictor: word; var LastValue: word; out Value: Word); +var + BitNumber: byte; + Byte1, Byte2: byte; +begin + case BitCount of + 1: + begin + if FillOrder = 2 then + BitNumber:=BitPos //Leftmost pixel starts with bit 0 + else + BitNumber:=7-BitPos; //Leftmost pixel starts with bit 7 + Value:=((PCUInt8(Run)^) and (1 shl BitNumber) shr BitNumber); + inc(BitPos); + if BitPos = 8 then + begin + BitPos := 0; + inc(Run); //next byte when all bits read + end; + if Predictor = 2 then Value := (LastValue+Value) and 1; + LastValue:=Value; + if Value > 0 then Value := $ffff; + end; + 4: + begin + if BitPos = 0 then + begin + Value := PCUInt8(Run)^ shr 4; + BitPos := 4; + end + else + begin + Value := PCUInt8(Run)^ and 15; + BitPos := 0; + Inc(Run); + end; + if Predictor = 2 then Value := (LastValue+Value) and $f; + LastValue:=Value; + Value := Value + (value shl 4) + (value shl 8) + (value shl 12); + end; + 8: + begin + Value:=PCUInt8(Run)^; + inc(Run); + if Predictor = 2 then Value := (LastValue+Value) and $ff; + LastValue:=Value; + Value:=Value shl 8+Value; + end; + 12: + begin + Byte1 := PCUInt8(Run)^; + Byte2 := PCUInt8(Run+1)^; + if BitPos = 0 then begin + Value := (Byte1 shl 4) or (Byte2 shr 4); + inc(Run); + BitPos := 4; + end else begin + Value := ((Byte1 and $0F) shl 8) or Byte2; + inc(Run, 2); + BitPos := 0; + end; + if Predictor = 2 then Value := (LastValue+Value) and $fff; + LastValue:=Value; + Value := (Value shl 4) + (Value shr 8); + end; + 16: + begin + Value:=FixEndian(PCUInt16(Run)^); + inc(Run,2); + if Predictor = 2 then Value := (LastValue+Value) and $ffff; + LastValue:=Value; + end; + end; +end; + +procedure TBGRAReaderTiff.SetStreamPos(p: LongWord); +var + NewPosition: int64; +begin + NewPosition:=Int64(p)+fStartPos; + if NewPosition>s.Size then + TiffError('Offset outside of stream'); + s.Position:=NewPosition; +end; + +procedure TBGRAReaderTiff.LoadFromStream(aStream: TStream; AutoClear: boolean); +var + i: Integer; + aContinue: Boolean; +begin + if AutoClear then + Clear; + aContinue:=true; + Progress(psStarting, 0, False, Rect(0,0,0,0), '', aContinue); + if not aContinue then exit; + LoadHeaderFromStream(aStream); + LoadIFDsFromStream; + for i := 0 to ImageCount-1 do + begin + Progress(psRunning, (i+1)*100 div (ImageCount+1), False, Rect(0,0,0,0), + IntToStr(i+1)+'/'+IntToStr(ImageCount), aContinue); + LoadImageFromStream(i); + end; + Progress(psEnding, 100, False, Rect(0,0,0,0), '', aContinue); + ReleaseStream; +end; + +procedure TBGRAReaderTiff.LoadHeaderFromStream(aStream: TStream); +begin + FFirstIFDStart:=0; + s:=aStream; + fStartPos:=s.Position; + ReadTiffHeader(false,FFirstIFDStart); +end; + +procedure TBGRAReaderTiff.LoadIFDsFromStream; +var + i,j: Integer; + IFDStart: LongWord; + IFD: TTiffIFD; +begin + IFDStart:=FirstIFDStart; + i:=0; + while IFDStart>0 do begin + for j := 0 to i-1 do + if Images[j].IFDStart = IFDStart then exit; //IFD cycle detected + + if ImageCount=i then + begin + IFD := TTiffIFD.Create; + ImageList.Add(IFD); + end else + IFD:=Images[i]; + IFDStart:=ReadIFD(IFDStart, IFD); + inc(i); + end; +end; + +function TBGRAReaderTiff.FirstImg: TTiffIFD; +begin + Result:=nil; + if (ImageList=nil) or (ImageList.Count=0) then exit; + Result:=TTiffIFD(ImageList[0]); +end; + +function TBGRAReaderTiff.GetBiggestImage: TTiffIFD; +var + Size: Int64; + IFD: TTiffIFD; + CurSize: int64; + i: Integer; +begin + Result:=nil; + Size:=0; + for i:=0 to ImageCount-1 do begin + IFD:=Images[i]; + CurSize:=Int64(IFD.ImageWidth)*IFD.ImageHeight; + if CurSize 65535 then + TiffError('expected PhotometricInterpretation, but found '+IntToStr(UValue)); + IFD.PhotoMetricInterpretation:=UValue; + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 262: PhotometricInterpretation='); + case IFD.PhotoMetricInterpretation of + 0: write('0=bilevel grayscale 0 is white'); + 1: write('1=bilevel grayscale 0 is black'); + 2: write('2=RGB 0,0,0 is black'); + 3: write('3=Palette color'); + 4: write('4=Transparency Mask'); + 5: write('5=CMYK 8bit'); + 8: write('8=L*a*b* with a and b [-128;127]'); + 9: write('9=L*a*b* with a and b [0;255]'); + end; + writeln; + end; + {$endif} + end; + 263: + begin + // Tresholding + UValue:=ReadEntryUnsigned; + case UValue of + 1: ; // no dithering or halftoning was applied + 2: ; // an ordered dithering or halftoning was applied + 3: ; // a randomized dithering or halftoning was applied + else + TiffError('expected Tresholding, but found '+IntToStr(UValue)); + end; + IFD.Tresholding:=UValue; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 263: Tresholding=',IFD.Tresholding); + {$endif} + end; + 264: + begin + // CellWidth + IFD.CellWidth:=ReadEntryUnsigned; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 264: CellWidth=',IFD.CellWidth); + {$endif} + end; + 265: + begin + // CellLength + IFD.CellLength:=ReadEntryUnsigned; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 265: CellLength=',IFD.CellLength); + {$endif} + end; + 266: + begin + // FillOrder + UValue:=ReadEntryUnsigned; + case UValue of + 1: IFD.FillOrder:=1; // left to right = high to low + 2: IFD.FillOrder:=2; // left to right = low to high + else + TiffError('expected FillOrder, but found '+IntToStr(UValue)); + end; + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 266: FillOrder=',IntToStr(IFD.FillOrder),'='); + case IFD.FillOrder of + 1: write('left to right = high to low'); + 2: write('left to right = low to high'); + end; + writeln; + end; + {$endif} + end; + 269: + begin + // DocumentName + IFD.DocumentName:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 269: DocumentName=',IFD.DocumentName); + {$endif} + end; + 270: + begin + // ImageDescription + IFD.ImageDescription:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 270: ImageDescription=',IFD.ImageDescription); + {$endif} + end; + 271: + begin + // Make - scanner manufacturer + IFD.Make_ScannerManufacturer:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 271: Make_ScannerManufacturer=',IFD.Make_ScannerManufacturer); + {$endif} + end; + 272: + begin + // Model - scanner model + IFD.Model_Scanner:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 272: Model_Scanner=',IFD.Model_Scanner); + {$endif} + end; + 273: + begin + // StripOffsets (store offset to entity, not the actual contents of the offsets) + IFD.StripOffsets:=GetPos; //Store position of entity so we can look up multiple offsets later + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 273: StripOffsets, offset for entry=',IFD.StripOffsets); + {$endif} + end; + 274: + begin + // Orientation + UValue:=ReadEntryUnsigned; + case UValue of + 1: ;// 0,0 is left, top + 2: ;// 0,0 is right, top + 3: ;// 0,0 is right, bottom + 4: ;// 0,0 is left, bottom + 5: ;// 0,0 is top, left (rotated) + 6: ;// 0,0 is top, right (rotated) + 7: ;// 0,0 is bottom, right (rotated) + 8: ;// 0,0 is bottom, left (rotated) + else + TiffError('expected Orientation, but found '+IntToStr(UValue)); + end; + IFD.Orientation:=UValue; + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 274: Orientation=',IntToStr(IFD.Orientation),'='); + case IFD.Orientation of + 1: write('0,0 is left, top'); + 2: write('0,0 is right, top'); + 3: write('0,0 is right, bottom'); + 4: write('0,0 is left, bottom'); + 5: write('0,0 is top, left (rotated)'); + 6: write('0,0 is top, right (rotated)'); + 7: write('0,0 is bottom, right (rotated)'); + 8: write('0,0 is bottom, left (rotated)'); + end; + writeln; + end; + {$endif} + end; + 277: + begin + // SamplesPerPixel + IFD.SamplesPerPixel:=ReadEntryUnsigned; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 277: SamplesPerPixel=',IFD.SamplesPerPixel); + {$endif} + end; + 278: + begin + // RowsPerStrip + UValue:=ReadEntryUnsigned; + if UValue=0 then + TiffError('expected RowsPerStrip, but found '+IntToStr(UValue)); + IFD.RowsPerStrip:=UValue; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 278: RowsPerStrip=',IFD.RowsPerStrip); + {$endif} + end; + 279: + begin + // StripByteCounts (the number of bytes in each strip). + // We're storing the position of the tag, not the various bytecounts themselves + IFD.StripByteCounts:=GetPos; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 279: StripByteCounts, offset for entry=',IFD.StripByteCounts); + {$endif} + end; + 280: + begin + // MinSampleValue + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 280: skipping MinSampleValue'); + {$endif} + end; + 281: + begin + // MaxSampleValue + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 281: skipping MaxSampleValue'); + {$endif} + end; + 282: + begin + // XResolution + IFD.XResolution:=ReadEntryRational; + {$ifdef FPC_Debug_Image} + try + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 282: XResolution=',IFD.XResolution.Numerator,'/',IFD.XResolution.Denominator,'=',IFD.XResolution.Numerator/IFD.XResolution.Denominator); + except + //ignore division by 0 + end; + {$endif} + end; + 283: + begin + // YResolution + IFD.YResolution:=ReadEntryRational; + {$ifdef FPC_Debug_Image} + try + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 283: YResolution=',IFD.YResolution.Numerator,'/',IFD.YResolution.Denominator,'=',IFD.YResolution.Numerator/IFD.YResolution.Denominator); + except + //ignore division by 0 + end; {$endif} + end; + 284: + begin + // PlanarConfiguration + SValue:=ReadEntrySigned; + case SValue of + TiffPlanarConfigurationChunky: ; // 1 + TiffPlanarConfigurationPlanar: ; // 2 + else + TiffError('expected PlanarConfiguration, but found '+IntToStr(SValue)); + end; + IFD.PlanarConfiguration:=SValue; + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 284: PlanarConfiguration='); + case SValue of + TiffPlanarConfigurationChunky: write('chunky format'); + TiffPlanarConfigurationPlanar: write('planar format'); + end; + writeln; + end; + {$endif} + end; + 285: + begin + // PageName + IFD.PageName:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 285: PageName="'+IFD.PageName+'"'); + {$endif} + end; + 288: + begin + // FreeOffsets + // The free bytes in a tiff file are described with FreeByteCount and FreeOffsets + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 288: skipping FreeOffsets'); + {$endif} + end; + 289: + begin + // FreeByteCount + // The free bytes in a tiff file are described with FreeByteCount and FreeOffsets + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 289: skipping FreeByteCount'); + {$endif} + end; + 290: + begin + // GrayResponseUnit + // precision of GrayResponseCurve + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 290: skipping GrayResponseUnit'); + {$endif} + end; + 291: + begin + // GrayResponseCurve + // the optical density for each possible pixel value + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 291: skipping GrayResponseCurve'); + {$endif} + end; + 296: + begin + // fResolutionUnit + UValue:=ReadEntryUnsigned; + case UValue of + 1: IFD.ResolutionUnit:=1; // none + 2: IFD.ResolutionUnit:=2; // inch + 3: IFD.ResolutionUnit:=3; // centimeter + else + TiffError('expected ResolutionUnit, but found '+IntToStr(UValue)); + end; + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 296: ResolutionUnit='); + case IFD.ResolutionUnit of + 1: write('none'); + 2: write('inch'); + 3: write('centimeter'); + end; + writeln; + end; + {$endif} + end; + 297: + begin + // page number (starting at 0) and total number of pages + UValue:=GetPos; + ReadShortValues(UValue,WordBuffer,Count); + try + if Count<>2 then begin + {$ifdef FPC_Debug_Image} + if Debug then begin + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 297: PageNumber/Count: '); + for i:=0 to Count-1 do + write(IntToStr(WordBuffer[i]),' '); + writeln; + end; + {$endif} + TiffError('PageNumber Count=2 expected, but found '+IntToStr(Count)); + end; + IFD.PageNumber:=WordBuffer[0]; + IFD.PageCount:=WordBuffer[1]; + if IFD.PageNumber>=IFD.PageCount then begin + // broken order => repair + UValue:=IFD.PageNumber; + IFD.PageNumber:=IFD.PageCount; + IFD.PageCount:=UValue; + end; + finally + ReAllocMem(WordBuffer,0); + end; + {$ifdef FPC_Debug_Image} + if Debug then begin + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 297: PageNumber=',IFD.PageNumber,'/',IFD.PageCount); + end; + {$endif} + end; + 305: + begin + // Software + IFD.Software:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 305: Software="',IFD.Software,'"'); + {$endif} + end; + 306: + begin + // DateAndTime + IFD.DateAndTime:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 306: DateAndTime="',IFD.DateAndTime,'"'); + {$endif} + end; + 315: + begin + // Artist + IFD.Artist:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 315: Artist="',IFD.Artist,'"'); + {$endif} + end; + 316: + begin + // HostComputer + IFD.HostComputer:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 316: HostComputer="',IFD.HostComputer,'"'); + {$endif} + end; + 317: + begin + // Predictor + UValue:=word(ReadEntryUnsigned); + case UValue of + 1: ; + 2: ; + else TiffError('expected Predictor, but found '+IntToStr(UValue)); + end; + IFD.Predictor:=UValue; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 317: Predictor="',IFD.Predictor,'"'); + {$endif} + end; + 320: + begin + // ColorMap: N = 3*2^BitsPerSample + IFD.ColorMap:=GetPos; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 320: skipping ColorMap'); + {$endif} + end; + 322: + begin + // TileWidth + IFD.TileWidth:=ReadEntryUnsigned; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 322: TileWidth=',IFD.TileWidth); + {$endif} + if IFD.TileWidth=0 then + TiffError('TileWidth=0'); + end; + 323: + begin + // TileLength = TileHeight + IFD.TileLength:=ReadEntryUnsigned; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 323: TileLength=',IFD.TileLength); + {$endif} + if IFD.TileLength=0 then + TiffError('TileLength=0'); + end; + 324: + begin + // TileOffsets + IFD.TileOffsets:=GetPos; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 324: TileOffsets=',IFD.TileOffsets); + {$endif} + if IFD.TileOffsets=0 then + TiffError('TileOffsets=0'); + end; + 325: + begin + // TileByteCounts + IFD.TileByteCounts:=GetPos; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 325: TileByteCounts=',IFD.TileByteCounts); + {$endif} + if IFD.TileByteCounts=0 then + TiffError('TileByteCounts=0'); + end; + 338: + begin + // ExtraSamples: if SamplesPerPixel is bigger than PhotometricInterpretation + // then ExtraSamples is an array defining the extra samples + // 0=unspecified + // 1=alpha (premultiplied) + // 2=alpha (unassociated) + IFD.ExtraSamples:=GetPos; + {$ifdef FPC_Debug_Image} + if Debug then begin + ReadShortValues(IFD.ExtraSamples,WordBuffer,Count); + write('TBGRAReaderTiff.ReadDirectoryEntry Tag 338: ExtraSamples: '); + for i:=0 to Count-1 do + write(IntToStr(WordBuffer[i]),' '); + writeln; + ReAllocMem(WordBuffer,0); + end; + {$endif} + end; + 347: + begin + // ToDo: JPEGTables + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 347: skipping JPEG Tables'); + {$endif} + end; + 512: + begin + // ToDo: JPEGProc + // short + // 1 = baseline sequential + // 14 = lossless process with Huffman encoding + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 512: skipping JPEGProc'); + {$endif} + end; + 513: + begin + // ToDo: JPEGInterchangeFormat + // long + // non zero: start of start of image SOI marker + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 513: skipping JPEGInterchangeFormat'); + {$endif} + end; + 514: + begin + // ToDo: JPEGInterchangeFormatLength + // long + // length in bytes of 513 + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 514: skipping JPEGInterchangeFormatLength'); + {$endif} + end; + 515: + begin + // ToDo: JPEGRestartInterval + // short + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 515: skipping JPEGRestartInterval'); + {$endif} + end; + 517: + begin + // ToDo: JPEGLosslessPredictor + // short + // Count: SamplesPerPixels + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 517: skipping JPEGLosslessPredictor'); + {$endif} + end; + 518: + begin + // ToDo: JPEGPointTransforms + // short + // Count: SamplesPerPixels + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 518: skipping JPEGPointTransforms'); + {$endif} + end; + 519: + begin + // ToDo: JPEGQTables + // long + // Count: SamplesPerPixels + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 519: skipping JPEGQTables'); + {$endif} + end; + 520: + begin + // ToDo: JPEGDCTables + // long + // Count: SamplesPerPixels + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 520: skipping JPEGDCTables'); + {$endif} + end; + 521: + begin + // ToDo: JPEGACTables + // long + // Count: SamplesPerPixels + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 521: skipping JPEGACTables'); + {$endif} + end; + 530: + begin + // ToDo: YCbCrSubSampling alias ChromaSubSampling + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 530: skipping YCbCrSubSampling alias ChromaSubSampling'); + {$endif} + end; + 700: + begin + // ToDo: XMP + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 700: skipping XMP'); + {$endif} + end; + 33432: + begin + // Copyright + IFD.Copyright:=ReadEntryString; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 33432: Copyright="',IFD.Copyright,'"'); + {$endif} + end; + 34675: + begin + // ToDo: ICC Profile + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 34675: skipping ICC profile'); + {$endif} + end; + else + begin + EntryType:=ReadWord; + EntryCount:=ReadDWord; + EntryStart:=ReadDWord; + if (EntryType=0) and (EntryCount=0) and (EntryStart=0) then ; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart); + {$endif} + end; + end; +end; + +function TBGRAReaderTiff.ReadEntryUnsigned: LongWord; +var + EntryCount: LongWord; + EntryType: Word; +begin + Result:=0; + EntryType:=ReadWord; + EntryCount:=ReadDWord; + if EntryCount<>1 then + TiffError('EntryCount=1 expected, but found '+IntToStr(EntryCount)); + //writeln('TBGRAReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); + case EntryType of + 1: begin + // byte: 8bit unsigned + Result:=ReadByte; + end; + 3: begin + // short: 16bit unsigned + Result:=ReadWord; + end; + 4: begin + // long: 32bit unsigned long + Result:=ReadDWord; + end; + else + TiffError('expected single unsigned value, but found type='+IntToStr(EntryType)); + end; +end; + +function TBGRAReaderTiff.ReadEntrySigned: Cint32; +var + EntryCount: LongWord; + EntryType: Word; +begin + Result:=0; + EntryType:=ReadWord; + EntryCount:=ReadDWord; + if EntryCount<>1 then + TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount)); + //writeln('TBGRAReaderTiff.ReadEntrySigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); + case EntryType of + 1: begin + // byte: 8bit unsigned + Result:=cint8(ReadByte); + end; + 3: begin + // short: 16bit unsigned + Result:=cint16(ReadWord); + end; + 4: begin + // long: 32bit unsigned long + Result:=cint32(ReadDWord); + end; + 6: begin + // sbyte: 8bit signed + Result:=cint8(ReadByte); + end; + 8: begin + // sshort: 16bit signed + Result:=cint16(ReadWord); + end; + 9: begin + // slong: 32bit signed long + Result:=cint32(ReadDWord); + end; + else + TiffError('expected single signed value, but found type='+IntToStr(EntryType)); + end; +end; + +function TBGRAReaderTiff.ReadEntryRational: TTiffRational; +var + EntryCount: LongWord; + EntryStart: LongWord; + EntryType: Word; +begin + Result:=TiffRational0; + EntryType:=ReadWord; + EntryCount:=ReadDWord; + if EntryCount<>1 then + TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount)); + //writeln('TBGRAReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); + case EntryType of + 1: begin + // byte: 8bit unsigned + Result.Numerator:=ReadByte; + end; + 3: begin + // short: 16bit unsigned + Result.Numerator:=ReadWord; + end; + 4: begin + // long: 32bit unsigned long + Result.Numerator:=ReadDWord; + end; + 5: begin + // rational: Two longs: numerator + denominator + // this does not fit into 4 bytes + EntryStart:=ReadDWord; + SetStreamPos(EntryStart); + Result.Numerator:=ReadDWord; + Result.Denominator:=ReadDWord; + end; + else + TiffError('expected rational unsigned value, but found type='+IntToStr(EntryType)); + end; +end; + +function TBGRAReaderTiff.ReadEntryString: string; +var + EntryType: Word; + EntryCount: LongWord; + EntryStart: LongWord; +begin + Result:=''; + EntryType:=ReadWord; + if EntryType<>2 then + TiffError('asciiz expected, but found '+IntToStr(EntryType)); + EntryCount:=ReadDWord; + SetLength(Result,EntryCount-1); + if EntryCount>4 then begin + // long string -> next 4 LongWord is the offset + EntryStart:=ReadDWord; + SetStreamPos(EntryStart); + s.Read(Result[1],EntryCount-1); + end else begin + // short string -> stored directly in the next 4 bytes + if Result<>'' then + s.Read(Result[1],length(Result)); + // skip rest of 4 bytes + if length(Result)<4 then + s.Read(EntryStart,4-length(Result)); + end; +end; + +function TBGRAReaderTiff.ReadByte: Byte; +begin + Result:=s.ReadByte; +end; + +function TBGRAReaderTiff.ReadWord: Word; +begin + Result:=FixEndian(s.ReadWord); +end; + +function TBGRAReaderTiff.ReadDWord: LongWord; +begin + Result:=FixEndian(s.ReadDWord); +end; + +procedure TBGRAReaderTiff.ReadValues(StreamPos: LongWord; out EntryType: word; out + EntryCount: LongWord; out Buffer: Pointer; out ByteCount: PtrUInt); +var + EntryStart: LongWord; +begin + Buffer:=nil; + ByteCount:=0; + EntryType:=0; + EntryCount:=0; + SetStreamPos(StreamPos); + ReadWord; // skip tag + EntryType:=ReadWord; + EntryCount:=ReadDWord; + if EntryCount=0 then exit; + case EntryType of + 1,6,7: ByteCount:=EntryCount; // byte + 2: ByteCount:=EntryCount; // asciiz + 3,8: ByteCount:=2*EntryCount; // short + 4,9: ByteCount:=4*EntryCount; // long + 5,10: ByteCount:=8*EntryCount; // rational + 11: ByteCount:=4*EntryCount; // single + 12: ByteCount:=8*EntryCount; // double + else + TiffError('invalid EntryType '+IntToStr(EntryType)); + end; + if ByteCount>4 then begin + EntryStart:=ReadDWord; + SetStreamPos(EntryStart); + end; + GetMem(Buffer,ByteCount); + s.Read(Buffer^,ByteCount); +end; + +procedure TBGRAReaderTiff.ReadShortOrLongValues(StreamPos: LongWord; out + Buffer: PLongWord; out Count: LongWord); +var + p: Pointer; + ByteCount: PtrUInt; + EntryType: word; + i: LongWord; +begin + Buffer:=nil; + Count:=0; + p:=nil; + try + ReadValues(StreamPos,EntryType,Count,p,ByteCount); + if Count=0 then exit; + if EntryType=3 then begin + // short + GetMem(Buffer,SizeOf(LongWord)*Count); + for i:=0 to Count-1 do + Buffer[i]:=FixEndian(PWord(p)[i]); + end else if EntryType=4 then begin + // long + Buffer:=p; + p:=nil; + if FReverseEndian then + for i:=0 to Count-1 do + Buffer[i]:=FixEndian(PLongWord(Buffer)[i]); + end else + TiffError('only short or long allowed'); + finally + if p<>nil then FreeMem(p); + end; +end; + +procedure TBGRAReaderTiff.ReadShortValues(StreamPos: LongWord; out Buffer: PWord; + out Count: LongWord); +var + p: Pointer; + ByteCount: PtrUInt; + EntryType: word; + i: LongWord; +begin + Buffer:=nil; + Count:=0; + p:=nil; + try + ReadValues(StreamPos,EntryType,Count,p,ByteCount); + //writeln('ReadShortValues ',FReverseEndian,' ',EntryType,' Count=',Count,' ByteCount=',ByteCount); + if Count=0 then exit; + if EntryType=3 then begin + // short + Buffer:=p; + p:=nil; + if FReverseEndian then + for i:=0 to Count-1 do + Buffer[i]:=FixEndian(Buffer[i]); + //for i:=0 to Count-1 do writeln(i,' ',Buffer[i]); + end else + TiffError('only short allowed, but found '+IntToStr(EntryType)); + finally + if p<>nil then FreeMem(p); + end; +end; + +procedure TBGRAReaderTiff.LoadImageFromStream(Index: integer); +var + IFD: TTiffIFD; +begin + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.LoadImageFromStream Index=',Index); + {$endif} + IFD:=Images[Index]; + LoadImageFromStream(IFD); +end; + +procedure TBGRAReaderTiff.LoadImageFromStream(IFD: TTiffIFD); +var + SampleCnt: LongWord; + SampleBits: PWord; + ChannelValues, LastChannelValues: array of word; + All8Bit, All16Bit: boolean; + + procedure CheckBitCount; + var + Channel: LongWord; + begin + All8Bit := true; + All16Bit := true; + for Channel := 0 to SampleCnt-1 do + begin + if SampleBits[Channel] <> 8 then All8Bit:= false; + if SampleBits[Channel] <> 16 then All16Bit:= false; + end; + end; + +var + PaletteCnt,PaletteStride: LongWord; + PaletteValues: PWord; + + AlphaChannel: integer; + PremultipliedAlpha: boolean; + + procedure InitColor; + var Channel: LongWord; + begin + SetLength(ChannelValues, SampleCnt); + SetLength(LastChannelValues, SampleCnt); + for Channel := 0 to SampleCnt-1 do + LastChannelValues[Channel] := 0; + end; + + procedure ReadNext16BitData(var Run: Pointer); + var Channel: PtrUInt; + begin + if FReverseEndian then + begin + if IFD.Predictor=2 then + begin + for Channel := 0 to SampleCnt-1 do + begin + {$PUSH}{$Q-} + Inc(ChannelValues[Channel],Swap(Word(Run^))); + {$POP} + inc(Run, 2); + end; + end else + begin + for Channel := 0 to SampleCnt-1 do + begin + ChannelValues[Channel] := Swap(Word(Run^)); + inc(Run, 2); + end; + end; + end else + begin + if IFD.Predictor=2 then + begin + for Channel := 0 to SampleCnt-1 do + begin + {$PUSH}{$Q-} + Inc(ChannelValues[Channel],Word(Run^)); + {$POP} + inc(Run, 2); + end; + end else + begin + for Channel := 0 to SampleCnt-1 do + begin + ChannelValues[Channel] := Word(Run^); + inc(Run, 2); + end; + end; + end; + end; + + procedure ReadNext8BitData(var Run: Pointer); + var Channel: PtrUInt; + begin + if IFD.Predictor=2 then + begin + for Channel := 0 to SampleCnt-1 do + begin + {$PUSH}{$Q-} + LastChannelValues[Channel] := (LastChannelValues[Channel]+Byte(Run^)) and $ff; + ChannelValues[Channel] := LastChannelValues[Channel]+(LastChannelValues[Channel] shl 8); + {$POP} + inc(Run); + end; + end else + begin + for Channel := 0 to SampleCnt-1 do + begin + ChannelValues[Channel] := Byte(Run^)+(Byte(Run^) shl 8); + inc(Run); + end; + end; + end; + + procedure ReadNextPixelData(var Run: Pointer; var BitPos: byte); + var Channel: LongWord; + begin + for Channel := 0 to SampleCnt-1 do + ReadImgValue(SampleBits[Channel], Run,BitPos,IFD.FillOrder, + IFD.Predictor,LastChannelValues[Channel], + ChannelValues[Channel]); + end; + + procedure GetPixelAsLab(out lab: TLabA); + begin + lab.L := 0; + lab.a := 0; + lab.b := 0; + lab.alpha := 1; + + case IFD.PhotoMetricInterpretation of + 8: begin + case IFD.GrayBits of + 8,16: lab.L := ChannelValues[0]*(100/65535); + 0:begin + lab.L := ChannelValues[0]*(100/65535); + case IFD.RedBits of + 16: lab.a := SmallInt(ChannelValues[1])/256; + 8: lab.a := ShortInt(ChannelValues[1] shr 8); + end; + case IFD.BlueBits of + 16: lab.b := SmallInt(ChannelValues[2])/256; + 8: lab.b := ShortInt(ChannelValues[2] shr 8); + end; + end; + end; + end; + 9: begin + case IFD.GrayBits of + 16: lab.L := ChannelValues[0]*(100/65280); + 8: lab.L := ChannelValues[0]*(100/65535); + 0:begin + case IFD.GreenBits of + 16: lab.L := ChannelValues[0]*(100/65280); + 8: lab.L := ChannelValues[0]*(100/65535); + end; + case IFD.RedBits of + 16: lab.a := (ChannelValues[1]-32768)/256; + 8: lab.a := (ChannelValues[1] shr 8)-128; + end; + case IFD.BlueBits of + 16: lab.b := (ChannelValues[2]-32768)/256; + 8: lab.b := (ChannelValues[2] shr 8)-128; + end; + end; + end; + end; + //10: ITULAB: ITU L*a*b* + //32844: LOGL: CIE Log2(L) + //32845: LOGLUV: CIE Log2(L) (u',v') + else + TiffError('PhotometricInterpretation='+IntToStr(IFD.PhotoMetricInterpretation)+' not supported'); + end; + + if AlphaChannel >= 0 then + lab.alpha:= ChannelValues[AlphaChannel]/65535; + end; + +var + FPColorValue: TFPColor; + + procedure GetPixelAsFPColor; + var PaletteIndex: LongWord; + GrayValue: Word; + lab: TLabA; + begin + if IFD.PhotoMetricInterpretation >= 8 then + begin + GetPixelAsLab(lab); + FPColorValue.FromLabA(lab); + exit; + end; + + case IFD.PhotoMetricInterpretation of + 0,1: // 0:bilevel grayscale 0 is white; 1:0 is black + begin + GrayValue := ChannelValues[0]; + if IFD.PhotoMetricInterpretation=0 then + GrayValue:=$ffff-GrayValue; + FPColorValue.red := GrayValue; + FPColorValue.green:= GrayValue; + FPColorValue.blue := GrayValue; + FPColorValue.alpha := alphaOpaque; + end; + + 2: // RGB(A) + begin + FPColorValue.red := ChannelValues[0]; + FPColorValue.green:= ChannelValues[1]; + FPColorValue.blue := ChannelValues[2]; + FPColorValue.alpha := alphaOpaque; + end; + + 3: //3 Palette/color map indexed + begin + PaletteIndex := ChannelValues[0] shr (16 - SampleBits[0]); + FPColorValue.red := PaletteValues[PaletteIndex]; + FPColorValue.green:= PaletteValues[PaletteIndex+PaletteStride]; + FPColorValue.blue := PaletteValues[PaletteIndex+2*PaletteStride]; + FPColorValue.alpha := alphaOpaque; + end; + + //4 Mask/holdout mask (obsolete by TIFF 6.0 specification) + + 5: // CMYK plus optional alpha + FPColorValue:=CMYKToFPColor(ChannelValues[0],ChannelValues[1],ChannelValues[2],ChannelValues[3]); + + //6: YCBCR: CCIR 601 + else + TiffError('PhotometricInterpretation='+IntToStr(IFD.PhotoMetricInterpretation)+' not supported'); + end; + + if AlphaChannel >= 0 then + begin + FPColorValue.alpha:= ChannelValues[AlphaChannel]; + if PremultipliedAlpha and (FPColorValue.alpha <> alphaOpaque) and (FPColorValue.alpha <> 0) then + begin + FPColorValue.red := (FPColorValue.red * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; + FPColorValue.green := (FPColorValue.green * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; + FPColorValue.blue := (FPColorValue.blue * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; + end; + end; + end; + +var + ChunkOffsets: PLongWord; + ChunkByteCounts: PLongWord; + Chunk: PByte; + ChunkCount: LongWord; + ChunkIndex: LongWord; + CurCount: LongWord; + CurOffset: LongWord; + CurByteCnt: PtrInt; + Run: PByte; + BitPos: Byte; + x, y, cx, cy, dx1,dy1, dx2,dy2, sx, sy: integer; + SampleBitsPerPixel: LongWord; + CurFPImg: TFPCustomImage; + aContinue, ConvertFromLab: Boolean; + ExpectedChunkLength: PtrInt; + ChunkType: TTiffChunkType; + TilesAcross, TilesDown: LongWord; + ChunkLeft, ChunkTop, ChunkWidth, ChunkHeight: LongWord; + ChunkBytesPerLine: LongWord; + + LabArray: array of TLabA; + ConversionFromLab: TBridgedConversion; + DestStride: PtrInt; + PDest: PByte; + CurPixelValue: TBGRAPixel; + + procedure ComputeDestStride; + begin + DestStride := dy1*TCustomUniversalBitmap(CurFPImg).RowSize; + if TCustomUniversalBitmap(CurFPImg).LineOrder = riloBottomToTop then + DestStride := -DestStride; + inc(DestStride, dx1*PtrInt(TCustomUniversalBitmap(CurFPImg).Colorspace.GetSize)); + end; + +begin + if (IFD.ImageWidth=0) or (IFD.ImageHeight=0) then + exit; + + if IFD.PhotoMetricInterpretation=High(IFD.PhotoMetricInterpretation) then + TiffError('missing PhotometricInterpretation'); + if IFD.BitsPerSample=0 then + TiffError('missing BitsPerSample'); + if IFD.TileWidth>0 then begin + ChunkType:=tctTile; + if IFD.TileLength=0 then + TiffError('missing TileLength'); + if IFD.TileOffsets=0 then + TiffError('missing TileOffsets'); + if IFD.TileByteCounts=0 then + TiffError('missing TileByteCounts'); + end else begin + ChunkType:=tctStrip; + if IFD.RowsPerStrip=0 then + TiffError('missing RowsPerStrip'); + if IFD.StripOffsets=0 then + TiffError('missing StripOffsets'); + if IFD.StripByteCounts=0 then + TiffError('missing StripByteCounts'); + end; + + if IFD.PlanarConfiguration > 1 then + TiffError('Planar configuration not handled'); + + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.LoadImageFromStream reading ...'); + {$endif} + + ChunkOffsets:=nil; + ChunkByteCounts:=nil; + Chunk:=nil; + SampleBits:=nil; + try + // read chunk starts and sizes + if ChunkType=tctTile then begin + TilesAcross:=(IFD.ImageWidth+IFD.TileWidth-1) div IFD.TileWidth; + TilesDown:=(IFD.ImageHeight+IFD.TileLength-1) div IFD.TileLength; + {$ifdef FPC_Debug_Image} + if Debug then + writeln('TBGRAReaderTiff.LoadImageFromStream TilesAcross=',TilesAcross,' TilesDown=',TilesDown); + {$endif} + ChunkCount := TilesAcross * TilesDown; + ReadShortOrLongValues(IFD.TileOffsets,ChunkOffsets,CurCount); + if CurCount 2) then + begin + ComputeDestStride; + PDest := TBGRACustomBitmap(CurFPImg).GetPixelAddress(sx,sy); + if (IFD.PhotoMetricInterpretation = 0) and (SampleCnt = 1) then + begin + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= FastRoundDiv257(not (PWord(Run)^)); + PBGRAPixel(PDest)^.green:= PBGRAPixel(PDest)^.red; + PBGRAPixel(PDest)^.blue:= PBGRAPixel(PDest)^.red; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run, 2); + inc(PDest, DestStride); + end; + end else + if (IFD.PhotoMetricInterpretation = 1) and (SampleCnt = 1) then + begin + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= FastRoundDiv257(PWord(Run)^); + PBGRAPixel(PDest)^.green:= PBGRAPixel(PDest)^.red; + PBGRAPixel(PDest)^.blue:= PBGRAPixel(PDest)^.red; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run, 2); + inc(PDest, DestStride); + end; + end else + if (IFD.PhotoMetricInterpretation = 2) and (SampleCnt = 3) then + begin + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= FastRoundDiv257(PWord(Run)^); + PBGRAPixel(PDest)^.green:= FastRoundDiv257(PWord(Run+2)^); + PBGRAPixel(PDest)^.blue:= FastRoundDiv257(PWord(Run+4)^); + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run, 6); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + ReadNext16BitData(Run); + GetPixelAsFPColor; + PBGRAPixel(PDest)^.red:= FastRoundDiv257(FPColorValue.red); + PBGRAPixel(PDest)^.green:= FastRoundDiv257(FPColorValue.green); + PBGRAPixel(PDest)^.blue:= FastRoundDiv257(FPColorValue.blue); + PBGRAPixel(PDest)^.alpha:= FastRoundDiv257(FPColorValue.alpha); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + ReadNext16BitData(Run); + GetPixelAsFPColor; + CurFPImg.Colors[x,y]:= FPColorValue; + // next column + inc(x,dx1); + inc(y,dy1); + end; + end else + if All8Bit then + begin + if CurFPImg is TBGRACustomBitmap then + begin + ComputeDestStride; + PDest := TBGRACustomBitmap(CurFPImg).GetPixelAddress(sx,sy); + if (IFD.PhotoMetricInterpretation = 0) and (SampleCnt = 1) then + begin + if IFD.Predictor = 2 then + begin + CurPixelValue := BGRAPixelTransparent; + for cx:=0 to ChunkWidth-1 do begin + {$PUSH}{$R-}inc(CurPixelValue.green, run^);{$POP} + PBGRAPixel(PDest)^.red:= not CurPixelValue.green; + PBGRAPixel(PDest)^.green:= not CurPixelValue.green; + PBGRAPixel(PDest)^.blue:= not CurPixelValue.green; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= not (Run^); + PBGRAPixel(PDest)^.green:= not (Run^); + PBGRAPixel(PDest)^.blue:= not (Run^); + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run); + inc(PDest, DestStride); + end; + end else + if (IFD.PhotoMetricInterpretation = 1) and (SampleCnt = 1) then + begin + if IFD.Predictor = 2 then + begin + CurPixelValue := BGRAPixelTransparent; + for cx:=0 to ChunkWidth-1 do begin + {$PUSH}{$R-}inc(CurPixelValue.green, run^);{$POP} + PBGRAPixel(PDest)^.red:= CurPixelValue.green; + PBGRAPixel(PDest)^.green:= CurPixelValue.green; + PBGRAPixel(PDest)^.blue:= CurPixelValue.green; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= Run^; + PBGRAPixel(PDest)^.green:= Run^; + PBGRAPixel(PDest)^.blue:= Run^; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run); + inc(PDest, DestStride); + end; + end else + if (IFD.PhotoMetricInterpretation = 2) and (SampleCnt = 3) then + begin + if IFD.Predictor = 2 then + begin + CurPixelValue := BGRAPixelTransparent; + for cx:=0 to ChunkWidth-1 do begin + {$PUSH}{$R-}inc(CurPixelValue.red, run^);{$POP} + {$PUSH}{$R-}inc(CurPixelValue.green, (run+1)^);{$POP} + {$PUSH}{$R-}inc(CurPixelValue.blue, (run+2)^);{$POP} + PBGRAPixel(PDest)^.red:= CurPixelValue.red; + PBGRAPixel(PDest)^.green:= CurPixelValue.green; + PBGRAPixel(PDest)^.blue:= CurPixelValue.blue; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run,3); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + PBGRAPixel(PDest)^.red:= Run^; + PBGRAPixel(PDest)^.green:= (Run+1)^; + PBGRAPixel(PDest)^.blue:= (Run+2)^; + PBGRAPixel(PDest)^.alpha:= 255; + inc(Run,3); + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + ReadNext8BitData(Run); + GetPixelAsFPColor; + PBGRAPixel(PDest)^.red:= FPColorValue.red shr 8; + PBGRAPixel(PDest)^.green:= FPColorValue.green shr 8; + PBGRAPixel(PDest)^.blue:= FPColorValue.blue shr 8; + PBGRAPixel(PDest)^.alpha:= FPColorValue.alpha shr 8; + inc(PDest, DestStride); + end; + end else + for cx:=0 to ChunkWidth-1 do begin + ReadNext8BitData(Run); + GetPixelAsFPColor; + CurFPImg.Colors[x,y]:= FPColorValue; + // next column + inc(x,dx1); + inc(y,dy1); + end; + end else + begin + for cx:=0 to ChunkWidth-1 do begin + ReadNextPixelData(Run,BitPos); + GetPixelAsFPColor; + CurFPImg.Colors[x,y]:= FPColorValue; + // next column + inc(x,dx1); + inc(y,dy1); + end; + end; + end; + + // next line + inc(sx,dx2); + inc(sy,dy2); + end; + // next chunk + end; + finally + ReAllocMem(SampleBits,0); + ReAllocMem(ChunkOffsets,0); + ReAllocMem(ChunkByteCounts,0); + ReAllocMem(Chunk,0); + ReAllocMem(PaletteValues,0); + end; +end; + +procedure TBGRAReaderTiff.ReleaseStream; +begin + s := nil; +end; + +function TBGRAReaderTiff.FixEndian(w: Word): Word; inline; +begin + if FReverseEndian then + Result:= SwapEndian(w) + else + result:= w; +end; + +function TBGRAReaderTiff.FixEndian(d: LongWord): LongWord; inline; +begin + if FReverseEndian then + Result:= SwapEndian(d) + else + result:= d; +end; + +procedure TBGRAReaderTiff.DecodePackBits(var Buffer: Pointer; var Count: PtrInt); +var + NewBuffer: Pointer; + NewCount: PtrInt; +begin + DecompressPackBits(Buffer,Count,NewBuffer,NewCount); + FreeMem(Buffer); + Buffer:=NewBuffer; + Count:=NewCount; +end; + +procedure TBGRAReaderTiff.DecodeLZW(var Buffer: Pointer; var Count: PtrInt); +var + NewBuffer: Pointer; + NewCount: PtrInt; +begin + DecompressLZW(Buffer,Count,NewBuffer,NewCount); + FreeMem(Buffer); + Buffer:=NewBuffer; + Count:=NewCount; +end; + +procedure TBGRAReaderTiff.DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; + ExpectedCount: PtrInt); +var + NewBuffer: PByte; + NewCount: LongWord; + ErrorMsg: String; +begin + ErrorMsg:=''; + NewBuffer:=nil; + try + NewCount:=ExpectedCount; + if not DecompressDeflate(Buffer,Count,NewBuffer,NewCount,@ErrorMsg) then + TiffError(ErrorMsg); + FreeMem(Buffer); + Buffer:=NewBuffer; + Count:=NewCount; + NewBuffer:=nil; + finally + ReAllocMem(NewBuffer,0); + end; +end; + +procedure TBGRAReaderTiff.InternalRead(Str: TStream; AnImage: TFPCustomImage); +// read the biggest image +var + aContinue: Boolean; + BestIFD: TTiffIFD; +begin + Clear; + + // read header + aContinue:=true; + Progress(psStarting, 0, False, Rect(0,0,0,0), '', aContinue); + if not aContinue then exit; + LoadHeaderFromStream(Str); + LoadIFDsFromStream; + + // find the biggest image + BestIFD := GetBiggestImage; + Progress(psRunning, 25, False, Rect(0,0,0,0), '', aContinue); + if not aContinue then exit; + + // read image + if Assigned(BestIFD) then begin + BestIFD.Img := AnImage; + LoadImageFromStream(BestIFD); + end; + + // end + Progress(psEnding, 100, False, Rect(0,0,0,0), '', aContinue); +end; + +function TBGRAReaderTiff.InternalCheck(Str: TStream): boolean; +var + IFDStart: LongWord; +begin + try + s:=Str; + fStartPos:=s.Position; + Result:=ReadTiffHeader(true,IFDStart) and (IFDStart<>0); + s.Position:=fStartPos; + except + Result:=false; + end; +end; + +procedure TBGRAReaderTiff.DoCreateImage(ImgFileDir: TTiffIFD); +begin + if Assigned(OnCreateImage) then + OnCreateImage(Self,ImgFileDir); +end; + +constructor TBGRAReaderTiff.Create; +begin + ImageList:=TFPList.Create; +end; + +destructor TBGRAReaderTiff.Destroy; +begin + Clear; + FreeAndNil(ImageList); + inherited Destroy; +end; + +procedure TBGRAReaderTiff.Clear; +var + i: Integer; + Img: TTiffIFD; +begin + for i:=ImageCount-1 downto 0 do begin + Img:=Images[i]; + ImageList.Delete(i); + Img.Free; + end; + FReverseEndian:=false; + FreeAndNil(FIFDList); +end; + +procedure DecompressPackBits(Buffer: Pointer; Count: PtrInt; out + NewBuffer: Pointer; out NewCount: PtrInt); +{ Algorithm: + while not got the expected number of bytes + read one byte n + if n in 0..127 copy the next n+1 bytes + else if n in -127..-1 then copy the next byte 1-n times + else continue + end +} +var + p: Pcint8; + n: cint8; + d: pcint8; + i,j: integer; + EndP: Pcint8; +begin + // compute NewCount + NewCount:=0; + NewBuffer:=nil; + if Count=0 then exit; + p:=Pcint8(Buffer); + EndP:=p+Count; + while p CodeBufferLength do + begin + if SrcPos >= Count then + begin + result := EoiCode; + exit; + end; + If BigEndian then + CodeBuffer := (CodeBuffer shl 8) or PByte(Buffer)[SrcPos] + else + CodeBuffer := CodeBuffer or (LongWord(PByte(Buffer)[SrcPos]) shl CodeBufferLength); + Inc(SrcPos); + Inc(CodeBufferLength, 8); + end; + + if BigEndian then + begin + result := CodeBuffer shr (CodeBufferLength-CurBitLength); + Dec(CodeBufferLength, CurBitLength); + CodeBuffer := CodeBuffer and ((1 shl CodeBufferLength) - 1); + end else + begin + result := CodeBuffer and ((1 shl CurBitLength)-1); + Dec(CodeBufferLength, CurBitLength); + CodeBuffer := CodeBuffer shr CurBitLength; + end; + end; + + procedure ClearTable; + var + i: Integer; + begin + for i:=0 to TableCount-1 do + if Table[i].Data <> @Table[i].ShortData then + ReAllocMem(Table[i].Data,0); + TableCount:=0; + end; + + procedure InitializeTable; + begin + CurBitLength:=9; + ClearTable; + end; + + function IsInTable(Code: word): boolean; + begin + Result:=Code<258+TableCount; + end; + + procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false); + var + s: TLZWString; + begin + //WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IFD.ImageWidth,' y=',(NewCount div 4) div IFD.ImageWidth,' PixelByte=',NewCount mod 4); + if Code<256 then begin + // write byte + s.ShortData[0] := code; + s.Data:=@s.ShortData; + s.Count:=1; + end else if Code>=258 then begin + // write string + if Code-258>=TableCount then + Error('LZW code out of bounds'); + s:=Table[Code-258]; + end else + Error('LZW code out of bounds'); + if NewCount+s.Count+1>NewCapacity then begin + NewCapacity:=NewCapacity*2+8; + ReAllocMem(NewBuffer,NewCapacity); + end; + System.Move(s.Data^,NewBuffer[NewCount],s.Count); + //for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug + inc(NewCount,s.Count); + if AddFirstChar then begin + NewBuffer[NewCount]:=s.Data^; + //write(HexStr(NewBuffer[NewCount],2)); // debug + inc(NewCount); + end; + //writeln(',WriteStringFromCode'); // debug + end; + + procedure AddStringToTable(Code, AddFirstCharFromCode: integer); + // add string from code plus first character of string from code as new string + var + s1, s2: TLZWString; + p: PByte; + NewCount: integer; + begin + //WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount); + //check whether can store more codes or not + if TableCount=high(Table)+1 then exit; + // find string 1 + if Code<256 then begin + // string is byte + s1.ShortData[0] := code; + s1.Data:=@s1.ShortData; + s1.Count:=1; + end else if Code>=258 then begin + // normal string + if Code-258>=TableCount then + Error('LZW code out of bounds'); + s1:=Table[Code-258]; + end else + Error('LZW code out of bounds'); + // find string 2 + if AddFirstCharFromCode<256 then begin + // string is byte + s2.ShortData[0] := AddFirstCharFromCode; + s2.Data:=@s2.ShortData; + s2.Count:=1; + end else begin + // normal string + if AddFirstCharFromCode-258>=TableCount then + Error('LZW code out of bounds'); + s2:=Table[AddFirstCharFromCode-258]; + end; + // set new table entry + NewCount := s1.Count+1; + Table[TableCount].Count:= NewCount; + if NewCount > 4 then + begin + p:=nil; + GetMem(p,NewCount); + end else + p := @Table[TableCount].ShortData; + Table[TableCount].Data:=p; + System.Move(s1.Data^,p^,s1.Count); + // add first character from string 2 + p[s1.Count]:=s2.Data^; + // increase TableCount + inc(TableCount); + case TableCount+258+TableMargin of + 512,1024,2048: begin + //check if there is room for a greater code + if (Count-SrcPos) shl 3 + integer(CodeBufferLength) > integer(CurBitLength) then + inc(CurBitLength); + end; + end; + end; + +begin + NewBuffer:=nil; + NewCount:=0; + if Count=0 then exit; + //WriteLn('DecompressLZW START Count=',Count); + //for SrcPos:=0 to 19 do + // write(HexStr(PByte(Buffer)[SrcPos],2)); + //writeln(); + + NewCapacity:=Count*2; + ReAllocMem(NewBuffer,NewCapacity); + + if PByte(Buffer)[0] = $80 then + begin + BigEndian := true; //endian-ness of LZW is not necessarily consistent with the rest of the file + TableMargin := 1; //keep one free code to be able to write EOI code + end else + begin + BigEndian := false; + TableMargin := 0; + end; + SrcPos:=0; + CurBitLength:=9; + CodeBufferLength := 0; + CodeBuffer := 0; + TableCount:=0; + OldCode := NoCode; + try + repeat + Code:=GetNextCode; + //WriteLn('DecompressLZW Code=',Code); + if Code=EoiCode then break; + if Code=ClearCode then begin + InitializeTable; + Code:=GetNextCode; + //WriteLn('DecompressLZW after clear Code=',Code); + if Code=EoiCode then break; + if Code=ClearCode then + Error('LZW code out of bounds'); + WriteStringFromCode(Code); + OldCode:=Code; + end else begin + if Code NoCode then + AddStringToTable(OldCode,Code); + OldCode:=Code; + end else if (Code=TableCount+258) and (OldCode <> NoCode) then begin + WriteStringFromCode(OldCode,true); + AddStringToTable(OldCode,OldCode); + OldCode:=Code; + end else + Error('LZW code out of bounds'); + end; + until false; + finally + ClearTable; + end; + + ReAllocMem(NewBuffer,NewCount); +end; + +function DecompressDeflate(Compressed: PByte; CompressedCount: LongWord; + out Decompressed: PByte; var DecompressedCount: LongWord; + ErrorMsg: PAnsiString = nil): boolean; +var + stream : z_stream; + err : integer; +begin + Result:=false; + + //writeln('DecompressDeflate START'); + Decompressed:=nil; + if CompressedCount=0 then begin + DecompressedCount:=0; + exit; + end; + + err := inflateInit(stream{%H-}); + if err <> Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='inflateInit failed'; + exit; + end; + + // set input = compressed data + stream.avail_in := CompressedCount; + stream.next_in := Compressed; + + // set output = decompressed data + if DecompressedCount=0 then + DecompressedCount:=CompressedCount; + Getmem(Decompressed,DecompressedCount); + stream.avail_out := DecompressedCount; + stream.next_out := Decompressed; + + // Finish the stream + while TRUE do begin + //writeln('run: total_in=',stream.total_in,' avail_in=',stream.avail_in,' total_out=',stream.total_out,' avail_out=',stream.avail_out); + if (stream.avail_out=0) then begin + // need more space + if DecompressedCount<128 then + DecompressedCount:=DecompressedCount+128 + else if DecompressedCount>High(DecompressedCount)-1024 then begin + if ErrorMsg<>nil then + ErrorMsg^:='inflate decompression failed, because not enough space'; + exit; + end else + DecompressedCount:=DecompressedCount*2; + ReAllocMem(Decompressed,DecompressedCount); + stream.next_out:=Decompressed+stream.total_out; + stream.avail_out:=DecompressedCount-stream.total_out; + end; + err := inflate(stream, Z_NO_FLUSH); + if err = Z_STREAM_END then + break; + if err<>Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='inflate finish failed'; + exit; + end; + end; + + //writeln('decompressed: total_in=',stream.total_in,' total_out=',stream.total_out); + DecompressedCount:=stream.total_out; + ReAllocMem(Decompressed,DecompressedCount); + + err := inflateEnd(stream); + if err<>Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='inflateEnd failed'; + exit; + end; + Result:=true; +end; + +initialization + DefaultBGRAImageReader[ifTiff] := TBGRAReaderTiff; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadwebp.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadwebp.pas new file mode 100644 index 0000000..a921f98 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadwebp.pas @@ -0,0 +1,151 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadWebP; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPImage; + +type + TWebPHeader = record + RIFFCode: array[1..4] of char; + FileSize: LongWord; + WebPCode: array[1..4] of char; + end; + + { TBGRAReaderWebP } + + TBGRAReaderWebP = class(TFPCustomImageReader) + protected + function ReadHeader(Str: TStream): TWebPHeader; + procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; + function InternalCheck(Str: TStream): boolean; override; + end; + +implementation + +uses libwebp{$ifdef linux}, linuxlib{$endif}, BGRABitmapTypes; + +var + MyLibWebPLoaded: boolean; + +procedure NeedLibWebP; +begin + if not MyLibWebPLoaded then + begin + if not LibWebPLoad({$ifdef linux}FindLinuxLibrary('libwebp.so', 6){$endif}) then + raise exception.Create('Cannot find libwebp library ('+LibWebPFilename+')'); + MyLibWebPLoaded:= true; + end; +end; + +{ TBGRAReaderWebP } + +function TBGRAReaderWebP.ReadHeader(Str: TStream): TWebPHeader; +begin + fillchar({%H-}result, sizeof({%H-}result), 0); + Str.Read(result, sizeof(result)); + result.FileSize:= LEtoN(result.FileSize); +end; + +procedure TBGRAReaderWebP.InternalRead(Str: TStream; Img: TFPCustomImage); +const + CopySize = 65536; +var + header: TWebPHeader; + oldPos: Int64; + mem, p: PByte; + totalSize, remain: LongWord; + toRead, w, h, x, y: integer; + loadInto: TBGRACustomBitmap; + pbgra: PBGRAPixel; + ok: Boolean; +begin + NeedLibWebP; + + oldPos := Str.Position; + header := ReadHeader(Str); + if (header.RIFFCode <> 'RIFF') or (header.WebPCode <> 'WEBP') then + raise exception.Create('Invalid header'); + Str.Position:= OldPos; + totalSize := header.FileSize+8; + getmem(mem, totalSize); + loadInto := nil; + try + p := mem; + remain := totalSize; + while remain > 0 do + begin + if remain > CopySize then toRead := CopySize else + toRead := remain; + Str.ReadBuffer(p^, toRead); + inc(p, toRead); + dec(remain, toRead); + end; + + if WebPGetInfo(mem, totalSize, @w, @h) = 0 then + raise exception.Create('Invalid WebP header'); + + Img.SetSize(w, h); + if Img is TBGRACustomBitmap then + loadInto := TBGRACustomBitmap(Img) + else + loadInto := BGRABitmapFactory.Create(w,h); + {$PUSH}{$WARNINGS OFF} + if TBGRAPixel_RGBAOrder then + ok := WebPDecodeRGBAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil + else + ok := WebPDecodeBGRAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil; + {$POP} + loadInto.InvalidateBitmap; + if not ok then raise exception.Create('Error decoding WebP'); + if loadInto.LineOrder = riloBottomToTop then loadInto.VerticalFlip; + if Img <> loadInto then + begin + for y := 0 to h-1 do + begin + pbgra := loadInto.ScanLine[y]; + for x := 0 to w-1 do + begin + Img.Colors[x,y] := pbgra^.ToFPColor; + inc(pbgra); + end; + end; + end; + finally + if Assigned(loadInto) and (loadInto <> Img) then loadInto.Free; + freemem(mem); + end; +end; + +function TBGRAReaderWebP.InternalCheck(Str: TStream): boolean; +var + oldPos: Int64; + header: TWebPHeader; +begin + oldPos := Str.Position; + try + header := ReadHeader(Str); + result := (header.RIFFCode = 'RIFF') and (header.WebPCode = 'WEBP') and + (header.FileSize <= $FFFFFFF6) and (header.FileSize <= Str.Size-Str.Position+4); + finally + Str.Position:= OldPos; + end; +end; + +initialization + + DefaultBGRAImageReader[ifWebP] := TBGRAReaderWebP; + +finalization + + if MyLibWebPLoaded then + begin + LibWebPUnload; + MyLibWebPLoaded:= false; + end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrareadxpm.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadxpm.pas new file mode 100644 index 0000000..a9b23ab --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrareadxpm.pas @@ -0,0 +1,91 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAReadXPM; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPReadXPM, FPimage; + +type + + { TBGRAReaderXPM } + + TBGRAReaderXPM = class(TFPReaderXPM) + protected + procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; + function InternalCheck(Str: TStream): boolean; override; + public + class procedure ConvertToXPM3(ASource: TStream; ADestination: TStream); static; + end; + +implementation + +uses BGRABitmapTypes; + +{ TBGRAReaderXPM } + +procedure TBGRAReaderXPM.InternalRead(Str: TStream; Img: TFPCustomImage); +var tempStream: TMemoryStream; +begin + tempStream := TMemoryStream.Create; + try + ConvertToXPM3(Str, tempStream); + tempStream.Position:= 0; + try + img.UsePalette := true; + inherited InternalRead(tempStream, Img); + finally + end; + finally + tempStream.free; + end; +end; + +function TBGRAReaderXPM.InternalCheck(Str: TStream): boolean; +var {%H-}magic : array[0..5] of char; + l : integer; + prevPos: int64; +begin + try + prevPos := str.Position; + l := str.Read ({%H-}magic[0],sizeof(magic)); + str.Position:= prevPos; + result := (l = sizeof(magic)) and (magic = '! XPM2'); + if not result then result := inherited InternalCheck(Str) + except + result := false; + end; +end; + +class procedure TBGRAReaderXPM.ConvertToXPM3(ASource: TStream; + ADestination: TStream); +var + lst: TStringList; + i : integer; +begin + lst := TStringList.Create; + try + lst.LoadFromStream(ASource); + if (lst[0] = '! XPM2') and (lst.count > 1) then + begin + lst[0] := '/* XPM */'; + lst.Insert(1, 'static char * data[] = {'); + for i := 2 to lst.Count-2 do + lst[i] := '"' + lst[i] + '",'; + lst[lst.count-1] := '"' + lst[lst.count-1] + '"'; + lst.Add('}'); + end; + lst.SaveToStream(ADestination); + finally + lst.free; + end; +end; + +initialization + + DefaultBGRAImageReader[ifXPixMap] := TBGRAReaderXPM; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrarenderer3d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrarenderer3d.pas new file mode 100644 index 0000000..d31f34a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrarenderer3d.pas @@ -0,0 +1,842 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRARenderer3D; + +{$mode objfpc}{$H+} + +interface + +uses BGRABitmapTypes, + BGRASceneTypes, BGRASSE, + BGRAPolygon, BGRAColorInt, + BGRAClasses, BGRAMatrix3D, + BGRAPolygonAliased; + +type + TInt65536ShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TColorInt65536 of object; + + { TBGRAShader3D } + + TBGRAShader3D = class + protected + FAmbiantLightness: integer; + FAmbiantLightColor: TColorInt65536; + FUseAmbiantColor: boolean; + FLights: TList; + FContextBlock: TMemoryBlockAlign128; + FShaderFunc: TShaderFunction3D; + FInt65536ShaderFunc: TInt65536ShaderFunction3D; + FContext: PBasicLightingContext; + FOnlyDirectionalLights: boolean; + FWhiteMaterial: boolean; + + procedure ComputeDiffuseLightness(Context: PSceneLightingContext); inline; + procedure ComputeDiffuseLight(Context: PSceneLightingContext); inline; + procedure ComputeDiffuseAndSpecularLight(Context: PSceneLightingContext); inline; + + function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; + function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; + function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; + function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; + function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; + + function Int65536ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; + function Int65536ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; + function Int65536ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; + function Int65536ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; + function Int65536ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; + public + constructor Create(const AAmbiantLightColorF: TColorF; ALights: TList); + destructor Destroy; override; + function Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TBGRAPixel; + function Int65536Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536; + procedure Prepare(constref ADescription: TFaceRenderingDescription); + property ShaderFunction: TShaderFunction3D read FShaderFunc; + property Int65536ShaderFunction: TInt65536ShaderFunction3D read FInt65536ShaderFunc; + property Context: PBasicLightingContext read FContext; + property OnlyDirectionalLights: boolean read FOnlyDirectionalLights; + end; + + { TBGRARenderer3D } + + TBGRARenderer3D = class(TCustomRenderer3D) + protected + FColorGradientTempBmp: TBGRACustomBitmap; + FZBuffer: PSingle; + FOutputSurface, FRenderSurface: TBGRACustomBitmap; + FRenderSurfaceMultisample: Integer; + FMultishapeFiller: TBGRAMultishapeFiller; + FOptions: TRenderingOptions; + FShader: TBGRAShader3D; + FDepths: array of single; + FLightings: array of word; + + FShadedColors: array of TBGRAPixel; + FSameShadedColors: boolean; + + FCenter: record + proj: TPointF; + pos3D,normal3D: TPoint3D_128; + color: TBGRAPixel; + end; + + function GetHasZBuffer: boolean; override; + function GetGlobalScale: single; override; + function GetSurfaceWidth: integer; override; + function GetSurfaceHeight: integer; override; + function GetHandlesNearClipping: boolean; override; + function GetHandlesFaceCulling: boolean; override; + public + constructor Create(AOutputSurface: TBGRACustomBitmap; + ARenderingOptions: TRenderingOptions; + AAmbiantLightColorF: TColorF; + ALights: TList); + function RenderFace(var ADescription: TFaceRenderingDescription; + AComputeCoordinate: TComputeProjectionFunc): boolean; override; + destructor Destroy; override; + end; + +implementation + +uses SysUtils, BGRAResample; + +{ TBGRAShader3D } + +constructor TBGRAShader3D.Create(const AAmbiantLightColorF: TColorF; + ALights: TList); +var + j: Integer; +begin + FAmbiantLightColor := ColorFToColorInt65536(AAmbiantLightColorF); + FAmbiantLightness := round((AAmbiantLightColorF[1]+AAmbiantLightColorF[2]+AAmbiantLightColorF[3])/3*32768); + FUseAmbiantColor:= (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b); + FLights := ALights; + FContextBlock := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext)); + FOnlyDirectionalLights:= true; + for j := 0 to FLights.Count-1 do + if not TBGRALight3D(FLights[j]).IsDirectional then FOnlyDirectionalLights := false; +end; + +destructor TBGRAShader3D.Destroy; +begin + FreeAndNil(FContextBlock); + inherited Destroy; +end; + +function TBGRAShader3D.Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; + AColor: TBGRAPixel): TBGRAPixel; +begin + with Context^ do + begin + Position := APosition; + Normal := ANormal; + end; + result := ShaderFunction(Context,AColor); +end; + +function TBGRAShader3D.Int65536Apply(APosition: TPoint3D_128; + ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536; +begin + with Context^ do + begin + Position := APosition; + Normal := ANormal; + end; + result := Int65536ShaderFunction(Context,AColor); +end; + +procedure TBGRAShader3D.Prepare(constref + ADescription: TFaceRenderingDescription); +var + UseDiffuseColor: Boolean; + j: Integer; + ctx: PSceneLightingContext; +begin + with ADescription do + begin + FWhiteMaterial:= Texture <> nil; + if Material.GetSpecularOn then + begin + FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor); + FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseAndSpecularColor); + end else + begin + UseDiffuseColor := FUseAmbiantColor; + if not UseDiffuseColor then + begin + with Material.GetDiffuseColorInt do + UseDiffuseColor := (r <> g) or (g <> b); + if not UseDiffuseColor and Material.GetAutoDiffuseColor then + begin + for j := 0 to FLights.Count-1 do + if TBGRALight3D(FLights[j]).GetColoredLight then + begin + UseDiffuseColor := true; + break; + end; + end; + end; + if UseDiffuseColor then + begin + FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseColor); + FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseColor); + end else + begin + if FLights.Count = 0 then + begin + if FAmbiantLightness = 32768 then + begin + FShaderFunc := TShaderFunction3D(@ApplyNoLighting); + FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyNoLighting); + end else + begin + FShaderFunc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly); + FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithAmbiantLightnessOnly); + end; + end else + begin + FShaderFunc := TShaderFunction3D(@ApplyLightingWithLightness); + FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithLightness); + end; + end; + end; + + ctx := PSceneLightingContext( FContextBlock.Data ); + ctx^.material := Material; + ctx^.LightThroughFactor := LightThroughFactor; + ctx^.LightThrough := ctx^.LightThroughFactor > 0; + ctx^.SaturationHighF := Material.GetSaturationHigh; + ctx^.SaturationLowF := Material.GetSaturationLow; + ctx^.SaturationHigh := round(Material.GetSaturationHigh*32768); + ctx^.SaturationLow := round(Material.GetSaturationLow*32768); + FContext := PBasicLightingContext(ctx); + end; +end; + +procedure TBGRAShader3D.ComputeDiffuseLightness( + Context: PSceneLightingContext); +var i: Int32or64; +begin + Context^.lightness := FAmbiantLightness; + + i := FLights.Count-1; + while i >= 0 do + begin + TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context); + dec(i); + end; +end; + +procedure TBGRAShader3D.ComputeDiffuseLight(Context: PSceneLightingContext); +var i: Int32or64; + m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D(Context^.material); + + if FWhiteMaterial or m.GetAutoAmbiantColor then + Context^.diffuseColor := FAmbiantLightColor + else + Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt; + + i := FLights.Count-1; + while i >= 0 do + begin + TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context); + dec(i); + end; + + Context^.diffuseColor.a := 65536; +end; + +procedure TBGRAShader3D.ComputeDiffuseAndSpecularLight( + Context: PSceneLightingContext); +var i: Int32or64; + m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D(Context^.material); + + if FWhiteMaterial or m.GetAutoAmbiantColor then + Context^.diffuseColor := FAmbiantLightColor + else + Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt; + Context^.specularColor := ColorInt65536(0,0,0,0); + + i := FLights.Count-1; + while i >= 0 do + begin + TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context); + dec(i); + end; + + Context^.diffuseColor.a := 65536; +end; + +function TBGRAShader3D.ApplyNoLighting(Context: PSceneLightingContext; + Color: TBGRAPixel): TBGRAPixel; +var + m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D(Context^.material); + + if FWhiteMaterial or m.GetAutoAmbiantColor then + result := Color + else + result := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetAmbiantColorInt,True); +end; + +function TBGRAShader3D.ApplyLightingWithAmbiantLightnessOnly( + Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; +var + m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D(Context^.material); + + if not FWhiteMaterial and not m.GetAutoAmbiantColor then + Color := ColorIntToBGRA(BGRAToColorInt(Color,True)* m.GetAmbiantColorInt,True); + + if FAmbiantLightness <= 0 then + result := BGRA(0,0,0,color.alpha) + else + result := ApplyIntensityFast(Color, FAmbiantLightness); +end; + +function TBGRAShader3D.ApplyLightingWithLightness(Context: PSceneLightingContext; + Color: TBGRAPixel): TBGRAPixel; +var + m: TBGRAMaterial3D; +begin + ComputeDiffuseLightness(Context); + + m := TBGRAMaterial3D(Context^.material); + if not FWhiteMaterial and not m.GetAutoSimpleColor then + Color := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetSimpleColorInt,True); + + with Context^ do + if Lightness <= 0 then + result := BGRA(0,0,0,color.alpha) + else + begin + if Lightness <= SaturationLow then + result := ApplyIntensityFast(Color, Lightness) + else if Lightness >= SaturationHigh then + result := BGRA(255,255,255,color.alpha) + else + result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow), + (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 ); + end; +end; + +function TBGRAShader3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; + Color: TBGRAPixel): TBGRAPixel; +begin + ComputeDiffuseLight(Context); + result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor,True); +end; + +function TBGRAShader3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; + Color: TBGRAPixel): TBGRAPixel; +begin + ComputeDiffuseAndSpecularLight(Context); + result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor,True); +end; + +function TBGRAShader3D.Int65536ApplyNoLighting(Context: PSceneLightingContext; + Color: TBGRAPixel): TColorInt65536; +var + m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D(Context^.material); + + if not FWhiteMaterial and not m.GetAutoAmbiantColor then + result := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt + else + result := BGRAToColorInt(Color,True); +end; + +function TBGRAShader3D.Int65536ApplyLightingWithAmbiantLightnessOnly( + Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; +var + m: TBGRAMaterial3D; + MaterialColor: TColorInt65536; +begin + m := TBGRAMaterial3D(Context^.material); + + if not FWhiteMaterial and not m.GetAutoAmbiantColor then + MaterialColor := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt + else + MaterialColor := BGRAToColorInt(Color,True); + + if FAmbiantLightness <= 0 then + result := ColorInt65536(0,0,0,MaterialColor.a) + else + result := MaterialColor * + ColorInt65536(FAmbiantLightness shl 1,FAmbiantLightness shl 1,FAmbiantLightness shl 1,65536); +end; + +function TBGRAShader3D.Int65536ApplyLightingWithLightness( + Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; +var + MaterialColor: TColorInt65536; + m: TBGRAMaterial3D; + Extra: Int32or64; +begin + ComputeDiffuseLightness(Context); + + m := TBGRAMaterial3D(Context^.material); + if not FWhiteMaterial and not m.GetAutoSimpleColor then + MaterialColor := BGRAToColorInt(Color,True)*m.GetSimpleColorInt + else + MaterialColor := BGRAToColorInt(Color,True); + + with Context^ do + if Lightness <= 0 then + result := ColorInt65536(0,0,0,MaterialColor.a) + else + begin + if Lightness <= SaturationLow then + result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536) + else if Lightness >= SaturationHigh then + result := ColorInt65536(65536,65536,65536,MaterialColor.a) + else + begin + result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536); + Extra := (Lightness - SaturationLow)*65536 div (SaturationHigh-SaturationLow); + inc(result.r, Extra); + inc(result.g, Extra); + inc(result.b, Extra); + end; + end; +end; + +function TBGRAShader3D.Int65536ApplyLightingWithDiffuseColor( + Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; +begin + ComputeDiffuseLight(Context); + result := BGRAToColorInt(Color,True)*Context^.diffuseColor; +end; + +function TBGRAShader3D.Int65536ApplyLightingWithDiffuseAndSpecularColor( + Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; +begin + ComputeDiffuseAndSpecularLight(Context); + result := BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor; +end; + +{ TBGRARenderer3D } + +function TBGRARenderer3D.GetHasZBuffer: boolean; +begin + result := Assigned(FZBuffer); +end; + +function TBGRARenderer3D.GetGlobalScale: single; +begin + result := FRenderSurfaceMultisample; +end; + +function TBGRARenderer3D.GetSurfaceWidth: integer; +begin + result := FOutputSurface.Width; +end; + +function TBGRARenderer3D.GetSurfaceHeight: integer; +begin + result := FOutputSurface.Height; +end; + +function TBGRARenderer3D.GetHandlesNearClipping: boolean; +begin + result := false; +end; + +function TBGRARenderer3D.GetHandlesFaceCulling: boolean; +begin + result := false; +end; + +constructor TBGRARenderer3D.Create(AOutputSurface: TBGRACustomBitmap; + ARenderingOptions: TRenderingOptions; + AAmbiantLightColorF: TColorF; + ALights: TList); +begin + if AOutputSurface = nil then + raise exception.Create('No surface specified'); + FOutputSurface := AOutputSurface; + FOptions := ARenderingOptions; + + if (FOptions.AntialiasingMode = am3dResample) + and (FOptions.AntialiasingResampleLevel > 1) then + begin + FRenderSurface := FOutputSurface.NewBitmap(FOutputSurface.Width*FOptions.AntialiasingResampleLevel, + FOutputSurface.Height*FOptions.AntialiasingResampleLevel); + FRenderSurfaceMultisample := FOptions.AntialiasingResampleLevel; + end else + begin + FRenderSurface := FOutputSurface; + FRenderSurfaceMultisample := 1; + end; + + FColorGradientTempBmp := FRenderSurface.NewBitmap(2,2); + FColorGradientTempBmp.ScanInterpolationFilter := rfLinear; + + if FOptions.PerspectiveMode = pmZBuffer then + begin + Getmem(FZBuffer, FRenderSurface.NbPixels*sizeof(single)); + FillDWord(FZBuffer^, FRenderSurface.NbPixels, LongWord(single(0))); + end + else + FZBuffer := nil; + + if (FOptions.AntialiasingMode = am3dMultishape) and + (FOptions.PerspectiveMode <> pmZBuffer) then + begin + FMultishapeFiller := TBGRAMultishapeFiller.Create; + FMultishapeFiller.PolygonOrder := poLastOnTop; + end + else + FMultishapeFiller := nil; + + FShader := TBGRAShader3D.Create(AAmbiantLightColorF, ALights); +end; + +function TBGRARenderer3D.RenderFace(var ADescription: TFaceRenderingDescription; + AComputeCoordinate: TComputeProjectionFunc): boolean; + + procedure ComputeCenter; + var j: Int32or64; + begin + with ADescription do + begin + with FCenter do + begin + ClearPoint3D_128(pos3D); + ClearPoint3D_128(normal3D); + color := MergeBGRA(slice(Colors,NbVertices)); + end; + for j := 0 to NbVertices-1 do + begin + FCenter.pos3D.Offset(Positions3D[j]); + FCenter.normal3D.Offset(Normals3D[j]); + end; + with FCenter do + begin + pos3D.Scale(1/NbVertices); + Normalize3D_128(normal3D); + end; + end; + FCenter.proj := AComputeCoordinate(FCenter.pos3D); + end; + + procedure DrawFaceWithShader; + var + j,k: Int32or64; + SameColor: boolean; + begin + with ADescription do + begin + if Texture <> nil then + begin + BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, + slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices), + Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation, + FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); + exit; + end; + + SameColor := True; + for j := 1 to NbVertices-1 do + if (Colors[j]<>Colors[j-1]) then SameColor := False; + + if SameColor then + begin + BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, + slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),nil, + slice(TexCoords,NbVertices),False,FShader.ShaderFunction,True,Colors[0],FZBuffer,FShader.Context); + end else + if NbVertices = 3 then + begin + FColorGradientTempBmp.SetPixel(0,0,Colors[0]); + FColorGradientTempBmp.SetPixel(1,0,Colors[1]); + FColorGradientTempBmp.SetPixel(0,1,Colors[2]); + FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[1],Colors[2])); + BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, + slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp, + [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); + end else + if NbVertices = 4 then + begin + FColorGradientTempBmp.SetPixel(0,0,Colors[0]); + FColorGradientTempBmp.SetPixel(1,0,Colors[1]); + FColorGradientTempBmp.SetPixel(1,1,Colors[2]); + FColorGradientTempBmp.SetPixel(0,1,Colors[3]); + BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, + slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp, + [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); + end else + if NbVertices >= 3 then + begin //split into triangles + ComputeCenter; + k := NbVertices-1; + for j := 0 to NbVertices-1 do + begin + FColorGradientTempBmp.SetPixel(0,0,Colors[k]); + FColorGradientTempBmp.SetPixel(1,0,Colors[j]); + FColorGradientTempBmp.SetPixel(0,1,FCenter.color); + FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[j],FCenter.color)); + BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, + [Projections[k],Projections[j],FCenter.proj], [Positions3D[k],Positions3D[j],FCenter.pos3D], + [Normals3D[k],Normals3D[j],FCenter.normal3D], FColorGradientTempBmp, + [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); + k := j; + end; + end; + end; + end; + + procedure ComputeShadedColors; + var + j: Int32or64; + begin + with ADescription do + begin + //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong) + if length(FShadedColors) < NbVertices then + setlength(FShadedColors, NbVertices); + + for j := 0 to NbVertices-1 do + FShadedColors[j] := FShader.Apply(Positions3D[j],Normals3D[j],Colors[j]); + + FSameShadedColors := True; + for j := 1 to NbVertices-1 do + if (FShadedColors[j]<>FShadedColors[j-1]) then + begin + FSameShadedColors := False; + break; + end; + end; + end; + + procedure DrawWithMultishape; + var shadedCenter: TBGRAPixel; + j,k: Int32or64; + begin + with ADescription do + begin + if Texture <> nil then + begin + if (FOptions.PerspectiveMode <> pmLinearMapping) and (NbVertices=4) then + FMultishapeFiller.AddQuadPerspectiveMapping( + Projections[0],Projections[1],Projections[2],Projections[3], + Texture,TexCoords[0],TexCoords[1],TexCoords[2],TexCoords[3]) + else + if NbVertices>=3 then + begin + for j := 0 to NbVertices-3 do + FMultishapeFiller.AddTriangleLinearMapping( + Projections[j],Projections[j+1],Projections[j+2], + Texture,TexCoords[j],TexCoords[j+1],TexCoords[j+2]); + end; + end + else + begin + ComputeShadedColors; + + if FSameShadedColors then + FMultishapeFiller.AddPolygon(slice(Projections,NbVertices),FShadedColors[0]) + else + if NbVertices=3 then + FMultishapeFiller.AddTriangleLinearColor( + Projections[0],Projections[1],Projections[2], + FShadedColors[0],FShadedColors[1],FShadedColors[2]) + else + if NbVertices>=3 then + begin //split into triangles + ComputeCenter; + shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color); + k := NbVertices-1; + for j := 0 to NbVertices-1 do + begin + FMultishapeFiller.AddTriangleLinearColor( + Projections[k],Projections[j],FCenter.proj, + FShadedColors[k],FShadedColors[j],shadedCenter); + k := j; + end; + end; + end; + end; + end; + + procedure DrawAliasedColoredFace; + var j,k: integer; + shadedCenter: TBGRAPixel; + begin + with ADescription do + begin + ComputeShadedColors; + + if FSameShadedColors then + begin + if FOptions.PerspectiveMode = pmZBuffer then + BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices), + slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer) + else + FRenderSurface.FillPoly(slice(Projections,NbVertices),FShadedColors[0],dmDrawWithTransparency); + end + else + begin + if NbVertices > 4 then + begin //split into triangles + ComputeCenter; + shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color); + k := NbVertices-1; + if FOptions.PerspectiveMode = pmLinearMapping then + begin + for j := 0 to NbVertices-1 do + begin + FRenderSurface.FillPolyLinearColor([Projections[k],Projections[j],FCenter.proj],[FShadedColors[k],FShadedColors[j],shadedCenter]); + k := j; + end; + end else + begin + for j := 0 to NbVertices-1 do + begin + BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, [Projections[k],Projections[j],FCenter.proj], + [FDepths[k],FDepths[j],FCenter.pos3D.z], [FShadedColors[k],FShadedColors[j],shadedCenter],True,FZBuffer); + k := j; + end; + end; + end else + begin + if FOptions.PerspectiveMode = pmLinearMapping then + FRenderSurface.FillPolyLinearColor(slice(Projections,NbVertices),slice(FShadedColors,NbVertices)) + else + BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices), + slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer); + end; + end; + end; + end; + + procedure DrawWithoutShader; + var + noLighting: Boolean; + j: Int32or64; + begin + with ADescription do + begin + if length(FDepths) < NbVertices then + setlength(FDepths, NbVertices); + for j := 0 to NbVertices-1 do + FDepths[j] := Positions3D[j].z; + + if Texture <> nil then + begin + noLighting := True; + if length(FLightings) < NbVertices then + setlength(FLightings, NbVertices); + for j := 0 to NbVertices-1 do + begin + FLightings[j] := FShader.Int65536Apply(Positions3D[j],Normals3D[j],BGRAWhite).g div 2; + if abs(FLightings[j]-32768) > 1 then noLighting := false; + end; + + if noLighting then + begin + if FOptions.PerspectiveMode <> pmLinearMapping then + FRenderSurface.FillPolyPerspectiveMapping(slice(Projections,NbVertices), + slice(FDepths,NbVertices),Texture,slice(TexCoords,NbVertices), + FOptions.TextureInterpolation, FZBuffer) + else + FRenderSurface.FillPolyLinearMapping(slice(Projections,NbVertices), + Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation); + end else + begin + if FOptions.PerspectiveMode <> pmLinearMapping then + FRenderSurface.FillPolyPerspectiveMappingLightness( + slice(Projections,NbVertices),slice(FDepths,NbVertices),Texture, + slice(TexCoords,NbVertices),slice(FLightings,NbVertices), + FOptions.TextureInterpolation, FZBuffer) + else + FRenderSurface.FillPolyLinearMappingLightness( + slice(Projections,NbVertices),Texture,slice(TexCoords,NbVertices), + slice(FLightings,NbVertices),FOptions.TextureInterpolation); + end; + end + else + DrawAliasedColoredFace; //already low-quality shaded + end; + end; + +var + j: integer; + SkipShader: boolean; +begin + result := true; + FShader.Prepare(ADescription); + with ADescription do + begin + //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud + if ( (FOptions.LightingInterpolation = liAlwaysHighQuality) or + ((FOptions.LightingInterpolation = liSpecularHighQuality) and Material.GetSpecularOn) ) + and (NormalsMode <> lnNone) then + begin + //if there are only directional lights and all the normals are the same, + //then the lighting will be uniform so we can skip the shader + if FShader.OnlyDirectionalLights then + begin + SkipShader := true; + for j := 1 to NbVertices-1 do + if Normals3D[j] <> Normals3D[j-1] then + begin + SkipShader := false; + break; + end; + end else + SkipShader := false; + + if not SkipShader then + begin + DrawFaceWithShader; + exit; + end; + end; + + if Assigned(FMultishapeFiller) then //high-quality antialiasing + DrawWithMultishape + else + DrawWithoutShader; + end; +end; + +destructor TBGRARenderer3D.Destroy; +begin + FreeAndNil(FShader); + + if Assigned(FMultishapeFiller) then + begin + FMultishapeFiller.Draw(FRenderSurface); + FreeAndNil(FMultishapeFiller); + end; + + if FZBuffer <> nil then + begin + FreeMem(FZBuffer); + FZBuffer := nil; + end; + + FreeAndNil(FColorGradientTempBmp); + + if FRenderSurfaceMultisample > 1 then + begin + BGRAResample.DownSamplePutImage(FRenderSurface, + FRenderSurfaceMultisample,FRenderSurfaceMultisample, + FOutputSurface, 0,0, dmDrawWithTransparency); + FreeAndNil(FRenderSurface); + FRenderSurfaceMultisample := 1; + end + else + FRenderSurface := nil; + + inherited Destroy; +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraresample.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraresample.pas new file mode 100644 index 0000000..6c435b5 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraresample.pas @@ -0,0 +1,1532 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAResample; + +{$mode objfpc}{$H+} + +interface + +{ This unit provides resampling functions, i.e. resizing of bitmaps with or + without interpolation filters. + + SimpleStretch does a boxed resample with limited antialiasing. + + FineResample uses floating point coordinates to get an antialiased resample. + It can use minimal interpolation (4 pixels when upsizing) for simple interpolation + filters (linear and cosine-like) or wide kernel resample for complex interpolation. + In this cas, it calls WideKernelResample. + + WideKernelResample can be called by custom filter kernel, derived + from TWideKernelFilter. It is slower of course than simple interpolation. } + +uses + SysUtils, BGRABitmapTypes; + +{------------------------------- Simple stretch ------------------------------------} + +function SimpleStretch(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer): TBGRACustomBitmap; +procedure StretchPutImage(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte; ANoTransition: boolean = false); +procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX,factorY: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode); +function DownSample(source: TBGRACustomBitmap; factorX,factorY: integer): TBGRACustomBitmap; + +{---------------------------- Interpolation filters --------------------------------} + +function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single; +function FineInterpolation256(t256: integer; ResampleFilter: TResampleFilter): integer; + +type + TWideKernelFilter = class + function Interpolation(t: single): single; virtual; abstract; + function ShouldCheckRange: boolean; virtual; abstract; + function KernelWidth: single; virtual; abstract; + end; + + TMitchellKernel = class(TWideKernelFilter) + function Interpolation(t: single): single; override; + function ShouldCheckRange: boolean; override; + function KernelWidth: single; override; + end; + + { TSplineKernel } + + TSplineKernel = class(TWideKernelFilter) + public + Coeff: single; + constructor Create; overload; + constructor Create(ACoeff: single); overload; + function Interpolation(t: single): single; override; + function ShouldCheckRange: boolean; override; + function KernelWidth: single; override; + end; + + { TCubicKernel } + + TCubicKernel = class(TWideKernelFilter) + function pow3(x: single): single; inline; + function Interpolation(t: single): single; override; + function ShouldCheckRange: boolean; override; + function KernelWidth: single; override; + end; + + { TLanczosKernel } + + TLanczosKernel = class(TWideKernelFilter) + private + FNumberOfLobes: integer; + FFactor: ValReal; + procedure SetNumberOfLobes(AValue: integer); + public + constructor Create(ANumberOfLobes: integer); + function Interpolation(t: single): single; override; + function ShouldCheckRange: boolean; override; + function KernelWidth: single; override; + + property NumberOfLobes : integer read FNumberOfLobes write SetNumberOfLobes; + end; + +function CreateInterpolator(style: TSplineStyle): TWideKernelFilter; + +{-------------------------------- Fine resample ------------------------------------} + +function FineResample(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; + +function WideKernelResample(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap; + +implementation + +uses Math, BGRABlend, BGRAClasses; + +function SimpleStretch(bmp: TBGRACustomBitmap; + newWidth, newHeight: integer): TBGRACustomBitmap; +begin + if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then + begin + Result := bmp.Duplicate; + exit; + end; + Result := bmp.NewBitmap(NewWidth, NewHeight); + StretchPutImage(bmp, newWidth,newHeight, result, 0,0, dmSet, 255); +end; + +procedure StretchPutImage(bmp: TBGRACustomBitmap; NewWidth, NewHeight: integer; + dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte; ANoTransition: boolean); +type + TTransitionState = (tsNone, tsPlain, tsLeft, tsMiddle, tsRight); +var + x_src,y_src, y_src2, prev_y_src, prev_y_src2: Int32or64; + inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src, + acc_x_src2, acc_y_src2: Int32or64; + x_dest, y_dest: Int32or64; + + PDest, PSrc1, PSrc2: PBGRAPixel; + vertColors: packed array[1..2] of TBGRAPixel; + DeltaSrcX: Int32or64; + targetRect: TRect; + tempData: PBGRAPixel; + prevHorizTransition,horizTransition,prevVertTransition,vertTransition: TTransitionState; + horizSlightlyDifferent,vertSlightlyDifferent: boolean; + + procedure LinearMix(PSrc: PBGRAPixel; DeltaSrc: integer; AccSrcQuarter: boolean; + PDest: PBGRAPixel; slightlyDifferent: boolean; var transition: TTransitionState); + var + asum: Int32or64; + a1,a2: Int32or64; + newTransition: TTransitionState; + begin + if (DeltaSrc=0) or ANoTransition then + begin + PDest^ := PSrc^; + transition:= tsPlain; + end + else + begin + if slightlyDifferent then + begin + if AccSrcQuarter then newTransition:= tsRight else + newTransition:= tsLeft; + end else + newTransition:= tsMiddle; + + if (newTransition = tsMiddle) or ((newTransition = tsRight) and (transition = tsLeft)) or + ((newTransition = tsLeft) and (transition = tsRight)) then + begin + transition:= tsMiddle; + if ADrawMode = dmXor then + begin + pdest^.alpha := (psrc^.alpha + (psrc+DeltaSrc)^.alpha + 1) shr 1; + pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red + 1) shr 1; + pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green + 1) shr 1; + pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue + 1) shr 1; + end else + begin + asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha; + if asum = 0 then + pdest^ := BGRAPixelTransparent + else if asum = 510 then + begin + pdest^.alpha := 255; + pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red + 1) shr 1; + pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green + 1) shr 1; + pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue + 1) shr 1; + end else + begin + pdest^.alpha := asum shr 1; + a1 := psrc^.alpha; + a2 := (psrc+DeltaSrc)^.alpha; + pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum; + pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum; + pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum; + end; + end; + end else + if newTransition = tsRight then + begin + transition := tsRight; + if ADrawMode = dmXor then + begin + pdest^.alpha := (psrc^.alpha + (psrc+DeltaSrc)^.alpha*3 + 2) shr 2; + pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red*3 + 2) shr 2; + pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green*3 + 2) shr 2; + pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue*3 + 2) shr 2; + end else + begin + asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha*3; + if asum = 0 then + pdest^ := BGRAPixelTransparent + else if asum = 1020 then + begin + pdest^.alpha := 255; + pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red*3 + 2) shr 2; + pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green*3 + 2) shr 2; + pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue*3 + 2) shr 2; + end else + begin + pdest^.alpha := asum shr 2; + a1 := psrc^.alpha; + a2 := (psrc+DeltaSrc)^.alpha; + pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2*3 + (asum shr 1)) div asum; + pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2*3 + (asum shr 1)) div asum; + pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2*3 + (asum shr 1)) div asum; + end; + end; + end else + begin + transition:= tsLeft; + if ADrawMode = dmXor then + begin + pdest^.alpha := (psrc^.alpha*3 + (psrc+DeltaSrc)^.alpha + 2) shr 2; + pdest^.red := (psrc^.red*3 + (psrc+DeltaSrc)^.red + 2) shr 2; + pdest^.green := (psrc^.green*3 + (psrc+DeltaSrc)^.green + 2) shr 2; + pdest^.blue := (psrc^.blue*3 + (psrc+DeltaSrc)^.blue + 2) shr 2; + end else + begin + asum := psrc^.alpha*3 + (psrc+DeltaSrc)^.alpha; + if asum = 0 then + pdest^ := BGRAPixelTransparent + else if asum = 1020 then + begin + pdest^.alpha := 255; + pdest^.red := (psrc^.red*3 + (psrc+DeltaSrc)^.red + 2) shr 2; + pdest^.green := (psrc^.green*3 + (psrc+DeltaSrc)^.green + 2) shr 2; + pdest^.blue := (psrc^.blue*3 + (psrc+DeltaSrc)^.blue + 2) shr 2; + end else + begin + pdest^.alpha := asum shr 2; + a1 := psrc^.alpha; + a2 := (psrc+DeltaSrc)^.alpha; + pdest^.red := (psrc^.red*a1*3 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum; + pdest^.green := (psrc^.green*a1*3 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum; + pdest^.blue := (psrc^.blue*a1*3 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum; + end; + end; + end; + end; + end; + +begin + if (newWidth <= 0) or (newHeight <= 0) or (bmp.Width <= 0) + or (bmp.Height <= 0) then + exit; + + targetRect := rect(0,0,NewWidth,NewHeight); + if OffsetX < dest.ClipRect.Left then targetRect.Left:= dest.ClipRect.Left-OffsetX; + if OffsetY < dest.ClipRect.Top then targetRect.Top:= dest.ClipRect.Top-OffsetY; + if OffsetX+NewWidth > dest.ClipRect.Right then targetRect.Right := dest.ClipRect.Right-OffsetX; + if OffsetY+NewHeight > dest.ClipRect.Bottom then targetRect.Bottom := dest.ClipRect.Bottom-OffsetY; + if (targetRect.Right <= targetRect.Left) or (targetRect.Bottom <= targetRect.Top) then exit; + + bmp.LoadFromBitmapIfNeeded; + + if (ADrawMode <> dmSet) or (AOpacity <> 255) then + getmem(tempData, (targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel) ) + else + tempData := nil; + + inc_x_src := bmp.Width div newwidth; + mod_x_src := bmp.Width mod newwidth; + inc_y_src := bmp.Height div newheight; + mod_y_src := bmp.Height mod newheight; + + prev_y_src := -1; + prev_y_src2 := -1; + + acc_y_src := targetRect.Top*mod_y_src; + y_src := targetRect.Top*inc_y_src + (acc_y_src div NewHeight); + acc_y_src := acc_y_src mod NewHeight; + + y_src := y_src+ (bmp.Height div 4) div newheight; + acc_y_src := acc_y_src+ (bmp.Height div 4) mod newheight; + + y_src2 := y_src+ (bmp.Height div 2) div newheight; + acc_y_src2 := acc_y_src+ (bmp.Height div 2) mod newheight; + if acc_y_src2 > NewHeight then + begin + dec(acc_y_src2, NewHeight); + inc(y_src2); + end; + horizSlightlyDifferent := (NewWidth > bmp.Width*2 div 3) and (NewWidth < bmp.Width*4 div 3); + prevVertTransition:= tsNone; + vertSlightlyDifferent := (NewHeight > bmp.Height*2 div 3) and (NewHeight < bmp.Height*4 div 3); + for y_dest := targetRect.Top to targetRect.Bottom - 1 do + begin + if (y_src = prev_y_src) and (y_src2 = prev_y_src2) and not vertSlightlyDifferent then + begin + if tempData = nil then + move((dest.ScanLine[y_dest-1+OffsetY]+OffsetX+targetRect.Left)^,(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left)^,(targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel)) + else + PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity); + end else + begin + if tempData = nil then + PDest := dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left + else + PDest := tempData; + PSrc1 := bmp.Scanline[y_src]; + + acc_x_src := targetRect.Left*mod_x_src; + x_src := targetRect.Left*inc_x_src + (acc_x_src div NewWidth); + acc_x_src := acc_x_src mod NewWidth; + + x_src := x_src+ (bmp.Width div 4) div NewWidth; + acc_x_src := acc_x_src+ (bmp.Width div 4) mod NewWidth; + + DeltaSrcX := (bmp.Width div 2) div NewWidth; + acc_x_src2 := acc_x_src+ (bmp.Width div 2) mod NewWidth; + if acc_x_src2 > NewWidth then + begin + dec(acc_x_src2, NewWidth); + inc(DeltaSrcX); + end; + inc(Psrc1, x_src); + prevHorizTransition := tsNone; + + if y_src2=y_src then + begin + horizTransition:= prevHorizTransition; + for x_dest := targetRect.left to targetRect.right - 1 do + begin + LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, PDest, horizSlightlyDifferent, horizTransition); + + Inc(PSrc1, inc_x_src); + Inc(acc_x_src, mod_x_src); + if acc_x_src >= newWidth then + begin + Dec(acc_x_src, newWidth); + Inc(PSrc1); + dec(DeltaSrcX); + end; + Inc(acc_x_src2, mod_x_src); + if acc_x_src2 >= newWidth then + begin + Dec(acc_x_src2, newWidth); + Inc(DeltaSrcX); + end; + inc(PDest); + end; + prevVertTransition:= tsPlain; + end else + begin + PSrc2 := bmp.Scanline[y_src2]+x_src; + for x_dest := targetRect.left to targetRect.right - 1 do + begin + horizTransition:= prevHorizTransition; + LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[1], horizSlightlyDifferent, horizTransition); + horizTransition:= prevHorizTransition; + LinearMix(psrc2, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[2], horizSlightlyDifferent, horizTransition); + prevHorizTransition:= horizTransition; + vertTransition:= prevVertTransition; + LinearMix(@vertColors[1],1,acc_y_src2 >= NewHeight shr 2,PDest,vertSlightlyDifferent,vertTransition); + + Inc(PSrc1, inc_x_src); + Inc(PSrc2, inc_x_src); + Inc(acc_x_src, mod_x_src); + if acc_x_src >= newWidth then + begin + Dec(acc_x_src, newWidth); + Inc(PSrc1); + Inc(PSrc2); + dec(DeltaSrcX); + end; + Inc(acc_x_src2, mod_x_src); + if acc_x_src2 >= newWidth then + begin + Dec(acc_x_src2, newWidth); + Inc(DeltaSrcX); + end; + inc(PDest); + end; + prevVertTransition:= vertTransition; + end; + + if tempData <> nil then + PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity); + end; + + prev_y_src := y_src; + prev_y_src2 := y_src2; + + Inc(y_src, inc_y_src); + Inc(acc_y_src, mod_y_src); + if acc_y_src >= newheight then + begin + Dec(acc_y_src, newheight); + Inc(y_src); + end; + + Inc(y_src2, inc_y_src); + Inc(acc_y_src2, mod_y_src); + if acc_y_src2 >= newheight then + begin + Dec(acc_y_src2, newheight); + Inc(y_src2); + end; + end; + dest.InvalidateBitmap; + if Assigned(tempData) then FreeMem(tempData); +end; + +procedure DownSamplePutImage2(source: TBGRACustomBitmap; + dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); +const factorX = 2; factorY = 2; nbi= factorX*factorY; +var xb,yb,ys: Int32or64; + pdest: PBGRAPixel; + psrc1,psrc2: PBGRAPixel; + asum,maxsum: UInt32or64; + newWidth,newHeight: Int32or64; + r,g,b: UInt32or64; +begin + if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then + raise exception.Create('Source size must be a multiple of factorX and factorY'); + newWidth := source.Width div factorX; + newHeight := source.Height div factorY; + ys := 0; + maxsum := 255*Int32or64(factorX)*Int32or64(factorY); + for yb := 0 to newHeight-1 do + begin + pdest := dest.ScanLine[yb+OffsetY]+OffsetX; + psrc1 := source.Scanline[ys]; inc(ys); + psrc2 := source.Scanline[ys]; inc(ys); + for xb := newWidth-1 downto 0 do + begin + asum := 0; + asum := psrc1^.alpha + psrc2^.alpha + (psrc1+1)^.alpha + (psrc2+1)^.alpha; + if asum = maxsum then + begin + pdest^.alpha := 255; + r := psrc1^.red + psrc2^.red + (psrc1+1)^.red + (psrc2+1)^.red; + g := psrc1^.green + psrc2^.green + (psrc1+1)^.green + (psrc2+1)^.green; + b := psrc1^.blue + psrc2^.blue + (psrc1+1)^.blue + (psrc2+1)^.blue; + inc(psrc1,factorX); inc(psrc2,factorX); + pdest^.red := (r + (nbi shr 1)) shr 2; + pdest^.green := (g + (nbi shr 1)) shr 2; + pdest^.blue := (b + (nbi shr 1)) shr 2; + end else + if ADrawMode <> dmSetExceptTransparent then + begin + if asum = 0 then + begin + if ADrawMode = dmSet then + pdest^ := BGRAPixelTransparent; + inc(psrc1,factorX); inc(psrc2,factorX); + end + else + begin + r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha; + g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha; + b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha; + inc(psrc1,factorX); inc(psrc2,factorX); + if ADrawMode = dmSet then + begin + pdest^.alpha := (asum + (nbi shr 1)) shr 2; + pdest^.red := (r + (asum shr 1)) div asum; + pdest^.green := (g + (asum shr 1)) div asum; + pdest^.blue := (b + (asum shr 1)) div asum; + end + else + begin + if ADrawMode = dmDrawWithTransparency then + DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) shr 2)) else + if ADrawMode = dmFastBlend then + FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) shr 2)); + end; + end; + end; + inc(pdest); + end; + end; +end; + +procedure DownSamplePutImage3(source: TBGRACustomBitmap; + dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); +const factorX = 3; factorY = 3; nbi= factorX*factorY; +var xb,yb,ys: Int32or64; + pdest: PBGRAPixel; + psrc1,psrc2,psrc3: PBGRAPixel; + asum,maxsum: UInt32or64; + newWidth,newHeight: Int32or64; + r,g,b: UInt32or64; +begin + if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then + raise exception.Create('Source size must be a multiple of factorX and factorY'); + newWidth := source.Width div factorX; + newHeight := source.Height div factorY; + ys := 0; + maxsum := 255*Int32or64(factorX)*Int32or64(factorY); + for yb := 0 to newHeight-1 do + begin + pdest := dest.ScanLine[yb+OffsetY]+OffsetX; + psrc1 := source.Scanline[ys]; inc(ys); + psrc2 := source.Scanline[ys]; inc(ys); + psrc3 := source.Scanline[ys]; inc(ys); + for xb := newWidth-1 downto 0 do + begin + asum := 0; + asum := psrc1^.alpha + psrc2^.alpha + psrc3^.alpha + + (psrc1+1)^.alpha + (psrc2+1)^.alpha + (psrc3+1)^.alpha + + (psrc1+2)^.alpha + (psrc2+2)^.alpha + (psrc3+2)^.alpha; + if asum = maxsum then + begin + pdest^.alpha := 255; + r := psrc1^.red + psrc2^.red + psrc3^.red + + (psrc1+1)^.red + (psrc2+1)^.red + (psrc3+1)^.red + + (psrc1+2)^.red + (psrc2+2)^.red + (psrc3+2)^.red; + g := psrc1^.green + psrc2^.green + psrc3^.green + + (psrc1+1)^.green + (psrc2+1)^.green + (psrc3+1)^.green + + (psrc1+2)^.green + (psrc2+2)^.green + (psrc3+2)^.green; + b := psrc1^.blue + psrc2^.blue + psrc3^.blue + + (psrc1+1)^.blue + (psrc2+1)^.blue + (psrc3+1)^.blue + + (psrc1+2)^.blue + (psrc2+2)^.blue + (psrc3+2)^.blue; + inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); + pdest^.red := (r + (nbi shr 1)) div 9; + pdest^.green := (g + (nbi shr 1)) div 9; + pdest^.blue := (b + (nbi shr 1)) div 9; + end else + if ADrawMode <> dmSetExceptTransparent then + begin + if asum = 0 then + begin + if ADrawMode = dmSet then + pdest^ := BGRAPixelTransparent; + inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); + end + else + begin + r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + psrc3^.red*psrc3^.alpha + + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha + (psrc3+1)^.red*(psrc3+1)^.alpha + + (psrc1+2)^.red*(psrc1+2)^.alpha + (psrc2+2)^.red*(psrc2+2)^.alpha + (psrc3+2)^.red*(psrc3+2)^.alpha; + g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + psrc3^.green*psrc3^.alpha + + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha + (psrc3+1)^.green*(psrc3+1)^.alpha + + (psrc1+2)^.green*(psrc1+2)^.alpha + (psrc2+2)^.green*(psrc2+2)^.alpha + (psrc3+2)^.green*(psrc3+2)^.alpha; + b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + psrc3^.blue*psrc3^.alpha + + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha + (psrc3+1)^.blue*(psrc3+1)^.alpha + + (psrc1+2)^.blue*(psrc1+2)^.alpha + (psrc2+2)^.blue*(psrc2+2)^.alpha + (psrc3+2)^.blue*(psrc3+2)^.alpha; + inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); + if ADrawMode = dmSet then + begin + pdest^.alpha := (asum + (nbi shr 1)) div 9; + pdest^.red := (r + (asum shr 1)) div asum; + pdest^.green := (g + (asum shr 1)) div asum; + pdest^.blue := (b + (asum shr 1)) div asum; + end + else + begin + if ADrawMode = dmDrawWithTransparency then + DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) div 9)) else + if ADrawMode = dmFastBlend then + FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) div 9)); + end; + end; + end; + inc(pdest); + end; + end; +end; + +procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX, factorY: integer; + dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); +var xb,yb,ys,iy,ix: Int32or64; + pdest,psrci: PBGRAPixel; + psrc: array of PBGRAPixel; + asum,maxsum: UInt32or64; + newWidth,newHeight: Int32or64; + r,g,b,nbi: UInt32or64; +begin + if ADrawMode = dmXor then raise exception.Create('dmXor drawmode not supported'); + if (factorX = 2) and (factorY = 2) then + begin + DownSamplePutImage2(source,dest,OffsetX,OffsetY,ADrawMode); + exit; + end; + if (factorX = 3) and (factorY = 3) then + begin + DownSamplePutImage3(source,dest,OffsetX,OffsetY,ADrawMode); + exit; + end; + if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then + raise exception.Create('Source size must be a multiple of factorX and factorY'); + newWidth := source.Width div factorX; + newHeight := source.Height div factorY; + ys := 0; + maxsum := 255*Int32or64(factorX)*Int32or64(factorY); + nbi := factorX*factorY; + setlength(psrc, factorY); + for yb := 0 to newHeight-1 do + begin + pdest := dest.ScanLine[yb+OffsetY]+OffsetX; + for iy := factorY-1 downto 0 do + begin + psrc[iy] := source.Scanline[ys]; + inc(ys); + end; + for xb := newWidth-1 downto 0 do + begin + asum := 0; + for iy := factorY-1 downto 0 do + begin + psrci := psrc[iy]; + for ix := factorX-1 downto 0 do + inc(asum, (psrci+ix)^.alpha); + end; + if asum = maxsum then + begin + pdest^.alpha := 255; + r := 0; + g := 0; + b := 0; + for iy := factorY-1 downto 0 do + for ix := factorX-1 downto 0 do + begin + with psrc[iy]^ do + begin + inc(r, red); + inc(g, green); + inc(b, blue); + end; + inc(psrc[iy]); + end; + pdest^.red := (r + (nbi shr 1)) div nbi; + pdest^.green := (g + (nbi shr 1)) div nbi; + pdest^.blue := (b + (nbi shr 1)) div nbi; + end else + if ADrawMode <> dmSetExceptTransparent then + begin + if asum = 0 then + begin + if ADrawMode = dmSet then + pdest^ := BGRAPixelTransparent; + for iy := factorY-1 downto 0 do + inc(psrc[iy],factorX); + end + else + begin + r := 0; + g := 0; + b := 0; + for iy := factorY-1 downto 0 do + for ix := factorX-1 downto 0 do + begin + with psrc[iy]^ do + begin + inc(r, red*alpha); + inc(g, green*alpha); + inc(b, blue*alpha); + end; + inc(psrc[iy]); + end; + if ADrawMode = dmSet then + begin + pdest^.alpha := (asum + (nbi shr 1)) div nbi; + pdest^.red := (r + (asum shr 1)) div asum; + pdest^.green := (g + (asum shr 1)) div asum; + pdest^.blue := (b + (asum shr 1)) div asum; + end + else + begin + if ADrawMode = dmDrawWithTransparency then + DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) div nbi)) else + if ADrawMode = dmFastBlend then + FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, + (g + (asum shr 1)) div asum, + (b + (asum shr 1)) div asum, + (asum + (nbi shr 1)) div nbi)); + end; + end; + end; + inc(pdest); + end; + end; +end; + +function DownSample(source: TBGRACustomBitmap; factorX, factorY: integer): TBGRACustomBitmap; +begin + if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then + raise exception.Create('Source size must be a multiple of factorX and factorY'); + result := source.NewBitmap(source.Width div factorX, source.Height div factorY); + DownSamplePutImage(source,factorX,factorY,result,0,0,dmSet); +end; + +{---------------------------- Interpolation filters ----------------------------------------} + +function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single; +begin + if ResampleFilter <= rfLinear then + begin + if ResampleFilter = rfBox then + begin + result := round(t); + end else + result := t; + end else + begin + if t <= 0.5 then + result := t*t*2 else + result := 1-(1-t)*(1-t)*2; + if ResampleFilter <> rfCosine then result := (result+t)*0.5; + end; +end; + +function FineInterpolation256(t256: integer; ResampleFilter: TResampleFilter): integer; +begin + if ResampleFilter <= rfLinear then + begin + if ResampleFilter = rfBox then + begin + if t256 < 128 then + result := 0 + else + result := 256; + end + else + result := t256; + end else + begin + if t256 <= 128 then + result := (t256*t256) shr 7 else + result := 256 - (((256-t256)*(256-t256)) shr 7); + if ResampleFilter <> rfCosine then result := (result+t256) shr 1; + end; +end; + +{ TCubicKernel } + +function TCubicKernel.pow3(x: single): single; +begin + if x <= 0.0 then + result:=0.0 + else + result:=x * x * x; +end; + +function TCubicKernel.Interpolation(t: single): single; +const globalfactor = 1/6; +begin + if t > 2 then + result := 0 + else + result:= globalfactor * + (pow3(t + 2 ) - 4 * pow3(t + 1 ) + 6 * pow3(t ) - 4 * pow3(t - 1 ) ); +end; + +function TCubicKernel.ShouldCheckRange: boolean; +begin + Result:= false; +end; + +function TCubicKernel.KernelWidth: single; +begin + Result:= 2; +end; + +{ TMitchellKernel } + +function TMitchellKernel.Interpolation(t: single): single; +var + tt, ttt: single; +const OneEighteenth = 1 / 18; +begin + t := Abs(t); + tt := Sqr(t); + ttt := tt * t; + if t < 1 then Result := (21 * ttt - 36 * tt + 16 ) * OneEighteenth + else if t < 2 then Result := (- 7 * ttt + 36 * tt - 60 * t + 32) * OneEighteenth + else Result := 0; +end; + +function TMitchellKernel.ShouldCheckRange: Boolean; +begin + Result := True; +end; + +function TMitchellKernel.KernelWidth: single; +begin + Result := 2; +end; + +{ TSplineKernel } + +constructor TSplineKernel.Create; +begin + coeff := 0.5; +end; + +constructor TSplineKernel.Create(ACoeff: single); +begin + Coeff := ACoeff; +end; + +function TSplineKernel.Interpolation(t: single): single; +var + tt, ttt: single; +begin + t := Abs(t); + tt := Sqr(t); + ttt := tt * t; + if t < 1 then + Result := (2 - Coeff) * ttt - (3 - Coeff) * tt + 1 + else if t < 2 then + Result := -Coeff * (ttt - 5 * tt + 8 * t - 4) + else + Result := 0; +end; + +function TSplineKernel.ShouldCheckRange: Boolean; +begin + Result := True; +end; + +function TSplineKernel.KernelWidth: single; +begin + Result := 2; +end; + +{ TLanczosKernel } +{ by stab } +procedure TLanczosKernel.SetNumberOfLobes(AValue: integer); +begin + if AValue < 1 then AValue := 1; + if FNumberOfLobes=AValue then Exit; + FNumberOfLobes:=AValue; + if AValue = 1 then FFactor := 1.5 else FFactor := AValue; +end; + +constructor TLanczosKernel.Create(ANumberOfLobes: integer); +begin + NumberOfLobes:= ANumberOfLobes; +end; + +function TLanczosKernel.Interpolation(t: single): single; +var Pi_t: ValReal; +begin + if t = 0 then + Result := 1 + else if t < FNumberOfLobes then + begin + Pi_t := pi * t; + Result := FFactor * sin(Pi_t) * sin(Pi_t / FNumberOfLobes) / + (Pi_t * Pi_t) + end + else + Result := 0; +end; + +function TLanczosKernel.ShouldCheckRange: boolean; +begin + Result := True; +end; + +function TLanczosKernel.KernelWidth: single; +begin + Result := FNumberOfLobes; +end; + +{--------------------------------------------- Fine resample ------------------------------------------------} + +function FineResampleLarger(bmp: TBGRACustomBitmap; + newWidth, newHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; +type + TInterpolationEntry = record + isrc1,isrc2,factCorr: integer; + end; +var + yb, xb: integer; + pdest,psrc1,psrc2: PBGRAPixel; + xsrc, ysrc, xfactor, yfactor: double; + xTab,yTab: array of TInterpolationEntry; + xInfo,yInfo: TInterpolationEntry; + cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel; + factHoriz, factVert: single; + fUpLeft, fUpRight, fLowLeft, fLowRight: integer; + faUpLeft, faUpRight, faLowLeft, faLowRight: integer; + rSum, gSum, bSum, aSum: integer; + temp: TBGRACustomBitmap; +begin + if (newWidth < bmp.Width) or (newHeight < bmp.Height) then + raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')'); + + if (newWidth = 0) or (newHeight = 0) then + begin + Result := bmp.NewBitmap(NewWidth, NewHeight); + exit; + end; + + bmp.LoadFromBitmapIfNeeded; + + if (bmp.Width = 1) and (bmp.Height = 1) then + begin + Result := bmp.NewBitmap(NewWidth, NewHeight); + Result.Fill(bmp.GetPixel(0, 0)); + exit; + end + else + if bmp.Width = 1 then + begin + temp := bmp.NewBitmap(2, bmp.Height); + temp.PutImage(0, 0, bmp, dmSet); + temp.PutImage(1, 0, bmp, dmSet); + Result := FineResampleLarger(temp, 2, newHeight, ResampleFilter); + temp.Free; + temp := Result; + Result := SimpleStretch(temp, newWidth,temp.Height); + temp.Free; + exit; + end + else + if bmp.Height = 1 then + begin + temp := bmp.NewBitmap(bmp.Width, 2); + temp.PutImage(0, 0, bmp, dmSet); + temp.PutImage(0, 1, bmp, dmSet); + Result := FineResampleLarger(temp, newWidth, 2, ResampleFilter); + temp.Free; + temp := Result; + Result := SimpleStretch(temp, temp.Width,newHeight); + temp.Free; + exit; + end; + + Result := bmp.NewBitmap(NewWidth, NewHeight); + yfactor := (bmp.Height - 1) / (newHeight - 1); + xfactor := (bmp.Width - 1) / (newWidth - 1); + + setlength(yTab, newHeight); + for yb := 0 to newHeight - 1 do + begin + ysrc := yb * yfactor; + factVert := frac(ysrc); + yTab[yb].isrc1 := floor(ysrc); + yTab[yb].isrc2 := min(bmp.Height-1, ceil(ysrc)); + yTab[yb].factCorr := round(FineInterpolation(factVert,ResampleFilter)*256); + end; + setlength(xTab, newWidth); + for xb := 0 to newWidth - 1 do + begin + xsrc := xb * xfactor; + factHoriz := frac(xsrc); + xTab[xb].isrc1 := floor(xsrc); + xTab[xb].isrc2 := min(bmp.Width-1,ceil(xsrc)); + xTab[xb].factCorr := round(FineInterpolation(factHoriz,ResampleFilter)*256); + end; + + for yb := 0 to newHeight - 1 do + begin + pdest := Result.Scanline[yb]; + yInfo := yTab[yb]; + psrc1 := bmp.scanline[yInfo.isrc1]; + psrc2 := bmp.scanline[yInfo.isrc2]; + for xb := 0 to newWidth - 1 do + begin + xInfo := xTab[xb]; + + cUpLeft := (psrc1 + xInfo.isrc1)^; + cUpRight := (psrc1 + xInfo.isrc2)^; + cLowLeft := (psrc2 + xInfo.isrc1)^; + cLowRight := (psrc2 + xInfo.isrc2)^; + + fLowRight := (xInfo.factCorr * yInfo.factCorr + 128) shr 8; + fLowLeft := yInfo.factCorr - fLowRight; + fUpRight := xInfo.factCorr - fLowRight; + fUpLeft := (256 - xInfo.factCorr) - fLowLeft; + + faUpLeft := fUpLeft * cUpLeft.alpha; + faUpRight := fUpRight * cUpRight.alpha; + faLowLeft := fLowLeft * cLowLeft.alpha; + faLowRight := fLowRight * cLowRight.alpha; + + rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight + + cLowLeft.red * faLowLeft + cLowRight.red * faLowRight; + gSum := cUpLeft.green * faUpLeft + cUpRight.green * faUpRight + + cLowLeft.green * faLowLeft + cLowRight.green * faLowRight; + bSum := cUpLeft.blue * faUpLeft + cUpRight.blue * faUpRight + + cLowLeft.blue * faLowLeft + cLowRight.blue * faLowRight; + aSum := cUpLeft.alpha * fUpLeft + cUpRight.alpha * fUpRight + + cLowLeft.alpha * fLowLeft + cLowRight.alpha * fLowRight; + + if aSum = 0 then + pdest^ := BGRAPixelTransparent + else + pdest^ := BGRA((rSum + aSum shr 1) div aSum, (gSum + aSum shr 1) div aSum, + (bSum + aSum shr 1) div aSum, (aSum + 128) shr 8); + Inc(pdest); + + end; + end; +end; + +function FineResampleSmaller(bmp: TBGRACustomBitmap; + newWidth, newHeight: integer): TBGRACustomBitmap; +var + yb, xb, yb2, xb2: integer; + pdest, psrc: PBGRAPixel; + lineDelta, delta: integer; + xsrc1, ysrc1, xsrc2, ysrc2, xfactor, yfactor: double; + ixsrc1, ixsrc2, iysrc1, iysrc2, ixsrc1p1, ixsrc2m1, iysrc1p1, iysrc2m1: integer; + cBorder, cFull, cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel; + factHoriz1, factHoriz2, factVert1, factVert2, Sum, fUpLeft, fUpRight, + fLowLeft, fLowRight, faUpLeft, faUpRight, faLowLeft, faLowRight: single; + rSum, gSum, bSum, aSum: double; +begin + if (newWidth > bmp.Width) or (newHeight > bmp.Height) then + raise ERangeError.Create('FineResampleSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')'); + Result := bmp.NewBitmap(NewWidth, NewHeight); + if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then + exit; + + bmp.LoadFromBitmapIfNeeded; + + if bmp.lineOrder = riloTopToBottom then + lineDelta := bmp.Width + else + lineDelta := -bmp.Width; + + yfactor := bmp.Height / newHeight; + xfactor := bmp.Width / newWidth; + for yb := 0 to newHeight - 1 do + begin + pdest := Result.Scanline[yb]; + ysrc1 := yb * yfactor; + ysrc2 := (yb + 1) * yfactor; + iysrc1 := trunc(ysrc1); + if (int(ysrc2) = int(ysrc1)) or (ysrc2 = iysrc1 + 1) then + begin + iysrc2 := iysrc1; + factVert1 := 1; + factVert2 := 0; + end + else + begin + iysrc2 := trunc(ysrc2); + factVert1 := 1 - frac(ysrc1); + factVert2 := frac(ysrc2); + end; + for xb := 0 to newWidth - 1 do + begin + xsrc1 := xb * xfactor; + xsrc2 := (xb + 1) * xfactor; + ixsrc1 := trunc(xsrc1); + if (int(xsrc2) = int(xsrc1)) or (xsrc2 = ixsrc1 + 1) then + begin + ixsrc2 := ixsrc1; + factHoriz1 := 1; + factHoriz2 := 0; + end + else + begin + ixsrc2 := trunc(xsrc2); + factHoriz1 := 1 - frac(xsrc1); + factHoriz2 := frac(xsrc2); + end; + + cUpLeft := bmp.GetPixel(ixsrc1, iysrc1); + cUpRight := bmp.GetPixel(ixsrc2, iysrc1); + cLowLeft := bmp.GetPixel(ixsrc1, iysrc2); + cLowRight := bmp.GetPixel(ixsrc2, iysrc2); + + fUpLeft := factHoriz1 * factVert1; + fUpRight := factHoriz2 * factVert1; + fLowLeft := factHoriz1 * factVert2; + fLowRight := factHoriz2 * factVert2; + + faUpLeft := fUpLeft * cUpLeft.alpha; + faUpRight := fUpRight * cUpRight.alpha; + faLowLeft := fLowLeft * cLowLeft.alpha; + faLowRight := fLowRight * cLowRight.alpha; + + Sum := fUpLeft + fUpRight + fLowLeft + fLowRight; + rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight + + cLowLeft.red * faLowLeft + cLowRight.red * faLowRight; + gSum := cUpLeft.green * faUpLeft + cUpRight.green * faUpRight + + cLowLeft.green * faLowLeft + cLowRight.green * faLowRight; + bSum := cUpLeft.blue * faUpLeft + cUpRight.blue * faUpRight + + cLowLeft.blue * faLowLeft + cLowRight.blue * faLowRight; + aSum := cUpLeft.alpha * fUpLeft + cUpRight.alpha * fUpRight + + cLowLeft.alpha * fLowLeft + cLowRight.alpha * fLowRight; + + ixsrc1p1 := ixsrc1 + 1; + ixsrc2m1 := ixsrc2 - 1; + iysrc1p1 := iysrc1 + 1; + iysrc2m1 := iysrc2 - 1; + + if ixsrc2m1 >= ixsrc1p1 then + begin + psrc := bmp.scanline[iysrc1] + ixsrc1p1; + for xb2 := ixsrc1p1 to ixsrc2m1 do + begin + cBorder := psrc^; + Inc(psrc); + IncF(rSum, cBorder.red * cBorder.alpha * factVert1); + IncF(gSum, cBorder.green * cBorder.alpha * factVert1); + IncF(bSum, cBorder.blue * cBorder.alpha * factVert1); + IncF(aSum, cBorder.alpha * factVert1); + IncF(Sum, factVert1); + end; + + if (factVert2 <> 0) and (iysrc2 < bmp.Height) then + begin + psrc := bmp.scanline[iysrc2] + ixsrc1p1; + for xb2 := ixsrc1p1 to ixsrc2m1 do + begin + cBorder := psrc^; + Inc(psrc); + IncF(rSum, cBorder.red * cBorder.alpha * factVert2); + IncF(gSum, cBorder.green * cBorder.alpha * factVert2); + IncF(bSum, cBorder.blue * cBorder.alpha * factVert2); + IncF(aSum, cBorder.alpha * factVert2); + IncF(Sum, factVert2); + end; + end; + end; + + if iysrc2m1 >= iysrc1p1 then + begin + psrc := bmp.scanline[iysrc1p1] + ixsrc1; + for yb2 := iysrc1p1 to iysrc2m1 do + begin + cBorder := psrc^; + Inc(psrc, lineDelta); + IncF(rSum, cBorder.red * cBorder.alpha * factHoriz1); + IncF(gSum, cBorder.green * cBorder.alpha * factHoriz1); + IncF(bSum, cBorder.blue * cBorder.alpha * factHoriz1); + IncF(aSum, cBorder.alpha * factHoriz1); + IncF(Sum, factHoriz1); + end; + + if (factHoriz2 <> 0) and (ixsrc2 < bmp.Width) then + begin + psrc := bmp.scanline[iysrc1p1] + ixsrc2; + for yb2 := iysrc1p1 to iysrc2m1 do + begin + cBorder := psrc^; + Inc(psrc, lineDelta); + IncF(rSum, cBorder.red * cBorder.alpha * factHoriz2); + IncF(gSum, cBorder.green * cBorder.alpha * factHoriz2); + IncF(bSum, cBorder.blue * cBorder.alpha * factHoriz2); + IncF(aSum, cBorder.alpha * factHoriz2); + IncF(Sum, factHoriz2); + end; + end; + end; + + if (ixsrc2m1 >= ixsrc1p1) and (iysrc2m1 >= iysrc1p1) then + begin + delta := lineDelta - (ixsrc2m1 - ixsrc1p1 + 1); + psrc := bmp.scanline[iysrc1p1] + ixsrc1p1; + for yb2 := iysrc1p1 to iysrc2m1 do + begin + for xb2 := ixsrc1p1 to ixsrc2m1 do + begin + cFull := psrc^; + IncF(rSum, cFull.red * cFull.alpha); + IncF(gSum, cFull.green * cFull.alpha); + IncF(bSum, cFull.blue * cFull.alpha); + IncF(aSum, cFull.alpha); + IncF(Sum, 1); + Inc(psrc); + end; + Inc(psrc, delta); + end; + end; + + if aSum = 0 then + pdest^ := BGRAPixelTransparent + else + pdest^ := BGRA(round(rSum / aSum), round(gSum / aSum), + round(bSum / aSum), round(aSum / Sum)); + Inc(pdest); + + end; + end; +end; + +function CreateInterpolator(style: TSplineStyle): TWideKernelFilter; +begin + case Style of + ssInside, ssInsideWithEnds: result := TCubicKernel.Create; + ssCrossing, ssCrossingWithEnds: result := TMitchellKernel.Create; + ssOutside: result := TSplineKernel.Create(0.5); + ssRoundOutside: result := TSplineKernel.Create(0.75); + ssVertexToSide: result := TSplineKernel.Create(1); + ssEasyBezier: raise Exception.Create('EasyBezier does not have an interpolator'); + else + raise Exception.Create('Unknown spline style'); + end; +end; + +function FineResample(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; +var + temp, newtemp: TBGRACustomBitmap; + tempFilter1,tempFilter2: TWideKernelFilter; +begin + if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then + begin + Result := bmp.Duplicate; + exit; + end; + case ResampleFilter of + rfBicubic: //blur + begin + tempFilter1 := TCubicKernel.Create; + result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); + tempFilter1.Free; + exit; + end; + rfMitchell: + begin + tempFilter1 := TMitchellKernel.Create; + result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); + tempFilter1.Free; + exit; + end; + rfSpline: + begin + tempFilter1 := TSplineKernel.Create; + result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); + tempFilter1.Free; + exit; + end; + rfLanczos2,rfLanczos3,rfLanczos4: + begin + tempFilter1 := TLanczosKernel.Create(ord(ResampleFilter)-ord(rfLanczos2)+2); + result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); + tempFilter1.Free; + exit; + end; + rfBestQuality: + begin + tempFilter1 := TSplineKernel.Create; + tempFilter2 := TMitchellKernel.Create; + result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter2,tempFilter1); + tempFilter1.Free; + tempFilter2.Free; + exit; + end; + end; + + if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then + Result := FineResampleLarger(bmp, NewWidth, NewHeight, ResampleFilter) + else + if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then + Result := FineResampleSmaller(bmp, NewWidth, NewHeight) + else + begin + temp := bmp; + + if NewWidth < bmp.Width then + begin + newtemp := FineResampleSmaller(temp, NewWidth, temp.Height); + if (temp <> bmp) then + temp.Free; + temp := newtemp; + end; + + if NewHeight < bmp.Height then + begin + newtemp := FineResampleSmaller(temp, temp.Width, NewHeight); + if (temp <> bmp) then + temp.Free; + temp := newtemp; + end; + + if NewWidth > bmp.Width then + begin + newtemp := FineResampleLarger(temp, NewWidth, temp.Height, ResampleFilter); + if (temp <> bmp) then + temp.Free; + temp := newtemp; + end; + + if NewHeight > bmp.Height then + begin + newtemp := FineResampleLarger(temp, temp.Width, NewHeight, ResampleFilter); + if (temp <> bmp) then + temp.Free; + temp := newtemp; + end; + + if temp <> bmp then + Result := temp + else + Result := bmp.Duplicate; + end; +end; + +{------------------------ Wide kernel filtering adapted from Graphics32 ---------------------------} + +function Constrain(const Value, Lo, Hi: Integer): Integer; +begin + if Value < Lo then + Result := Lo + else if Value > Hi then + Result := Hi + else + Result := Value; +end; + +type + TPointRec = record + Pos: Integer; + Weight: Single; + end; + + TCluster = array of TPointRec; + TMappingTable = array of TCluster; + +{$warnings off} +function BuildMappingTable( + DstLo, DstHi: Integer; + ClipLo, ClipHi: Integer; + SrcLo, SrcHi: Integer; + KernelSmaller,KernelLarger: TWideKernelFilter): TMappingTable; +Const FullEdge = false; +var + SrcW, DstW, ClipW: Integer; + FilterWidth: Single; + Scale, OldScale: Single; + Center: Single; + Left, Right: Integer; + I, J, K: Integer; + Weight: Single; +begin + SrcW := SrcHi - SrcLo; + DstW := DstHi - DstLo; + ClipW := ClipHi - ClipLo; + if SrcW = 0 then + begin + Result := nil; + Exit; + end + else if SrcW = 1 then + begin + SetLength(Result, ClipW); + for I := 0 to ClipW - 1 do + begin + SetLength(Result[I], 1); + Result[I][0].Pos := 0; + Result[I][0].Weight := 1; + end; + Exit; + end; + SetLength(Result, ClipW); + if ClipW = 0 then Exit; + + if FullEdge then Scale := DstW / SrcW + else Scale := (DstW - 1) / (SrcW - 1); + + K := 0; + + if Scale = 0 then + begin + SetLength(Result[0], 1); + Result[0][0].Pos := (SrcLo + SrcHi) div 2; + Result[0][0].Weight := 1; + end + else if Scale < 1 then + begin + FilterWidth := KernelSmaller.KernelWidth; + OldScale := Scale; + Scale := 1 / Scale; + FilterWidth := FilterWidth * Scale; + for I := 0 to ClipW - 1 do + begin + if FullEdge then + Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale + else + Center := SrcLo + (I - DstLo + ClipLo) * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + for J := Left to Right do + begin + Weight := KernelSmaller.Interpolation((Center - J) * OldScale) * OldScale; + if Weight <> 0 then + begin + K := Length(Result[I]); + SetLength(Result[I], K + 1); + Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1); + Result[I][K].Weight := Weight; + end; + end; + if Length(Result[I]) = 0 then + begin + SetLength(Result[I], 1); + Result[I][0].Pos := Floor(Center); + Result[I][0].Weight := 1; + end; + end; + end + else // scale > 1 + begin + FilterWidth := KernelLarger.KernelWidth; + Scale := 1 / Scale; + for I := 0 to ClipW - 1 do + begin + if FullEdge then + Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale + else + Center := SrcLo + (I - DstLo + ClipLo) * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + for J := Left to Right do + begin + Weight := KernelLarger.Interpolation(Center - j); + if Weight <> 0 then + begin + K := Length(Result[I]); + SetLength(Result[I], k + 1); + Result[I][K].Pos := Constrain(j, SrcLo, SrcHi - 1); + Result[I][K].Weight := Weight; + end; + end; + end; + end; +end; +{$warnings on} + +function WideKernelResample(bmp: TBGRACustomBitmap; + NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap; +type + TSum = record + sumR,sumG,sumB,sumA: single; + end; + +var + mapX,mapY: TMappingTable; + xb,yb,xc,yc,MapXLoPos,MapXHiPos: integer; + clusterX,clusterY: TCluster; + verticalSum: array of TSum; + scanlinesSrc: array of PBGRAPixel; + sum: TSum; + c: TBGRAPixel; + w,wa: single; + pdest: PBGRAPixel; +begin + result := bmp.NewBitmap(NewWidth,NewHeight); + if (NewWidth=0) or (NewHeight=0) then exit; + mapX := BuildMappingTable(0,NewWidth,0,NewWidth,0,bmp.Width,ResampleFilterSmaller,ResampleFilterLarger); + mapY := BuildMappingTable(0,NewHeight,0,NewHeight,0,bmp.Height,ResampleFilterSmaller,ResampleFilterLarger); + + MapXLoPos := MapX[0][0].Pos; + MapXHiPos := MapX[NewWidth - 1][High(MapX[NewWidth - 1])].Pos; + + setlength(verticalSum, MapXHiPos-MapXLoPos+1); + + setlength(scanlinesSrc, bmp.Height); + for yb := 0 to bmp.Height-1 do + scanlinesSrc[yb] := bmp.ScanLine[yb]; + + for yb := 0 to NewHeight-1 do + begin + clusterY := mapY[yb]; + + for xb := MapXLoPos to MapXHiPos do + begin + fillchar(verticalSum[xb - MapXLoPos],sizeof(verticalSum[xb - MapXLoPos]),0); + for yc := 0 to high(clusterY) do + with verticalSum[xb - MapXLoPos] do + begin + c := (scanlinesSrc[clusterY[yc].Pos]+xb)^; + w := clusterY[yc].Weight; + wa := w * c.alpha; + IncF(sumA, wa); + IncF(sumR, c.red * wa); + IncF(sumG, c.green * wa); + IncF(sumB, c.blue * wa); + end; + end; + + pdest := result.Scanline[yb]; + + for xb := 0 to NewWidth-1 do + begin + clusterX := mapX[xb]; + {$hints off} + fillchar(sum,sizeof(sum),0); + {$hints on} + for xc := 0 to high(clusterX) do + begin + w := clusterX[xc].Weight; + with verticalSum[ClusterX[xc].Pos - MapXLoPos] do + begin + IncF(sum.sumA, sumA*w); + IncF(sum.sumR, sumR*w); + IncF(sum.sumG, sumG*w); + IncF(sum.sumB, sumB*w); + end; + end; + + if sum.sumA < 0.5 then + pdest^ := BGRAPixelTransparent else + begin + c.red := constrain(round(sum.sumR/sum.sumA),0,255); + c.green := constrain(round(sum.sumG/sum.sumA),0,255); + c.blue := constrain(round(sum.sumB/sum.sumA),0,255); + if sum.sumA > 255 then + c.alpha := 255 else + c.alpha := round(sum.sumA); + pdest^ := c; + end; + inc(pdest); + end; + end; + +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrascanner.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrascanner.inc new file mode 100644 index 0000000..5af3648 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrascanner.inc @@ -0,0 +1,266 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + TBGRACustomBitmap = class; + +{=== IBGRAScanner ===} + {* Interface for a scanner. A scanner is like an image, but its content + has no limit and it can be calculated on the fly. It is like a + infinite readonly image. + * + * Note: it must not implement reference counting even if it is an interface + * + * ''TBGRACustomBitmap'' implements this interface and the content is repeated + horizontally and vertically. There are also various classes + in ''BGRAGradientScanner'' unit that generate gradients on the fly and + in ''BGRATransform'' unit that provide geometrical transformations of images } + IBGRAScanner = interface + {** Move to the position (''X'',''Y'') for the next call to ''ScanNextPixel'' } + procedure ScanMoveTo(X,Y: Integer); + {** Scan the pixel at the current location and increments ''X'' } + function ScanNextPixel: TBGRAPixel; + function ScanNextExpandedPixel: TExpandedPixel; + {** Scan at any location using floating point coordinates } + function ScanAt(X,Y: Single): TBGRAPixel; + function ScanAtExpanded(X,Y: Single): TExpandedPixel; + {** Scan at any location using integer coordinates } + function ScanAtInteger(X,Y: integer): TBGRAPixel; + function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; + {** Copy a row of pixels from ''X'' to ''X''+''count''-1 to a specified destination + ''pdest''. ''mode'' indicates how to combine with existing data } + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); + procedure ScanSkipPixels(ACount: integer); + {** Returns True if the function ''ScanPutPixels'' is available. Otherwise + you need to call ''ScanNextPixel'' and combine pixels for example + with ''SetPixel'' } + function IsScanPutPixelsDefined: boolean; + {** Returns the corresponding OpenGL texture. The value is ''nil'' if no texture is associated. **} + function GetTextureGL: IUnknown; + function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; + function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; + function ProvidesScanline(ARect: TRect): boolean; + function GetScanlineAt(X,Y: integer): PBGRAPixel; + function GetScanCustomColorspace: TColorspaceAny; + procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); + procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); + function ScanAtIntegerMask(X,Y: integer): TByteMask; + function ScanAtMask(X,Y: Single): TByteMask; + end; + + {** A type of function of a scanner that returns the content at floating point coordinates } + TScanAtFunction = function (X,Y: Single): TBGRAPixel of object; + {** A type of function of a scanner that returns the content at integer coordinates } + TScanAtIntegerFunction = function (X,Y: Integer): TBGRAPixel of object; + {** A type of function of a scanner that returns the next pixel } + TScanNextPixelFunction = function: TBGRAPixel of object; + + { TBGRACustomScanner } + {* Base class for implementing ''IBGRAScanner'' interface } + TBGRACustomScanner = class(IBGRAScanner) + private + FCurX,FCurY: integer; + FOwnCur: boolean; + FChunk: packed array[0..3] of TExpandedPixel; + public + function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual; + function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; virtual; + procedure ScanMoveTo(X,Y: Integer); virtual; + function ScanNextPixel: TBGRAPixel; virtual; + function ScanNextExpandedPixel: TExpandedPixel; virtual; + function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract; + function ScanAtExpanded(X,Y: Single): TExpandedPixel; virtual; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual; + procedure ScanSkipPixels(ACount: integer); virtual; + function IsScanPutPixelsDefined: boolean; virtual; + function GetTextureGL: IUnknown; virtual; + function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; virtual; + function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; virtual; + function ProvidesScanline({%H-}ARect: TRect): boolean; virtual; + function GetScanlineAt({%H-}X,{%H-}Y: integer): PBGRAPixel; virtual; + function GetScanCustomColorspace: TColorspaceAny; virtual; + procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); virtual; + procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); virtual; + function ScanAtIntegerMask(X,Y: integer): TByteMask; virtual; + function ScanAtMask(X,Y: Single): TByteMask; virtual; + protected + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + end; +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +{ TBGRACustomScanner } +{ The abstract class record the position so that a derived class + need only to redefine ScanAt } + +function TBGRACustomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + result := ScanAt(X,Y); +end; + +function TBGRACustomScanner.ScanAtIntegerExpanded(X, Y: integer + ): TExpandedPixel; +begin + result := GammaExpansion(ScanAtInteger(X,Y)); +end; + +procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer); +begin + FCurX := X; + FCurY := Y; + FOwnCur := true; +end; + +{ Call ScanAt to determine pixel value } +function TBGRACustomScanner.ScanNextPixel: TBGRAPixel; +begin + result := ScanAt(FCurX,FCurY); + Inc(FCurX); +end; + +function TBGRACustomScanner.ScanNextExpandedPixel: TExpandedPixel; +begin + result := GammaExpansion(ScanNextPixel); +end; + +function TBGRACustomScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel; +begin + result := GammaExpansion(ScanAt(X,Y)); +end; + +{$hints off} +procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +begin + //do nothing +end; + +procedure TBGRACustomScanner.ScanSkipPixels(ACount: integer); +begin + if FOwnCur then inc(FCurX, ACount) + else + begin + while ACount > 0 do + begin + ScanNextPixel; + dec(ACount); + end; + end; +end; + +{$hints on} + +function TBGRACustomScanner.IsScanPutPixelsDefined: boolean; +begin + result := false; +end; + +function TBGRACustomScanner.GetTextureGL: IUnknown; +begin + result := nil; +end; + +function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect; + Channel: TChannel; ANothingValue: Byte): TRect; +begin + result := InternalGetImageBoundsWithin(nil,self,ARect,[Channel],ANothingValue); +end; + +function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect; + Channels: TChannels; ANothingValue: Byte): TRect; +begin + result := InternalGetImageBoundsWithin(nil,self,ARect,Channels,ANothingValue); +end; + +function TBGRACustomScanner.ProvidesScanline(ARect: TRect): boolean; +begin + result := false; +end; + +function TBGRACustomScanner.GetScanlineAt(X, Y: integer): PBGRAPixel; +begin + result := nil; +end; + +function TBGRACustomScanner.GetScanCustomColorspace: TColorspaceAny; +begin + result := TExpandedPixelColorspace; +end; + +procedure TBGRACustomScanner.ScanNextCustomChunk(var ACount: integer; out + APixels: Pointer); +var + i: Integer; + p: PExpandedPixel; +begin + if ACount > length(FChunk) then ACount := length(FChunk); + p := @FChunk[low(FChunk)]; + APixels := p; + for i := ACount-1 downto 0 do + begin + p^ := ScanNextExpandedPixel; + inc(p); + end; +end; + +procedure TBGRACustomScanner.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); +var + cs: TColorspaceAny; + pPixels: Pointer; +begin + cs := GetScanCustomColorspace; + if cs = TBGRAPixelColorspace then + begin + ScanNextCustomChunk(ACount, pPixels); + AMask := @PBGRAPixel(pPixels)^.green; + AStride := sizeof(TBGRAPixel); + end else + if cs = TByteMaskColorspace then + begin + ScanNextCustomChunk(ACount, pPixels); + AMask := PByteMask(pPixels); + AStride := sizeof(TByteMask); + end else + raise exception.Create('This scanner does not provide a mask.'); +end; + +function TBGRACustomScanner.ScanAtIntegerMask(X,Y: integer): TByteMask; +begin + if GetScanCustomColorspace = TBGRAPixelColorspace then + result := ScanAtInteger(X,Y).green + else + result := ScanAtMask(X,Y); +end; + +function TBGRACustomScanner.ScanAtMask(X,Y: Single): TByteMask; +begin + if GetScanCustomColorspace = TBGRAPixelColorspace then + result := ScanAt(X,Y).green + else + raise exception.Create('This scanner does not provide a mask.'); +end; + +{ Interface gateway } +function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + if GetInterface(iid, obj) then + Result := S_OK + else + Result := longint(E_NOINTERFACE); +end; + +{ There is no automatic reference counting, but it is compulsory to define these functions } +function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +{$ENDIF} \ No newline at end of file diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrascene3d.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrascene3d.pas new file mode 100644 index 0000000..3ca41b8 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrascene3d.pas @@ -0,0 +1,1643 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAScene3D; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRAColorInt, + BGRASSE, BGRAMatrix3D, + BGRASceneTypes, BGRARenderer3D; + +type + TProjection3D = BGRAMatrix3D.TProjection3D; + TLightingNormal3D = BGRASceneTypes.TLightingNormal3D; + TLightingInterpolation3D = BGRASceneTypes.TLightingInterpolation3D; + TAntialiasingMode3D = BGRASceneTypes.TAntialiasingMode3D; + TPerspectiveMode3D = BGRASceneTypes.TPerspectiveMode3D; + TRenderingOptions = BGRASceneTypes.TRenderingOptions; + + IBGRAVertex3D = BGRASceneTypes.IBGRAVertex3D; + IBGRANormal3D = BGRASceneTypes.IBGRANormal3D; + IBGRALight3D = BGRASceneTypes.IBGRALight3D; + IBGRADirectionalLight3D = BGRASceneTypes.IBGRADirectionalLight3D; + IBGRAPointLight3D = BGRASceneTypes.IBGRAPointLight3D; + IBGRAMaterial3D = BGRASceneTypes.IBGRAMaterial3D; + IBGRAFace3D = BGRASceneTypes.IBGRAFace3D; + IBGRAPart3D = BGRASceneTypes.IBGRAPart3D; + IBGRAObject3D = BGRASceneTypes.IBGRAObject3D; + + arrayOfIBGRAVertex3D = BGRASceneTypes.arrayOfIBGRAVertex3D; + +const + lnNone = BGRASceneTypes.lnNone; + lnFace = BGRASceneTypes.lnFace; + lnVertex = BGRASceneTypes.lnVertex; + lnFaceVertexMix = BGRASceneTypes.lnFaceVertexMix; + + liLowQuality = BGRASceneTypes.liLowQuality; + liSpecularHighQuality = BGRASceneTypes.liSpecularHighQuality; + liAlwaysHighQuality = BGRASceneTypes.liAlwaysHighQuality; + + am3dNone = BGRASceneTypes.am3dNone; + am3dMultishape = BGRASceneTypes.am3dMultishape; + am3dResample = BGRASceneTypes.am3dResample; + + pmLinearMapping = BGRASceneTypes.pmLinearMapping; + pmPerspectiveMapping = BGRASceneTypes.pmPerspectiveMapping; + pmZBuffer = BGRASceneTypes.pmZBuffer; + +type + + { TCamera3D } + + TCamera3D = class + private + procedure ComputeMatrix; + function GetLookWhere: TPoint3D; + function GetMatrix: TMatrix3D; + function GetViewPoint: TPoint3D; + procedure SetMatrix(AValue: TMatrix3D); + procedure SetViewPoint(AValue: TPoint3D); + protected + FMatrix: TMatrix3D; + FMatrixComputed: boolean; + FViewPoint: TPoint3D_128; + FLookWhere, FTopDir: TPoint3D_128; + public + procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); + procedure LookDown(angleDeg: single); + procedure LookLeft(angleDeg: single); + procedure LookRight(angleDeg: single); + procedure LookUp(angleDeg: single); + property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint; + property LookWhere: TPoint3D read GetLookWhere; + property Matrix: TMatrix3D read GetMatrix write SetMatrix; + end; + + { TBGRAScene3D } + + TBGRAScene3D = class + private + FSurface: TBGRACustomBitmap; //destination of software renderer + FViewCenter: TPointF; //where origin is drawn + FAutoViewCenter: boolean; //use middle of the screen + FZoom: TPointF; //how much the drawing is zoomed + FAutoZoom: Boolean; //display 1 as 80% of surface size + FProjection: TProjection3D; //current projection + FRenderedFaceCount: integer; //current counter of rendered faces + + FCamera: TCamera3D; + + FObjects: array of IBGRAObject3D; + FObjectCount: integer; + FMaterials: array of IBGRAMaterial3D; + FMaterialCount: integer; + FDefaultMaterial : IBGRAMaterial3D; + + FAmbiantLightColorF: TColorF; //lightness without light sources + FLights: TList; //individual light sources + + function GetAmbiantLightColorF: TColorF; + function GetAmbiantLightness: single; + function GetAmbiantLightColor: TBGRAPixel; + function GetFaceCount: integer; + function GetLight(AIndex: integer): IBGRALight3D; + function GetLightCount: integer; + function GetMaterial(AIndex: integer): IBGRAMaterial3D; + function GetNormalCount: integer; + function GetObject(AIndex: integer): IBGRAObject3D; + function GetVertexCount: integer; + function GetViewCenter: TPointF; + function GetViewPoint: TPoint3D; + function GetZoom: TPointF; + procedure SetAmbiantLightColorF(const AValue: TColorF); + procedure SetAmbiantLightness(const AValue: single); + procedure SetAmbiantLightColor(const AValue: TBGRAPixel); + procedure SetAutoViewCenter(const AValue: boolean); + procedure SetAutoZoom(const AValue: boolean); + procedure SetViewCenter(const AValue: TPointF); + procedure SetViewPoint(const AValue: TPoint3D); + procedure ComputeView(ScaleX,ScaleY: single); + function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; + procedure AddObject(AObj: IBGRAObject3D); + procedure AddLight(ALight: TObject); + procedure AddMaterial(AMaterial: IBGRAMaterial3D); + procedure Init; + + protected + FRenderer: TCustomRenderer3D; + FMaterialLibrariesFetched: array of string; + FTexturesFetched: array of record + Name: string; + Bitmap: TBGRACustomBitmap; + end; + procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual; + function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; virtual; + function FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; virtual; + procedure HandleFetchException(AException: Exception); virtual; + procedure DoRender; virtual; + procedure DoClear; virtual; + function GetRenderWidth: integer; + function GetRenderHeight: integer; + procedure OnMaterialTextureChanged({%H-}ASender: TObject); virtual; + procedure SetDefaultMaterial(AValue: IBGRAMaterial3D); + procedure InvalidateMaterial; + + public + DefaultLightingNormal: TLightingNormal3D; + RenderingOptions: TRenderingOptions; + UnknownColor: TBGRAPixel; + FetchDirectory: string; + FetchThrowsException: boolean; + + constructor Create; overload; + constructor Create(ASurface: TBGRACustomBitmap); overload; + destructor Destroy; override; + procedure Clear; virtual; + function FetchObject(AName: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; + procedure FetchMaterials(ALibraryName: string); virtual; + function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; + function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; + function LoadObjectFromStream(AStream: TStream; SwapFacesOrientation: boolean = true): IBGRAObject3D; + procedure LoadMaterialsFromFile(AFilename: string); + procedure LoadMaterialsFromFileUTF8(AFilename: string); + procedure LoadMaterialsFromStream(AStream: TStream); + procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); + procedure LookLeft(angleDeg: single); + procedure LookRight(angleDeg: single); + procedure LookUp(angleDeg: single); + procedure LookDown(angleDeg: single); + procedure Render; overload; virtual; + procedure Render(ARenderer: TCustomRenderer3D); overload; + function CreateObject: IBGRAObject3D; overload; + function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload; + function CreateObject(AColor: TBGRAPixel): IBGRAObject3D; overload; + function CreateSphere(ARadius: Single; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; + function CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; + function CreateHalfSphere(ARadius: Single; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; + function CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; + procedure RemoveObject(AObject: IBGRAObject3D); + function AddDirectionalLight(ADirection: TPoint3D; ALightness: single = 1; AMinIntensity : single = 0): IBGRADirectionalLight3D; overload; + function AddDirectionalLight(ADirection: TPoint3D; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRADirectionalLight3D; overload; + function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; ALightness: single = 1; AMinIntensity : single = 0): IBGRAPointLight3D; overload; + function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRAPointLight3D; overload; + procedure RemoveLight(ALight: IBGRALight3D); + procedure SetZoom(value: Single); overload; + procedure SetZoom(value: TPointF); overload; + function CreateMaterial: IBGRAMaterial3D; overload; + function CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D; overload; + function GetMaterialByName(AName: string): IBGRAMaterial3D; + procedure UpdateMaterials; virtual; + procedure UpdateMaterial(AMaterialName: string); virtual; + procedure ForEachVertex(ACallback: TVertex3DCallback); + procedure ForEachFace(ACallback: TFace3DCallback); + function MakeLightList: TList; + + property ViewCenter: TPointF read GetViewCenter write SetViewCenter; + property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter; + property AutoZoom: boolean read FAutoZoom write SetAutoZoom; + property Surface: TBGRACustomBitmap read FSurface write FSurface; + property Object3D[AIndex: integer]: IBGRAObject3D read GetObject; + property Object3DCount: integer read FObjectCount; + property VertexCount: integer read GetVertexCount; + property NormalCount: integer read GetNormalCount; + property FaceCount: integer read GetFaceCount; + property Zoom: TPointF read GetZoom write SetZoom; + property AmbiantLightness: single read GetAmbiantLightness write SetAmbiantLightness; + property AmbiantLightColor: TBGRAPixel read GetAmbiantLightColor write SetAmbiantLightColor; + property AmbiantLightColorF: TColorF read GetAmbiantLightColorF write SetAmbiantLightColorF; + property LightCount: integer read GetLightCount; + property Light[AIndex: integer]: IBGRALight3D read GetLight; + property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint; + property RenderedFaceCount : integer read FRenderedFaceCount; + property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial; + property MaterialCount: integer read FMaterialCount; + property Camera: TCamera3D read FCamera; + property DefaultMaterial: IBGRAMaterial3D read FDefaultMaterial write SetDefaultMaterial; + end; + +implementation + +uses BGRACoordPool3D, BGRAUTF8; + +{$i lightingclasses3d.inc} +{$i vertex3d.inc} +{$i face3d.inc} +{$i part3d.inc} +{$i object3d.inc} +{$i shapes3d.inc} + +{ TCamera3D } + +function TCamera3D.GetLookWhere: TPoint3D; +begin + result := Point3D(FLookWhere); +end; + +function TCamera3D.GetMatrix: TMatrix3D; +begin + if not FMatrixComputed then + begin + ComputeMatrix; + FMatrixComputed := true; + end; + result := FMatrix; +end; + +function TCamera3D.GetViewPoint: TPoint3D; +begin + result := Point3D(FViewPoint); +end; + +procedure TCamera3D.SetMatrix(AValue: TMatrix3D); +begin + FMatrix := AValue; + FMatrixComputed:= true; + FViewPoint := Point3D_128(FMatrix[1,4],FMatrix[2,4],FMatrix[3,4]); +end; + +procedure TCamera3D.SetViewPoint(AValue: TPoint3D); +begin + FViewPoint := Point3D_128(AValue); + FMatrix[1,4] := FViewPoint.x; + FMatrix[2,4] := FViewPoint.y; + FMatrix[3,4] := FViewPoint.z; + FMatrixComputed := false; +end; + +procedure TCamera3D.ComputeMatrix; +var ZDir, XDir, YDir: TPoint3D_128; +begin + if IsPoint3D_128_Zero(FTopDir) then exit; + YDir := -FTopDir; + Normalize3D_128(YDir); + + ZDir := FLookWhere-FViewPoint; + if IsPoint3D_128_Zero(ZDir) then exit; + Normalize3D_128(ZDir); + + VectProduct3D_128(YDir,ZDir,XDir); + VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir + Normalize3D_128(XDir); + Normalize3D_128(YDir); + + FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint); + FMatrix := MatrixInverse3D(FMatrix); +end; + +procedure TCamera3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); +begin + FLookWhere := Point3D_128(AWhere); + FTopDir := Point3D_128(ATopDir); + FMatrixComputed := false; +end; + +procedure TCamera3D.LookLeft(angleDeg: single); +var m,inv: TMatrix3D; +begin + inv := MatrixInverse3D(Matrix); + m := MatrixRotateY(angleDeg*Pi/180); + FLookWhere := inv*m*Matrix*FLookWhere; + FMatrixComputed := false; +end; + +procedure TCamera3D.LookRight(angleDeg: single); +begin + LookLeft(-angleDeg); +end; + +procedure TCamera3D.LookUp(angleDeg: single); +var m,inv: TMatrix3D; +begin + inv := MatrixInverse3D(Matrix); + m := MatrixRotateX(-angleDeg*Pi/180); + FLookWhere := inv*m*Matrix*FLookWhere; + FMatrixComputed := false; +end; + +procedure TCamera3D.LookDown(angleDeg: single); +begin + LookUp(-angleDeg); +end; + + +{ TBGRAScene3D } + +function TBGRAScene3D.GetViewCenter: TPointF; +begin + if FAutoViewCenter then + begin + result := PointF((GetRenderWidth-1)/2,(GetRenderHeight-1)/2) + end + else + result := FViewCenter; +end; + +function TBGRAScene3D.GetViewPoint: TPoint3D; +begin + result := Camera.ViewPoint; +end; + +function TBGRAScene3D.GetZoom: TPointF; +var size: single; +begin + if FAutoZoom then + begin + Size := sqrt(GetRenderWidth*GetRenderHeight)*0.8; + if Size = 0 then + result := PointF(1,1) + else + result := PointF(size,size); + end else + result := FZoom; +end; + +procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF); +begin + FAmbiantLightColorF := AValue; +end; + +procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single); +begin + FAmbiantLightColorF := ColorF(AValue, AValue, AValue, 1); +end; + +procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel); +begin + FAmbiantLightColorF := ColorInt65536ToColorF(BGRAToColorInt(AValue,True)); +end; + +function TBGRAScene3D.GetObject(AIndex: integer): IBGRAObject3D; +begin + if (AIndex < 0) or (AIndex >= FObjectCount) then + raise exception.Create('Index out of bounds'); + result := FObjects[AIndex]; +end; + +function TBGRAScene3D.GetVertexCount: integer; +var i: integer; +begin + result := 0; + for i := 0 to Object3DCount-1 do + inc(result, Object3D[i].TotalVertexCount); +end; + +function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel; +begin + result := ColorIntToBGRA(ColorFToColorInt65536(FAmbiantLightColorF),True); +end; + +function TBGRAScene3D.GetFaceCount: integer; +var i: integer; +begin + result := 0; + for i := 0 to Object3DCount-1 do + inc(result, Object3D[i].FaceCount); +end; + +function TBGRAScene3D.GetLight(AIndex: integer): IBGRALight3D; +begin + if (AIndex < 0) or (AIndex >= FLights.Count) then + result := nil + else + result := TBGRALight3D(FLights[AIndex]); +end; + +function TBGRAScene3D.GetLightCount: integer; +begin + result := FLights.Count; +end; + +function TBGRAScene3D.GetMaterial(AIndex: integer): IBGRAMaterial3D; +begin + if (AIndex < 0) or (AIndex >= FMaterialCount) then + raise exception.Create('Index out of bounds'); + result := FMaterials[AIndex]; +end; + +function TBGRAScene3D.GetNormalCount: integer; +var i: integer; +begin + result := 0; + for i := 0 to Object3DCount-1 do + inc(result, Object3D[i].TotalNormalCount); +end; + +function TBGRAScene3D.GetAmbiantLightness: single; +begin + result := (FAmbiantLightColorF[1]+FAmbiantLightColorF[2]+FAmbiantLightColorF[3])/3; +end; + +function TBGRAScene3D.GetAmbiantLightColorF: TColorF; +begin + result := FAmbiantLightColorF; +end; + +procedure TBGRAScene3D.SetAutoViewCenter(const AValue: boolean); +begin + if FAutoViewCenter=AValue then exit; + if not AValue then + FViewCenter := ViewCenter; + FAutoViewCenter:=AValue; +end; + +procedure TBGRAScene3D.SetAutoZoom(const AValue: boolean); +begin + if FAutoZoom=AValue then exit; + if not AValue then + FZoom := Zoom; + FAutoZoom:=AValue; +end; + +procedure TBGRAScene3D.SetDefaultMaterial(AValue: IBGRAMaterial3D); +begin + if FDefaultMaterial=AValue then Exit; + FDefaultMaterial:=AValue; + InvalidateMaterial; +end; + +procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF); +begin + FViewCenter := AValue; + FAutoViewCenter:= False; +end; + +procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D); +begin + Camera.ViewPoint := AValue; +end; + +procedure TBGRAScene3D.AddObject(AObj: IBGRAObject3D); +begin + if FObjectCount = length(FObjects) then + setlength(FObjects, FObjectCount*2+1); + FObjects[FObjectCount] := AObj; + inc(FObjectCount); +end; + +procedure TBGRAScene3D.AddLight(ALight: TObject); +begin + FLights.Add(ALight); + IBGRALight3D(TBGRALight3D(ALight))._AddRef; +end; + +procedure TBGRAScene3D.AddMaterial(AMaterial: IBGRAMaterial3D); +begin + if FMaterialCount = length(FMaterials) then + setlength(FMaterials, FMaterialCount*2+1); + FMaterials[FMaterialCount] := AMaterial; + inc(FMaterialCount); +end; + +procedure TBGRAScene3D.Init; +begin + UnknownColor := BGRA(0,128,255); + FAutoZoom := True; + FAutoViewCenter := True; + + FCamera := TCamera3D.Create; + Camera.ViewPoint := Point3D(0,0,-100); + Camera.LookAt(Point3D(0,0,0), Point3D(0,-1,0)); + with RenderingOptions do + begin + TextureInterpolation := False; + PerspectiveMode := pmPerspectiveMapping; + LightingInterpolation := liSpecularHighQuality; + AntialiasingMode := am3dNone; + AntialiasingResampleLevel := 2; + end; + AmbiantLightness := 1; + AmbiantLightColor := BGRAWhite; + DefaultLightingNormal := lnFaceVertexMix; + FLights := TList.Create; + FRenderedFaceCount:= 0; + FMaterialCount := 0; + FObjectCount := 0; + DefaultMaterial := CreateMaterial; + RenderingOptions.MinZ := 1; +end; + +constructor TBGRAScene3D.Create; +begin + Init; +end; + +constructor TBGRAScene3D.Create(ASurface: TBGRACustomBitmap); +begin + FSurface := ASurface; + Init; +end; + +destructor TBGRAScene3D.Destroy; +var + i: Integer; +begin + DoClear; + FreeAndNil(FLights); + FreeAndNil(FCamera); + for i := 0 to high(FTexturesFetched) do + FTexturesFetched[i].Bitmap.Free; + inherited Destroy; +end; + +procedure TBGRAScene3D.Clear; +begin + DoClear; + DefaultMaterial := CreateMaterial; +end; + +function TBGRAScene3D.FetchObject(AName: string; SwapFacesOrientation: boolean + ): IBGRAObject3D; +begin + if FetchDirectory = '' then raise exception.Create('Please define first the FetchDirectory'); + try + result := LoadObjectFromFileUTF8(ConcatPaths([FetchDirectory,AName]), SwapFacesOrientation); + except + on ex:Exception do + HandleFetchException(ex); + end; +end; + +procedure TBGRAScene3D.UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); + + function ParseColor(text: string): TBGRAPixel; + var + color,tempColor: TBGRAPixel; + begin + color := UnknownColor; + + if copy(text,1,2) = 'dk' then + begin + tempcolor := ParseColor(copy(text,3,length(text)-2)); + tempcolor := MergeBGRA(tempcolor,3,BGRABlack,1); + color := StrToBGRA('dark'+copy(text,3,length(text)-2),tempcolor); + end; + if copy(text,1,2) = 'lt' then + begin + tempcolor := ParseColor(copy(text,3,length(text)-2)); + tempcolor := MergeBGRA(tempcolor,3,BGRAWhite,1); + color := StrToBGRA('light'+copy(text,3,length(text)-2),tempcolor); + end; + Color := StrToBGRA(StringReplace(text,'deep','dark',[]),Color); + Color := StrToBGRA(StringReplace(text,'dark','deep',[]),Color); + Color := StrToBGRA(text,Color); + result := color; + end; + +var + mat: IBGRAMaterial3D; + c: TBGRAPixel; +begin + mat := GetMaterialByName(AMaterialName); + if mat = nil then + begin + mat := CreateMaterial; + mat.Name := AMaterialName; + c := ParseColor(AMaterialName); + mat.AmbiantColor := c; + mat.DiffuseColor := c; + end; + AFace.Material := mat; +end; + +function TBGRAScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; +begin + result := BGRABitmapFactory.Create(AfileNameUTF8,True); +end; + +function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; +var + i: Integer; + bmp: TBGRACustomBitmap; +begin + bmp := nil; + for i := 0 to high(FTexturesFetched) do + if FTexturesFetched[i].Name = AName then + begin + bmp := FTexturesFetched[i].Bitmap; + result := bmp; + texSize := PointF(bmp.Width,bmp.Height); + exit; + end; + if FetchDirectory <> '' then + begin + try + bmp := LoadBitmapFromFileUTF8(ConcatPaths([FetchDirectory,AName])); + except + on ex:Exception do + HandleFetchException(ex); + end; + end; + if bmp = nil then + begin + result := nil; + texSize := PointF(1,1); + end else + begin + setlength(FTexturesFetched, length(FTexturesFetched)+1); + FTexturesFetched[high(FTexturesFetched)].Name := AName; + FTexturesFetched[high(FTexturesFetched)].Bitmap := bmp; + result := bmp; + texSize := PointF(bmp.Width,bmp.Height); + end; +end; + +procedure TBGRAScene3D.FetchMaterials(ALibraryName: string); +var + i: Integer; +begin + if FetchDirectory <> '' then + begin + for i := 0 to high(FMaterialLibrariesFetched) do + if FMaterialLibrariesFetched[i]=ALibraryName then exit; + setlength(FMaterialLibrariesFetched,length(FMaterialLibrariesFetched)+1); + FMaterialLibrariesFetched[high(FMaterialLibrariesFetched)] := ALibraryName; + try + LoadMaterialsFromFile(ConcatPaths([FetchDirectory,ALibraryName])); + except + on ex:Exception do + HandleFetchException(ex); + end; + end; +end; + +procedure TBGRAScene3D.HandleFetchException(AException: Exception); +begin + if FetchThrowsException then + raise AException; +end; + +procedure TBGRAScene3D.DoClear; +var i: integer; +begin + for i := 0 to FLights.Count-1 do + TBGRALight3D(FLights[i]).ReleaseInterface; + FLights.Clear; + + for i := 0 to FObjectCount-1 do + begin + FObjects[i].Clear; + FObjects[i] := nil; + end; + FObjects := nil; + FObjectCount := 0; + + FMaterials := nil; + FMaterialCount := 0; + DefaultMaterial := nil; +end; + +function TBGRAScene3D.GetRenderWidth: integer; +begin + if Assigned(FRenderer) then + result := FRenderer.SurfaceWidth + else + if Assigned(FSurface) then + result := FSurface.Width + else + result := 0; +end; + +function TBGRAScene3D.GetRenderHeight: integer; +begin + if Assigned(FRenderer) then + result := FRenderer.SurfaceHeight + else + if Assigned(FSurface) then + result := FSurface.Height + else + result := 0; +end; + +procedure TBGRAScene3D.OnMaterialTextureChanged(ASender: TObject); +begin + InvalidateMaterial; +end; + +procedure TBGRAScene3D.InvalidateMaterial; +var + i: Integer; +begin + for i := 0 to FObjectCount-1 do + FObjects[i].InvalidateMaterial; +end; + +function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D; +begin + result := LoadObjectFromFileUTF8(SysToUTF8(AFilename), SwapFacesOrientation); +end; + +function TBGRAScene3D.LoadObjectFromFileUTF8(AFilename: string; + SwapFacesOrientation: boolean): IBGRAObject3D; +var source: TFileStreamUTF8; +begin + source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite); + try + result := LoadObjectFromStream(source,SwapFacesOrientation); + finally + source.free; + end; +end; + +function TBGRAScene3D.LoadObjectFromStream(AStream: TStream; + SwapFacesOrientation: boolean): IBGRAObject3D; +var s: string; + secondValue,thirdValue: string; + + function GetNextToken: string; + var idxStart,idxEnd,idxSlash: integer; + begin + idxStart := 1; + while (idxStart <= length(s)) and (s[idxStart]in[' ',#9]) do inc(idxStart); + if idxStart > length(s) then + begin + result := ''; + exit; + end; + idxEnd := idxStart; + while (idxEnd < length(s)) and not (s[idxEnd+1]in[' ',#9]) do inc(idxEnd); + result := copy(s,idxStart, idxEnd-idxStart+1); + delete(s,1,idxEnd); + idxSlash := pos('/',result); + if idxSlash <> 0 then + begin + secondValue:= copy(result,idxSlash+1,length(result)-idxSlash); + result := copy(result,1,idxSlash-1); + idxSlash:= pos('/',secondValue); + if idxSlash <> 0 then + begin + thirdValue:= copy(secondValue,idxSlash+1,length(secondValue)-idxSlash); + secondValue:= copy(secondValue,1,idxSlash-1); + end else + thirdValue:= ''; + end else + begin + secondValue:= ''; + thirdValue:= ''; + end; + end; + +type + TFaceVertexExtra = record + normal: IBGRANormal3D; + texCoord: TPointF; + end; + +var lineType : string; + x,y,z : single; + code : integer; + faceVertices: array of IBGRAVertex3D; + faceExtra: array of TFaceVertexExtra; + NbFaceVertices,v,v2,v3,i: integer; + tempV: IBGRAVertex3D; + tempN: TFaceVertexExtra; + materialname: string; + face: IBGRAFace3D; + lines: TStringList; + lineIndex: integer; + texCoords: array of TPointF; + nbTexCoords: integer; + +begin + lines := TStringList.Create; + lines.LoadFromStream(AStream); + result := CreateObject; + faceVertices := nil; + faceExtra := nil; + NbFaceVertices:= 0; + materialname := 'default'; + lineIndex := 0; + texCoords := nil; + nbTexCoords:= 0; + while lineIndex < lines.Count do + begin + s := lines[lineIndex]; + if pos('#',s) <> 0 then + s := copy(s,1,pos('#',s)-1); + inc(lineIndex); + lineType := GetNextToken; + if lineType = 'v' then + begin + val(GetNextToken,x,code); + val(GetNextToken,y,code); + val(GetNextToken,z,code); + result.MainPart.Add(x,y,z); + end else + if lineType = 'vt' then + begin + val(GetNextToken,x,code); + val(GetNextToken,y,code); + if nbTexCoords >= length(texCoords) then + setlength(texCoords, length(texCoords)*2+1); + texCoords[nbTexCoords] := PointF(x,y); + inc(nbTexCoords); + end else + if lineType = 'vn' then + begin + val(GetNextToken,x,code); + val(GetNextToken,y,code); + val(GetNextToken,z,code); + result.MainPart.AddNormal(x,y,z); + result.LightingNormal := lnVertex; + end else + if lineType = 'mtllib' then + FetchMaterials(trim(s)) + else + if lineType = 'usemtl' then + materialname := trim(s) + else + if lineType = 'f' then + begin + NbFaceVertices:= 0; + repeat + val(GetNextToken,v,code); + if (code = 0) and (v < 0) then v := result.MainPart.VertexCount+1+v; + if (code = 0) and (v >= 1) and (v <= result.MainPart.VertexCount) then + begin + if length(faceVertices) = NbFaceVertices then + begin + setlength(faceVertices, length(faceVertices)*2+1); + setlength(faceExtra, length(faceExtra)*2+1); + end; + faceVertices[NbFaceVertices] := result.MainPart.Vertex[v-1]; + val(secondValue,v2,code); + if (code = 0) and (v2 < 0) then v2 := nbTexCoords+1+v2; + if (code = 0) and (v2 >= 1) and (v2-1 < nbTexCoords) then + faceExtra[NbFaceVertices].texCoord := texCoords[v2-1] + else if nbTexCoords > v-1 then + faceExtra[NbFaceVertices].texCoord := texCoords[v-1] + else + faceExtra[NbFaceVertices].texCoord := PointF(0,0); + val(thirdValue,v3,code); + if (code = 0) and (v3 < 0) then v3 := result.MainPart.NormalCount+1+v3; + if code = 0 then + faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v3-1] + else if result.MainPart.NormalCount > v-1 then + faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v-1] + else + faceExtra[NbFaceVertices].normal := nil; + inc(NbFaceVertices); + end else break; + until false; + if NbFaceVertices > 2 then + begin + if SwapFacesOrientation then + for i := 0 to NbFaceVertices div 2-1 do + begin + tempV := faceVertices[i]; + faceVertices[i] := faceVertices[NbFaceVertices-1-i]; + faceVertices[NbFaceVertices-1-i] := tempV; + tempN := faceExtra[i]; + faceExtra[i] := faceExtra[NbFaceVertices-1-i]; + faceExtra[NbFaceVertices-1-i] := tempN; + end; + face := result.AddFace(slice(faceVertices,NbFaceVertices)); + for i := 0 to NbFaceVertices-1 do + begin + face.SetNormal(i, faceExtra[i].normal); + face.SetTexCoord(i, faceExtra[i].texCoord); + end; + face.MaterialName := materialname; + end; + end; + end; + lines.Free; +end; + +procedure TBGRAScene3D.LoadMaterialsFromFile(AFilename: string); +var source: TFileStreamUTF8; +begin + source := TFileStreamUTF8.Create(SysToUTF8(AFilename),fmOpenRead,fmShareDenyWrite); + try + LoadMaterialsFromStream(source); + finally + source.free; + end; +end; + +procedure TBGRAScene3D.LoadMaterialsFromFileUTF8(AFilename: string); +var source: TFileStreamUTF8; +begin + source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite); + try + LoadMaterialsFromStream(source); + finally + source.free; + end; +end; + +procedure TBGRAScene3D.LoadMaterialsFromStream(AStream: TStream); +var + s: String; + + function GetNextToken: string; + var idxStart,idxEnd: integer; + begin + idxStart := 1; + while (idxStart <= length(s)) and (s[idxStart]in[#9,' ']) do inc(idxStart); + if idxStart > length(s) then + begin + result := ''; + exit; + end; + idxEnd := idxStart; + while (idxEnd < length(s)) and not (s[idxEnd+1]in[#9,' ']) do inc(idxEnd); + result := copy(s,idxStart, idxEnd-idxStart+1); + delete(s,1,idxEnd); + end; + + function GetSingle: single; + var {%H-}code: integer; + begin + val(GetNextToken,result,{%H-}code); + end; + + function GetColorF: TColorF; + var r,g,b: single; + {%H-}code: integer; + begin + val(GetNextToken,r,{%H-}code); + val(GetNextToken,g,{%H-}code); + val(GetNextToken,b,{%H-}code); + result := ColorF(r,g,b,1); + end; + +var + lines: TStringList; + lineIndex: integer; + lineType: String; + currentMaterial: IBGRAMaterial3D; + materialName: string; + texZoom: TPointF; + v: single; + +begin + lines := TStringList.Create; + lines.LoadFromStream(AStream); + lineIndex := 0; + while lineIndex < lines.Count do + begin + s := lines[lineIndex]; + if pos('#',s) <> 0 then + s := copy(s,1,pos('#',s)-1); + inc(lineIndex); + lineType := GetNextToken; + if lineType = 'newmtl' then + begin + materialName := trim(s); + currentMaterial := GetMaterialByName(materialName); + if currentMaterial = nil then + begin + currentMaterial := CreateMaterial; + currentMaterial.Name := materialName; + end; + end else + if currentMaterial <> nil then + begin + if lineType = 'Ka' then currentMaterial.AmbiantColorF := GetColorF else + if lineType = 'Kd' then currentMaterial.DiffuseColorF := GetColorF else + if lineType = 'Ks' then currentMaterial.SpecularColorF := GetColorF else + if (lineType = 'map_Ka') or (lineType = 'map_Kd') then + begin + currentMaterial.Texture := FetchTexture(trim(s),texZoom); + texZoom.y := -texZoom.y; + currentMaterial.TextureZoom := texZoom; + end else + if lineType = 'Ns' then currentMaterial.SpecularIndex := round(GetSingle) else + if lineType = 'd' then + begin + v := GetSingle; + if v > 1 then + currentMaterial.SimpleAlpha := 255 + else if v < 0 then + currentMaterial.SimpleAlpha := 0 + else + currentMaterial.SimpleAlpha := round(v*255); + end; + end; + end; + lines.Free; +end; + +procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); +begin + Camera.LookAt(AWhere,ATopDir); +end; + +procedure TBGRAScene3D.LookLeft(angleDeg: single); +begin + Camera.LookLeft(angleDeg); +end; + +procedure TBGRAScene3D.LookRight(angleDeg: single); +begin + Camera.LookRight(angleDeg); +end; + +procedure TBGRAScene3D.LookUp(angleDeg: single); +begin + Camera.LookUp(angleDeg); +end; + +procedure TBGRAScene3D.LookDown(angleDeg: single); +begin + Camera.LookDown(angleDeg); +end; + +procedure TBGRAScene3D.Render; +begin + FRenderer := TBGRARenderer3D.Create(FSurface, RenderingOptions, + FAmbiantLightColorF, + FLights); + DoRender; + FreeAndNil(FRenderer); +end; + +procedure TBGRAScene3D.Render(ARenderer: TCustomRenderer3D); +begin + FRenderer := ARenderer; + DoRender; + FRenderer := nil; +end; + +procedure TBGRAScene3D.ComputeView(ScaleX,ScaleY: single); +var + i: Integer; +begin + FProjection.Zoom := Zoom; + FProjection.Zoom.X := FProjection.Zoom.X * ScaleX; + FProjection.Zoom.Y := FProjection.Zoom.Y * ScaleY; + FProjection.Center := ViewCenter; + FProjection.Center.X := FProjection.Center.X * ScaleX; + FProjection.Center.Y := FProjection.Center.Y * ScaleY; + for i := 0 to FObjectCount-1 do + FObjects[i].ComputeWithMatrix(Camera.Matrix, FProjection); +end; + +function TBGRAScene3D.ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; +var InvZ: single; +begin + if AViewCoord.z > 0 then + begin + InvZ := 1/AViewCoord.z; + result := PointF(AViewCoord.x*InvZ*FProjection.Zoom.x + FProjection.Center.x, + AViewCoord.y*InvZ*FProjection.Zoom.Y + FProjection.Center.y); + end else + result := PointF(0,0); +end; + +type + arrayOfTBGRAFace3D = array of TBGRAFace3D; + +procedure InsertionSortFaces(var a: arrayOfTBGRAFace3D); +var i,j: integer; + temp: TBGRAFace3D; +begin + for i := 1 to high(a) do + begin + Temp := a[i]; + j := i; + while (j>0) and (a[j-1].ViewCenterZ > Temp.ViewCenterZ) do + begin + a[j] := a[j-1]; + dec(j); + end; + a[j] := Temp; + end; +end; + +function PartitionFaces(var a: arrayOfTBGRAFace3D; left,right: integer): integer; + + procedure Swap(idx1,idx2: integer); inline; + var temp: TBGRAFace3D; + begin + temp := a[idx1]; + a[idx1] := a[idx2]; + a[idx2] := temp; + end; + +var pivotIndex: integer; + pivotValue: TBGRAFace3D; + storeIndex: integer; + i: integer; + +begin + pivotIndex := left + random(right-left+1); + pivotValue := a[pivotIndex]; + swap(pivotIndex,right); + storeIndex := left; + for i := left to right-1 do + if a[i].ViewCenterZ <= pivotValue.ViewCenterZ then + begin + swap(i,storeIndex); + inc(storeIndex); + end; + swap(storeIndex,right); + result := storeIndex; +end; + +procedure QuickSortFaces(var a: arrayOfTBGRAFace3D; left,right: integer); +var pivotNewIndex: integer; +begin + if right > left+9 then + begin + pivotNewIndex := PartitionFaces(a,left,right); + QuickSortFaces(a,left,pivotNewIndex-1); + QuickSortFaces(a,pivotNewIndex+1,right); + end; +end; + +procedure SortFaces(var a: arrayOfTBGRAFace3D); +begin + if length(a) < 10 then InsertionSortFaces(a) else + begin + QuickSortFaces(a,0,high(a)); + InsertionSortFaces(a); + end; +end; + +function IsPolyVisible(const p : array of TPointF; ori: integer = 1) : boolean; +var i: integer; +begin + i := 0; + while i<=high(p)-2 do + begin + if ori* + ( (p[i+1].x-p[i].x)*(p[i+2].y-p[i].y) - + (p[i+1].y-p[i].y)*(p[i+2].x-p[i].x)) > 0 then + begin + result := true; + exit; + end; + inc(i); + end; + result := false; +end; + +procedure TBGRAScene3D.DoRender; +var + LFaces: array of TBGRAFace3D; + LFaceOpaque: array of boolean; + LFaceCount: integer; + + procedure PrepareFaces; + var i,j, LFaceIndex: integer; + obj: IBGRAObject3D; + begin + LFaces := nil; + LFaceCount := 0; + for i := 0 to FObjectCount-1 do + begin + obj := FObjects[i]; + inc(LFaceCount, obj.GetFaceCount); + obj.Update; + end; + setlength(LFaces, LFaceCount); + LFaceIndex := 0; + for i := 0 to FObjectCount-1 do + with FObjects[i] do + begin + for j := 0 to GetFaceCount-1 do + begin + LFaces[LFaceIndex] := TBGRAFace3D(GetFace(j).GetAsObject); + inc(LFaceIndex); + end; + end; + end; + +var + faceDesc: TFaceRenderingDescription; + LVertices: array of TBGRAVertex3D; + + procedure DrawFace(numFace: integer); + var + j,k: Integer; + VCount,NewVCount: integer; + NegNormals: boolean; + LastVisibleVertex: integer; + + procedure AddZIntermediate(n1,n2: integer); + var t: single; + v1,v2: TBGRAVertex3D; + begin + v1 := LVertices[n1]; + v2 := LVertices[n2]; + t := (RenderingOptions.MinZ - v1.ViewCoord.z)/(v2.ViewCoord.z - v1.ViewCoord.z); + LVertices[NewVCount] := nil; //computed + + faceDesc.Colors[NewVCount] := MergeBGRA(faceDesc.Colors[n1],round((1-t)*65536),faceDesc.Colors[n2],round(t*65536)); + faceDesc.TexCoords[NewVCount] := faceDesc.TexCoords[n1]*(1-t) + faceDesc.TexCoords[n2]*t; + faceDesc.Positions3D[NewVCount] := faceDesc.Positions3D[n1]*(1-t) + faceDesc.Positions3D[n2]*t; + faceDesc.Normals3D[NewVCount] := faceDesc.Normals3D[n1]*(1-t) + faceDesc.Normals3D[n2]*t; + faceDesc.Projections[NewVCount] := ComputeCoordinate(faceDesc.Positions3D[NewVCount]); + inc(NewVCount); + end; + + procedure LoadVertex(idxL: integer; idxV: integer); + var vertexDesc: PBGRAFaceVertexDescription; + tempV: TBGRAVertex3D; + begin + with LFaces[numFace] do + begin + vertexDesc := VertexDescription[idxV]; + with vertexDesc^ do + begin + tempV := TBGRAVertex3D(vertex.GetAsObject); + LVertices[idxL] := tempV; + + faceDesc.Colors[idxL] := ActualColor; + faceDesc.TexCoords[idxL] := ActualTexCoord; + + with tempV.CoordData^ do + begin + faceDesc.Positions3D[idxL] := viewCoord; + facedesc.Normals3D[idxL] := viewNormal; + faceDesc.Projections[idxL] := projectedCoord; + end; + if Normal <> nil then + facedesc.Normals3D[idxL] := Normal.ViewNormal_128; + Normalize3D_128(facedesc.Normals3D[idxL]); + end; + end; + end; + + begin + with LFaces[numFace] do + begin + VCount := VertexCount; + if VCount < 3 then exit; + + faceDesc.NormalsMode := Object3D.LightingNormal; + + faceDesc.Material := ActualMaterial; + if faceDesc.Material = nil then exit; + faceDesc.Texture := ActualTexture; + + if length(LVertices) < VCount+3 then //keep margin for z-clip + begin + setlength(LVertices, (VCount+3)*2); + setlength(faceDesc.Colors, length(LVertices)); + setlength(faceDesc.TexCoords, length(LVertices)); + setlength(faceDesc.Projections, length(LVertices)); + setlength(faceDesc.Positions3D, length(LVertices)); + setlength(faceDesc.Normals3D, length(LVertices)); + end; + + if FRenderer.HandlesNearClipping then + begin + for j := 0 to VCount-1 do + LoadVertex(j,j); + end else + begin + NewVCount := 0; + LastVisibleVertex := -1; + for k := VCount-1 downto 0 do + if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then + begin + LastVisibleVertex := k; + break; + end; + if LastVisibleVertex = -1 then exit; + + k := VCount-1; + for j := 0 to VCount-1 do + begin + if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then + begin + if k <> LastVisibleVertex then //one or more vertices is out + begin + LoadVertex(NewVCount+1, LastVisibleVertex); + LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount); + AddZIntermediate(NewVCount+1,NewVCount+2); + + LoadVertex(NewVCount+1, j); + LoadVertex(NewVCount+2, k); + + AddZIntermediate(NewVCount+1,NewVCount+2); + inc(NewVCount); + end else + begin + LoadVertex(NewVCount, j); + inc(NewVCount); + end; + LastVisibleVertex := j; + end; + k := j; + end; + VCount := NewVCount; + if VCount < 3 then exit; //after z-clipping + end; + + if not FRenderer.HandlesFaceCulling then + begin + if not IsPolyVisible(slice(faceDesc.Projections,VCount)) then + begin + if not Biface then exit; + NegNormals := True; + end else + begin + NegNormals := False; + end; + end else + NegNormals := false; + + //compute normals + case faceDesc.NormalsMode of + lnFace: for j := 0 to VCount-1 do + faceDesc.Normals3D[j] := ViewNormal_128; + lnFaceVertexMix: + for j := 0 to VCount-1 do + begin + faceDesc.Normals3D[j].Offset(ViewNormal_128); + Normalize3D_128(faceDesc.Normals3D[j]); + end; + end; + if NegNormals then + for j := 0 to VCount-1 do + faceDesc.Normals3D[j] := -faceDesc.Normals3D[j]; + + if LightThroughFactorOverride then + faceDesc.LightThroughFactor := LightThroughFactor + else + faceDesc.LightThroughFactor := faceDesc.Material.GetLightThroughFactor; + + faceDesc.NbVertices:= VCount; + faceDesc.Biface := Biface; + + if FRenderer.RenderFace(faceDesc, @ComputeCoordinate) then + inc(FRenderedFaceCount); + end; + end; + +var i,j: integer; + +begin + FRenderedFaceCount:= 0; + + PrepareFaces; + ComputeView(FRenderer.GlobalScale,FRenderer.GlobalScale); + FRenderer.Projection := FProjection; + + SortFaces(LFaces); + LVertices := nil; + + //if there is a Z-Buffer, it is possible to avoid drawing things that + //are hidden by opaque faces by drawing first all opaque faces + if FRenderer.HasZBuffer then + begin + setlength(LFaceOpaque, length(LFaces)); + for i := 0 to High(LFaces) do + begin + if (LFaces[i].Texture = nil) then + begin + LFaceOpaque[i] := true; + with LFaces[i] do + for j := 0 to VertexCount-1 do + if VertexColor[j].alpha <> 255 then + begin + LFaceOpaque[i] := false; + break; + end; + end else + LFaceOpaque[i] := true; + end; + + //draw near opaque faces first + for i := 0 to High(LFaces) do + if LFaceOpaque[i] then DrawFace(i); + + //draw other faces + for i := High(LFaces) downto 0 do + if not LFaceOpaque[i] then DrawFace(i); + end else + begin + for i := High(LFaces) downto 0 do + DrawFace(i); + end; +end; + +function TBGRAScene3D.CreateObject: IBGRAObject3D; +begin + result := TBGRAObject3D.Create(self); + AddObject(result); +end; + +function TBGRAScene3D.CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; +begin + result := TBGRAObject3D.Create(self); + result.Texture := ATexture; + AddObject(result); +end; + +function TBGRAScene3D.CreateObject(AColor: TBGRAPixel): IBGRAObject3D; +begin + result := TBGRAObject3D.Create(self); + result.Color := AColor; + AddObject(result); +end; + +function TBGRAScene3D.CreateSphere(ARadius: Single; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D; +begin + result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision); + AddObject(result); +end; + +function TBGRAScene3D.CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D; +begin + result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision); + result.Color := AColor; + AddObject(result); +end; + +function TBGRAScene3D.CreateHalfSphere(ARadius: Single; + AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D; +begin + result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True); + AddObject(result); +end; + +function TBGRAScene3D.CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel; + AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D; +begin + result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True); + result.Color := AColor; + AddObject(result); +end; + +procedure TBGRAScene3D.RemoveObject(AObject: IBGRAObject3D); +var + i,j: Integer; +begin + for i := FObjectCount-1 downto 0 do + if FObjects[i] = AObject then + begin + dec(FObjectCount); + FObjects[i] := nil; + for j := i to FObjectCount-1 do + FObjects[j] := FObjects[j+1]; + end; +end; + +function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D; + ALightness: single; AMinIntensity: single): IBGRADirectionalLight3D; +var lightObj: TBGRADirectionalLight3D; +begin + lightObj := TBGRADirectionalLight3D.Create(ADirection); + result := lightObj; + result.ColorF := ColorF(ALightness,ALightness,ALightness,1); + result.MinIntensity := AMinIntensity; + AddLight(lightObj); +end; + +function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D; + AOptimalDistance: single; ALightness: single; AMinIntensity: single + ): IBGRAPointLight3D; +var lightObj: TBGRAPointLight3D; +begin + lightObj := TBGRAPointLight3D.Create(AVertex, ALightness*sqr(AOptimalDistance)); + result := lightObj; + result.MinIntensity := AMinIntensity; + AddLight(lightObj); +end; + +function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D; + AColor: TBGRAPixel; AMinIntensity: single): IBGRADirectionalLight3D; +var lightObj: TBGRADirectionalLight3D; +begin + lightObj := TBGRADirectionalLight3D.Create(ADirection); + result := lightObj; + result.MinIntensity := AMinIntensity; + result.Color := AColor; + AddLight(lightObj); +end; + +function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D; + AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single + ): IBGRAPointLight3D; +var lightObj: TBGRAPointLight3D; +begin + lightObj := TBGRAPointLight3D.Create(AVertex,sqr(AOptimalDistance)); + result := lightObj; + result.Color := AColor; + result.MinIntensity := AMinIntensity; + AddLight(lightObj); +end; + +procedure TBGRAScene3D.RemoveLight(ALight: IBGRALight3D); +var idx: integer; +begin + idx := FLights.IndexOf(ALight.GetAsObject); + if idx <> -1 then + begin + ALight._Release; + FLights.Delete(Idx); + end; +end; + +procedure TBGRAScene3D.SetZoom(value: Single); +begin + SetZoom(PointF(value,value)); +end; + +procedure TBGRAScene3D.SetZoom(value: TPointF); +begin + FZoom := value; + FAutoZoom := false; +end; + +function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D; +var m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D.Create; + m.OnTextureChanged := @OnMaterialTextureChanged; + result := m; + AddMaterial(result); +end; + +function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D; +var m: TBGRAMaterial3D; +begin + m := TBGRAMaterial3D.Create; + m.SetSpecularIndex(ASpecularIndex); + m.SetSpecularColor(BGRAWhite); + m.OnTextureChanged := @OnMaterialTextureChanged; + result := m; + AddMaterial(result); +end; + +function TBGRAScene3D.GetMaterialByName(AName: string): IBGRAMaterial3D; +var i: integer; +begin + for i := 0 to MaterialCount-1 do + if AName = Material[i].Name then + begin + result := Material[i]; + exit; + end; + result := nil; +end; + +procedure TBGRAScene3D.UpdateMaterials; +var i,j: integer; + obj: IBGRAObject3D; + face: IBGRAFace3D; +begin + for i := 0 to Object3DCount-1 do + begin + obj := Object3D[i]; + for j := 0 to obj.FaceCount-1 do + begin + face := obj.Face[j]; + if face.MaterialName <> '' then + UseMaterial(face.MaterialName,face); + end; + end; +end; + +procedure TBGRAScene3D.UpdateMaterial(AMaterialName: string); +var i,j: integer; + obj: IBGRAObject3D; + face: IBGRAFace3D; +begin + for i := 0 to Object3DCount-1 do + begin + obj := Object3D[i]; + for j := 0 to obj.FaceCount-1 do + begin + face := obj.Face[j]; + if face.MaterialName = AMaterialName then + UseMaterial(face.MaterialName,face); + end; + end; +end; + +procedure TBGRAScene3D.ForEachVertex(ACallback: TVertex3DCallback); +var i: integer; +begin + for i := 0 to Object3DCount-1 do + Object3D[i].ForEachVertex(ACallback); +end; + +procedure TBGRAScene3D.ForEachFace(ACallback: TFace3DCallback); +var i: integer; +begin + for i := 0 to Object3DCount-1 do + Object3D[i].ForEachFace(ACallback); +end; + +function TBGRAScene3D.MakeLightList: TList; +var i: integer; +begin + result := TList.Create; + for i := 0 to FLights.Count-1 do + result.Add(FLights[i]); +end; + +initialization + + Randomize; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrascenetypes.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrascenetypes.pas new file mode 100644 index 0000000..b06e33b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrascenetypes.pas @@ -0,0 +1,1199 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASceneTypes; + +{$mode objfpc}{$H+} + +interface + +uses BGRABitmapTypes, BGRASSE, BGRAMatrix3D, BGRAColorInt; + +type + TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix); + TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality); + TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample); + TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer); + + TRenderingOptions = record + LightingInterpolation: TLightingInterpolation3D; + AntialiasingMode: TAntialiasingMode3D; + AntialiasingResampleLevel: integer; + PerspectiveMode: TPerspectiveMode3D; + TextureInterpolation: boolean; + MinZ: single; + end; + + PSceneLightingContext = ^TSceneLightingContext; + TSceneLightingContext = packed record + basic: TBasicLightingContext; + {128} diffuseColor, {144} specularColor: TColorInt65536; + {160} vL, {176} dummy: TPoint3D_128; + {192} vH: TPoint3D_128; + {208} lightness: integer; + {212} material : TObject; + LightThroughFactor: single; + LightThrough: LongBool; + SaturationLow: integer; + SaturationLowF: single; + SaturationHigh: integer; + SaturationHighF: single; + end; + + TBox3D = record + min,max: TPoint3D; + end; + + IBGRAVertex3D = interface; + + { IBGRALight3D } + + IBGRALight3D = interface ['{85C683B6-07AC-4B8D-9324-06BC22882433}'] + procedure ComputeDiffuseLightness(Context: PSceneLightingContext); + procedure ComputeDiffuseColor(Context: PSceneLightingContext); + procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); + + function GetColor: TBGRAPixel; + function GetColoredLight: boolean; + function GetColorF: TColorF; + function GetColorInt: TColorInt65536; + function GetLightnessF: single; + function GetAsObject: TObject; + procedure SetColor(const AValue: TBGRAPixel); + procedure SetColorF(const AValue: TColorF); + procedure SetColorInt(const AValue: TColorInt65536); + property Color: TBGRAPixel read GetColor write SetColor; + property ColorF: TColorF read GetColorF write SetColorF; + property ColorInt: TColorInt65536 read GetColorInt write SetColorInt; + property LightnessF: single read GetLightnessF; + property ColoredLight: boolean read GetColoredLight; + + function GetMinIntensity: single; + procedure SetMinIntensity(const AValue: single); + property MinIntensity: single read GetMinIntensity write SetMinIntensity; + function IsDirectional: boolean; + end; + + IBGRAPointLight3D = interface(IBGRALight3D) ['{C939900D-DDD6-49F0-B1E9-E29F94FDB4C8}'] + function GetVertex: IBGRAVertex3D; + procedure SetVertex(const AValue: IBGRAVertex3D); + property Vertex: IBGRAVertex3D read GetVertex write SetVertex; + end; + + IBGRADirectionalLight3D = interface(IBGRALight3D) ['{8D575CEE-8DD2-46FB-9BCC-17DE3DAAF53D}'] + function GetDirection: TPoint3D; + procedure SetDirection(const AValue: TPoint3D); + property Direction: TPoint3D read GetDirection write SetDirection; + end; + + { IBGRAMaterial3D } + + IBGRAMaterial3D = interface + function GetAmbiantAlpha: byte; + function GetAutoAmbiantColor: boolean; + function GetAutoDiffuseColor: boolean; + function GetAutoSimpleColor: boolean; + function GetAutoSpecularColor: boolean; + function GetAmbiantColor: TBGRAPixel; + function GetAmbiantColorF: TColorF; + function GetAmbiantColorInt: TColorInt65536; + function GetDiffuseAlpha: byte; + function GetDiffuseColor: TBGRAPixel; + function GetDiffuseColorF: TColorF; + function GetDiffuseColorInt: TColorInt65536; + function GetLightThroughFactor: single; + function GetName: string; + function GetSaturationHigh: single; + function GetSaturationLow: single; + function GetSimpleAlpha: byte; + function GetSimpleColor: TBGRAPixel; + function GetSimpleColorF: TColorF; + function GetSimpleColorInt: TColorInt65536; + function GetSpecularColor: TBGRAPixel; + function GetSpecularColorF: TColorF; + function GetSpecularColorInt: TColorInt65536; + function GetSpecularIndex: integer; + function GetSpecularOn: boolean; + function GetTexture: IBGRAScanner; + function GetTextureZoom: TPointF; + function GetAsObject: TObject; + + procedure SetAmbiantAlpha(AValue: byte); + procedure SetAutoDiffuseColor(const AValue: boolean); + procedure SetAutoSpecularColor(const AValue: boolean); + procedure SetAmbiantColor(const AValue: TBGRAPixel); + procedure SetAmbiantColorF(const AValue: TColorF); + procedure SetAmbiantColorInt(const AValue: TColorInt65536); + procedure SetDiffuseAlpha(AValue: byte); + procedure SetDiffuseColor(const AValue: TBGRAPixel); + procedure SetDiffuseColorF(const AValue: TColorF); + procedure SetDiffuseColorInt(const AValue: TColorInt65536); + procedure SetLightThroughFactor(const AValue: single); + procedure SetName(const AValue: string); + procedure SetSaturationHigh(const AValue: single); + procedure SetSaturationLow(const AValue: single); + procedure SetSimpleAlpha(AValue: byte); + procedure SetSimpleColor(AValue: TBGRAPixel); + procedure SetSimpleColorF(AValue: TColorF); + procedure SetSimpleColorInt(AValue: TColorInt65536); + procedure SetSpecularColor(const AValue: TBGRAPixel); + procedure SetSpecularColorF(const AValue: TColorF); + procedure SetSpecularColorInt(const AValue: TColorInt65536); + procedure SetSpecularIndex(const AValue: integer); + procedure SetTexture(AValue: IBGRAScanner); + procedure SetTextureZoom(AValue: TPointF); + + property AutoSimpleColor: boolean read GetAutoSimpleColor; + property SimpleColor: TBGRAPixel read GetSimpleColor write SetSimpleColor; + property SimpleColorF: TColorF read GetSimpleColorF write SetSimpleColorF; + property SimpleColorInt: TColorInt65536 read GetSimpleColorInt write SetSimpleColorInt; + property SimpleAlpha: byte read GetSimpleAlpha write SetSimpleAlpha; + + property AmbiantColor: TBGRAPixel read GetAmbiantColor write SetAmbiantColor; + property AmbiantColorF: TColorF read GetAmbiantColorF write SetAmbiantColorF; + property AmbiantColorInt: TColorInt65536 read GetAmbiantColorInt write SetAmbiantColorInt; + property AutoAmbiantColor: boolean read GetAutoAmbiantColor; + property AmbiantAlpha: byte read GetAmbiantAlpha write SetAmbiantAlpha; + property Texture: IBGRAScanner read GetTexture write SetTexture; + property TextureZoom: TPointF read GetTextureZoom write SetTextureZoom; + + property DiffuseColor: TBGRAPixel read GetDiffuseColor write SetDiffuseColor; + property DiffuseColorF: TColorF read GetDiffuseColorF write SetDiffuseColorF; + property DiffuseColorInt: TColorInt65536 read GetDiffuseColorInt write SetDiffuseColorInt; + property AutoDiffuseColor: boolean read GetAutoDiffuseColor write SetAutoDiffuseColor; + property DiffuseAlpha: byte read GetDiffuseAlpha write SetDiffuseAlpha; + property SaturationLow: single read GetSaturationLow write SetSaturationLow; + property SaturationHigh: single read GetSaturationHigh write SetSaturationHigh; + + property SpecularColor: TBGRAPixel read GetSpecularColor write SetSpecularColor; + property SpecularColorF: TColorF read GetSpecularColorF write SetSpecularColorF; + property SpecularColorInt: TColorInt65536 read GetSpecularColorInt write SetSpecularColorInt; + property AutoSpecularColor: boolean read GetAutoSpecularColor write SetAutoSpecularColor; + property SpecularIndex: integer read GetSpecularIndex write SetSpecularIndex; + property SpecularOn: boolean read GetSpecularOn; + + property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; + property Name: string read GetName write SetName; + end; + + { IBGRANormal3D } + + IBGRANormal3D = interface + function GetCustomNormal: TPoint3D; + function GetCustomNormal_128: TPoint3D_128; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + procedure SetCustomNormal(AValue: TPoint3D); + procedure SetCustomNormal_128(AValue: TPoint3D_128); + procedure SetViewNormal(AValue: TPoint3D); + procedure SetViewNormal_128(AValue: TPoint3D_128); + property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; + property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; + property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; + end; + + { IBGRAVertex3D } + + IBGRAVertex3D = interface + function GetColor: TBGRAPixel; + function GetCustomFlags: LongWord; + function GetCustomNormal: TPoint3D; + function GetCustomNormal_128: TPoint3D_128; + function GetLight: Single; + function GetProjectedCoord: TPointF; + function GetUsage: integer; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + function GetParentColor: Boolean; + function GetSceneCoord: TPoint3D; + function GetSceneCoord_128: TPoint3D_128; + function GetTexCoord: TPointF; + function GetViewCoord: TPoint3D; + function GetViewCoord_128: TPoint3D_128; + procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D); + function GetViewCoordZ: single; + procedure SetColor(const AValue: TBGRAPixel); + procedure SetCustomFlags(AValue: LongWord); + procedure SetCustomNormal(AValue: TPoint3D); + procedure SetCustomNormal_128(AValue: TPoint3D_128); + procedure SetLight(const AValue: Single); + procedure SetProjectedCoord(const AValue: TPointF); + procedure SetViewNormal(const AValue: TPoint3D); + procedure SetViewNormal_128(const AValue: TPoint3D_128); + procedure SetParentColor(const AValue: Boolean); + procedure SetSceneCoord(const AValue: TPoint3D); + procedure SetSceneCoord_128(const AValue: TPoint3D_128); + procedure SetTexCoord(const AValue: TPointF); + procedure SetViewCoord(const AValue: TPoint3D); + procedure SetViewCoord_128(const AValue: TPoint3D_128); + procedure NormalizeViewNormal; + procedure AddViewNormal(const AValue: TPoint3D_128); + property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord; + property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128; + property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord; + property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128; + property ViewCoordZ: single read GetViewCoordZ; + property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord; + property TexCoord: TPointF read GetTexCoord write SetTexCoord; + property Color: TBGRAPixel read GetColor write SetColor; + property ParentColor: Boolean read GetParentColor write SetParentColor; + property Light: Single read GetLight write SetLight; + property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; + property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; + property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; + property Usage: integer read GetUsage; + property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; + function GetAsObject: TObject; + end; + + arrayOfIBGRAVertex3D = array of IBGRAVertex3D; + TVertex3DCallback = procedure(AVertex: IBGRAVertex3D) of object; + + { IBGRAPart3D } + + IBGRAPart3D = interface + procedure Clear(ARecursive: boolean); + function Add(x,y,z: single): IBGRAVertex3D; overload; + function Add(pt: TPoint3D): IBGRAVertex3D; overload; + function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload; + function Add(pt: TPoint3D_128): IBGRAVertex3D; overload; + function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload; + function AddNormal(x,y,z: single): IBGRANormal3D; overload; + function AddNormal(pt: TPoint3D): IBGRANormal3D; overload; + function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload; + function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload; + function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload; + function Add(const pts_128: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload; + procedure Add(const pts: array of IBGRAVertex3D); overload; + procedure Add(AVertex: IBGRAVertex3D); overload; + function GetTotalNormalCount: integer; + function IndexOf(AVertex: IBGRAVertex3D): integer; + procedure RemoveVertex(Index: integer); + procedure RemoveNormal(Index: integer); + function GetBoundingBox: TBox3D; + function GetMatrix: TMatrix3D; + function GetPart(AIndex: Integer): IBGRAPart3D; + function GetPartCount: integer; + function GetRadius: single; + function GetVertex(AIndex: Integer): IBGRAVertex3D; + function GetVertexCount: integer; + function GetNormal(AIndex: Integer): IBGRANormal3D; + function GetNormalCount: integer; + function GetTotalVertexCount: integer; + function GetContainer: IBGRAPart3D; + procedure ResetTransform; + procedure Scale(size: single; Before: boolean = true); overload; + procedure Scale(x,y,z: single; Before: boolean = true); overload; + procedure Scale(size: TPoint3D; Before: boolean = true); overload; + procedure SetMatrix(const AValue: TMatrix3D); + procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); + procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); + procedure Translate(x,y,z: single; Before: boolean = true); overload; + procedure Translate(ofs: TPoint3D; Before: boolean = true); overload; + procedure RotateXDeg(angle: single; Before: boolean = true); + procedure RotateYDeg(angle: single; Before: boolean = true); + procedure RotateZDeg(angle: single; Before: boolean = true); + procedure RotateXRad(angle: single; Before: boolean = true); + procedure RotateYRad(angle: single; Before: boolean = true); + procedure RotateZRad(angle: single; Before: boolean = true); + procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); + function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; + procedure NormalizeViewNormal; + procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); + procedure RemoveUnusedVertices; + function CreatePart: IBGRAPart3D; + procedure ForEachVertex(ACallback: TVertex3DCallback); + property VertexCount: integer read GetVertexCount; + property NormalCount: integer read GetNormalCount; + property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; + property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal; + property Matrix: TMatrix3D read GetMatrix write SetMatrix; + property PartCount: integer read GetPartCount; + property Part[AIndex: Integer]: IBGRAPart3D read GetPart; + property Radius: single read GetRadius; + property BoundingBox: TBox3D read GetBoundingBox; + property TotalVertexCount: integer read GetTotalVertexCount; + property TotalNormalCount: integer read GetTotalNormalCount; + property Container: IBGRAPart3D read GetContainer; + end; + + IBGRAObject3D = interface; + + { IBGRAFace3D } + + IBGRAFace3D = interface + procedure FlipFace; + function AddVertex(AVertex: IBGRAVertex3D): integer; + function GetBiface: boolean; + function GetCustomFlags: LongWord; + function GetLightThroughFactorOverride: boolean; + function GetMaterial: IBGRAMaterial3D; + function GetMaterialName: string; + function GetObject3D: IBGRAObject3D; + function GetParentTexture: boolean; + function GetTexCoord(AIndex: Integer): TPointF; + function GetTexCoordOverride(AIndex: Integer): boolean; + function GetTexture: IBGRAScanner; + function GetVertex(AIndex: Integer): IBGRAVertex3D; + function GetNormal(AIndex: Integer): IBGRANormal3D; + function GetVertexColor(AIndex: Integer): TBGRAPixel; + function GetVertexColorOverride(AIndex: Integer): boolean; + function GetVertexCount: integer; + function GetViewCenter: TPoint3D; + function GetViewCenter_128: TPoint3D_128; + function GetViewCenterZ: single; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + function GetLightThroughFactor: single; + procedure SetCustomFlags(AValue: LongWord); + procedure SetLightThroughFactor(const AValue: single); + procedure SetBiface(const AValue: boolean); + procedure SetLightThroughFactorOverride(const AValue: boolean); + procedure SetMaterial(const AValue: IBGRAMaterial3D); + procedure SetMaterialName(const AValue: string); + procedure SetParentTexture(const AValue: boolean); + procedure SetTexCoord(AIndex: Integer; const AValue: TPointF); + procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean); + procedure SetTexture(const AValue: IBGRAScanner); + procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); + procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); + procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel); + procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean); + procedure ComputeViewNormalAndCenter; + procedure ComputeVertexColors; + procedure UpdateMaterial; + procedure SetColor(AColor: TBGRAPixel); + property Texture: IBGRAScanner read GetTexture write SetTexture; + property ParentTexture: boolean read GetParentTexture write SetParentTexture; + property VertexCount: integer read GetVertexCount; + property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; + property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor; + property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride; + property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord; + property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride; + property ViewNormal: TPoint3D read GetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128; + property ViewCenter: TPoint3D read GetViewCenter; + property ViewCenter_128: TPoint3D_128 read GetViewCenter_128; + property ViewCenterZ: single read GetViewCenterZ; + property Object3D: IBGRAObject3D read GetObject3D; + property Biface: boolean read GetBiface write SetBiface; + property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; + property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride; + property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; + property MaterialName: string read GetMaterialName write SetMaterialName; + function GetAsObject: TObject; + property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; + end; + + TFace3DCallback = procedure(AFace: IBGRAFace3D) of object; + + { IBGRAObject3D } + + IBGRAObject3D = interface + procedure Clear; + function GetColor: TBGRAPixel; + function GetFace(AIndex: integer): IBGRAFace3D; + function GetFaceCount: integer; + function GetMaterial: IBGRAMaterial3D; + function GetRefCount: integer; + function GetTotalNormalCount: integer; + function GetTotalVertexCount: integer; + function GetLight: Single; + function GetLightingNormal: TLightingNormal3D; + function GetParentLighting: boolean; + function GetTexture: IBGRAScanner; + function GetMainPart: IBGRAPart3D; + function GetScene: TObject; + procedure SetColor(const AValue: TBGRAPixel); + procedure SetLight(const AValue: Single); + procedure SetLightingNormal(const AValue: TLightingNormal3D); + procedure SetMaterial(const AValue: IBGRAMaterial3D); + procedure SetParentLighting(const AValue: boolean); + procedure SetTexture(const AValue: IBGRAScanner); + procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); + procedure RemoveUnusedVertices; + procedure InvalidateColor; + procedure InvalidateMaterial; + procedure ForEachVertex(ACallback: TVertex3DCallback); + procedure ForEachFace(ACallback: TFace3DCallback); + function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; + function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload; + procedure Update; + procedure SetBiface(AValue : boolean); + procedure SeparatePart(APart: IBGRAPart3D); + property MainPart: IBGRAPart3D read GetMainPart; + property Texture: IBGRAScanner read GetTexture write SetTexture; + property Light: Single read GetLight write SetLight; + property Color: TBGRAPixel read GetColor write SetColor; + property Face[AIndex: integer]: IBGRAFace3D read GetFace; + property FaceCount: integer read GetFaceCount; + property LightingNormal: TLightingNormal3D read GetLightingNormal write SetLightingNormal; + property ParentLighting: boolean read GetParentLighting write SetParentLighting; + property TotalVertexCount: integer read GetTotalVertexCount; + property TotalNormalCount: integer read GetTotalNormalCount; + property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; + property Scene: TObject read GetScene; + property RefCount: integer read GetRefCount; + end; + + TBGRAMaterialTextureChangedEvent = procedure(ASender: TObject) of object; + + { TBGRAMaterial3D } + + TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D) + private + FName: string; + FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean; + FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536; + FDiffuseLightness: integer; + + FSpecularColorInt: TColorInt65536; + FSpecularIndex: integer; + FSpecularOn: boolean; + + FSaturationLowF: single; + FSaturationHighF: single; + FLightThroughFactor: single; + + FTexture: IBGRAScanner; + FTextureZoom: TPointF; + FOnTextureChanged: TBGRAMaterialTextureChangedEvent; + + //phong precalc + FPowerTable: array of single; + FPowerTableSize, FPowerTableExp2: integer; + FPowerTableSizeF: single; + + procedure UpdateSpecular; + procedure UpdateSimpleColor; + procedure ComputePowerTable; + public + constructor Create; + destructor Destroy; override; + + function GetAutoAmbiantColor: boolean; + function GetAutoDiffuseColor: boolean; + function GetAutoSpecularColor: boolean; + function GetAutoSimpleColor: boolean; + function GetAmbiantAlpha: byte; + function GetAmbiantColor: TBGRAPixel; + function GetAmbiantColorF: TColorF; + function GetAmbiantColorInt: TColorInt65536; + function GetDiffuseAlpha: byte; + function GetDiffuseColor: TBGRAPixel; + function GetDiffuseColorF: TColorF; + function GetDiffuseColorInt: TColorInt65536; + function GetLightThroughFactor: single; + function GetSpecularColor: TBGRAPixel; + function GetSpecularColorF: TColorF; + function GetSpecularColorInt: TColorInt65536; + function GetSpecularIndex: integer; + function GetSaturationHigh: single; + function GetSaturationLow: single; + function GetSimpleAlpha: byte; + function GetSimpleColor: TBGRAPixel; + function GetSimpleColorF: TColorF; + function GetSimpleColorInt: TColorInt65536; + function GetTextureZoom: TPointF; + function GetSpecularOn: boolean; + function GetAsObject: TObject; + function GetName: string; + + procedure SetAutoAmbiantColor(const AValue: boolean); + procedure SetAutoDiffuseColor(const AValue: boolean); + procedure SetAutoSpecularColor(const AValue: boolean); + procedure SetAmbiantAlpha(AValue: byte); + procedure SetAmbiantColor(const AValue: TBGRAPixel); + procedure SetAmbiantColorF(const AValue: TColorF); + procedure SetAmbiantColorInt(const AValue: TColorInt65536); + procedure SetDiffuseAlpha(AValue: byte); + procedure SetDiffuseColor(const AValue: TBGRAPixel); + procedure SetDiffuseColorF(const AValue: TColorF); + procedure SetDiffuseColorInt(const AValue: TColorInt65536); + procedure SetLightThroughFactor(const AValue: single); + procedure SetSpecularColor(const AValue: TBGRAPixel); + procedure SetSpecularColorF(const AValue: TColorF); + procedure SetSpecularColorInt(const AValue: TColorInt65536); + procedure SetSpecularIndex(const AValue: integer); virtual; + procedure SetSaturationHigh(const AValue: single); + procedure SetSaturationLow(const AValue: single); + procedure SetSimpleAlpha(AValue: byte); + procedure SetSimpleColor(AValue: TBGRAPixel); + procedure SetSimpleColorF(AValue: TColorF); + procedure SetSimpleColorInt(AValue: TColorInt65536); + procedure SetTextureZoom(AValue: TPointF); + procedure SetName(const AValue: string); + + function GetTexture: IBGRAScanner; + procedure SetTexture(AValue: IBGRAScanner); + + procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536); + procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536); + procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer); + + property OnTextureChanged: TBGRAMaterialTextureChangedEvent read FOnTextureChanged write FOnTextureChanged; + + end; + + TFaceRenderingDescription = record + NormalsMode: TLightingNormal3D; + + Material: TBGRAMaterial3D; + Texture: IBGRAScanner; + LightThroughFactor: single; + Biface: boolean; + + NbVertices: Integer; + Projections: array of TPointF; + Colors: array of TBGRAPixel; + Positions3D, Normals3D: array of TPoint3D_128; + TexCoords: array of TPointF; + end; + + { TCustomRenderer3D } + + TCustomRenderer3D = class + private + FProjection: TProjection3D; + FProjectionDefined: boolean; + function GetProjectionDefined: boolean; + protected + function GetGlobalScale: single; virtual; abstract; + function GetHasZBuffer: boolean; virtual; abstract; + function GetHandlesNearClipping: boolean; virtual; abstract; + function GetHandlesFaceCulling: boolean; virtual; abstract; + function GetSurfaceWidth: integer; virtual; abstract; + function GetSurfaceHeight: integer; virtual; abstract; + procedure SetProjection(const AValue: TProjection3D); virtual; + public + function RenderFace(var ADescription: TFaceRenderingDescription; + AComputeCoordinate: TComputeProjectionFunc): boolean; virtual; abstract; + property GlobalScale: single read GetGlobalScale; + property HasZBuffer: boolean read GetHasZBuffer; + property SurfaceWidth: integer read GetSurfaceWidth; + property SurfaceHeight: integer read GetSurfaceHeight; + property Projection: TProjection3D read FProjection write SetProjection; + property ProjectionDefined: boolean read GetProjectionDefined; + property HandlesNearClipping: boolean read GetHandlesNearClipping; + property HandlesFaceCulling: boolean read GetHandlesFaceCulling; + end; + + { TBGRALight3D } + + TBGRALight3D = class(TInterfacedObject,IBGRALight3D) + protected + FMinIntensity: single; + FColorInt: TColorInt65536; + FViewVector : TPoint3D_128; + FLightness: integer; + public + constructor Create; + destructor Destroy; override; + procedure ReleaseInterface; + + procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract; + procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract; + procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract; + + function GetLightnessF: single; + function GetColor: TBGRAPixel; + function GetColorF: TColorF; + function GetColorInt: TColorInt65536; + function GetAsObject: TObject; + procedure SetColor(const AValue: TBGRAPixel); + procedure SetColorF(const AValue: TColorF); + procedure SetColorInt(const AValue: TColorInt65536); + function GetColoredLight: boolean; + + function GetMinIntensity: single; + procedure SetMinIntensity(const AValue: single); + function IsDirectional: boolean; virtual; abstract; + + function GetIntensity: single; virtual; + function GetPosition: TPoint3D; virtual; + function GetDirection: TPoint3D; virtual; + end; + +implementation + +{ TCustomRenderer3D } + +function TCustomRenderer3D.GetProjectionDefined: boolean; +begin + result := FProjectionDefined; +end; + +{$PUSH}{$OPTIMIZATION OFF} // avoids internal error 2012090607 +procedure TCustomRenderer3D.SetProjection(const AValue: TProjection3D); +begin + FProjection := AValue; + FProjectionDefined := true; +end; +{$POP} + +{ TBGRAMaterial3D } + +procedure TBGRAMaterial3D.UpdateSpecular; +begin + FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536); + FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or + FAutoSpecularColor); +end; + +procedure TBGRAMaterial3D.UpdateSimpleColor; +begin + FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768; + FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536); +end; + +procedure TBGRAMaterial3D.ComputePowerTable; +var i: integer; + Exponent: single; +begin + //exponent computed by squares + Exponent := 1; + FPowerTableExp2 := 0; + While Exponent*FPowerTableSize/16 < FSpecularIndex do + begin + Exponent := Exponent * 2; + Inc(FPowerTableExp2); + end; + + //remaining exponent + setlength(FPowerTable,FPowerTableSize+3); + FPowerTable[0] := 0; //out of bound + FPowerTable[1] := 0; //image of zero + for i := 1 to FPowerTableSize do // ]0;1] + FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent); + FPowerTable[FPowerTableSize+2] := 1; //out of bound +end; + +constructor TBGRAMaterial3D.Create; +begin + SetAmbiantColorInt(ColorInt65536(65536,65536,65536)); + SetDiffuseColorInt(ColorInt65536(65536,65536,65536)); + FSpecularIndex := 10; + SetSpecularColorInt(ColorInt65536(0,0,0)); + FLightThroughFactor:= 0; + SetSaturationLow(2); + SetSaturationHigh(3); + + FTexture := nil; + FTextureZoom := PointF(1,1); + + FPowerTableSize := 128; + FPowerTableSizeF := FPowerTableSize; + FPowerTable := nil; +end; + +destructor TBGRAMaterial3D.Destroy; +begin + inherited Destroy; +end; + +function TBGRAMaterial3D.GetAutoAmbiantColor: boolean; +begin + result := FAutoAmbiantColor; +end; + +procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte); +begin + if AValue = 0 then + FDiffuseColorInt.a := 0 + else + FDiffuseColorInt.a := AValue*257+1; + UpdateSimpleColor; +end; + +function TBGRAMaterial3D.GetAutoDiffuseColor: boolean; +begin + result := FAutoDiffuseColor; +end; + +function TBGRAMaterial3D.GetAutoSpecularColor: boolean; +begin + result := FAutoSpecularColor; +end; + +function TBGRAMaterial3D.GetAutoSimpleColor: boolean; +begin + result := FAutoSimpleColor; +end; + +function TBGRAMaterial3D.GetAmbiantAlpha: byte; +var v: integer; +begin + if FAmbiantColorInt.a < 128 then + result := 0 + else + begin + v := (FAmbiantColorInt.a-128) shr 8; + if v > 255 then v := 255; + result := v; + end; +end; + +function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel; +begin + result := ColorIntToBGRA(FAmbiantColorInt,True); +end; + +function TBGRAMaterial3D.GetAmbiantColorF: TColorF; +begin + result := ColorInt65536ToColorF(FAmbiantColorInt); +end; + +function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536; +begin + result := FAmbiantColorInt; +end; + +function TBGRAMaterial3D.GetDiffuseAlpha: byte; +var v: integer; +begin + if FDiffuseColorInt.a < 128 then + result := 0 + else + begin + v := (FDiffuseColorInt.a-128) shr 8; + if v > 255 then v := 255; + result := v; + end; +end; + +function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel; +begin + result := ColorIntToBGRA(FDiffuseColorInt,True); +end; + +function TBGRAMaterial3D.GetDiffuseColorF: TColorF; +begin + result := ColorInt65536ToColorF(FDiffuseColorInt); +end; + +function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536; +begin + result := FDiffuseColorInt; +end; + +function TBGRAMaterial3D.GetLightThroughFactor: single; +begin + result := FLightThroughFactor; +end; + +function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel; +begin + result := ColorIntToBGRA(FSpecularColorInt,True); +end; + +function TBGRAMaterial3D.GetSpecularColorF: TColorF; +begin + result := ColorInt65536ToColorF(FSpecularColorInt); +end; + +function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536; +begin + result := FSpecularColorInt; +end; + +function TBGRAMaterial3D.GetSpecularIndex: integer; +begin + result := FSpecularIndex; +end; + +function TBGRAMaterial3D.GetSaturationHigh: single; +begin + result := FSaturationHighF; +end; + +function TBGRAMaterial3D.GetSaturationLow: single; +begin + result := FSaturationLowF; +end; + +function TBGRAMaterial3D.GetSimpleAlpha: byte; +begin + result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1; +end; + +function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel; +begin + result := ColorIntToBGRA(GetSimpleColorInt,True); +end; + +function TBGRAMaterial3D.GetSimpleColorF: TColorF; +begin + result := ColorInt65536ToColorF(GetSimpleColorInt); +end; + +function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536; +begin + result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768; +end; + +function TBGRAMaterial3D.GetTexture: IBGRAScanner; +begin + result := FTexture; +end; + +function TBGRAMaterial3D.GetTextureZoom: TPointF; +begin + result := FTextureZoom; +end; + +procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean); +begin + If AValue then + SetAmbiantColorInt(ColorInt65536(65536,65536,65536)); +end; + +procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean); +begin + If AValue then + SetDiffuseColorInt(ColorInt65536(65536,65536,65536)); +end; + +procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean); +begin + If AValue then + SetSpecularColorInt(ColorInt65536(65536,65536,65536)); +end; + +procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte); +begin + if AValue = 0 then + FAmbiantColorInt.a := 0 + else + FAmbiantColorInt.a := AValue*257+1; + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel); +begin + FAmbiantColorInt := BGRAToColorInt(AValue,True); + FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF); +begin + FAmbiantColorInt := ColorFToColorInt65536(AValue); + FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536); +begin + FAmbiantColorInt := AValue; + FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel); +begin + FDiffuseColorInt := BGRAToColorInt(AValue,True); + FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; + FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF); +begin + FDiffuseColorInt := ColorFToColorInt65536(AValue); + FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; + FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536); +begin + FDiffuseColorInt := AValue; + FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; + FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); + UpdateSimpleColor; +end; + +procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single); +begin + FLightThroughFactor:= AValue; +end; + +procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel); +begin + FSpecularColorInt := BGRAToColorInt(AValue,True); + UpdateSpecular; +end; + +procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF); +begin + FSpecularColorInt := ColorFToColorInt65536(AValue); + UpdateSpecular; +end; + +procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536); +begin + FSpecularColorInt := AValue; + UpdateSpecular; +end; + +procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer); +begin + FSpecularIndex := AValue; + UpdateSpecular; + + FPowerTable := nil; +end; + +procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single); +begin + FSaturationHighF:= AValue; +end; + +procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single); +begin + FSaturationLowF:= AValue; +end; + +procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte); +begin + SetAmbiantAlpha(AValue); + SetDiffuseAlpha(AValue); +end; + +procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel); +begin + SetAmbiantColor(AValue); + SetDiffuseColor(AValue); +end; + +procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF); +begin + SetAmbiantColorF(AValue); + SetDiffuseColorF(AValue); +end; + +procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536); +begin + SetAmbiantColorInt(AValue); + SetDiffuseColorInt(AValue); +end; + +procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner); +begin + If AValue <> FTexture then + begin + FTexture := AValue; + if Assigned(FOnTextureChanged) then + FOnTextureChanged(self); + end; +end; + +procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF); +begin + if AValue <> FTextureZoom then + begin + FTextureZoom := AValue; + if Assigned(FOnTextureChanged) then + FOnTextureChanged(self); + end; +end; + +function TBGRAMaterial3D.GetName: string; +begin + result := FName; +end; + +procedure TBGRAMaterial3D.SetName(const AValue: string); +begin + FName := AValue; +end; + +function TBGRAMaterial3D.GetSpecularOn: boolean; +begin + result := FSpecularOn; +end; + +function TBGRAMaterial3D.GetAsObject: TObject; +begin + result := self; +end; + +procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536); +var + NH,PowerTablePos: single; //keep first for asm + + NnH: single; + PowerTableFPos: single; + PowerTableIPos,i: Int32or64; +begin + if SpecularCosine <= 0 then + NnH := 0 + else + if SpecularCosine >= 1 then + NnH := 1 else + begin + NH := SpecularCosine; + if FPowerTable = nil then ComputePowerTable; + {$IFDEF CPUI386} {$asmmode intel} + i := FPowerTableExp2; + if i > 0 then + begin + PowerTablePos := FPowerTableSize; + asm + db $d9,$45,$f0 //flds NH + mov ecx,i + @loop: + db $dc,$c8 //fmul st,st(0) + dec ecx + jnz @loop + db $d8,$4d,$ec //fmuls PowerTablePos + db $d9,$5d,$ec //fstps PowerTablePos + end; + end + else + PowerTablePos := NH*FPowerTableSize; + {$ELSE} + PowerTablePos := NH; + for i := FPowerTableExp2-1 downto 0 do + PowerTablePos := PowerTablePos*PowerTablePos; + PowerTablePos := PowerTablePos * FPowerTableSize; + {$ENDIF} + PowerTableIPos := round(PowerTablePos+0.5); + PowerTableFPos := PowerTablePos-PowerTableIPos; + NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos; + end; //faster than NnH := exp(FSpecularIndex*ln(NH)); ! + + if FAutoDiffuseColor then + Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536) + else + Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536); + + if FAutoSpecularColor then + Context^.specularColor := Context^.specularColor + ALightColor*round(SpecularIntensity* NnH*65536) + else + Context^.specularColor := Context^.specularColor + ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536); +end; + +procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext; + const DiffuseIntensity: single; const ALightColor: TColorInt65536); +begin + if FAutoDiffuseColor then + Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536) + else + Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536); +end; + +procedure TBGRAMaterial3D.ComputeDiffuseLightness( + Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer); +begin + if FAutoDiffuseColor then + begin + if ALightLightness <> 32768 then + inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) ) + else + inc(Context^.lightness, DiffuseLightnessTerm32768 ); + end else + begin + if FDiffuseLightness <> 32768 then + inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness)) ) + else + inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) ); + end; +end; + +{ TBGRALight3D } + +constructor TBGRALight3D.Create; +begin + SetColorF(ColorF(1,1,1,1)); + FViewVector := Point3D_128(0,0,-1); + FMinIntensity:= 0; +end; + +destructor TBGRALight3D.Destroy; +begin + inherited Destroy; +end; + +procedure TBGRALight3D.ReleaseInterface; +begin + _Release; +end; + +function TBGRALight3D.GetLightnessF: single; +begin + result := FLightness/32768; +end; + +function TBGRALight3D.GetColor: TBGRAPixel; +begin + result := ColorIntToBGRA(FColorInt,True); +end; + +function TBGRALight3D.GetColorF: TColorF; +begin + result := ColorInt65536ToColorF(FColorInt); +end; + +function TBGRALight3D.GetColorInt: TColorInt65536; +begin + result := FColorInt; +end; + +function TBGRALight3D.GetAsObject: TObject; +begin + result := self; +end; + +procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel); +begin + SetColorInt(BGRAToColorInt(AValue,True)); +end; + +procedure TBGRALight3D.SetColorF(const AValue: TColorF); +begin + SetColorInt(ColorFToColorInt65536(AValue)); +end; + +procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536); +begin + FColorInt := AValue; + FLightness:= (AValue.r+AValue.g+AValue.b) div 6; +end; + +function TBGRALight3D.GetColoredLight: boolean; +begin + result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b); +end; + +function TBGRALight3D.GetMinIntensity: single; +begin + result := FMinIntensity; +end; + +procedure TBGRALight3D.SetMinIntensity(const AValue: single); +begin + FMinIntensity := AValue; +end; + +function TBGRALight3D.GetIntensity: single; +begin + result := 1; +end; + +function TBGRALight3D.GetPosition: TPoint3D; +begin + result := Point3D(0,0,0); +end; + +function TBGRALight3D.GetDirection: TPoint3D; +begin + result := Point3D(0,0,0); +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraslicescaling.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraslicescaling.pas new file mode 100644 index 0000000..3884b0c --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraslicescaling.pas @@ -0,0 +1,778 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASliceScaling; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, IniFiles; + +type + TMargins = record + top, right, bottom, left: integer; + end; + TSlicePosition = (spTopLeft, spTop, spTopRight, spLeft, spMiddle, spRight, + spBottomLeft, spBottom, spBottomRight); + TSliceBitmapArray = array[TSlicePosition] of TBGRABitmap; + TSliceRectArray = array[TSlicePosition] of TRect; + TSliceRepeatPosition = (srpTop, srpLeft, srpMiddleHorizontal, + srpMiddleVertical, srpRight, srpBottom); + TSliceRepeatArray = array[TSliceRepeatPosition] of boolean; + +const + SliceRepeatPositionStr : array[TSliceRepeatPosition] of string = + ('Top','Left','MiddleHorizontal','MiddleVertical','Right','Bottom'); + +function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins; + +type + + { TBGRASliceScaling } + + TBGRASliceScaling = class + private + FSliceRectArray: TSliceRectArray; + FSliceBitmapArray: TSliceBitmapArray; + FSliceRepeat: TSliceRepeatArray; + FBitmap: TBGRABitmap; + FBitmapOwned: boolean; + FBitmapSourceRect: TRect; + FMargins: TMargins; + FDrawMode: TDrawMode; + FResampleMode: TResampleMode; + FResampleFilter: TResampleFilter; + function GetBitmapHeight: integer; + function GetBitmapWidth: integer; + function GetSlice(APosition: TSlicePosition): TBGRABitmap; + function GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean; + function GetSliceRepeatAsString: string; + procedure SetBitmap(AValue: TBGRABitmap); + procedure SetBitmapSourceRect(AValue: TRect); + procedure SetDrawMode(AValue: TDrawMode); + procedure SetResampleFilter(AValue: TResampleFilter); + procedure SetResampleMode(AValue: TResampleMode); + procedure SetSliceRepeat(Aposition: TSliceRepeatPosition; AValue: boolean); + procedure SetSliceRepeatAsString(AValue: string); + protected + // Stuff + procedure UpdateSliceRectArray; + function ComputeSliceRectArray(ARect: TRect): TSliceRectArray; + procedure SliceScalingDraw(ADest: TBGRABitmap; ADestRect: TRect; + DrawGrid: boolean = False); + procedure Init; + procedure ClearBitmapArray; + public + // Create an instance and stores the bitmap, either as a reference to a TBGRABitmap from the caller, + // or as a local owned copy in other cases + constructor Create(ABitmap: TBGRABitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); overload; + constructor Create(ABitmap: TBitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; + constructor Create(AFilename: string; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; + constructor Create(AFilename: string; AIsUtf8: boolean; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; + constructor Create(AStream: TStream; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; + constructor Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); overload; + constructor Create(ABitmap: TBitmap); overload; + constructor Create(AFilename: string); overload; + constructor Create(AFilename: string; AIsUtf8: boolean); overload; + constructor Create(AStream: TStream); overload; + constructor Create; overload; + procedure SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; + procedure SetMargins(AMargins: TMargins); overload; + destructor Destroy; override; + public + procedure NotifyBitmapChanged; //to notify the source bitmap has changed + //so new bitmaps should be used + // Draw + procedure Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean = False); overload; + procedure Draw(ABitmap: TBGRABitmap; ALeft, ATop, AWidth, AHeight: integer; + DrawGrid: boolean = False); overload; + procedure AutodetectRepeat; + public + // Property + property DrawMode: TDrawMode read FDrawMode write SetDrawMode; + property ResampleMode: TResampleMode read FResampleMode write SetResampleMode; + property ResampleFilter: TResampleFilter read FResampleFilter + write SetResampleFilter; + property BitmapWidth: integer read GetBitmapWidth; + property BitmapHeight: integer read GetBitmapHeight; + property BitmapSource: TBGRABitmap read FBitmap write SetBitmap; + property BitmapSourceRect: TRect read FBitmapSourceRect write SetBitmapSourceRect; + property Margins: TMargins read FMargins write SetMargins; + property SliceBitmap[APosition: TSlicePosition]: TBGRABitmap read GetSlice; + property SliceRepeat[Aposition: TSliceRepeatPosition]: boolean + read GetSliceRepeat write SetSliceRepeat; + property SliceRepeatAsString: string read GetSliceRepeatAsString write SetSliceRepeatAsString; + end; + + TSliceScalingArray = array of TBGRASliceScaling; + TSliceScalingDirection = (sdHorizontal, sdVertical); + TBGRABitmapArray = array of TBGRABitmap; + + { TBGRAMultiSliceScaling } + + TBGRAMultiSliceScaling = class + private + FSliceScalingArray: TSliceScalingArray; + FBitmapOwned: boolean; + FBitmap: TBGRABitmap; + function GetCount: integer; + procedure SetFSliceScalingArray(AValue: TSliceScalingArray); + public + constructor Create(ABitmap: TBGRABitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); overload; + constructor Create(ABitmap: TBitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); overload; + constructor Create(ABitmapFilename: string; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); overload; + constructor Create(ABitmapFilename: string; AIsUtf8: boolean; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); overload; + constructor Create(AStream: TStream; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); overload; + destructor Destroy; override; + constructor Create(AIniFilename, ASection: string; AIsUtf8Filename: boolean= false); overload; + public + procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap; + ARect: TRect; DrawGrid: boolean = False); overload; + procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap; + ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean = False); overload; + public + property Count: integer read GetCount; + property SliceScalingArray: TSliceScalingArray + read FSliceScalingArray write SetFSliceScalingArray; + end; + +implementation + +uses BGRAUTF8; + +function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins; +begin + Result.top := atop; + Result.right := aright; + Result.bottom := abottom; + Result.left := aleft; +end; + +{ TBGRAMultiSliceScaling } + +procedure TBGRAMultiSliceScaling.SetFSliceScalingArray(AValue: TSliceScalingArray); +begin + if FSliceScalingArray = AValue then + Exit; + FSliceScalingArray := AValue; +end; + +function TBGRAMultiSliceScaling.GetCount: integer; +begin + result := length(FSliceScalingArray); +end; + +constructor TBGRAMultiSliceScaling.Create(ABitmap: TBGRABitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); +var + i: integer; + ItemWidth,ItemHeight,ItemStepX,ItemStepY: integer; +begin + FBitmap := ABitmap; + FBitmapOwned := ABitmapOwner; + ItemWidth := ABitmap.Width; + ItemHeight := ABitmap.Height; + ItemStepX := 0; + ItemStepY := 0; + case Direction of + sdVertical: begin + ItemHeight:= ABitmap.Height div NumberOfItems; + ItemStepY := ItemHeight; + end; + sdHorizontal: + begin + ItemWidth:= ABitmap.Width div NumberOfItems; + ItemStepX := ItemWidth; + end; + end; + + SetLength(FSliceScalingArray, NumberOfItems); + for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do + begin + FSliceScalingArray[i] := TBGRASliceScaling.Create(ABitmap, + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); + FSliceScalingArray[i].BitmapSourceRect := rect(ItemStepX*i,ItemStepY*i,ItemStepX*i+ItemWidth,ItemStepY*i+ItemHeight); + end; +end; + +constructor TBGRAMultiSliceScaling.Create(ABitmap: TBitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); +begin + Create(TBGRABitmap.Create(ABitmap), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, + NumberOfItems, Direction, True); +end; + +constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); +begin + Create(TBGRABitmap.Create(ABitmapFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, + NumberOfItems, Direction, True); +end; + +constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; AIsUtf8: boolean; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); +begin + Create(TBGRABitmap.Create(ABitmapFilename,AIsUtf8), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, + NumberOfItems, Direction, True); +end; + +constructor TBGRAMultiSliceScaling.Create(AStream: TStream; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; + Direction: TSliceScalingDirection); +begin + Create(TBGRABitmap.Create(AStream), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, + NumberOfItems, Direction, True); +end; + +destructor TBGRAMultiSliceScaling.Destroy; +var + i: integer; +begin + for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do + FSliceScalingArray[i].Free; + if FBitmapOwned then FBitmap.Free; + + inherited Destroy; +end; + +constructor TBGRAMultiSliceScaling.Create(AIniFilename, ASection: string; + AIsUtf8Filename: boolean); +var + i: integer; + temp: TMemIniFile; + Direction: TSliceScalingDirection; + defaultRepeat: string; + IniPathUTF8,BitmapFilename: string; +begin + if AIsUtf8Filename then + begin + if not FileExistsUTF8(AIniFilename) then exit; + temp := TMemIniFile.Create(UTF8ToSys(AIniFilename)); + IniPathUTF8 := ExtractFilePath(AIniFilename); + end else + begin + if not FileExists(AIniFilename) then exit; + temp := TMemIniFile.Create(AIniFilename); + IniPathUTF8 := SysToUTF8(ExtractFilePath(AIniFilename)); + end; + + if temp.ReadBool(ASection, 'HorizontalDirection', False) then + Direction := sdHorizontal + else + Direction := sdVertical; + + BitmapFilename := temp.ReadString(ASection, 'Bitmap', ''); + if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then + BitmapFilename := IniPathUTF8+SysToUTF8(copy(BitmapFilename,3,Length(BitmapFilename)-2)); + Create( + BitmapFilename,True, + temp.ReadInteger(ASection, 'MarginTop', 0), + temp.ReadInteger(ASection, 'MarginRight', 0), + temp.ReadInteger(ASection, 'MarginBottom', 0), + temp.ReadInteger(ASection, 'MarginLeft', 0), + temp.ReadInteger(ASection, 'NumberOfItems', 1), + Direction); + + defaultRepeat := temp.ReadString(ASection, 'Repeat', 'Auto'); + for i := 0 to High(FSliceScalingArray) do + FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(ASection, 'Repeat'+IntToStr(i+1), defaultRepeat); + + temp.Free; +end; + +procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap; + ARect: TRect; DrawGrid: boolean); +begin + if (ItemNumber < 0) or (ItemNumber >= Count) then exit; + FSliceScalingArray[ItemNumber].Draw(ABitmap, ARect, DrawGrid); +end; + +procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap; + ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean); +begin + if (ItemNumber < 0) or (ItemNumber >= Count) then exit; + FSliceScalingArray[ItemNumber].Draw(ABitmap, ALeft, ATop, AWidth, AHeight, DrawGrid); +end; + +{ TBGRASliceScaling } + +procedure TBGRASliceScaling.SetDrawMode(AValue: TDrawMode); +begin + if FDrawMode = AValue then + Exit; + FDrawMode := AValue; +end; + +procedure TBGRASliceScaling.SetBitmap(AValue: TBGRABitmap); +begin + if FBitmap = AValue then + Exit; + if FBitmapOwned then + FBitmap.Free; + FBitmap := AValue; + FBitmapOwned := False; + UpdateSliceRectArray; +end; + +procedure TBGRASliceScaling.SetBitmapSourceRect(AValue: TRect); +begin + if (FBitmapSourceRect.Left=AValue.Left) and + (FBitmapSourceRect.Right=AValue.Right) and + (FBitmapSourceRect.Top=AValue.Top) and + (FBitmapSourceRect.Bottom=AValue.Bottom) then Exit; + FBitmapSourceRect:=AValue; + UpdateSliceRectArray; +end; + +function TBGRASliceScaling.GetSlice(APosition: TSlicePosition): TBGRABitmap; +begin + if FSliceBitmapArray[APosition] = nil then + with FSliceRectArray[APosition] do + begin + FSliceBitmapArray[APosition] := TBGRABitmap.Create(right - left, bottom - top); + FSliceBitmapArray[APosition].PutImage(-left, -top, FBitmap, dmSet); + end; + Result := FSliceBitmapArray[APosition]; +end; + +function TBGRASliceScaling.GetBitmapHeight: integer; +begin + result := FBitmapSourceRect.Bottom - FBitmapSourceRect.Top; +end; + +function TBGRASliceScaling.GetBitmapWidth: integer; +begin + result := FBitmapSourceRect.Right - FBitmapSourceRect.Left; +end; + +function TBGRASliceScaling.GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean; +begin + Result := FSliceRepeat[Aposition]; +end; + +function TBGRASliceScaling.GetSliceRepeatAsString: string; +var p: TSliceRepeatPosition; +begin + result := ''; + for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do + if SliceRepeat[p] then + begin + if result <> '' then AppendStr(result, '+'); + AppendStr(result, SliceRepeatPositionStr[p]); + end; +end; + +procedure TBGRASliceScaling.SetResampleFilter(AValue: TResampleFilter); +begin + if FResampleFilter = AValue then + Exit; + FResampleFilter := AValue; +end; + +procedure TBGRASliceScaling.SetResampleMode(AValue: TResampleMode); +begin + if FResampleMode = AValue then + Exit; + FResampleMode := AValue; +end; + +procedure TBGRASliceScaling.SetSliceRepeat(Aposition: TSliceRepeatPosition; + AValue: boolean); +begin + FSliceRepeat[Aposition] := AValue; +end; + +procedure TBGRASliceScaling.SetSliceRepeatAsString(AValue: string); +var p: TSliceRepeatPosition; + attr: string; + idx: integer; +begin + AValue := trim(AValue); + if compareText(AValue,'All')=0 then + begin + for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do + SliceRepeat[p] := true; + exit; + end; + for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do + SliceRepeat[p] := false; + if compareText(AValue,'None')=0 then exit; + + while AValue <> '' do + begin + idx := pos('+',AValue); + if idx <> 0 then + begin + attr := copy(AValue,1,idx-1); + delete(AValue,1,idx); + end else + begin + attr := AValue; + AValue := ''; + end; + for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do + if CompareText(SliceRepeatPositionStr[p],attr)=0 then + begin + SliceRepeat[p] := true; + attr := ''; + break; + end; + if compareText(attr,'Auto')=0 then AutodetectRepeat else + if attr <> '' then + raise exception.Create('Unknown slice repeat attribute ('+attr+')'); + end; +end; + +procedure TBGRASliceScaling.UpdateSliceRectArray; +begin + ClearBitmapArray; + if FBitmap = nil then exit; + FSliceRectArray := ComputeSliceRectArray(FBitmapSourceRect); +end; + +function TBGRASliceScaling.ComputeSliceRectArray(ARect: TRect): TSliceRectArray; +var + Width, Height: integer; + pos: TSlicePosition; + lMargins: TMargins; + ratio: single; +begin + Width := ARect.Right - ARect.Left; + Height := ARect.Bottom - ARect.Top; + if (Width <= 0) or (Height <= 0) then + raise Exception.Create('Empty rectangle'); + + lMargins := FMargins; + if lMargins.top < 0 then + lMargins.top := 0; + if lMargins.right < 0 then + lMargins.right := 0; + if lMargins.bottom < 0 then + lMargins.bottom := 0; + if lMargins.left < 0 then + lMargins.left := 0; + if lmargins.left + lMargins.right >= Width then + begin + ratio := Width / (lmargins.left + lMargins.right + 1); + lMargins.left := trunc(lMargins.left * ratio); + lMargins.right := trunc(lMargins.right * ratio); + end; + if lmargins.top + lMargins.bottom >= Height then + begin + ratio := Height / (lmargins.top + lMargins.bottom + 1); + lMargins.top := trunc(lMargins.top * ratio); + lMargins.bottom := trunc(lMargins.bottom * ratio); + end; + with lMargins do + begin + Result[spTopLeft] := rect(0, 0, Left, Top); + Result[spTop] := rect(Left, 0, Width - Right, Top); + Result[spTopRight] := rect(Width - Right, 0, Width, Top); + Result[spLeft] := rect(0, Top, Left, Height - Bottom); + Result[spMiddle] := rect(Left, Top, Width - Right, Height - Bottom); + Result[spRight] := rect(Width - Right, Top, Width, Height - Bottom); + Result[spBottomLeft] := rect(0, Height - Bottom, Left, Height); + Result[spBottom] := rect(Left, Height - Bottom, Width - Right, Height); + Result[spBottomRight] := rect(Width - Right, Height - Bottom, Width, Height); + end; + for pos := low(TSlicePosition) to high(TSlicePosition) do + Result[pos].Offset(ARect.Left, ARect.Top); +end; + +procedure TBGRASliceScaling.SliceScalingDraw(ADest: TBGRABitmap; + ADestRect: TRect; DrawGrid: boolean); +var + pos: TSlicePosition; + tempBGRA: TBGRABitmap; + DestSliceRect: TSliceRectArray; + repeatSlice: boolean; +begin + if (ADestRect.Right <= ADestRect.Left) or (ADestRect.Bottom <= ADestRect.Top) then + exit; + DestSliceRect := ComputeSliceRectArray(ADestRect); + for pos := Low(TSlicePosition) to High(TSlicePosition) do + begin + with DestSliceRect[pos] do + begin + if (right > left) and (bottom > top) then + begin + case pos of + spTop: repeatSlice := SliceRepeat[srpTop]; + spRight: repeatSlice := SliceRepeat[srpRight]; + spBottom: repeatSlice := SliceRepeat[srpBottom]; + spLeft: repeatSlice := SliceRepeat[srpLeft]; + spMiddle: repeatSlice := + SliceRepeat[srpMiddleHorizontal] and SliceRepeat[srpMiddleVertical]; + else + repeatSlice := False; + end; + //simple copy + if (right - left = FSliceRectArray[pos].right - FSliceRectArray[pos].left) and + (bottom - top = FSliceRectArray[pos].bottom - FSliceRectArray[pos].top) then + begin + FBitmap.ScanOffset := + point(FSliceRectArray[pos].left - left, FSliceRectArray[pos].top - top); + ADest.FillRect(left, top, right, bottom, FBitmap, FDrawMode); + end + else + //repeat in both direction + if repeatSlice then + begin + tempBGRA := SliceBitmap[pos]; + tempBGRA.ScanOffset := point(-left, -top); + ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode); + end + else + //resample in both directions (or in one direction if the other direction has the same size) + if (pos <> spMiddle) or (not SliceRepeat[srpMiddleHorizontal] and + not SliceRepeat[srpMiddleVertical]) then + begin + SliceBitmap[pos].ResampleFilter := ResampleFilter; + tempBGRA := SliceBitmap[pos].Resample(right - left, bottom - top, FResampleMode); + ADest.PutImage(left, top, tempBGRA, FDrawMode); + tempBGRA.Free; + end + else //one dimension resample, other dimension resample + begin + SliceBitmap[pos].ResampleFilter := ResampleFilter; + if not SliceRepeat[srpMiddleHorizontal] then + tempBGRA := SliceBitmap[pos].Resample( + right - left, SliceBitmap[pos].Height, FResampleMode) + else + tempBGRA := SliceBitmap[pos].Resample( + SliceBitmap[pos].Width, bottom - top, FResampleMode); + tempBGRA.ScanOffset := point(-left, -top); + ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode); + tempBGRA.Free; + end; + end; + end; + end; + if DrawGrid then + begin + ADest.DrawLineAntialias(DestSliceRect[spTop].left, DestSliceRect[spTop].top, + DestSliceRect[spBottom].left, DestSliceRect[spBottom].bottom, + BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); + ADest.DrawLineAntialias(DestSliceRect[spTop].right - 1, DestSliceRect[spTop].top, + DestSliceRect[spBottom].right - 1, DestSliceRect[spBottom].bottom, + BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); + ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].top, + DestSliceRect[spRight].right, DestSliceRect[spRight].top, + BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); + ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].bottom - 1, + DestSliceRect[spRight].right, DestSliceRect[spRight].bottom - 1, + BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); + end; +end; + +procedure TBGRASliceScaling.Init; +var + pos: TSliceRepeatPosition; +begin + FBitmap := nil; + FBitmapOwned := False; + for pos := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do + FSliceRepeat[pos] := False; + SetMargins(0, 0, 0, 0); + FBitmapSourceRect := rect(0,0,0,0); + DrawMode := dmDrawWithTransparency; + ResampleMode := rmFineResample; + ResampleFilter := rfHalfCosine; +end; + +procedure TBGRASliceScaling.ClearBitmapArray; +var + pos: TSlicePosition; +begin + for pos := low(TSlicePosition) to high(TSlicePosition) do + FreeAndNil(FSliceBitmapArray[pos]); +end; + +constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); +begin + Create(ABitmap, ABitmapOwner); + SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); +end; + +constructor TBGRASliceScaling.Create(ABitmap: TBitmap; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); +begin + Create(ABitmap); + SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); +end; + +constructor TBGRASliceScaling.Create(AFilename: string; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); +begin + Create(AFilename); + SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); +end; + +constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); +begin + Create(AFilename, AIsUtf8); + SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); +end; + +constructor TBGRASliceScaling.Create(AStream: TStream; + AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); +begin + Create(AStream); + SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); +end; + +constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); +begin + Init; + FBitmap := ABitmap; + FBitmapOwned := ABitmapOwner; + FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); +end; + +constructor TBGRASliceScaling.Create(ABitmap: TBitmap); +begin + Init; + FBitmap := TBGRABitmap.Create(ABitmap); + FBitmapOwned := True; + FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); +end; + +constructor TBGRASliceScaling.Create(AFilename: string); +begin + Init; + FBitmap := TBGRABitmap.Create(AFilename); + FBitmapOwned := True; + FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); +end; + +constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean); +begin + Init; + FBitmap := TBGRABitmap.Create(AFilename,AIsUtf8); + FBitmapOwned := True; + FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); +end; + +constructor TBGRASliceScaling.Create(AStream: TStream); +begin + Init; + FBitmap := TBGRABitmap.Create(AStream); + FBitmapOwned := True; + FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); +end; + +constructor TBGRASliceScaling.Create; +begin + Init; +end; + +procedure TBGRASliceScaling.SetMargins(AMarginTop, AMarginRight, + AMarginBottom, AMarginLeft: integer); +begin + SetMargins(BGRASliceScaling.Margins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft)); +end; + +procedure TBGRASliceScaling.SetMargins(AMargins: TMargins); +begin + if (AMargins.top <> FMargins.top) or (AMargins.right <> FMargins.right) or + (AMargins.bottom <> FMargins.bottom) or (AMargins.left <> FMargins.left) then + begin + FMargins := AMargins; + UpdateSliceRectArray; + end; +end; + +destructor TBGRASliceScaling.Destroy; +begin + ClearBitmapArray; + if FBitmapOwned then + FreeAndNil(FBitmap); + inherited Destroy; +end; + +procedure TBGRASliceScaling.NotifyBitmapChanged; +begin + ClearBitmapArray; +end; + +procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean); +begin + SliceScalingDraw(ABitmap, ARect, DrawGrid); +end; + +procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; + ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean); +begin + Draw(ABitmap, rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), DrawGrid); +end; + +procedure TBGRASliceScaling.AutodetectRepeat; +var + middleSlice: TBGRABitmap; + x, y: integer; + p: PBGRAPixel; + c0: TBGRAPixel; + isRepeating: boolean; +begin + middleSlice := SliceBitmap[spMiddle]; + isRepeating := True; + for y := 0 to middleSlice.Height - 1 do + begin + p := middleSlice.ScanLine[y]; + c0 := p^; + for x := middleSlice.Width - 1 downto 0 do + begin + if p^ <> c0 then + begin + isRepeating := False; + break; + end; + Inc(p); + end; + if not isRepeating then + break; + end; + if isRepeating then + SliceRepeat[srpMiddleHorizontal] := True; + + isRepeating := True; + for x := 0 to middleSlice.Width - 1 do + begin + c0 := middleSlice.GetPixel(x, 0); + for y := middleSlice.Height - 1 downto 1 do + begin + if middleSlice.GetPixel(x, y) <> c0 then + begin + isRepeating := False; + break; + end; + end; + if not isRepeating then + break; + end; + if isRepeating then + SliceRepeat[srpMiddleVertical] := True; +end; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraspritegl.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraspritegl.pas new file mode 100644 index 0000000..b97068e --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraspritegl.pas @@ -0,0 +1,586 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASpriteGL; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAOpenGLType, + BGRABitmapTypes; + +type + { TBGLCustomSprite } + + TBGLCustomSprite = class + protected + FHandle: Pointer; + FTexture: IBGLTexture; + FFrameLoopStart: integer; + FFrameLoopEnd : integer; + procedure SetFrameLoopEnd(AValue: integer); + procedure SetFrameLoopStart(AValue: integer); + function GetHorizontalAlign: TAlignment; virtual; abstract; + function GetVerticalAlign: TTextLayout; virtual; abstract; + procedure SetHorizontalAlign(AValue: TAlignment); virtual; abstract; + procedure SetVerticalAlign(AValue: TTextLayout); virtual; abstract; + function GetAlpha: Integer; virtual; abstract; + function GetAngle: Single; virtual; abstract; + function GetColor: TBGRAPixel; virtual; abstract; + function GetActualFrame: Single; virtual; abstract; + function GetFrame: Single; + function GetH: Single; virtual; abstract; + function GetLayer: Integer; virtual; abstract; + function GetLocation: TPointF; virtual; + function GetVisible: Boolean; virtual; + function GetW: Single; virtual; abstract; + function GetX: Single; virtual; abstract; + function GetY: Single; virtual; abstract; + function GetTexture: IBGLTexture; virtual; + function GetHandle: Pointer; virtual; + procedure SetAlpha(AValue: Integer); virtual; abstract; + procedure SetAngle(AValue: Single); virtual; abstract; + procedure SetColor(AValue: TBGRAPixel); virtual; abstract; + procedure SetFrame(AValue: Single); + procedure SetActualFrame(AValue: Single); virtual; abstract; + procedure SetH(AValue: Single); virtual; abstract; + procedure SetLayer(AValue: Integer); virtual; abstract; + procedure SetLocation(AValue: TPointF); virtual; + procedure SetW(AValue: Single); virtual; abstract; + procedure SetVisible({%H-}AValue: boolean); virtual; + procedure SetX(AValue: Single); virtual; abstract; + procedure SetY(AValue: Single); virtual; abstract; + procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); virtual; + procedure OnInit; virtual; + public + constructor Create(ATexture: IBGLTexture; ALayer: integer); + destructor Destroy; override; + procedure OnDraw; virtual; + procedure OnElapse({%H-}AElapsedMs: integer); virtual; + procedure OnTimer; virtual; + procedure QueryDestroy; virtual; abstract; + property Layer : Integer read GetLayer write SetLayer; + property Location: TPointF read GetLocation write SetLocation; + property X : Single read GetX write SetX; + property Y : Single read GetY write SetY; + property W : Single read GetW write SetW; + property H : Single read GetH write SetH; + property Angle : Single read GetAngle write SetAngle; + property Frame : Single read GetFrame write SetFrame; + property FrameLoopStart : integer read FFrameLoopStart write SetFrameLoopStart; + property FrameLoopEnd : integer read FFrameLoopEnd write SetFrameLoopEnd; + property Alpha : Integer read GetAlpha write SetAlpha; + property Color : TBGRAPixel read GetColor write SetColor; + property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; + property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; + property Visible : Boolean read GetVisible write SetVisible; + property Texture : IBGLTexture read GetTexture; + property Handle : Pointer read GetHandle; + end; + + { TBGLDefaultSprite } + + TBGLDefaultSprite = class(TBGLCustomSprite) + protected + FColor : TBGRAPixel; + FLocation,FSize: TPointF; + FAngle,FFrame : single; + FHorizontalAlign: TAlignment; + FVerticalAlign: TTextLayout; + FQueryDestroy: boolean; + FLayer: integer; + FHidden: boolean; + function GetHorizontalAlign: TAlignment; override; + function GetVerticalAlign: TTextLayout; override; + procedure SetHorizontalAlign(AValue: TAlignment); override; + procedure SetVerticalAlign(AValue: TTextLayout); override; + function GetAlpha: Integer; override; + function GetAngle: Single; override; + function GetColor: TBGRAPixel; override; + function GetDestroy: Boolean; + function GetActualFrame: Single; override; + function GetH: Single; override; + function GetLayer: Integer; override; + function GetVisible: Boolean; override; + function GetW: Single; override; + function GetX: Single; override; + function GetY: Single; override; + procedure SetAlpha(AValue: Integer); override; + procedure SetAngle(AValue: Single); override; + procedure SetColor(AValue: TBGRAPixel); override; + procedure SetDestroy(AValue: Boolean); + procedure SetActualFrame(AValue: Single); override; + procedure SetH(AValue: Single); override; + procedure SetLayer(AValue: Integer); override; + procedure SetVisible(AValue: boolean); override; + procedure SetW(AValue: Single); override; + procedure SetX(AValue: Single); override; + procedure SetY(AValue: Single); override; + procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); override; + public + procedure QueryDestroy; override; + end; + + { TBGLCustomSpriteEngine } + + TBGLCustomSpriteEngine = class + protected + function GetSprite(AIndex: integer): TBGLCustomSprite; virtual; abstract; + function GetCount: integer; virtual; abstract; + public + procedure Add(ASprite: TBGLCustomSprite); virtual; abstract; + procedure Remove(ASprite: TBGLCustomSprite); virtual; abstract; + procedure OnDraw; virtual; abstract; + procedure OnTimer; virtual; abstract; + procedure OnElapse(AElapsedMs: integer); virtual; abstract; + procedure Clear; virtual; abstract; + procedure Delete(AIndex: integer); virtual; abstract; + property Count: Integer read GetCount; + property Sprite[AIndex: integer]: TBGLCustomSprite read GetSprite; + end; + + { TBGLDefaultSpriteEngine } + + TBGLDefaultSpriteEngine = class(TBGLCustomSpriteEngine) + protected + FSpriteRemoved: TBGLCustomSprite; + FSprites: array of TBGLDefaultSprite; + FSpritesCount: integer; + function GetSprite(AIndex: integer): TBGLCustomSprite; override; + function GetCount: integer; override; + public + constructor Create; + procedure Add(ASprite: TBGLCustomSprite); override; + procedure Remove(ASprite: TBGLCustomSprite); override; + procedure OnDraw; override; + procedure OnTimer; override; + procedure OnElapse(AElapsedMs: integer); override; + procedure Clear; override; + procedure Delete(AIndex: integer); override; + end; + +var + BGLSpriteEngine : TBGLCustomSpriteEngine; + +implementation + +{ TBGLDefaultSpriteEngine } + +function TBGLDefaultSpriteEngine.GetSprite(AIndex: integer): TBGLCustomSprite; +begin + if (AIndex < 0) or (Aindex >= Count) then + raise ERangeError.Create('Index out of bounds'); + result := FSprites[AIndex]; +end; + +function TBGLDefaultSpriteEngine.GetCount: integer; +begin + result := FSpritesCount; +end; + +constructor TBGLDefaultSpriteEngine.Create; +begin + FSpritesCount := 0; +end; + +procedure TBGLDefaultSpriteEngine.Add(ASprite: TBGLCustomSprite); +var + i: Integer; +begin + if ASprite = nil then exit; + if not (ASprite is TBGLDefaultSprite) then + raise exception.Create('Invalid class'); + for i := 0 to Count-1 do + if FSprites[i] = ASprite then exit; + if Count = length(FSprites) then + setlength(FSprites, length(FSprites)*2 + 1); + FSprites[Count] := TBGLDefaultSprite(ASprite); + Inc(FSpritesCount); +end; + +procedure TBGLDefaultSpriteEngine.Remove(ASprite: TBGLCustomSprite); +var + i: Integer; +begin + if ASprite = FSpriteRemoved then exit; + for i := 0 to Count-1 do + if FSprites[i] = ASprite then + begin + Delete(i); + exit; + end; +end; + +procedure TBGLDefaultSpriteEngine.OnDraw; +var i: integer; +begin + for i := 0 to Count-1 do + FSprites[i].OnDraw; +end; + +procedure TBGLDefaultSpriteEngine.OnTimer; +var i,j,k: integer; + temp: TBGLDefaultSprite; +begin + for i := 0 to Count-1 do + FSprites[i].OnTimer; + for i := Count-1 downto 0 do + if FSprites[i].FQueryDestroy then + Delete(i); + for i := 1 to Count-1 do + begin + j := i; + while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j); + if j <> i then + begin + temp := FSprites[i]; + for k := i downto j+1 do + FSprites[k] := FSprites[k-1]; + FSprites[j] := temp; + end; + end; +end; + +procedure TBGLDefaultSpriteEngine.OnElapse(AElapsedMs: integer); +var i,j,k: integer; + temp: TBGLDefaultSprite; +begin + for i := 0 to Count-1 do + FSprites[i].OnElapse(AElapsedMs); + for i := Count-1 downto 0 do + if FSprites[i].FQueryDestroy then + Delete(i); + for i := 1 to Count-1 do + begin + j := i; + while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j); + if j <> i then + begin + temp := FSprites[i]; + for k := i downto j+1 do + FSprites[k] := FSprites[k-1]; + FSprites[j] := temp; + end; + end; +end; + +procedure TBGLDefaultSpriteEngine.Clear; +var i: integer; +begin + for i := 0 to Count-1 do + begin + FSpriteRemoved := FSprites[i]; + FSpriteRemoved.Free; + FSpriteRemoved := nil; + end; + FSprites := nil; + FSpritesCount := 0; +end; + +procedure TBGLDefaultSpriteEngine.Delete(AIndex: integer); +var i: integer; +begin + if (AIndex < 0) or (AIndex >= Count) then exit; + FSpriteRemoved := FSprites[AIndex]; + for i := AIndex to Count-1 do + FSprites[i] := FSprites[i+1]; + dec(FSpritesCount); + if FSpritesCount <= length(FSprites) div 2 then + setlength(FSprites,FSpritesCount); + FSpriteRemoved.Free; + FSpriteRemoved := nil; +end; + +{ TBGLDefaultSprite } + +function TBGLDefaultSprite.GetHorizontalAlign: TAlignment; +begin + result := FHorizontalAlign; +end; + +function TBGLDefaultSprite.GetVerticalAlign: TTextLayout; +begin + result := FVerticalAlign; +end; + +procedure TBGLDefaultSprite.SetHorizontalAlign(AValue: TAlignment); +begin + FHorizontalAlign:= AValue; +end; + +procedure TBGLDefaultSprite.SetVerticalAlign(AValue: TTextLayout); +begin + FVerticalAlign := AValue; +end; + +function TBGLDefaultSprite.GetAlpha: Integer; +begin + result := FColor.alpha; +end; + +function TBGLDefaultSprite.GetAngle: Single; +begin + result := FAngle; +end; + +function TBGLDefaultSprite.GetColor: TBGRAPixel; +begin + result := FColor; +end; + +function TBGLDefaultSprite.GetDestroy: Boolean; +begin + result := FQueryDestroy; +end; + +function TBGLDefaultSprite.GetActualFrame: Single; +begin + result := FFrame; +end; + +function TBGLDefaultSprite.GetH: Single; +begin + result := FSize.Y; +end; + +function TBGLDefaultSprite.GetLayer: Integer; +begin + result := FLayer; +end; + +function TBGLDefaultSprite.GetVisible: Boolean; +begin + Result:= not FHidden; +end; + +function TBGLDefaultSprite.GetW: Single; +begin + result := FSize.X; +end; + +function TBGLDefaultSprite.GetX: Single; +begin + result := FLocation.X; +end; + +function TBGLDefaultSprite.GetY: Single; +begin + result := FLocation.Y; +end; + +procedure TBGLDefaultSprite.SetAlpha(AValue: Integer); +begin + FColor.Alpha := AValue; +end; + +procedure TBGLDefaultSprite.SetAngle(AValue: Single); +begin + FAngle:= AValue; +end; + +procedure TBGLDefaultSprite.SetColor(AValue: TBGRAPixel); +begin + FColor := AValue; +end; + +procedure TBGLDefaultSprite.SetDestroy(AValue: Boolean); +begin + FQueryDestroy:= AValue; +end; + +procedure TBGLDefaultSprite.SetActualFrame(AValue: Single); +begin + FFrame:= AValue; +end; + +procedure TBGLDefaultSprite.SetH(AValue: Single); +begin + FSize.Y := AValue; +end; + +procedure TBGLDefaultSprite.SetLayer(AValue: Integer); +begin + FLayer:= AValue; +end; + +procedure TBGLDefaultSprite.SetVisible(AValue: boolean); +begin + FHidden := not AValue; +end; + +procedure TBGLDefaultSprite.SetW(AValue: Single); +begin + FSize.X := AValue; +end; + +procedure TBGLDefaultSprite.SetX(AValue: Single); +begin + FLocation.X := AValue; +end; + +procedure TBGLDefaultSprite.SetY(AValue: Single); +begin + FLocation.Y := AValue; +end; + +procedure TBGLDefaultSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer); +begin + inherited CreateHandle(ATexture, ALayer); + FQueryDestroy := false; + FLayer:= ALayer; +end; + +procedure TBGLDefaultSprite.QueryDestroy; +begin + SetDestroy(True); +end; + +{ TBGLCustomSprite } + +function TBGLCustomSprite.GetTexture: IBGLTexture; +begin + result := FTexture; +end; + +function TBGLCustomSprite.GetHandle: Pointer; +begin + result := FHandle; +end; + +procedure TBGLCustomSprite.SetFrame(AValue: Single); +var loopLength: integer; +begin + if (FrameLoopEnd <> 0) and (FrameLoopStart <> 0) then + begin + loopLength := FrameLoopEnd-FrameLoopStart+1; + if AValue >= FrameLoopEnd+0.49 then + begin + if loopLength <= 1 then + AValue := FrameLoopEnd+0.49 + else + begin + DecF(AValue, Trunc((AValue-(FrameLoopStart-0.5))/loopLength)*loopLength); + if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopStart-0.49; + if AValue < FrameLoopStart-0.49 then AValue := FrameLoopStart-0.49; + end; + end else + if AValue < FrameLoopStart-0.49 then + begin + if loopLength <= 1 then + AValue := FrameLoopStart-0.49 + else + begin + IncF(AValue, Trunc((FrameLoopEnd+0.5-AValue)/loopLength)*loopLength); + if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopEnd+0.49; + if AValue < FrameLoopStart-0.49 then AValue := FrameLoopEnd+0.49; + end; + end; + end; + SetActualFrame(AValue); +end; + +procedure TBGLCustomSprite.SetFrameLoopEnd(AValue: integer); +begin + FFrameLoopEnd := AValue; + if FFrameLoopEnd < FFrameLoopStart then + FFrameLoopStart := FFrameLoopEnd; +end; + +procedure TBGLCustomSprite.SetFrameLoopStart(AValue: integer); +begin + FFrameLoopStart := AValue; + if FFrameLoopStart > FFrameLoopEnd then + FFrameLoopEnd := FFrameLoopStart; +end; + +function TBGLCustomSprite.GetFrame: Single; +begin + result := GetActualFrame; +end; + +function TBGLCustomSprite.GetLocation: TPointF; +begin + result := PointF(X,Y); +end; + +function TBGLCustomSprite.GetVisible: Boolean; +begin + result := true; +end; + +procedure TBGLCustomSprite.SetLocation(AValue: TPointF); +begin + X := AValue.X; + Y := AValue.Y; +end; + +procedure TBGLCustomSprite.SetVisible(AValue: boolean); +begin + raise ENotImplemented.Create('Not implemented in base class'); +end; + +procedure TBGLCustomSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer); +begin + FHandle := nil; +end; + +procedure TBGLCustomSprite.OnInit; +begin + //nothing +end; + +constructor TBGLCustomSprite.Create(ATexture: IBGLTexture; ALayer: integer); +begin + CreateHandle(ATexture,ALayer); + FTexture := ATexture; + Layer := ALayer; + if ATexture = nil then + begin + W := 0; + H := 0; + end else + begin + W := ATexture.FrameWidth; + H := ATexture.FrameHeight; + end; + HorizontalAlign := taLeftJustify; + VerticalAlign:= tlTop; + Color := BGRAWhite; + FrameLoopStart := 1; + FrameLoopEnd := 0; + OnInit; + BGLSpriteEngine.Add(self); +end; + +destructor TBGLCustomSprite.Destroy; +begin + if Assigned(BGLSpriteEngine) then + BGLSpriteEngine.Remove(self); + inherited Destroy; +end; + +procedure TBGLCustomSprite.OnDraw; +var NumFrame: integer; +begin + if Visible and (Texture <> nil) then + begin + NumFrame := Trunc(Frame+0.5); + if Angle <> 0 then + Texture.Frame[NumFrame].StretchDrawAngle(X,Y,W,H,Angle,HorizontalAlign,VerticalAlign, Color) + else + Texture.Frame[NumFrame].StretchDraw(X,Y,W,H,HorizontalAlign,VerticalAlign, Color) + end; +end; + +procedure TBGLCustomSprite.OnElapse(AElapsedMs: integer); +begin + //override if you want to handle time as continuous flow. It is recommended to use floating point positions in this case. +end; + +procedure TBGLCustomSprite.OnTimer; +begin + //override if you want to handle time as discrete frames with fixed time interval +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.inc b/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.inc new file mode 100644 index 0000000..a52c86b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.inc @@ -0,0 +1,28 @@ +{$IFDEF SSE_LOADV} + {$UNDEF SSE_LOADV} + {$ifdef cpux86_64} + mov rax,v + movups xmm1,[rax] + {$else} + mov eax,v + movups xmm1,[eax] + {$endif} +{$ELSE} + {$IFDEF SSE_SAVEV} + {$UNDEF SSE_SAVEV} + {$ifdef cpux86_64} + mov rax,v + movups [rax],xmm1 + {$else} + mov eax,v + movups [eax],xmm1 + {$endif} + {$ELSE} + {$IFDEF CPUI386} + {$DEFINE BGRASSE_AVAILABLE} + {$ENDIF} + {$IFDEF cpux86_64} + {$DEFINE BGRASSE_AVAILABLE} + {$ENDIF} + {$ENDIF} +{$ENDIF} \ No newline at end of file diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.pas new file mode 100644 index 0000000..274229f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasse.pas @@ -0,0 +1,656 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASSE; + +{$mode objfpc}{$H+} + +{$i bgrasse.inc} +{$modeswitch advancedrecords} + +interface + +{begin //param: eax, edx, ecx //float: eax ecx edx + //flds $d9 + //fadds $d8 + //fstps $d9 +$18 + //fmuls $d8 +$08 + //fsubrs $d8 +$28 + //offset +$40 $..} +uses + BGRABitmapTypes {$ifdef CPUI386}, cpu, mmx{$endif}; + +const FLAG_ENABLED_SSE = true; + +var UseSSE, UseSSE2, UseSSE3 : boolean; + +{$ifdef CPUI386} + {$asmmode intel} +{$ENDIF} +{$ifdef cpux86_64} + {$asmmode intel} +{$ENDIF} + +{$ifdef BGRASSE_AVAILABLE} + //SSE rotate singles + const Shift231 = 1 + 8; + Shift312 = 2 + 16; +{$endif} + +type + + { TPoint3D_128 } + + TPoint3D_128 = packed record + x,y,z,t: single; + procedure Offset(const point3D_128: TPoint3D_128); + procedure Scale(AScale: single); + end; + PPoint3D_128 = ^TPoint3D_128; + + function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload; + function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload; + function Point3D_128(const pointF: TPointF): TPoint3D_128; inline; overload; + function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload; + function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload; + procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single); + operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128; + operator + (constref v1,v2: TPoint3D_128): TPoint3D_128; + operator - (const v1,v2: TPoint3D_128): TPoint3D_128; + operator - (const v: TPoint3D_128): TPoint3D_128; inline; + operator = (const v1,v2: TPoint3D_128): boolean; inline; + procedure ClearPoint3D_128(out v: TPoint3D_128); + {$IFDEF BGRASSE_AVAILABLE} + procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128); + {$ENDIF} + function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean; inline; + +var + Add3D_Aligned : procedure (var dest: TPoint3D_128; constref src: TPoint3D_128); + Normalize3D_128 : procedure (var v: TPoint3D_128); + VectProduct3D_128 : procedure (const u,v: TPoint3D_128; out w: TPoint3D_128); + DotProduct3D_128 : function (constref v1,v2: TPoint3D_128): single; + +const + Point3D_128_Zero : TPoint3D_128 = (x:0; y:0; z:0; t:0); + +type + + { TMemoryBlockAlign128 } + + TMemoryBlockAlign128 = class + private + FContainer: Pointer; + FData: Pointer; + public + constructor Create(size: integer); + destructor Destroy; override; + property Data: pointer read FData; + end; + + PBasicLightingContext = ^TBasicLightingContext; + TBasicLightingContext = packed record + {0} Position, {16} Normal: TPoint3D_128; + {32} PositionInvZ, {48} NormalInvZ: TPoint3D_128; + {64} PositionStepInvZ, {80} NormalStepInvZ: TPoint3D_128; + {96} dummy4: single; + {100} dummy3: LongBool; + {104} dummy1: LongWord; + {108} dummy2: LongWord; + {112} dummy: packed array[0..15]of byte; + end; {128} + +const ExtendedLightingContextSize = 128; + +implementation + +{ TPoint3D_128 } + +procedure TPoint3D_128.Offset(const point3D_128: TPoint3D_128); +begin + self.x := self.x + point3D_128.x; + self.y := self.y + point3D_128.y; + self.z := self.z + point3D_128.z; +end; + +procedure TPoint3D_128.Scale(AScale: single); +begin + self.x := self.x * AScale; + self.y := self.y * AScale; + self.z := self.z * AScale; +end; + +function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload; +begin + result.x := point3D_128.x; + result.y := point3D_128.y; + result.z := point3D_128.z; +end; + +function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload; +begin + result.x := point3D.x; + result.y := point3D.y; + result.z := point3D.z; + result.t := 0; +end; + +function Point3D_128(const pointF: TPointF): TPoint3D_128; +begin + result.x := pointF.x; + result.y := pointF.y; + result.z := 0; + result.t := 0; +end; + +function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload; +begin + result.x := x; + result.y := y; + result.z := z; + result.t := 0; +end; + +function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload; +begin + result.x := x; + result.y := y; + result.z := z; + result.t := t; +end; + +operator + (constref v1,v2: TPoint3D_128): TPoint3D_128; +{$ifdef CPUI386} assembler; +asm + db $d9, $00 //flds [eax] + db $d8, $02 //fadds [edx] + db $d9, $19 //fstps [ecx] + + db $d9, $40, $04 //flds [eax+4] + db $d8, $42, $04 //fadds [edx+4] + db $d9, $59, $04 //fstps [ecx+4] + + db $d9, $40, $08 //flds [eax+8] + db $d8, $42, $08 //fadds [edx+8] + db $d9, $59, $08 //fstps [ecx+8] + + xor eax,eax + mov [ecx+12],eax +end; +{$else} +begin + result.x := v1.x+v2.x; + result.y := v1.y+v2.y; + result.z := v1.z+v2.z; + result.t := 0; +end; +{$endif} + +{$ifdef BGRASSE_AVAILABLE} +procedure Add3D_AlignedSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); assembler; +asm + movaps xmm0, [dest] + movups xmm1, [src] + addps xmm0, xmm1 + movaps [dest], xmm0 +end; +{$endif} + +procedure Add3D_NoSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); +{$ifdef CPUI386} assembler; +asm + db $d9, $00 //flds [eax] + db $d8, $02 //fadds [edx] + db $d9, $18 //fstps [eax] + + db $d9, $40, $04 //flds [eax+4] + db $d8, $42, $04 //fadds [edx+4] + db $d9, $58, $04 //fstps [eax+4] + + db $d9, $40, $08 //flds [eax+8] + db $d8, $42, $08 //fadds [edx+8] + db $d9, $58, $08 //fstps [eax+8] +end; +{$else} +begin + dest.x := dest.x + src.x; + dest.y := dest.y + src.y; + dest.z := dest.z + src.z; +end; +{$endif} + +operator - (const v1,v2: TPoint3D_128): TPoint3D_128; +{$ifdef CPUI386} assembler; +asm + db $d9, $02 //flds [edx] + db $d8, $28 //fsubrs [eax] + db $d9, $19 //fstps [ecx] + + db $d9, $42, $04 //flds [edx+4] + db $d8, $68, $04 //fsubrs [eax+4] + db $d9, $59, $04 //fstps [ecx+4] + + db $d9, $42, $08 //flds [edx+8] + db $d8, $68, $08 //fsubrs [eax+8] + db $d9, $59, $08 //fstps [ecx+8] + + xor eax,eax + mov [ecx+12],eax +end; +{$else} +begin + result.x := v1.x-v2.x; + result.y := v1.y-v2.y; + result.z := v1.z-v2.z; + result.t := 0; +end; +{$endif} + +operator-(const v: TPoint3D_128): TPoint3D_128; inline; +begin + result.x := -v.x; + result.y := -v.y; + result.z := -v.z; + result.t := 0; +end; + +operator=(const v1, v2: TPoint3D_128): boolean; inline; +begin + result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z); +end; + +procedure ClearPoint3D_128(out v: TPoint3D_128); +{$ifdef cpux86_64} assembler; +asm + push rbx + mov rax,v + xor rbx,rbx + mov [rax],rbx + mov [rax+8],rbx + pop rbx +end; +{$else} + {$ifdef CPUI386} assembler; + asm + push ebx + mov eax,v + xor ebx,ebx + mov [eax],ebx + mov [eax+4],ebx + mov [eax+8],ebx + pop ebx + end; + {$else} + var p: PLongWord; + begin + p := @v; + p^ := 0; + inc(p); + p^ := 0; + inc(p); + p^ := 0; + end; + {$endif} +{$endif} + +procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128); +{$ifdef BGRASSE_AVAILABLE} assembler; + asm + xorps xmm0,xmm0 + {$ifdef cpux86_64} + mov rax,v + movaps [rax],xmm0 + {$else} + mov eax,v + movaps [eax],xmm0 + {$endif} + end; +{$else} +var p: PLongWord; +begin + p := @v; + p^ := 0; + inc(p); + p^ := 0; + inc(p); + p^ := 0; +end; +{$endif} + +function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean; +begin + result := (v.x=0) and (v.y=0) and (v.z=0); +end; + +operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128; +{$ifdef CPUI386} assembler; +asm + db $d9, $00 //flds [eax] + db $d8, $4d, $08 //fmuls [ebp+8] + db $d9, $1a //fstps [edx] + + db $d9, $40, $04 //flds [eax+4] + db $d8, $4d, $08 //fmuls [ebp+8] + db $d9, $5a, $04 //fstps [edx+4] + + db $d9, $40, $08 //flds [eax+8] + db $d8, $4d, $08 //fmuls [ebp+8] + db $d9, $5a, $08 //fstps [edx+8] + + xor eax,eax + mov [edx+12],eax +end; +{$else} +begin + result.x := v1.x*factor; + result.y := v1.y*factor; + result.z := v1.z*factor; + result.t := 0; +end; +{$endif} + +{$ifdef BGRASSE_AVAILABLE} +function DotProduct3D_128_SSE3(constref v1,v2: TPoint3D_128): single; assembler; +asm + movups xmm0, [v1] + movups xmm1, [v2] + mulps xmm0, xmm1 + + haddps xmm0,xmm0 + haddps xmm0,xmm0 + movss [result], xmm0 +end; +{$endif} + +function DotProduct3D_128_NoSSE(constref v1,v2: TPoint3D_128): single; +begin + result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z; +end; + +procedure Normalize3D_128_NoSSE(var v: TPoint3D_128); +var len2: single; +begin + len2 := DotProduct3D_128_NoSSE(v,v); + if len2 = 0 then exit; + v.Scale( 1/sqrt(len2) ); +end; + +{$ifdef BGRASSE_AVAILABLE} +procedure Normalize3D_128_SSE1(var v: TPoint3D_128); +var len2: single; +begin + asm + {$DEFINE SSE_LOADV}{$i bgrasse.inc} + movaps xmm2, xmm1 + mulps xmm2, xmm2 + + //mix1 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $4e + addps xmm2, xmm7 + //mix2 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $11 + addps xmm2, xmm7 + + movss len2, xmm2 + end; + if (len2 = 0) then exit; + if len2 < 1e-6 then //out of bounds for SSE instruction + begin + v.Scale( 1/sqrt(len2) ); + end else + asm + rsqrtps xmm2, xmm2 + mulps xmm1, xmm2 //apply + {$DEFINE SSE_SAVEV}{$i bgrasse.inc} + end; +end; +{$endif} + +{$ifdef BGRASSE_AVAILABLE} +procedure Normalize3D_128_SSE3(var v: TPoint3D_128); +var len2: single; +begin + asm + {$DEFINE SSE_LOADV}{$i bgrasse.inc} + movaps xmm2, xmm1 + mulps xmm2, xmm2 + + haddps xmm2,xmm2 + haddps xmm2,xmm2 + + movss len2, xmm2 + end; + if (len2 = 0) then exit; + if len2 < 1e-6 then //out of bounds for SSE instruction + begin + v.Scale( 1/sqrt(len2) ); + end else + asm + rsqrtps xmm2, xmm2 + mulps xmm1, xmm2 //apply + {$DEFINE SSE_SAVEV}{$i bgrasse.inc} + end; +end; +{$endif} + +procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single); +begin + {$ifdef BGRASSE_AVAILABLE} + if UseSSE then + begin + asm + {$DEFINE SSE_LOADV}{$i bgrasse.inc} + movaps xmm2, xmm1 + mulps xmm2, xmm2 + end; + if UseSSE3 then + asm + haddps xmm2,xmm2 + haddps xmm2,xmm2 + {$ifdef cpux86_64} + mov rax, SqLen + movss [rax], xmm2 + {$else} + mov eax, SqLen + movss [eax], xmm2 + {$endif} + end else + asm + //mix1 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $4e + addps xmm2, xmm7 + //mix2 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $11 + addps xmm2, xmm7 + {$ifdef cpux86_64} + mov rax, SqLen + movss [rax], xmm2 + {$else} + mov eax, SqLen + movss [eax], xmm2 + {$endif} + end; + if SqLen = 0 then exit; + if SqLen < 1e-6 then //out of bounds for SSE instruction + begin + v.Scale( 1/sqrt(SqLen) ); + end else + asm + rsqrtps xmm2, xmm2 + mulps xmm1, xmm2 //apply + {$DEFINE SSE_SAVEV}{$i bgrasse.inc} + end; + end + else +{$endif} + begin + SqLen := DotProduct3D_128_NoSSE(v,v); + if SqLen = 0 then exit; + v.Scale( 1/sqrt(SqLen) ); + end; +end; + +procedure VectProduct3D_128_NoSSE(const u,v: TPoint3D_128; out w: TPoint3D_128); +begin + w.x := u.y*v.z-u.z*v.y; + w.y := u.z*v.x-u.x*v.z; + w.z := u.x*v.Y-u.y*v.x; + w.t := 0; +end; + +{$ifdef BGRASSE_AVAILABLE} +procedure VectProduct3D_128_SSE(constref u,v: TPoint3D_128; out w: TPoint3D_128); assembler; +asm + {$ifdef cpux86_64} + mov rax,u + movups xmm6,[rax] + {$else} + mov eax,u + movups xmm6,[eax] + {$endif} + movaps xmm4, xmm6 + shufps xmm6, xmm6, Shift231 + + {$ifdef cpux86_64} + mov rax,v + movups xmm7,[rax] + {$else} + mov eax,v + movups xmm7,[eax] + {$endif} + movaps xmm5,xmm7 + shufps xmm7, xmm7, Shift312 + + movaps xmm3,xmm6 + mulps xmm3,xmm7 + + shufps xmm4, xmm4, Shift312 + shufps xmm5, xmm5, Shift231 + + mulps xmm4,xmm5 + subps xmm3,xmm4 + + {$ifdef cpux86_64} + mov rax,w + movups [rax],xmm3 + {$else} + mov eax,w + movups [eax],xmm3 + {$endif} +end; + +{$endif} + +{ TMemoryBlockAlign128 } + +{$hints off} +constructor TMemoryBlockAlign128.Create(size: integer); +{$IFDEF BGRASSE_AVAILABLE} +var + delta: PtrUInt; +begin + getmem(FContainer, size+15); + delta := PtrUInt(FContainer) and 15; + if delta <> 0 then delta := 16-delta; + FData := pbyte(FContainer)+delta; +end; +{$ELSE} +begin + getmem(FContainer, size); + FData := FContainer; +end; +{$ENDIF} +{$hints on} + +destructor TMemoryBlockAlign128.Destroy; +begin + freemem(FContainer); + inherited Destroy; +end; + +{$ifdef BGRASSE_AVAILABLE} +function sse3_support : boolean; + + var + _ecx : longint; + + begin + {$IFDEF CPUI386} + if cpuid_support then + begin + asm + push ebx + mov eax,1 + cpuid + mov _ecx,ecx + pop ebx + end; + sse3_support:=(_ecx and 1)<>0; + end + else + sse3_support:=false; + {$ELSE} + asm + push rbx + mov eax,1 + cpuid + mov _ecx,ecx + pop rbx + end; + sse3_support:=(_ecx and 1)<>0; + {$ENDIF} + end; +{$endif} + +initialization + + {$ifdef CPUI386} + UseSSE := is_sse_cpu and FLAG_ENABLED_SSE; + {$else} + {$ifdef cpux86_64} + UseSSE := FLAG_ENABLED_SSE; + {$else} + UseSSE := false; + {$endif} + {$endif} + + {$IFDEF BGRASSE_AVAILABLE} + if UseSSE then + begin + {$ifdef cpux86_64} + UseSSE2 := true; + {$else} + UseSSE2 := is_sse2_cpu; + {$endif} + UseSSE3 := sse3_support; + + Add3D_Aligned := @Add3D_AlignedSSE; + VectProduct3D_128 := @VectProduct3D_128_NoSSE; //VectProduct3D_128_SSE is slower (due to access penalty?) + if UseSSE3 then + begin + Normalize3D_128 := @Normalize3D_128_SSE3; + DotProduct3D_128 := @DotProduct3D_128_NoSSE; //DotProduct3D_128_SSE3 is slower (due to access penalty?) + end + else + begin + Normalize3D_128 := @Normalize3D_128_SSE1; + DotProduct3D_128 := @DotProduct3D_128_NoSSE; + end; + end + else + {$ENDIF} + begin + UseSSE := false; + UseSSE2 := false; + UseSSE3 := false; + + Add3D_Aligned := @Add3D_NoSSE; + Normalize3D_128 := @Normalize3D_128_NoSSE; + VectProduct3D_128 := @VectProduct3D_128_NoSSE; + DotProduct3D_128 := @DotProduct3D_128_NoSSE; + end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrastreamlayers.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrastreamlayers.pas new file mode 100644 index 0000000..75f8e3c --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrastreamlayers.pas @@ -0,0 +1,393 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAStreamLayers; + +{$mode objfpc}{$H+} +{$MODESWITCH ADVANCEDRECORDS} + +interface + +uses + BGRAClasses, SysUtils, BGRALayers, BGRABitmap, BGRALzpCommon, BGRAMemDirectory; + +function CheckStreamForLayers(AStream: TStream): boolean; +function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false; + ADestination: TBGRALayeredBitmap = nil; AProgress: boolean = false): TBGRALayeredBitmap; +procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; ASelectedLayerIndex: integer; + ACompression: TLzpCompression = lzpZStream; AProgress: boolean = false); +procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression = lzpZStream); +function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression = lzpZStream) : TBGRABitmap; +procedure RegisterStreamLayers; + +implementation + +uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp, + BGRAUTF8, Math; + +type + PLayerHeader = ^TLayerHeader; + + { TLayerHeader } + + TLayerHeader = packed record + LayerOption, BlendOp, + LayerOfsX, LayerOfsY, + LayerUniqueId, LayerOpacity: Longint; + LayerBitmapSize: int64; + OriginalGuid: TGuid; + OriginalMatrix: TAffineMatrix; + procedure FixEndian; + end; + +{ TLayerHeader } + +procedure TLayerHeader.FixEndian; +begin + LayerOption := NtoLE(LayerOption); + BlendOp := NtoLE(BlendOp); + LayerOfsX := NtoLE(LayerOfsX); + LayerOfsY := NtoLE(LayerOfsY); + LayerUniqueId := NtoLE(LayerUniqueId); + LayerOpacity := NtoLE(LayerOpacity); + LayerBitmapSize := NtoLE(LayerBitmapSize); + OriginalGuid.D1 := NtoBE(OriginalGuid.D1); + OriginalGuid.D2 := NtoBE(OriginalGuid.D2); + OriginalGuid.D3 := NtoBE(OriginalGuid.D3); + LongWord(OriginalMatrix[1,1]) := NtoLE(LongWord(OriginalMatrix[1,1])); + LongWord(OriginalMatrix[2,1]) := NtoLE(LongWord(OriginalMatrix[2,1])); + LongWord(OriginalMatrix[1,2]) := NtoLE(LongWord(OriginalMatrix[1,2])); + LongWord(OriginalMatrix[2,2]) := NtoLE(LongWord(OriginalMatrix[2,2])); + LongWord(OriginalMatrix[1,3]) := NtoLE(LongWord(OriginalMatrix[1,3])); + LongWord(OriginalMatrix[2,3]) := NtoLE(LongWord(OriginalMatrix[2,3])); +end; + +procedure SaveLayeredBitmapToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); +begin + SaveLayersToStream(AStream,ALayers,-1); +end; + +procedure LoadLayeredBitmapFromStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); +var selectedIndex: integer; +begin + if not CheckStreamForLayers(AStream) then + begin + if Assigned(ALayers) then ALayers.Clear; + end + else + LoadLayersFromStream(AStream,selectedIndex,false,ALayers as TBGRALayeredBitmap); +end; + +const + StreamHeader = 'TBGRALayeredBitmap'#26#0; + StreamMaxLayerCount = 4096; + StreamMaxHeaderSize = 256; + +function CheckStreamForLayers(AStream: TStream): boolean; +var + OldPosition: Int64; + HeaderFound: string; +begin + result := false; + OldPosition:= AStream.Position; + try + SetLength(HeaderFound, length(StreamHeader)); + SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound))); + if HeaderFound = StreamHeader then + result := true; + except + on ex: exception do + begin + //nothing + end; + end; + AStream.Position:= OldPosition; +end; + +procedure RenameLayersToUniqueId(ALayers: TBGRACustomLayeredBitmap); +var + layerDir: TMemDirectory; + i: Integer; +begin + layerDir := ALayers.MemDirectory.FindPath('layers'); + if Assigned(layerDir) then + begin + for i := 0 to ALayers.NbLayers-1 do + layerDir.Rename('layer'+inttostr(i+1), '', inttostr(ALayers.LayerUniqueId[i])); + end; +end; + +procedure RenameLayersToIndex(ALayers: TBGRACustomLayeredBitmap); +var + layerDir: TMemDirectory; + i: Integer; +begin + layerDir := ALayers.MemDirectory.FindPath('layers'); + if Assigned(layerDir) then + begin + for i := 0 to ALayers.NbLayers-1 do + layerDir.Rename(inttostr(ALayers.LayerUniqueId[i]), '', 'layer'+inttostr(i+1)); + end; +end; + +function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean; + ADestination: TBGRALayeredBitmap; AProgress: boolean): TBGRALayeredBitmap; +var + OldPosition: Int64; + HeaderFound: string; + NbLayers, canvasWidth, canvasHeight: LongInt; + HeaderSize, LayerHeaderSize: LongInt; + LayerStackStartPosition, LayerHeaderPosition, + LayerBitmapPosition, LayerEndPosition, MemDirPos: Int64; + StackOption: LongInt; + Layer: TBGRABitmap; + i,LayerIndex: integer; + LayerName: string; + Compression: TLzpCompression; + LayerBlendOp: TBlendOperation; + LayerIdFound: boolean; + h: TLayerHeader; +begin + if Assigned(ADestination) then + begin + result := ADestination; + result.Clear; + end else + result := TBGRALayeredBitmap.Create; + OldPosition:= AStream.Position; + SetLength(HeaderFound, length(StreamHeader)); + try + //format identifier + SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound))); + if HeaderFound <> StreamHeader then + raise exception.Create('Invalid header'); + + //header size + HeaderSize:= LEReadLongint(AStream); + if (HeaderSize < 12) or (HeaderSize > StreamMaxHeaderSize) then + raise exception.Create('Invalid header size'); + LayerStackStartPosition := AStream.Position + HeaderSize; + + NbLayers:= LEReadLongint(AStream); + if (NbLayers < 0) or (NbLayers > StreamMaxLayerCount) then + raise exception.Create('Invalid layer count'); + + ASelectedLayerIndex:= LEReadLongint(AStream); + if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= NbLayers) then + raise exception.Create('Selected layer out of bounds'); + + StackOption := LEReadLongint(AStream); + result.LinearBlend := (StackOption and 1) = 1; + if (StackOption and 2) = 2 then Compression := lzpRLE else Compression:= lzpZStream; + + if headerSize >= 20 then + begin + canvasWidth := LEReadLongint(AStream); + canvasHeight := LEReadLongint(AStream); + result.SetSize(canvasWidth,canvasHeight); + end; + + if headerSize >= 28 then + begin + MemDirPos := LEReadInt64(AStream); + end else MemDirPos := 0; + //end of header + + if MemDirPos <> 0 then + begin + AStream.Position:= MemDirPos+OldPosition; + result.MemDirectory.LoadFromStream(AStream); + end else + result.MemDirectory.Clear; + + AStream.Position:= LayerStackStartPosition; + for i := 0 to NbLayers-1 do + begin + if AProgress then OnLayeredBitmapLoadProgress(round(i*100/NbLayers)); + LayerHeaderSize:= LEReadLongint(AStream); + + LayerHeaderPosition := AStream.Position; + LayerBitmapPosition := LayerHeaderPosition + LayerHeaderSize; + LayerEndPosition := -1; + + fillchar({%H-}h, sizeof(h), 0); + h.LayerOption := 1; //visible + h.BlendOp:= integer(result.DefaultBlendingOperation); + h.LayerOpacity := 65535; //opaque + h.LayerUniqueId:= maxLongint; + h.FixEndian; + + AStream.ReadBuffer(h, min(LayerHeaderSize, sizeof(h))); + h.FixEndian; + + if h.BlendOp > ord(high(TBlendOperation)) then + LayerBlendOp := result.DefaultBlendingOperation + else + LayerBlendOp:= TBlendOperation(h.BlendOp); + + LayerIdFound := h.LayerUniqueId <> maxLongint; + + if h.LayerBitmapSize > 0 then + LayerEndPosition:= LayerBitmapPosition+h.LayerBitmapSize; + + AStream.Position:= LayerBitmapPosition; + Layer := LoadLayerBitmapFromStream(AStream, Compression); + LayerName := Layer.Caption; + LayerIndex := result.AddOwnedLayer(Layer); + Layer := nil; + + result.LayerName[LayerIndex] := LayerName; + result.LayerVisible[LayerIndex] := (h.LayerOption and 1) = 1; + result.BlendOperation[LayerIndex]:= LayerBlendOp; + result.LayerOffset[LayerIndex] := Point(h.LayerOfsX,h.LayerOfsY); + if ALoadLayerUniqueIds and LayerIdFound then + result.LayerUniqueId[LayerIndex] := h.LayerUniqueId; + result.LayerOpacity[LayerIndex] := h.LayerOpacity shr 8; + result.LayerOriginalGuid[LayerIndex] := h.OriginalGuid; + result.LayerOriginalMatrix[LayerIndex] := h.OriginalMatrix; + result.LayerOriginalRenderStatus[layerIndex] := orsProof; + + if LayerEndPosition <> -1 then AStream.Position := LayerEndPosition; + end; + if AProgress then OnLayeredBitmapLoadProgress(100); + + RenameLayersToUniqueId(result); + result.NotifyLoaded; + except + on ex: Exception do + begin + AStream.Position := OldPosition; + if not Assigned(ADestination) then result.Free; + raise ex; + end; + end; +end; + +procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; + ASelectedLayerIndex: integer; ACompression: TLzpCompression; AProgress: boolean); +var + StackOption: longint; + i: integer; + DirectoryOffsetPos, EndPos: int64; + LayerHeaderPosition: int64; + LayerBitmapPosition,BitmapSize, startPos: int64; + bitmap: TBGRABitmap; + h: TLayerHeader; +begin + if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= ALayers.NbLayers) then + raise exception.Create('Selected layer out of bounds'); + + ALayers.NotifySaving; + + startPos := AStream.Position; + AStream.Write(StreamHeader[1], length(StreamHeader)); + LEWriteLongint(AStream, 28); //header size + LEWriteLongint(AStream, ALayers.NbLayers); + LEWriteLongint(AStream, ASelectedLayerIndex); + StackOption := 0; + if ALayers.LinearBlend then StackOption := StackOption or 1; + if ACompression = lzpRLE then StackOption:= StackOption or 2; + LEWriteLongint(AStream, StackOption); + LEWriteLongint(AStream, ALayers.Width); + LEWriteLongint(AStream, ALayers.Height); + DirectoryOffsetPos := AStream.Position; + LEWriteInt64(AStream, 0); + //end of header + + for i := 0 to ALayers.NbLayers-1 do + begin + if AProgress then OnLayeredBitmapSaveProgress(round(i*100/ALayers.NbLayers)); + LEWriteLongint(AStream, sizeof(h)); + LayerHeaderPosition := AStream.Position; + + bitmap := ALayers.GetLayerBitmapDirectly(i); //do it before to ensure update from original + + h.LayerOption:= 0; + if ALayers.LayerVisible[i] then h.LayerOption:= h.LayerOption or 1; + h.BlendOp:= Longint(ALayers.BlendOperation[i]); + h.LayerOfsX:= ALayers.LayerOffset[i].x; + h.LayerOfsY:= ALayers.LayerOffset[i].y; + h.LayerUniqueId:= ALayers.LayerUniqueId[i]; + h.LayerOpacity:= integer(ALayers.LayerOpacity[i])*$101; + h.LayerBitmapSize := 0; + h.OriginalGuid := ALayers.LayerOriginalGuid[i]; + h.OriginalMatrix := ALayers.LayerOriginalMatrix[i]; + h.FixEndian; + AStream.WriteBuffer(h, sizeof(h)); + //end of layer header + + LayerBitmapPosition:=AStream.Position; + if bitmap <> nil then + SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression) + else + begin + bitmap := ALayers.GetLayerBitmapCopy(i); + SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression); + bitmap.free; + end; + + BitmapSize := AStream.Position - LayerBitmapPosition; + + //store back the bitmap size + AStream.Position:= LayerHeaderPosition + (PByte(@PLayerHeader(nil)^.LayerBitmapSize)-PByte(nil)); + LEWriteInt64(AStream, BitmapSize); + + AStream.Position:= LayerBitmapPosition+BitmapSize; + end; + if AProgress then OnLayeredBitmapSaveProgress(100); + + EndPos:= AStream.Position; + if ALayers.HasMemFiles then + begin + AStream.Position := DirectoryOffsetPos; + LEWriteInt64(AStream,EndPos-startPos); + AStream.Position:= EndPos; + RenameLayersToIndex(ALayers); + ALayers.MemDirectory.SaveToStream(AStream); + RenameLayersToUniqueId(ALayers); + end; +end; + +procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression); +var Compressed: TBGRACompressableBitmap; +begin + if ACompression = lzpZStream then + begin + Compressed := TBGRACompressableBitmap.Create(ABitmap); + Compressed.Caption := ACaption; + Compressed.CompressionLevel:= cldefault; + Compressed.WriteToStream(AStream); + Compressed.Free; + end else + TBGRAWriterLazPaint.WriteRLEImage(AStream, ABitmap, ACaption); +end; + +function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression): TBGRABitmap; +var Compressed: TBGRACompressableBitmap; + captionFound: string; +begin + if ACompression = lzpZStream then + begin + Compressed := TBGRACompressableBitmap.Create; + Compressed.ReadFromStream(AStream); + result := Compressed.GetBitmap; + Compressed.Free; + end else + begin + result := TBGRABitmap.Create; + TBGRAReaderLazPaint.LoadRLEImage(AStream, result, captionFound); + result.Caption := captionFound; + end; +end; + +procedure RegisterStreamLayers; +begin + LayeredBitmapSaveToStreamProc := @SaveLayeredBitmapToStream; + LayeredBitmapLoadFromStreamProc := @LoadLayeredBitmapFromStream; + LayeredBitmapCheckStreamProc := @CheckStreamForLayers; +end; + +initialization + + RegisterStreamLayers; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasvg.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvg.pas new file mode 100644 index 0000000..b427138 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvg.pas @@ -0,0 +1,1330 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASVG; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, DOM, BGRAUnits, BGRASVGShapes, + BGRACanvas2D, BGRASVGType, FPimage; + +{ An SVG file has a width and height which describe the viewport size. It is not however really + the size of the content. The latter is defined as a rectangle called viewbox. There are thus + various ways of drawing an SVG file. If the viewbox is not specified, then it is a rectangle + with origin (0,0) and with the same size as the viewport. In this case, a pixel in the viewbox + corresponds to a pixel in the viewport. Otherwise, viewbox is scaled to fit the viewport. + + ------ Different DPIs ----------------- + + The default DPI of the SVG file is the DPI used to convert between pixel units and other units + like centimeters or inches. In general, this should not be used to scale the image, because it + can make the SVG measures inconsistent. It should rather be set to the DPI which was used + internally and which should be 96 according to CSS specifications. Some programs however + use a different DPI so it can be useful to change it according to the source program. + + The destination DPI that can be specified when drawing can be used to scale the SVG. For example + you can prepare your SVG to be at the correct size for 96 DPI display and then draw them + on a display for which the apparent DPI is different (this can be set systemwide on Windows and + Linux). + + ------ Various ways of scaling -------- + + There are various functions to draw and also to get the presentation matrix. The latter is + a matrix, not including the translation to x and y, that contains all transforms to apply + to the viewbox coordinates. The drawing functions are Draw and StretchDraw and to get the + presentation matrix the functions are GetPresentationMatrix and GetStretchPresentationMatrix + respectively. + + Drawing in user coordinates, i.e. without taking account of the viewbox or viewport size. One + can achieve this by calling the Draw function with an x and y coordinates and a destination + unit/DPI. You would do that only if you want to make use of the viewbox offset or + if you already have applied all necessary transforms. The corresponding presentation matrix + is the identity. + + Drawing with a specific alignment in user coordinates. This can be done by calling Draw + with horizontal and vertical alignment, x and y coordinates to align to, a destination unit/DPI + and Scaled set to False. + + Drawing with a specific alignment, scaled to view port units. This will draw the SVG at its + expected size but apply the alignment you want. This is what you would want to do if you + want to customize the alignment. One can achieve this as above but by specifying the Scaled + parameter to True. + + Drawing inside a specified rectangle, not preserving the aspect ratio. In this case, you + want a certain size and the original size does not matter much. The viewbox of the SVG is + stretched to fit the rectangle. One can achieve this by calling StretchDraw with the + specified rectangle and the UseSvgAspectRatio to False. + + Drawing inside a rectangle, using the parameter of the SVG about the aspect ratio. In this case, + the SVG may either be stretched as before, scaled to fit the rectangle or scaled to cover it. + Also the SVG may be set with a certain horizontal and vertical alignment within the rectangle. + One can draw this way by calling StretchDraw with the UseSvgAspectRatio set to True. + You would typically use this method to show the SVG as it was intended to look like but in + a custom container by suppling WidthAsPixel and HeightAsPixel for the rectangle size. + + Drawing inside a rectangle, preserving the aspect ratio. In this case, you call StretchDraw with + a horizontal and vertical alignment, the rectangle and the Slice parameter. When Slice is set + to False, the viewbox will fit the rectangle. If Slice is to True then the viewbox may overflow + the rectangle so that it covers the whole surface. Using this function, one can have control + over the way the SVG is scaled. Slice is useful for background. + + Drawing inside a rectangle of the size defined by the SVG. That will draw the SVG as it is + supposed to look like. One can do that by calling StretchDraw with a unit parameter. You would + typically use pixel units and this will draw to the size WidthAsPixel by HeightAsPixel. + + } + +type + TCSSUnit = BGRAUnits.TCSSUnit; + +const + cuCustom = BGRAUnits.cuCustom; + cuPixel = BGRAUnits.cuPixel; + cuCentimeter = BGRAUnits.cuCentimeter; + cuMillimeter = BGRAUnits.cuMillimeter; + cuInch = BGRAUnits.cuInch; + cuPica = BGRAUnits.cuPica; + cuPoint = BGRAUnits.cuPoint; + cuFontEmHeight = BGRAUnits.cuFontEmHeight; + cuFontXHeight = BGRAUnits.cuFontXHeight; + cuPercent = BGRAUnits.cuPercent; + +type + + { TSVGUnits } + + TSVGUnits = class(TCSSUnitConverter) + private + FOnRecompute: TSVGRecomputeEvent; + procedure Recompute; + procedure SetOnRecompute(AValue: TSVGRecomputeEvent); + protected + FSvg: TDOMElement; + FContainerHeight: TFloatWithCSSUnit; + FContainerWidth: TFloatWithCSSUnit; + FDefaultDpi: PSingle; + + //fetched or computed + FViewBox: TSVGViewBox; + FPreserveAspectRatio: TSVGPreserveAspectRatio; + FViewPortSize, FProportionalViewSize, FStretchedViewSize: TSVGSize; + + procedure SetContainerHeight(AValue: TFloatWithCSSUnit); + procedure SetContainerWidth(AValue: TFloatWithCSSUnit); + function GetDpiX: single; override; + function GetDpiY: single; override; + function GetCustomOrigin: TPointF; + procedure SetCustomOrigin(AValue: TPointF); + procedure SetViewBox(AValue: TSVGViewBox); + public + procedure SetDefaultDpiAndOrigin; + constructor Create(ASvg: TDOMElement; ADefaultDpi: PSingle); + function GetStretchRectF(AViewPort: TRectF; const par: TSVGPreserveAspectRatio): TRectF; + property ViewBox: TSVGViewBox read FViewBox write SetViewBox; + property ViewPortSize: TSVGSize read FViewPortSize; + property ProportionalViewSize: TSVGSize read FProportionalViewSize; + property PreserveAspectRatio: TSVGPreserveAspectRatio read FPreserveAspectRatio; + property StretchedViewSize: TSVGSize read FStretchedViewSize; + property CustomOrigin: TPointF read GetCustomOrigin write SetCustomOrigin; + property ContainerWidth: TFloatWithCSSUnit read FContainerWidth write SetContainerWidth; + property ContainerHeight: TFloatWithCSSUnit read FContainerHeight write SetContainerHeight; + property OnRecompute: TSVGRecomputeEvent read FOnRecompute write SetOnRecompute; + end; + + { TBGRASVG } + + TBGRASVG = class(TSVGCustomElement) + private + function GetComputedHeight: TFloatWithCSSUnit; + function GetComputedWidth: TFloatWithCSSUnit; + function GetContainerHeight: TFloatWithCSSUnit; + function GetContainerHeightAsPixel: single; + function GetContainerWidth: TFloatWithCSSUnit; + function GetContainerWidthAsPixel: single; + function GetFontSize: TFloatWithCSSUnit; + function GetHeight: TFloatWithCSSUnit; + function GetHeightAsCm: single; + function GetHeightAsInch: single; + function GetHeightAsPixel: single; + function GetLayer(AIndex: integer): TSVGGroup; + function GetLayerCount: integer; + function GetPreserveAspectRatio: TSVGPreserveAspectRatio; + function GetUnits: TSVGUnits; + function GetUTF8String: utf8string; + function GetViewBox: TSVGViewBox; overload; + function GetViewBox(AUnit: TCSSUnit): TSVGViewBox; overload; + procedure GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox); + function GetViewMin(AUnit: TCSSUnit): TPointF; + function GetViewSize(AUnit: TCSSUnit): TPointF; + function GetVisualHeight: TFloatWithCSSUnit; + function GetVisualHeightAsPixel: single; + function GetVisualWidth: TFloatWithCSSUnit; + function GetVisualWidthAsPixel: single; + function GetWidth: TFloatWithCSSUnit; + function GetWidthAsCm: single; + function GetWidthAsInch: single; + function GetWidthAsPixel: single; + function GetZoomable: boolean; + procedure SetContainerHeight(AValue: TFloatWithCSSUnit); + procedure SetContainerHeightAsPixel(AValue: single); + procedure SetContainerWidth(AValue: TFloatWithCSSUnit); + procedure SetContainerWidthAsPixel(AValue: single); + procedure SetDefaultDpi(AValue: single); + procedure SetFontSize(AValue: TFloatWithCSSUnit); + procedure SetHeight(AValue: TFloatWithCSSUnit); + procedure SetHeightAsCm(AValue: single); + procedure SetHeightAsInch(AValue: single); + procedure SetHeightAsPixel(AValue: single); + procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); + procedure SetUTF8String(AValue: utf8string); + procedure SetViewBox(AValue: TSVGViewBox); + procedure SetWidth(AValue: TFloatWithCSSUnit); + procedure SetWidthAsCm(AValue: single); + procedure SetWidthAsInch(AValue: single); + procedure SetWidthAsPixel(AValue: single); + procedure SetZoomable(AValue: boolean); + protected + FXml: TXMLDocument; + FDefaultDpi: single; + FContent: TSVGContent; + FDataLink: TSVGDataLink; + procedure Init(ACreateEmpty: boolean); + function GetViewBoxAlignment(AHorizAlign: TAlignment; AVertAlign: TTextLayout; AUnit: TCSSUnit): TPointF; + function GetViewBoxScale: TPointF; + procedure UnitsRecompute(Sender: TObject); + procedure SetAttribute(AName: string; AValue: string); override; + public + constructor Create; overload; + constructor Create(AWidth,AHeight: single; AUnit: TCSSUnit); overload; + constructor Create(AFilenameUTF8: string); overload; + constructor Create(AStream: TStream); overload; + constructor CreateFromString(AUTF8String: string); + destructor Destroy; override; + function Duplicate: TBGRASVG; + procedure CropToViewBox(AScale: single = 1); + procedure LoadFromFile(AFilenameUTF8: string); + procedure LoadFromStream(AStream: TStream; AURI: UnicodeString = 'stream:'); + procedure LoadFromResource(AFilename: string); + procedure SaveToFile(AFilenameUTF8: string); + procedure SaveToStream(AStream: TStream); + procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit = cuPixel); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: single); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: TPointF); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; AUnit: TCSSUnit = cuPixel; AScale: boolean = true); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: single; AScale: boolean = true); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: TPointF; AScale: boolean = true); overload; + procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x,y,w,h: single; useSvgAspectRatio: boolean = false); overload; + procedure StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean = false); overload; + procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); overload; + procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; x,y,w,h: single; ASlice: boolean = false); overload; + procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; r: TRectF; ASlice: boolean = false); overload; + function GetStretchRectF(AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y,w,h: single; ASlice: boolean = false): TRectF; overload; + function GetStretchRectF(x,y,w,h: single): TRectF; overload; + function GetPresentationMatrix(AHorizAlign: TAlignment; AVertAlign: TTextLayout; + AUnit: TCSSUnit; AScale: boolean): TAffineMatrix; + function GetStretchPresentationMatrix(w,h: single; useSvgAspectRatio: boolean = false): TAffineMatrix; overload; + function GetStretchPresentationMatrix(AHorizAlign: TAlignment; AVertAlign: TTextLayout; w,h: single; ASlice: boolean = false): TAffineMatrix; overload; + function GetStretchPresentationMatrix(AUnit: TCSSUnit): TAffineMatrix; overload; + function FindElementById(AID: string): TSVGElement; overload; + function FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; overload; + procedure ConvertToUnit(AUnit: TCSSUnit); override; //except Width, Height, ContainerWidth, ContainerHeight + property AsUTF8String: utf8string read GetUTF8String write SetUTF8String; + property Units: TSVGUnits read GetUnits; + property FontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; + property Width: TFloatWithCSSUnit read GetWidth write SetWidth; + property Height: TFloatWithCSSUnit read GetHeight write SetHeight; + property ComputedWidth: TFloatWithCSSUnit read GetComputedWidth; + property ComputedHeight: TFloatWithCSSUnit read GetComputedHeight; + property WidthAsPixel: single read GetWidthAsPixel write SetWidthAsPixel; + property HeightAsPixel: single read GetHeightAsPixel write SetHeightAsPixel; + property WidthAsCm: single read GetWidthAsCm write SetWidthAsCm; + property HeightAsCm: single read GetHeightAsCm write SetHeightAsCm; + property WidthAsInch: single read GetWidthAsInch write SetWidthAsInch; + property HeightAsInch: single read GetHeightAsInch write SetHeightAsInch; + property ContainerWidth: TFloatWithCSSUnit read GetContainerWidth write SetContainerWidth; + property ContainerWidthAsPixel: single read GetContainerWidthAsPixel write SetContainerWidthAsPixel; + property ContainerHeight: TFloatWithCSSUnit read GetContainerHeight write SetContainerHeight; + property ContainerHeightAsPixel: single read GetContainerHeightAsPixel write SetContainerHeightAsPixel; + property Zoomable: boolean read GetZoomable write SetZoomable; + property ViewBox: TSVGViewBox read GetViewBox write SetViewBox; + property ViewBoxInUnit[AUnit: TCSSUnit]: TSVGViewBox read GetViewBox; + property ViewMinInUnit[AUnit: TCSSUnit]: TPointF read GetViewMin; + property ViewSizeInUnit[AUnit: TCSSUnit]: TPointF read GetViewSize; + property VisualWidth: TFloatWithCSSUnit read GetVisualWidth; + property VisualHeight: TFloatWithCSSUnit read GetVisualHeight; + property VisualWidthAsPixel: single read GetVisualWidthAsPixel; + property VisualHeightAsPixel: single read GetVisualHeightAsPixel; + property Attribute[AName: string]: string read GetAttribute write SetAttribute; + property AttributeDef[AName: string; ADefault: string]: string read GetAttribute; + property DefaultDpi: single read FDefaultDpi write SetDefaultDpi; //this is not saved in the SVG file + property Content: TSVGContent read FContent; + property DataLink: TSVGDataLink read FDataLink;//(for test or internal info) + property preserveAspectRatio: TSVGPreserveAspectRatio read GetPreserveAspectRatio write SetPreserveAspectRatio; + property Layer[AIndex: integer]: TSVGGroup read GetLayer; + property LayerCount: integer read GetLayerCount; + end; + + { TFPReaderSVG } + + TFPReaderSVG = class(TBGRAImageReader) + private + FRenderDpi: single; + FWidth,FHeight: integer; + FScale: single; + protected + function InternalCheck(Stream: TStream): boolean; override; + procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; + public + constructor Create; override; + function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; + function GetBitmapDraft(AStream: TStream; AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; + property RenderDpi: single read FRenderDpi write FRenderDpi; + property Width: integer read FWidth; + property Height: integer read FHeight; + property Scale: single read FScale write FScale; + end; + +procedure RegisterSvgFormat; + +implementation + +uses XMLRead, XMLWrite, BGRAUTF8, math, xmltextreader, URIParser, BGRATransform; + +const SvgNamespace = 'http://www.w3.org/2000/svg'; + +{ TFPReaderSVG } + +function TFPReaderSVG.InternalCheck(Stream: TStream): boolean; +var + magic: array[1..6] of char; + prevPos: int64; + count: LongInt; +begin + prevPos := Stream.Position; + count := Stream.Read({%H-}magic, sizeof(magic)); + Stream.Position:= prevPos; + result:= (count = sizeof(magic)) and ((magic = 'Img then + begin + Img.SetSize(bgra.Width,bgra.Height); + for y := 0 to bgra.Height-1 do + begin + p := bgra.ScanLine[y]; + for x := 0 to bgra.Width-1 do + begin + Img.Colors[x,y] := BGRAToFPColor(p^); + inc(p); + end; + end; + end; + FWidth:= bgra.Width; + FHeight:= bgra.Height; + finally + if bgra<>Img then bgra.Free; + svg.Free; + end; +end; + +constructor TFPReaderSVG.Create; +begin + inherited Create; + FRenderDpi:= 96; + FScale := 1; +end; + +function TFPReaderSVG.GetQuickInfo(AStream: TStream): TQuickImageInfo; +var + svg: TBGRASVG; + vsize: TPointF; +begin + svg := TBGRASVG.Create(AStream); + svg.DefaultDpi:= RenderDpi; + vsize := svg.GetViewSize(cuPixel); + svg.Free; + result.Width:= ceil(vsize.x); + result.Height:= ceil(vsize.y); + result.AlphaDepth:= 8; + result.ColorDepth:= 24; +end; + +function TFPReaderSVG.GetBitmapDraft(AStream: TStream; AMaxWidth, + AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; +var + svg: TBGRASVG; + vsize: TPointF; + c2d: TBGRACanvas2D; + ratio: Single; +begin + svg := TBGRASVG.Create(AStream); + result := nil; + try + svg.DefaultDpi:= RenderDpi; + if svg.preserveAspectRatio.Preserve then + vsize := svg.GetViewSize(cuPixel) + else vsize := PointF(svg.WidthAsPixel, svg.HeightAsPixel); + AOriginalWidth:= ceil(vsize.x); + AOriginalHeight:= ceil(vsize.y); + if (vsize.x = 0) or (vsize.y = 0) then exit; + ratio := min(AMaxWidth/vsize.x, AMaxHeight/vsize.y); + result := BGRABitmapFactory.Create(ceil(vsize.x*ratio),ceil(vsize.y*ratio)); + if ratio <> 0 then + begin + c2d := TBGRACanvas2D.Create(result); + svg.StretchDraw(c2d, 0,0,result.width,result.height); + c2d.Free; + end; + finally + svg.Free; + end; +end; + +var AlreadyRegistered: boolean; + +procedure RegisterSvgFormat; +begin + if AlreadyRegistered then exit; + ImageHandlers.RegisterImageReader ('Scalable Vector Graphic', 'svg', TFPReaderSVG); + AlreadyRegistered:= True; +end; + +function TSVGUnits.GetCustomOrigin: TPointF; +begin + result := FViewBox.min; +end; + +procedure TSVGUnits.SetCustomOrigin(AValue: TPointF); +var newViewBox: TSVGViewBox; +begin + newViewBox := ViewBox; + newViewBox.min := AValue; + ViewBox := newViewBox; +end; + +procedure TSVGUnits.Recompute; +begin + FViewBox:= TSVGViewBox.Parse( FSvg.GetAttribute('viewBox') ); + FPreserveAspectRatio := TSVGPreserveAspectRatio.Parse( FSvg.GetAttribute('preserveAspectRatio') ); + FViewPortSize.width := parseValue(FSvg.GetAttribute('width'), FloatWithCSSUnit(FViewBox.size.x, cuPixel)); + FViewPortSize.height := parseValue(FSvg.GetAttribute('height'), FloatWithCSSUnit(FViewBox.size.y, cuPixel)); + + //view port defined as percentage of container + if FViewPortSize.width.CSSUnit = cuPercent then + begin + FViewPortSize.width.value := FViewPortSize.width.value/100*FContainerWidth.value; + FViewPortSize.width.CSSUnit := FContainerWidth.CSSUnit; + end; + if FViewPortSize.height.CSSUnit = cuPercent then + begin + FViewPortSize.height.value := FViewPortSize.height.value/100*FContainerHeight.value; + FViewPortSize.height.CSSUnit := FContainerHeight.CSSUnit; + end; + + //ensure same unit for width and height + if FViewPortSize.width.CSSUnit <> FViewPortSize.height.CSSUnit then + FViewPortSize.height := ConvertHeight(FViewPortSize.height, FViewPortSize.width.CSSUnit, 0); + + //if not viewbox is specified, it is equal to the viewport + if (FViewBox.size.x <= 0) and (FViewBox.size.y <= 0) then + begin + FViewBox.min := PointF(0, 0); + FViewBox.size.x := ConvertWidth(FViewPortSize.width, cuPixel, 0).value; + FViewBox.size.y := ConvertHeight(FViewPortSize.height, cuPixel, 0).value; + end; + + //compute stretching for default SVG aspect ratio (meet) + FProportionalViewSize := FViewPortSize; + with GetStretchRectF(RectF(0,0,FViewPortSize.width.value,FViewPortSize.height.value), + TSVGPreserveAspectRatio.DefaultValue) do + begin + FProportionalViewSize.width.value := Width; + FProportionalViewSize.height.value := Height; + end; + + //compute stretching according to specified SVG aspect ratio (can be slice or none) + FStretchedViewSize := FViewPortSize; + with GetStretchRectF(RectF(0,0,FViewPortSize.width.value,FViewPortSize.height.value), + PreserveAspectRatio) do + begin + FStretchedViewSize.width.value := Width; + FStretchedViewSize.height.value := Height; + end; + + ViewBoxWidth := FloatWithCSSUnit(FViewBox.size.x, cuPixel); + ViewBoxHeight := FloatWithCSSUnit(FViewBox.size.y, cuPixel); + + if Assigned(FOnRecompute) then FOnRecompute(self); +end; + +procedure TSVGUnits.SetOnRecompute(AValue: TSVGRecomputeEvent); +begin + if FOnRecompute=AValue then Exit; + FOnRecompute:=AValue; +end; + +procedure TSVGUnits.SetContainerHeight(AValue: TFloatWithCSSUnit); +begin + if CompareMem(@FContainerHeight,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; + FContainerHeight:=AValue; + Recompute; +end; + +procedure TSVGUnits.SetContainerWidth(AValue: TFloatWithCSSUnit); +begin + if CompareMem(@FContainerWidth,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; + FContainerWidth:=AValue; + Recompute; +end; + +procedure TSVGUnits.SetDefaultDpiAndOrigin; +begin + FSvg.RemoveAttribute('viewBox'); + Recompute; +end; + +procedure TSVGUnits.SetViewBox(AValue: TSVGViewBox); +begin + FSvg.SetAttribute('viewBox', formatValue(AValue.min.x)+' '+ + formatValue(AValue.min.y)+' '+ + formatValue(AValue.size.x)+' '+ + formatValue(AValue.size.y)); + Recompute; +end; + +function TSVGUnits.GetDpiX: single; +begin + result := FDefaultDpi^; +end; + +function TSVGUnits.GetDpiY: single; +begin + result := FDefaultDpi^; +end; + +constructor TSVGUnits.Create(ASvg: TDOMElement; ADefaultDpi: PSingle); +begin + FSvg := ASvg; + FDefaultDpi := ADefaultDpi; + FContainerWidth := FloatWithCSSUnit(640,cuPixel); + FContainerHeight := FloatWithCSSUnit(480,cuPixel); + Recompute; +end; + +function TSVGUnits.GetStretchRectF(AViewPort: TRectF; const par: TSVGPreserveAspectRatio): TRectF; +var w0,h0,w,h: single; +begin + result := AViewPort; + w0 := AViewPort.Width; + h0 := AViewPort.Height; + + if par.Preserve and + (FViewBox.size.x > 0) and (FViewBox.size.y > 0) and + (w0 > 0) and (h0 > 0) then + begin + w := w0; + h := h0; + + //viewBox wider than viewSize + if (FViewBox.size.x/FViewBox.size.y > w/h) xor par.Slice then + begin + h := w * FViewBox.size.y / FViewBox.size.x; + result.Bottom := result.Top+h; + end else + begin + w := h * FViewBox.size.x / FViewBox.size.y; + result.Right := result.Left+w; + end; + case par.HorizAlign of + taCenter: result.Offset((w0-w)/2, 0); + taRightJustify: result.Offset(w0-w, 0); + end; + case par.VertAlign of + tlCenter: result.Offset(0, (h0-h)/2); + tlBottom: result.Offset(0, h0-h); + end; + end; +end; + +{ TBGRASVG } + +function TBGRASVG.GetComputedHeight: TFloatWithCSSUnit; +begin + result := Units.ViewPortSize.height; +end; + +function TBGRASVG.GetComputedWidth: TFloatWithCSSUnit; +begin + result := Units.ViewPortSize.width; +end; + +function TBGRASVG.GetVisualHeight: TFloatWithCSSUnit; +begin + result := Units.StretchedViewSize.height; +end; + +function TBGRASVG.GetVisualHeightAsPixel: single; +begin + result := Units.ConvertHeight(VisualHeight, cuPixel).value; +end; + +function TBGRASVG.GetVisualWidth: TFloatWithCSSUnit; +begin + result := Units.StretchedViewSize.width; +end; + +function TBGRASVG.GetContainerHeight: TFloatWithCSSUnit; +begin + result := Units.ContainerHeight; +end; + +function TBGRASVG.GetContainerHeightAsPixel: single; +begin + result := Units.ConvertHeight(Units.ContainerHeight, cuPixel).value; +end; + +function TBGRASVG.GetContainerWidth: TFloatWithCSSUnit; +begin + result := Units.ContainerWidth; +end; + +function TBGRASVG.GetContainerWidthAsPixel: single; +begin + result := Units.ConvertWidth(Units.ContainerWidth, cuPixel).value; +end; + +function TBGRASVG.GetFontSize: TFloatWithCSSUnit; +begin + result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); +end; + +function TBGRASVG.GetHeight: TFloatWithCSSUnit; +begin + result := TCSSUnitConverter.parseValue(Attribute['height'],FloatWithCSSUnit(Units.ViewBox.size.y,cuCustom)); + if result.CSSUnit = cuCustom then result.CSSUnit:= cuPixel; +end; + +function TBGRASVG.GetHeightAsCm: single; +begin + result := FUnits.ConvertHeight(ComputedHeight,cuCentimeter).value; +end; + +function TBGRASVG.GetHeightAsInch: single; +begin + result := FUnits.ConvertHeight(ComputedHeight,cuInch).value; +end; + +function TBGRASVG.GetHeightAsPixel: single; +begin + result := FUnits.ConvertHeight(ComputedHeight,cuPixel).value; +end; + +function TBGRASVG.GetLayer(AIndex: integer): TSVGGroup; +var + i: Integer; +begin + result := nil; + for i := 0 to Content.ElementCount-1 do + begin + if (Content.ElementObject[i] is TSVGGroup) and + TSVGGroup(Content.Element[i]).IsLayer then + begin + if AIndex = 0 then exit(TSVGGroup(Content.Element[i])); + dec(AIndex); + end; + end; +end; + +function TBGRASVG.GetLayerCount: integer; +var + i: Integer; +begin + result := 0; + for i := 0 to Content.ElementCount-1 do + begin + if (Content.ElementObject[i] is TSVGGroup) and + TSVGGroup(Content.Element[i]).IsLayer then + inc(result); + end; +end; + +function TBGRASVG.GetPreserveAspectRatio: TSVGPreserveAspectRatio; +begin + result := Units.PreserveAspectRatio; +end; + +function TBGRASVG.GetStretchPresentationMatrix(AHorizAlign: TAlignment; + AVertAlign: TTextLayout; w, h: single; ASlice: boolean): TAffineMatrix; +var + rF: TRectF; +begin + with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do + result := AffineMatrixTranslation(x, y); + rF := GetStretchRectF(AHorizAlign, AVertAlign, 0, 0, w, h, ASlice); + with Units.ViewBox do + begin + if size.x > 0 then result := AffineMatrixScale(rF.Width/size.x, 1) * result; + if size.y > 0 then result := AffineMatrixScale(1, rF.Height/size.y) * result; + end; + result := AffineMatrixTranslation(rF.Left, rF.Top) * result; +end; + +function TBGRASVG.GetStretchPresentationMatrix(AUnit: TCSSUnit): TAffineMatrix; +var + w, h: TFloatWithCSSUnit; +begin + w := ComputedWidth; + h := ComputedHeight; + result := GetStretchPresentationMatrix(Units.ConvertWidth(w, AUnit).value, + Units.ConvertHeight(h, AUnit).value, true); +end; + +function TBGRASVG.GetUnits: TSVGUnits; +begin + result := TSVGUnits(FUnits); +end; + +function TBGRASVG.GetUTF8String: utf8string; +var str: TMemoryStream; +begin + str := TMemoryStream.Create; + SaveToStream(str); + setlength(result, str.Size); + str.Position := 0; + str.Read(result[1], length(result)); + str.Free; +end; + +function TBGRASVG.GetViewBox: TSVGViewBox; +begin + result := Units.ViewBox; +end; + +function TBGRASVG.GetViewBox(AUnit: TCSSUnit): TSVGViewBox; +begin + GetViewBoxIndirect(AUnit,result); +end; + +procedure TBGRASVG.GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox); +begin + with Units.ViewBox do + begin + AViewBox.min := FUnits.ConvertCoord(min,cuCustom,AUnit); + AViewBox.size := FUnits.ConvertCoord(size,cuCustom,AUnit); + end; +end; + +function TBGRASVG.GetViewMin(AUnit: TCSSUnit): TPointF; +var + vb: TSVGViewBox; +begin + GetViewBoxIndirect(AUnit,vb); + result:= vb.min; +end; + +function TBGRASVG.GetViewSize(AUnit: TCSSUnit): TPointF; +var + vb: TSVGViewBox; +begin + GetViewBoxIndirect(AUnit,vb); + result:= vb.size; +end; + +function TBGRASVG.GetVisualWidthAsPixel: single; +begin + result := Units.ConvertWidth(VisualWidth, cuPixel).value; +end; + +function TBGRASVG.GetWidth: TFloatWithCSSUnit; +begin + result := TCSSUnitConverter.parseValue(Attribute['width'],FloatWithCSSUnit(Units.ViewBox.size.x,cuCustom)); + if result.CSSUnit = cuCustom then result.CSSUnit := cuPixel; +end; + +function TBGRASVG.GetWidthAsCm: single; +begin + result := FUnits.ConvertWidth(ComputedWidth,cuCentimeter).value; +end; + +function TBGRASVG.GetWidthAsInch: single; +begin + result := FUnits.ConvertWidth(ComputedWidth,cuInch).value; +end; + +function TBGRASVG.GetWidthAsPixel: single; +begin + result := FUnits.ConvertWidth(ComputedWidth,cuPixel).value; +end; + +function TBGRASVG.GetZoomable: boolean; +begin + result := AttributeDef['zoomAndPan','magnify']<>'disable'; +end; + +procedure TBGRASVG.SetContainerHeight(AValue: TFloatWithCSSUnit); +begin + if AValue.CSSUnit = cuPercent then raise exception.Create('Container width cannot be expressed as percentage'); + Units.ContainerHeight := AValue; +end; + +procedure TBGRASVG.SetContainerHeightAsPixel(AValue: single); +begin + ContainerHeight := FloatWithCSSUnit(AValue, cuPixel); +end; + +procedure TBGRASVG.SetContainerWidth(AValue: TFloatWithCSSUnit); +begin + if AValue.CSSUnit = cuPercent then raise exception.Create('Container width cannot be expressed as percentage'); + Units.ContainerWidth := AValue; +end; + +procedure TBGRASVG.SetContainerWidthAsPixel(AValue: single); +begin + ContainerWidth := FloatWithCSSUnit(AValue, cuPixel); +end; + +procedure TBGRASVG.SetAttribute(AName: string; AValue: string); +begin + AName := trim(AName); + if compareText(AName,'viewBox')= 0 then AName := 'viewBox' else + if compareText(AName,'width')=0 then AName := 'width' else + if compareText(AName,'height')=0 then AName := 'height'; + inherited SetAttribute(AName,AValue); + if (AName = 'viewBox') or (AName = 'width') or (AName = 'height') then + Units.Recompute; +end; + +procedure TBGRASVG.SetDefaultDpi(AValue: single); +begin + if FDefaultDpi=AValue then Exit; + FDefaultDpi:=AValue; + Units.Recompute; +end; + +procedure TBGRASVG.SetFontSize(AValue: TFloatWithCSSUnit); +begin + SetVerticalAttributeWithUnit('font-size', AValue); +end; + +procedure TBGRASVG.SetHeight(AValue: TFloatWithCSSUnit); +begin + if AValue.CSSUnit = cuPixel then AValue.CSSUnit := cuCustom; + Attribute['height'] := TCSSUnitConverter.formatValue(AValue); + Units.Recompute; +end; + +procedure TBGRASVG.SetHeightAsCm(AValue: single); +begin + Height := FloatWithCSSUnit(AValue,cuCentimeter); +end; + +procedure TBGRASVG.SetHeightAsInch(AValue: single); +begin + Height := FloatWithCSSUnit(AValue,cuInch); +end; + +procedure TBGRASVG.SetHeightAsPixel(AValue: single); +begin + Height := FloatWithCSSUnit(AValue,cuPixel); +end; + +procedure TBGRASVG.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); +begin + Attribute['preserveAspectRatio'] := AValue.ToString; + Units.Recompute; +end; + +procedure TBGRASVG.SetUTF8String(AValue: utf8string); +var str: TMemoryStream; +begin + str:= TMemoryStream.Create; + str.Write(AValue[1],length(AValue)); + str.Position:= 0; + LoadFromStream(str); + str.Free; +end; + +{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607 +procedure TBGRASVG.SetViewBox(AValue: TSVGViewBox); +begin + Units.ViewBox := AValue; +end; +{$POP} + +procedure TBGRASVG.SetWidth(AValue: TFloatWithCSSUnit); +begin + if AValue.CSSUnit = cuPixel then AValue.CSSUnit := cuCustom; + Attribute['width'] := TCSSUnitConverter.formatValue(AValue); + Units.Recompute; +end; + +procedure TBGRASVG.SetWidthAsCm(AValue: single); +begin + Width := FloatWithCSSUnit(AValue,cuCentimeter); +end; + +procedure TBGRASVG.SetWidthAsInch(AValue: single); +begin + Width := FloatWithCSSUnit(AValue,cuInch); +end; + +procedure TBGRASVG.SetWidthAsPixel(AValue: single); +begin + Width := FloatWithCSSUnit(AValue,cuPixel); +end; + +procedure TBGRASVG.SetZoomable(AValue: boolean); +begin + if AValue then + Attribute['zoomAndPan'] := 'magnify' + else + Attribute['zoomAndPan'] := 'disable'; +end; + +procedure TBGRASVG.Init(ACreateEmpty: boolean); +begin + FDefaultDpi := 96; //web browser default + if ACreateEmpty then + begin + FXml := TXMLDocument.Create; + FDomElem := FXml.CreateElement('svg'); + FUnits := TSVGUnits.Create(FDomElem,@FDefaultDpi); + Units.OnRecompute:= @UnitsRecompute; + FDataLink := TSVGDataLink.Create(nil); + FContent := TSVGContent.Create(FDomElem,FUnits,FDataLink); + FXml.AppendChild(FDomElem); + end; +end; + +function TBGRASVG.GetViewBoxAlignment(AHorizAlign: TAlignment; + AVertAlign: TTextLayout; AUnit: TCSSUnit): TPointF; +var vb: TSVGViewBox; +begin + GetViewBoxIndirect(AUnit, vb); + with vb do + begin + case AHorizAlign of + taCenter: result.x := -(min.x+size.x*0.5); + taRightJustify: result.x := -(min.x+size.x); + else + {taLeftJustify:} result.x := -min.x; + end; + case AVertAlign of + tlCenter: result.y := -(min.y+size.y*0.5); + tlBottom: result.y := -(min.y+size.y); + else + {tlTop:} result.y := -min.y; + end; + end; +end; + +function TBGRASVG.GetViewBoxScale: TPointF; +var + svs: TSVGSize; + vb: TSVGViewBox; +begin + svs := Units.StretchedViewSize; + vb := ViewBox; + if vb.size.x <> 0 then + result.x := Units.ConvertWidth(svs.width, cuPixel).value / vb.size.x + else result.x := 1; + if vb.size.y <> 0 then + result.y := Units.ConvertHeight(svs.Height, cuPixel).value / vb.size.y + else result.y := 1; +end; + +procedure TBGRASVG.UnitsRecompute(Sender: TObject); +begin + FContent.Recompute; +end; + +constructor TBGRASVG.Create; +begin + Init(True); +end; + +constructor TBGRASVG.Create(AWidth, AHeight: single; AUnit: TCSSUnit); +begin + Init(True); + Width := FloatWithCSSUnit(AWidth,AUnit); + Height := FloatWithCSSUnit(AHeight,AUnit); +end; + +constructor TBGRASVG.Create(AFilenameUTF8: string); +begin + Init(False); + LoadFromFile(AFilenameUTF8); +end; + +constructor TBGRASVG.Create(AStream: TStream); +begin + Init(False); + LoadFromStream(AStream); +end; + +constructor TBGRASVG.CreateFromString(AUTF8String: string); +begin + Init(False); + AsUTF8String:= AUTF8String; +end; + +destructor TBGRASVG.Destroy; +begin + FreeAndNil(FContent); + FreeAndNil(FDataLink); + FreeAndNil(FUnits); + FDomElem:= nil; + FreeAndNil(FXml); + inherited Destroy; +end; + +function TBGRASVG.Duplicate: TBGRASVG; +var + stream: TMemoryStream; + svg: TBGRASVG; +begin + stream := TMemoryStream.Create; + svg := nil; + try + SaveToStream(stream); + stream.Position:= 0; + svg := TBGRASVG.Create; + svg.DefaultDpi:= DefaultDpi; + svg.LoadFromStream(stream); + result := svg; + svg := nil; + finally + svg.Free; + stream.Free + end; +end; + +procedure TBGRASVG.CropToViewBox(AScale: single); +var w,h: single; +begin + w:= VisualWidthAsPixel * AScale; + h:= VisualHeightAsPixel * AScale; + ViewBox := Units.ViewBox; // make sure viewbox is explicit + WidthAsPixel:= w; + HeightAsPixel:= h; +end; + +procedure TBGRASVG.LoadFromFile(AFilenameUTF8: string); +var stream: TStream; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(stream, UTF8ToUTF16(FilenameToURI(AFilenameUTF8))); + finally + stream.Free; + end; +end; + +procedure TBGRASVG.LoadFromStream(AStream: TStream; AURI: UnicodeString); +var xml: TXMLDocument; + root: TDOMNode; + byteOrderMark: packed array[1..3] of byte; + startPos: int64; + parser: TDOMParser; + source: TXMLInputSource; +begin + //skip utf8 byte order mark + startPos:= AStream.Position; + if AStream.Read({%H-}byteOrderMark,sizeof(byteOrderMark)) = 3 then + begin + if (byteOrderMark[1] = $ef) and (byteOrderMark[2] = $bb) and (byteOrderMark[3] = $bf) then + inc(startPos, 3); + end; + AStream.Position:= startPos; + source := TXMLInputSource.Create(AStream); + source.BaseURI:= AURI; + parser := TDOMParser.Create; + parser.Options.PreserveWhitespace:= true; + try + parser.Parse(source, xml); + finally + parser.Free; + source.Free; + end; + root := xml.FirstChild; + while (root <> nil) and not (root is TDOMElement) do root := root.NextSibling; + if root = nil then + begin + xml.Free; + raise exception.Create('Root node not found'); + end; + FreeAndNil(FContent); + FreeAndNil(FDataLink); + FreeAndNil(FUnits); + FreeAndNil(FXml); + FXml := xml; + FDomElem := root as TDOMElement; + FUnits := TSVGUnits.Create(FDomElem,@FDefaultDpi); + Units.OnRecompute:= @UnitsRecompute; + FDataLink := TSVGDataLink.Create(nil); + FContent := TSVGContent.Create(FDomElem,FUnits,FDataLink); +end; + +procedure TBGRASVG.LoadFromResource(AFilename: string); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + LoadFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TBGRASVG.SaveToFile(AFilenameUTF8: string); +var stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); + try + SaveToStream(stream); + finally + stream.free; + end; +end; + +procedure TBGRASVG.SaveToStream(AStream: TStream); +begin + if Attribute['xmlns'] = '' then Attribute['xmlns'] := SvgNamespace; + if (NamespaceURI['xlink'] = '') and NeedNamespace('xlink') then + NamespaceURI['xlink'] := 'http://www.w3.org/1999/xlink'; + WriteXMLFile(FXml, AStream); +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; x, y: single; AUnit: TCSSUnit; AScale: boolean); +var prevMatrix: TAffineMatrix; +begin + prevMatrix := ACanvas2d.matrix; + ACanvas2d.translate(x,y); + if AScale then + with GetViewBoxScale do ACanvas2d.scale(x, y); + with GetViewBoxAlignment(AHorizAlign,AVertAlign,cuPixel) do ACanvas2d.translate(x,y); + Draw(ACanvas2d, 0,0, AUnit); + ACanvas2d.matrix := prevMatrix; +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; x, y: single; destDpi: single; AScale: boolean); +begin + Draw(ACanvas2d, AHorizAlign,AVertAlign, x,y, PointF(destDpi,destDpi), AScale); +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; x, y: single; destDpi: TPointF; AScale: boolean); +begin + ACanvas2d.save; + ACanvas2d.translate(x,y); + ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); + if AScale then + with GetViewBoxScale do ACanvas2d.scale(x, y); + with GetViewBoxAlignment(AHorizAlign,AVertAlign, cuPixel) do ACanvas2d.translate(x,y); + Draw(ACanvas2d, 0,0, cuPixel); + ACanvas2d.restore; +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); +var prevLinearBlend: boolean; + prevFontSize: TFloatWithCSSUnit; +begin + prevLinearBlend:= ACanvas2d.linearBlend; + acanvas2d.linearBlend := true; + ACanvas2d.save; + ACanvas2d.translate(x,y); + ACanvas2d.strokeMatrix := ACanvas2d.matrix; + prevFontSize := EnterFontSize(true); + Content.Draw(ACanvas2d,AUnit); + ExitFontSize(prevFontSize); + ACanvas2d.restore; + ACanvas2d.linearBlend := prevLinearBlend; +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: single); +begin + Draw(ACanvas2d, x,y, PointF(destDpi,destDpi)); +end; + +procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: TPointF); +begin + ACanvas2d.save; + ACanvas2d.translate(x,y); + ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); + Draw(ACanvas2d, 0,0, cuPixel); + ACanvas2d.restore; +end; + +procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single; useSvgAspectRatio: boolean); +var vb: TSVGViewBox; +begin + if useSvgAspectRatio then + begin + with preserveAspectRatio do + StretchDraw(ACanvas2d, HorizAlign, VertAlign, x,y,w,h, Slice); + exit; + end; + ACanvas2d.save; + ACanvas2d.translate(x,y); + ACanvas2d.strokeResetTransform; + GetViewBoxIndirect(cuPixel,vb); + with vb do + begin + ACanvas2d.translate(-min.x,-min.y); + if size.x <> 0 then + ACanvas2d.scale(w/size.x,1); + if size.y <> 0 then + ACanvas2d.scale(1,h/size.y); + end; + Draw(ACanvas2d, 0,0, cuPixel); + ACanvas2d.restore; +end; + +procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean); +begin + StretchDraw(ACanvas2d, r.Left, r.Top, r.Width, r.Height, useSvgAspectRatio); +end; + +procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); +var + w, h: TFloatWithCSSUnit; +begin + w := ComputedWidth; + h := ComputedHeight; + StretchDraw(ACanvas2d, x, y, Units.ConvertWidth(w, AUnit).value, + Units.ConvertHeight(h, AUnit).value, true); +end; + +procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; x, y, w, h: single; + ASlice: boolean); +var r: TRectF; +begin + r := GetStretchRectF(AHorizAlign,AVertAlign, x, y, w, h, ASlice); + StretchDraw(ACanvas2d, r); +end; + +procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; r: TRectF; ASlice: boolean); +begin + StretchDraw(ACanvas2d, AHorizAlign, AVertAlign, r.Left, r.Top, r.Width, r.Height, ASlice); +end; + +function TBGRASVG.GetStretchRectF(x,y,w,h: single): TRectF; +begin + result := Units.GetStretchRectF(RectWithSizeF(x,y,w,h), preserveAspectRatio); +end; + +function TBGRASVG.GetPresentationMatrix(AHorizAlign: TAlignment; + AVertAlign: TTextLayout; AUnit: TCSSUnit; AScale: boolean): TAffineMatrix; +begin + with GetViewBoxAlignment(AHorizAlign, AVertAlign, AUnit) do + result := AffineMatrixTranslation(x, y); + if AScale then + with GetViewBoxScale do + result := AffineMatrixScale(x, y) * result; +end; + +function TBGRASVG.GetStretchPresentationMatrix(w, h: single; + useSvgAspectRatio: boolean): TAffineMatrix; +var + rF: TRectF; +begin + if not useSvgAspectRatio then + begin + with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do + result := AffineMatrixTranslation(x, y); + with Units.ViewBox do + begin + if size.x > 0 then result := AffineMatrixScale(w/size.x, 1) * result; + if size.y > 0 then result := AffineMatrixScale(1, h/size.y) * result; + end; + end else + begin + with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do + result := AffineMatrixTranslation(x, y); + rF := GetStretchRectF(0,0,w,h); + with Units.ViewBox do + begin + if size.x > 0 then result := AffineMatrixScale(rF.Width/size.x, 1) * result; + if size.y > 0 then result := AffineMatrixScale(1, rF.Height/size.y) * result; + end; + result := AffineMatrixTranslation(rF.Left, rF.Top) * result; + end; +end; + +function TBGRASVG.GetStretchRectF(AHorizAlign: TAlignment; + AVertAlign: TTextLayout; x, y, w, h: single; ASlice: boolean): TRectF; +var + aspect: TSVGPreserveAspectRatio; +begin + aspect.HorizAlign:= AHorizAlign; + aspect.VertAlign:= AVertAlign; + aspect.Preserve:= true; + aspect.Slice:= ASlice; + result := Units.GetStretchRectF(RectWithSizeF(x, y, w, h), aspect); +end; + +function TBGRASVG.FindElementById(AID: string): TSVGElement; +begin + result := DataLink.FindElementById(AId, TSVGElement); +end; + +function TBGRASVG.FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; +begin + result := DataLink.FindElementById(AId, AClass); +end; + +procedure TBGRASVG.ConvertToUnit(AUnit: TCSSUnit); +var + prevFontSize: TFloatWithCSSUnit; +begin + prevFontSize := Units.CurrentFontEmHeight; + Units.CurrentFontEmHeight := Units.RootFontEmHeight; + if HasAttribute('font-size') then + SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); + Units.CurrentFontEmHeight := prevFontSize; + + prevFontSize := EnterFontSize(true); + inherited ConvertToUnit(AUnit); + Content.ConvertToUnit(AUnit); + ExitFontSize(prevFontSize); +end; + +initialization + + DefaultBGRAImageReader[ifSvg] := TFPReaderSVG; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgoriginal.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgoriginal.pas new file mode 100644 index 0000000..e7774e3 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgoriginal.pas @@ -0,0 +1,702 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASVGOriginal; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, BGRASVG, BGRATransform, + BGRALayerOriginal, BGRAUnits, BGRALayers; + +type + TBGRALayerSVGOriginal = class; + + { TBGRASVGOriginalDiff } + + TBGRASVGOriginalDiff = class(TBGRAOriginalDiff) + protected + FContentVersionBefore,FContentVersionAfter: integer; + FSvgStreamBefore,FSvgStreamAfter: TMemoryStream; + FDpiBefore, FDpiAfter: single; + public + constructor Create(AFromOriginal: TBGRALayerSVGOriginal); + procedure ComputeDiff(AToOriginal: TBGRALayerSVGOriginal); + procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; + procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; + function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; + procedure Append(ADiff: TBGRAOriginalDiff); override; + function IsIdentity: boolean; override; + destructor Destroy; override; + end; + + { TBGRALayerSVGOriginal } + + TBGRALayerSVGOriginal = class(TBGRALayerCustomOriginal) + private + function GetDPI: single; + function GetSvgHeight: single; + function GetSvgWidth: single; + procedure SetDPI(AValue: single); + protected + FSVG: TBGRASVG; + FPresentationMatrix: TAffineMatrix; + FDiff: TBGRASVGOriginalDiff; + FContentVersion: integer; + procedure BeginUpdate; + procedure EndUpdate; + procedure ComputePresentation(AContainerWidth, AContainerHeight: integer; AScaleDPI: single); + public + constructor Create; override; + destructor Destroy; override; + procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override; + function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override; + procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; + procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; + procedure LoadFromStream(AStream: TStream); override; + procedure SaveSVGToStream(AStream: TStream); + procedure SetSVG(ASVG: TBGRASVG; AContainerWidth: integer = 640; + AContainerHeight: integer = 480; AScaleDPI: single = 1); + procedure LoadSVGFromStream(AStream: TStream; AContainerWidth: integer = 640; + AContainerHeight: integer = 480; AScaleDPI: single = 1); + function GetSVGCopy: TBGRASVG; + class function StorageClassName: RawByteString; override; + class function CanConvertToSVG: boolean; override; + function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG; override; + property Width: single read GetSvgWidth; + property Height: single read GetSvgHeight; + property DPI: single read GetDPI write SetDPI; + property PresentationMatrix: TAffineMatrix read FPresentationMatrix; + end; + + { TBGRALayeredSVG } + + TBGRALayeredSVG = class(TBGRALayeredBitmap) + protected + function GetMimeType: string; override; + procedure InternalLoadFromStream(AStream: TStream); + procedure InternalSaveToStream(AStream: TStream); + public + ContainerWidth, ContainerHeight, DefaultSvgDPI, DPI: integer; + DefaultLayerName: string; + constructor Create; overload; override; + constructor Create(AWidth, AHeight: integer); overload; override; + procedure LoadFromStream(AStream: TStream); override; + procedure LoadFromFile(const filenameUTF8: string); override; + procedure SaveToStream(AStream: TStream); override; + procedure SaveToFile(const filenameUTF8: string); override; + end; + +implementation + +uses BGRACanvas2D, BGRAMemDirectory, BGRAUTF8, BGRASVGShapes, math, BGRASVGType, + BGRAVectorize; + +{ TBGRASVGOriginalDiff } + +constructor TBGRASVGOriginalDiff.Create(AFromOriginal: TBGRALayerSVGOriginal); +begin + if Assigned(AFromOriginal.FSVG) then + begin + FSvgStreamBefore := TMemoryStream.Create; + AFromOriginal.FSVG.SaveToStream(FSvgStreamBefore); + end; + FContentVersionBefore:= AFromOriginal.FContentVersion; + FDpiBefore:= AFromOriginal.DPI; +end; + +procedure TBGRASVGOriginalDiff.ComputeDiff(AToOriginal: TBGRALayerSVGOriginal); +begin + FreeAndNil(FSvgStreamAfter); + if Assigned(AToOriginal.FSVG) then + begin + FSvgStreamAfter := TMemoryStream.Create; + AToOriginal.FSVG.SaveToStream(FSvgStreamAfter); + end; + FContentVersionAfter:= AToOriginal.FContentVersion; + FDpiAfter:= AToOriginal.DPI; +end; + +procedure TBGRASVGOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); +var + orig: TBGRALayerSVGOriginal; +begin + orig := AOriginal as TBGRALayerSVGOriginal; + if Assigned(FSvgStreamAfter) then + begin + FSvgStreamAfter.Position:= 0; + orig.FSVG.LoadFromStream(FSvgStreamAfter); + end else + orig.FSVG.Content.Clear; + orig.FContentVersion := FContentVersionAfter; +end; + +procedure TBGRASVGOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); +var + orig: TBGRALayerSVGOriginal; +begin + orig := AOriginal as TBGRALayerSVGOriginal; + if Assigned(FSvgStreamBefore) then + begin + FSvgStreamBefore.Position:= 0; + orig.FSVG.LoadFromStream(FSvgStreamBefore); + end else + orig.FSVG.Content.Clear; + orig.FContentVersion := FContentVersionBefore; +end; + +function TBGRASVGOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; +begin + result := (ADiff is TBGRASVGOriginalDiff) and + (TBGRASVGOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter); +end; + +procedure TBGRASVGOriginalDiff.Append(ADiff: TBGRAOriginalDiff); +var + next: TBGRASVGOriginalDiff; +begin + next := ADiff as TBGRASVGOriginalDiff; + if next.FContentVersionAfter < FContentVersionAfter then + raise exception.Create('Cannot append diff made before this one.'); + FDpiAfter:= next.FDpiAfter; + FreeAndNil(FSvgStreamAfter); + if Assigned(next.FSvgStreamAfter) then + begin + FSvgStreamAfter := TMemoryStream.Create; + next.FSvgStreamAfter.Position:= 0; + FSvgStreamAfter.CopyFrom(next.FSvgStreamAfter, next.FSvgStreamAfter.Size); + end; + FContentVersionAfter:= next.FContentVersionAfter; +end; + +function TBGRASVGOriginalDiff.IsIdentity: boolean; +begin + result := (FDpiBefore = FDpiAfter) and + ( ((FSvgStreamBefore=nil) and (FSvgStreamAfter=nil)) or + (Assigned(FSvgStreamBefore) and Assigned(FSvgStreamAfter) and + (FSvgStreamBefore.Size = FSvgStreamAfter.Size) and + CompareMem(FSvgStreamBefore.Memory,FSvgStreamAfter.Memory,FSvgStreamBefore.Size)) ); +end; + +destructor TBGRASVGOriginalDiff.Destroy; +begin + FSvgStreamBefore.Free; + inherited Destroy; +end; + +{ TBGRALayerSVGOriginal } + +function TBGRALayerSVGOriginal.GetDPI: single; +begin + result := FSVG.DefaultDpi; +end; + +function TBGRALayerSVGOriginal.GetSvgHeight: single; +begin + result := FSVG.HeightAsPixel; +end; + +function TBGRALayerSVGOriginal.GetSvgWidth: single; +begin + result := FSVG.WidthAsPixel; +end; + +procedure TBGRALayerSVGOriginal.SetDPI(AValue: single); +begin + BeginUpdate; + FSVG.DefaultDpi:= AValue; + EndUpdate; +end; + +procedure TBGRALayerSVGOriginal.BeginUpdate; +begin + if DiffExpected and (FDiff=nil) then + FDiff := TBGRASVGOriginalDiff.Create(self); +end; + +procedure TBGRALayerSVGOriginal.EndUpdate; +begin + if Assigned(FDiff) then FDiff.ComputeDiff(self); + NotifyChange(FDiff); + FDiff := nil; +end; + +procedure TBGRALayerSVGOriginal.ComputePresentation(AContainerWidth, AContainerHeight: integer; + AScaleDPI: single); +var + compWidth, compHeight: single; +begin + FSVG.Units.ContainerWidth := FloatWithCSSUnit(AContainerWidth / AScaleDPI, cuPixel); + FSVG.Units.ContainerHeight := FloatWithCSSUnit(AContainerHeight / AScaleDPI, cuPixel); + compWidth := FSVG.WidthAsPixel; + compHeight := FSVG.HeightAsPixel; + FSVG.WidthAsPixel := compWidth * AScaleDPI; + FSVG.HeightAsPixel := compHeight * AScaleDPI; + FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel); +end; + +constructor TBGRALayerSVGOriginal.Create; +begin + inherited Create; + FSVG := TBGRASVG.Create; + FContentVersion := 0; +end; + +destructor TBGRALayerSVGOriginal.Destroy; +begin + FSVG.Free; + FDiff.Free; + inherited Destroy; +end; + +procedure TBGRALayerSVGOriginal.Render(ADest: TBGRABitmap; + AMatrix: TAffineMatrix; ADraft: boolean); +var + c2D: TBGRACanvas2D; +begin + if Assigned(FSVG) then + begin + c2D := TBGRACanvas2D.Create(ADest); + c2D.transform(AMatrix*FPresentationMatrix); + c2D.fontRenderer := TBGRAVectorizedFontRenderer.Create; + if ADraft then c2D.antialiasing := false; + FSVG.Draw(c2D, 0, 0, cuPixel); + c2D.Free; + end; +end; + +function TBGRALayerSVGOriginal.GetRenderBounds(ADestRect: TRect; + AMatrix: TAffineMatrix): TRect; +var + aff: TAffineBox; + r: TRectF; +begin + if Assigned(FSVG) then + begin + with FSVG.ViewBox do + r := RectWithSizeF(min.x, min.y, size.x, size.y); + aff := AMatrix * FPresentationMatrix * TAffineBox.AffineBox(r); + result := aff.RectBounds; + end else + result := EmptyRect; +end; + +procedure TBGRALayerSVGOriginal.LoadFromStorage( + AStorage: TBGRACustomOriginalStorage); +var svgStream: TMemoryStream; + valDpi: Single; +begin + svgStream := TMemoryStream.Create; + try + if AStorage.ReadFile('content.svg', svgStream) then + begin + if not Assigned(FSVG) then FSVG := TBGRASVG.Create; + svgStream.Position:= 0; + FSVG.LoadFromStream(svgStream); + end else + begin + FreeAndNil(FSVG); + FSVG := TBGRASVG.Create; + end; + FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel); + FContentVersion:= AStorage.Int['content-version']; + finally + svgStream.Free; + end; + valDpi := AStorage.Float['dpi']; + if valDpi <> EmptySingle then + FSVG.DefaultDpi:= valDpi; +end; + +procedure TBGRALayerSVGOriginal.SaveToStorage( + AStorage: TBGRACustomOriginalStorage); +var svgStream: TMemoryStream; +begin + if Assigned(FSVG) then + begin + if FContentVersion > AStorage.Int['content-version'] then + begin + svgStream := TMemoryStream.Create; + try + FSVG.SaveToStream(svgStream); + AStorage.WriteFile('content.svg', svgStream, true, true); + svgStream := nil; + AStorage.Int['content-version'] := FContentVersion; + finally + svgStream.Free; + end; + end; + AStorage.Float['dpi'] := FSVG.DefaultDpi; + end; +end; + +procedure TBGRALayerSVGOriginal.LoadFromStream(AStream: TStream); +begin + if TMemDirectory.CheckHeader(AStream) then + inherited LoadFromStream(AStream) + else + LoadSVGFromStream(AStream); +end; + +procedure TBGRALayerSVGOriginal.SaveSVGToStream(AStream: TStream); +begin + FSVG.SaveToStream(AStream); +end; + +procedure TBGRALayerSVGOriginal.SetSVG(ASVG: TBGRASVG; AContainerWidth: integer; + AContainerHeight: integer; AScaleDPI: single); +begin + BeginUpdate; + FSVG.Free; + FSVG := ASVG; + ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI); + Inc(FContentVersion); + EndUpdate; +end; + +procedure TBGRALayerSVGOriginal.LoadSVGFromStream(AStream: TStream; AContainerWidth: integer; + AContainerHeight: integer; AScaleDPI: single); +begin + BeginUpdate; + FSVG.LoadFromStream(AStream); + ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI); + Inc(FContentVersion); + EndUpdate; +end; + +function TBGRALayerSVGOriginal.GetSVGCopy: TBGRASVG; +begin + result := FSVG.Duplicate; +end; + +class function TBGRALayerSVGOriginal.StorageClassName: RawByteString; +begin + result := 'svg'; +end; + +class function TBGRALayerSVGOriginal.CanConvertToSVG: boolean; +begin + Result:= true; +end; + +function TBGRALayerSVGOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG; +begin + if not IsAffineMatrixIdentity(AMatrix) then + raise exception.Create('Matrix not valid for SVG original'); + AOffset := Point(0,0); + Result:= GetSVGCopy; +end; + +{ TBGRALayeredSVG } + +function TBGRALayeredSVG.GetMimeType: string; +begin + Result:= 'image/svg+xml'; +end; + +procedure TBGRALayeredSVG.InternalLoadFromStream(AStream: TStream); +var + svg, svgLayer: TBGRASVG; + visualWidth, visualHeight: single; + svgOrig: TBGRALayerSVGOriginal; + idx, i, j: Integer; + layer: TSVGGroup; + prefix: String; + originalViewBox: TSVGViewBox; + m: TAffineMatrix; +begin + svg := TBGRASVG.Create; + try + svg.DefaultDpi := DefaultSvgDPI; + svg.LoadFromStream(AStream); + svg.Units.ContainerWidth := FloatWithCSSUnit(ContainerWidth / DPI * svg.DefaultDpi, cuPixel); + svg.Units.ContainerHeight := FloatWithCSSUnit(ContainerHeight / DPI * svg.DefaultDpi, cuPixel); + svg.CropToViewBox(DPI / svg.DefaultDpi); + visualWidth := svg.WidthAsPixel; + visualHeight := svg.HeightAsPixel; + Clear; + SetSize(floor(visualWidth + 0.95),floor(visualHeight + 0.95)); + if svg.LayerCount > 0 then + begin + for i := 0 to svg.LayerCount-1 do + begin + layer := svg.Layer[i]; + svgLayer := TBGRASVG.Create; + svgLayer.DefaultDpi:= svg.DefaultDpi; + svgLayer.WidthAsPixel := visualWidth; + svgLayer.HeightAsPixel := visualHeight; + for j := 0 to svg.NamespaceCount-1 do + begin + prefix := svg.NamespacePrefix[j]; + svgLayer.NamespaceURI[prefix] := svg.NamespaceURI[prefix]; + end; + try + svgLayer.ViewBox := svg.ViewBox; + if layer.DOMElement.hasAttribute('bgra:originalViewBox') then + begin + originalViewBox := TSVGViewBox.Parse(layer.DOMElement.GetAttribute('bgra:originalViewBox')); + svgLayer.WidthAsPixel := originalViewBox.size.x; + svgLayer.HeightAsPixel := originalViewBox.size.y; + svgLayer.ViewBox := originalViewBox; + m := layer.matrix[cuPixel] * AffineMatrixTranslation(originalViewBox.min.x, originalViewBox.min.y); + end else + m := layer.matrix[cuPixel]; + for j := 0 to svg.Content.IndexOfElement(layer)-1 do + if svg.Content.ElementObject[j] is TSVGDefine then + svgLayer.Content.CopyElement(svg.Content.ElementObject[j]); + for j := 0 to layer.Content.ElementCount-1 do + svgLayer.Content.CopyElement(layer.Content.ElementObject[j]); + svgOrig := TBGRALayerSVGOriginal.Create; + svgOrig.SetSVG(svgLayer); + svgLayer := nil; + idx := AddLayerFromOwnedOriginal(svgOrig); + LayerName[idx] := layer.Name; + LayerVisible[idx] := layer.Visible; + LayerOpacity[idx] := min(255,max(0,round(layer.opacity*255))); + BlendOperation[idx] := layer.mixBlendMode; + LayerOriginalMatrix[idx] := m; + RenderLayerFromOriginal(idx); + finally + svgLayer.Free; + end; + end; + end else + begin + svgOrig := TBGRALayerSVGOriginal.Create; + svgOrig.SetSVG(svg); + svg := nil; + idx := AddLayerFromOwnedOriginal(svgOrig); + LayerName[idx] := DefaultLayerName+'1'; + RenderLayerFromOriginal(idx); + end; + finally + svg.Free; + end; +end; + +procedure TBGRALayeredSVG.InternalSaveToStream(AStream: TStream); + + procedure StoreLayerBitmap(ABitmap: TBGRABitmap; AOwned: boolean; const AMatrix: TAffineMatrix; + ADestElem: TSVGCustomElement; AContent: TSVGContent); + var + img: TSVGImage; + ab: TAffineBox; + vb: TSVGViewBox; + begin + ab := AMatrix * TAffineBox.AffineBox(PointF(0, 0), PointF(ABitmap.Width, 0), PointF(0, ABitmap.Height)); + + img := AContent.AppendImage(AMatrix[1,3], AMatrix[2, 3], ABitmap.Width, ABitmap.Height, ABitmap, AOwned); + img.matrix[cuCustom] := AffineMatrixLinear(AMatrix); + + if ADestElem is TSVGGroup then + with TSVGGroup(ADestElem) do + begin + with ab.RectBounds do + begin + vb.min := PointF(Left, Top); + vb.size := PointF(Width, Height); + end; + DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); + DOMElement.SetAttribute('bgra:originalViewBox', vb.ToString); + end; + end; + + procedure StoreLayer(ALayerIndex: integer; ASVG: TBGRASVG; ADestElem: TSVGCustomElement; + ADest: TSVGContent; out AMatrix: TAffineMatrix); + var + c: TBGRALayerOriginalAny; + bmp, part: TBGRABitmap; + layerSvg: TBGRASVG; + i: Integer; + prefix: String; + origViewBox: TSVGViewBox; + wantedOfs: TPoint; + r: TRect; + begin + AMatrix := AffineMatrixIdentity; + if LayerOriginalKnown[ALayerIndex] then + c:= LayerOriginalClass[ALayerIndex] + else c := nil; + + if Assigned(c) and c.CanConvertToSVG then + begin + if LayerOriginal[ALayerIndex].IsInfiniteSurface then + begin + layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(LayerOriginalMatrix[ALayerIndex], + wantedOfs) as TBGRASVG; + layerSvg.WidthAsPixel:= Self.Width; + layerSvg.HeightAsPixel:= Self.Height; + AMatrix := AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); + end else + begin + layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(AffineMatrixIdentity, + wantedOfs) as TBGRASVG; + AMatrix:= LayerOriginalMatrix[ALayerIndex] + * AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y) + * layerSvg.GetStretchPresentationMatrix(cuPixel); + end; + origViewBox := layerSvg.ViewBox; + try + layerSvg.ConvertToUnit(cuCustom); + if ADestElem is TSVGGroup then + with TSVGGroup(ADestElem) do + begin + DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); + DOMElement.SetAttribute('bgra:originalViewBox', origViewBox.ToString); + end; + for i := 0 to layerSvg.Content.ElementCount-1 do + ADest.CopyElement(layerSvg.Content.ElementObject[i]); + for i := 0 to layerSvg.NamespaceCount-1 do + begin + prefix := layerSvg.NamespacePrefix[i]; + ASVG.NamespaceURI[prefix] := layerSvg.NamespaceURI[prefix]; + end; + finally + layerSvg.Free; + end; + end else + begin + r := LayerBitmap[ALayerIndex].GetImageBounds; + if (r.Left = 0) and (r.Top = 0) and (r.Width = LayerBitmap[ALayerIndex].Width) and + (r.Height = LayerBitmap[ALayerIndex].Height) then + StoreLayerBitmap(LayerBitmap[ALayerIndex], false, + AffineMatrixTranslation(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y), ADestElem, ADest) + else + begin + part := LayerBitmap[ALayerIndex].GetPart(r); + StoreLayerBitmap(part, true, + AffineMatrixTranslation(LayerOffset[ALayerIndex].X + r.Left, + LayerOffset[ALayerIndex].Y + r.Top), ADestElem, ADest) + end; + end; + end; + +var + svg: TBGRASVG; + vb : TSVGViewBox; + i,j: Integer; + g: TSVGGroup; + m: TAffineMatrix; + identifiers, newIdentifiers: TStringList; +begin + svg := TBGRASVG.Create; + identifiers := nil; + newIdentifiers := nil; + try + svg.WidthAsPixel := Width; + svg.HeightAsPixel := Height; + vb.min := PointF(0, 0); + vb.size := PointF(Width, Height); + svg.ViewBox := vb; + if (NbLayers = 1) and (LayerOpacity[0] = 255) and LayerVisible[0] and + (LayerOriginalGuid[0] = GUID_NULL) then + begin + StoreLayer(0, svg, svg, svg.Content, m); + end else + begin + svg.NamespaceURI['inkscape'] := 'http://www.inkscape.org/namespaces/inkscape'; + identifiers := TStringList.Create; + newIdentifiers := TStringList.Create; + for i := 0 to NbLayers-1 do + begin + g := svg.Content.AppendGroup; + g.IsLayer := true; + g.Name:= LayerName[i]; + g.opacity:= LayerOpacity[i]/255; + g.Visible:= LayerVisible[i]; + g.mixBlendMode:= BlendOperation[i]; + StoreLayer(i, svg, g, g.Content, m); + g.matrix[cuPixel] := m; + identifiers.Clear; + g.ListIdentifiers(identifiers); + newIdentifiers.Clear; + for j := 0 to identifiers.Count-1 do + newIdentifiers.Add('layer'+inttostr(i+1)+'-'+identifiers[j]); + g.RenameIdentifiers(identifiers, newIdentifiers); + end; + end; + svg.SaveToStream(AStream); + finally + newIdentifiers.Free; + identifiers.Free; + svg.Free; + end; +end; + +constructor TBGRALayeredSVG.Create; +begin + inherited Create; + ContainerWidth:= 640; + ContainerHeight:= 480; + DefaultLayerName := 'Layer'; + DPI := 96; + DefaultSvgDPI:= 96; +end; + +constructor TBGRALayeredSVG.Create(AWidth, AHeight: integer); +begin + inherited Create(AWidth, AHeight); + ContainerWidth:= 640; + ContainerHeight:= 480; + DefaultLayerName := 'Layer'; +end; + +procedure TBGRALayeredSVG.LoadFromStream(AStream: TStream); +begin + OnLayeredBitmapLoadFromStreamStart; + try + InternalLoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + end; +end; + +procedure TBGRALayeredSVG.LoadFromFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); + OnLayeredBitmapLoadStart(filenameUTF8); + try + LoadFromStream(AStream); + finally + OnLayeredBitmapLoaded; + AStream.Free; + end; +end; + +procedure TBGRALayeredSVG.SaveToStream(AStream: TStream); +begin + OnLayeredBitmapSaveToStreamStart; + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + end; +end; + +procedure TBGRALayeredSVG.SaveToFile(const filenameUTF8: string); +var AStream: TFileStreamUTF8; +begin + AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate); + OnLayeredBitmapSaveStart(filenameUTF8); + try + InternalSaveToStream(AStream); + finally + OnLayeredBitmapSaved; + AStream.Free; + end; +end; + +procedure RegisterLayeredSvgFormat; +begin + RegisterLayeredBitmapReader('svg', TBGRALayeredSVG); + RegisterLayeredBitmapWriter('svg', TBGRALayeredSVG); +end; + +initialization + + RegisterLayerOriginal(TBGRALayerSVGOriginal); + RegisterLayeredSvgFormat; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgshapes.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgshapes.pas new file mode 100644 index 0000000..e048ec9 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgshapes.pas @@ -0,0 +1,4748 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASVGShapes; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAUnits, DOM, BGRAPath, BGRABitmapTypes, + BGRACanvas2D, BGRASVGType, BGRAGraphics; + +type + TSVGContent = class; + + { TSVGElementWithContent } + + TSVGElementWithContent = class(TSVGElement) + protected + FContent: TSVGContent; + FSubDatalink: TSVGDataLink; + class function OwnDatalink: boolean; virtual; + procedure SetDatalink(AValue: TSVGDataLink); override; + public + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + procedure ListIdentifiers(AResult: TStringList); override; + procedure RenameIdentifiers(AFrom, ATo: TStringList); override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + destructor Destroy; override; + procedure Recompute; override; + property Content: TSVGContent read FContent; + end; + + TSVGGradient = class; + + { TSVGElementWithGradient } + + TSVGElementWithGradient = class(TSVGElement) + private + FFillGradientElement, FStrokeGradientElement: TSVGGradient; + FGradientElementsDefined, FRegisteredToDatalink: boolean; + FFillCanvasGradient, FStrokeCanvasGradient: IBGRACanvasGradient2D; + procedure DatalinkOnLink(Sender: TObject; AElement: TSVGElement; + ALink: boolean); + function EvaluatePercentage(fu: TFloatWithCSSUnit): single; { fu is a percentage of a number [0.0..1.0] } + function GetFillGradientElement: TSVGGradient; + function GetStrokeGradientElement: TSVGGradient; + procedure ResetGradients; + procedure FindGradientElements; + protected + procedure Initialize; override; + procedure AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D); + function CreateCanvasLinearGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; + const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; + function CreateCanvasRadialGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; + const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; + procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override; + procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override; + procedure SetDatalink(AValue: TSVGDataLink); override; + procedure SetFill(AValue: string); override; + procedure SetStroke(AValue: string); override; + public + destructor Destroy; override; + procedure InitializeGradient(ACanvas2d: TBGRACanvas2D; + const origin: TPointF; const w,h: single; AUnit: TCSSUnit); + property FillGradientElement: TSVGGradient read GetFillGradientElement; + property StrokeGradientElement: TSVGGradient read GetStrokeGradientElement; + end; + + { TSVGLine } + + TSVGLine = class(TSVGElement) + private + function GetX1: TFloatWithCSSUnit; + function GetX2: TFloatWithCSSUnit; + function GetY1: TFloatWithCSSUnit; + function GetY2: TFloatWithCSSUnit; + procedure SetX1(AValue: TFloatWithCSSUnit); + procedure SetX2(AValue: TFloatWithCSSUnit); + procedure SetY1(AValue: TFloatWithCSSUnit); + procedure SetY2(AValue: TFloatWithCSSUnit); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property x1: TFloatWithCSSUnit read GetX1 write SetX1; + property y1: TFloatWithCSSUnit read GetY1 write SetY1; + property x2: TFloatWithCSSUnit read GetX2 write SetX2; + property y2: TFloatWithCSSUnit read GetY2 write SetY2; + end; + + { TSVGRectangle } + + TSVGRectangle = class(TSVGElementWithGradient) + private + function GetX: TFloatWithCSSUnit; + function GetY: TFloatWithCSSUnit; + function GetWidth: TFloatWithCSSUnit; + function GetHeight: TFloatWithCSSUnit; + function GetRX: TFloatWithCSSUnit; + function GetRY: TFloatWithCSSUnit; + procedure SetX(AValue: TFloatWithCSSUnit); + procedure SetY(AValue: TFloatWithCSSUnit); + procedure SetWidth(AValue: TFloatWithCSSUnit); + procedure SetHeight(AValue: TFloatWithCSSUnit); + procedure SetRX(AValue: TFloatWithCSSUnit); + procedure SetRY(AValue: TFloatWithCSSUnit); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property x: TFloatWithCSSUnit read GetX write SetX; + property y: TFloatWithCSSUnit read GetY write SetY; + property width: TFloatWithCSSUnit read GetWidth write SetWidth; + property height: TFloatWithCSSUnit read GetHeight write SetHeight; + property rx: TFloatWithCSSUnit read GetRX write SetRX; + property ry: TFloatWithCSSUnit read GetRY write SetRY; + end; + + { TSVGCircle } + + TSVGCircle = class(TSVGElementWithGradient) + private + function GetCX: TFloatWithCSSUnit; + function GetCY: TFloatWithCSSUnit; + function GetR: TFloatWithCSSUnit; + procedure SetCX(AValue: TFloatWithCSSUnit); + procedure SetCY(AValue: TFloatWithCSSUnit); + procedure SetR(AValue: TFloatWithCSSUnit); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property cx: TFloatWithCSSUnit read GetCX write SetCX; + property cy: TFloatWithCSSUnit read GetCY write SetCY; + property r: TFloatWithCSSUnit read GetR write SetR; + end; + + { TSVGEllipse } + + TSVGEllipse = class(TSVGElementWithGradient) + private + function GetCX: TFloatWithCSSUnit; + function GetCY: TFloatWithCSSUnit; + function GetRX: TFloatWithCSSUnit; + function GetRY: TFloatWithCSSUnit; + procedure SetCX(AValue: TFloatWithCSSUnit); + procedure SetCY(AValue: TFloatWithCSSUnit); + procedure SetRX(AValue: TFloatWithCSSUnit); + procedure SetRY(AValue: TFloatWithCSSUnit); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property cx: TFloatWithCSSUnit read GetCX write SetCX; + property cy: TFloatWithCSSUnit read GetCY write SetCY; + property rx: TFloatWithCSSUnit read GetRX write SetRX; + property ry: TFloatWithCSSUnit read GetRY write SetRY; + end; + + { TSVGPath } + + TSVGPath = class(TSVGElementWithGradient) + private + FPath: TBGRAPath; + FBoundingBox: TRectF; + FBoundingBoxComputed: boolean; + function GetBoundingBoxF: TRectF; + function GetPath: TBGRAPath; + function GetPathLength: TFloatWithCSSUnit; + function GetData: string; + procedure SetPathLength(AValue: TFloatWithCSSUnit); + procedure SetData(AValue: string); + protected + function GetDOMElement: TDOMElement; override; + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + destructor Destroy; override; + property d: string read GetData write SetData; + property path: TBGRAPath read GetPath; + property pathLength: TFloatWithCSSUnit read GetPathLength write SetPathLength; + property boundingBoxF: TRectF read GetBoundingBoxF; + end; + + { TSVGPolypoints } + + TSVGPolypoints = class(TSVGElementWithGradient) + private + FBoundingBox: TRectF; + FBoundingBoxComputed: boolean; + function GetBoundingBoxF: TRectF; + function GetClosed: boolean; + function GetPoints: string; + function GetPointsF: ArrayOfTPointF; + procedure SetPoints(AValue: string); + procedure SetPointsF(AValue: ArrayOfTPointF); + procedure ComputeBoundingBox(APoints: ArrayOfTPointF); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + public + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink); overload; + destructor Destroy; override; + property points: string read GetPoints write SetPoints; + property pointsF: ArrayOfTPointF read GetPointsF write SetPointsF; + property closed: boolean read GetClosed; + property boundingBoxF: TRectF read GetBoundingBoxF; + end; + + { TSVGTextElement } + + TSVGTextElement = class(TSVGElementWithGradient); + + { TSVGTextElementWithContent } + + TSVGTextElementWithContent = class(TSVGTextElement) + protected + FContent: TSVGContent; + public + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; + destructor Destroy; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property Content: TSVGContent read FContent; + end; + + { TSVGTextPositioning } + + TSVGTextPositioning = class(TSVGTextElementWithContent) + private + function GetX: ArrayOfTFloatWithCSSUnit; + function GetY: ArrayOfTFloatWithCSSUnit; + function GetDX: ArrayOfTFloatWithCSSUnit; + function GetDY: ArrayOfTFloatWithCSSUnit; + function GetRotate: ArrayOfTSVGNumber; + procedure SetX(AValue: ArrayOfTFloatWithCSSUnit); + procedure SetY(AValue: ArrayOfTFloatWithCSSUnit); + procedure SetDX(AValue: ArrayOfTFloatWithCSSUnit); + procedure SetDY(AValue: ArrayOfTFloatWithCSSUnit); + procedure SetRotate(AValue: ArrayOfTSVGNumber); + public + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property x: ArrayOfTFloatWithCSSUnit read GetX write SetX; + property y: ArrayOfTFloatWithCSSUnit read GetY write SetY; + property dx: ArrayOfTFloatWithCSSUnit read GetDX write SetDX; + property dy: ArrayOfTFloatWithCSSUnit read GetDY write SetDY; + property rotate: ArrayOfTSVGNumber read GetRotate write SetRotate; + end; + + { TSVGTRef } + + TSVGTRef = class(TSVGTextElement) + private + function GetXlinkHref: string; + procedure SetXlinkHref(AValue: string); + public + class function GetDOMTag: string; override; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + end; + + ArrayOfTextParts = array of record + Level: integer; + BaseElement: TSVGElement; + Text: string; + SplitPos: integer; + AbsoluteCoord: TPointF; + PartStartCoord, PartEndCoord: TPointF; + Bounds: TRectF; + PosUnicode: integer; + InheritedRotation: single; + end; + + { TSVGText } + + TSVGText = class(TSVGTextPositioning) + private + FInGetSimpleText: boolean; + function GetFontBold: boolean; + function GetFontFamily: string; + function GetFontFamilyList: ArrayOfString; + function GetFontItalic: boolean; + function GetFontSize: TFloatWithCSSUnit; + function GetFontStyle: string; + function GetFontStyleLCL: TFontStyles; + function GetFontWeight: string; + function GetSimpleText: string; + function GetTextAnchor: TSVGTextAnchor; + function GetTextDirection: TSVGTextDirection; + function GetTextDecoration: string; + function GetTextLength: TFloatWithCSSUnit; + function GetLengthAdjust: TSVGLengthAdjust; + procedure SetFontBold(AValue: boolean); + procedure SetFontFamily(AValue: string); + procedure SetFontFamilyList(AValue: ArrayOfString); + procedure SetFontItalic(AValue: boolean); + procedure SetFontSize(AValue: TFloatWithCSSUnit); + procedure SetFontStyle(AValue: string); + procedure SetFontStyleLCL(AValue: TFontStyles); + procedure SetFontWeight(AValue: string); + procedure SetSimpleText(AValue: string); + procedure SetTextAnchor(AValue: TSVGTextAnchor); + procedure SetTextDirection(AValue: TSVGTextDirection); + procedure SetTextDecoration(AValue: string); + procedure SetTextLength(AValue: TFloatWithCSSUnit); + procedure SetLengthAdjust(AValue: TSVGLengthAdjust); + protected + procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; + ADraw: boolean; AAllTextBounds: TRectF; + var APosition: TPointF; + var ATextParts: ArrayOfTextParts); overload; + procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; + ADraw: boolean; AAllTextBounds: TRectF; + var APosition: TPointF; + var ATextParts: ArrayOfTextParts; ALevel: integer; + AStartPart, AEndPart: integer); overload; + procedure InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; + AText: string; APosUnicode: integer; AInheritedRotation: single; + ADraw: boolean; AAllTextBounds: TRectF; + var APosition: TPointF; out ABounds: TRectF); + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + procedure CleanText(var ATextParts: ArrayOfTextParts); + function GetTRefContent(AElement: TSVGTRef): string; + function GetAllText(AInheritedRotation: single): ArrayOfTextParts; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property textLength: TFloatWithCSSUnit read GetTextLength write SetTextLength; + property lengthAdjust: TSVGLengthAdjust read GetLengthAdjust write SetLengthAdjust; + property SimpleText: string read GetSimpleText write SetSimpleText; + property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; + property fontFamily: string read GetFontFamily write SetFontFamily; + property fontFamilyList: ArrayOfString read GetFontFamilyList write SetFontFamilyList; + property fontWeight: string read GetFontWeight write SetFontWeight; + property fontStyle: string read GetFontStyle write SetFontStyle; + property fontStyleLCL: TFontStyles read GetFontStyleLCL write SetFontStyleLCL; + property textDecoration: string read GetTextDecoration write SetTextDecoration; + property fontBold: boolean read GetFontBold write SetFontBold; + property fontItalic: boolean read GetFontItalic write SetFontItalic; + property textAnchor: TSVGTextAnchor read GetTextAnchor write SetTextAnchor; + property textDirection: TSVGTextDirection read GetTextDirection write SetTextDirection; + end; + + { TSVGTSpan } + + TSVGTSpan = class(TSVGText) + public + class function GetDOMTag: string; override; + end; + + { TSVGTextPath } + + TSVGTextPath = class(TSVGTextElementWithContent) + private + function GetStartOffset: TFloatWithCSSUnit; + function GetMethod: TSVGTextPathMethod; + function GetSpacing: TSVGTextPathSpacing; + function GetXlinkHref: string; + procedure SetStartOffset(AValue: TFloatWithCSSUnit); + procedure SetMethod(AValue: TSVGTextPathMethod); + procedure SetSpacing(AValue: TSVGTextPathSpacing); + procedure SetXlinkHref(AValue: string); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property startOffset: TFloatWithCSSUnit read GetStartOffset write SetStartOffset; + property method: TSVGTextPathMethod read GetMethod write SetMethod; + property spacing: TSVGTextPathSpacing read GetSpacing write SetSpacing; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + end; + + { TSVGAltGlyph } + + TSVGAltGlyph = class(TSVGTextElementWithContent) + private + function GetGlyphRef: string; + function GetFormat: string; + function GetXlinkHref: string; + procedure SetGlyphRef(AValue: string); + procedure SetFormat(AValue: string); + procedure SetXlinkHref(AValue: string); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + property glyphRef: string read GetGlyphRef write SetGlyphRef; + property format: string read GetFormat write SetFormat; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + end; + + { TSVGAltGlyphDef } + + TSVGAltGlyphDef = class(TSVGTextElementWithContent) + public + class function GetDOMTag: string; override; + end; + + { TSVGAltGlyphItem } + + TSVGAltGlyphItem = class(TSVGTextElementWithContent) + public + class function GetDOMTag: string; override; + end; + + { TSVGGlyphRef } + + TSVGGlyphRef = class(TSVGTextElement) + private + function GetX: TSVGNumber; + function GetY: TSVGNumber; + function GetDx: TSVGNumber; + function GetDy: TSVGNumber; + function GetGlyphRef: string; + function GetFormat: string; + function GetXlinkHref: string; + procedure SetX(AValue: TSVGNumber); + procedure SetY(AValue: TSVGNumber); + procedure SetDx(AValue: TSVGNumber); + procedure SetDy(AValue: TSVGNumber); + procedure SetGlyphRef(AValue: string); + procedure SetFormat(AValue: string); + procedure SetXlinkHref(AValue: string); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + property x: TSVGNumber read GetX write SetX; + property y: TSVGNumber read GetY write SetY; + property dx: TSVGNumber read GetDx write SetDx; + property dy: TSVGNumber read GetDy write SetDy; + property glyphRef: string read GetGlyphRef write SetGlyphRef; + property format: string read GetFormat write SetFormat; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + end; + + { TSVGClipPath } + + TSVGClipPath = class(TSVGElement) + private + function GetExternalResourcesRequired: boolean; + function GetClipPathUnits: TSVGObjectUnits; + procedure SetExternalResourcesRequired(AValue: boolean); + procedure SetClipPathUnits(AValue: TSVGObjectUnits); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + property externalResourcesRequired: boolean + read GetExternalResourcesRequired write SetExternalResourcesRequired; + property clipPathUnits: TSVGObjectUnits read GetClipPathUnits write SetClipPathUnits; + end; + + { TSVGColorProfile } + + TSVGColorProfile = class(TSVGElement) + private + function GetLocal: string; + function GetName: string; + function GetRenderingIntent: TSVGRenderingIntent; + function GetXlinkHref: string; + procedure SetLocal(AValue: string); + procedure SetName(AValue: string); + procedure SetRenderingIntent(AValue: TSVGRenderingIntent); + procedure SetXlinkHref(AValue: string); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + property local: string read GetLocal write SetLocal; + property name: string read GetName write SetName; + property renderingIntent: TSVGRenderingIntent read GetRenderingIntent write SetRenderingIntent; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + end; + + { TSVGImage } + + TSVGImage = class(TSVGElement) + private + function GetBitmap: TBGRACustomBitmap; + function GetExternalResourcesRequired: boolean; + function GetImageRendering: TSVGImageRendering; + function GetX: TFloatWithCSSUnit; + function GetY: TFloatWithCSSUnit; + function GetWidth: TFloatWithCSSUnit; + function GetHeight: TFloatWithCSSUnit; + function GetPreserveAspectRatio: TSVGPreserveAspectRatio; + function GetXlinkHref: string; + procedure SetExternalResourcesRequired(AValue: boolean); + procedure SetImageRendering(AValue: TSVGImageRendering); + procedure SetX(AValue: TFloatWithCSSUnit); + procedure SetY(AValue: TFloatWithCSSUnit); + procedure SetWidth(AValue: TFloatWithCSSUnit); + procedure SetHeight(AValue: TFloatWithCSSUnit); + procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); + procedure SetXlinkHref(AValue: string); + protected + FBitmap: TBGRACustomBitmap; + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink); overload; override; + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink); overload; override; + destructor Destroy; override; + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + procedure SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean); overload; + procedure SetBitmap(AStream: TStream; AMimeType: string); overload; + property externalResourcesRequired: boolean + read GetExternalResourcesRequired write SetExternalResourcesRequired; + property x: TFloatWithCSSUnit read GetX write SetX; + property y: TFloatWithCSSUnit read GetY write SetY; + property width: TFloatWithCSSUnit read GetWidth write SetWidth; + property height: TFloatWithCSSUnit read GetHeight write SetHeight; + property imageRendering: TSVGImageRendering read GetImageRendering write SetImageRendering; + property preserveAspectRatio: TSVGPreserveAspectRatio + read GetPreserveAspectRatio write SetPreserveAspectRatio; + property xlinkHref: string read GetXlinkHref write SetXlinkHref; + property Bitmap: TBGRACustomBitmap read GetBitmap; + end; + + { TSVGPattern } + + TSVGPattern = class(TSVGImage) + private + function GetPatternUnits: TSVGObjectUnits; + function GetPatternContentUnits: TSVGObjectUnits; + function GetPatternTransform: string; + function GetViewBox: TSVGViewBox; + procedure SetPatternUnits(AValue: TSVGObjectUnits); + procedure SetPatternContentUnits(AValue: TSVGObjectUnits); + procedure SetPatternTransform(AValue: string); + procedure SetViewBox(AValue: TSVGViewBox); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + property patternUnits: TSVGObjectUnits read GetPatternUnits write SetPatternUnits; + property patternContentUnits: TSVGObjectUnits + read GetPatternContentUnits write SetPatternContentUnits; + property patternTransform: string read GetPatternTransform write SetPatternTransform; + property viewBox: TSVGViewBox read GetViewBox write SetViewBox; + end; + + { TSVGMarker } + + TSVGMarker = class(TSVGElement) + private + function GetExternalResourcesRequired: boolean; + function GetViewBox: TSVGViewBox; + function GetPreserveAspectRatio: TSVGPreserveAspectRatio; + function GetRefX: TFloatWithCSSUnit; + function GetRefY: TFloatWithCSSUnit; + function GetMarkerWidth: TFloatWithCSSUnit; + function GetMarkerHeight: TFloatWithCSSUnit; + function GetMarkerUnits: TSVGMarkerUnits; + function GetOrient: TSVGOrient; + procedure SetExternalResourcesRequired(AValue: boolean); + procedure SetViewBox(AValue: TSVGViewBox); + procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); + procedure SetRefX(AValue: TFloatWithCSSUnit); + procedure SetRefY(AValue: TFloatWithCSSUnit); + procedure SetMarkerWidth(AValue: TFloatWithCSSUnit); + procedure SetMarkerHeight(AValue: TFloatWithCSSUnit); + procedure SetMarkerUnits(AValue: TSVGMarkerUnits); + procedure SetOrient(AValue: TSVGOrient); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property externalResourcesRequired: boolean + read GetExternalResourcesRequired write SetExternalResourcesRequired; + property viewBox: TSVGViewBox read GetViewBox write SetViewBox; + property preserveAspectRatio: TSVGPreserveAspectRatio + read GetPreserveAspectRatio write SetPreserveAspectRatio; + property refX: TFloatWithCSSUnit read GetRefX write SetRefX; + property refY: TFloatWithCSSUnit read GetRefY write SetRefY; + property markerWidth: TFloatWithCSSUnit read GetMarkerWidth write SetMarkerWidth; + property markerHeight: TFloatWithCSSUnit read GetMarkerHeight write SetMarkerHeight; + property markerUnits: TSVGMarkerUnits read GetMarkerUnits write SetMarkerUnits; + property orient: TSVGOrient read GetOrient write SetOrient; + end; + + { TSVGMask } + + TSVGMask = class(TSVGElement) + private + function GetExternalResourcesRequired: boolean; + function GetX: TFloatWithCSSUnit; + function GetY: TFloatWithCSSUnit; + function GetWidth: TFloatWithCSSUnit; + function GetHeight: TFloatWithCSSUnit; + function GetMaskUnits: TSVGObjectUnits; + function GetMaskContentUnits: TSVGObjectUnits; + procedure SetExternalResourcesRequired(AValue: boolean); + procedure SetX(AValue: TFloatWithCSSUnit); + procedure SetY(AValue: TFloatWithCSSUnit); + procedure SetWidth(AValue: TFloatWithCSSUnit); + procedure SetHeight(AValue: TFloatWithCSSUnit); + procedure SetMaskUnits(AValue: TSVGObjectUnits); + procedure SetMaskContentUnits(AValue: TSVGObjectUnits); + protected + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property externalResourcesRequired: boolean + read GetExternalResourcesRequired write SetExternalResourcesRequired; + property x: TFloatWithCSSUnit read GetX write SetX; + property y: TFloatWithCSSUnit read GetY write SetY; + property width: TFloatWithCSSUnit read GetWidth write SetWidth; + property height: TFloatWithCSSUnit read GetHeight write SetHeight; + property maskUnits: TSVGObjectUnits read GetMaskUnits write SetMaskUnits; + property maskContentUnits: TSVGObjectUnits + read GetMaskContentUnits write SetMaskContentUnits; + end; + + TConvMethod = (cmNone,cmHoriz,cmVertical,cmOrtho); + + { TSVGGradient } + + TSVGGradient = class(TSVGElementWithContent) + private + function GetColorInterpolation: TSVGColorInterpolation; + function GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix; + function GetGradientTransform: string; + function GetGradientUnits: TSVGObjectUnits; + function GetHRef: string; + function GetSpreadMethod: TSVGSpreadMethod; + procedure SetColorInterpolation(AValue: TSVGColorInterpolation); + procedure SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix); + procedure SetGradientTransform(AValue: string); + procedure SetGradientUnits(AValue: TSVGObjectUnits); + procedure SetHRef(AValue: string); + procedure SetSpreadMethod(AValue: TSVGSpreadMethod); + protected + InheritedGradients: TSVGElementList;//(for HRef) + procedure Initialize; override; + function GetInheritedAttribute(AValue: string; + AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + public + destructor Destroy; override; + procedure ScanInheritedGradients(const forceScan: boolean = false); + property hRef: string read GetHRef write SetHRef; + property gradientUnits: TSVGObjectUnits read GetGradientUnits write SetGradientUnits; + property gradientTransform: string read GetGradientTransform write SetGradientTransform; + property gradientMatrix[AUnit: TCSSUnit]: TAffineMatrix read GetGradientMatrix write SetGradientMatrix; + property spreadMethod: TSVGSpreadMethod read GetSpreadMethod write SetSpreadMethod; + property colorInterpolation: TSVGColorInterpolation read GetColorInterpolation write SetColorInterpolation; + end; + + { TSVGGradientLinear } + + { TSVGLinearGradient } + + TSVGLinearGradient = class(TSVGGradient) + private + function GetX1: TFloatWithCSSUnit; + function GetX2: TFloatWithCSSUnit; + function GetY1: TFloatWithCSSUnit; + function GetY2: TFloatWithCSSUnit; + procedure SetX1(AValue: TFloatWithCSSUnit); + procedure SetX2(AValue: TFloatWithCSSUnit); + procedure SetY1(AValue: TFloatWithCSSUnit); + procedure SetY2(AValue: TFloatWithCSSUnit); + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property x1: TFloatWithCSSUnit read GetX1 write SetX1; + property y1: TFloatWithCSSUnit read GetY1 write SetY1; + property x2: TFloatWithCSSUnit read GetX2 write SetX2; + property y2: TFloatWithCSSUnit read GetY2 write SetY2; + end; + + { TSVGRadialGradient } + + TSVGRadialGradient = class(TSVGGradient) + private + function GetCX: TFloatWithCSSUnit; + function GetCY: TFloatWithCSSUnit; + function GetR: TFloatWithCSSUnit; + function GetFX: TFloatWithCSSUnit; + function GetFY: TFloatWithCSSUnit; + function GetFR: TFloatWithCSSUnit; + procedure SetCX(AValue: TFloatWithCSSUnit); + procedure SetCY(AValue: TFloatWithCSSUnit); + procedure SetR(AValue: TFloatWithCSSUnit); + procedure SetFX(AValue: TFloatWithCSSUnit); + procedure SetFY(AValue: TFloatWithCSSUnit); + procedure SetFR(AValue: TFloatWithCSSUnit); + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property cx: TFloatWithCSSUnit read GetCX write SetCX; + property cy: TFloatWithCSSUnit read GetCY write SetCY; + property r: TFloatWithCSSUnit read GetR write SetR; + property fx: TFloatWithCSSUnit read GetFX write SetFX; + property fy: TFloatWithCSSUnit read GetFY write SetFY; + property fr: TFloatWithCSSUnit read GetFR write SetFR; + end; + + { TSVGStopGradient } + + TSVGStopGradient = class(TSVGElement) + private + function GetOffset: TFloatWithCSSUnit; + function GetStopColor: TBGRAPixel; + function GetStopOpacity: single; + procedure SetOffset(AValue: TFloatWithCSSUnit); + procedure SetStopColor(AValue: TBGRAPixel); + procedure SetStopOpacity(AValue: single); + public + class function GetDOMTag: string; override; + property offset: TFloatWithCSSUnit read GetOffset write SetOffset; + property stopColor: TBGRAPixel read GetStopColor write SetStopColor; + property stopOpacity: single read GetStopOpacity write SetStopOpacity; + end; + + { TSVGDefine } + + TSVGDefine = class(TSVGElementWithContent) + public + class function GetDOMTag: string; override; + end; + + { TSVGGroup } + + TSVGGroup = class(TSVGElementWithContent) + private + function GetFontSize: TFloatWithCSSUnit; + function GetIsLayer: boolean; + function GetName: string; + procedure SetFontSize(AValue: TFloatWithCSSUnit); + procedure SetIsLayer(AValue: boolean); + procedure SetName(AValue: string); + protected + procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; + class function OwnDatalink: boolean; override; + property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; + public + class function GetDOMTag: string; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + property IsLayer: boolean read GetIsLayer write SetIsLayer; + property Name: string read GetName write SetName; + end; + + { TSVGLink } + + TSVGLink = class(TSVGGroup) + private + function GetTarget: string; + function GetXlinkHref: string; + function GetXlinkTitle: string; + procedure SetTarget(AValue: string); + procedure SetXlinkHref(AValue: string); + procedure SetXlinkTitle(AValue: string); + public + class function GetDOMTag: string; override; + property XlinkHref: string read GetXlinkHref write SetXlinkHref; + property XlinkTitle: string read GetXlinkTitle write SetXlinkTitle; + property Target: string read GetTarget write SetTarget; + end; + + { TSVGStyle } + + TSVGRuleset = record + selector, + declarations: string; + end; + ArrayOfTSVGStyleItem = packed array of TSVGRuleset; + + TSVGStyle = class(TSVGElement) + private + FRulesets: ArrayOfTSVGStyleItem; + function GetRulesetCount: integer; + procedure Parse(const s: String); + function IsValidRulesetIndex(const AIndex: integer): boolean; + function GetRuleset(const AIndex: integer): TSVGRuleset; + procedure SetRuleset(const AIndex: integer; sr: TSVGRuleset); + function Find(ARuleset: TSVGRuleset): integer; overload; + protected + procedure Initialize; override; + public + class function GetDOMTag: string; override; + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; override; + destructor Destroy; override; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + function Count: Integer; + function Find(const AName: string): integer; overload; + function Add(ARuleset: TSVGRuleset): integer; + procedure Remove(ARuleset: TSVGRuleset); + procedure Clear; + procedure ReParse; + property Ruleset[AIndex: integer]: TSVGRuleset read GetRuleset write SetRuleset; + property RulesetCount: integer read GetRulesetCount; + end; + + { TSVGContent } + + TSVGContent = class + protected + FDataLink: TSVGDataLink; + FDomElem: TDOMElement; + FDoc: TDOMDocument; + FElements: TFPList; + FUnits: TCSSUnitConverter; + function GetDOMNode(AElement: TObject): TDOMNode; + function GetElementDOMNode(AIndex: integer): TDOMNode; + procedure AppendElement(AElement: TObject); overload; + function ExtractElementAt(AIndex: integer): TObject; + procedure InsertElementBefore(AElement: TSVGElement; ASuccessor: TSVGElement); + function GetElement(AIndex: integer): TSVGElement; + function GetElementObject(AIndex: integer): TObject; + function GetIsSVGElement(AIndex: integer): boolean; + function GetElementCount: integer; + function GetUnits: TCSSUnitConverter; + function TryCreateElementFromNode(ANode: TDOMNode): TObject; virtual; + public + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink); + destructor Destroy; override; + procedure Clear; + procedure ConvertToUnit(AUnit: TCSSUnit); + procedure Recompute; + procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit); overload; + procedure Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); overload; + function AppendElement(ASVGType: TSVGFactory): TSVGElement; overload; + procedure BringElement(AElement: TObject; AFromContent: TSVGContent); overload; + procedure CopyElement(AElement: TObject); + procedure RemoveElement(AElement: TObject); + function AppendDOMText(AText: string): TDOMText; + function AppendDefine: TSVGDefine; + function AppendLinearGradient(x1,y1,x2,y2: single; AIsPercent: boolean): TSVGLinearGradient; overload; + function AppendLinearGradient(x1,y1,x2,y2: single; AUnit: TCSSUnit): TSVGLinearGradient; overload; + function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AIsPercent: boolean): TSVGRadialGradient; overload; + function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AUnit: TCSSUnit): TSVGRadialGradient; overload; + function AppendStop(AColor: TBGRAPixel; AOffset: single; AIsPercent: boolean): TSVGStopGradient; + function AppendLine(x1,y1,x2,y2: single; AUnit: TCSSUnit = cuCustom): TSVGLine; overload; + function AppendLine(p1,p2: TPointF; AUnit: TCSSUnit = cuCustom): TSVGLine; overload; + function AppendCircle(cx,cy,r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload; + function AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload; + function AppendEllipse(cx,cy,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload; + function AppendEllipse(c,r: TPointF; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload; + function AppendPath(data: string; AUnit: TCSSUnit = cuCustom): TSVGPath; overload; + function AppendPath(path: TBGRAPath; AUnit: TCSSUnit = cuCustom): TSVGPath; overload; + function AppendPolygon(const points: array of single; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload; + function AppendPolygon(const points: array of TPointF; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload; + function AppendRect(x,y,width,height: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; + function AppendRect(origin,size: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; + function AppendImage(x,y,width,height: single; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; + function AppendImage(origin,size: TPointF; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; + function AppendImage(x,y,width,height: single; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; + function AppendImage(origin,size: TPointF; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; + function AppendText(x,y: single; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload; + function AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload; + function AppendTextSpan(AText: string): TSVGTSpan; + function AppendRoundRect(x,y,width,height,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; + function AppendRoundRect(origin,size,radius: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; + function AppendGroup: TSVGGroup; + function IndexOfElement(AElement: TObject): integer; + property ElementCount: integer read GetElementCount; + property Element[AIndex: integer]: TSVGElement read GetElement; + property ElementObject[AIndex: integer]: TObject read GetElementObject; + property ElementDOMNode[AIndex: integer]: TDOMNode read GetElementDOMNode; + property IsSVGElement[AIndex: integer]: boolean read GetIsSVGElement; + property Units: TCSSUnitConverter read GetUnits; + end; + +function GetSVGFactory(ATagName: string): TSVGFactory; +function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink): TSVGElement; + +implementation + +uses BGRATransform, BGRAUTF8, base64, BGRAGradientScanner; + +function GetSVGFactory(ATagName: string): TSVGFactory; +var tag: string; +begin + tag := LowerCase(ATagName); + if tag='line' then + result := TSVGLine else + if tag='rect' then + result := TSVGRectangle else + if tag='circle' then + result := TSVGCircle else + if tag='ellipse' then + result := TSVGEllipse else + if tag='path' then + result := TSVGPath else + if (tag='polygon') or (tag='polyline') then + result := TSVGPolypoints else + if tag='text' then + result := TSVGText else + if tag='tspan' then + result := TSVGTSpan else + if tag='tref' then + result := TSVGTRef else + if tag='textpath' then + result := TSVGTextPath else + if tag='altglyph' then + result := TSVGAltGlyph else + if tag='altglyphdef' then + result := TSVGAltGlyphDef else + if tag='altglyphitem' then + result := TSVGAltGlyphItem else + if tag='glyphref' then + result := TSVGGlyphRef else + if tag='clippath' then + result := TSVGClipPath else + if tag='colorprofile' then + result := TSVGColorProfile else + if tag='image' then + result := TSVGImage else + if tag='pattern' then + result := TSVGPattern else + if tag='marker' then + result := TSVGMarker else + if tag='mask' then + result := TSVGMask else + if tag='lineargradient' then + result := TSVGLinearGradient else + if tag='radialgradient' then + result := TSVGRadialGradient else + if tag='stop' then + result := TSVGStopGradient else + if tag='defs' then + result := TSVGDefine else + if tag='g' then + result := TSVGGroup else + if tag='a' then + result := TSVGLink else + if tag='style' then + result := TSVGStyle else + result := TSVGElement; +end; + +function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink): TSVGElement; +var + factory: TSVGFactory; +begin + factory := GetSVGFactory(AElement.TagName); + result := factory.Create(AElement,AUnits,ADataLink); +end; + +{ TSVGDefine } + +class function TSVGDefine.GetDOMTag: string; +begin + Result:= 'defs'; +end; + +{ TSVGLink } + +function TSVGLink.GetTarget: string; +begin + result := Attribute['target']; +end; + +function TSVGLink.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +function TSVGLink.GetXlinkTitle: string; +begin + result := Attribute['xlink:title']; +end; + +procedure TSVGLink.SetTarget(AValue: string); +begin + Attribute['target'] := AValue; +end; + +procedure TSVGLink.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGLink.SetXlinkTitle(AValue: string); +begin + Attribute['xlink:title'] := AValue; +end; + +class function TSVGLink.GetDOMTag: string; +begin + Result:= 'a'; +end; + +{ TSVGElementWithContent } + +class function TSVGElementWithContent.OwnDatalink: boolean; +begin + result := false; +end; + +procedure TSVGElementWithContent.SetDatalink(AValue: TSVGDataLink); +var + i: Integer; +begin + inherited SetDatalink(AValue); + if not OwnDatalink then + begin + for i := 0 to FContent.ElementCount-1 do + if FContent.IsSVGElement[i] then + FContent.Element[i].DataLink := AValue; + FContent.FDataLink := AValue; + end else + FSubDatalink.Parent := AValue; +end; + +constructor TSVGElementWithContent.Create(ADocument: TDOMDocument; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(ADocument, AUnits, ADataLink); + if OwnDatalink then + FSubDataLink := TSVGDataLink.Create(ADataLink) + else FSubDatalink := ADataLink; + FContent := TSVGContent.Create(FDomElem,AUnits,FSubDataLink); +end; + +constructor TSVGElementWithContent.Create(AElement: TDOMElement; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(AElement, AUnits, ADataLink); + if OwnDatalink then + FSubDataLink := TSVGDataLink.Create(ADataLink) + else FSubDatalink := ADataLink; + FContent := TSVGContent.Create(AElement,AUnits,FSubDataLink); +end; + +procedure TSVGElementWithContent.ListIdentifiers(AResult: TStringList); +var + i: Integer; +begin + inherited ListIdentifiers(AResult); + for i := 0 to Content.ElementCount-1 do + if Content.IsSVGElement[i] then + Content.Element[i].ListIdentifiers(AResult); +end; + +procedure TSVGElementWithContent.RenameIdentifiers(AFrom, ATo: TStringList); +var + i: Integer; +begin + inherited RenameIdentifiers(AFrom, ATo); + for i := 0 to Content.ElementCount-1 do + if Content.IsSVGElement[i] then + Content.Element[i].RenameIdentifiers(AFrom, ATo); +end; + +procedure TSVGElementWithContent.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + Content.ConvertToUnit(AUnit); +end; + +destructor TSVGElementWithContent.Destroy; +begin + FreeAndNil(FContent); + if OwnDatalink then FreeAndNil(FSubDatalink); + inherited Destroy; +end; + +procedure TSVGElementWithContent.Recompute; +begin + FContent.Recompute; + inherited Recompute; +end; + +{ TSVGElementWithGradient } + +procedure TSVGElementWithGradient.Initialize; +begin + inherited Initialize; + FRegisteredToDatalink:= false; + ResetGradients; +end; + +procedure TSVGElementWithGradient.ResetGradients; +begin + if FGradientElementsDefined then + begin + if Assigned(DataLink) and FRegisteredToDatalink then + begin + DataLink.RegisterLinkListener(@DatalinkOnLink, false); + FRegisteredToDatalink := false; + end; + FGradientElementsDefined := false; + end; + FFillGradientElement := nil; + FStrokeGradientElement := nil; + FFillCanvasGradient := nil; + FStrokeCanvasGradient := nil; +end; + +procedure TSVGElementWithGradient.FindGradientElements; +var + fillNotFound, strokeNotFound: boolean; +begin + if Assigned(FDataLink) then + begin + if FRegisteredToDatalink then + begin + FDataLink.RegisterLinkListener(@DatalinkOnLink, false); + FRegisteredToDatalink := false; + end; + FFillGradientElement := TSVGGradient(FDataLink.FindElementByRef(fill, true, TSVGGradient, fillNotFound)); + FStrokeGradientElement := TSVGGradient(FDataLink.FindElementByRef(stroke, true, TSVGGradient, strokeNotFound)); + if Assigned(FFillGradientElement) or fillNotFound or + Assigned(FStrokeGradientElement) or strokeNotFound then + begin + FDatalink.RegisterLinkListener(@DatalinkOnLink, true); + FRegisteredToDatalink := true; + end; + end else + begin + FFillGradientElement := nil; + FStrokeGradientElement := nil; + end; + if FFillGradientElement <> nil then + FFillGradientElement.ScanInheritedGradients; + if FStrokeGradientElement <> nil then + FStrokeGradientElement.ScanInheritedGradients; + FGradientElementsDefined:= true; +end; + +function TSVGElementWithGradient.EvaluatePercentage(fu: TFloatWithCSSUnit): single; +begin + Result:= fu.value; + if fu.CSSUnit <> cuPercent then + begin + if Result < 0 then + Result:= 0 + else if Result > 1 then + Result:= 1; + Result:= Result * 100; + end; +end; + +procedure TSVGElementWithGradient.DatalinkOnLink(Sender: TObject; + AElement: TSVGElement; ALink: boolean); +begin + if not ALink then + begin + if (AElement = FFillGradientElement) or (AElement = FStrokeGradientElement) then + ResetGradients; + end else + if ALink then + if FGradientElementsDefined and ((FFillGradientElement = nil) or (FStrokeGradientElement = nil)) then + ResetGradients; +end; + +function TSVGElementWithGradient.GetFillGradientElement: TSVGGradient; +begin + if not FGradientElementsDefined then + FindGradientElements; + result := FFillGradientElement; +end; + +function TSVGElementWithGradient.GetStrokeGradientElement: TSVGGradient; +begin + if not FGradientElementsDefined then + FindGradientElements; + result := FStrokeGradientElement; +end; + +procedure TSVGElementWithGradient.AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D); + + function AddStopElementFrom(el: TSVGElement): integer; + var + i: integer; + begin + if el is TSVGGradient then + begin + if el.HasAttribute('color-interpolation') then + canvas.gammaCorrection:= TSVGGradient(el).colorInterpolation = sciLinearRGB; + if el.HasAttribute('spreadMethod') then + case TSVGGradient(el).spreadMethod of + ssmReflect: canvas.repetition := grReflect; + ssmRepeat: canvas.repetition := grRepeat; + else canvas.repetition:= grPad; + end; + end; + result:= 0; + with (el as TSVGGradient).Content do + for i:= 0 to ElementCount-1 do + if IsSVGElement[i] and (Element[i] is TSVGStopGradient) then + with TSVGStopGradient(Element[i]) do + begin + canvas.addColorStop(EvaluatePercentage(offset)/100, stopColor); + Inc(result); + end; + end; + +var + i: integer; +begin + if not Assigned(ASVGGradient) then exit; + with ASVGGradient.InheritedGradients do + for i:= 0 to Count-1 do + AddStopElementFrom(Items[i]); +end; + +function TSVGElementWithGradient.CreateCanvasLinearGradient( + ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; + const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; +var p1,p2: TPointF; + g: TSVGLinearGradient; + m: TAffineMatrix; +begin + g := ASVGGradient as TSVGLinearGradient; + if g.gradientUnits = souObjectBoundingBox then + begin + p1.x:= EvaluatePercentage(g.x1)/100; + p1.y:= EvaluatePercentage(g.y1)/100; + p2.x:= EvaluatePercentage(g.x2)/100; + p2.y:= EvaluatePercentage(g.y2)/100; + m := ACanvas2d.matrix; + ACanvas2d.translate(origin.x,origin.y); + ACanvas2d.scale(w,h); + ACanvas2d.transform(g.gradientMatrix[cuCustom]); + result:= ACanvas2d.createLinearGradient(p1,p2); + ACanvas2d.matrix := m; + end else + begin + p1.x:= Units.ConvertWidth(g.x1,AUnit,w).value; + p1.y:= Units.ConvertHeight(g.y1,AUnit,h).value; + p2.x:= Units.ConvertWidth(g.x2,AUnit,w).value; + p2.y:= Units.ConvertHeight(g.y2,AUnit,h).value; + m := ACanvas2d.matrix; + ACanvas2d.transform(g.gradientMatrix[AUnit]); + result:= ACanvas2d.createLinearGradient(p1,p2); + ACanvas2d.matrix := m; + end; + + AddStopElements(ASVGGradient, result); +end; + +function TSVGElementWithGradient.CreateCanvasRadialGradient( + ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; const origin: TPointF; + const w, h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; +var c,f: TPointF; + r,fr: single; + g: TSVGRadialGradient; + m: TAffineMatrix; + + procedure CheckFocalAndCreate(c: TPointF; r: single; f: TPointF; fr: single); + var u: TPointF; + d: single; + begin + u := f-c; + d := VectLen(u); + if d >= r then + begin + u.Scale( (r/d)*0.99999 ); + f := c+u; + end; + result:= ACanvas2d.createRadialGradient(c,r,f,fr,true); + AddStopElements(ASVGGradient, result); + end; + +begin + g := ASVGGradient as TSVGRadialGradient; + if g.gradientUnits = souObjectBoundingBox then + begin + c.x:= EvaluatePercentage(g.cx)/100; + c.y:= EvaluatePercentage(g.cy)/100; + r:= abs(EvaluatePercentage(g.r))/100; + f.x:= EvaluatePercentage(g.fx)/100; + f.y:= EvaluatePercentage(g.fy)/100; + fr:= abs(EvaluatePercentage(g.fr))/100; + + m := ACanvas2d.matrix; + ACanvas2d.translate(origin.x,origin.y); + ACanvas2d.scale(w,h); + ACanvas2d.transform(g.gradientMatrix[cuCustom]); + CheckFocalAndCreate(c,r,f,fr); + ACanvas2d.matrix := m; + end else + begin + c.x:= Units.ConvertWidth(g.cx, AUnit, w).value; + c.y:= Units.ConvertHeight(g.cy, AUnit, h).value; + r:= abs(Units.ConvertOrtho(g.r, AUnit, w, h).value); + f.x:= Units.ConvertWidth(g.fx, AUnit, w).value; + f.y:= Units.ConvertHeight(g.fy, AUnit, h).value; + fr:= abs(Units.ConvertOrtho(g.fr, AUnit, w, h).value); + + m := ACanvas2d.matrix; + ACanvas2d.transform(g.gradientMatrix[AUnit]); + CheckFocalAndCreate(c,r,f,fr); + ACanvas2d.matrix := m; + end; +end; + +procedure TSVGElementWithGradient.InitializeGradient(ACanvas2d: TBGRACanvas2D; + const origin: TPointF; const w,h: single; AUnit: TCSSUnit); +begin + if FillGradientElement <> nil then + begin + if FillGradientElement is TSVGLinearGradient then + FFillCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit) + else if FillGradientElement is TSVGRadialGradient then + FFillCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit); + end; + if StrokeGradientElement <> nil then + begin + if StrokeGradientElement is TSVGLinearGradient then + FStrokeCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit) + else if StrokeGradientElement is TSVGRadialGradient then + FStrokeCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit); + end; +end; + +procedure TSVGElementWithGradient.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); +begin + inherited ApplyFillStyle(ACanvas2D,AUnit); + if Assigned(FFillCanvasGradient) then + ACanvas2D.fillStyle(FFillCanvasGradient); +end; + +procedure TSVGElementWithGradient.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; + AUnit: TCSSUnit); +begin + inherited ApplyStrokeStyle(ACanvas2D,AUnit); + if Assigned(FStrokeCanvasGradient) then + ACanvas2D.strokeStyle(FStrokeCanvasGradient); +end; + +procedure TSVGElementWithGradient.SetDatalink(AValue: TSVGDataLink); +begin + ResetGradients; + inherited SetDatalink(AValue); +end; + +procedure TSVGElementWithGradient.SetFill(AValue: string); +begin + ResetGradients; + inherited SetFill(AValue); +end; + +procedure TSVGElementWithGradient.SetStroke(AValue: string); +begin + ResetGradients; + inherited SetStroke(AValue); +end; + +destructor TSVGElementWithGradient.Destroy; +begin + ResetGradients; + inherited Destroy; +end; + +{ TSVGTextElementWithContent } + +constructor TSVGTextElementWithContent.Create(ADocument: TDOMDocument; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(ADocument, AUnits, ADataLink); + FContent := TSVGContent.Create(FDomElem,AUnits,ADataLink); +end; + +constructor TSVGTextElementWithContent.Create(AElement: TDOMElement; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(AElement, AUnits, ADataLink); + FContent := TSVGContent.Create(AElement,AUnits,ADataLink); +end; + +destructor TSVGTextElementWithContent.Destroy; +begin + FreeAndNil(FContent); + inherited Destroy; +end; + +procedure TSVGTextElementWithContent.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + Content.ConvertToUnit(AUnit); +end; + +{ TSVGTextPositioning } + +function TSVGTextPositioning.GetX: ArrayOfTFloatWithCSSUnit; +begin + result := ArrayOfHorizAttributeWithUnitInherit['x',False]; +end; + +function TSVGTextPositioning.GetY: ArrayOfTFloatWithCSSUnit; +begin + result := ArrayOfVerticalAttributeWithUnitInherit['y',False]; +end; + +function TSVGTextPositioning.GetDx: ArrayOfTFloatWithCSSUnit; +begin + result := ArrayOfHorizAttributeWithUnitInherit['dx',False]; +end; + +function TSVGTextPositioning.GetDy: ArrayOfTFloatWithCSSUnit; +begin + result := ArrayOfVerticalAttributeWithUnitInherit['dy',False]; +end; + +function TSVGTextPositioning.GetRotate: ArrayOfTSVGNumber; +begin + result := ArrayOfAttributeNumberInherit['rotate',False]; +end; + +procedure TSVGTextPositioning.SetX(AValue: ArrayOfTFloatWithCSSUnit); +begin + ArrayOfHorizAttributeWithUnit['x'] := AValue; +end; + +procedure TSVGTextPositioning.SetY(AValue: ArrayOfTFloatWithCSSUnit); +begin + ArrayOfVerticalAttributeWithUnit['y'] := AValue; +end; + +procedure TSVGTextPositioning.SetDx(AValue: ArrayOfTFloatWithCSSUnit); +begin + ArrayOfHorizAttributeWithUnit['dx'] := AValue; +end; + +procedure TSVGTextPositioning.SetDy(AValue: ArrayOfTFloatWithCSSUnit); +begin + ArrayOfVerticalAttributeWithUnit['dy'] := AValue; +end; + +procedure TSVGTextPositioning.SetRotate(AValue: ArrayOfTSVGNumber); +begin + ArrayOfAttributeNumber['rotate'] := AValue; +end; + +procedure TSVGTextPositioning.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); + if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); + if HasAttribute('dx') then dx := Units.ConvertWidth(dx, AUnit); + if HasAttribute('dy') then dy := Units.ConvertHeight(dy, AUnit); +end; + +{ TSVGText } + +function TSVGText.GetFontBold: boolean; +var valueText: string; +begin + valueText := trim(fontWeight); + result := (valueText = 'bold') or (valueText = 'bolder') or + (valueText = '600') or (valueText = '700') or (valueText = '800') or + (valueText = '900'); +end; + +function TSVGText.GetFontFamily: string; +begin + result := AttributeOrStyleDef['font-family', 'sans-serif']; +end; + +function TSVGText.GetFontFamilyList: ArrayOfString; +begin + result := TBGRACanvas2D.StrToFontNameList(AttributeOrStyle['font-family']); +end; + +function TSVGText.GetFontItalic: boolean; +var valueText: string; +begin + valueText := trim(fontStyle); + result := (valueText = 'oblique') or (valueText = 'italic'); +end; + +function TSVGText.GetFontSize: TFloatWithCSSUnit; +begin + result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); +end; + +function TSVGText.GetFontStyle: string; +begin + result := AttributeOrStyleDef['font-style','normal']; +end; + +function TSVGText.GetFontStyleLCL: TFontStyles; +var + s: String; +begin + result := []; + if fontBold then include(result, fsBold); + if fontItalic then include(result, fsItalic); + s := ' '+textDecoration+' '; + if pos('underline',s) <> 0 then include(result, fsUnderline); + if pos('line-through',s) <> 0 then include(result, fsStrikeOut); +end; + +function TSVGText.GetFontWeight: string; +begin + result := AttributeOrStyleDef['font-weight','normal']; +end; + +function TSVGText.GetSimpleText: string; +var + i: Integer; +begin + if FInGetSimpleText then exit(''); //avoid reentrance + FInGetSimpleText := true; + result := ''; + for i := 0 to FContent.ElementCount-1 do + if FContent.IsSVGElement[i] then + begin + if FContent.Element[i] is TSVGTRef then + AppendStr(result, GetTRefContent(TSVGTRef(FContent.Element[i])) ) + else + if FContent.Element[i] is TSVGText then + AppendStr(result, TSVGText(FContent.Element[i]).SimpleText); + end else + begin + if FContent.ElementDOMNode[i] is TDOMText then + AppendStr(result, UTF16ToUTF8(TDOMText(FContent.ElementDOMNode[i]).Data)); + end; + FInGetSimpleText := false; +end; + +function TSVGText.GetTextAnchor: TSVGTextAnchor; +begin + case AttributeOrStyleDef['text-anchor','start'] of + 'middle': result := staMiddle; + 'end': result := staEnd; + else result := staStart; + end; +end; + +function TSVGText.GetTextDirection: TSVGTextDirection; +begin + if AttributeOrStyle['direction'] = 'rtl' then + result := stdRtl + else + result := stdLtr; +end; + +function TSVGText.GetTextDecoration: string; +begin + result := AttributeOrStyleDef['text-decoration','none']; +end; + +function TSVGText.GetTextLength: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnitDef['textLength']; +end; + +function TSVGText.GetLengthAdjust: TSVGLengthAdjust; +var + valueText: string; +begin + valueText := trim(Attribute['lengthAdjust','spacing']); + if valueText = 'spacing' then + result := slaSpacing + else + result := slaSpacingAndGlyphs; +end; + +procedure TSVGText.SetFontBold(AValue: boolean); +begin + if AValue then fontWeight:= 'bold' else fontWeight:= 'normal'; +end; + +procedure TSVGText.SetFontFamily(AValue: string); +begin + Attribute['font-family'] := AValue; + RemoveStyle('font-family'); +end; + +procedure TSVGText.SetFontFamilyList(AValue: ArrayOfString); +begin + fontFamily := TBGRACanvas2D.FontNameListToStr(AValue); +end; + +procedure TSVGText.SetFontItalic(AValue: boolean); +begin + if AValue then fontStyle:= 'italic' else fontStyle:= 'normal'; +end; + +procedure TSVGText.SetFontSize(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['font-size'] := AValue; +end; + +procedure TSVGText.SetFontStyle(AValue: string); +begin + Attribute['font-style'] := AValue; + RemoveStyle('font-style'); +end; + +procedure TSVGText.SetFontStyleLCL(AValue: TFontStyles); +var + s: String; +begin + fontItalic:= fsItalic in AValue; + fontBold:= fsBold in AValue; + s := ''; + if fsUnderline in AValue then AppendStr(s, 'underline '); + if fsStrikeOut in AValue then AppendStr(s, 'line-through '); + textDecoration:= trim(s); +end; + +procedure TSVGText.SetFontWeight(AValue: string); +begin + Attribute['font-weight'] := AValue; + RemoveStyle('font-weight'); +end; + +procedure TSVGText.SetTextAnchor(AValue: TSVGTextAnchor); +begin + case AValue of + staMiddle: Attribute['text-anchor'] := 'middle'; + staEnd: Attribute['text-anchor'] := 'end'; + else {staStart} Attribute['text-anchor'] := 'start'; + end; +end; + +procedure TSVGText.SetTextDirection(AValue: TSVGTextDirection); +begin + if AValue = stdLtr then + Attribute['direction'] := 'ltr' + else + Attribute['direction'] := 'rtl'; +end; + +procedure TSVGText.SetSimpleText(AValue: string); +begin + Content.Clear; + if AValue = '' then exit; + Content.appendDOMText(AValue); +end; + +procedure TSVGText.SetTextDecoration(AValue: string); +begin + Attribute['text-decoration'] := AValue; + RemoveStyle('text-decoration'); +end; + +procedure TSVGText.SetTextLength(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['textLength'] := AValue; + RemoveStyle('textLength'); +end; + +procedure TSVGText.SetLengthAdjust(AValue: TSVGLengthAdjust); +begin + if AValue = slaSpacing then + Attribute['lengthAdjust'] := 'spacing' + else + Attribute['lengthAdjust'] := 'spacingAndGlyphs'; + RemoveStyle('lengthAdjust'); +end; + +procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; + AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF; + var APosition: TPointF; var ATextParts: ArrayOfTextParts); +begin + if not ADraw then ATextParts[0].AbsoluteCoord := APosition; + InternalDrawOrCompute(ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition, ATextParts, 0,0,high(ATextParts)); +end; + +procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; + AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF; + var APosition: TPointF; var ATextParts: ArrayOfTextParts; + ALevel: integer; AStartPart, AEndPart: integer); +var + prevFontSize: TFloatWithCSSUnit; + ax, ay, adx, ady: ArrayOfTFloatWithCSSUnit; + i, subStartPart, subEndPart, subLevel: integer; + subElem: TSVGText; + partBounds: TRectF; +begin + if AStartPart > AEndPart then exit; + + prevFontSize := EnterFontSize; + + if not ADraw then + begin + ax := Units.ConvertWidth(x,AUnit); + ay := Units.ConvertHeight(y,AUnit); + if length(ax)>0 then APosition.x := ax[0].value; + if length(ay)>0 then APosition.y := ay[0].value; + if (length(ax)>0) or (length(ay)>0) then + ATextParts[AStartPart].AbsoluteCoord := APosition; + end else + APosition := ATextParts[AStartPart].AbsoluteCoord; + + adx := Units.ConvertWidth(dx,AUnit); + ady := Units.ConvertHeight(dy,AUnit); + if length(adx)>0 then IncF(APosition.x, adx[0].value); + if length(ady)>0 then IncF(APosition.y, ady[0].value); + + i := AStartPart; + while i <= AEndPart do + begin + if ATextParts[i].Level > ALevel then + begin + subStartPart := i; + subEndPart := i; + subElem := TSVGText(ATextParts[subStartPart].BaseElement); + subLevel := ATextParts[subStartPart].Level; + while (subEndPart < AEndPart) and + ( ((ATextParts[subEndPart+1].Level = subLevel) and (ATextParts[subEndPart+1].BaseElement = subElem)) or + (ATextParts[subEndPart+1].Level > subLevel) ) do + inc(subEndPart); + subElem.InternalDrawOrCompute( + ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition, + ATextParts, subLevel, subStartPart, subEndPart); + i := subEndPart+1; + end + else + begin + if not ADraw then + ATextParts[i].PartStartCoord := APosition + else + APosition := ATextParts[i].PartStartCoord; + + if ATextParts[i].Text <>'' then + InternalDrawOrComputePart(ACanvas2d, AUnit, ATextParts[i].Text, ATextParts[i].PosUnicode, + ATextParts[i].InheritedRotation, ADraw, AAllTextBounds, APosition, partBounds) + else + partBounds := EmptyRectF; + + if not ADraw then + begin + ATextParts[i].PartEndCoord := APosition; + ATextParts[i].Bounds := partBounds; + end + else + APosition := ATextParts[i].PartEndCoord; + + inc(i); + end; + end; + + ExitFontSize(prevFontSize); +end; + +procedure TSVGText.InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D; + AUnit: TCSSUnit; AText: string; APosUnicode: integer; AInheritedRotation: single; + ADraw: boolean; AAllTextBounds: TRectF; var APosition: TPointF; out ABounds: TRectF); +var + ts: TCanvas2dTextSize; + fs: TFontStyles; + dir: TSVGTextDirection; + deco: String; + fh: TFloatWithCSSUnit; + rotations: ArrayOfTSVGNumber; + glyphSizes: array of single; + glyphByGlyph: Boolean; + cursor: TGlyphCursorUtf8; + glyph: TGlyphUtf8; + posGlyph: integer; + curPos: TPointF; + curRotation, firstRotation: single; + posUnicode, i: integer; + adx, ady, ax, ay: ArrayOfTFloatWithCSSUnit; +begin + fh := Units.CurrentFontEmHeight; + ACanvas2d.fontEmHeight := Units.ConvertHeight(fh, AUnit).value; + ACanvas2d.fontName := fontFamily; + fs := []; + if fontBold then include(fs, fsBold); + if fontItalic then include(fs, fsItalic); + deco := ' '+textDecoration+' '; + if pos(' line-through ',deco)<>0 then include(fs, fsStrikeOut); + if pos(' underline ',deco)<>0 then include(fs, fsUnderline); + ACanvas2d.fontStyle := fs; + dir := textDirection; + case dir of + stdRtl: ACanvas2d.direction:= fbmRightToLeft; + else {stdLtr} ACanvas2d.direction:= fbmLeftToRight; + end; + ACanvas2d.textBaseline:= 'alphabetic'; + + rotations := rotate; + if (length(rotations) <> 0) and + (APosUnicode >= length(rotations)) then + begin + firstRotation := rotations[high(rotations)]; + glyphByGlyph:= true; + end else + begin + firstRotation:= AInheritedRotation; + glyphByGlyph:= firstRotation <> 0; + end; + for i := APosUnicode to APosUnicode + UTF8Length(AText) - 1 do + if i >= length(rotations) then break else + if rotations[i] <> 0 then glyphByGlyph := true; + ax := x; + ay := y; + adx := dx; + ady := dy; + for i := APosUnicode + 1 to APosUnicode + UTF8Length(AText) - 1 do + begin + if (i < length(ax)) or (i < length(ay)) then glyphByGlyph:= true; + if (i < length(adx)) and (adx[i].value <> 0) then glyphByGlyph := true; + if (i < length(ady)) and (ady[i].value <> 0) then glyphByGlyph := true; + end; + + if glyphByGlyph then + begin + ts.width:= 0; + ts.height := 0; + cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction); + setlength(glyphSizes, length(AText)); //more than enough + posGlyph := 0; + repeat + glyph := cursor.GetNextGlyph; + if glyph.Empty then break; + with ACanvas2d.measureText(glyph.GlyphUtf8) do + begin + incF(ts.Width, width); + if height > ts.Height then ts.Height := height; + glyphSizes[posGlyph] := width; + end; + inc(posGlyph); + until false; + end else + begin + ts := ACanvas2d.measureText(AText); + glyphSizes := nil; + end; + + if dir = stdRtl then DecF(APosition.x, ts.width); + + ABounds := RectF(APosition.x,APosition.y,APosition.x+ts.width,APosition.y+ts.height); + if ADraw then + begin + ACanvas2d.beginPath; + InitializeGradient(ACanvas2d, AAllTextBounds.TopLeft, AAllTextBounds.Width,AAllTextBounds.Height,AUnit); + if glyphByGlyph then + begin + curPos := APosition; + curRotation := firstRotation; + posGlyph := 0; + cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction); + repeat + glyph := cursor.GetNextGlyph; + if glyph.Empty then break; + posUnicode := APosUnicode + UTF8Length(copy(AText, 1, glyph.ByteOffset)); + if posUnicode < length(rotations) then + curRotation := rotations[posUnicode]; + ACanvas2d.save; + ACanvas2d.translate(curPos.x, curPos.y); + ACanvas2d.rotate(curRotation*Pi/180); + if glyph.Mirrored then + begin + if glyph.MirroredGlyphUtf8 <> '' then + ACanvas2d.text(glyph.GlyphUtf8, 0, 0) else + begin + ACanvas2d.translate(glyphSizes[posGlyph], 0); + ACanvas2d.scale(-1,0); + ACanvas2d.text(glyph.GlyphUtf8, 0, 0); + end; + end else + ACanvas2d.text(glyph.GlyphUtf8, 0, 0); + ACanvas2d.restore; + IncF(curPos.x, glyphSizes[posGlyph]); + for i := 1 to UTF8Length(copy(AText, glyph.ByteOffset+1, glyph.ByteSize)) do + begin + if posUnicode + i < length(ax) then curPos.x := Units.ConvertWidth(ax[posUnicode + i], AUnit).value; + if posUnicode + i < length(ay) then curPos.y := Units.ConvertHeight(ay[posUnicode + i], AUnit).value; + if posUnicode + i < length(adx) then incF(curPos.x, Units.ConvertWidth(adx[posUnicode + i], AUnit).value); + if posUnicode + i < length(ady) then incF(curPos.y, Units.ConvertHeight(ady[posUnicode + i], AUnit).value); + end; + inc(posGlyph); + until false; + end else + ACanvas2d.text(AText,APosition.x,APosition.y); + Paint(ACanvas2D, AUnit); + end; + + if dir = stdLtr then IncF(APosition.x, ts.width); +end; + +procedure TSVGText.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + allTextBounds: TRectF; + textParts: ArrayOfTextParts; + anchor: TSVGTextAnchor; + + procedure DoAlignText(AStartPart,AEndPart: integer); + var + advance,ofs: single; + j: Integer; + begin + advance := textParts[AEndPart].PartEndCoord.x - textParts[AStartPart].AbsoluteCoord.x; + ofs := 0; + + case anchor of + staMiddle: ofs := (-1/2)*advance; + staEnd: ofs := -advance; + else ofs := 0; + end; + + for j := AStartPart to AEndPart do + begin + if not isEmptyPointF(textParts[j].AbsoluteCoord) then IncF(textParts[j].AbsoluteCoord.x, ofs); + if not isEmptyPointF(textParts[j].PartStartCoord) then IncF(textParts[j].PartStartCoord.x, ofs); + if not isEmptyPointF(textParts[j].PartEndCoord) then IncF(textParts[j].PartEndCoord.x, ofs); + if not IsEmptyRectF(textParts[j].Bounds) then textParts[j].Bounds.Offset(ofs,0); + end; + end; + +var + i, absStartIndex: Integer; + pos: TPointF; +begin + textParts := GetAllText(0); + CleanText(textParts); + if length(textParts)>0 then + begin + pos := PointF(0,0); + InternalDrawOrCompute(ACanvas2d, AUnit, False, EmptyRectF, pos, textParts); + + anchor := textAnchor; + + absStartIndex := -1; + for i := 0 to high(textParts) do + begin + if not IsEmptyPointF(textParts[i].AbsoluteCoord) then + begin + if absStartIndex <> -1 then DoAlignText(absStartIndex,i-1); + absStartIndex := i; + end; + end; + if absStartIndex <> -1 then DoAlignText(absStartIndex,high(textParts)); + + allTextBounds := EmptyRectF; + for i := 0 to high(textParts) do + allTextBounds := allTextBounds.Union(textParts[i].Bounds); + + pos := PointF(0,0); + InternalDrawOrCompute(ACanvas2d, AUnit, True, allTextBounds, pos, textParts); + end; +end; + +procedure TSVGText.CleanText(var ATextParts: ArrayOfTextParts); +var wasSpace: boolean; + wasSpaceBeforePartIdx: integer; + i,j: integer; + k,l, startPos, endPosP1: integer; + fullText, cleanedText: string; +begin + wasSpace := false; + wasSpaceBeforePartIdx:= -1; + fullText := ''; + for k := 0 to high(ATextParts) do + AppendStr(fullText, ATextParts[k].Text); + + setlength(cleanedText, length(fullText)); + j := 0; + k := 0; + for i := 1 to length(fullText) do + begin + if not (fullText[i] in[#0..#32]) and wasSpace and (j>0) then + begin + inc(j); + cleanedText[j] := ' '; + if wasSpaceBeforePartIdx <> -1 then + for l := wasSpaceBeforePartIdx to k-1 do + inc(ATextParts[l].SplitPos); + wasSpace:= false; + end; + while (k < length(ATextParts)) and (i = ATextParts[k].SplitPos) do + begin + if wasSpace and (wasSpaceBeforePartIdx = -1) then + wasSpaceBeforePartIdx:= k; + ATextParts[k].SplitPos := j+1; + inc(k); + end; + if fullText[i] in[#0..#32] then + wasSpace := true + else + begin + inc(j); + cleanedText[j] := fullText[i]; + wasSpace := false; + wasSpaceBeforePartIdx := -1; + end; + end; + while k < length(ATextParts) do + begin + ATextParts[k].SplitPos := j+1; + inc(k); + end; + setlength(cleanedText, j); + + for k := 0 to high(ATextParts) do + begin + startPos := ATextParts[k].SplitPos; + if k = high(ATextParts) then endPosP1 := j+1 else + endPosP1 := ATextParts[k+1].SplitPos; + ATextParts[k].Text:= copy(cleanedText, startPos, endPosP1 - startPos); + end; +end; + +function TSVGText.GetTRefContent(AElement: TSVGTRef): string; +var + refText: TSVGText; +begin + if Assigned(FDataLink) then + refText := TSVGText(FDataLink.FindElementByRef(AElement.xlinkHref, TSVGText)) + else refText := nil; + if Assigned(refText) then result := refText.SimpleText else result := ''; +end; + +function TSVGText.GetAllText(AInheritedRotation: single): ArrayOfTextParts; +var + idxOut,curLen: Integer; + posUnicode: integer; + + procedure AppendPart(AText: string); + begin + if (idxOut > 0) and (result[idxOut-1].Text = '') + and (result[idxOut-1].BaseElement = self) then dec(idxOut); + result[idxOut].Level := 0; + result[idxOut].BaseElement:= self; + result[idxOut].Text := AText; + result[idxOut].SplitPos:= curLen+1; + result[idxOut].AbsoluteCoord := EmptyPointF; + result[idxOut].PartStartCoord := EmptyPointF; + result[idxOut].Bounds := EmptyRectF; + result[idxOut].PosUnicode := posUnicode; + result[idxOut].InheritedRotation:= AInheritedRotation; + inc(curLen, length(AText)); + inc(idxOut); + inc(posUnicode, UTF8Length(AText)); + end; + +var + i,j: integer; + svgElem: TSVGElement; + subParts: ArrayOfTextParts; + node: TDOMNode; + rotations: ArrayOfTSVGNumber; + inheritedRotation: TSVGNumber; + +begin + setlength(result, Content.ElementCount+1); + idxOut := 0; + curLen := 0; + posUnicode := 0; + AppendPart(''); //needed when there is a sub part to know the base element + for i := 0 to Content.ElementCount-1 do + begin + if Content.IsSVGElement[i] then + begin + svgElem := Content.Element[i]; + if svgElem is TSVGTRef then + AppendPart(GetTRefContent(TSVGTRef(svgElem))) + else + if svgElem is TSVGText then + begin + rotations := rotate; + if posUnicode = 0 then inheritedRotation:= AInheritedRotation else + if posUnicode-1 >= length(rotations) then + begin + if rotations <> nil then + inheritedRotation:= rotations[high(rotations)] + else inheritedRotation := 0; + end else + inheritedRotation := rotations[posUnicode-1]; + subParts := TSVGText(svgElem).GetAllText(inheritedRotation); + if length(subParts) > 0 then + begin + setlength(result, length(result)+length(subParts)-1); + for j := 0 to high(subParts) do + begin + result[idxOut] := subParts[j]; + inc(result[idxOut].Level); + result[idxOut].SplitPos:= curLen+1; + inc(curLen, length(result[idxOut].Text)); + inc(idxOut); + end; + end else + AppendPart(''); + end; + end else + begin + node := Content.ElementDOMNode[i]; + if node is TDOMText then + AppendPart(UTF16ToUTF8(TDOMText(node).Data)); + end; + end; + setlength(result, idxOut); +end; + +class function TSVGText.GetDOMTag: string; +begin + Result:= 'text'; +end; + +procedure TSVGText.ConvertToUnit(AUnit: TCSSUnit); +var + prevFontSize: TFloatWithCSSUnit; +begin + prevFontSize := EnterFontSize; + inherited ConvertToUnit(AUnit); + if HasAttribute('textLength') then textLength := Units.ConvertWidth(textLength, AUnit); + if HasAttribute('font-size') then + SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); + ExitFontSize(prevFontSize); +end; + +{ TSVGTSpan } + +class function TSVGTSpan.GetDOMTag: string; +begin + Result:= 'tspan'; +end; + +{ TSVGTRef } + +function TSVGTRef.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGTRef.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +class function TSVGTRef.GetDOMTag: string; +begin + Result:= 'tref'; +end; + +{ TSVGTextPath } + +function TSVGTextPath.GetStartOffset: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnitDef['startOffset']; +end; + +function TSVGTextPath.GetMethod: TSVGTextPathMethod; +var + valueText: string; +begin + valueText := trim(Attribute['method','align']); + if valueText = 'align' then + result := stpmAlign + else + result := stpmStretch; +end; + +function TSVGTextPath.GetSpacing: TSVGTextPathSpacing; +var + valueText: string; +begin + valueText := trim(Attribute['spacing','exact']); + if valueText = 'exact' then + result := stpsExact + else + result := stpsAuto; +end; + +function TSVGTextPath.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGTextPath.SetStartOffset(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['startOffset'] := AValue; + RemoveStyle('startOffset'); +end; + +procedure TSVGTextPath.SetMethod(AValue: TSVGTextPathMethod); +begin + if AValue = stpmAlign then + Attribute['method'] := 'align' + else + Attribute['method'] := 'stretch'; + RemoveStyle('method'); +end; + +procedure TSVGTextPath.SetSpacing(AValue: TSVGTextPathSpacing); +begin + if AValue = stpsExact then + Attribute['spacing'] := 'exact' + else + Attribute['spacing'] := 'auto'; + RemoveStyle('spacing'); +end; + +procedure TSVGTextPath.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGTextPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGTextPath.GetDOMTag: string; +begin + Result:= 'textpath'; +end; + +procedure TSVGTextPath.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('startOffset') then startOffset := Units.ConvertWidth(startOffset, AUnit); +end; + +{ TSVGAltGlyph } + +function TSVGAltGlyph.GetGlyphRef: string; +begin + result := Attribute['glyphRef','']; +end; + +function TSVGAltGlyph.GetFormat: string; +begin + result := Attribute['format','']; +end; + +function TSVGAltGlyph.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGAltGlyph.SetGlyphRef(AValue: string); +begin + Attribute['glyphRef'] := AValue; +end; + +procedure TSVGAltGlyph.SetFormat(AValue: string); +begin + Attribute['format'] := AValue; +end; + +procedure TSVGAltGlyph.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGAltGlyph.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGAltGlyph.GetDOMTag: string; +begin + Result:= 'altglyph'; +end; + +{ TSVGAltGlyphDef } + +class function TSVGAltGlyphDef.GetDOMTag: string; +begin + Result:= 'altglyphdef'; +end; + +{ TSVGAltGlyphItem } + +class function TSVGAltGlyphItem.GetDOMTag: string; +begin + Result:= 'altglyphitem'; +end; + +{ TSVGGlyphRef } + +function TSVGGlyphRef.GetX: TSVGNumber; +begin + result := HorizAttribute['x']; +end; + +function TSVGGlyphRef.GetY: TSVGNumber; +begin + result := VerticalAttribute['y']; +end; + +function TSVGGlyphRef.GetDx: TSVGNumber; +begin + result := HorizAttribute['dx']; +end; + +function TSVGGlyphRef.GetDy: TSVGNumber; +begin + result := VerticalAttribute['dy']; +end; + +function TSVGGlyphRef.GetGlyphRef: string; +begin + result := Attribute['glyphRef','']; +end; + +function TSVGGlyphRef.GetFormat: string; +begin + result := Attribute['format','']; +end; + +function TSVGGlyphRef.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGGlyphRef.SetX(AValue: TSVGNumber); +begin + HorizAttribute['x'] := AValue; +end; + +procedure TSVGGlyphRef.SetY(AValue: TSVGNumber); +begin + VerticalAttribute['y'] := AValue; +end; + +procedure TSVGGlyphRef.SetDx(AValue: TSVGNumber); +begin + HorizAttribute['dx'] := AValue; +end; + +procedure TSVGGlyphRef.SetDy(AValue: TSVGNumber); +begin + HorizAttribute['dy'] := AValue; +end; + +procedure TSVGGlyphRef.SetGlyphRef(AValue: string); +begin + Attribute['glyphRef'] := AValue; +end; + +procedure TSVGGlyphRef.SetFormat(AValue: string); +begin + Attribute['format'] := AValue; +end; + +procedure TSVGGlyphRef.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGGlyphRef.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGGlyphRef.GetDOMTag: string; +begin + Result:= 'glyphref'; +end; + +{ TSVGClipPath } + +function TSVGClipPath.GetExternalResourcesRequired: boolean; +begin + if Attribute['externalResourcesRequired'] = 'true' then + result := true + else + result := false; +end; + +function TSVGClipPath.GetClipPathUnits: TSVGObjectUnits; +begin + if Attribute['clipPathUnits'] = 'objectBoundingBox' then + result := souObjectBoundingBox + else + result := souUserSpaceOnUse; +end; + +procedure TSVGClipPath.SetExternalResourcesRequired(AValue: boolean); +begin + if AValue then + Attribute['ExternalResourcesRequired'] := 'true' + else + Attribute['ExternalResourcesRequired'] := 'false'; +end; + +procedure TSVGClipPath.SetClipPathUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['clipPathUnits'] := 'userSpaceOnUse' + else + Attribute['clipPathUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGClipPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGClipPath.GetDOMTag: string; +begin + Result:= 'clippath'; +end; + +{ TSVGColorProfile } + +function TSVGColorProfile.GetLocal: string; +begin + result := Attribute['local']; +end; + +function TSVGColorProfile.GetName: string; +begin + result := Attribute['name']; +end; + +function TSVGColorProfile.GetRenderingIntent: TSVGRenderingIntent; +var + s: string; +begin + s := Attribute['rendering-intent','auto']; + if s = 'auto' then + result := sriAuto + else if s = 'perceptual' then + result := sriPerceptual + else if s = 'relative-colorimetric' then + result := sriRelativeColorimetric + else if s = 'saturation' then + result := sriSaturation + else { 'absolute-colorimetric' } + result := sriAbsoluteColorimetric; +end; + +function TSVGColorProfile.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGColorProfile.SetLocal(AValue: string); +begin + Attribute['local'] := AValue; +end; + +procedure TSVGColorProfile.SetName(AValue: string); +begin + Attribute['name'] := AValue; +end; + +procedure TSVGColorProfile.SetRenderingIntent(AValue: TSVGRenderingIntent); +begin + if AValue = sriAuto then + Attribute['rendering-intent'] := 'auto' + else if AValue = sriPerceptual then + Attribute['rendering-intent'] := 'perceptual' + else if AValue = sriRelativeColorimetric then + Attribute['rendering-intent'] := 'relative-colorimetric' + else if AValue = sriSaturation then + Attribute['rendering-intent'] := 'saturation' + else { sriAbsoluteColorimetric } + Attribute['rendering-intent'] := 'absolute-colorimetric' +end; + +procedure TSVGColorProfile.SetXlinkHref(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGColorProfile.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGColorProfile.GetDOMTag: string; +begin + Result:= 'colorprofile'; +end; + +{ TSVGImage } + +function TSVGImage.GetBitmap: TBGRACustomBitmap; +var + s: String; + posDelim: SizeInt; + stream64: TStringStream; + decoder: TBase64DecodingStream; + byteStream: TMemoryStream; +begin + if FBitmap = nil then + begin + FBitmap := BGRABitmapFactory.Create; + s := xlinkHref; + if copy(s,1,5) = 'data:' then + begin + posDelim := pos(';', s); + if posDelim > 0 then + begin + if copy(s, posDelim+1, 7) = 'base64,' then + begin + byteStream := TMemoryStream.Create; + try + stream64 := TStringStream.Create(s); + try + stream64.Position:= posDelim+7; + decoder := TBase64DecodingStream.Create(stream64, bdmMIME); + try + byteStream.CopyFrom(decoder, decoder.Size); + byteStream.Position:= 0; + finally + decoder.Free; + end; + finally + stream64.Free; + end; + try + FBitmap.LoadFromStream(byteStream); + except + on ex: exception do + begin + //image discarded if error + FBitmap.SetSize(0, 0); + end; + end; + finally + byteStream.Free; + end; + end; + end; + end; + end; + result := FBitmap; +end; + +function TSVGImage.GetExternalResourcesRequired: boolean; +begin + if Attribute['externalResourcesRequired'] = 'true' then + result := true + else + result := false; +end; + +function TSVGImage.GetImageRendering: TSVGImageRendering; +var s: string; +begin + s := AttributeOrStyle['image-rendering']; + if (s = 'smooth') or (s = 'optimizeQuality') then result := sirSmooth + else if s = 'high-quality' then result := sirHighQuality + else if s = 'crisp-edges' then result := sirCrispEdges + else if (s = 'pixelated') or (s = 'optimizeSpeed') then result := sirPixelated + else result := sirAuto; +end; + +function TSVGImage.GetX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['x']; +end; + +function TSVGImage.GetY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['y']; +end; + +function TSVGImage.GetWidth: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['width']; +end; + +function TSVGImage.GetHeight: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['height']; +end; + +function TSVGImage.GetPreserveAspectRatio: TSVGPreserveAspectRatio; +begin + result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']); +end; + +function TSVGImage.GetXlinkHref: string; +begin + result := Attribute['xlink:href']; +end; + +procedure TSVGImage.SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean); +var + byteStream: TMemoryStream; +begin + if AValue = FBitmap then exit; + FreeAndNil(FBitmap); + if AOwned then + FBitmap := AValue + else FBitmap := AValue.Duplicate; + if FBitmap = nil then + begin + FDomElem.RemoveAttribute('xlink:href'); + FDomElem.RemoveAttribute('href'); + exit; + end; + byteStream := TMemoryStream.Create; + try + FBitmap.SaveToStreamAsPng(byteStream); + SetBitmap(byteStream, 'image/png'); + finally + byteStream.Free; + end; +end; + +procedure TSVGImage.SetBitmap(AStream: TStream; AMimeType: string); +var + s: TStringStream; + encoder: TBase64EncodingStream; +begin + s := TStringStream.Create('data:'+AMimeType+';base64,'); + encoder := nil; + try + encoder := TBase64EncodingStream.Create(s); + s.Position:= s.Size; + AStream.Position := 0; + encoder.CopyFrom(AStream, AStream.Size); + encoder.Flush; + xlinkHref:= s.DataString; + finally + encoder.Free; + s.Free; + end; +end; + +procedure TSVGImage.SetExternalResourcesRequired(AValue: boolean); +begin + if AValue then + Attribute['ExternalResourcesRequired'] := 'true' + else + Attribute['ExternalResourcesRequired'] := 'false'; +end; + +procedure TSVGImage.SetImageRendering(AValue: TSVGImageRendering); +var s: string; +begin + case AValue of + sirSmooth: s := 'smooth'; + sirHighQuality: s := 'high-quality'; + sirCrispEdges: s := 'crisp-edges'; + sirPixelated: s := 'pixelated'; + else {sirAuto} s := 'auto'; + end; +end; + +procedure TSVGImage.SetX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['x'] := AValue; +end; + +procedure TSVGImage.SetY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['y'] := AValue; +end; + +procedure TSVGImage.SetWidth(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['width'] := AValue; +end; + +procedure TSVGImage.SetHeight(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['height'] := AValue; +end; + +procedure TSVGImage.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); +begin + Attribute['preserveAspectRatio'] := AValue.ToString; +end; + +procedure TSVGImage.SetXlinkHref(AValue: string); +begin + if xlinkHref = AValue then exit; + Attribute['xlink:href'] := AValue; + FreeAndNil(FBitmap); +end; + +procedure TSVGImage.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + aspect: TSVGPreserveAspectRatio; + coord: TPointF; + w, h: single; + ratioBitmap: single; + ratioPresentation: Single; + visualW, visualH: single; + filter: TResampleFilter; +begin + coord := PointF(Units.ConvertWidth(x, AUnit).value, + Units.ConvertHeight(y, AUnit).value); + w := Units.ConvertWidth(width, AUnit).value; + h := Units.ConvertHeight(height, AUnit).value; + if (w = 0) or (h = 0) or Bitmap.Empty then exit; + case imageRendering of + sirAuto, sirCrispEdges: filter := rfHalfCosine; + sirPixelated: filter := rfBox; + else filter := rfLinear; + end; + aspect := preserveAspectRatio; + if not aspect.Preserve then + ACanvas2d.drawImage(Bitmap, coord.x, coord.y, w, h, filter) + else + begin + ratioBitmap := Bitmap.Width/Bitmap.Height; + ratioPresentation := w/h; + if (ratioBitmap >= ratioPresentation) xor aspect.Slice then + begin + visualW := w; + visualH := visualW / ratioBitmap; + end else + begin + visualH := h; + visualW := visualH * ratioBitmap; + end; + case aspect.HorizAlign of + taRightJustify: IncF(coord.x, w - visualW); + taCenter: IncF(coord.x, (w - visualW)/2); + end; + case aspect.VertAlign of + tlBottom: IncF(coord.y, h - visualH); + tlCenter: IncF(coord.y, (h - visualH)/2); + end; + ACanvas2d.drawImage(FBitmap, coord.x, coord.y, visualW, visualH, filter); + end; +end; + +constructor TSVGImage.Create(ADocument: TDOMDocument; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(ADocument, AUnits, ADataLink); + FBitmap:= nil; +end; + +constructor TSVGImage.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink); +begin + inherited Create(AElement, AUnits, ADataLink); + FBitmap:= nil; +end; + +destructor TSVGImage.Destroy; +begin + FBitmap.Free; + inherited Destroy; +end; + +class function TSVGImage.GetDOMTag: string; +begin + Result:= 'image'; +end; + +procedure TSVGImage.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); + if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); + if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); + if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); +end; + +{ TSVGPattern } + +function TSVGPattern.GetPatternUnits: TSVGObjectUnits; +begin + if Attribute['patternUnits'] = 'userSpaceOnUse' then + result := souUserSpaceOnUse + else + result := souObjectBoundingBox; +end; + +function TSVGPattern.GetPatternContentUnits: TSVGObjectUnits; +begin + if Attribute['patternContentUnits'] = 'objectBoundingBox' then + result := souObjectBoundingBox + else + result := souUserSpaceOnUse; +end; + +function TSVGPattern.GetPatternTransform: string; +begin + result := Attribute['patternTransform']; +end; + +function TSVGPattern.GetViewBox: TSVGViewBox; +begin + result := TSVGViewBox.Parse(Attribute['viewBox']); +end; + +procedure TSVGPattern.SetPatternUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['patternUnits'] := 'userSpaceOnUse' + else + Attribute['patternUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGPattern.SetPatternContentUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['patternContentUnits'] := 'userSpaceOnUse' + else + Attribute['patternContentUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGPattern.SetPatternTransform(AValue: string); +begin + Attribute['patternTransform'] := AValue; +end; + +procedure TSVGPattern.SetViewBox(AValue: TSVGViewBox); +begin + Attribute['viewBox'] := AValue.ToString; +end; + +procedure TSVGPattern.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGPattern.GetDOMTag: string; +begin + Result:= 'pattern'; +end; + +{ TSVGMarker } + +function TSVGMarker.GetExternalResourcesRequired: boolean; +begin + if Attribute['externalResourcesRequired'] = 'true' then + result := true + else + result := false; +end; + +function TSVGMarker.GetViewBox: TSVGViewBox; +begin + result := TSVGViewBox.Parse(Attribute['viewBox']); +end; + +function TSVGMarker.GetPreserveAspectRatio: TSVGPreserveAspectRatio; +begin + result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']); +end; + +function TSVGMarker.GetRefX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['refX']; +end; + +function TSVGMarker.GetRefY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['refY']; +end; + +function TSVGMarker.GetMarkerWidth: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['markerWidth']; +end; + +function TSVGMarker.GetMarkerHeight: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['markerHeight']; +end; + +function TSVGMarker.GetMarkerUnits: TSVGMarkerUnits; +begin + if Attribute['markerUnits','strokeWidth'] = 'strokeWidth' then + result := smuStrokeWidth + else + result := smuUserSpaceOnUse; +end; + +function TSVGMarker.GetOrient: TSVGOrient; +var + err: integer; + s: string; +begin + s := Attribute['orient','0']; + result.angle := 0; + if s = 'auto' then + result.auto := soaAuto + else if s = 'auto-start-reverse' then + result.auto := soaAutoReverse + else + begin + result.auto := soaNone; + Val(s, result.angle, err); + if err <> 0 then + raise Exception('conversion error: '+IntToStr(err)+#13+'"'+s+'"'); + end; +end; + +procedure TSVGMarker.SetExternalResourcesRequired(AValue: boolean); +begin + if AValue then + Attribute['ExternalResourcesRequired'] := 'true' + else + Attribute['ExternalResourcesRequired'] := 'false'; +end; + +procedure TSVGMarker.SetViewBox(AValue: TSVGViewBox); +begin + Attribute['viewBox'] := AValue.ToString; +end; + +procedure TSVGMarker.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); +begin + Attribute['preserveAspectRatio'] := AValue.ToString; +end; + +procedure TSVGMarker.SetRefX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['refX'] := AValue; +end; + +procedure TSVGMarker.SetRefY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['refY'] := AValue; +end; + +procedure TSVGMarker.SetMarkerWidth(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['markerWidth'] := AValue; +end; + +procedure TSVGMarker.SetMarkerHeight(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['markerHeight'] := AValue; +end; + +procedure TSVGMarker.SetMarkerUnits(AValue: TSVGMarkerUnits); +begin + if AValue = smuStrokeWidth then + Attribute['markerUnits'] := 'strokeWidth' + else + Attribute['markerUnits'] := 'useSpaceOnUse'; +end; + +procedure TSVGMarker.SetOrient(AValue: TSVGOrient); +var + s: string; +begin + if AValue.auto = soaAuto then + s := 'auto' + else if AValue.auto = soaAutoReverse then + s := 'auto-start-reverse' + else + s := FloatToStr(AValue.angle); + Attribute['orient'] := s; +end; + +procedure TSVGMarker.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGMarker.GetDOMTag: string; +begin + Result:= 'marker'; +end; + +procedure TSVGMarker.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('refX') then refX := Units.ConvertWidth(refX, AUnit); + if HasAttribute('refY') then refY := Units.ConvertHeight(refY, AUnit); + if HasAttribute('markerWidth') then markerWidth := Units.ConvertWidth(markerWidth, AUnit); + if HasAttribute('markerHeight') then markerHeight := Units.ConvertHeight(markerHeight, AUnit); +end; + +{ TSVGMask } + +function TSVGMask.GetExternalResourcesRequired: boolean; +begin + if Attribute['externalResourcesRequired'] = 'true' then + result := true + else + result := false; +end; + +function TSVGMask.GetX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['x']; +end; + +function TSVGMask.GetY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['y']; +end; + +function TSVGMask.GetWidth: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['width']; +end; + +function TSVGMask.GetHeight: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['height']; +end; + +function TSVGMask.GetMaskUnits: TSVGObjectUnits; +begin + if Attribute['maskUnits'] = 'objectBoundingBox' then + result := souObjectBoundingBox + else + result := souUserSpaceOnUse; +end; + +function TSVGMask.GetMaskContentUnits: TSVGObjectUnits; +begin + if Attribute['maskContentUnits'] = 'objectBoundingBox' then + result := souObjectBoundingBox + else + result := souUserSpaceOnUse; +end; + +procedure TSVGMask.SetExternalResourcesRequired(AValue: boolean); +begin + if AValue then + Attribute['ExternalResourcesRequired'] := 'true' + else + Attribute['ExternalResourcesRequired'] := 'false'; +end; + +procedure TSVGMask.SetX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['x'] := AValue; +end; + +procedure TSVGMask.SetY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['y'] := AValue; +end; + +procedure TSVGMask.SetWidth(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['width'] := AValue; +end; + +procedure TSVGMask.SetHeight(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['height'] := AValue; +end; + +procedure TSVGMask.SetMaskUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['maskUnits'] := 'userSpaceOnUse' + else + Attribute['maskUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGMask.SetMaskContentUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['maskContentUnits'] := 'userSpaceOnUse' + else + Attribute['maskContentUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGMask.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //todo +end; + +class function TSVGMask.GetDOMTag: string; +begin + Result:= 'mask'; +end; + +procedure TSVGMask.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); + if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); + if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); + if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); +end; + +{ TSVGGroup } + +function TSVGGroup.GetFontSize: TFloatWithCSSUnit; +begin + result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); +end; + +function TSVGGroup.GetIsLayer: boolean; +begin + result := (Attribute['inkscape:groupmode'] = 'layer') +end; + +function TSVGGroup.GetName: string; +begin + result := Attribute['inkscape:label']; +end; + +procedure TSVGGroup.SetFontSize(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['font-size'] := AValue; +end; + +procedure TSVGGroup.SetIsLayer(AValue: boolean); +begin + if AValue = GetIsLayer then exit; + if AValue then + Attribute['inkscape:groupmode'] := 'layer' + else Attribute['inkscape:groupmode'] := ''; +end; + +procedure TSVGGroup.SetName(AValue: string); +begin + Attribute['inkscape:label'] := AValue; +end; + +procedure TSVGGroup.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + prevFontSize: TFloatWithCSSUnit; +begin + prevFontSize := EnterFontSize; + FContent.Draw(ACanvas2d, AUnit); + ExitFontSize(prevFontSize); +end; + +class function TSVGGroup.OwnDatalink: boolean; +begin + Result:= true; +end; + +class function TSVGGroup.GetDOMTag: string; +begin + Result:= 'g'; +end; + +procedure TSVGGroup.ConvertToUnit(AUnit: TCSSUnit); +var + prevFontSize: TFloatWithCSSUnit; +begin + if HasAttribute('font-size') then + SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); + prevFontSize := EnterFontSize; + inherited ConvertToUnit(AUnit); + ExitFontSize(prevFontSize); +end; + +{ TSVGStyle } + +constructor TSVGStyle.Create(AElement: TDOMElement; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(AElement, AUnits, ADataLink); + Parse(AElement.TextContent); +end; + +procedure TSVGStyle.Initialize; +begin + inherited Initialize; + Clear; +end; + +class function TSVGStyle.GetDOMTag: string; +begin + Result:= 'style'; +end; + +destructor TSVGStyle.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TSVGStyle.ConvertToUnit(AUnit: TCSSUnit); +var + declarations: String; + + function GetPropertyValue(AName: string; out AValue: TFloatWithCSSUnit): boolean; + var valueStr: string; + begin + valueStr := GetPropertyFromStyleDeclarationBlock(declarations, AName, ''); + if valueStr <> '' then + begin + AValue := Units.parseValue(valueStr, FloatWithCSSUnit(0, cuCustom)); + result := true; + end else + begin + AValue := FloatWithCSSUnit(0, cuCustom); + result := false; + end; + end; + + procedure SetPropertyValue(AName: string; AValue: TFloatWithCSSUnit); + begin + UpdateStyleDeclarationBlock(declarations, AName, Units.formatValue(AValue)); + end; + +var + i: Integer; + value: TFloatWithCSSUnit; +begin + inherited ConvertToUnit(AUnit); + for i := 0 to RulesetCount-1 do + begin + declarations := Ruleset[i].declarations; + if GetPropertyValue('stroke-width', value) then + SetPropertyValue('stroke-width', Units.ConvertOrtho(value, AUnit)); + if GetPropertyValue('stroke-dash-offset', value) then + SetPropertyValue('stroke-dash-offset', Units.ConvertOrtho(value, AUnit)); + if GetPropertyValue('font-size', value) then + SetPropertyValue('font-size', Units.ConvertHeight(value, AUnit)); + FRulesets[i].declarations := declarations; + end; +end; + +procedure TSVGStyle.Parse(const s: String); + + function IsValidDeclarationBlock(const sa: string): boolean; + var + i: integer; + begin + //(for case example "{ ; ;}") + for i:= 1 to Length(sa) do + if not (sa[i] in [' ',';']) then + exit(true); + result:= false; + end; + +const + EmptyRuleset: TSVGRuleset = (selector: ''; declarations: ''); +var + i,l,pg: integer; + st: String; + rec: TSVGRuleset; +begin + (* + Example of internal style block + circle {..} + circle.type1 {..} + .pic1 {..} + *) + Clear; + l:= 0; + pg:= 0; + st:= ''; + rec:= EmptyRuleset; + for i:= 1 to Length(s) do + begin + if s[i] = '{' then + begin + Inc(pg); + if (pg = 1) and (Length(st) <> 0) then + begin + rec.selector:= Trim(st); + st:= ''; + end; + end + else if s[i] = '}' then + begin + Dec(pg); + if (pg = 0) and (Length(st) <> 0) then + begin + if IsValidDeclarationBlock(st) then + begin + rec.declarations:= Trim(st); + Inc(l); + SetLength(FRulesets,l); + FRulesets[l-1]:= rec; + rec:= EmptyRuleset; + end; + st:= ''; + end; + end + else + st:= st + s[i]; + end; +end; + +function TSVGStyle.GetRulesetCount: integer; +begin + result := Length(FRulesets); +end; + +function TSVGStyle.IsValidRulesetIndex(const AIndex: integer): boolean; +begin + result:= (AIndex >= 0) and (AIndex < Length(FRulesets)); +end; + +function TSVGStyle.GetRuleset(const AIndex: integer): TSVGRuleset; +begin + if IsValidRulesetIndex(AIndex) then + result:= FRulesets[AIndex] + else + raise exception.Create(rsInvalidIndex); +end; + +procedure TSVGStyle.SetRuleset(const AIndex: integer; sr: TSVGRuleset); +begin + if IsValidRulesetIndex(AIndex) then + FRulesets[AIndex]:= sr + else + raise exception.Create(rsInvalidIndex); +end; + +function TSVGStyle.Count: Integer; +begin + result:= Length(FRulesets); +end; + +function TSVGStyle.Find(ARuleset: TSVGRuleset): integer; +var + i: integer; +begin + for i:= 0 to Length(FRulesets)-1 do + with FRulesets[i] do + if (selector = ARuleset.selector) and + (declarations = ARuleset.declarations) then + begin + result:= i; + Exit; + end; + result:= -1; +end; + +function TSVGStyle.Find(const AName: string): integer; +var + i: integer; +begin + for i:= 0 to Length(FRulesets)-1 do + with FRulesets[i] do + if selector = AName then + begin + result:= i; + Exit; + end; + result:= -1; +end; + +function TSVGStyle.Add(ARuleset: TSVGRuleset): integer; +var + l: integer; +begin + l:= Length(FRulesets); + SetLength(FRulesets,l+1); + FRulesets[l]:= ARuleset; + result:= l; +end; + +procedure TSVGStyle.Remove(ARuleset: TSVGRuleset); +var + l,p: integer; +begin + p:= Find(ARuleset); + l:= Length(FRulesets); + if p <> -1 then + begin + Finalize(FRulesets[p]); + System.Move(FRulesets[p+1], FRulesets[p], (l-p)*SizeOf(TSVGRuleset)); + SetLength(FRulesets,l-1); + end; +end; + +procedure TSVGStyle.Clear; +begin + SetLength(FRulesets,0); +end; + +procedure TSVGStyle.ReParse; +begin + Parse(FDomElem.TextContent); +end; + +{ TSVGRectangle } + +function TSVGRectangle.GetX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['x']; +end; + +function TSVGRectangle.GetY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['y']; +end; + +function TSVGRectangle.GetWidth: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['width']; +end; + +function TSVGRectangle.GetHeight: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['height']; +end; + +function TSVGRectangle.GetRX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['rx']; +end; + +function TSVGRectangle.GetRY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['ry']; +end; + +procedure TSVGRectangle.SetX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['x'] := AValue; +end; + +procedure TSVGRectangle.SetY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['y'] := AValue; +end; + +procedure TSVGRectangle.SetWidth(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['width'] := AValue; +end; + +procedure TSVGRectangle.SetHeight(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['height'] := AValue; +end; + +procedure TSVGRectangle.SetRX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['rx'] := AValue; +end; + +procedure TSVGRectangle.SetRY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['ry'] := AValue; +end; + +class function TSVGRectangle.GetDOMTag: string; +begin + Result:= 'rect'; +end; + +procedure TSVGRectangle.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); + if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); + if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit); + if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit); + if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); + if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); +end; + +procedure TSVGRectangle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + vx,vy,vw,vh: Single; +begin + if not isStrokeNone or not isFillNone then + begin + vx:= Units.ConvertWidth(x,AUnit).value; + vy:= Units.ConvertHeight(y,AUnit).value; + vw:= Units.ConvertWidth(width,AUnit).value; + vh:= Units.ConvertHeight(height,AUnit).value; + ACanvas2d.beginPath; + ACanvas2d.roundRect(vx,vy, vw,vh, + Units.ConvertWidth(rx,AUnit).value,Units.ConvertHeight(ry,AUnit).value); + InitializeGradient(ACanvas2d, PointF(vx,vy),vw,vh,AUnit); + Paint(ACanvas2D,AUnit); + end; +end; + +{ TSVGPolypoints } + +function TSVGPolypoints.GetClosed: boolean; +begin + result := FDomElem.TagName = 'polygon'; +end; + +function TSVGPolypoints.GetBoundingBoxF: TRectF; +begin + if not FBoundingBoxComputed then + ComputeBoundingBox(pointsF); + result := FBoundingBox; +end; + +function TSVGPolypoints.GetPoints: string; +begin + result := Attribute['points']; +end; + +function TSVGPolypoints.GetPointsF: ArrayOfTPointF; +var parser: TSVGParser; + nbcoord,i: integer; +begin + parser:=TSVGParser.Create(points); + nbcoord := 0; + repeat + parser.ParseFloat; + if not parser.NumberError then + inc(nbcoord); + until parser.NumberError or parser.Done; + parser.ClearError; + setlength(Result,nbcoord div 2); + parser.Position := 1; + for i := 0 to high(result) do + begin + result[i].x := parser.ParseFloat; + result[i].y := parser.ParseFloat; + end; + parser.Free; +end; + +procedure TSVGPolypoints.SetPoints(AValue: string); +begin + Attribute['points'] := AValue; +end; + +procedure TSVGPolypoints.SetPointsF(AValue: ArrayOfTPointF); +var s: string; + i: integer; +begin + s:= ''; + for i := 0 to high(AValue) do + begin + if s <> '' then AppendStr(s, ' '); + with AValue[i] do + AppendStr(s, TCSSUnitConverter.formatValue(x)+' '+TCSSUnitConverter.formatValue(y)); + end; + points := s; + ComputeBoundingBox(AValue); +end; + +procedure TSVGPolypoints.ComputeBoundingBox(APoints: ArrayOfTPointF); +var + i: Integer; +begin + if length(APoints) > 1 then + begin + with APoints[0] do + FBoundingBox:= RectF(x,y,x,y); + for i:= 1 to high(APoints) do + with APoints[i] do + begin + if x < FBoundingBox.Left then + FBoundingBox.Left:= x + else if x > FBoundingBox.Right then + FBoundingBox.Right:= x; + if y < FBoundingBox.Top then + FBoundingBox.Top:= y + else if y > FBoundingBox.Bottom then + FBoundingBox.Bottom:= y; + end; + FBoundingBoxComputed := true; + end else + begin + FBoundingBox := RectF(0,0,0,0); + FBoundingBoxComputed := true; + end; +end; + +constructor TSVGPolypoints.Create(ADocument: TDOMDocument; + AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink); +begin + inherited Create(ADocument, AUnits, ADataLink); + if AClosed then + Init(ADocument, 'polygon', AUnits) + else + Init(ADocument, 'polyline', AUnits); +end; + +destructor TSVGPolypoints.Destroy; +begin + inherited Destroy; +end; + +procedure TSVGPolypoints.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + prevMatrix: TAffineMatrix; + pts: ArrayOfTPointF; +begin + if isFillNone and isStrokeNone then exit; + if AUnit <> cuCustom then + begin + prevMatrix := ACanvas2d.matrix; + ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit), + Units.ConvertHeight(1,cuCustom,AUnit)); + InternalDraw(ACanvas2d, cuCustom); + ACanvas2d.matrix:= prevMatrix; + end else + begin + ACanvas2d.beginPath; + pts := pointsF; + ACanvas2d.polylineTo(pts); + if closed then ACanvas2d.closePath; + + with boundingBoxF do + InitializeGradient(ACanvas2d, + PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit); + Paint(ACanvas2D, AUnit); + end; +end; + +{ TSVGPath } + +function TSVGPath.GetPathLength: TFloatWithCSSUnit; +begin + result := OrthoAttributeWithUnit['pathLength']; +end; + +function TSVGPath.GetPath: TBGRAPath; +begin + if FPath = nil then + FPath := TBGRAPath.Create(Attribute['d']); + result := FPath; +end; + +function TSVGPath.GetBoundingBoxF: TRectF; +begin + if not FBoundingBoxComputed then + begin + FBoundingBox := path.GetBounds; + FBoundingBoxComputed := true; + end; + result := FBoundingBox; +end; + +function TSVGPath.GetData: string; +begin + if FPath = nil then + result := Attribute['d'] + else + result := FPath.SvgString; +end; + +procedure TSVGPath.SetPathLength(AValue: TFloatWithCSSUnit); +begin + OrthoAttributeWithUnit['pathLength'] := AValue; +end; + +procedure TSVGPath.SetData(AValue: string); +begin + if FPath = nil then + Attribute['d'] := AValue + else + FPath.SvgString := AValue; + FBoundingBoxComputed := false; +end; + +function TSVGPath.GetDOMElement: TDOMElement; +begin + if FPath <> nil then Attribute['d'] := FPath.SvgString; + Result:=inherited GetDOMElement; +end; + +constructor TSVGPath.Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(ADocument, AUnits, ADataLink); + FPath := nil; + FBoundingBoxComputed := false; + FBoundingBox := rectF(0,0,0,0); +end; + +constructor TSVGPath.Create(AElement: TDOMElement; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + inherited Create(AElement, AUnits, ADataLink); + FPath := nil; + FBoundingBoxComputed := false; + FBoundingBox := rectF(0,0,0,0); +end; + +destructor TSVGPath.Destroy; +begin + FreeAndNil(FPath); + inherited Destroy; +end; + +procedure TSVGPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + prevMatrix: TAffineMatrix; +begin + if isFillNone and isStrokeNone then exit; + if AUnit <> cuCustom then + begin + prevMatrix := ACanvas2d.matrix; + ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit), + Units.ConvertHeight(1,cuCustom,AUnit)); + InternalDraw(ACanvas2d, cuCustom); + ACanvas2d.matrix:= prevMatrix; + end else + begin + ACanvas2d.path(path); + if Assigned(FillGradientElement) or Assigned(StrokeGradientElement) then + with boundingBoxF do + InitializeGradient(ACanvas2d, + PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit); + Paint(ACanvas2D, AUnit); + end; +end; + +class function TSVGPath.GetDOMTag: string; +begin + Result:= 'path'; +end; + +{ TSVGEllipse } + +function TSVGEllipse.GetCX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['cx']; +end; + +function TSVGEllipse.GetCY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['cy']; +end; + +function TSVGEllipse.GetRX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['rx']; +end; + +function TSVGEllipse.GetRY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['ry']; +end; + +procedure TSVGEllipse.SetCX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['cx'] := AValue; +end; + +procedure TSVGEllipse.SetCY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['cy'] := AValue; +end; + +procedure TSVGEllipse.SetRX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['rx'] := AValue; +end; + +procedure TSVGEllipse.SetRY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['ry'] := AValue; +end; + +procedure TSVGEllipse.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + vcx,vcy,vrx,vry: Single; +begin + if not isFillNone or not isStrokeNone then + begin + vcx:= Units.ConvertWidth(cx,AUnit).value; + vcy:= Units.ConvertHeight(cy,AUnit).value; + vrx:= Units.ConvertWidth(rx,AUnit).value; + vry:= Units.ConvertHeight(ry,AUnit).value; + ACanvas2d.beginPath; + ACanvas2d.ellipse(vcx,vcy,vrx,vry); + InitializeGradient(ACanvas2d, PointF(vcx-vrx,vcy-vry),vrx*2,vry*2,AUnit); + Paint(ACanvas2D, AUnit); + end; +end; + +class function TSVGEllipse.GetDOMTag: string; +begin + Result:= 'ellipse'; +end; + +procedure TSVGEllipse.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit); + if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit); + if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit); + if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit); +end; + +{ TSVGCircle } + +function TSVGCircle.GetCX: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['cx']; +end; + +function TSVGCircle.GetCY: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['cy']; +end; + +function TSVGCircle.GetR: TFloatWithCSSUnit; +begin + result := OrthoAttributeWithUnit['r']; +end; + +procedure TSVGCircle.SetCX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['cx'] := AValue; +end; + +procedure TSVGCircle.SetCY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['cy'] := AValue; +end; + +procedure TSVGCircle.SetR(AValue: TFloatWithCSSUnit); +begin + OrthoAttributeWithUnit['r'] := AValue; +end; + +procedure TSVGCircle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var + vcx,vcy,vr: Single; +begin + if not isFillNone or not isStrokeNone then + begin + vcx:= Units.ConvertWidth(cx,AUnit).value; + vcy:= Units.ConvertHeight(cy,AUnit).value; + vr:= Units.ConvertOrtho(r,AUnit).value; + ACanvas2d.beginPath; + ACanvas2d.circle(vcx,vcy,vr); + InitializeGradient(ACanvas2d, PointF(vcx-vr,vcy-vr),vr*2,vr*2,AUnit); + Paint(ACanvas2d, AUnit); + end; +end; + +class function TSVGCircle.GetDOMTag: string; +begin + Result:= 'circle'; +end; + +procedure TSVGCircle.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit); + if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit); + if HasAttribute('r') then r := Units.ConvertOrtho(r, AUnit); +end; + +{ TSVGLine } + +function TSVGLine.GetX1: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['x1']; +end; + +function TSVGLine.GetX2: TFloatWithCSSUnit; +begin + result := HorizAttributeWithUnit['x2']; +end; + +function TSVGLine.GetY1: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['y1']; +end; + +function TSVGLine.GetY2: TFloatWithCSSUnit; +begin + result := VerticalAttributeWithUnit['y2']; +end; + +procedure TSVGLine.SetX1(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['x1'] := AValue; +end; + +procedure TSVGLine.SetX2(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['x2'] := AValue; +end; + +procedure TSVGLine.SetY1(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['y1'] := AValue; +end; + +procedure TSVGLine.SetY2(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['y2'] := AValue; +end; + +procedure TSVGLine.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + if not isStrokeNone then + begin + ApplyStrokeStyle(ACanvas2D,AUnit); + ACanvas2d.beginPath; + ACanvas2d.moveTo(Units.ConvertWidth(x1,AUnit).value,Units.ConvertHeight(y1,AUnit).value); + ACanvas2d.lineTo(Units.ConvertWidth(x2,AUnit).value,Units.ConvertHeight(y2,AUnit).value); + ACanvas2d.stroke; + end; +end; + +class function TSVGLine.GetDOMTag: string; +begin + Result:= 'line'; +end; + +procedure TSVGLine.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if HasAttribute('x1') then x1 := Units.ConvertWidth(x1, AUnit); + if HasAttribute('y1') then y1 := Units.ConvertHeight(y1, AUnit); + if HasAttribute('x2') then x2 := Units.ConvertWidth(x2, AUnit); + if HasAttribute('y2') then y2 := Units.ConvertHeight(y2, AUnit); +end; + +{ TSVGGradient } //## + +function TSVGGradient.GetHRef: string; +begin + result := Attribute['xlink:href']; +end; + +function TSVGGradient.GetSpreadMethod: TSVGSpreadMethod; +var + s: String; +begin + s := Attribute['spreadMethod']; + if s = 'reflect' then result := ssmReflect + else if s = 'repeat' then result := ssmRepeat + else result := ssmPad; +end; + +procedure TSVGGradient.SetColorInterpolation(AValue: TSVGColorInterpolation); +begin + if AValue = sciLinearRGB then + Attribute['color-interpolation'] := 'linearRGB' + else Attribute['color-interpolation'] := 'sRGB'; +end; + +procedure TSVGGradient.SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix); +begin + if not IsAffineMatrixIdentity(AValue) then + gradientTransform := MatrixToTransform(AValue, AUnit) + else FDomElem.RemoveAttribute('gradientTransform'); +end; + +procedure TSVGGradient.SetGradientTransform(AValue: string); +begin + Attribute['gradientTransform'] := AValue; +end; + +function TSVGGradient.GetGradientUnits: TSVGObjectUnits; +begin + if Attribute['gradientUnits','objectBoundingBox'] = 'userSpaceOnUse' then + result := souUserSpaceOnUse + else + result := souObjectBoundingBox; +end; + +function TSVGGradient.GetGradientTransform: string; +begin + result := Attribute['gradientTransform']; +end; + +function TSVGGradient.GetColorInterpolation: TSVGColorInterpolation; +begin + if Attribute['color-interpolation'] = 'linearRGB' then + result := sciLinearRGB + else result := sciStdRGB; +end; + +function TSVGGradient.GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix; +begin + result := TransformToMatrix(gradientTransform, AUnit); +end; + +procedure TSVGGradient.SetGradientUnits(AValue: TSVGObjectUnits); +begin + if AValue = souUserSpaceOnUse then + Attribute['gradientUnits'] := 'userSpaceOnUse' + else + Attribute['gradientUnits'] := 'objectBoundingBox'; +end; + +procedure TSVGGradient.SetHRef(AValue: string); +begin + Attribute['xlink:href'] := AValue; +end; + +procedure TSVGGradient.SetSpreadMethod(AValue: TSVGSpreadMethod); +var + s: String; +begin + case AValue of + ssmReflect: s := 'reflect'; + ssmRepeat: s := 'repeat'; + else s := 'pad'; + end; + Attribute['spreadMethod'] := s; +end; + +procedure TSVGGradient.Initialize; +begin + inherited; + InheritedGradients:= TSVGElementList.Create; +end; + +function TSVGGradient.GetInheritedAttribute(AValue: string; + AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +var + i: integer; + el: TSVGGradient; + invalidDef: TFloatWithCSSUnit; +begin + invalidDef:= FloatWithCSSUnit(EmptySingle,cuPercent); + //find valid inherited Attribute (start from "self": item[0]) + for i:= 0 to InheritedGradients.Count-1 do + begin + el:= TSVGGradient( InheritedGradients[i] ); + with el do + begin + if AConvMethod = cmHoriz then + result:= HorizAttributeWithUnitDef[AValue,invalidDef] + else if AConvMethod = cmVertical then + result:= VerticalAttributeWithUnitDef[AValue,invalidDef] + else if AConvMethod = cmOrtho then + result:= OrthoAttributeWithUnitDef[AValue,invalidDef] + else + result:= AttributeWithUnitDef[AValue,invalidDef]; + + if (result.value <> invalidDef.value) or + (result.CSSUnit <> invalidDef.CSSUnit) then + exit; + end; + end; + result:= ADefault; +end; + +destructor TSVGGradient.Destroy; +begin + FreeAndNil(InheritedGradients); + inherited Destroy; +end; + +procedure TSVGGradient.ScanInheritedGradients(const forceScan: boolean = false); +var + el: TSVGGradient; +begin + //(if list empty = not scan) + if (InheritedGradients.Count <> 0) and (not forceScan) then + exit; + + InheritedGradients.Clear; + InheritedGradients.Add(Self);//(important) + if FDataLink = nil then exit; + el:= Self; + while el.hRef <> '' do + begin + el := TSVGGradient(FDataLink.FindElementByRef(el.hRef, TSVGGradient)); + if Assigned(el) then InheritedGradients.Add(el); + end; +end; + +{ TSVGLinearGradient } + +function TSVGLinearGradient.GetX1: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('x1',cmNone,FloatWithCSSUnit(0,cuPercent)); +end; + +function TSVGLinearGradient.GetX2: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('x2',cmNone,FloatWithCSSUnit(100,cuPercent)); +end; + +function TSVGLinearGradient.GetY1: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('y1',cmNone,FloatWithCSSUnit(0,cuPercent)); +end; + +function TSVGLinearGradient.GetY2: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('y2',cmNone,FloatWithCSSUnit(0,cuPercent)); +end; + +procedure TSVGLinearGradient.SetX1(AValue: TFloatWithCSSUnit); +begin + AttributeWithUnit['x1']:= AValue; +end; + +procedure TSVGLinearGradient.SetX2(AValue: TFloatWithCSSUnit); +begin + AttributeWithUnit['x2']:= AValue; +end; + +procedure TSVGLinearGradient.SetY1(AValue: TFloatWithCSSUnit); +begin + AttributeWithUnit['y1']:= AValue; +end; + +procedure TSVGLinearGradient.SetY2(AValue: TFloatWithCSSUnit); +begin + AttributeWithUnit['y2']:= AValue; +end; + +class function TSVGLinearGradient.GetDOMTag: string; +begin + Result:= 'linearGradient'; +end; + +procedure TSVGLinearGradient.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if gradientUnits = souUserSpaceOnUse then + begin + if HasAttribute('x1') then x1 := Units.ConvertWidth(HorizAttributeWithUnit['x1'], AUnit); + if HasAttribute('y1') then y1 := Units.ConvertHeight(VerticalAttributeWithUnit['y1'], AUnit); + if HasAttribute('x2') then x2 := Units.ConvertWidth(HorizAttributeWithUnit['x2'], AUnit); + if HasAttribute('y2') then y2 := Units.ConvertHeight(VerticalAttributeWithUnit['y2'], AUnit); + end; +end; + +{ TSVGRadialGradient } + +function TSVGRadialGradient.GetCX: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('cx',cmHoriz,FloatWithCSSUnit(50,cuPercent)); +end; + +function TSVGRadialGradient.GetCY: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('cy',cmVertical,FloatWithCSSUnit(50,cuPercent)); +end; + +function TSVGRadialGradient.GetR: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('r',cmOrtho,FloatWithCSSUnit(50,cuPercent)); +end; + +function TSVGRadialGradient.GetFX: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('fx',cmHoriz,cx); +end; + +function TSVGRadialGradient.GetFY: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('fy',cmVertical,cy); +end; + +function TSVGRadialGradient.GetFR: TFloatWithCSSUnit; +begin + result := GetInheritedAttribute('fr',cmHoriz,FloatWithCSSUnit(0,cuPercent)); +end; + +procedure TSVGRadialGradient.SetCX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['cx'] := AValue; +end; + +procedure TSVGRadialGradient.SetCY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['cy'] := AValue; +end; + +procedure TSVGRadialGradient.SetR(AValue: TFloatWithCSSUnit); +begin + OrthoAttributeWithUnit['r'] := AValue; +end; + +procedure TSVGRadialGradient.SetFX(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['fx'] := AValue; +end; + +procedure TSVGRadialGradient.SetFY(AValue: TFloatWithCSSUnit); +begin + VerticalAttributeWithUnit['fy'] := AValue; +end; + +procedure TSVGRadialGradient.SetFR(AValue: TFloatWithCSSUnit); +begin + OrthoAttributeWithUnit['fr'] := AValue; +end; + +class function TSVGRadialGradient.GetDOMTag: string; +begin + Result:= 'radialGradient'; +end; + +procedure TSVGRadialGradient.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + if gradientUnits = souUserSpaceOnUse then + begin + if HasAttribute('cx') then cx := Units.ConvertWidth(HorizAttributeWithUnit['cx'], AUnit); + if HasAttribute('cy') then cy := Units.ConvertHeight(VerticalAttributeWithUnit['cy'], AUnit); + if HasAttribute('fx') then fx := Units.ConvertWidth(HorizAttributeWithUnit['fx'], AUnit); + if HasAttribute('fy') then fy := Units.ConvertHeight(VerticalAttributeWithUnit['fy'], AUnit); + if HasAttribute('r') then r := Units.ConvertOrtho(OrthoAttributeWithUnit['r'], AUnit); + if HasAttribute('fr') then fr := Units.ConvertOrtho(OrthoAttributeWithUnit['fr'], AUnit); + end; +end; + +{ TSVGStopGradient } + +function TSVGStopGradient.GetOffset: TFloatWithCSSUnit; +begin + result := AttributeWithUnit['offset']; +end; + +function TSVGStopGradient.GetStopColor: TBGRAPixel; +begin + result := StrToBGRA(AttributeOrStyleDef['stop-color','black']); + result.alpha := round(result.alpha*stopOpacity); +end; + +function TSVGStopGradient.GetStopOpacity: single; +var errPos: integer; +begin + val(AttributeOrStyleDef['stop-opacity','1'], result, errPos); + if errPos <> 0 then result := 1 else + if result < 0 then result := 0 else + if result > 1 then result := 1; +end; + +procedure TSVGStopGradient.SetOffset(AValue: TFloatWithCSSUnit); +begin + AttributeWithUnit['offset'] := AValue; +end; + +procedure TSVGStopGradient.SetStopColor(AValue: TBGRAPixel); +begin + stopOpacity:= AValue.alpha/255; + AValue.alpha:= 255; + Attribute['stop-color'] := Lowercase(BGRAToStr(AValue, CSSColors, 0, true, true)); + RemoveStyle('stop-color'); +end; + +procedure TSVGStopGradient.SetStopOpacity(AValue: single); +begin + Attribute['stop-opacity'] := Units.formatValue(AValue); + RemoveStyle('stop-opacity'); +end; + +class function TSVGStopGradient.GetDOMTag: string; +begin + Result:= 'stop'; +end; + +{ TSVGContent } + +function TSVGContent.GetElement(AIndex: integer): TSVGElement; +begin + result := TObject(FElements.Items[AIndex]) as TSVGElement; +end; + +function TSVGContent.GetElementObject(AIndex: integer): TObject; +begin + result := TObject(FElements.Items[AIndex]); +end; + +function TSVGContent.GetElementCount: integer; +begin + result := FElements.Count; +end; + +function TSVGContent.GetUnits: TCSSUnitConverter; +begin + result := FUnits; +end; + +function TSVGContent.TryCreateElementFromNode(ANode: TDOMNode): TObject; +begin + if ANode is TDOMElement then + result := CreateSVGElementFromNode(TDOMElement(ANode),FUnits,FDataLink) + else + result := ANode; +end; + +function TSVGContent.GetIsSVGElement(AIndex: integer): boolean; +begin + result := TObject(FElements[AIndex]) is TSVGElement; +end; + +function TSVGContent.GetElementDOMNode(AIndex: integer): TDOMNode; +begin + result := GetDOMNode(TObject(FElements[AIndex])); +end; + +function TSVGContent.GetDOMNode(AElement: TObject): TDOMNode; +begin + if AElement is TDOMNode then + result := TDOMNode(AElement) + else if AElement is TSVGElement then + result := TSVGElement(AElement).DOMElement + else + raise exception.Create('Unexpected element type'); +end; + +procedure TSVGContent.AppendElement(AElement: TObject); +begin + FDomElem.AppendChild(GetDOMNode(AElement)); + FElements.Add(AElement); + if AElement is TSVGElement then + TSVGElement(AElement).DataLink := FDataLink; +end; + +function TSVGContent.ExtractElementAt(AIndex: integer): TObject; +begin + result := ElementObject[AIndex]; + if result is TSVGElement then + begin + TSVGElement(result).DataLink := nil; + FElements.Delete(AIndex); + FDomElem.RemoveChild(TSVGElement(result).DOMElement); + end else + if result is TDOMNode then + FDomElem.RemoveChild(TDOMNode(result)) + else + raise exception.Create('Unexpected element type'); +end; + +procedure TSVGContent.InsertElementBefore(AElement: TSVGElement; + ASuccessor: TSVGElement); +var idx: integer; +begin + idx := FElements.IndexOf(ASuccessor); + if idx <> -1 then + begin + FElements.Insert(idx,AElement); + FDomElem.InsertBefore(GetDOMNode(AElement), GetDOMNode(ASuccessor)); + AElement.DataLink := FDataLink; + end + else + AppendElement(AElement); +end; + +constructor TSVGContent.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; + ADataLink: TSVGDataLink); +var cur: TDOMNode; + elem: TObject; +begin + FDoc := AElement.OwnerDocument; + FDomElem := AElement; + FDataLink := ADataLink; + FElements := TFPList.Create; + FUnits := AUnits; + cur := FDomElem.FirstChild; + while cur <> nil do + begin + elem := TryCreateElementFromNode(cur); + if Assigned(elem) then FElements.Add(elem); + cur := cur.NextSibling; + end; +end; + +destructor TSVGContent.Destroy; +var i:integer; +begin + for i := ElementCount-1 downto 0 do + if not (ElementObject[i] is TDOMNode) then + ElementObject[i].Free; + FreeAndNil(FElements); + inherited Destroy; +end; + +procedure TSVGContent.Clear; +var + i: Integer; +begin + for i := 0 to ElementCount-1 do + if IsSVGElement[i] then Element[i].Free; + FElements.Clear; + while Assigned(FDomElem.FirstChild) do + FDomElem.RemoveChild(FDomElem.FirstChild); +end; + +procedure TSVGContent.ConvertToUnit(AUnit: TCSSUnit); +var i: integer; +begin + for i := 0 to ElementCount-1 do + if IsSVGElement[i] then + Element[i].ConvertToUnit(AUnit); +end; + +procedure TSVGContent.Recompute; +var + i: Integer; +begin + for i := 0 to ElementCount-1 do + if IsSVGElement[i] then + Element[i].Recompute; +end; + +procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); +var prevMatrix: TAffineMatrix; +begin + if (x<>0) or (y<>0) then + begin + prevMatrix := ACanvas2d.matrix; + ACanvas2d.translate(x,y); + Draw(ACanvas2d, AUnit); + ACanvas2d.matrix := prevMatrix; + end else + Draw(ACanvas2d, AUnit); +end; + +procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var i: integer; +begin + for i := 0 to ElementCount-1 do + if IsSVGElement[i] then + Element[i].Draw(ACanvas2d, AUnit); +end; + +function TSVGContent.AppendElement(ASVGType: TSVGFactory): TSVGElement; +begin + result := ASVGType.Create(FDoc,Units,FDataLink); + AppendElement(result); +end; + +procedure TSVGContent.BringElement(AElement: TObject; + AFromContent: TSVGContent); +var + idx: Integer; +begin + idx := AFromContent.IndexOfElement(AElement); + if idx = -1 then raise exception.Create('Cannot find element in content'); + AFromContent.ExtractElementAt(idx); + AppendElement(AElement); +end; + +procedure TSVGContent.CopyElement(AElement: TObject); +var + nodeCopy: TDOMNode; + objCopy: TObject; +begin + if AElement is TSVGElement then + nodeCopy := TSVGElement(AElement).DOMElement.CloneNode(true, FDoc) + else if AElement is TDOMNode then + nodeCopy := TDOMNode(AElement).CloneNode(true, FDoc) + else + raise exception.Create('Unexpected element type'); + + FDomElem.AppendChild(nodeCopy); + objCopy := TryCreateElementFromNode(nodeCopy); + if Assigned(objCopy) then FElements.Add(objCopy); +end; + +procedure TSVGContent.RemoveElement(AElement: TObject); +var + idx: Integer; +begin + idx := IndexOfElement(AElement); + if idx = -1 then exit; + if AElement is TSVGElement then + begin + ExtractElementAt(idx); + TSVGElement(AElement).DOMElement.Free; + AElement.Free; + end else + if AElement is TDOMNode then + begin + ExtractElementAt(idx); + TDOMNode(AElement).Free; + end else + raise exception.Create('Unexpected element type'); +end; + +function TSVGContent.AppendDOMText(AText: string): TDOMText; +begin + result := TDOMText.Create(FDomElem.OwnerDocument); + result.Data:= AText; + AppendElement(result); +end; + +function TSVGContent.AppendDefine: TSVGDefine; +begin + result := TSVGDefine.Create(FDoc,Units,FDataLink); + AppendElement(result); +end; + +function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single; AIsPercent: boolean): TSVGLinearGradient; +var + u: TCSSUnit; +begin + result := TSVGLinearGradient.Create(FDoc,Units,FDataLink); + result.gradientUnits:= souObjectBoundingBox; + if AIsPercent then u := cuPercent else u := cuCustom; + result.x1 := FloatWithCSSUnit(x1, u); + result.x2 := FloatWithCSSUnit(x2, u); + result.y1 := FloatWithCSSUnit(y1, u); + result.y2 := FloatWithCSSUnit(y2, u); + AppendElement(result); +end; + +function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single; + AUnit: TCSSUnit): TSVGLinearGradient; +begin + result := TSVGLinearGradient.Create(FDoc,Units,FDataLink); + result.gradientUnits:= souUserSpaceOnUse; + result.x1 := FloatWithCSSUnit(x1, AUnit); + result.x2 := FloatWithCSSUnit(x2, AUnit); + result.y1 := FloatWithCSSUnit(y1, AUnit); + result.y2 := FloatWithCSSUnit(y2, AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single; + AIsPercent: boolean): TSVGRadialGradient; +var + u: TCSSUnit; +begin + result := TSVGRadialGradient.Create(FDoc,Units,FDataLink); + result.gradientUnits:= souObjectBoundingBox; + if AIsPercent then u := cuPercent else u := cuCustom; + result.cx := FloatWithCSSUnit(cx, u); + result.cy := FloatWithCSSUnit(cy, u); + result.r := FloatWithCSSUnit(r, u); + result.fx := FloatWithCSSUnit(fx, u); + result.fy := FloatWithCSSUnit(fy, u); + result.fr := FloatWithCSSUnit(fr, u); + AppendElement(result); +end; + +function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single; + AUnit: TCSSUnit): TSVGRadialGradient; +begin + result := TSVGRadialGradient.Create(FDoc,Units,FDataLink); + result.gradientUnits:= souUserSpaceOnUse; + result.cx := FloatWithCSSUnit(cx, AUnit); + result.cy := FloatWithCSSUnit(cy, AUnit); + result.r := FloatWithCSSUnit(r, AUnit); + result.fx := FloatWithCSSUnit(fx, AUnit); + result.fy := FloatWithCSSUnit(fy, AUnit); + result.fr := FloatWithCSSUnit(fr, AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendStop(AColor: TBGRAPixel; AOffset: single; + AIsPercent: boolean): TSVGStopGradient; +begin + result := TSVGStopGradient.Create(FDoc,Units,FDataLink); + if AIsPercent then + result.Offset := FloatWithCSSUnit(AOffset, cuPercent) + else result.Offset := FloatWithCSSUnit(AOffset, cuCustom); + result.stopColor := AColor; + AppendElement(result); +end; + +function TSVGContent.AppendLine(x1, y1, x2, y2: single; AUnit: TCSSUnit + ): TSVGLine; +begin + result := TSVGLine.Create(FDoc,Units,FDataLink); + result.x1 := FloatWithCSSUnit(x1,AUnit); + result.y1 := FloatWithCSSUnit(y1,AUnit); + result.x2 := FloatWithCSSUnit(x2,AUnit); + result.y2 := FloatWithCSSUnit(y2,AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendLine(p1, p2: TPointF; AUnit: TCSSUnit): TSVGLine; +begin + result := AppendLine(p1.x,p1.y,p2.x,p2.y,AUnit); +end; + +function TSVGContent.AppendCircle(cx, cy, r: single; AUnit: TCSSUnit + ): TSVGCircle; +begin + result := TSVGCircle.Create(FDoc,Units,FDataLink); + result.cx := FloatWithCSSUnit(cx,AUnit); + result.cy := FloatWithCSSUnit(cy,AUnit); + result.r := FloatWithCSSUnit(r,AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit + ): TSVGCircle; +begin + result := AppendCircle(c.x,c.y,r,AUnit); +end; + +function TSVGContent.AppendEllipse(cx, cy, rx, ry: single; AUnit: TCSSUnit + ): TSVGEllipse; +begin + result := TSVGEllipse.Create(FDoc,Units,FDataLink); + result.cx := FloatWithCSSUnit(cx,AUnit); + result.cy := FloatWithCSSUnit(cy,AUnit); + result.rx := FloatWithCSSUnit(rx,AUnit); + result.ry := FloatWithCSSUnit(ry,AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendEllipse(c, r: TPointF; AUnit: TCSSUnit): TSVGEllipse; +begin + result := AppendEllipse(c.x,c.y,r.x,r.y,AUnit); +end; + +function TSVGContent.AppendPath(data: string; AUnit: TCSSUnit): TSVGPath; +var tempPath: TBGRAPath; +begin + if AUnit <> cuCustom then + begin + tempPath := TBGRAPath.Create(data); + result := AppendPath(tempPath, AUnit); + tempPath.Free; + end else + begin + result := TSVGPath.Create(FDoc,Units,FDataLink); + result.d := data; + AppendElement(result); + end; +end; + +function TSVGContent.AppendPath(path: TBGRAPath; AUnit: TCSSUnit): TSVGPath; +begin + result := TSVGPath.Create(FDoc,Units,FDataLink); + result.path.scale(Units.ConvertWidth(1,AUnit,cuCustom)); + path.copyTo(result.path); + AppendElement(result); +end; + +function TSVGContent.AppendPolygon(const points: array of single; + AUnit: TCSSUnit): TSVGPolypoints; +var + pts: ArrayOfTPointF; + i: integer; +begin + result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink); + setlength(pts, length(points) div 2); + for i := 0 to high(pts) do + pts[i] := Units.ConvertCoord(PointF(points[i shl 1],points[(i shl 1)+1]),AUnit,cuCustom); + result.pointsF := pts; + AppendElement(result); +end; + +function TSVGContent.AppendPolygon(const points: array of TPointF; + AUnit: TCSSUnit): TSVGPolypoints; +var + pts: ArrayOfTPointF; + i: integer; +begin + result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink); + setlength(pts, length(points)); + for i := 0 to high(pts) do + pts[i] := Units.ConvertCoord(points[i],AUnit,cuCustom); + result.pointsF := pts; + AppendElement(result); +end; + +function TSVGContent.AppendRect(x, y, width, height: single; AUnit: TCSSUnit + ): TSVGRectangle; +begin + result := TSVGRectangle.Create(FDoc,Units,FDataLink); + result.x := FloatWithCSSUnit(x,AUnit); + result.y := FloatWithCSSUnit(y,AUnit); + result.width := FloatWithCSSUnit(width,AUnit); + result.height := FloatWithCSSUnit(height,AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendRect(origin, size: TPointF; AUnit: TCSSUnit + ): TSVGRectangle; +begin + result := AppendRect(origin.x,origin.y,size.x,size.y,AUnit); +end; + +function TSVGContent.AppendImage(x, y, width, height: single; ABitmap: TBGRACustomBitmap; + ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage; +begin + result := TSVGImage.Create(FDoc,Units,FDataLink); + result.x := FloatWithCSSUnit(x, AUnit); + result.y := FloatWithCSSUnit(y, AUnit); + result.width := FloatWithCSSUnit(width, AUnit); + result.height := FloatWithCSSUnit(height, AUnit); + result.SetBitmap(ABitmap, ABitmapOwned); + AppendElement(result); +end; + +function TSVGContent.AppendImage(origin, size: TPointF; ABitmap: TBGRACustomBitmap; + ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage; +begin + result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmap,ABitmapOwned,AUnit); +end; + +function TSVGContent.AppendImage(x, y, width, height: single; + ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit): TSVGImage; +begin + result := TSVGImage.Create(FDoc,Units,FDataLink); + result.x := FloatWithCSSUnit(x, AUnit); + result.y := FloatWithCSSUnit(y, AUnit); + result.width := FloatWithCSSUnit(width, AUnit); + result.height := FloatWithCSSUnit(height, AUnit); + result.SetBitmap(ABitmapStream, AMimeType); + AppendElement(result); +end; + +function TSVGContent.AppendImage(origin, size: TPointF; ABitmapStream: TStream; + AMimeType: string; AUnit: TCSSUnit): TSVGImage; +begin + result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmapStream,AMimeType,AUnit); +end; + +function TSVGContent.AppendText(x, y: single; AText: string; AUnit: TCSSUnit + ): TSVGText; +var + a: ArrayOfTFloatWithCSSUnit; +begin + result := TSVGText.Create(FDoc,Units,FDataLink); + setlength(a,1); + try + a[0] := FloatWithCSSUnit(x,AUnit); + result.x := a; + a[0] := FloatWithCSSUnit(y,AUnit); + result.y := a; + finally + setlength(a,0); + end; + if AText <> '' then + result.SimpleText:= AText; + AppendElement(result); +end; + +function TSVGContent.AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit + ): TSVGText; +begin + result := AppendText(origin.x,origin.y,AText,AUnit); +end; + +function TSVGContent.AppendTextSpan(AText: string): TSVGTSpan; +begin + result := TSVGTSpan.Create(FDoc,Units,FDataLink); + result.SimpleText:= AText; + AppendElement(result); +end; + +function TSVGContent.AppendRoundRect(x, y, width, height, rx, ry: single; + AUnit: TCSSUnit): TSVGRectangle; +begin + result := TSVGRectangle.Create(FDoc,Units,FDataLink); + result.x := FloatWithCSSUnit(x,AUnit); + result.y := FloatWithCSSUnit(y,AUnit); + result.width := FloatWithCSSUnit(width,AUnit); + result.height := FloatWithCSSUnit(height,AUnit); + result.rx := FloatWithCSSUnit(rx,AUnit); + result.ry := FloatWithCSSUnit(ry,AUnit); + AppendElement(result); +end; + +function TSVGContent.AppendRoundRect(origin, size, radius: TPointF; + AUnit: TCSSUnit): TSVGRectangle; +begin + result := AppendRoundRect(origin.x,origin.y,size.x,size.y,radius.x,radius.y,AUnit); +end; + +function TSVGContent.AppendGroup: TSVGGroup; +begin + result := TSVGGroup.Create(FDoc, Units, FDataLink); + AppendElement(result); +end; + +function TSVGContent.IndexOfElement(AElement: TObject): integer; +begin + result := FElements.IndexOf(AElement); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgtype.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgtype.pas new file mode 100644 index 0000000..57ed4ee --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrasvgtype.pas @@ -0,0 +1,2468 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRASVGType; + +{$mode objfpc}{$H+} +{$MODESWITCH ADVANCEDRECORDS} + +interface + +uses + BGRAClasses, SysUtils, BGRATransform, BGRABitmapTypes, BGRAUnits, + DOM, BGRACanvas2D, fgl, BGRAGraphics; + +type + ArrayOfFloat = array of single; + ArrayOfString = array of string; + + TSVGElement = class; + TSVGElementList = specialize TFPGList; + TSVGElementDictionary = specialize TFPGMap; + TSVGFactory = class of TSVGElement; + + TSVGFillMode = ( + sfmEvenOdd = Ord(fmAlternate), + sfmNonZero = Ord(fmWinding) + ); + + TSVGPaintOrder = ( + spoFillStrokeMarkers, + spoFillMarkersStroke, + spoStrokeFillMarkers, + spoStrokeMarkersFill, + spoMarkersFillStroke, + spoMarkersStrokeFill + ); + + TSVGLengthAdjust = ( + slaSpacing, + slaSpacingAndGlyphs + ); + + TSVGTextPathMethod = ( + stpmAlign, + stpmStretch + ); + + TSVGTextPathSpacing = ( + stpsAuto, + stpsExact + ); + + TSVGTextAnchor = ( + staStart, + staMiddle, + staEnd + ); + + TSVGTextDirection = ( + stdLtr, + stdRtl + ); + + TSVGObjectUnits = ( + souUserSpaceOnUse, + souObjectBoundingBox + ); + + TSVGSpreadMethod = ( + ssmPad, + ssmReflect, + ssmRepeat + ); + + TSVGColorInterpolation = ( + sciStdRGB, + sciLinearRGB + ); + + TSVGImageRendering = ( + sirAuto, + sirSmooth, + sirHighQuality, + sirCrispEdges, + sirPixelated + ); + + TSVGRenderingIntent = ( + sriAuto, + sriPerceptual, + sriRelativeColorimetric, + sriSaturation, + sriAbsoluteColorimetric + ); + + TSVGMarkerUnits = ( + smuStrokeWidth, + smuUserSpaceOnUse + ); + + TSVGOrientAuto = (soaNone,soaAuto,soaAutoReverse); + TSVGOrient = record + auto: TSVGOrientAuto; + angle: TSVGNumber; + end; + + TFindStyleState = (fssNotSearched, + fssNotFound, + fssFound); + TStyleAttribute = record + attr : string; + pos : integer; + end; + ArrayOfTStyleAttribute = array of TStyleAttribute; + + { TSVGViewBox } + + TSVGViewBox = record + min, size: TPointF; + function ToString: string; + class function Parse(AValue: string): TSVGViewBox; static; + class function DefaultValue: TSVGViewBox; static; + end; + TSVGSize = record + width, height: TFloatWithCSSUnit; + end; + + { TSVGPreserveAspectRatio } + + TSVGPreserveAspectRatio = record + Preserve, Slice: boolean; + HorizAlign: TAlignment; + VertAlign: TTextLayout; + function ToString: string; + class function Parse(AValue: string): TSVGPreserveAspectRatio; static; + class function DefaultValue: TSVGPreserveAspectRatio; static; + end; + + TSVGRecomputeEvent = procedure(Sender: TObject) of object; + TSVGLinkEvent = procedure(Sender: TObject; AElement: TSVGElement; ALink: boolean) of object; + TSVGLinkListeners = specialize TFPGList; + + { TSVGDataLink } + + TSVGDataLink = class + private + FElements: TSVGElementDictionary; + FStyles: TSVGElementList; + FParent: TSVGDataLink; + FChildren: TList; + FLinkListeners: TSVGLinkListeners; + function GetElement(AIndex: integer): TSVGElement; + function GetStyle(AIndex: integer): TSVGElement; + function IsValidIndex(const AIndex: integer; list: TSVGElementList): boolean; + function FindTo(el: TSVGElement; list: TSVGElementList): integer; + procedure NotifyLink(AElement: TSVGElement; ALink: boolean); + procedure SetParent(AValue: TSVGDataLink); + public + constructor Create(AParent: TSVGDataLink); + destructor Destroy; override; + + function ElementCount: integer; + function StyleCount: integer; + function FindElement(el: TSVGElement): integer; + function FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; + function FindElementByRef(ARef: string; AClass: TSVGFactory): TSVGElement; + function FindElementByRef(ARef: string; ANeedUrl: boolean; AClass: TSVGFactory; out ANotFound: boolean): TSVGElement; + function FindStyle(el: TSVGElement): integer; + function IsLinkElement(el: TSVGElement): boolean; + function IsLinkStyle(el: TSVGElement): boolean; + function IsLink(el: TSVGElement): boolean; + function Link(el: TSVGElement): integer; + procedure Unlink(el: TSVGElement); + procedure UnlinkAll; + procedure RegisterLinkListener(AHandler: TSVGLinkEvent; ARegister: boolean); + + property Styles[ID: integer]: TSVGElement read GetStyle; + property Elements[AIndex: integer]: TSVGElement read GetElement; + property Parent: TSVGDataLink read FParent write SetParent; + end; + + { TSVGCustomElement } + + TSVGCustomElement = class + protected + FDomElem: TDOMElement; + FUnits: TCSSUnitConverter; + function GetDOMElement: TDOMElement; virtual; + + function GetAttributeFromElement(ANode: TDOMElement; AName: string; ACanInherit: boolean): string; + function GetAttribute(AName: string; ADefault: string; ACanInherit: boolean): string; overload; + function GetAttribute(AName: string; ADefault: string): string; overload; + function GetAttribute(AName: string): string; overload; + function GetAttributeNumber(AName: string; ADefault: TSVGNumber): TSVGNumber; overload; + function GetArrayOfAttributeNumber(AName: string): ArrayOfTSVGNumber; + function GetArrayOfAttributeNumber(AName: string; ACanInherit: boolean): ArrayOfTSVGNumber; + function GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; + function GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload; + function GetArrayOfAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; + function GetArrayOfAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + + function GetHorizAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; + function GetHorizAttribute(AName: string): TSVGNumber; + function GetHorizAttributeWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + function GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; + function GetArrayOfHorizAttributeWithUnit(AName: string; + ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; + function GetArrayOfHorizAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + + function GetVerticalAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; + function GetVerticalAttribute(AName: string): TSVGNumber; + function GetVerticalAttributeWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + function GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; + function GetArrayOfVerticalAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + function GetArrayOfVerticalAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; + + function GetOrthoAttributeWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + function GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; + function GetArrayOfOrthoAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + function GetArrayOfOrthoAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; + + function GetAttributeOrStyle(AName,ADefault: string; ACanInherit: boolean): string; overload; + function GetAttributeOrStyle(AName,ADefault: string): string; overload; + function GetAttributeOrStyle(AName: string): string; overload; + function GetHorizAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + function GetArrayOfHorizAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + function GetOrthoAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; + function GetArrayOfOrthoAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + function GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; overload; + function GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; + function GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; overload; + function GetArrayOfAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + function GetVerticalAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; overload; + function GetVerticalAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; + function GetArrayOfVerticalAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; + + function GetNamespaceCount: integer; + function GetNamespacePrefix(AIndex: integer): string; + function GetNamespaceURI(APrefix: string): string; + + class function GetPropertyFromStyleDeclarationBlock(ABlock: string; + AProperty: string; ADefault: string): string; + class procedure LocateStyleDeclaration(AText: string; AProperty: string; + out AStartPos, AColonPos, AValueLength: integer); + class procedure UpdateStyleDeclarationBlock(var ABlock: string; AProperty: string; AValue: string); + class function RemovePropertyFromDeclarationBlock(var ABlock: string; AProperty: string): boolean; + function GetInlineStyle(const AName,ADefault: string): string; + function GetInlineStyleWithUnit(const AName: string): TFloatWithCSSUnit; overload; + function GetInlineStyleWithUnit(const AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; + function GetStyleFromStyleSheet(const {%H-}AName,ADefault: string): string; virtual; + function GetStyle(const AName,ADefault: string): string; overload; + function GetStyle(const AName: string): string; overload; + + procedure SetAttribute(AName: string; AValue: TSVGNumber); virtual; overload; + procedure SetAttribute(AName: string; AValue: string); virtual; overload; + procedure SetAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); + procedure SetArrayOfAttributeWithUnit(AName: string; const AValue: ArrayOfTFloatWithCSSUnit); + + procedure SetHorizAttribute(AName: string; AValue: TSVGNumber); + procedure SetHorizAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); + procedure SetArrayOfHorizAttributeWithUnit(AName: string; + AValue: ArrayOfTFloatWithCSSUnit); + + procedure SetVerticalAttribute(AName: string; AValue: TSVGNumber); + procedure SetArrayOfAttributeNumber(AName: string; AValue: ArrayOfTSVGNumber); + procedure SetVerticalAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); + procedure SetArrayOfVerticalAttributeWithUnit(AName: string; AValue: ArrayOfTFloatWithCSSUnit); + + procedure SetOrthoAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); + procedure SetArrayOfOrthoAttributeWithUnit(AName: string; AValue: ArrayOfTFloatWithCSSUnit); + + procedure SetNamespaceURI(APrefix: string; AValue: string); + + procedure SetInlineStyle(AName: string; AValue: string); overload; + procedure SetInlineStyle(AName: string; AValue: TFloatWithCSSUnit); overload; + public + procedure RemoveStyle(const AName: string); + function HasAttribute(AName: string): boolean; + function HasInlineStyle(AName: string): boolean; + + procedure ConvertToUnit(AUnit: TCSSUnit); virtual; + function EnterFontSize(AIsRoot: boolean = false): TFloatWithCSSUnit; virtual; + procedure ExitFontSize(APrevFontSize: TFloatWithCSSUnit); virtual; + + function MatrixToTransform(m: TAffineMatrix; AFromUnit: TCSSUnit): string; + function TransformToMatrix(ATransform: string; AToUnit: TCSSUnit): TAffineMatrix; + + procedure RemoveNamespace(APrefix: string); + function NeedNamespace(APrefix: string): boolean; + property NamespaceURI[APrefix: string]: string read GetNamespaceURI write SetNamespaceURI; + property NamespacePrefix[AIndex: integer]: string read GetNamespacePrefix; + property NamespaceCount: integer read GetNamespaceCount; + + property Style[AName: string]: string read GetStyle write SetInlineStyle; + property StyleDef[AName,ADefault: string]: string read GetStyle; + end; + + { TSVGElement } + + TSVGElement = class(TSVGCustomElement) + private + FImportStyleState: TFindStyleState; + FImportedStyles: ArrayOfTStyleAttribute; + function GetClipPath: string; + function GetFill: string; + function GetFillColor: TBGRAPixel; + function GetFillOpacity: single; + function GetFillRule: string; + function GetIsFillNone: boolean; + function GetIsStrokeNone: boolean; + function GetMatrix(AUnit: TCSSUnit): TAffineMatrix; + function GetMixBlendMode: TBlendOperation; + function GetOpacity: single; + function GetPaintOrder: TSVGPaintOrder; + function GetStroke: string; + function GetStrokeColor: TBGRAPixel; + function GetStrokeLineCap: string; + function GetStrokeLineCapLCL: TPenEndCap; + function GetStrokeLineJoin: string; + function GetStrokeLineJoinLCL: TPenJoinStyle; + function GetStrokeMiterLimit: single; + function GetStrokeOpacity: single; + function GetStrokeWidth: TFloatWithCSSUnit; + function GetStrokeDashArray: string; + function GetStrokeDashArrayF: ArrayOfFloat; + function GetStrokeDashOffset: TFloatWithCSSUnit; + function GetTransform: string; + function GetID: string; + function GetClassAttr: string; + function GetVisible: boolean; + procedure SetClipPath(AValue: string); + procedure SetFillColor(AValue: TBGRAPixel); + procedure SetFillOpacity(AValue: single); + procedure SetFillRule(AValue: string); + procedure SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix); + procedure SetMixBlendMode(AValue: TBlendOperation); + procedure SetOpacity(AValue: single); + procedure SetPaintOrder(AValue: TSVGPaintOrder); + procedure SetStrokeColor(AValue: TBGRAPixel); + procedure SetStrokeLineCap(AValue: string); + procedure SetStrokeLineCapLCL(AValue: TPenEndCap); + procedure SetStrokeLineJoin(AValue: string); + procedure SetStrokeLineJoinLCL(AValue: TPenJoinStyle); + procedure SetStrokeMiterLimit(AValue: single); + procedure SetStrokeOpacity(AValue: single); + procedure SetStrokeWidth(AValue: TFloatWithCSSUnit); + procedure SetStrokeDashArray(AValue: string); + procedure SetStrokeDashArrayF(AValue: ArrayOfFloat); + procedure SetStrokeDashOffset(AValue: TFloatWithCSSUnit); + procedure SetTransform(AValue: string); + procedure SetID(AValue: string); + procedure SetClassAttr(AValue: string); + function FindStyleElementInternal(const classStr: string; + out attributesStr: string): integer; + procedure ImportStyles; + procedure SetVisible(AValue: boolean); + protected + FDataLink: TSVGDataLink; + procedure Init(ADocument: TDOMDocument; ATag: string; AUnits: TCSSUnitConverter); overload; + procedure Init(AElement: TDOMElement; AUnits: TCSSUnitConverter); overload; + procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual; + function GetStyleFromStyleSheet(const AName,ADefault: string): string; override; + procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual; + procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); virtual; + procedure SetDatalink(AValue: TSVGDataLink); virtual; + procedure SetFill(AValue: string); virtual; + procedure SetStroke(AValue: string); virtual; + procedure Initialize; virtual; + procedure Paint(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); + public + constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual; + constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual; + class function GetDOMTag: string; virtual; + destructor Destroy; override; + procedure ListIdentifiers(AResult: TStringList); virtual; + procedure RenameIdentifiers(AFrom, ATo: TStringList); virtual; + procedure ConvertToUnit(AUnit: TCSSUnit); override; + procedure Recompute; virtual; + procedure Draw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); + procedure fillNone; + procedure strokeNone; + procedure strokeDashArrayNone; + procedure transformNone; + function fillMode: TSVGFillMode; + property DataLink: TSVGDataLink read FDataLink write SetDataLink; + property DOMElement: TDOMElement read GetDOMElement; + property Units: TCSSUnitConverter read FUnits; + property ID: string read GetID write SetID; + property classAttr: string read GetClassAttr write SetClassAttr; + property transform: string read GetTransform write SetTransform; + property matrix[AUnit: TCSSUnit]: TAffineMatrix read GetMatrix write SetMatrix; + property isFillNone: boolean read GetIsFillNone; + property isStrokeNone: boolean read GetIsStrokeNone; + property stroke: string read GetStroke write SetStroke; + property strokeWidth: TFloatWithCSSUnit read GetStrokeWidth write SetStrokeWidth; + property strokeColor: TBGRAPixel read GetStrokeColor write SetStrokeColor; + property strokeOpacity: single read GetStrokeOpacity write SetStrokeOpacity; + property strokeMiterLimit: single read GetStrokeMiterLimit write SetStrokeMiterLimit; + property strokeLineJoin: string read GetStrokeLineJoin write SetStrokeLineJoin; + property strokeLineJoinLCL: TPenJoinStyle read GetStrokeLineJoinLCL write SetStrokeLineJoinLCL; + property strokeLineCap: string read GetStrokeLineCap write SetStrokeLineCap; + property strokeLineCapLCL: TPenEndCap read GetStrokeLineCapLCL write SetStrokeLineCapLCL; + property strokeDashArray: string read GetStrokeDashArray write SetStrokeDashArray; + property strokeDashArrayF: ArrayOfFloat read GetStrokeDashArrayF write SetStrokeDashArrayF; + property strokeDashOffset: TFloatWithCSSUnit read GetStrokeDashOffset write SetStrokeDashOffset; + property fill: string read GetFill write SetFill; + property fillColor: TBGRAPixel read GetFillColor write SetFillColor; + property fillOpacity: single read GetFillOpacity write SetFillOpacity; + property fillRule: string read GetFillRule write SetFillRule; + property paintOrder: TSVGPaintOrder read GetPaintOrder write SetPaintOrder; + property mixBlendMode: TBlendOperation read GetMixBlendMode write SetMixBlendMode; + property opacity: single read GetOpacity write SetOpacity; + property clipPath: string read GetClipPath write SetClipPath; + property Visible: boolean read GetVisible write SetVisible; + + property Attribute[AName: string]: string read GetAttribute write SetAttribute; + property AttributeDef[AName,ADefault: string]: string read GetAttribute; + property AttributeOrStyleDef[AName,ADefault: string]: string read GetAttributeOrStyle; + property AttributeOrStyle[AName: string]: string read GetAttributeOrStyle; + property AttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetAttributeWithUnit; + property AttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetAttributeWithUnit write SetAttributeWithUnit; + property ArrayOfAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfAttributeWithUnit; + property ArrayOfAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfAttributeWithUnit write SetArrayOfAttributeWithUnit; + + property ArrayOfAttributeNumberInherit[AName: string; ACanInherit: boolean]: ArrayOfTSVGNumber read GetArrayOfAttributeNumber; + property ArrayOfAttributeNumber[AName: string]: ArrayOfTSVGNumber read GetArrayOfAttributeNumber write SetArrayOfAttributeNumber; + + property HorizAttributeDef[AName: string; ADefault: TSVGNumber]: TSVGNumber read GetHorizAttribute; + property HorizAttribute[AName: string]: TSVGNumber read GetHorizAttribute write SetHorizAttribute; + property HorizAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeWithUnit; + property HorizAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetHorizAttributeWithUnit write SetHorizAttributeWithUnit; + property HorizAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeOrStyleWithUnit; + property ArrayOfHorizAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeWithUnit; + property ArrayOfHorizAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeWithUnit write SetArrayOfHorizAttributeWithUnit; + property ArrayOfHorizAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeOrStyleWithUnit; + + property VerticalAttributeDef[AName: string; ADefault: TSVGNumber]: TSVGNumber read GetVerticalAttribute; + property VerticalAttribute[AName: string]: TSVGNumber read GetVerticalAttribute write SetVerticalAttribute; + property VerticalAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit; + property VerticalAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit write SetVerticalAttributeWithUnit; + property VerticalAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeOrStyleWithUnit; + property ArrayOfVerticalAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeWithUnit; + property ArrayOfVerticalAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeWithUnit write SetArrayOfVerticalAttributeWithUnit; + property ArrayOfVerticalAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeOrStyleWithUnit; + + property OrthoAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit; + property OrthoAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit write SetOrthoAttributeWithUnit; + property OrthoAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeOrStyleWithUnit; + property ArrayOfOrthoAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfOrthoAttributeWithUnit write SetArrayOfOrthoAttributeWithUnit; + property ArrayOfOrthoAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfOrthoAttributeOrStyleWithUnit; + end; + + { TSVGParser } + + TSVGParser = class + private + function GetDone: boolean; + protected + FPos: integer; + FNumberError: boolean; + FText: string; + public + constructor Create(AText: string); + function ParseFloat: single; + function ParseId: string; + function ParseSymbol: char; + function ParseTransform: TAffineMatrix; + procedure SkipSymbol(ASymbol: char); + procedure SkipUpToSymbol(ASymbol:char); + procedure ClearError; + property Position: integer read FPos write FPos; + property NumberError: boolean read FNumberError; + property Text: string read FText; + property Done: boolean read GetDone; + end; + + resourcestring + rsInvalidIndex = 'Invalid index'; + +implementation + +uses BGRASVGShapes; + +{ TSVGCustomElement } + +function TSVGCustomElement.GetNamespaceCount: integer; +var + i: Integer; + name: string; +begin + result := 0; + for i := 0 to FDomElem.Attributes.Length-1 do + begin + name := FDomElem.Attributes.Item[i].NodeName; + if name.StartsWith('xmlns:') then inc(result); + end; +end; + +function TSVGCustomElement.GetNamespacePrefix(AIndex: integer): string; +var + i: Integer; + name: string; +begin + if AIndex < 0 then exit(''); + result := ''; + for i := 0 to FDomElem.Attributes.Length-1 do + begin + name := FDomElem.Attributes.Item[i].NodeName; + if name.StartsWith('xmlns:') then + begin + if AIndex > 0 then dec(AIndex) + else exit(name.Substring(6)); + end; + end; +end; + +function TSVGCustomElement.GetNamespaceURI(APrefix: string): string; +begin + result := GetAttribute('xmlns:' + APrefix); +end; + +procedure TSVGCustomElement.SetNamespaceURI(APrefix: string; AValue: string); +begin + if AValue = '' then FDomElem.RemoveAttribute('xmlns:' + APrefix) + else SetAttribute('xmlns:' + APrefix, AValue); +end; + +function TSVGCustomElement.GetDOMElement: TDOMElement; +begin + result := FDomElem; +end; + +function TSVGCustomElement.GetAttributeOrStyle(AName, ADefault: string; + ACanInherit: boolean): string; +var + curNode: TDOMElement; + styleDecl: DOMString; +begin + result := GetInlineStyle(AName,''); + if result = '' then + begin + result := GetStyleFromStyleSheet(AName,''); + if result = '' then + begin + result := GetAttributeFromElement(FDomElem, AName, false); + if (result = 'currentColor') and (AName <> 'color') then + begin + AName := 'color'; + result := GetAttributeFromElement(FDomElem, AName, false); + end; + + if result = '' then + begin + if ACanInherit then + begin + curNode := FDomElem; + while true do + begin + if curNode.ParentNode is TDOMElement then + curNode := TDOMElement(curNode.ParentNode) + else break; + + styleDecl := curNode.GetAttribute('style'); + result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ''); + if result <> '' then exit; + result := GetAttributeFromElement(curNode, AName, false); + if (result = 'currentColor') and (AName <> 'color') then + begin + curNode := FDomElem; + AName := 'color'; + continue; + end; + if result <> '' then exit; + end; + end; + result := ADefault; + end; + end; + end; +end; + +function TSVGCustomElement.GetAttributeOrStyle(AName, ADefault: string): string; +begin + result := GetAttributeOrStyle(AName, ADefault, true); +end; + +function TSVGCustomElement.GetAttributeOrStyle(AName: string): string; +begin + result:= GetAttributeOrStyle(AName,''); +end; + +function TSVGCustomElement.GetHorizAttributeOrStyleWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeOrStyleWithUnit(AName,ADefault); +end; + +function TSVGCustomElement.GetArrayOfHorizAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeOrStyleWithUnit(AName); +end; + +function TSVGCustomElement.GetOrthoAttributeOrStyleWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeOrStyleWithUnit(AName,ADefault); +end; + +function TSVGCustomElement.GetArrayOfOrthoAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeOrStyleWithUnit(AName); +end; + +class procedure TSVGCustomElement.LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos, + AColonPos, AValueLength: integer); +var i: integer; + curStart,curColon,curValueLength: integer; + + function CheckShouldReturnResult: boolean; + begin + if Trim(Copy(AText,curStart,curColon-curStart)) = AProperty then + begin + AStartPos:= curStart; + AColonPos:= curColon; + AValueLength:= curValueLength; + result := true + end + else + result := false + end; + +begin + AProperty := Trim(AProperty); + AStartPos := -1; + AColonPos := -1; + AValueLength:= -1; + curStart := -1; + curColon := -1; + curValueLength := -1; + for i := 1 to length(AText) do + begin + if curStart = -1 then + begin + if AText[i] in['-','_','a'..'z','A'..'Z','\'] then + begin + curStart := i; + curColon := -1; + end; + end else + if curColon = -1 then + begin + if AText[i] = ':' then + begin + curColon := i; + curValueLength:= -1; + end; + end else + if AText[i] = ';' then + begin + curValueLength := i-(curColon+1); + if CheckShouldReturnResult then exit; + curStart := -1; + curColon := -1; + curValueLength:= -1; + end; + end; + if curColon <> -1 then + begin + curValueLength:= length(AText)-(curColon+1)+1; + if CheckShouldReturnResult then exit; + end; +end; + +class procedure TSVGCustomElement.UpdateStyleDeclarationBlock(var ABlock: string; + AProperty: string; AValue: string); +var + startPos, colonPos, valueLength: integer; +begin + if pos(';',AValue)<>0 then + raise exception.Create('Invalid character in value'); + if pos(':',AProperty)<>0 then + raise exception.Create('Invalid character in name'); + LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); + if valueLength <> -1 then + begin + delete(ABlock, colonPos+1, valueLength); + insert(' '+Trim(AValue), ABlock, colonPos+1); + end else + begin + while (length(ABlock) > 0) and (ABlock[length(ABlock)] in[' ',#9,#10,#12,#13]) do + delete(ABlock, length(ABlock), 1); + if length(ABlock)>0 then + begin + if ABlock[length(ABlock)] <> ';' then AppendStr(ABlock, '; '); + end; + AppendStr(ABlock, AProperty+': '+AValue); + end; +end; + +class function TSVGCustomElement.RemovePropertyFromDeclarationBlock( + var ABlock: string; AProperty: string): boolean; +var + startPos, colonPos, valueLength: integer; +begin + LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); + if valueLength <> -1 then + begin + delete(ABlock, startPos, colonPos+valueLength-startPos); + while (length(ABlock)>=startPos) and (ABlock[startPos] in[' ',#9,#10,#12,#13]) do delete(ABlock,startPos,1); + if (length(ABlock)>=startPos) and (ABlock[startPos] = ';') then delete(ABlock,startPos,1); + result := true; + end else + result := false; +end; + +class function TSVGCustomElement.GetPropertyFromStyleDeclarationBlock(ABlock: string; + AProperty: string; ADefault: string): string; +var + startPos, colonPos, valueLength: integer; +begin + LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); + if valueLength <> -1 then + result := trim(copy(ABlock, colonPos+1, valueLength)) + else + result := ADefault; +end; + +function TSVGCustomElement.GetInlineStyle(const AName, ADefault: string + ): string; +var + styleDecl: String; +begin + styleDecl := GetAttribute('style','',False); + result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ADefault); +end; + +function TSVGCustomElement.GetInlineStyleWithUnit(const AName: string): TFloatWithCSSUnit; +begin + result := GetInlineStyleWithUnit(AName, FloatWithCSSUnit(0, cuCustom)); +end; + +function TSVGCustomElement.GetInlineStyleWithUnit(const AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := TCSSUnitConverter.parseValue(GetInlineStyle(AName, ''), ADefault); +end; + +function TSVGCustomElement.GetStyleFromStyleSheet(const AName, ADefault: string): string; +begin + result := ADefault; +end; + +function TSVGCustomElement.GetStyle(const AName, ADefault: string): string; +var + curNode: TDOMElement; + styleDecl: DOMString; +begin + result:= GetInlineStyle(AName,''); + if result <> '' then exit; + + result := GetStyleFromStyleSheet(AName,''); + if result <> '' then exit; + + curNode := FDomElem; + while true do + begin + if curNode.ParentNode is TDOMElement then + curNode := TDOMElement(curNode.ParentNode) + else break; + + styleDecl := curNode.GetAttribute('style'); + result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ''); + if result <> '' then exit; + end; + + result := ADefault; +end; + +function TSVGCustomElement.GetStyle(const AName: string): string; +begin + result:= GetStyle(AName,''); +end; + +function TSVGCustomElement.GetAttributeFromElement(ANode: TDOMElement; + AName: string; ACanInherit: boolean): string; +begin + repeat + if ((AName = 'xlink:href') or (AName = 'xlink:title')) and + not ANode.hasAttribute(AName) and ANode.hasAttribute(AName.Substring(6)) then + result := Trim(ANode.GetAttribute(AName.Substring(6))) + else result := Trim(ANode.GetAttribute(AName)); + + if result = 'inherit' then result := ''; + if (result = '') and ACanInherit and + (ANode.ParentNode is TDOMElement) then + ANode := ANode.ParentNode as TDOMElement + else + ANode := nil; + until ANode = nil; +end; + +function TSVGCustomElement.GetAttribute(AName: string; ADefault: string; + ACanInherit: boolean): string; +begin + result := GetAttributeFromElement(FDomElem, AName, ACanInherit); + if result = '' then result := ADefault else + if (result = 'currentColor') and (AName <> 'color') then + result := GetAttribute('color', ADefault, ACanInherit); +end; + +function TSVGCustomElement.GetAttribute(AName: string; ADefault: string): string; +begin + result := GetAttribute(AName, ADefault, False); +end; + +function TSVGCustomElement.GetAttribute(AName: string): string; +begin + result:= GetAttribute(AName,''); +end; + +function TSVGCustomElement.GetAttributeNumber(AName: string; ADefault: TSVGNumber): TSVGNumber; +begin + result := TCSSUnitConverter.parseValue(GetAttribute(AName),ADefault); +end; + +function TSVGCustomElement.GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := TCSSUnitConverter.parseValue(GetAttribute(AName),ADefault); +end; + +function TSVGCustomElement.GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; +begin + result := GetAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); +end; + +function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string; + ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; +var + valueText: string; +begin + valueText := GetAttributeOrStyle(AName, '', ACanInherit); + result := TCSSUnitConverter.parseValue(valueText,ADefault); +end; + +function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeOrStyleWithUnit(AName, ADefault, True); +end; + +function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; +begin + result := GetAttributeOrStyleWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); +end; + +function TSVGCustomElement.GetVerticalAttributeOrStyleWithUnit(AName: string; + ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; +begin + result := GetAttributeOrStyleWithUnit(AName,ADefault,ACanInherit); +end; + +function TSVGCustomElement.GetVerticalAttributeOrStyleWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetVerticalAttributeOrStyleWithUnit(AName,ADefault,true); +end; + +function TSVGCustomElement.GetArrayOfVerticalAttributeOrStyleWithUnit( + AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeOrStyleWithUnit(AName); +end; + +procedure TSVGCustomElement.SetInlineStyle(AName: string; AValue: string); +var + declarationBlock: string; +begin + declarationBlock := GetAttribute('style','',false); + UpdateStyleDeclarationBlock(declarationBlock, AName, AValue); + SetAttribute('style', declarationBlock); +end; + +procedure TSVGCustomElement.SetInlineStyle(AName: string; + AValue: TFloatWithCSSUnit); +begin + SetInlineStyle(AName, FUnits.formatValue(AValue)); +end; + +function TSVGCustomElement.GetOrthoAttributeWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeWithUnit(AName,ADefault); +end; + +function TSVGCustomElement.GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; +begin + result := GetOrthoAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); +end; + +function TSVGCustomElement.GetHorizAttribute(AName: string; + ADefault: TSVGNumber): TSVGNumber; +var value: TFloatWithCSSUnit; +begin + value.value := GetAttributeNumber(AName,ADefault); + value.CSSUnit := cuPixel; + result := value.value; +end; + +function TSVGCustomElement.GetHorizAttribute(AName: string): TSVGNumber; +begin + result := GetHorizAttribute(AName,0); +end; + +function TSVGCustomElement.GetHorizAttributeWithUnit(AName: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeWithUnit(AName,ADefault); +end; + +function TSVGCustomElement.GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; +begin + result := GetHorizAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); +end; + +function TSVGCustomElement.GetArrayOfAttributeNumber(AName: string): ArrayOfTSVGNumber; +begin + result := GetArrayOfAttributeNumber(AName,true); +end; + +function TSVGCustomElement.GetArrayOfAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; +begin + result := TCSSUnitConverter.parseArrayOfValuesWithUnit(GetAttribute(AName,'',ACanInherit)); +end; + +function TSVGCustomElement.GetArrayOfAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeWithUnit(AName,true); +end; + +function TSVGCustomElement.GetArrayOfAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +var + valueText: string; +begin + valueText := GetAttributeOrStyle(AName); + result := TCSSUnitConverter.parseArrayOfValuesWithUnit(valueText); +end; + +function TSVGCustomElement.GetArrayOfOrthoAttributeWithUnit(AName: string; + ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeWithUnit(AName, ACanInherit); +end; + +function TSVGCustomElement.GetArrayOfOrthoAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfOrthoAttributeWithUnit(AName, true); +end; + +function TSVGCustomElement.GetArrayOfHorizAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeWithUnit(AName,ACanInherit); +end; + +function TSVGCustomElement.GetArrayOfHorizAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfHorizAttributeWithUnit(AName,true); +end; + +function TSVGCustomElement.GetArrayOfVerticalAttributeWithUnit(AName: string; + ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfAttributeWithUnit(AName,ACanInherit); +end; + +function TSVGCustomElement.GetArrayOfAttributeNumber(AName: string; + ACanInherit: boolean): ArrayOfTSVGNumber; +begin + result := TCSSUnitConverter.parseArrayOfNumbers(GetAttribute(AName,'',ACanInherit)); +end; + +function TSVGCustomElement.GetVerticalAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; +begin + result := GetAttributeNumber(AName,ADefault); +end; + +function TSVGCustomElement.GetVerticalAttribute(AName: string): TSVGNumber; +begin + result := GetVerticalAttribute(AName,0); +end; + +function TSVGCustomElement.GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +begin + result := GetAttributeWithUnit(AName,ADefault); +end; + +function TSVGCustomElement.GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; +begin + result := GetVerticalAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); +end; + +function TSVGCustomElement.GetArrayOfVerticalAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; +begin + result := GetArrayOfVerticalAttributeWithUnit(AName, True); +end; + +procedure TSVGCustomElement.SetAttribute(AName: string; AValue: TSVGNumber); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetAttribute(AName: string; AValue: string); +begin + if ((AName = 'xlink:href') or (AName = 'xlink:title')) and + not FDomElem.hasAttribute(AName) and FDomElem.hasAttribute(AName.Substring(6)) then + FDomElem.SetAttribute(AName.Substring(6), AValue) + else + FDomElem.SetAttribute(AName,AValue); +end; + +procedure TSVGCustomElement.SetAttributeWithUnit(AName: string; + AValue: TFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetHorizAttribute(AName: string; + AValue: TSVGNumber); +begin + SetAttribute(AName, AValue); +end; + +procedure TSVGCustomElement.SetHorizAttributeWithUnit(AName: string; + AValue: TFloatWithCSSUnit); +begin + SetAttributeWithUnit(AName, AValue); +end; + +procedure TSVGCustomElement.SetArrayOfHorizAttributeWithUnit(AName: string; + AValue: ArrayOfTFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetVerticalAttribute(AName: string; + AValue: TSVGNumber); +begin + SetAttribute(AName, AValue) +end; + +procedure TSVGCustomElement.SetArrayOfAttributeNumber(AName: string; + AValue: ArrayOfTSVGNumber); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetArrayOfAttributeWithUnit(AName: string; + const AValue: ArrayOfTFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetVerticalAttributeWithUnit(AName: string; + AValue: TFloatWithCSSUnit); +begin + SetAttributeWithUnit(AName, AValue); +end; + +procedure TSVGCustomElement.SetArrayOfVerticalAttributeWithUnit(AName: string; + AValue: ArrayOfTFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetOrthoAttributeWithUnit(AName: string; + AValue: TFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.SetArrayOfOrthoAttributeWithUnit(AName: string; + AValue: ArrayOfTFloatWithCSSUnit); +begin + SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); +end; + +procedure TSVGCustomElement.RemoveStyle(const AName: string); +var + declarationBlock: string; +begin + declarationBlock := GetAttribute('style','',false); + if RemovePropertyFromDeclarationBlock(declarationBlock, AName) then + SetAttribute('style', declarationBlock); +end; + +function TSVGCustomElement.HasAttribute(AName: string): boolean; +begin + result := FDomElem.hasAttribute(AName); +end; + +function TSVGCustomElement.HasInlineStyle(AName: string): boolean; +begin + result := trim(GetInlineStyle(AName, '')) <> ''; //an empty declaration is illegal +end; + +procedure TSVGCustomElement.ConvertToUnit(AUnit: TCSSUnit); +begin + if HasInlineStyle('stroke-width') then + SetInlineStyle('stroke-width', FUnits.ConvertWidth(GetInlineStyleWithUnit('stroke-width'), AUnit)); + if HasInlineStyle('stroke-dash-offset') then + SetInlineStyle('stroke-dash-offset', FUnits.ConvertWidth(GetInlineStyleWithUnit('stroke-dash-offset'), AUnit)); + if HasInlineStyle('font-size') then + SetInlineStyle('font-size', FUnits.ConvertHeight(GetInlineStyleWithUnit('font-size'), AUnit)); +end; + +function TSVGCustomElement.EnterFontSize(AIsRoot: boolean): TFloatWithCSSUnit; +var + fs: TFloatWithCSSUnit; +begin + result := FUnits.CurrentFontEmHeight; + if AIsRoot then FUnits.CurrentFontEmHeight := FUnits.RootFontEmHeight; + fs := GetAttributeOrStyleWithUnit('font-size', FUnits.CurrentFontEmHeight, false); + if fs.CSSUnit in [cuFontEmHeight,cuFontXHeight] then + fs := FUnits.ConvertHeight(fs, cuCustom); + FUnits.CurrentFontEmHeight:= fs; +end; + +procedure TSVGCustomElement.ExitFontSize(APrevFontSize: TFloatWithCSSUnit); +begin + FUnits.CurrentFontEmHeight := APrevFontSize; +end; + +procedure TSVGCustomElement.RemoveNamespace(APrefix: string); +begin + NamespaceURI['APrefix'] := ''; +end; + +function TSVGCustomElement.NeedNamespace(APrefix: string): boolean; +var + prefixColon: DOMString; + + function NeedNamespaceRec(ANode: TDOMElement): boolean; + var + i: Integer; + begin + for i := 0 to ANode.Attributes.Length-1 do + if copy(ANode.Attributes[i].NodeName, 1, length(prefixColon)) = prefixColon then + exit(true); + + for i := 0 to ANode.ChildNodes.Length-1 do + if (ANode.ChildNodes[i] is TDOMElement) and + NeedNamespaceRec(ANode.ChildNodes[i] as TDOMElement) then + exit(true); + + result := false; + end; + +begin + prefixColon := APrefix+':'; + result := NeedNamespaceRec(FDomElem); +end; + +function TSVGCustomElement.MatrixToTransform(m: TAffineMatrix; + AFromUnit: TCSSUnit): string; +var s: string; + translateStr: string; +begin + translateStr := 'translate('+FUnits.formatValue(FUnits.ConvertWidth(m[1,3],AFromUnit,cuCustom))+' '+ + FUnits.formatValue(FUnits.ConvertHeight(m[2,3],AFromUnit,cuCustom))+')'; + if IsAffineMatrixTranslation(m) then + begin + if IsAffineMatrixIdentity(m) then + result := '' + else result := translateStr; + end else + begin + if (m[1,3] <> 0) or (m[2,3] <> 0) then + begin + s := translateStr; + m[1,3] := 0; + m[2,3] := 0; + end else + s := ''; + if IsAffineMatrixScale(m) then + result := trim(s+' scale('+FUnits.formatValue(m[1,1])+' '+FUnits.formatValue(m[2,2])+')') + else + result := trim(s+' matrix('+FUnits.formatValue(m[1,1])+' '+FUnits.formatValue(m[2,1])+' '+ + FUnits.formatValue(m[1,2])+' '+FUnits.formatValue(m[2,2])+' ' + + FUnits.formatValue(m[1,3])+' '+FUnits.formatValue(m[2,3])+')'); + end; +end; + +function TSVGCustomElement.TransformToMatrix(ATransform: string; + AToUnit: TCSSUnit): TAffineMatrix; +var parser: TSVGParser; +begin + if Trim(ATransform) = '' then + begin + result := AffineMatrixIdentity; + exit; + end; + parser := TSVGParser.Create(ATransform); + result := parser.ParseTransform; + result[1,3] := FUnits.ConvertWidth(result[1,3], cuCustom, AToUnit); + result[2,3] := FUnits.ConvertHeight(result[2,3], cuCustom, AToUnit); + parser.Free; +end; + +{ TSVGViewBox } + +function TSVGViewBox.ToString: string; +begin + result := + TCSSUnitConverter.formatValue(min.x)+' '+ + TCSSUnitConverter.formatValue(min.y)+' '+ + TCSSUnitConverter.formatValue(size.x)+' '+ + TCSSUnitConverter.formatValue(size.y); +end; + +class function TSVGViewBox.Parse(AValue: string): TSVGViewBox; + + function parseNextFloat: single; + var + idxSpace,{%H-}errPos: integer; + begin + idxSpace:= pos(' ',AValue); + if idxSpace <> 0 then + val(copy(AValue,1,idxSpace-1),result,errPos) + else + result := 0; + delete(AValue,1,idxSpace); + while (AValue <> '') and (AValue[1] = ' ') do delete(AValue,1,1); + end; + +begin + AValue := trim(AValue)+' '; + with result do + begin + min.x := parseNextFloat; + min.y := parseNextFloat; + size.x := parseNextFloat; + size.y := parseNextFloat; + end; +end; + +class function TSVGViewBox.DefaultValue: TSVGViewBox; +begin + with result do + begin + min.x := 0; + min.y := 0; + size.x := 0; + size.y := 0; + end; +end; + +{ TSVGPreserveAspectRatio } + +function TSVGPreserveAspectRatio.ToString: string; +begin + if not Preserve then result := 'none' else + begin + result := ''; + case HorizAlign of + taCenter: AppendStr(result, 'xMid'); + taRightJustify: AppendStr(result, 'xMax'); + else AppendStr(result, 'xMin'); + end; + case VertAlign of + tlCenter: AppendStr(result, 'YMid'); + tlBottom: AppendStr(result, 'YMax'); + else AppendStr(result, 'YMin'); + end; + if Slice then AppendStr(result, ' slice') + else AppendStr(result, ' meet'); + end; +end; + +class function TSVGPreserveAspectRatio.Parse(AValue: string + ): TSVGPreserveAspectRatio; +var p: TSVGParser; + id: string; +begin + p := TSVGParser.Create(AValue); + result := DefaultValue; + repeat + id := p.ParseId; + if id = 'none' then + begin + result.Preserve := false; + //set other parameters for intermediate value of ViewSize (before stretching non-proportionaly) + result.Slice := false; + result.HorizAlign := taCenter; + result.VertAlign := tlCenter; + exit; + end else + if id = 'slice' then result.Slice := true + else if (length(id)=8) and (id[1] = 'x') and (id[5] = 'Y') then + begin + case copy(id,2,3) of + 'Min': result.HorizAlign := taLeftJustify; + 'Mid': result.HorizAlign := taCenter; + 'Max': result.HorizAlign := taRightJustify; + end; + case copy(id,6,3) of + 'Min': result.VertAlign := tlTop; + 'Mid': result.VertAlign := tlCenter; + 'Max': result.VertAlign := tlBottom; + end; + end; + until id = ''; + p.Free; +end; + +class function TSVGPreserveAspectRatio.DefaultValue: TSVGPreserveAspectRatio; +begin + result.Preserve := true; + result.Slice := false; + result.HorizAlign := taCenter; + result.VertAlign := tlCenter; +end; + +{ TSVGParser } + +function TSVGParser.GetDone: boolean; +begin + result := FPos>length(FText) +end; + +constructor TSVGParser.Create(AText: string); +begin + FNumberError:= false; + FPos := 1; + FText := AText; +end; + +function TSVGParser.ParseFloat: single; +var numberStart: integer; + errPos: integer; +begin + while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); + numberStart:= FPos; + if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos); + while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos); + if (FPos <= length(FText)) and (FText[FPos] in['e','E']) then inc(FPos); + if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos); + while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos); + if FPos = numberStart then + begin + FNumberError := true; + result := 0; + end + else + begin + val(copy(FText,numberStart,FPos-numberStart),result,errPos); + if errPos <> 0 then FNumberError := true; + end; +end; + +function TSVGParser.ParseId: string; +var idStart: integer; +begin + while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); + idStart:= FPos; + if (FPos <= length(FText)) and (FText[FPos] in['A'..'Z','a'..'z']) then inc(FPos); + while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','A'..'Z','a'..'z','_']) do inc(FPos); + result := copy(FText,idStart,FPos-idStart); +end; + +function TSVGParser.ParseSymbol: char; +begin + while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); + if (FPos <= length(FText)) and not (FText[FPos] in['A'..'Z','a'..'z','0'..'9']) then + begin + result := FText[FPos]; + inc(FPos); + end else + result := #0; +end; + +function TSVGParser.ParseTransform: TAffineMatrix; +var + kind: String; + m : TAffineMatrix; + angle,tx,ty: single; +begin + result := AffineMatrixIdentity; + while not Done do + begin + kind := ParseId; + if kind = '' then break; + if ParseSymbol <> '(' then break; + if compareText(kind,'matrix')=0 then + begin + m[1,1] := ParseFloat; + SkipSymbol(','); + m[2,1] := ParseFloat; + SkipSymbol(','); + m[1,2] := ParseFloat; + SkipSymbol(','); + m[2,2] := ParseFloat; + SkipSymbol(','); + m[1,3] := ParseFloat; + SkipSymbol(','); + m[2,3] := ParseFloat; + result := result * m; + end else + if compareText(kind,'translate')=0 then + begin + tx := ParseFloat; + SkipSymbol(','); + ty := ParseFloat; + result := result * AffineMatrixTranslation(tx,ty); + end else + if compareText(kind,'scale')=0 then + begin + tx := ParseFloat; + SkipSymbol(','); + ClearError; + ty := ParseFloat; + if NumberError then ty := tx; + result := result * AffineMatrixScale(tx,ty); + end else + if compareText(kind,'rotate')=0 then + begin + angle := ParseFloat; + SkipSymbol(','); + tx := ParseFloat; + SkipSymbol(','); + ty := ParseFloat; + result := result * AffineMatrixTranslation(tx,ty)* + AffineMatrixRotationDeg(angle)* + AffineMatrixTranslation(-tx,-ty); + end else + if compareText(kind,'skewx')=0 then + begin + angle := ParseFloat; + result := result * AffineMatrixSkewXDeg(angle); + end else + if compareText(kind,'skewy')=0 then + begin + angle := ParseFloat; + result := result * AffineMatrixSkewYDeg(angle); + end; + SkipUpToSymbol(')'); + end; +end; + +procedure TSVGParser.SkipSymbol(ASymbol: char); +begin + while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); + if (FPos <= length(FText)) and (FText[FPos] = ASymbol) then inc(FPos); +end; + +procedure TSVGParser.SkipUpToSymbol(ASymbol: char); +begin + while (FPos <= length(FText)) and (FText[FPos]<>ASymbol) do inc(FPos); + if (FPos <= length(FText)) and (FText[FPos]=ASymbol) then inc(FPos); +end; + +procedure TSVGParser.ClearError; +begin + FNumberError:= false; +end; + +{ TSVGDataLink } + +constructor TSVGDataLink.Create(AParent: TSVGDataLink); +begin + FElements:= TSVGElementDictionary.Create; + FElements.Sorted := true; + FStyles:= TSVGElementList.Create; + FParent := AParent; + if Assigned(FParent) then FParent.FChildren.Add(self); + FLinkListeners := TSVGLinkListeners.Create; + FChildren := TList.Create; +end; + +destructor TSVGDataLink.Destroy; +var + i: Integer; +begin + for i := FChildren.Count-1 downto 0 do + TSVGDatalink(FChildren[i]).Parent := nil; + Parent := nil; + FreeAndNil(FChildren); + FreeAndNil(FLinkListeners); + FreeAndNil(FElements); + FreeAndNil(FStyles); + inherited Destroy; +end; + +function TSVGDataLink.GetElement(AIndex: integer): TSVGElement; +begin + if (AIndex < 0) or (AIndex > FElements.Count) then + raise exception.Create(rsInvalidIndex); + result:= FElements.Data[AIndex]; +end; + +function TSVGDataLink.GetStyle(AIndex: integer): TSVGElement; +begin + if not IsValidIndex(AIndex,FStyles) then + raise exception.Create(rsInvalidIndex); + result:= FStyles[AIndex]; +end; + +function TSVGDataLink.IsValidIndex(const AIndex: integer; list: TSVGElementList): boolean; +begin + result:= (AIndex >= 0) and (AIndex < list.Count); +end; + +function TSVGDataLink.FindTo(el: TSVGElement; list: TSVGElementList): integer; +begin + result := list.IndexOf(el); +end; + +procedure TSVGDataLink.NotifyLink(AElement: TSVGElement; ALink: boolean); +var + i: Integer; + temp: array of TSVGLinkEvent; +begin + // make copy because listeners might change the list + SetLength(temp, FLinkListeners.Count); + for i:= 0 to high(temp) do + temp[i] := FLinkListeners.Items[i]; + for i := 0 to high(temp) do + temp[i](self, AElement, ALink); + // children datalinks may use the element + for i := FChildren.Count-1 downto 0 do + TSVGDataLink(FChildren[i]).NotifyLink(AElement, ALink); +end; + +procedure TSVGDataLink.SetParent(AValue: TSVGDataLink); + // notify link change for all elements and parent elements + procedure NotifyLinkRec(ADatalink: TSVGDataLink; ALink: boolean); + var + i: Integer; + begin + if ADatalink = nil then exit; + for i := 0 to ADatalink.ElementCount-1 do + NotifyLink(ADatalink.Elements[i], ALink); + NotifyLinkRec(ADatalink.Parent, ALink); + end; +begin + if FParent=AValue then Exit; + NotifyLinkRec(FParent, False); + if Assigned(FParent) then FParent.FChildren.Remove(self); + FParent:=AValue; + if Assigned(FParent) then FParent.FChildren.Add(self); + NotifyLinkRec(FParent, True); +end; + +function TSVGDataLink.FindElement(el: TSVGElement): integer; +begin + result:= FElements.IndexOfData(el); +end; + +function TSVGDataLink.FindStyle(el: TSVGElement): integer; +begin + result:= FindTo(el,FStyles); +end; + +function TSVGDataLink.ElementCount: integer; +begin + result:= FElements.Count; +end; + +function TSVGDataLink.StyleCount: integer; +begin + result:= FStyles.Count; +end; + +function TSVGDataLink.IsLinkElement(el: TSVGElement): boolean; +begin + result:= FindElement(el) <> -1; +end; + +function TSVGDataLink.IsLinkStyle(el: TSVGElement): boolean; +begin + result:= FindStyle(el) <> -1; +end; + +function TSVGDataLink.IsLink(el: TSVGElement): boolean; +begin + result:= IsLinkStyle(el) or IsLinkElement(el); +end; + +function TSVGDataLink.Link(el: TSVGElement): integer; +begin + if el.ID <> '' then + begin + if FElements.IndexOf(el.ID)<>-1 then exit(-1); + result := FElements.Add(el.ID, el); + end else + result := -1; + + if el is TSVGStyle then + FStyles.Add(el); + + NotifyLink(el, true); +end; + +procedure TSVGDataLink.Unlink(el: TSVGElement); +var + index: integer; +begin + index:= FindElement(el); + if index = -1 then exit; + + if el is TSVGStyle then + FStyles.Remove(el); + + FElements.Delete(index); + NotifyLink(el, false); +end; + +procedure TSVGDataLink.UnlinkAll; +begin + FStyles.Clear; + FElements.Clear; +end; + +procedure TSVGDataLink.RegisterLinkListener(AHandler: TSVGLinkEvent; + ARegister: boolean); +begin + if ARegister then + FLinkListeners.Add(AHandler) + else FLinkListeners.Remove(AHandler); +end; + +function TSVGDataLink.FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; +var + index: Integer; +begin + index := FElements.IndexOf(AId); + if index = -1 then + begin + if Assigned(Parent) then + result := Parent.FindElementById(AID, AClass) + else result := nil + end + else + begin + result := FElements.Data[index]; + if not (result is AClass) then result := nil; + end; +end; + +function StringStartsWith(AText, AStart: string): boolean; +begin + Result:= (AStart<>'') and (StrLComp(PChar(AStart),PChar(AText),length(AStart))=0); +end; + +function TSVGDataLink.FindElementByRef(ARef: string; AClass: TSVGFactory): TSVGElement; +var + notFound: boolean; +begin + result := FindElementByRef(ARef, false, AClass, notFound); +end; + +function TSVGDataLink.FindElementByRef(ARef: string; ANeedUrl: boolean; AClass: TSVGFactory; + out ANotFound: boolean): TSVGElement; +begin + if StringStartsWith(ARef,'url(#') then + begin + result := FindElementById(System.Copy(ARef,6,Length(ARef)-6), AClass); + ANotFound := (result = nil); + end + else if not ANeedUrl and StringStartsWith(ARef,'#') then + begin + result := FindElementById(System.Copy(ARef,2,Length(ARef)-1), AClass); + ANotFound := (result = nil); + end + else + begin + ANotFound := false; + exit(nil); + end; +end; + +{ TSVGElement } + +function TSVGElement.GetClipPath: string; +begin + result := AttributeOrStyle['clip-path']; +end; + +function TSVGElement.GetFill: string; +begin + result := AttributeOrStyleDef['fill','black']; +end; + +function TSVGElement.GetFillColor: TBGRAPixel; +begin + result := StrToBGRA(fill,BGRABlack); + result.alpha := round(result.alpha*fillOpacity*opacity); + if result.alpha = 0 then result := BGRAPixelTransparent; +end; + +function TSVGElement.GetFillOpacity: single; +var errPos: integer; +begin + val(AttributeOrStyleDef['fill-opacity','1'], result, errPos); + if errPos <> 0 then result := 1 else + if result < 0 then result := 0 else + if result > 1 then result := 1; +end; + +function TSVGElement.GetFillRule: string; +begin + result := AttributeOrStyleDef['fill-rule','nonzero']; +end; + +function TSVGElement.GetIsFillNone: boolean; +begin + result := compareText(trim(fill),'none')=0; +end; + +function TSVGElement.GetIsStrokeNone: boolean; +var strokeStr: string; +begin + strokeStr := stroke; + result := (trim(strokeStr)='') or (compareText(trim(strokeStr),'none')=0); +end; + +function TSVGElement.GetMatrix(AUnit: TCSSUnit): TAffineMatrix; +begin + result := TransformToMatrix(transform, AUnit); +end; + +function TSVGElement.GetMixBlendMode: TBlendOperation; +var + opstr: String; +begin + opstr := AttributeOrStyle['mix-blend-mode']; + if opstr = 'lighten' then + result := boLighten else + if opstr = 'screen' then + result := boScreen else + if opstr = 'color-dodge' then + result := boColorDodge else + if opstr = 'color-burn' then + result := boColorBurn else + if opstr = 'darken' then + result := boDarken else + if (opstr = 'plus') or (opstr = 'add') then + result := boLinearAdd else + if opstr = 'multiply' then + result := boMultiply else + if opstr = 'overlay' then + result := boOverlay else + if opstr = 'soft-light' then + result := boSvgSoftLight else + if opstr = 'hard-light' then + result := boHardLight else + if opstr = 'difference' then + result := boLinearDifference else + if opstr = 'difference' then + result := boLinearDifference else + if opstr = 'exclusion' then + result := boLinearExclusion else + if opstr = 'hue' then + result := boCorrectedHue else + if opstr = 'color' then + result := boCorrectedColor else + if opstr = 'luminosity' then + result := boCorrectedLightness else + if opstr = 'saturation' then + result := boCorrectedSaturation + else + result := boTransparent; +end; + +function TSVGElement.GetOpacity: single; +var errPos: integer; +begin + val(AttributeOrStyleDef['opacity','1'], result, errPos); + if errPos <> 0 then result := 1 else + if result < 0 then result := 0 else + if result > 1 then result := 1; +end; + +function TSVGElement.GetPaintOrder: TSVGPaintOrder; +var + parser: TSVGParser; + + function GetNext: integer; + var + id: String; + begin + id := parser.ParseId; + if id = 'fill' then exit(0) + else if id = 'stroke' then exit(1) + else if id = 'markers' then exit(2) + else if id = '' then exit(-1) + else result := GetNext; + end; + +var + s: string; +begin + s := AttributeOrStyle['paint-order', 'normal']; + if s = 'normal' then exit(spoFillStrokeMarkers); + parser := TSVGParser.Create(s); + case GetNext of + 0: case GetNext of + 2: result := spoFillMarkersStroke; + else result := spoFillStrokeMarkers; + end; + 1: case GetNext of + 2: result := spoStrokeMarkersFill; + else result := spoStrokeFillMarkers; + end; + 2: case GetNext of + 1: result := spoMarkersStrokeFill; + else result := spoMarkersFillStroke; + end; + else + result := spoFillStrokeMarkers; + end; + parser.Free; +end; + +function TSVGElement.GetStroke: string; +begin + result := AttributeOrStyleDef['stroke','none']; +end; + +function TSVGElement.GetStrokeColor: TBGRAPixel; +begin + result := StrToBGRA(stroke); + result.alpha := round(result.alpha*strokeOpacity*opacity); + if result.alpha = 0 then result := BGRAPixelTransparent; +end; + +function TSVGElement.GetStrokeLineCap: string; +begin + result := AttributeOrStyleDef['stroke-linecap','butt']; +end; + +function TSVGElement.GetStrokeLineCapLCL: TPenEndCap; +var + s: String; +begin + s := strokeLineCap; + if s = 'round' then result := pecRound + else if s = 'square' then result := pecSquare + else result := pecFlat; +end; + +function TSVGElement.GetStrokeLineJoin: string; +begin + result := AttributeOrStyleDef['stroke-linejoin','miter']; +end; + +function TSVGElement.GetStrokeLineJoinLCL: TPenJoinStyle; +var + s: String; +begin + s := strokeLineJoin; + if s = 'bevel' then result := pjsBevel + else if s = 'miter' then result := pjsMiter + else result := pjsRound; +end; + +function TSVGElement.GetStrokeMiterLimit: single; +var errPos: integer; +begin + val(AttributeOrStyleDef['stroke-miterlimit','4'], result, errPos); + if errPos <> 0 then result := 4 else + if result < 1 then result := 1; +end; + +function TSVGElement.GetStrokeOpacity: single; +var errPos: integer; +begin + val(AttributeOrStyleDef['stroke-opacity','1'], result, errPos); + if errPos <> 0 then result := 1 else + if result < 0 then result := 0 else + if result > 1 then result := 1; +end; + +function TSVGElement.GetStrokeWidth: TFloatWithCSSUnit; +begin + result := OrthoAttributeOrStyleWithUnit['stroke-width',FloatWithCSSUnit(1,cuCustom)]; +end; + +function TSVGElement.GetStrokeDashArray: string; +begin + result := AttributeOrStyleDef['stroke-dasharray','none']; +end; + +function TSVGElement.GetStrokeDashArrayF: ArrayOfFloat; +var + parser: TSVGParser; + nvalue,i: integer; + s_array: String; +begin + s_array:= strokeDashArray; + if s_array = 'none' then + begin + setlength(Result,0); + exit; + end; + parser:=TSVGParser.Create(s_array); + nvalue := 0; + repeat + parser.ParseFloat; + if not parser.NumberError then + inc(nvalue); + until parser.NumberError or parser.Done; + parser.ClearError; + setlength(Result,nvalue); + parser.Position := 1; + for i := 0 to high(result) do + result[i] := parser.ParseFloat; + parser.Free; +end; + +function TSVGElement.GetStrokeDashOffset: TFloatWithCSSUnit; +begin + result := OrthoAttributeOrStyleWithUnit['stroke-dashoffset', + FloatWithCSSUnit(0,cuCustom)]; +end; + +function TSVGElement.GetStyleFromStyleSheet(const AName, ADefault: string): string; +var + i: Integer; +begin + if FImportStyleState = fssNotSearched then ImportStyles; + if FImportStyleState <> fssNotFound then + for i:= Length(FImportedStyles)-1 downto 0 do + begin + result:= GetPropertyFromStyleDeclarationBlock(FImportedStyles[i].attr, AName, ''); + if result <> '' then exit; + end; + result := inherited GetStyleFromStyleSheet(AName, ADefault); +end; + +function TSVGElement.GetTransform: string; +begin + result := Attribute['transform']; +end; + +function TSVGElement.GetID: string; +begin + result := Attribute['xml:id']; + if result = '' then result := Attribute['id']; +end; + +function TSVGElement.GetClassAttr: string; +begin + result := Attribute['class']; +end; + +function TSVGElement.GetVisible: boolean; +begin + result := (AttributeOrStyle['display'] <> 'none'); +end; + +procedure TSVGElement.SetDatalink(AValue: TSVGDataLink); +begin + if Assigned(FDataLink) then FDataLink.Unlink(self); + FDataLink := AValue; + if Assigned(FDataLink) then FDataLink.Link(self); +end; + +procedure TSVGElement.SetClipPath(AValue: string); +begin + Attribute['clip-path'] := AValue; + RemoveStyle('clip-path'); +end; + +procedure TSVGElement.SetFill(AValue: string); +begin + Attribute['fill'] := AValue; + RemoveStyle('fill'); +end; + +procedure TSVGElement.SetFillColor(AValue: TBGRAPixel); +begin + fillOpacity:= AValue.alpha/255; + AValue.alpha:= 255; + fill := LowerCase(BGRAToStr(AValue, CSSColors, 0, true, true)); +end; + +procedure TSVGElement.SetFillOpacity(AValue: single); +begin + Attribute['fill-opacity'] := Units.formatValue(AValue); + RemoveStyle('fill-opacity'); +end; + +procedure TSVGElement.SetFillRule(AValue: string); +begin + Attribute['fill-rule'] := AValue; + RemoveStyle('fill-rule'); +end; + +procedure TSVGElement.SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix); +begin + if not IsAffineMatrixIdentity(AValue) then + transform := MatrixToTransform(AValue, AUnit) + else transformNone; +end; + +procedure TSVGElement.SetMixBlendMode(AValue: TBlendOperation); +var + opstr: String; +begin + case AValue of + boLighten: opstr := 'lighten'; + boScreen: opstr := 'screen'; + boColorDodge: opstr := 'color-dodge'; + boColorBurn: opstr := 'color-burn'; + boDarken: opstr := 'darken'; + boLinearAdd: opstr := 'add'; + boMultiply: opstr := 'multiply'; + boOverlay: opstr := 'overlay'; + boSvgSoftLight: opstr := 'soft-light'; + boHardLight: opstr := 'hard-light'; + boLinearDifference: opstr := 'difference'; + boLinearExclusion: opstr := 'exclusion'; + boCorrectedHue: opstr := 'hue'; + boCorrectedColor: opstr := 'color'; + boCorrectedLightness: opstr := 'luminosity'; + boCorrectedSaturation: opstr := 'saturation'; + else {boTransparent} + begin + RemoveStyle('mix-blend-mode'); + FDomElem.RemoveAttribute('mix-blend-mode'); + exit; + end; + end; + Style['mix-blend-mode'] := opstr; + FDomElem.RemoveAttribute('mix-blend-mode'); +end; + +procedure TSVGElement.SetOpacity(AValue: single); +begin + Attribute['opacity'] := Units.formatValue(AValue); + RemoveStyle('opacity'); +end; + +procedure TSVGElement.SetPaintOrder(AValue: TSVGPaintOrder); +var + s: String; +begin + case AValue of + spoFillStrokeMarkers: s := 'normal'; + spoFillMarkersStroke: s := 'fill markers'; + spoStrokeFillMarkers: s := 'stroke'; + spoStrokeMarkersFill: s := 'stroke markers'; + spoMarkersFillStroke: s := 'markers'; + spoMarkersStrokeFill: s := 'markers stroke'; + end; + Attribute['paint-order'] := s; + RemoveStyle('paint-order'); +end; + +procedure TSVGElement.SetStroke(AValue: string); +begin + Attribute['stroke'] := AValue; + RemoveStyle('stroke'); +end; + +procedure TSVGElement.SetStrokeColor(AValue: TBGRAPixel); +begin + strokeOpacity:= AValue.alpha/255; + AValue.alpha:= 255; + stroke := Lowercase(BGRAToStr(AValue, CSSColors, 0, true, true)); +end; + +procedure TSVGElement.SetStrokeLineCap(AValue: string); +begin + Attribute['stroke-linecap'] := AValue; + RemoveStyle('stroke-linecap'); +end; + +procedure TSVGElement.SetStrokeLineCapLCL(AValue: TPenEndCap); +begin + case AValue of + pecRound: strokeLineCap:= 'round'; + pecSquare: strokeLineCap:= 'square'; + else strokeLineCap:= 'butt'; + end; +end; + +procedure TSVGElement.SetStrokeLineJoin(AValue: string); +begin + Attribute['stroke-linejoin'] := AValue; + RemoveStyle('stroke-linejoin'); +end; + +procedure TSVGElement.SetStrokeLineJoinLCL(AValue: TPenJoinStyle); +begin + case AValue of + pjsBevel: strokeLineJoin:= 'bevel'; + pjsMiter: strokeLineJoin:= 'miter'; + else strokeLineJoin:= 'round'; + end; +end; + +procedure TSVGElement.SetStrokeMiterLimit(AValue: single); +begin + if AValue < 1 then AValue := 1; + Attribute['stroke-miterlimit'] := Units.formatValue(AValue); + RemoveStyle('stroke-miterlimit'); +end; + +procedure TSVGElement.SetStrokeOpacity(AValue: single); +begin + Attribute['stroke-opacity'] := Units.formatValue(AValue); + RemoveStyle('stroke-opacity'); +end; + +procedure TSVGElement.SetStrokeWidth(AValue: TFloatWithCSSUnit); +begin + HorizAttributeWithUnit['stroke-width'] := AValue; + RemoveStyle('stroke-width'); +end; + +procedure TSVGElement.SetStrokeDashArray(AValue: string); +begin + Attribute['stroke-dasharray'] := AValue; + RemoveStyle('stroke-dasharray'); +end; + +procedure TSVGElement.SetStrokeDashArrayF(AValue: ArrayOfFloat); +var + s: string; + i: integer; +begin + if length(AValue) = 0 then + begin + strokeDashArrayNone; + exit; + end; + s:= ''; + for i := 0 to high(AValue) do + begin + if s <> '' then AppendStr(s, ' '); + AppendStr(s, TCSSUnitConverter.formatValue(AValue[i])+' '); + end; + strokeDashArray := s; +end; + +procedure TSVGElement.SetStrokeDashOffset(AValue: TFloatWithCSSUnit); +begin + OrthoAttributeWithUnit['stroke-dashoffset'] := AValue; + RemoveStyle('stroke-dashoffset'); +end; + +procedure TSVGElement.SetTransform(AValue: string); +begin + Attribute['transform'] := AValue; +end; + +procedure TSVGElement.SetID(AValue: string); +begin + if AValue = ID then exit; + if Assigned(DataLink) then DataLink.Unlink(self); + if Attribute['xml:id']<>'' then + Attribute['xml:id'] := AValue + else + Attribute['id'] := AValue; + if Assigned(DataLink) then DataLink.Link(self); +end; + +procedure TSVGElement.SetClassAttr(AValue: string); +begin + Attribute['class'] := AValue; +end; + +procedure TSVGElement.Init(ADocument: TDOMDocument; ATag: string; + AUnits: TCSSUnitConverter); +begin + if ATag='' then + raise exception.Create('Cannot create a generic element'); + + FDomElem := ADocument.CreateElement(ATag); + FUnits := AUnits; + if Assigned(FDataLink) then FDataLink.Link(self); +end; + +procedure TSVGElement.Init(AElement: TDOMElement; + AUnits: TCSSUnitConverter); +begin + FDomElem := AElement; + FUnits := AUnits; + if Assigned(FDataLink) then FDataLink.Link(self); +end; + +procedure TSVGElement.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +begin + //nothing +end; + +procedure TSVGElement.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); +begin + ACanvas2D.fillStyle(fillColor); + + ACanvas2D.fillMode := TFillMode(fillMode); +end; + +procedure TSVGElement.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); +var + a: ArrayOfFloat; + lw: single; + i: Integer; +begin + ACanvas2d.strokeStyle(strokeColor); + lw := Units.ConvertWidth(strokeWidth,AUnit).value; + ACanvas2d.lineWidth := lw; + ACanvas2d.lineCap := strokeLineCap; + ACanvas2d.lineJoin := strokeLineJoin; + ACanvas2d.miterLimit := strokeMiterLimit; + + a:= strokeDashArrayF; + if (Length(a) <> 0) and (lw > 0) then + begin + for i := 0 to high(a) do + a[i] := a[i] / lw; + ACanvas2d.lineStyle(a); + end + else + ACanvas2d.lineStyle(psSolid); +end; + +procedure TSVGElement.Initialize; +begin + SetLength(FImportedStyles,0); + FImportStyleState := fssNotSearched; +end; + +procedure TSVGElement.Paint(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); + procedure DoFill; + begin + if not isFillNone then + begin + ApplyFillStyle(ACanvas2D,AUnit); + ACanvas2d.fill; + end; + end; + procedure DoStroke; + begin + if not isStrokeNone then + begin + ApplyStrokeStyle(ACanvas2D,AUnit); + ACanvas2d.stroke; + end; + end; +begin + if paintOrder in [spoFillStrokeMarkers, spoFillMarkersStroke, spoMarkersFillStroke] then + begin + DoFill; + DoStroke; + end else + begin + DoStroke; + DoFill; + end; +end; + +constructor TSVGElement.Create(AElement: TDOMElement; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + FDataLink:= ADataLink; + Initialize; + Init(AElement,AUnits); +end; + +constructor TSVGElement.Create(ADocument: TDOMDocument; + AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); +begin + FDataLink:= ADataLink; + Initialize; + Init(ADocument, GetDOMTag, AUnits); +end; + +class function TSVGElement.GetDOMTag: string; +begin + result := ''; +end; + +destructor TSVGElement.Destroy; +begin + SetLength(FImportedStyles,0); + if Assigned(FDataLink) then FDataLink.Unlink(self); + inherited Destroy; +end; + +procedure TSVGElement.ListIdentifiers(AResult: TStringList); +var + myId: String; +begin + myId := Id; + if (myId <> '') and (AResult.IndexOf(myId) = -1) then + AResult.Add(myId); +end; + +procedure TSVGElement.RenameIdentifiers(AFrom, ATo: TStringList); +var + idx: Integer; + strokeDone, fillDone, clipDone, HrefDone: boolean; + before, after: String; +begin + if AFrom.Count <> ATo.Count then raise exception.Create('Identifier list size mismatch'); + idx := AFrom.IndexOf(Id); + if idx <> -1 then Id := ATo[idx]; + strokeDone := false; + fillDone:= false; + clipDone:= false; + HrefDone:= false; + for idx := 0 to AFrom.Count-1 do + begin + before := 'url(#' + AFrom[idx] + ')'; + after := 'url(#' + ATo[idx] + ')'; + if not strokeDone and (stroke = before) then + begin stroke := after; strokeDone := true; end; + if not fillDone and (fill = before) then + begin fill := after; fillDone := true; end; + if not clipDone and (clipPath = before) then + begin clipPath := after; clipDone := true; end; + if not hrefDone and (Attribute['xlink:href'] = before) then + begin Attribute['xlink:href'] := after; hrefDone := true; end; + end; +end; + +procedure TSVGElement.ConvertToUnit(AUnit: TCSSUnit); +begin + inherited ConvertToUnit(AUnit); + FImportStyleState:= fssNotSearched; + if HasAttribute('stroke-width') then + SetAttributeWithUnit('stroke-width', Units.ConvertWidth(GetAttributeWithUnit('stroke-width'), AUnit)); + if HasAttribute('stroke-dash-offset') then + SetAttributeWithUnit('stroke-dash-offset', Units.ConvertWidth(GetAttributeWithUnit('stroke-dash-offset'), AUnit)); +end; + +procedure TSVGElement.Recompute; +begin + +end; + +procedure TSVGElement.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); +var prevMatrix: TAffineMatrix; +begin + if not Visible then exit; + prevMatrix := ACanvas2d.matrix; + ACanvas2d.transform(matrix[AUnit]); + InternalDraw(ACanvas2d,AUnit); + ACanvas2d.matrix := prevMatrix; +end; + +procedure TSVGElement.fillNone; +begin + fill := 'none'; +end; + +procedure TSVGElement.strokeNone; +begin + stroke := 'none'; +end; + +procedure TSVGElement.strokeDashArrayNone; +begin + strokeDashArray := 'none'; +end; + +procedure TSVGElement.transformNone; +begin + FDomElem.RemoveAttribute('transform'); +end; + +function TSVGElement.fillMode: TSVGFillMode; +begin + if fillRule = 'evenodd' then + result := sfmEvenOdd + else + result := sfmNonZero; +end; + +function TSVGElement.FindStyleElementInternal(const classStr: string; + out attributesStr: string): integer; +var + i: integer; +begin + attributesStr:= ''; + with FDataLink do + for i:= 0 to StyleCount-1 do + begin + result:= (Styles[i] as TSVGStyle).Find(classStr); + if result <> -1 then + begin + attributesStr:= (Styles[i] as TSVGStyle).Ruleset[result].declarations; + Exit; + end; + end; + result:= -1; +end; + +procedure TSVGElement.ImportStyles; + + procedure AddStyle(const s: string; const id: integer); + var + l: integer; + begin + FImportStyleState:= fssFound; + l:= Length(FImportedStyles); + SetLength(FImportedStyles,l+1); + with FImportedStyles[l] do + begin + attr:= s; + pos:= id; + end; + end; + +var + fid: integer; + tag,styleC,s: string; +begin + FImportStyleState:= fssNotFound; + SetLength(FImportedStyles,0); + tag:= FDomElem.TagName; + styleC:= classAttr; + (* + if style element is: + + and circle declare: + + + FImportedStyles[0] = 'fill:blue; fill-opacity: 0.4;' + FImportedStyles[1] = 'fill:yellow;' + + fill-opacity for "style1" = 0.4 not default 1! + *) + + //Find as: "[tag]" example "circle" + fid:= FindStyleElementInternal(tag,s); + if fid <> -1 then + AddStyle(s,fid); + if styleC <> '' then + begin + //Find as: "[tag].[class]" example "circle.style1" + fid:= FindStyleElementInternal(tag+'.'+styleC,s); + if fid <> -1 then + AddStyle(s,fid) + else + begin + //Find as: ".[class]" example ".style1" + fid:= FindStyleElementInternal('.'+styleC,s); + if fid <> -1 then + AddStyle(s,fid); + end; + end; +end; + +procedure TSVGElement.SetVisible(AValue: boolean); +begin + if AValue <> Visible then + Style['display'] := 'inline'; + FDomElem.RemoveAttribute('display'); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgratext.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgratext.pas new file mode 100644 index 0000000..385b782 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgratext.pas @@ -0,0 +1,1870 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAText; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +{$IFDEF LINUX} + {$DEFINE SYSTEM_RENDERER_IS_FINE} + {$DEFINE SYSTEM_CLEARTYPE_RENDERER_IS_FINE} + {$DEFINE RENDER_TEXT_ON_TBITMAP} +{$ENDIF} +{$IFDEF FREEBSD} + {$DEFINE SYSTEM_RENDERER_IS_FINE} + {$DEFINE SYSTEM_CLEARTYPE_RENDERER_IS_FINE} +{$ENDIF} +{$IFDEF DARWIN} + {$DEFINE SYSTEM_RENDERER_IS_FINE} + {$DEFINE RENDER_TEXT_ON_TBITMAP} +{$ENDIF} +{$IFDEF WINDOWS} + {$IFNDEF LEGACY_FONT_VERTICAL_OFFSET} + {$DEFINE FIX_FONT_VERTICAL_OFFSET} + {$ENDIF} +{$ENDIF} +{$IFDEF BGRABITMAP_USE_MSEGUI} + {$DEFINE RENDER_TEXT_ON_TBITMAP} +{$ENDIF} + +{ + Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType + + This unit provides basic text rendering functions using system renderer + (LCL or MSEgui). + + Text functions use a temporary bitmap where the operating system text drawing + is used. Then it is scaled down (if antialiasing is activated) and colored. + + These routines are rather slow, so you may use other font renderers + like TBGRATextEffectFontRenderer in BGRATextFX if you want to use LCL fonts, + or, if you have TrueType fonts files, you may use TBGRAFreeTypeFontRenderer + in BGRAFreeType. } + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAPen, BGRAGrayscaleMask + {$IFDEF LCL},InterfaceBase, LCLVersion{$ENDIF}; + +const + RenderTextOnBitmap = {$IFDEF RENDER_TEXT_ON_TBITMAP}true{$ELSE}false{$ENDIF}; + +type + TWordBreakHandler = BGRABitmapTypes.TWordBreakHandler; + + { TBGRASystemFontRenderer } + + TBGRASystemFontRenderer = class(TBGRACustomFontRenderer) + protected + FFont: TFont; //font parameters + FWordBreakHandler: TWordBreakHandler; + FOwnUnderline: boolean; + procedure UpdateFont; virtual; + function InternalTextSize(sUTF8: string; AShowPrefix: boolean): TSize; + function InternalTextSizeAngle(sUTF8: string; AShowPrefix: boolean; AOrientation: integer): TSize; virtual; + procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string; + x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); + procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; ATexture: IBGRAScanner); + procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); + procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); virtual; + procedure InternalTextOutEllipse(ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); + procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean; + AWordBreak: TWordBreakHandler); overload; + procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string; + AWordBreak: TWordBreakHandler); overload; + function InternalGetFontPixelMetric: TFontPixelMetric; + procedure DefaultWorkBreakHandler(var ABeforeUTF8, AAfterUTF8: string); + public + OverrideUnderlineDecoration: boolean; // draw unerline according to computed font pixel metric instead of using system rendering of underline + procedure SplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string); + function GetFontPixelMetric: TFontPixelMetric; override; + function FontExists(AName: string): boolean; override; + class function PatchSystemFontName(AName: string): string; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override; + procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload; + procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload; + function TextSize(sUTF8: string): TSize; overload; override; + function TextSizeAngle(sUTF8: string; orientationTenthDegCCW: integer): TSize; override; + function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; + function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; + constructor Create; + destructor Destroy; override; + property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; + end; + +{$IFDEF BGRABITMAP_USE_MSEGUI} + TMSEFontRenderer = class(TBGRASystemFontRenderer); +{$ELSE} + TLCLFontRenderer = class(TBGRASystemFontRenderer); +{$ENDIF} + +function CleanTextOutString(s: string): string; //this works with UTF8 strings as well +function RemoveLineEnding(var s: string; indexByte: integer): boolean; //this works with UTF8 strings however the index is the byte index +function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; + +procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string; + c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0; + ShowPrefix: boolean = false; RightToLeft: boolean = false); + +procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientationTenthDegCCW: integer; + sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0); + +procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single; + sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0); + +function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +function BGRATextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; +function BGRATextFitInfoAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; +function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: integer): TSize; +function BGRAOriginalTextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; + out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize; +function BGRAOriginalTextSizeExAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; + out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize; + +function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload; +function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; overload; +function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload; +function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight, AXHeight: single): ArrayOfTPointF; overload; + +function GetFontHeightSign: integer; +function FontEmHeightSign: integer; +function FontFullHeightSign: integer; +function SystemFontAvailable: boolean; +function GetFineClearTypeAuto: TBGRAFontQuality; +function FixSystemFontFullHeight({%H-}AFontName: string; AFontHeight: integer): integer; + +{$IFDEF LCL} +function LCLFontAvailable: boolean; +function FixLCLFontFullHeight(AFontName: string; AFontHeight: integer): integer; +{$ENDIF} + +procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true); +procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true); +procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x,y: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; KeepRGBOrder: boolean=true); + +const FontAntialiasingLevel = {$IFDEF SYSTEM_RENDERER_IS_FINE}3{$ELSE}6{$ENDIF}; +const FontDefaultQuality = fqAntialiased; +const IsLclFontRendererFine = {$IFDEF SYSTEM_RENDERER_IS_FINE}true{$ELSE}false{$ENDIF}; + +function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric; + +var + BGRATextOutImproveReadabilityProc : procedure (bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); + +procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); +procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); +procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; + AText: string; const AStyle: TTextStyle); +function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; +function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; +function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; +function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; AMaxWidth: integer; AOrientation: integer): integer; +procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); + +implementation + +uses Math, BGRATransform, BGRABlend, BGRAUTF8, BGRAUnicode, BGRATextBidi + {$IFDEF LCL}, Forms{$IF lcl_fullversion >= 1070000}, lclplatformdef{$ENDIF}{$ENDIF}; + +const MaxPixelMetricCount = 100; + +var + SystemFontDisabledValue: boolean; + fqFineClearTypeComputed: boolean; + fqFineClearTypeValue: TBGRAFontQuality; + FontHeightSignComputed: boolean; + FontHeightSignValue: integer; + FontPixelMetricArray: array[0..MaxPixelMetricCount-1] of record + usage: integer; + name: string; + height: integer; + italic: boolean; + bold: boolean; + metric: TFontPixelMetric; + end; + FontPixelMetricCount: integer; + +{$IFDEF BGRABITMAP_USE_MSEGUI} +{$i bgramsegui_text.inc} +{$ELSE} +procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); +begin + ABitmap.Canvas.Brush.Style := bsClear; + ABitmap.Canvas.TextOut(ACoord.X, ACoord.Y, AText); +end; + +procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); +begin + ABitmap.Canvas.Font.Orientation := AOrientation; + BitmapTextOut(ABitmap, ACoord, AText); +end; + +procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; + AText: string; const AStyle: TTextStyle); +begin + ABitmap.Canvas.Brush.Style := bsClear; + {$IFDEF DARWIN} + if AStyle.RightToLeft then AText := UTF8EmbedDirection(AText, true); + {$ENDIF} + ABitmap.Canvas.TextRect(ARect, ACoord.X, ACoord.Y, AText, AStyle); +end; + +function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; +begin + {$IFDEF DARWIN} + AText := StringReplace(AText, ' ', UTF8_NO_BREAK_SPACE, [rfReplaceAll]); + {$ENDIF} + result := ABitmap.Canvas.TextExtent(AText); +end; + +function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; +begin + ABitmap.Canvas.Font.Orientation := AOrientation; + result := BitmapTextExtent(ABitmap, AText); +end; + +function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; +begin + {$IFDEF DARWIN} + AText := StringReplace(AText, ' ', UTF8_NO_BREAK_SPACE, [rfReplaceAll]); + {$ENDIF} + result := ABitmap.Canvas.TextFitInfo(AText, AMaxWidth); +end; + +function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; AMaxWidth: integer; AOrientation: integer): integer; +begin + ABitmap.Canvas.Font.Orientation := AOrientation; + result := BitmapTextFitInfo(ABitmap, AText, AMaxWidth); +end; + +procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); +begin + ABitmap.Canvas.Brush.Style := bsSolid; + ABitmap.Canvas.Brush.Color := AColor; + ABitmap.Canvas.Pen.Style := psClear; + ABitmap.Canvas.FillRect(ARect); +end; +{$ENDIF} + +procedure ComputeFontVerticalBounds(text: string; font: TFont; out top, bottom, totalHeight: integer); +var + xb,yb: integer; + pmask: PBGRAPixel; + nbPix: array of integer; + nbCur: integer; + mean: integer; + mask: TBGRACustomBitmap; + size: TSize; +begin + if not SystemFontAvailable then + begin + top := 0; + bottom := 0; + totalHeight := 0; + exit; + end; + size := BGRAOriginalTextSize(font,fqSystem,text,FontAntialiasingLevel); + mask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack); + mask.Canvas.Font := font; + mask.Canvas.Font.Quality := fqAntialiased; + mask.Canvas.Font.Color := clWhite; + mask.Canvas.Font.Style := font.style * [fsBold,fsItalic]; + BitmapTextOut(mask.Bitmap, Point(0,0), text); + top := -1; + bottom := -1; + totalHeight:= mask.Height; + + mean := 0; + setlength(nbPix, mask.Height); + for yb := 0 to mask.Height-1 do + begin + pmask := mask.scanline[yb]; + nbCur := 0; + for xb := 0 to mask.Width-1 do + begin + if (pmask^.green > 0) then inc(nbCur); + inc(pmask); + end; + nbPix[yb] := nbCur; + inc(mean,nbCur); + end; + mean := (mean+ (mask.Height div 2)) div mask.Height; + + for yb := 0 to high(nbPix) do + begin + if nbPix[yb]> mean div 3 then + begin + if top = -1 then top := yb + else bottom := yb+1; + end; + end; + mask.Free; +end; + +function ComputeFontPixelMetric(AFont: TFont): TFontPixelMetric; +begin + ComputeFontVerticalBounds('acemu',AFont,result.xLine,result.Baseline,result.Lineheight); + ComputeFontVerticalBounds('gDjSO',AFont,result.CapLine,result.DescentLine,result.Lineheight); + if result.xLine = -1 then result.xLine := result.CapLine else + if result.CapLine = -1 then result.CapLine := result.xLine; + if result.DescentLine = -1 then result.DescentLine := result.Baseline else + if result.Baseline = -1 then result.Baseline := result.DescentLine; + result.Defined := (result.xLine <> -1) and (result.CapLine <> -1) and (result.Baseline <> -1) and (result.DescentLine <> -1) and + (result.Lineheight <> -1); +end; + +function ComparePixelMetric(index: integer; font: TFont): integer; +begin + if (index < 0) or (index >= FontPixelMetricCount) then + result := 0 + else + begin + with FontPixelMetricArray[index] do + if (name = font.Name) and (height = font.Height) then + result := 0 else + if (height > font.Height) then + result := 1 else + if (height < font.Height) then + result := -1 else + if name > font.Name then + result := 1 else + if name < font.Name then + result := -1 + else result := 0; + end; +end; + +procedure FindPixelMetricPos(AFont: TFont; out startPos,endPos: integer); +var middle,iStart,iEnd: integer; +begin + if FontPixelMetricCount = 0 then + begin + startPos := 0; + endPos := 0; + end; + iStart:= 0; + iEnd:= FontPixelMetricCount; + while iStart < iEnd do + begin + middle := (iStart+iEnd) div 2; + if ComparePixelMetric(middle,AFont) >= 0 then + iEnd := middle + else + iStart := middle+1; + end; + startPos := iStart; + + iStart:= startPos; + iEnd:= FontPixelMetricCount; + while iStart < iEnd do + begin + middle := (iStart+iEnd) div 2; + if ComparePixelMetric(middle,AFont) <= 0 then + iStart := middle+1 + else + iEnd := middle; + end; + endPos := iEnd; +end; + +procedure RemoveOldPixelMetric; +var sum,nb,i: integer; +begin + if FontPixelMetricCount = 0 then exit; + sum := 0; + for i := 0 to FontPixelMetricCount-1 do + inc(sum, FontPixelMetricArray[i].usage); + sum := sum div FontPixelMetricCount; + nb := 0; + for i := 0 to FontPixelMetricCount-1 do + begin + if FontPixelMetricArray[i].usage > sum then + begin + FontPixelMetricArray[nb] := FontPixelMetricArray[i]; + inc(nb); + end; + end; + FontPixelMetricCount := nb; +end; + +function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric; +var i,startPos,endPos: integer; + prevHeight,fixHeight: integer; +begin + if (AFont.Height < -200) or (AFont.Height > 150) then + begin + prevHeight := AFont.Height; + if AFont.Height < 0 then + fixHeight := -200 + else + fixHeight := 150; + AFont.Height := fixHeight; + result := GetLCLFontPixelMetric(AFont); + AFont.Height := prevHeight; + + result.Baseline := round(result.Baseline/fixHeight*prevHeight); + result.CapLine := round(result.CapLine/fixHeight*prevHeight); + result.DescentLine := round(result.DescentLine/fixHeight*prevHeight); + result.Lineheight := round(result.Lineheight/fixHeight*prevHeight); + result.xLine := round(result.xLine/fixHeight*prevHeight); + exit; + end; + + FindPixelMetricPos(AFont,startPos,endPos); + for i := startPos to endPos-1 do + if (FontPixelMetricArray[i].bold = AFont.bold) and + (FontPixelMetricArray[i].italic = AFont.Italic) then + begin + result := FontPixelMetricArray[i].metric; + inc(FontPixelMetricArray[i].usage); + exit; + end; + if FontPixelMetricCount = MaxPixelMetricCount then RemoveOldPixelMetric; + for i := FontPixelMetricCount downto endPos+1 do + FontPixelMetricArray[i] := FontPixelMetricArray[i-1]; + inc(FontPixelMetricCount); + with FontPixelMetricArray[endPos]do + begin + italic := AFont.Italic; + bold := AFont.Bold; + usage := 1; + name := AFont.Name; + height:= AFont.Height; + metric := ComputeFontPixelMetric(AFont); + result := metric; + end; +end; + +const DefaultFontHeightSign = -1; + +function BGRATextUnderline(ATopLeft: TPointF; + AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; +begin + result := BGRATextUnderline(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine); +end; + +function BGRATextUnderline(ATopLeft: TPointF; + AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; +var height,y: single; +begin + height := AEmHeight*0.080; + y := ATopLeft.y+ABaseline+1.6*height; + result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y), + PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter, + SolidPenStyle, []); +end; + +function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; + AMetrics: TFontPixelMetric): ArrayOfTPointF; +begin + result := BGRATextStrikeOut(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine,AMetrics.Baseline-AMetrics.xLine); +end; + +function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, + AEmHeight, AXHeight: single): ArrayOfTPointF; +var height,y: single; +begin + height := AEmHeight*0.075; + y := ATopLeft.y+ABaseline-AXHeight*0.5; + result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y), + PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter, + SolidPenStyle, []); +end; + +function GetFontHeightSign: integer; +var + HeightP1, HeightM1: integer; + tempBmp: TBitmap; +begin + if SystemFontDisabledValue then + begin + result := DefaultFontHeightSign; + exit; + end; + + if FontHeightSignComputed then + begin + result := FontHeightSignValue; + exit; + end; + + if {$IFDEF LCL}WidgetSet.LCLPlatform = lpNoGUI{$ELSE}False{$ENDIF} then + begin + SystemFontDisabledValue:= True; + result := -1; + exit; + end; + + tempBmp := nil; + try + tempBmp := TBitmap.Create; + tempBmp.Width := 30; + tempBmp.Height := 30; + tempBmp.Canvas.Font.Name := 'Arial'; + tempBmp.Canvas.Font.Style := []; + tempBmp.Canvas.Font.Height := 20; + HeightP1 := BitmapTextExtent(tempBmp, 'Hg').cy; + tempBmp.Canvas.Font.Height := -20; + HeightM1 := BitmapTextExtent(tempBmp, 'Hg').cy; + + if HeightP1 > HeightM1 then + FontHeightSignValue := 1 + else + FontHeightSignValue := -1; + + FontHeightSignComputed := true; + result := FontHeightSignValue; + except + on ex: Exception do + begin + SystemFontDisabledValue := True; + result := -1; + end; + end; + tempBmp.Free; +end; + +function GetFineClearTypeAuto: TBGRAFontQuality; +var + lclBmp: TBitmap; + bgra: TBGRACustomBitmap; + x,y: integer; +begin + if fqFineClearTypeComputed then + begin + result:= fqFineClearTypeValue; + exit; + end; + result := fqFineAntialiasing; + if not SystemFontDisabledValue and not ({$IFDEF LCL}WidgetSet.LCLPlatform = lpNoGUI{$ELSE}False{$ENDIF}) then + begin + lclBmp := TBitmap.Create; + lclBmp.Width := 1; + lclBmp.Height := 1; + lclBmp.Canvas.Font.Height := -50; + lclBmp.Canvas.Font.Quality := fqCleartype; + lclBmp.Canvas.Font.Color := clBlack; + with BitmapTextExtent(lclBmp, '/') do + begin + lclBmp.Width := cx; + lclBmp.Height := cy; + end; + BitmapFillRect(lclBmp, rect(0,0,lclBmp.Width,lclBmp.Height), clWhite); + BitmapTextOut(lclBmp, Point(0,0), '/'); + bgra:= BGRABitmapFactory.Create(lclBmp); + x:= bgra.Width div 2; + for y := 0 to bgra.Height-1 do + with bgra.GetPixel(x,y) do + if (red<>blue) then + begin + if blue < red then + result:= fqFineClearTypeRGB + else + result:= fqFineClearTypeBGR; + break; + end else + if (green = 0) then break; + bgra.Free; + lclBmp.Free; + end; + fqFineClearTypeValue := result; + fqFineClearTypeComputed:= true; +end; + +{$IFNDEF WINDOWS} +var LCLFontFullHeightRatio : array of record + FontName: string; + Ratio: single; + end; +{$ENDIF} + +function FixSystemFontFullHeight(AFontName: string; AFontHeight: integer): integer; +{$IFNDEF WINDOWS} +const TestHeight = 200; +var + i: Integer; + ratio : single; + f: TFont; + h: LongInt; +begin + if (AFontHeight = 0) or + (AFontHeight*FontEmHeightSign > 0) then + result := AFontHeight + else + begin + ratio := EmptySingle; + for i := 0 to high(LCLFontFullHeightRatio) do + if CompareText(AFontName, LCLFontFullHeightRatio[i].FontName)=0 then + begin + ratio := LCLFontFullHeightRatio[i].Ratio; + break; + end; + if ratio = EmptySingle then + begin + f := TFont.Create; + f.Quality := fqDefault; + f.Name := AFontName; + f.Height := FontFullHeightSign*TestHeight; + h := BGRATextSize(f, fqSystem, 'Hg', 1).cy; + f.Free; + if h = 0 then ratio := 1 + else ratio := TestHeight/h; + + setlength(LCLFontFullHeightRatio, length(LCLFontFullHeightRatio)+1); + LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].FontName:= AFontName; + LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].Ratio:= ratio; + end; + result := round(AFontHeight*ratio); + end; +end; +{$ELSE} +begin + result := AFontHeight; +end; +{$ENDIF} + +{$IFDEF LCL} +function LCLFontAvailable: boolean; +begin + result := SystemFontAvailable; +end; + +function FixLCLFontFullHeight(AFontName: string; AFontHeight: integer): integer; +begin + result := FixSystemFontFullHeight(AFontName, AFontHeight); +end; +{$ENDIF} + +function FontEmHeightSign: integer; +begin + result := GetFontHeightSign; +end; + +function FontFullHeightSign: integer; +begin + result := -FontEmHeightSign; +end; + +function SystemFontAvailable: boolean; +begin + if not FontHeightSignComputed then GetFontHeightSign; + result := not SystemFontDisabledValue; +end; + +procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, + y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; + texture: IBGRAScanner; RGBOrder: boolean); +begin + BGRAGrayscaleMask.BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird,mask,color,texture,RGBOrder); +end; + +procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); +begin + BGRABlend.BGRAFillClearTypeMask(dest,x,y,xThird,mask,color,texture,RGBOrder); +end; + +procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; + mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; + KeepRGBOrder: boolean); +begin + BGRABlend.BGRAFillClearTypeRGBMask(dest,x,y,mask,color,texture,KeepRGBOrder); +end; + +function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; + sUTF8: string; CustomAntialiasingLevel: Integer; + out actualAntialiasingLevel: integer; + out extraVerticalMarginDueToRotation: integer): TSize; +begin + result := BGRAOriginalTextSizeExAngle(Font, Font.Orientation, Quality, sUTF8, + CustomAntialiasingLevel, actualAntialiasingLevel, extraVerticalMarginDueToRotation); +end; + +function BGRAOriginalTextSizeExAngle(Font: TFont; AOrientation: integer; + Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; + out actualAntialiasingLevel: integer; + out extraVerticalMarginDueToRotation: integer): TSize; +var + tempBmp: TBitmap; +begin + actualAntialiasingLevel:= CustomAntialiasingLevel; + extraVerticalMarginDueToRotation := 0; + if not SystemFontAvailable then + result := Size(0,0) + else + begin + tempBmp := nil; + try + tempBmp := TBitmap.Create; + tempBmp.Canvas.Font := Font; + if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then + begin + tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel; + end else + begin + tempBmp.Canvas.Font.Height := Font.Height; + actualAntialiasingLevel:= 1; + end; + result := BitmapTextExtentAngle(tempBmp, sUTF8, AOrientation); + if Font.Orientation <> 0 then + begin + tempBmp.Canvas.Font.Orientation:= 0; + extraVerticalMarginDueToRotation := result.cy - + BitmapTextExtentAngle(tempBmp, sUTF8, AOrientation).cy; + end; + except + on ex: exception do + begin + result := Size(0,0); + SystemFontDisabledValue := True; + end; + end; + tempBmp.Free; + end; +end; + +function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; + CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; +begin + result := BGRATextFitInfoAngle(Font, Font.Orientation, Quality, sUTF8, + CustomAntialiasingLevel, AMaxWidth); +end; + +function BGRATextFitInfoAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; + CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; +var + actualAntialiasingLevel{$IFDEF LCL}{$IF lcl_fullversion < 1070000}, len1{$ENDIF}{$ENDIF}: Integer; + tempBmp: TBitmap; +begin + if (AMaxWidth = 0) or (length(sUTF8)=0) then exit(0); + actualAntialiasingLevel:= CustomAntialiasingLevel; + if not SystemFontAvailable then + result := 0 + else + begin + tempBmp := nil; + try + tempBmp := TBitmap.Create; + tempBmp.Canvas.Font := Font; + if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then + begin + tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel; + end else + begin + tempBmp.Canvas.Font.Height := Font.Height; + actualAntialiasingLevel:= 1; + end; + {$IFDEF LCL}{$IF lcl_fullversion < 1070000} + len1 := BitmapTextExtentAngle(tempBmp, + copy(sUTF8,1,UTF8CharacterLength(@sUTF8[1])), + AOrientation).cx; + if len1 > AMaxWidth*actualAntialiasingLevel then exit(0); + {$ENDIF}{$ENDIF} + result := BitmapTextFitInfoAngle(tempBmp, sUTF8, + AMaxWidth*actualAntialiasingLevel, AOrientation); + except + on ex: exception do + begin + result := 0; + SystemFontDisabledValue := True; + end; + end; + tempBmp.Free; + end; +end; + +function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; + sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +begin + result := BGRAOriginalTextSizeAngle(Font, Font.Orientation, Quality, sUTF8, + CustomAntialiasingLevel); +end; + +function BGRAOriginalTextSizeAngle(Font: TFont; AOrientation: integer; + Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +var actualAntialiasingLevel, extraMargin: integer; +begin + result := BGRAOriginalTextSizeExAngle(Font, AOrientation, Quality, sUTF8, + CustomAntialiasingLevel, actualAntialiasingLevel, extraMargin); + {$IFDEF FIX_FONT_VERTICAL_OFFSET} + if extraMargin > 0 then dec(result.cy, extraMargin); + {$ENDIF} +end; + +function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +begin + result := BGRATextSizeAngle(Font, Font.Orientation, Quality, sUTF8, CustomAntialiasingLevel); +end; + +function BGRATextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; +begin + {$IFDEF SYSTEM_RENDERER_IS_FINE} + if Quality = fqFineAntialiasing then Quality:= fqSystem; + {$ENDIF} + result := BGRAOriginalTextSizeAngle(Font, AOrientation, Quality, sUTF8, CustomAntialiasingLevel); + if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then + begin + result.cx := ceil(Result.cx/CustomAntialiasingLevel); + result.cy := ceil(Result.cy/CustomAntialiasingLevel); + end; +end; + +function RemovePrefix(sUTF8: string): string; +var i,resLen: integer; +begin + setlength(result, length(sUTF8)); + resLen := 0; + i := 1; + while i <= length(sUTF8) do + begin + if sUTF8[i] = '&' then + begin // double ('&&') indicate single char '&' + if (i < length(sUTF8)) and (sUTF8[i+1] = '&') then + begin + inc(resLen); + result[resLen] := '&'; + inc(i,2); + end else + // single indicate underline + inc(i); + end else + begin + inc(resLen); + result[resLen] := sUTF8[i]; + inc(i); + end; + end; + setlength(result,resLen); +end; + +procedure FilterOriginalText(Quality: TBGRAFontQuality; CustomAntialiasingLevel: Integer; var temp: TBGRACustomBitmap; + out grayscaleMask: TGrayscaleMask); +var + n: integer; + maxAlpha: UInt32or64; + pb: PByte; + multiplyX: integer; + resampled: TBGRACustomBitmap; +begin + grayscaleMask := nil; + case Quality of + fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing: + begin + if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then multiplyX:= 3 else multiplyX:= 1; + if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then + begin + temp.ResampleFilter := rfSpline; + resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel),rmFineResample); + grayscaleMask := TGrayscaleMask.Create(resampled,cGreen); + FreeAndNil(resampled); + end else + grayscaleMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel)); + FreeAndNil(temp); + + maxAlpha := 0; + pb := grayscaleMask.Data; + for n := grayscaleMask.NbPixels - 1 downto 0 do + begin + if Pb^ > maxAlpha then maxAlpha := Pb^; + Inc(pb); + end; + if (maxAlpha <> 0) and (maxAlpha <> 255) then + begin + pb := grayscaleMask.Data; + for n := grayscaleMask.NbPixels - 1 downto 0 do + begin + pb^:= pb^ * 255 div maxAlpha; + Inc(pb); + end; + end; + end; + fqSystem: + begin + grayscaleMask := TGrayscaleMask.Create(temp, cGreen); + FreeAndNil(temp); + {$IFNDEF LINUX} + pb := grayscaleMask.Data; + for n := grayscaleMask.NbPixels - 1 downto 0 do + begin + pb^:= GammaExpansionTab[pb^] shr 8; + Inc(pb); + end; + {$ENDIF} + end; + end; +end; + +function CleanTextOutString(s: string): string; +begin + result := BGRABitmapTypes.CleanTextOutString(s); +end; + +function RemoveLineEnding(var s: string; indexByte: integer): boolean; +begin + result := BGRABitmapTypes.RemoveLineEnding(s, indexByte); +end; + +function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; +begin + result := BGRABitmapTypes.RemoveLineEndingUTF8(sUTF8,indexUTF8); +end; + +procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap; + x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner); +begin + if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB,fqSystemClearType] then + begin + if grayscale <> nil then + BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird, grayscale,c,tex,Quality=fqFineClearTypeRGB) + else if temp <> nil then + BGRAFillClearTypeRGBMask(dest,x,y, temp,c,tex); + end + else + begin + if grayscale <> nil then + begin + if tex <> nil then + grayscale.DrawAsAlpha(dest, x, y, tex) else + grayscale.DrawAsAlpha(dest, x, y, c); + end + else if temp <> nil then + dest.PutImage(x, y, temp, dmDrawWithTransparency); + end; +end; + +procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string; + c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0; + ShowPrefix: boolean = false; RightToLeft: boolean = false); +var + size: TSize; + sizeFactor, extraVerticalMargin: integer; + xMarginF: single; + style: TTextStyle; + noPrefix: string; +begin + if not SystemFontAvailable then exit; + + if CustomAntialiasingLevel = 0 then + CustomAntialiasingLevel:= FontAntialiasingLevel; + + if Font.Orientation mod 3600 <> 0 then + begin + BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,sUTF8,c,tex,align); + exit; + end; + + {$IFDEF SYSTEM_RENDERER_IS_FINE} + if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and + (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then + begin + if Quality = fqFineAntialiasing then Quality := fqSystem; + {$IFDEF SYSTEM_CLEARTYPE_RENDERER_IS_FINE} + if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType; + {$ENDIF} + end; + {$ENDIF} + + if ShowPrefix then + noPrefix := RemovePrefix(sUTF8) + else + noPrefix := sUTF8; + + size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin); + if (size.cx = 0) or (size.cy = 0) then + exit; + + if (size.cy >= 144) and (Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (CustomAntialiasingLevel > 4) then + begin + CustomAntialiasingLevel:= 4; + size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin); + end; + + case align of + taLeftJustify: ; + taCenter: DecF(xf, size.cx/2/sizeFactor); + taRightJustify: DecF(xf, size.cx/sizeFactor); + end; + + xMarginF := size.cy/sizeFactor; + fillchar({%H-}style,sizeof(style),0); + style.SingleLine := true; + style.Alignment := taLeftJustify; + style.Layout := tlTop; + style.RightToLeft := RightToLeft; + style.ShowPrefix := ShowPrefix; + BGRATextRect(bmp, Font, Quality, + rect(floor(xf-xMarginF), floor(yf)-1, ceil(xf+size.cx/sizeFactor+xMarginF), ceil(yf+size.cy/sizeFactor)+1), + xf,yf, sUTF8, style, c, tex, sizeFactor); +end; + +procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; + orientationTenthDegCCW: integer; + sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0); +var + posF: TPointF; + x,y: integer; + deltaX,deltaY: integer; + size: TSize; + temp: TBGRACustomBitmap; + TopLeft,TopRight,BottomRight,BottomLeft: TPointF; + Top,dy: Single; + Left: Single; + cosA,sinA: single; + rotBounds: TRect; + sizeFactor, extraVerticalMargin: integer; + TempFont: TFont; + oldOrientation: integer; + grayscale:TGrayscaleMask; + {$IFDEF RENDER_TEXT_ON_TBITMAP} + tempLCL: TBitmap; + {$ENDIF} + + procedure rotBoundsAdd(pt: TPointF); + begin + if pt.x < Left then Left := pt.x; + if pt.y < Top then Top := pt.y; + if floor(pt.X) < rotBounds.Left then rotBounds.Left := floor(pt.X/sizeFactor)*sizeFactor; + if floor(pt.Y) < rotBounds.Top then rotBounds.Top := floor(pt.Y/sizeFactor)*sizeFactor; + if ceil(pt.X) > rotBounds.Right then rotBounds.Right := ceil(pt.X/sizeFactor)*sizeFactor; + if ceil(pt.Y) > rotBounds.Bottom then rotBounds.Bottom := ceil(pt.Y/sizeFactor)*sizeFactor; + end; + +begin + if not SystemFontAvailable then exit; + + if CustomAntialiasingLevel = 0 then + CustomAntialiasingLevel:= FontAntialiasingLevel; + + if orientationTenthDegCCW mod 3600 = 0 then + begin + oldOrientation := Font.Orientation; + Font.Orientation := 0; + BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align); + Font.Orientation := oldOrientation; + exit; + end; + TempFont := TFont.Create; + TempFont.Assign(Font); + TempFont.Height := Font.Height; + size := BGRAOriginalTextSizeExAngle(TempFont,orientationTenthDegCCW,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor, extraVerticalMargin); + if (size.cx = 0) or (size.cy = 0) then + begin + tempFont.Free; + exit; + end; + {$IFDEF FIX_FONT_VERTICAL_OFFSET} + if extraVerticalMargin > 0 then + dy := -extraVerticalMargin*0.5 -1 + else + dy := 0; + {$ELSE} + dy := 0; + {$ENDIF} + tempFont.Free; + + cosA := cos(orientationTenthDegCCW*Pi/1800); + sinA := sin(orientationTenthDegCCW*Pi/1800); + TopLeft := PointF(sinA*dy,cosA*dy); + posF := PointF(xf,yf); + posF.Offset( TopLeft * (1/sizeFactor) ); + TopRight := TopLeft + PointF(cosA*size.cx,-sinA*size.cx); + BottomRight := TopRight + PointF(sinA*size.cy,cosA*size.cy); + BottomLeft := TopLeft + PointF(sinA*size.cy,cosA*size.cy); + rotBounds := rect(0,0,0,0); + Top := 0; + Left := 0; + rotBoundsAdd(TopRight); + rotBoundsAdd(BottomRight); + rotBoundsAdd(BottomLeft); + inc(rotBounds.Right); + inc(rotBounds.Bottom); + + posF.Offset( Left/sizeFactor, Top/sizeFactor ); + case align of + taLeftJustify: ; + taCenter: + posF.Offset( -TopRight*(1/(2*sizeFactor)) ); + taRightJustify: + posF.Offset( -TopRight*(1/sizeFactor) ); + end; + x := floor(posF.x); + deltaX := round((posF.x - x)*sizeFactor); + y := floor(posF.y); + deltaY := round((posF.y - y)*sizeFactor); + if deltaX <> 0 then inc(rotBounds.Right, sizeFactor); + if deltaY <> 0 then inc(rotBounds.Bottom, sizeFactor); + + {$IFDEF RENDER_TEXT_ON_TBITMAP} + tempLCL := TBitmap.Create; + tempLCL.Width := rotBounds.Right-rotBounds.Left; + tempLCL.Height := rotBounds.Bottom-rotBounds.Top; + BitmapFillRect(tempLCL, Rect(0,0,tempLCL.Width,tempLCL.Height), clBlack); + with tempLCL do begin + {$ELSE} + temp := BGRABitmapFactory.Create(rotBounds.Right-rotBounds.Left,rotBounds.Bottom-rotBounds.Top, BGRABlack); + with temp do begin + {$ENDIF} + Canvas.Font := Font; + Canvas.Font.Color := clWhite; + Canvas.Font.Height := round(Font.Height*sizeFactor); + BitmapTextOutAngle({$IFDEF RENDER_TEXT_ON_TBITMAP}tempLCL{$ELSE}temp.Bitmap{$ENDIF}, + Point(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY), sUTF8, + orientationTenthDegCCW); + end; + {$IFDEF RENDER_TEXT_ON_TBITMAP} + temp := BGRABitmapFactory.create(tempLCL,False); + tempLCL.Free; + {$ENDIF} + + FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale); + BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,0, c,tex); + temp.Free; + grayscale.Free; +end; + +procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single; + sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0); +var + lim: TRect; + tx, ty: integer; + temp: TBGRACustomBitmap; + sizeFactor: integer; + cr: TRect; + grayscale:TGrayscaleMask; + {$IFDEF RENDER_TEXT_ON_TBITMAP} + tempLCL: TBitmap; + {$ENDIF} +begin + if not SystemFontAvailable then exit; + + if CustomAntialiasingLevel = 0 then + CustomAntialiasingLevel:= FontAntialiasingLevel; + + cr := bmp.ClipRect; + if ARect.Left < cr.Left then + lim.Left := cr.Left else lim.Left := ARect.Left; + if ARect.Top < cr.Top then + lim.Top := cr.Top else lim.Top := ARect.Top; + if ARect.Right > cr.Right then + lim.Right := cr.Right else lim.Right := ARect.Right; + if ARect.Bottom > cr.Bottom then + lim.Bottom := cr.Bottom else lim.Bottom := ARect.Bottom; + + tx := lim.Right - lim.Left; + ty := lim.Bottom - lim.Top; + if (tx <= 0) or (ty <= 0) then + exit; + + {$IFDEF SYSTEM_RENDERER_IS_FINE} + if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and + (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then + begin + if Quality = fqFineAntialiasing then Quality := fqSystem; + {$IFDEF SYSTEM_CLEARTYPE_RENDERER_IS_FINE} + if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType; + {$ENDIF} + end; + {$ENDIF} + + if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then + sizeFactor := CustomAntialiasingLevel + else + sizeFactor := 1; + + {$IFDEF RENDER_TEXT_ON_TBITMAP} + tempLCL := TBitmap.Create; + tempLCL.Width := tx*sizeFactor; + tempLCL.Height := ty*sizeFactor; + BitmapFillRect(tempLCL, Rect(0,0,tempLCL.Width,tempLCL.Height), clBlack); + with tempLCL do begin + {$ELSE} + temp := BGRABitmapFactory.Create(tx*sizeFactor, ty*sizeFactor, BGRABlack); + with temp do begin + {$ENDIF} + Canvas.Font := Font; + Canvas.Font.Orientation := 0; + if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then Canvas.Font.Height := Font.Height*CustomAntialiasingLevel + else Canvas.Font.Height := Font.Height; + Canvas.Font.Color := clWhite; + BitmapTextRect({$IFDEF RENDER_TEXT_ON_TBITMAP}tempLCL{$ELSE}temp.Bitmap{$ENDIF}, rect(lim.Left-ARect.Left, lim.Top-ARect.Top, + (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), + Point(round((xf - lim.Left)*sizeFactor), round((yf - lim.Top)*sizeFactor)), + sUTF8, style); + end; + {$IFDEF RENDER_TEXT_ON_TBITMAP} + temp := BGRABitmapFactory.create(tempLCL,False); + tempLCL.Free; + {$ENDIF} + + FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale); + BGRAInternalRenderText(bmp, Quality, grayscale,temp, lim.left,lim.top,0, c,tex); + temp.Free; + grayscale.Free; +end; + +{ TBGRASystemFontRenderer } + +{ Update font properties to internal TFont object } +procedure TBGRASystemFontRenderer.UpdateFont; +var fixedHeight: integer; + fs: TFontStyles; + patchedName: String; +begin + patchedName := PatchSystemFontName(FontName); + if FFont.Name <> patchedName then + FFont.Name := patchedName; + fs := FontStyle; + if (OverrideUnderlineDecoration or (CompareText(Trim(patchedName),'FreeSans')=0) or + (CompareText(Trim(patchedName),'FreeMono')=0) or (CompareText(Trim(patchedName),'FreeSerif')=0)) + and (fsUnderline in fs) then + begin + Exclude(fs, fsUnderline); + FOwnUnderline := true; + end else + FOwnUnderline := false; + if FFont.Style <> fs then + FFont.Style := fs; + if FontEmHeight < 0 then + fixedHeight := FixSystemFontFullHeight(patchedName, FontEmHeight * FontEmHeightSign) + else + fixedHeight := FontEmHeight * FontEmHeightSign; + if FFont.Height <> fixedHeight then + FFont.Height := fixedHeight; + if FontQuality = fqSystemClearType then + FFont.Quality := fqCleartype + else + FFont.Quality := FontDefaultQuality; +end; + +function TBGRASystemFontRenderer.InternalTextSize(sUTF8: string; + AShowPrefix: boolean): TSize; +begin + result := InternalTextSizeAngle(sUTF8, AShowPrefix, FontOrientation); +end; + +function TBGRASystemFontRenderer.InternalTextSizeAngle(sUTF8: string; + AShowPrefix: boolean; AOrientation: integer): TSize; +begin + if AShowPrefix then sUTF8 := RemovePrefix(sUTF8); + result := BGRAText.BGRATextSizeAngle(FFont, AOrientation, FontQuality, + sUTF8, FontAntialiasingLevel); + if (result.cy >= 24) + and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) + and (FontAntialiasingLevel > 4) then + result := BGRAText.BGRATextSizeAngle(FFont, AOrientation, FontQuality, + sUTF8, 4); +end; + +procedure TBGRASystemFontRenderer.SplitText(var ATextUTF8: string; + AMaxWidth: integer; out ARemainsUTF8: string); +var WordBreakHandler: TWordBreakHandler; +begin + UpdateFont; + if Assigned(FWordBreakHandler) then + WordBreakHandler := FWordBreakHandler + else + WordBreakHandler := @DefaultWorkBreakHandler; + + InternalSplitText(ATextUTF8, AMaxWidth, ARemainsUTF8, WordBreakHandler); +end; + +function TBGRASystemFontRenderer.GetFontPixelMetric: TFontPixelMetric; +begin + UpdateFont; + result := InternalGetFontPixelMetric; +end; + +function TBGRASystemFontRenderer.FontExists(AName: string): boolean; +var + i: Integer; +begin + {$IFDEF LCL} + for i := 0 to Screen.Fonts.Count-1 do + if CompareText(Screen.Fonts[i], AName) = 0 then exit(true); + result := false; + {$ELSE} + result := true; + {$ENDIF} +end; + +class function TBGRASystemFontRenderer.PatchSystemFontName(AName: string): string; +begin + if AName = 'serif' then + result := {$IFDEF DARWIN}'Times'{$ELSE}'serif'{$ENDIF} + else if AName = 'monospace' then + result := {$IFDEF DARWIN}'Courier'{$ELSE}{$IFDEF LINUX}'DejaVu Sans Mono'{$ELSE}'monospace'{$ENDIF}{$ENDIF} + else result := AName; +end; + +procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; + sUTF8: string; c: TBGRAPixel; align: TAlignment); +begin + UpdateFont; + InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,nil,align,false,false); +end; + +procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; + align: TAlignment; ARightToLeft: boolean); +begin + UpdateFont; + InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,nil,align,false,ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; + sUTF8: string; texture: IBGRAScanner; align: TAlignment); +begin + UpdateFont; + InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align,false,false); +end; + +procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientationTenthDegCCW: integer; sUTF8: string; + texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); +begin + UpdateFont; + InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align,false,ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; + texture: IBGRAScanner; align: TAlignment); +begin + UpdateFont; + InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align); +end; + +procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; + align: TAlignment); +begin + UpdateFont; + InternalTextOut(ADest, x,y, sUTF8, c,nil, align); +end; + +procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; + ARightToLeft: boolean); +begin + UpdateFont; + InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align, + False, ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; + ARightToLeft: boolean); +begin + UpdateFont; + InternalTextOut(ADest, x,y, sUTF8, c,nil, align, false, ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; + style: TTextStyle; c: TBGRAPixel); +begin + UpdateFont; + InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil); +end; + +procedure TBGRASystemFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; + style: TTextStyle; texture: IBGRAScanner); +begin + UpdateFont; + InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture); +end; + +procedure TBGRASystemFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap; + AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); +begin + UpdateFont; + InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign,ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap; + AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; + AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); +begin + UpdateFont; + InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign,ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.InternalTextWordBreak( + ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer; + AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; + AVertAlign: TTextLayout; ARightToLeft: boolean); +var remains, part, curText,nextText: string; + stepX,stepY: integer; + lines: TStringList; + i: integer; + lineShift: single; + WordBreakHandler: TWordBreakHandler; + lineEndingBreak: boolean; + bidiLayout: TBidiTextLayout; + bidiAlign: TBidiTextAlignment; +begin + if (ATextUTF8 = '') or (AMaxWidth <= 0) then exit; + + if Assigned(FWordBreakHandler) then + WordBreakHandler := FWordBreakHandler + else + WordBreakHandler := @DefaultWorkBreakHandler; + + if ContainsBidiIsolateOrFormattingUTF8(ATextUTF8) or + (pos(UTF8_LINE_SEPARATOR, ATextUTF8) <> 0) then + begin + bidiLayout := TBidiTextLayout.Create(self, ATextUTF8, ARightToLeft); + bidiLayout.WordBreakHandler:= WordBreakHandler; + bidiLayout.AvailableWidth := AMaxWidth; + case AHorizAlign of + taLeftJustify: bidiAlign:= btaLeftJustify; + taRightJustify: begin + bidiAlign:= btaRightJustify; + dec(x, AMaxWidth); + end + else + begin + bidiAlign:= btaCenter; + dec(x, AMaxWidth div 2); + end; + end; + for i := 0 to bidiLayout.ParagraphCount-1 do + bidiLayout.ParagraphAlignment[i] := bidiAlign; + case AVertAlign of + tlBottom: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight); + tlCenter: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight/2); + end; + if ATexture <> nil then bidiLayout.DrawText(ADest, ATexture) + else bidiLayout.DrawText(ADest, AColor); + bidiLayout.Free; + exit; + end; + + stepX := 0; + stepY := TextSize('Hg').cy; + + lines := TStringList.Create; + curText := ATextUTF8; + repeat + InternalSplitText(curText, AMaxWidth, remains, lineEndingBreak, WordBreakHandler); + part := curText; + if not lineEndingBreak then + // append following direction to part + case GetFirstStrongBidiClassUTF8(remains) of + ubcLeftToRight: if ARightToLeft then AppendStr(part, UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK)); + ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then AppendStr(part, UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK)); + end; + lines.Add(part); + // prefix next part with previous direction + nextText := remains; + if not lineEndingBreak then + case GetLastStrongBidiClassUTF8(curText) of + ubcLeftToRight: if ARightToLeft then nextText := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) + nextText; + ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then nextText := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK) + nextText; + end; + curText := nextText; + until remains = ''; + if AVertAlign = tlCenter then lineShift := lines.Count/2 + else if AVertAlign = tlBottom then lineShift := lines.Count + else lineShift := 0; + + dec(X, round(stepX*lineShift)); + dec(Y, round(stepY*lineShift)); + for i := 0 to lines.Count-1 do + begin + InternalTextOut(ADest,x,y,lines[i],AColor,ATexture,AHorizAlign,false,ARightToLeft); + inc(X, stepX); + inc(Y, stepY); + end; + lines.Free; +end; + +procedure TBGRASystemFontRenderer.InternalTextRect(ADest: TBGRACustomBitmap; + ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; + ATexture: IBGRAScanner); +var + oldOrientation: integer; + previousClip, intersected: TRect; + lines: TStringList; + iStart,i,h: integer; + availableWidth: integer; +begin + if sUTF8='' then exit; + previousClip := ADest.ClipRect; + if style.Clipping then + begin + intersected := TRect.Intersect(previousClip, ARect); + if intersected.IsEmpty then exit; + ADest.ClipRect := intersected; + end; + if style.SystemFont then FFont.Name := 'default'; + + if not (style.Alignment in[taCenter,taRightJustify]) then ARect.Left := x; + if not (style.Layout in[tlCenter,tlBottom]) then ARect.top := y; + if (ARect.Right <= ARect.Left) and style.Clipping then + begin + ADest.ClipRect := previousClip; + exit; + end; + if style.Layout = tlCenter then Y := (ARect.Top+ARect.Bottom) div 2 else + if style.Layout = tlBottom then Y := ARect.Bottom else + Y := ARect.Top; + if style.Alignment = taCenter then X := (ARect.Left+ARect.Right) div 2 else + if style.Alignment = taRightJustify then X := ARect.Right else + X := ARect.Left; + oldOrientation := FontOrientation; + FontOrientation := 0; + if style.Wordbreak then + begin + if style.ShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled + InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture, + style.Alignment,style.Layout,style.RightToLeft); + end + else + begin + lines := nil; + iStart := 1; + + if not style.SingleLine then + begin + i := iStart; + while i <= length(sUTF8) do + begin + if sUTF8[i] in[#13,#10] then + begin + if not assigned(lines) then lines := TStringList.Create; + lines.add(copy(sUTF8,iStart,i-iStart)); + if (sUTF8[i]=#13) and (i < length(sUTF8)) and (sUTF8[i+1]=#10) then inc(i); + iStart := i+1 + end; + inc(i); + end; + end; + + if style.Alignment = taLeftJustify then + availableWidth := ARect.Right-X + else + availableWidth := ARect.Right-ARect.Left; + if availableWidth < 0 then availableWidth:= 0; + + if lines = nil then //only one line + begin + if style.Layout = tlCenter then dec(Y, InternalTextSize(sUTF8,style.ShowPrefix).cy div 2); + if style.Layout = tlBottom then dec(Y, InternalTextSize(sUTF8,style.ShowPrefix).cy); + if style.EndEllipsis then + InternalTextOutEllipse(ADest,X,Y,availableWidth,sUTF8,c,ATexture,style.Alignment, + style.ShowPrefix,style.RightToLeft) + else + InternalTextOut(ADest,X,Y,sUTF8,c,ATexture,style.Alignment, + style.ShowPrefix,style.RightToLeft); + end else + begin //multiple lines + lines.add(copy(sUTF8, iStart, length(sUTF8)-iStart+1)); + h := InternalTextSize('Hg',False).cy; + if style.Layout = tlCenter then dec(Y, h*lines.Count div 2); + if style.Layout = tlBottom then dec(Y, h*lines.Count); + for i := 0 to lines.Count-1 do + begin + if style.EndEllipsis then + InternalTextOutEllipse(ADest,X,Y,availableWidth,lines[i],c,ATexture,style.Alignment, + style.ShowPrefix,style.RightToLeft) + else + InternalTextOut(ADest,X,Y,lines[i],c,ATexture,style.Alignment, + style.ShowPrefix,style.RightToLeft); + inc(Y,h); + end; + lines.Free; + end; + + end; + + FontOrientation := oldOrientation; + if style.Clipping then + ADest.ClipRect := previousClip; +end; + +procedure TBGRASystemFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap; x, + y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); +begin + InternalTextOutAngle(ADest, x,y, FontOrientation, sUTF8, c, texture, + align, ASHowPrefix, ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.InternalTextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); +var mode : TBGRATextOutImproveReadabilityMode; + s: TSize; + pts: ArrayOfTPointF; + m: TAffineMatrix; + i: Integer; +begin + if sUTF8='' then exit; + {$IF defined(LINUX) or defined(DARWIN)} + //help LCL detect the correct direction + case GetFirstStrongBidiClassUTF8(sUTF8) of + ubcRightToLeft, ubcArabicLetter: if not ARightToLeft then sUTF8 := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) + sUTF8; + else + begin //suppose left-to-right + if ARightToLeft then sUTF8 := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK) + sUTF8; + end; + end; + {$ENDIF} + if Assigned(BGRATextOutImproveReadabilityProc) and + (FontQuality in[{$IFNDEF SYSTEM_RENDERER_IS_FINE}fqFineAntialiasing,{$ENDIF} + fqFineClearTypeBGR,fqFineClearTypeRGB]) and + (AOrientation mod 3600 = 0) then + begin + case FontQuality of + fqFineClearTypeBGR: mode := irClearTypeBGR; + fqFineClearTypeRGB: mode := irClearTypeRGB; + else + mode := irNormal; + end; + if AShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled + BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,texture,align,mode); + end else + begin + if AOrientation = 0 then + BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,texture,align, + 0,AShowPrefix,ARightToLeft) + else + BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,AOrientation, + sUTF8,c,texture,align,0); + end; + if FOwnUnderline then + begin + s := InternalTextSizeAngle(sUTF8, AShowPrefix, AOrientation); + pts := BGRATextUnderline(PointF(x,y),s.cx,InternalGetFontPixelMetric); + if AOrientation mod 3600 <> 0 then + begin + m := AffineMatrixTranslation(x,y)* + AffineMatrixRotationDeg(-AOrientation/10)* + AffineMatrixTranslation(-x,-y); + for i := 0 to high(pts) do + pts[i] := m*pts[i]; + end; + if texture<>nil then + ADest.FillPolyAntialias(pts, texture, false) + else + ADest.FillPolyAntialias(pts, c, false); + end; +end; + +procedure TBGRASystemFontRenderer.InternalTextOutEllipse( + ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string; + c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; + AShowPrefix: boolean; ARightToLeft: boolean); +var remain: string; +begin + if sUTF8='' then exit; + if InternalTextSize(sUTF8,AShowPrefix).cx > availableWidth then + begin + InternalSplitText(sUTF8, round(availableWidth - InternalTextSize('...',AShowPrefix).cx), remain, nil); + AppendStr(sUTF8, '...'); + end; + InternalTextOut(ADest,x,y,sUTF8,c,texture,align,AShowPrefix,ARightToLeft); +end; + +procedure TBGRASystemFontRenderer.InternalSplitText(var ATextUTF8: string; + AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean; AWordBreak: TWordBreakHandler); +var p,skipCount, charLen: integer; + zeroWidth: boolean; + u: LongWord; +begin + ALineEndingBreak:= false; + if ATextUTF8= '' then + begin + ARemainsUTF8 := ''; + exit; + end; + if RemoveLineEnding(ATextUTF8,1) then + begin + ARemainsUTF8:= ATextUTF8; + ATextUTF8 := ''; + ALineEndingBreak:= true; + exit; + end; + if InternalTextSize(ATextUTF8, false).cx <= AMaxWidth then + begin + for p := 1 to length(ATextUTF8) do + begin + if RemoveLineEnding(ATextUTF8,p) then + begin + ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + ALineEndingBreak:= true; + exit; + end; + end; + ARemainsUTF8 := ''; + exit; + end; + + if AMaxWidth <= 0 then + skipCount := 0 + else + skipCount := BGRATextFitInfo(FFont, FontQuality, ATextUTF8, FontAntialiasingLevel, AMaxWidth); + + if skipCount <= 0 then skipCount := 1; + + p := 1; + zeroWidth := true; + repeat + charLen := UTF8CharacterLength(@ATextUTF8[p]); + u := UTF8CodepointToUnicode(@ATextUTF8[p], charLen); + if not IsZeroWidthUnicode(u) then + zeroWidth:= false; + inc(p, charLen); //UTF8 chars may be more than 1 byte long + dec(skipCount); + + if RemoveLineEnding(ATextUTF8,p) then + begin + ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + ALineEndingBreak:= true; + exit; + end; + until ((skipCount <= 0) and not zeroWidth) or (p >= length(ATextUTF8)+1); + + ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char + if Assigned(AWordBreak) then AWordBreak(ATextUTF8,ARemainsUTF8); +end; + +procedure TBGRASystemFontRenderer.InternalSplitText(var ATextUTF8: string; + AMaxWidth: integer; out ARemainsUTF8: string; AWordBreak: TWordBreakHandler); +var lineEndingBreak: boolean; +begin + InternalSplitText(ATextUTF8,AMaxWidth,ARemainsUTF8,lineEndingBreak,AWordBreak); +end; + +function TBGRASystemFontRenderer.InternalGetFontPixelMetric: TFontPixelMetric; +var fxFont: TFont; +begin + if FontQuality in[fqSystem,fqSystemClearType] then + result := GetLCLFontPixelMetric(FFont) + else + begin + FxFont := TFont.Create; + FxFont.Assign(FFont); + FxFont.Height := fxFont.Height*FontAntialiasingLevel; + Result:= GetLCLFontPixelMetric(FxFont); + if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel); + if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel); + if Result.DescentLine <> -1 then Result.DescentLine:= round((Result.DescentLine-1)/FontAntialiasingLevel); + if Result.Lineheight <> -1 then Result.Lineheight:= round(Result.Lineheight/FontAntialiasingLevel); + if Result.xLine <> -1 then Result.xLine:= round(Result.xLine/FontAntialiasingLevel); + FxFont.Free; + end; +end; + +procedure TBGRASystemFontRenderer.DefaultWorkBreakHandler(var ABeforeUTF8, + AAfterUTF8: string); +begin + BGRADefaultWordBreakHandler(ABeforeUTF8,AAfterUTF8); +end; + +function TBGRASystemFontRenderer.TextSize(sUTF8: string): TSize; +var oldOrientation: integer; +begin + oldOrientation:= FontOrientation; + FontOrientation:= 0; + UpdateFont; + result := InternalTextSize(sUTF8,False); + FontOrientation:= oldOrientation; +end; + +function TBGRASystemFontRenderer.TextSizeAngle(sUTF8: string; + orientationTenthDegCCW: integer): TSize; +var oldOrientation: integer; +begin + oldOrientation:= FontOrientation; + FontOrientation:= orientationTenthDegCCW; + UpdateFont; + result := InternalTextSize(sUTF8,False); + FontOrientation:= oldOrientation; +end; + +function TBGRASystemFontRenderer.TextSize(sUTF8: string; + AMaxWidth: integer; ARightToLeft: boolean): TSize; +var + remains: string; + h, i, w: integer; + WordBreakHandler: TWordBreakHandler; + layout: TBidiTextLayout; +begin + UpdateFont; + + if Assigned(FWordBreakHandler) then + WordBreakHandler := FWordBreakHandler + else + WordBreakHandler := @DefaultWorkBreakHandler; + + if ContainsBidiIsolateOrFormattingUTF8(sUTF8) then + begin + layout := TBidiTextLayout.Create(self, sUTF8, ARightToLeft); + layout.WordBreakHandler:= WordBreakHandler; + layout.AvailableWidth := AMaxWidth; + for i := 0 to layout.ParagraphCount-1 do + layout.ParagraphAlignment[i] := btaLeftJustify; + result.cx := 0; + for i := 0 to layout.PartCount-1 do + begin + w := ceil(layout.PartRectF[i].Right); + if w > result.cx then result.cx := w; + end; + result.cy := ceil(layout.TotalTextHeight); + layout.Free; + end else + begin + result.cx := 0; + result.cy := 0; + h := InternalTextSize('Hg',False).cy; + repeat + InternalSplitText(sUTF8, AMaxWidth, remains, WordBreakHandler); + with InternalTextSize(sUTF8, false) do + if cx > result.cx then result.cx := cx; + inc(result.cy, h); + sUTF8 := remains; + until remains = ''; + end; +end; + +function TBGRASystemFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer + ): integer; +begin + UpdateFont; + result := BGRATextFitInfo(FFont, FontQuality, sUTF8, FontAntialiasingLevel, AMaxWidth); +end; + +constructor TBGRASystemFontRenderer.Create; +begin + FFont := TFont.Create; +end; + +destructor TBGRASystemFontRenderer.Destroy; +begin + FFont.Free; + inherited Destroy; +end; + +initialization + + fqFineClearType := @GetFineClearTypeAuto; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgratextbidi.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgratextbidi.pas new file mode 100644 index 0000000..774d506 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgratextbidi.pas @@ -0,0 +1,3487 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRATextBidi; + +{$mode objfpc}{$H+} +{$MODESWITCH ADVANCEDRECORDS} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRAUTF8, BGRAUnicode, BGRATransform, + BGRAUnicodeText; + +type + TBrokenLinesChangedEvent = procedure(ASender: TObject; AParagraphIndex: integer; + ASubBrokenStart, ASubBrokenChangedCountBefore, ASubBrokenChangedCountAfter: integer; + ASubBrokenTotalCountBefore, ASubBrokenTotalCountAfter: integer) of object; + TParagraphLayoutSplitEvent = procedure(ASender: TObject; AParagraphIndex: integer; + ASubBrokenIndex, ACharIndex: integer) of object; + + { TBidiCaretPos } + + TBidiCaretPos = record + PartIndex: integer; + + Top, Bottom: TPointF; + RightToLeft: boolean; + + PreviousTop, PreviousBottom: TPointF; + PreviousRightToLeft: boolean; + + procedure Transform(AMatrix: TAffineMatrix); + end; + + PPartInfo = ^TPartInfo; + + { TPartInfo } + + TPartInfo = record + brokenLineIndex: integer; + startIndex, endIndex: integer; + bidiLevel: byte; + modified: bytebool; + rectF: TRectF; + posCorrection: TPointF; + function IsRightToLeft: boolean; + end; + + PBrokenLineInfo = ^TBrokenLineInfo; + + { TBrokenLineInfo } + + TBrokenLineInfo = record + unbrokenLineIndex: integer; + startIndex, endIndex: integer; + bidiLevel: byte; + rectF: TRectF; + usedWidth: single; + firstPartIndex: integer; + parts: array of TPartInfo; + partCount: integer; + function IsRightToLeft: boolean; + end; + + PParagraphInfo = ^TParagraphInfo; + TParagraphInfo = record + alignment: TBidiTextAlignment; + layoutComputed, overflow: boolean; + rectF: TRectF; + firstBrokenLineIndex: integer; + firstPartIndex: integer; + brokenLines: array of TBrokenLineInfo; + brokenLineCount: integer; + end; + + TBidiTextLayout = class; + + { TPartEnumerator } + + TPartEnumerator = record + private + FJustCreated: boolean; + FParagraphIndex: integer; + FBrokenLineIndex: integer; + FPartIndex: integer; + FLayout: TBidiTextLayout; + FSubBrokenIndex: integer; + FSubBrokenCount: integer; + FCurBroken: PBrokenLineInfo; + FSubPartIndex: integer; + FSubPartCount: integer; + FEndPartIndex: integer; + function GetPartInfo: PPartInfo; + procedure Update; + public + class function New(ALayout: TBidiTextLayout; AParagraphIndex: integer; + ASubBrokenIndex: integer; ASubPartIndex: integer; AEndPartIndex: integer): TPartEnumerator; static; + function GetNext: boolean; + property Layout: TBidiTextLayout read FLayout; + property ParagraphIndex: integer read FParagraphIndex; + property BrokenLineIndex: integer read FBrokenLineIndex; + property PartIndex: integer read FPartIndex; + property PartInfo: PPartInfo read GetPartInfo; + property BrokenLineInfo: PBrokenLineInfo read FCurBroken; + end; + + { TBidiTextLayout } + + TBidiTextLayout = class + private + FAvailableHeight: single; + FAvailableWidth: single; + FClipMargin: integer; + FOnBrokenLinesChanged: TBrokenLinesChangedEvent; + FOnParagraphChanged: TParagraphEvent; + FOnParagraphDeleted: TParagraphEvent; + FOnParagraphMergedWithNext: TParagraphEvent; + FOnParagraphSplit: TParagraphLayoutSplitEvent; + FOnParagraphVerticalTrimChanged: TParagraphEvent; + FParagraphSpacingAbove: single; + FParagraphSpacingBelow: single; + FTopLeft: TPointF; + FMatrix, FMatrixInverse: TAffineMatrix; + FTabSize: Single; + FWordBreakHandler: TWordBreakHandler; + function GetBrokenLineAffineBox(AIndex: integer): TAffineBox; + function GetBrokenLineCount: integer; + function GetBrokenLineEndCaret(AIndex: integer): TBidiCaretPos; + function GetBrokenLineEndPart(AIndex: integer): integer; + function GetBrokenLineStartPart(AIndex: integer): integer; + function GetBrokenLineUntransformedEndCaret(AIndex: integer): TBidiCaretPos; + function GetBrokenLineEndIndex(AIndex: integer): integer; + function GetBrokenLineParagraphIndex(AIndex: integer): integer; + function GetBrokenLineUnbrokenIndex(AIndex: integer): integer; + function GetBrokenLineInfo(AIndex: integer): PBrokenLineInfo; + function GetBrokenLineRectF(AIndex: integer): TRectF; + function GetBrokenLineRightToLeft(AIndex: integer): boolean; + function GetBrokenLineStartCaret(AIndex: integer): TBidiCaretPos; + function GetBrokenLineUntransformedStartCaret(AIndex: integer): TBidiCaretPos; + function GetBrokenLineStartIndex(AIndex: integer): integer; + function GetBrokenLineUsedWidth(AIndex: integer): single; + function GetCharCount: integer; + function GetFontBidiMode: TFontBidiMode; + function GetLayoutComputed: boolean; + function GetLineHeight: single; + function GetMatrix: TAffineMatrix; + function GetMatrixInverse: TAffineMatrix; + function GetParagraphAffineBox(AIndex: integer): TAffineBox; + function GetParagraphAlignment(AIndex: integer): TBidiTextAlignment; + function GetParagraphCount: integer; + function GetParagraphEndBrokenLine(AIndex: integer): integer; + function GetParagraphEndIndex(AIndex: integer): integer; + function GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; + function GetParagraphEndPart(AIndex: integer): integer; + function GetParagraphInfo(AIndex: integer): PParagraphInfo; + function GetParagraphRectF(AIndex: integer): TRectF; + function GetParagraphRightToLeft(AIndex: integer): boolean; + function GetParagraphStartBrokenLine(AIndex: integer): integer; + function GetParagraphStartIndex(AIndex: integer): integer; + function GetParagraphStartPart(AIndex: integer): integer; + function GetPartAffineBox(AIndex: integer): TAffineBox; + function GetPartBrokenLineIndex(AIndex: integer): integer; + function GetPartCount: integer; + function GetPartEnumerator(AFirstPart: integer): TPartEnumerator; + function GetPartEnumerator(AFirstPart, ALastPartPlus1: integer): TPartEnumerator; + function GetPartInfo(AIndex: integer): PPartInfo; + function GetPartEndIndex(AIndex: integer): integer; + function GetPartRectF(AIndex: integer): TRectF; + function GetPartRightToLeft(AIndex: integer): boolean; + function GetPartStartIndex(AIndex: integer): integer; + function GetText: string; + function GetTotalTextHeight: single; + function GetUnicodeChar(APosition0: integer): LongWord; + function GetUsedWidth: single; + function GetUTF8Char(APosition0: integer): string4; + procedure SetAvailableHeight(AValue: single); + procedure SetAvailableWidth(AValue: single); + procedure SetFontBidiMode(AValue: TFontBidiMode); + procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); + procedure SetParagraphAlignment(AIndex: integer; AValue: TBidiTextAlignment); + procedure SetParagraphSpacingAbove(AValue: single); + procedure SetParagraphSpacingBelow(AValue: single); + procedure SetTabSize(AValue: single); + procedure SetTopLeft(AValue: TPointF); + procedure ComputeMatrix; + protected + FAnalysis: TUnicodeAnalysis; + FRenderer: TBGRACustomFontRenderer; + FLineHeight: single; + + FParagraph: array of TParagraphInfo; + FComputedBrokenLineCount: integer; + FComputedPartCount: integer; + + FColor: TBGRAPixel; + FTexture: IBGRAScanner; + + function TextSizeBidiOverride(sUTF8: string; ARightToLeft: boolean): TPointF; + function TextSizeBidiOverrideSplit(AStartIndex, AEndIndex: integer; ARightToLeft: boolean; ASplitIndex: integer): TPointF; + function TextFitInfoBidiOverride(sUTF8: string; AWidth: single; ARightToLeft: boolean): integer; + function GetFontFullHeight: single; + function GetFontBaseline: single; + function GetFontOrientation: single; + procedure TextOutBidiOverride(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; ARightToLeft: boolean); + procedure TextPathBidiOverride(ADest: IBGRAPath; x, y: single; sUTF8: string; ARightToLeft: boolean); + + procedure AddPart(AStartIndex, AEndIndex: integer; ABidiLevel: byte; ARectF: TRectF; APosCorrection: TPointF; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); + function GetPartStartCaret(APartIndex: integer): TBidiCaretPos; + function GetPartEndCaret(APartIndex: integer): TBidiCaretPos; + function GetUntransformedPartStartCaret(APartIndex: integer): TBidiCaretPos; + function GetUntransformedPartStartCaret(APartIndex: integer; APrevPart, APart: PPartInfo): TBidiCaretPos; + function GetUntransformedPartEndCaret(APartIndex: integer): TBidiCaretPos; + function GetUntransformedPartEndCaret(APartIndex: integer; APart: PPartInfo): TBidiCaretPos; + function GetUntransformedParagraphAt(APosition: TPointF): integer; overload; + + function GetSameLevelString(startIndex,endIndex: integer): string; overload; + function GetSameLevelString(startIndex,endIndex: integer; out nonDiscardedCount: integer): string; overload; + function ComputeBidiTree(AMaxWidth: single; startIndex, endIndex: integer; bidiLevel: byte): TBidiTree; + procedure AddPartsFromTree(APos: TPointF; ATree: TBidiTree; fullHeight, baseLine: single; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); + procedure Init(ATextUTF8: string; ABidiMode: TFontBidiMode); virtual; + procedure ComputeLayout; virtual; + procedure CheckTextLayout; + procedure NeedLayout; + procedure InvalidateParagraphLayout(AParagraphIndex: integer); + procedure InternalInvalidateParagraphLayout(AParagraphIndex: integer); + procedure OffsetParagraph(AParagraphIndex: integer; ADeltaY: single; ADeltaBroken, ADeltaPart: integer); + procedure OffsetParagraphCharIndex(AParagraphIndex: integer; ADeltaChar: integer); + procedure TrimParagraphLayoutVertically(AParagraphIndex: integer); + procedure InternalDrawText(ADest: TBGRACustomBitmap); + procedure InternalPathText(ADest: IBGRAPath); overload; + procedure InternalPathText(ADest: IBGRAPath; AClipRect: TRect); overload; + procedure InternalDrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, ALastPartPlus1: integer); + procedure InternalPathTextParts(ADest: IBGRAPath; AFirstPart, ALastPartPlus1: integer); overload; + procedure InternalPathTextParts(ADest: IBGRAPath; AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); overload; + procedure InternalRangeError; + + //unicode analysis events + procedure BidiModeChanged({%H-}ASender: TObject); + procedure CharDeleted({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); + procedure CharInserted({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); + procedure AnalysisChanged({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); + procedure ParagraphDeleted({%H-}ASender: TObject; AParagraphIndex: integer); + procedure ParagraphMergedWithNext({%H-}ASender: TObject; AParagraphIndex: integer); + procedure ParagraphSplit({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharIndex: integer); + procedure InternalParagraphDeleted(AParagraphIndex: integer); + property LayoutComputed: boolean read GetLayoutComputed; + public + constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string); overload; + constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; ARightToLeft: boolean); overload; + constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; AFontBidiMode: TFontBidiMode); overload; + destructor Destroy; override; + procedure SetLayout(ARect: TRectF); + procedure InvalidateLayout; + procedure ComputeLayoutIfNeeded; + function AddOverrideIfNecessary(var sUTF8: string; ARightToLeft: boolean): boolean; + function GetTextPart(APartIndex: integer; AAddOverrideIfNecessary: boolean): string; + + procedure DrawText(ADest: TBGRACustomBitmap); overload; + procedure DrawText(ADest: TBGRACustomBitmap; AColor: TBGRAPixel); overload; + procedure DrawText(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner); overload; + procedure PathText(ADest: IBGRAPath); + procedure PathText(ADest: IBGRAPath; AClipRect: TRect); + procedure DrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, ALastPartPlus1: integer); overload; + procedure DrawTextParts(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstPart, ALastPartPlus1: integer); overload; + procedure DrawTextParts(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstPart, ALastPartPlus1: integer); overload; + procedure PathTextParts(ADest: IBGRAPath; AFirstPart, ALastPartPlus1: integer); overload; + procedure PathTextParts(ADest: IBGRAPath; AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); overload; + procedure DrawParagraphs(ADest: TBGRACustomBitmap; AFirstPara, ALastParaPlus1: integer); overload; + procedure DrawParagraphs(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstPara, ALastParaPlus1: integer); overload; + procedure DrawParagraphs(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstPara, ALastParaPlus1: integer); overload; + procedure PathParagraphs(ADest: IBGRAPath; AFirstPara, ALastParaPlus1: integer); overload; + procedure PathParagraphs(ADest: IBGRAPath; AClipRect: TRect; AFirstPara, ALastParaPlus1: integer); overload; + procedure DrawBrokenLines(ADest: TBGRACustomBitmap; AFirstBroken, ALastBrokenPlus1: integer); overload; + procedure DrawBrokenLines(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstBroken, ALastBrokenPlus1: integer); overload; + procedure DrawBrokenLines(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstBroken, ALastBrokenPlus1: integer); overload; + procedure PathBrokenLines(ADest: IBGRAPath; AFirstBroken, ALastBrokenPlus1: integer); overload; + procedure PathBrokenLines(ADest: IBGRAPath; AClipRect: TRect; AFirstBroken, ALastBrokenPlus1: integer); overload; + + procedure DrawCaret(ADest: TBGRACustomBitmap; ACharIndex: integer; AMainColor, ASecondaryColor: TBGRAPixel); + procedure DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, AEndIndex: integer; + AFillColor: TBGRAPixel; ABorderColor: TBGRAPixel; APenWidth: single); overload; + procedure DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, AEndIndex: integer; + AFillColor: TBGRAPixel); overload; + + function GetCaret(ACharIndex: integer): TBidiCaretPos; + function GetUntransformedCaret(ACharIndex: integer): TBidiCaretPos; + function GetCharIndexAt(APosition: TPointF): integer; + function GetTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean = true; AMergeBoxes: boolean = true; AVerticalClip: boolean = false): ArrayOfTPointF; + function GetUntransformedTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean = true; AMergeBoxes: boolean = true; AVerticalClip: boolean = false): ArrayOfTPointF; + function GetParagraphAt(ACharIndex: Integer): integer; overload; + function GetParagraphAt(APosition: TPointF): integer; overload; + function GetBrokenLineAt(ACharIndex: integer): integer; + + function InsertText(ATextUTF8: string; APosition: integer): integer; + function InsertLineSeparator(APosition: integer): integer; + function DeleteText(APosition, ACount: integer): integer; + function DeleteTextBefore(APosition, ACount: integer): integer; + function CopyText(APosition, ACount: integer): string; + function CopyTextBefore(APosition, ACount: integer): string; + function IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; + function IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; + function FindTextAbove(AFromPosition: integer): integer; + function FindTextBelow(AFromPosition: integer): integer; + + property CharCount: integer read GetCharCount; + property UTF8Char[APosition0: integer]: string4 read GetUTF8Char; + property UnicodeChar[APosition0: integer]: LongWord read GetUnicodeChar; + + property BrokenLineCount: integer read GetBrokenLineCount; + property BrokenLineParagraphIndex[AIndex: integer]: integer read GetBrokenLineParagraphIndex; + property BrokenLineUnbrokenIndex[AIndex: integer]: integer read GetBrokenLineUnbrokenIndex; + property BrokenLineStartIndex[AIndex: integer]: integer read GetBrokenLineStartIndex; + property BrokenLineEndIndex[AIndex: integer]: integer read GetBrokenLineEndIndex; + property BrokenLineStartPart[AIndex: integer]: integer read GetBrokenLineStartPart; + property BrokenLineEndPart[AIndex: integer]: integer read GetBrokenLineEndPart; + property BrokenLineRectF[AIndex: integer]: TRectF read GetBrokenLineRectF; + property BrokenLineUsedWidth[AIndex: integer]: single read GetBrokenLineUsedWidth; + property BrokenLineAffineBox[AIndex: integer]: TAffineBox read GetBrokenLineAffineBox; + property BrokenLineRightToLeft[AIndex: integer]: boolean read GetBrokenLineRightToLeft; + property BrokenLineStartCaret[AIndex: integer]: TBidiCaretPos read GetBrokenLineStartCaret; + property BrokenLineEndCaret[AIndex: integer]: TBidiCaretPos read GetBrokenLineEndCaret; + property OnBrokenLinesChanged: TBrokenLinesChangedEvent read FOnBrokenLinesChanged write FOnBrokenLinesChanged; + + property PartCount: integer read GetPartCount; + property PartStartIndex[AIndex: integer]: integer read GetPartStartIndex; + property PartEndIndex[AIndex: integer]: integer read GetPartEndIndex; + property PartBrokenLineIndex[AIndex: integer]: integer read GetPartBrokenLineIndex; + property PartStartCaret[AIndex: integer]: TBidiCaretPos read GetPartStartCaret; + property PartEndCaret[AIndex: integer]: TBidiCaretPos read GetPartEndCaret; + property PartRectF[AIndex: integer]: TRectF read GetPartRectF; + property PartAffineBox[AIndex: integer]: TAffineBox read GetPartAffineBox; + property PartRightToLeft[AIndex: integer]: boolean read GetPartRightToLeft; + + property TopLeft: TPointF read FTopLeft write SetTopLeft; + property AvailableWidth: single read FAvailableWidth write SetAvailableWidth; + property AvailableHeight: single read FAvailableHeight write SetAvailableHeight; + property TabSize: single read FTabSize write SetTabSize; + property ParagraphSpacingAbove: single read FParagraphSpacingAbove write SetParagraphSpacingAbove; + property ParagraphSpacingBelow: single read FParagraphSpacingBelow write SetParagraphSpacingBelow; + property ParagraphRectF[AIndex: integer]: TRectF read GetParagraphRectF; + property ParagraphAffineBox[AIndex: integer]: TAffineBox read GetParagraphAffineBox; + property ParagraphAlignment[AIndex: integer]: TBidiTextAlignment read GetParagraphAlignment write SetParagraphAlignment; + property ParagraphStartIndex[AIndex: integer]: integer read GetParagraphStartIndex; + property ParagraphEndIndex[AIndex: integer]: integer read GetParagraphEndIndex; + property ParagraphEndIndexBeforeParagraphSeparator[AIndex: integer]: integer read GetParagraphEndIndexBeforeParagraphSeparator; + property ParagraphRightToLeft[AIndex: integer]: boolean read GetParagraphRightToLeft; + property ParagraphStartPart[AIndex: integer]: integer read GetParagraphStartPart; + property ParagraphEndPart[AIndex: integer]: integer read GetParagraphEndPart; + property ParagraphStartBrokenLine[AIndex: integer]: integer read GetParagraphStartBrokenLine; + property ParagraphEndBrokenLine[AIndex: integer]: integer read GetParagraphEndBrokenLine; + property ParagraphCount: integer read GetParagraphCount; + property OnParagraphDeleted : TParagraphEvent read FOnParagraphDeleted write FOnParagraphDeleted; + property OnParagraphMergedWithNext: TParagraphEvent read FOnParagraphMergedWithNext write FOnParagraphMergedWithNext; + property OnParagraphSplit: TParagraphLayoutSplitEvent read FOnParagraphSplit write FOnParagraphSplit; + property OnParagraphChanged: TParagraphEvent read FOnParagraphChanged write FOnParagraphChanged; + property OnParagraphVerticalTrimChanged: TParagraphEvent read FOnParagraphVerticalTrimChanged write FOnParagraphVerticalTrimChanged; + + property UsedWidth: single read GetUsedWidth; + property TotalTextHeight: single read GetTotalTextHeight; + property LineHeight: single read GetLineHeight; + + property Matrix: TAffineMatrix read GetMatrix; + property MatrixInverse: TAffineMatrix read GetMatrixInverse; + property TextUTF8: string read GetText; + property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; + property ClipMargin: integer read FClipMargin write FClipMargin; // how many pixels can the text go outside of its box + + property FontRenderer: TBGRACustomFontRenderer read FRenderer write SetFontRenderer; + property FontBidiMode: TFontBidiMode read GetFontBidiMode write SetFontBidiMode; + end; + + { TBidiLayoutTree } + + TBidiLayoutTree = class(TBidiTree) + private + FBidiPos: single; + FSize: TPointF; + FTextUTF8: string; + FNonDiscardedCount: integer; + FLayout: TBidiTextLayout; + FMaxWidth: single; + function GetCumulatedBidiPos: single; + function GetHeight: single; + function GetLayout: TBidiTextLayout; + function GetMaxWidth: single; + function GetWidth: single; + procedure UpdateBranchSize; + public + constructor Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); override; + procedure AddBranch(ABranch: TBidiTree); override; + procedure Shorten(AEndIndex: integer); override; + procedure AfterFinish; override; + function TrySplit: boolean; override; + property Layout: TBidiTextLayout read GetLayout; + property MaxWidth: single read GetMaxWidth; + property BidiPos: single read FBidiPos; + property CumulatedBidiPos: single read GetCumulatedBidiPos; + property Width: single read GetWidth; + property Height: single read GetHeight; + end; + + TBidiLayoutTreeData = record + Layout: TBidiTextLayout; + MaxWidth: single; + end; + +implementation + +uses math; + +{ TPartEnumerator } + +function TPartEnumerator.GetPartInfo: PPartInfo; +begin + if FSubPartIndex < FSubPartCount then + result := @FCurBroken^.parts[FSubPartIndex] + else + result := nil; +end; + +procedure TPartEnumerator.Update; +begin + with FLayout.FParagraph[FParagraphIndex] do + begin + FSubBrokenCount:= brokenLineCount; + FBrokenLineIndex:= FSubBrokenIndex + firstBrokenLineIndex; + if FSubBrokenIndex < brokenLineCount then + begin + FCurBroken := @brokenLines[FSubBrokenIndex]; + with FCurBroken^ do + begin + FSubPartCount:= partCount; + FPartIndex:= FSubPartIndex + firstPartIndex; + end; + end else + begin + FCurBroken := nil; + FSubPartCount:= 0; + if brokenLineCount > 0 then + FPartIndex := brokenLines[brokenLineCount-1].firstPartIndex + + brokenLines[brokenLineCount-1].partCount + else + FPartIndex := firstPartIndex; + end; + end; +end; + +class function TPartEnumerator.New(ALayout: TBidiTextLayout; + AParagraphIndex: integer; ASubBrokenIndex: integer; ASubPartIndex: integer; + AEndPartIndex: integer): TPartEnumerator; +begin + result.FLayout := ALayout; + result.FParagraphIndex:= AParagraphIndex; + result.FSubBrokenIndex:= ASubBrokenIndex; + result.FSubPartIndex:= ASubPartIndex; + result.Update; + result.FJustCreated:= true; + result.FEndPartIndex:= AEndPartIndex; +end; + +function TPartEnumerator.GetNext: boolean; +begin + if FPartIndex >= FEndPartIndex then exit(false); + if FJustCreated then + begin + FJustCreated := false; + result := (FSubPartIndex < FSubPartCount) and (FPartIndex < FEndPartIndex); + exit; + end; + if FSubPartIndex + 1 >= FSubPartCount then + begin + if FSubBrokenIndex + 1 >= FSubBrokenCount then + begin + if (FParagraphIndex + 1 >= FLayout.ParagraphCount) or + (FLayout.FParagraph[FParagraphIndex + 1].brokenLineCount = 0) then + exit(false) else + begin + inc(FPartIndex); + inc(FParagraphIndex); + FSubBrokenIndex:= 0; + FSubPartIndex:= 0; + Update; + end; + end else + begin + inc(FPartIndex); + inc(FSubBrokenIndex); + inc(FBrokenLineIndex); + FSubPartIndex:= 0; + with FLayout.FParagraph[FParagraphIndex] do + begin + FCurBroken := @brokenLines[FSubBrokenIndex]; + with FCurBroken^ do + begin + FSubPartCount:= partCount; + FPartIndex:= FSubPartIndex + firstPartIndex; + end; + end; + end; + end else + begin + inc(FPartIndex); + inc(FSubPartIndex); + end; + result := FPartIndex < FEndPartIndex; +end; + +{ TPartInfo } + +function TPartInfo.IsRightToLeft: boolean; +begin + result := odd(bidiLevel); +end; + +{ TBrokenLineInfo } + +function TBrokenLineInfo.IsRightToLeft: boolean; +begin + result := odd(bidiLevel); +end; + +{ TBidiLayoutTree } + +function TBidiLayoutTree.GetLayout: TBidiTextLayout; +begin + result := FLayout; +end; + +function TBidiLayoutTree.GetHeight: single; +begin + result := FSize.y; +end; + +function TBidiLayoutTree.GetCumulatedBidiPos: single; +begin + result := BidiPos; + if Assigned(Parent) then + IncF(result, TBidiLayoutTree(Parent).CumulatedBidiPos); +end; + +function TBidiLayoutTree.GetMaxWidth: single; +begin + result := FMaxWidth; +end; + +function TBidiLayoutTree.GetWidth: single; +begin + result := FSize.x; +end; + +procedure TBidiLayoutTree.UpdateBranchSize; +var + i: Integer; + last: TBidiLayoutTree; +begin + if not IsLeaf then + begin + //write('Update branch size from ', round(FSize.x)); + if Count = 0 then + begin + FSize := PointF(0,0) + end + else + begin + last := TBidiLayoutTree(Branch[Count-1]); + FSize.x := last.BidiPos + last.Width; + FSize.y := 0; + for i := 0 to Count-1 do + FSize.y := max(FSize.y, TBidiLayoutTree(Branch[i]).Height); + end; + //writeln(' to ', round(FSize.x), ' (',inttostr(Count),')'); + end; +end; + +constructor TBidiLayoutTree.Create(AData: pointer; AStartIndex, + AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); +begin + inherited Create(AData, AStartIndex, AEndIndex, ABidiLevel, AIsLeaf); + FLayout := TBidiLayoutTreeData(AData^).Layout; + FMaxWidth := TBidiLayoutTreeData(AData^).MaxWidth; + if IsLeaf then + begin + FTextUTF8:= Layout.GetSameLevelString(StartIndex,EndIndex, FNonDiscardedCount); + FSize := Layout.TextSizeBidiOverride(FTextUTF8, IsRightToLeft); + //writeln('Created leaf ', round(FSize.x), ' of level ',BidiLevel); + end + else + begin + //writeln('Created branch of level ',BidiLevel); + FTextUTF8:= ''; + FNonDiscardedCount:= 0; + FSize := PointF(0,0); + end; +end; + +procedure TBidiLayoutTree.AddBranch(ABranch: TBidiTree); +var + prev: TBidiLayoutTree; +begin + inherited AddBranch(ABranch); + if Count > 1 then + begin + prev := TBidiLayoutTree(Branch[Count-2]); + TBidiLayoutTree(ABranch).FBidiPos:= prev.BidiPos + prev.Width; + end; + if (TBidiLayoutTree(ABranch).Width <> 0) or + (TBidiLayoutTree(ABranch).Height <> 0) then + UpdateBranchSize; +end; + +procedure TBidiLayoutTree.Shorten(AEndIndex: integer); +begin + inherited Shorten(AEndIndex); + if IsLeaf then + begin + FTextUTF8:= Layout.GetSameLevelString(StartIndex,EndIndex, FNonDiscardedCount); + FSize := Layout.TextSizeBidiOverride(FTextUTF8, IsRightToLeft); + //writeln('Shortened leaf ', round(FSize.x)); + end else + UpdateBranchSize; +end; + +procedure TBidiLayoutTree.AfterFinish; +begin + if Assigned(Parent) then + TBidiLayoutTree(Parent).UpdateBranchSize; +end; + +function TBidiLayoutTree.TrySplit: boolean; +var + fitInfo, splitIndex: Integer; + a: TUnicodeAnalysis; + remain: Single; +begin + if not IsLeaf then exit(false); + if MaxWidth = EmptySingle then exit(false); + remain := MaxWidth - CumulatedBidiPos; + if Width > remain then + begin + fitInfo := Layout.TextFitInfoBidiOverride(FTextUTF8, remain, IsRightToLeft); + if fitInfo < FNonDiscardedCount then + begin + //writeln('Splitting leaf ',round(Width), ' (max ',round(remain),')'); + splitIndex:= StartIndex; + a:= Layout.FAnalysis; + while fitInfo > 0 do + begin + while (splitIndex < EndIndex) and a.BidiInfo[splitIndex].IsDiscardable do + Inc(splitIndex); + if splitIndex < EndIndex then inc(splitIndex); + dec(fitInfo); + end; + Shorten(splitIndex); + TBidiLayoutTree(Parent).UpdateBranchSize; + exit(true); + end; + end; + exit(false); +end; + +{ TBidiCaretPos } + +procedure TBidiCaretPos.Transform(AMatrix: TAffineMatrix); +begin + Top := AMatrix*Top; + Bottom := AMatrix*Bottom; + PreviousTop := AMatrix*PreviousTop; + PreviousBottom := AMatrix*PreviousBottom; +end; + +{ TBidiTextLayout } + +function TBidiTextLayout.GetBrokenLineAffineBox(AIndex: integer): TAffineBox; +begin + result := Matrix*TAffineBox.AffineBox(BrokenLineRectF[AIndex]); +end; + +function TBidiTextLayout.GetBrokenLineCount: integer; +begin + NeedLayout; + result := FComputedBrokenLineCount; +end; + +function TBidiTextLayout.GetBrokenLineEndCaret(AIndex: integer): TBidiCaretPos; +begin + result := GetBrokenLineUntransformedEndCaret(AIndex); + result.Transform(Matrix); +end; + +function TBidiTextLayout.GetBrokenLineEndPart(AIndex: integer): integer; +begin + with GetBrokenLineInfo(AIndex)^ do + result := firstPartIndex + partCount; +end; + +function TBidiTextLayout.GetBrokenLineStartPart(AIndex: integer): integer; +begin + result := GetBrokenLineInfo(AIndex)^.firstPartIndex; +end; + +function TBidiTextLayout.GetBrokenLineUntransformedEndCaret(AIndex: integer): TBidiCaretPos; +begin + with GetBrokenLineInfo(AIndex)^ do + begin + result.Top.y := rectF.Top; + if BrokenLineRightToLeft[AIndex] then + result.Top.x := rectF.Left + else + result.Top.x := rectF.Right; + result.Bottom.y := rectF.Bottom; + result.Bottom.x := result.Top.x; + result.RightToLeft := IsRightToLeft; + result.PartIndex:= -1; + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := result.RightToLeft; + end; +end; + +function TBidiTextLayout.GetBrokenLineEndIndex(AIndex: integer): integer; +begin + result := GetBrokenLineInfo(AIndex)^.endIndex; +end; + +function TBidiTextLayout.GetBrokenLineParagraphIndex(AIndex: integer): integer; +var + ub: Integer; +begin + ub := GetBrokenLineInfo(AIndex)^.unbrokenLineIndex; + result := FAnalysis.UnbrokenLineParagraphIndex[ub]; +end; + +function TBidiTextLayout.GetBrokenLineUnbrokenIndex(AIndex: integer): integer; +begin + result := GetBrokenLineInfo(AIndex)^.unbrokenLineIndex; +end; + +function TBidiTextLayout.GetBrokenLineInfo(AIndex: integer): PBrokenLineInfo; +var + minParaIndex, maxParaIndex, midParaIndex: integer; +begin + NeedLayout; + if (AIndex < 0) or (AIndex >= FComputedBrokenLineCount) then + raise ERangeError.Create('Invalid index'); + minParaIndex := 0; + maxParaIndex := ParagraphCount-1; + result := nil; + repeat + if minParaIndex > maxParaIndex then + InternalRangeError else + if minParaIndex = maxParaIndex then + begin + result := @FParagraph[minParaIndex].brokenLines + [AIndex - FParagraph[minParaIndex].firstBrokenLineIndex]; + exit; + end else + begin + midParaIndex := (minParaIndex + maxParaIndex + 1) shr 1; + if AIndex < FParagraph[midParaIndex].firstBrokenLineIndex then + maxParaIndex := midParaIndex-1 + else + minParaIndex := midParaIndex; + end; + until false; +end; + +function TBidiTextLayout.GetBrokenLineRectF(AIndex: integer): TRectF; +begin + result := GetBrokenLineInfo(AIndex)^.rectF; +end; + +function TBidiTextLayout.GetBrokenLineRightToLeft(AIndex: integer): boolean; +begin + result := GetBrokenLineInfo(AIndex)^.IsRightToLeft; +end; + +function TBidiTextLayout.GetBrokenLineStartCaret(AIndex: integer): TBidiCaretPos; +begin + result := GetBrokenLineUntransformedStartCaret(AIndex); + result.Transform(Matrix); +end; + +function TBidiTextLayout.GetBrokenLineUntransformedStartCaret(AIndex: integer): TBidiCaretPos; +begin + NeedLayout; + with GetBrokenLineInfo(AIndex)^ do + begin + result.Top.y := rectF.Top; + if BrokenLineRightToLeft[AIndex] then + result.Top.x := rectF.Right + else + result.Top.x := rectF.Left; + result.Bottom.y := rectF.Bottom; + result.Bottom.x := result.Top.x; + result.RightToLeft := IsRightToLeft; + result.PartIndex:= -1; + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := result.RightToLeft; + end; +end; + +function TBidiTextLayout.GetBrokenLineStartIndex(AIndex: integer): integer; +begin + result := GetBrokenLineInfo(AIndex)^.startIndex; +end; + +function TBidiTextLayout.GetBrokenLineUsedWidth(AIndex: integer): single; +begin + result := GetBrokenLineInfo(AIndex)^.usedWidth; +end; + +function TBidiTextLayout.GetCharCount: integer; +begin + result := FAnalysis.CharCount; +end; + +function TBidiTextLayout.GetFontBidiMode: TFontBidiMode; +begin + result := FAnalysis.BidiMode; +end; + +function TBidiTextLayout.GetLayoutComputed: boolean; +var + i: Integer; +begin + for i := 0 to ParagraphCount-1 do + if not FParagraph[i].layoutComputed then exit(false); + result := true; +end; + +function TBidiTextLayout.GetLineHeight: single; +begin + NeedLayout; + result := FLineHeight; +end; + +function TBidiTextLayout.GetMatrix: TAffineMatrix; +begin + NeedLayout; + result := FMatrix; +end; + +function TBidiTextLayout.GetMatrixInverse: TAffineMatrix; +begin + NeedLayout; + result := FMatrixInverse; +end; + +function TBidiTextLayout.GetParagraphAffineBox(AIndex: integer): TAffineBox; +begin + result := Matrix*TAffineBox.AffineBox(ParagraphRectF[AIndex]); +end; + +function TBidiTextLayout.GetParagraphAlignment(AIndex: integer): TBidiTextAlignment; +begin + //layout not needed + if (AIndex < 0) or (AIndex >= ParagraphCount) then + raise ERangeError.Create('Invalid index'); + result := FParagraph[AIndex].alignment; +end; + +function TBidiTextLayout.GetParagraphCount: integer; +begin + result := FAnalysis.ParagraphCount; +end; + +function TBidiTextLayout.GetParagraphEndBrokenLine(AIndex: integer): integer; +begin + if AIndex = ParagraphCount-1 then + result := BrokenLineCount + else + result := GetParagraphInfo(AIndex+1)^.firstBrokenLineIndex; +end; + +function TBidiTextLayout.GetParagraphEndIndex(AIndex: integer): integer; +begin + result := FAnalysis.ParagraphEndIndex[AIndex]; +end; + +function TBidiTextLayout.GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; +begin + result := FAnalysis.ParagraphEndIndexBeforeParagraphSeparator[AIndex]; +end; + +function TBidiTextLayout.GetParagraphEndPart(AIndex: integer): integer; +begin + if AIndex = ParagraphCount-1 then + result := PartCount + else + result := GetParagraphInfo(AIndex+1)^.firstPartIndex; +end; + +function TBidiTextLayout.GetParagraphInfo(AIndex: integer): PParagraphInfo; +begin + NeedLayout; + if (AIndex < 0) or (AIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + result := @FParagraph[AIndex]; +end; + +function TBidiTextLayout.GetParagraphRectF(AIndex: integer): TRectF; +begin + result := GetParagraphInfo(AIndex)^.rectF; +end; + +function TBidiTextLayout.GetParagraphRightToLeft(AIndex: integer): boolean; +begin + result := FAnalysis.ParagraphRightToLeft[AIndex]; +end; + +function TBidiTextLayout.GetParagraphStartBrokenLine(AIndex: integer): integer; +begin + result := GetParagraphInfo(AIndex)^.firstBrokenLineIndex; +end; + +function TBidiTextLayout.GetParagraphStartIndex(AIndex: integer): integer; +begin + result := FAnalysis.ParagraphStartIndex[AIndex]; +end; + +function TBidiTextLayout.GetParagraphStartPart(AIndex: integer): integer; +begin + result := GetParagraphInfo(AIndex)^.firstPartIndex; +end; + +function TBidiTextLayout.GetPartAffineBox(AIndex: integer): TAffineBox; +begin + result := Matrix*TAffineBox.AffineBox(PartRectF[AIndex]); +end; + +function TBidiTextLayout.GetPartBrokenLineIndex(AIndex: integer): integer; +begin + result := GetPartInfo(AIndex)^.brokenLineIndex; +end; + +function TBidiTextLayout.GetPartCount: integer; +begin + NeedLayout; + result := FComputedPartCount; +end; + +function TBidiTextLayout.GetPartEnumerator(AFirstPart: integer): TPartEnumerator; +begin + result := GetPartEnumerator(AFirstPart, FComputedPartCount); +end; + +function TBidiTextLayout.GetPartEnumerator(AFirstPart, ALastPartPlus1: integer): TPartEnumerator; +var + minParaIndex,maxParaIndex,midParaIndex: integer; + minBrokenIndex, maxBrokenIndex, midBrokenIndex: Integer; +begin + if (AFirstPart < 0) or (AFirstPart > FComputedPartCount) or + (ALastPartPlus1 < 0) or (ALastPartPlus1 > FComputedPartCount) then + raise ERangeError.Create('Invalid start index'); + minParaIndex:= 0; + maxParaIndex:= ParagraphCount - 1; + repeat + if minParaIndex > maxParaIndex then + InternalRangeError else + if minParaIndex = maxParaIndex then + with FParagraph[minParaIndex] do + begin + if brokenLineCount = 0 then + begin + result := TPartEnumerator.New(self, minParaIndex, 0, 0, ALastPartPlus1); + exit; + end; + minBrokenIndex := 0; + maxBrokenIndex := brokenLineCount-1; + repeat + if minBrokenIndex > maxBrokenIndex then + InternalRangeError else + if minBrokenIndex = maxBrokenIndex then + begin + result := TPartEnumerator.New(self, minParaIndex, minBrokenIndex, + AFirstPart - brokenLines[minBrokenIndex].firstPartIndex, + ALastPartPlus1); + exit; + end else + begin + midBrokenIndex := (minBrokenIndex + maxBrokenIndex + 1) shr 1; + if AFirstPart < brokenLines[midBrokenIndex].firstPartIndex then + maxBrokenIndex := midBrokenIndex-1 + else + minBrokenIndex := midBrokenIndex; + end; + until false; + end else + begin + midParaIndex := (minParaIndex + maxParaIndex + 1) shr 1; + if AFirstPart < FParagraph[midParaIndex].firstPartIndex then + maxParaIndex := midParaIndex-1 + else + minParaIndex := midParaIndex; + end; + until false; +end; + + +function TBidiTextLayout.GetPartInfo(AIndex: integer): PPartInfo; +var + partEnum: TPartEnumerator; +begin + partEnum := GetPartEnumerator(AIndex); + if not partEnum.GetNext then raise ERangeError.Create('Invalid index'); + result := partEnum.PartInfo; +end; + +function TBidiTextLayout.GetPartEndIndex(AIndex: integer): integer; +begin + result := GetPartInfo(AIndex)^.endIndex; +end; + +function TBidiTextLayout.GetPartRectF(AIndex: integer): TRectF; +begin + result := GetPartInfo(AIndex)^.rectF; +end; + +function TBidiTextLayout.GetPartRightToLeft(AIndex: integer): boolean; +begin + result := GetPartInfo(AIndex)^.IsRightToLeft; +end; + +function TBidiTextLayout.GetPartStartIndex(AIndex: integer): integer; +begin + result := GetPartInfo(AIndex)^.startIndex; +end; + +function TBidiTextLayout.GetText: string; +begin + result := FAnalysis.TextUTF8; +end; + +function TBidiTextLayout.GetTotalTextHeight: single; +begin + NeedLayout; + result := FParagraph[ParagraphCount-1].rectF.Bottom - FParagraph[0].rectF.Top; +end; + +function TBidiTextLayout.GetUnicodeChar(APosition0: integer): LongWord; +begin + result := FAnalysis.UnicodeChar[APosition0]; +end; + +function TBidiTextLayout.GetUsedWidth: single; +var + i: Integer; +begin + result := 0; + for i := 0 to BrokenLineCount-1 do + result := max(result, BrokenLineUsedWidth[i]); +end; + +function TBidiTextLayout.GetUTF8Char(APosition0: integer): string4; +begin + result := FAnalysis.UTF8Char[APosition0]; +end; + +procedure TBidiTextLayout.SetAvailableHeight(AValue: single); +var + i: Integer; +begin + if FAvailableHeight=AValue then Exit; + FAvailableHeight:=AValue; + for i := 0 to ParagraphCount-1 do + TrimParagraphLayoutVertically(i); +end; + +procedure TBidiTextLayout.SetAvailableWidth(AValue: single); +begin + if FAvailableWidth=AValue then Exit; + FAvailableWidth:=AValue; + InvalidateLayout; +end; + +procedure TBidiTextLayout.SetFontBidiMode(AValue: TFontBidiMode); +begin + FAnalysis.BidiMode := AValue; +end; + +procedure TBidiTextLayout.SetFontRenderer(AValue: TBGRACustomFontRenderer); +begin + if FRenderer=AValue then Exit; + FRenderer:=AValue; + InvalidateLayout; +end; + +procedure TBidiTextLayout.SetParagraphAlignment(AIndex: integer; + AValue: TBidiTextAlignment); +var + brokenCount: Integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + FParagraph[AIndex].alignment := AValue; + InvalidateParagraphLayout(AIndex); + if Assigned(FOnBrokenLinesChanged) then + begin + brokenCount := FParagraph[AIndex].brokenLineCount; + FOnBrokenLinesChanged(self, AIndex, 0, brokenCount, brokenCount, + brokenCount, brokenCount); + end; +end; + +procedure TBidiTextLayout.SetParagraphSpacingAbove(AValue: single); +begin + if FParagraphSpacingAbove=AValue then Exit; + FParagraphSpacingAbove:=AValue; + InvalidateLayout; +end; + +procedure TBidiTextLayout.SetParagraphSpacingBelow(AValue: single); +begin + if FParagraphSpacingBelow=AValue then Exit; + FParagraphSpacingBelow:=AValue; + InvalidateLayout; +end; + +procedure TBidiTextLayout.SetTabSize(AValue: single); +begin + if FTabSize=AValue then Exit; + FTabSize:=AValue; + InvalidateLayout; +end; + +procedure TBidiTextLayout.SetTopLeft(AValue: TPointF); +begin + if FTopLeft=AValue then Exit; + FTopLeft:=AValue; + if LayoutComputed then ComputeMatrix; +end; + +procedure TBidiTextLayout.ComputeMatrix; +begin + FMatrix := AffineMatrixTranslation(FTopLeft.x, FTopLeft.y)*AffineMatrixRotationDeg(-GetFontOrientation); + FMatrixInverse := AffineMatrixInverse(FMatrix); +end; + +procedure TBidiTextLayout.BidiModeChanged(ASender: TObject); +begin + InvalidateLayout; +end; + +procedure TBidiTextLayout.CharDeleted(ASender: TObject; + AParagraphIndex: integer; ACharStart, ACharCount: integer); +var + i, charEnd, j, partIndex: Integer; + curPart: PPartInfo; +begin + InvalidateParagraphLayout(AParagraphIndex); + charEnd := ACharStart + ACharCount; + with FParagraph[AParagraphIndex] do + begin + for j := 0 to brokenLineCount-1 do + with brokenLines[j] do + begin + // is broken line affected ? + if (startIndex < charEnd) and (endIndex > ACharStart) then + begin + for partIndex := 0 to partCount-1 do + begin + curPart := @parts[partIndex]; + // is part affected ? + if (curPart^.startIndex < charEnd) + or (curPart^.endIndex > ACharStart) then + begin + curPart^.modified := true; + // is part completely deleted ? + if (curPart^.startIndex >= ACharStart) and + (curPart^.endIndex <= charEnd) then + begin + curPart^.startIndex := ACharStart; + curPart^.endIndex := ACharStart; + end else + begin + // part partially deleted + if curPart^.startIndex < ACharStart then + curPart^.endIndex := ACharStart + else if curPart^.endIndex > charEnd then + begin + curPart^.startIndex := charEnd - ACharCount; + dec(curPart^.endIndex, ACharCount); + end; + end; + end else + if curPart^.startIndex >= charEnd then // part located after deletion + begin + dec(curPart^.startIndex, ACharCount); + dec(curPart^.endIndex, ACharCount); + end; + end; + dec(endIndex, ACharCount); + end else + if startIndex >= charEnd then // broken line located after deletion + begin + dec(startIndex, ACharCount); + dec(endIndex, ACharCount); + for partIndex := 0 to partCount-1 do + begin + curPart := @parts[partIndex]; + dec(curPart^.startIndex, ACharCount); + dec(curPart^.endIndex, ACharCount); + end; + end; + end; + end; + for i := AParagraphIndex + 1 to high(FParagraph) do + OffsetParagraphCharIndex(i, -ACharCount); +end; + +function TBidiTextLayout.TextSizeBidiOverride(sUTF8: string; + ARightToLeft: boolean): TPointF; +begin + AddOverrideIfNecessary(sUTF8, ARightToLeft); + result := FRenderer.TextSizeAngleF(sUTF8, FRenderer.FontOrientation); +end; + +procedure TBidiTextLayout.ParagraphSplit(ASender: TObject; + AParagraphIndex: integer; ACharIndex: integer); +var + i, j, subBrokenIndex, brokenMoveCount: Integer; + curPara, nextPara: PParagraphInfo; +begin + if (AParagraphIndex < 0) or (AParagraphIndex > high(FParagraph)) then + raise exception.Create('Paragrah index out of bounds (0 <= '+inttostr(AParagraphIndex)+' <= '+inttostr(high(FParagraph))+')'); + + setlength(FParagraph, length(FParagraph)+1); + for i := high(FParagraph) downto AParagraphIndex+2 do + FParagraph[i] := FParagraph[i-1]; + + curPara := @FParagraph[AParagraphIndex]; + nextPara := @FParagraph[AParagraphIndex+1]; + + subBrokenIndex := curPara^.brokenLineCount; + for j := 0 to curPara^.brokenLineCount-1 do + if (curPara^.brokenLines[j].startIndex <= ACharIndex) and + (curPara^.brokenLines[j].endIndex > ACharIndex) then + begin + subBrokenIndex := j; + break; + end else + if (curPara^.brokenLines[j].startIndex > ACharIndex) then + begin + subBrokenIndex := max(j-1, 0); + break; + end; + brokenMoveCount := curPara^.brokenLineCount - (subBrokenIndex + 1); + if brokenMoveCount < 0 then brokenMoveCount := 0; + + nextPara^.alignment := curPara^.alignment; + nextPara^.layoutComputed := false; + nextPara^.overflow := curPara^.overflow; + nextPara^.rectF := EmptyRectF; + nextPara^.firstBrokenLineIndex:= curPara^.firstBrokenLineIndex + curPara^.brokenLineCount - brokenMoveCount; + if brokenMoveCount > 0 then + nextPara^.firstPartIndex := curPara^.brokenLines[curPara^.brokenLineCount - brokenMoveCount].firstPartIndex + else + begin + if curPara^.brokenLineCount > 0 then + with curPara^.brokenLines[curPara^.brokenLineCount - 1] do + nextPara^.firstPartIndex := firstPartIndex + partCount + else nextPara^.firstPartIndex := curPara^.firstPartIndex; + end; + nextPara^.brokenLineCount:= brokenMoveCount; + setlength(nextPara^.brokenLines, brokenMoveCount); + for j := 0 to brokenMoveCount - 1 do + nextPara^.brokenLines[j] := curPara^.brokenLines[curPara^.brokenLineCount - brokenMoveCount + j]; + dec(curPara^.brokenLineCount, brokenMoveCount); + InternalInvalidateParagraphLayout(AParagraphIndex); + InternalInvalidateParagraphLayout(AParagraphIndex+1); + if Assigned(FOnParagraphSplit) then + FOnParagraphSplit(self, AParagraphIndex, subBrokenIndex, ACharIndex); +end; + +procedure TBidiTextLayout.InternalParagraphDeleted(AParagraphIndex: integer); +var + i, deltaBroken, deltaPart: Integer; + deltaY: Single; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then exit; + deltaY := -FParagraph[AParagraphIndex].rectF.Height; + deltaBroken := -FParagraph[AParagraphIndex].brokenLineCount; + deltaPart := 0; + for i := 0 to FParagraph[AParagraphIndex].brokenLineCount-1 do + dec(deltaPart, FParagraph[AParagraphIndex].brokenLines[i].partCount); + + for i := AParagraphIndex to high(FParagraph)-1 do + begin + FParagraph[i] := FParagraph[i+1]; + OffsetParagraph(i, deltaY, deltaBroken, deltaPart); + end; + setlength(FParagraph, length(FParagraph)-1); + inc(FComputedBrokenLineCount, deltaBroken); + inc(FComputedPartCount, deltaPart); +end; + +procedure TBidiTextLayout.CharInserted(ASender: TObject; + AParagraphIndex: integer; ACharStart, ACharCount: integer); +var + i, j, partIndex: Integer; +begin + InvalidateParagraphLayout(AParagraphIndex); + with FParagraph[AParagraphIndex] do + begin + for j := 0 to brokenLineCount-1 do + with brokenLines[j] do + begin + // is broken line affected + if (ACharStart >= startIndex) and (ACharStart < endIndex) then + begin + for partIndex := 0 to partCount-1 do + with parts[partIndex] do + begin + // is part affected + if (ACharStart > startIndex) and (ACharStart < endIndex) then + begin + modified := true; + inc(endIndex, ACharCount); + end else + if (ACharStart <= startIndex) then // part located after insertion + begin + inc(startIndex, ACharCount); + inc(endIndex, ACharCount); + end; + end; + inc(endIndex, ACharCount); + end else + if (ACharStart <= StartIndex) then // broken line located after insertion + begin + inc(startIndex, ACharCount); + inc(endIndex, ACharCount); + for partIndex := 0 to partCount-1 do + with parts[partIndex] do + begin + inc(startIndex, ACharCount); + inc(endIndex, ACharCount); + end; + end; + end; + end; + for i := AParagraphIndex + 1 to high(FParagraph) do + OffsetParagraphCharIndex(i, ACharCount); +end; + +procedure TBidiTextLayout.AnalysisChanged(ASender: TObject; + AParagraphIndex: integer; ACharStart, ACharCount: integer); +begin + InvalidateParagraphLayout(AParagraphIndex); +end; + +procedure TBidiTextLayout.ParagraphMergedWithNext(ASender: TObject; + AParagraphIndex: integer); +var + i, mergedBrokenLineCount, prevBrokenLineCount: Integer; + curPara: PParagraphInfo; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= high(FParagraph)) then + InternalRangeError; + curPara := @FParagraph[AParagraphIndex]; + prevBrokenLineCount := curPara^.brokenLineCount; + mergedBrokenLineCount := prevBrokenLineCount + FParagraph[AParagraphIndex+1].brokenLineCount; + if length(curPara^.brokenLines) < mergedBrokenLineCount then + setlength(curPara^.brokenLines, mergedBrokenLineCount); + for i := 0 to FParagraph[AParagraphIndex+1].brokenLineCount-1 do + curPara^.brokenLines[prevBrokenLineCount + i] := + FParagraph[AParagraphIndex+1].brokenLines[i]; + curPara^.brokenLineCount := mergedBrokenLineCount; + curPara^.rectF.Bottom:= FParagraph[AParagraphIndex+1].rectF.Bottom; + curPara^.overflow := curPara^.overflow or FParagraph[AParagraphIndex+1].overflow; + for i := AParagraphIndex + 1 to high(FParagraph)-1 do + FParagraph[i] := FParagraph[i+1]; + setlength(FParagraph, length(FParagraph) - 1); + InternalInvalidateParagraphLayout(AParagraphIndex); + if Assigned(FOnParagraphMergedWithNext) then + FOnParagraphMergedWithNext(self, AParagraphIndex); +end; + +procedure TBidiTextLayout.ParagraphDeleted(ASender: TObject; + AParagraphIndex: integer); +begin + InternalParagraphDeleted(AParagraphIndex); + If Assigned(FOnParagraphDeleted) then + FOnParagraphDeleted(self, AParagraphIndex); +end; + +function TBidiTextLayout.TextSizeBidiOverrideSplit(AStartIndex, AEndIndex: integer; + ARightToLeft: boolean; ASplitIndex: integer): TPointF; +var checkIndex: integer; + s: String; +begin + if ASplitIndex <= AStartIndex then + begin + s := FAnalysis.CopyTextUTF8(AStartIndex, AEndIndex-AStartIndex); + result := TextSizeBidiOverride(s, ARightToLeft); + result.x := 0; + exit; + end; + + s := FAnalysis.CopyTextUTF8(AStartIndex, ASplitIndex-AStartIndex); + checkIndex := ASplitIndex-1; + while (checkIndex > AStartIndex) and + FAnalysis.BidiInfo[checkIndex].IsLigatureTransparent do dec(checkIndex); + if (ARightToLeft and FAnalysis.BidiInfo[checkIndex].HasLigatureLeft) or + (not ARightToLeft and FAnalysis.BidiInfo[checkIndex].HasLigatureRight) then + s := s+UnicodeCharToUTF8(UNICODE_ZERO_WIDTH_JOINER); + result := TextSizeBidiOverride(s, ARightToLeft); +end; + +function TBidiTextLayout.TextFitInfoBidiOverride(sUTF8: string; AWidth: single; + ARightToLeft: boolean): integer; +var + over: Boolean; + i: Integer; + p, pStart, pEnd: PChar; + u: LongWord; +begin + if sUTF8 = '' then exit(0); + over := AddOverrideIfNecessary(sUTF8, ARightToLeft); + + result := FRenderer.TextFitInfoF(sUTF8, AWidth); + if over then dec(result); + + //check that position is not a combining mark + pEnd := @sUTF8[length(sUTF8)]; + pStart := @sUTF8[1]; + if over then inc(pStart, UTF8CharacterLength(pStart)); + p := @sUTF8[1]; + for i := 1 to result do + begin + inc(p, UTF8CharacterLength(p)); + if p > pEnd then break; + end; + if p <= pEnd then + begin + while (result > 0) and (p > pStart) do + begin + u := UTF8CodepointToUnicode(p, UTF8CharacterLength(p)); + if GetUnicodeBidiClassEx(u) = ubcCombiningLeftToRight then + begin + dec(p); + while (p >= pStart) and (p^ in[#$80..#$BF]) do dec(p); + dec(result); + end else + break; + end; + end; +end; + +function TBidiTextLayout.GetFontFullHeight: single; +begin + result := FRenderer.TextSizeAngleF('Hg', FRenderer.FontOrientation).y; +end; + +function TBidiTextLayout.GetFontBaseline: single; +begin + result := FRenderer.GetFontPixelMetric.Baseline; +end; + +function TBidiTextLayout.GetFontOrientation: single; +begin + result := FRenderer.FontOrientation*0.1; +end; + +procedure TBidiTextLayout.TextOutBidiOverride(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; ARightToLeft: boolean); +begin + if sUTF8 = #9 then exit; + AddOverrideIfNecessary(sUTF8, ARightToLeft); + + if FTexture <> nil then + FRenderer.TextOut(ADest, x,y, sUTF8, FTexture, taLeftJustify, ARightToLeft) + else + FRenderer.TextOut(ADest, x,y, sUTF8, FColor, taLeftJustify, ARightToLeft); +end; + +procedure TBidiTextLayout.TextPathBidiOverride(ADest: IBGRAPath; x, + y: single; sUTF8: string; ARightToLeft: boolean); +begin + if sUTF8 = #9 then exit; + AddOverrideIfNecessary(sUTF8, ARightToLeft); + + FRenderer.CopyTextPathTo(ADest, x,y, sUTF8, taLeftJustify, ARightToLeft) +end; + +function TBidiTextLayout.AddOverrideIfNecessary(var sUTF8: string; + ARightToLeft: boolean): boolean; +var + p: PChar; + pEnd: Pointer; + add, hasStrong: boolean; + charLen: Integer; + u: LongWord; + curBidi: TUnicodeBidiClass; + isSpacing: boolean; +begin + if sUTF8 = '' then exit(false); + isSpacing:= true; + p := @sUTF8[1]; + pEnd := p + length(sUTF8); + add := false; + hasStrong := false; + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + if (charLen = 0) or (p+charLen > pEnd) then break; + u := UTF8CodepointToUnicode(p, charLen); + curBidi := GetUnicodeBidiClass(u); + if curBidi <> ubcWhiteSpace then isSpacing:= false; + if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then + hasStrong := true; + if (curBidi = ubcLeftToRight) and ARightToLeft then + begin + add := true; + break; + end else + if (curBidi in[ubcRightToLeft,ubcArabicLetter]) and not ARightToLeft then + begin + add := true; + break; + end; + inc(p,charLen); + end; + if not hasStrong and ARightToLeft and not isSpacing then add := true; + if add then + begin + if ARightToLeft then + sUTF8 := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_OVERRIDE)+ sUTF8 + else + sUTF8 := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_OVERRIDE)+ sUTF8; + exit(true); + end + else exit(false); +end; + +function TBidiTextLayout.GetTextPart(APartIndex: integer; + AAddOverrideIfNecessary: boolean): string; +begin + result := FAnalysis.CopyTextUTF8(PartStartIndex[APartIndex], + PartEndIndex[APartIndex] - PartStartIndex[APartIndex]); + if AAddOverrideIfNecessary then + AddOverrideIfNecessary(result, PartRightToLeft[APartIndex]); +end; + +procedure TBidiTextLayout.AddPart(AStartIndex, AEndIndex: integer; + ABidiLevel: byte; ARectF: TRectF; APosCorrection: TPointF; + ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); +begin + if ABrokenLine^.partCount >= length(ABrokenLine^.parts) then + setlength(ABrokenLine^.parts, length(ABrokenLine^.parts)*2+8); + + with ABrokenLine^.parts[ABrokenLine^.partCount] do + begin + startIndex:= AStartIndex; + endIndex:= AEndIndex; + bidiLevel := ABidiLevel; + rectF := ARectF; + posCorrection := APosCorrection; + brokenLineIndex:= ABrokenLineIndex; + modified := false; + end; + inc(ABrokenLine^.partCount) +end; + +function TBidiTextLayout.GetSameLevelString(startIndex, endIndex: integer): string; +var + nonDiscardedCount: integer; +begin + result := GetSameLevelString(startIndex,endIndex,nonDiscardedCount); +end; + +function TBidiTextLayout.GetSameLevelString(startIndex, endIndex: integer; out nonDiscardedCount: integer): string; +begin + result := FAnalysis.CopyTextUTF8DiscardChars(startIndex, endIndex, nonDiscardedCount); +end; + +function TBidiTextLayout.ComputeBidiTree(AMaxWidth: single; startIndex, + endIndex: integer; bidiLevel: byte): TBidiTree; +var + data: TBidiLayoutTreeData; +begin + data.MaxWidth := AMaxWidth; + data.Layout := self; + result := FAnalysis.CreateBidiTree(TBidiLayoutTree, @data, startIndex, endIndex, bidiLevel); +end; + +constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string); +begin + Init(sUTF8, fbmAuto); + FRenderer := AFontRenderer; +end; + +constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; ARightToLeft: boolean); +begin + if ARightToLeft then + Init(sUTF8, fbmRightToLeft) + else + Init(sUTF8, fbmLeftToRight); + FRenderer := AFontRenderer; +end; + +constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; + sUTF8: string; AFontBidiMode: TFontBidiMode); +begin + Init(sUTF8, AFontBidiMode); + FRenderer := AFontRenderer; +end; + +destructor TBidiTextLayout.Destroy; +begin + FAnalysis.Free; + inherited Destroy; +end; + +procedure TBidiTextLayout.SetLayout(ARect: TRectF); +begin + TopLeft := ARect.TopLeft; + AvailableWidth:= ARect.Width; + AvailableHeight:= ARect.Height; +end; + +procedure TBidiTextLayout.InvalidateLayout; +var + i: Integer; +begin + for i := 0 to ParagraphCount-1 do + InvalidateParagraphLayout(i); +end; + +procedure TBidiTextLayout.ComputeLayoutIfNeeded; +begin + if not LayoutComputed then ComputeLayout; +end; + +procedure TBidiTextLayout.InvalidateParagraphLayout(AParagraphIndex: integer); +begin + InternalInvalidateParagraphLayout(AParagraphIndex); + if Assigned(FOnParagraphChanged) then + FOnParagraphChanged(self, AParagraphIndex); +end; + +procedure TBidiTextLayout.InternalInvalidateParagraphLayout( + AParagraphIndex: integer); +begin + if (AParagraphIndex >= 0) and (AParagraphIndex <= high(FParagraph)) then + FParagraph[AParagraphIndex].layoutComputed := false; +end; + +procedure TBidiTextLayout.OffsetParagraph(AParagraphIndex: integer; + ADeltaY: single; ADeltaBroken, ADeltaPart: integer); +var subBrokenIndex: integer; + curBroken: PBrokenLineInfo; + partIndex: integer; +begin + if (ADeltaY = 0) and (ADeltaBroken = 0) and (ADeltaPart = 0) then exit; + with FParagraph[AParagraphIndex] do + begin + rectF.Offset(0, ADeltaY); + inc(firstBrokenLineIndex, ADeltaBroken); + inc(firstPartIndex, ADeltaPart); + for subBrokenIndex := 0 to brokenLineCount-1 do + begin + curBroken := @brokenLines[subBrokenIndex]; + curBroken^.rectF.Offset(0, ADeltaY); + inc(curBroken^.firstPartIndex, ADeltaPart); + for partIndex := 0 to curBroken^.partCount-1 do + with curBroken^.parts[partIndex] do + begin + inc(brokenLineIndex, ADeltaBroken); + rectF.Offset(0, ADeltaY); + end; + end; + if ADeltaY <> 0 then + TrimParagraphLayoutVertically(AParagraphIndex); + end; +end; + +procedure TBidiTextLayout.OffsetParagraphCharIndex(AParagraphIndex: integer; + ADeltaChar: integer); +var + j, k: Integer; +begin + with FParagraph[AParagraphIndex] do + begin + for j := 0 to brokenLineCount-1 do + with brokenLines[j] do + begin + inc(startIndex, ADeltaChar); + inc(endIndex, ADeltaChar); + for k := 0 to partCount-1 do + begin + inc(parts[k].startIndex, ADeltaChar); + inc(parts[k].endIndex, ADeltaChar); + end; + end; + end; +end; + +procedure TBidiTextLayout.TrimParagraphLayoutVertically(AParagraphIndex: integer); +var + subBrokenIndex, nextDeltaBroken, nextDeltaPart, i: Integer; +begin + if (AvailableHeight = EmptySingle) or (AParagraphIndex < 0) or + (AParagraphIndex > high(FParagraph)) then exit; + with FParagraph[AParagraphIndex] do + begin + if not layoutComputed then exit; + if overflow and (rectF.Bottom < AvailableHeight) then + begin + layoutComputed:= false; + if Assigned(FOnParagraphVerticalTrimChanged) then + FOnParagraphVerticalTrimChanged(self, AParagraphIndex); + end else + if (rectF.Bottom > AvailableHeight) then + begin + for subBrokenIndex := 0 to brokenLineCount-1 do + begin + //there must be at least one broken line in the text + if (AParagraphIndex = 0) and (subBrokenIndex = 0) then continue; + if brokenLines[subBrokenIndex].rectF.Top >= AvailableHeight then + begin + nextDeltaBroken := 0; + nextDeltaPart := 0; + for i := subBrokenIndex to brokenLineCount-1 do + begin + dec(nextDeltaBroken); + dec(nextDeltaPart, brokenLines[i].partCount); + end; + brokenLineCount := subBrokenIndex; + for i := AParagraphIndex+1 to ParagraphCount-1 do + OffsetParagraph(i, 0, nextDeltaBroken, nextDeltaPart); + inc(FComputedPartCount, nextDeltaPart); + inc(FComputedBrokenLineCount, nextDeltaBroken); + overflow := true; + if subBrokenIndex > 0 then + rectF.Bottom := brokenLines[subBrokenIndex-1].rectF.Bottom + ParagraphSpacingBelow*FLineHeight + else rectF.Bottom := rectF.Top + ParagraphSpacingAbove*FLineHeight; + if Assigned(FOnParagraphVerticalTrimChanged) then + FOnParagraphVerticalTrimChanged(self, AParagraphIndex); + break; + end; + end; + end; + end; +end; + +procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap); +begin + DrawText(ADest, BGRABlack); +end; + +procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap; AColor: TBGRAPixel); +begin + FColor := AColor; + InternalDrawText(ADest); +end; + +procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap; + ATexture: IBGRAScanner); +begin + FColor := BGRAWhite; + FTexture := ATexture; + InternalDrawText(ADest); + FTexture := nil; +end; + +procedure TBidiTextLayout.PathText(ADest: IBGRAPath); +begin + InternalPathText(ADest); +end; + +procedure TBidiTextLayout.PathText(ADest: IBGRAPath; AClipRect: TRect); +begin + InternalPathText(ADest, AClipRect); +end; + +procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, + ALastPartPlus1: integer); +begin + DrawTextParts(ADest, BGRABlack, AFirstPart, ALastPartPlus1); +end; + +procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; + AColor: TBGRAPixel; AFirstPart, ALastPartPlus1: integer); +begin + FColor := AColor; + InternalDrawTextParts(ADest, AFirstPart, ALastPartPlus1); +end; + +procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; + ATexture: IBGRAScanner; AFirstPart, ALastPartPlus1: integer); +begin + FColor := BGRAWhite; + FTexture := ATexture; + InternalDrawTextParts(ADest, AFirstPart, ALastPartPlus1); + FTexture := nil; +end; + +procedure TBidiTextLayout.PathTextParts(ADest: IBGRAPath; AFirstPart, + ALastPartPlus1: integer); +begin + InternalPathTextParts(ADest, AFirstPart, ALastPartPlus1); +end; + +procedure TBidiTextLayout.PathTextParts(ADest: IBGRAPath; AClipRect: TRect; + AFirstPart, ALastPartPlus1: integer); +begin + InternalPathTextParts(ADest, AClipRect, AFirstPart, ALastPartPlus1); +end; + +procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; + AFirstPara, ALastParaPlus1: integer); +begin + if ALastParaPlus1 <= AFirstPara then exit; + DrawTextParts(ADest, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); +end; + +procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; + AColor: TBGRAPixel; AFirstPara, ALastParaPlus1: integer); +begin + if ALastParaPlus1 <= AFirstPara then exit; + DrawTextParts(ADest, AColor, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); +end; + +procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; + ATexture: IBGRAScanner; AFirstPara, ALastParaPlus1: integer); +begin + if ALastParaPlus1 <= AFirstPara then exit; + DrawTextParts(ADest, ATexture, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); +end; + +procedure TBidiTextLayout.PathParagraphs(ADest: IBGRAPath; AFirstPara, + ALastParaPlus1: integer); +begin + if ALastParaPlus1 <= AFirstPara then exit; + PathTextParts(ADest, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); +end; + +procedure TBidiTextLayout.PathParagraphs(ADest: IBGRAPath; AClipRect: TRect; + AFirstPara, ALastParaPlus1: integer); +begin + if ALastParaPlus1 <= AFirstPara then exit; + PathTextParts(ADest, AClipRect, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); +end; + +procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; + AFirstBroken, ALastBrokenPlus1: integer); +begin + if ALastBrokenPlus1 <= AFirstBroken then exit; + DrawTextParts(ADest, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); +end; + +procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; + AColor: TBGRAPixel; AFirstBroken, ALastBrokenPlus1: integer); +begin + if ALastBrokenPlus1 <= AFirstBroken then exit; + DrawTextParts(ADest, AColor, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); + +end; + +procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; + ATexture: IBGRAScanner; AFirstBroken, ALastBrokenPlus1: integer); +begin + if ALastBrokenPlus1 <= AFirstBroken then exit; + DrawTextParts(ADest, ATexture, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); +end; + +procedure TBidiTextLayout.PathBrokenLines(ADest: IBGRAPath; AFirstBroken, + ALastBrokenPlus1: integer); +begin + if ALastBrokenPlus1 <= AFirstBroken then exit; + PathTextParts(ADest, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); +end; + +procedure TBidiTextLayout.PathBrokenLines(ADest: IBGRAPath; AClipRect: TRect; + AFirstBroken, ALastBrokenPlus1: integer); +begin + if ALastBrokenPlus1 <= AFirstBroken then exit; + PathTextParts(ADest, AClipRect, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); +end; + +procedure TBidiTextLayout.ComputeLayout; +var curLineHeight, baseLine, tabPixelSize: single; + paraIndex, ubIndex, i,j, nextTabIndex, splitIndex: Integer; + curPara: PParagraphInfo; + brokenIndex, partIndex: integer; + curBroken: PBrokenLineInfo; + lineStart, subStart, lineEnd: integer; + paraSpacingAbove, paraSpacingBelow, correctedBaseLine: single; + paraRTL, needNewLine: boolean; + partStr, remainStr: string; + pos: TPointF; + curBidiPos,endBidiPos,nextTabBidiPos, availWidth0, remainWidth: single; + tabSectionStart, tabSectionCount: integer; + tabSection: array of record + startIndex, endIndex: integer; + bidiPos: single; + tree: TBidiLayoutTree; + end; + alignment: TAlignment; + paraBidiLevel: Byte; + r: TRectF; + u: LongWord; + nextTree: TBidiLayoutTree; + oldBrokenLines: array of TBrokenLineInfo; + oldBrokenLineCount: integer; + + procedure AddTabSection(startIndex,endIndex: integer; tree: TBidiLayoutTree); + begin + if tabSectionCount >= length(tabSection) then setlength(tabSection, length(tabSection)*2+4); + tabSection[tabSectionCount].startIndex:= startIndex; + tabSection[tabSectionCount].endIndex:= endIndex; + tabSection[tabSectionCount].bidiPos:= curBidiPos; + tabSection[tabSectionCount].tree := tree; + inc(tabSectionCount); + end; + + procedure StartBrokenLine(ACharStart: integer; ACharEnd: integer; ABidiLevel: byte; AWidth, AHeight: single); + begin + if curPara^.brokenLineCount >= length(curPara^.brokenLines) then + setlength(curPara^.brokenLines, length(curPara^.brokenLines)*2+4); + + curBroken := @curPara^.brokenLines[curPara^.brokenLineCount]; + curBroken^.unbrokenLineIndex := ubIndex; + curBroken^.startIndex:= ACharStart; + curBroken^.endIndex:= ACharEnd; + curBroken^.bidiLevel := ABidiLevel; + curBroken^.firstPartIndex:= partIndex+1; + curBroken^.usedWidth:= AWidth; + + if FAvailableWidth <> EmptySingle then + curBroken^.rectF := RectF(0,pos.y,FAvailableWidth,pos.y+AHeight) + else + begin + case alignment of + taRightJustify: curBroken^.rectF := RectF(-AWidth,pos.y,0,pos.y+AHeight); + taCenter: curBroken^.rectF := RectF(-AWidth*0.5,pos.y,AWidth*0.5,pos.y+AHeight); + else {taLeftJustify} + curBroken^.rectF := RectF(0,pos.y,AWidth,pos.y+AHeight); + end; + end; + + if FAvailableWidth = EmptySingle then + begin + if FParagraph[paraIndex].rectF.Left = EmptySingle then + begin + FParagraph[paraIndex].rectF.Left := curBroken^.rectF.left; + FParagraph[paraIndex].rectF.Right := curBroken^.rectF.Right; + end else + begin + if FParagraph[paraIndex].rectF.Left < curBroken^.rectF.left then + FParagraph[paraIndex].rectF.Left := curBroken^.rectF.left; + if FParagraph[paraIndex].rectF.Right > curBroken^.rectF.Right then + FParagraph[paraIndex].rectF.Right := curBroken^.rectF.Right; + end; + end; + + inc(curPara^.brokenLineCount); + inc(brokenIndex); + end; + + procedure DoneBrokenLine; + begin + inc(partIndex, curBroken^.partCount); + IncF(pos.y, curBroken^.rectF.Height); + end; + + procedure ClearTabSections; + var + i: Integer; + begin + tabSectionCount := 0; + for i := 0 to high(tabSection) do + FreeAndNil(tabSection[i].tree); + end; + + procedure UpdateQuickSearch; + begin + FComputedPartCount:= partIndex + 1; + FComputedBrokenLineCount:= brokenIndex + 1; + end; + + procedure Finished; + begin + ClearTabSections; + UpdateQuickSearch; + CheckTextLayout; + end; + + procedure StartParagraph(AParagraphIndex: integer); + begin + curPara := @FParagraph[AParagraphIndex]; + curPara^.overflow := false; + curPara^.firstBrokenLineIndex:= brokenIndex + 1; + curPara^.firstPartIndex := partIndex + 1; + + oldBrokenLineCount:= curPara^.brokenLineCount; + oldBrokenLines:= curPara^.brokenLines; + curPara^.brokenLines := nil; + curPara^.brokenLineCount:= 0; + + curPara^.rectF.Top := pos.y; + curPara^.rectF.Bottom := pos.y; + if FAvailableWidth <> EmptySingle then + begin + curPara^.rectF.Left := 0; + curPara^.rectF.Right := FAvailableWidth; + end else + begin + curPara^.rectF.Left := EmptySingle; + curPara^.rectF.Right := EmptySingle; + end; + paraRTL := ParagraphRightToLeft[AParagraphIndex]; + if FAvailableWidth <> EmptySingle then + alignment := BidiTextAlignmentToAlignment(curPara^.alignment, paraRTL) + else + alignment := taLeftJustify; + end; + + procedure DoneParagraph(AParagraphIndex: integer); + var + firstBrokenIndex, lastBrokenIndexFromEnd: Integer; + newBroken, oldBroken: PBrokenLineInfo; + + function BrokenDifferent: boolean; + var + i: integer; + oldPart, newPart: PPartInfo; + begin + if (oldBroken^.startIndex <> newBroken^.startIndex) or + (oldBroken^.endIndex <> newBroken^.endIndex) or + (oldBroken^.bidiLevel <> newBroken^.bidiLevel) or + (oldBroken^.partCount <> newBroken^.partCount) then exit(true); + for i := 0 to oldBroken^.partCount-1 do + begin + oldPart := @oldBroken^.parts[i]; + newPart := @newBroken^.parts[i]; + if oldPart^.modified then exit(true); + if (oldPart^.startIndex <> newPart^.startIndex) or + (oldPart^.endIndex <> newPart^.endIndex) or + (oldPart^.bidiLevel <> newPart^.bidiLevel) then exit(true); + end; + result := false; + end; + begin + curPara^.layoutComputed := true; + if Assigned(FOnBrokenLinesChanged) then + begin + firstBrokenIndex := 0; + while (firstBrokenIndex < oldBrokenLineCount) and + (firstBrokenIndex < curPara^.brokenLineCount) do + begin + oldBroken := @oldBrokenLines[firstBrokenIndex]; + newBroken := @curPara^.brokenLines[firstBrokenIndex]; + if BrokenDifferent then break; + inc(firstBrokenIndex); + end; + lastBrokenIndexFromEnd := 0; + while (oldBrokenLineCount - lastBrokenIndexFromEnd - 1 > firstBrokenIndex) and + (curPara^.brokenLineCount - lastBrokenIndexFromEnd - 1 > firstBrokenIndex) do + begin + oldBroken := @oldBrokenLines[oldBrokenLineCount - lastBrokenIndexFromEnd - 1]; + newBroken := @curPara^.brokenLines[curPara^.brokenLineCount - lastBrokenIndexFromEnd - 1]; + if BrokenDifferent then break; + inc(lastBrokenIndexFromEnd); + end; + if Assigned(FOnBrokenLinesChanged) and + ((curPara^.brokenLineCount <> oldBrokenLineCount) or + (firstBrokenIndex < oldBrokenLineCount)) then + begin + FOnBrokenLinesChanged(self, AParagraphIndex, firstBrokenIndex, + oldBrokenLineCount - lastBrokenIndexFromEnd - firstBrokenIndex, + curPara^.brokenLineCount - lastBrokenIndexFromEnd - firstBrokenIndex, + oldBrokenLineCount, curPara^.brokenLineCount); + end; + end; + end; + +begin + FLineHeight:= GetFontFullHeight; + baseLine := GetFontBaseline; + ComputeMatrix; + + paraSpacingAbove := ParagraphSpacingAbove * FLineHeight; + paraSpacingBelow := ParagraphSpacingBelow * FLineHeight; + if FAvailableWidth <> EmptySingle then + availWidth0 := FAvailableWidth + else + availWidth0:= 0; + + tabPixelSize := TabSize*TextSizeBidiOverride(' ',False).x; + tabSection := nil; + pos := PointF(0,0); + brokenIndex := -1; + curBroken:= nil; + partIndex := -1; + + for paraIndex := 0 to ParagraphCount-1 do + begin + curPara := @FParagraph[paraIndex]; + if curPara^.layoutComputed then + begin + OffsetParagraph(paraIndex, pos.y - curPara^.rectF.Top, + brokenIndex+1 - curPara^.firstBrokenLineIndex, + partIndex+1 - curPara^.firstPartIndex); + if curPara^.layoutComputed then + begin + pos.y := FParagraph[paraIndex].rectF.Bottom; + inc(brokenIndex, curPara^.brokenLineCount); + for i := 0 to curPara^.brokenLineCount-1 do + inc(partIndex, curPara^.brokenLines[i].partCount); + continue; + end; + end; + + StartParagraph(paraIndex); + IncF(pos.y, paraSpacingAbove); + curPara^.rectF.Bottom:= pos.y; + + for ubIndex := FAnalysis.ParagraphFirstUnbrokenLine[paraIndex] to FAnalysis.ParagraphLastUnbrokenLinePlusOne[paraIndex]-1 do + begin + if (FAvailableHeight <> EmptySingle) and (pos.y >= FAvailableHeight) and + (ubIndex <> 0) {there must be at least one broken line} then + begin + curPara^.overflow:= true; + curPara^.rectF.Bottom := pos.y; + DoneParagraph(paraIndex); + for i := paraIndex+1 to high(FParagraph) do + begin + StartParagraph(i); + curPara^.overflow:= true; + DoneParagraph(i); + end; + Finished; + exit; + end; + + lineStart := FAnalysis.UnbrokenLineStartIndex[ubIndex]; + lineEnd := FAnalysis.UnbrokenLineEndIndex[ubIndex]; + if lineStart < lineEnd then + paraBidiLevel := FAnalysis.BidiInfo[lineStart].ParagraphBidiLevel + else + paraBidiLevel := 0; + + if lineEnd > lineStart then + begin + u := UnicodeChar[lineEnd-1]; + case u of + UNICODE_LINE_SEPARATOR, UNICODE_PARAGRAPH_SEPARATOR, UNICODE_NEXT_LINE: dec(lineEnd); + 13,10: + begin + dec(lineEnd); + if lineEnd > lineStart then + begin + u := UnicodeChar[lineEnd-1]; + if (u = 13) or (u = 10) then dec(lineEnd); + end; + end; + end; + end; + + subStart := lineStart; + + //empty paragraph + if subStart = lineEnd then + begin + StartBrokenLine(subStart, lineEnd, paraBidiLevel, 0, FLineHeight); + + case alignment of + taRightJustify: pos.x := availWidth0; + taCenter: pos.x := availWidth0*0.5; + else {taLeftJustify} + pos.x := 0; + end; + AddPart(subStart, lineEnd, paraBidiLevel, + RectF(pos.x, curBroken^.rectF.Top, + pos.x, curBroken^.rectF.Bottom), + PointF(0,0), brokenIndex, curBroken); + + DoneBrokenLine; + end else + //break lines + while subStart < lineEnd do + begin + //split into sections according to tabs + ClearTabSections; + curBidiPos := 0; + tabSectionStart := subStart; + tabSectionCount := 0; + curLineHeight := FLineHeight; + + while tabSectionStart < lineEnd do + begin + needNewLine := false; + while (tabSectionStart < lineEnd) and (FAnalysis.UnicodeChar[tabSectionStart] = 9) do + begin + if tabPixelSize = 0 then inc(tabSectionStart) + else + begin + nextTabBidiPos := tabPixelSize* (floor(curBidiPos / tabPixelSize + 1e-6)+1); + if (FAvailableWidth = EmptySingle) or (nextTabBidiPos <= FAvailableWidth) or (tabSectionStart = subStart) then + begin + AddTabSection(tabSectionStart, tabSectionStart+1, nil); + inc(tabSectionStart); + curBidiPos := nextTabBidiPos; + end else + begin + //if tab is last char then go to the end of the line + if tabSectionStart = lineEnd-1 then + begin + AddTabSection(tabSectionStart, lineEnd, nil); + inc(tabSectionStart); + curBidiPos := FAvailableWidth; + needNewLine := true; + break; + end + else //otherwise a new line is needed before the tab + begin + needNewLine := true; + break; + end; + end; + end; + end; + if needNewLine then + begin + splitIndex:= tabSectionStart; + break; + end; + + nextTabIndex := tabSectionStart; + while (nextTabIndex < lineEnd) and (FAnalysis.UnicodeChar[nextTabIndex] <> 9) do inc(nextTabIndex); + if FAvailableWidth = EmptySingle then + remainWidth := EmptySingle + else + remainWidth := FAvailableWidth - curBidiPos; + nextTree := TBidiLayoutTree(ComputeBidiTree(remainWidth, tabSectionStart, nextTabIndex, paraBidiLevel)); + splitIndex := nextTree.EndIndex; + + AddTabSection(tabSectionStart, splitIndex, nextTree); + + if splitIndex < nextTabIndex then + begin + if (tabSectionCount = 1) and (splitIndex = tabSectionStart) then + begin + inc(splitIndex); + while (splitIndex < nextTabIndex) and not FAnalysis.BidiInfo[splitIndex].IsMulticharStart do inc(splitIndex); + end; + partStr := FAnalysis.CopyTextUTF8(tabSectionStart, splitIndex-tabSectionStart); + remainStr := FAnalysis.CopyTextUTF8(splitIndex, nextTabIndex-splitIndex); + if tabSectionCount > 1 then partStr := ' '+partStr; + if Assigned(FWordBreakHandler) then + FWordBreakHandler(partStr, remainStr) + else + BGRADefaultWordBreakHandler(partStr, remainStr); + if tabSectionCount > 1 then delete(partStr,1,1); + + splitIndex:= tabSectionStart + UTF8Length(partStr); + + //section is deleted + if splitIndex = tabSectionStart then + begin + dec(tabSectionCount); + //tabSectionStart stay the same + end + else + begin + //section is extended + if splitIndex > nextTree.EndIndex then + begin + nextTree := TBidiLayoutTree(ComputeBidiTree(EmptySingle, tabSectionStart, splitIndex, paraBidiLevel)); + tabSection[tabSectionCount-1].tree.Free; + tabSection[tabSectionCount-1].tree := nextTree; + end + else + begin //otherwise the section is split + nextTree.Shorten(splitIndex); + tabSection[tabSectionCount-1].endIndex:= splitIndex; + end; + + IncF(curBidiPos, nextTree.Width); + if nextTree.Height > curLineHeight then curLineHeight := nextTree.Height; + + tabSectionStart := splitIndex; + while (tabSectionStart < nextTabIndex) and IsUnicodeSpace(FAnalysis.UnicodeChar[tabSectionStart]) do inc(tabSectionStart); + end; + break; + end else + begin + IncF(curBidiPos, nextTree.Width); + if nextTree.Height > curLineHeight then curLineHeight := nextTree.Height; + tabSectionStart := splitIndex; + end; + end; + + // add broken line info + StartBrokenLine(subStart, splitIndex, paraBidiLevel, curBidiPos, curLineHeight); + + subStart := tabSectionStart; + + case alignment of + taRightJustify: + if paraRTL then + pos.x := availWidth0 + else + pos.x := availWidth0 - curBidiPos; + taCenter: + if paraRTL then + pos.x := (availWidth0 + curBidiPos)*0.5 + else + pos.x := (availWidth0 - curBidiPos)*0.5; + else {taLeftJustify} + if paraRTL then + pos.x := curBidiPos + else + pos.x := 0; + end; + + if FLineHeight <> 0 then + correctedBaseLine := baseLine*curLineHeight/FLineHeight + else + correctedBaseLine:= 0; + + for j := 0 to tabSectionCount-1 do + begin + if not Assigned(tabSection[j].tree) then + begin + if j = tabSectionCount-1 then + endBidiPos:= curBidiPos + else + endBidiPos:= tabSection[j+1].bidiPos; + + if paraRTL then + r := RectF(pos.x-endBidiPos, pos.y, pos.x-tabSection[j].bidiPos, pos.y+curLineHeight) + else + r := RectF(pos.x+tabSection[j].bidiPos, pos.y, pos.x+endBidiPos, pos.y+curLineHeight); + + AddPart(tabSection[j].startIndex, tabSection[j].endIndex, paraBidiLevel, r, PointF(0,0), brokenIndex, curBroken); + end + else + begin + if paraRTL then + AddPartsFromTree(pos - PointF(tabSection[j].bidiPos,0), tabSection[j].tree, curLineHeight, correctedBaseLine, brokenIndex, curBroken) + else + AddPartsFromTree(pos + PointF(tabSection[j].bidiPos,0), tabSection[j].tree, curLineHeight, correctedBaseLine, brokenIndex, curBroken) + end; + end; + + DoneBrokenLine; + if (FAvailableHeight <> EmptySingle) and (pos.y >= FAvailableHeight) then + begin + curPara^.overflow := true; + break; + end; + end; + end; + IncF(pos.y, paraSpacingBelow); + curPara^.rectF.Bottom := pos.y; + DoneParagraph(paraIndex); + end; + Finished; +end; + +procedure TBidiTextLayout.CheckTextLayout; +var + i, charIndex, partIndex, j, k, curBrokenLineEndIndex: Integer; +begin + charIndex := 0; + partIndex := 0; + if length(FParagraph) <> ParagraphCount then + raise exception.Create('Number of paragraph mismatch ' + inttostr(length(FParagraph)) + + '/' + inttostr(ParagraphCount)); + for i := 0 to ParagraphCount-1 do + begin + if not FParagraph[i].layoutComputed then + raise exception.Create('Layout not computed for paragraph ' + inttostr(i)); + if i > 0 then + begin + if FParagraph[i].firstBrokenLineIndex < FParagraph[i-1].firstBrokenLineIndex then + raise exception.Create('Broken index is not ascending'); + if FParagraph[i].firstBrokenLineIndex <> FParagraph[i-1].firstBrokenLineIndex + + FParagraph[i-1].brokenLineCount then + raise exception.Create('Expecting at least one broken line'); + if FParagraph[i].firstPartIndex < FParagraph[i-1].firstPartIndex then + raise exception.Create('Part index is not ascending'); + if FParagraph[i].firstPartIndex <> partIndex then + raise exception.Create('Part index is not consistent between paragraphs'); + end else + begin + if FParagraph[i].firstPartIndex <> 0 then + raise exception.Create('First part index is expected to be 0'); + if FParagraph[i].firstBrokenLineIndex <> 0 then + raise exception.Create('First broken index is expected to be 0'); + if (FParagraph[i].brokenLineCount > 0) and + (FParagraph[i].brokenLines[0].firstPartIndex <> FParagraph[i].firstPartIndex) then + raise exception.Create('Inconsistent part index between paragraph and first broken line'); + end; + with FParagraph[i] do + for j := 0 to brokenLineCount-1 do + begin + if brokenLines[j].firstPartIndex <> partIndex then + raise exception.Create('Inconsistent first part index of broken line (' + + inttostr(brokenLines[j].firstPartIndex) + ' expecting ' + + inttostr(partIndex) + ' for broken line ' + + inttostr(firstBrokenLineIndex + j) + ')'); + inc(partIndex, brokenLines[j].partCount); + if brokenLines[j].startIndex < charIndex then + raise exception.Create('Inconsistent first char index of broken line (' + + inttostr(brokenLines[j].startIndex) + ' expecting at least ' + + inttostr(charIndex) + ' for broken line ' + + inttostr(firstBrokenLineIndex + j) + ' and paragraph ' + inttostr(i) + ')'); + with brokenLines[j] do + begin + curBrokenLineEndIndex := endIndex; + for k := 0 to partCount-1 do + with parts[k] do + begin + if startIndex < charIndex then + raise exception.Create('Inconsistent first char index of part'); + if endIndex > curBrokenLineEndIndex then + raise exception.Create('Last char index of part out of broken line range'); + charIndex := endIndex; + end; + end; + charIndex := brokenLines[j].endIndex; + end; + end; + if charIndex > CharCount then + raise exception.Create('Last char index of broken line out of bounds (' + + inttostr(charIndex)+' > '+inttostr(CharCount) + ')'); +end; + +procedure TBidiTextLayout.NeedLayout; +begin + if not LayoutComputed then ComputeLayout; +end; + +procedure TBidiTextLayout.InternalDrawText(ADest: TBGRACustomBitmap); +begin + InternalDrawTextParts(ADest, 0, PartCount); +end; + +procedure TBidiTextLayout.InternalPathText(ADest: IBGRAPath); +begin + InternalPathTextParts(ADest, 0, PartCount); +end; + +procedure TBidiTextLayout.InternalPathText(ADest: IBGRAPath; AClipRect: TRect); +begin + InternalPathTextParts(ADest, AClipRect, 0, PartCount); +end; + +procedure TBidiTextLayout.InternalDrawTextParts(ADest: TBGRACustomBitmap; + AFirstPart, ALastPartPlus1: integer); +var + part: PPartInfo; + enumPart: TPartEnumerator; + r: TRectF; + b: TRect; + pos: TPointF; +begin + NeedLayout; + enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); + while enumPart.GetNext do begin + part := enumPart.PartInfo; + r := part^.rectF; + DecF(r.Left, LineHeight/2 + FClipMargin); + DecF(r.Top, FClipMargin); + IncF(r.Right, LineHeight/2 + FClipMargin); + IncF(r.Bottom, FClipMargin); + b := (Matrix*TAffineBox.AffineBox(r)).RectBounds; + if not b.IntersectsWith(ADest.ClipRect) then continue; + pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); + TextOutBidiOverride(ADest, pos.x, pos.y, + FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), + part^.IsRightToLeft); + end; +end; + +procedure TBidiTextLayout.InternalPathTextParts(ADest: IBGRAPath; AFirstPart, + ALastPartPlus1: integer); +var + part: PPartInfo; + pos: TPointF; + enumPart: TPartEnumerator; +begin + NeedLayout; + enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); + while enumPart.GetNext do begin + part := enumPart.PartInfo; + pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); + TextPathBidiOverride(ADest, pos.x, pos.y, + FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), + part^.IsRightToLeft); + end; +end; + +procedure TBidiTextLayout.InternalPathTextParts(ADest: IBGRAPath; + AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); +var + part: PPartInfo; + enumPart: TPartEnumerator; + r: TRectF; + b: TRect; + pos: TPointF; +begin + NeedLayout; + enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); + while enumPart.GetNext do begin + part := enumPart.PartInfo; + r := part^.rectF; + DecF(r.Left, LineHeight/2 + FClipMargin); + DecF(r.Top, FClipMargin); + IncF(r.Right, LineHeight/2 + FClipMargin); + IncF(r.Bottom, FClipMargin); + b := (Matrix*TAffineBox.AffineBox(r)).RectBounds; + if not b.IntersectsWith(AClipRect) then continue; + pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); + TextPathBidiOverride(ADest, pos.x, pos.y, + FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), + part^.IsRightToLeft); + end; +end; + +procedure TBidiTextLayout.InternalRangeError; +begin + raise ERangeError.Create('Internal error'); +end; + +procedure TBidiTextLayout.DrawCaret(ADest: TBGRACustomBitmap; + ACharIndex: integer; AMainColor, ASecondaryColor: TBGRAPixel); + + procedure DrawSingleCaret(ATop,ABottom: TPointF; ARightToLeft, AShowDir: boolean; AColor: TBGRAPixel); + var u,v: TPointF; + triSize,len: single; + begin + //hinting depending on orientation + if abs(ATop.x - ABottom.x) < abs(ATop.y - ABottom.y) then + begin + ATop.x := round(ATop.x); + ABottom.x := round(ABottom.x); + end + else + begin + ATop.y := round(ATop.y); + ABottom.y := round(ABottom.y); + end; + u := ABottom-ATop; + len := VectLen(u); + if len > 0 then + begin + u := (1/len)*u; + v := PointF(u.y,-u.x); + if AShowDir then + begin + triSize := len*0.2; + if ARightToLeft then + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - triSize*v, ATop - v + triSize*u, ABottom - v]), AColor, false) + else + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + triSize*v, ATop + triSize*u + v, ABottom + v]), AColor, False) + end + else + begin + if len > 10 then + begin + if ARightToLeft then + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - 2*v, ABottom - 2*v]), AColor, False) + else + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + 2*v, ABottom + 2*v]), AColor, False) + end + else + begin + if ARightToLeft then + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - v, ABottom - v]), AColor, False) + else + ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + v, ABottom + v]), AColor, False) + end; + end; + end else + ADest.DrawPixel(round(ATop.x),round(ATop.y), AColor); + end; + +var + caret: TBidiCaretPos; + showDir: Boolean; +begin + NeedLayout; + + caret := GetCaret(ACharIndex); + showDir := not isEmptyPointF(caret.PreviousTop) and (caret.RightToLeft <> caret.PreviousRightToLeft); + if not isEmptyPointF(caret.Top) then DrawSingleCaret(caret.Top, caret.Bottom, caret.RightToLeft, showDir, AMainColor); + if not isEmptyPointF(caret.PreviousTop) then DrawSingleCaret(caret.PreviousTop, caret.PreviousBottom, caret.PreviousRightToLeft, showDir, ASecondaryColor); +end; + +procedure TBidiTextLayout.DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, + AEndIndex: integer; AFillColor: TBGRAPixel; ABorderColor: TBGRAPixel; APenWidth: single); +var + env: ArrayOfTPointF; +begin + NeedLayout; + + if AStartIndex = AEndIndex then exit; + env := GetTextEnveloppe(AStartIndex,AEndIndex, False, True); + ADest.FillPolyAntialias(env, AFillColor, False); + if (ABorderColor.alpha <> 0) and (APenWidth > 0) then + ADest.DrawPolygonAntialias(env, ABorderColor, APenWidth); +end; + +procedure TBidiTextLayout.DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, + AEndIndex: integer; AFillColor: TBGRAPixel); +begin + DrawSelection(ADest, AStartIndex,AEndIndex, AFillColor, BGRAPixelTransparent, 0); +end; + +function TBidiTextLayout.GetCaret(ACharIndex: integer): TBidiCaretPos; +begin + result := GetUntransformedCaret(ACharIndex); + result.Transform(Matrix); +end; + +function TBidiTextLayout.GetUntransformedCaret(ACharIndex: integer): TBidiCaretPos; +var + i, blIndex, lastPartIndex: Integer; + w: Single; + bl: PBrokenLineInfo; + part: PPartInfo; +begin + NeedLayout; + + if (ACharIndex < 0) or (ACharIndex > CharCount) then + raise ERangeError.Create('Invalid index'); + + if (PartCount > 0) and (ACharIndex >= PartEndIndex[PartCount-1]) then + begin + result := GetUntransformedPartEndCaret(PartCount-1); + exit; + end; + + result.PartIndex := -1; + result.Top := EmptyPointF; + result.Bottom := EmptyPointF; + result.RightToLeft := false; + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := false; + + blIndex := GetBrokenLineAt(ACharIndex); + bl := GetBrokenLineInfo(blIndex); + if blIndex <> -1 then + begin + lastPartIndex := bl^.firstPartIndex + bl^.partCount - 1; + for i := bl^.firstPartIndex to lastPartIndex do + begin + part := @bl^.parts[i - bl^.firstPartIndex]; + if ACharIndex <= part^.startIndex then + begin + result := GetUntransformedPartStartCaret(i); + exit; + end else + if (ACharIndex > part^.startIndex) and (ACharIndex <= part^.endIndex) then + begin + if (i < FComputedPartCount-1) and (ACharIndex = part^.startIndex) then + begin + result := GetUntransformedPartStartCaret(i+1); + exit; + end else + begin + if ACharIndex = part^.endIndex then + begin + result := GetUntransformedPartEndCaret(i); + exit; + end else + begin + w := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, ACharIndex).x; + + if part^.IsRightToLeft then + result.Top := PointF(part^.rectF.Right - w, part^.rectF.Top) + else result.Top := PointF(part^.rectF.Left + w, part^.rectF.Top); + result.Bottom := result.Top + PointF(0, part^.rectF.Height); + + result.RightToLeft := part^.IsRightToLeft; + result.PreviousRightToLeft := result.RightToLeft; + result.PartIndex := i; + end; + exit; + end; + end else + if i = lastPartIndex then + begin + result := GetUntransformedPartEndCaret(i); + exit; + end; + end; + end; + + if ACharIndex = 0 then + begin + result.Top := PointF(0,0); + result.Bottom := PointF(0,FLineHeight); + result.RightToLeft := false; + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := false; + result.PartIndex := 0; + end; +end; + +function TBidiTextLayout.GetCharIndexAt(APosition: TPointF): integer; +var + brokenIndex,j, fit: Integer; + u,u2: LongWord; + axis, origin: TPointF; + len, w, curW, newW: Single; + str: String; + curIndex, newIndex, paraIndex: integer; + untransformedPos: TPointF; + para: PParagraphInfo; + curBroken: PBrokenLineInfo; + part: PPartInfo; + ab: TAffineBox; +begin + NeedLayout; + untransformedPos := FMatrixInverse*APosition; + paraIndex := GetUntransformedParagraphAt(untransformedPos); + para := @FParagraph[paraIndex]; + + if untransformedPos.Y < para^.rectF.Top then + exit(ParagraphStartIndex[paraIndex]); + + if untransformedPos.Y >= para^.rectF.Bottom then + exit(ParagraphEndIndex[paraIndex]); + + for brokenIndex := 0 to para^.brokenLineCount-1 do + begin + curBroken := @para^.brokenLines[brokenIndex]; + if untransformedPos.Y < curBroken^.rectF.Bottom then + begin + if untransformedPos.Y < curBroken^.rectF.Top then + exit(curBroken^.startIndex); + + //before part + if curBroken^.partCount > 0 then + begin + if (curBroken^.IsRightToLeft and (untransformedPos.x >= curBroken^.parts[0].rectF.Right)) or + (not curBroken^.IsRightToLeft and (untransformedPos.x < curBroken^.parts[0].rectF.Left)) then + exit(curBroken^.startIndex) + end; + + for j := 0 to curBroken^.partCount-1 do + begin + part := @curBroken^.parts[j]; + ab := Matrix*TAffineBox.AffineBox(part^.rectF); + if ab.Contains(APosition) then + begin + if part^.IsRightToLeft then + begin + axis := ab.TopLeft - ab.TopRight; + origin := ab.TopRight; + end else + begin + axis := ab.TopRight - ab.TopLeft; + origin := ab.TopLeft; + end; + len := VectLen(axis); + if len > 0 then + begin + w := ((APosition-origin)*axis)/len; + //if there is just one char, it is the whole part + if part^.endIndex = part^.startIndex + 1 then + begin + if w > 0.5*len then + exit(part^.endIndex) + else + exit(part^.startIndex); + end; + + str := FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex); + fit := TextFitInfoBidiOverride(str, w, part^.IsRightToLeft); + curIndex := part^.startIndex+fit; + if curIndex > part^.endIndex then curIndex:= part^.endIndex; + if curIndex = 0 then curW := 0 + else curW := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, curIndex).x; + while (curW < w) and (curIndex < part^.endIndex) do + begin + newIndex := curIndex+1; + while (newIndex < part^.endIndex) and not FAnalysis.BidiInfo[newIndex].IsMulticharStart do inc(newIndex); + newW := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, newIndex).x; + if newW >= w then + begin + if (curW+newW)*0.5 + 1 < w then curIndex := newIndex; + break; + end else + begin + curW := newW; + curIndex := newIndex; + end; + end; + exit(curIndex); + end; + exit(part^.startIndex); + end; + end; + + //after part + result := curBroken^.endIndex; + if result > curBroken^.startIndex then + begin + u := GetUnicodeChar(result-1); + if IsUnicodeParagraphSeparator(u) or (u = UNICODE_LINE_SEPARATOR) then + begin + dec(result); + if (result > curBroken^.startIndex) and (u = 13) or (u = 10) then + begin + u2 := GetUnicodeChar(result-1); + if (u2 <> u) and ((u2 = 13) or (u2 = 10)) then dec(result); + end; + end; + end; + exit; + end; + end; + + exit(ParagraphEndIndexBeforeParagraphSeparator[paraIndex]); +end; + +function TBidiTextLayout.GetTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean; AMergeBoxes: boolean; AVerticalClip: boolean): ArrayOfTPointF; +var + i: Integer; + m: TAffineMatrix; +begin + result := GetUntransformedTextEnveloppe(AStartIndex,AEndIndex,false,AMergeBoxes,AVerticalClip); + if APixelCenteredCoordinates then m := AffineMatrixTranslation(-0.5,0.5)*Matrix else m := Matrix; + for i := 0 to high(result) do + result[i] := m*result[i]; +end; + +function TBidiTextLayout.GetUntransformedTextEnveloppe(AStartIndex, + AEndIndex: integer; APixelCenteredCoordinates: boolean; AMergeBoxes: boolean; AVerticalClip: boolean): ArrayOfTPointF; +var + startCaret, endCaret: TBidiCaretPos; + vertResult: array of record + box: TAffineBox; + joinPrevious: boolean; + end; + + procedure AppendVertResult(ABox: TAffineBox; ARightToLeft: boolean); + begin + if AVerticalClip and (AvailableHeight <> EmptySingle) then + begin + if (ABox.TopLeft.y >= AvailableHeight) or (ABox.TopRight.y >= AvailableHeight) then exit; + if ABox.BottomLeft.y > AvailableHeight then ABox.BottomLeft.y := AvailableHeight; + end; + + if ARightToLeft then + ABox := TAffineBox.AffineBox(ABox.TopRight,ABox.TopLeft,ABox.BottomRight); + + if AMergeBoxes and (vertResult <> nil) and (ABox.TopLeft = vertResult[high(vertResult)].box.BottomLeft) and + (ABox.TopRight = vertResult[high(vertResult)].box.BottomRight) then + vertResult[high(vertResult)].box := + TAffineBox.AffineBox(vertResult[high(vertResult)].box.TopLeft, vertResult[high(vertResult)].box.TopRight, ABox.BottomLeft) + else + begin + setlength(vertResult, length(vertResult)+1); + vertResult[high(vertResult)].box := ABox; + if high(vertResult)>0 then + vertResult[high(vertResult)].joinPrevious:= AMergeBoxes and ((VectLen(ABox.TopLeft-vertResult[high(vertResult)-1].box.BottomLeft)<1e-3) or + (VectLen(ABox.TopRight-vertResult[high(vertResult)-1].box.BottomRight)<1e-3)) + else + vertResult[high(vertResult)].joinPrevious:= false; + end; + end; + + procedure AppendComplexSelection; + var + horizResult: array of TAffineBox; + + procedure AppendHorizResult(AStartTop, AEndTop, AEndBottom, AStartBottom: TPointF; ARightToLeft: boolean); + var + temp: TPointF; + + procedure TryMergeBefore; + begin + while length(horizResult)>=2 do + begin + if (horizResult[high(horizResult)].TopRight = horizResult[high(horizResult)-1].TopLeft) and + (horizResult[high(horizResult)].BottomRight = horizResult[high(horizResult)-1].BottomLeft) then + begin + horizResult[high(horizResult)-1] := TAffineBox.AffineBox(horizResult[high(horizResult)].TopLeft, + horizResult[high(horizResult)-1].TopRight, + horizResult[high(horizResult)].BottomLeft); + setlength(horizResult, length(horizResult)-1); + end else + if (horizResult[high(horizResult)].TopLeft = horizResult[high(horizResult)-1].TopRight) and + (horizResult[high(horizResult)].BottomLeft = horizResult[high(horizResult)-1].BottomRight) then + begin + horizResult[high(horizResult)-1] := TAffineBox.AffineBox(horizResult[high(horizResult)-1].TopLeft, + horizResult[high(horizResult)].TopRight, + horizResult[high(horizResult)-1].BottomLeft); + setlength(horizResult, length(horizResult)-1); + end else + break; + end; + end; + + begin + if ARightToLeft then + begin + temp := AStartTop; + AStartTop := AEndTop; + AEndTop := temp; + + temp := AStartBottom; + AStartBottom := AEndBottom; + AEndBottom := temp; + end; + + if AMergeBoxes and (horizResult <> nil) and (AStartTop = horizResult[high(horizResult)].TopRight) + and (AStartBottom = horizResult[high(horizResult)].BottomRight) then + begin + horizResult[high(horizResult)] := TAffineBox.AffineBox(horizResult[high(horizResult)].TopLeft,AEndTop,horizResult[high(horizResult)].BottomLeft); + TryMergeBefore; + end + else + if AMergeBoxes and (horizResult <> nil) and (AEndTop = horizResult[high(horizResult)].TopLeft) + and (AEndBottom = horizResult[high(horizResult)].BottomLeft) then + begin + horizResult[high(horizResult)] := TAffineBox.AffineBox(AStartTop,horizResult[high(horizResult)].TopRight,AStartBottom); + TryMergeBefore; + end + else + begin + setlength(horizResult, length(horizResult)+1); + horizResult[high(horizResult)] := TAffineBox.AffineBox(AStartTop, AEndTop, AStartBottom); + end; + end; + + procedure FlushHorizResult; + var + idx, j: Integer; + begin + if horizResult <> nil then + begin + AppendVertResult(horizResult[0], false); + if length(horizResult)>1 then //additional boxes are added without vertical join + begin + idx := length(vertResult); + setlength(vertResult, length(vertResult)+length(horizResult)-1); + for j := 1 to high(horizResult) do + begin + vertResult[idx+j-1].box := horizResult[j]; + vertResult[idx+j-1].joinPrevious := false; + end; + end; + horizResult := nil; + end; + end; + + var + curPartStartCaret, curPartEndCaret, + lineStartCaret, lineEndCaret, curPartCaret: TBidiCaretPos; + curBrokenIndex, curParaIndex, prevParaIndex, j, + brokenLineLastPartIndexPlus1, curPartIndex: integer; + r: TRectF; + partEnum: TPartEnumerator; + prevPart, curPart: PPartInfo; + curBroken: PBrokenLineInfo; + + begin + horizResult := nil; + partEnum := GetPartEnumerator(startCaret.PartIndex, endCaret.PartIndex + 1); + curPart := nil; + curParaIndex := -1; + + if partEnum.GetNext then + while true do + begin + prevParaIndex := curParaIndex; + prevPart := curPart; + curParaIndex := partEnum.ParagraphIndex; + curPart := partEnum.PartInfo; + curPartIndex := partEnum.PartIndex; + curBroken := partEnum.BrokenLineInfo; + curBrokenIndex := partEnum.BrokenLineIndex; + + //space between paragraph + if (curPartIndex > startCaret.PartIndex) and (ParagraphSpacingAbove+ParagraphSpacingBelow <> 0) then + begin + if (curParaIndex > 0) and (prevParaIndex = curParaIndex-1) then + begin + FlushHorizResult; + + r := RectF(ParagraphRectF[curParaIndex-1].Left, ParagraphRectF[curParaIndex-1].Bottom - ParagraphSpacingBelow*FLineHeight, + ParagraphRectF[curParaIndex-1].Right, ParagraphRectF[curParaIndex-1].Bottom); + AppendVertResult(TAffineBox.AffineBox(r), False); + + r := RectF(ParagraphRectF[curParaIndex].Left, ParagraphRectF[curParaIndex].Top, + ParagraphRectF[curParaIndex].Right, ParagraphRectF[curParaIndex].Top + ParagraphSpacingAbove*FLineHeight); + AppendVertResult(TAffineBox.AffineBox(r), False); + end; + end; + + //whole broken line selected + brokenLineLastPartIndexPlus1 := curBroken^.firstPartIndex + curBroken^.partCount; + if (curPartIndex = curBroken^.firstPartIndex) and + ((curPartIndex > startCaret.PartIndex) or (AStartIndex = curPart^.startIndex)) and + (endCaret.PartIndex >= brokenLineLastPartIndexPlus1) then + begin + FlushHorizResult; + + lineStartCaret := GetBrokenLineUntransformedStartCaret(curBrokenIndex); + lineEndCaret := GetBrokenLineUntransformedEndCaret(curBrokenIndex); + AppendVertResult(TAffineBox.AffineBox(lineStartCaret.Top,lineEndCaret.Top,lineStartCaret.Bottom), BrokenLineRightToLeft[curBrokenIndex]); + + //skip broken line + for j := curPartIndex to brokenLineLastPartIndexPlus1-2 do + partEnum.GetNext; + if not partEnum.GetNext then break; + end else + begin + if curPartIndex > startCaret.PartIndex then + curPartStartCaret := GetUntransformedPartStartCaret(curPartIndex, prevPart, curPart) + else curPartStartCaret := startCaret; + + if curPartIndex < endCaret.PartIndex then + curPartEndCaret := GetUntransformedPartEndCaret(curPartIndex, curPart) + else curPartEndCaret := endCaret; + + //start of lines + if (curPartIndex > startCaret.PartIndex) and (prevPart^.brokenLineIndex <> curBrokenIndex) then + begin + FlushHorizResult; + + lineStartCaret := GetBrokenLineUntransformedStartCaret(curBrokenIndex); + if curBroken^.IsRightToLeft = curPart^.IsRightToLeft then + AppendHorizResult(lineStartCaret.Top, curPartStartCaret.Top, + curPartStartCaret.Bottom, lineStartCaret.Bottom, + BrokenLineRightToLeft[curBrokenIndex]) + else + AppendHorizResult(lineStartCaret.Top, curPartEndCaret.Top, + curPartEndCaret.Bottom, lineStartCaret.Bottom, + curBroken^.IsRightToLeft); + end; + + //text parts + AppendHorizResult(curPartStartCaret.Top, curPartEndCaret.Top, + curPartEndCaret.Bottom, curPartStartCaret.Bottom, + curPart^.IsRightToLeft); + + //end of lines + if not partEnum.GetNext then break; + + if (partEnum.BrokenLineIndex <> curBrokenIndex) then + begin + lineEndCaret := GetBrokenLineUntransformedEndCaret(curBrokenIndex); + if curBroken^.IsRightToLeft = curPart^.IsRightToLeft then + curPartCaret := GetUntransformedPartEndCaret(curPartIndex) + else + curPartCaret := GetUntransformedPartStartCaret(curPartIndex); + AppendHorizResult(curPartCaret.Top, lineEndCaret.Top, + lineEndCaret.Bottom, curPartCaret.Bottom, curBroken^.IsRightToLeft) + end; + end; + + end; + + FlushHorizResult; + end; + +var + temp: integer; + i,j, idxOut, k: integer; + +begin + NeedLayout; + + vertResult := nil; + + if AStartIndex > AEndIndex then + begin + temp := AStartIndex; + AStartIndex:= AEndIndex; + AEndIndex:= temp; + end; + startCaret := GetUntransformedCaret(AStartIndex); + endCaret := GetUntransformedCaret(AEndIndex); + if not isEmptyPointF(endCaret.PreviousTop) then + begin + endCaret.Top := endCaret.PreviousTop; endCaret.PreviousTop := EmptyPointF; + endCaret.Bottom := endCaret.PreviousBottom; endCaret.PreviousBottom := EmptyPointF; + endCaret.RightToLeft := endCaret.PreviousRightToLeft; + if endCaret.PartIndex <> -1 then dec(endCaret.PartIndex); + end; + + if startCaret.PartIndex = endCaret.PartIndex then + begin + if not isEmptyPointF(startCaret.Top) and not isEmptyPointF(endCaret.Top) then + AppendVertResult(TAffineBox.AffineBox(startCaret.Top,endCaret.Top,startCaret.Bottom), startCaret.RightToLeft); + end else + AppendComplexSelection; + + if APixelCenteredCoordinates then + for i := 0 to high(vertResult) do + vertResult[i].box.Offset(-0.5, -0.5); + + if vertResult <> nil then + begin + setlength(result, length(vertResult)*5 - 1); //maximum point count + idxOut := 0; + i := 0; + while i <= high(vertResult) do + begin + if i > 0 then + begin + result[idxOut] := EmptyPointF; + inc(idxOut); + end; + result[idxOut] := vertResult[i].box.TopLeft; inc(idxOut); + result[idxOut] := vertResult[i].box.TopRight; inc(idxOut); + result[idxOut] := vertResult[i].box.BottomRight; inc(idxOut); + j := i; + while (j CharCount) then raise exception.Create('Position out of bounds'); + paraMinIndex := 0; + paraMaxIndex := ParagraphCount-1; + repeat + if paraMinIndex > paraMaxIndex then + InternalRangeError else + if paraMinIndex = paraMaxIndex then + with FParagraph[paraMinIndex] do + begin + brokenMinIndex := 0; + brokenMaxIndex := brokenLineCount-1; + repeat + if brokenMinIndex > brokenMaxIndex then InternalRangeError else + if brokenMinIndex = brokenMaxIndex then + begin + result := brokenMinIndex + firstBrokenLineIndex; + exit; + end else + begin + brokenMidIndex := (brokenMinIndex + brokenMaxIndex + 1) shr 1; + if ACharIndex < brokenLines[brokenMidIndex].startIndex then + brokenMaxIndex := brokenMidIndex-1 + else brokenMinIndex := brokenMidIndex; + end; + until false; + end else + begin + paraMidIndex := (paraMinIndex + paraMaxIndex + 1) shr 1; + if ACharIndex < ParagraphStartIndex[paraMidIndex] then + paraMaxIndex := paraMidIndex-1 + else paraMinIndex := paraMidIndex; + end; + until false; +end; + +function TBidiTextLayout.InsertText(ATextUTF8: string; APosition: integer): integer; +begin + result := FAnalysis.InsertText(ATextUTF8,APosition); +end; + +function TBidiTextLayout.InsertLineSeparator(APosition: integer): integer; +begin + result := InsertText(UnicodeCharToUTF8(UNICODE_LINE_SEPARATOR), APosition); +end; + +function TBidiTextLayout.DeleteText(APosition, ACount: integer): integer; +begin + result := FAnalysis.DeleteText(APosition, ACount); +end; + +function TBidiTextLayout.DeleteTextBefore(APosition, ACount: integer): integer; +begin + result := FAnalysis.DeleteTextBefore(APosition, ACount); +end; + +function TBidiTextLayout.CopyText(APosition, ACount: integer): string; +begin + ACount := IncludeNonSpacingChars(APosition, ACount); + result := FAnalysis.CopyTextUTF8(APosition, ACount); +end; + +function TBidiTextLayout.CopyTextBefore(APosition, ACount: integer): string; +begin + ACount := IncludeNonSpacingCharsBefore(APosition, ACount); + result := FAnalysis.CopyTextUTF8(APosition-ACount, ACount); +end; + +function TBidiTextLayout.IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; +begin + result := FAnalysis.IncludeNonSpacingChars(APosition,ACount,AIncludeCombiningMarks); +end; + +function TBidiTextLayout.IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; +begin + result := FAnalysis.IncludeNonSpacingCharsBefore(APosition,ACount,AIncludeCombiningMarks); +end; + +function TBidiTextLayout.FindTextAbove(AFromPosition: integer): integer; +var + curPos: TBidiCaretPos; + bIndex: LongInt; + pt: TPointF; +begin + curPos := GetUntransformedCaret(AFromPosition); + bIndex := PartBrokenLineIndex[curPos.PartIndex]; + if (bIndex > 0) and not isEmptyPointF(curPos.Top) then + begin + dec(bIndex); + pt := PointF(curPos.Top.x, (BrokenLineRectF[bIndex].Top+BrokenLineRectF[bIndex].Bottom)*0.5); + result := GetCharIndexAt(Matrix*pt); + end else + exit(-1); +end; + +function TBidiTextLayout.FindTextBelow(AFromPosition: integer): integer; +var + curPos: TBidiCaretPos; + bIndex: LongInt; + pt: TPointF; +begin + curPos := GetUntransformedCaret(AFromPosition); + bIndex := PartBrokenLineIndex[curPos.PartIndex]; + if (bIndex < BrokenLineCount-1) and not isEmptyPointF(curPos.Top) then + begin + inc(bIndex); + pt := PointF(curPos.Top.x, (BrokenLineRectF[bIndex].Top+BrokenLineRectF[bIndex].Bottom)*0.5); + result := GetCharIndexAt(Matrix*pt); + end else + exit(-1); +end; + +function TBidiTextLayout.GetPartStartCaret(APartIndex: integer): TBidiCaretPos; +begin + result := GetUntransformedPartStartCaret(APartIndex); + result.Transform(Matrix) +end; + +function TBidiTextLayout.GetPartEndCaret(APartIndex: integer): TBidiCaretPos; +begin + result := GetUntransformedPartEndCaret(APartIndex); + result.Transform(Matrix); +end; + +function TBidiTextLayout.GetUntransformedPartStartCaret(APartIndex: integer): TBidiCaretPos; +var + prevPart, part: PPartInfo; + partEnum: TPartEnumerator; +begin + if (APartIndex < 0) or (APartIndex > PartCount) then + raise ERangeError.Create('Invalid index'); + + if APartIndex > 0 then + begin + partEnum := GetPartEnumerator(APartIndex - 1); + if not partEnum.GetNext then InternalRangeError; + prevPart := partEnum.PartInfo; + if not partEnum.GetNext then InternalRangeError; + part := partEnum.PartInfo; + end else + begin + prevPart := nil; + part := GetPartInfo(APartIndex); + end; + + result := GetUntransformedPartStartCaret(APartIndex, prevPart, part); +end; + +function TBidiTextLayout.GetUntransformedPartStartCaret(APartIndex: integer; + APrevPart, APart: PPartInfo): TBidiCaretPos; +begin + result.PartIndex := APartIndex; + + if APart^.IsRightToLeft then + result.Top := PointF(APart^.rectF.Right, APart^.rectF.Top) + else + result.Top := PointF(APart^.rectF.Left, APart^.rectF.Top); + result.Bottom := result.Top + PointF(0, APart^.rectF.Height); + + result.RightToLeft := APart^.IsRightToLeft; + + if (APartIndex > 0) and (APrevPart^.endIndex = APart^.startIndex) and + (BrokenLineUnbrokenIndex[APrevPart^.brokenLineIndex] = + BrokenLineUnbrokenIndex[APart^.brokenLineIndex]) then + begin + if APrevPart^.IsRightToLeft then + result.PreviousTop := PointF(APrevPart^.rectF.Left, APrevPart^.rectF.Top) + else + result.PreviousTop := PointF(APrevPart^.rectF.Right, APrevPart^.rectF.Top); + result.PreviousBottom := result.PreviousTop + PointF(0, APrevPart^.rectF.Height); + result.PreviousRightToLeft := APrevPart^.IsRightToLeft; + end else + begin + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := result.RightToLeft; + end; +end; + +function TBidiTextLayout.GetUntransformedPartEndCaret(APartIndex: integer): TBidiCaretPos; +var + part: PPartInfo; +begin + part := GetPartInfo(APartIndex); + result := GetUntransformedPartEndCaret(APartIndex, part); +end; + +function TBidiTextLayout.GetUntransformedPartEndCaret(APartIndex: integer; + APart: PPartInfo): TBidiCaretPos; +begin + result.PartIndex := APartIndex; + + if APart^.IsRightToLeft then + result.Top := PointF(APart^.rectF.Left, APart^.rectF.Top) + else + result.Top := PointF(APart^.rectF.Right, APart^.rectF.Top); + result.Bottom := result.Top + PointF(0, APart^.rectF.Height); + result.RightToLeft := APart^.IsRightToLeft; + + result.PreviousTop := EmptyPointF; + result.PreviousBottom := EmptyPointF; + result.PreviousRightToLeft := result.RightToLeft; +end; + +function TBidiTextLayout.GetUntransformedParagraphAt(APosition: TPointF): integer; + + procedure FindRec(AFirstParaIndex, ALastParaIndex: integer); + var + midIndex: Integer; + begin + midIndex := (AFirstParaIndex + ALastParaIndex) shr 1; + if APosition.y < FParagraph[midIndex].rectF.Top then + begin + if midIndex <= AFirstParaIndex then + begin + result := AFirstParaIndex; + exit; + end; + FindRec(AFirstParaIndex, midIndex-1); + end + else if APosition.y >= FParagraph[midIndex].rectF.Bottom then + begin + if midIndex >= ALastParaIndex then + begin + result := ALastParaIndex; + exit; + end; + FindRec(midIndex+1, ALastParaIndex); + end + else + begin + result := midIndex; + exit; + end; + end; + +begin + NeedLayout; + result := 0; + FindRec(0, ParagraphCount-1); +end; + +procedure TBidiTextLayout.AddPartsFromTree(APos: TPointF; ATree: TBidiTree; + fullHeight, baseLine: single; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); +var + i: Integer; + root, branch: TBidiLayoutTree; + dy: Single; +begin + root := TBidiLayoutTree(ATree); + if root.IsLeaf then + begin + if (root.Height <> fullHeight) and (fullHeight <> 0) then + begin + dy := baseLine * (1 - root.Height/fullHeight); + end else + dy := 0; + if odd(root.BidiLevel) then + begin + DecF(APos.x, root.Width); + AddPart(root.StartIndex, root.EndIndex, root.BidiLevel, + RectF(APos.x, APos.y, APos.x+root.Width, APos.y+fullHeight), PointF(0,dy), ABrokenLineIndex, ABrokenLine); + end else + begin + AddPart(root.StartIndex, root.EndIndex, root.BidiLevel, + RectF(APos.x, APos.y, APos.x+root.Width, APos.y+fullHeight), PointF(0,dy), ABrokenLineIndex, ABrokenLine); + IncF(APos.x, root.Width); + end; + end else + begin + for i := 0 to root.Count-1 do + begin + branch := TBidiLayoutTree(root.Branch[i]); + if odd(root.BidiLevel) then + begin + if odd(branch.BidiLevel) then + begin + AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); + DecF(APos.x, branch.Width); + end else + begin + DecF(APos.x, branch.Width); + AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); + end; + end else + begin + if odd(branch.BidiLevel) then + begin + IncF(APos.x, branch.Width); + AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); + end else + begin + AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); + IncF(APos.x, branch.Width); + end; + end; + end; + end; +end; + +procedure TBidiTextLayout.Init(ATextUTF8: string; ABidiMode: TFontBidiMode); +var + i: Integer; +begin + FComputedBrokenLineCount:= 0; + FComputedPartCount:= 0; + FTopLeft := PointF(0,0); + FAvailableWidth:= EmptySingle; + FAvailableHeight:= EmptySingle; + FTabSize := 8; + FParagraphSpacingAbove:= 0; + FParagraphSpacingBelow:= 0; + FMatrix := AffineMatrixIdentity; + FClipMargin := 0; + FColor := BGRABlack; + FTexture := nil; + FWordBreakHandler:= nil; + FAnalysis := TUnicodeAnalysis.Create(ATextUTF8, ABidiMode); + FAnalysis.OnBidiModeChanged:= @BidiModeChanged; + FAnalysis.OnCharDeleted:= @CharDeleted; + FAnalysis.OnParagraphDeleted:=@ParagraphDeleted; + FAnalysis.OnParagraphMergedWithNext:=@ParagraphMergedWithNext; + FAnalysis.OnCharInserted:=@CharInserted; + FAnalysis.OnParagraphSplit:=@ParagraphSplit; + FAnalysis.OnAnalysisChanged:= @AnalysisChanged; + SetLength(FParagraph, FAnalysis.ParagraphCount); + for i := 0 to high(FParagraph) do + begin + FParagraph[i].rectF := EmptyRectF; + FParagraph[i].alignment:= btaNatural; + FParagraph[i].layoutComputed := false; + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgratextfx.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgratextfx.pas new file mode 100644 index 0000000..8766deb --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgratextfx.pas @@ -0,0 +1,902 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRATextFX; + +{$mode objfpc}{$H+} + +{ + Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType + + This unit provide text effects. The simplest way to render effects is to use TBGRATextEffectFontRenderer class. + To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions + to draw text like TBGRABitmap.TextOut will use the chosen renderer. To set the effects, keep a variable containing + the TBGRATextEffectFontRenderer class and modify ShadowVisible and other effects parameters. + + The TBGRATextEffectFontRenderer class makes use of other classes depending on the situation. For example, + TBGRATextEffect, which is also in this unit, provides effects on a text mask. But the renderer also uses + BGRAVectorize unit in order to have big texts or to rotate them at will. + + Note that you may need TBGRATextEffect if you want to have more control over text effects, especially + if you always draw the same text. Keeping the same TBGRATextEffect object will avoid creating the text + mask over and over again. + + TextShadow function is a simple function to compute an image containing a text with shadow. + +} + +interface + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAPhongTypes, BGRAText, + BGRACustomTextFX, BGRAVectorize; + +type + TBGRATextEffect = class; + + { TBGRATextEffectFontRenderer } + + TBGRATextEffectFontRenderer = class(TBGRASystemFontRenderer) + private + function GetShaderLightPosition: TPoint; + function GetShaderLightPositionF: TPointF; + function GetVectorizedRenderer: TBGRAVectorizedFontRenderer; + procedure SetShaderLightPosition(const AValue: TPoint); + procedure SetShaderLightPositionF(const AValue: TPointF); + protected + FShaderOwner: boolean; + FShader: TCustomPhongShading; + FVectorizedRenderer: TBGRAVectorizedFontRenderer; + function ShadowActuallyVisible :boolean; + function ShaderActuallyActive: boolean; + function OutlineActuallyVisible: boolean; + procedure Init; + function VectorizedFontNeeded(AOrientation: integer): boolean; + procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; + align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); override; + public + ShaderActive: boolean; + + ShadowVisible: boolean; + ShadowColor: TBGRAPixel; + ShadowRadius: integer; + ShadowOffset: TPoint; + ShadowQuality: TRadialBlurType; + + OutlineColor: TBGRAPixel; + OutlineWidth: single; + OutlineVisible,OuterOutlineOnly: boolean; + OutlineJoin: TPenJoinStyle; + OutlineTexture: IBGRAScanner; + constructor Create; overload; + constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload; + destructor Destroy; override; + function TextSize(sUTF8: string): TSize; overload; override; + function TextSizeAngle(sUTF8: string; orientationTenthDegCCW: integer): TSize; override; + function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; + function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; + property Shader: TCustomPhongShading read FShader; + property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition; + property ShaderLightPositionF: TPointF read GetShaderLightPositionF write SetShaderLightPositionF; + property VectorizedFontRenderer: TBGRAVectorizedFontRenderer read GetVectorizedRenderer; + end; + + { TBGRATextEffect } + + TBGRATextEffect = class(TBGRACustomTextEffect) + protected + procedure InitImproveReadability(AText: string; Font: TFont; SubOffsetX,SubOffsetY: single); + procedure Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); + procedure InitWithFontName(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); + public + constructor Create(AText: string; Font: TFont; Antialiasing: boolean); overload; + constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; + constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); overload; + constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean); overload; + constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; + constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean); overload; + constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; + end; + +function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; + AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap; + +procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); + +implementation + +uses BGRAGradientScanner, Math, BGRAGrayscaleMask, BGRAPath, BGRATransform, + BGRAPolygon, BGRAPen; + +procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); +var + useClearType,clearTypeRGBOrder: boolean; + metric: TFontPixelMetric; + deltaX: single; + x,y,yb,cury,fromy: integer; + toAdd: integer; + lines: array[0..3] of integer; + parts: array[0..3] of TGrayscaleMask; + n,nbLines: integer; + alphaMax: UInt32or64; + pmask: PByte; + fx: TBGRATextEffect; + FxFont: TFont; + prevCenter, newCenter, diffCenter: single; + xThird: integer; + +begin + useClearType:= mode in[irClearTypeRGB,irClearTypeBGR]; + clearTypeRGBOrder := mode <> irClearTypeBGR; + deltaX := xf-floor(xf); + x := round(floor(xf)); + + FxFont := TFont.Create; + FxFont.Assign(AFont); + FxFont.Height := fxFont.Height*FontAntialiasingLevel; + metric := GetLCLFontPixelMetric(FxFont); + if not metric.Defined or (metric.Lineheight < 8*FontAntialiasingLevel) or (metric.Lineheight >= 24*FontAntialiasingLevel) then + begin + fxFont.Free; + if useClearType then + begin + if ClearTypeRGBOrder then + BGRATextOut(bmp, AFont, fqFineClearTypeRGB, xf,yf, text, color, tex, align) + else + BGRATextOut(bmp, AFont, fqFineClearTypeBGR, xf,yf, text, color, tex, align) + end else + BGRATextOut(bmp, AFont, fqFineAntialiasing, xf,yf, text, color, tex, align); + exit; + end; + + if (metric.Baseline-metric.xLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 3 then + begin + toAdd := FontAntialiasingLevel- ((metric.Baseline-metric.xLine) mod FontAntialiasingLevel); + for yb := 1 to toAdd div 2 do + begin + if metric.xLine > 0 then dec(metric.xLine); + if metric.Baseline < metric.Lineheight then inc(metric.Baseline); + end; + end; + if metric.CapLine >= metric.xLine then metric.CapLine := -1 else + begin + if (metric.xLine-metric.CapLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 2 then + begin + toAdd := FontAntialiasingLevel - (metric.xLine-metric.CapLine) mod FontAntialiasingLevel; + dec(metric.CapLine, toAdd); + if metric.CapLine <= 0 then metric.CapLine := -1; + end; + end; + + nbLines := 0; + lines[nbLines] := metric.CapLine+1; + inc(nbLines); + lines[nbLines] := metric.xLine+1; + inc(nbLines); + lines[nbLines] := metric.Baseline+1; + inc(nbLines); + lines[nbLines] := metric.Lineheight+1; + inc(nbLines); + + if not useClearType then + fx := TBGRATextEffect.Create(text,FxFont,False,deltaX*FontAntialiasingLevel,0,FontAntialiasingLevel,FontAntialiasingLevel) else + fx := TBGRATextEffect.Create(text,FxFont,False,0,0,3,0); + + if fx.TextMask = nil then + begin + fx.Free; + FxFont.Free; + exit; + end; + alphaMax := 0; + prevCenter := 0; + newCenter := 0; + for yb := 0 to nbLines-1 do + begin + if yb= 0 then fromy := 0 + else fromy := lines[yb-1]; + + if lines[yb] > fromy then + begin + if useClearType then + parts[yb] := TGrayscaleMask.CreateDownSample(fx.TextMask, + round(fx.TextMask.Width / FontAntialiasingLevel * 3), + round((lines[yb] - fromy) / FontAntialiasingLevel), + rect(0, fromy, fx.TextMask.Width, lines[yb]) ) + else + parts[yb] := TGrayscaleMask.CreateDownSample(fx.TextMask, + round(fx.TextMask.Width / FontAntialiasingLevel), + round((lines[yb] - fromy) / FontAntialiasingLevel), + rect(0, fromy, fx.TextMask.Width, lines[yb]) ); + + if alphaMax < 255 then + begin + pmask := parts[yb].Data; + for n := parts[yb].NbPixels-1 downto 0 do + begin + if pmask^ > alphaMax then alphaMax := pmask^; + inc(pmask); + end; + end; + + if yb < 2 then + begin + IncF(newCenter, parts[yb].Height); + IncF(prevCenter, lines[yb]-fromy); + end else + if yb = 2 then + begin + IncF(newCenter, parts[yb].Height/2); + IncF(prevCenter, (lines[yb]-fromy)/2); + end; + end else + parts[yb] := nil; + end; + + prevCenter := prevCenter / FontAntialiasingLevel; + diffCenter := prevCenter-newCenter; + y := round( yf + diffCenter ); + + xThird := 0; + if useClearType then + begin + case align of + taCenter: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel+deltaX)*3); + taRightJustify: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel+deltaX)*3); + else xThird:= xThird+round((fx.TextMaskOffset.x/FontAntialiasingLevel+deltaX)*3); + end; + end else + begin + case align of + taCenter: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel); + taRightJustify: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel); + else x:= x+round(fx.TextMaskOffset.x/FontAntialiasingLevel); + end; + end; + cury := y+round(fx.TextMaskOffset.y/FontAntialiasingLevel); + for yb := 0 to nbLines-1 do + if parts[yb] <> nil then + begin + if (alphaMax > 0) and (alphaMax < 255) then + begin + pmask := parts[yb].data; + for n := parts[yb].NbPixels-1 downto 0 do + begin + pmask^ := pmask^*255 div alphaMax; + inc(pmask); + end; + end; + if useClearType then + BGRAFillClearTypeGrayscaleMask(bmp,x,cury,xThird,parts[yb],color,tex,ClearTypeRGBOrder) + else if mode = irMask then + parts[yb].Draw(bmp,x,cury) + else + begin + if tex <> nil then + parts[yb].DrawAsAlpha(bmp,x,cury,tex) else + parts[yb].DrawAsAlpha(bmp,x,cury,color); + end; + inc(cury,parts[yb].Height); + parts[yb].Free; + end; + + fx.Free; + FxFont.Free; +end; + +procedure BGRAReplace(var Destination: TBGRACustomBitmap; Temp: TObject); +begin + Destination.Free; + Destination := Temp as TBGRACustomBitmap; +end; + +function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; + AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; + AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap; +var + bmpOut,bmpSdw: TBGRACustomBitmap; OutTxtSize: TSize; OutX,OutY: Integer; +begin + bmpOut:= BGRABitmapFactory.Create(AWidth,AHeight); + bmpOut.FontAntialias:= True; + bmpOut.FontHeight:= AFontHeight; + bmpOut.FontStyle:= AFontStyle; + bmpOut.FontName:= AFontName; + bmpOut.FontQuality:= AFontQuality; + + OutTxtSize:= bmpOut.TextSize(AText); + OutX:= Round(AWidth/2) - Round(OutTxtSize.cx/2); + OutY:= Round(AHeight/2) - Round(OutTxtSize.cy/2); + + bmpSdw:= BGRABitmapFactory.Create(OutTxtSize.cx+2*ARadius,OutTxtSize.cy+2*ARadius); + bmpSdw.FontAntialias:= True; + bmpSdw.FontHeight:= AFontHeight; + bmpSdw.FontStyle:= AFontStyle; + bmpSdw.FontName:= AFontName; + bmpSdw.FontQuality:= AFontQuality; + + bmpSdw.TextOut(ARadius,ARadius,AText,AShadowColor); + BGRAReplace(bmpSdw,bmpSdw.FilterBlurRadial(ARadius,rbFast)); + bmpOut.PutImage(OutX+AOffSetX-ARadius,OutY+AOffSetY-ARadius,bmpSdw,dmDrawWithTransparency); + bmpSdw.Free; + + if AShowText = True then bmpOut.TextOut(OutX,OutY,AText,ATextColor); + + Result:= bmpOut; +end; + +{ TBGRATextEffectFontRenderer } + +function TBGRATextEffectFontRenderer.GetShaderLightPosition: TPoint; +begin + if FShader = nil then + result := point(0,0) + else + result := FShader.LightPosition; +end; + +function TBGRATextEffectFontRenderer.GetShaderLightPositionF: TPointF; +begin + if FShader = nil then + result := pointF(0,0) + else + result := FShader.LightPositionF; +end; + +function TBGRATextEffectFontRenderer.GetVectorizedRenderer: TBGRAVectorizedFontRenderer; +begin + FVectorizedRenderer.FontEmHeight := FontEmHeight; + FVectorizedRenderer.FontName := FontName; + FVectorizedRenderer.FontOrientation:= FontOrientation; + FVectorizedRenderer.FontQuality := FontQuality; + FVectorizedRenderer.FontStyle:= FontStyle; + + FVectorizedRenderer.ShadowColor := ShadowColor; + FVectorizedRenderer.ShadowVisible := ShadowVisible; + FVectorizedRenderer.ShadowOffset := ShadowOffset; + FVectorizedRenderer.ShadowRadius := ShadowRadius; + + FVectorizedRenderer.OutlineColor := OutlineColor; + FVectorizedRenderer.OutlineVisible := OutlineVisible; + FVectorizedRenderer.OutlineWidth := OutlineWidth; + FVectorizedRenderer.OutlineTexture := OutlineTexture; + FVectorizedRenderer.OuterOutlineOnly := OuterOutlineOnly; + FVectorizedRenderer.OutlineJoin := OutlineJoin; + result := FVectorizedRenderer; +end; + +procedure TBGRATextEffectFontRenderer.SetShaderLightPosition(const AValue: TPoint); +begin + if FShader <> nil then + FShader.LightPosition := AValue; +end; + +procedure TBGRATextEffectFontRenderer.SetShaderLightPositionF(const AValue: TPointF); +begin + if FShader <> nil then + FShader.LightPositionF := AValue; +end; + +function TBGRATextEffectFontRenderer.ShadowActuallyVisible: boolean; +begin + result := ShadowVisible and (ShadowColor.alpha <> 0); +end; + +function TBGRATextEffectFontRenderer.ShaderActuallyActive: boolean; +begin + result := (FShader <> nil) and ShaderActive; +end; + +function TBGRATextEffectFontRenderer.OutlineActuallyVisible: boolean; +begin + result := (OutlineWidth <> 0) and ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible; +end; + +procedure TBGRATextEffectFontRenderer.Init; +begin + ShaderActive := true; + + ShadowColor := BGRABlack; + ShadowVisible := false; + ShadowOffset := Point(5,5); + ShadowRadius := 5; + ShadowQuality:= rbFast; + + OutlineColor := BGRAPixelTransparent; + OutlineVisible := True; + OutlineWidth:= DefaultOutlineWidth; + OuterOutlineOnly:= false; + OutlineJoin := pjsMiter; + FVectorizedRenderer := TBGRAVectorizedFontRenderer.Create; +end; + +function TBGRATextEffectFontRenderer.VectorizedFontNeeded(AOrientation: integer): boolean; + function IsBigFont: boolean; + var textsz: TSize; + begin + textsz := inherited InternalTextSize('Hg',False); + result := (not OutlineActuallyVisible and (textsz.cy >= 24)) or + (OutlineActuallyVisible and (textsz.cy > 42)); + end; +var bAntialiasing, bSpecialOutline, bOriented, bEffectVectorizedSupported: boolean; +begin + bAntialiasing := FontQuality in [fqFineAntialiasing,fqFineClearTypeRGB,fqFineClearTypeBGR]; + bSpecialOutline:= OutlineActuallyVisible and (abs(OutlineWidth) <> DefaultOutlineWidth); + bOriented := AOrientation <> 0; + bEffectVectorizedSupported := OutlineActuallyVisible or ShadowActuallyVisible or ShaderActuallyActive; + result := bSpecialOutline or + (bAntialiasing and IsBigFont) or + (bOriented and bEffectVectorizedSupported); +end; + +procedure TBGRATextEffectFontRenderer.InternalTextOutAngle( + ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; + c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; + AShowPrefix: boolean = false; ARightToLeft: boolean = false); + + procedure DrawFX(fx: TBGRATextEffect; x,y: single; outline: boolean); + procedure DoOutline; + begin + if OutlineActuallyVisible then + begin + if OutlineTexture <> nil then + fx.DrawOutline(ADest,round(x),round(y), OutlineTexture, align) + else + fx.DrawOutline(ADest,round(x),round(y), OutlineColor, align); + end; + end; + begin + if ShadowActuallyVisible then + begin + fx.ShadowQuality := ShadowQuality; + fx.DrawShadow(ADest,round(x)+ShadowOffset.X,round(y)+ShadowOffset.Y,ShadowRadius,ShadowColor, align); + end; + if outline and OuterOutlineOnly then DoOutline; + if texture <> nil then + begin + if ShaderActuallyActive then + fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture, align) + else + fx.Draw(ADest,round(x),round(y), texture, align); + end else + begin + if ShaderActuallyActive then + fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), c, align) + else + fx.Draw(ADest,round(x),round(y), c, align); + end; + if outline and not OuterOutlineOnly then DoOutline; + end; + + procedure ComplexVectorized; + var + p: TBGRAPath; + w: single; + f: TBGRAMultishapeFiller; + s: TBGRAPenStroker; + mask, shaded: TBGRACustomBitmap; + boundsF: TRectF; + b: TRect; + fx: TBGRATextEffect; + oldShaderLightPos: TPoint; + h: integer; + begin + p := TBGRAPath.Create; + try + p.translate(x-0.5,y-0.5); + p.rotateDeg(-AOrientation/10); + VectorizedFontRenderer.CopyTextPathTo(p,0,0,sUTF8,align,ARightToLeft); + if abs(OutlineWidth) < 3 then + w := abs(OutlineWidth)*2/3 + else + w := abs(OutlineWidth)-1; + if p.IsEmpty then + boundsF := EmptyRectF + else + begin + boundsF := p.GetBounds; + DecF(boundsF.Left, 1); + DecF(boundsF.Top, 1); + IncF(boundsF.Right, 1); + IncF(boundsF.Bottom, 1); + if ShadowActuallyVisible then + begin + DecF(boundsF.Left, ShadowRadius); + DecF(boundsF.Top, ShadowRadius); + IncF(boundsF.Right, ShadowRadius); + IncF(boundsF.Bottom, ShadowRadius); + end; + boundsF := TRectF.Intersect(boundsF, RectF(0,0,ADest.Width,ADest.Height)); + end; + if not boundsF.IsEmpty then + begin + with boundsF do + b := rect(floor(left),floor(top),ceil(right),ceil(bottom)); + shaded := nil; + try + if ShaderActuallyActive or ShadowActuallyVisible then + begin + mask := BGRABitmapFactory.Create(b.Width,b.Height,BGRABlack); + try + mask.LinearAntialiasing:= true; + mask.FillPath(p, AffineMatrixTranslation(-b.Left,-b.Top), BGRAWhite); + fx := TBGRATextEffect.Create(mask, false, mask.Width,mask.Height, Point(0,0)); + if ShaderActuallyActive then + begin + shaded := ADest.NewBitmap(mask.Width,mask.Height); + oldShaderLightPos := Shader.LightPosition; + Shader.LightPosition := Point(Shader.LightPosition.X - b.Left, + Shader.LightPosition.Y - b.Top); + h := VectorizedFontRenderer.TextSize('Hg').cy; + if texture <> nil then + fx.DrawShaded(shaded, 0,0, Shader, round(h*0.05), texture, taLeftJustify) + else + fx.DrawShaded(shaded, 0,0, Shader, round(h*0.05), c, taLeftJustify); + Shader.LightPosition := oldShaderLightPos; + shaded.AlphaFill(255); + shaded.ScanOffset := Point(-b.Left,-b.Top); + end; + if ShadowActuallyVisible then + begin + fx.ShadowQuality := ShadowQuality; + fx.DrawShadow(ADest,b.Left+ShadowOffset.X,b.Top+ShadowOffset.Y,ShadowRadius,ShadowColor, taLeftJustify); + end; + fx.Free; + finally + mask.Free; + end; + end; + s := nil; + f := TBGRAMultishapeFiller.Create; + if shaded<>nil then + f.AddPathFill(p, shaded) else + if texture<>nil then + f.AddPathFill(p, texture) + else + f.AddPathFill(p, c); + if OutlineActuallyVisible then + begin + s := TBGRAPenStroker.Create; + f.AddPathStroke(p, OutlineColor, w, s); + end; + if OuterOutlineOnly then + f.PolygonOrder:= poFirstOnTop + else + f.PolygonOrder:= poLastOnTop; + if ADest.LinearAntialiasing then + f.Draw(ADest, dmLinearBlend) + else + f.Draw(ADest, dmDrawWithTransparency); + f.Free; + s.Free; + finally + shaded.Free; + end; + end; + finally + p.Free; + end; + end; + +var fx: TBGRATextEffect; +begin + if VectorizedFontNeeded(AOrientation) then + begin + if ShaderActuallyActive or ShadowActuallyVisible then + ComplexVectorized else + begin + if texture<>nil then + VectorizedFontRenderer.TextOutAngle(ADest,x,y,AOrientation,sUTF8,texture,align,ARightToLeft) + else + VectorizedFontRenderer.TextOutAngle(ADest,x,y,AOrientation,sUTF8,c,align,ARightToLeft); + end; + end else + if (AOrientation = 0) and (ShaderActuallyActive or ShadowActuallyVisible or OutlineActuallyVisible) then + begin + fx := TBGRATextEffect.Create(sUTF8, FFont, + FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB], + x-floor(x), y-floor(y)); + DrawFX(fx, x,y, true); + fx.Free; + end else + inherited InternalTextOutAngle(ADest,x,y,AOrientation,sUTF8,c,texture,align,AShowPrefix,ARightToLeft); +end; + +constructor TBGRATextEffectFontRenderer.Create; +begin + inherited Create; + FShader := nil; + FShaderOwner:= false; + Init; +end; + +constructor TBGRATextEffectFontRenderer.Create(AShader: TCustomPhongShading; + AShaderOwner: boolean); +begin + inherited Create; + Init; + FShader := AShader; + FShaderOwner := AShaderOwner; +end; + +destructor TBGRATextEffectFontRenderer.Destroy; +begin + if FShaderOwner then FShader.Free; + FVectorizedRenderer.Free; + inherited Destroy; +end; + +function TBGRATextEffectFontRenderer.TextSize(sUTF8: string): TSize; +begin + if VectorizedFontNeeded(0) then + result := VectorizedFontRenderer.TextSize(sUTF8) + else + result := inherited TextSize(sUTF8); +end; + +function TBGRATextEffectFontRenderer.TextSizeAngle(sUTF8: string; + orientationTenthDegCCW: integer): TSize; +begin + if VectorizedFontNeeded(orientationTenthDegCCW) then + result := VectorizedFontRenderer.TextSizeAngle(sUTF8, orientationTenthDegCCW) + else + result := inherited TextSizeAngle(sUTF8, orientationTenthDegCCW); +end; + +function TBGRATextEffectFontRenderer.TextSize(sUTF8: string; + AMaxWidth: integer; ARightToLeft: boolean): TSize; +begin + if VectorizedFontNeeded(FontOrientation) then + result := VectorizedFontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft) + else + result := inherited TextSize(sUTF8, AMaxWidth, ARightToLeft); +end; + +function TBGRATextEffectFontRenderer.TextFitInfo(sUTF8: string; + AMaxWidth: integer): integer; +begin + if VectorizedFontNeeded(FontOrientation) then + result := VectorizedFontRenderer.TextFitInfo(sUTF8, AMaxWidth) + else + result := inherited TextFitInfo(sUTF8, AMaxWidth) +end; + +{ TBGRATextEffect } + +procedure TBGRATextEffect.InitImproveReadability(AText: string; Font: TFont; + SubOffsetX, SubOffsetY: single); +var size: TSize; + overhang: integer; + temp: TBGRACustomBitmap; +begin + FShadowQuality:= rbFast; + if SubOffsetX < 0 then SubOffsetX := 0; + if SubOffsetY < 0 then SubOffsetY := 0; + size := BGRATextSize(Font, fqFineAntialiasing, AText, FontAntialiasingLevel); + FTextSize := size; + if size.cy = 0 then FTextSize.cy := BGRATextSize(Font, fqFineAntialiasing, 'Hg', FontAntialiasingLevel).cy; + overhang := size.cy div 2; + inc(size.cx, 2*overhang + ceil(SubOffsetX) ); + inc(size.cy, 2 + ceil(SubOffsetY) ); + + FOffset := Point(-overhang,-1); //include overhang + temp := BGRABitmapFactory.Create(size.cx, size.cy, BGRABlack); + BGRATextOutImproveReadability(temp, Font, overhang+SubOffsetX,1+SubOffsetY, AText, BGRAWhite, nil, taLeftJustify, irMask); + FTextMask := TGrayscaleMask.Create; + FTextMask.CopyFrom(temp, cGreen); + temp.Free; +end; + +constructor TBGRATextEffect.Create(AText: string; Font: TFont; + Antialiasing: boolean; SubOffsetX,SubOffsetY: single); +begin + Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, 0,0); +end; + +constructor TBGRATextEffect.Create(AText: string; Font: TFont; + Antialiasing: boolean; SubOffsetX, SubOffsetY: single; GrainX, GrainY: Integer + ); +begin + Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, GrainX, GrainY); +end; + +constructor TBGRATextEffect.Create(AText: string; AFontName: string; + AFullHeight: integer; Antialiasing: boolean); +begin + InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, 0, 0); +end; + +constructor TBGRATextEffect.Create(AText: string; AFontName: string; + AFullHeight: integer; Antialiasing: boolean; SubOffsetX, SubOffsetY: single); +begin + InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, SubOffsetX, SubOffsetY); +end; + +constructor TBGRATextEffect.Create(AText: string; AFontName: string; + AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean); +begin + InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, 0, 0); +end; + +constructor TBGRATextEffect.Create(AText: string; AFontName: string; + AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, + SubOffsetY: single); +begin + InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, SubOffsetX, SubOffsetY); +end; + +procedure TBGRATextEffect.Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); +const FXAntialiasingLevel = FontAntialiasingLevel; +var temp: TBGRACustomBitmap; + tempBmp: TBitmap; + size: TSize; + p: PByte; + n,v,maxAlpha: integer; + alpha: byte; + sizeX,sizeY: integer; + onePixel: integer; + quality: TBGRAFontQuality; + iSubX,iSubY: integer; +begin + if IsLclFontRendererFine then Antialiasing := false; + FShadowQuality := rbFast; + if Antialiasing and Assigned(BGRATextOutImproveReadabilityProc) then + begin + InitImproveReadability(AText, Font, SubOffsetX,SubOffsetY); + exit; + end; + if Antialiasing and not IsLclFontRendererFine then + quality := fqFineAntialiasing + else + quality := fqSystem; + size := BGRAOriginalTextSize(Font,quality,AText,FXAntialiasingLevel); + if (size.cx = 0) or (size.cy = 0) then + begin + size := BGRATextSize(Font,quality,'Hg',FXAntialiasingLevel); + FTextSize.cx := 0; + FTextSize.cy := size.cy; + FOffset := Point(0,0); + exit; + end; + FTextSize := size; + + sizeX := size.cx+size.cy; + sizeY := size.cy; + + iSubX := 0; + iSubY := 0; + if SubOffsetX < 0 then SubOffsetX := 0; + if SubOffsetY < 0 then SubOffsetY := 0; + + if Antialiasing then + begin + sizeX := (sizeX + FXAntialiasingLevel-1); + dec(sizeX, sizeX mod FXAntialiasingLevel); + + sizeY := (sizeY + FXAntialiasingLevel-1); + dec(sizeY, sizeY mod FXAntialiasingLevel); + + if SubOffsetX <> 0 then + begin + inc(sizeX, ceil(SubOffsetX*FXAntialiasingLevel) ); + iSubX := round(SubOffsetX*FXAntialiasingLevel); + end; + if SubOffsetY <> 0 then + begin + inc(sizeY, ceil(SubOffsetY*FXAntialiasingLevel) ); + iSubY := round(SubOffsetY*FXAntialiasingLevel); + end; + + OnePixel := FXAntialiasingLevel; + end else + begin + OnePixel := 1; + + if SubOffsetX <> 0 then + begin + iSubX := round(SubOffsetX); + inc(sizeX, iSubX); + end; + if SubOffsetY <> 0 then + begin + iSubY := round(SubOffsetY); + inc(sizeY, iSubY); + end; + end; + FOffset := Point(-size.cy div 2,-OnePixel); //include overhang + + if GrainX > 0 then + begin + SizeX := SizeX+ (GrainX-1); + dec(SizeX, SizeX mod GrainX); + end; + if GrainY > 0 then + begin + SizeY := SizeY+ (GrainY-1); + dec(SizeY, SizeY mod GrainY); + end; + if RenderTextOnBitmap then + begin + tempBmp := TBitmap.Create; + tempBmp.Width := sizeX; + tempBmp.Height := sizeY+2*OnePixel; + BitmapFillRect(tempBmp, rect(0,0,tempBmp.Width,tempBmp.Height), clBlack); + tempBmp.Canvas.Font := Font; + tempBmp.Canvas.Font.Orientation := 0; + tempBmp.Canvas.Font.Height := Font.Height*OnePixel; + tempBmp.Canvas.Font.Color := clWhite; + tempBmp.Canvas.Font.Quality := FontDefaultQuality; + BitmapTextOut(tempBmp, Point(-FOffset.X+iSubX, -FOffset.Y+iSubY), AText); + temp := BGRABitmapFactory.Create(tempBmp); + tempBmp.Free; + end else + begin + temp := BGRABitmapFactory.Create(sizeX, sizeY+2*OnePixel,clBlack); + temp.Canvas.Font := Font; + temp.Canvas.Font.Orientation := 0; + temp.Canvas.Font.Height := Font.Height*OnePixel; + temp.Canvas.Font.Color := clWhite; + temp.Canvas.Font.Quality := FontDefaultQuality; + BitmapTextOut(temp.Bitmap, Point(-FOffset.X+iSubX, -FOffset.Y+iSubY), AText); + end; + + if Antialiasing then + begin + FTextSize.cx := round(FTextSize.cx/FXAntialiasingLevel); + FTextSize.cy := round(FTextSize.cy/FXAntialiasingLevel); + FOffset := Point(round(FOffset.X/FXAntialiasingLevel),round(FOffset.Y/FXAntialiasingLevel)); + + FTextMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/FXAntialiasingLevel), + round(temp.Height/FXAntialiasingLevel)); + temp.Free; + + maxAlpha := 0; + p := FTextMask.Data; + for n := FTextMask.NbPixels - 1 downto 0 do + begin + alpha := P^; + if alpha > maxAlpha then maxAlpha := alpha; + Inc(p); + end; + if maxAlpha <> 0 then + begin + p := FTextMask.Data; + for n := FTextMask.NbPixels - 1 downto 0 do + begin + p^:= integer(p^ * 255) div maxAlpha; + Inc(p); + end; + end; + end + else + begin + FTextMask := TGrayscaleMask.Create(temp, cGreen); + temp.Free; + + p := FTextMask.data; + for n := FTextMask.NbPixels-1 downto 0 do + p^ := GammaExpansionTab[p^] shr 8; + end; +end; + +procedure TBGRATextEffect.InitWithFontName(AText: string; AFontName: string; + AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, SubOffsetY: single); +var lFont: TFont; +begin + lFont := TFont.Create; + lFont.Name := AFontName; + lFont.Height := AFullHeight * FontFullHeightSign; + lFont.Style := AStyle; + Init(AText, lFont, Antialiasing, SubOffsetX, SubOffsetY, 0,0); + lFont.Free; +end; + +constructor TBGRATextEffect.Create(AText: string; Font: TFont; + Antialiasing: boolean); +begin + Init(AText, Font, Antialiasing, 0,0,0,0); +end; + +initialization + + BGRATextOutImproveReadabilityProc := @BGRATextOutImproveReadability; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrathumbnail.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrathumbnail.pas new file mode 100644 index 0000000..ce1d7ec --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrathumbnail.pas @@ -0,0 +1,520 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAThumbnail; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmap, BGRABitmapTypes, FPimage; + +function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload; +function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload; +function GetFileThumbnail(AFilenameUTF8: string; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetStreamThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string = ''; ADest: TBGRABitmap= nil): TBGRABitmap; overload; +function GetStreamThumbnail(AStream: TStream; AReader: TFPCustomImageReader; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; overload; + +function GetOpenRasterThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetLazPaintThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetJpegThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetPsdThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; + +function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetTargaThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetTiffThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetGifThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetXwdThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetXPixMapThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +function GetBmpMioMapThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; + +procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean = false); +procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean; AScale: single); + +var + ImageCheckersColor1,ImageCheckersColor2 : TBGRAPixel; + IconCheckersColor1,IconCheckersColor2 : TBGRAPixel; + CheckersScale: single = 1; + +implementation + +uses base64, BGRAUTF8, + DOM, XMLRead, BGRAReadJPEG, BGRAReadPng, BGRAReadGif, BGRAReadBMP, + BGRAReadPSD, BGRAReadIco, UnzipperExt, BGRAReadLzp; + +procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; + AIconCheckers: boolean); +begin + DrawThumbnailCheckers(bmp, ARect, AIconCheckers, CheckersScale); +end; + +procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean; AScale: single); +begin + if AIconCheckers then + bmp.DrawCheckers(ARect, IconCheckersColor1, IconCheckersColor2, round(8*AScale), round(8*AScale)) + else + bmp.DrawCheckers(ARect, ImageCheckersColor1, ImageCheckersColor2, round(8*AScale), round(8*AScale)); +end; + +function InternalGetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; + ADest: TBGRABitmap; AVerticalShrink: single = 1; AHorizShrink: single = 1; AShowHotSpot: boolean = false; ADarkCheckers: boolean = false): TBGRABitmap; +var + factorX, factorY, factor: single; + xIcon,yIcon,wIcon,hIcon: Integer; + hotspot: TPoint; +begin + result := nil; + try + if (ABitmap <> nil) and (ABitmap.Width <> 0) and (ABitmap.Height <> 0) then + begin + If Assigned(ADest) then + begin + result := ADest; + result.SetSize(AWidth,AHeight); + result.Fill(ABackColor); + end else + result := TBGRABitmap.Create(AWidth,AHeight,ABackColor); + factorX := result.Width/(ABitmap.Width*AHorizShrink); + factorY := result.Height/(ABitmap.Height*AVerticalShrink); + if factorX < factorY then factor := factorX else factor := factorY; + wIcon := round(ABitmap.Width*AHorizShrink*factor); + if wIcon = 0 then wIcon := 1; + hIcon := round(ABitmap.Height*AVerticalShrink*factor); + if hIcon = 0 then hIcon := 1; + xIcon:= (result.Width-wIcon) div 2; + yIcon:= (result.Height-hIcon) div 2; + if ACheckers then DrawThumbnailCheckers(result,Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ADarkCheckers,CheckersScale); + if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then + begin + hotspot := Point(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height); + result.HorizLine(xIcon,hotspot.y-1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); + result.HorizLine(xIcon,hotspot.y,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); + result.HorizLine(xIcon,hotspot.y+1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); + result.VertLine(hotspot.x-1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); + result.VertLine(hotspot.x,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); + result.VertLine(hotspot.x+1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); + end; + if (ABackColor.alpha <> 0) or ACheckers then + result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmDrawWithTransparency) else + result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmSet); + if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then + begin + result.HorizLine(xIcon,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height,xIcon+wIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency); + result.VertLine(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon,yIcon+hIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency); + end; + end; + except + end; +end; + +function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil; + AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; +begin + result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink, + false,false); +end; + +function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; +begin + result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink, + AFormat = ifCur, AFormat in[ifCur,ifIco]); + +end; + +function GetFileThumbnail(AFilenameUTF8: string; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var stream: TFileStreamUTF8; +begin + result := nil; + try + stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); + except + exit; + end; + try + result := GetStreamThumbnail(stream, AWidth,AHeight,ABackColor,ACheckers,ExtractFileExt(AFilenameUTF8),ADest); + finally + stream.free; + end; +end; + +function GetStreamThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string; + ADest: TBGRABitmap): TBGRABitmap; +var + ff: TBGRAImageFormat; + reader: TFPCustomImageReader; +begin + ff := DetectFileFormat(AStream,ASuggestedExtensionUTF8); + case ff of + ifJpeg: result := GetJpegThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifIco: result := GetIcoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifCur: result := GetCurThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifPaintDotNet: result := GetPaintDotNetThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifLazPaint: result := GetLazPaintThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifOpenRaster: result := GetOpenRasterThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifPhoxo: result := GetPhoxoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + ifPsd: result := GetPsdThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); + else + begin + if (ff = ifUnknown) or (DefaultBGRAImageReader[ff] = nil) then + result := nil + else + begin + result := nil; + reader := nil; + try + reader := CreateBGRAImageReader(ff); + result := GetStreamThumbnail(AStream, reader, AWidth, AHeight, ABackColor, ACheckers, ADest); + finally + reader.Free; + end; + end; + end; + end; +end; + +function GetStreamThumbnail(AStream: TStream; AReader: TFPCustomImageReader; + AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; + ADest: TBGRABitmap): TBGRABitmap; +var + bmp: TBGRACustomBitmap; + AOriginalWidth, AOriginalHeight: integer; +begin + if AReader is TBGRAImageReader then + begin + bmp := nil; + try + bmp := TBGRAImageReader(AReader).GetBitmapDraft(AStream, AWidth,AHeight, AOriginalWidth,AOriginalHeight); + if Assigned(bmp) and (bmp.Height <> 0) and (bmp.Width <> 0) then + result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, + AOriginalHeight/bmp.Height, AOriginalWidth/bmp.Width); + except + result := nil; + end; + bmp.free; + exit; + end; + + bmp := TBGRABitmap.Create; + try + bmp.LoadFromStream(AStream, AReader); + except + FreeAndNil(bmp); + end; + if bmp = nil then + result := nil + else + begin + result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest); + bmp.Free; + end; +end; + +function GetOpenRasterThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + unzip: TUnzipperStreamUtf8; + png: TMemoryStream; +begin + result := nil; + unzip := TUnzipperStreamUtf8.Create; + try + unzip.InputStream := AStream; + png := TMemoryStream.Create; + try + if unzip.UnzipFileToStream('Thumbnails\thumbnail.png', png, False) then + begin + png.Position:= 0; + result := GetPngThumbnail(png,AWidth,AHeight,ABackColor,ACheckers,ADest); + end else + begin + png.Clear; + if unzip.UnzipFileToStream('mergedimage.png', png, False) then + begin + png.Position:= 0; + result := GetPngThumbnail(png,AWidth,AHeight,ABackColor,ACheckers,ADest); + end; + end; + finally + png.Free; + end; + except + end; + unzip.Free; +end; + +function GetLazPaintThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TBGRAReaderLazPaint; +begin + reader:= TBGRAReaderLazPaint.Create; + reader.WantThumbnail := true; + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; +end; + +function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + if DefaultBGRAImageReader[ifPhoxo] = nil then + result := nil + else + begin + reader := CreateBGRAImageReader(ifPhoxo); + result := GetStreamThumbnail(AStream, reader, AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; + end; +end; + +function GetJpegThumbnail(AStream: TStream; AWidth, AHeight: integer + ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + jpeg: TBGRAReaderJpeg; +begin + jpeg := TBGRAReaderJpeg.Create; + jpeg.Performance := jpBestSpeed; + jpeg.MinWidth := AWidth; + jpeg.MinHeight := AHeight; + result := GetStreamThumbnail(AStream, jpeg, AWidth,AHeight,ABackColor,ACheckers,ADest); + jpeg.Free; +end; + +function GetPsdThumbnail(AStream: TStream; AWidth, AHeight: integer + ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + psd: TBGRAReaderPSD; + bmp: TBGRABitmap; +begin + psd:= TBGRAReaderPSD.Create; + psd.MinifyHeight:= AHeight; + bmp := TBGRABitmap.Create; + try + bmp.LoadFromStream(AStream, psd); + except + FreeAndNil(bmp); + end; + if bmp = nil then + result := nil + else + begin + result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, psd.Height/bmp.Height); + bmp.Free; + end; + psd.Free; +end; + +function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; +var + pngFormat: TBGRAReaderPNG; +begin + pngFormat:= TBGRAReaderPNG.Create; + result:= GetStreamThumbnail(AStream, pngFormat, AWidth,AHeight, ABackColor, ACheckers, ADest); + pngFormat.Free; +end; + +function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + {%H-}magic: packed array[0..6] of byte; + xmlHeader: TMemoryStream; + xmlHeaderSize: longint; + doc: TXMLDocument; + custom,thumb,pngNode: TDOMNode; + png64: TStringStream; + decode64: TBase64DecodingStream; +begin + result := nil; + if AStream.Read({%H-}magic,sizeof(magic)) <> sizeof(magic) then exit; + if chr(magic[0])+chr(magic[1])+chr(magic[2])+chr(magic[3]) <> 'PDN3' then exit; + xmlHeaderSize := magic[4] + (magic[5] shl 8) + (magic[6] shl 16); + if xmlHeaderSize >= 10*1024*1024 then exit; + xmlHeader:= TMemoryStream.Create; + try + if xmlHeader.CopyFrom(AStream,xmlHeaderSize) <> xmlHeaderSize then + begin + xmlHeader.Free; + exit; + end; + except + xmlHeader.Free; + exit; + end; + xmlHeader.Position := 0; + try + XMLRead.ReadXMLFile(doc, xmlHeader); + except + xmlHeader.Free; + exit; + end; + xmlHeader.Free; + try + custom := doc.DocumentElement.FindNode('custom'); + if Assigned(custom) then + begin + thumb := custom.FindNode('thumb'); + if Assigned(thumb) then + begin + pngNode := thumb.Attributes.GetNamedItem('png'); + if Assigned(pngNode) then + begin + png64 := TStringStream.Create(string(pngNode.NodeValue)); + try + png64.Position := 0; + decode64 := TBase64DecodingStream.Create(png64); + try + result := GetPngThumbnail(decode64,AWidth,AHeight,ABackColor,ACheckers, ADest); + finally + decode64.Free; + end; + finally + png64.free; + end; + end; + end; + end; + except + end; + doc.Free; +end; + +function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + bmpFormat: TBGRAReaderBMP; +begin + bmpFormat:= TBGRAReaderBMP.Create; + result:= GetStreamThumbnail(AStream, bmpFormat, AWidth,AHeight, ABackColor, ACheckers, ADest); + bmpFormat.Free; +end; + +function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TBGRAReaderIco; + icoBmp: TBGRABitmap; +begin + result := nil; + reader := TBGRAReaderIco.Create; + reader.WantedWidth:= AWidth; + reader.WantedHeight:= AHeight; + icoBmp := TBGRABitmap.Create; + try + icoBmp.LoadFromStream(AStream, reader); + result := GetBitmapThumbnail(icoBmp, ifIco, AWidth, AHeight, ABackColor, ACheckers, ADest); + except + end; + icoBmp.Free; + reader.Free; +end; + +function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TBGRAReaderCur; + icoBmp: TBGRABitmap; +begin + result := nil; + reader := TBGRAReaderCur.Create; + reader.WantedWidth:= AWidth; + reader.WantedHeight:= AHeight; + icoBmp := TBGRABitmap.Create; + try + icoBmp.LoadFromStream(AStream, reader); + result := GetBitmapThumbnail(icoBmp, ifCur, AWidth, AHeight, ABackColor, ACheckers, ADest); + except + end; + icoBmp.Free; + reader.Free; +end; + +function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifPcx); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; +end; + +function GetTargaThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifTarga); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); + reader.Free; +end; + +function GetTiffThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifTiff); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; +end; + +function GetGifThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifGif); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); + reader.Free; +end; + +function GetXwdThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifXwd); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); + reader.Free; +end; + +function GetXPixMapThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifXPixMap); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; +end; + +function GetBmpMioMapThumbnail(AStream: TStream; AWidth, AHeight: integer; + ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; +var + reader: TFPCustomImageReader; +begin + reader:= CreateBGRAImageReader(ifBmpMioMap); + result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); + reader.Free; +end; + +initialization + + IconCheckersColor1 := BGRA(140,180,180); + IconCheckersColor2 := BGRA(80,140,140); + + ImageCheckersColor1 := BGRA(255,255,255); + ImageCheckersColor2 := BGRA(220,220,220); + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgratransform.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgratransform.pas new file mode 100644 index 0000000..87b5e6c --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgratransform.pas @@ -0,0 +1,2051 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRATransform; + +{$mode objfpc} + +interface + +{ This unit contains bitmap transformations as classes and the TAffineMatrix record and functions. } + +uses + BGRAClasses, SysUtils, BGRABitmapTypes; + +type + { Contains an affine matrix, i.e. a matrix to transform linearly and translate TPointF coordinates } + TAffineMatrix = BGRABitmapTypes.TAffineMatrix; + { Contains an affine base and information on the resulting box } + TAffineBox = BGRABitmapTypes.TAffineBox; + + { TBGRAAffineScannerTransform allow to transform any scanner. To use it, + create this object with a scanner as parameter, call transformation + procedures, and finally, use the newly created object as a scanner. + + You can transform a gradient or a bitmap. See TBGRAAffineBitmapTransform + for bitmap specific transformation. } + + { TBGRAAffineScannerTransform } + + TBGRAAffineScannerTransform = class(TBGRACustomScanner) + protected + FScanner: IBGRAScanner; + FScanAtFunc: TScanAtFunction; + FCur: TPointF; + FEmptyMatrix: Boolean; + FMatrix: TAffineMatrix; + procedure SetMatrix(AMatrix: TAffineMatrix); + function InternalScanCurrentPixel: TBGRAPixel; virtual; + function GetViewMatrix: TAffineMatrix; + procedure SetViewMatrix(AValue: TAffineMatrix); + public + GlobalOpacity: Byte; + constructor Create(AScanner: IBGRAScanner); + procedure Reset; + procedure Invert; + procedure Translate(OfsX,OfsY: Single); + procedure RotateDeg(AngleCW: Single); + procedure RotateRad(AngleCCW: Single); + procedure MultiplyBy(AMatrix: TAffineMatrix); + procedure Fit(Origin,HAxis,VAxis: TPointF); virtual; + procedure Scale(sx,sy: single); overload; + procedure Scale(factor: single); overload; + function GetScanCustomColorspace: TColorspaceAny; override; + procedure ScanMoveTo(X, Y: Integer); override; + procedure ScanMoveToF(X, Y: single); inline; + function ScanNextPixel: TBGRAPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + property Matrix: TAffineMatrix read FMatrix write SetMatrix; + property ViewMatrix: TAffineMatrix read GetViewMatrix write SetViewMatrix; + end; + + { If you don't want the bitmap to repeats itself, or want to specify the + resample filter, or want to fit easily the bitmap on axes, + use TBGRAAffineBitmapTransform instead of TBGRAAffineScannerTransform } + + { TBGRAAffineBitmapTransform } + + TBGRAAffineBitmapTransform = class(TBGRAAffineScannerTransform) + protected + FBitmap: TBGRACustomBitmap; + FRepeatImageX,FRepeatImageY: boolean; + FResampleFilter : TResampleFilter; + FBuffer: PBGRAPixel; + FBufferSize: Int32or64; + FIncludeEdges: boolean; + procedure Init(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean= false; ARepeatImageY: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); + public + constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImage: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); overload; + constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean; ARepeatImageY: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); overload; + destructor Destroy; override; + function InternalScanCurrentPixel: TBGRAPixel; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + function IsScanPutPixelsDefined: boolean; override; + procedure Fit(Origin, HAxis, VAxis: TPointF); override; + end; + + { TBGRAQuadLinearScanner } + + TBGRAQuadLinearScanner = class(TBGRACustomScanner) + private + FPadding: boolean; + FPoints,FVectors: array[0..3] of TPointF; + FInvLengths,FDets: array[0..3] of single; + FCoeffs: array[0..3] of TPointF; + aa,bb0,cc0,inv2aa: double; + FSource: IBGRAScanner; + FSourceMatrix: TAffineMatrix; + FUVVector: TPointF; + + ScanParaBB, ScanParaCC, ScanParaBBInv: double; + + ScanVertV0,ScanVertVStep0,ScanVertDenom0,ScanVertDenomStep0: double; + + FHasC1, FHasC2: boolean; + FShowC1, FShowC2: boolean; + FScanFunc: TScanNextPixelFunction; + FCurXF,FCurYF: single; + FBuffer: PBGRAPixel; + FBufferSize: Int32or64; + FTextureInterpolation: Boolean; + function GetCulling: TFaceCulling; + function ScanNone: TBGRAPixel; + function ScanGeneral: TBGRAPixel; + procedure PrepareScanVert0; + function ScanVert0: TBGRAPixel; + procedure PrepareScanPara; + function ScanPara: TBGRAPixel; + procedure GetTexColorAt(u,v: Single; out AColor: TBGRAPixel; out AIsPadding: boolean); inline; + function GetTexColorAt(u,v: Single; detNeg: boolean): TBGRAPixel; inline; + procedure ScanMoveToF(X,Y: single); inline; + procedure SetCulling(AValue: TFaceCulling); + procedure Init(ASource: IBGRAScanner; const APoints: array of TPointF; + ATextureInterpolation: boolean); + public + function ScanAt(X, Y: Single): TBGRAPixel; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanMoveTo(X, Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + constructor Create(ASource: IBGRAScanner; + ASourceMatrix: TAffineMatrix; const APoints: array of TPointF; + ATextureInterpolation: boolean = true); overload; + constructor Create(ASource: IBGRAScanner; + const ATexCoords: array of TPointF; const APoints: array of TPointF; + ATextureInterpolation: boolean = true); overload; + destructor Destroy; override; + property Culling: TFaceCulling read GetCulling write SetCulling; + property Padding: boolean read FPadding write FPadding; + end; + + { TBGRABitmapScanner } + + TBGRABitmapScanner = class(TBGRACustomScanner) + protected + FSource: TBGRACustomBitmap; + FRepeatX,FRepeatY: boolean; + FScanline: PBGRAPixel; + FCurX: integer; + FOrigin: TPoint; + public + constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean; AOrigin: TPoint); + procedure ScanMoveTo(X, Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + end; + + { TBGRAExtendedBorderScanner } + + TBGRAExtendedBorderScanner = class(TBGRACustomScanner) + protected + FSource: IBGRAScanner; + FBounds: TRect; + public + constructor Create(ASource: IBGRAScanner; ABounds: TRect); + function ScanAt(X,Y: Single): TBGRAPixel; override; + end; + + { TBGRAScannerOffset } + + TBGRAScannerOffset = class(TBGRACustomScanner) + protected + FSource: IBGRAScanner; + FOffset: TPoint; + public + constructor Create(ASource: IBGRAScanner; AOffset: TPoint); + destructor Destroy; override; + procedure ScanMoveTo(X, Y: Integer); override; + function ScanNextPixel: TBGRAPixel; override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + function IsScanPutPixelsDefined: boolean; override; + procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; + procedure ScanSkipPixels(ACount: integer); override; + end; + + +{---------------------- Affine matrix functions -------------------} +//fill a matrix +function AffineMatrix(m11,m12,m13,m21,m22,m23: single): TAffineMatrix; overload; +function AffineMatrix(AU,AV: TPointF; ATranslation: TPointF): TAffineMatrix; overload; + +//matrix multiplication +operator *(M,N: TAffineMatrix): TAffineMatrix; +operator =(M,N: TAffineMatrix): boolean; + +//matrix multiplication by a vector (apply transformation to that vector) +operator *(M: TAffineMatrix; V: TPointF): TPointF; +operator *(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF; +operator *(M: TAffineMatrix; ab: TAffineBox): TAffineBox; + +//check if matrix is inversible +function IsAffineMatrixInversible(M: TAffineMatrix): boolean; + +//check if the matrix is a translation (including the identity) +function IsAffineMatrixTranslation(M: TAffineMatrix): boolean; + +//check if the matrix is a scaling (including a projection i.e. with factor 0) +function IsAffineMatrixScale(M: TAffineMatrix): boolean; + +//check if the matrix is the identity +function IsAffineMatrixIdentity(M: TAffineMatrix): boolean; + +//compute inverse (check if inversible before) +function AffineMatrixInverse(M: TAffineMatrix): TAffineMatrix; + +//define a translation matrix +function AffineMatrixTranslation(OfsX,OfsY: Single): TAffineMatrix; + +//define a scaling matrix +function AffineMatrixScale(sx,sy: single): TAffineMatrix; +function AffineMatrixScaledRotation(ASourceVector, ATargetVector: TPointF): TAffineMatrix; +function AffineMatrixScaledRotation(ASourcePoint, ATargetPoint, AOrigin: TPointF): TAffineMatrix; + +function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix; +function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix; +function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix; +function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix; + +//define a linear matrix +function AffineMatrixLinear(v1,v2: TPointF): TAffineMatrix; overload; +function AffineMatrixLinear(const AMatrix: TAffineMatrix): TAffineMatrix; overload; + +//define a rotation matrix (positive radians are counter-clockwise) +//(assuming the y-axis is pointing down) +function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix; + +//Positive degrees are clockwise +//(assuming the y-axis is pointing down) +function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix; + +//define the identity matrix (that do nothing) +function AffineMatrixIdentity: TAffineMatrix; + +function IsAffineMatrixOrthogonal(M: TAffineMatrix): boolean; +function IsAffineMatrixScaledRotation(M: TAffineMatrix): boolean; + +type + { TBGRATriangleLinearMapping is a scanner that provides + an optimized transformation for linear texture mapping + on triangles } + + { TBGRATriangleLinearMapping } + + TBGRATriangleLinearMapping = class(TBGRACustomScanner) + protected + FScanner: IBGRAScanner; + FMatrix: TAffineMatrix; + FTexCoord1,FDiff2,FDiff3,FStep: TPointF; + FCurTexCoord: TPointF; + FScanAtFunc: TScanAtFunction; + public + constructor Create(AScanner: IBGRAScanner; pt1,pt2,pt3: TPointF; tex1,tex2,tex3: TPointF); + procedure ScanMoveTo(X,Y: Integer); override; + procedure ScanMoveToF(X,Y: Single); + function ScanAt(X,Y: Single): TBGRAPixel; override; + function ScanNextPixel: TBGRAPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + end; + +type + TPerspectiveTransform = class; + + { TBGRAPerspectiveScannerTransform } + + TBGRAPerspectiveScannerTransform = class(TBGRACustomScanner) + private + FTexture: IBGRAScanner; + FMatrix: TPerspectiveTransform; + FScanAtProc: TScanAtFunction; + function GetIncludeOppositePlane: boolean; + procedure SetIncludeOppositePlane(AValue: boolean); + public + constructor Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF); overload; + constructor Create(texture: IBGRAScanner; const texCoordsQuad: array of TPointF; const quad: array of TPointF); overload; + destructor Destroy; override; + procedure ScanMoveTo(X, Y: Integer); override; + function ScanAt(X, Y: Single): TBGRAPixel; override; + function ScanNextPixel: TBGRAPixel; override; + procedure ScanSkipPixels(ACount: integer); override; + property IncludeOppositePlane: boolean read GetIncludeOppositePlane write SetIncludeOppositePlane; + end; + + { TPerspectiveTransform } + + TPerspectiveTransform = class + private + sx ,shy ,w0 ,shx ,sy ,w1 ,tx ,ty ,w2 : single; + scanDenom,scanNumX,scanNumY: single; + FOutsideValue: TPointF; + FIncludeOppositePlane: boolean; + procedure Init; + public + constructor Create; overload; + constructor Create(x1,y1,x2,y2: single; const quad: array of TPointF); overload; + constructor Create(const quad: array of TPointF; x1,y1,x2,y2: single); overload; + constructor Create(const srcQuad,destQuad: array of TPointF); overload; + function MapQuadToQuad(const srcQuad,destQuad: array of TPointF): boolean; + function MapRectToQuad(x1,y1,x2,y2: single; const quad: array of TPointF): boolean; + function MapQuadToRect(const quad: array of TPointF; x1,y1,x2,y2: single): boolean; + function MapSquareToQuad(const quad: array of TPointF): boolean; + function MapQuadToSquare(const quad: array of TPointF): boolean; + procedure AssignIdentity; + function Invert: boolean; + procedure Translate(dx,dy: single); + procedure MultiplyBy(a: TPerspectiveTransform); + procedure PremultiplyBy(b: TPerspectiveTransform); + function Duplicate: TPerspectiveTransform; + function Apply(pt: TPointF): TPointF; + procedure ScanMoveTo(x,y:single); + function ScanNext: TPointF; + procedure ScanSkip(ACount: integer); + property OutsideValue: TPointF read FOutsideValue write FOutsideValue; + property IncludeOppositePlane: boolean read FIncludeOppositePlane write FIncludeOppositePlane; + end; + +type + { TBGRATwirlScanner applies a twirl transformation. + + Note : this scanner handles integer coordinates only, so + any further transformation applied after this one may not + render correctly. } + + { TBGRATwirlScanner } + + TBGRATwirlScanner = Class(TBGRACustomScanner) + protected + FScanner: IBGRAScanner; + FScanAtFunc: TScanAtFunction; + FCenter: TPoint; + FTurn, FRadius, FExponent: Single; + public + constructor Create(AScanner: IBGRAScanner; ACenter: TPoint; ARadius: single; ATurn: single = 1; AExponent: single = 3); + function ScanAt(X, Y: Single): TBGRAPixel; override; + property Radius: Single read FRadius; + property Center: TPoint read FCenter; + property Exponent: Single read FExponent; + end; + + { TBGRASphereDeformationScanner } + + TBGRASphereDeformationScanner = Class(TBGRACustomScanner) + protected + FScanner: IBGRAScanner; + FScanAtFunc: TScanAtFunction; + FCenter: TPointF; + FRadiusX, FRadiusY: Single; + public + constructor Create(AScanner: IBGRAScanner; ACenter: TPointF; ARadiusX,ARadiusY: single); + function ScanAt(X, Y: Single): TBGRAPixel; override; + property RadiusX: Single read FRadiusX; + property RadiusY: Single read FRadiusY; + end; + + { TBGRAVerticalCylinderDeformationScanner } + + TBGRAVerticalCylinderDeformationScanner = Class(TBGRACustomScanner) + protected + FScanner: IBGRAScanner; + FScanAtFunc: TScanAtFunction; + FCenterX: single; + FRadiusX: Single; + public + constructor Create(AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single); + function ScanAt(X, Y: Single): TBGRAPixel; override; + property RadiusX: Single read FRadiusX; + end; + + +implementation + +uses BGRABlend, Math; + +function AffineMatrix(m11, m12, m13, m21, m22, m23: single): TAffineMatrix; +begin + result[1,1] := m11; + result[1,2] := m12; + result[1,3] := m13; + result[2,1] := m21; + result[2,2] := m22; + result[2,3] := m23; +end; + +function AffineMatrix(AU, AV: TPointF; ATranslation: TPointF): TAffineMatrix; +begin + result:= AffineMatrix(AU.x, AV.x, ATranslation.x, + AU.y, AV.y, ATranslation.y); +end; + +operator *(M, N: TAffineMatrix): TAffineMatrix; +begin + result[1,1] := M[1,1]*N[1,1] + M[1,2]*N[2,1]; + result[1,2] := M[1,1]*N[1,2] + M[1,2]*N[2,2]; + result[1,3] := M[1,1]*N[1,3] + M[1,2]*N[2,3] + M[1,3]; + + result[2,1] := M[2,1]*N[1,1] + M[2,2]*N[2,1]; + result[2,2] := M[2,1]*N[1,2] + M[2,2]*N[2,2]; + result[2,3] := M[2,1]*N[1,3] + M[2,2]*N[2,3] + M[2,3]; +end; + +operator=(M, N: TAffineMatrix): boolean; +begin + result := CompareMem(@M,@N,SizeOf(TAffineMatrix)); +end; + +operator*(M: TAffineMatrix; V: TPointF): TPointF; +begin + if isEmptyPointF(V) then + result := EmptyPointF + else + begin + result.X := V.X*M[1,1]+V.Y*M[1,2]+M[1,3]; + result.Y := V.X*M[2,1]+V.Y*M[2,2]+M[2,3]; + end; +end; + +operator*(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF; +var + i: Int32or64; + ofs: TPointF; +begin + setlength(result, length(A)); + if IsAffineMatrixTranslation(M) then + begin + ofs := PointF(M[1,3],M[2,3]); + for i := 0 to high(A) do + result[i] := A[i]+ofs; + end else + for i := 0 to high(A) do + result[i] := M*A[i]; +end; + +operator*(M: TAffineMatrix; ab: TAffineBox): TAffineBox; +begin + result.TopLeft := M*ab.TopLeft; + result.TopRight := M*ab.TopRight; + result.BottomLeft := M*ab.BottomLeft; +end; + +function IsAffineMatrixInversible(M: TAffineMatrix): boolean; +begin + result := M[1,1]*M[2,2]-M[1,2]*M[2,1] <> 0; +end; + +function IsAffineMatrixTranslation(M: TAffineMatrix): boolean; +begin + result := (m[1,1]=1) and (m[1,2]=0) and (m[2,1] = 0) and (m[2,2]=1); +end; + +function IsAffineMatrixScale(M: TAffineMatrix): boolean; +begin + result := (M[1,3]=0) and (M[2,3]=0) and + (M[1,2]=0) and (M[2,1]=0); +end; + +function IsAffineMatrixIdentity(M: TAffineMatrix): boolean; +begin + result := IsAffineMatrixTranslation(M) and (M[1,3]=0) and (M[2,3]=0); +end; + +function AffineMatrixInverse(M: TAffineMatrix): TAffineMatrix; +var det,f: single; + linearInverse: TAffineMatrix; +begin + det := M[1,1]*M[2,2]-M[1,2]*M[2,1]; + if det = 0 then + raise Exception.Create('Not inversible'); + f := 1/det; + linearInverse := AffineMatrix(M[2,2]*f,-M[1,2]*f,0, + -M[2,1]*f,M[1,1]*f,0); + result := linearInverse * AffineMatrixTranslation(-M[1,3],-M[2,3]); +end; + +function AffineMatrixTranslation(OfsX, OfsY: Single): TAffineMatrix; +begin + result := AffineMatrix(1, 0, OfsX, + 0, 1, OfsY); +end; + +function AffineMatrixScale(sx, sy: single): TAffineMatrix; +begin + result := AffineMatrix(sx, 0, 0, + 0, sy, 0); +end; + +function AffineMatrixScaledRotation(ASourceVector, ATargetVector: TPointF): TAffineMatrix; +var + prevScale, newScale, scale: Single; + u1,v1,u2,v2,w: TPointF; +begin + prevScale := VectLen(ASourceVector); + newScale := VectLen(ATargetVector); + if (prevScale = 0) or (newScale = 0) then + result := AffineMatrixIdentity + else + begin + scale := newScale/prevScale; + u1 := ASourceVector*(1/prevScale); + v1 := PointF(-u1.y,u1.x); + w := ATargetVector*(1/newScale); + u2 := PointF(w*u1, w*v1); + v2 := PointF(-u2.y,u2.x); + result := AffineMatrix(scale*u2,scale*v2,PointF(0,0)); + end; +end; + +function AffineMatrixScaledRotation(ASourcePoint, ATargetPoint, AOrigin: TPointF): TAffineMatrix; +begin + result := AffineMatrixTranslation(AOrigin.x,AOrigin.y)* + AffineMatrixScaledRotation(ASourcePoint-AOrigin, ATargetPoint-AOrigin)* + AffineMatrixTranslation(-AOrigin.x,-AOrigin.y); +end; + +function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix; +begin + result := AffineMatrix(1,tan(AngleCW*Pi/180),0, + 0, 1, 0); +end; + +function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix; +begin + result := AffineMatrix(1, 0, 0, + tan(AngleCW*Pi/180), 1, 0) +end; + +function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix; +begin + + result := AffineMatrix(1,tan(-AngleCCW),0, + 0, 1, 0); +end; + +function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix; +begin + result := AffineMatrix(1, 0, 0, + tan(-angleCCW), 1, 0) +end; + +function AffineMatrixLinear(v1,v2: TPointF): TAffineMatrix; +begin + result := AffineMatrix(v1.x, v2.x, 0, + v1.y, v2.y, 0); +end; + +function AffineMatrixLinear(const AMatrix: TAffineMatrix): TAffineMatrix; +begin + result := AffineMatrix(AMatrix[1,1],AMatrix[1,2],0, + AMatrix[2,1],AMatrix[2,2],0); +end; + +function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix; +begin + result := AffineMatrix(cos(AngleCCW), sin(AngleCCW), 0, + -sin(AngleCCW), cos(AngleCCW), 0); +end; + +function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix; +const DegToRad = -Pi/180; +begin + result := AffineMatrixRotationRad(AngleCW*DegToRad); +end; + +function AffineMatrixIdentity: TAffineMatrix; +begin + result := AffineMatrix(1, 0, 0, + 0, 1, 0); +end; + +function IsAffineMatrixOrthogonal(M: TAffineMatrix): boolean; +begin + result := PointF(M[1,1],M[2,1])*PointF(M[1,2],M[2,2]) = 0; +end; + +function IsAffineMatrixScaledRotation(M: TAffineMatrix): boolean; +begin + result := IsAffineMatrixOrthogonal(M) and + (VectLen(PointF(M[1,1],M[2,1]))=VectLen(PointF(M[1,2],M[2,2]))); +end; + +{ TBGRAVerticalCylinderDeformationScanner } + +constructor TBGRAVerticalCylinderDeformationScanner.Create( + AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single); +begin + FScanner := AScanner; + FScanAtFunc := @FScanner.ScanAt; + FCenterX := ACenterX; + FRadiusX := ARadiusX; +end; + +function TBGRAVerticalCylinderDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel; +var + xn,len,fact: Single; +begin + xn := (x - FCenterX) / FRadiusX; + len := abs(xn); + if (len <= 1) then + begin + if (len > 0) then + begin + fact := 1 / len * arcsin(len) / (Pi / 2); + xn := xn * fact; + end; + result := FScanAtFunc(xn * FRadiusX + FCenterX, y); + end + else + result := BGRAPixelTransparent; +end; + +{ TBGRASphereDeformationScanner } + +constructor TBGRASphereDeformationScanner.Create(AScanner: IBGRAScanner; + ACenter: TPointF; ARadiusX, ARadiusY: single); +begin + FScanner := AScanner; + FScanAtFunc := @FScanner.ScanAt; + FCenter := ACenter; + FRadiusX := ARadiusX; + FRadiusY := ARadiusY; +end; + +function TBGRASphereDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel; +var + xn, yn, len,fact: Single; +begin + xn := (x - FCenter.X) / FRadiusX; + yn := (y - FCenter.Y) / FRadiusY; + len := sqrt(sqr(xn) + sqr(yn)); + if (len <= 1) then + begin + if (len > 0) then + begin + fact := 1 / len * arcsin(len) / (Pi / 2); + xn := xn * fact; + yn := yn * fact; + end; + result := FScanAtFunc(xn * FRadiusX + FCenter.X, yn * FRadiusY + FCenter.Y); + end + else + result := BGRAPixelTransparent; +end; + +{ TBGRAExtendedBorderScanner } + +constructor TBGRAExtendedBorderScanner.Create(ASource: IBGRAScanner; + ABounds: TRect); +begin + FSource := ASource; + FBounds := ABounds; +end; + +function TBGRAExtendedBorderScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + if x < FBounds.Left then x := FBounds.Left; + if y < FBounds.Top then y := FBounds.Top; + if x > FBounds.Right-1 then x := FBounds.Right-1; + if y > FBounds.Bottom-1 then y := FBounds.Bottom-1; + result := FSource.ScanAt(X,Y); +end; + +{ TBGRAScannerOffset } + +constructor TBGRAScannerOffset.Create(ASource: IBGRAScanner; AOffset: TPoint); +begin + FSource := ASource; + FOffset := AOffset; +end; + +destructor TBGRAScannerOffset.Destroy; +begin + fillchar(FSource,sizeof(FSource),0); + inherited Destroy; +end; + +procedure TBGRAScannerOffset.ScanMoveTo(X, Y: Integer); +begin + FSource.ScanMoveTo(X-FOffset.X,Y-FOffset.Y); +end; + +function TBGRAScannerOffset.ScanNextPixel: TBGRAPixel; +begin + Result:=FSource.ScanNextPixel; +end; + +function TBGRAScannerOffset.ScanAt(X, Y: Single): TBGRAPixel; +begin + Result:=FSource.ScanAt(X - FOffset.X, Y - FOffset.Y); +end; + +function TBGRAScannerOffset.IsScanPutPixelsDefined: boolean; +begin + Result:=FSource.IsScanPutPixelsDefined; +end; + +procedure TBGRAScannerOffset.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +begin + FSource.ScanPutPixels(pdest, count, mode); +end; + +procedure TBGRAScannerOffset.ScanSkipPixels(ACount: integer); +begin + FSource.ScanSkipPixels(ACount); +end; + +{ TBGRABitmapScanner } + +constructor TBGRABitmapScanner.Create(ASource: TBGRACustomBitmap; ARepeatX, + ARepeatY: boolean; AOrigin: TPoint); +begin + FSource := ASource; + FRepeatX := ARepeatX; + FRepeatY := ARepeatY; + FScanline := nil; + FOrigin := AOrigin; +end; + +procedure TBGRABitmapScanner.ScanMoveTo(X, Y: Integer); +begin + if (FSource.NbPixels = 0) then + begin + FScanline := nil; + exit; + end; + Inc(Y,FOrigin.Y); + if FRepeatY then Y := PositiveMod(Y,FSource.Height); + if (Y < 0) or (Y >= FSource.Height) then + begin + FScanline := nil; + exit; + end; + FScanline := FSource.Scanline[Y]; + FCurX := X+FOrigin.X; + if FRepeatX then FCurX := PositiveMod(FCurX, FSource.Width); +end; + +function TBGRABitmapScanner.ScanNextPixel: TBGRAPixel; +begin + if (FScanline = nil) then + begin + result := BGRAPixelTransparent; + exit; + end; + if FRepeatX then + begin + result := (FScanline+FCurX)^; + inc(FCurX); + if FCurX = FSource.Width then FCurX := 0; + end else + begin + if (FCurX >= FSource.Width) then + begin + result := BGRAPixelTransparent; + exit; + end; + if FCurX < 0 then + result := BGRAPixelTransparent + else + result := (FScanline+FCurX)^; + inc(FCurX); + end; +end; + +function TBGRABitmapScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + Result := FSource.GetPixelCycle(X+FOrigin.X,Y+FOrigin.Y,rfLinear,FRepeatX,FRepeatY); +end; + +procedure TBGRABitmapScanner.ScanSkipPixels(ACount: integer); +begin + if FScanLine <> nil then + begin + inc(FCurX, ACount); + if FCurX > FSource.Width then FCurX := PositiveMod(FCurX, FSource.Width); + end; +end; + +{ TBGRATriangleLinearMapping } + +constructor TBGRATriangleLinearMapping.Create(AScanner: IBGRAScanner; pt1, pt2, + pt3: TPointF; tex1, tex2, tex3: TPointF); +begin + FScanner := AScanner; + FScanAtFunc := @FScanner.ScanAt; + + FMatrix := AffineMatrix(pt2.X-pt1.X, pt3.X-pt1.X, 0, + pt2.Y-pt1.Y, pt3.Y-pt1.Y, 0); + if not IsAffineMatrixInversible(FMatrix) then + FMatrix := AffineMatrix(0,0,0,0,0,0) + else + FMatrix := AffineMatrixInverse(FMatrix) * AffineMatrixTranslation(-pt1.x,-pt1.y); + + FTexCoord1 := tex1; + FDiff2 := tex2-tex1; + FDiff3 := tex3-tex1; + FStep := FDiff2*FMatrix[1,1]+FDiff3*FMatrix[2,1]; +end; + +procedure TBGRATriangleLinearMapping.ScanMoveTo(X, Y: Integer); +begin + ScanMoveToF(X, Y); +end; + +procedure TBGRATriangleLinearMapping.ScanMoveToF(X, Y: Single); +var + Cur: TPointF; +begin + Cur := FMatrix*PointF(X,Y); + FCurTexCoord := FTexCoord1+FDiff2*Cur.X+FDiff3*Cur.Y; +end; + +function TBGRATriangleLinearMapping.ScanAt(X, Y: Single): TBGRAPixel; +begin + ScanMoveToF(X,Y); + result := ScanNextPixel; +end; + +function TBGRATriangleLinearMapping.ScanNextPixel: TBGRAPixel; +begin + result := FScanAtFunc(FCurTexCoord.X,FCurTexCoord.Y); + FCurTexCoord.Offset(FStep); +end; + +procedure TBGRATriangleLinearMapping.ScanSkipPixels(ACount: integer); +begin + FCurTexCoord.Offset(FStep*ACount); +end; + +{ TBGRAAffineScannerTransform } + +constructor TBGRAAffineScannerTransform.Create(AScanner: IBGRAScanner); +begin + FScanner := AScanner; + FScanAtFunc := @FScanner.ScanAt; + GlobalOpacity := 255; + Reset; +end; + +procedure TBGRAAffineScannerTransform.Reset; +begin + FMatrix := AffineMatrixIdentity; + FEmptyMatrix := False; +end; + +procedure TBGRAAffineScannerTransform.Invert; +begin + if not FEmptyMatrix and IsAffineMatrixInversible(FMatrix) then + FMatrix := AffineMatrixInverse(FMatrix) else + FEmptyMatrix := True; +end; + +function TBGRAAffineScannerTransform.GetViewMatrix: TAffineMatrix; +begin + if FEmptyMatrix then + result := AffineMatrixIdentity + else + result := AffineMatrixInverse(FMatrix); +end; + +procedure TBGRAAffineScannerTransform.SetViewMatrix(AValue: TAffineMatrix); +begin + Matrix := AValue; + Invert; +end; + +procedure TBGRAAffineScannerTransform.SetMatrix(AMatrix: TAffineMatrix); +begin + FEmptyMatrix := False; + FMatrix := AMatrix; +end; + +//transformations are inverted because the effect on the resulting image +//is the inverse of the transformation. This is due to the fact +//that the matrix is applied to source coordinates, not destination coordinates +procedure TBGRAAffineScannerTransform.Translate(OfsX, OfsY: Single); +begin + MultiplyBy(AffineMatrixTranslation(-OfsX,-OfsY)); +end; + +procedure TBGRAAffineScannerTransform.RotateDeg(AngleCW: Single); +begin + MultiplyBy(AffineMatrixRotationDeg(-AngleCW)); +end; + +procedure TBGRAAffineScannerTransform.RotateRad(AngleCCW: Single); +begin + MultiplyBy(AffineMatrixRotationRad(-AngleCCW)); +end; + +procedure TBGRAAffineScannerTransform.MultiplyBy(AMatrix: TAffineMatrix); +begin + FMatrix := FMatrix * AMatrix; +end; + +procedure TBGRAAffineScannerTransform.Fit(Origin, HAxis, VAxis: TPointF); +begin + SetMatrix(AffineMatrix(HAxis.X-Origin.X, VAxis.X-Origin.X, 0, + HAxis.Y-Origin.Y, VAxis.Y-Origin.Y, 0)); + Invert; + Translate(Origin.X,Origin.Y); +end; + +procedure TBGRAAffineScannerTransform.Scale(sx, sy: single); +begin + if (sx=0) or (sy=0) then + begin + FEmptyMatrix := True; + exit; + end; + + MultiplyBy(AffineMatrixScale(1/sx,1/sy)); +end; + +procedure TBGRAAffineScannerTransform.Scale(factor: single); +begin + Scale(factor,factor); +end; + +function TBGRAAffineScannerTransform.GetScanCustomColorspace: TColorspaceAny; +begin + Result:= TBGRAPixelColorspace; +end; + +procedure TBGRAAffineScannerTransform.ScanMoveTo(X, Y: Integer); +begin + ScanMoveToF(X,Y); +end; + +procedure TBGRAAffineScannerTransform.ScanMoveToF(X, Y: single); +begin + FCur := FMatrix * PointF(X,Y); +end; + +function TBGRAAffineScannerTransform.InternalScanCurrentPixel: TBGRAPixel; +begin + if FEmptyMatrix then + begin + result := BGRAPixelTransparent; + exit; + end; + result := FScanAtFunc(FCur.X,FCur.Y); +end; + +function TBGRAAffineScannerTransform.ScanNextPixel: TBGRAPixel; +begin + result := InternalScanCurrentPixel; + FCur.Offset(FMatrix[1,1], FMatrix[2,1]); + if GlobalOpacity <> 255 then result.alpha := ApplyOpacity(result.alpha,GlobalOpacity); +end; + +procedure TBGRAAffineScannerTransform.ScanSkipPixels(ACount: integer); +begin + FCur.Offset(FMatrix[1,1]*ACount, FMatrix[2,1]*ACount); +end; + +function TBGRAAffineScannerTransform.ScanAt(X, Y: Single): TBGRAPixel; +begin + ScanMoveToF(X,Y); + result := InternalScanCurrentPixel; + if GlobalOpacity <> 255 then result.alpha := ApplyOpacity(result.alpha,GlobalOpacity); +end; + +{ TBGRAQuadLinearScanner } + +function TBGRAQuadLinearScanner.GetTexColorAt(u, v: Single; detNeg: boolean + ): TBGRAPixel; +var isPadding: boolean; +begin + if detNeg then + begin + if not FShowC2 then + begin + result := BGRAPixelTransparent; + exit; + end; + end else + if not FShowC1 then + begin + result := BGRAPixelTransparent; + exit; + end; + GetTexColorAt(u,v,result,isPadding); +end; + +procedure TBGRAQuadLinearScanner.ScanMoveToF(X, Y: single); +begin + if not (FHasC1 and FShowC1) and not (FHasC2 and FShowC2) then + begin + FScanFunc := @ScanNone; + exit; + end; + FCurXF := X; + FCurYF := Y; + if (FVectors[0].x = 0) and (FVectors[2].x = 0) then + begin + PrepareScanVert0; + FScanFunc := @ScanVert0; + end else + if aa = 0 then + begin + PrepareScanPara; + FScanFunc := @ScanPara + end + else + FScanFunc := @ScanGeneral; +end; + +procedure TBGRAQuadLinearScanner.SetCulling(AValue: TFaceCulling); +begin + FShowC1 := AValue in [fcKeepCW,fcNone]; + FShowC2 := AValue in [fcKeepCCW,fcNone]; +end; + +procedure TBGRAQuadLinearScanner.Init(ASource: IBGRAScanner; + const APoints: array of TPointF; ATextureInterpolation: boolean); +var + i: Int32or64; + v: TPointF; + len: single; +begin + if length(APoints)<>4 then + raise exception.Create('Expecting 4 points'); + FTextureInterpolation:= ATextureInterpolation; + FSource := ASource; + FSourceMatrix := AffineMatrixIdentity; + FUVVector := PointF(0,0); + for i := 0 to 3 do + begin + FPoints[i] := APoints[i]; + v := APoints[(i+1) mod 4] - APoints[i]; + len := sqrt(v*v); + if len > 0 then FInvLengths[i] := 1/len + else FInvLengths[i] := 0; + FVectors[i] := v*FInvLengths[i]; + end; + + FCoeffs[0] := FPoints[0]; + FCoeffs[1] := FPoints[1]-FPoints[0]; + FCoeffs[2] := FPoints[3]-FPoints[0]; + FCoeffs[3] := FPoints[0]+FPoints[2]-FPoints[1]-FPoints[3]; + + aa := VectDet(FCoeffs[3],FCoeffs[2]); + bb0 := VectDet(FCoeffs[3],FCoeffs[0]) + VectDet(FCoeffs[1],FCoeffs[2]); + cc0 := VectDet(FCoeffs[1],FCoeffs[0]); + for i := 0 to 3 do + FDets[i] := VectDet(FVectors[i],FVectors[(i+1) mod 4]); + if aa <> 0 then inv2aa := 1/(2*aa) else inv2aa := 1; + + FShowC1 := true; + FShowC2 := true; + + FHasC1 := false; + FHasC2 := false; + for i := 0 to 3 do + if FDets[i] > 0 then FHasC1 := true + else if FDets[i] < 0 then FHasC2 := true; + + FBuffer := nil; + FBufferSize := 0; + + ScanMoveToF(0,0); +end; + +function TBGRAQuadLinearScanner.ScanAt(X, Y: Single): TBGRAPixel; +begin + ScanMoveToF(X,Y); + Result:= FScanFunc(); +end; + +procedure TBGRAQuadLinearScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; + mode: TDrawMode); +var + n: Int32or64; + p: PBGRAPixel; +begin + if mode = dmSet then + p := pdest + else + begin + if count > FBufferSize then + begin + FBufferSize := count; + ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel)); + end; + p := FBuffer; + end; + for n := count-1 downto 0 do + begin + p^ := FScanFunc(); + inc(p); + end; + if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255); +end; + +function TBGRAQuadLinearScanner.IsScanPutPixelsDefined: boolean; +begin + result := true; +end; + +procedure TBGRAQuadLinearScanner.ScanMoveTo(X, Y: Integer); +begin + ScanMoveToF(X,Y); +end; + +function TBGRAQuadLinearScanner.ScanNextPixel: TBGRAPixel; +begin + Result:= FScanFunc(); +end; + +procedure TBGRAQuadLinearScanner.ScanSkipPixels(ACount: integer); +begin + ScanMoveToF(FCurXF+ACount,FCurYF); +end; + +function TBGRAQuadLinearScanner.ScanGeneral: TBGRAPixel; +var u1,u2,v1,v2,x,y: double; + bb,cc,det,delta,denom: double; + mergeC1,mergeC2: boolean; + isPad1,isPad2: boolean; + c1,c2: TBGRAPixel; +begin + x := FCurXF; + y := FCurYF; + IncF(FCurXF, 1); + if (Y = FPoints[0].y) and (FVectors[0].y = 0) then + begin + if FVectors[0].x = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + u1 := (X - FPoints[0].x)/(FPoints[1].x-FPoints[0].x); + result := GetTexColorAt(u1,0,FDets[0]<0); + exit; + end; + if (X = FPoints[1].x) and (FVectors[1].x = 0) then + begin + if FVectors[1].y = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + v1 := (Y - FPoints[1].y)/(FPoints[2].y-FPoints[1].y); + result := GetTexColorAt(0,v1,FDets[1]<0); + end; + if (Y = FPoints[2].y) and (FVectors[2].y = 0) then + begin + if FVectors[2].x = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + u1 := (X - FPoints[3].x)/(FPoints[2].x-FPoints[3].x); + result := GetTexColorAt(u1,1,FDets[2]<0); + end; + if (X = FPoints[3].x) and (FVectors[3].x = 0) then + begin + if FVectors[3].y = 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + v1 := (Y - FPoints[0].y)/(FPoints[3].y-FPoints[0].y); + result := GetTexColorAt(0,v1,FDets[3]<0); + end; + + bb := bb0 + x*FCoeffs[3].y - y*FCoeffs[3].x; + cc := cc0 + x*FCoeffs[1].y - y*FCoeffs[1].x; + if cc = 0 then + begin + v1 := -bb*2*inv2aa; + denom := FCoeffs[1].x+FCoeffs[3].x*v1; + if denom = 0 then + begin + result := BGRAPixelTransparent; + exit; + end + else + u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom; + + result := GetTexColorAt(u1,v1,bb<0); + end else + begin + delta := bb*bb - 4*aa*cc; + + if delta < 0 then + begin + result := BGRAPixelTransparent; + exit; + end; + det := sqrt(delta); + + if FHasC1 and FShowC1 then + begin + mergeC1 := true; + v1 := (-bb+det)*inv2aa; + if v1 = 0 then + u1 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0]) + else if v1 = 1 then + u1 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2]) + else + begin + denom := FCoeffs[1].x+FCoeffs[3].x*v1; + if abs(denom)<1e-6 then + begin + u1 := (bb+det)*inv2aa; + denom := FCoeffs[1].y+FCoeffs[3].y*u1; + if denom = 0 then mergeC1 := false + else v1 := (y-FCoeffs[0].y-FCoeffs[2].y*u1)/denom; + end + else u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom; + end; + end else + begin + u1 := 0; + v1 := 0; + mergeC1 := false; + end; + + if FHasC2 and FShowC2 then + begin + mergeC2 := true; + v2 := (-bb-det)*inv2aa; + if v2 = 0 then + u2 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0]) + else if v2 = 1 then + u2 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2]) + else + begin + denom := FCoeffs[1].x+FCoeffs[3].x*v2; + if abs(denom)<1e-6 then + begin + u2 := (bb-det)*inv2aa; + denom := FCoeffs[1].y+FCoeffs[3].y*u2; + if denom = 0 then mergeC2 := false + else v2 := (y-FCoeffs[0].y-FCoeffs[2].y*u2)/denom; + end + else u2 := (x-FCoeffs[0].x-FCoeffs[2].x*v2)/denom; + end; + end else + begin + u2 := 0; + v2 := 0; + mergeC2 := false; + end; + + if mergeC1 then + begin + if mergeC2 then + begin + GetTexColorAt(u1,v1,c1,isPad1); + GetTexColorAt(u2,v2,c2,isPad2); + if isPad1 then + begin + if isPad2 then result := MergeBGRA(c1,c2) + else result := c2; + end else + begin + if isPad2 then result := c1 + else result := MergeBGRA(c1,c2); + end; + end + else GetTexColorAt(u1,v1,result,isPad1); + end + else + if mergeC2 then + GetTexColorAt(u2,v2,result,isPad2) + else result := BGRAPixelTransparent; + end; +end; + +function TBGRAQuadLinearScanner.GetCulling: TFaceCulling; +begin + if FShowC1 and FShowC2 then + result := fcNone + else if FShowC1 then + result := fcKeepCW + else + result := fcKeepCCW; +end; + +function TBGRAQuadLinearScanner.ScanNone: TBGRAPixel; +begin + result := BGRAPixelTransparent; +end; + +procedure TBGRAQuadLinearScanner.PrepareScanVert0; +begin + if (FVectors[1].x <> 0) then + begin + ScanVertVStep0 := 1/(FPoints[2].x-FPoints[1].x); + ScanVertV0 := (FCurXF-FPoints[1].x)*ScanVertVStep0; + ScanVertDenom0 := (FPoints[1].y-FPoints[0].y)*(1-ScanVertV0) + (FPoints[2].y-FPoints[3].y)*ScanVertV0; + ScanVertDenomStep0 := (FPoints[2].y-FPoints[3].y-FPoints[1].y+FPoints[0].y)*ScanVertVStep0; + end + else + begin + ScanVertV0 := 0; + ScanVertVStep0 := EmptySingle; + end; +end; + +function TBGRAQuadLinearScanner.ScanVert0: TBGRAPixel; +var u: single; + isPad: boolean; +begin + IncF(FCurXF, 1); + if ScanVertVStep0 = EmptySingle then + begin + result := BGRAPixelTransparent; + exit; + end; + if ScanVertDenom0 = 0 then + result := BGRAPixelTransparent + else + begin + u := (FCurYF-(FPoints[0].y*(1-ScanVertV0) + FPoints[3].y*ScanVertV0))/ScanVertDenom0; + GetTexColorAt(u,ScanVertV0,result,isPad); + end; + IncF(ScanVertV0, ScanVertVStep0); + IncF(ScanVertDenom0, ScanVertDenomStep0); +end; + +procedure TBGRAQuadLinearScanner.PrepareScanPara; +begin + ScanParaBB := bb0 + FCurXF*FCoeffs[3].y - FCurYF*FCoeffs[3].x; + ScanParaCC := cc0 + FCurXF*FCoeffs[1].y - FCurYF*FCoeffs[1].x; + if ScanParaBB <> 0 then + ScanParaBBInv := 1/ScanParaBB + else + ScanParaBBInv := 1; +end; + +function TBGRAQuadLinearScanner.ScanPara: TBGRAPixel; +var + u,v,denom: Single; + isPad: boolean; +begin + IncF(FCurXF, 1); + + if ScanParaBB = 0 then + result := BGRAPixelTransparent + else + begin + v := -ScanParaCC*ScanParaBBInv; + denom := FCoeffs[1].x+FCoeffs[3].x*v; + if denom = 0 then + result := BGRAPixelTransparent + else + begin + u := (FCurXF-1-FCoeffs[0].x-FCoeffs[2].x*v)/denom; + GetTexColorAt(u,v,result,isPad); + end; + end; + + if FCoeffs[3].y <> 0 then + begin + IncF(ScanParaBB, FCoeffs[3].y); + if ScanParaBB <> 0 then + ScanParaBBInv := 1/ScanParaBB + else + ScanParaBBInv := 1; + end; + IncF(ScanParaCC, FCoeffs[1].y); +end; + +procedure TBGRAQuadLinearScanner.GetTexColorAt(u,v: Single; out AColor: TBGRAPixel; out AIsPadding: boolean); +begin + AIsPadding:= false; + if u < 0 then begin if Padding then begin u := 0; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; + if u > 1 then begin if Padding then begin u := 1; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; + if v < 0 then begin if Padding then begin v := 0; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; + if v > 1 then begin if Padding then begin v := 1; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; + with (FSourceMatrix * PointF(u,v) + FUVVector*(u*v)) do + if FTextureInterpolation then + AColor := FSource.ScanAt(x,y) + else + AColor := FSource.ScanAtInteger(System.round(x),System.round(y)); +end; + +constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner; + ASourceMatrix: TAffineMatrix; const APoints: array of TPointF; + ATextureInterpolation: boolean); +begin + Init(ASource, APoints, ATextureInterpolation); + FSourceMatrix := ASourceMatrix; +end; + +constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner; + const ATexCoords: array of TPointF; const APoints: array of TPointF; + ATextureInterpolation: boolean); +begin + Init(ASource, APoints, ATextureInterpolation); + FSourceMatrix := AffineMatrixTranslation(ATexCoords[0].x,ATexCoords[0].y)* + AffineMatrixLinear(ATexCoords[1]-ATexCoords[0],ATexCoords[3]-ATexCoords[0]); + FUVVector := ATexCoords[2] - (ATexCoords[1]+ATexCoords[3]-ATexCoords[0]); +end; + +destructor TBGRAQuadLinearScanner.Destroy; +begin + freemem(FBuffer); + inherited Destroy; +end; + +{ TBGRAAffineBitmapTransform } + +procedure TBGRAAffineBitmapTransform.Init(ABitmap: TBGRACustomBitmap; + ARepeatImageX: Boolean; ARepeatImageY: Boolean; + AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false); +begin + if (ABitmap.Width = 0) or (ABitmap.Height = 0) then + raise Exception.Create('Empty image'); + inherited Create(ABitmap); + FBitmap := ABitmap; + FRepeatImageX := ARepeatImageX; + FRepeatImageY := ARepeatImageY; + FResampleFilter:= AResampleFilter; + FBuffer := nil; + FBufferSize:= 0; + FIncludeEdges := AIncludeEdges; +end; + +constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap; + ARepeatImage: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); +begin + Init(ABitmap,ARepeatImage,ARepeatImage,AResampleFilter,AIncludeEdges); +end; + +constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap; + ARepeatImageX: Boolean; ARepeatImageY: Boolean; + AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false); +begin + Init(ABitmap,ARepeatImageX,ARepeatImageY,AResampleFilter,AIncludeEdges); +end; + +destructor TBGRAAffineBitmapTransform.Destroy; +begin + FreeMem(FBuffer); +end; + +function TBGRAAffineBitmapTransform.InternalScanCurrentPixel: TBGRAPixel; +begin + if FEmptyMatrix then + begin + result := BGRAPixelTransparent; + exit; + end; + result := FBitmap.GetPixelCycle(FCur.X,FCur.Y,FResampleFilter,FRepeatImageX,FRepeatImageY); +end; + +procedure TBGRAAffineBitmapTransform.ScanPutPixels(pdest: PBGRAPixel; + count: integer; mode: TDrawMode); +const PrecisionShift = {$IFDEF CPU64}24{$ELSE}12{$ENDIF}; + Precision = 1 shl PrecisionShift; +var p: PBGRAPixel; + n: integer; + posXPrecision, posYPrecision: Int32or64; + deltaXPrecision,deltaYPrecision: Int32or64; + ix,iy,shrMask,w,h: Int32or64; + py0: PByte; + deltaRow: Int32or64; +begin + w := FBitmap.Width; + h := FBitmap.Height; + if (w = 0) or (h = 0) then exit; + + if GlobalOpacity = 0 then + begin + if mode = dmSet then + FillDWord(pdest^, count, LongWord(BGRAPixelTransparent)); + FCur.Offset(FMatrix[1,1]*count, FMatrix[2,1]*count); + exit; + end; + + posXPrecision := round(FCur.X*Precision); + deltaXPrecision:= round(FMatrix[1,1]*Precision); + posYPrecision := round(FCur.Y*Precision); + deltaYPrecision:= round(FMatrix[2,1]*Precision); + shrMask := -1; + shrMask := shrMask shr PrecisionShift; + shrMask := not shrMask; + + if mode = dmSet then + p := pdest + else + begin + if count > FBufferSize then + begin + FBufferSize := count; + ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel)); + end; + p := FBuffer; + end; + + if FResampleFilter = rfBox then + begin + inc(posXPrecision, Precision shr 1); + inc(posYPrecision, Precision shr 1); + py0 := PByte(FBitmap.ScanLine[0]); + if FBitmap.LineOrder = riloTopToBottom then + deltaRow := FBitmap.Width*sizeof(TBGRAPixel) else + deltaRow := -FBitmap.Width*sizeof(TBGRAPixel); + if FRepeatImageX or FRepeatImageY then + begin + for n := count-1 downto 0 do + begin + if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; + if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; + if FRepeatImageX then ix := PositiveMod(ix,w); + if FRepeatImageY then iy := PositiveMod(iy,h); + if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then + p^ := BGRAPixelTransparent + else + p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^; + inc(p); + inc(posXPrecision, deltaXPrecision); + inc(posYPrecision, deltaYPrecision); + end; + end else + begin + for n := count-1 downto 0 do + begin + if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; + if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; + if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then + p^ := BGRAPixelTransparent + else + p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^; + inc(p); + inc(posXPrecision, deltaXPrecision); + inc(posYPrecision, deltaYPrecision); + end; + end; + end else + begin + if FRepeatImageX and FRepeatImageY then + begin + for n := count-1 downto 0 do + begin + if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; + if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; + p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter); + inc(p); + inc(posXPrecision, deltaXPrecision); + inc(posYPrecision, deltaYPrecision); + end; + end else + if FRepeatImageX or FRepeatImageY then + begin + for n := count-1 downto 0 do + begin + if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; + if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; + p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter, FRepeatImageX,FRepeatImageY); + inc(p); + inc(posXPrecision, deltaXPrecision); + inc(posYPrecision, deltaYPrecision); + end; + end else + begin + for n := count-1 downto 0 do + begin + if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; + if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; + p^ := FBitmap.GetPixel256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter); + inc(p); + inc(posXPrecision, deltaXPrecision); + inc(posYPrecision, deltaYPrecision); + end; + end; + end; + + if GlobalOpacity < 255 then + begin + if mode = dmSet then + p := pdest + else + p := FBuffer; + for n := count-1 downto 0 do + begin + p^.alpha := ApplyOpacity(p^.alpha,GlobalOpacity); + if p^.alpha = 0 then p^ := BGRAPixelTransparent; + inc(p); + end; + end; + + if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255); + FCur.Offset(FMatrix[1,1]*count, FMatrix[2,1]*count); +end; + +function TBGRAAffineBitmapTransform.IsScanPutPixelsDefined: boolean; +begin + Result:=true; +end; + +procedure TBGRAAffineBitmapTransform.Fit(Origin, HAxis, VAxis: TPointF); +begin + if (FBitmap.Width = 0) or (FBitmap.Height = 0) then exit; + Matrix := AffineMatrix(HAxis.X-Origin.X, VAxis.X-Origin.X, Origin.X, + HAxis.Y-Origin.Y, VAxis.Y-Origin.Y, Origin.Y); + Invert; + if FIncludeEdges then + begin + Matrix := AffineMatrixTranslation(-0.5,-0.5)*AffineMatrixScale(FBitmap.Width,FBitmap.Height)*Matrix; + end else + Matrix := AffineMatrixScale(FBitmap.Width-1,FBitmap.Height-1)*Matrix; +end; + +{ TBGRAPerspectiveScannerTransform } + +function TBGRAPerspectiveScannerTransform.GetIncludeOppositePlane: boolean; +begin + if FMatrix = nil then + result := false + else + result := FMatrix.IncludeOppositePlane; +end; + +procedure TBGRAPerspectiveScannerTransform.SetIncludeOppositePlane( + AValue: boolean); +begin + if FMatrix <> nil then + FMatrix.IncludeOppositePlane := AValue; +end; + +constructor TBGRAPerspectiveScannerTransform.Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF); +begin + if DoesQuadIntersect(quad[0],quad[1],quad[2],quad[3]) or not IsConvex(quad,False) or (texCoord1.x = texCoord2.x) or (texCoord1.y = texCoord2.y) then + FMatrix := nil + else + begin + FMatrix := TPerspectiveTransform.Create(quad,texCoord1.x,texCoord1.y,texCoord2.x,texCoord2.y); + FMatrix.OutsideValue := EmptyPointF; + end; + FTexture := texture; + FScanAtProc:= @FTexture.ScanAt; +end; + +constructor TBGRAPerspectiveScannerTransform.Create(texture: IBGRAScanner; + const texCoordsQuad: array of TPointF; const quad: array of TPointF); +begin + if DoesQuadIntersect(quad[0],quad[1],quad[2],quad[3]) or not IsConvex(quad,False) or + DoesQuadIntersect(texCoordsQuad[0],texCoordsQuad[1],texCoordsQuad[2],texCoordsQuad[3]) or not IsConvex(texCoordsQuad,False) then + FMatrix := nil + else + begin + FMatrix := TPerspectiveTransform.Create(quad,texCoordsQuad); + FMatrix.OutsideValue := EmptyPointF; + end; + FTexture := texture; + FScanAtProc:= @FTexture.ScanAt; +end; + +destructor TBGRAPerspectiveScannerTransform.Destroy; +begin + FMatrix.free; + inherited Destroy; +end; + +procedure TBGRAPerspectiveScannerTransform.ScanMoveTo(X, Y: Integer); +begin + if FMatrix = nil then exit; + FMatrix.ScanMoveTo(X,Y); +end; + +function TBGRAPerspectiveScannerTransform.ScanAt(X, Y: Single): TBGRAPixel; +var ptSource: TPointF; +begin + if FMatrix = nil then + result := BGRAPixelTransparent else + begin + ptSource := FMatrix.Apply(PointF(X,Y)); + if ptSource.x = EmptySingle then + result := BGRAPixelTransparent + else + Result:= FScanAtProc(ptSource.X, ptSource.Y); + end; +end; + +function TBGRAPerspectiveScannerTransform.ScanNextPixel: TBGRAPixel; +var ptSource: TPointF; +begin + if FMatrix = nil then + result := BGRAPixelTransparent else + begin + ptSource := FMatrix.ScanNext; + if ptSource.x = EmptySingle then + result := BGRAPixelTransparent + else + Result:= FScanAtProc(ptSource.X, ptSource.Y); + end; +end; + +procedure TBGRAPerspectiveScannerTransform.ScanSkipPixels(ACount: integer); +begin + if FMatrix<>nil then FMatrix.ScanSkip(ACount); +end; + +{ TPerspectiveTransform } + +procedure TPerspectiveTransform.Init; +begin + FOutsideValue := PointF(0,0); + FIncludeOppositePlane:= True; +end; + +constructor TPerspectiveTransform.Create; +begin + Init; + AssignIdentity; +end; + +constructor TPerspectiveTransform.Create(x1, y1, x2, y2: single; + const quad: array of TPointF); +begin + Init; + MapRectToQuad(x1 ,y1 ,x2 ,y2 ,quad ); +end; + +constructor TPerspectiveTransform.Create(const quad: array of TPointF; x1, y1, + x2, y2: single); +begin + Init; + MapQuadToRect(quad, x1,y1,x2,y2); +end; + +constructor TPerspectiveTransform.Create(const srcQuad, + destQuad: array of TPointF); +begin + Init; + MapQuadToQuad(srcQuad,destQuad); +end; + +{ Map a quad to quad. First compute quad to square, and then square to quad. } +function TPerspectiveTransform.MapQuadToQuad(const srcQuad, + destQuad: array of TPointF): boolean; +var + p : TPerspectiveTransform; +begin + if not MapQuadToSquare(srcQuad ) then + begin + result:=false; + exit; + end; + + p := TPerspectiveTransform.Create; + if not p.MapSquareToQuad(destQuad) then + begin + p.Free; + result:=false; + exit; + end; + + //combine both transformations + MultiplyBy(p); + p.Free; + result:=true; +end; + +//Map a rectangle to a quad. Make a polygon for the rectangle, and map it. +function TPerspectiveTransform.MapRectToQuad(x1, y1, x2, y2: single; + const quad: array of TPointF): boolean; +begin + result := MapQuadToQuad([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)], quad); +end; + +//Map a quad to a rectangle. Make a polygon for the rectangle, and map the quad into it. +function TPerspectiveTransform.MapQuadToRect(const quad: array of TPointF; x1, + y1, x2, y2: single): boolean; +begin + result := MapQuadToQuad(quad, [PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)]); +end; + +//Map a square to a quad +function TPerspectiveTransform.MapSquareToQuad(const quad: array of TPointF): boolean; +var + d,d1,d2: TPointF; + den ,u ,v : double; + +begin + d := quad[0]-quad[1]+quad[2]-quad[3]; + + if (d.x = 0.0 ) and + (d.y = 0.0 ) then + begin + // Affine case (parallelogram) + sx :=quad[1].x - quad[0].x; + shy:=quad[1].y - quad[0].y; + w0 :=0.0; + shx:=quad[2].x - quad[1].x; + sy :=quad[2].y - quad[1].y; + w1 :=0.0; + tx :=quad[0].x; + ty :=quad[0].y; + w2 :=1.0; + + end + else + begin + d1 := quad[1]-quad[2]; + d2 := quad[3]-quad[2]; + den:=d1.x * d2.y - d2.x * d1.y; + + if den = 0.0 then + begin + // Singular case + sx :=0.0; + shy:=0.0; + w0 :=0.0; + shx:=0.0; + sy :=0.0; + w1 :=0.0; + tx :=0.0; + ty :=0.0; + w2 :=0.0; + result:=false; + exit; + end; + + // General case + u:=(d.x * d2.y - d.y * d2.x ) / den; + v:=(d.y * d1.x - d.x * d1.y ) / den; + + sx :=quad[1].x - quad[0].x + u * quad[1].x; + shy:=quad[1].y - quad[0].y + u * quad[1].y; + w0 :=u; + shx:=quad[3].x - quad[0].x + v * quad[3].x; + sy :=quad[3].y - quad[0].y + v * quad[3].y; + w1 :=v; + tx :=quad[0].x; + ty :=quad[0].y; + w2 :=1.0; + + end; + + result:=true; + +end; + +//Map a quad to a square. Compute mapping from square to quad, then invert. +function TPerspectiveTransform.MapQuadToSquare(const quad: array of TPointF): boolean; +begin + if not MapSquareToQuad(quad ) then + result:=false + else + result := Invert; +end; + +procedure TPerspectiveTransform.AssignIdentity; +begin + sx :=1; + shy:=0; + w0 :=0; + shx:=0; + sy :=1; + w1 :=0; + tx :=0; + ty :=0; + w2 :=1; +end; + +function TPerspectiveTransform.Invert: boolean; +var + d0, d1, d2, d : double; + copy : TPerspectiveTransform; + +begin + d0:= sy * w2 - w1 * ty; + d1:= w0 * ty - shy * w2; + d2:= shy * w1 - w0 * sy; + d := sx * d0 + shx * d1 + tx * d2; + + if d = 0.0 then + begin + sx := 0.0; + shy:= 0.0; + w0 := 0.0; + shx:= 0.0; + sy := 0.0; + w1 := 0.0; + tx := 0.0; + ty := 0.0; + w2 := 0.0; + result:= false; + exit; + end; + + d:= 1.0 / d; + + copy := Duplicate; + + sx :=d * d0; + shy:=d * d1; + w0 :=d * d2; + shx:=d * (copy.w1 * copy.tx - copy.shx * copy.w2 ); + sy :=d * (copy.sx * copy.w2 - copy.w0 * copy.tx ); + w1 :=d * (copy.w0 * copy.shx - copy.sx * copy.w1 ); + tx :=d * (copy.shx * copy.ty - copy.sy * copy.tx ); + ty :=d * (copy.shy * copy.tx - copy.sx * copy.ty ); + w2 :=d * (copy.sx * copy.sy - copy.shy * copy.shx ); + + copy.free; + + result:=true; +end; + +procedure TPerspectiveTransform.Translate(dx, dy: single); +begin + tx:=tx + dx; + ty:=ty + dy; +end; + +procedure TPerspectiveTransform.MultiplyBy(a: TPerspectiveTransform); +var b: TPerspectiveTransform; +begin + b := Duplicate; + sx :=a.sx * b.sx + a.shx * b.shy + a.tx * b.w0; + shx:=a.sx * b.shx + a.shx * b.sy + a.tx * b.w1; + tx :=a.sx * b.tx + a.shx * b.ty + a.tx * b.w2; + shy:=a.shy * b.sx + a.sy * b.shy + a.ty * b.w0; + sy :=a.shy * b.shx + a.sy * b.sy + a.ty * b.w1; + ty :=a.shy * b.tx + a.sy * b.ty + a.ty * b.w2; + w0 :=a.w0 * b.sx + a.w1 * b.shy + a.w2 * b.w0; + w1 :=a.w0 * b.shx + a.w1 * b.sy + a.w2 * b.w1; + w2 :=a.w0 * b.tx + a.w1 * b.ty + a.w2 * b.w2; + b.Free; +end; + +procedure TPerspectiveTransform.PremultiplyBy(b: TPerspectiveTransform); +var + a : TPerspectiveTransform; + begin + a := Duplicate; + sx :=a.sx * b.sx + a.shx * b.shy + a.tx * b.w0; + shx:=a.sx * b.shx + a.shx * b.sy + a.tx * b.w1; + tx :=a.sx * b.tx + a.shx * b.ty + a.tx * b.w2; + shy:=a.shy * b.sx + a.sy * b.shy + a.ty * b.w0; + sy :=a.shy * b.shx + a.sy * b.sy + a.ty * b.w1; + ty :=a.shy * b.tx + a.sy * b.ty + a.ty * b.w2; + w0 :=a.w0 * b.sx + a.w1 * b.shy + a.w2 * b.w0; + w1 :=a.w0 * b.shx + a.w1 * b.sy + a.w2 * b.w1; + w2 :=a.w0 * b.tx + a.w1 * b.ty + a.w2 * b.w2; + a.Free; +end; + +function TPerspectiveTransform.Duplicate: TPerspectiveTransform; +begin + result := TPerspectiveTransform.Create; + result.sx :=sx; + result.shy:=shy; + result.w0 :=w0; + result.shx:=shx; + result.sy :=sy; + result.w1 :=w1; + result.tx :=tx; + result.ty :=ty; + result.w2 :=w2; +end; + +function TPerspectiveTransform.Apply(pt: TPointF): TPointF; +var + m : single; +begin + m:= pt.x * w0 + pt.y * w1 + w2; + if (m=0) or (not FIncludeOppositePlane and (m < 0)) then + result := FOutsideValue + else + begin + m := 1/m; + result.x := m * (pt.x * sx + pt.y * shx + tx ); + result.y := m * (pt.x * shy + pt.y * sy + ty ); + end; +end; + +procedure TPerspectiveTransform.ScanMoveTo(x, y: single); +begin + ScanDenom := x * w0 + y * w1 + w2; + ScanNumX := x * sx + y * shx + tx; + scanNumY := x * shy + y * sy + ty; +end; + +function TPerspectiveTransform.ScanNext: TPointF; +var m: single; +begin + if (ScanDenom = 0) or (not FIncludeOppositePlane and (ScanDenom < 0)) then + result := FOutsideValue + else + begin + m := 1/scanDenom; + result.x := m * ScanNumX; + result.y := m * scanNumY; + end; + IncF(ScanDenom, w0); + IncF(ScanNumX, sx); + IncF(scanNumY, shy); +end; + +procedure TPerspectiveTransform.ScanSkip(ACount: integer); +begin + IncF(ScanDenom, w0*ACount); + IncF(ScanNumX, sx*ACount); + IncF(scanNumY, shy*ACount); +end; + +{ TBGRATwirlScanner } + +constructor TBGRATwirlScanner.Create(AScanner: IBGRAScanner; ACenter: TPoint; ARadius: single; ATurn: single = 1; AExponent: single = 3); +begin + FScanner := AScanner; + FScanAtFunc := @FScanner.ScanAt; + FCenter := ACenter; + FTurn := ATurn; + FRadius := ARadius; + FExponent := AExponent; +end; + +function TBGRATwirlScanner.ScanAt(X, Y: Single): TBGRAPixel; +var p: TPoint; + d: single; + a,cosa,sina: integer; +begin + p := Point(Round(X)-FCenter.X,Round(Y)-FCenter.Y); + if (abs(p.x) < FRadius) and (abs(p.Y) < FRadius) then + begin + d := sqrt(p.x*p.x+p.y*p.y); + if d < FRadius then + begin + d := (FRadius-d)/FRadius; + if FExponent <> 1 then d := exp(ln(d)*FExponent); + a := round(d*FTurn*65536); + cosa := Cos65536(a)-32768; + sina := Sin65536(a)-32768; + result := FScanner.ScanAt((p.x*cosa+p.y*sina)/32768 + FCenter.X, + (-p.x*sina+p.y*cosa)/32768 + FCenter.Y); + exit; + end; + end; + result := FScanAtFunc(X,Y); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgratypewriter.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgratypewriter.pas new file mode 100644 index 0000000..f99437c --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgratypewriter.pas @@ -0,0 +1,1293 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRATypewriter; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, Avl_Tree, BGRABitmapTypes, BGRACanvas2D, BGRATransform; + +type + TGlyphBoxes = array of record + Glyph: string; + Box: TAffineBox; + end; + + { TBGRAGlyph } + + TBGRAGlyph = class + protected + FIdentifier: string; + procedure WriteHeader(AStream: TStream; AName: string; AContentSize: longint); + class procedure ReadHeader(AStream: TStream; out AName: string; out AContentSize: longint); static; + function ContentSize: integer; virtual; + function HeaderName: string; virtual; + procedure WriteContent(AStream: TStream); virtual; + procedure ReadContent(AStream: TStream); virtual; + public + Width,Height: single; + constructor Create(AIdentifier: string); virtual; + constructor Create(AStream: TStream); virtual; + procedure Path({%H-}ADest: IBGRAPath; {%H-}AMatrix: TAffineMatrix; {%H-}AReverse: boolean= false); virtual; + property Identifier: string read FIdentifier; + procedure SaveToStream(AStream: TStream); + class function LoadFromStream(AStream: TStream): TBGRAGlyph; static; + end; + + TKerningInfo = class + IdLeft, IdRight: string; + KerningOffset: single; + end; + + TGlyphPointCurveMode= TEasyBezierCurveMode; + +const + cmAuto = TEasyBezierCurveMode.cmAuto; + cmCurve = TEasyBezierCurveMode.cmCurve; + cmAngle = TEasyBezierCurveMode.cmAngle; + +type + { TBGRAPolygonalGlyph } + + TBGRAPolygonalGlyph = class(TBGRAGlyph) + private + function GetClosed: boolean; + function GetMinimumDotProduct: single; + function GetPoint(AIndex: integer): TPointF; + function GetPointCount: integer; + procedure SetClosed(AValue: boolean); + procedure SetMinimumDotProduct(AValue: single); + procedure SetPoint(AIndex: integer; AValue: TPointF); + procedure SetQuadraticCurves(AValue: boolean); + protected + FQuadraticCurves: boolean; + FEasyBezier: TEasyBezierCurve; + function ContentSize: integer; override; + function HeaderName: string; override; + procedure WriteContent(AStream: TStream); override; + procedure ReadContent(AStream: TStream); override; + function PointTransformMatrix(APoint: PPointF; AData: pointer): TPointF; + procedure Init; + public + Offset: TPointF; + constructor Create(AIdentifier: string); override; + constructor Create(AStream: TStream); override; + constructor Create(AStream: TStream; AQuadratic: boolean); + procedure SetPoints(const APoints: array of TPointF); overload; + procedure SetPoints(const APoints: array of TPointF; const ACurveMode: array of TGlyphPointCurveMode); overload; + procedure Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; AReverse: boolean = false); override; + property QuadraticCurves: boolean read FQuadraticCurves write SetQuadraticCurves; + property Closed: boolean read GetClosed write SetClosed; + property MinimumDotProduct: single read GetMinimumDotProduct write SetMinimumDotProduct; + property Point[AIndex: integer]: TPointF read GetPoint write SetPoint; + property PointCount: integer read GetPointCount; + end; + + TBGRACustomTypeWriterHeader = record + HeaderName: String; + NbGlyphs: integer; + end; + + TBGRAGlyphDisplayInfo = record + Glyph: TBGRAGlyph; + Matrix: TAffineMatrix; + Mirrored, RTL: WordBool; + end; + + TBGRATextDisplayInfo = array of TBGRAGlyphDisplayInfo; + TBrowseGlyphCallbackFlag = (gcfMirrored, gcfMerged, gcfRightToLeft, gcfKerning); + TBrowseGlyphCallbackFlags = set of TBrowseGlyphCallbackFlag; + TBrowseGlyphCallback = procedure(ATextUTF8: string; AGlyph: TBGRAGlyph; + AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean) of object; + + TTextFitInfoCallbackData = record + WidthAccumulator, MaxWidth: single; + CharCount: integer; + ByteCount: integer; + PrevGlyphId: string; + end; + + TDisplayInfoCallbackData = record + Align: TBGRATypeWriterAlignment; + Matrix: TAffineMatrix; + Info: TBGRATextDisplayInfo; + InfoIndex: integer; + PrevGlyphId: string; + end; + + TTextSizeCallbackData = record + Size: TPointF; + PrevGlyphId: string; + end; + + { TBGRACustomTypeWriter } + + TBGRACustomTypeWriter = class + private + FBidiMode: TFontBidiMode; + FGlyphs: TAVLTree; + FKerningInfos: TAVLTree; + procedure GlyphCallbackForDisplayInfo({%H-}ATextUTF8: string; + AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out + AContinue: boolean); + procedure GlyphCallbackForTextFitInfoBeforeTransform(ATextUTF8: string; + AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); + procedure SetBidiMode(AValue: TFontBidiMode); + procedure GlyphCallbackForTextSizeBeforeTransform({%H-}ATextUTF8: string; + AGlyph: TBGRAGlyph; {%H-}AFlags: TBrowseGlyphCallbackFlags; AData: pointer; out AContinue: boolean); + protected + TypeWriterMatrix: TAffineMatrix; + function FindGlyph(AIdentifier: string): TAVLTreeNode; + function GetGlyph(AIdentifier: string): TBGRAGlyph; virtual; + procedure SetGlyph(AIdentifier: string; AValue: TBGRAGlyph); + function GetDisplayInfo(ATextUTF8: string; X,Y: Single; + AAlign: TBGRATypeWriterAlignment): TBGRATextDisplayInfo; + procedure GlyphPath(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft; AMirrored: boolean = false); + procedure DrawLastPath(ADest: TBGRACanvas2D); + procedure ClearGlyphs; + procedure RemoveGlyph(AIdentifier: string); + procedure AddGlyph(AGlyph: TBGRAGlyph); + function GetGlyphMatrix(AGlyph: TBGRAGlyph; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix; + function GetTextMatrix(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix; + property Glyph[AIdentifier: string]: TBGRAGlyph read GetGlyph write SetGlyph; + function CustomHeaderSize: integer; virtual; + procedure WriteCustomHeader(AStream: TStream); virtual; + function ReadCustomTypeWriterHeader(AStream: TStream): TBGRACustomTypeWriterHeader; + procedure ReadAdditionalHeader({%H-}AStream: TStream); virtual; + function HeaderName: string; virtual; + procedure BrowseGlyphs(ATextUTF8: string; ACallback: TBrowseGlyphCallback; AData: pointer; ADisplayOrder: boolean); + procedure BrowseAllGlyphs(ACallback: TBrowseGlyphCallback; AData: pointer); + function FindKerning(AIdLeft, AIdRight: string): TAVLTreeNode; + function GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; virtual; + function ComputeKerning(AIdLeft, AIdRight: string): single; virtual; + public + OutlineMode: TBGRATypeWriterOutlineMode; + DrawGlyphsSimultaneously : boolean; + SubstituteBidiBracket: boolean; + LigatureWithF: boolean; + constructor Create; + function GetTextSizeBeforeTransform(ATextUTF8 :string): TPointF; + procedure TextFitInfoBeforeTransform(ATextUTF8: string; AMaxWidth: single; out ACharCount, AByteCount: integer; out AUsedWidth: single); + procedure SaveGlyphsToFile(AFilenameUTF8: string); + procedure SaveGlyphsToStream(AStream: TStream); + procedure LoadGlyphsFromFile(AFilenameUTF8: string); + procedure LoadGlyphsFromStream(AStream: TStream); + procedure DrawGlyph(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft; AMirrored: boolean = false); + procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual; + procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual; + function GetGlyphBox(AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox; + function GetTextBox(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox; + function GetTextGlyphBoxes(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes; + procedure NeedGlyphRange(AUnicodeFrom, AUnicodeTo: LongWord); + procedure NeedGlyphAnsiRange; + destructor Destroy; override; + property BidiMode: TFontBidiMode read FBidiMode write SetBidiMode; + end; + +function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload; +function ComputeEasyBezier(APoints: array of TPointF; ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload; + +implementation + +uses BGRAUTF8, BGRAUnicode, math; + +procedure LEWritePointF(Stream: TStream; AValue: TPointF); +begin + LEWriteSingle(Stream,AValue.x); + LEWriteSingle(Stream,AValue.y); +end; + +function LEReadPointF(Stream: TStream): TPointF; +begin + result.x := LEReadSingle(Stream); + result.y := LEReadSingle(Stream); +end; + +function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; +var + glyph: TBGRAPolygonalGlyph; + canvas2D: TBGRACanvas2D; + i: integer; +begin + if length(APoints) <= 2 then + begin + setlength(result, length(APoints)); + for i := 0 to high(result) do + result[i] := APoints[i]; + exit; + end; + glyph := TBGRAPolygonalGlyph.Create(''); + glyph.QuadraticCurves := true; + glyph.Closed:= AClosed; + glyph.MinimumDotProduct := AMinimumDotProduct; + glyph.SetPoints(APoints); + canvas2D := TBGRACanvas2D.Create(nil); + canvas2D.pixelCenteredCoordinates := true; + glyph.Path(canvas2D,AffineMatrixIdentity); + glyph.Free; + result := canvas2D.currentPath; + canvas2D.free; +end; + +function ComputeEasyBezier(APoints: array of TPointF; + ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean; + AMinimumDotProduct: single): ArrayOfTPointF; +var + glyph: TBGRAPolygonalGlyph; + canvas2D: TBGRACanvas2D; + i: integer; +begin + if length(APoints) <= 2 then + begin + setlength(result, length(APoints)); + for i := 0 to high(result) do + result[i] := APoints[i]; + exit; + end; + glyph := TBGRAPolygonalGlyph.Create(''); + glyph.QuadraticCurves := true; + glyph.Closed:= AClosed; + glyph.MinimumDotProduct := AMinimumDotProduct; + glyph.SetPoints(APoints, ACurveMode); + canvas2D := TBGRACanvas2D.Create(nil); + canvas2D.pixelCenteredCoordinates := true; + glyph.Path(canvas2D,AffineMatrixIdentity); + glyph.Free; + result := canvas2D.currentPath; + canvas2D.free; +end; + +{ TBGRAPolygonalGlyph } + +function TBGRAPolygonalGlyph.GetClosed: boolean; +begin + result := FEasyBezier.Closed; +end; + +function TBGRAPolygonalGlyph.GetMinimumDotProduct: single; +begin + result := FEasyBezier.MinimumDotProduct; +end; + +function TBGRAPolygonalGlyph.GetPoint(AIndex: integer): TPointF; +begin + result := FEasyBezier.Point[AIndex]; +end; + +function TBGRAPolygonalGlyph.GetPointCount: integer; +begin + result := FEasyBezier.PointCount; +end; + +procedure TBGRAPolygonalGlyph.SetClosed(AValue: boolean); +begin + FEasyBezier.Closed := AValue; +end; + +procedure TBGRAPolygonalGlyph.SetMinimumDotProduct(AValue: single); +begin + FEasyBezier.MinimumDotProduct := AValue; +end; + +procedure TBGRAPolygonalGlyph.SetPoint(AIndex: integer; AValue: TPointF); +begin + FEasyBezier.Point[AIndex] := AValue; +end; + +procedure TBGRAPolygonalGlyph.SetQuadraticCurves(AValue: boolean); +begin + if FQuadraticCurves=AValue then Exit; + FQuadraticCurves:=AValue; +end; + +function TBGRAPolygonalGlyph.ContentSize: integer; +begin + Result:= (inherited ContentSize) + sizeof(single)*2 + 4 + sizeof(single)*2*PointCount; +end; + +function TBGRAPolygonalGlyph.HeaderName: string; +begin + if FQuadraticCurves then + Result:='TBGRAEasyBezierGlyph' + else + Result:='TBGRAPolygonalGlyph' +end; + +procedure TBGRAPolygonalGlyph.WriteContent(AStream: TStream); +var i: integer; +begin + inherited WriteContent(AStream); + LEWritePointF(AStream, Offset); + LEWriteLongint(AStream,PointCount); + for i := 0 to PointCount-1 do + LEWritePointF(AStream, FEasyBezier.Point[i]); + if FQuadraticCurves then + for i := 0 to PointCount-1 do + LEWriteLongint(AStream, ord(FEasyBezier.CurveMode[i])); +end; + +procedure TBGRAPolygonalGlyph.ReadContent(AStream: TStream); +var i: integer; + tempPts: array of TPointF; + flags: LongInt; +begin + inherited ReadContent(AStream); + Offset := LEReadPointF(AStream); + SetLength(tempPts, LEReadLongint(AStream)); + for i := 0 to high(tempPts) do + tempPts[i] := LEReadPointF(AStream); + SetPoints(tempPts); + if FQuadraticCurves then + begin + for i := 0 to high(tempPts) do + begin + flags := LEReadLongint(AStream); + FEasyBezier.CurveMode[i] := TEasyBezierCurveMode(flags and 255); + end; + end; +end; + +function TBGRAPolygonalGlyph.PointTransformMatrix(APoint: PPointF; + AData: pointer): TPointF; +begin + result := TAffineMatrix(AData^) * APoint^; +end; + +procedure TBGRAPolygonalGlyph.Init; +begin + FEasyBezier.Init; + Closed := True; + Offset := PointF(0,0); + FQuadraticCurves:= False; +end; + +constructor TBGRAPolygonalGlyph.Create(AIdentifier: string); +begin + Init; + inherited Create(AIdentifier); +end; + +constructor TBGRAPolygonalGlyph.Create(AStream: TStream); +begin + Init; + inherited Create(AStream); +end; + +constructor TBGRAPolygonalGlyph.Create(AStream: TStream; AQuadratic: boolean); +begin + Init; + FQuadraticCurves:= AQuadratic; + inherited Create(AStream); +end; + +procedure TBGRAPolygonalGlyph.SetPoints(const APoints: array of TPointF); +begin + FEasyBezier.SetPoints(APoints, cmAuto); +end; + +procedure TBGRAPolygonalGlyph.SetPoints(const APoints: array of TPointF; + const ACurveMode: array of TGlyphPointCurveMode); +begin + if length(APoints) <> length(ACurveMode) then + raise exception.Create('Dimension mismatch'); + FEasyBezier.SetPoints(APoints, ACurveMode); +end; + +procedure TBGRAPolygonalGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; + AReverse: boolean); +var + nextMove: boolean; + + procedure DoPoint(AIndex: integer); + begin + if isEmptyPointF(Point[AIndex]) then + begin + if not nextMove and Closed then ADest.closePath; + nextMove := true; + end else + begin + if nextMove then + begin + ADest.moveTo(AMatrix*Point[AIndex]); + nextMove := false; + end else + ADest.lineTo(AMatrix*Point[AIndex]); + end; + end; + +var + i: integer; +begin + AMatrix := AMatrix*AffineMatrixTranslation(Offset.X,Offset.Y); + if not FQuadraticCurves then + begin + nextMove := true; + if AReverse then + begin + for i := PointCount-1 downto 0 do + DoPoint(i); + end else + for i := 0 to PointCount-1 do + DoPoint(i); + if not nextmove and Closed then ADest.closePath; + end else + FEasyBezier.CopyToPath(ADest, @PointTransformMatrix, @AMatrix, AReverse); +end; + +{ TBGRAGlyph } + +procedure TBGRAGlyph.WriteHeader(AStream: TStream; AName: string; + AContentSize: longint); +begin + LEWriteByte(AStream, length(AName)); + AStream.Write(AName[1],length(AName)); + LEWriteLongint(AStream, AContentSize); +end; + +class procedure TBGRAGlyph.ReadHeader(AStream: TStream; out AName: string; out + AContentSize: longint); +var NameLength: integer; +begin + NameLength := LEReadByte(AStream); + setlength(AName,NameLength); + AStream.Read(AName[1],length(AName)); + AContentSize := LEReadLongint(AStream); +end; + +function TBGRAGlyph.ContentSize: integer; +begin + result := 4+length(FIdentifier)+sizeof(single)*2; +end; + +function TBGRAGlyph.HeaderName: string; +begin + result := 'TBGRAGlyph'; +end; + +procedure TBGRAGlyph.WriteContent(AStream: TStream); +begin + LEWriteLongint(AStream,length(FIdentifier)); + AStream.Write(FIdentifier[1],length(FIdentifier)); + LEWriteSingle(AStream,Width); + LEWriteSingle(AStream,Height); +end; + +procedure TBGRAGlyph.ReadContent(AStream: TStream); +var lIdentifierLength: integer; +begin + lIdentifierLength:= LEReadLongint(AStream); + setlength(FIdentifier, lIdentifierLength); + AStream.Read(FIdentifier[1],length(FIdentifier)); + Width := LEReadSingle(AStream); + Height := LEReadSingle(AStream); +end; + +constructor TBGRAGlyph.Create(AIdentifier: string); +begin + FIdentifier:= AIdentifier; +end; + +constructor TBGRAGlyph.Create(AStream: TStream); +begin + ReadContent(AStream); +end; + +procedure TBGRAGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; + AReverse: boolean); +begin + //nothing +end; + +procedure TBGRAGlyph.SaveToStream(AStream: TStream); +begin + WriteHeader(AStream, HeaderName, ContentSize); + WriteContent(AStream); +end; + +class function TBGRAGlyph.LoadFromStream(AStream: TStream) : TBGRAGlyph; +var lName: string; + lContentSize: integer; + EndPosition: Int64; +begin + ReadHeader(AStream,lName,lContentSize); + EndPosition := AStream.Position + lContentSize; + if lName = 'TBGRAPolygonalGlyph' then + result := TBGRAPolygonalGlyph.Create(AStream) + else if lName = 'TBGRAEasyBezierGlyph' then + result := TBGRAPolygonalGlyph.Create(AStream, true) + else if lName = 'TBGRAGlyph' then + result := TBGRAGlyph.Create(AStream) + else + raise exception.Create('Unknown glyph type (' + lName + ')'); + AStream.Position:= EndPosition; +end; + +function CompareGlyphNode(Data1, Data2: Pointer): integer; +begin + result := CompareStr(TBGRAGlyph(Data1).Identifier,TBGRAGlyph(Data2).Identifier); +end; + +function CompareKerningInfo(Data1, Data2: Pointer): integer; +begin + result := CompareStr(TKerningInfo(Data1).IdLeft, TKerningInfo(Data2).IdLeft); + if result = 0 then + result := CompareStr(TKerningInfo(Data1).IdRight, TKerningInfo(Data2).IdRight); +end; + +{ TBGRACustomTypeWriter } + +function TBGRACustomTypeWriter.GetGlyph(AIdentifier: string): TBGRAGlyph; +var Node: TAVLTreeNode; +begin + Node := FindGlyph(AIdentifier); + if Node = nil then + result := nil + else + result := TBGRAGlyph(Node.Data); +end; + +procedure TBGRACustomTypeWriter.SetGlyph(AIdentifier: string; AValue: TBGRAGlyph); +var Node: TAVLTreeNode; +begin + if AValue.Identifier <> AIdentifier then + raise exception.Create('Identifier mismatch'); + Node := FindGlyph(AIdentifier); + if Node <> nil then + begin + if pointer(AValue) <> Node.Data then + TBGRAGlyph(Node.Data).Free; + Node.Data := AValue; + end else + FGlyphs.Add(pointer(AValue)); +end; + +procedure TBGRACustomTypeWriter.SetBidiMode(AValue: TFontBidiMode); +begin + if FBidiMode=AValue then Exit; + FBidiMode:=AValue; +end; + +procedure TBGRACustomTypeWriter.GlyphCallbackForTextFitInfoBeforeTransform( + ATextUTF8: string; AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; + AData: Pointer; out AContinue: boolean); +var + newWidth: Single; + partialCharCount, charLen: Integer; + p,pEnd: PChar; +begin + AContinue := true; + with TTextFitInfoCallbackData(AData^) do + begin + newWidth := WidthAccumulator+AGlyph.Width; + if gcfKerning in AFlags then + IncF(newWidth, GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags)); + if newWidth < MaxWidth then + begin + WidthAccumulator := newWidth; + inc(ByteCount, length(ATextUTF8)); + inc(CharCount, UTF8Length(ATextUTF8)); + end else + begin + AContinue := false; + if gcfMerged in AFlags then + begin + partialCharCount := Trunc(UTF8Length(ATextUTF8)*(MaxWidth-WidthAccumulator)/AGlyph.Width); + p := @ATextUTF8[1]; + pEnd := p+length(ATextUTF8); + while (p 0) do + begin + charLen := UTF8CharacterLength(p); + inc(p, charLen); + inc(ByteCount, charLen); + inc(CharCount); + dec(partialCharCount); + end; + end; + end; + PrevGlyphId:= AGlyph.Identifier; + end; +end; + +procedure TBGRACustomTypeWriter.GlyphCallbackForDisplayInfo(ATextUTF8: string; + AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); +var + m2: TAffineMatrix; + kerning: Single; +begin + with TDisplayInfoCallbackData(AData^) do + begin + if gcfKerning in AFlags then + begin + if gcfRightToLeft in AFlags then + kerning := GetKerningOffset(AGlyph.Identifier, PrevGlyphId, gcfRightToLeft in AFlags) + else kerning := GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags); + Matrix := Matrix*AffineMatrixTranslation(kerning,0); + end; + + if Align in [twaLeft,twaMiddle,twaRight] then + m2 := Matrix*AffineMatrixTranslation(0,-AGlyph.Height/2) else + if Align in [twaBottomLeft,twaBottom,twaBottomRight] then + m2 := Matrix*AffineMatrixTranslation(0,-AGlyph.Height) + else + m2 := Matrix; + + if gcfMirrored in AFlags then + m2 := m2*AffineMatrixTranslation(AGlyph.Width,0)*AffineMatrixScale(-1,1); + + Info[InfoIndex].Glyph := AGlyph; + Info[InfoIndex].Mirrored:= gcfMirrored in AFlags; + Info[InfoIndex].RTL := gcfRightToLeft in AFlags; + Info[InfoIndex].Matrix := m2; + + Matrix := Matrix*AffineMatrixTranslation(AGlyph.Width,0); + inc(InfoIndex); + PrevGlyphId := AGlyph.Identifier; + end; + AContinue:= true; +end; + +function TBGRACustomTypeWriter.FindGlyph(AIdentifier: string): TAVLTreeNode; +var Comp: integer; + Node: TAVLTreeNode; +begin + Node:=FGlyphs.Root; + while (Node<>nil) do begin + Comp:=CompareStr(AIdentifier,TBGRAGlyph(Node.Data).Identifier); + if Comp=0 then break; + if Comp<0 then begin + Node:=Node.Left + end else begin + Node:=Node.Right + end; + end; + result := Node; +end; + +constructor TBGRACustomTypeWriter.Create; +begin + FGlyphs := TAVLTree.Create(@CompareGlyphNode); + TypeWriterMatrix := AffineMatrixIdentity; + OutlineMode:= twoFill; + DrawGlyphsSimultaneously := false; + FKerningInfos := nil; +end; + +function TBGRACustomTypeWriter.GetTextSizeBeforeTransform(ATextUTF8: string): TPointF; +var data: TTextSizeCallbackData; +begin + data.Size := PointF(0,0); + data.PrevGlyphId:= ''; + BrowseGlyphs(ATextUTF8, @GlyphCallbackForTextSizeBeforeTransform, @data, false); + result := data.Size; +end; + +procedure TBGRACustomTypeWriter.TextFitInfoBeforeTransform(ATextUTF8: string; AMaxWidth: single; + out ACharCount, AByteCount: integer; out AUsedWidth: single); +var + data: TTextFitInfoCallbackData; +begin + data.WidthAccumulator:= 0; + data.MaxWidth := AMaxWidth; + data.CharCount:= 0; + data.ByteCount:= 0; + data.PrevGlyphId:= ''; + BrowseGlyphs(ATextUTF8, @GlyphCallbackForTextFitInfoBeforeTransform, @data, false); + ACharCount:= data.CharCount; + AByteCount:= data.ByteCount; + AUsedWidth:= data.WidthAccumulator; +end; + +procedure TBGRACustomTypeWriter.DrawGlyph(ADest: TBGRACanvas2D; + AIdentifier: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment; AMirrored: boolean); +begin + GlyphPath(ADest, AIdentifier, X,Y, AAlign, AMirrored); + DrawLastPath(ADest); +end; + +procedure TBGRACustomTypeWriter.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; + X, Y: Single; AAlign: TBGRATypeWriterAlignment); +var + di: TBGRATextDisplayInfo; + i: Integer; +begin + di := GetDisplayInfo(ATextUTF8,x,y,AAlign); + + if (OutlineMode <> twoPath) and not DrawGlyphsSimultaneously then + begin + //draw each glyph + for i := 0 to high(di) do + begin + ADest.beginPath; + di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); + DrawLastPath(ADest); + end; + end else + begin + ADest.beginPath; + for i := 0 to high(di) do + di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); + DrawLastPath(ADest); + end; +end; + +procedure TBGRACustomTypeWriter.CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); +var + i: integer; + di: TBGRATextDisplayInfo; +begin + di := GetDisplayInfo(ATextUTF8,x,y,AAlign); + for i := 0 to high(di) do + di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); +end; + +function TBGRACustomTypeWriter.GetGlyphBox(AIdentifier: string; X, Y: Single; + AAlign: TBGRATypeWriterAlignment): TAffineBox; +var g: TBGRAGlyph; + m: TAffineMatrix; +begin + g := GetGlyph(AIdentifier); + if g = nil then result := TAffineBox.EmptyBox else + begin + m := GetGlyphMatrix(g,X,Y,AAlign); + result := TAffineBox.AffineBox(m*PointF(0,0),m*PointF(g.Width,0),m*PointF(0,g.Height)); + end; +end; + +function TBGRACustomTypeWriter.GetTextBox(ATextUTF8: string; X, Y: Single; + AAlign: TBGRATypeWriterAlignment): TAffineBox; +var + m: TAffineMatrix; + size: TPointF; +begin + if ATextUTF8 = '' then result := TAffineBox.EmptyBox else + begin + size := GetTextSizeBeforeTransform(ATextUTF8); + m := AffineMatrixTranslation(X,Y)*TypeWriterMatrix; + if AAlign in[twaTop,twaMiddle,twaBottom] then m := m*AffineMatrixTranslation(-size.x/2,0) else + if AAlign in[twaTopRight, twaRight, twaBottomRight] then m := m*AffineMatrixTranslation(-size.x,0); + if AAlign in [twaLeft,twaMiddle,twaRight] then m := m*AffineMatrixTranslation(0,-size.y/2) else + if AAlign in [twaBottomLeft,twaBottom,twaBottomRight] then m := m*AffineMatrixTranslation(0,-size.y); + result := TAffineBox.AffineBox(m*PointF(0,0),m*PointF(size.x,0),m*PointF(0,size.y)); + end; +end; + +function TBGRACustomTypeWriter.GetTextGlyphBoxes(ATextUTF8: string; X, Y: Single; + AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; +var + di: TBGRATextDisplayInfo; + i: Integer; +begin + di := GetDisplayInfo(ATextUTF8, X,Y, AAlign); + setlength(result, length(di)); + for i := 0 to high(result) do + with di[i] do + begin + result[i].Glyph := Glyph.Identifier; + result[i].Box := TAffineBox.AffineBox(Matrix*PointF(0,0),Matrix*PointF(Glyph.Width,0),Matrix*PointF(0,Glyph.Height)); + end; +end; + +procedure TBGRACustomTypeWriter.NeedGlyphRange(AUnicodeFrom, AUnicodeTo: LongWord); +var c: LongWord; +begin + for c := AUnicodeFrom to AUnicodeTo do + GetGlyph(UnicodeCharToUTF8(c)); +end; + +procedure TBGRACustomTypeWriter.NeedGlyphAnsiRange; +var i: integer; +begin + for i := 0 to 255 do + GetGlyph(AnsiToUtf8(chr(i))); +end; + +function TBGRACustomTypeWriter.GetDisplayInfo(ATextUTF8: string; X, + Y: Single; AAlign: TBGRATypeWriterAlignment): TBGRATextDisplayInfo; +var + data: TDisplayInfoCallbackData; +begin + data.Align := AAlign; + data.Matrix := GetTextMatrix(ATextUTF8, X,Y,AAlign); + setlength(data.Info, UTF8Length(ATextUTF8)); + data.InfoIndex := 0; + data.PrevGlyphId:= ''; + BrowseGlyphs(ATextUTF8, @GlyphCallbackForDisplayInfo, @data, true); + setlength(data.Info, data.InfoIndex); + result := data.Info; +end; + +procedure TBGRACustomTypeWriter.GlyphPath(ADest: TBGRACanvas2D; AIdentifier: string; + X, Y: Single; AAlign: TBGRATypeWriterAlignment; AMirrored: boolean); +var g: TBGRAGlyph; +begin + ADest.beginPath; + g := GetGlyph(AIdentifier); + if g = nil then exit; + if AMirrored then + g.Path(ADest, GetGlyphMatrix(g,X,Y,AAlign), AMirrored) + else + g.Path(ADest, GetGlyphMatrix(g,X,Y,AAlign)*AffineMatrixTranslation(g.Width,0)*AffineMatrixScale(-1,1), AMirrored); +end; + +procedure TBGRACustomTypeWriter.DrawLastPath(ADest: TBGRACanvas2D); +begin + case OutlineMode of + twoPath: ; + twoFill: ADest.fill; + twoStroke: ADest.stroke; + twoFillOverStroke: ADest.fillOverStroke; + twoStrokeOverFill: ADest.strokeOverFill; + twoFillThenStroke: begin ADest.fill; ADest.stroke; end; + twoStrokeThenFill: begin ADest.stroke; ADest.fill; end; + end; +end; + +procedure TBGRACustomTypeWriter.ClearGlyphs; +begin + FGlyphs.FreeAndClear; + if Assigned(FKerningInfos) then + FKerningInfos.FreeAndClear; +end; + +procedure TBGRACustomTypeWriter.RemoveGlyph(AIdentifier: string); +var Node: TAVLTreeNode; +begin + Node := FindGlyph(AIdentifier); + if Node <> nil then FGlyphs.FreeAndDelete(Node); +end; + +procedure TBGRACustomTypeWriter.AddGlyph(AGlyph: TBGRAGlyph); +begin + Glyph[AGlyph.Identifier] := AGlyph; +end; + +procedure TBGRACustomTypeWriter.SaveGlyphsToStream(AStream: TStream); +var + Enumerator: TAVLTreeNodeEnumerator; +begin + LEWriteLongint(AStream,CustomHeaderSize); + WriteCustomHeader(AStream); + + Enumerator := FGlyphs.GetEnumerator; + while Enumerator.MoveNext do + TBGRAGlyph(Enumerator.Current.Data).SaveToStream(AStream); + Enumerator.Free; +end; + +procedure TBGRACustomTypeWriter.LoadGlyphsFromFile(AFilenameUTF8: string); +var Stream: TFileStreamUTF8; +begin + Stream := nil; + try + Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead); + LoadGlyphsFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TBGRACustomTypeWriter.LoadGlyphsFromStream(AStream: TStream); +var Header: TBGRACustomTypeWriterHeader; + i: integer; + g: TBGRAGlyph; + HeaderSize: integer; + GlyphStartPosition: Int64; +begin + HeaderSize := LEReadLongint(AStream); + GlyphStartPosition:= AStream.Position+HeaderSize; + Header := ReadCustomTypeWriterHeader(AStream); + if header.HeaderName <> HeaderName then + raise exception.Create('Invalid file format ("'+header.HeaderName+'" should be "'+HeaderName+'")'); + ReadAdditionalHeader(AStream); + AStream.Position:= GlyphStartPosition; + for i := 0 to Header.NbGlyphs-1 do + begin + g := TBGRAGlyph.LoadFromStream(AStream); + AddGlyph(g); + end; +end; + +procedure TBGRACustomTypeWriter.SaveGlyphsToFile(AFilenameUTF8: string); +var Stream: TFileStreamUTF8; +begin + Stream := nil; + try + Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate or fmOpenWrite); + SaveGlyphsToStream(Stream); + finally + Stream.Free; + end; +end; + +function TBGRACustomTypeWriter.GetGlyphMatrix(AGlyph: TBGRAGlyph; X, Y: Single; + AAlign: TBGRATypeWriterAlignment): TAffineMatrix; +var tGlyph: TPointF; +begin + if AGlyph = nil then + begin + result := AffineMatrixIdentity; + exit; + end; + tGlyph := PointF(0,0); + if AAlign in [twaTop,twaMiddle,twaBottom] then DecF(tGlyph.X, AGlyph.Width/2); + if AAlign in [twaTopRight,twaRight,twaBottomRight] then DecF(tGlyph.X, AGlyph.Width); + if AAlign in [twaLeft,twaMiddle,twaRight] then DecF(tGlyph.Y, AGlyph.Height/2); + if AAlign in [twaBottomLeft,twaBottom,twaBottomRight] then DecF(tGlyph.Y, AGlyph.Height); + result := AffineMatrixTranslation(X,Y)*TypeWriterMatrix*AffineMatrixTranslation(tGlyph.X,tGlyph.Y); +end; + +function TBGRACustomTypeWriter.GetTextMatrix(ATextUTF8: string; X, Y: Single; + AAlign: TBGRATypeWriterAlignment): TAffineMatrix; +var + tGlyph, size: TPointF; +begin + tGlyph := PointF(0,0); + if not (AAlign in [twaLeft,twaTopLeft,twaBottomLeft]) then + begin + size := GetTextSizeBeforeTransform(ATextUTF8); + if AAlign in[twaTop,twaMiddle,twaBottom] then tGlyph.X := -size.x/2 else + if AAlign in[twaTopRight, twaRight, twaBottomRight] then tGlyph.X := -size.x; + end; + result := AffineMatrixTranslation(X,Y)*TypeWriterMatrix*AffineMatrixTranslation(tGlyph.X,tGlyph.Y); +end; + +function TBGRACustomTypeWriter.CustomHeaderSize: integer; +begin + result := 1+length(HeaderName)+4; +end; + +procedure TBGRACustomTypeWriter.WriteCustomHeader(AStream: TStream); +var lHeaderName: string; +begin + lHeaderName:= HeaderName; + LEWriteByte(AStream,length(lHeaderName)); + AStream.Write(lHeaderName[1],length(lHeaderName)); + LEWriteLongint(AStream,FGlyphs.Count); +end; + +function TBGRACustomTypeWriter.ReadCustomTypeWriterHeader(AStream: TStream + ): TBGRACustomTypeWriterHeader; +begin + setlength(result.HeaderName, LEReadByte(AStream)); + AStream.Read(result.HeaderName[1],length(result.HeaderName)); + result.NbGlyphs:= LEReadLongint(AStream); +end; + +procedure TBGRACustomTypeWriter.ReadAdditionalHeader(AStream: TStream); +begin + //nothing +end; + +function TBGRACustomTypeWriter.HeaderName: string; +begin + result := 'TBGRACustomTypeWriter'; +end; + +procedure TBGRACustomTypeWriter.BrowseGlyphs(ATextUTF8: string; + ACallback: TBrowseGlyphCallback; AData: pointer; ADisplayOrder: boolean); +type + TCharInfo = record + charStart, charEnd: integer; + bidiInfo: PUnicodeBidiInfo; + end; + function CharEquals(const info: TCharInfo; text: string): boolean; + var + i: Integer; + begin + if info.charEnd-info.charStart >= length(text) then + begin + for i := 1 to length(text) do + if ATextUTF8[info.charStart+i-1] <> text[i] then exit(false); + result := true; + end else + result := false; + end; +var + bidiArray: TBidiUTF8Array; + charInfo: array of TCharInfo; + + procedure OrderedCharInfo; + var + displayOrder: TUnicodeDisplayOrder; + bidiIdx, orderIndex, nb: integer; + begin + displayOrder := GetUTF8DisplayOrder(bidiArray); + orderIndex := 0; + nb := 0; + for orderIndex := 0 to high(displayOrder) do + if bidiArray[displayOrder[orderIndex]].BidiInfo.IsMulticharStart then inc(nb); + setlength(charInfo, nb); + nb := 0; + for orderIndex := 0 to high(displayOrder) do + if bidiArray[displayOrder[orderIndex]].BidiInfo.IsMulticharStart then + begin + bidiIdx := displayOrder[orderIndex]; + charInfo[nb].charStart := bidiArray[bidiIdx].Offset+1; + charInfo[nb].bidiInfo := @bidiArray[bidiIdx].BidiInfo; + while (bidiIdx < high(bidiArray)) and + not bidiArray[bidiIdx+1].BidiInfo.IsMulticharStart do inc(bidiIdx); + if bidiIdx < high(bidiArray) then charInfo[nb].charEnd := bidiArray[bidiIdx+1].Offset+1 + else charInfo[nb].charEnd := length(ATextUTF8)+1; + inc(nb); + end; + end; + + procedure UnorderedCharInfo; + var + i,nb: Integer; + begin + nb := 0; + i := 0; + while i <= high(bidiArray) do + begin + if not bidiArray[i].BidiInfo.IsRemoved then + begin + inc(nb); + while (i < high(bidiArray)) and not bidiArray[i+1].BidiInfo.IsMulticharStart do inc(i); + end; + inc(i); + end; + setlength(charInfo,nb); + nb := 0; + i := 0; + while i <= high(bidiArray) do + begin + if not bidiArray[i].BidiInfo.IsRemoved then + begin + charInfo[nb].charStart := bidiArray[i].Offset+1; + charInfo[nb].bidiInfo:= @bidiArray[i].BidiInfo; + while (i < high(bidiArray)) and not bidiArray[i+1].BidiInfo.IsMulticharStart do inc(i); + if i < high(bidiArray) then charInfo[nb].charEnd := bidiArray[i+1].Offset+1 + else charInfo[nb].charEnd := length(ATextUTF8)+1; + inc(nb); + end; + inc(i); + end; + end; + +var + cur,curStart: integer; + curRTL,curRTLScript,curLigatureLeft,curLigatureRight,merged: boolean; + + procedure TryMerge(const AChars: array of string); + var + i: Integer; + match: Boolean; + begin + if merged or (cur-1+length(AChars) > length(charInfo)) then exit; + if length(AChars)<=1 then raise exception.Create('Expecting several characters'); + match := true; + if not ADisplayOrder and curRTL then + begin + for i := 0 to high(AChars) do + if not CharEquals(charInfo[cur-1+high(AChars)-i], AChars[i]) then match := false; + end else + for i := 0 to high(AChars) do + if not CharEquals(charInfo[cur-1+i], AChars[i]) then match := false; + if match then + begin + inc(cur, length(AChars)-1); + if not ADisplayOrder and curRTL then + curLigatureLeft:= charInfo[cur-1].bidiInfo^.HasLigatureLeft + else + curLigatureRight:= charInfo[cur-1].bidiInfo^.HasLigatureRight; + merged := true; + end; + end; + +var + nextchar,glyphId: string; + g: TBGRAGlyph; + u: LongWord; + shouldContinue: boolean; + flags: TBrowseGlyphCallbackFlags; + i,charDestPos,charLen: integer; + prevGlyphId: string; + prevRTL: boolean; + bracketInfo: TUnicodeBracketInfo; +begin + if ATextUTF8 = '' then exit; + + bidiArray := AnalyzeBidiUTF8(ATextUTF8, BidiMode); + if ADisplayOrder then OrderedCharInfo else UnorderedCharInfo; + + cur := 0; + prevGlyphId:= ''; + prevRTL := false; + while cur < length(charInfo) do + begin + curStart := cur; + curRTL:= charInfo[cur].bidiInfo^.IsRightToLeft; + curRTLScript := charInfo[cur].bidiInfo^.IsRightToLeftScript; + curLigatureLeft:= charInfo[cur].bidiInfo^.HasLigatureLeft; + curLigatureRight:= charInfo[cur].bidiInfo^.HasLigatureRight; + merged := false; + inc(cur); + TryMerge(['f','f','i']); + TryMerge(['f','f','l']); + TryMerge(['f','f']); + TryMerge(['f','i']); + TryMerge(['f','l']); + TryMerge([UTF8_ARABIC_ALEPH,UTF8_ARABIC_LAM]); + TryMerge([UTF8_ARABIC_ALEPH_HAMZA_ABOVE,UTF8_ARABIC_LAM]); + TryMerge([UTF8_ARABIC_ALEPH_HAMZA_BELOW,UTF8_ARABIC_LAM]); + TryMerge([UTF8_ARABIC_ALEPH_MADDA_ABOVE,UTF8_ARABIC_LAM]); + //text extract correspond to the unordered actual sequence of characters + setlength(nextchar, max(charInfo[curStart].charEnd, charInfo[cur-1].charEnd) + -min(charInfo[curStart].charStart, charInfo[cur-1].charStart)); + move(ATextUTF8[min(charInfo[curStart].charStart, charInfo[cur-1].charStart)], nextchar[1], length(nextchar)); + //glyph direction corresponds to script direction + if (curRTL and not ADisplayOrder) <> curRTLScript then + begin + setlength(glyphId, length(nextChar)); + charDestPos := 1; + for i := cur-1 downto curStart do + begin + charLen := charInfo[i].charEnd-charInfo[i].charStart; + move(ATextUTF8[charInfo[i].charStart], glyphId[charDestPos], charLen); + inc(charDestPos, charLen); + end; + end else + begin + setlength(glyphId, length(nextChar)); + charDestPos := 1; + for i := curStart to cur-1 do + begin + charLen := charInfo[i].charEnd-charInfo[i].charStart; + move(ATextUTF8[charInfo[i].charStart], glyphId[charDestPos], charLen); + inc(charDestPos, charLen); + end; + end; + glyphId := UTF8Ligature(glyphId, curRTLScript, curLigatureLeft, curLigatureRight); + flags := []; + if merged then include(flags, gcfMerged); + if curRTL then include(flags, gcfRightToLeft); + if curRTL and charInfo[curStart].bidiInfo^.IsMirrored and (UTF8Length(glyphId)=1) then + begin + u := UTF8CodepointToUnicode(pchar(glyphId), length(glyphId)); + if SubstituteBidiBracket then + begin + bracketInfo := GetUnicodeBracketInfo(u); + if bracketInfo.OpeningBracket = u then + glyphId := UnicodeCharToUTF8(bracketInfo.ClosingBracket) + else if bracketInfo.ClosingBracket = u then + glyphId := UnicodeCharToUTF8(bracketInfo.OpeningBracket) + else + include(flags, gcfMirrored); + end else + include(flags, gcfMirrored); + end; + g := GetGlyph(glyphId); + if g <> nil then + begin + if (prevGlyphId <> '') and (curRTL = prevRTL) then include(flags, gcfKerning); + ACallback(nextchar, g, flags, AData, shouldContinue); + prevGlyphId := glyphId; + prevRTL := curRTL; + if not shouldContinue then break; + end; + end; +end; + +procedure TBGRACustomTypeWriter.BrowseAllGlyphs( + ACallback: TBrowseGlyphCallback; AData: pointer); +var + g: TAVLTreeNode; + shouldContinue: boolean; +begin + g := FGlyphs.FindLowest; + shouldContinue:= true; + while Assigned(g) and shouldContinue do + begin + ACallback(TBGRAGlyph(g.Data).Identifier, TBGRAGlyph(g.Data), [], + AData, shouldContinue); + g := g.Right; + end; +end; + +procedure TBGRACustomTypeWriter.GlyphCallbackForTextSizeBeforeTransform( + ATextUTF8: string; AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; + AData: pointer; out AContinue: boolean); +var + gSizeY: Single; +begin + with TTextSizeCallbackData(AData^) do + begin + if gcfKerning in AFlags then + incF(size.x, GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags) ); + IncF(Size.x, AGlyph.Width); + gSizeY := AGlyph.Height; + if gSizeY > Size.y then Size.y := gSizeY; + PrevGlyphId:= AGlyph.Identifier; + end; + AContinue:= true; +end; + +function TBGRACustomTypeWriter.FindKerning(AIdLeft, AIdRight: string): TAVLTreeNode; +var Comp: integer; + Node: TAVLTreeNode; +begin + if not Assigned(FKerningInfos) then exit(nil); + Node:=FKerningInfos.Root; + while (Node<>nil) do begin + Comp:=CompareStr(AIdLeft,TKerningInfo(Node.Data).IdLeft); + if Comp=0 then + Comp:=CompareStr(AIdRight,TKerningInfo(Node.Data).IdRight); + if Comp=0 then break; + if Comp<0 then begin + Node:=Node.Left + end else begin + Node:=Node.Right + end; + end; + result := Node; +end; + +function TBGRACustomTypeWriter.GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; +var + temp: String; + node: TAVLTreeNode; + info: TKerningInfo; +begin + if ARightToLeft then + begin + temp := AIdBefore; + AIdBefore := AIdAfter; + AIdAfter := temp; + end; + if FKerningInfos = nil then + FKerningInfos := TAVLTree.Create(@CompareKerningInfo); + node := FindKerning(AIdBefore, AIdAfter); + if Assigned(node) then + result := TKerningInfo(node.Data).KerningOffset + else + begin + result := ComputeKerning(AIdBefore, AIdAfter); + info := TKerningInfo.Create; + info.IdLeft:= AIdBefore; + info.IdRight:= AIdAfter; + info.KerningOffset:= result; + FKerningInfos.Add(Pointer(info)); + end; +end; + +function TBGRACustomTypeWriter.ComputeKerning(AIdLeft, AIdRight: string): single; +begin + result := 0; +end; + +destructor TBGRACustomTypeWriter.Destroy; +begin + if Assigned(FKerningInfos) then + begin + FKerningInfos.FreeAndClear; + FKerningInfos.Free; + end; + FGlyphs.FreeAndClear; + FGlyphs.Free; + inherited Destroy; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraunicode.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraunicode.pas new file mode 100644 index 0000000..5962e71 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraunicode.pas @@ -0,0 +1,1301 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAUnicode; +{ Implementation of Unicode bidi algorithm } +{ Author: circular } + +{$mode objfpc}{$H+} +{$modeswitch advancedrecords} + +interface + +uses + BGRAClasses, SysUtils; + +type + TUnicodeBidiClass = (ubcBoundaryNeutral, ubcSegmentSeparator, ubcParagraphSeparator, ubcWhiteSpace, ubcOtherNeutrals, + ubcCommonSeparator, ubcNonSpacingMark, + ubcLeftToRight, ubcEuropeanNumber, ubcEuropeanNumberSeparator, ubcEuropeanNumberTerminator, + ubcRightToLeft, ubcArabicLetter, ubcArabicNumber, + ubcUnknown, + ubcCombiningLeftToRight, //ubcLeftToRight in Mc category + ubcMirroredNeutral); //ubcOtherNeutrals with Mirrored property + TUnicodeJoiningType = (ujtNonJoining{U}, ujtTransparent{T}, ujtRightJoining{R}, ujtLeftJoining{L}, + ujtDualJoining{D}, ujtJoinCausing{C}); + TFontBidiMode = (fbmAuto, fbmLeftToRight, fbmRightToLeft); + +const + ubcNeutral = [ubcSegmentSeparator, ubcParagraphSeparator, ubcWhiteSpace, ubcOtherNeutrals]; + + BIDI_FLAG_REMOVED = 1; //RLE, LRE, RLO, LRO, PDF and BN are supposed to be removed + BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH = 2; //implicit end of paragraph (paragraph spacing below due to end of text) + BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH = 4; //explicit end of paragraph (paragraph spacing below due to paragraph split) + BIDI_FLAG_END_OF_LINE = 8; //line break
+ BIDI_FLAG_LIGATURE_RIGHT = 16; //joins to the letter on the right (possible for joining type R and D) + BIDI_FLAG_LIGATURE_LEFT = 32; //joins to the letter on the left (possible for joining type L and D) + BIDI_FLAG_LIGATURE_BOUNDARY = 64; //zero-width joiner or non-joiner + BIDI_FLAG_LIGATURE_TRANSPARENT = 128; //does not affect ligature + BIDI_FLAG_RTL_SCRIPT = 256; //script is written from right to left (arabic, N'Ko...) + BIDI_FLAG_NON_SPACING_MARK = 512; //it is a non-spacing mark + BIDI_FLAG_COMBINING_LEFT = 1024; //this letter is to be combined to the left of previous letter + BIDI_FLAG_COMBINING_RIGHT = 2048; //this letter is to be combined to the right of previous letter + BIDI_FLAG_MULTICHAR_START = 4096; //start of a multichar (letter + non spacing marks, non spacing marks) + BIDI_FLAG_MIRRORED = 8192; //the glyph is mirrored when in RTL text + +type + PUnicodeBidiInfo = ^TUnicodeBidiInfo; + + { TUnicodeBidiInfo } + + TUnicodeBidiInfo = packed record + private + function GetDiscardable: boolean; + function GetEndOfLine: boolean; + function GetEndOfParagraph: boolean; + function GetExplicitEndOfParagraph: boolean; + function GetHasLigatureLeft: boolean; + function GetHasLigatureRight: boolean; + function GetImplicitEndOfParagraph: boolean; + function GetIsCombiningLeft: boolean; + function GetIsCombiningRight: boolean; + function GetIsMirrored: boolean; + function GetLigatureBoundary: boolean; + function GetLigatureTransparent: boolean; + function GetMulticharStart: boolean; + function GetNonSpacingMark: boolean; + function GetRemoved: boolean; + function GetRightToLeft: boolean; + function GetParagraphRightToLeft: boolean; + function GetRightToLeftScript: boolean; + public + ParagraphBidiLevel, BidiLevel: byte; + Flags: Word; + class operator =(const AInfo1, AInfo2: TUnicodeBidiInfo): boolean; + property IsRemoved: boolean read GetRemoved; + property IsRightToLeft: boolean read GetRightToLeft; + property IsParagraphRightToLeft: boolean read GetParagraphRightToLeft; + property IsEndOfLine: boolean read GetEndOfLine; + property IsEndOfParagraph: boolean read GetEndOfParagraph; + property IsExplicitEndOfParagraph: boolean read GetExplicitEndOfParagraph; + property IsImplicitEndOfParagraph: boolean read GetImplicitEndOfParagraph; + property HasLigatureRight: boolean read GetHasLigatureRight; + property HasLigatureLeft: boolean read GetHasLigatureLeft; + property IsLigatureBoundary: boolean read GetLigatureBoundary; + property IsLigatureTransparent: boolean read GetLigatureTransparent; + property IsDiscardable: boolean read GetDiscardable; + property IsRightToLeftScript: boolean read GetRightToLeftScript; + property IsNonSpacingMark: boolean read GetNonSpacingMark; + property IsCombiningLeft: boolean read GetIsCombiningLeft; + property IsCombiningRight: boolean read GetIsCombiningRight; + property IsMulticharStart: boolean read GetMulticharStart; + property IsMirrored: boolean read GetIsMirrored; + end; + + TUnicodeBidiArray = packed array of TUnicodeBidiInfo; + TUnicodeDisplayOrder = array of integer; + +const + //maximum nesting level of isolates and bidi-formatting blocks (char bidi level can actually be higher due to char properties) + UNICODE_MAX_BIDI_DEPTH = 125; + + UNICODE_NO_BREAK_SPACE = $A0; + UNICODE_LINE_SEPARATOR = $2028; //equivalent of
+ UNICODE_PARAGRAPH_SEPARATOR = $2029; //equivalent of

+ UNICODE_NEXT_LINE = $0085; //equivalent of CRLF + + //characters that split lines into top-level bidi blocks + UNICODE_LEFT_TO_RIGHT_ISOLATE = $2066; + UNICODE_RIGHT_TO_LEFT_ISOLATE = $2067; + UNICODE_FIRST_STRONG_ISOLATE = $2068; + UNICODE_POP_DIRECTIONAL_ISOLATE = $2069; + + //characters that split into bidi sub-blocks (called "formatting") + UNICODE_LEFT_TO_RIGHT_EMBEDDING = $202A; + UNICODE_RIGHT_TO_LEFT_EMBEDDING = $202B; + UNICODE_LEFT_TO_RIGHT_OVERRIDE = $202D; + UNICODE_RIGHT_TO_LEFT_OVERRIDE = $202E; + UNICODE_POP_DIRECTIONAL_FORMATTING = $202C; + + //characters that mark direction without splitting the bidi block + UNICODE_LEFT_TO_RIGHT_MARK = $200E; + UNICODE_RIGHT_TO_LEFT_MARK = $200F; + UNICODE_ARABIC_LETTER_MARK = $061C; + + //data separators + UNICODE_INFORMATION_SEPARATOR_FOUR = $001C; //end-of-file + UNICODE_INFORMATION_SEPARATOR_THREE = $001D; //section separator + UNICODE_INFORMATION_SEPARATOR_TWO = $001E; //record separator, kind of equivalent to paragraph separator + UNICODE_INFORMATION_SEPARATOR_ONE = $001F; //field separator, kind of equivalent to Tab + + //zero-width + UNICODE_ZERO_WIDTH_SPACE = $200B; + UNICODE_ZERO_WIDTH_NON_JOINER = $200C; + UNICODE_ZERO_WIDTH_NO_BREAK_SPACE = $FEFF; //byte order mark + UNICODE_ZERO_WIDTH_JOINER = $200D; + UNICODE_COMBINING_GRAPHEME_JOINER = $034F; + + //arabic letters + UNICODE_ARABIC_TATWEEL = $0640; //horizontal line that makes a ligature with most letters + + //ideographic punctuation + UNICODE_IDEOGRAPHIC_COMMA = $3001; + UNICODE_IDEOGRAPHIC_FULL_STOP = $3002; + UNICODE_FULLWIDTH_COMMA = $FF0C; + UNICODE_HORIZONTAL_ELLIPSIS = $2026; + + //bracket equivalence + UNICODE_RIGHT_POINTING_ANGLE_BRACKET = $232A; + UNICODE_RIGHT_ANGLE_BRACKET = $3009; + +type //bracket matching + TUnicodeBracketInfo = record + IsBracket: boolean; + OpeningBracket,ClosingBracket: LongWord; + end; + +{ Returns the Bidi class as defined by Unicode used to determine text direction } +function GetUnicodeBidiClass(u: LongWord): TUnicodeBidiClass; +{ Same as above but returns additional classes: ubcCombiningLeftToRight and ubcMirroredNeutral } +function GetUnicodeBidiClassEx(u: LongWord): TUnicodeBidiClass; +function GetUnicodeBracketInfo(u: LongWord): TUnicodeBracketInfo; +{ Returns how the letter can be joined to the surrounding letters (for example in arabic) } +function GetUnicodeJoiningType(u: LongWord): TUnicodeJoiningType; +{ Returns the Combining class defined by unicode for non-spacing marks and combining marks + or 255 if the character is not to be combined } +function GetUnicodeCombiningClass(u: LongWord): byte; +function IsZeroWidthUnicode(u: LongWord): boolean; +{ Returns if the symbol can be mirrored horizontally for right-to-left text } +function IsUnicodeMirrored(u: LongWord): boolean; +function IsUnicodeParagraphSeparator(u: LongWord): boolean; +function IsUnicodeCrLf(u: LongWord): boolean; +function IsUnicodeSpace(u: LongWord): boolean; +function IsUnicodeIsolateOrFormatting(u: LongWord): boolean; +function IsModifierCombiningMark(u: LongWord): boolean; + +{ Analyze unicode and return bidi levels for each character. + baseDirection can be either UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE or UNICODE_FIRST_STRONG_ISOLATE } +function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; baseDirection: LongWord): TUnicodeBidiArray; +function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; ABidiMode: TFontBidiMode): TUnicodeBidiArray; + +{ Determine diplay order, provided the display surface is horizontally infinite } +function GetUnicodeDisplayOrder(const AInfo: TUnicodeBidiArray): TUnicodeDisplayOrder; overload; +function GetUnicodeDisplayOrder(ALevels: PByte; ACount: integer): TUnicodeDisplayOrder; overload; +function GetUnicodeDisplayOrder(ABidiInfo: PUnicodeBidiInfo; AStride, ACount: integer): TUnicodeDisplayOrder; overload; + +implementation + +{$i generatedunicode.inc} + +function GetUnicodeCombiningClass(u: LongWord): byte; +var + minIndex, maxIndex, midIndex: Integer; + compU: LongWord; +begin + minIndex := 0; + maxIndex := high(UnicodeCombiningInfos); + repeat + midIndex := (minIndex+maxIndex) shr 1; + compU := UnicodeCombiningInfos[midIndex].u; + if u = compU then exit(UnicodeCombiningInfos[midIndex].c) else + if u < compU then maxIndex := midIndex-1 + else minIndex := midIndex+1; + until maxIndex < minIndex; + result := 255; //not combining +end; + +function GetUnicodeBidiClass(u: LongWord): TUnicodeBidiClass; +begin + result := GetUnicodeBidiClassEx(u); + if result = ubcMirroredNeutral then result := ubcOtherNeutrals + else if result = ubcCombiningLeftToRight then result := ubcLeftToRight; +end; + +function IsUnicodeMirrored(u: LongWord): boolean; +begin + result := GetUnicodeBidiClassEx(u) = ubcMirroredNeutral; +end; + +function IsZeroWidthUnicode(u: LongWord): boolean; +begin + case u of + UNICODE_ZERO_WIDTH_SPACE, UNICODE_ZERO_WIDTH_NON_JOINER, + UNICODE_ZERO_WIDTH_JOINER, UNICODE_ZERO_WIDTH_NO_BREAK_SPACE, + UNICODE_LEFT_TO_RIGHT_MARK,UNICODE_RIGHT_TO_LEFT_MARK, + UNICODE_ARABIC_LETTER_MARK: result := true; + else result := false; + end; +end; + +function IsUnicodeParagraphSeparator(u: LongWord): boolean; +begin + case u of + $0A, $0D, UNICODE_NEXT_LINE, UNICODE_PARAGRAPH_SEPARATOR, + UNICODE_INFORMATION_SEPARATOR_FOUR, UNICODE_INFORMATION_SEPARATOR_THREE, UNICODE_INFORMATION_SEPARATOR_TWO: result := true; + else result := false; + end; +end; + +function IsUnicodeCrLf(u: LongWord): boolean; +begin + result := (u=10) or (u=13); +end; + +function IsUnicodeSpace(u: LongWord): boolean; +begin + result := GetUnicodeBidiClass(u) = ubcWhiteSpace; +end; + +function IsUnicodeIsolateOrFormatting(u: LongWord): boolean; +begin + case u of + UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE, + UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, + UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(true) + else exit(false); + end; +end; + +function IsModifierCombiningMark(u: LongWord): boolean; +begin + case u of + $0654,$0655,$0658,$06DC,$06E3,$06E7,$06E8,$08D3,$08F3: exit(true); + else exit(false); + end; +end; + +{ TUnicodeBidiInfo } + +function TUnicodeBidiInfo.GetDiscardable: boolean; +begin + result := IsRemoved and not IsLigatureBoundary; +end; + +function TUnicodeBidiInfo.GetEndOfLine: boolean; +begin + result := (Flags and BIDI_FLAG_END_OF_LINE) <> 0; +end; + +function TUnicodeBidiInfo.GetEndOfParagraph: boolean; +begin + result := (Flags and (BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH or BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH)) <> 0; +end; + +function TUnicodeBidiInfo.GetExplicitEndOfParagraph: boolean; +begin + result := (Flags and BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH) <> 0; +end; + +function TUnicodeBidiInfo.GetHasLigatureLeft: boolean; +begin + result := (Flags and BIDI_FLAG_LIGATURE_LEFT) <> 0; +end; + +function TUnicodeBidiInfo.GetHasLigatureRight: boolean; +begin + result := (Flags and BIDI_FLAG_LIGATURE_RIGHT) <> 0; +end; + +function TUnicodeBidiInfo.GetImplicitEndOfParagraph: boolean; +begin + result := (Flags and BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH) <> 0; +end; + +function TUnicodeBidiInfo.GetIsCombiningLeft: boolean; +begin + result := (Flags and BIDI_FLAG_COMBINING_LEFT) <> 0; +end; + +function TUnicodeBidiInfo.GetIsCombiningRight: boolean; +begin + result := (Flags and BIDI_FLAG_COMBINING_RIGHT) <> 0; +end; + +function TUnicodeBidiInfo.GetIsMirrored: boolean; +begin + result := (Flags and BIDI_FLAG_MIRRORED) <> 0; +end; + +function TUnicodeBidiInfo.GetLigatureBoundary: boolean; +begin + result := (Flags and BIDI_FLAG_LIGATURE_BOUNDARY) <> 0; +end; + +function TUnicodeBidiInfo.GetLigatureTransparent: boolean; +begin + result := (Flags and BIDI_FLAG_LIGATURE_TRANSPARENT) <> 0; +end; + +function TUnicodeBidiInfo.GetMulticharStart: boolean; +begin + result := (Flags and BIDI_FLAG_MULTICHAR_START) <> 0; +end; + +function TUnicodeBidiInfo.GetNonSpacingMark: boolean; +begin + result := (Flags and BIDI_FLAG_NON_SPACING_MARK) <> 0; +end; + +function TUnicodeBidiInfo.GetRemoved: boolean; +begin + result := (Flags and BIDI_FLAG_REMOVED) <> 0; +end; + +function TUnicodeBidiInfo.GetRightToLeft: boolean; +begin + result := Odd(BidiLevel); +end; + +function TUnicodeBidiInfo.GetParagraphRightToLeft: boolean; +begin + result := Odd(ParagraphBidiLevel); +end; + +function TUnicodeBidiInfo.GetRightToLeftScript: boolean; +begin + result := (Flags and BIDI_FLAG_RTL_SCRIPT) <> 0; +end; + +class operator TUnicodeBidiInfo.=(const AInfo1, AInfo2: TUnicodeBidiInfo + ): boolean; +begin + result := (AInfo1.BidiLevel = AInfo2.BidiLevel) and + (AInfo1.Flags = AInfo2.Flags) and + (AInfo1.ParagraphBidiLevel = AInfo2.ParagraphBidiLevel); +end; + +function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; baseDirection: LongWord): TUnicodeBidiArray; +type + TUnicodeAnalysisElement = record + bidiClass: TUnicodeBidiClass; + prevInIsolate, nextInIsolate: integer; //next index in current isolate + end; + TUnicodeAnalysisArray = array of TUnicodeAnalysisElement; + +var + a: TUnicodeAnalysisArray; + + procedure ResolveWeakTypes(startIndex, afterEndIndex: integer; startOfSequence, {%H-}endOfSequence: TUnicodeBidiClass); + var + curIndex,backIndex: Integer; + latestStrongClass, prevClass: TUnicodeBidiClass; + begin + //rules W1 and W2 + prevClass := startOfSequence; + latestStrongClass:= prevClass; + curIndex := startIndex; + while curIndex <> afterEndIndex do + begin + if not result[curIndex].IsRemoved then + begin + case a[curIndex].bidiClass of + ubcNonSpacingMark: a[curIndex].bidiClass:= prevClass; + ubcEuropeanNumber: if latestStrongClass = ubcArabicLetter then a[curIndex].bidiClass:= ubcArabicNumber; + end; + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_ISOLATE, + UNICODE_RIGHT_TO_LEFT_ISOLATE, + UNICODE_FIRST_STRONG_ISOLATE, + UNICODE_POP_DIRECTIONAL_ISOLATE: prevClass := ubcOtherNeutrals; + else prevClass := a[curIndex].bidiClass; + end; + if prevClass in [ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then latestStrongClass:= prevClass; + end; + curIndex := a[curIndex].nextInIsolate; + end; + + // rule W4 and W5 + prevClass := startOfSequence; + curIndex := startIndex; + while curIndex <> afterEndIndex do + begin + if not result[curIndex].IsRemoved then + begin + case a[curIndex].bidiClass of + ubcArabicLetter: a[curIndex].bidiClass := ubcRightToLeft; + ubcEuropeanNumber: + begin + backIndex := curIndex; + while backIndex > startIndex do + begin + dec(backIndex); + if result[backIndex].IsRemoved then continue; + if a[backIndex].bidiClass = ubcEuropeanNumberTerminator then + a[backIndex].bidiClass := ubcEuropeanNumber + else break; + end; + end; + ubcEuropeanNumberSeparator: + if (prevClass = ubcEuropeanNumber) and (a[curIndex].nextInIsolate <> afterEndIndex) and + (a[a[curIndex].nextInIsolate].bidiClass = ubcEuropeanNumber) then + a[curIndex].bidiClass:= ubcEuropeanNumber; + ubcCommonSeparator: + if (prevClass in[ubcEuropeanNumber,ubcArabicNumber]) and (a[curIndex].nextInIsolate <> afterEndIndex) and + (a[a[curIndex].nextInIsolate].bidiClass = prevClass) then + a[curIndex].bidiClass:= prevClass; + ubcEuropeanNumberTerminator: + if prevClass = ubcEuropeanNumber then + a[curIndex].bidiClass:= ubcEuropeanNumber; + end; + prevClass := a[curIndex].bidiClass; + end; + + curIndex := a[curIndex].nextInIsolate; + end; + + // rule W6 and W7 + curIndex := startIndex; + latestStrongClass := startOfSequence; + while curIndex <> afterEndIndex do + begin + if not result[curIndex].IsRemoved then + begin + case a[curIndex].bidiClass of + ubcEuropeanNumberSeparator,ubcEuropeanNumberTerminator,ubcCommonSeparator: a[curIndex].bidiClass := ubcOtherNeutrals; + ubcLeftToRight,ubcRightToLeft,ubcArabicLetter: latestStrongClass:= a[curIndex].bidiClass; + ubcEuropeanNumber: if latestStrongClass = ubcLeftToRight then a[curIndex].bidiClass := ubcLeftToRight; + end; + end; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + procedure ResolveNeutrals(startIndex, afterEndIndex: integer; startOfSequence, endOfSequence: TUnicodeBidiClass); + var + curIndex,prevIndex,previewIndex: Integer; + curRTL, include, rightToLeftEmbedding: Boolean; + bidiClass: TUnicodeBidiClass; + begin + rightToLeftEmbedding := odd(result[startIndex].BidiLevel); + curIndex := startIndex; + curRTL := startOfSequence in [ubcRightToLeft,ubcArabicLetter]; + while curIndex <> afterEndIndex do + begin + case a[curIndex].bidiClass of + ubcLeftToRight: curRTL := false; + ubcRightToLeft,ubcArabicLetter,ubcArabicNumber,ubcEuropeanNumber: curRTL := true; + else + if curRTL <> rightToLeftEmbedding then + begin + //determine whether following neutral chars are included in reverse direction + prevIndex := curIndex; + previewIndex := a[curIndex].nextInIsolate; + include := false; + while previewIndex <> afterEndIndex do //uses endOfSequence for overflow + begin + if previewIndex = afterEndIndex then + bidiClass:= endOfSequence + else + bidiClass:= a[previewIndex].bidiClass; + case bidiClass of + ubcLeftToRight: + begin + include := not curRTL; + break; + end; + ubcRightToLeft,ubcArabicLetter,ubcArabicNumber,ubcEuropeanNumber: + begin + include := curRTL; + break; + end; + end; + prevIndex := previewIndex; + previewIndex := a[previewIndex].nextInIsolate; + end; + if previewIndex = afterEndIndex then previewIndex := prevIndex; + if include then + begin + while curIndex <> previewIndex do + begin + if a[curIndex].bidiClass = ubcBoundaryNeutral then + result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; //supposed to be removed for rendering + + if a[curIndex].bidiClass in (ubcNeutral+[ubcBoundaryNeutral,ubcUnknown]) then + begin + if curRTL then a[curIndex].bidiClass := ubcRightToLeft + else a[curIndex].bidiClass := ubcLeftToRight; + end; + + curIndex := a[curIndex].nextInIsolate; + end; + end else + curRTL := rightToLeftEmbedding; + end; + end; + + if a[curIndex].bidiClass = ubcBoundaryNeutral then + result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; //supposed to be removed for rendering + + if a[curIndex].bidiClass in (ubcNeutral+[ubcBoundaryNeutral,ubcUnknown]) then + begin + if curRTL then a[curIndex].bidiClass := ubcRightToLeft + else a[curIndex].bidiClass := ubcLeftToRight; + end; + + curIndex := a[curIndex].nextInIsolate; + end; + end; + + procedure ResolveBrackets(startIndex, afterEndIndex: integer; startOfSequence, {%H-}endOfSequence: TUnicodeBidiClass); + type TBracketPair = record + openIndex,closeIndex: integer; + end; + var + bracketPairs: array of TBracketPair; + bracketPairCount: integer; + rightToLeft: boolean; + + procedure SortBracketPairs; + var + i,j,k: Integer; + temp: TBracketPair; + begin + for i := 1 to bracketPairCount-1 do + begin + for j := 0 to i-1 do + if bracketPairs[j].openIndex > bracketPairs[i].openIndex then + begin + temp := bracketPairs[i]; + for k := i downto j+1 do + bracketPairs[k] := bracketPairs[k-1]; + bracketPairs[j] := temp; + end; + end; + end; + + procedure FindBrackets; // rule BD16 + const MAX_BRACKET_STACK = 63; + var + bracketStack: array[0..MAX_BRACKET_STACK-1] of record + bracketCharInfo: TUnicodeBracketInfo; + index: integer; + end; + bracketStackPos,peekPos: integer; + curIndex: integer; + curBracket: TUnicodeBracketInfo; + begin + bracketPairCount := 0; + bracketStackPos := 0; + bracketStack[0].index := -1; //avoid warning + curIndex := startIndex; + while curIndex <> afterEndIndex do + begin + if a[curIndex].bidiClass = ubcOtherNeutrals then + begin + curBracket := GetUnicodeBracketInfo(u[curIndex]); + if curBracket.IsBracket then + begin + // found opening bracket + if curBracket.OpeningBracket = u[curIndex] then + begin + if bracketStackPos <= high(bracketStack) then + begin + bracketStack[bracketStackPos].bracketCharInfo := curBracket; + bracketStack[bracketStackPos].index := curIndex; + inc(bracketStackPos); + end else + break; + end else + begin + for peekPos := bracketStackPos-1 downto 0 do + if (bracketStack[peekPos].bracketCharInfo.ClosingBracket = u[curIndex]) or + ((bracketStack[peekPos].bracketCharInfo.ClosingBracket = UNICODE_RIGHT_ANGLE_BRACKET) and (u[curIndex] = UNICODE_RIGHT_POINTING_ANGLE_BRACKET)) or + ((bracketStack[peekPos].bracketCharInfo.ClosingBracket = UNICODE_RIGHT_POINTING_ANGLE_BRACKET) and (u[curIndex] = UNICODE_RIGHT_ANGLE_BRACKET)) then + begin + bracketStackPos := peekPos; + if bracketPairCount >= length(bracketPairs) then + setlength(bracketPairs, bracketPairCount*2 + 8); + bracketPairs[bracketPairCount].openIndex := bracketStack[peekPos].index; + bracketPairs[bracketPairCount].closeIndex := curIndex; + inc(bracketPairCount); + break; + end; + end; + end; + end; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + procedure SetCharClass(index: integer; newClass: TUnicodeBidiClass); + begin + a[index].bidiClass:= newClass; + index := a[index].nextInIsolate; + while (index <> afterEndIndex) and (GetUnicodeBidiClass(u[index]) = ubcNonSpacingMark) do + begin + a[index].bidiClass := newClass; + index := a[index].nextInIsolate; + end; + end; + + procedure ResolveBrackets; // rule N0 + var + i, curIndex: Integer; + sameDirection, oppositeDirection, oppositeContext: boolean; + begin + for i := 0 to bracketPairCount-1 do + begin + curIndex := bracketPairs[i].openIndex+1; + sameDirection:= false; + oppositeDirection:= false; + while curIndex <> bracketPairs[i].closeIndex do + begin + Assert((curIndex >= startIndex) and (curIndex < length(a)), 'Expecting valid index'); + case a[curIndex].bidiClass of + ubcLeftToRight: + if not rightToLeft then + begin + sameDirection := true; + break; + end else oppositeDirection:= true; + ubcRightToLeft,ubcArabicLetter,ubcEuropeanNumber,ubcArabicNumber: + if rightToLeft then + begin + sameDirection := true; + break; + end else oppositeDirection:= true; + end; + curIndex := a[curIndex].nextInIsolate; + end; + if sameDirection then + begin + if rightToLeft then + begin + SetCharClass(bracketPairs[i].openIndex, ubcRightToLeft); + SetCharClass(bracketPairs[i].closeIndex, ubcRightToLeft); + end else + begin + SetCharClass(bracketPairs[i].openIndex, ubcLeftToRight); + SetCharClass(bracketPairs[i].closeIndex, ubcLeftToRight); + end; + end else + if oppositeDirection then + begin + curIndex := a[bracketPairs[i].openIndex].prevInIsolate; + oppositeContext := false; + while curIndex >= startIndex do + begin + case a[curIndex].bidiClass of + ubcRightToLeft,ubcArabicLetter,ubcEuropeanNumber,ubcArabicNumber: + begin + oppositeContext := not rightToLeft; + break; + end; + ubcLeftToRight: + begin + oppositeContext := rightToLeft; + break; + end; + end; + curIndex := a[curIndex].prevInIsolate; + end; + if rightToLeft xor oppositeContext then + begin + SetCharClass(bracketPairs[i].openIndex, ubcRightToLeft); + SetCharClass(bracketPairs[i].closeIndex, ubcRightToLeft); + end else + begin + SetCharClass(bracketPairs[i].openIndex, ubcLeftToRight); + SetCharClass(bracketPairs[i].closeIndex, ubcLeftToRight); + end; + end; + end; + end; + + begin + rightToLeft:= startOfSequence in[ubcRightToLeft,ubcArabicLetter]; + FindBrackets; + SortBracketPairs; + ResolveBrackets; + end; + + procedure ResolveLigature(startIndex: integer); + var + prevJoiningType, joiningType: TUnicodeJoiningType; + prevJoiningTypeBidilevel: byte; + prevJoiningTypeIndex: integer; + curIndex: Integer; + begin + prevJoiningType := ujtNonJoining; + prevJoiningTypeIndex := -1; + prevJoiningTypeBidilevel:= 0; + curIndex := startIndex; + while curIndex <> -1 do + begin + if prevJoiningTypeBidilevel <> result[curIndex].BidiLevel then + prevJoiningType := ujtNonJoining; + if result[curIndex].IsNonSpacingMark then + joiningType := ujtTransparent //NSM are always joining-transparent + else joiningType := GetUnicodeJoiningType(u[curIndex]); + if joiningType = ujtTransparent then + result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_TRANSPARENT; + if result[curIndex].IsRightToLeft then + begin + if (joiningType in[ujtRightJoining,ujtDualJoining]) + and (prevJoiningType in[ujtLeftJoining,ujtDualJoining,ujtJoinCausing]) then + result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_RIGHT; + if (prevJoiningType in[ujtLeftJoining,ujtDualJoining]) and (prevJoiningTypeIndex <> -1) and + (joiningType in[ujtRightJoining,ujtDualJoining,ujtJoinCausing]) then + result[prevJoiningTypeIndex].Flags:= result[prevJoiningTypeIndex].Flags or BIDI_FLAG_LIGATURE_LEFT; + end else + begin + if (joiningType in[ujtLeftJoining,ujtDualJoining]) + and (prevJoiningType in[ujtRightJoining,ujtDualJoining,ujtJoinCausing]) then + result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_LEFT; + if (prevJoiningType in[ujtRightJoining,ujtDualJoining]) and (prevJoiningTypeIndex <> -1) and + (joiningType in[ujtLeftJoining,ujtDualJoining,ujtJoinCausing]) then + result[prevJoiningTypeIndex].Flags:= result[prevJoiningTypeIndex].Flags or BIDI_FLAG_LIGATURE_RIGHT; + end; + if joiningType <> ujtTransparent then + begin + prevJoiningType := joiningType; + prevJoiningTypeIndex:= curIndex; + prevJoiningTypeBidilevel:= result[curIndex].BidiLevel; + end; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + procedure AnalyzeSequence(startIndex, afterEndIndex: integer; sos, eos: TUnicodeBidiClass); + begin + if afterEndIndex = startIndex then exit; + ResolveWeakTypes(startIndex, afterEndIndex, sos, eos); + ResolveBrackets(startIndex, afterEndIndex, sos, eos); + ResolveNeutrals(startIndex, afterEndIndex, sos, eos); + end; + + procedure SameLevelRuns(startIndex: integer); + var + curBidiLevel: byte; + latestIndex,curIndex, curStartIndex: Integer; + curSos,eos: TUnicodeBidiClass; + begin + curIndex := startIndex; + while (curIndex<>-1) and result[curIndex].IsRemoved do + curIndex := a[curIndex].nextInIsolate; + if curIndex = -1 then exit; + + curStartIndex:= curIndex; + curBidiLevel := result[curIndex].bidiLevel; + if odd(curBidiLevel) then curSos := ubcRightToLeft else curSos := ubcLeftToRight; + latestIndex := -1; + while curIndex <> -1 do + begin + if not result[curIndex].IsRemoved then + begin + if (latestIndex <> -1) and (result[curIndex].bidiLevel <> curBidiLevel) then + begin + if result[curIndex].bidiLevel > curBidiLevel then + begin + if odd(result[curIndex].bidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; + end else + begin + if odd(curBidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; + end; + + AnalyzeSequence(curStartIndex, a[latestIndex].nextInIsolate, curSos, eos); + + curSos := eos; + curBidiLevel:= result[curIndex].bidiLevel; + curStartIndex:= curIndex; + end; + latestIndex := curIndex; + end; + + if (a[curIndex].nextInIsolate = -1) and (latestIndex<>-1) then + begin + if odd(result[latestIndex].bidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; + AnalyzeSequence(curStartIndex, a[latestIndex].nextInIsolate, curSos, eos); + break; + end; + + curIndex := a[curIndex].nextInIsolate; + end; + end; + + //analyse bidi formatting of an embedding or an override block + procedure AnalyzeFormattingBlocks(startIndex, lastIndex: integer; minBidiLevel: byte; formattingCode: LongWord); + var curIndex, nextIndex, levelIncrease: integer; + subFormatBeforeStart, subFormatStart, formatNesting: integer; + subFormatCode: LongWord; + begin + case formattingCode of + UNICODE_LEFT_TO_RIGHT_OVERRIDE,UNICODE_LEFT_TO_RIGHT_EMBEDDING: + if odd(minBidiLevel) then inc(minBidiLevel); + UNICODE_RIGHT_TO_LEFT_OVERRIDE,UNICODE_RIGHT_TO_LEFT_EMBEDDING: + if not odd(minBidiLevel) then inc(minBidiLevel); + end; + nextIndex := startIndex; + repeat + Assert(nextIndex >= 0, 'Expecting valid index'); + curIndex := nextIndex; + nextIndex := a[curIndex].nextInIsolate; + result[curIndex].bidiLevel := minBidiLevel; + + //apply override + if formattingCode = UNICODE_LEFT_TO_RIGHT_OVERRIDE then a[curIndex].bidiClass := ubcLeftToRight + else if formattingCode = UNICODE_RIGHT_TO_LEFT_OVERRIDE then a[curIndex].bidiClass := ubcRightToLeft; + + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, + UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: + begin + result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_OVERRIDE,UNICODE_LEFT_TO_RIGHT_EMBEDDING: + if odd(minBidiLevel) then levelIncrease := 1 + else levelIncrease := 2; + UNICODE_RIGHT_TO_LEFT_OVERRIDE,UNICODE_RIGHT_TO_LEFT_EMBEDDING: + if odd(minBidiLevel) then levelIncrease := 2 + else levelIncrease := 1; + else levelIncrease:= 2; + end; + if minBidiLevel <= UNICODE_MAX_BIDI_DEPTH-levelIncrease-1 then + begin + subFormatCode:= u[curIndex]; + subFormatBeforeStart := curIndex; + subFormatStart := nextIndex; + formatNesting:= 1; + while formatNesting > 0 do + begin + //sub-format ends because no more chars + if curIndex = lastIndex then + begin + if curIndex <> subFormatBeforeStart then + AnalyzeFormattingBlocks(subFormatStart, curIndex, minBidiLevel+levelIncrease, subFormatCode); + break; + end; + + Assert(nextIndex >= 0, 'Expecting valid index'); + case u[nextIndex] of + UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, + UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: inc(formatNesting); + UNICODE_POP_DIRECTIONAL_FORMATTING: + begin + dec(formatNesting); + if formatNesting = 0 then + begin + //sub-format ends because enough matching pop chars found + if curIndex <> subFormatBeforeStart then + AnalyzeFormattingBlocks(subFormatStart, curIndex, minBidiLevel+levelIncrease, subFormatCode); + + curIndex := nextIndex; + nextIndex := a[curIndex].nextInIsolate; + result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; + break; + end; + end; + end; + + curIndex := nextIndex; + nextIndex := a[curIndex].nextInIsolate; + end; + end; + end; + UNICODE_POP_DIRECTIONAL_FORMATTING: //ignored when no matching formatting code + begin + result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; + end; + end; + until curIndex = lastIndex; + end; + + procedure ResolveImplicitLevels(startIndex: integer); // rule I1 and I2 + var + curIndex: Integer; + begin + curIndex := startIndex; + while curIndex <> -1 do + begin + case a[curIndex].bidiClass of + ubcRightToLeft,ubcArabicLetter: + if not Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel); + ubcEuropeanNumber,ubcArabicNumber: + if Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel) + else inc(result[curIndex].bidiLevel, 2); + ubcLeftToRight: if Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel); + end; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + procedure ResetEndOfParagraphLevels(startIndex: integer); // rule L1 + var + prevIndex,curIndex: Integer; + + procedure TweakWhiteSpaceBefore(index: integer); + var + isWhiteSpaceOrIsolate: boolean; + begin + while index <> -1 do + begin + case u[index] of + UNICODE_FIRST_STRONG_ISOLATE, UNICODE_POP_DIRECTIONAL_ISOLATE, + UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: + isWhiteSpaceOrIsolate:= true; + else + isWhiteSpaceOrIsolate:= GetUnicodeBidiClass(u[index]) = ubcWhiteSpace; + end; + if isWhiteSpaceOrIsolate then + result[index].bidiLevel := result[index].ParagraphBidiLevel + else + break; + index := a[index].prevInIsolate; + end; + end; + + begin + prevIndex := -1; + curIndex := startIndex; + while curIndex <> -1 do + begin + case GetUnicodeBidiClass(u[curIndex]) of + ubcSegmentSeparator, ubcParagraphSeparator: + begin + result[curIndex].bidiLevel := result[curIndex].ParagraphBidiLevel; + TweakWhiteSpaceBefore(prevIndex); + end; + end; + prevIndex := curIndex; + curIndex := a[curIndex].nextInIsolate; + end; + TweakWhiteSpaceBefore(prevIndex); + end; + + function DetermineIsolateDirectionFromFirstStrongClass(startIndex: integer): LongWord; + var + curIndex: Integer; + begin + curIndex := startIndex; + while curIndex <> -1 do + begin + Assert(curIndex >= 0, 'Expecting valid index'); + case a[curIndex].bidiClass of + ubcLeftToRight: exit(UNICODE_LEFT_TO_RIGHT_ISOLATE); + ubcRightToLeft,ubcArabicLetter: exit(UNICODE_RIGHT_TO_LEFT_ISOLATE); + end; + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_OVERRIDE: exit(UNICODE_LEFT_TO_RIGHT_ISOLATE); + UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(UNICODE_RIGHT_TO_LEFT_ISOLATE); + end; + curIndex := a[curIndex].nextInIsolate; + end; + result := UNICODE_LEFT_TO_RIGHT_ISOLATE; + end; + + procedure LinkCharsInIsolate(startIndex: integer; charCount: integer; out endIndex : integer); + var + curIndex,isolateStackPos, + prevIndex: Integer; + begin + a[startIndex].prevInIsolate := -1; + prevIndex := -1; + curIndex := startIndex; + isolateStackPos:= 0; + while curIndex < startIndex+charCount do + begin + if u[curIndex] = UNICODE_POP_DIRECTIONAL_ISOLATE then + if isolateStackPos > 0 then dec(isolateStackPos); + + if isolateStackPos = 0 then + begin + if prevIndex<>-1 then a[prevIndex].nextInIsolate := curIndex; + a[curIndex].prevInIsolate := prevIndex; + + prevIndex := curIndex; + end; + + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE: inc(isolateStackPos); + end; + inc(curIndex); + end; + a[prevIndex].nextInIsolate := -1; + endIndex := prevIndex; + end; + + //split isolates in order to format them independently + procedure AnalyzeIsolates(startIndex: integer; charCount: integer; isolateDirection: LongWord; minBidiLevel: byte = 0; + isParagraph: boolean = false); + var curIndex, endIndex: integer; + nextIndex: integer; + subBidiLevel, levelIncrease: byte; + subIsolateStart: integer; + subIsolateDirection: LongWord; + begin + if charCount = 0 then exit; + Assert(startIndex>=0, 'Invalid start index'); + + LinkCharsInIsolate(startIndex, charCount, endIndex); + + if isolateDirection = UNICODE_FIRST_STRONG_ISOLATE then + isolateDirection := DetermineIsolateDirectionFromFirstStrongClass(startIndex); + + case isolateDirection of + UNICODE_LEFT_TO_RIGHT_ISOLATE: if Odd(minBidiLevel) then inc(minBidiLevel); + UNICODE_RIGHT_TO_LEFT_ISOLATE: if not Odd(minBidiLevel) then inc(minBidiLevel); + else + raise EInvalidOperation.Create('Unknown isolate direction'); + end; + + if isParagraph then + begin + curIndex := startIndex; + while curIndex <> -1 do + begin + result[curIndex].ParagraphBidiLevel := minBidiLevel; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + case isolateDirection of + UNICODE_LEFT_TO_RIGHT_ISOLATE: AnalyzeFormattingBlocks(startIndex, endIndex, minBidiLevel, UNICODE_LEFT_TO_RIGHT_EMBEDDING); + UNICODE_RIGHT_TO_LEFT_ISOLATE: AnalyzeFormattingBlocks(startIndex, endIndex, minBidiLevel, UNICODE_RIGHT_TO_LEFT_EMBEDDING); + end; + + SameLevelRuns(startIndex); + ResolveImplicitLevels(startIndex); + ResolveLigature(startIndex); + + if isParagraph then + ResetEndOfParagraphLevels(startIndex); + + //analyse sub-isolates + curIndex := startIndex; + while curIndex <> -1 do + begin + Assert(curIndex >= 0, 'Expecting valid index'); + case u[curIndex] of + UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE: + begin + subBidiLevel := result[curIndex].bidiLevel; + nextIndex := a[curIndex].nextInIsolate; + if nextIndex <> -1 then + begin + if result[nextIndex].bidiLevel > subBidiLevel then + subBidiLevel:= result[nextIndex].bidiLevel; + end; + if ((isolateDirection = UNICODE_LEFT_TO_RIGHT_ISOLATE) and + (u[curIndex] = UNICODE_RIGHT_TO_LEFT_ISOLATE)) or + ((isolateDirection = UNICODE_LEFT_TO_RIGHT_ISOLATE) and + (u[curIndex] = UNICODE_RIGHT_TO_LEFT_ISOLATE)) then + levelIncrease := 1 + else + levelIncrease:= 2; + if subBidiLevel+levelIncrease <= UNICODE_MAX_BIDI_DEPTH-1 then + begin + subIsolateDirection := u[curIndex]; + subIsolateStart:= curIndex+1; + curIndex := nextIndex; + + //sub-isolates ends because no more chars + if curIndex = -1 then + begin + AnalyzeIsolates(subIsolateStart, startIndex+charCount-subIsolateStart, subIsolateDirection, subBidiLevel+1); + break; + end else + begin + AnalyzeIsolates(subIsolateStart, curIndex-subIsolateStart, subIsolateDirection, subBidiLevel+1); + continue; + end; + end; + end; + end; + curIndex := a[curIndex].nextInIsolate; + end; + end; + + //split UTF8 string into paragraphs + procedure SplitParagraphs; + var + lineStartIndex, curIndex: integer; + begin + curIndex := 0; + lineStartIndex := curIndex; + while curIndex < ALength do + begin + if a[curIndex].bidiClass = ubcParagraphSeparator then + begin + //skip second CRLF char + if IsUnicodeCrLf(u[curIndex]) and (curIndex+1 < ALength) and + IsUnicodeCrLf(u[curIndex+1]) and (u[curIndex+1] <> u[curIndex]) then + begin + inc(curIndex); + result[curIndex].Flags := result[curIndex].Flags and not BIDI_FLAG_MULTICHAR_START; + end; + + result[curIndex].Flags := result[curIndex].Flags or BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH; + + AnalyzeIsolates(lineStartIndex, curIndex+1-lineStartIndex, baseDirection, 0, true); + lineStartIndex := curIndex+1; + end; + inc(curIndex); + end; + if curIndex > lineStartIndex then + begin + result[curIndex-1].Flags := result[curIndex-1].Flags or BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH; + AnalyzeIsolates(lineStartIndex, curIndex-lineStartIndex, baseDirection, 0, true); + end; + end; + +var i: integer; + classEx: TUnicodeBidiClass; +begin + setlength(a, ALength); + setlength(result, ALength); + if ALength > 0 then + begin + for i := 0 to high(a) do + begin + classEx := GetUnicodeBidiClassEx(u[i]); + case classEx of + ubcMirroredNeutral: + begin + result[i].Flags := result[i].Flags or BIDI_FLAG_MIRRORED; + a[i].bidiClass := ubcOtherNeutrals; + end; + ubcCombiningLeftToRight: + begin + case GetUnicodeCombiningClass(u[i]) of + 208, 224: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_LEFT; + 210, 226, 9: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_RIGHT; + 0: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_LEFT OR BIDI_FLAG_COMBINING_RIGHT; + end; + a[i].bidiClass := ubcLeftToRight; + end; + otherwise + a[i].bidiClass := classEx; + end; + case u[i] of + UNICODE_LINE_SEPARATOR: //line separator within paragraph + result[i].Flags := result[i].Flags or BIDI_FLAG_END_OF_LINE; + UNICODE_ZERO_WIDTH_JOINER, UNICODE_ZERO_WIDTH_NON_JOINER: + result[i].Flags := result[i].Flags OR BIDI_FLAG_LIGATURE_BOUNDARY; + end; + case a[i].bidiClass of + ubcArabicLetter,ubcArabicNumber,ubcRightToLeft: + result[i].Flags := result[i].Flags OR BIDI_FLAG_RTL_SCRIPT; + ubcNonSpacingMark: result[i].Flags := result[i].Flags OR BIDI_FLAG_NON_SPACING_MARK; + end; + if (result[i].Flags and (BIDI_FLAG_NON_SPACING_MARK or BIDI_FLAG_COMBINING_LEFT + or BIDI_FLAG_COMBINING_RIGHT) = 0) or + (i = 0) or (a[i-1].bidiClass in [ubcSegmentSeparator, ubcParagraphSeparator]) then + result[i].Flags := result[i].Flags OR BIDI_FLAG_MULTICHAR_START; + end; + SplitParagraphs; + end; +end; + +function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; + ABidiMode: TFontBidiMode): TUnicodeBidiArray; +begin + case ABidiMode of + fbmLeftToRight: result := AnalyzeBidiUnicode(u, ALength, UNICODE_LEFT_TO_RIGHT_ISOLATE); + fbmRightToLeft: result := AnalyzeBidiUnicode(u, ALength, UNICODE_RIGHT_TO_LEFT_ISOLATE); + else + {fbmAuto} result := AnalyzeBidiUnicode(u, ALength, UNICODE_FIRST_STRONG_ISOLATE); + end; +end; + +function GetUnicodeDisplayOrder(const AInfo: TUnicodeBidiArray): TUnicodeDisplayOrder; +begin + if length(AInfo)=0 then + result := nil + else + result := GetUnicodeDisplayOrder(@AInfo[0], sizeof(TUnicodeBidiInfo), length(AInfo)); +end; + +function GetUnicodeDisplayOrder(ALevels: PByte; ACount: integer): TUnicodeDisplayOrder; + + procedure DetermineDisplayOrderRec(AOffset: integer; AStartIndex, ABlockCount: integer; AEmbeddingLevel: byte); + var minLevel: byte; + blockIndex,subStartIndex,subCount, subOffset: integer; + begin + //writeln('DetermineDisplayOrderRec('+inttostr(AOffset)+'/'+inttostr(ACount)+',' + inttostr(AStartIndex) +',*' +inttostr(ABlockCount)+','+inttostr(AEmbeddingLevel)+')'); + blockIndex := 0; + subStartIndex := 0; //avoid warning + while blockIndex < ABlockCount do + begin + Assert(AOffset < ACount, 'Offset out of bounds'); + if ALevels[AOffset] = AEmbeddingLevel then + begin + if odd(AEmbeddingLevel) then + result[AStartIndex+ABlockCount-1-blockIndex] := AOffset + else + result[AStartIndex+blockIndex] := AOffset; + inc(AOffset); + inc(blockIndex); + end else + begin + if not odd(AEmbeddingLevel) then + subStartIndex := AStartIndex+blockIndex; + subOffset := AOffset; + minLevel := ALevels[AOffset]; + inc(AOffset); + inc(blockIndex); + subCount := 1; + while true do + begin + if (blockIndex < ABlockCount) and (ALevels[AOffset] > AEmbeddingLevel) then + begin + Assert(AOffset < ACount, 'Offset out of bounds'); + if ALevels[AOffset] < minLevel then + minLevel:= ALevels[AOffset]; + inc(AOffset); + inc(blockIndex); + inc(subCount); + end else + begin + if odd(AEmbeddingLevel) then + subStartIndex := AStartIndex+ABlockCount-1-(blockIndex-1); + DetermineDisplayOrderRec(subOffset, subStartIndex, subCount, minLevel); + break; + end; + end; + end; + end; + end; + +begin + setlength(result, ACount); + DetermineDisplayOrderRec(0, 0, ACount, 0); +end; + +function GetUnicodeDisplayOrder(ABidiInfo: PUnicodeBidiInfo; AStride, ACount: integer): TUnicodeDisplayOrder; +var + levels: packed array of byte; + originalIndices: array of integer; + index,len, i: integer; + p: PByte; +begin + len := 0; + p := PByte(ABidiInfo); + for i := 0 to ACount-1 do + begin + if not PUnicodeBidiInfo(p)^.IsRemoved then inc(len); + inc(p, AStride); + end; + if len = 0 then + result := nil + else + begin + setlength(levels, len); + setlength(originalIndices, len); + p := PByte(ABidiInfo); + index := 0; + for i := 0 to ACount-1 do + begin + if not PUnicodeBidiInfo(p)^.IsRemoved then + begin + levels[index] := PUnicodeBidiInfo(p)^.BidiLevel; + originalIndices[index] := i; + inc(index); + end; + inc(p, AStride); + end; + result := GetUnicodeDisplayOrder(@levels[0], len); + for i := 0 to len-1 do + result[i] := originalIndices[result[i]]; + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraunicodetext.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraunicodetext.pas new file mode 100644 index 0000000..3686c1a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraunicodetext.pas @@ -0,0 +1,960 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAUnicodeText; + +{$mode objfpc}{$H+} +{ $DEFINE DEBUG} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, BGRAUnicode, BGRAUTF8; + +type + TDeleteCharEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; + TInsertCharEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; + TParagraphEvent = procedure(ASender: TObject; AParagraphIndex: integer) of object; + TParagraphSplitEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharIndex: integer) of object; + TAnalysisChangedEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; + + { TBidiTree } + + TBidiTree = class + private + FParent: TBidiTree; + FData: pointer; + FStartIndex, FEndIndex: integer; + FBidiLevel: byte; + FBranches: TList; + FIsLeaf: boolean; + function GetBranch(AIndex: integer): TBidiTree; + function GetCount: integer; + function GetIsRightToLeft: boolean; + public + constructor Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); virtual; + destructor Destroy; override; + procedure AfterFinish; virtual; + procedure AddBranch(ABranch: TBidiTree); virtual; + procedure Shorten(AEndIndex: integer); virtual; + function TrySplit: boolean; virtual; + property StartIndex: integer read FStartIndex; + property EndIndex: integer read FEndIndex; + property BidiLevel: byte read FBidiLevel; + property IsRightToLeft: boolean read GetIsRightToLeft; + property Parent: TBidiTree read FParent; + property IsLeaf: boolean read FIsLeaf; + property Count: integer read GetCount; + property Branch[AIndex: integer]: TBidiTree read GetBranch; + property Data: pointer read FData; + end; + + TBidiTreeAny = class of TBidiTree; + + { TUnicodeAnalysis } + + TUnicodeAnalysis = class + private + FOnAnalysisChanged: TAnalysisChangedEvent; + FOnBidiModeChanged: TNotifyEvent; + FOnCharDeleted: TDeleteCharEvent; + FOnCharInserted: TInsertCharEvent; + FOnParagraphMergedWithNext: TParagraphEvent; + FOnParagraphDeleted: TParagraphEvent; + FOnParagraphSplit: TParagraphSplitEvent; + function GetParagraphRightToLeft(AIndex: integer): boolean; + protected + FText: string; + FCharCount: integer; + FBidi: TBidiUTF8Array; + FParagraph: array of record + firstUnbrokenLineIndex: integer; + end; + FParagraphCount: integer; + + FUnbrokenLine: array of record + startIndex: integer; + paragraphIndex: integer; + end; + FUnbrokenLineCount: integer; + + FBidiMode: TFontBidiMode; + procedure Analyze; + procedure CheckTextAnalysis; + function GetUnbrokenLineParagraphIndex(AIndex: integer): integer; + function GetUnbrokenLineStartIndex(AIndex: integer): integer; + function GetUnbrokenLineEndIndex(AIndex: integer): integer; + function GetParagraphEndIndex(AIndex: integer): integer; + function GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; + function GetParagraphFirstUnbrokenLine(AIndex: integer): integer; + function GetParagraphLastUnbrokenLinePlusOne(AIndex: integer): integer; + function GetParagraphStartIndex(AIndex: integer): integer; + function GetUnicodeChar(APosition0: integer): LongWord; + function GetUTF8Char(APosition0: integer): string4; + function GetBidiInfo(APosition0: integer): TUnicodeBidiInfo; + procedure SetBidiMode(AValue: TFontBidiMode); + + procedure InternalDeleteBidiAndUTF8(ABidiStart, ABidiCount: integer); + procedure InternalDeleteParagraph(AParagraphIndex: integer); + procedure InternalDeleteText(APosition, ACount: integer); + procedure InternalDeleteWithinParagraph(AParagraphIndex: integer; + APosition, ACount: integer; AUpdateBidi: boolean); + function InternalInsertText(APosition: integer; + const ANewBidi: TBidiUTF8Array; ANewTextUTF8: string): integer; + procedure InternalMergeParagraphWithNext(AParagraphIndex: integer); + procedure InternalSplitParagraph(AParagraphIndex: integer); + procedure InternalUpdateBidiIsolate(AParagraphIndex: integer; ABidiStart, ABidiCount: integer); + procedure InternalUpdateUnbrokenLines(AParagraphIndex: integer); + procedure CreateBidiTreeRec(ABidiTreeFactory: TBidiTreeAny; AData: pointer; ABidiTree: TBidiTree); + procedure CheckCharRange(AStartIndex, AEndIndex: integer; AMinIndex, AMaxIndex: integer); + public + constructor Create(ATextUTF8: string; ABidiMode: TFontBidiMode); + function GetParagraphAt(ACharIndex: integer): integer; + function CopyTextUTF8(AStartIndex, ACount: integer): string; + function CopyTextUTF8DiscardChars(AStartIndex,AEndIndex: integer; out ANonDiscardedCount: integer): string; + function InsertText(ATextUTF8: string; APosition: integer): integer; + function DeleteText(APosition, ACount: integer): integer; + function DeleteTextBefore(APosition, ACount: integer): integer; + function IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; + function IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; + function CreateBidiTree(ABidiTreeFactory: TBidiTreeAny; AData: pointer; AStartIndex, AEndIndex: integer; + AEmbeddingBidiLevel: integer): TBidiTree; + + property TextUTF8: string read FText; + property UTF8Char[APosition0: integer]: string4 read GetUTF8Char; + property UnicodeChar[APosition0: integer]: LongWord read GetUnicodeChar; + property BidiInfo[APosition0: integer]: TUnicodeBidiInfo read GetBidiInfo; + property CharCount: integer read FCharCount; + property UnbrokenLineCount: integer read FUnbrokenLineCount; + property UnbrokenLineStartIndex[AIndex: integer]: integer read GetUnbrokenLineStartIndex; + property UnbrokenLineEndIndex[AIndex: integer]: integer read GetUnbrokenLineEndIndex; + property UnbrokenLineParagraphIndex[AIndex: integer]: integer read GetUnbrokenLineParagraphIndex; + property ParagraphCount: integer read FParagraphCount; + property ParagraphFirstUnbrokenLine[AIndex:integer] : integer read GetParagraphFirstUnbrokenLine; + property ParagraphLastUnbrokenLinePlusOne[AIndex:integer] : integer read GetParagraphLastUnbrokenLinePlusOne; + property ParagraphStartIndex[AIndex: integer]: integer read GetParagraphStartIndex; + property ParagraphEndIndex[AIndex: integer]: integer read GetParagraphEndIndex; + property ParagraphEndIndexBeforeParagraphSeparator[AIndex: integer]: integer read GetParagraphEndIndexBeforeParagraphSeparator; + property ParagraphRightToLeft[AIndex: integer]: boolean read GetParagraphRightToLeft; + property BidiMode: TFontBidiMode read FBidiMode write SetBidiMode; + property OnBidiModeChanged: TNotifyEvent read FOnBidiModeChanged write FOnBidiModeChanged; + property OnCharDeleted: TDeleteCharEvent read FOnCharDeleted write FOnCharDeleted; + property OnCharInserted: TInsertCharEvent read FOnCharInserted write FOnCharInserted; + property OnParagraphDeleted: TParagraphEvent read FOnParagraphDeleted write FOnParagraphDeleted; + property OnParagraphMergedWithNext: TParagraphEvent read FOnParagraphMergedWithNext write FOnParagraphMergedWithNext; + property OnParagraphSplit: TParagraphSplitEvent read FOnParagraphSplit write FOnParagraphSplit; + property OnAnalysisChanged: TAnalysisChangedEvent read FOnAnalysisChanged write FOnAnalysisChanged; + end; + +implementation + +uses math; + +{ TBidiTree } + +function TBidiTree.GetCount: integer; +begin + if Assigned(FBranches) then + result:= FBranches.Count + else + result := 0; +end; + +function TBidiTree.GetIsRightToLeft: boolean; +begin + result := odd(BidiLevel); +end; + +function TBidiTree.GetBranch(AIndex: integer): TBidiTree; +begin + if (AIndex < 0) or (AIndex >= Count) then raise exception.Create('Branch index out of bounds'); + result := TBidiTree(FBranches[AIndex]); +end; + +constructor TBidiTree.Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); +begin + FData := AData; + FParent := nil; + FStartIndex:= AStartIndex; + FEndIndex:= AEndIndex; + FBidiLevel:= ABidiLevel; + FBranches:= nil; + FIsLeaf:= AIsLeaf; +end; + +destructor TBidiTree.Destroy; +var + i: Integer; +begin + if Assigned(FBranches) then + begin + for i := 0 to FBranches.Count-1 do + TBidiTree(FBranches[i]).Free; + FBranches.Free; + end; + inherited Destroy; +end; + +procedure TBidiTree.AfterFinish; +begin + // +end; + +procedure TBidiTree.AddBranch(ABranch: TBidiTree); +begin + if IsLeaf then raise exception.Create('A leaf cannot have branches'); + if Assigned(ABranch.Parent) then raise exception.Create('Branch already has a parent'); + ABranch.FParent := self; + if FBranches = nil then FBranches := TList.Create; + FBranches.Add(ABranch); +end; + +procedure TBidiTree.Shorten(AEndIndex: integer); +var + i: Integer; +begin + if AEndIndex = EndIndex then exit; + if AEndIndex > EndIndex then raise exception.Create('Cannot extend the branch'); + if AEndIndex < StartIndex then raise exception.Create('End index before start'); + for i := Count-1 downto 0 do + if AEndIndex <= Branch[i].StartIndex then + begin + Branch[i].Free; + FBranches.Delete(i); + end else + if AEndIndex < Branch[i].EndIndex then + Branch[i].Shorten(AEndIndex); + FEndIndex:= AEndIndex; +end; + +function TBidiTree.TrySplit: boolean; +begin + result := false; +end; + +{ TUnicodeAnalysis } + +function TUnicodeAnalysis.GetParagraphFirstUnbrokenLine(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); + result := FParagraph[AIndex].firstUnbrokenLineIndex; +end; + +procedure TUnicodeAnalysis.SetBidiMode(AValue: TFontBidiMode); +var + i, bidiStart, bidiCount: LongInt; +begin + if FBidiMode=AValue then Exit; + FBidiMode:=AValue; + for i := 0 to ParagraphCount-1 do + begin + bidiStart := ParagraphStartIndex[i]; + bidiCount := ParagraphEndIndex[i]-bidiStart; + InternalUpdateBidiIsolate(i, bidiStart, bidiCount); + end; + if Assigned(FOnBidiModeChanged) then FOnBidiModeChanged(self); +end; + +function TUnicodeAnalysis.GetParagraphEndIndex(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); + result := FUnbrokenLine[FParagraph[AIndex+1].firstUnbrokenLineIndex].startIndex; + +end; + +function TUnicodeAnalysis.GetParagraphEndIndexBeforeParagraphSeparator( + AIndex: integer): integer; +var + u: LongWord; +begin + result := GetParagraphEndIndex(AIndex); + if (result > 0) and (AIndex < ParagraphCount) then // last paragraph separator would be temporary before split + begin + u := UnicodeChar[result-1]; + if (result>0) and IsUnicodeParagraphSeparator(u) then + begin + dec(result); + if IsUnicodeCrLf(u) and (result>0) and IsUnicodeCrLf(UnicodeChar[result-1]) and + (UnicodeChar[result-1] <> u) then dec(result); + end; + end; +end; + +function TUnicodeAnalysis.GetParagraphStartIndex(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); + result := FUnbrokenLine[FParagraph[AIndex].firstUnbrokenLineIndex].startIndex; +end; + +function TUnicodeAnalysis.GetUnbrokenLineParagraphIndex(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); + result := FUnbrokenLine[AIndex].paragraphIndex; +end; + +function TUnicodeAnalysis.GetBidiInfo(APosition0: integer): TUnicodeBidiInfo; +begin + if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); + result := FBidi[APosition0].BidiInfo; +end; + +function TUnicodeAnalysis.GetUnbrokenLineStartIndex(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); + result := FUnbrokenLine[AIndex].startIndex; +end; + +function TUnicodeAnalysis.GetParagraphLastUnbrokenLinePlusOne(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); + result := FParagraph[AIndex+1].firstUnbrokenLineIndex; +end; + +function TUnicodeAnalysis.GetUnbrokenLineEndIndex(AIndex: integer): integer; +begin + if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); + result := FUnbrokenLine[AIndex+1].startIndex; +end; + +function TUnicodeAnalysis.GetParagraphRightToLeft(AIndex: integer): boolean; +var + firstUnbroken, startIndex: Integer; +begin + if (AIndex < 0) or (AIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + + firstUnbroken := ParagraphFirstUnbrokenLine[AIndex]; + startIndex := UnbrokenLineStartIndex[firstUnbroken]; + if startIndex < CharCount then + result := odd(BidiInfo[startIndex].ParagraphBidiLevel) + else + result := BidiMode = fbmRightToLeft; +end; + +procedure TUnicodeAnalysis.Analyze; +var + lineIndex, i: Integer; + curParaIndex: integer; +begin + FBidi:= AnalyzeBidiUTF8(FText, FBidiMode); + FCharCount := length(FBidi); + + FUnbrokenLineCount := 1; + FParagraphCount := 1; + for i := 0 to high(FBidi) do + begin + if FBidi[i].BidiInfo.IsEndOfLine or FBidi[i].BidiInfo.IsExplicitEndOfParagraph then + begin + if FBidi[i].BidiInfo.IsExplicitEndOfParagraph then inc(FParagraphCount); + inc(FUnbrokenLineCount); + end; + end; + + curParaIndex := 0; + lineIndex := 0; + setlength(FParagraph, FParagraphCount+1); + FParagraph[curParaIndex].firstUnbrokenLineIndex:= lineIndex; + setlength(FUnbrokenLine, FUnbrokenLineCount+1); + FUnbrokenLine[lineIndex].startIndex := 0; + FUnbrokenLine[lineIndex].paragraphIndex := curParaIndex; + inc(lineIndex); + for i := 0 to high(FBidi) do + begin + if FBidi[i].BidiInfo.IsEndOfLine or FBidi[i].BidiInfo.IsExplicitEndOfParagraph then + begin + if FBidi[i].BidiInfo.IsExplicitEndOfParagraph then + begin + inc(curParaIndex); + FParagraph[curParaIndex].firstUnbrokenLineIndex:= lineIndex; + end; + FUnbrokenLine[lineIndex].startIndex := i+1; + FUnbrokenLine[lineIndex].paragraphIndex := curParaIndex; + inc(lineIndex); + end; + end; + FParagraph[curParaIndex+1].firstUnbrokenLineIndex:= lineIndex; + FUnbrokenLine[lineIndex].startIndex := length(FBidi); + FUnbrokenLine[lineIndex].paragraphIndex:= curParaIndex+1; + + setlength(FBidi, length(FBidi)+1); + FBidi[High(FBidi)].Offset := length(FText); +end; + +constructor TUnicodeAnalysis.Create(ATextUTF8: string; ABidiMode: TFontBidiMode); +begin + FText:= ATextUTF8; + FBidiMode:= ABidiMode; + Analyze; +end; + +function TUnicodeAnalysis.GetParagraphAt(ACharIndex: integer): integer; + procedure FindRec(AFirstParagraphIndex, ALastParagraphIndex: integer); + var + midIndex: Integer; + begin + if ALastParagraphIndex= ParagraphStartIndex[midIndex+1]) then + FindRec(midIndex+1, ALastParagraphIndex) + else + begin + result := midIndex; + exit; + end; + end; + +begin + if (ACharIndex < 0) or (ACharIndex > CharCount) then raise exception.Create('Position out of bounds'); + FindRec(0, ParagraphCount-1); +end; + +function TUnicodeAnalysis.CopyTextUTF8(AStartIndex, ACount: integer): string; +begin + if (AStartIndex < 0) or (AStartIndex+ACount > CharCount) then + raise exception.Create('Char range out of bounds [' + inttostr(AStartIndex) + '..' + + inttostr(AStartIndex+ACount) + '] out of [0..' + inttostr(CharCount) + ']'); + result := copy(FText, FBidi[AStartIndex].Offset+1, FBidi[AStartIndex+ACount].Offset-FBidi[AStartIndex].Offset) +end; + +function TUnicodeAnalysis.CopyTextUTF8DiscardChars(AStartIndex, + AEndIndex: integer; out ANonDiscardedCount: integer): string; +var i, len, charLen: integer; +begin + CheckCharRange(AStartIndex, AEndIndex, 0, CharCount); + + ANonDiscardedCount:= 0; + len := 0; + for i := AStartIndex to AEndIndex-1 do + if not FBidi[i].BidiInfo.IsDiscardable then + begin + inc(len, FBidi[i+1].Offset - FBidi[i].Offset); + inc(ANonDiscardedCount); + end; + + setlength(result, len); + len := 0; + for i := AStartIndex to AEndIndex-1 do + if not FBidi[i].BidiInfo.IsDiscardable then + begin + charLen := FBidi[i+1].Offset - FBidi[i].Offset; + move(FText[FBidi[i].Offset+1], result[len+1], charLen); + inc(len, charLen); + end; +end; + +function TUnicodeAnalysis.InsertText(ATextUTF8: string; APosition: integer): integer; +var + newBidi: TBidiUTF8Array; +begin + if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); + if length(ATextUTF8)=0 then exit(0); + + newBidi:= AnalyzeBidiUTF8(ATextUTF8, FBidiMode); + result:= InternalInsertText(APosition, newBidi, ATextUTF8); +end; + +function TUnicodeAnalysis.DeleteText(APosition, ACount: integer): integer; +begin + ACount := IncludeNonSpacingChars(APosition, ACount); + if ACount = 0 then exit(0); + InternalDeleteText(APosition, ACount); + result := ACount; +end; + +function TUnicodeAnalysis.DeleteTextBefore(APosition, ACount: integer): integer; +begin + ACount := IncludeNonSpacingCharsBefore(APosition, ACount, False); + if ACount = 0 then exit(0); + InternalDeleteText(APosition-ACount, ACount); + result := ACount; +end; + +function TUnicodeAnalysis.IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; +begin + if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); + if APosition+ACount > CharCount then raise exception.Create('Exceed end of text'); + + //keep Cr/Lf pair together and non spacing marks after last char together + while (APosition+ACount < CharCount) and + not (BidiInfo[APosition+ACount].IsMulticharStart + or (not AIncludeCombiningMarks and + (BidiInfo[APosition+ACount].IsCombiningLeft + or BidiInfo[APosition+ACount].IsCombiningRight) + ) + ) do inc(ACount); + + result := ACount; +end; + +function TUnicodeAnalysis.IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; +begin + if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); + if APosition-ACount < 0 then raise exception.Create('Exceed start of text'); + if ACount = 0 then exit(0); + + //keep before non spacing marks until real char together + while (APosition-ACount > 0) and + not (BidiInfo[APosition-ACount].IsMulticharStart + or (not AIncludeCombiningMarks and + (BidiInfo[APosition-ACount].IsCombiningLeft + or BidiInfo[APosition-ACount].IsCombiningRight) + ) + ) do inc(ACount); + + result := ACount; +end; + +function TUnicodeAnalysis.CreateBidiTree(ABidiTreeFactory: TBidiTreeAny; + AData: pointer; AStartIndex, AEndIndex: integer; AEmbeddingBidiLevel: integer): TBidiTree; +begin + result := ABidiTreeFactory.Create(AData, AStartIndex, AEndIndex, AEmbeddingBidiLevel, false); + CreateBidiTreeRec(ABidiTreeFactory, AData, result); +end; + +procedure TUnicodeAnalysis.CreateBidiTreeRec(ABidiTreeFactory: TBidiTreeAny; AData: pointer; ABidiTree: TBidiTree); +var + startIndex, endIndex, i: integer; + subLevel: byte; + subStart: integer; + subTree: TBidiTree; +begin + startIndex := ABidiTree.StartIndex; + endIndex:= ABidiTree.EndIndex; + + while (startIndex < endIndex) and FBidi[startIndex].BidiInfo.IsDiscardable do inc(startIndex); + while (startIndex < endIndex) and FBidi[endIndex-1].BidiInfo.IsDiscardable do dec(endIndex); + if endIndex = startIndex then exit; + + i := startIndex; + while i < endIndex do + begin + if not FBidi[i].BidiInfo.IsDiscardable then + begin + if FBidi[i].BidiInfo.BidiLevel > ABidiTree.BidiLevel then + begin + subStart := i; + subLevel := FBidi[i].BidiInfo.BidiLevel; + inc(i); + while (i < endIndex) and (FBidi[i].BidiInfo.BidiLevel > ABidiTree.BidiLevel) do + begin + if FBidi[i].BidiInfo.BidiLevel < subLevel then + subLevel := FBidi[i].BidiInfo.BidiLevel; + inc(i); + end; + + subTree := ABidiTreeFactory.Create(AData, subStart, i, subLevel, false); + ABidiTree.AddBranch(subTree); + CreateBidiTreeRec(ABidiTreeFactory, AData, subTree); + subTree.AfterFinish; + if subTree.EndIndex < i then + begin + ABidiTree.Shorten(subTree.EndIndex); + exit; + end; + end else + begin + subStart:= i; + inc(i); + while (i < endIndex) and (FBidi[i].BidiInfo.BidiLevel = ABidiTree.BidiLevel) do inc(i); + + subTree := ABidiTreeFactory.Create(AData, subStart, i, ABidiTree.BidiLevel, true); + ABidiTree.AddBranch(subTree); + if subTree.TrySplit then + begin + ABidiTree.Shorten(subTree.EndIndex); + exit; + end; + end; + + end else + inc(i); + end; +end; + +procedure TUnicodeAnalysis.CheckCharRange(AStartIndex, AEndIndex: integer; + AMinIndex, AMaxIndex: integer); +begin + if AEndIndex AMaxIndex) then + raise exception.Create('Char range out of bounds ['+inttostr(AStartIndex)+','+IntToStr(AEndIndex)+'] > ['+inttostr(AMinIndex)+','+IntToStr(AMaxIndex)+']'); +end; + +procedure TUnicodeAnalysis.CheckTextAnalysis; +var + i: Integer; +begin + for i := 1 to high(FBidi)-1 do + if (FBidi[i].Offset <= 0) or (FBidi[i].Offset > length(FText)-1) then + raise exception.Create('UTF8 offset out of range for char '+inttostr(i)); + if (length(FBidi)>0) and ((FBidi[0].Offset <> 0) or (FBidi[high(FBidi)].Offset <> length(FText))) then + raise exception.Create('Unexpected UTF8 offset'); + for i := 0 to high(FUnbrokenLine) do + begin + if (i > 0) and (FUnbrokenLine[i].startIndex < FUnbrokenLine[i-1].startIndex) then + raise exception.Create('Unbroken line position must be increasing'); + if (i > 0) and (FUnbrokenLine[i].paragraphIndex < FUnbrokenLine[i-1].paragraphIndex) then + raise exception.Create('Unbroken line paragraph must be increasing'); + if (i > 0) and (FUnbrokenLine[i].paragraphIndex > FUnbrokenLine[i-1].paragraphIndex+1) then + raise exception.Create('Unbroken line must not skip paragraph'); + end; + if (length(FUnbrokenLine)>0) and ((FUnbrokenLine[0].paragraphIndex <> 0) + or (FUnbrokenLine[High(FUnbrokenLine)].paragraphIndex <> high(FParagraph))) then + raise exception.Create('Unexpected paragraph index'); + for i := 0 to high(FParagraph) do + begin + if (i > 0) and (FParagraph[i].firstUnbrokenLineIndex <= FParagraph[i-1].firstUnbrokenLineIndex) then + raise exception.Create('Paragraph unbroken line index must be strictly increasing'); + end; + if (length(FParagraph)>0) and ((FParagraph[0].firstUnbrokenLineIndex <> 0) or + (FParagraph[high(FParagraph)].firstUnbrokenLineIndex <> high(FUnbrokenLine))) then + raise exception.Create('Unexpected paragraph unbroken line index'); +end; + +function TUnicodeAnalysis.GetUnicodeChar(APosition0: integer): LongWord; +var p : PChar; + charLen, startOfs: Integer; +begin + if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); + startOfs := FBidi[APosition0].Offset; + p := @FText[startOfs+1]; + charLen := FBidi[APosition0+1].Offset - startOfs; + result := UTF8CodepointToUnicode(p, charLen); +end; + +function TUnicodeAnalysis.GetUTF8Char(APosition0: integer): string4; +begin + if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); + result := copy(FText, FBidi[APosition0].Offset+1, FBidi[APosition0+1].Offset-FBidi[APosition0].Offset); +end; + +procedure TUnicodeAnalysis.InternalDeleteText(APosition, ACount: integer); +var + i, delStart: Integer; + hasParaSep: Boolean; + indexBeforeSep: LongInt; +begin + for i := ParagraphCount-1 downto 0 do + if (APosition < ParagraphEndIndex[i]) and (APosition+ACount > ParagraphStartIndex[i]) then + begin + indexBeforeSep := ParagraphEndIndexBeforeParagraphSeparator[i]; + hasParaSep := indexBeforeSep<>ParagraphEndIndex[i]; + + if (i < ParagraphCount-1) and hasParaSep and (APosition+ACount > indexBeforeSep) then //paragraph separator removed + begin + if APosition <= ParagraphStartIndex[i] then + InternalDeleteParagraph(i) + else + begin + delStart := max(APosition,ParagraphStartIndex[i]); + InternalDeleteWithinParagraph(i, delStart, min(APosition+ACount,indexBeforeSep)-delStart, False); + InternalMergeParagraphWithNext(i); + end; + end else + begin + delStart := max(APosition,ParagraphStartIndex[i]); + InternalDeleteWithinParagraph(i, delStart, min(APosition+ACount,ParagraphEndIndex[i])-delStart, True); + end; + end; + {$IFDEF DEBUG}CheckTextAnalysis;{$ENDIF} +end; + +procedure TUnicodeAnalysis.InternalDeleteParagraph(AParagraphIndex: integer); +var + unbrokenStart, unbrokenEnd, unbrokenCount: Integer; + bidiStart, bidiCount, i: LongInt; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + + unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; + unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; + unbrokenCount := unbrokenEnd-unbrokenStart; + + bidiStart := ParagraphStartIndex[AParagraphIndex]; + bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; + InternalDeleteBidiAndUTF8(bidiStart, bidiCount); + + for i := unbrokenStart to high(FUnbrokenLine)-unbrokenCount do + begin + FUnbrokenLine[i] := FUnbrokenLine[i+unbrokenCount]; + dec(FUnbrokenLine[i].paragraphIndex); + dec(FUnbrokenLine[i].startIndex, bidiCount); + end; + setlength(FUnbrokenLine, length(FUnbrokenLine)-unbrokenCount); + dec(FUnbrokenLineCount, unbrokenCount); + + for i := AParagraphIndex+1 to ParagraphCount do + dec(FParagraph[i].firstUnbrokenLineIndex, unbrokenCount); + if Assigned(FOnCharDeleted) then FOnCharDeleted(self, AParagraphIndex, bidiStart, bidiCount); + + for i := AParagraphIndex to ParagraphCount-1 do + FParagraph[i] := FParagraph[i+1]; + dec(FParagraphCount); + setlength(FParagraph, FParagraphCount+1); + if Assigned(FOnParagraphDeleted) then FOnParagraphDeleted(self, AParagraphIndex); +end; + +procedure TUnicodeAnalysis.InternalDeleteWithinParagraph( + AParagraphIndex: integer; APosition, ACount: integer; AUpdateBidi: boolean); +var + unbrokenEnd: Integer; + bidiStart, bidiCount: LongInt; + i: integer; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + + InternalDeleteBidiAndUTF8(APosition, ACount); + + unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; + for i := unbrokenEnd to high(FUnbrokenLine) do + dec(FUnbrokenLine[i].startIndex, ACount); + + bidiStart := ParagraphStartIndex[AParagraphIndex]; + bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; + + if AUpdateBidi then InternalUpdateBidiIsolate(AParagraphIndex, bidiStart, bidiCount); + InternalUpdateUnbrokenLines(AParagraphIndex); + + if Assigned(FOnCharDeleted) then FOnCharDeleted(self, AParagraphIndex, APosition, ACount); +end; + +procedure TUnicodeAnalysis.InternalMergeParagraphWithNext(AParagraphIndex: integer); +var + indexBeforeSep, bidiStart, bidiCount, i: LongInt; + hasParaSep: Boolean; + unbrokenEnd: Integer; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount-1) then + raise ERangeError.Create('Paragraph index out of bounds'); + + indexBeforeSep := ParagraphEndIndexBeforeParagraphSeparator[AParagraphIndex]; + hasParaSep := indexBeforeSep<>ParagraphEndIndex[AParagraphIndex]; + if not hasParaSep then exit; + + bidiStart := indexBeforeSep; + bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; + InternalDeleteBidiAndUTF8(bidiStart, bidiCount); + if Assigned(FOnCharDeleted) then + FOnCharDeleted(self, AParagraphIndex, bidiStart, bidiCount); + + unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; + for i := unbrokenEnd to high(FUnbrokenLine)-1 do + begin + FUnbrokenLine[i] := FUnbrokenLine[i+1]; + dec(FUnbrokenLine[i].paragraphIndex); + dec(FUnbrokenLine[i].startIndex, bidiCount); + end; + setlength(FUnbrokenLine, length(FUnbrokenLine)-1); + dec(FUnbrokenLineCount); + + for i := AParagraphIndex+1 to high(FParagraph)-1 do + begin + FParagraph[i] := FParagraph[i+1]; + dec(FParagraph[i].firstUnbrokenLineIndex); + end; + setlength(FParagraph, length(FParagraph)-1); + dec(FParagraphCount); + + bidiStart := ParagraphStartIndex[AParagraphIndex]; + bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; + InternalUpdateBidiIsolate(AParagraphIndex, bidiStart, bidiCount); + + if Assigned(FOnParagraphMergedWithNext) then + FOnParagraphMergedWithNext(self, AParagraphIndex); +end; + +procedure TUnicodeAnalysis.InternalDeleteBidiAndUTF8(ABidiStart, + ABidiCount: integer); +var + utf8Start, utf8Count, bidiEnd, i: Integer; +begin + if ABidiCount = 0 then exit; + if ABidiCount < 0 then raise exception.Create('Bidi count must be positive'); + bidiEnd := ABidiStart+ABidiCount; + CheckCharRange(ABidiStart, bidiEnd, 0, CharCount); + + utf8Start := FBidi[ABidiStart].Offset+1; + if bidiEnd >= CharCount then + utf8Count := length(FText) - (utf8Start-1) + else + utf8Count := FBidi[bidiEnd].Offset - (utf8Start-1); + delete(FText, utf8Start, utf8Count); + + for i := ABidiStart to high(FBidi)-ABidiCount do + begin + FBidi[i] := FBidi[i+ABidiCount]; + dec(FBidi[i].Offset, utf8Count); + end; + setlength(FBidi, length(FBidi)-ABidiCount); + dec(FCharCount, ABidiCount); +end; + +procedure TUnicodeAnalysis.InternalUpdateBidiIsolate(AParagraphIndex: integer; ABidiStart, ABidiCount: integer); +var + utf8Start, utf8Count, bidiEnd, i: Integer; + newBidi: TBidiUTF8Array; + startDiff,endDiff: integer; +begin + if ABidiCount = 0 then exit; + if ABidiCount < 0 then raise exception.Create('Bidi count must be positive'); + bidiEnd := ABidiStart+ABidiCount; + CheckCharRange(ABidiStart, bidiEnd, 0, CharCount); + + utf8Start := FBidi[ABidiStart].Offset+1; + if bidiEnd >= CharCount then + utf8Count := length(FText) - (utf8Start-1) + else + utf8Count := FBidi[bidiEnd].Offset - (utf8Start-1); + + newBidi:= AnalyzeBidiUTF8(copy(FText, utf8Start, utf8Count), FBidiMode); + + startDiff := maxLongint; + endDiff := -maxLongint; + for i := 0 to min(ABidiCount, length(newBidi))-1 do + if FBidi[ABidiStart+i].BidiInfo <> newBidi[i].BidiInfo then + begin + if i < startDiff then startDiff := i; + if i > endDiff then endDiff := i; + FBidi[ABidiStart+i] := newBidi[i]; + inc(FBidi[ABidiStart+i].Offset, utf8Start-1); + end; + if Assigned(OnAnalysisChanged) and (endDiff >= startDiff) then + OnAnalysisChanged(self, AParagraphIndex, startDiff, endDiff); +end; + +procedure TUnicodeAnalysis.InternalUpdateUnbrokenLines(AParagraphIndex: integer); +var + newUnbrokenCount, unbrokenStart, unbrokenEnd, unbrokenCount, + unbrokenDelta, curUnbrokenIndex: Integer; + bidiStart, bidiEnd, i: LongInt; +begin + if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then + raise ERangeError.Create('Paragraph index out of bounds'); + + bidiStart := ParagraphStartIndex[AParagraphIndex]; + if AParagraphIndex = ParagraphCount-1 then + bidiEnd := ParagraphEndIndex[AParagraphIndex] + else + bidiEnd := ParagraphEndIndexBeforeParagraphSeparator[AParagraphIndex]; + unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; + unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; + unbrokenCount := unbrokenEnd-unbrokenStart; + + newUnbrokenCount := 1; + for i := bidiStart to bidiEnd-1 do + if FBidi[i].BidiInfo.IsEndOfLine or + FBidi[i].BidiInfo.IsExplicitEndOfParagraph then inc(newUnbrokenCount); + + if newUnbrokenCount < unbrokenCount then + begin + unbrokenDelta := unbrokenCount-newUnbrokenCount; + for i := unbrokenEnd-unbrokenDelta to high(FUnbrokenLine)-unbrokenDelta do + FUnbrokenLine[i] := FUnbrokenLine[i+unbrokenDelta]; + setlength(FUnbrokenLine, length(FUnbrokenLine)-unbrokenDelta); + dec(FUnbrokenLineCount, unbrokenDelta); + end else + if newUnbrokenCount > unbrokenCount then + begin + unbrokenDelta := newUnbrokenCount-unbrokenCount; + setlength(FUnbrokenLine, length(FUnbrokenLine)+unbrokenDelta); + inc(FUnbrokenLineCount, unbrokenDelta); + for i := high(FUnbrokenLine) downto unbrokenEnd+unbrokenDelta do + FUnbrokenLine[i] := FUnbrokenLine[i-unbrokenDelta]; + end; + for i := AParagraphIndex+1 to high(FParagraph) do + inc(FParagraph[i].firstUnbrokenLineIndex, newUnbrokenCount-unbrokenCount); + + curUnbrokenIndex := unbrokenStart; + FUnbrokenLine[curUnbrokenIndex].startIndex:= bidiStart; + FUnbrokenLine[curUnbrokenIndex].paragraphIndex:= AParagraphIndex; + for i := bidiStart to bidiEnd-1 do + begin + if FBidi[i].BidiInfo.IsEndOfLine or + FBidi[i].BidiInfo.IsExplicitEndOfParagraph then // paragraph separator before split + begin + inc(curUnbrokenIndex); + FUnbrokenLine[curUnbrokenIndex].startIndex := i+1; + FUnbrokenLine[curUnbrokenIndex].paragraphIndex:= AParagraphIndex; + end; + end; +end; + +function TUnicodeAnalysis.InternalInsertText(APosition: integer; + const ANewBidi: TBidiUTF8Array; ANewTextUTF8: string): integer; +var + utf8Start, utf8Count, + prevCharCount, bidiCount, paraBidiStart, paraBidiCount, + i, unbrokenEnd, paraIndex: integer; +begin + if (APosition < 0) or (APosition>CharCount) then + raise exception.Create('Position out of bounds'); + if length(ANewBidi)=0 then exit; + + prevCharCount:= CharCount; + paraIndex := GetParagraphAt(APosition); + bidiCount := length(ANewBidi); + + utf8Start := FBidi[APosition].Offset+1; + utf8Count := length(ANewTextUTF8); + Insert(ANewTextUTF8, FText, utf8Start); + + setlength(FBidi, length(FBidi)+bidiCount); + for i := high(FBidi) downto APosition+bidiCount do + begin + FBidi[i] := FBidi[i-bidiCount]; + inc(FBidi[i].Offset, utf8Count); + end; + for i := 0 to high(ANewBidi) do + begin + FBidi[APosition+i] := ANewBidi[i]; + inc(FBidi[APosition+i].Offset, utf8Start-1); + end; + inc(FCharCount, bidiCount); + + unbrokenEnd := FParagraph[paraIndex+1].firstUnbrokenLineIndex; + for i := unbrokenEnd to high(FUnbrokenLine) do + inc(FUnbrokenLine[i].startIndex, bidiCount); + + paraBidiStart := ParagraphStartIndex[paraIndex]; + paraBidiCount := ParagraphEndIndex[paraIndex]-paraBidiStart; + InternalUpdateBidiIsolate(paraIndex, paraBidiStart, paraBidiCount); + + InternalUpdateUnbrokenLines(paraIndex); + if Assigned(FOnCharInserted) then + FOnCharInserted(self, paraIndex, APosition, bidiCount); + + InternalSplitParagraph(paraIndex); + {$IFDEF DEBUG}CheckTextAnalysis;{$ENDIF} + result := CharCount-prevCharCount; +end; + +procedure TUnicodeAnalysis.InternalSplitParagraph(AParagraphIndex: integer); +var + i, unbrokenStart, unbrokenEndIncl, j, paraIndex: integer; +begin + unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; + unbrokenEndIncl := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex-1; + for i := unbrokenStart+1 to unbrokenEndIncl do + begin + if (FUnbrokenLine[i].startIndex > 0) and + FBidi[FUnbrokenLine[i].startIndex-1].BidiInfo.IsExplicitEndOfParagraph then + begin + paraIndex := FUnbrokenLine[i].paragraphIndex; + setlength(FParagraph, length(FParagraph)+1); + inc(FParagraphCount); + for j := high(FParagraph) downto paraIndex+2 do + FParagraph[j] := FParagraph[j-1]; + FParagraph[paraIndex+1].firstUnbrokenLineIndex:= i; + for j := i to high(FUnbrokenLine) do + inc(FUnbrokenLine[j].paragraphIndex); + + if Assigned(OnParagraphSplit) then + OnParagraphSplit(self, paraIndex, FUnbrokenLine[i].startIndex); + end; + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgraunits.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgraunits.pas new file mode 100644 index 0000000..27d469d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgraunits.pas @@ -0,0 +1,572 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAUnits; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, BGRABitmapTypes; + +type + TSVGNumber = single;//double + ArrayOfTSVGNumber = array of TSVGNumber; + + TCSSUnit = (cuCustom, cuPixel, + cuCentimeter, cuMillimeter, + cuInch, cuPica, cuPoint, + cuFontEmHeight, cuFontXHeight, cuPercent); + TFloatWithCSSUnit = record + value: single; + CSSUnit: TCSSUnit; + end; + + ArrayOfTFloatWithCSSUnit = array of TFloatWithCSSUnit; + + +function FloatWithCSSUnit(AValue: single; AUnit: TCSSUnit): TFloatWithCSSUnit; + +const + CSSUnitShortName: array[TCSSUnit] of string = + ('','px', + 'cm','mm', + 'in','pc','pt', + 'em','ex','%'); + +type + { TCSSUnitConverter } + + TCSSUnitConverter = class + protected + FViewBoxHeight: TFloatWithCSSUnit; + FViewBoxWidth: TFloatWithCSSUnit; + FViewBoxHeightInUnit: array[TCSSUnit] of single; + FViewBoxWidthInUnit: array[TCSSUnit] of single; + FCurrentFontEmHeight: TFloatWithCSSUnit; + function GetRootFontEmHeight: TFloatWithCSSUnit; + function GetDefaultUnitHeight: TFloatWithCSSUnit; virtual; + function GetDefaultUnitWidth: TFloatWithCSSUnit; virtual; + function GetDpiX: single; virtual; + function GetDpiY: single; virtual; + function GetFontEmHeight: TFloatWithCSSUnit; virtual; + function GetFontXHeight: TFloatWithCSSUnit; virtual; + procedure SetViewBoxHeight(AValue: TFloatWithCSSUnit); + procedure SetViewBoxWidth(AValue: TFloatWithCSSUnit); + property FontEmHeight: TFloatWithCSSUnit read GetFontEmHeight; + property FontXHeight: TFloatWithCSSUnit read GetFontXHeight; + property DefaultUnitWidth: TFloatWithCSSUnit read GetDefaultUnitWidth; + property DefaultUnitHeight: TFloatWithCSSUnit read GetDefaultUnitHeight; + public + constructor Create; + function ConvertOrtho(xy: single; sourceUnit, destUnit: TCSSUnit): single; overload; + function ConvertOrtho(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; + function ConvertWidth(x: single; sourceUnit, destUnit: TCSSUnit): single; overload; + function ConvertHeight(y: single; sourceUnit, destUnit: TCSSUnit): single; overload; + function ConvertWidth(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; + function ConvertHeight(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; + function ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; overload; + function ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; overload; + function ConvertCoord(pt: TPointF; sourceUnit, destUnit: TCSSUnit): TPointF; overload; + function GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit): TAffineMatrix; overload; + function Convert(xy: single; sourceUnit, destUnit: TCSSUnit; dpi: single; containerSize: single = 0): single; + function ConvertOrtho(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TFloatWithCSSUnit; overload; + function ConvertWidth(x: single; sourceUnit, destUnit: TCSSUnit; containerWidth: single): single; overload; + function ConvertHeight(y: single; sourceUnit, destUnit: TCSSUnit; containerHeight: single): single; overload; + function ConvertWidth(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single): TFloatWithCSSUnit; overload; + function ConvertHeight(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerHeight: single): TFloatWithCSSUnit; overload; + function ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single): ArrayOfTFloatWithCSSUnit; overload; + function ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit; containerHeight: single): ArrayOfTFloatWithCSSUnit; overload; + function ConvertCoord(pt: TPointF; sourceUnit, destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TPointF; overload; + function GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit; containerWidth: single; containerHeight: single): TAffineMatrix; overload; + class function parseValue(AValue: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; static; + class function parseValue(AValue: string; ADefault: single): single; overload; static; + class function parseArrayOfNumbers(AValue: string): ArrayOfTSVGNumber; overload; static; + class function parseArrayOfValuesWithUnit(AValue: string): ArrayOfTFloatWithCSSUnit; overload; static; + class function formatValue(AValue: TFloatWithCSSUnit; APrecision: integer = 7): string; overload; static; + class function formatValue(AValue: single; APrecision: integer = 7): string; overload; static; + class function formatValue(AValue: ArrayOfTSVGNumber; APrecision: integer = 7): string; overload; static; + class function formatValue(AValue: ArrayOfTFloatWithCSSUnit; APrecision: integer = 7): string; overload; static; + property ViewBoxWidth: TFloatWithCSSUnit read FViewBoxWidth write SetViewBoxWidth; + property ViewBoxHeight: TFloatWithCSSUnit read FViewBoxHeight write SetViewBoxHeight; + property DpiX: single read GetDpiX; + property DpiY: single read GetDpiY; + property CurrentFontEmHeight: TFloatWithCSSUnit read FCurrentFontEmHeight write FCurrentFontEmHeight; + property RootFontEmHeight: TFloatWithCSSUnit read GetRootFontEmHeight; + end; + +implementation + +uses BGRATransform; + +var + formats: TFormatSettings; + +const InchFactor: array[TCSSUnit] of integer = + (9600, 9600, + 254, 2540, + 100, 600, 7200, + 0, 0, 0); + +function FloatWithCSSUnit(AValue: single; AUnit: TCSSUnit): TFloatWithCSSUnit; +begin + result.value:= AValue; + result.CSSUnit:= AUnit; +end; + +{ TCSSUnitConverter } + +procedure TCSSUnitConverter.SetViewBoxHeight(AValue: TFloatWithCSSUnit); +var + u: TCSSUnit; +begin + if (FViewBoxHeight.value=AValue.value) and + (FViewBoxHeight.CSSUnit=AValue.CSSUnit) then Exit; + FViewBoxHeight:=AValue; + for u := low(TCSSUnit) to high(TCSSUnit) do + FViewBoxHeightInUnit[u] := ConvertHeight(FViewBoxHeight, u, 0).value; +end; + +procedure TCSSUnitConverter.SetViewBoxWidth(AValue: TFloatWithCSSUnit); +var + u: TCSSUnit; +begin + if (FViewBoxWidth.value=AValue.value) and + (FViewBoxWidth.CSSUnit=AValue.CSSUnit) then Exit; + FViewBoxWidth:=AValue; + for u := low(TCSSUnit) to high(TCSSUnit) do + FViewBoxWidthInUnit[u] := ConvertWidth(FViewBoxWidth, u, 0).value; +end; + +function TCSSUnitConverter.GetRootFontEmHeight: TFloatWithCSSUnit; +begin + result := FloatWithCSSUnit(12, cuPoint); +end; + +function TCSSUnitConverter.GetFontEmHeight: TFloatWithCSSUnit; +begin + result := FCurrentFontEmHeight; +end; + +function TCSSUnitConverter.GetFontXHeight: TFloatWithCSSUnit; +begin + result := FCurrentFontEmHeight; + result.value := result.value * 0.5; //approximation +end; + +function TCSSUnitConverter.GetDefaultUnitHeight: TFloatWithCSSUnit; +begin + result := FloatWithCSSUnit(1,cuPixel); +end; + +function TCSSUnitConverter.GetDefaultUnitWidth: TFloatWithCSSUnit; +begin + result := FloatWithCSSUnit(1,cuPixel); +end; + +function TCSSUnitConverter.GetDpiX: single; +begin + result := 96; +end; + +function TCSSUnitConverter.GetDpiY: single; +begin + result := 96; +end; + +function TCSSUnitConverter.Convert(xy: single; sourceUnit, destUnit: TCSSUnit; + dpi: single; containerSize: single): single; +var sourceFactor, destFactor: integer; +begin + //fallback values for cuCustom as pixels + if sourceUnit = cuCustom then sourceUnit := cuPixel; + if destUnit = cuCustom then destUnit := cuPixel; + if (sourceUnit = destUnit) then + result := xy + else + if sourceUnit = cuPercent then + begin + result := xy/100*containerSize; + end else + if sourceUnit = cuFontEmHeight then + begin + with FontEmHeight do result := Convert(xy*value,CSSUnit, destUnit, dpi); + end else + if sourceUnit = cuFontXHeight then + begin + with FontXHeight do result := Convert(xy*value,CSSUnit, destUnit, dpi); + end else + if destUnit = cuFontEmHeight then + begin + with ConvertHeight(FontEmHeight, sourceUnit) do + if value = 0 then result := 0 else result := xy/value; + end else + if destUnit = cuFontXHeight then + begin + with ConvertHeight(FontXHeight, sourceUnit) do + if value = 0 then result := 0 else result := xy/value; + end else + if sourceUnit = cuPixel then + begin + if dpi = 0 then result := 0 + else result := xy*(InchFactor[destUnit]/(dpi*100)); + end else + if destUnit = cuPixel then + begin + if dpi = 0 then result := 0 + else result := xy*((dpi*100)/InchFactor[sourceUnit]); + end else + begin + sourceFactor := InchFactor[sourceUnit]; + destFactor := InchFactor[destUnit]; + if (sourceFactor = 0) or (destFactor = 0) then + result := 0 + else + result := xy*(destFactor/sourceFactor); + end; +end; + +function TCSSUnitConverter.ConvertOrtho(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TFloatWithCSSUnit; +begin + result.value := (ConvertWidth(AValue.value, AValue.CSSUnit, destUnit, containerWidth) + + ConvertHeight(AValue.value, AValue.CSSUnit, destUnit, containerHeight)) / 2; + result.CSSUnit:= destUnit; +end; + +function TCSSUnitConverter.ConvertWidth(x: single; sourceUnit, + destUnit: TCSSUnit; containerWidth: single): single; +begin + if sourceUnit = destUnit then + result := x + else if sourceUnit = cuCustom then + with DefaultUnitWidth do + begin + result := x*ConvertWidth(value,CSSUnit, destUnit, containerWidth) + end + else if sourceUnit = cuPercent then + begin + result := x/100*containerWidth; + end + else if destUnit = cuCustom then + with ConvertWidth(DefaultUnitWidth,sourceUnit) do + begin + if value = 0 then + result := 0 + else + result := x/value; + end else + result := Convert(x, sourceUnit, destUnit, DpiX, containerWidth); +end; + +function TCSSUnitConverter.ConvertHeight(y: single; sourceUnit, + destUnit: TCSSUnit; containerHeight: single): single; +begin + if sourceUnit = cuCustom then + with DefaultUnitHeight do + begin + result := y*ConvertHeight(value,CSSUnit, destUnit, containerHeight) + end + else if sourceUnit = cuPercent then + begin + result := y/100*containerHeight; + end + else if destUnit = cuCustom then + with ConvertHeight(DefaultUnitHeight,sourceUnit) do + begin + if value = 0 then + result := 0 + else + result := y/value; + end else + result := Convert(y, sourceUnit, destUnit, DpiY, containerHeight); +end; + +function TCSSUnitConverter.ConvertWidth(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit; containerWidth: single): TFloatWithCSSUnit; +begin + result.CSSUnit := destUnit; + result.value:= ConvertWidth(AValue.value,AValue.CSSUnit,destUnit,containerWidth); +end; + +function TCSSUnitConverter.ConvertHeight(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit; containerHeight: single): TFloatWithCSSUnit; +begin + result.CSSUnit := destUnit; + result.value:= ConvertHeight(AValue.value,AValue.CSSUnit,destUnit,containerHeight); +end; + +function TCSSUnitConverter.ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; + destUnit: TCSSUnit; containerWidth: single): ArrayOfTFloatWithCSSUnit; +var + i: integer; +begin + for i := low(AValue) to high(AValue) do + AValue[i]:= ConvertWidth(AValue[i],destUnit,containerWidth); + result := AValue; +end; + +function TCSSUnitConverter.ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; + destUnit: TCSSUnit; containerHeight: single): ArrayOfTFloatWithCSSUnit; +var + i: integer; +begin + for i := low(AValue) to high(AValue) do + AValue[i]:= ConvertHeight(AValue[i],destUnit,containerHeight); + result := AValue; +end; + +function TCSSUnitConverter.ConvertCoord(pt: TPointF; sourceUnit, + destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TPointF; +begin + result.x := ConvertWidth(pt.x, sourceUnit, destUnit, containerWidth); + result.y := ConvertHeight(pt.y, sourceUnit, destUnit, containerHeight); +end; + +function TCSSUnitConverter.GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit; + containerWidth: single; containerHeight: single): TAffineMatrix; +var + ptUnit: TPointF; +begin + ptUnit := ConvertCoord(PointF(1, 1), AFromUnit, AToUnit, containerWidth, containerHeight); + result := AffineMatrixScale(ptUnit.x, ptUnit.y); +end; + +class function TCSSUnitConverter.parseValue(AValue: string; + ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; +var cssUnit: TCSSUnit; + errPos: integer; +begin + AValue := trim(AValue); + result.CSSUnit:= cuCustom; + for cssUnit := succ(cuCustom) to high(cssUnit) do + if (length(AValue)>=length(CSSUnitShortName[cssUnit])) and + (CompareText(copy(AValue,length(AValue)-length(CSSUnitShortName[cssUnit])+1,length(CSSUnitShortName[cssUnit])), + CSSUnitShortName[cssUnit])=0) then + begin + AValue := copy(AValue,1,length(AValue)-length(CSSUnitShortName[cssUnit])); + result.CSSUnit := cssUnit; + break; + end; + val(AValue,result.value,errPos); + if errPos <> 0 then + result := ADefault; +end; + +class function TCSSUnitConverter.parseValue(AValue: string; ADefault: single): single; +var + errPos: integer; +begin + AValue := trim(AValue); + val(AValue,result,errPos); + if errPos <> 0 then + result := ADefault; +end; + +class function TCSSUnitConverter.parseArrayOfNumbers(AValue: string): ArrayOfTSVGNumber; +var + i, l,p: integer; + + procedure CanAddToArray; + var + len: integer; + begin + if l <> 0 then + begin + len := length(result); + setlength(result,len+1); + result[len] := parseValue( copy(AValue,p,l), 0); + end; + end; + +begin + AValue := trim(AValue); + if AValue = '' then exit(nil); + + setlength(result,0); + p:= 1; + l:= 0; + for i := 1 to length(AValue) do + begin + if AValue[i] in [#9,#10,#13,#32,#44] then + begin + CanAddToArray; + p:= i+1; + l:= 0; + end + else + Inc(l); + end; + CanAddToArray; +end; + +class function TCSSUnitConverter.parseArrayOfValuesWithUnit(AValue: string): ArrayOfTFloatWithCSSUnit; +var + i, l,p: integer; + def: TFloatWithCSSUnit; + + procedure CanAddToArray; + var + len: integer; + begin + if l <> 0 then + begin + len := length(result); + setlength(result,len+1); + result[len] := parseValue( copy(AValue,p,l), def); + end; + end; + +begin + AValue := trim(AValue); + if AValue = '' then exit(nil); + + def := FloatWithCSSUnit(0, cuCustom); + setlength(result,0); + p:= 1; + l:= 0; + for i := 1 to length(AValue) do + begin + if AValue[i] in [#9,#10,#13,#32,#44] then + begin + CanAddToArray; + p:= i+1; + l:= 0; + end + else + Inc(l); + end; + CanAddToArray; +end; + +class function TCSSUnitConverter.formatValue(AValue: TFloatWithCSSUnit; APrecision: integer = 7): string; +begin + result := FloatToStrF(AValue.value,ffGeneral,APrecision,0,formats)+CSSUnitShortName[AValue.CSSUnit]; +end; + +class function TCSSUnitConverter.formatValue(AValue: single; APrecision: integer + ): string; +begin + result := FloatToStrF(AValue,ffGeneral,APrecision,0,formats); +end; + +class function TCSSUnitConverter.formatValue(AValue: ArrayOfTSVGNumber; APrecision: integer = 7): string; +var + i, len: integer; +begin + len:= length(AValue); + if len = 0 then + result:= '' + else if len = 1 then + result:= formatValue(AValue[0], APrecision) + else + begin + result:= ''; + for i := 0 to len-1 do + begin + result:= result + formatValue(AValue[i], APrecision); + if i <> (len-1) then + result:= result + ', '; + end; + end; +end; + +class function TCSSUnitConverter.formatValue(AValue: ArrayOfTFloatWithCSSUnit; APrecision: integer = 7): string; +var + i, len: integer; +begin + len:= length(AValue); + if len = 0 then + result:= '' + else if len = 1 then + result:= formatValue(AValue[0], APrecision) + else + begin + result:= ''; + for i := 0 to len-1 do + begin + result:= result + formatValue(AValue[i], APrecision); + if i <> (len-1) then + result:= result + ', '; + end; + end; +end; + +constructor TCSSUnitConverter.Create; +begin + inherited; + FCurrentFontEmHeight:= GetRootFontEmHeight; + ViewBoxWidth := FloatWithCSSUnit(0, cuPixel); + ViewBoxHeight := FloatWithCSSUnit(0, cuPixel); +end; + +function TCSSUnitConverter.ConvertOrtho(xy: single; sourceUnit, + destUnit: TCSSUnit): single; +begin + result := (ConvertWidth(xy, sourceUnit, destUnit) + + ConvertHeight(xy, sourceUnit, destUnit)) / 2; +end; + +function TCSSUnitConverter.ConvertOrtho(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit): TFloatWithCSSUnit; +begin + result.value := (ConvertWidth(AValue.value, AValue.CSSUnit, destUnit) + + ConvertHeight(AValue.value, AValue.CSSUnit, destUnit)) / 2; + result.CSSUnit:= destUnit; +end; + +function TCSSUnitConverter.ConvertWidth(x: single; sourceUnit, + destUnit: TCSSUnit): single; +begin + result := ConvertWidth(x, sourceUnit, destUnit, FViewBoxWidthInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertHeight(y: single; sourceUnit, + destUnit: TCSSUnit): single; +begin + result := ConvertHeight(y, sourceUnit, destUnit, FViewBoxHeightInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertWidth(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit): TFloatWithCSSUnit; +begin + result := ConvertWidth(AValue, destUnit, FViewBoxWidthInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertHeight(AValue: TFloatWithCSSUnit; + destUnit: TCSSUnit): TFloatWithCSSUnit; +begin + result := ConvertHeight(AValue, destUnit, FViewBoxHeightInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; + destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; +begin + result := ConvertWidth(AValue, destUnit, FViewBoxWidthInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; + destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; +begin + result := ConvertHeight(AValue, destUnit, FViewBoxHeightInUnit[destUnit]); +end; + +function TCSSUnitConverter.ConvertCoord(pt: TPointF; sourceUnit, + destUnit: TCSSUnit): TPointF; +begin + result := ConvertCoord(pt, sourceUnit, destUnit, + FViewBoxWidthInUnit[destUnit], FViewBoxHeightInUnit[destUnit]); +end; + +function TCSSUnitConverter.GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit): TAffineMatrix; +begin + result := GetConversionMatrix(AFromUnit, AToUnit, + FViewBoxWidthInUnit[AToUnit], FViewBoxHeightInUnit[AToUnit]); +end; + +initialization + + formats := DefaultFormatSettings; + formats.DecimalSeparator := '.'; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrautf8.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrautf8.pas new file mode 100644 index 0000000..8415793 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrautf8.pas @@ -0,0 +1,1509 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAUTF8; + +{$mode objfpc}{$H+} +{$i bgrabitmap.inc} + +interface + +uses + BGRAClasses, SysUtils, math, BGRAUnicode{$IFDEF BGRABITMAP_USE_LCL}, lazutf8classes{$ENDIF}; + +const + UTF8_ARABIC_ALEPH = 'ا'; + UTF8_ARABIC_ALEPH_HAMZA_BELOW = 'Ø¥'; + UTF8_ARABIC_ALEPH_HAMZA_ABOVE = 'Ø£'; + UTF8_ARABIC_ALEPH_MADDA_ABOVE = 'Ø¢'; + UTF8_ARABIC_LAM = 'Ù„'; + UTF8_NO_BREAK_SPACE = ' '; + UTF8_ZERO_WIDTH_NON_JOINER = '‌'; + UTF8_ZERO_WIDTH_JOINER = 'â€'; + UTF8_LINE_SEPARATOR = #$E2#$80#$A8; //equivalent of
+ UTF8_PARAGRAPH_SEPARATOR = #$E2#$80#$A9; //equivalent of

+ UTF8_NEXT_LINE = #$C2#$85; //equivalent of CRLF + +{$IFDEF BGRABITMAP_USE_LCL} +type + TFileStreamUTF8 = lazutf8classes.TFileStreamUTF8; + TStringListUTF8 = lazutf8classes.TStringListUTF8; +{$ELSE} +type + TFileStreamUTF8 = class(THandleStream) + private + FFileName: utf8string; + public + constructor Create(const AFileName: utf8string; Mode: Word); overload; + constructor Create(const AFileName: utf8string; Mode: Word; Rights: LongWord); overload; + destructor Destroy; override; + property FileName: utf8string Read FFilename; + end; + + TStringListUTF8 = class(TStringList) + protected + function DoCompareText(const s1,s2 : string) : PtrInt; override; + public + procedure LoadFromFile(const FileName: string); override; + procedure SaveToFile(const FileName: string); override; + end; +{$ENDIF} + +procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); +procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); + +function UTF8ToSys(const s: string): string; +function SysToUTF8(const s: string): string; + +function UTF8LowerCase(const s: string): string; +function UTF8UpperCase(const s: string): string; + +function UTF8CompareStr(const S1, S2: string): Integer; +function UTF8CompareText(const S1, S2: string): Integer; + +function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar; + +function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle; +function FileCreateUTF8(Const FileName : string) : THandle; overload; +function FileCreateUTF8(Const FileName : string; Rights: LongWord) : THandle; overload; +function FileExistsUTF8(Const FileName : string): boolean; +function DeleteFileUTF8(Const FileName : string): boolean; +function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint; +function FindNextUTF8(var Rslt: TSearchRec): Longint; +procedure FindCloseUTF8(var F: TSearchrec); + +type + string4 = string[4]; + TUnicodeArray = packed array of LongWord; + TIntegerArray = array of integer; + +function UTF8CharacterLength(p: PChar): integer; +function UTF8Length(const s: string): PtrInt; overload; +function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; overload; +function UnicodeCharToUTF8(u: LongWord): string4; +function UTF8ReverseString(const s: string): string; +function UTF8CodepointToUnicode(p: PChar; ACodePointLen: integer): LongWord; +function UTF8ToUTF16(const S: AnsiString): UnicodeString; +function UTF16ToUTF8(const S: UnicodeString): AnsiString; +procedure UTF8ToUnicodeArray(const sUTF8: string; out u: TUnicodeArray; out ofs: TIntegerArray); + +type + TBidiUTF8Info = packed record + Offset: Integer; + BidiInfo: TUnicodeBidiInfo; + end; + TBidiUTF8Array = packed array of TBidiUTF8Info; + TUnicodeDisplayOrder = BGRAUnicode.TUnicodeDisplayOrder; + TUnicodeBidiInfo = BGRAUnicode.TUnicodeBidiInfo; + +function GetBidiClassUTF8(P: PChar): TUnicodeBidiClass; +function GetFirstStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; +function GetLastStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; +function IsRightToLeftUTF8(const sUTF8: string): boolean; +function IsZeroWidthUTF8(const sUTF8: string): boolean; +function AddParagraphBidiUTF8(s: string; ARightToLeft: boolean): string; +function AnalyzeBidiUTF8(const sUTF8: string): TBidiUTF8Array; overload; +function AnalyzeBidiUTF8(const sUTF8: string; ABidiMode: TFontBidiMode): TBidiUTF8Array; overload; +function AnalyzeBidiUTF8(const sUTF8: string; ARightToLeft: boolean): TBidiUTF8Array; overload; +function GetUTF8DisplayOrder(const ABidi: TBidiUTF8Array): TUnicodeDisplayOrder; +function ContainsBidiIsolateOrFormattingUTF8(const sUTF8: string): boolean; + +function UTF8OverrideDirection(const sUTF8: string; ARightToLeft: boolean): string; +function UTF8EmbedDirection(const sUTF8: string; ARightToLeft: boolean): string; +function UTF8Ligature(const sUTF8: string; ARightToLeft: boolean; ALigatureLeft, ALigatureRight: boolean): string; + +type + + { TGlyphUtf8 } + + TGlyphUtf8 = record + private + function GetEmpty: boolean; + public + GlyphUtf8, MirroredGlyphUtf8: string; + RightToLeft, Mirrored, Merged: boolean; + ByteOffset, ByteSize: integer; + property Empty: boolean read GetEmpty; + end; + + { TGlyphCursorUtf8 } + + TGlyphCursorUtf8 = record + private + sUTF8: string; + currentChar: string; + currentOffset: integer; + currentBidiInfo: TUnicodeBidiInfo; + bidiArray: TBidiUTF8Array; + displayOrder: TUnicodeDisplayOrder; + displayIndex: Integer; + procedure NextMultichar; + procedure PeekMultichar; + public + class function New(const textUTF8: string; ABidiMode: TFontBidiMode): TGlyphCursorUtf8; static; + function GetNextGlyph: TGlyphUtf8; + procedure Rewind; + function EndOfString: boolean; + end; + +//little endian stream functions +function LEReadInt64(Stream: TStream): int64; +procedure LEWriteInt64(Stream: TStream; AValue: int64); +function LEReadLongint(Stream: TStream): longint; +procedure LEWriteLongint(Stream: TStream; AValue: LongInt); +function LEReadByte(Stream: TStream): byte; +procedure LEWriteByte(Stream: TStream; AValue: Byte); +function LEReadSingle(Stream: TStream): single; +procedure LEWriteSingle(Stream: TStream; AValue: single); + +implementation + +{$IFDEF BGRABITMAP_USE_LCL} +uses LazFileUtils, LazUtf8; + +procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); +begin + lazutf8classes.LoadStringsFromFileUTF8(List,FileName); +end; + +procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); +begin + lazutf8classes.SaveStringsToFileUTF8(List,FileName); +end; + +function UTF8ToSys(const s: string): string; +begin + result := LazUtf8.UTF8ToSys(s); +end; + +function SysToUTF8(const s: string): string; +begin + result := LazUtf8.SysToUTF8(s); +end; + +function UTF8LowerCase(const s: string): string; +begin + result := LazUtf8.UTF8LowerCase(s); +end; + +function UTF8UpperCase(const s: string): string; +begin + result := LazUtf8.UTF8UpperCase(s); +end; + +function UTF8CompareStr(const S1, S2: string): Integer; +begin + result := LazUtf8.UTF8CompareStr(S1,S2); +end; + +function UTF8CompareText(const S1, S2: string): Integer; +begin + result := LazUtf8.UTF8CompareText(S1,S2); +end; + +function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle; +begin + result := LazFileUtils.FileOpenUTF8(FileName, Mode); +end; + +function FileCreateUTF8(Const FileName : string) : THandle; overload; +begin + result := LazFileUtils.FileCreateUTF8(FileName); +end; + +function FileCreateUTF8(Const FileName : string; Rights: LongWord) : THandle; overload; +begin + result := LazFileUtils.FileCreateUTF8(FileName, Rights); +end; + +function FileExistsUTF8(Const FileName : string): boolean; +begin + result := LazFileUtils.FileExistsUTF8(FileName); +end; + +function DeleteFileUTF8(const FileName: string): boolean; +begin + result := LazFileUtils.DeleteFileUTF8(FileName); +end; + +function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec + ): Longint; +begin + result := LazFileUtils.FindFirstUTF8(Path,Attr,Rslt); +end; + +function FindNextUTF8(var Rslt: TSearchRec): Longint; +begin + result := LazFileUtils.FindNextUTF8(Rslt); +end; + +procedure FindCloseUTF8(var F: TSearchrec); +begin + LazFileUtils.FindCloseUTF8(F); +end; + +function UTF8CharacterLength(p: PChar): integer; +begin + result := LazUtf8.UTF8CharacterLength(p); +end; + +function UTF8Length(const s: string): PtrInt; +begin + result := LazUtf8.UTF8Length(s); +end; + +function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; +begin + result := LazUtf8.UTF8Length(p, ByteCount); +end; + +function UnicodeCharToUTF8(u: LongWord): string4; +begin + result := LazUtf8.UnicodeToUTF8(u); +end; + +function UTF8ToUTF16(const S: AnsiString): UnicodeString; +begin + result := LazUTf8.UTF8ToUTF16(s); +end; + +function UTF16ToUTF8(const S: UnicodeString): AnsiString; +begin + result := LazUTf8.UTF16ToUTF8(s); +end; + +{$ELSE} + +procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); +var + uList: TStringListUTF8; +begin + if List is TStringListUTF8 then + begin + List.LoadFromFile(FileName); + exit; + end; + uList:=TStringListUTF8.Create; + try + uList.LoadFromFile(FileName); + List.Assign(uList); + finally + uList.Free; + end; +end; + +procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); +var + uList: TStringListUTF8; +begin + if List is TStringListUTF8 then + begin + List.SaveToFile(FileName); + exit; + end; + uList:=TStringListUTF8.Create; + try + uList.Assign(List); + uList.SaveToFile(FileName); + finally + uList.Free; + end; +end; + +function UTF8LowerCase(const s: string): string; +begin + result := UTF8Encode(UnicodeLowerCase(UTF8Decode(s))); +end; + +function UTF8UpperCase(const s: string): string; +begin + result := UTF8Encode(UnicodeUpperCase(UTF8Decode(s))); +end; + +function UTF8CompareStr(const S1, S2: string): Integer; +begin + Result := SysUtils.CompareStr(S1, S2); +end; + +function UTF8CompareText(const S1, S2: string): Integer; +begin + Result := UnicodeCompareText(UTF8Decode(S1), UTF8Decode(S2)); +end; + +function FileOpenUTF8(const FileName: string; Mode: Integer): THandle; +begin + result := FileOpen(UTF8ToSys(FileName),Mode); +end; + +function FileCreateUTF8(const FileName: string): THandle; +begin + result := FileCreate(UTF8ToSys(FileName)); +end; + +function FileCreateUTF8(const FileName: string; Rights: LongWord): THandle; +begin + result := FileCreate(UTF8ToSys(FileName),Rights); +end; + +function FileExistsUTF8(const FileName: string): boolean; +begin + result := FileExists(UTF8ToSys(FileName)); +end; + +function DeleteFileUTF8(const FileName: string): boolean; +begin + result := DeleteFile(UTF8ToSys(FileName)); +end; + +function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec + ): Longint; +begin + result := FindFirst(UTF8ToSys(Path),Attr,Rslt); + Rslt.Name := SysToUTF8(Rslt.Name); +end; + +function FindNextUTF8(var Rslt: TSearchRec): Longint; +begin + result := FindNext(Rslt); + if result = 0 then + Rslt.Name := SysToUTF8(Rslt.Name); +end; + +procedure FindCloseUTF8(var F: TSearchrec); +begin + FindClose(F); +end; + +function UTF8ToSys(const s: string): string; +begin + result := Utf8ToAnsi(s); +end; + +function SysToUTF8(const s: string): string; +begin + result := AnsiToUtf8(s); +end; + +function UTF8CharacterLength(p: PChar): integer; +begin + if p<>nil then begin + if ord(p^)<%11000000 then begin + // regular single byte character (#0 is a character, this is pascal ;) + Result:=1; + end + else begin + // multi byte + if ((ord(p^) and %11100000) = %11000000) then begin + // could be 2 byte character + if (ord(p[1]) and %11000000) = %10000000 then + Result:=2 + else + Result:=1; + end + else if ((ord(p^) and %11110000) = %11100000) then begin + // could be 3 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then + Result:=3 + else + Result:=1; + end + else if ((ord(p^) and %11111000) = %11110000) then begin + // could be 4 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then + Result:=4 + else + Result:=1; + end + else + Result:=1; + end; + end else + Result:=0; +end; + +function UTF8Length(const s: string): PtrInt; +begin + Result:=UTF8Length(PChar(s),length(s)); +end; + +function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; +var + CharLen: LongInt; +begin + Result:=0; + while (ByteCount>0) do begin + inc(Result); + CharLen:=UTF8CharacterLength(p); + inc(p,CharLen); + dec(ByteCount,CharLen); + end; +end; + +function UnicodeToUTF8Inline(CodePoint: LongWord; Buf: PChar): integer; +begin + case CodePoint of + 0..$7f: + begin + Result:=1; + Buf[0]:=char(byte(CodePoint)); + end; + $80..$7ff: + begin + Result:=2; + Buf[0]:=char(byte($c0 or (CodePoint shr 6))); + Buf[1]:=char(byte($80 or (CodePoint and $3f))); + end; + $800..$ffff: + begin + Result:=3; + Buf[0]:=char(byte($e0 or (CodePoint shr 12))); + Buf[1]:=char(byte((CodePoint shr 6) and $3f) or $80); + Buf[2]:=char(byte(CodePoint and $3f) or $80); + end; + $10000..$10ffff: + begin + Result:=4; + Buf[0]:=char(byte($f0 or (CodePoint shr 18))); + Buf[1]:=char(byte((CodePoint shr 12) and $3f) or $80); + Buf[2]:=char(byte((CodePoint shr 6) and $3f) or $80); + Buf[3]:=char(byte(CodePoint and $3f) or $80); + end; + else + Result:=0; + end; +end; + +function UnicodeCharToUTF8(u: LongWord): string4; +begin + result[0] := chr(UnicodeToUTF8Inline(u,@result[1])); +end; + +constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word); +var + lHandle: THandle; +begin + FFileName:= AFileName; + if Mode = fmcreate then + lHandle:= FileCreateUTF8(AFileName) + else + lHandle:= FileOpenUTF8(AFileName, Mode); + + If (THandle(lHandle)=feInvalidHandle) then + begin + if Mode = fmCreate then + raise EFCreateError.createfmt({SFCreateError}'Unable to create file "%s"', [AFileName]) + else + raise EFOpenError.Createfmt({SFOpenError}'Unable to open file "%s"', [AFilename]); + end + else + inherited Create(lHandle); +end; + +constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word; Rights: LongWord); +var + lHandle: THandle; +begin + FFileName:=AFileName; + if Mode=fmcreate then + lHandle:=FileCreateUTF8(AFileName,Rights) + else + lHandle:=FileOpenUTF8(AFileName,Mode); + + if (THandle(lHandle)=feInvalidHandle) then + begin + if Mode=fmcreate then + raise EFCreateError.createfmt({SFCreateError}'Unable to create file "%s"',[AFileName]) + else + raise EFOpenError.Createfmt({SFOpenError}'Unable to open file "%s"',[AFilename]); + end + else + inherited Create(lHandle); +end; + +destructor TFileStreamUTF8.Destroy; +begin + FileClose(Handle); +end; + +function TStringListUTF8.DoCompareText(const s1, s2: string): PtrInt; +begin + if CaseSensitive then + Result:= UTF8CompareStr(s1,s2) + else + Result:= UTF8CompareText(s1,s2); +end; + +procedure TStringListUTF8.LoadFromFile(const FileName: string); +var + TheStream: TFileStreamUTF8; +begin + TheStream:= TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(TheStream); + finally + TheStream.Free; + end; +end; + +procedure TStringListUTF8.SaveToFile(const FileName: string); +var + TheStream: TFileStreamUTF8; +begin + TheStream:=TFileStreamUTF8.Create(FileName,fmCreate); + try + SaveToStream(TheStream); + finally + TheStream.Free; + end; +end; + +{copied from LazUTF8 + ------------------------------------------------------------------------------} +type + TConvertResult = (trNoError, trNullSrc, trNullDest, trDestExhausted, + trInvalidChar, trUnfinishedChar); + + TConvertOption = (toInvalidCharError, toInvalidCharToSymbol, + toUnfinishedCharError, toUnfinishedCharToSymbol); + TConvertOptions = set of TConvertOption; + +{ ------------------------------------------------------------------------------ + Name: ConvertUTF8ToUTF16 + Params: Dest - Pointer to destination string + DestWideCharCount - Wide char count allocated in destination string + Src - Pointer to source string + SrcCharCount - Char count allocated in source string + Options - Conversion options, if none is set, both + invalid and unfinished source chars are skipped + + toInvalidCharError - Stop on invalid source char and report + error + toInvalidCharToSymbol - Replace invalid source chars with '?' + toUnfinishedCharError - Stop on unfinished source char and + report error + toUnfinishedCharToSymbol - Replace unfinished source char with '?' + + ActualWideCharCount - Actual wide char count converted from source + string to destination string + Returns: + trNoError - The string was successfully converted without + any error + trNullSrc - Pointer to source string is nil + trNullDest - Pointer to destination string is nil + trDestExhausted - Destination buffer size is not big enough to hold + converted string + trInvalidChar - Invalid source char has occurred + trUnfinishedChar - Unfinished source char has occurred + + Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian) + ------------------------------------------------------------------------------} +function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt; + Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions; + out ActualWideCharCount: SizeUInt): TConvertResult; +var + DestI, SrcI: SizeUInt; + B1, B2, B3, B4: Byte; + W: Word; + C: LongWord; + + function UnfinishedCharError: Boolean; + begin + if toUnfinishedCharToSymbol in Options then + begin + Dest[DestI] := System.WideChar('?'); + Inc(DestI); + Result := False; + end + else + if toUnfinishedCharError in Options then + begin + ConvertUTF8ToUTF16 := trUnfinishedChar; + Result := True; + end + else Result := False; + end; + + function InvalidCharError(Count: SizeUInt): Boolean; inline; + begin + if not (toInvalidCharError in Options) then + begin + if toInvalidCharToSymbol in Options then + begin + Dest[DestI] := System.WideChar('?'); + Inc(DestI); + end; + + Dec(SrcI, Count); + + // skip trailing UTF-8 char bytes + while (Count > 0) do + begin + if (Byte(Src[SrcI]) and %11000000) <> %10000000 then Break; + Inc(SrcI); + Dec(Count); + end; + + Result := False; + end + else + if toInvalidCharError in Options then + begin + ConvertUTF8ToUTF16 := trUnfinishedChar; + Result := True; + end; + end; + +begin + ActualWideCharCount := 0; + + if not Assigned(Src) then + begin + Result := trNullSrc; + Exit; + end; + + if not Assigned(Dest) then + begin + Result := trNullDest; + Exit; + end; + SrcI := 0; + DestI := 0; + + while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do + begin + B1 := Byte(Src[SrcI]); + Inc(SrcI); + + if B1 < 128 then // single byte UTF-8 char + begin + Dest[DestI] := System.WideChar(B1); + Inc(DestI); + end + else + begin + if SrcI >= SrcCharCount then + if UnfinishedCharError then Exit(trInvalidChar) + else Break; + + B2 := Byte(Src[SrcI]); + Inc(SrcI); + + if (B1 and %11100000) = %11000000 then // double byte UTF-8 char + begin + if (B2 and %11000000) = %10000000 then + begin + Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111)); + Inc(DestI); + end + else // invalid character, assume single byte UTF-8 char + if InvalidCharError(1) then Exit(trInvalidChar); + end + else + begin + if SrcI >= SrcCharCount then + if UnfinishedCharError then Exit(trInvalidChar) + else Break; + + B3 := Byte(Src[SrcI]); + Inc(SrcI); + + if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char + begin + if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then + begin + W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111); + if (W < $D800) or (W > $DFFF) then // to single wide char UTF-16 char + begin + Dest[DestI] := System.WideChar(W); + Inc(DestI); + end + else // invalid UTF-16 character, assume double byte UTF-8 char + if InvalidCharError(2) then Exit(trInvalidChar); + end + else // invalid character, assume double byte UTF-8 char + if InvalidCharError(2) then Exit(trInvalidChar); + end + else + begin + if SrcI >= SrcCharCount then + if UnfinishedCharError then Exit(trInvalidChar) + else Break; + + B4 := Byte(Src[SrcI]); + Inc(SrcI); + + if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000) + and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then + begin // 4 byte UTF-8 char + C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12) + or ((B3 and %00111111) shl 6) or (B4 and %00111111); + // to double wide char UTF-16 char + Dest[DestI] := System.WideChar($D800 or ((C - $10000) shr 10)); + Inc(DestI); + if DestI >= DestWideCharCount then Break; + Dest[DestI] := System.WideChar($DC00 or ((C - $10000) and %0000001111111111)); + Inc(DestI); + end + else // invalid character, assume triple byte UTF-8 char + if InvalidCharError(3) then Exit(trInvalidChar); + end; + end; + end; + end; + + if DestI >= DestWideCharCount then + begin + DestI := DestWideCharCount - 1; + Result := trDestExhausted; + end + else + Result := trNoError; + + Dest[DestI] := #0; + ActualWideCharCount := DestI + 1; +end; + +function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString; +var + L: SizeUInt; +begin + if ByteCnt=0 then + exit(''); + SetLength(Result, ByteCnt); + // wide chars of UTF-16 <= bytes of UTF-8 string + if ConvertUTF8ToUTF16(PWideChar(Result), Length(Result) + 1, P, ByteCnt, + [toInvalidCharToSymbol], L) = trNoError + then SetLength(Result, L - 1) + else Result := ''; +end; + +{------------------------------------------------------------------------------ + Name: UTF8ToUTF16 + Params: S - Source UTF-8 string + Returns: UTF-16 encoded string + + Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian) + Avoid copying the result string since on windows a widestring requires a full + copy + ------------------------------------------------------------------------------} +function UTF8ToUTF16(const S: AnsiString): UnicodeString; +begin + Result:=UTF8ToUTF16(PChar(S),length(S)); +end; + +{------------------------------------------------------------------------------ + Name: ConvertUTF16ToUTF8 + Params: Dest - Pointer to destination string + DestCharCount - Char count allocated in destination string + Src - Pointer to source string + SrcWideCharCount - Wide char count allocated in source string + Options - Conversion options, if none is set, both + invalid and unfinished source chars are skipped. + See ConvertUTF8ToUTF16 for details. + + ActualCharCount - Actual char count converted from source + string to destination string + Returns: See ConvertUTF8ToUTF16 + + Converts the specified UTF-16 encoded string (system endian) to UTF-8 encoded + ------------------------------------------------------------------------------} +function ConvertUTF16ToUTF8(Dest: PChar; DestCharCount: SizeUInt; + Src: PWideChar; SrcWideCharCount: SizeUInt; Options: TConvertOptions; + out ActualCharCount: SizeUInt): TConvertResult; +var + DestI, SrcI: SizeUInt; + W1, W2: Word; + C: LongWord; + + function UnfinishedCharError: Boolean; + begin + if toUnfinishedCharToSymbol in Options then + begin + Dest[DestI] := Char('?'); + Inc(DestI); + Result := False; + end + else + if toUnfinishedCharError in Options then + begin + ConvertUTF16ToUTF8 := trUnfinishedChar; + Result := True; + end + else Result := False; + end; + + function InvalidCharError(Count: SizeUInt): Boolean; inline; + begin + if not (toInvalidCharError in Options) then + begin + if toInvalidCharToSymbol in Options then + begin + Dest[DestI] := Char('?'); + Inc(DestI); + end; + + Dec(SrcI, Count); + // skip trailing UTF-16 wide char + if (Word(Src[SrcI]) and $FC00) = $DC00 then Inc(SrcI); + + Result := False; + end + else + if toInvalidCharError in Options then + begin + ConvertUTF16ToUTF8 := trUnfinishedChar; + Result := True; + end; + end; + +begin + ActualCharCount := 0; + + if not Assigned(Src) then + begin + Result := trNullSrc; + Exit; + end; + + if not Assigned(Dest) then + begin + Result := trNullDest; + Exit; + end; + SrcI := 0; + DestI := 0; + + while (DestI < DestCharCount) and (SrcI < SrcWideCharCount) do + begin + W1 := Word(Src[SrcI]); + Inc(SrcI); + + if (W1 < $D800) or (W1 > $DFFF) then // single wide char UTF-16 char + begin + if W1 < $0080 then // to single byte UTF-8 char + begin + Dest[DestI] := Char(W1); + Inc(DestI); + end + else + if W1 < $0800 then // to double byte UTF-8 char + begin + Dest[DestI] := Char(%11000000 or ((W1 and %11111000000) shr 6)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or (W1 and %111111)); + Inc(DestI); + end + else + begin // to triple byte UTF-8 char + Dest[DestI] := Char(%11100000 or ((W1 and %1111000000000000) shr 12)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or ((W1 and %111111000000) shr 6)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or (W1 and %111111)); + Inc(DestI); + end; + end + else + begin + if SrcI >= SrcWideCharCount then + if UnfinishedCharError then Exit(trInvalidChar) + else Break; + + W2 := Word(Src[SrcI]); + Inc(SrcI); + + if (W1 and $F800) = $D800 then // double wide char UTF-16 char + begin + if (W2 and $FC00) = $DC00 then + begin + C := (W1 - $D800) shl 10 + (W2 - $DC00) + $10000; + + // to 4 byte UTF-8 char + Dest[DestI] := Char(%11110000 or (C shr 18)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or ((C and $3F000) shr 12)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or ((C and %111111000000) shr 6)); + Inc(DestI); + if DestI >= DestCharCount then Break; + Dest[DestI] := Char(%10000000 or (C and %111111)); + Inc(DestI); + end + else // invalid character, assume single wide char UTF-16 char + if InvalidCharError(1) then Exit(trInvalidChar); + end + else // invalid character, assume single wide char UTF-16 char + if InvalidCharError(1) then Exit(trInvalidChar); + end; + end; + + if DestI >= DestCharCount then + begin + DestI := DestCharCount - 1; + Result := trDestExhausted; + end + else + Result := trNoError; + + Dest[DestI] := #0; + ActualCharCount := DestI + 1; +end; + +function UTF16ToUTF8(const P: PWideChar; WideCnt: SizeUInt): AnsiString; +var + L: SizeUInt; +begin + if WideCnt=0 then + exit(''); + + SetLength(Result, WideCnt * 3); + // bytes of UTF-8 <= 3 * wide chars of UTF-16 string + // e.g. %11100000 10100000 10000000 (UTF-8) is $0800 (UTF-16) + if ConvertUTF16ToUTF8(PChar(Result), Length(Result) + 1, P, WideCnt, + [toInvalidCharToSymbol], L) = trNoError then + begin + SetLength(Result, L - 1); + end else + Result := ''; +end; + +{------------------------------------------------------------------------------ + Name: UTF16ToUTF8 + Params: S - Source UTF-16 string (system endian) + Returns: UTF-8 encoded string + + Converts the specified UTF-16 encoded string (system endian) to UTF-8 encoded + ------------------------------------------------------------------------------} +function UTF16ToUTF8(const S: UnicodeString): AnsiString; +begin + Result := UTF16ToUTF8(PWideChar(S),length(S)); +end; + +{end of copy from LazUTF8 + ------------------------------------------------------------------------------} + +{$ENDIF} + +function UTF8ReverseString(const s: string): string; +var + pSrc,pDest,pEnd: PChar; + charLen: Integer; +begin + if s = '' then + begin + result := ''; + exit; + end; + setlength(result, length(s)); + pDest := @result[1] + length(result); + pSrc := @s[1]; + pEnd := pSrc+length(s); + while pSrc < pEnd do + begin + charLen := UTF8CharacterLength(pSrc); + if (charLen = 0) or (pSrc+charLen > pEnd) then break; + dec(pDest, charLen); + move(pSrc^, pDest^, charLen); + inc(pSrc, charLen); + end; +end; + +function UTF8CodepointToUnicode(p: PChar; ACodePointLen: integer): LongWord; +begin + case ACodePointLen of + 0: result := 0; + 1: result := ord(p^); + 2: result := ((ord(p^) and %00011111) shl 6) or (ord(p[1]) and %00111111); + 3: result := ((ord(p^) and %00011111) shl 12) or ((ord(p[1]) and %00111111) shl 6) + or (ord(p[2]) and %00111111); + 4: result := ((ord(p^) and %00001111) shl 18) or ((ord(p[1]) and %00111111) shl 12) + or ((ord(p[2]) and %00111111) shl 6) or (ord(p[3]) and %00111111); + else + raise exception.Create('Invalid code point length'); + end; +end; + +function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar; +var + CharLen: LongInt; +begin + Result:=UTF8Str; + if Result<>nil then begin + while (CharIndex>0) and (Len>0) do begin + CharLen:=UTF8CharacterLength(Result); + dec(Len,CharLen); + dec(CharIndex); + inc(Result,CharLen); + end; + if (CharIndex<>0) or (Len<0) then + Result:=nil; + end; +end; + +function GetBidiClassUTF8(P: PChar): TUnicodeBidiClass; +begin + result := GetUnicodeBidiClass(UTF8CodepointToUnicode(P, UTF8CharacterLength(p))); +end; + +function GetFirstStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; +var + p,pEnd: PChar; + charLen: Integer; + u: LongWord; + curBidi: TUnicodeBidiClass; + isolateNesting: integer; +begin + if sUTF8 = '' then exit(ubcUnknown); + p := @sUTF8[1]; + pEnd := p + length(sUTF8); + isolateNesting:= 0; + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + if (charLen = 0) or (p+charLen > pEnd) then break; + u := UTF8CodepointToUnicode(p, charLen); + case u of + UNICODE_POP_DIRECTIONAL_ISOLATE: if isolateNesting > 0 then dec(isolateNesting); + UNICODE_LEFT_TO_RIGHT_OVERRIDE: exit(ubcLeftToRight); + UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(ubcRightToLeft); + end; + curBidi := GetUnicodeBidiClass(u); + if isolateNesting = 0 then + begin + if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then + exit(curBidi); + end; + case u of + UNICODE_FIRST_STRONG_ISOLATE, UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: inc(isolateNesting); + end; + if curBidi = ubcParagraphSeparator then isolateNesting:= 0; + inc(p,charLen); + end; + exit(ubcUnknown); +end; + +function GetLastStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; +var + p,pEnd: PChar; + charLen: Integer; + u: LongWord; + curBidi: TUnicodeBidiClass; + isolateNesting: integer; +begin + if sUTF8 = '' then exit(ubcUnknown); + p := @sUTF8[1]; + pEnd := p + length(sUTF8); + isolateNesting:= 0; + result := ubcUnknown; + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + if (charLen = 0) or (p+charLen > pEnd) then break; + u := UTF8CodepointToUnicode(p, charLen); + case u of + UNICODE_POP_DIRECTIONAL_ISOLATE: if isolateNesting > 0 then dec(isolateNesting); + end; + curBidi := GetUnicodeBidiClass(u); + if isolateNesting = 0 then + begin + if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then + result := curBidi; + end; + case u of + UNICODE_FIRST_STRONG_ISOLATE, UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: inc(isolateNesting); + end; + if curBidi = ubcParagraphSeparator then isolateNesting:= 0; + inc(p,charLen); + end; +end; + +function IsRightToLeftUTF8(const sUTF8: string): boolean; +begin + result := GetFirstStrongBidiClassUTF8(sUTF8) in[ubcRightToLeft,ubcArabicLetter]; +end; + +function IsZeroWidthUTF8(const sUTF8: string): boolean; +var + p,pEnd: PChar; + charLen: Integer; + u: LongWord; +begin + if sUTF8 = '' then exit(true); + p := @sUTF8[1]; + pEnd := p + length(sUTF8); + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + if (charLen = 0) or (p+charLen > pEnd) then break; + u := UTF8CodepointToUnicode(p, charLen); + if not IsZeroWidthUnicode(u) then exit(false); + inc(p,charLen); + end; + exit(true); +end; + +function AddParagraphBidiUTF8(s: string; ARightToLeft: boolean): string; +var + i,curParaStart: Integer; + + procedure CheckParagraph; + var + para,newPara: string; + paraRTL: boolean; + begin + if i > curParaStart then + begin + para := copy(s,curParaStart,i-curParaStart); + paraRTL := GetFirstStrongBidiClassUTF8(para) in[ubcRightToLeft,ubcArabicLetter]; + //detected paragraph does not match overall RTL option + if paraRTL <> ARightToLeft then + begin + if not paraRTL then + newPara := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK)+para+UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) + else + newPara := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK)+para+UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK); + inc(i, length(newPara)-length(para)); + delete(s, curParaStart, length(para)); + insert(newPara, s, curParaStart); + end; + end; + end; + +var + charLen: integer; + u: LongWord; + +begin + i := 1; + curParaStart := 1; + while i <= length(s) do + begin + charLen := UTF8CharacterLength(@s[i]); + u := UTF8CodepointToUnicode(@s[i], charLen); + if IsUnicodeParagraphSeparator(u) then + begin + CheckParagraph; + //skip end of line + inc(i); + //skip second CRLF + if ((u = 10) or (u = 13)) and (i <= length(s)) and (s[i] in[#13,#10]) and (s[i]<>s[i-1]) then inc(i); + curParaStart := i; + end else + inc(i); + end; + CheckParagraph; + result := s; +end; + +procedure UTF8ToUnicodeArray(const sUTF8: string; out u: TUnicodeArray; out ofs: TIntegerArray); +var + index,len,charLen: integer; + p,pStart,pEnd: PChar; +begin + if sUTF8 = '' then + begin + u := nil; + ofs := nil; + end + else + begin + pStart := @sUTF8[1]; + pEnd := pStart + length(sUTF8); + p := pStart; + len := 0; + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + inc(len); + inc(p,charLen); + end; + + setlength(u, len); + setlength(ofs, len); + p := pStart; + index := 0; + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + u[index] := UTF8CodepointToUnicode(p, charLen); + ofs[index] := p - pStart; + inc(index); + inc(p,charLen); + end; + end; +end; + +function AnalyzeBidiUTF8(const sUTF8: string; ABidiMode: TFontBidiMode): TBidiUTF8Array; +var + u: TUnicodeArray; + ofs: TIntegerArray; + a: TUnicodeBidiArray; + i: Integer; +begin + if sUTF8 = '' then + result := nil + else + begin + UTF8ToUnicodeArray(sUTF8, u, ofs); + a := AnalyzeBidiUnicode(@u[0], length(u), ABidiMode); + setlength(result, length(u)); + for i := 0 to high(result) do + begin + result[i].Offset:= ofs[i]; + result[i].BidiInfo := a[i]; + end; + end; +end; + +function AnalyzeBidiUTF8(const sUTF8: string; ARightToLeft: boolean): TBidiUTF8Array; +begin + if ARightToLeft then + result := AnalyzeBidiUTF8(sUTF8, fbmRightToLeft) + else result := AnalyzeBidiUTF8(sUTF8, fbmLeftToRight); +end; + +function AnalyzeBidiUTF8(const sUTF8: string): TBidiUTF8Array; +begin + result := AnalyzeBidiUTF8(sUTF8, fbmAuto) +end; + +function GetUTF8DisplayOrder(const ABidi: TBidiUTF8Array): TUnicodeDisplayOrder; +begin + if length(ABidi) = 0 then + result := nil + else + result := GetUnicodeDisplayOrder(@ABidi[0].BidiInfo, sizeof(TBidiUTF8Info), length(ABidi)); +end; + +function ContainsBidiIsolateOrFormattingUTF8(const sUTF8: string): boolean; +var + p,pEnd: PChar; + charLen: Integer; + u: LongWord; +begin + if sUTF8 = '' then exit(false); + p := @sUTF8[1]; + pEnd := p + length(sUTF8); + while p < pEnd do + begin + charLen := UTF8CharacterLength(p); + if (charLen = 0) or (p+charLen > pEnd) then break; + u := UTF8CodepointToUnicode(p, charLen); + case u of + UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE, + UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, + UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(true); + end; + inc(p,charLen); + end; + exit(false); +end; + +function UTF8OverrideDirection(const sUTF8: string; ARightToLeft: boolean): string; +begin + if ARightToLeft then + result := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_OVERRIDE) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING) + else + result := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_OVERRIDE) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING); +end; + +function UTF8EmbedDirection(const sUTF8: string; ARightToLeft: boolean): string; +begin + if ARightToLeft then + result := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_EMBEDDING) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING) + else + result := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_EMBEDDING) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING); +end; + +function UTF8Ligature(const sUTF8: string; ARightToLeft: boolean; + ALigatureLeft, ALigatureRight: boolean): string; +begin + result := sUTF8; + if (ALigatureRight and ARightToLeft) or + (ALigatureLeft and not ARightToLeft) then + result := UTF8_ZERO_WIDTH_JOINER + result; + if (ALigatureLeft and ARightToLeft) or + (ALigatureRight and not ARightToLeft) then + result := result + UTF8_ZERO_WIDTH_JOINER; +end; + +//little endian stream functions +function LEReadInt64(Stream: TStream): int64; +begin + Result := 0; + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +procedure LEWriteInt64(Stream: TStream; AValue: int64); +begin + AValue := NtoLE(AValue); + stream.Write(AValue, sizeof(AValue)); +end; + +function LEReadLongint(Stream: TStream): longint; +begin + Result := 0; + stream.Read(Result, sizeof(Result)); + Result := LEtoN(Result); +end; + +procedure LEWriteLongint(Stream: TStream; AValue: LongInt); +begin + AValue := NtoLE(AValue); + stream.Write(AValue, sizeof(AValue)); +end; + +function LEReadByte(Stream: TStream): byte; +begin + Result := 0; + stream.Read(Result, sizeof(Result)); +end; + +procedure LEWriteByte(Stream: TStream; AValue: Byte); +begin + stream.Write(AValue, sizeof(AValue)); +end; + +function LEReadSingle(Stream: TStream): single; +var + ResultAsDWord : LongWord absolute result; +begin + ResultAsDWord := 0; + stream.Read(ResultAsDWord, sizeof(Result)); + ResultAsDWord := LEtoN(ResultAsDWord); +end; + +procedure LEWriteSingle(Stream: TStream; AValue: single); +var + ValueAsDWord : LongWord absolute AValue; +begin + ValueAsDWord := NtoLE(ValueAsDWord); + stream.Write(ValueAsDWord, sizeof(AValue)); +end; + +{ TGlyphUtf8 } + +function TGlyphUtf8.GetEmpty: boolean; +begin + result := GlyphUtf8 = ''; +end; + +{ TGlyphCursorUtf8 } + +class function TGlyphCursorUtf8.New(const textUTF8: string; ABidiMode: TFontBidiMode): TGlyphCursorUtf8; +begin + result.sUTF8 := textUTF8; + result.bidiArray := AnalyzeBidiUTF8(result.sUTF8, ABidiMode); + result.displayOrder := GetUTF8DisplayOrder(result.bidiArray); + result.Rewind; +end; + +function TGlyphCursorUtf8.GetNextGlyph: TGlyphUtf8; +var + rtlScript, ligatureLeft, ligatureRight: Boolean; + u: LongWord; + bracketInfo: TUnicodeBracketInfo; +begin + if EndOfString then + begin + result.GlyphUtf8:= ''; + result.RightToLeft:= false; + result.Mirrored:= false; + result.MirroredGlyphUtf8:= ''; + exit; + end; + PeekMultichar; + NextMultichar; + result.GlyphUtf8 := currentChar; + result.RightToLeft := currentBidiInfo.IsRightToLeft; + result.Mirrored := currentBidiInfo.IsMirrored; + result.MirroredGlyphUtf8:= ''; + result.ByteOffset := currentOffset; + result.ByteSize := length(currentChar); + result.Merged:= false; + if result.Mirrored then + begin + u := UTF8CodepointToUnicode(pchar(currentChar), + min(UTF8CharacterLength(pchar(currentChar)), length(currentChar))); + bracketInfo := GetUnicodeBracketInfo(u); + if bracketInfo.OpeningBracket = u then + result.MirroredGlyphUtf8 := UnicodeCharToUTF8(bracketInfo.ClosingBracket) + else if bracketInfo.ClosingBracket = u then + result.MirroredGlyphUtf8 := UnicodeCharToUTF8(bracketInfo.OpeningBracket); + end else + begin + rtlScript := currentBidiInfo.IsRightToLeftScript; + ligatureRight := currentBidiInfo.HasLigatureRight; + ligatureLeft := currentBidiInfo.HasLigatureLeft; + if (currentChar.StartsWith(UTF8_ARABIC_ALEPH) or + currentChar.StartsWith(UTF8_ARABIC_ALEPH_HAMZA_BELOW) or + currentChar.StartsWith(UTF8_ARABIC_ALEPH_HAMZA_ABOVE) or + currentChar.StartsWith(UTF8_ARABIC_ALEPH_MADDA_ABOVE)) and + not EndOfString then + begin + PeekMultichar; + if currentChar.StartsWith(UTF8_ARABIC_LAM) then + begin + result.GlyphUtf8 := currentChar + result.GlyphUtf8; + result.ByteOffset:= Min(result.ByteOffset, currentOffset); + inc(result.ByteSize, length(currentChar)); + result.Merged := true; + ligatureRight := currentBidiInfo.HasLigatureRight; + NextMultichar; + end; + end; + result.GlyphUtf8 := UTF8Ligature(result.GlyphUtf8, rtlScript, ligatureLeft, ligatureRight); + end; +end; + +procedure TGlyphCursorUtf8.Rewind; +begin + displayIndex := 0; + while (displayIndex < length(displayOrder)) + and not bidiArray[displayOrder[displayIndex]].BidiInfo.IsMulticharStart do + inc(displayIndex); +end; + +procedure TGlyphCursorUtf8.NextMultichar; +begin + inc(displayIndex); + while (displayIndex < length(displayOrder)) + and not bidiArray[displayOrder[displayIndex]].BidiInfo.IsMulticharStart do + inc(displayIndex); +end; + +procedure TGlyphCursorUtf8.PeekMultichar; +var + startIndex, nextIndex, charLen, startOffset: Integer; +begin + startIndex := displayOrder[displayIndex]; + startOffset := bidiArray[startIndex].Offset; + currentBidiInfo := bidiArray[startIndex].BidiInfo; + nextIndex := startIndex+1; + while (nextIndex < length(bidiArray)) + and not bidiArray[nextIndex].BidiInfo.IsMulticharStart do + inc(nextIndex); + if nextIndex >= length(bidiArray) then + charLen := length(sUTF8) - startOffset + else + charLen := bidiArray[nextIndex].Offset - startOffset; + setlength(currentChar, charLen); + if charLen > 0 then move(sUTF8[startOffset+1], currentChar[1], charLen); + currentOffset := startOffset; +end; + +function TGlyphCursorUtf8.EndOfString: boolean; +begin + result := displayIndex >= length(displayOrder); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgravectorize.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgravectorize.pas new file mode 100644 index 0000000..300d5d2 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgravectorize.pas @@ -0,0 +1,2405 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAVectorize; + +{$mode objfpc}{$H+} + +interface + +{ + Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType + + This unit provides vectorizers : + - VectorizeMonochrome function vectorizes a back'n'white image + - TBGRAVectorizedFont allows to vectorize and to load vectorized font and draw them + + TBGRAVectorizedFontRenderer class works like other font renderers, i.e., it can + be assigned to the FontRenderer property. You can use it in two different modes : + - if you supply a directory, it will look for *.glyphs files in it to load fonts + - if you don't supply a directory, fonts will be vectorized from LCL + + Note that unless you want to supply your own glyphs files, you don't need + to use explicitely this renderer, because TBGRATextEffectFontRenderer will + make use of it if necessary, according to effects parameters used. +} + +uses + BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATypewriter, + BGRATransform, BGRACanvas2D, BGRAText; + +//vectorize a monochrome bitmap +function VectorizeMonochrome(ASource: TBGRACustomBitmap; AZoom: single; APixelCenteredCoordinates: boolean; + AWhiteBackground: boolean = true; ADiagonalFillPercent: single = 66; AIntermediateDiagonals: boolean = true): ArrayOfTPointF; +function VectorizeMonochrome(ASource: TBGRACustomBitmap; ARect: TRect; AZoom: single; APixelCenteredCoordinates: boolean; + AWhiteBackground: boolean = true; ADiagonalFillPercent: single = 66; AIntermediateDiagonals: boolean = true): ArrayOfTPointF; + +type + TBGRAVectorizedFont = class; + + //this is the class to assign to FontRenderer property of TBGRABitmap + { TBGRAVectorizedFontRenderer } + + TBGRAVectorizedFontRenderer = class(TBGRACustomFontRenderer) + protected + FVectorizedFontArray: array of record + FontName: string; + FontStyle: TFontStyles; + VectorizedFont: TBGRAVectorizedFont; + end; + FVectorizedFont: TBGRAVectorizedFont; + FCanvas2D: TBGRACanvas2D; + FDirectoryUTF8: string; + function OutlineActuallyVisible: boolean; + procedure UpdateFont; + function GetCanvas2D(ASurface: TBGRACustomBitmap): TBGRACanvas2D; + procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner); + procedure InternalCopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment; ABidiMode: TFontBidiMode); + procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; ABidiMode: TFontBidiMode); + procedure Init; + public + MinFontResolution, MaxFontResolution: integer; + QuadraticCurves: boolean; + + OutlineVisible: boolean; + OutlineWidth: single; + OutlineColor: TBGRAPixel; + OutlineTexture: IBGRAScanner; + OuterOutlineOnly: boolean; + OutlineJoin: TPenJoinStyle; + + ShadowVisible: boolean; + ShadowColor: TBGRAPixel; + ShadowRadius: integer; + ShadowOffset: TPoint; + + constructor Create; overload; + constructor Create(ADirectoryUTF8: string); overload; + function GetFontPixelMetric: TFontPixelMetric; override; + function GetFontPixelMetricF: TFontPixelMetricF; override; + function FontExists(AName: string): boolean; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override; + procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); overload; override; + procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); overload; override; + procedure CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); override; + procedure CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment; ARightToLeft: boolean); override; + function HandlesTextPath: boolean; override; + function TextSize(sUTF8: string): TSize; overload; override; + function TextSizeF(sUTF8: string): TPointF; overload; override; + function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; + function TextSizeF(sUTF8: string; AMaxWidthF: single; {%H-}ARightToLeft: boolean): TPointF; overload; override; + function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; + function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; override; + destructor Destroy; override; + end; + + TGlyphSizes = array of record + Text, Glyph: String; + Width,Height: single; + end; + TGlyphSizesCallbackData = record + Sizes: TGlyphSizes; + Count: integer; + end; + + TBGRAVectorizedFontHeader = record + Name: string; + Style: TFontStyles; + EmHeightRatio: single; + Resolution: integer; + PixelMetric: TFontPixelMetric; + end; + TBGRAGlyphsInfo = record + Name: string; + Style: TFontStyles; + NbGlyphs: integer; + end; + + { TBGRAVectorizedFont } + + TBGRAVectorizedFont = class(TBGRACustomTypeWriter) + private + FName : string; + FStyle: TFontStyles; + FResolution: integer; + FFont: TFont; + FBuffer: TBGRACustomBitmap; + FFullHeight: single; + FFontMatrix: TAffineMatrix; + FOrientation: single; + FQuadraticCurves: boolean; + FItalicSlope: single; + FWordBreakHandler: TWordBreakHandler; + FDirectory: string; + FDirectoryContent: array of record + Filename: string; + FontName: string; + FontStyle: TFontStyles; + end; + FFontEmHeightRatioComputed: boolean; + FFontEmHeightRatio: single; + FFontPixelMetric: TFontPixelMetric; + FFontPixelMetricComputed: boolean; + FFontFound: boolean; + function GetEmHeight: single; + function GetFontPixelMetric: TFontPixelMetric; + function GetLCLHeight: single; + function GetVectorizeLCL: boolean; + procedure SetEmHeight(AValue: single); + procedure SetItalicSlope(AValue: single); + procedure SetLCLHeight(AValue: single); + procedure SetOrientation(AValue: single); + procedure SetQuadraticCurves(AValue: boolean); + procedure SetResolution(AValue: integer); + procedure SetFontMatrix(AValue: TAffineMatrix); + procedure SetFullHeight(AValue: single); + procedure SetName(AValue: string); + procedure SetStyle(AValue: TFontStyles); + function GetFontEmHeightRatio: single; + procedure SetVectorizeLCL(AValue: boolean); + procedure GlyphCallbackForGlyphSizes(ATextUTF8: string; AGlyph: TBGRAGlyph; + {%H-}AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); + procedure UpdateQuadraticCallback({%H-}ATextUTF8: string; AGlyph: TBGRAGlyph; + {%H-}AFlags: TBrowseGlyphCallbackFlags; {%H-}AData: Pointer; out AContinue: boolean); + protected + procedure UpdateFont; + procedure UpdateMatrix; + function GetGlyph(AIdentifier: string): TBGRAGlyph; override; + procedure DefaultWordBreakHandler(var ABefore, AAfter: string); + procedure Init(AVectorize: boolean); + function CustomHeaderSize: integer; override; + procedure WriteCustomHeader(AStream: TStream); override; + procedure ReadAdditionalHeader(AStream: TStream); override; + function ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader; + function HeaderName: string; override; + procedure SetDirectory(const AValue: string); + function ComputeKerning(AIdLeft, AIdRight: string): single; override; + public + UnderlineDecoration,StrikeOutDecoration: boolean; + constructor Create; overload; + constructor Create(AVectorizeLCL: boolean); overload; + destructor Destroy; override; + function GetGlyphSize(AIdentifier:string): TPointF; + function GetTextGlyphSizes(ATextUTF8:string): TGlyphSizes; + function GetTextSize(ATextUTF8:string): TPointF; + function TextFitInfo(ATextUTF8: string; AMaxWidth: single): integer; + procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string); + procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); override; + procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X, Y: Single; + AAlign: TBGRATypeWriterAlignment=twaTopLeft); override; + procedure DrawTextWordBreak(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); + procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); overload; + procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft); overload; + function GetTextWordBreakGlyphBoxes(ATextUTF8: string; X,Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes; + function GetTextRectGlyphBoxes(ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes; overload; + function GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes; overload; + procedure UpdateDirectory; + function LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo; + + property Resolution: integer read FResolution write SetResolution; + property Style: TFontStyles read FStyle write SetStyle; + property Name: string read FName write SetName; + property LCLHeight: single read GetLCLHeight write SetLCLHeight; + property EmHeight: single read GetEmHeight write SetEmHeight; + property FullHeight: single read FFullHeight write SetFullHeight; + property FontMatrix: TAffineMatrix read FFontMatrix write SetFontMatrix; + property Orientation: single read FOrientation write SetOrientation; + property QuadraticCurves: boolean read FQuadraticCurves write SetQuadraticCurves; + property ItalicSlope: single read FItalicSlope write SetItalicSlope; + property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; + property Directory: string read FDirectory write SetDirectory; + property FontEmHeightRatio: single read GetFontEmHeightRatio; + property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric; + property FontFound: boolean read FFontFound; + property VectorizeLCL: boolean read GetVectorizeLCL write SetVectorizeLCL; + end; + +implementation + +uses BGRAUTF8{$IFDEF LCL}, Forms{$ENDIF}; + +function VectorizeMonochrome(ASource: TBGRACustomBitmap; ARect: TRect; AZoom: single; APixelCenteredCoordinates: boolean; + AWhiteBackground: boolean; ADiagonalFillPercent: single; AIntermediateDiagonals: boolean): ArrayOfTPointF; +const unitShift = 6; + iHalf = 1 shl (unitShift-1); + iUnit = 1 shl unitShift; +var + iDiag,iOut: integer; + n: integer; + factor: single; + offset: single; + p,pprev,pnext : PBGRAPixel; + x,y,ix,iy: integer; + points: array of record + coord: tpoint; + prev,next: integer; + drawn,{shouldRemove,}removed,done: boolean; + end; + nbPoints:integer; + PointsPreviousLineStart,PointsCurrentLineStart: integer; + cur: packed array[1..9] of boolean; + ortho: array of array of boolean; + + polygonF: array of TPointF; + + function CheckPixel(const APixel: TBGRAPixel): boolean; inline; + begin + result := (APixel.green <= 128) xor not AWhiteBackground; + end; + + function AddPoint(x,y,APrev,ANext: integer): integer; + begin + if nbpoints = length(points) then + setlength(points, nbpoints*2+1); + result := nbpoints; + with points[result] do + begin + coord := point(x,y); + prev := APrev; + next := ANext; + drawn := false; + removed := false; +// shouldRemove := false; + end; + inc(nbpoints); + end; + + function InsertPoint(x,y,APrev,ANext: integer): integer; + begin + if nbpoints = length(points) then + setlength(points, nbpoints*2+1); + result := nbpoints; + with points[result] do + begin + coord := point(x,y); + prev := APrev; + next := ANext; + drawn := false; + removed := false; +// shouldRemove := false; + end; + if APrev<>-1 then points[APrev].next := result; + if ANext<>-1 then points[ANext].prev := result; + inc(nbpoints); + end; + + procedure RemovePoint(idx: integer); + begin + points[idx].removed:= true; + if points[idx].prev <> -1 then points[points[idx].prev].next := points[idx].next; + if points[idx].next <> -1 then points[points[idx].next].prev := points[idx].prev; + end; + + procedure AddLine(x1,y1,x2,y2: integer); overload; + var i,j,k: integer; + begin + for i := PointsPreviousLineStart to nbpoints-1 do + if (points[i].coord.x = x2) and (points[i].coord.y = y2) and (points[i].prev = -1) then + begin + for j := i+1 to nbpoints-1 do + if (points[j].coord.x = x1) and (points[j].coord.y = y1) and (points[j].next = -1) then + begin + points[j].next := i; + points[i].prev := j; + exit; + end; + k := addpoint(x1,y1,-1,i); + points[i].prev := k; + exit; + end else + if (points[i].coord.x = x1) and (points[i].coord.y = y1) and (points[i].next = -1) then + begin + for j := i+1 to nbpoints-1 do + if (points[j].coord.x = x2) and (points[j].coord.y = y2) and (points[j].prev = -1) then + begin + points[j].prev := i; + points[i].next := j; + exit; + end; + k := addpoint(x2,y2,i,-1); + points[i].next := k; + exit; + end; + k := addpoint(x1,y1,-1,-1); + points[k].next := addpoint(x2,y2,k,-1); + end; + procedure AddLine(x1,y1,x2,y2,x3,y3: integer); overload; + begin + AddLine(x1,y1,x2,y2); + AddLine(x2,y2,x3,y3); + end; + procedure AddLine(x1,y1,x2,y2,x3,y3,x4,y4: integer); overload; + begin + AddLine(x1,y1,x2,y2); + AddLine(x2,y2,x3,y3); + AddLine(x3,y3,x4,y4); + end; + procedure AddLine(x1,y1,x2,y2,x3,y3,x4,y4,x5,y5: integer); overload; + begin + AddLine(x1,y1,x2,y2); + AddLine(x2,y2,x3,y3); + AddLine(x3,y3,x4,y4); + AddLine(x4,y4,x5,y5); + end; + + procedure AddPolygon(nStart: integer); + + procedure Rewind(out cycle: boolean); + var cur: integer; + begin + cur := nStart; + cycle := false; + while (points[cur].prev <> -1) do + begin + cur := points[cur].prev; + if cur = nStart then + begin + cycle := true; //identify cycle + break; + end; + end; + nStart := cur; + end; + + function aligned(start1,end1,start2,end2: integer): boolean; + var + u,v: TPointF; + lu,lv: single; + begin + if (start1=-1) or (end1=-1) or (start2=-1) or (end2=-1) then + begin + result :=false; + exit; + end; + u := pointF(points[end1].coord.x - points[start1].coord.x, points[end1].coord.y - points[start1].coord.y); + lu := sqrt(u*u); + if lu <> 0 then u.Scale(1/lu); + v := pointF(points[end2].coord.x - points[start2].coord.x, points[end2].coord.y - points[start2].coord.y); + lv := sqrt(v*v); + if lv <> 0 then v.Scale(1/lv); + + result := u*v > 0.999; + end; + + function angle45(prev,cur,next: integer): boolean; + var + u,v: TPointF; + lu,lv,dp: single; + begin + if (prev=-1) or (cur=-1) or (next=-1) then + begin + result :=false; + exit; + end; + u := pointF(points[next].coord.x - points[cur].coord.x, points[next].coord.y - points[cur].coord.y); + lu := sqrt(u*u); + if lu <> 0 then u.Scale(1/lu); + v := pointF(points[cur].coord.x - points[prev].coord.x, points[cur].coord.y - points[prev].coord.y); + lv := sqrt(v*v); + if lv <> 0 then v.Scale(1/lv); + + dp := u*v; + result := (dp > 0.70) and (dp < 0.72); + end; + + procedure RemoveAligned; + var cur,prev,next: integer; + begin + cur := nStart; + prev := -1; + while not points[cur].removed do + begin + next := points[cur].next; + //remove aligned points + if (prev <> -1) and aligned(prev,cur,cur,next) then + RemovePoint(cur) + else + prev := cur; + cur := next; + + if next = nStart then + begin + next := points[cur].next; + if (prev <> -1) and (next <> prev) then + if aligned(prev,cur,cur,next) then + begin + RemovePoint(cur); + nStart := next; + end; + break; //cycle + end; + end; + end; + + procedure MakePolygon(cycle: boolean); + var ptsF: array of TPointF; + nbPtsF: integer; + nb,nb2,cur,i: integer; + begin + cur := nStart; + nb := 0; + nb2 := 0; + repeat + if not points[cur].removed then inc(nb); + inc(nb2); + cur := points[cur].next; + until (cur = -1) or (cur = nStart) or (nb2 > nbPoints); + if (nb2 > nbPoints) or (nb <= 2) then exit; + + setlength(ptsF,nb); + cur := nStart; + nbPtsF := 0; + repeat + with points[cur] do + if not removed then + begin + ptsF[nbPtsF] := pointf(coord.x*factor+offset,coord.y*factor+offset); + points[cur].drawn := true; + inc(nbPtsF); + end; + cur := points[cur].next; + until (cur = -1) or (cur = nStart); + + if cycle then + begin + if polygonF = nil then + polygonF := ptsF else + begin + cur := length(polygonF); + setlength(polygonF, length(polygonF)+length(ptsF)+1); + polygonF[cur] := EmptyPointF; + for i := 0 to high(ptsF) do + begin + inc(cur); + polygonF[cur] := ptsF[i]; + end; + end; + end; + ptsF := nil; + //Bitmap.DrawPolyLineAntialias(ptsF,BGRABlack,1); + end; + + function segabslength(cur,next: integer): integer; + var + tx,ty: integer; + begin + if (cur = -1) or (next = -1) then result := 0 + else + begin + tx := abs(points[next].coord.x - points[cur].coord.x); + ty := abs(points[next].coord.y - points[cur].coord.y); + if tx > ty then result := tx else result := ty; + end; + end; + + function getnext(cur: integer): integer; + begin + result := cur; + if result <> -1 then + begin + repeat + result := points[result].next; + if result = cur then result := -1; + until (result = -1) or not points[result].removed; + end; + end; + + function getprev(cur: integer): integer; + begin + result := cur; + if result <> -1 then + begin + repeat + result := points[result].prev; + if result = cur then result := -1; + until (result = -1) or not points[result].removed; + end; + end; + + procedure NiceLines; + var cur2, next,next2, startIdx, endIdx: integer; + nb: integer; + u: TPoint; + + function SameDirection(p1,p2: integer): boolean; + var + v: TPoint; + begin + v := Point(points[p2].coord.x-points[p1].coord.x, + points[p2].coord.y-points[p1].coord.y); + result := (v.x*u.y - v.y*u.x = 0) and (v.x*u.x + v.y*u.y > 0); + end; + + function GetSide(p1,p2: integer): integer; + var + v: TPoint; + begin + v := Point(points[p2].coord.x-points[p1].coord.x, + points[p2].coord.y-points[p1].coord.y); + result := v.x*u.y - v.y*u.x; + if result < 0 then result := -1 else if result > 0 then result := 1; + end; + + procedure DoNiceLines(DoDiag: boolean); + var cur, nbSegs, i: integer; + isDiag: Boolean; + segs: array of record + p1,p2: TPoint; + abslen: integer; + end; + + begin + for cur := 0 to nb-1 do + if not points[cur].removed and not points[cur].done then + begin + next := getnext(cur); + isDiag := (points[next].coord.x <> points[cur].coord.x) and + (points[next].coord.y <> points[cur].coord.y); + if (segabslength(cur,next) > iUnit) and (DoDiag xor (not isDiag)) then + begin + startIdx := cur; + endIdx := next; + u := Point(points[next].coord.x-points[cur].coord.x, + points[next].coord.y-points[cur].coord.y); + nbsegs := 1; + + if (u.x <> 0) or (u.y <> 0) then + begin + repeat + next := getnext(endIdx); + next2 := getnext(next); + if (next<>startIdx) and (next2<>startIdx) and angle45(getprev(endIdx),endIdx,next) and + (segabslength(endIdx,next) < 2*iUnit) and SameDirection(next,next2) then + begin + endIdx := next2; + inc(nbsegs); + end + else + break; + until false; + + repeat + next := getprev(startIdx); + next2 := getprev(next); + if (next<>endIdx) and (next2<>endIdx) and angle45(getnext(startIdx),startIdx,next) and + (segabslength(startIdx,next) < 2*iUnit) and SameDirection(next2,next) then + begin + startIdx := next2; + inc(nbsegs); + end + else + break; + until false; + + setlength(segs, nbSegs); + cur2 := startIdx; + for i := 0 to nbSegs-1 do + begin + next := getnext(cur2); + segs[i].p1 := points[cur2].coord; + segs[i].p2 := points[next].coord; + segs[i].abslen := segabslength(cur2,next); + points[cur2].done := true; + points[next].done := true; + if cur2 <> startIdx then RemovePoint(cur2); + + if next = endIdx then break + else + begin + cur2 := getnext(next); + RemovePoint(next); + end; + end; + + cur2 := startIdx; + for i := 0 to nbSegs-2 do + begin + if i <> 0 then + cur2 := InsertPoint( (segs[i].p1.x+segs[i].p2.x) div 2, + (segs[i].p1.y+segs[i].p2.y) div 2, + cur2, endIdx); + if abs(segs[i].abslen-segs[i+1].abslen) > iHalf then + cur2 := InsertPoint( (segs[i].p2.x+segs[i+1].p1.x) div 2, + (segs[i].p2.y+segs[i+1].p1.y) div 2, + cur2, endIdx); + end; + end; + end; + end; + end; + + procedure Init; + var cur: integer; + begin + u := Point(0,0); + nb := nbPoints; + for cur := 0 to nb-1 do + points[cur].done := false; + end; + + begin + Init; + DoNiceLines(false); + DoNiceLines(true); + end; + + var cycle: boolean; + begin + //rewind + Rewind(cycle); + RemoveAligned; + if AIntermediateDiagonals then NiceLines; + MakePolygon(cycle); + end; + + function GetBoundsWithin: TRect; + var p: PBGRAPixel; + yb, xb, xb2, maxx, maxy, minx, miny: LongInt; + begin + maxx := ARect.Left-1; + maxy := ARect.Top-1; + minx := ARect.Right; + miny := ARect.Bottom; + for yb := ARect.Top to ARect.Bottom-1 do + begin + p := ASource.ScanLine[yb] + ARect.Left; + for xb := ARect.Left to ARect.Right - 1 do + begin + if CheckPixel(p^) then + begin + if xb < minx then minx := xb; + if yb < miny then miny := yb; + if xb > maxx then maxx := xb; + if yb > maxy then maxy := yb; + + inc(p, ARect.Right-1-xb); + for xb2 := ARect.Right-1 downto xb+1 do + begin + if CheckPixel(p^) then + begin + if xb2 > maxx then maxx := xb2; + break; + end; + dec(p); + end; + break; + end; + Inc(p); + end; + end; + if minx > maxx then Result := EmptyRect + else + begin + Result.left := minx; + Result.top := miny; + Result.right := maxx + 1; + Result.bottom := maxy + 1; + end; + end; + + function IsRectFull: boolean; + var + yb, xb: LongInt; + p: PBGRAPixel; + begin + for yb := ARect.Top to ARect.Bottom-1 do + begin + p := ASource.ScanLine[yb] + ARect.Left; + for xb := ARect.Left to ARect.Right - 1 do + begin + if not CheckPixel(p^) then exit(false); + inc(p); + end; + end; + result := true; + end; + +begin + ARect.Intersect( rect(0,0,ASource.Width,ASource.Height) ); + if ARect.IsEmpty then exit(nil); + ARect := GetBoundsWithin; + if ARect.IsEmpty then exit(nil); + + factor := AZoom; + offset := AZoom*0.5; + if APixelCenteredCoordinates then DecF(Offset, 0.5); + + if IsRectFull then + begin + result := PointsF([PointF((ARect.Left-0.5)*factor+offset, (ARect.Top-0.5)*factor+offset), + PointF((ARect.Left-0.5)*factor+offset, (ARect.Bottom-0.5)*factor+offset), + PointF((ARect.Right-0.5)*factor+offset, (ARect.Bottom-0.5)*factor+offset), + PointF((ARect.Right-0.5)*factor+offset, (ARect.Top-0.5)*factor+offset)]); + exit; + end; + + iDiag := round((ADiagonalFillPercent-50)/100 * iHalf)*2; //even rounding to keep alignment with iOut + iOut := (iHalf-iDiag) div 2; + + nbpoints := 0; + points := nil; + polygonF := nil; + + setlength(ortho,ARect.Height,ARect.Width); + for y := 0 to ARect.Height-1 do + begin + if y = 0 then + pprev := nil + else + pprev := ASource.ScanLine[ARect.Top+y-1]+ARect.Left; + p := ASource.ScanLine[ARect.Top+y]+ARect.Left; + if y = ARect.Height-1 then + pnext := nil + else + pnext := ASource.ScanLine[ARect.Top+y+1]+ARect.Left; + + {$hints off} + fillchar(cur,sizeof(cur),0); + {$hints on} + cur[6] := CheckPixel(p^); inc(p); + if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; + if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; + for x := 0 to ARect.Width-1 do + begin + cur[1] := cur[2]; + cur[2] := cur[3]; + cur[4] := cur[5]; + cur[5] := cur[6]; + cur[7] := cur[8]; + cur[8] := cur[9]; + + if x = ARect.Width-1 then + begin + cur[6]:= false; + cur[9]:= false; + cur[3]:= false; + end else + begin + cur[6] := CheckPixel(p^); inc(p); + if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; + if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; + end; + + ortho[y,x] := (cur[5] and not cur[7] and not cur[9] and not cur[3] and not cur[1]); + if (not cur[5] and (cur[4] xor cur[6]) and (cur[8] xor cur[2]) and + (ord(cur[1])+ord(cur[3])+ord(cur[7])+ord(cur[9]) = 3)) then + begin + if (not cur[6] and not cur[9] and not cur[8] and (CheckPixel(ASource.getPixel(x-1,y-2)) or CheckPixel(ASource.getPixel(x+2,y+1).green)) ) or + (not cur[8] and not cur[7] and not cur[4] and (CheckPixel(ASource.getPixel(x-2,y+1)) or CheckPixel(ASource.getPixel(x+1,y-2).green)) ) or + (not cur[4] and not cur[1] and not cur[2] and (CheckPixel(ASource.getPixel(x+1,y+2)) or CheckPixel(ASource.getPixel(x-2,y-1).green)) ) or + (not cur[2] and not cur[3] and not cur[6] and (CheckPixel(ASource.getPixel(x-1,y+2)) or CheckPixel(ASource.getPixel(x+2,y-1).green)) ) then + ortho[y,x] := true; + end; + { or + (cur[5] and cur[4] and cur[6] and cur[2] and cur[8] and (Ord(cur[1])+ord(cur[3])+ord(cur[7])+ord(cur[9]) = 3))}; + //if ortho[y,x] then AddPoint(x shl unitShift,y shl unitShift,-1,-1); + end; + end; + + PointsCurrentLineStart := nbPoints; + for y := 0 to ARect.Height-1 do + begin + iy := (y+ARect.Top) shl unitShift; + + PointsPreviousLineStart := PointsCurrentLineStart; + PointsCurrentLineStart := nbPoints; + if y = 0 then + pprev := nil + else + pprev := ASource.ScanLine[ARect.Top+y-1]+ARect.Left; + p := ASource.ScanLine[ARect.Top+y]+ARect.Left; + if y = ARect.Height-1 then + pnext := nil + else + pnext := ASource.ScanLine[ARect.Top+y+1]+ARect.Left; + + {$hints off} + fillchar(cur,sizeof(cur),0); + {$hints on} + cur[6] := CheckPixel(p^); inc(p); + if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; + if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; + ix := ARect.Left shl unitShift; + for x := 0 to ARect.Width-1 do + begin + cur[1] := cur[2]; + cur[2] := cur[3]; + cur[4] := cur[5]; + cur[5] := cur[6]; + cur[7] := cur[8]; + cur[8] := cur[9]; + + if x = ARect.Width-1 then + begin + cur[6]:= false; + cur[9]:= false; + cur[3]:= false; + end else + begin + cur[6] := CheckPixel(p^); inc(p); + if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; + if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; + end; + + if cur[5] then + begin + if not cur[1] and not cur[2] and not cur[3] and not cur[4] and not cur[6] and not cur[7] and not cur[8] and not cur[9] then + begin + if iDiag > 0 then + begin + AddLine(ix-iHalf,iy-iDiag,ix-iDiag,iy-iHalf,ix+iDiag,iy-iHalf,ix+iHalf,iy-iDiag,ix+iHalf,iy+iDiag); + AddLine(ix+iHalf,iy+iDiag,ix+iDiag,iy+iHalf,ix-iDiag,iy+iHalf,ix-iHalf,iy+iDiag,ix-iHalf,iy-iDiag); + end else + begin + AddLine(ix-iHalf,iy,ix,iy-iHalf,ix+iHalf,iy); + AddLine(ix+iHalf,iy,ix,iy+iHalf,ix-iHalf,iy); + end; + end else + if cur[6] and not cur[9] and not cur[8] then + begin + if cur[7] then + begin + if not ortho[y-1,x] then + begin + if ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix+iHalf,iy-iHalf,ix+iDiag,iy-iHalf,ix-iOut,iy-iUnit+iOut); + end; + end else + if cur[4] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + if cur[1] then AddLine(ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) else + if cur[2] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + if cur[3] then + begin + if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) + end else + AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf); + end; + if cur[8] and not cur[7] and not cur[4] then + begin + if cur[1] then + begin + if not ortho[y,x-1] then + begin + if ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy-iDiag,ix-iUnit+iOut,iy+iOut); + end; + end else + if cur[2] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + if cur[3] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) else + if cur[6] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + if cur[9] then + begin + if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) + end else + AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf); + end; + if cur[4] and not cur[1] and not cur[2] then + begin + if cur[3] then + begin + if not ortho[y+1,x] then + begin + if ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix-iHalf,iy+iHalf,ix-iDiag,iy+iHalf,ix+iOut,iy+iUnit-iOut); + end; + end else + if cur[6] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + if cur[9] then AddLine(ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) else + if cur[8] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + if cur[7] then + begin + if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) + end else + AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf); + end; + if cur[2] and not cur[3] and not cur[6] then + begin + if cur[9] then + begin + if not ortho[y,x+1] then + begin + if ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy+iDiag,ix+iUnit-iOut,iy-iOut); + end; + end else + if cur[8] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + if cur[7] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) else + if cur[4] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + if cur[1] then + begin + if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix-iHalf,iy+iHalf) else + AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) + end else + AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf); + end; + + if cur[3] and not cur[6] then + begin + if cur[9] then + begin + if ortho[y+1,x] and ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + if ortho[y+1,x] and not ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy+iDiag,ix+iUnit-iOut,iy-iOut) else + if not ortho[y+1,x] and ortho[y-1,x] then AddLine(ix+iUnit-iOut,iy+iOut,ix+iHalf,iy-iDiag,ix+iHalf,iy-iHalf) else + AddLine(ix+iUnit-iOut,iy+iOut,ix+iUnit-iOut*2,iy,ix+iUnit-iOut,iy-iOut); + end else + if cur[8] then + begin + if not ortho[y,x+1] then + if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + AddLine(ix+iUnit-iOut,iy+iOut,ix+iHalf,iy-iDiag,ix+iHalf,iy-iHalf) + end else + if cur[7] then + begin + if ortho[y+1,x] and ortho[y,x-1] then + AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + if ortho[y+1,x] and not ortho[y,x-1] then + AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) else + if not ortho[y+1,x] and ortho[y,x-1] then + AddLine(ix+iUnit-iOut,iy+iOut, ix+iDiag,iy-iHalf, ix-iHalf,iy-iHalf) else + AddLine(ix+iUnit-iOut,iy+iOut,ix-iOut,iy-iUnit+iOut) + end else + if cur[4] then AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf) else + if cur[1] then + begin + if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut); + end else + if cur[2] then + begin + if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf); + end else + AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut); + end; + + if cur[9] and not cur[8] then + begin + if cur[7] then + begin + if ortho[y,x+1] and ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + if ortho[y,x+1] and not ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix+iDiag,iy-iHalf,ix-iOut,iy-iUnit+iOut) else + if not ortho[y,x+1] and ortho[y,x-1] then AddLine(ix+iOut,iy-iUnit+iOut,ix-iDiag,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix+iOut,iy-iUnit+iOut,ix,iy-iUnit+iOut*2,ix-iOut,iy-iUnit+iOut); + end else + if cur[4] then + begin + if not ortho[y-1,x] then + if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix+iOut,iy-iUnit+iOut,ix-iDiag,iy-iHalf,ix-iHalf,iy-iHalf) + end else + if cur[1] then + begin + if ortho[y,x+1] and ortho[y+1,x] then + AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + if ortho[y,x+1] and not ortho[y+1,x] then + AddLine(ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) else + if not ortho[y,x+1] and ortho[y+1,x] then + AddLine(ix+iOut,iy-iUnit+iOut, ix-iHalf,iy-iDiag, ix-iHalf,iy+iHalf) else + AddLine(ix+iOut,iy-iUnit+iOut,ix-iUnit+iOut,iy+iOut) + end else + if cur[2] then AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf) else + if cur[3] then + begin + if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut); + end else + if cur[6] then + begin + if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf); + end else + AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut); + end; + + if cur[7] and not cur[4] then + begin + if cur[1] then + begin + if ortho[y-1,x] and ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + if ortho[y-1,x] and not ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy-iDiag,ix-iUnit+iOut,iy+iOut) else + if not ortho[y-1,x] and ortho[y+1,x] then AddLine(ix-iUnit+iOut,iy-iOut,ix-iHalf,iy+iDiag,ix-iHalf,iy+iHalf) else + AddLine(ix-iUnit+iOut,iy-iOut,ix-iUnit+iOut*2,iy,ix-iUnit+iOut,iy+iOut); + end else + if cur[2] then + begin + if not ortho[y,x-1] then + if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else + AddLine(ix-iUnit+iOut,iy-iOut,ix-iHalf,iy+iDiag,ix-iHalf,iy+iHalf) + end else + if cur[3] then + begin + if ortho[y-1,x] and ortho[y,x+1] then + AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + if ortho[y-1,x] and not ortho[y,x+1] then + AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) else + if not ortho[y-1,x] and ortho[y,x+1] then + AddLine(ix-iUnit+iOut,iy-iOut, ix-iDiag,iy+iHalf, ix+iHalf,iy+iHalf) else + AddLine(ix-iUnit+iOut,iy-iOut,ix+iOut,iy+iUnit-iOut) + end else + if cur[6] then AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf) else + if cur[9] then + begin + if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut); + end else + if cur[8] then + begin + if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf); + end else + AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut); + end; + + if cur[1] and not cur[2] then + begin + if cur[3] then + begin + if ortho[y,x-1] and ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + if ortho[y,x-1] and not ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix-iDiag,iy+iHalf,ix+iOut,iy+iUnit-iOut) else + if not ortho[y,x-1] and ortho[y,x+1] then AddLine(ix-iOut,iy+iUnit-iOut,ix+iDiag,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix-iOut,iy+iUnit-iOut,ix,iy+iUnit-iOut*2,ix+iOut,iy+iUnit-iOut); + end else + if cur[6] then + begin + if not ortho[y+1,x] then + if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else + AddLine(ix-iOut,iy+iUnit-iOut,ix+iDiag,iy+iHalf,ix+iHalf,iy+iHalf) + end else + if cur[9] then + begin + if ortho[y,x-1] and ortho[y-1,x] then + AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else + if ortho[y,x-1] and not ortho[y-1,x] then + AddLine(ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) else + if not ortho[y,x-1] and ortho[y-1,x] then + AddLine(ix-iOut,iy+iUnit-iOut, ix+iHalf,iy+iDiag, ix+iHalf,iy-iHalf) else + AddLine(ix-iOut,iy+iUnit-iOut,ix+iUnit-iOut,iy-iOut) + end else + if cur[8] then AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf) else + if cur[7] then + begin + if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut); + end else + if cur[4] then + begin + if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else + AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf); + end else + AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut); + end; + end else + if ortho[y,x] then + begin + if not cur[9] then AddLine(ix+iHalf,iy+iHalf,ix-iHalf,iy+iHalf,ix-iHalf,iy-iHalf) else + if not cur[7] then AddLine(ix+iHalf,iy-iHalf,ix+iHalf,iy+iHalf,ix-iHalf,iy+iHalf) else + if not cur[1] then AddLine(ix-iHalf,iy-iHalf,ix+iHalf,iy-iHalf,ix+iHalf,iy+iHalf) else + if not cur[3] then AddLine(ix-iHalf,iy+iHalf,ix-iHalf,iy-iHalf,ix+iHalf,iy-iHalf); + end; + inc(ix,iUnit); + end; + end; + + factor := factor / iUnit; + + for n := 0 to nbPoints-1 do + with points[n] do + if not drawn and not removed then + AddPolygon(n); + + result := polygonF; +end; + +function VectorizeMonochrome(ASource: TBGRACustomBitmap; + AZoom: single; APixelCenteredCoordinates: boolean; AWhiteBackground: boolean; + ADiagonalFillPercent: single; AIntermediateDiagonals: boolean): ArrayOfTPointF; +begin + result := VectorizeMonochrome(ASource, rect(0,0,ASource.Width,ASource.Height), AZoom, APixelCenteredCoordinates, + AWhiteBackground, ADiagonalFillPercent, AIntermediateDiagonals); +end; + +{ TBGRAVectorizedFontRenderer } + +function TBGRAVectorizedFontRenderer.OutlineActuallyVisible: boolean; +begin + result := OutlineVisible and (abs(OutlineWidth) > 0) and (OutlineColor.Alpha <> 0) or (OutlineTexture <> nil); +end; + +procedure TBGRAVectorizedFontRenderer.UpdateFont; +var i,neededResolution: integer; +begin + FVectorizedFont := nil; + FontName := Trim(FontName); + for i := 0 to high(FVectorizedFontArray) do + if (CompareText(FVectorizedFontArray[i].FontName,FontName)=0) and + (FVectorizedFontArray[i].FontStyle = FontStyle) then + begin + FVectorizedFont := FVectorizedFontArray[i].VectorizedFont; + break; + end; + + if FVectorizedFont = nil then + begin + FVectorizedFont:= TBGRAVectorizedFont.Create(False); + FVectorizedFont.Name := FontName; + FVectorizedFont.Style := FontStyle - [fsUnderline]; + FVectorizedFont.UnderlineDecoration := fsUnderline in FontStyle; + FVectorizedFont.Directory := FDirectoryUTF8; + if not FVectorizedFont.FontFound and SystemFontAvailable then + begin + FVectorizedFont.VectorizeLCL := True; + FVectorizedFont.Name := TBGRASystemFontRenderer.PatchSystemFontName(FontName); + end; + Setlength(FVectorizedFontArray,length(FVectorizedFontArray)+1); + FVectorizedFontArray[high(FVectorizedFontArray)].FontName := FontName; + FVectorizedFontArray[high(FVectorizedFontArray)].FontStyle := FontStyle; + FVectorizedFontArray[high(FVectorizedFontArray)].VectorizedFont := FVectorizedFont; + end; + if FontEmHeight > 0 then + FVectorizedFont.EmHeight := FontEmHeightF + else + FVectorizedFont.FullHeight:= -FontEmHeightF; + if OutlineActuallyVisible then + begin + if OuterOutlineOnly then + FVectorizedFont.OutlineMode := twoFillOverStroke + else + FVectorizedFont.OutlineMode := twoStrokeOverFill; + end + else FVectorizedFont.OutlineMode := twoFill; + FVectorizedFont.QuadraticCurves := (FVectorizedFont.FullHeight > FVectorizedFont.Resolution*1.2) and QuadraticCurves; + if FVectorizedFont.VectorizeLCL then + begin + neededResolution := trunc((FVectorizedFont.FullHeight+80)/50)*50; + if neededResolution < MinFontResolution then neededResolution := MinFontResolution; + if neededResolution > MaxFontResolution then neededResolution := MaxFontResolution; + if FVectorizedFont.Resolution < neededResolution then FVectorizedFont.Resolution:= neededResolution; + end; +end; + +function TBGRAVectorizedFontRenderer.GetCanvas2D(ASurface: TBGRACustomBitmap + ): TBGRACanvas2D; +begin + if (FCanvas2D = nil) or (FCanvas2D.surface <> ASurface) then + begin + FCanvas2D.Free; + FCanvas2D := TBGRACanvas2D.Create(ASurface); + end; + result := FCanvas2D; + FCanvas2D.antialiasing:= FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]; + FCanvas2D.lineJoinLCL := OutlineJoin; + if OutlineTexture <> nil then + FCanvas2D.strokeStyle(OutlineTexture) + else + FCanvas2D.strokeStyle(OutlineColor); + if abs(OutlineWidth) < 3 then + FCanvas2D.lineWidth := abs(OutlineWidth)*2/3 + else + FCanvas2D.lineWidth := abs(OutlineWidth)-1; + if not ShadowVisible then + FCanvas2D.shadowColor(BGRAPixelTransparent) + else + begin + FCanvas2D.shadowColor(ShadowColor); + FCanvas2D.shadowBlur:= ShadowRadius; + FCanvas2D.shadowOffset := PointF(ShadowOffset.X,ShadowOffset.Y); + end; +end; + +procedure TBGRAVectorizedFontRenderer.InternalTextRect( + ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; + style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner); +var + twAlign : TBGRATypeWriterAlignment; + c2D: TBGRACanvas2D; + intersectedClip,previousClip: TRect; +begin + previousClip := ADest.ClipRect; + if style.Clipping then + begin + intersectedClip := TRect.Intersect(previousClip, ARect); + if intersectedClip.IsEmpty then exit; + ADest.ClipRect := intersectedClip; + end; + UpdateFont; + if style.RightToLeft then + FVectorizedFont.BidiMode := fbmRightToLeft + else + FVectorizedFont.BidiMode := fbmLeftToRight; + FVectorizedFont.Orientation := 0; + case style.Alignment of + taCenter: case style.Layout of + tlCenter: twAlign := twaMiddle; + tlBottom: twAlign := twaBottom; + else twAlign:= twaTop; + end; + taRightJustify: + case style.Layout of + tlCenter: twAlign := twaRight; + tlBottom: twAlign := twaBottomRight; + else twAlign := twaTopRight; + end; + else + case style.Layout of + tlCenter: twAlign := twaLeft; + tlBottom: twAlign := twaBottomLeft; + else twAlign:= twaTopLeft; + end; + end; + c2D := GetCanvas2D(ADest); + if texture = nil then + c2D.fillStyle(c) + else + c2D.fillStyle(texture); + if style.Wordbreak then + FVectorizedFont.DrawTextRect(c2D, sUTF8, x-0.5,y-0.5,ARect.Right-0.5,ARect.Bottom-0.5, twAlign) + else + begin + case style.Layout of + tlCenter: y := (ARect.Top+ARect.Bottom) div 2; + tlBottom: y := ARect.Bottom; + end; + case style.Alignment of + taCenter: FVectorizedFont.DrawText(c2D, sUTF8, (ARect.Left+ARect.Right-1)/2,y-0.5, twAlign); + taRightJustify: FVectorizedFont.DrawText(c2D, sUTF8, ARect.Right-0.5,y-0.5, twAlign); + else + FVectorizedFont.DrawText(c2D, sUTF8, x-0.5,y-0.5, twAlign); + end; + end; + if style.Clipping then + ADest.ClipRect := previousClip; +end; + +procedure TBGRAVectorizedFontRenderer.InternalCopyTextPathTo(ADest: IBGRAPath; + x, y: single; s: string; align: TAlignment; ABidiMode: TFontBidiMode); +var + twAlign : TBGRATypeWriterAlignment; + ofs: TPointF; +begin + UpdateFont; + FVectorizedFont.BidiMode := ABidiMode; + FVectorizedFont.Orientation := 0; + case align of + taCenter: twAlign:= twaMiddle; + taRightJustify: twAlign := twaRight; + else twAlign:= twaLeft; + end; + ofs := PointF(x,y); + ofs.Offset(0, FVectorizedFont.FullHeight*0.5); + FVectorizedFont.CopyTextPathTo(ADest, s, ofs.x,ofs.y, twAlign); +end; + +procedure TBGRAVectorizedFontRenderer.InternalTextOutAngle( + ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; + c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; + ABidiMode: TFontBidiMode); +var + twAlign : TBGRATypeWriterAlignment; + c2D: TBGRACanvas2D; + ofs: TPointF; +begin + UpdateFont; + FVectorizedFont.Orientation := orientation; + FVectorizedFont.BidiMode := ABidiMode; + case align of + taCenter: twAlign:= twaMiddle; + taRightJustify: twAlign := twaRight; + else twAlign:= twaLeft; + end; + c2D := GetCanvas2D(ADest); + if Assigned(texture) then + c2D.fillStyle(texture) + else + c2D.fillStyle(c); + ofs := PointF(x,y); + ofs.Offset( AffineMatrixRotationDeg(-orientation*0.1)*PointF(0,FVectorizedFont.FullHeight*0.5) ); + FVectorizedFont.DrawText(c2D, s, ofs.x,ofs.y, twAlign); +end; + +procedure TBGRAVectorizedFontRenderer.Init; +begin + FVectorizedFontArray := nil; + FDirectoryUTF8 := ''; + + OutlineVisible:= True; + OutlineColor := BGRAPixelTransparent; + OuterOutlineOnly := false; + OutlineJoin := pjsMiter; + + ShadowColor := BGRABlack; + ShadowVisible := false; + ShadowOffset := Point(5,5); + ShadowRadius := 5; + + MaxFontResolution := 300; +end; + +constructor TBGRAVectorizedFontRenderer.Create; +begin + Init; +end; + +constructor TBGRAVectorizedFontRenderer.Create(ADirectoryUTF8: string); +begin + Init; + FDirectoryUTF8 := ADirectoryUTF8; +end; + +function TBGRAVectorizedFontRenderer.GetFontPixelMetric: TFontPixelMetric; +var factor: single; +begin + UpdateFont; + result := FVectorizedFont.FontPixelMetric; + if FVectorizedFont.Resolution > 0 then + begin + factor := FVectorizedFont.FullHeight/FVectorizedFont.Resolution; + result.Baseline := round(result.Baseline*factor); + result.CapLine := round(result.CapLine*factor); + result.Lineheight := round(result.Lineheight*factor); + result.DescentLine := round(result.DescentLine*factor); + result.xLine := round(result.xLine*factor); + end; +end; + +function TBGRAVectorizedFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; +var factor: single; + fpm: TFontPixelMetric; +begin + UpdateFont; + fpm := FVectorizedFont.FontPixelMetric; + result.Defined := fpm.Defined; + if FVectorizedFont.Resolution > 0 then + factor := FVectorizedFont.FullHeight/FVectorizedFont.Resolution + else factor := 1; + result.Baseline := fpm.Baseline*factor; + result.CapLine := fpm.CapLine*factor; + result.Lineheight := fpm.Lineheight*factor; + result.DescentLine := fpm.DescentLine*factor; + result.xLine := fpm.xLine*factor; +end; + +function TBGRAVectorizedFontRenderer.FontExists(AName: string): boolean; +var + i: Integer; +begin + {$IFDEF LCL} + for i := 0 to Screen.Fonts.Count-1 do + if CompareText(Screen.Fonts[i], AName) = 0 then exit(true); + result := false; + {$ELSE} + result := true; + {$ENDIF} +end; + +procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); +begin + InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmAuto); +end; + +procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment; + ARightToLeft: boolean); +begin + if ARightToLeft then + InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmRightToLeft) + else + InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmLeftToRight); +end; + +procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; texture: IBGRAScanner; + align: TAlignment); +begin + InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmAuto); +end; + +procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, + y: single; orientation: integer; s: string; texture: IBGRAScanner; + align: TAlignment; ARightToLeft: boolean); +begin + if ARightToLeft then + InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmRightToLeft) + else + InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmLeftToRight); +end; + +procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; texture: IBGRAScanner; align: TAlignment); +begin + TextOutAngle(ADest,x,y,FontOrientation,s,texture,align); +end; + +procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; texture: IBGRAScanner; align: TAlignment; + ARightToLeft: boolean); +begin + TextOutAngle(ADest,x,y,FontOrientation,s,texture,align,ARightToLeft); +end; + +procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; c: TBGRAPixel; align: TAlignment); +begin + TextOutAngle(ADest,x,y,FontOrientation,s,c,align); +end; + +procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, + y: single; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); +begin + TextOutAngle(ADest,x,y,FontOrientation,s,c,align,ARightToLeft); +end; + +procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap; + ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); +begin + InternalTextRect(ADest,ARect,x,y,s,style,c,nil); +end; + +procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap; + ARect: TRect; x, y: integer; s: string; style: TTextStyle; + texture: IBGRAScanner); +begin + InternalTextRect(ADest,ARect,x,y,s,style,BGRAPixelTransparent,texture); +end; + +procedure TBGRAVectorizedFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); +begin + InternalCopyTextPathTo(ADest, x,y, s, align, fbmAuto); +end; + +procedure TBGRAVectorizedFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, + y: single; s: string; align: TAlignment; ARightToLeft: boolean); +begin + if ARightToLeft then + InternalCopyTextPathTo(ADest, x,y, s, align, fbmRightToLeft) + else + InternalCopyTextPathTo(ADest, x,y, s, align, fbmLeftToRight); +end; + +function TBGRAVectorizedFontRenderer.HandlesTextPath: boolean; +begin + Result:= true; +end; + +function TBGRAVectorizedFontRenderer.TextSize(sUTF8: string): TSize; +var sizeF: TPointF; +begin + sizeF := TextSizeF(sUTF8); + result.cx := round(sizeF.x); + result.cy := round(sizeF.y); +end; + +function TBGRAVectorizedFontRenderer.TextSizeF(sUTF8: string): TPointF; +begin + UpdateFont; + FVectorizedFont.BidiMode := fbmAuto; + result := FVectorizedFont.GetTextSize(sUTF8); +end; + +function TBGRAVectorizedFontRenderer.TextSize(sUTF8: string; + AMaxWidth: integer; ARightToLeft: boolean): TSize; +begin + with TextSizeF(sUTF8, AMaxWidth, ARightToLeft) do + result := Size(system.Round(x),system.Round(y)); +end; + +function TBGRAVectorizedFontRenderer.TextSizeF(sUTF8: string; + AMaxWidthF: single; ARightToLeft: boolean): TPointF; +var + remains: string; + w,h: single; +begin + UpdateFont; + FVectorizedFont.BidiMode := fbmAuto; + result.x := 0; + result.y := 0; + h := FVectorizedFont.FullHeight; + repeat + FVectorizedFont.SplitText(sUTF8, AMaxWidthF, remains); + w := FVectorizedFont.GetTextSize(sUTF8).x; + if w > result.x then result.x := w; + IncF(result.y, h); + sUTF8 := remains; + until remains = ''; +end; + +function TBGRAVectorizedFontRenderer.TextFitInfo(sUTF8: string; + AMaxWidth: integer): integer; +begin + UpdateFont; + FVectorizedFont.BidiMode := fbmAuto; + result := FVectorizedFont.TextFitInfo(sUTF8, AMaxWidth); +end; + +function TBGRAVectorizedFontRenderer.TextFitInfoF(sUTF8: string; + AMaxWidthF: single): integer; +begin + UpdateFont; + FVectorizedFont.BidiMode := fbmAuto; + result := FVectorizedFont.TextFitInfo(sUTF8, AMaxWidthF); +end; + +destructor TBGRAVectorizedFontRenderer.Destroy; +var i: integer; +begin + FCanvas2D.Free; + for i := 0 to high(FVectorizedFontArray) do + FVectorizedFontArray[i].VectorizedFont.Free; + FVectorizedFontArray := nil; + inherited Destroy; +end; + +{ TBGRAVectorizedFont } + +procedure TBGRAVectorizedFont.SetResolution(AValue: integer); +begin + if FResolution=AValue then Exit; + FResolution:=AValue; + UpdateFont; +end; + +procedure TBGRAVectorizedFont.SetOrientation(AValue: single); +begin + if FOrientation=AValue then Exit; + FOrientation:=AValue; + UpdateMatrix; +end; + +procedure TBGRAVectorizedFont.SetItalicSlope(AValue: single); +begin + if FItalicSlope=AValue then Exit; + FItalicSlope:=AValue; + UpdateMatrix; +end; + +procedure TBGRAVectorizedFont.SetLCLHeight(AValue: single); +begin + if (AValue > 0) xor (FontEmHeightSign < 0) then + EmHeight := abs(AValue) + else + FullHeight := abs(AValue); +end; + +function TBGRAVectorizedFont.GetEmHeight: single; +begin + result := FullHeight * FontEmHeightRatio; +end; + +function TBGRAVectorizedFont.GetFontPixelMetric: TFontPixelMetric; +begin + if not FFontPixelMetricComputed and (FFont <> nil) then + begin + FFontPixelMetric := BGRAText.GetLCLFontPixelMetric(FFont); + FFontPixelMetricComputed := true; + end; + result := FFontPixelMetric; +end; + +function TBGRAVectorizedFont.GetLCLHeight: single; +begin + result := FullHeight * FontFullHeightSign; +end; + +function TBGRAVectorizedFont.GetVectorizeLCL: boolean; +begin + result := FFont <> nil; +end; + +procedure TBGRAVectorizedFont.GlyphCallbackForGlyphSizes(ATextUTF8: string; AGlyph: TBGRAGlyph; + AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); +begin + with TGlyphSizesCallbackData(AData^) do + begin + if Count = length(Sizes) then + setlength(Sizes, 2*Count+1); + Sizes[Count].Text := ATextUTF8; + if AGlyph<>nil then + begin + Sizes[Count].Glyph:= AGlyph.Identifier; + Sizes[Count].Width:= AGlyph.Width*FullHeight; + Sizes[Count].Height:= AGlyph.Height*FullHeight; + end else + begin + Sizes[Count].Glyph:= ''; + Sizes[Count].Width:= 0; + Sizes[Count].Height:= 0; + end; + inc(Count); + end; + AContinue:= true; +end; + +procedure TBGRAVectorizedFont.UpdateQuadraticCallback(ATextUTF8: string; + AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); +begin + if AGlyph is TBGRAPolygonalGlyph then + TBGRAPolygonalGlyph(AGlyph).QuadraticCurves:= FQuadraticCurves; + AContinue := true; +end; + +procedure TBGRAVectorizedFont.SetEmHeight(AValue: single); +begin + if FontEmHeightRatio > 0 then + FullHeight := AValue / FontEmHeightRatio; +end; + +procedure TBGRAVectorizedFont.SetQuadraticCurves(AValue: boolean); +begin + if FQuadraticCurves=AValue then Exit; + FQuadraticCurves:=AValue; + BrowseAllGlyphs(@UpdateQuadraticCallback, nil); +end; + +procedure TBGRAVectorizedFont.SetFontMatrix(AValue: TAffineMatrix); +begin + FFontMatrix:=AValue; + UpdateMatrix; +end; + +procedure TBGRAVectorizedFont.SetFullHeight(AValue: single); +begin + if FFullHeight=AValue then Exit; + FFullHeight:=AValue; + UpdateMatrix; +end; + +procedure TBGRAVectorizedFont.SetName(AValue: string); +begin + if FName=AValue then Exit; + FName:=AValue; + UpdateFont; +end; + +procedure TBGRAVectorizedFont.SetStyle(AValue: TFontStyles); +begin + if FStyle=AValue then Exit; + FStyle:=AValue; + UpdateFont; + SubstituteBidiBracket:= fsItalic in AValue; +end; + +function TBGRAVectorizedFont.GetFontEmHeightRatio: single; +var + lEmHeight, lFullHeight: single; + OldHeight: integer; +begin + if not FFontEmHeightRatioComputed then + begin + if FFont <> nil then + begin + OldHeight := FFont.Height; + FFont.Height := FontEmHeightSign * 100; + lEmHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy; + FFont.Height := FixSystemFontFullHeight(FFont.Name, FontFullHeightSign * 100); + lFullHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy; + if lEmHeight = 0 then + FFontEmHeightRatio := 1 + else + FFontEmHeightRatio := lFullHeight/lEmHeight; + FFontEmHeightRatioComputed := true; + FFont.Height := OldHeight; + end else + begin + result := 1; + exit; + end; + end; + result := FFontEmHeightRatio; +end; + +procedure TBGRAVectorizedFont.SetVectorizeLCL(AValue: boolean); +begin + if AValue then + begin + if FFont = nil then + FFont := TFont.Create; + end else + begin + if FFont <> nil then + FreeAndNil(FFont); + end; + UpdateFont; +end; + +procedure TBGRAVectorizedFont.UpdateFont; +var i: integer; + bestIndex, bestDistance: integer; + distance: integer; +begin + if FFont <> nil then + begin + ClearGlyphs; + FFont.Name := TBGRASystemFontRenderer.PatchSystemFontName(FName); + FFont.Style := FStyle; + FFont.Height := FixSystemFontFullHeight(FFont.Name, FontFullHeightSign * FResolution); + FFont.Quality := fqNonAntialiased; + FFontEmHeightRatio := 1; + FFontEmHeightRatioComputed := false; + fillchar(FFontPixelMetric,sizeof(FFontPixelMetric),0); + FFontPixelMetricComputed := false; + FFontFound := True; + end else + begin + bestIndex := -1; + bestDistance := 1000; + for i := 0 to high(FDirectoryContent) do + begin + if CompareText(FDirectoryContent[i].FontName,FName) = 0 then + begin + distance := 0; + if (fsBold in FDirectoryContent[i].FontStyle) xor (fsBold in FStyle) then inc(distance, 10); + if (fsItalic in FDirectoryContent[i].FontStyle) xor (fsItalic in FStyle) then inc(distance, 5); + if (fsStrikeOut in FDirectoryContent[i].FontStyle) xor (fsStrikeOut in FStyle) then inc(distance, 1); + if (fsUnderline in FDirectoryContent[i].FontStyle) xor (fsUnderline in FStyle) then inc(distance, 1); + if (bestIndex = -1) or (distance < bestDistance) then + begin + bestIndex := i; + bestDistance := distance; + if FDirectoryContent[i].FontStyle = FStyle then break; + end; + end; + end; + if bestIndex <> -1 then + begin + if not (fsItalic in FDirectoryContent[bestIndex].FontStyle) and (fsItalic in FStyle) then + ItalicSlope := 0.25 + else if (fsItalic in FDirectoryContent[bestIndex].FontStyle) and not (fsItalic in FStyle) then + ItalicSlope := -0.25 + else + ItalicSlope := 0; + + UnderlineDecoration := not (fsUnderline in FDirectoryContent[bestIndex].FontStyle) and (fsUnderline in FStyle); + StrikeOutDecoration := not (fsStrikeOut in FDirectoryContent[bestIndex].FontStyle) and (fsStrikeOut in FStyle); + + ClearGlyphs; + LoadGlyphsFromFile(FDirectoryContent[bestIndex].Filename); + FFontFound := True; + end else + FFontFound := false; + end; +end; + +procedure TBGRAVectorizedFont.UpdateMatrix; +begin + TypeWriterMatrix := FFontMatrix*AffineMatrixRotationDeg(-Orientation*0.1)*AffineMatrixScale(FFullHeight,FFullHeight)*AffineMatrixLinear(PointF(1,0),PointF(-FItalicSlope,1)); +end; + +constructor TBGRAVectorizedFont.Create; +begin + inherited Create; + Init(True); +end; + +constructor TBGRAVectorizedFont.Create(AVectorizeLCL: boolean); +begin + inherited Create; + Init(AVectorizeLCL); +end; + +destructor TBGRAVectorizedFont.Destroy; +begin + FFont.Free; + FBuffer.Free; + inherited Destroy; +end; + +function TBGRAVectorizedFont.GetGlyphSize(AIdentifier: string): TPointF; +var g: TBGRAGlyph; +begin + g := GetGlyph(AIdentifier); + if g = nil then result := EmptyPointF else + result := PointF(g.Width*FullHeight,g.Height*FullHeight); +end; + +function TBGRAVectorizedFont.GetTextGlyphSizes(ATextUTF8: string): TGlyphSizes; +var + data: TGlyphSizesCallbackData; +begin + data.Count:= 0; + setlength(data.Sizes, UTF8Length(ATextUTF8)); + BrowseGlyphs(ATextUTF8, @GlyphCallbackForGlyphSizes, @data, false); + setlength(data.Sizes, data.Count); + result := data.Sizes; +end; + +function TBGRAVectorizedFont.GetTextSize(ATextUTF8: string): TPointF; +begin + result := GetTextSizeBeforeTransform(ATextUTF8)*FullHeight; +end; + +function TBGRAVectorizedFont.TextFitInfo(ATextUTF8: string; AMaxWidth: single): integer; +var + charCount, byteCount: integer; + usedWidth: single; +begin + if FullHeight=0 then result := UTF8Length(ATextUTF8) else + begin + TextFitInfoBeforeTransform(ATextUTF8, AMaxWidth/FullHeight, charCount, byteCount, usedWidth); + result := charCount; + end; +end; + +procedure TBGRAVectorizedFont.SplitText(var ATextUTF8: string; AMaxWidth: single; + out ARemainsUTF8: string); +var + pstr: pchar; + p,left,charlen: integer; + totalWidth: single; + firstChar: boolean; + nextchar: string; + g: TBGRAGlyph; +begin + totalWidth := 0; + if ATextUTF8 = '' then + begin + ARemainsUTF8 := ''; + exit; + end else + begin + p := 1; + pstr := @ATextUTF8[1]; + left := length(ATextUTF8); + firstChar := true; + while left > 0 do + begin + if RemoveLineEnding(ATextUTF8,p) then + begin + ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + exit; + end; + + charlen := UTF8CharacterLength(pstr); + setlength(nextchar, charlen); + move(pstr^, nextchar[1], charlen); + inc(pstr,charlen); + + g := GetGlyph(nextchar); + if g <> nil then + begin + IncF(totalWidth, g.Width*FullHeight); + if not firstChar and (totalWidth > AMaxWidth) then + begin + ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); + ATextUTF8 := copy(ATextUTF8,1,p-1); + if Assigned(FWordBreakHandler) then + FWordBreakHandler(ATextUTF8,ARemainsUTF8) else + DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8); + exit; + end; + end; + + dec(left,charlen); + inc(p,charlen); + firstChar := false; + end; + end; + ARemainsUTF8 := ''; //no split +end; + +procedure TBGRAVectorizedFont.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X, + Y: Single; AAlign: TBGRATypeWriterAlignment); +var underlinePoly: ArrayOfTPointF; + m: TAffineMatrix; + i: integer; + deltaY: single; +begin + inherited DrawText(ADest, ATextUTF8, X, Y, AAlign); + if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else + if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else + deltaY := 0; + if UnderlineDecoration and (Resolution > 0) then + begin + underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, + (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution); + if underlinePoly <> nil then + begin + m := GetTextMatrix(ATextUTF8, X,Y,AAlign); + for i := 0 to high(underlinePoly) do + underlinePoly[i] := m*underlinePoly[i]; + if OutlineMode <> twoPath then ADest.beginPath; + ADest.moveTo(m*underlinePoly[high(underlinePoly)]); + for i := high(underlinePoly)-1 downto 0 do + ADest.lineTo(m*underlinePoly[i]); + DrawLastPath(ADest); + end; + end; + if StrikeOutDecoration and (Resolution > 0) then + begin + underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, + (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution); + if underlinePoly <> nil then + begin + m := GetTextMatrix(ATextUTF8, X,Y,AAlign); + for i := 0 to high(underlinePoly) do + underlinePoly[i] := m*underlinePoly[i]; + if OutlineMode <> twoPath then ADest.beginPath; + ADest.moveTo(m*underlinePoly[high(underlinePoly)]); + for i := high(underlinePoly)-1 downto 0 do + ADest.lineTo(m*underlinePoly[i]); + DrawLastPath(ADest); + end; + end; +end; + +procedure TBGRAVectorizedFont.CopyTextPathTo(ADest: IBGRAPath; + ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment); +var underlinePoly: ArrayOfTPointF; + m: TAffineMatrix; + i: integer; + deltaY: single; +begin + inherited CopyTextPathTo(ADest,ATextUTF8, X, Y, AAlign); + if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else + if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else + deltaY := 0; + if UnderlineDecoration and (Resolution > 0) then + begin + underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, + (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution); + if underlinePoly <> nil then + begin + m := GetTextMatrix(ATextUTF8, X,Y,AAlign); + ADest.moveTo(m*underlinePoly[high(underlinePoly)]); + for i := high(underlinePoly)-1 downto 0 do + ADest.lineTo(m*underlinePoly[i]); + ADest.closePath; + end; + end; + if StrikeOutDecoration and (Resolution > 0) then + begin + underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, + (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution); + if underlinePoly <> nil then + begin + m := GetTextMatrix(ATextUTF8, X,Y,AAlign); + ADest.moveTo(m*underlinePoly[high(underlinePoly)]); + for i := high(underlinePoly)-1 downto 0 do + ADest.lineTo(m*underlinePoly[i]); + ADest.closePath; + end; + end; +end; + +procedure TBGRAVectorizedFont.DrawTextWordBreak(ADest: TBGRACanvas2D; + ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment); +var ARemains: string; + pos,step: TPointF; + lines: TStringList; + i: integer; + lineShift: single; + oldItalicSlope: single; + lineAlignment: TBGRATypeWriterAlignment; +begin + if (ATextUTF8 = '') or (MaxWidth <= 0) then exit; + + oldItalicSlope:= ItalicSlope; + ItalicSlope := 0; + pos := PointF(X,Y); + step := TypeWriterMatrix*PointF(0,1); + ItalicSlope := oldItalicSlope; + + if AAlign in[twaTop,twaMiddle,twaBottom] then + lineAlignment := twaMiddle + else if AAlign in[twaTopLeft,twaLeft,twaBottomLeft] then + begin + if ItalicSlope < 0 then + lineAlignment:= twaTopLeft + else + lineAlignment := twaBottomLeft; + end else + begin + if ItalicSlope < 0 then + lineAlignment := twaBottomRight + else + lineAlignment := twaTopRight; + end; + + if AAlign in[twaTopLeft,twaTop,twaTopRight] then + begin + case lineAlignment of + twaMiddle: lineShift := 0.5; + twaBottomLeft,twaBottomRight: lineShift := 1; + twaTopRight,twaTopLeft : lineShift := 0; + end; + pos.Offset(step*lineShift); + repeat + SplitText(ATextUTF8, MaxWidth, ARemains); + DrawText(ADest,ATextUTF8,pos.X,pos.Y,lineAlignment); + ATextUTF8 := ARemains; + pos.Offset(step); + until ARemains = ''; + end else + begin + lines := TStringList.Create; + repeat + SplitText(ATextUTF8, MaxWidth, ARemains); + lines.Add(ATextUTF8); + ATextUTF8 := ARemains; + until ARemains = ''; + if AAlign in[twaLeft,twaMiddle,twaRight] then lineShift := lines.Count/2-0.5 + else if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then lineShift := lines.Count-0.5 + else lineShift := -0.5; + + case lineAlignment of + twaMiddle: ; + twaBottomLeft,twaBottomRight: DecF(lineShift, 0.5); + twaTopRight,twaTopLeft : IncF(lineShift, 0.5); + end; + + pos.Offset(step*(-lineShift)); + for i := 0 to lines.Count-1 do + begin + DrawText(ADest,lines[i],pos.X,pos.Y,lineAlignment); + pos.Offset(step); + end; + lines.Free; + end; +end; + +procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; + X1, Y1, X2, Y2: Single; AAlign: TBGRATypeWriterAlignment); +var X,Y: single; + oldOrientation: single; +begin + if X2 <= X1 then exit; + if AAlign in[twaTopLeft,twaTop,twaTopRight] then Y := Y1 else + if AAlign in[twaLeft,twaMiddle,twaRight] then Y := (Y1+Y2)/2 else + if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then Y := Y2; + if AAlign in[twaLeft,twaTopLeft,twaBottomLeft] then X := X1 else + if AAlign in[twaTop,twaMiddle,twaBottom] then X := (X1+X2)/2 else + if AAlign in[twaRight,twaTopRight,twaBottomRight] then X := X2; + oldOrientation:= Orientation; + Orientation:= 0; + DrawTextWordBreak(ADest,ATextUTF8,X,Y,X2-X1,AAlign); + Orientation:= oldOrientation; +end; + +procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; + ATopLeft, ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment); +begin + DrawTextRect(ADest,ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign); +end; + +function TBGRAVectorizedFont.GetTextWordBreakGlyphBoxes(ATextUTF8: string; X, Y, + MaxWidth: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; +var ARemains: string; + pos,step: TPointF; + lines: TStringList; + i: integer; + lineShift: single; + oldItalicSlope: single; + tempArray: array of TGlyphBoxes; + tempPos,j: integer; + lineAlignment: TBGRATypeWriterAlignment; +begin + result := nil; + if ATextUTF8 = '' then exit; + + oldItalicSlope:= ItalicSlope; + ItalicSlope := 0; + pos := PointF(X,Y); + step := TypeWriterMatrix*PointF(0,1); + ItalicSlope := oldItalicSlope; + + if AAlign in[twaTop,twaMiddle,twaBottom] then + lineAlignment := twaMiddle + else if AAlign in[twaTopLeft,twaLeft,twaBottomLeft] then + begin + if ItalicSlope < 0 then + lineAlignment:= twaTopLeft + else + lineAlignment := twaBottomLeft; + end else + begin + if ItalicSlope < 0 then + lineAlignment := twaBottomRight + else + lineAlignment := twaTopRight; + end; + + lines := TStringList.Create; + repeat + SplitText(ATextUTF8, MaxWidth, ARemains); + lines.Add(ATextUTF8); + ATextUTF8 := ARemains; + until ARemains = ''; + + if AAlign in[twaLeft,twaMiddle,twaRight] then lineShift := lines.Count/2-0.5 + else if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then lineShift := lines.Count-0.5 + else lineShift := -0.5; + + case lineAlignment of + twaMiddle: ; + twaBottomLeft, twaBottomRight: DecF(lineShift, 0.5); + twaTopRight,twaTopLeft : IncF(lineShift, 0.5); + end; + + pos.Offset(step*(-lineShift)); + setlength(tempArray, lines.Count); + tempPos := 0; + for i := 0 to lines.Count-1 do + begin + tempArray[i] := GetTextGlyphBoxes(lines[i],pos.X,pos.Y,lineAlignment); + inc(tempPos, length(tempArray[i])); + pos.Offset(step); + end; + lines.Free; + setlength(result, tempPos); + tempPos := 0; + for i := 0 to high(tempArray) do + for j := 0 to high(tempArray[i]) do + begin + result[tempPos] := tempArray[i][j]; + inc(tempPos); + end; +end; + +function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; X1, Y1, X2, + Y2: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; +var X,Y,oldOrientation: single; +begin + if X2 <= X1 then + begin + result := nil; + exit; + end; + if AAlign in[twaTopLeft,twaTop,twaTopRight] then Y := Y1 else + if AAlign in[twaLeft,twaMiddle,twaRight] then Y := (Y1+Y2)/2 else + if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then Y := Y2; + if AAlign in[twaLeft,twaTopLeft,twaBottomLeft] then X := X1 else + if AAlign in[twaTop,twaMiddle,twaBottom] then X := (X1+X2)/2 else + if AAlign in[twaRight,twaTopRight,twaBottomRight] then X := X2; + oldOrientation:= Orientation; + Orientation:= 0; + result := GetTextWordBreakGlyphBoxes(ATextUTF8,X,Y,X2-X1,AAlign); + Orientation:= oldOrientation; +end; + +function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft, + ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; +begin + result := GetTextRectGlyphBoxes(ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign); +end; + +procedure TBGRAVectorizedFont.UpdateDirectory; +var + NbFiles: integer; + SearchRec: TSearchRec; + Info: TBGRAGlyphsInfo; + Fullname: string; +begin + NbFiles := 0; + FDirectoryContent := nil; + if FDirectory = '' then exit; + if (length(FDirectory) > 0) and not (FDirectory[length(FDirectory)] in AllowDirectorySeparators) then + AppendStr(FDirectory, DirectorySeparator); + if FindFirstUTF8(FDirectory +'*.glyphs', faAnyFile, SearchRec) = 0 then + repeat + {$PUSH}{$WARNINGS OFF} + if (faDirectory or faVolumeId or faSysFile) and SearchRec.Attr = 0 then + {$POP} + begin + Fullname := FDirectory+SearchRec.Name; + Info := LoadGlyphsInfo(Fullname); + if (info.Name <> '') and (info.NbGlyphs > 0) then + begin + if NbFiles = length(FDirectoryContent) then + setlength(FDirectoryContent,2*NbFiles+1); + FDirectoryContent[NbFiles].Filename:= Fullname; + FDirectoryContent[NbFiles].FontName:= info.Name; + FDirectoryContent[NbFiles].FontStyle:= info.Style; + inc(NbFiles); + end; + end; + until FindNext(SearchRec) <> 0; + FindClose(SearchRec); + SetLength(FDirectoryContent,NbFiles); +end; + +function TBGRAVectorizedFont.LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo; +var Stream: TFileStreamUTF8; + twHeader: TBGRACustomTypeWriterHeader; + vfHeader: TBGRAVectorizedFontHeader; +begin + result.Name := ''; + result.NbGlyphs := 0; + result.Style := []; + Stream := nil; + try + Stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead); + Stream.Position := 4; + twHeader := ReadCustomTypeWriterHeader(Stream); + result.NbGlyphs := twHeader.NbGlyphs; + if twHeader.HeaderName = HeaderName then + begin + vfHeader := ReadVectorizedFontHeader(Stream); + result.Name := vfHeader.Name; + result.Style:= vfHeader.Style; + end; + except + on ex:exception do + begin + + end; + end; + Stream.Free; +end; + +function TBGRAVectorizedFont.GetGlyph(AIdentifier: string): TBGRAGlyph; +var size: TSize; + g: TBGRAPolygonalGlyph; + pts: array of TPointF; + dx,dy: Integer; +begin + Result:=inherited GetGlyph(AIdentifier); + if (result = nil) and (FResolution > 0) and (FFont <> nil) then + begin + g := TBGRAPolygonalGlyph.Create(AIdentifier); + size := BGRATextSize(FFont, fqSystem, AIdentifier, 1); + dx := FResolution div 2; + dy := FResolution div 2; + FBuffer.SetSize(size.cx+2*dx,FResolution+2*dy); + FBuffer.Fill(BGRAWhite); + BGRATextOut(FBuffer, FFont, fqSystem, dx,dy, AIdentifier, BGRABlack, nil, taLeftJustify); + pts := VectorizeMonochrome(FBuffer,1/FResolution,False,true,50); + g.SetPoints(pts); + g.QuadraticCurves := FQuadraticCurves; + g.Width := size.cx/FResolution; + g.Height := 1; + g.Offset := PointF(-dx/FResolution,-dy/FResolution); + SetGlyph(AIdentifier,g); + result := g; + end else + if (result <> nil) and (result is TBGRAPolygonalGlyph) then + TBGRAPolygonalGlyph(result).QuadraticCurves := FQuadraticCurves; +end; + +procedure TBGRAVectorizedFont.DefaultWordBreakHandler(var ABefore,AAfter: string); +begin + BGRADefaultWordBreakHandler(ABefore,AAfter); +end; + +procedure TBGRAVectorizedFont.Init(AVectorize: boolean); +begin + FName := 'Arial'; + FStyle := []; + FFontMatrix := AffineMatrixIdentity; + FOrientation := 0; + FResolution := 100; + FFontEmHeightRatio := 1; + FFontEmHeightRatioComputed := false; + if AVectorize then + FFont := TFont.Create + else + FFont := nil; + FBuffer := BGRABitmapFactory.Create; + FFullHeight := 20; + FItalicSlope := 0; + LigatureWithF := true; + UpdateFont; + UpdateMatrix; + FWordBreakHandler:= nil; +end; + +function TBGRAVectorizedFont.CustomHeaderSize: integer; +begin + Result:= (inherited CustomHeaderSize) + 4+length(FName)+4 + sizeof(single) + 4 + 5*4; +end; + +procedure TBGRAVectorizedFont.WriteCustomHeader(AStream: TStream); +var metric: TFontPixelMetric; +begin + inherited WriteCustomHeader(AStream); + LEWriteLongint(AStream, length(FName)); + AStream.Write(FName[1],length(FName)); + LEWriteLongint(AStream, integer(FStyle)); + LEWriteSingle(AStream, FontEmHeightRatio); + LEWriteLongint(AStream, Resolution); + metric := FontPixelMetric; + LEWriteLongint(AStream, metric.Baseline); + LEWriteLongint(AStream, metric.xLine); + LEWriteLongint(AStream, metric.CapLine); + LEWriteLongint(AStream, metric.DescentLine); + LEWriteLongint(AStream, metric.Lineheight); +end; + +procedure TBGRAVectorizedFont.ReadAdditionalHeader(AStream: TStream); +var Header: TBGRAVectorizedFontHeader; +begin + inherited ReadAdditionalHeader(AStream); + Header := ReadVectorizedFontHeader(AStream); + FName := Header.Name; + FStyle := Header.Style; + if header.EmHeightRatio <> 0 then + begin + FFontEmHeightRatio := Header.EmHeightRatio; + FFontEmHeightRatioComputed := true; + end else + begin + FFontEmHeightRatio := 1; + FFontEmHeightRatioComputed := false; + end; + FFontPixelMetric := Header.PixelMetric; + FFontPixelMetricComputed := True; + if FFont = nil then + FResolution := Header.Resolution; +end; + +function TBGRAVectorizedFont.ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader; +var lNameLength: integer; +begin + lNameLength := LEReadLongint(AStream); + setlength(result.Name, lNameLength); + AStream.Read(result.Name[1],length(result.Name)); + result.Style := TFontStyles(LEReadLongint(AStream)); + result.EmHeightRatio:= LEReadSingle(AStream); + result.Resolution := LEReadLongint(AStream); + result.PixelMetric.Baseline := LEReadLongint(AStream); + result.PixelMetric.xLine := LEReadLongint(AStream); + result.PixelMetric.CapLine := LEReadLongint(AStream); + result.PixelMetric.DescentLine := LEReadLongint(AStream); + result.PixelMetric.Lineheight := LEReadLongint(AStream); + result.PixelMetric.Defined := result.PixelMetric.Lineheight > 0; +end; + +function TBGRAVectorizedFont.HeaderName: string; +begin + Result:= 'TBGRAVectorizedFont'; +end; + +procedure TBGRAVectorizedFont.SetDirectory(const AValue: string); +begin + if Trim(AValue) = Trim(FDirectory) then exit; + FDirectory := Trim(AValue); + UpdateDirectory; + UpdateFont; +end; + +function TBGRAVectorizedFont.ComputeKerning(AIdLeft, AIdRight: string): single; +var + together: String; +begin + if Resolution = 0 then exit(0); + if IsRightToLeftUTF8(AIdLeft) then + begin + if IsRightToLeftUTF8(AIdRight) then + together := AIdRight + AIdLeft + else + together := UTF8OverrideDirection(AIdRight + AIdLeft, true); + end else + together := AIdLeft + AIdRight; + result := BGRATextSize(FFont, fqSystem, together, 1).cx/Resolution + - Glyph[AIdLeft].Width - Glyph[AIdRight].Width; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawinbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawinbitmap.pas new file mode 100644 index 0000000..10bc5fb --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawinbitmap.pas @@ -0,0 +1,263 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + /**************************************************************************\ + bgrawinbitmap.pas + ----------------- + This unit should NOT be added to the 'uses' clause. + It contains accelerations for Windows. Notably, it + provides direct access to bitmap data. +} + +unit BGRAWinBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRALCLBitmap, Windows, Graphics, GraphType; + +type + { TBGRAWinBitmap } + + TBGRAWinBitmap = class(TBGRALCLBitmap) + private + procedure AlphaCorrectionNeeded; + protected + DIB_SectionHandle: HBITMAP; + FReversed: boolean; + function DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo; + + procedure ReallocData; override; + procedure FreeData; override; + + procedure RebuildBitmap; override; + procedure FreeBitmap; override; + + procedure Init; override; + function GetBitmap: TBitmap; override; + + public + procedure LoadFromBitmapIfNeeded; override; + procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean=True); overload; override; + procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override; + procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; + ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; + procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; + end; + +implementation + +uses BGRADefaultBitmap, BGRABitmapTypes; + +type + { TWinBitmapTracker } + + TWinBitmapTracker = class(TBitmap) + protected + FUser: TBGRAWinBitmap; + procedure Changed(Sender: TObject); override; + public + constructor Create(AUser: TBGRAWinBitmap); overload; + property User: TBGRAWinBitmap read FUser write FUser; + end; + +procedure TWinBitmapTracker.Changed(Sender: TObject); +begin + if FUser <> nil then + FUser.AlphaCorrectionNeeded; + inherited Changed(Sender); +end; + +constructor TWinBitmapTracker.Create(AUser: TBGRAWinBitmap); +begin + FUser := AUser; + inherited Create; +end; + +{ TBGRAWinBitmap } + +procedure TBGRAWinBitmap.FreeData; +begin + if DIB_SectionHandle <> 0 then + begin + FreeBitmap; + DeleteObject(DIB_SectionHandle); + FDataByte := nil; + DIB_SectionHandle := 0; + end; +end; + +procedure TBGRAWinBitmap.RebuildBitmap; +begin + if FBitmap = nil then + begin + FBitmap := TWinBitmapTracker.Create(nil); + FBitmap.Handle := DIB_SectionHandle; + TWinBitmapTracker(FBitmap).User := self; + end; +end; + +procedure TBGRAWinBitmap.FreeBitmap; +begin + if FBitmap <> nil then + begin + TWinBitmapTracker(FBitmap).User := nil; + FBitmap.ReleaseHandle; + FBitmap.Free; + FBitmap := nil; + end; +end; + +procedure TBGRAWinBitmap.Init; +begin + inherited Init; + FLineOrder := riloBottomToTop; +end; + +function TBGRAWinBitmap.GetBitmap: TBitmap; +begin + Result:=inherited GetBitmap; + if (LineOrder = riloTopToBottom) and not FReversed then + begin + VerticalFlip; + FReversed:= true; + end; +end; + +procedure TBGRAWinBitmap.LoadFromBitmapIfNeeded; +begin + if FReversed then + begin + FReversed := false; + VerticalFlip; + end; + if FAlphaCorrectionNeeded then + begin + DoAlphaCorrection; + end; +end; + +procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); +begin + if self = nil then exit; + Draw(ACanvas, BGRAClasses.Rect(x,y,x+Width,y+Height), Opaque); +end; + +procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); +var + info: TBITMAPINFO; +begin + if (self = nil) or (Width = 0) or (Height = 0) then exit; + if TBGRAPixel_RGBAOrder then SwapRedBlue; + if Opaque then + begin + info := DIBitmapInfo(Width, Height); + if LineOrder = riloTopToBottom then + StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Bottom, Rect.Right - + Rect.Left, Rect.Top - Rect.Bottom, + 0, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY) + else + StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Top, Rect.Right - + Rect.Left, Rect.Bottom - Rect.Top, + 0, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY); + end + else + begin + if Empty then exit; + if LineOrder = riloTopToBottom then VerticalFlip; + LoadFromBitmapIfNeeded; + ACanvas.StretchDraw(Rect, Bitmap); + if LineOrder = riloTopToBottom then VerticalFlip; + end; + if TBGRAPixel_RGBAOrder then SwapRedBlue; +end; + +procedure TBGRAWinBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; + AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); +var + info: TBITMAPINFO; + IsFlipped: boolean; + Temp: TBGRAPtrBitmap; +begin + Temp := nil; + IsFlipped := False; + if ALineOrder = riloTopToBottom then + begin + Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData); + Temp.VerticalFlip; + IsFlipped := True; + end; + if TBGRAPixel_RGBAOrder then + begin + if Temp = nil then + Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData); + Temp.SwapRedBlue; + end; + + info := DIBitmapInfo(AWidth, AHeight); + StretchDIBits(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right - + ARect.Left, ARect.Bottom - ARect.Top, + 0, 0, AWidth, AHeight, AData, info, DIB_RGB_COLORS, SRCCOPY); + + if Temp <> nil then + begin + if TBGRAPixel_RGBAOrder then Temp.SwapRedBlue; + if IsFlipped then + Temp.VerticalFlip; + Temp.Free; + end; +end; + +procedure TBGRAWinBitmap.AlphaCorrectionNeeded; +begin + FAlphaCorrectionNeeded := True; +end; + +function TBGRAWinBitmap.DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo; +begin + with {%H-}Result.bmiHeader do + begin + biSize := sizeof(Result.bmiHeader); + biWidth := AWidth; + biHeight := AHeight; + biPlanes := 1; + biBitCount := 32; + biCompression := BI_RGB; + biSizeImage := 0; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + end; +end; + +procedure TBGRAWinBitmap.ReallocData; +var + ScreenDC: HDC; + info: TBitmapInfo; +begin + FreeData; + if (Width <> 0) and (Height <> 0) then + begin + ScreenDC := GetDC(0); + info := DIBitmapInfo(Width, Height); + DIB_SectionHandle := CreateDIBSection(ScreenDC, info, DIB_RGB_COLORS, FDataByte, 0, 0); + + if (NbPixels > 0) and (FDataByte = nil) then + raise EOutOfMemory.Create('TBGRAWinBitmap.ReallocBitmap: Windows error ' + + IntToStr(GetLastError)); + + ReleaseDC(0, ScreenDC); + end; + InvalidateBitmap; +end; + +procedure TBGRAWinBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); +begin + self.Canvas.CopyRect(BGRAClasses.rect(0, 0, Width, Height), CanvasSource, + BGRAClasses.rect(X, Y, X + Width, Y + Height)); +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawinresource.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawinresource.pas new file mode 100644 index 0000000..478588d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawinresource.pas @@ -0,0 +1,1165 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAWinResource; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRAMultiFileType, BGRABitmapTypes, BGRAReadBMP; + +const + RT_CURSOR = 1; + RT_BITMAP = 2; + RT_ICON = 3; + + RT_MENU = 4; + RT_DIALOG = 5; + RT_STRING = 6; + RT_FONTDIR = 7; + RT_FONT = 8; + RT_ACCELERATOR = 9; + RT_RCDATA = 10; + RT_MESSAGETABLE = 11; + + RT_GROUP = 11; + RT_GROUP_CURSOR = RT_GROUP + RT_CURSOR; + RT_GROUP_ICON = RT_GROUP + RT_ICON; + + RT_VERSION = 16; + RT_ANICURSOR = 21; + RT_ANIICON = 22; + RT_HTML = 23; + RT_MANIFEST = 24; + + ICON_OR_CURSOR_FILE_ICON_TYPE = 1; + ICON_OR_CURSOR_FILE_CURSOR_TYPE = 2; + +type + TNameOrId = record + Id: integer; + Name: utf8string; + end; + + { TResourceInfo } + + TResourceInfo = object + DataVersion: LongWord; + MemoryFlags: Word; + LanguageId: Word; + Version: LongWord; + Characteristics: LongWord; + procedure SwapIfNecessary; + end; + + TWinResourceContainer = class; + + { TCustomResourceEntry } + + TCustomResourceEntry = class(TMultiFileEntry) + private + class function GetNextEntry(AContainer: TMultiFileContainer; AStream: TStream): TCustomResourceEntry; static; + procedure Serialize(ADestination: TStream); + protected + FTypeNameOrId: TNameOrId; + FEntryNameOrId: TNameOrId; + FResourceInfo: TResourceInfo; + FReferenceCount: integer; + function GetName: utf8string; override; + procedure SetName(AValue: utf8string); override; + function GetId: integer; + procedure SetId(AValue: integer); + function GetTypeId: integer; + function GetTypeName: utf8string; + procedure IncrementReferences; virtual; + procedure DecrementReferences; virtual; + procedure SerializeHeader(ADestination: TStream); virtual; + procedure SerializeData(ADestination: TStream); virtual; abstract; + function GetDataSize: integer; virtual; abstract; + function GetLanguageId: integer; + procedure SetLanguageId(AValue: integer); + public + constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); + function GetStream: TStream; override; + property Id: integer read GetId write SetId; + property TypeName: utf8string read GetTypeName; + property TypeId: integer read GetTypeId; + property LanguageId: integer read GetLanguageId write SetLanguageId; + end; + + { TUnformattedResourceEntry } + + TUnformattedResourceEntry = class(TCustomResourceEntry) + protected + FDataStream: TStream; + function GetFileSize: int64; override; + function GetDataSize: integer; override; + procedure SerializeData(ADestination: TStream); override; + function GetExtension: utf8string; override; + public + constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); + destructor Destroy; override; + function CopyTo(ADestination: TStream): int64; override; + function GetStream: TStream; override; + end; + + { TBitmapResourceEntry } + + TBitmapResourceEntry = class(TUnformattedResourceEntry) + protected + function GetFileSize: int64; override; + function GetExtension: utf8string; override; + public + constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); + function CopyTo(ADestination: TStream): int64; override; + procedure CopyFrom(ASource: TStream); + end; + + { TGroupIconHeader } + + TGroupIconHeader = object + Reserved, ResourceType, ImageCount: Word; + procedure SwapIfNecessary; + end; + TGroupIconDirEntry = packed record + Width, Height, Colors, Reserved: byte; + //stored in little endian + case byte of + 0: (Variable: LongWord; ImageSize: LongWord; ImageId: Word); + 1: (Planes, BitsPerPixel: Word); + 2: (HotSpotX, HotSpotY: Word); + end; + TIconFileDirEntry = packed record + Width, Height, Colors, Reserved: byte; + //stored in little endian + case byte of + 0: (Variable: LongWord; ImageSize: LongWord; ImageOffset: LongWord); + 1: (Planes, BitsPerPixel: Word); + 2: (HotSpotX, HotSpotY: Word); + end; + + { TGroupIconOrCursorEntry } + + TGroupIconOrCursorEntry = class(TCustomResourceEntry) + private + function GetNbIcons: integer; + protected + FGroupIconHeader: TGroupIconHeader; + FDirectory: packed array of TGroupIconDirEntry; + function GetFileSize: int64; override; + function GetDataSize: integer; override; + procedure SerializeData(ADestination: TStream); override; + procedure IncrementReferences; override; + procedure DecrementReferences; override; + function ExpectedResourceType: word; virtual; abstract; + public + constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); + constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); + procedure Clear; + function CopyTo(ADestination: TStream): int64; override; + procedure CopyFrom(ASource: TStream); + property NbIcons: integer read GetNbIcons; + end; + + { TGroupIconEntry } + + TGroupIconEntry = class(TGroupIconOrCursorEntry) + protected + function GetExtension: utf8string; override; + function ExpectedResourceType: word; override; + public + constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); + constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); + end; + + { TGroupCursorEntry } + + TGroupCursorEntry = class(TGroupIconOrCursorEntry) + protected + function GetExtension: utf8string; override; + function ExpectedResourceType: word; override; + public + constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); + constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); + end; + + { TWinResourceContainer } + + TWinResourceContainer = class(TMultiFileContainer) + private + function InternalFind(const AEntry: TNameOrId; const AType: TNameOrId; ALanguageId: integer = 0): TCustomResourceEntry; + procedure AddHidden(AEntry: TCustomResourceEntry); + function GetMaxId(AType: TNameOrId): integer; + procedure IncrementReferenceOf(ANameId, ATypeId: integer); + procedure DecrementReferenceOf(ANameId, ATypeId: integer); + protected + FHiddenEntries: TMultiFileEntryList; + procedure Init; override; + procedure ClearHiddenEntries; + procedure RemoveHidden(AEntry: TCustomResourceEntry); + function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream; ALanguageId: integer): TMultiFileEntry; overload; + function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; + public + procedure Clear; override; + destructor Destroy; override; + procedure Delete(AIndex: integer); override; + procedure LoadFromStream(AStream: TStream); override; + function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; override; + function IndexOf(AName: utf8string; AExtenstion: utf8string; ALanguageId: integer; ACaseSensitive: boolean = True): integer; overload; + procedure SaveToStream(ADestination: TStream); override; + end; + +implementation + +uses Math, BGRAUTF8; + +operator =(const ANameOrId1, ANameOrId2: TNameOrId): boolean; +begin + if (ANameOrId1.Id < 0) then + result := (ANameOrId2.Id < 0) and (ANameOrId2.Name = ANameOrId1.Name) + else + result := ANameOrId2.Id = ANameOrId1.Id; +end; + +function NameOrId(AName: string): TNameOrId; overload; +begin + result.Id := -1; + result.Name := AName; +end; + +function NameOrId(AId: integer): TNameOrId; overload; +begin + result.Id := AId; + result.Name := IntToStr(AId); +end; + +{ TGroupCursorEntry } + +function TGroupCursorEntry.GetExtension: utf8string; +begin + Result:= 'cur'; +end; + +function TGroupCursorEntry.ExpectedResourceType: word; +begin + result := ICON_OR_CURSOR_FILE_CURSOR_TYPE; +end; + +constructor TGroupCursorEntry.Create(AContainer: TMultiFileContainer; + AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; + ADataStream: TStream); +begin + inherited Create(AContainer,NameOrId(RT_GROUP_CURSOR),AEntryNameOrId,AResourceInfo,ADataStream); +end; + +constructor TGroupCursorEntry.Create(AContainer: TMultiFileContainer; + AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); +begin + inherited Create(AContainer,NameOrId(RT_GROUP_CURSOR),AEntryNameOrId,AResourceInfo); +end; + +{ TGroupIconEntry } + +function TGroupIconEntry.GetExtension: utf8string; +begin + Result:= 'ico'; +end; + +function TGroupIconEntry.ExpectedResourceType: word; +begin + result := ICON_OR_CURSOR_FILE_ICON_TYPE; +end; + +constructor TGroupIconEntry.Create(AContainer: TMultiFileContainer; + AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; + ADataStream: TStream); +begin + inherited Create(AContainer,NameOrId(RT_GROUP_ICON),AEntryNameOrId,AResourceInfo,ADataStream); +end; + +constructor TGroupIconEntry.Create(AContainer: TMultiFileContainer; + AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); +begin + inherited Create(AContainer,NameOrId(RT_GROUP_ICON),AEntryNameOrId,AResourceInfo); +end; + +{ TGroupIconHeader } + +procedure TGroupIconHeader.SwapIfNecessary; +begin + Reserved := LEtoN(Reserved); + ResourceType := LEtoN(ResourceType); + ImageCount := LEtoN(ImageCount); +end; + +{ TGroupIconOrCursorEntry } + +function TGroupIconOrCursorEntry.GetNbIcons: integer; +begin + result := FGroupIconHeader.ImageCount; +end; + +function TGroupIconOrCursorEntry.GetFileSize: int64; +var + i: Integer; +begin + Result:= sizeof(FGroupIconHeader) + sizeof(TIconFileDirEntry)*NbIcons; + for i := 0 to NbIcons-1 do + inc(Result, LEtoN(FDirectory[i].ImageSize) ); +end; + +function TGroupIconOrCursorEntry.GetDataSize: integer; +begin + result := sizeof(FGroupIconHeader) + sizeof(TGroupIconDirEntry)*NbIcons; +end; + +procedure TGroupIconOrCursorEntry.SerializeData(ADestination: TStream); +begin + FGroupIconHeader.SwapIfNecessary; + try + ADestination.WriteBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); + finally + FGroupIconHeader.SwapIfNecessary; + end; + ADestination.WriteBuffer(FDirectory[0], sizeof(TGroupIconDirEntry)*NbIcons); +end; + +procedure TGroupIconOrCursorEntry.IncrementReferences; +var + i: Integer; +begin + for i := 0 to NbIcons-1 do + TWinResourceContainer(Container).IncrementReferenceOf(LEtoN(FDirectory[i].ImageId), TypeId - RT_GROUP); +end; + +procedure TGroupIconOrCursorEntry.DecrementReferences; +var + i: Integer; +begin + for i := 0 to NbIcons-1 do + TWinResourceContainer(Container).DecrementReferenceOf(LEtoN(FDirectory[i].ImageId), TypeId - RT_GROUP); +end; + +constructor TGroupIconOrCursorEntry.Create(AContainer: TMultiFileContainer; + ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; + ADataStream: TStream); +begin + inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); + + ADataStream.ReadBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); + FGroupIconHeader.SwapIfNecessary; + if FGroupIconHeader.ResourceType <> ExpectedResourceType then + raise exception.Create('Unexpected group type'); + + if ADataStream.Position + NbIcons*sizeof(TGroupIconDirEntry) > ADataStream.Size then + raise exception.Create('Directory dimension mismatch'); + setlength(FDirectory, NbIcons); + ADataStream.ReadBuffer(FDirectory[0], NbIcons*sizeof(TGroupIconDirEntry)); + ADataStream.Free; +end; + +constructor TGroupIconOrCursorEntry.Create(AContainer: TMultiFileContainer; + ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; + const AResourceInfo: TResourceInfo); +begin + inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); + + FGroupIconHeader.Reserved := 0; + FGroupIconHeader.ResourceType := ExpectedResourceType; + FGroupIconHeader.ImageCount := 0; +end; + +procedure TGroupIconOrCursorEntry.Clear; +begin + DecrementReferences; + FDirectory := nil; + FGroupIconHeader.ImageCount := 0; +end; + +function TGroupIconOrCursorEntry.CopyTo(ADestination: TStream): int64; +var + fileDir: packed array of TIconFileDirEntry; + offset, written, i: integer; + iconEntry: TCustomResourceEntry; + iconEntrySize: LongWord; + iconData: TMemoryStream; + copyCount: Int64; + subType: TNameOrId; + + procedure FillZero(ACount: integer); + var + Zero: packed array[0..255] of byte; + begin + if ACount <= 0 then exit; + FillChar({%H-}Zero, Sizeof(Zero), 0); + while ACount > 0 do + begin + ADestination.WriteBuffer(Zero, Min(ACount, sizeof(Zero))); + Dec(ACount, Min(ACount, sizeof(Zero))); + end; + end; + +begin + result:= 0; + FGroupIconHeader.SwapIfNecessary; + try + ADestination.WriteBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); + finally + FGroupIconHeader.SwapIfNecessary; + end; + Inc(result, sizeof(FGroupIconHeader)); + + offset := result+sizeof(TIconFileDirEntry)*NbIcons; + setlength(fileDir, NbIcons); + for i := 0 to NbIcons-1 do + begin + move(FDirectory[i], fileDir[i], 12); + fileDir[i].ImageOffset := NtoLE(offset); + inc(offset, fileDir[i].ImageSize); + end; + + ADestination.WriteBuffer(fileDir[0], sizeof(TIconFileDirEntry)*NbIcons); + inc(result, sizeof(TIconFileDirEntry)*NbIcons); + + subType := NameOrId(TypeId - RT_GROUP); + for i := 0 to NbIcons-1 do + begin + iconEntry := (Container as TWinResourceContainer).InternalFind(NameOrId(LEtoN(FDirectory[i].ImageId)),subType); //no language for icons + iconEntrySize := LEtoN(FDirectory[i].ImageSize); + if iconEntry = nil then + FillZero(iconEntrySize) else + begin + iconData := TMemoryStream.Create; + try + iconEntry.CopyTo(IconData); + iconData.Position:= 0; + copyCount := Min(IconData.Size, iconEntrySize); + if copyCount > 0 then written := ADestination.CopyFrom(IconData, copyCount) + else written := 0; + FillZero(iconEntrySize-written); + finally + IconData.Free; + end; + end; + inc(result, iconEntrySize); + end; +end; + +procedure TGroupIconOrCursorEntry.CopyFrom(ASource: TStream); +var + tempGroup: TGroupIconHeader; + fileDir: packed array of TIconFileDirEntry; + iconStream: array of TMemoryStream; + startPos: int64; + maxId, i: integer; + iconEntry: TUnformattedResourceEntry; + resourceInfo: TResourceInfo; + subType: TNameOrId; +begin + startPos := ASource.Position; + ASource.ReadBuffer({%H-}tempGroup, sizeof(tempGroup)); + tempGroup.SwapIfNecessary; + if tempGroup.ResourceType <> ExpectedResourceType then + raise exception.Create('Unexpected resource type'); + + if ASource.Position + sizeof(TIconFileDirEntry)*tempGroup.ImageCount > ASource.Size then + raise exception.Create('Directory dimension mismatch'); + + setlength(fileDir, tempGroup.ImageCount); + ASource.ReadBuffer(fileDir[0], sizeof(TIconFileDirEntry)*tempGroup.ImageCount); + + try + setlength(iconStream, tempGroup.ImageCount); + for i := 0 to tempGroup.ImageCount-1 do + begin + ASource.Position:= startPos + LEtoN(fileDir[i].ImageOffset); + iconStream[i] := TMemoryStream.Create; + iconStream[i].CopyFrom(ASource, LEtoN(fileDir[i].ImageSize)); + end; + + subType := NameOrId(self.TypeId - RT_GROUP); + maxId := TWinResourceContainer(Container).GetMaxId(subType); + + Clear; + FGroupIconHeader.ImageCount := tempGroup.ImageCount; + setlength(FDirectory, tempGroup.ImageCount); + fillchar({%H-}resourceInfo,sizeof(resourceInfo),0); + for i := 0 to tempGroup.ImageCount-1 do + begin + move(fileDir[i], FDirectory[i], 12); + inc(maxId); + FDirectory[i].ImageId := maxId; + iconEntry := TUnformattedResourceEntry.Create(Container, subType, NameOrId(maxId), resourceInfo, iconStream[i]); + iconStream[i] := nil; + TWinResourceContainer(Container).AddHidden(iconEntry); + end; + + finally + for i := 0 to high(iconStream) do + iconStream[i].Free; + iconStream := nil; + end; +end; + +{ TBitmapResourceEntry } + +function TBitmapResourceEntry.GetFileSize: int64; +begin + result := sizeof(TBitMapFileHeader)+FDataStream.Size; +end; + +function TBitmapResourceEntry.GetExtension: utf8string; +begin + Result:= 'bmp'; +end; + +constructor TBitmapResourceEntry.Create(AContainer: TMultiFileContainer; + AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; + ADataStream: TStream); +begin + inherited Create(AContainer, NameOrId(RT_BITMAP), AEntryNameOrId, AResourceInfo, ADataStream); +end; + +function TBitmapResourceEntry.CopyTo(ADestination: TStream): int64; +var fileHeader: TBitMapFileHeader; +begin + result := 0; + FDataStream.Position := 0; + fileHeader := MakeBitmapFileHeader(FDataStream); + ADestination.WriteBuffer(fileHeader, sizeof(fileHeader)); + inc(result, sizeof(fileHeader) ); + FDataStream.Position := 0; + inc(result, ADestination.CopyFrom(FDataStream, FDataStream.Size) ); +end; + +procedure TBitmapResourceEntry.CopyFrom(ASource: TStream); +var + fileHeader: TBitMapFileHeader; + dataSize: integer; +begin + ASource.ReadBuffer({%H-}fileHeader, sizeof(fileHeader)); + if fileHeader.bfType <> Word('BM') then + raise exception.Create('Invalid file header'); + dataSize := LEtoN(fileHeader.bfSize) - sizeof(fileHeader); + if ASource.Position + dataSize > ASource.Size then + raise exception.Create('Invalid file size'); + + FDataStream.Free; + FDataStream := TMemoryStream.Create; + FDataStream.CopyFrom(ASource, dataSize); +end; + +{ TUnformattedResourceEntry } + +function TUnformattedResourceEntry.GetFileSize: int64; +begin + Result:= FDataStream.Size; +end; + +function TUnformattedResourceEntry.GetDataSize: integer; +begin + result := FDataStream.Size; +end; + +procedure TUnformattedResourceEntry.SerializeData(ADestination: TStream); +begin + if FDataStream.Size > 0 then + begin + FDataStream.Position := 0; + ADestination.CopyFrom(FDataStream, FDataStream.Size); + end; +end; + +function TUnformattedResourceEntry.GetExtension: utf8string; +var format: TBGRAImageFormat; +begin + case TypeId of + RT_MANIFEST: result := 'manifest'; + RT_HTML: result := 'html'; + RT_RCDATA: + begin + FDataStream.Position:= 0; + format := DetectFileFormat(FDataStream); + if format = ifUnknown then + result := 'dat' + else + result := SuggestImageExtension(format); + end; + RT_ANICURSOR: result := 'ani'; + else + if TypeName = 'ANICURSOR' then + result := 'ani' + else + result := ''; + end; +end; + +constructor TUnformattedResourceEntry.Create(AContainer: TMultiFileContainer; + ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; + const AResourceInfo: TResourceInfo; ADataStream: TStream); +begin + inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); + FDataStream := ADataStream; +end; + +destructor TUnformattedResourceEntry.Destroy; +begin + FreeAndNil(FDataStream); + inherited Destroy; +end; + +function TUnformattedResourceEntry.CopyTo(ADestination: TStream): int64; +begin + if FDataStream.Size > 0 then + begin + FDataStream.Position := 0; + result := ADestination.CopyFrom(FDataStream, FDataStream.Size) + end + else + result := 0; +end; + +function TUnformattedResourceEntry.GetStream: TStream; +begin + Result:= FDataStream; +end; + +{ TResourceInfo } + +procedure TResourceInfo.SwapIfNecessary; +begin + DataVersion := LEtoN(DataVersion); + MemoryFlags := LEtoN(MemoryFlags); + LanguageId := LEtoN(LanguageId); + Version := LEtoN(Version); + Characteristics := LEtoN(Characteristics); +end; + +{ TCustomResourceEntry } + +function TCustomResourceEntry.GetId: integer; +begin + result := FEntryNameOrId.Id; +end; + +function TCustomResourceEntry.GetTypeId: integer; +begin + result := FTypeNameOrId.Id; +end; + +function GetDWord(var ASource: PByte; var ARemainingBytes: Integer): LongWord; +begin + if ARemainingBytes >= 4 then + begin + result := LEtoN(PLongWord(ASource)^); + inc(ASource, 4); + dec(ARemainingBytes, 4); + end else + begin + result := 0; + inc(ASource, ARemainingBytes); + ARemainingBytes:= 0; + end; +end; + +function GetWord(var ASource: PByte; var ARemainingBytes: Integer): Word; +begin + if ARemainingBytes >= 2 then + begin + result := LEtoN(PWord(ASource)^); + inc(ASource, 2); + dec(ARemainingBytes, 2); + end else + begin + result := 0; + inc(ASource, ARemainingBytes); + ARemainingBytes:= 0; + end; +end; + +function GetNameOrId(var ASource: PByte; var ARemainingBytes: Integer): TNameOrId; +var curChar: Word; + pstart: PByte; +begin + pstart := ASource; + curChar := GetWord(ASource,ARemainingBytes); + if curChar = $ffff then + begin + result.Id := GetWord(ASource,ARemainingBytes); + result.Name := IntToStr(result.Id); + end else + begin + while curChar <> 0 do + curChar := GetWord(ASource,ARemainingBytes); + result.Id := -1; + result.Name := UTF8Encode(WideCharLenToString(PWideChar(pstart), (ASource-pstart) div 2 -1)); + end; +end; + +function TCustomResourceEntry.GetLanguageId: integer; +begin + result := FResourceInfo.LanguageId; +end; + +class function TCustomResourceEntry.GetNextEntry(AContainer: TMultiFileContainer; AStream: TStream): TCustomResourceEntry; +var + entrySize, headerSize, remaining, padding: Integer; + headerData: Pointer; + pHeaderData: PByte; + typeNameOrId: TNameOrId; + entryNameOrId: TNameOrId; + info: TResourceInfo; + dataStream: TMemoryStream; + dummy: LongWord; +begin + result := nil; + if AStream.Position + 16 < AStream.Size then + begin + entrySize := LEtoN(AStream.ReadDWord); + headerSize := LEtoN(AStream.ReadDWord); + if headerSize < 16 then + raise exception.Create('Header too small'); + remaining := ((headerSize-8) + 3) and not 3; + if AStream.Position + remaining + entrySize > AStream.Size then + raise exception.Create('Data would be outside of stream'); + + GetMem(headerData, remaining); + try + AStream.ReadBuffer(headerData^, remaining); + pHeaderData := PByte(headerData); + typeNameOrId := GetNameOrId(pHeaderData, remaining); + entryNameOrId := GetNameOrId(pHeaderData, remaining); + padding := (4 - (PtrUInt(pHeaderData-PByte(headerData)) and 3)) and 3; + inc(pHeaderData, padding); + dec(remaining, padding); + + FillChar({%H-}info, SizeOf(info), 0); + Move(pHeaderData^, info, Min(Sizeof(info), remaining)); + info.SwapIfNecessary; + + dataStream := TMemoryStream.Create; + if entrySize > 0 then dataStream.CopyFrom(AStream, entrySize); + padding := ((entrySize+3) and not 3) - entrySize; + if padding > 0 then AStream.Read({%H-}dummy, padding); + finally + FreeMem(headerData); + end; + + dataStream.Position := 0; + case typeNameOrId.Id of + RT_BITMAP: result := TBitmapResourceEntry.Create(AContainer,entryNameOrId,info,dataStream); + RT_GROUP_ICON: result := TGroupIconEntry.Create(AContainer,entryNameOrId,info,dataStream); + RT_GROUP_CURSOR: result := TGroupCursorEntry.Create(AContainer,entryNameOrId,info,dataStream); + else + result := TUnformattedResourceEntry.Create(AContainer,typeNameOrId,entryNameOrId,info,dataStream); + end; + end; +end; + +procedure WriteNameOrId(ADestination: TStream; ANameOrId: TNameOrId); +var buffer: PUnicodeChar; + maxLen,actualLen: integer; +begin + if ANameOrId.Id < 0 then + begin + maxLen := length(ANameOrId.Name)*2 + 1; + getmem(buffer, maxLen*sizeof(UnicodeChar)); + try + fillchar(buffer^, maxLen*sizeof(UnicodeChar), 0); + actualLen := Utf8ToUnicode(buffer, maxLen, @ANameOrId.Name[1], length(ANameOrId.Name)); + ADestination.WriteBuffer(buffer^, actualLen*sizeof(UnicodeChar)); + finally + freemem(buffer); + end; + end else + begin + ADestination.WriteWord($ffff); + ADestination.WriteWord(NtoLE(Word(ANameOrId.Id))); + end; +end; + +procedure TCustomResourceEntry.Serialize(ADestination: TStream); +var zero: LongWord; + padding: integer; +begin + SerializeHeader(ADestination); + SerializeData(ADestination); + padding := (4-(GetDataSize and 3)) and 3; + if padding > 0 then + begin + zero := 0; + ADestination.WriteBuffer(zero, padding); + end; +end; + +procedure TCustomResourceEntry.SetLanguageId(AValue: integer); +begin + if (AValue >= 0) and (AValue <= 65535) then + begin + if AValue = LanguageId then exit; + if FTypeNameOrId.Id >= 0 then + begin + if TWinResourceContainer(Container).InternalFind(FEntryNameOrId, FTypeNameOrId, AValue) <> nil then + raise exception.Create('Language id already used for this resource'); + end else + raise exception.Create('Language id cannot be specified for custom types'); + FEntryNameOrId.Id := AValue; + FEntryNameOrId.Name := IntToStr(AValue); + end + else + raise ERangeError.Create('Id out of bounds'); +end; + +procedure TCustomResourceEntry.SerializeHeader(ADestination: TStream); +var + entryHeader: record + EntrySize: integer; + HeaderSize: integer; + end; + headerStream: TMemoryStream; +begin + entryHeader.EntrySize := LEtoN(GetDataSize); + headerStream := TMemoryStream.Create; + try + WriteNameOrId(headerStream,FTypeNameOrId); + WriteNameOrId(headerStream,FEntryNameOrId); + if headerStream.Position and 3 = 2 then headerStream.WriteWord(0); + FResourceInfo.SwapIfNecessary; + try + headerStream.WriteBuffer(FResourceInfo, sizeof(FResourceInfo)); + finally + FResourceInfo.SwapIfNecessary; + end; + entryHeader.HeaderSize := LEtoN(integer(headerStream.Size+8)); + headerStream.Position:= 0; + ADestination.WriteBuffer(entryHeader, sizeof(entryHeader)); + ADestination.CopyFrom(headerStream, headerStream.Size); + if headerStream.Size and 3 = 2 then ADestination.WriteWord(0); + finally + headerStream.Free; + end; +end; + +constructor TCustomResourceEntry.Create(AContainer: TMultiFileContainer; + ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; + const AResourceInfo: TResourceInfo); +begin + inherited Create(AContainer); + FTypeNameOrId := ATypeNameOrId; + FEntryNameOrId := AEntryNameOrId; + FResourceInfo := AResourceInfo; +end; + +function TCustomResourceEntry.GetStream: TStream; +begin + result := nil; + raise exception.Create('Stream not available'); +end; + +procedure TCustomResourceEntry.SetId(AValue: integer); +begin + if (AValue >= 0) and (AValue <= 65535) then + begin + if AValue = FEntryNameOrId.Id then exit; + if TWinResourceContainer(Container).InternalFind(NameOrId(AValue), FTypeNameOrId, LanguageId) <> nil then + raise exception.Create('Id already used for this resource type'); + FEntryNameOrId.Id := AValue; + FEntryNameOrId.Name := IntToStr(AValue); + end + else + raise ERangeError.Create('Id out of bounds'); +end; + +function TCustomResourceEntry.GetName: utf8string; +begin + Result:= FEntryNameOrId.Name; +end; + +procedure TCustomResourceEntry.SetName(AValue: utf8string); +begin + if FEntryNameOrId = NameOrId(AValue) then exit; + if TWinResourceContainer(Container).InternalFind(NameOrId(AValue), FTypeNameOrId, LanguageId) <> nil then + raise exception.Create('Name already used for this resource type'); + FEntryNameOrId.Name := AValue; + FEntryNameOrId.Id := -1; +end; + +function TCustomResourceEntry.GetTypeName: utf8string; +begin + result := FTypeNameOrId.Name; +end; + +procedure TCustomResourceEntry.IncrementReferences; +begin + //nothing +end; + +procedure TCustomResourceEntry.DecrementReferences; +begin + //nothing +end; + +{ TWinResourceContainer } + +procedure TWinResourceContainer.LoadFromStream(AStream: TStream); +var curEntry: TCustomResourceEntry; + i: Integer; +begin + Clear; + repeat + curEntry := TCustomResourceEntry.GetNextEntry(self, AStream); + if curEntry <> nil then + begin + if curEntry.TypeId in [RT_ICON,RT_CURSOR] then + FHiddenEntries.Add(curEntry) + else + AddEntry(curEntry); + end; + until curEntry = nil; + for i := 0 to Count-1 do + TCustomResourceEntry(Entry[i]).IncrementReferences; +end; + +function TWinResourceContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean): integer; +begin + result := IndexOf(AName, AExtenstion, 0, ACaseSensitive); +end; + +function TWinResourceContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; + ALanguageId: integer; ACaseSensitive: boolean): integer; +var + i: Integer; + entryId, errPos: integer; +begin + if AExtenstion = '' then + begin + result := -1; + exit; + end; + if ACaseSensitive then + begin + for i := 0 to Count-1 do + if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id < 0) and + (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Name = AName) and + (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and + (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then + begin + result := i; + exit; + end; + end else + for i := 0 to Count-1 do + if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id < 0) and + (UTF8CompareText(TCustomResourceEntry(Entry[i]).FEntryNameOrId.Name,AName) = 0) and + (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and + (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then + begin + result := i; + exit; + end; + val(AName, entryId, errPos); + if (errPos = 0) and (entryId >= 0) then + begin + for i := 0 to Count-1 do + if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id = entryId) and + (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and + (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then + begin + result := i; + exit; + end; + end; + result := -1; +end; + +procedure TWinResourceContainer.Init; +begin + inherited Init; + FHiddenEntries := TMultiFileEntryList.Create; +end; + +procedure TWinResourceContainer.ClearHiddenEntries; +var i: integer; +begin + if Assigned(FHiddenEntries) then + begin + for i := 0 to FHiddenEntries.Count-1 do + FHiddenEntries[i].Free; + FHiddenEntries.Clear; + end; +end; + +procedure TWinResourceContainer.RemoveHidden(AEntry: TCustomResourceEntry); +var + index: LongInt; +begin + if Assigned(FHiddenEntries) then + begin + index := FHiddenEntries.IndexOf(AEntry); + if index <> -1 then + begin + AEntry.Free; + FHiddenEntries.Delete(index); + end; + end; +end; + +function TWinResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; + AContent: TStream; ALanguageId: integer): TMultiFileEntry; +var + resourceInfo: TResourceInfo; + entryName: TNameOrId; + errPos: integer; +begin + FillChar({%H-}resourceInfo, sizeof(resourceInfo), 0); + resourceInfo.LanguageId := ALanguageId; + val(AName, entryName.Id, errPos); + if (errPos = 0) and (entryName.Id >= 0) then + entryName.Name := IntToStr(entryName.Id) + else + begin + entryName.Id := -1; + entryName.Name := AName; + end; + + case UTF8LowerCase(AExtension) of + 'ico': begin + result := TGroupIconEntry.Create(self, entryName, resourceInfo); + AContent.Position:= 0; + TGroupIconEntry(result).CopyFrom(AContent); + AContent.Free; + end; + 'cur': begin + result := TGroupCursorEntry.Create(self, entryName, resourceInfo); + AContent.Position:= 0; + TGroupCursorEntry(result).CopyFrom(AContent); + AContent.Free; + end; + 'bmp': begin + result := TBitmapResourceEntry.Create(self, entryName, resourceInfo, AContent); + AContent.Position:= 0; + TBitmapResourceEntry(result).CopyFrom(AContent); + AContent.Free; + end; + 'dat': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_RCDATA), entryName, resourceInfo, AContent); + 'html','htm': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_HTML), entryName, resourceInfo, AContent); + 'manifest': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_MANIFEST), entryName, resourceInfo, AContent); + 'ani': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_ANICURSOR), entryName, resourceInfo, AContent); + else + case SuggestImageFormat('.'+AExtension) of + ifUnknown: raise exception.Create('Unhandled file extension'); + else + result := TUnformattedResourceEntry.Create(self, NameOrId(RT_RCDATA), entryName, resourceInfo, AContent); + end; + end; +end; + +function TWinResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; + AContent: TStream): TMultiFileEntry; +begin + result := CreateEntry(AName, AExtension, AContent, 0); +end; + +procedure TWinResourceContainer.Clear; +begin + ClearHiddenEntries; + inherited Clear; +end; + +destructor TWinResourceContainer.Destroy; +begin + ClearHiddenEntries; + FreeAndNil(FHiddenEntries); + inherited Destroy; +end; + +procedure TWinResourceContainer.Delete(AIndex: integer); +begin + if (AIndex >= 0) and (AIndex < Count) then + TCustomResourceEntry(Entry[AIndex]).DecrementReferences; + inherited Delete(AIndex); +end; + +procedure TWinResourceContainer.SaveToStream(ADestination: TStream); +var + i: Integer; +begin + for i := 0 to Count-1 do + TCustomResourceEntry(Entry[i]).Serialize(ADestination); + for i := 0 to FHiddenEntries.Count-1 do + TCustomResourceEntry(FHiddenEntries.Items[i]).Serialize(ADestination); +end; + +function TWinResourceContainer.InternalFind(const AEntry: TNameOrId; + const AType: TNameOrId; ALanguageId: integer): TCustomResourceEntry; +var i: integer; +begin + if Assigned(FHiddenEntries) and (ALanguageId = 0) and (AType.Id >= 0) then + begin + for i := 0 to FHiddenEntries.Count-1 do + if (TCustomResourceEntry(FHiddenEntries.Items[i]).FEntryNameOrId = AEntry) and + (TCustomResourceEntry(FHiddenEntries.Items[i]).FTypeNameOrId = AType) then + begin + result := TCustomResourceEntry(FHiddenEntries.Items[i]); + exit; + end; + end; + for i := 0 to Count-1 do + if (TCustomResourceEntry(Entry[i]).FEntryNameOrId = AEntry) and + (TCustomResourceEntry(Entry[i]).FTypeNameOrId = AType) and + (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then + begin + result := TCustomResourceEntry(Entry[i]); + exit; + end; + result := nil; +end; + +procedure TWinResourceContainer.AddHidden(AEntry: TCustomResourceEntry); +begin + FHiddenEntries.Add(AEntry); +end; + +function TWinResourceContainer.GetMaxId(AType: TNameOrId): integer; +var i: integer; +begin + result := 0; + if Assigned(FHiddenEntries) and (AType.Id >= 0) then + begin + for i := 0 to FHiddenEntries.Count-1 do + if (TCustomResourceEntry(FHiddenEntries.Items[i]).FTypeNameOrId = AType) then + begin + if TCustomResourceEntry(FHiddenEntries.Items[i]).Id > result then result := TCustomResourceEntry(FHiddenEntries.Items[i]).Id; + end; + end; + for i := 0 to Count-1 do + if (TCustomResourceEntry(Entry[i]).FTypeNameOrId = AType) then + begin + if TCustomResourceEntry(Entry[i]).Id > result then result := TCustomResourceEntry(Entry[i]).Id; + end; +end; + +procedure TWinResourceContainer.IncrementReferenceOf(ANameId, ATypeId: integer); +var + item: TCustomResourceEntry; +begin + item := InternalFind(NameOrId(ANameId), NameOrId(ATypeId)); + if Assigned(item) then inc(item.FReferenceCount); +end; + +procedure TWinResourceContainer.DecrementReferenceOf(ANameId, ATypeId: integer); +var + item: TCustomResourceEntry; +begin + item := InternalFind(NameOrId(ANameId), NameOrId(ATypeId)); + if Assigned(item) then + begin + if item.FReferenceCount > 1 then + dec(item.FReferenceCount) + else + RemoveHidden(item); + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawritebmpmiomap.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritebmpmiomap.pas new file mode 100644 index 0000000..42053ac --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritebmpmiomap.pas @@ -0,0 +1,390 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAWriteBmpMioMap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, BGRABitmapTypes, BGRAReadBmpMioMap; + +type + + { TBGRAWriterBmpMioMap } + + TBGRAWriterBmpMioMap = class (TFPCustomImageWriter) + protected + FHeader: TMioHeader; + FPalette: packed array of record + ColorValue: Word; + AlphaValue: Byte; + Padding: Byte; + end; + FPaletteIndexes: packed array[0..65535] of Int32or64; + FPaletteOffset: Int32or64; + FPaletteAlpha: boolean; + FChunks: array of TMemoryStream; + FCurrentChunk: TMemoryStream; + FMaxChunkSize: Word; + function IndexOfColor(const AColor: TBGRAPixel): Int32or64; + procedure InitHeader(Img: TFPCustomImage); + procedure InitPalette; + procedure InitChunks; + procedure FlushChunk; + procedure FreeChunks; + procedure NeedChunk; + procedure AppendToChunks(const Buffer; Count: integer); + procedure BuildPaletteAndChunks(Img: TFPCustomImage); + procedure WriteHeader(Str: TStream); + procedure WritePalette(Str: TStream); + procedure WriteChunks(Str: TStream); + procedure ReadScanline(Img: TFPCustomImage; Y: integer; ADest: PBGRAPixel); + procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; + public + constructor Create; override; + property MaxChunkSize: Word read FMaxChunkSize write FMaxChunkSize; + end; + +implementation + +{ TBGRAWriterBmpMioMap } + +function TBGRAWriterBmpMioMap.IndexOfColor(const AColor: TBGRAPixel): Int32or64; +var searchedColorValue: Word; + searchedAlphaValue: Byte; + i,startSearch,endSearch: Int32or64; +begin + searchedColorValue:= BGRAToMioMap(AColor); + searchedAlphaValue:= AlphaToMioMap(AColor.alpha); + if length(FPalette)>0 then + begin + with FPalette[0] do + begin + if (ColorValue = searchedColorValue) and + (AlphaValue = searchedAlphaValue) then + begin + result := 0; + exit; + end; + end; + end; + + startSearch:= FPaletteOffset+1; + endSearch:= FPaletteOffset+$FC; + if endSearch >= FHeader.nbColors then + endSearch:= FHeader.nbColors-1; + for i := startSearch to endSearch do + with FPalette[i] do + begin + if (ColorValue = searchedColorValue) + and (AlphaValue = searchedAlphaValue) then + begin + result := i; + exit; + end; + end; + + result := FPaletteIndexes[searchedColorValue]; + if (result <> -1) and (FPalette[result].AlphaValue <> searchedAlphaValue) then + result := -1; + + if result = -1 then + begin + if fheader.nbColors = 65535 then + raise exception.Create('Too many colors'); + result := fheader.nbColors; + inc(FHeader.nbColors); + if length(FPalette) <= result then + setlength(FPalette, length(FPalette)*2 + 128); + with FPalette[result] do + begin + ColorValue := searchedColorValue; + AlphaValue := searchedAlphaValue; + end; + FPaletteIndexes[searchedColorValue] := result; + if (searchedAlphaValue > 0) and (searchedAlphaValue < 32) then + FPaletteAlpha := true; + end; +end; + +procedure TBGRAWriterBmpMioMap.InitHeader(Img: TFPCustomImage); +begin + if (Img.Width > 65535) or (Img.Height > 65535) then + raise exception.Create('Image too big to be saved in Bmp MioMap format'); + FHeader.magic := MioMapMagicValue; + fheader.format:= 0; + FHeader.width := Img.Width; + FHeader.height := img.Height; + FHeader.nbColors := 0; + FHeader.nbChunks := 0; +end; + +procedure TBGRAWriterBmpMioMap.InitPalette; +var i: Int32or64; +begin + for i := 0 to high(FPaletteIndexes) do + FPaletteIndexes[i] := -1; + FPaletteOffset := 0; + FPaletteAlpha := false; + IndexOfColor(BGRAPixelTransparent); //define transparent color as zero +end; + +procedure TBGRAWriterBmpMioMap.InitChunks; +begin + FCurrentChunk := nil; +end; + +procedure TBGRAWriterBmpMioMap.FlushChunk; +begin + if FCurrentChunk <> nil then + begin + setlength(FChunks, length(FChunks)+1); + FChunks[high(FChunks)] := FCurrentChunk; + FCurrentChunk := nil; + inc(FHeader.nbChunks); + end; +end; + +procedure TBGRAWriterBmpMioMap.FreeChunks; +var + i: Integer; +begin + FreeAndNil(FCurrentChunk); + for i := 0 to high(FChunks) do + FChunks[i].Free; + FChunks := nil; +end; + +procedure TBGRAWriterBmpMioMap.NeedChunk; +begin + if FCurrentChunk = nil then + begin + if FHeader.nbChunks = 65535 then + raise exception.Create('Too many chunks'); + FCurrentChunk := TMemoryStream.Create; + end; +end; + +procedure TBGRAWriterBmpMioMap.AppendToChunks(const Buffer; Count: integer); +begin + if Count > 65535 then + raise exception.Create('Buffer too big'); + NeedChunk; + if FCurrentChunk.Size + Count > MaxChunkSize then + begin + FlushChunk; + NeedChunk; + end; + FCurrentChunk.WriteBuffer(Buffer,Count); +end; + +procedure TBGRAWriterBmpMioMap.BuildPaletteAndChunks(Img: TFPCustomImage); +var y,w: Int32or64; + PData,PDataEnd: PBGRAPixel; + p: PBGRAPixel; + currentColorIndex, + nextColorIndex, + repCount: Int32or64; + b: byte; + changeOfsRec: packed record + valFD: byte; + valLo: byte; + valHi: byte; + end; + repRec: packed record + valFE: byte; + relativeColorIndex: byte; + count: byte; + end; + repZeroRec: packed record + valFF: byte; + count: byte; + end; + +begin + w := Img.Width; + getmem(PData, w*sizeof(TBGRAPixel)); + try + PDataEnd := PData+w; + for y := 0 to Img.Height-1 do + begin + ReadScanline(Img,Y,PData); + p := PData; + while p < PDataEnd do + begin + currentColorIndex:= IndexOfColor(p^); + nextColorIndex := currentColorIndex; + repCount:= 1; + inc(p); + while p < PDataEnd do + begin + nextColorIndex:= IndexOfColor(p^); + if nextColorIndex = currentColorIndex then + begin + inc(p); + inc(repCount); + if repCount = 255 then break; + end + else + break; + end; + if currentColorIndex = 0 then + begin + if repCount = 1 then + begin + b := 0; + AppendToChunks(b,1); + end else + begin + repZeroRec.valFF := $ff; + repZeroRec.count := repCount; + AppendToChunks(repZeroRec, sizeof(repZeroRec)); + end; + end else + begin + if (currentColorIndex < FPaletteOffset+1) + or (currentColorIndex > FPaletteOffset+$FC) then + begin + if (abs(nextColorIndex-currentColorIndex) < $FC) then + begin + FPaletteOffset := (nextColorIndex+currentColorIndex) div 2 - 126; + end else + FPaletteOffset := currentColorIndex-126; + if FPaletteOffset < 0 then FPaletteOffset := 0; + changeOfsRec.valFD := $fd; + changeOfsRec.valLo := FPaletteOffset and 255; + changeOfsRec.valHi := FPaletteOffset shr 8; + AppendToChunks(changeOfsRec,sizeof(changeOfsRec)); + end; + if (currentColorIndex < FPaletteOffset+1) + or (currentColorIndex > FPaletteOffset+$FC) then + raise exception.Create('Index out of range'); + if repCount = 1 then + begin + b := currentColorIndex-FPaletteOffset; + AppendToChunks(b,1); + end else + if repCount = 2 then + begin + b := currentColorIndex-FPaletteOffset; + AppendToChunks(b,1); + AppendToChunks(b,1); + end else + begin + repRec.valFE:= $FE; + repRec.count := repCount; + repRec.relativeColorIndex := currentColorIndex-FPaletteOffset; + AppendToChunks(repRec, sizeof(repRec)); + end; + end; + end; + FlushChunk; + end; + finally + freemem(PData); + end; +end; + +procedure TBGRAWriterBmpMioMap.WriteChunks(Str: TStream); +var + bigChunkDef: packed record + val255: byte; + valHi: byte; + valLo: byte; + end; + i: Int32or64; +begin + for i := 0 to high(FChunks) do + begin + if FChunks[i].Size > 254 then + begin + bigChunkDef.val255 := 255; + bigChunkDef.valHi := FChunks[i].Size shr 8; + bigChunkDef.valLo := FChunks[i].Size and 255; + Str.WriteBuffer(bigChunkDef, sizeof(bigChunkDef)); + end else + Str.WriteByte(FChunks[i].Size); + end; + for i := 0 to high(FChunks) do + begin + FChunks[i].Position := 0; + if Str.CopyFrom(FChunks[i],FChunks[i].Size) <> FChunks[i].Size then + raise exception.Create('Unable to write chunk'); + end; +end; + +procedure TBGRAWriterBmpMioMap.WriteHeader(Str: TStream); +var header: TMioHeader; +begin + if FPaletteAlpha then FHeader.format := 1; + FlushChunk; + + header := FHeader; + header.format:= NtoLE(header.format); + header.width:= NtoLE(header.width); + header.height:= NtoLE(header.height); + header.nbColors:= NtoLE(header.nbColors); + header.nbChunks:= NtoLE(header.nbChunks); + Str.WriteBuffer(header, sizeof(header)); +end; + +procedure TBGRAWriterBmpMioMap.WritePalette(Str: TStream); +var + colors: packed array of Word; + alphas: packed array of byte; + i: Int32or64; +begin + setlength(Colors, FHeader.nbColors); + for i := 0 to FHeader.nbColors-1 do + colors[i] := NtoLE(FPalette[i].ColorValue); + Str.WriteBuffer(colors[0], length(Colors)*sizeof(word)); + if FPaletteAlpha then + begin + setlength(alphas, FHeader.nbColors); + for i := 0 to FHeader.nbColors-1 do + alphas[i] := FPalette[i].AlphaValue; + Str.WriteBuffer(alphas[0], length(alphas)*sizeof(byte)); + end; +end; + +procedure TBGRAWriterBmpMioMap.ReadScanline(Img: TFPCustomImage; Y: integer; + ADest: PBGRAPixel); +var + i: Int32or64; +begin + if Img is TBGRACustomBitmap then + Move(TBGRACustomBitmap(Img).ScanLine[Y]^, ADest^, Img.Width*sizeof(TBGRAPixel)) + else + begin + for i := 0 to Img.Width-1 do + (ADest+i)^ := FPColorToBGRA(Img.Colors[y,i]); + end; +end; + +procedure TBGRAWriterBmpMioMap.InternalWrite(Str: TStream; Img: TFPCustomImage); +begin + try + InitHeader(Img); + InitPalette; + InitChunks; + BuildPaletteAndChunks(Img); + WriteHeader(Str); + WritePalette(Str); + WriteChunks(Str); + finally + FreeChunks; + end; +end; + +constructor TBGRAWriterBmpMioMap.Create; +begin + inherited Create; + MaxChunkSize := 254; +end; + +initialization + + DefaultBGRAImageWriter[ifBmpMioMap] := TBGRAWriterBmpMioMap; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawritelzp.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritelzp.pas new file mode 100644 index 0000000..cff2638 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritelzp.pas @@ -0,0 +1,430 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAWriteLzp; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap; + +type + { TBGRAWriterLazPaint } + + TBGRAWriterLazPaint = class(TFPCustomImageWriter) + private + function GetCompression: TLzpCompression; + function GetIncludeThumbnail: boolean; + procedure SetCompression(AValue: TLzpCompression); + procedure SetIncludeThumbnail(AValue: boolean); + function WriteThumbnail(Str: TStream; Img: TFPCustomImage): boolean; + protected + CompressionMode: LongWord; + procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; + function InternalWriteLayers({%H-}Str: TStream; {%H-}Img: TFPCustomImage): boolean; virtual; + function GetNbLayers: integer; virtual; + public + Caption: string; + constructor Create; override; + class procedure WriteRLEImage(Str: TStream; Img: TFPCustomImage; ACaption: string= ''); static; + property Compression: TLzpCompression read GetCompression write SetCompression; + property IncludeThumbnail: boolean read GetIncludeThumbnail write SetIncludeThumbnail; + end; + +implementation + +uses BGRACompressableBitmap; + +{ TBGRAWriterLazPaint } + +function TBGRAWriterLazPaint.WriteThumbnail(Str: TStream; Img: TFPCustomImage): boolean; +var w,h: integer; + thumbStream: TStream; + OldResampleFilter: TResampleFilter; + thumbnail: TBGRACustomBitmap; +begin + result := false; + if not (Img is TBGRACustomBitmap) then exit; + if (Img.Width > LazpaintThumbMaxWidth) or + (Img.Height > LazpaintThumbMaxHeight) then + begin + if Img.Width > LazpaintThumbMaxWidth then + begin + w := LazpaintThumbMaxWidth; + h := round(Img.Height* (w/Img.Width)); + end else + begin + w := Img.Width; + h := Img.Height; + end; + if h > LazpaintThumbMaxHeight then + begin + h := LazpaintThumbMaxHeight; + w := round(Img.Width* (h/Img.Height)); + end; + OldResampleFilter:= TBGRACustomBitmap(Img).ResampleFilter; + TBGRACustomBitmap(Img).ResampleFilter:= rfMitchell; + thumbnail := TBGRACustomBitmap(Img).Resample(w,h,rmFineResample); + TBGRACustomBitmap(Img).ResampleFilter := OldResampleFilter; + + try + thumbStream := TMemoryStream.Create; + try + thumbnail.SaveToStreamAsPng(thumbStream); + thumbStream.Position:= 0; + Str.CopyFrom(thumbStream, thumbStream.Size); + result := true; + finally + thumbStream.Free; + end; + finally + thumbnail.Free; + end; + end else + begin + thumbStream := TMemoryStream.Create; + try + TBGRACustomBitmap(Img).SaveToStreamAsPng(thumbStream); + thumbStream.Position:= 0; + Str.CopyFrom(thumbStream, thumbStream.Size); + result := true; + finally + thumbStream.Free; + end; + end; +end; + +function TBGRAWriterLazPaint.GetCompression: TLzpCompression; +begin + if (CompressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_ZSTREAM then + result := lzpZStream + else + result := lzpRLE; +end; + +function TBGRAWriterLazPaint.GetIncludeThumbnail: boolean; +begin + result := (CompressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0; +end; + +procedure TBGRAWriterLazPaint.SetCompression(AValue: TLzpCompression); +begin + if AValue = lzpZStream then + CompressionMode := (CompressionMode and not LAZPAINT_COMPRESSION_MASK) or LAZPAINT_COMPRESSION_MODE_ZSTREAM + else + CompressionMode := (CompressionMode and not LAZPAINT_COMPRESSION_MASK) or LAZPAINT_COMPRESSION_MODE_RLE; +end; + +procedure TBGRAWriterLazPaint.SetIncludeThumbnail(AValue: boolean); +begin + if AValue then + CompressionMode := CompressionMode or LAZPAINT_THUMBNAIL_PNG else + CompressionMode := CompressionMode and not LAZPAINT_THUMBNAIL_PNG; +end; + +procedure TBGRAWriterLazPaint.InternalWrite(Str: TStream; Img: TFPCustomImage); +var {%H-}header: TLazPaintImageHeader; + compBmp: TBGRACompressableBitmap; + startPos, endPos: int64; +begin + startPos := str.Position; + fillchar({%H-}header,sizeof(header),0); + header.magic := LAZPAINT_MAGIC_HEADER; + header.zero1 := 0; + header.headerSize:= sizeof(header); + header.width := Img.Width; + header.height := img.Height; + header.nbLayers:= GetNbLayers; + header.previewOffset:= 0; + header.zero2 := 0; + header.compressionMode:= CompressionMode; + header.reserved1:= 0; + header.layersOffset:= 0; + LazPaintImageHeader_SwapEndianIfNeeded(header); + str.WriteBuffer(header,sizeof(header)); + LazPaintImageHeader_SwapEndianIfNeeded(header); + + if IncludeThumbnail then + if not WriteThumbnail(Str, Img) then + begin + IncludeThumbnail := false; + header.compressionMode:= CompressionMode; //update field for thumbnail + end; + + header.previewOffset:= Str.Position - startPos; + if Compression = lzpRLE then + WriteRLEImage(Str, Img, Caption) + else + begin + compBmp := TBGRACompressableBitmap.Create(Img as TBGRABitmap); + compBmp.Caption := Caption; + compBmp.WriteToStream(Str); + compBmp.Free; + end; + + endPos := str.Position; + if InternalWriteLayers(Str, Img) then + begin + header.layersOffset := endPos - startPos; + endPos := str.Position; + end; + + str.Position:= startPos; + LazPaintImageHeader_SwapEndianIfNeeded(header); + str.WriteBuffer(header,sizeof(header)); + str.Position:= endPos; +end; + +function TBGRAWriterLazPaint.InternalWriteLayers(Str: TStream; + Img: TFPCustomImage): boolean; +begin + result := false; +end; + +function TBGRAWriterLazPaint.GetNbLayers: integer; +begin + result := 1; +end; + +constructor TBGRAWriterLazPaint.Create; +begin + inherited Create; + CompressionMode:= LAZPAINT_COMPRESSION_MODE_RLE; +end; + +class procedure TBGRAWriterLazPaint.WriteRLEImage(Str: TStream; + Img: TFPCustomImage; ACaption: string); +const PossiblePlanes = 4; +var + PPlane,PPlaneCur: array[0..PossiblePlanes-1] of PByte; + CompressedPlane: array[0..PossiblePlanes-1] of TMemoryStream; + NbPixels, NbNonTranspPixels, NbOpaquePixels: integer; + Colors: array[0..255] of Int32or64; + ColorCount: Int32or64; + CompressedRGB: array[0..3] of TMemoryStream; + ColorTab: packed array[0..256*3-1] of byte; + Indexed: PByte; + NonRGBSize,RGBSize: int64; + + procedure OutputPlane(AIndex: integer); + begin + str.WriteDWord(NtoLE(LongWord(CompressedPlane[AIndex].Size))); + CompressedPlane[AIndex].Position:= 0; + str.CopyFrom(CompressedPlane[AIndex],CompressedPlane[AIndex].Size); + end; + + procedure OutputRGB(AIndex: integer); + begin + str.WriteDWord(NtoLE(LongWord(CompressedRGB[AIndex].Size))); + CompressedRGB[AIndex].Position:= 0; + str.CopyFrom(CompressedRGB[AIndex],CompressedRGB[AIndex].Size); + end; + + function BuildPalette: boolean; + var n,i: Int32or64; + lastColor,color,colorIndex: Int32or64; + found: boolean; + begin + ColorCount := 0; + ColorIndex := 0; + lastColor := -1; + GetMem(Indexed, NbNonTranspPixels); + for n := 0 to NbNonTranspPixels-1 do + begin + color := (PPlane[0]+n)^+ ((PPlane[1]+n)^ shl 8)+ ((PPlane[2]+n)^ shl 16); + if color = lastColor then + begin + (Indexed+n)^ := ColorIndex; + continue; + end; + found := false; + for i := 0 to ColorCount-1 do + begin + if colors[i] = color then + begin + found := true; + ColorIndex := i; + break; + end; + end; + if not found then + begin + inc(ColorCount); + if ColorCount > 256 then + begin + result := false; + ReAllocMem(Indexed,0); + exit; + end; + colors[colorCount-1] := color; + ColorIndex := ColorCount-1; + end; + (Indexed+n)^ := ColorIndex; + lastColor := color; + end; + result := true; + end; + +var + i,x,y: integer; + PlaneFlags: Byte; + a: Int32or64; + psrc: PBGRAPixel; + +begin + NbPixels := Img.Width*img.Height; + + for i := 0 to PossiblePlanes-1 do + begin + getmem(PPlane[i],NbPixels); + PPlaneCur[i] := PPlane[i]; + CompressedPlane[i] := nil; + end; + + NbNonTranspPixels := 0; + NbOpaquePixels:= 0; + if img is TBGRACustomBitmap then + begin + for y := 0 to img.Height-1 do + begin + psrc := TBGRACustomBitmap(img).ScanLine[y]; + for x := img.Width-1 downto 0 do + begin + with psrc^ do + begin + PPlaneCur[3]^ := alpha; + inc(PPlaneCur[3]); + if alpha = 0 then begin inc(psrc); continue; end; + if alpha = 255 then inc(NbOpaquePixels); + + inc(NbNonTranspPixels); + PPlaneCur[0]^ := red; + PPlaneCur[1]^ := green; + PPlaneCur[2]^ := blue; + inc(PPlaneCur[0]); + inc(PPlaneCur[1]); + inc(PPlaneCur[2]); + end; + inc(psrc); + end; + end; + end else + for y := 0 to img.Height-1 do + for x := 0 to img.Width-1 do + begin + with img.Colors[x,y] do + begin + a := alpha shr 8; + PPlaneCur[3]^ := a; + inc(PPlaneCur[3]); + if a = 0 then continue; + if a = 255 then inc(NbOpaquePixels); + + inc(NbNonTranspPixels); + PPlaneCur[0]^ := red shr 8; + PPlaneCur[1]^ := green shr 8; + PPlaneCur[2]^ := blue shr 8; + inc(PPlaneCur[0]); + inc(PPlaneCur[1]); + inc(PPlaneCur[2]); + end; + end; + + PlaneFlags := 0; + if NbOpaquePixels = NbPixels then PlaneFlags := PlaneFlags or LazpaintChannelNoAlpha; + if CompareMem(PPlane[1],PPlane[0],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelGreenFromRed; + if CompareMem(PPlane[2],PPlane[0],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelBlueFromRed else + if CompareMem(PPlane[2],PPlane[1],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelBlueFromGreen; + + //if we cannot reduce to one plane, maybe we will have more luck with a palette + for i := 0 to 3 do CompressedRGB[i] := nil; + Indexed := nil; + RGBSize := 0; + if ((PlaneFlags and LazpaintChannelGreenFromRed) = 0) or + ((PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0) and (NbNonTranspPixels > 0) then + begin + if BuildPalette then + begin + if ColorCount shl 1 < NbNonTranspPixels then + begin + fillchar({%H-}ColorTab, sizeof(ColorTab), 0); + for i := 0 to ColorCount-1 do + begin + colorTab[i] := Colors[i] and 255; + colorTab[i+256] := (Colors[i] shr 8) and 255; + colorTab[i+512] := (Colors[i] shr 16) and 255; + end; + CompressedRGB[0] := TMemoryStream.Create; + EncodeLazRLE(colorTab[0], ColorCount, CompressedRGB[0]); + if (PlaneFlags and LazpaintChannelGreenFromRed) = 0 then + begin + CompressedRGB[1] := TMemoryStream.Create; + EncodeLazRLE(colorTab[256], ColorCount, CompressedRGB[1]); + end; + if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0 then + begin + CompressedRGB[2] := TMemoryStream.Create; + EncodeLazRLE(colorTab[512], ColorCount, CompressedRGB[2]); + end; + CompressedRGB[3] := TMemoryStream.Create; + EncodeLazRLE(Indexed^,NbNonTranspPixels,CompressedRGB[3]); + + for i := 0 to 3 do + if CompressedRGB[i] <> nil then + inc(RGBSize,CompressedRGB[i].Size); + end; + ReAllocMem(Indexed,0); + end; + end; + + if (PlaneFlags and LazpaintChannelGreenFromRed) <> 0 then ReAllocMem(PPlane[1],0); + if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) <> 0 then ReAllocMem(PPlane[2],0); + + NonRGBSize := 0; + for i := 0 to PossiblePlanes-1 do + if PPlane[i] <> nil then + begin + CompressedPlane[i] := TMemoryStream.Create; + if i = 3 then + EncodeLazRLE(PPlane[i]^, NbPixels,CompressedPlane[i]) + else + EncodeLazRLE(PPlane[i]^, NbNonTranspPixels,CompressedPlane[i]); + inc(NonRGBSize, CompressedPlane[i].Size); + end; + + if (CompressedRGB[3] <> nil) and (NonRGBSize > RGBSize) then + PlaneFlags:= PlaneFlags or LazpaintPalettedRGB; + + str.WriteDWord(NtoLE(LongWord(img.width))); + str.WriteDWord(NtoLE(LongWord(img.Height))); + str.WriteDWord(NtoLE(LongWord(length(ACaption)))); + if length(ACaption)>0 then str.WriteBuffer(ACaption[1],length(ACaption)); + str.WriteByte(PlaneFlags); + + if (PlaneFlags and LazpaintChannelNoAlpha) = 0 then OutputPlane(3); + if (PlaneFlags and LazpaintPalettedRGB) <> 0 then + begin + for i := 0 to 3 do + if CompressedRGB[i] <> nil then + OutputRGB(i); + end else + begin + OutputPlane(0); + if (PlaneFlags and LazpaintChannelGreenFromRed) = 0 then OutputPlane(1); + if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0 then OutputPlane(2); + end; + + for i := 0 to PossiblePlanes-1 do + begin + freemem(PPlane[i]); + CompressedPlane[i].Free; + end; + for i := 0 to 3 do + CompressedRGB[i].Free; +end; + +initialization + + DefaultBGRAImageWriter[ifLazPaint] := TBGRAWriterLazPaint; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawritepng.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritepng.pas new file mode 100644 index 0000000..4613e09 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritepng.pas @@ -0,0 +1,965 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + The original file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + PNG writer class modified by circular. + + ********************************************************************** + + Fix for images with grayscale and alpha, + and for images with transparent pixels + } +unit BGRAWritePNG; + +{$mode objfpc}{$H+} + +interface + + +uses sysutils, BGRAClasses, FPImage, FPImgCmn, PNGcomn, ZStream, BGRABitmapTypes; + +type + THeaderChunk = packed record + Width, height : LongWord; + BitDepth, ColorType, Compression, Filter, Interlace : byte; + end; + + TGetPixelFunc = function (x,y : LongWord) : TColorData of object; + TGetPixelBGRAFunc = function (p: PBGRAPixel) : TColorData of object; + + TColorFormatFunction = function (color:TFPColor) : TColorData of object; + + { TBGRAWriterPNG } + + TBGRAWriterPNG = class (TBGRACustomWriterPNG) + private + FUsetRNS, FCompressedText, FWordSized, FIndexed, + FUseAlpha, FGrayScale : boolean; + FByteWidth : byte; + FChunk : TChunk; + CFmt : TColorFormat; // format of the colors to convert from + FFmtColor : TColorFormatFunction; + FTransparentColor : TFPColor; + FTransparentColorOk: boolean; + FSwitchLine, FCurrentLine, FPreviousLine : pByteArray; + FPalette : TFPPalette; + OwnsPalette : boolean; + FHeader : THeaderChunk; + FGetPixel : TGetPixelFunc; + FGetPixelBGRA : TGetPixelBGRAFunc; + FDatalineLength : LongWord; + ZData : TMemoryStream; // holds uncompressed data until all blocks are written + Compressor : TCompressionStream; // compresses the data + FCompressionLevel : TCompressionLevel; + procedure WriteChunk; + function GetColorPixel (x,y:LongWord) : TColorData; + function GetPalettePixel (x,y:LongWord) : TColorData; + function GetColPalPixel (x,y:LongWord) : TColorData; + function GetColorPixelBGRA (p: PBGRAPixel) : TColorData; + function GetPalettePixelBGRA (p: PBGRAPixel) : TColorData; + function GetColPalPixelBGRA (p: PBGRAPixel) : TColorData; + procedure InitWriteIDAT; + procedure Gatherdata; + procedure WriteCompressedData; + procedure FinalWriteIDAT; + protected + property Header : THeaderChunk read FHeader; + procedure InternalWrite ({%H-}Str:TStream; {%H-}Img:TFPCustomImage); override; + function GetUseAlpha: boolean; override; + procedure SetUseAlpha(AValue: boolean); override; + procedure WriteIHDR; virtual; + procedure WritePLTE; virtual; + procedure WritetRNS; virtual; + procedure WriteIDAT; virtual; + procedure WriteTexts; virtual; + procedure WriteIEND; virtual; + function CurrentLine (x:LongWord) : byte; inline; + function PrevSample (x:LongWord): byte; inline; + function PreviousLine (x:LongWord) : byte; inline; + function PrevLinePrevSample (x:LongWord): byte; inline; + function DoFilter (LineFilter:byte;index:LongWord; b:byte) : byte; virtual; + procedure SetChunkLength (aValue : LongWord); + procedure SetChunkType (ct : TChunkTypes); overload; + procedure SetChunkType (ct : TChunkCode); overload; + function DecideGetPixel : TGetPixelFunc; virtual; + function DecideGetPixelBGRA : TGetPixelBGRAFunc; virtual; + procedure DetermineHeader (var AHeader : THeaderChunk); virtual; + function DetermineFilter ({%H-}Current, {%H-}Previous:PByteArray; {%H-}linelength:LongWord):byte; virtual; + procedure FillScanLine (y : integer; ScanLine : pByteArray); virtual; + function ColorDataGrayB(color:TFPColor) : TColorData; + function ColorDataColorB(color:TFPColor) : TColorData; + function ColorDataGrayW(color:TFPColor) : TColorData; + function ColorDataColorW(color:TFPColor) : TColorData; + function ColorDataGrayAB(color:TFPColor) : TColorData; + function ColorDataColorAB(color:TFPColor) : TColorData; + function ColorDataGrayAW(color:TFPColor) : TColorData; + function ColorDataColorAW(color:TFPColor) : TColorData; + property ChunkDataBuffer : pByteArray read FChunk.data; + property UsetRNS : boolean read FUsetRNS; + property SingleTransparentColor : TFPColor read FTransparentColor; + property SingleTransparentColorOk : boolean read FTransparentColorOk; + property ThePalette : TFPPalette read FPalette; + property ColorFormat : TColorformat read CFmt; + property ColorFormatFunc : TColorFormatFunction read FFmtColor; + property byteWidth : byte read FByteWidth; + property DatalineLength : LongWord read FDatalineLength; + public + constructor create; override; + destructor destroy; override; + property GrayScale : boolean read FGrayscale write FGrayScale; + property Indexed : boolean read FIndexed write FIndexed; + property CompressedText : boolean read FCompressedText write FCompressedText; + property WordSized : boolean read FWordSized write FWordSized; + property CompressionLevel : TCompressionLevel read FCompressionLevel write FCompressionLevel; + end; + +implementation + +constructor TBGRAWriterPNG.create; +begin + inherited; + Fchunk.acapacity := 0; + Fchunk.data := nil; + FGrayScale := False; + FIndexed := False; + FCompressedText := True; + FWordSized := False; + FUseAlpha := True; + FCompressionLevel:=clDefault; +end; + +destructor TBGRAWriterPNG.destroy; +begin + if OwnsPalette then FreeAndNil(FPalette); + with Fchunk do + if acapacity > 0 then + freemem (data); + inherited; +end; + +procedure TBGRAWriterPNG.WriteChunk; +var chead : TChunkHeader; + c : LongWord; +begin + with FChunk do + begin + {$IFDEF ENDIAN_LITTLE} + chead.CLength := swap (alength); + {$ELSE} + chead.CLength := alength; + {$ENDIF} + if (ReadType = '') then + if atype <> ctUnknown then + chead.CType := ChunkTypes[aType] + else + raise PNGImageException.create ('Doesn''t have a chunktype to write') + else + chead.CType := ReadType; + c := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType)); + c := CalculateCRC (c, data^, alength); + {$IFDEF ENDIAN_LITTLE} + crc := swap(c xor All1Bits); + {$ELSE} + crc := c xor All1Bits; + {$ENDIF} + with TheStream do + begin + Write (chead, sizeof(chead)); + Write (data^[0], alength); + Write (crc, sizeof(crc)); + end; + end; +end; + +procedure TBGRAWriterPNG.SetChunkLength(aValue : LongWord); +begin + with Fchunk do + begin + alength := aValue; + if aValue > acapacity then + begin + if acapacity > 0 then + freemem (data); + GetMem (data, alength); + acapacity := alength; + end; + end; +end; + +procedure TBGRAWriterPNG.SetChunkType (ct : TChunkTypes); +begin + with Fchunk do + begin + aType := ct; + ReadType := ChunkTypes[ct]; + end; +end; + +procedure TBGRAWriterPNG.SetChunkType (ct : TChunkCode); +begin + with FChunk do + begin + ReadType := ct; + aType := low(TChunkTypes); + while (aType < high(TChunkTypes)) and (ChunkTypes[aType] <> ct) do + inc (aType); + end; +end; + +function TBGRAWriterPNG.CurrentLine(x:LongWord):byte; +begin + result := FCurrentLine^[x]; +end; + +function TBGRAWriterPNG.PrevSample (x:LongWord): byte; +begin + if x < byteWidth then + result := 0 + else + result := FCurrentLine^[x - bytewidth]; +end; + +function TBGRAWriterPNG.PreviousLine (x:LongWord) : byte; +begin + result := FPreviousline^[x]; +end; + +function TBGRAWriterPNG.PrevLinePrevSample (x:LongWord): byte; +begin + if x < byteWidth then + result := 0 + else + result := FPreviousLine^[x - bytewidth]; +end; + +function TBGRAWriterPNG.DoFilter(LineFilter:byte;index:LongWord; b:byte) : byte; +var diff : byte; + procedure FilterSub; + begin + diff := PrevSample(index); + end; + procedure FilterUp; + begin + diff := PreviousLine(index); + end; + procedure FilterAverage; + var l, p : word; + begin + l := PrevSample(index); + p := PreviousLine(index); + Diff := (l + p) div 2; + end; + procedure FilterPaeth; + var dl, dp, dlp : word; // index for previous and distances for: + l, p, lp : byte; // r:predictor, Left, Previous, LeftPrevious + r : integer; + begin + l := PrevSample(index); + lp := PrevLinePrevSample(index); + p := PreviousLine(index); + r := Int32or64(l) + Int32or64(p) - Int32or64(lp); + dl := abs (r - l); + dlp := abs (r - lp); + dp := abs (r - p); + if (dl <= dp) and (dl <= dlp) then + diff := l + else if dp <= dlp then + diff := p + else + diff := lp; + end; +begin + case LineFilter of + 0 : diff := 0; + 1 : FilterSub; + 2 : FilterUp; + 3 : FilterAverage; + 4 : FilterPaeth; + end; + if diff > b then + result := (b + $100 - diff) + else + result := b - diff; +end; + +procedure TBGRAWriterPNG.DetermineHeader (var AHeader : THeaderChunk); +var c : integer; + + function ReducedColorEquals(const c1,c2: TFPColor): boolean; + var g1,g2: word; + begin + if FGrayScale then + begin + g1 := CalculateGray(c1); + g2 := CalculateGray(c2); + if fwordsized then + result := (g1 = g2) + else + result := (g1 shr 8 = g2 shr 8); + end else + begin + if FWordSized then + result := (c1.red = c2.red) and (c1.green = c2.green) and (c1.blue = c2.blue) + else + result := (c1.red shr 8 = c2.red shr 8) and (c1.green shr 8 = c2.green shr 8) and (c1.blue shr 8 = c2.blue shr 8); + end; + end; + + function CountAlphas : integer; + var none, half : boolean; + maxTransparentAlpha: word; + + procedure CountFromPalettedImage; + var + p : integer; + a : word; + c : TFPColor; + begin + with TheImage.Palette do + begin + p := count-1; + FTransparentColor.alpha := alphaOpaque; + while (p >= 0) do + begin + c := color[p]; + a := c.Alpha; + if a < FTransparentColor.alpha then //we're looking for the most transparent color + FTransparentColor := c; + if a <= maxTransparentAlpha then none := true + else if a <> alphaOpaque then half := true; + dec (p); + end; + + //check transparent color is used consistently + FTransparentColorOk := true; + p := count-1; + while (p >= 0) do + begin + c := color[p]; + if c.alpha > maxTransparentAlpha then + begin + if ReducedColorEquals(c, FTransparentColor) then + begin + FTransparentColorOk := false; + break; + end; + end + else + begin + if not ReducedColorEquals(c, FTransparentColor) then + begin + FTransparentColorOk := false; + break; + end; + end; + dec(p); + end; + end; + end; + + procedure CountFromRGBImage; + var + a : word; + c : TFPColor; + x,y : longint; // checks on < 0 + begin + with TheImage do + begin + x := width-1; + y := height-1; + FTransparentColor.alpha := alphaOpaque; + while (y >= 0) and not half do //we stop if we already need a full alpha + begin + c := colors[x,y]; + a := c.Alpha; + if a < FTransparentColor.alpha then //we're looking for the most transparent color + FTransparentColor := c; + if a <= maxTransparentAlpha then none := true + else if a <> alphaOpaque then half := true; + dec (x); + if (x < 0) then + begin + dec (y); + x := width-1; + end; + end; + + //check transparent color is used consistently + FTransparentColorOk := true; + x := width-1; + y := height-1; + while (y >= 0) do + begin + c := colors[x,y]; + if c.alpha > maxTransparentAlpha then + begin + if ReducedColorEquals(c, FTransparentColor) then + begin + FTransparentColorOk := false; + break; + end; + end + else + begin + if not ReducedColorEquals(c, FTransparentColor) then + begin + FTransparentColorOk := false; + break; + end; + end; + dec (x); + if (x < 0) then + begin + dec (y); + x := width-1; + end; + end; + end; + end; + + begin + FTransparentColorOk := false; + if FWordSized then maxTransparentAlpha := 0 + else maxTransparentAlpha := $00ff; + half := false; + none := false; + with TheImage do + if UsePalette then + CountFromPalettedImage + else + CountFromRGBImage; + + if half then + result := 3 + else + if none then + begin + if FTransparentColorOk then + result := 2 + else + result := 3; + end + else + result := 1; + end; + procedure DetermineColorFormat; + begin + with AHeader do + case colortype of + 0 : if FWordSized then + begin + FFmtColor := @ColorDataGrayW; + FByteWidth := 2; + //CFmt := cfGray16 + end + else + begin + FFmtColor := @ColorDataGrayB; + FByteWidth := 1; + //CFmt := cfGray8; + end; + 2 : if FWordSized then + begin + FFmtColor := @ColorDataColorW; + FByteWidth := 6; + //CFmt := cfBGR48 + end + else + begin + FFmtColor := @ColorDataColorB; + FByteWidth := 3; + //CFmt := cfBGR24; + end; + 4 : if FWordSized then + begin + FFmtColor := @ColorDataGrayAW; + FByteWidth := 4; + //CFmt := cfGrayA32 + end + else + begin + FFmtColor := @ColorDataGrayAB; + FByteWidth := 2; + //CFmt := cfGrayA16; + end; + 6 : if FWordSized then + begin + FFmtColor := @ColorDataColorAW; + FByteWidth := 8; + //CFmt := cfABGR64 + end + else + begin + FFmtColor := @ColorDataColorAB; + FByteWidth := 4; + //CFmt := cfABGR32; + end; + end; + end; +begin + with AHeader do + begin + {$IFDEF ENDIAN_LITTLE} + // problem: TheImage has integer width, PNG header LongWord width. + // Integer Swap can give negative value + Width := swap (LongWord(TheImage.Width)); + height := swap (LongWord(TheImage.Height)); + {$ELSE} + Width := TheImage.Width; + height := TheImage.Height; + {$ENDIF} + if FUseAlpha then + c := CountAlphas + else + c := 0; + if FIndexed then + begin + if OwnsPalette then FreeAndNil(FPalette); + OwnsPalette := not TheImage.UsePalette; + if OwnsPalette then + begin + FPalette := TFPPalette.Create (16); + FPalette.Build (TheImage); + end + else + FPalette := TheImage.Palette; + if ThePalette.count > 256 then + raise PNGImageException.Create ('Too many colors to use indexed PNG color type'); + ColorType := 3; + FUsetRNS := C > 1; + BitDepth := 8; + FByteWidth := 1; + end + else + begin + if c = 3 then + ColorType := 4; + FUsetRNS := (c = 2); + if not FGrayScale then + ColorType := ColorType + 2; + if FWordSized then + BitDepth := 16 + else + BitDepth := 8; + DetermineColorFormat; + end; + Compression := 0; + Filter := 0; + Interlace := 0; + end; +end; + +procedure TBGRAWriterPNG.WriteIHDR; +begin + // signature for PNG + TheStream.writeBuffer(Signature,sizeof(Signature)); + // Determine all settings for filling the header + fillchar(fheader,sizeof(fheader),#0); + DetermineHeader (FHeader); + // write the header chunk + SetChunkLength (sizeof(FHeader)); + move (FHeader, ChunkDataBuffer^, sizeof(FHeader)); + SetChunkType (ctIHDR); + WriteChunk; +end; + +{ Color convertions } + +function TBGRAWriterPNG.ColorDataGrayB(color:TFPColor) : TColorData; +var t : word; +begin + t := CalculateGray (color); + result := hi(t); +end; + +function TBGRAWriterPNG.ColorDataGrayW(color:TFPColor) : TColorData; +begin + result := CalculateGray (color); +end; + +function TBGRAWriterPNG.ColorDataGrayAB(color:TFPColor) : TColorData; +begin + result := ColorDataGrayB (color); + result := (color.Alpha and $ff00) or result; +end; + +function TBGRAWriterPNG.ColorDataGrayAW(color:TFPColor) : TColorData; +begin + result := ColorDataGrayW (color); + result := (color.Alpha shl 16) or result; +end; + +function TBGRAWriterPNG.ColorDataColorB(color:TFPColor) : TColorData; +begin + {$PUSH}{$HINTS OFF} + with color do + result := hi(red) + (green and $FF00) + (hi(blue) shl 16); + {$POP} +end; + +function TBGRAWriterPNG.ColorDataColorW(color:TFPColor) : TColorData; +begin + {$PUSH}{$HINTS OFF} + with color do + result := red + (green shl 16) + (qword(blue) shl 32); + {$POP} +end; + +function TBGRAWriterPNG.ColorDataColorAB(color:TFPColor) : TColorData; +begin + {$PUSH}{$HINTS OFF} + with color do + result := hi(red) + (green and $FF00) + (hi(blue) shl 16) + (hi(alpha) shl 24); + {$POP} +end; + +function TBGRAWriterPNG.ColorDataColorAW(color:TFPColor) : TColorData; +begin + {$PUSH}{$HINTS OFF} + with color do + result := red + (green shl 16) + (qword(blue) shl 32) + (qword(alpha) shl 48); + {$POP} +end; + +{ Data making routines } + +function TBGRAWriterPNG.GetColorPixel (x,y:LongWord) : TColorData; +begin + result := FFmtColor (TheImage[x,y]); +end; + +function TBGRAWriterPNG.GetPalettePixel (x,y:LongWord) : TColorData; +begin + result := TheImage.Pixels[x,y]; +end; + +function TBGRAWriterPNG.GetColPalPixel (x,y:LongWord) : TColorData; +begin + result := ThePalette.IndexOf (TheImage.Colors[x,y]); +end; + +function TBGRAWriterPNG.GetColorPixelBGRA(p: PBGRAPixel): TColorData; +begin + result := FFmtColor(p^.ToFPColor); +end; + +function TBGRAWriterPNG.GetPalettePixelBGRA(p: PBGRAPixel): TColorData; +begin + result := TheImage.Palette.IndexOf(p^.ToFPColor); +end; + +function TBGRAWriterPNG.GetColPalPixelBGRA(p: PBGRAPixel): TColorData; +begin + result := ThePalette.IndexOf(p^.ToFPColor); +end; + +function TBGRAWriterPNG.DecideGetPixel : TGetPixelFunc; +begin + case Fheader.colortype of + 3 : if TheImage.UsePalette then + result := @GetPalettePixel + else result := @GetColPalPixel; + else result := @GetColorPixel; + end; +end; + +function TBGRAWriterPNG.DecideGetPixelBGRA: TGetPixelBGRAFunc; +begin + case Fheader.colortype of + 3 : if TheImage.UsePalette then + result := @GetPalettePixelBGRA + else result := @GetColPalPixelBGRA; + else result := @GetColorPixelBGRA; + end; +end; + +procedure TBGRAWriterPNG.WritePLTE; +var r,t : integer; + c : TFPColor; +begin + with ThePalette do + begin + SetChunkLength (count*3); + SetChunkType (ctPLTE); + t := 0; + For r := 0 to count-1 do + begin + c := Color[r]; + ChunkdataBuffer^[t] := c.red div 256; + inc (t); + ChunkdataBuffer^[t] := c.green div 256; + inc (t); + ChunkdataBuffer^[t] := c.blue div 256; + inc (t); + end; + end; + WriteChunk; +end; + +procedure TBGRAWriterPNG.InitWriteIDAT; +begin + FDatalineLength := TheImage.Width*ByteWidth; + GetMem (FPreviousLine, FDatalineLength); + GetMem (FCurrentLine, FDatalineLength); + fillchar (FCurrentLine^,FDatalineLength,0); + ZData := TMemoryStream.Create; + Compressor := TCompressionStream.Create (FCompressionLevel,ZData); + FGetPixel := DecideGetPixel; + FGetPixelBGRA := DecideGetPixelBGRA; +end; + +procedure TBGRAWriterPNG.FinalWriteIDAT; +begin + ZData.Free; + FreeMem (FPreviousLine); + FreeMem (FCurrentLine); +end; + +function TBGRAWriterPNG.DetermineFilter (Current, Previous:PByteArray; linelength:LongWord) : byte; +begin + result := 0; +end; + +procedure TBGRAWriterPNG.FillScanLine (y : integer; ScanLine : pByteArray); +var x : integer; + cd : TColorData; + r, index : LongWord; + b : byte; + p : PBGRAPixel; +begin + index := 0; + if TheImage is TBGRACustomBitmap then + begin + p := TBGRACustomBitmap(TheImage).ScanLine[y]; + if FHeader.BitDepth <> 16 then + case FByteWidth of + 1: for x := pred(TheImage.Width) downto 0 do + begin + cd := FGetPixelBGRA(p); + ScanLine^[index] := cd; + inc (index); + inc(p); + end; + 2: for x := pred(TheImage.Width) downto 0 do + begin + cd := FGetPixelBGRA(p); + ScanLine^[index] := cd and $ff; + ScanLine^[index+1] := cd shr 8; + inc (index,2); + inc(p); + end; + 3: for x := pred(TheImage.Width) downto 0 do + begin + ScanLine^[index] := p^.red; + ScanLine^[index+1] := p^.green; + ScanLine^[index+2] := p^.blue; + inc (index,3); + inc(p); + end; + 4: for x := pred(TheImage.Width) downto 0 do + begin + ScanLine^[index] := p^.red; + ScanLine^[index+1] := p^.green; + ScanLine^[index+2] := p^.blue; + ScanLine^[index+3] := p^.alpha; + inc (index,4); + inc(p); + end; + else raise exception.Create('Unexpected byte width'); + end else + for x := pred(TheImage.Width) downto 0 do + begin + cd := FGetPixelBGRA(p); + {$IFDEF ENDIAN_BIG} + cd:=swap(cd); + {$ENDIF} + move (cd, ScanLine^[index], FBytewidth); + if WordSized then + begin + r := 0; + while (r+1 < FByteWidth) do + begin + b := Scanline^[index+r+1]; + Scanline^[index+r+1] := Scanline^[index+r]; + Scanline^[index+r] := b; + inc (r,2); + end; + end; + inc (index, FByteWidth); + inc(p); + end; + end + else + for x := 0 to pred(TheImage.Width) do + begin + cd := FGetPixel (x,y); + {$IFDEF ENDIAN_BIG} + cd:=swap(cd); + {$ENDIF} + move (cd, ScanLine^[index], FBytewidth); + if WordSized then + begin + r := 0; + while (r+1 < FByteWidth) do + begin + b := Scanline^[index+r+1]; + Scanline^[index+r+1] := Scanline^[index+r]; + Scanline^[index+r] := b; + inc (r,2); + end; + end; + inc (index, FByteWidth); + end; +end; + +procedure TBGRAWriterPNG.Gatherdata; +var x,y : integer; + lf : byte; +begin + for y := 0 to pred(TheImage.height) do + begin + FSwitchLine := FCurrentLine; + FCurrentLine := FPreviousLine; + FPreviousLine := FSwitchLine; + FillScanLine (y, FCurrentLine); + lf := DetermineFilter (FCurrentLine, FpreviousLine, FDataLineLength); + if lf <> 0 then + for x := 0 to FDatalineLength-1 do + FCurrentLine^[x] := DoFilter (lf, x, FCurrentLine^[x]); + Compressor.Write (lf, sizeof(lf)); + Compressor.Write (FCurrentLine^, FDataLineLength); + end; +end; + +procedure TBGRAWriterPNG.WriteCompressedData; +var l : LongWord; +begin + Compressor.Free; // Close compression and finish the writing in ZData + l := ZData.position; + ZData.position := 0; + SetChunkLength(l); + SetChunkType (ctIDAT); + ZData.Read (ChunkdataBuffer^, l); + WriteChunk; +end; + +procedure TBGRAWriterPNG.WriteIDAT; +begin + InitWriteIDAT; + GatherData; + WriteCompressedData; + FinalWriteIDAT; +end; + +procedure TBGRAWriterPNG.WritetRNS; + procedure PaletteAlpha; + var r : integer; + begin + with TheImage.palette do + begin + // search last palette entry with transparency + r := count; + repeat + dec (r); + until (r < 0) or (color[r].alpha <> alphaOpaque); + if r >= 0 then // there is at least 1 transparent color + begin + // from this color we go to the first palette entry + SetChunkLength (r+1); + repeat + chunkdatabuffer^[r] := (color[r].alpha shr 8); + dec (r); + until (r < 0); + end; + writechunk; + end; + end; + procedure GrayAlpha; + var g : word; + begin + SetChunkLength(2); + if WordSized then + g := CalculateGray (SingleTransparentColor) + else + g := hi (CalculateGray(SingleTransparentColor)); + {$IFDEF ENDIAN_LITTLE} + g := swap (g); + {$ENDIF} + move (g,ChunkDataBuffer^[0],2); + WriteChunk; + end; + procedure ColorAlpha; + var g : TFPColor; + begin + SetChunkLength(6); + g := SingleTransparentColor; + with g do + if WordSized then + begin + {$IFDEF ENDIAN_LITTLE} + red := swap (red); + green := swap (green); + blue := swap (blue); + {$ENDIF} + move (g, ChunkDatabuffer^[0], 6); + end + else + begin + ChunkDataBuffer^[0] := 0; + ChunkDataBuffer^[1] := red shr 8; + ChunkDataBuffer^[2] := 0; + ChunkDataBuffer^[3] := green shr 8; + ChunkDataBuffer^[4] := 0; + ChunkDataBuffer^[5] := blue shr 8; + end; + WriteChunk; + end; +begin + SetChunkType (cttRNS); + case fheader.colortype of + 6,4 : raise PNGImageException.create ('tRNS chunk forbidden for full alpha channels'); + 3 : PaletteAlpha; + 2 : ColorAlpha; + 0 : GrayAlpha; + end; +end; + +procedure TBGRAWriterPNG.WriteTexts; +begin +end; + +procedure TBGRAWriterPNG.WriteIEND; +begin + SetChunkLength(0); + SetChunkType (ctIEND); + WriteChunk; +end; + +procedure TBGRAWriterPNG.InternalWrite (Str:TStream; Img:TFPCustomImage); +begin + WriteIHDR; + if Fheader.colorType = 3 then + WritePLTE; + if FUsetRNS then + WritetRNS; + WriteIDAT; + WriteTexts; + WriteIEND; +end; + +function TBGRAWriterPNG.GetUseAlpha: boolean; +begin + result := FUseAlpha; +end; + +procedure TBGRAWriterPNG.SetUseAlpha(AValue: boolean); +begin + FUseAlpha := AValue; +end; + +initialization + + DefaultBGRAImageWriter[ifPng] := TBGRAWriterPNG; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawritetiff.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritetiff.pas new file mode 100644 index 0000000..060e1e3 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritetiff.pas @@ -0,0 +1,1023 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ + The original file is part of the Free Pascal run time library. + Copyright (c) 2012 by the Free Pascal development team + + Tiff writer for fpImage modified by circular. + + ********************************************************************** + + Working: + Grayscale 8,16bit (optional alpha), + RGB 8,16bit (optional alpha), + Orientation, + multiple images, pages + thumbnail + Compression: deflate + + ToDo: + Compression: LZW, packbits, jpeg, ... + Planar + ColorMap + separate mask + fillorder - not needed by baseline tiff reader + bigtiff 64bit offsets + endian - currently using system endianess + orientation with rotation +} +unit BGRAWriteTiff; + +{$mode objfpc}{$H+} + +interface + +uses + Math, BGRAClasses, SysUtils, zbase, zdeflate, FPimage, FPTiffCmn, + BGRABitmapTypes; + +type + + { TTiffWriterEntry } + + TTiffWriterEntry = class + public + Tag: Word; + EntryType: Word; + Count: LongWord; + Data: Pointer; + DataPos: LongWord; + Bytes: LongWord; + destructor Destroy; override; + end; + + TTiffWriterChunk = record + Data: Pointer; + Bytes: LongWord; + end; + PTiffWriterChunk = ^TTiffWriterChunk; + + { TTiffWriterChunkOffsets } + + TTiffWriterChunkOffsets = class(TTiffWriterEntry) + public + Chunks: PTiffWriterChunk; + ChunkByteCounts: TTiffWriterEntry; + constructor Create(ChunkType: TTiffChunkType); + destructor Destroy; override; + procedure SetCount(NewCount: LongWord); + end; + + { TBGRAWriterTiff } + + TBGRAWriterTiff = class(TFPCustomImageWriter) + private + FPremultiplyRGB: boolean; + FSaveCMYKAsRGB: boolean; + fStartPos: Int64; + FEntries: TFPList; // list of TFPList of TTiffWriterEntry + fStream: TStream; + fPosition: LongWord; + procedure ClearEntries; + procedure WriteTiff; + procedure WriteHeader; + procedure WriteIFDs; + procedure WriteEntry(Entry: TTiffWriterEntry); + procedure WriteData; + procedure WriteEntryData(Entry: TTiffWriterEntry); + procedure WriteBuf(var Buf; Count: LongWord); + procedure WriteWord(w: Word); + procedure WriteDWord(d: LongWord); + protected + procedure InternalWrite(Stream: TStream; Img: TFPCustomImage); override; + procedure AddEntryString(Tag: word; const s: string); + procedure AddEntryShort(Tag: word; Value: Word); + procedure AddEntryLong(Tag: word; Value: LongWord); + procedure AddEntryShortOrLong(Tag: word; Value: LongWord); + procedure AddEntryRational(Tag: word; const Value: TTiffRational); + procedure AddEntry(Tag: Word; EntryType: Word; EntryCount: LongWord; + Data: Pointer; Bytes: LongWord; + CopyData: boolean = true); + procedure AddEntry(Entry: TTiffWriterEntry); + procedure TiffError(Msg: string); + procedure EncodeDeflate(var Buffer: Pointer; var Count: LongWord); + public + constructor Create; override; + destructor Destroy; override; + procedure Clear; + procedure AddImage(Img: TFPCustomImage); + procedure SaveToStream(Stream: TStream); + property SaveCMYKAsRGB: boolean read FSaveCMYKAsRGB write FSaveCMYKAsRGB; + property PremultiplyRGB: boolean read FPremultiplyRGB write FPremultiplyRGB; + end; + +function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer; + +function CompressDeflate(InputData: PByte; InputCount: LongWord; + out Compressed: PByte; var CompressedCount: LongWord; + ErrorMsg: PAnsiString = nil): boolean; + +implementation + +function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer; +begin + Result:=integer(TTiffWriterEntry(Entry1).Tag)-integer(TTiffWriterEntry(Entry2).Tag); +end; + +function CompressDeflate(InputData: PByte; InputCount: LongWord; out + Compressed: PByte; var CompressedCount: LongWord; ErrorMsg: PAnsiString + ): boolean; +var + stream : z_stream; + err : integer; +begin + Result:=false; + //writeln('CompressDeflate START'); + Compressed:=nil; + if InputCount=0 then begin + CompressedCount:=0; + exit(true); + end; + + err := deflateInit(stream{%H-}, Z_DEFAULT_COMPRESSION); + if err <> Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='deflateInit failed'; + exit; + end; + + // set input = InputData data + stream.avail_in := InputCount; + stream.next_in := InputData; + + // set output = compressed data + if CompressedCount=0 then + CompressedCount:=InputCount; + GetMem(Compressed,CompressedCount); + stream.avail_out := CompressedCount; + stream.next_out := Compressed; + + err := deflate(stream, Z_NO_FLUSH); + if err<>Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='deflate failed'; + exit; + end; + + while TRUE do begin + //writeln('run: total_in=',stream.total_in,' avail_in=',stream.avail_in,' total_out=',stream.total_out,' avail_out=',stream.avail_out); + if (stream.avail_out=0) then begin + // need more space + if CompressedCount<128 then + CompressedCount:=CompressedCount+128 + else if CompressedCount>High(CompressedCount)-1024 then begin + if ErrorMsg<>nil then + ErrorMsg^:='deflate compression failed, because not enough space'; + exit; + end else + CompressedCount:=CompressedCount+1024; + ReAllocMem(Compressed,CompressedCount); + stream.next_out:=Compressed+stream.total_out; + stream.avail_out:=CompressedCount-stream.total_out; + end; + err := deflate(stream, Z_FINISH); + if err = Z_STREAM_END then + break; + if err<>Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='deflate finish failed'; + exit; + end; + end; + + //writeln('compressed: total_in=',stream.total_in,' total_out=',stream.total_out); + CompressedCount:=stream.total_out; + ReAllocMem(Compressed,CompressedCount); + + err := deflateEnd(stream); + if err<>Z_OK then begin + if ErrorMsg<>nil then + ErrorMsg^:='deflateEnd failed'; + exit; + end; + Result:=true; +end; + +{ TBGRAWriterTiff } + +procedure TBGRAWriterTiff.WriteWord(w: Word); +begin + if fStream<>nil then + fStream.WriteWord(w); + inc(fPosition,2); +end; + +procedure TBGRAWriterTiff.WriteDWord(d: LongWord); +begin + if fStream<>nil then + fStream.WriteDWord(d); + inc(fPosition,4); +end; + +procedure TBGRAWriterTiff.ClearEntries; +var + i: Integer; + List: TFPList; + j: Integer; +begin + for i:=FEntries.Count-1 downto 0 do begin + List:=TFPList(FEntries[i]); + for j:=List.Count-1 downto 0 do + TObject(List[j]).Free; + List.Free; + end; + FEntries.Clear; +end; + +procedure TBGRAWriterTiff.WriteTiff; +begin + {$IFDEF FPC_Debug_Image} + writeln('TBGRAWriterTiff.WriteTiff fStream=',fStream<>nil); + {$ENDIF} + fPosition:=0; + WriteHeader; + WriteIFDs; + WriteData; +end; + +procedure TBGRAWriterTiff.WriteHeader; +var + EndianMark: String; +begin + EndianMark:={$IFDEF FPC_BIG_ENDIAN}'MM'{$ELSE}'II'{$ENDIF}; + WriteBuf(EndianMark[1],2); + WriteWord(42); + WriteDWord(8); +end; + +procedure TBGRAWriterTiff.WriteIFDs; +var + i: Integer; + List: TFPList; + j: Integer; + Entry: TTiffWriterEntry; + NextIFDPos: LongWord; +begin + for i:=0 to FEntries.Count-1 do begin + List:=TFPList(FEntries[i]); + // write count + {$IFDEF FPC_Debug_Image} + writeln('TBGRAWriterTiff.WriteIFDs List=',i,' Count=',List.Count); + {$ENDIF} + WriteWord(List.Count); + // write array of entries + for j:=0 to List.Count-1 do begin + Entry:=TTiffWriterEntry(List[j]); + WriteEntry(Entry); + end; + // write position of next IFD + if i= 8 then + begin + WriteNextLabPixel(AColor); + exit; + end; + + case IFD.PhotoMetricInterpretation of + 0,1: // grayscale + begin + Value:=(LongWord(AColor.red)+AColor.green+AColor.blue) div 3; + if ExtraSample=1 then Value := Value*AColor.alpha div 65535; + if IFD.PhotoMetricInterpretation=0 then Value:=$ffff-Value;// 0 is white + WriteValue(Run, Value, GrayBits); + WriteValue(Run, AColor.alpha, AlphaBits); + end; + 2: // RGB + begin + Value := AColor.red; + if ExtraSample=1 then Value := Value*AColor.alpha div 65535; + WriteValue(Run, Value, RedBits); + Value := AColor.green; + if ExtraSample=1 then Value := Value*AColor.alpha div 65535; + WriteValue(Run, Value, GreenBits); + Value := AColor.blue; + if ExtraSample=1 then Value := Value*AColor.alpha div 65535; + WriteValue(Run, Value, BlueBits); + WriteValue(Run, AColor.alpha, AlphaBits); + end; + else raise exception.Create('Photometric interpretation not handled'); + end; + end; + +begin + ChunkOffsets:=nil; + Chunk:=nil; + IFD:=TTiffIFD.Create; + try + // add new list of entries + CurEntries:=TFPList.Create; + FEntries.Add(CurEntries); + + IFD.ReadFPImgExtras(Img); + if SaveCMYKAsRGB and (IFD.PhotoMetricInterpretation=5) then + IFD.PhotoMetricInterpretation:=2; + if (Img.Extra[TiffPhotoMetric]='') and (Img is TCustomUniversalBitmap) then + begin + if cfHasImaginaryColors in TCustomUniversalBitmap(Img).Colorspace.GetFlags then + IFD.PhotoMetricInterpretation := 8; + end; + + if Img.Extra[TiffCompression]='' then + IFD.Compression:= TiffCompressionDeflateZLib; + + if not (IFD.PhotoMetricInterpretation in [0,1,2,8,9]) then + TiffError('PhotoMetricInterpretation="'+Img.Extra[TiffPhotoMetric]+'" not supported'); + + GrayBits:=0; + RedBits:=0; + GreenBits:=0; + BlueBits:=0; + AlphaBits:=0; + ExtraSample:=0; + defaultColorBits := GetDefaultColorBits; + case IFD.PhotoMetricInterpretation of + 0,1: + begin + GrayBits:=StrToIntDef(Img.Extra[TiffGrayBits], defaultColorBits); + BitsPerSample[0]:=GrayBits; + SamplesPerPixel:=1; + end; + 2: + begin + RedBits:=StrToIntDef(Img.Extra[TiffRedBits], defaultColorBits); + GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits], defaultColorBits); + BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits], defaultColorBits); + BitsPerSample[0]:=RedBits; + BitsPerSample[1]:=GreenBits; + BitsPerSample[2]:=BlueBits; + SamplesPerPixel:=3; + end; + 8,9: + begin + RedBits:=StrToIntDef(Img.Extra[TiffRedBits], defaultColorBits); + GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits], defaultColorBits); + BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits], defaultColorBits); + BitsPerSample[0]:=GreenBits; + if (RedBits=0) and (BlueBits=0) then SamplesPerPixel := 1 + else + begin + SamplesPerPixel:= 3; + if RedBits=0 then RedBits := BlueBits else + if BlueBits=0 then BlueBits := RedBits; + BitsPerSample[1]:= RedBits; + BitsPerSample[2]:= BlueBits; + end; + end; + end; + AlphaBits:= StrToIntDef(Img.Extra[TiffAlphaBits],GetDefaultAlphaBits); + if AlphaBits>0 then begin + BitsPerSample[SamplesPerPixel]:=AlphaBits; + inc(SamplesPerPixel); + if PremultiplyRGB and (IFD.PhotoMetricInterpretation<=2) then + ExtraSample := 1 + else + ExtraSample := 2; + end; + + ImgWidth:=Img.Width; + ImgHeight:=Img.Height; + Compression:=IFD.Compression; + case Compression of + TiffCompressionNone, + TiffCompressionDeflateZLib: ; + else + {$ifdef FPC_DEBUG_IMAGE} + writeln('TBGRAWriterTiff.AddImage unsupported compression '+TiffCompressionName(Compression)+', using deflate instead.'); + {$endif} + Compression:=TiffCompressionDeflateZLib; + end; + + if IFD.Orientation in [1..4] then begin + OrientedWidth:=ImgWidth; + OrientedHeight:=ImgHeight; + end else begin + // rotated + OrientedWidth:=ImgHeight; + OrientedHeight:=ImgWidth; + end; + + {$IFDEF FPC_Debug_Image} + writeln('TBGRAWriterTiff.AddImage PhotoMetricInterpretation=',IFD.PhotoMetricInterpretation); + writeln('TBGRAWriterTiff.AddImage ImageWidth=',ImgWidth,' ImageHeight=',ImgHeight); + writeln('TBGRAWriterTiff.AddImage Orientation=',IFD.Orientation); + writeln('TBGRAWriterTiff.AddImage ResolutionUnit=',IFD.ResolutionUnit); + writeln('TBGRAWriterTiff.AddImage XResolution=',TiffRationalToStr(IFD.XResolution)); + writeln('TBGRAWriterTiff.AddImage YResolution=',TiffRationalToStr(IFD.YResolution)); + writeln('TBGRAWriterTiff.AddImage GrayBits=',GrayBits,' RedBits=',RedBits,' GreenBits=',GreenBits,' BlueBits=',BlueBits,' AlphaBits=',AlphaBits); + writeln('TBGRAWriterTiff.AddImage Compression=',TiffCompressionName(Compression)); + writeln('TBGRAWriterTiff.AddImage Page=',IFD.PageNumber,'/',IFD.PageCount); + {$ENDIF} + + // required meta entries + AddEntryShortOrLong(256,ImgWidth); + AddEntryShortOrLong(257,ImgHeight); + AddEntryShort(259,Compression); + AddEntryShort(262,IFD.PhotoMetricInterpretation); + AddEntryShort(274,IFD.Orientation); + AddEntryShort(296,IFD.ResolutionUnit); + AddEntryRational(282,IFD.XResolution); + AddEntryRational(283,IFD.YResolution); + // BitsPerSample (required) + AddEntry(258,3,SamplesPerPixel,@BitsPerSample[0],SamplesPerPixel*2); + AddEntryShort(277,SamplesPerPixel); + if ExtraSample<>0 then AddEntryShort(338, ExtraSample); + + // BitsPerPixel, BytesPerLine + BitsPerPixel:=0; + for i:=0 to SamplesPerPixel-1 do + inc(BitsPerPixel,BitsPerSample[i]); + BytesPerLine:=(BitsPerPixel*OrientedWidth+7) div 8; + + // optional entries + NewSubFileType:=0; + if IFD.ImageIsThumbNail then inc(NewSubFileType,1); + if IFD.ImageIsPage then inc(NewSubFileType,2); + if IFD.ImageIsMask then inc(NewSubFileType,4); + if NewSubFileType>0 then + AddEntryLong(254,NewSubFileType); + if IFD.DocumentName<>'' then + AddEntryString(269,IFD.DocumentName); + if IFD.ImageDescription<>'' then + AddEntryString(270,IFD.ImageDescription); + if IFD.Make_ScannerManufacturer<>'' then + AddEntryString(271,IFD.Make_ScannerManufacturer); + if IFD.Model_Scanner<>'' then + AddEntryString(272,IFD.Model_Scanner); + if IFD.Software<>'' then + AddEntryString(305,IFD.Software); + if IFD.DateAndTime<>'' then + AddEntryString(306,IFD.DateAndTime); + if IFD.Artist<>'' then + AddEntryString(315,IFD.Artist); + if IFD.HostComputer<>'' then + AddEntryString(316,IFD.HostComputer); + if IFD.PageCount>0 then begin + Shorts[0]:=IFD.PageNumber; + Shorts[1]:=IFD.PageCount; + AddEntry(297,3,2,@Shorts[0],2*SizeOf(Word)); + end; + if IFD.PageName<>'' then + AddEntryString(285,IFD.PageName); + if IFD.Copyright<>'' then + AddEntryString(33432,IFD.Copyright); + + // chunks + ChunkType:=tctStrip; + if IFD.TileWidth>0 then begin + AddEntryShortOrLong(322,IFD.TileWidth); + AddEntryShortOrLong(323,IFD.TileLength); + ChunkType:=tctTile; + end else begin + // RowsPerStrip (required) + if OrientedWidth=0 then + IFD.RowsPerStrip:=8 + else + IFD.RowsPerStrip:=8192 div BytesPerLine; + if IFD.RowsPerStrip<1 then + IFD.RowsPerStrip:=1; + {$IFDEF FPC_Debug_Image} + writeln('TBGRAWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' BytesPerLine=',BytesPerLine,' RowsPerStrip=',IFD.RowsPerStrip); + {$ENDIF} + AddEntryShortOrLong(278,IFD.RowsPerStrip); + end; + + // tags for Offsets and ByteCounts + ChunkOffsets:=TTiffWriterChunkOffsets.Create(ChunkType); + AddEntry(ChunkOffsets); + AddEntry(ChunkOffsets.ChunkByteCounts); + + labArray := nil; + if (Img is TCustomUniversalBitmap) and + (IFD.PhotoMetricInterpretation >= 8) then + begin + ConvertToLab := true; + ConversionToLab := TCustomUniversalBitmap(Img).Colorspace.GetBridgedConversion(TLabAColorspace); + end else + ConvertToLab := false; + + if (OrientedHeight>0) and (OrientedWidth>0) then begin + if ChunkType=tctTile then begin + TilesAcross:=(OrientedWidth+IFD.TileWidth{%H-}-1) div IFD.TileWidth; + TilesDown:=(OrientedHeight+IFD.TileLength{%H-}-1) div IFD.TileLength; + ChunkCount:=TilesAcross*TilesDown; + {$IFDEF FPC_Debug_Image} + writeln('TBGRAWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' OrientedHeight=',OrientedHeight,' TileWidth=',IFD.TileWidth,' TileLength=',IFD.TileLength,' TilesAcross=',TilesAcross,' TilesDown=',TilesDown,' ChunkCount=',ChunkCount); + {$ENDIF} + end else begin + ChunkCount:=(OrientedHeight+IFD.RowsPerStrip{%H-}-1) div IFD.RowsPerStrip; + end; + ChunkOffsets.SetCount(ChunkCount); + // create chunks + for ChunkIndex:=0 to ChunkCount-1 do begin + if ChunkType=tctTile then begin + ChunkLeft:=(ChunkIndex mod TilesAcross)*IFD.TileWidth; + ChunkTop:=(ChunkIndex div TilesAcross)*IFD.TileLength; + ChunkWidth:=Min(IFD.TileWidth,OrientedWidth-ChunkLeft); + ChunkHeight:=Min(IFD.TileLength,OrientedHeight-ChunkTop); + // boundary tiles are padded to a full tile + // the padding is filled with 0 and compression will get rid of it + ChunkBytesPerLine:=(BitsPerPixel*IFD.TileWidth+7) div 8; + ChunkBytes:=ChunkBytesPerLine*IFD.TileLength; + end else begin + ChunkLeft:=0; + ChunkTop:=IFD.RowsPerStrip*ChunkIndex; + ChunkWidth:=OrientedWidth; + ChunkHeight:=Min(IFD.RowsPerStrip,OrientedHeight-ChunkTop); + ChunkBytesPerLine:=BytesPerLine; + ChunkBytes:=ChunkBytesPerLine*ChunkHeight; + end; + GetMem(Chunk,ChunkBytes); + FillByte(Chunk^,ChunkBytes,0); // fill unused bytes with 0 to help compression + + // Orientation + if IFD.Orientation in [1..4] then begin + sx:=ChunkLeft; sy:=ChunkTop; + dy1 := 0; dx2 := 0; + case IFD.Orientation of + 1: begin dx1:=1; dy2:=1; end;// 0,0 is left, top + 2: begin sx:=OrientedWidth-sx-1; dx1:=-1; dy2:=1; end;// 0,0 is right, top + 3: begin sx:=OrientedWidth-sx-1; dx1:=-1; sy:=OrientedHeight-sy-1; dy2:=-1; end;// 0,0 is right, bottom + 4: begin dx1:=1; sy:=OrientedHeight-sy-1; dy2:=-1; end;// 0,0 is left, bottom + end; + end else begin + // rotated + sx:=ChunkTop; sy:=ChunkLeft; + dx1 := 0; dy2 := 0; + case IFD.Orientation of + 5: begin dx2:=1; dy1:=1; end;// 0,0 is top, left (rotated) + 6: begin dx2:=1; sy:=OrientedWidth-sy-1; dy1:=-1; end;// 0,0 is top, right (rotated) + 7: begin sx:=OrientedHeight-sx-1; dx2:=-1; sy:=OrientedWidth-sy-1; dy1:=-1; end;// 0,0 is bottom, right (rotated) + 8: begin sx:=OrientedHeight-sx-1; dx2:=-1; dy1:=1; end;// 0,0 is bottom, left (rotated) + end; + end; + //writeln('TBGRAWriterTiff.AddImage Chunk=',ChunkIndex,'/',ChunkCount,' ChunkBytes=',ChunkBytes,' ChunkRect=',ChunkLeft,',',ChunkTop,',',ChunkWidth,'x',ChunkHeight,' x=',x,' y=',y,' dx=',dx,' dy=',dy); + for cy:=0 to ChunkHeight-1 do begin + Run:=Chunk+cy*ChunkBytesPerLine; + + if ConvertToLab then + begin + if ChunkWidth > Length(labArray) then setlength(labArray, ChunkWidth); + sourceStride := TCustomUniversalBitmap(Img).RowSize*dy1; + if TCustomUniversalBitmap(Img).LineOrder = riloBottomToTop then + sourceStride := -sourceStride; + inc(sourceStride, dx1*PtrInt(TCustomUniversalBitmap(Img).Colorspace.GetSize) ); + ConversionToLab.Convert( TCustomUniversalBitmap(Img).GetPixelAddress(sx,sy), + @labArray[0], ChunkWidth, sourceStride, sizeof(TLabA), nil); + for cx := 0 to ChunkWidth-1 do + WriteNextLabPixel(labArray[cx]); + end else + begin + x := sx; + y := sy; + for cx:=0 to ChunkWidth-1 do begin + WriteNextPixel(Img.Colors[x,y]); + inc(x,dx1); + inc(y,dy1); + end; + end; + + inc(sx,dx2); + inc(sy,dy2); + end; + + // compress + case Compression of + TiffCompressionDeflateZLib: EncodeDeflate(Chunk,ChunkBytes); + end; + + ChunkOffsets.Chunks[ChunkIndex].Data:=Chunk; + ChunkOffsets.Chunks[ChunkIndex].Bytes:=ChunkBytes; + // next chunk + end; + // created chunks + end; + + CurEntries.Sort(@CompareTiffWriteEntries); + finally + IFD.Free; + end; +end; + +procedure TBGRAWriterTiff.SaveToStream(Stream: TStream); +begin + fStartPos:=Stream.Position; + // simulate write to compute offsets + fStream:=nil; + WriteTiff; + // write to stream + fStream:=Stream; + WriteTiff; + fStream:=nil; +end; + +procedure TBGRAWriterTiff.InternalWrite(Stream: TStream; Img: TFPCustomImage); +begin + AddImage(Img); + SaveToStream(Stream); +end; + +procedure TBGRAWriterTiff.AddEntryString(Tag: word; const s: string); +begin + if s<>'' then + AddEntry(Tag,2,length(s)+1,@s[1],length(s)+1) + else + AddEntry(Tag,2,0,nil,0); +end; + +procedure TBGRAWriterTiff.AddEntryShort(Tag: word; Value: Word); +begin + AddEntry(Tag,3,1,@Value,2); +end; + +procedure TBGRAWriterTiff.AddEntryLong(Tag: word; Value: LongWord); +begin + AddEntry(Tag,4,1,@Value,4); +end; + +procedure TBGRAWriterTiff.AddEntryShortOrLong(Tag: word; Value: LongWord); +begin + if Value<=High(Word) then + AddEntryShort(Tag,Value) + else + AddEntryLong(Tag,Value); +end; + +procedure TBGRAWriterTiff.AddEntryRational(Tag: word; const Value: TTiffRational + ); +begin + AddEntry(Tag,5,1,@Value,8); +end; + +procedure TBGRAWriterTiff.AddEntry(Tag: Word; EntryType: Word; EntryCount: LongWord; + Data: Pointer; Bytes: LongWord; CopyData: boolean); +var + Entry: TTiffWriterEntry; +begin + Entry:=TTiffWriterEntry.Create; + Entry.Tag:=Tag; + Entry.EntryType:=EntryType; + Entry.Count:=EntryCount; + if CopyData then begin + if Bytes>0 then begin + GetMem(Entry.Data,Bytes); + System.Move(Data^,Entry.Data^,Bytes); + end else begin + Entry.Data:=nil; + end; + end else + Entry.Data:=Data; + Entry.Bytes:=Bytes; + AddEntry(Entry); +end; + +procedure TBGRAWriterTiff.AddEntry(Entry: TTiffWriterEntry); +var + List: TFPList; +begin + List:=TFPList(FEntries[FEntries.Count-1]); + List.Add(Entry); +end; + +procedure TBGRAWriterTiff.TiffError(Msg: string); +begin + raise Exception.Create('TBGRAWriterTiff.TiffError: '+Msg); +end; + +procedure TBGRAWriterTiff.EncodeDeflate(var Buffer: Pointer; var Count: LongWord); +var + NewBuffer: PByte; + NewCount: LongWord; + ErrorMsg: String; +begin + ErrorMsg:=''; + NewBuffer:=nil; + try + NewCount:=Count; + if not CompressDeflate(Buffer,Count,NewBuffer,NewCount,@ErrorMsg) then + TiffError(ErrorMsg); + FreeMem(Buffer); + Buffer:=NewBuffer; + Count:=NewCount; + NewBuffer:=nil; + finally + ReAllocMem(NewBuffer,0); + end; +end; + +constructor TBGRAWriterTiff.Create; +begin + inherited Create; + FEntries:=TFPList.Create; + FSaveCMYKAsRGB:= true; + FPremultiplyRGB:= false; +end; + +destructor TBGRAWriterTiff.Destroy; +begin + Clear; + FreeAndNil(FEntries); + inherited Destroy; +end; + +procedure TBGRAWriterTiff.Clear; +begin + ClearEntries; +end; + +{ TTiffWriterEntry } + +destructor TTiffWriterEntry.Destroy; +begin + ReAllocMem(Data,0); + inherited Destroy; +end; + +{ TTiffWriterChunkOffsets } + +constructor TTiffWriterChunkOffsets.Create(ChunkType: TTiffChunkType); +begin + EntryType:=4; // long + ChunkByteCounts:=TTiffWriterEntry.Create; + ChunkByteCounts.EntryType:=4; // long + if ChunkType=tctTile then begin + Tag:=324; // TileOffsets + ChunkByteCounts.Tag:=325; // TileByteCounts + end else begin + Tag:=273; // StripOffsets + ChunkByteCounts.Tag:=279; // StripByteCounts + end; +end; + +destructor TTiffWriterChunkOffsets.Destroy; +var + i: Integer; +begin + if Chunks<>nil then begin + for i:=0 to Count-1 do + ReAllocMem(Chunks[i].Data,0); + ReAllocMem(Chunks,0); + end; + inherited Destroy; +end; + +procedure TTiffWriterChunkOffsets.SetCount(NewCount: LongWord); +var + Size: LongWord; +begin + {$IFDEF FPC_Debug_Image} + writeln('TTiffWriteStripOffsets.SetCount OldCount=',Count,' NewCount=',NewCount); + {$ENDIF} + Count:=NewCount; + Size:=Count*SizeOf(TTiffWriterChunk); + ReAllocMem(Chunks,Size); + if Size>0 then FillByte(Chunks^,Size,0); + Size:=Count*SizeOf(LongWord); + // Offsets + ReAllocMem(Data,Size); + if Size>0 then FillByte(Data^,Size,0); + Bytes:=Size; + // ByteCounts + ReAllocMem(ChunkByteCounts.Data,Size); + if Size>0 then FillByte(ChunkByteCounts.Data^,Size,0); + ChunkByteCounts.Count:=Count; + ChunkByteCounts.Bytes:=Size; +end; + +initialization + if ImageHandlers.ImageWriter[TiffHandlerName]=nil then + ImageHandlers.RegisterImageWriter (TiffHandlerName, 'tif;tiff', TBGRAWriterTiff); + DefaultBGRAImageWriter[ifTiff] := TBGRAWriterTiff; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/bgrawritewebp.pas b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritewebp.pas new file mode 100644 index 0000000..05ece31 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/bgrawritewebp.pas @@ -0,0 +1,119 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit BGRAWriteWebP; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPimage; + +type + { TBGRAWriterWebP } + + TBGRAWriterWebP = class(TFPCustomImageWriter) + protected + FLossless: boolean; + FQualityPercent: Single; + procedure InternalWrite(Stream: TStream; Img: TFPCustomImage); override; + public + constructor Create; override; + property QualityPercent: single read FQualityPercent write FQualityPercent; + { If Lossless is set to True, the QualityPercent property is ignored } + property Lossless: boolean read FLossless write FLossless; + + end; + +implementation + +uses libwebp{$ifdef linux}, linuxlib{$endif}, BGRABitmapTypes; + +var + MyLibWebPLoaded: boolean; + +procedure NeedLibWebP; +begin + if not MyLibWebPLoaded then + begin + if not LibWebPLoad({$ifdef linux}FindLinuxLibrary('libwebp.so', 6){$endif}) then + raise exception.Create('Cannot find libwebp library ('+LibWebPFilename+')'); + MyLibWebPLoaded:= true; + end; +end; + +{ TBGRAWriterWebP } + +procedure TBGRAWriterWebP.InternalWrite(Stream: TStream; Img: TFPCustomImage); +const + CopySize = 65536; +var + saveFrom: TBGRACustomBitmap; + outSize, remain, toWrite: LongWord; + outData, p: PByte; +begin + NeedLibWebP; + saveFrom := BGRABitmapFactory.Create(Img); + outData := nil; + try + if saveFrom.LineOrder = riloBottomToTop then + saveFrom.VerticalFlip; + + {$PUSH}{$WARNINGS OFF} + if Lossless then + begin + if TBGRAPixel_RGBAOrder then + outSize := WebPEncodeLosslessRGBA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, + saveFrom.RowSize, outData{%H-}) + else + outSize := WebPEncodeLosslessBGRA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, + saveFrom.RowSize, outData{%H-}); + end else + begin + if TBGRAPixel_RGBAOrder then + outSize := WebPEncodeRGBA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, + saveFrom.RowSize, QualityPercent, outData{%H-}) + else + outSize := WebPEncodeBGRA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, + saveFrom.RowSize, QualityPercent, outData{%H-}); + end; + {$POP} + if outSize = 0 then + raise exception.Create('Error encoding WebP'); + + remain := outSize; + p := outData; + while remain > 0 do + begin + if remain > CopySize then toWrite := CopySize + else toWrite := remain; + Stream.WriteBuffer(p^, toWrite); + inc(p, toWrite); + dec(remain, toWrite); + end; + finally + if Assigned(outData) then WebPFree(outData); + saveFrom.Free; + end; +end; + +constructor TBGRAWriterWebP.Create; +begin + inherited Create; + FQualityPercent := 100; + FLossless:= True; +end; + +initialization + + DefaultBGRAImageWriter[ifWebP] := TBGRAWriterWebP; + +finalization + + if MyLibWebPLoaded then + begin + LibWebPUnload; + MyLibWebPLoaded:= false; + end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blendpixelinline.inc b/vendor/kam_remake/src/ext/BGRABitmap/blendpixelinline.inc new file mode 100644 index 0000000..015ffcf --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blendpixelinline.inc @@ -0,0 +1,1312 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +function ByteLinearMultiplyInline(a, b: byte): byte; +begin + if b = 255 then exit(a) else + begin + if b >= 128 then inc(b); + Result := (a * b) shr 8; + end; +end; + +procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearMultiplyInline(dest^.red, c.red); + dest^.green := ByteLinearMultiplyInline(dest^.green, c.green); + dest^.blue := ByteLinearMultiplyInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearMultiplyInline(dest^.red, c.red) * + destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearMultiplyInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearMultiplyInline(dest^.blue, c.blue) * + destalpha + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ByteAddInline(a, b: byte): byte; +var + temp: LongWord; +begin + temp := LongWord(GammaExpansionTab[a]) + LongWord(GammaExpansionTab[b]); + if temp > 65535 then + temp := 65535; + Result := GammaCompressionTab[temp]; +end; +{$hints on} + +function ByteLinearAddInline(a, b: byte): byte; +var + temp: integer; +begin + temp := integer(a) + integer(b); + if temp > 255 then + temp := 255; + Result := temp; +end; + +procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteAddInline(dest^.red, c.red); + dest^.green := ByteAddInline(dest^.green, c.green); + dest^.blue := ByteAddInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := ByteAddInline(dest^.red * destalpha shr 8, c.red); + dest^.green := ByteAddInline(dest^.green * destalpha shr 8, c.green); + dest^.blue := ByteAddInline(dest^.blue * destalpha shr 8, c.blue); + dest^.alpha := c.alpha; + end; +end; + +procedure LinearAddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearAddInline(dest^.red, c.red); + dest^.green := ByteLinearAddInline(dest^.green, c.green); + dest^.blue := ByteLinearAddInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := ByteLinearAddInline(dest^.red * destalpha shr 8, c.red); + dest^.green := ByteLinearAddInline(dest^.green * destalpha shr 8, c.green); + dest^.blue := ByteLinearAddInline(dest^.blue * destalpha shr 8, c.blue); + dest^.alpha := c.alpha; + end; +end; + +function ByteBurnInline(a, b: byte): byte; inline; +var + temp: integer; +begin + if b = 0 then + Result := 0 + else + begin + temp := 255 - (((255 - a) shl 8) div b); + if temp < 0 then + Result := 0 + else + Result := temp; + end; +end; + +procedure ColorBurnPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteBurnInline(dest^.red, c.red); + dest^.green := ByteBurnInline(dest^.green, c.green); + dest^.blue := ByteBurnInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteBurnInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteBurnInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteBurnInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ByteDodgeInline(a, b: byte): byte; inline; +var + temp: integer; +begin + if b = 255 then + Result := 255 + else + begin + temp := (a shl 8) div (not b); + if temp > 255 then + Result := 255 + else + Result := temp; + end; +end; +{$hints on} + +procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteDodgeInline(dest^.red, c.red); + dest^.green := ByteDodgeInline(dest^.green, c.green); + dest^.blue := ByteDodgeInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteDodgeInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteDodgeInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteDodgeInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ByteDivideInline(a, b: byte): byte; inline; +var + temp: integer; +begin + if b = 0 then + Result := 255 + else if b = 255 then + exit(a) + else + begin + if b >= 128 then inc(b); + temp := ((a shl 8) + (b shr 1)) div b; + if temp > 255 then + Result := 255 + else + Result := temp; + end; +end; +{$hints on} + +procedure DividePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteDivideInline(dest^.red, c.red); + dest^.green := ByteDivideInline(dest^.green, c.green); + dest^.blue := ByteDivideInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteDivideInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteDivideInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteDivideInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ByteNonLinearReflectInline(a, b: byte): byte; inline; +var + temp: LongWord; + wa,wb: word; +begin + if b = 255 then + Result := 255 + else + begin + wa := GammaExpansionTab[a]; + wb := GammaExpansionTab[b]; + temp := wa * wa div (not wb); + if temp >= 65535 then + Result := 255 + else + Result := GammaCompressionTab[ temp ]; + end; +end; + +function ByteReflectInline(a, b: byte): byte; inline; +var + temp: integer; +begin + if b = 255 then + Result := 255 + else + begin + temp := a * a div (not b); + if temp > 255 then + Result := 255 + else + Result := temp; + end; +end; +{$hints on} + +procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteReflectInline(dest^.red, c.red); + dest^.green := ByteReflectInline(dest^.green, c.green); + dest^.blue := ByteReflectInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteReflectInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteReflectInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteReflectInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteReflectInline(c.red, dest^.red); + dest^.green := ByteReflectInline(c.green, dest^.green); + dest^.blue := ByteReflectInline(c.blue, dest^.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteReflectInline(c.red, dest^.red); + dest^.green := ByteReflectInline(c.green, dest^.green); + dest^.blue := ByteReflectInline(c.blue, dest^.blue); + end else + begin + dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + end; + + if (c.red > c.green) and (c.red > c.blue) then + dest^.alpha := c.red else + if (c.green > c.blue) then + dest^.alpha := c.green else + dest^.alpha := c.blue; + dest^.alpha := ApplyOpacity(GammaExpansionTab[dest^.alpha] shr 8,c.alpha); +end; + +procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteNonLinearReflectInline(dest^.red, c.red); + dest^.green := ByteNonLinearReflectInline(dest^.green, c.green); + dest^.blue := ByteNonLinearReflectInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteNonLinearReflectInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteNonLinearReflectInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteNonLinearReflectInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ByteOverlayInline(a, b: byte): byte; inline; +var wa,wb: word; +begin + wa := GammaExpansionTab[a]; + wb := GammaExpansionTab[b]; + if wa < 32768 then + Result := GammaCompressionTab[ (wa * wb) shr 15 ] + else + Result := GammaCompressionTab[ 65535 - ((not wa) * (not wb) shr 15) ]; +end; +{$hints on} + +function ByteLinearOverlayInline(a, b: byte): byte; inline; +begin + if a < 128 then + Result := (a * b) shr 7 + else + Result := 255 - ((not a) * (not b) shr 7); +end; + +procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteOverlayInline(dest^.red, c.red); + dest^.green := ByteOverlayInline(dest^.green, c.green); + dest^.blue := ByteOverlayInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteOverlayInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteOverlayInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteOverlayInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearOverlayInline(dest^.red, c.red); + dest^.green := ByteLinearOverlayInline(dest^.green, c.green); + dest^.blue := ByteLinearOverlayInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearOverlayInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearOverlayInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearOverlayInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteDifferenceInline(a, b: byte): byte; inline; +begin + Result := GammaCompressionTab[abs(integer(GammaExpansionTab[a]) - + integer(GammaExpansionTab[b]))]; +end; + +procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteDifferenceInline(dest^.red, c.red); + dest^.green := ByteDifferenceInline(dest^.green, c.green); + dest^.blue := ByteDifferenceInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteDifferenceInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteDifferenceInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteDifferenceInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteLinearDifferenceInline(a, b: byte): byte; inline; +begin + Result := abs(a - b); +end; + +procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearDifferenceInline(dest^.red, c.red); + dest^.green := ByteLinearDifferenceInline(dest^.green, c.green); + dest^.blue := ByteLinearDifferenceInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearDifferenceInline(dest^.red, c.red) * + destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearDifferenceInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearDifferenceInline(dest^.blue, c.blue) * + destalpha + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteExclusionInline(a, b: byte): byte; inline; +var aw,bw: word; +begin + aw := GammaExpansionTab[a]; + bw := GammaExpansionTab[b]; + {$HINTS OFF} + Result := GammaCompressionTab[aw+bw-(LongWord(aw)*LongWord(bw) shr 15)]; + {$HINTS ON} +end; + +procedure ExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteExclusionInline(dest^.red, c.red); + dest^.green := ByteExclusionInline(dest^.green, c.green); + dest^.blue := ByteExclusionInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteExclusionInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteExclusionInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteExclusionInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteLinearExclusionInline(a, b: byte): byte; inline; +begin + {$HINTS OFF} + Result := a+b-(a*b shr 7); + {$HINTS ON} +end; + +procedure LinearExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearExclusionInline(dest^.red, c.red); + dest^.green := ByteLinearExclusionInline(dest^.green, c.green); + dest^.blue := ByteLinearExclusionInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearExclusionInline(dest^.red, c.red) * + destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearExclusionInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearExclusionInline(dest^.blue, c.blue) * + destalpha + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteLinearSubtractInline(a, b: byte): byte; inline; +begin + if b >= a then + result := 0 + else + result := a-b; +end; + +procedure LinearSubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearSubtractInline(dest^.red, c.red); + dest^.green := ByteLinearSubtractInline(dest^.green, c.green); + dest^.blue := ByteLinearSubtractInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearSubtractInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearSubtractInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearSubtractInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure LinearSubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearSubtractInline(dest^.red, not c.red); + dest^.green := ByteLinearSubtractInline(dest^.green, not c.green); + dest^.blue := ByteLinearSubtractInline(dest^.blue, not c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearSubtractInline(dest^.red, not c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearSubtractInline(dest^.green, not c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearSubtractInline(dest^.blue, not c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteSubtractInline(a, b: byte): byte; inline; +begin + if b >= a then + result := 0 + else + result := GammaCompressionTab[integer(GammaExpansionTab[a]) - + integer(GammaExpansionTab[b])]; +end; + +procedure SubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteSubtractInline(dest^.red, c.red); + dest^.green := ByteSubtractInline(dest^.green, c.green); + dest^.blue := ByteSubtractInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteSubtractInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteSubtractInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteSubtractInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteSubtractInverseInline(a, b: byte): byte; inline; +var aw,bw: word; +begin + aw := GammaExpansionTab[a]; + bw := not GammaExpansionTab[b]; + if bw >= aw then + result := 0 + else + result := GammaCompressionTab[aw-bw]; +end; + +procedure SubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteSubtractInverseInline(dest^.red, c.red); + dest^.green := ByteSubtractInverseInline(dest^.green, c.green); + dest^.blue := ByteSubtractInverseInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteSubtractInverseInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteSubtractInverseInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteSubtractInverseInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteNegationInline(a, b: byte): byte; inline; +var + sum: integer; +begin + sum := integer(GammaExpansionTab[a]) + integer(GammaExpansionTab[b]); + if sum > 65535 then + sum := 131071 - sum; + Result := GammaCompressionTab[sum]; +end; + +function ByteLinearNegationInline(a, b: byte): byte; inline; +var + sum: integer; +begin + sum := integer(a) + integer(b); + if sum > 255 then + Result := 511 - sum + else + Result := sum; +end; + +procedure NegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteNegationInline(dest^.red, c.red); + dest^.green := ByteNegationInline(dest^.green, c.green); + dest^.blue := ByteNegationInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteNegationInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteNegationInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteNegationInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure LinearNegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLinearNegationInline(dest^.red, c.red); + dest^.green := ByteLinearNegationInline(dest^.green, c.green); + dest^.blue := ByteLinearNegationInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearNegationInline(dest^.red, c.red) * + destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearNegationInline(dest^.green, c.green) * + destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearNegationInline(dest^.blue, c.blue) * + destalpha + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteLightenInline(a, b: byte): byte; inline; +begin + if a > b then + Result := a + else + Result := b; +end; + +procedure LightenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteLightenInline(dest^.red, c.red); + dest^.green := ByteLightenInline(dest^.green, c.green); + dest^.blue := ByteLightenInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLightenInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLightenInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLightenInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteDarkenInline(a, b: byte): byte; inline; +begin + if a < b then + Result := a + else + Result := b; +end; + +procedure DarkenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteDarkenInline(dest^.red, c.red); + dest^.green := ByteDarkenInline(dest^.green, c.green); + dest^.blue := ByteDarkenInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteDarkenInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteDarkenInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteDarkenInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +{$hints off} +function ScreenByteInline(a, b: byte): byte; +begin + Result := 255 - ((not a) * (not b) shr 8); +end; +{$hints on} + +procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ScreenByteInline(dest^.red, c.red); + dest^.green := ScreenByteInline(dest^.green, c.green); + dest^.blue := ScreenByteInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ScreenByteInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ScreenByteInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ScreenByteInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteSoftLightInline(a,b: byte): byte; inline; +begin + result := ((not a)*b shr 7 + a)*a div 255; +end; + +procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteSoftLightInline(dest^.red, c.red); + dest^.green := ByteSoftLightInline(dest^.green, c.green); + dest^.blue := ByteSoftLightInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteSoftLightInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteSoftLightInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteSoftLightInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteSvgSoftLightInline(a,b: byte): byte; inline; +begin + if b <= 128 then + result := a - (((256 - b-b)*a shr 8)*(not a) shr 8) + else + begin + dec(b, 128); + if a <= 64 then + result := a + ((b+b) * UInt32or64(a*7 - ((a shl 2)*(a shl 2 + 256)*UInt32or64(256 - a) shr 16)) shr 8) + else + result := a + ((b+b+1) * UInt32or64(ByteSqrt(a)-a) shr 8); + end; +end; + +procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteSvgSoftLightInline(dest^.red, c.red); + dest^.green := ByteSvgSoftLightInline(dest^.green, c.green); + dest^.blue := ByteSvgSoftLightInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteSvgSoftLightInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteSvgSoftLightInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteSvgSoftLightInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +function ByteHardLightInline(a,b: byte): byte; inline; +begin + if b <= 128 then + result := a*b shr 7 + else + result := 255 - ((not a)*(not b) shr 7); +end; + +procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := ByteHardLightInline(dest^.red, c.red); + dest^.green := ByteHardLightInline(dest^.green, c.green); + dest^.blue := ByteHardLightInline(dest^.blue, c.blue); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteHardLightInline(dest^.red, c.red) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteHardLightInline(dest^.green, c.green) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteHardLightInline(dest^.blue, c.blue) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + if destalpha = 255 then + begin + dest^.red := dest^.red xor c.red; + dest^.green := dest^.green xor c.green; + dest^.blue := dest^.blue xor c.blue; + dest^.alpha := c.alpha; + end else + begin + dest^.red := ((dest^.red xor c.red) * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := ((dest^.green xor c.green) * destalpha + c.green * + (not destalpha)) shr 8; + dest^.blue := ((dest^.blue xor c.blue) * destalpha + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; +end; + +procedure BlendMaskPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +const alphaMax = 255*7; +var alpha: byte; +begin + alpha := (c.green shl 2) + (c.red shl 1) + c.blue; + alpha := alpha*c.alpha + (255*7)*(not c.alpha); + alpha := (alpha + (alphaMax shr 1)) div alphaMax; + if alpha = 0 then dest^ := BGRAPixelTransparent + else dest^.alpha := alpha; +end; + +function ByteLinearMultiplySaturationInline(a,b,l: byte): byte; inline; +begin + if b = 255 then + result := a + else if b = 0 then + result := l + else + result := (a-l)*b div 255 + l; +end; + +procedure LinearMultiplySaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; +var + destalpha: byte; + mini,maxi,l: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + mini := dest^.red; maxi := dest^.red; + if dest^.green < mini then mini := dest^.green else + if dest^.green > maxi then maxi := dest^.green; + if dest^.blue < mini then mini := dest^.blue else + if dest^.blue > maxi then maxi := dest^.blue; + l := (mini+maxi) div 2; + + if destalpha = 255 then + begin + dest^.red := ByteLinearMultiplySaturationInline(dest^.red, c.red, l); + dest^.green := ByteLinearMultiplySaturationInline(dest^.green, c.green, l); + dest^.blue := ByteLinearMultiplySaturationInline(dest^.blue, c.blue, l); + dest^.alpha := c.alpha; + end else + begin + dest^.red := (ByteLinearMultiplySaturationInline(dest^.red, c.red, l) * destalpha + + c.red * (not destalpha)) shr 8; + dest^.green := (ByteLinearMultiplySaturationInline(dest^.green, c.green, l) * destalpha + + c.green * (not destalpha)) shr 8; + dest^.blue := (ByteLinearMultiplySaturationInline(dest^.blue, c.blue, l) * destalpha + + c.blue * (not destalpha)) shr 8; + dest^.alpha := c.alpha; + end; + end; +end; + +procedure LinearHueInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + srcHSLA, destHSLA: TStdHSLA; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + srcHSLA := c.ToStdHSLA; + destHSLA := dest^.ToStdHSLA; + + destHSLA.hue := srcHSLA.hue; + destHSLA.alpha:= srcHSLA.alpha; + dest^ := destHSLA; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure LinearColorInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + srcHSLA, destHSLA: TStdHSLA; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + srcHSLA := c.ToStdHSLA; + destHSLA := dest^.ToStdHSLA; + srcHSLA.lightness := destHSLA.lightness; + dest^ := srcHSLA; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure LinearLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + destHSLA: TStdHSLA; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + destHSLA := dest^.ToStdHSLA; + destHSLA.lightness := c.ToStdHSLA.lightness; + dest^ := destHSLA; + dest^.alpha := c.alpha; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure LinearSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + destHSLA: TStdHSLA; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + destHSLA := dest^.ToStdHSLA; + if destHSLA.saturation <> 0 then + begin + destHSLA.saturation:= c.ToStdHSLA.saturation; + dest^ := destHSLA; + end; + dest^.alpha := c.alpha; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure CorrectedHueInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + srcGSBA, destGSBA: TGSBAPixel; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + srcGSBA := c.ToGSBAPixel; + destGSBA := dest^.ToGSBAPixel; + destGSBA.hue := srcGSBA.hue; + destGSBA.alpha:= srcGSBA.alpha; + dest^ := destGSBA; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure CorrectedColorInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + dest^ := SetLightness(c, dest^.Lightness); + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure CorrectedLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + dest^ := SetLightness(dest^, c.Lightness); + dest^.alpha := c.alpha; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; + +procedure CorrectedSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); +var + destalpha: byte; + destGSBA: TGSBAPixel; +begin + destalpha := dest^.alpha; + if destalpha = 0 then + begin + dest^ := c + end else + begin + destGSBA := dest^.ToGSBAPixel; + if destGSBA.saturation <> 0 then + begin + destGSBA.saturation:= c.ToGSBAPixel.saturation; + dest^ := destGSBA; + end; + dest^.alpha := c.alpha; + + if destalpha <> 255 then + begin + dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; + dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; + dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; + end; + end; +end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blendpixels.inc b/vendor/kam_remake/src/ext/BGRABitmap/blendpixels.inc new file mode 100644 index 0000000..ba55e70 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blendpixels.inc @@ -0,0 +1,497 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +procedure FastBlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + FastBlendPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DrawTransparentPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplyPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearMultiplyPixelInline(pdest, psrc^); //same look with non linear + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure AddPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + AddPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearAddPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearAddPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorBurnPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + ColorBurnPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorDodgePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + ColorDodgePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DividePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + DividePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ReflectPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + ReflectPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure GlowPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + GlowPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NiceGlowPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + NiceGlowPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure OverlayPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + OverlayPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearOverlayPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearOverlayPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DifferencePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + DifferencePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearDifferencePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearDifferencePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ExclusionPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + ExclusionPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearExclusionPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearExclusionPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearSubtractPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractInversePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearSubtractInversePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + SubtractPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractInversePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + SubtractInversePixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NegationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + NegationPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearNegationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearNegationPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LightenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LightenPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DarkenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + DarkenPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ScreenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + ScreenPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SoftLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + SoftLightPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SvgSoftLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + SvgSoftLightPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure HardLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + HardLightPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure BlendXorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + BlendXorPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure BlendMaskPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + BlendMaskPixelInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplySaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearMultiplySaturationInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearHuePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearHueInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearColorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearColorInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearLightnessPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearLightnessInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + LinearSaturationInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedHuePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + CorrectedHueInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedColorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + CorrectedColorInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedLightnessPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + CorrectedLightnessInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedSaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); +begin + while Count > 0 do + begin + CorrectedSaturationInline(pdest, psrc^); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +type + TBlendPixelsProc = procedure(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); + +const + BlendPixelsProc: array[TBlendOperation] of TBlendPixelsProc = + ( @FastBlendPixels, @DrawTransparentPixels, + @LightenPixels, @ScreenPixels, @AddPixels, @LinearAddPixels, @ColorDodgePixels, @DividePixels, @NiceGlowPixels, @SoftLightPixels, @HardLightPixels, + @GlowPixels, @ReflectPixels, @LinearOverlayPixels, @OverlayPixels, @DarkenPixels, @LinearMultiplyPixels, @ColorBurnPixels, + @DifferencePixels, @LinearDifferencePixels, @ExclusionPixels, @LinearExclusionPixels, @SubtractPixels, @LinearSubtractPixels, + @SubtractInversePixels, @LinearSubtractInversePixels, @NegationPixels, @LinearNegationPixels, @BlendXorPixels, @SvgSoftLightPixels, + @BlendMaskPixels, @LinearMultiplySaturationPixels, @LinearHuePixels, @LinearColorPixels, @LinearLightnessPixels, @LinearSaturationPixels, + @CorrectedHuePixels, @CorrectedColorPixels, @CorrectedLightnessPixels, @CorrectedSaturationPixels); + +procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; + blendOp: TBlendOperation; Count: integer; excludeChannels: TChannels = []); +const BufSize = 8; +var + destBuf: array[0..BufSize-1] of TBGRAPixel; + i: PtrInt; +begin + if (excludeChannels = [cRed,cGreen,cBlue,cAlpha]) or + ((blendOp = boMask) and (cAlpha in excludeChannels)) then exit; + + if excludeChannels = [] then + BlendPixelsProc[blendOp](pdest, psrc, count) else + begin + while Count >= BufSize do + begin + move(pdest^, {%H-}destBuf, sizeof(destBuf)); + BlendPixelsProc[blendOp](@destBuf, psrc, BufSize); + for i := 0 to BufSize-1 do + begin + if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; + if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; + if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; + if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; + inc(pdest); + end; + dec(count, BufSize); + end; + if count > 0 then + begin + move(pdest^, {%H-}destBuf, count*sizeof(TBGRAPixel)); + BlendPixelsProc[blendOp](@destBuf, psrc, count); + for i := 0 to count-1 do + begin + if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; + if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; + if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; + if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; + inc(pdest); + end; + end; + end; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blendpixelsover.inc b/vendor/kam_remake/src/ext/BGRABitmap/blendpixelsover.inc new file mode 100644 index 0000000..dd9cc22 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blendpixelsover.inc @@ -0,0 +1,1154 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{************************* blend over ***************************} + +procedure FastBlendPixelsWithOpacity(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +begin + while Count > 0 do + begin + FastBlendPixelInline(pdest, psrc^, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DrawPixelsWithOpacity(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +begin + while Count > 0 do + begin + DrawPixelInlineWithAlphaCheck(pdest, psrc^, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplyPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearMultiplyPixelInline(@temp, psrc^); //same look with non linear + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplyPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearMultiplyPixelInline(@temp, psrc^); //same look with non linear + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure AddPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + AddPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure AddPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + AddPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearAddPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearAddPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearAddPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearAddPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorBurnPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ColorBurnPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorBurnPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ColorBurnPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorDodgePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ColorDodgePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ColorDodgePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ColorDodgePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DividePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DividePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DividePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DividePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ReflectPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ReflectPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ReflectPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ReflectPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure GlowPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + GlowPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure GlowPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + GlowPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NiceGlowPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + NiceGlowPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NiceGlowPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + NiceGlowPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure OverlayPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + OverlayPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure OverlayPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + OverlayPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearOverlayPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearOverlayPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearOverlayPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearOverlayPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DifferencePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DifferencePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DifferencePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DifferencePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearDifferencePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearDifferencePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearDifferencePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearDifferencePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ExclusionPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ExclusionPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ExclusionPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ExclusionPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearExclusionPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearExclusionPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearExclusionPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearExclusionPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSubtractPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSubtractPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractInversePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSubtractInversePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSubtractInversePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSubtractInversePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SubtractPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SubtractPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractInversePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SubtractInversePixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SubtractInversePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SubtractInversePixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NegationPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + NegationPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure NegationPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + NegationPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearNegationPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearNegationPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearNegationPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearNegationPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LightenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LightenPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LightenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LightenPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DarkenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DarkenPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure DarkenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + DarkenPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ScreenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ScreenPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure ScreenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + ScreenPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SoftLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SoftLightPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SvgSoftLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SvgSoftLightPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SoftLightPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure SvgSoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + SvgSoftLightPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure HardLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + HardLightPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure HardLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + HardLightPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure BlendXorPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + BlendXorPixelInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure BlendXorPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + BlendXorPixelInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure MaskPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +const alphaMax = 255*7*255; +var + alpha, opacity256: UInt32or64; + newAlpha: byte; +begin + if Opacity >= 128 then opacity256 := Opacity+1 else opacity256 := Opacity; + while Count > 0 do + begin + if pdest^.alpha > 0 then + begin + alpha := (psrc^.green shl 2) + (psrc^.red shl 1) + psrc^.blue; + alpha := alpha*psrc^.alpha + (255*7)*(not psrc^.alpha); + newAlpha := (pdest^.alpha * alpha + (alphaMax shr 1)) div alphaMax; + pdest^.alpha := (pdest^.alpha*UInt32or64(256 - opacity256) + newAlpha*opacity256) shr 8; + if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; + end; + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplySaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearMultiplySaturationInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearHueLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearHueInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearColorLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearColorInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearLightnessLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearLightnessInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSaturationInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedHueLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedHueInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedColorLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedColorInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedLightnessLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedLightnessInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedSaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedSaturationInline(@temp, psrc^); + FastBlendPixelInline(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearMultiplySaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearMultiplySaturationInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearHueDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearHueInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearColorDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearColorInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearLightnessDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearLightnessInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure LinearSaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + LinearSaturationInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedHueDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedHueInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedColorDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedColorInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedLightnessDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedLightnessInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +procedure CorrectedSaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); +var temp: TBGRAPixel; +begin + while Count > 0 do + begin + temp := pdest^; + CorrectedSaturationInline(@temp, psrc^); + DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); + Inc(pdest); + Inc(psrc); + Dec(Count); + end; +end; + +{************************** table ****************************************} + +type + TBlendPixelsOverProc = procedure(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); + +const + BlendPixelsOverProc: array[Boolean, TBlendOperation] of TBlendPixelsOverProc = + ( (@FastBlendPixelsWithOpacity, @DrawPixelsWithOpacity, + @LightenPixelsDrawOver, @ScreenPixelsDrawOver, @AddPixelsDrawOver, @LinearAddPixelsDrawOver, @ColorDodgePixelsDrawOver, @DividePixelsDrawOver, @NiceGlowPixelsDrawOver, @SoftLightPixelsDrawOver, @HardLightPixelsDrawOver, + @GlowPixelsDrawOver, @ReflectPixelsDrawOver, @LinearOverlayPixelsDrawOver, @OverlayPixelsDrawOver, @DarkenPixelsDrawOver, @LinearMultiplyPixelsDrawOver, @ColorBurnPixelsDrawOver, + @DifferencePixelsDrawOver, @LinearDifferencePixelsDrawOver, @ExclusionPixelsDrawOver, @LinearExclusionPixelsDrawOver, @SubtractPixelsDrawOver, @LinearSubtractPixelsDrawOver, + @SubtractInversePixelsDrawOver, @LinearSubtractInversePixelsDrawOver, @NegationPixelsDrawOver, @LinearNegationPixelsDrawOver, @BlendXorPixelsDrawOver, @SvgSoftLightPixelsDrawOver, + @MaskPixelsDrawOver, @LinearMultiplySaturationDrawOver, @LinearHueDrawOver, @LinearColorDrawOver, @LinearLightnessDrawOver, @LinearSaturationDrawOver, + @CorrectedHueDrawOver, @CorrectedColorDrawOver, @CorrectedLightnessDrawOver, @CorrectedSaturationDrawOver), + (@FastBlendPixelsWithOpacity, @FastBlendPixelsWithOpacity, + @LightenPixelsLinearOver, @ScreenPixelsLinearOver, @AddPixelsLinearOver, @LinearAddPixelsLinearOver, @ColorDodgePixelsLinearOver, @DividePixelsLinearOver, @NiceGlowPixelsLinearOver, @SoftLightPixelsLinearOver, @HardLightPixelsLinearOver, + @GlowPixelsLinearOver, @ReflectPixelsLinearOver, @LinearOverlayPixelsLinearOver, @OverlayPixelsLinearOver, @DarkenPixelsLinearOver, @LinearMultiplyPixelsLinearOver, @ColorBurnPixelsLinearOver, + @DifferencePixelsLinearOver, @LinearDifferencePixelsLinearOver, @ExclusionPixelsLinearOver, @LinearExclusionPixelsLinearOver, @SubtractPixelsLinearOver, @LinearSubtractPixelsLinearOver, + @SubtractInversePixelsLinearOver, @LinearSubtractInversePixelsLinearOver, @NegationPixelsLinearOver, @LinearNegationPixelsLinearOver, @BlendXorPixelsLinearOver, @SvgSoftLightPixelsLinearOver, + @MaskPixelsDrawOver, @LinearMultiplySaturationLinearOver, @CorrectedHueLinearOver, @LinearColorLinearOver, @LinearLightnessLinearOver, @LinearSaturationLinearOver, + @CorrectedHueLinearOver, @CorrectedColorLinearOver, @CorrectedLightnessLinearOver, @CorrectedSaturationLinearOver)); + +{************************* calling procedure ***************************} + +procedure BlendPixelsOver(pdest: PBGRAPixel; psrc: PBGRAPixel; + blendOp: TBlendOperation; Count: integer; opacity: byte; linearBlend: boolean; excludeChannels: TChannels = []); +const BufSize = 8; +var + destBuf: array[0..BufSize-1] of TBGRAPixel; + i: PtrInt; + blendProc: TBlendPixelsOverProc; +begin + if (excludeChannels = [cRed,cGreen,cBlue,cAlpha]) or + ((blendOp = boMask) and (cAlpha in excludeChannels)) or + (opacity = 0) then exit; + + blendProc := BlendPixelsOverProc[linearblend, blendOp]; + if excludeChannels = [] then + blendProc(pdest, psrc, count, opacity) else + begin + while Count >= BufSize do + begin + move(pdest^, {%H-}destBuf, sizeof(destBuf)); + blendProc(@destBuf, psrc, BufSize, opacity); + for i := 0 to BufSize-1 do + begin + if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; + if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; + if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; + if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; + inc(pdest); + end; + dec(count, BufSize); + end; + if count > 0 then + begin + move(pdest^, {%H-}destBuf, count*sizeof(TBGRAPixel)); + blendProc(@destBuf, psrc, count, opacity); + for i := 0 to count-1 do + begin + if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; + if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; + if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; + if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; + inc(pdest); + end; + end; + end; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blurbox.inc b/vendor/kam_remake/src/ext/BGRABitmap/blurbox.inc new file mode 100644 index 0000000..5afbf60 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blurbox.inc @@ -0,0 +1,464 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +procedure IncAcc(var ADest: TAccumulator; ADelta: TAccumulator); inline; +begin + {$IFDEF PARAM_USE_INC64} + inc64(ADest, ADelta); + {$ELSE} + inc(ADest, ADelta); + {$ENDIF} +end; +procedure DecAcc(var ADest: TAccumulator; ADelta: TAccumulator); inline; +begin + {$IFDEF PARAM_USE_INC64} + dec64(ADest, ADelta); + {$ELSE} + dec(ADest, ADelta); + {$ENDIF} +end; + +type + TVertical = record red,green,blue,alpha,count: TAccumulator; end; + PVertical = ^TVertical; +var + verticals: PVertical; + left,right,width,height: Int32or64; + iRadiusX,iRadiusY: Int32or64; + factExtraX,factExtraY: UInt32or64; + + procedure PrepareVerticals; + var + xb,yb: Int32or64; + psrc,p: PByte; + pvert : PVertical; + {%H-}a2: UInt32or64; + delta: PtrInt; + srcPixSize: Integer; + begin + delta := ASource.RowSize; + if ASource.LineOrder = riloBottomToTop then delta := -delta; + srcPixSize := ASource.Colorspace.GetSize; + + fillchar(verticals^, width*sizeof(TVertical), 0); + psrc := ASource.GetPixelAddress(left,ABounds.Top); + pvert := verticals; + if factExtraY = 0 then + begin + for xb := left to right-1 do + begin + p := psrc; + for yb := 0 to iRadiusY-1 do + begin + if yb = height then break; + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, p^); + IncAcc(pvert^.alpha, 1); + {$ELSE} + with PBGRAPixel(p)^ do + if alpha <> 0 then + begin + a2 := alpha; + {$HINTS OFF} + IncAcc(pvert^.red, red * a2); + IncAcc(pvert^.green, green * a2); + IncAcc(pvert^.blue, blue * a2); + IncAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count); + inc(p, delta); + end; + inc(pvert); + inc(psrc, srcPixSize); + end; + end else + begin + for xb := left to right-1 do + begin + p := psrc; + for yb := 0 to iRadiusY-1 do + begin + if yb = height then break; + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, p^ * factMainY); + IncAcc(pvert^.alpha, factMainY); + {$ELSE} + with PBGRAPixel(p)^ do + if alpha <> 0 then + begin + a2 := alpha * factMainY; + {$HINTS OFF} + IncAcc(pvert^.red, red * a2); + IncAcc(pvert^.green, green * a2); + IncAcc(pvert^.blue, blue * a2); + IncAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count, factMainY); + inc(p, delta); + end; + if iRadiusY < height then + begin + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, p^ * factExtraY); + IncAcc(pvert^.alpha, factExtraY); + {$ELSE} + with PBGRAPixel(p)^ do + if alpha <> 0 then + begin + a2 := alpha * factExtraY; + {$HINTS OFF} + IncAcc(pvert^.red, red * a2); + IncAcc(pvert^.green, green * a2); + IncAcc(pvert^.blue, blue * a2); + IncAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count, factExtraY); + end; + inc(pvert); + inc(psrc, srcPixSize); + end; + end; + end; + + procedure NextVerticals(y: integer); + var + psrc0,psrc1,psrc2,psrc3: PByte; + pvert : PVertical; + xb: Int32or64; + {%H-}a2: UInt32or64; + srcPixSize: Integer; + begin + pvert := verticals; + if y-iRadiusY-1 >= ABounds.Top then + psrc1 := ASource.GetPixelAddress(left, y-iRadiusY-1) + else + psrc1 := nil; + if y+iRadiusY < ABounds.Bottom then + psrc2 := ASource.GetPixelAddress(left, y+iRadiusY) + else + psrc2 := nil; + srcPixSize := ASource.Colorspace.GetSize; + if factExtraY = 0 then + begin + for xb := width-1 downto 0 do + begin + if psrc1 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + DecAcc(pvert^.green, psrc1^); + DecAcc(pvert^.alpha, 1); + {$ELSE} + with PBGRAPixel(psrc1)^ do + if alpha <> 0 then + begin + {$HINTS OFF} + DecAcc(pvert^.red, red * alpha); + DecAcc(pvert^.green, green * alpha); + DecAcc(pvert^.blue, blue * alpha); + DecAcc(pvert^.alpha, alpha); + {$HINTS ON} + end; + {$ENDIF} + dec(pvert^.count); + inc(psrc1,srcPixSize); + end; + if psrc2 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, psrc2^); + IncAcc(pvert^.alpha, 1); + {$ELSE} + with PBGRAPixel(psrc2)^ do + if alpha <> 0 then + begin + {$HINTS OFF} + IncAcc(pvert^.red, red * alpha); + IncAcc(pvert^.green, green * alpha); + IncAcc(pvert^.blue, blue * alpha); + IncAcc(pvert^.alpha, alpha); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count); + inc(psrc2,srcPixSize); + end; + inc(pvert); + end; + end else + begin + if y-iRadiusY-2 >= ABounds.Top then + psrc0 := ASource.GetPixelAddress(left,y-iRadiusY-2) + else + psrc0 := nil; + if y+iRadiusY+1 < ABounds.Bottom then + psrc3 := ASource.GetPixelAddress(left,y+iRadiusY+1) + else + psrc3 := nil; + for xb := width-1 downto 0 do + begin + if psrc0 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + DecAcc(pvert^.green, psrc0^*factExtraY); + DecAcc(pvert^.alpha, factExtraY); + {$ELSE} + with PBGRAPixel(psrc0)^ do + if alpha <> 0 then + begin + a2 := alpha*factExtraY; + {$HINTS OFF} + DecAcc(pvert^.red, red * a2); + DecAcc(pvert^.green, green * a2); + DecAcc(pvert^.blue, blue * a2); + DecAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + dec(pvert^.count,factExtraY); + inc(psrc0,srcPixSize); + end; + if psrc1 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + DecAcc(pvert^.green, psrc1^*(factMainY - factExtraY)); + DecAcc(pvert^.alpha, (factMainY - factExtraY)); + {$ELSE} + with PBGRAPixel(psrc1)^ do + if alpha <> 0 then + begin + a2 := alpha*(factMainY - factExtraY); + {$HINTS OFF} + DecAcc(pvert^.red, red * a2); + DecAcc(pvert^.green, green * a2); + DecAcc(pvert^.blue, blue * a2); + DecAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + dec(pvert^.count, factMainY - factExtraY); + inc(psrc1,srcPixSize); + end; + if psrc2 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, psrc2^*(factMainY - factExtraY)); + IncAcc(pvert^.alpha, (factMainY - factExtraY)); + {$ELSE} + with PBGRAPixel(psrc2)^ do + if alpha <> 0 then + begin + a2 := alpha*(factMainY - factExtraY); + {$HINTS OFF} + IncAcc(pvert^.red, red * a2); + IncAcc(pvert^.green, green * a2); + IncAcc(pvert^.blue, blue * a2); + IncAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count, factMainY - factExtraY); + inc(psrc2,srcPixSize); + end; + if psrc3 <> nil then + begin + {$IFDEF PARAM_BYTEMASK} + IncAcc(pvert^.green, psrc3^*factExtraY); + IncAcc(pvert^.alpha, factExtraY); + {$ELSE} + with PBGRAPixel(psrc3)^ do + if alpha <> 0 then + begin + a2 := alpha*factExtraY; + {$HINTS OFF} + IncAcc(pvert^.red, red * a2); + IncAcc(pvert^.green, green * a2); + IncAcc(pvert^.blue, blue * a2); + IncAcc(pvert^.alpha, a2); + {$HINTS ON} + end; + {$ENDIF} + inc(pvert^.count,factExtraY); + inc(psrc3,srcPixSize); + end; + inc(pvert); + end; + end; + end; + + procedure MainLoop; + var + xb,yb,xdest: Int32or64; + pdest: PByte; + pvert : PVertical; + sumRed,sumGreen,sumBlue,sumAlpha,sumCount, + sumRed2,sumGreen2,sumBlue2,sumAlpha2,sumCount2, + {%H-}sumRed3,sumGreen3,{%H-}sumBlue3,sumAlpha3,{%H-}sumCount3: TAccumulator; + destPixSize: Integer; + begin + destPixSize := ADestination.Colorspace.GetSize; + for yb := ABounds.Top to ABounds.Bottom-1 do + begin + NextVerticals(yb); + if Assigned(ACheckShouldStop) and ACheckShouldStop(yb) then exit; + pdest := ADestination.GetPixelAddress(left,yb); + sumRed := 0; + sumGreen := 0; + sumBlue := 0; + sumAlpha := 0; + sumCount := 0; + pvert := verticals; + for xb := 0 to iRadiusX-1 do + begin + if xb = width then break; + IncAcc(sumRed, pvert^.red); + IncAcc(sumGreen, pvert^.green); + IncAcc(sumBlue, pvert^.blue); + IncAcc(sumAlpha, pvert^.alpha); + IncAcc(sumCount, pvert^.count); + inc(pvert); + end; + if factExtraX <> 0 then + begin + for xdest := 0 to width-1 do + begin + sumRed2 := 0; + sumGreen2 := 0; + sumBlue2 := 0; + sumAlpha2 := 0; + sumCount2 := 0; + if xdest-iRadiusX-1 >= 0 then + begin + pvert := verticals+(xdest-iRadiusX-1); + DecAcc(sumRed, pvert^.red); + DecAcc(sumGreen, pvert^.green); + DecAcc(sumBlue, pvert^.blue); + DecAcc(sumAlpha, pvert^.alpha); + DecAcc(sumCount, pvert^.count); + + IncAcc(sumRed2, pvert^.red); + IncAcc(sumGreen2, pvert^.green); + IncAcc(sumBlue2, pvert^.blue); + IncAcc(sumAlpha2, pvert^.alpha); + IncAcc(sumCount2, pvert^.count); + end; + if xdest+iRadiusX < width then + begin + pvert := verticals+(xdest+iRadiusX); + IncAcc(sumRed, pvert^.red); + IncAcc(sumGreen, pvert^.green); + IncAcc(sumBlue, pvert^.blue); + IncAcc(sumAlpha, pvert^.alpha); + IncAcc(sumCount, pvert^.count); + end; + if xdest+iRadiusX+1 < width then + begin + pvert := verticals+(xdest+iRadiusX+1); + IncAcc(sumRed2, pvert^.red); + IncAcc(sumGreen2, pvert^.green); + IncAcc(sumBlue2, pvert^.blue); + IncAcc(sumAlpha2, pvert^.alpha); + IncAcc(sumCount2, pvert^.count); + end; + sumAlpha3 := sumAlpha*factMainX + sumAlpha2*factExtraX; + {$IFDEF PARAM_BYTEMASK} + if sumAlpha3 > 0 then + begin + sumGreen3 := sumGreen*factMainX + sumGreen2*factExtraX; + pdest^ := (sumGreen3+(sumAlpha3 shr 1)) div sumAlpha3; + end else pdest^ := 0; + {$ELSE} + begin + sumCount3 := sumCount*factMainX + sumCount2*factExtraX; + if (sumAlpha3 >= (sumCount3+1) shr 1) and (sumCount3 > 0) then + with PBGRAPixel(pdest)^ do + begin + sumRed3 := sumRed*factMainX + sumRed2*factExtraX; + sumGreen3 := sumGreen*factMainX + sumGreen2*factExtraX; + sumBlue3 := sumBlue*factMainX + sumBlue2*factExtraX; + red := (sumRed3+(sumAlpha3 shr 1)) div sumAlpha3; + green := (sumGreen3+(sumAlpha3 shr 1)) div sumAlpha3; + blue := (sumBlue3+(sumAlpha3 shr 1)) div sumAlpha3; + alpha := (sumAlpha3+(sumCount3 shr 1)) div sumCount3; + end else + PBGRAPixel(pdest)^ := BGRAPixelTransparent; + end; + {$ENDIF} + inc(pdest, destPixSize); + end; + end else + begin + for xdest := 0 to width-1 do + begin + if xdest-iRadiusX-1 >= 0 then + begin + pvert := verticals+(xdest-iRadiusX-1); + DecAcc(sumRed, pvert^.red); + DecAcc(sumGreen, pvert^.green); + DecAcc(sumBlue, pvert^.blue); + DecAcc(sumAlpha, pvert^.alpha); + DecAcc(sumCount, pvert^.count); + end; + if xdest+iRadiusX < width then + begin + pvert := verticals+(xdest+iRadiusX); + IncAcc(sumRed, pvert^.red); + IncAcc(sumGreen, pvert^.green); + IncAcc(sumBlue, pvert^.blue); + IncAcc(sumAlpha, pvert^.alpha); + IncAcc(sumCount, pvert^.count); + end; + {$IFDEF PARAM_BYTEMASK} + if sumAlpha > 0 then + pdest^ := (sumGreen+(sumAlpha shr 1)) div sumAlpha + else pdest^ := 0; + {$ELSE} + if (sumAlpha >= (sumCount+1) shr 1) then + with PBGRAPixel(pdest)^ do + begin + red := (sumRed+(sumAlpha shr 1)) div sumAlpha; + green := (sumGreen+(sumAlpha shr 1)) div sumAlpha; + blue := (sumBlue+(sumAlpha shr 1)) div sumAlpha; + alpha := (sumAlpha+(sumCount shr 1)) div sumCount; + end else + PBGRAPixel(pdest)^ := BGRAPixelTransparent; + {$ENDIF} + inc(pdest, destPixSize); + end; + end; + end; + end; + +begin + if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then exit; + iRadiusX := floor(ARadiusX+0.5/factMainX); + iRadiusY := floor(ARadiusY+0.5/factMainY); + factExtraX := trunc(frac(ARadiusX+0.5/factMainX)*factMainX); + factExtraY := trunc(frac(ARadiusY+0.5/factMainY)*factMainY); + + if (iRadiusX <= 0) and (iRadiusY <= 0) and (factExtraX <= 0) and (factExtraY <= 0) then + begin + oldClip := ADestination.IntersectClip(ABounds); + ADestination.PutImage(0,0,ASource,dmSet); + ADestination.ClipRect := oldClip; + exit; + end; + left := ABounds.left; + right := ABounds.right; + width := right-left; + height := ABounds.bottom-ABounds.top; + ASource.LoadFromBitmapIfNeeded; + + getmem(verticals, width*sizeof(TVertical)); + try + PrepareVerticals; + MainLoop; + finally + freemem(verticals); + end; +end; +{$UNDEF PARAM_BYTEMASK} +{$UNDEF PARAM_USE_INC64} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blurfast.inc b/vendor/kam_remake/src/ext/BGRABitmap/blurfast.inc new file mode 100644 index 0000000..f703fac --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blurfast.inc @@ -0,0 +1,233 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception + +var + blurRowY,blurRowX: packed array of UInt32or64; + iRadiusX,iRadiusY: Int32or64; + weightFactor: UInt32or64; + + { Compute weights of pixels in a row } + procedure ComputeBlurRow; + var + i: Int32or64; + ofs: single; + begin + SetLength(blurRowX, 2*iRadiusX+1); + if frac(radiusX)=0 then ofs := 1 else ofs := frac(radiusX); + for i := 0 to iRadiusX do + begin + blurRowX[i] := round((i+ofs)*weightFactor); + blurRowX[high(blurRowX)-i] := blurRowX[i]; + end; + SetLength(blurRowY, 2*iRadiusY+1); + if frac(radiusY)=0 then ofs := 1 else ofs := frac(radiusY); + for i := 0 to iRadiusY do + begin + blurRowY[i] := round((i+ofs)*weightFactor); + blurRowY[high(blurRowY)-i] := blurRowY[i]; + end; + end; + + +var + srcDelta,srcPixSize, + verticalWeightShift, horizontalWeightShift: Int32or64; + ys1,ys2: Int32or64; + + { Compute blur result in a vertical direction } + procedure ComputeVerticalRow(psrc: PByte; var sums: TRowSum; pw: PNativeUInt; count: Int32or64); + begin + while count > 0 do + with sums do + begin + dec(count); + AccumulatePixel(psrc, pw^, sums, verticalWeightShift); + inc(pw); + inc(psrc,srcDelta); + end; + end; + +var + psum, psumEnd: PRowSum; + sums: packed array of TRowSum; + sumStartIndex: Int32or64; + total: TRowSum; + extendedTotal: TExtendedRowSum; + yb,xb,xs,x,xEnd: Int32or64; + pw: PNativeUInt; + psrc, pdest: PByte; + bmpWidth,bmpHeight : Int32or64; + accumulationFactor: double; + bounds: TRect; + highSum: Int32or64; + tempDest: TCustomUniversalBitmap; + destPixSize: Integer; + +begin + radiusX := round(radiusX*10)*0.1; + radiusY := round(radiusY*10)*0.1; + if (radiusX <= 0) and (radiusY <= 0) then + begin + ADestination.PutImage(0,0,bmp,dmSet); + exit; + end; + iRadiusX := ceil(radiusX); + iRadiusY := ceil(radiusY); + if (frac(radiusX)=0) and (frac(radiusY)=0) then + weightFactor:= 1 + else + weightFactor:= 10; + bmpWidth := bmp.Width; + bmpHeight := bmp.Height; + //create output + if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then + raise exception.Create('Dimension mismatch'); + bounds := bmp.GetImageBounds; + if bounds.IsEmpty then exit; + bounds.Left := max(0, bounds.Left - iRadiusX); + bounds.Top := max(0, bounds.Top - iRadiusY); + bounds.Right := min(bmp.Width, bounds.Right + iRadiusX); + bounds.Bottom := min(bmp.Height, bounds.Bottom + iRadiusY); + bounds.Intersect(ABounds); + if bounds.IsEmpty then exit; + + if radiusX*radiusY >= 100 then + begin + tempDest := ADestination.NewBitmap; + tempDest.SetSize(ADestination.Width,ADestination.Height); + FilterBlurBox(bmp,bounds,radiusX/3.2,radiusY/3.2,tempDest); + FilterBlurBox(tempDest,bounds,radiusX/2.9,radiusY/2.9,ADestination); + FilterBlurBox(ADestination,bounds,radiusX/3.2,radiusY/3.2,tempDest); + FilterBlurBox(tempDest,bounds,radiusX/2.3,radiusY/2.3,ADestination, ACheckShouldStop); + tempDest.Free; + exit; + end; + + accumulationFactor := (iRadiusY+2)*(iRadiusY+1) div 2 + (iRadiusY+1)*iRadiusY div 2; + accumulationFactor := accumulationFactor * sqr(weightFactor); + verticalWeightShift := 0; + while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do + begin + inc(verticalWeightShift); + accumulationFactor := accumulationFactor * 0.5; + end; + horizontalWeightShift:= 0; + accumulationFactor := accumulationFactor * + ((iRadiusX+2)*(iRadiusX+1) div 2 + (iRadiusX+1)*iRadiusX div 2) * + sqr(weightFactor); + while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do + begin + inc(horizontalWeightShift); + accumulationFactor := accumulationFactor * 0.5; + end; + ComputeBlurRow; + //current vertical sums + setlength(sums, 2*iRadiusX+1); + highSum := high(Sums); + psumEnd := @sums[highSum]; + inc(psumEnd); + if bmp.LineOrder = riloTopToBottom then + srcDelta := bmp.RowSize else srcDelta := -bmp.RowSize; + srcPixSize := bmp.Colorspace.GetSize; + destPixSize := ADestination.Colorspace.GetSize; + bmp.LoadFromBitmapIfNeeded; + + xEnd := bounds.left-iRadiusX+highSum; + if xEnd >= bmpWidth then xEnd := bmpWidth-1; + //loop through destination bitmap + for yb := bounds.top to bounds.bottom-1 do + begin + if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break; + //evalute available vertical range + if yb - iRadiusY < 0 then + ys1 := iRadiusY - yb + else + ys1 := 0; + if yb + iRadiusY >= bmpHeight then + ys2 := bmpHeight-1 - yb + iRadiusY + else + ys2 := 2*iRadiusY; + + { initial vertical rows are computed here. Later, + for each pixel, vertical sums are shifted, so there + is only one vertical sum to calculate } + fillchar(sums[0],sizeof(TRowSum)*length(sums),0); + x := bounds.left-iRadiusX; + if x < 0 then + begin + xs := -x; + x := 0; + end else + xs := 0; + psrc := bmp.GetPixelAddress(x, yb-iRadiusY+ys1); + psum := @sums[xs]; + pw := @blurRowY[ys1]; + while true do + begin + ComputeVerticalRow(psrc,psum^,pw,ys2-ys1+1); + inc(x); + inc(psrc, srcPixSize); + if x > xEnd then break; + inc(psum); + end; + sumStartIndex := 0; + + pdest := ADestination.GetPixelAddress(bounds.Left, yb); + for xb := bounds.left to bounds.right-1 do + begin + //add vertical rows + pw := @blurRowX[0]; + psum := @sums[sumStartIndex]; + if horizontalWeightShift > 4 then + begin //we don't want to loose too much precision + fillchar({%H-}extendedTotal,sizeof(extendedTotal),0); + for xs := highSum downto 0 do + begin + AccumulateExtended(extendedTotal, psum, pw^); + inc(pw); + inc(psum); + if psum >= psumEnd then pSum := @sums[0]; + end; + ComputeExtendedAverage(extendedTotal, pdest); + end else + if horizontalWeightShift > 0 then + begin //lossy but efficient way + fillchar({%H-}total,sizeof(total),0); + for xs := highSum downto 0 do + begin + AccumulateShr(total, psum, pw^, horizontalWeightShift); + inc(pw); + inc(psum); + if psum >= psumEnd then pSum := @sums[0]; + end; + ComputeClampedAverage(total, pdest); + end else + begin //normal way + {$hints off} + fillchar(total,sizeof(total),0); + {$hints on} + for xs := highSum downto 0 do + begin + AccumulateNormal(total, psum, pw^); + inc(pw); + inc(psum); + if psum >= psumEnd then pSum := @sums[0]; + end; + ComputeAverage(total, pdest) + end; + inc(pdest, destPixSize); + //shift vertical rows + psum := @sums[sumStartIndex]; + fillchar(psum^,sizeof(TRowSum),0); + if x < bmpWidth then + begin + ComputeVerticalRow(psrc,psum^,@blurRowY[ys1],ys2-ys1+1); + inc(x); + inc(psrc, srcPixSize); + end; + inc(sumStartIndex); + if sumStartIndex > highSum then sumStartIndex := 0; + end; + end; + ADestination.InvalidateBitmap; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/blurnormal.inc b/vendor/kam_remake/src/ext/BGRABitmap/blurnormal.inc new file mode 100644 index 0000000..0d7cc76 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/blurnormal.inc @@ -0,0 +1,253 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + PWeightedPixel = ^TWeightedPixel; + TWeightedPixel = packed record + Coord: TPoint; + Weight: Int32or64; + PtrOfs: Int32or64; + end; + +var + maskWidth,maskHeight: integer; + blurOfs: TPoint; + ppixel: PWeightedPixel; + Pixel: array of TWeightedPixel; + PixelArrayLineStart: array of integer; + DiffPixel: array of TWeightedPixel; + DiffPixelArrayLineStart: array of integer; + + bmpWidth,bmpHeight: Int32or64; + + procedure LoadMask(out ABlurOfs: TPoint); + var x,y,n: Int32or64; + tempWeight: Int32or64; + diffMask: array of packed array of Int32or64; + p: PByteMask; + qty,pStride: integer; + srcLineDelta, srcPixSize, srcLineOfs: PtrInt; + begin + ABlurOfs := point(blurMask.Width shr 1, blurMask.Height shr 1); + + //count number of non empty pixels + maskWidth := blurMask.Width; + maskHeight := blurMask.Height; + n := 0; + for y:= 0 to maskHeight-1 do + begin + blurMask.ScanMoveTo(0,Y); + x := maskWidth; + while x > 0 do + begin + qty := x; + blurMask.ScanNextMaskChunk(qty, p, pStride); + dec(x, qty); + while qty > 0 do + begin + if p^.gray <> 0 then inc(n); + inc(p, pStride); + dec(qty); + end; + end; + end; + + //initialize arrays + setlength(diffMask, maskHeight, maskWidth+1); + for y := 0 to maskHeight - 1 do + fillchar(diffMask[y,0], (maskWidth+1)*sizeof(Int32or64), 0); + + if bmp.LineOrder = riloTopToBottom then + srcLineDelta := bmp.RowSize else + srcLineDelta := -bmp.RowSize; + srcPixSize := bmp.Colorspace.GetSize; + + setlength(Pixel, n); + setlength(PixelArrayLineStart, maskHeight+1); //stores the first pixel of each line + n := 0; + //compute mask variations and initial mask pixel list + srcLineOfs := (0-ABlurOfs.Y)*srcLineDelta; + for y := 0 to maskHeight - 1 do + begin + PixelArrayLineStart[y] := n; + blurMask.ScanMoveTo(0,Y); + x := 0; + while x < maskWidth do + begin + qty := maskWidth - x; + blurMask.ScanNextMaskChunk(qty, p, pStride); + while qty > 0 do + begin + tempWeight := p^.gray; + dec(diffMask[y,x], tempWeight); + inc(diffMask[y,x+1], tempWeight); + + if tempWeight <> 0 then + begin + Pixel[n].Weight := tempWeight; + Pixel[n].Coord := Point(x,y); + Pixel[n].PtrOfs := srcLineOfs + (x-ABlurOfs.X)*srcPixSize; + Inc(n); + end; + inc(x); + inc(p, pStride); + dec(qty); + end; + end; + inc(srcLineOfs, srcLineDelta); + end; + PixelArrayLineStart[maskHeight] := n; + + //count number of diff pixels + n := 0; + for y := 0 to maskHeight - 1 do + for x := 0 to maskWidth do + if diffMask[y,x] <> 0 then Inc(n); + + //initialize arrays + setlength(DiffPixel, n); + setlength(DiffPixelArrayLineStart, maskHeight+1); //stores the first pixel of each diff line + n := 0; + //compute diff pixel list + srcLineOfs := (0-ABlurOfs.Y)*srcLineDelta; + for y := 0 to maskHeight - 1 do + begin + DiffPixelArrayLineStart[y] := n; + for x := 0 to maskWidth do + begin + tempWeight := diffMask[y,x]; + if tempWeight <> 0 then + begin + DiffPixel[n].Weight := tempWeight; + DiffPixel[n].Coord := Point(x-1,y); + DiffPixel[n].PtrOfs := srcLineOfs + (x-ABlurOfs.X-1)*srcPixSize; + Inc(n); + end; + end; + inc(srcLineOfs, srcLineDelta); + end; + DiffPixelArrayLineStart[maskHeight] := n; + end; + + function PrepareScan(AWantedBounds: TRect; out AClippedBounds: TRect): boolean; + begin + //evaluate required bounds taking blur radius into acount + AClippedBounds := bmp.GetImageBounds; + if AClippedBounds.IsEmpty then + begin + result := false; + exit; + end; + AClippedBounds.Left := max(0, AClippedBounds.Left - blurOfs.X); + AClippedBounds.Top := max(0, AClippedBounds.Top - blurOfs.Y); + AClippedBounds.Right := min(bmpWidth, AClippedBounds.Right + maskWidth - 1 - blurOfs.X); + AClippedBounds.Bottom := min(bmpHeight, AClippedBounds.Bottom + maskHeight - 1 - blurOfs.Y); + AClippedBounds.Intersect(AWantedBounds); + + if AClippedBounds.IsEmpty then + begin + result := false; + exit; + end; + + result := true; + end; + +var + bounds: TRect; + yb, xb: Int32or64; + mindy, maxdy, n, nStart, nCount, nDiffStart, nDiffCount: Int32or64; + bmpX,bmpXBase,bmpYBase: Int32or64; + pdest : PByte; + psrc : PByte; + srcPixSize,destPixSize: integer; + +begin + bmpWidth := bmp.Width; + bmpHeight:= bmp.Height; + bmp.LoadFromBitmapIfNeeded; + + if (ADestination.Width <> bmpWidth) or (ADestination.Height <> bmpHeight) then + raise exception.Create('Dimension mismatch'); + + LoadMask(blurOfs); + if not PrepareScan(ABounds, bounds) then exit; //nothing to do + + bmpYBase := bounds.Top - blurOfs.Y; + srcPixSize := bmp.Colorspace.GetSize; + destPixSize := ADestination.Colorspace.GetSize; + + //loop through destination + for yb := bounds.Top to bounds.Bottom - 1 do + begin + if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break; + psrc := bmp.GetPixelAddress(bounds.Left, yb); + pdest := ADestination.GetPixelAddress(bounds.Left, yb); + //compute vertical range + mindy := max(-blurOfs.Y, -yb); + maxdy := min(blurMask.Height - 1 - blurOfs.Y, bmpHeight - 1 - yb); + + AClearSum(AData); + + bmpXBase := bounds.Left-blurOfs.X; + nStart := PixelArrayLineStart[mindy+blurOfs.Y]; + nCount := PixelArrayLineStart[maxdy+blurOfs.Y+1]-nStart; + ppixel:= @Pixel[nStart]; + //go through pixel list of the current vertical range + for n := nCount-1 downto 0 do + begin + bmpX := bmpXBase+ppixel^.Coord.x; + //check horizontal range + if (bmpX >= 0) and (bmpX < bmpWidth) then + AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); + inc(ppixel); + end; + AComputeAverage(AData, pdest); + + nDiffStart := DiffPixelArrayLineStart[mindy+blurOfs.Y]; + nDiffCount := DiffPixelArrayLineStart[maxdy+blurOfs.Y+1]-nDiffStart; + + if nDiffCount < nCount then + begin + for xb := bounds.Left+1 to Bounds.Right - 1 do + begin + Inc(pdest, destPixSize); + inc(bmpXBase); + inc(psrc, srcPixSize); + + ppixel:= @DiffPixel[nDiffStart]; + for n := nDiffCount-1 downto 0 do + begin + bmpX := bmpXBase+ppixel^.Coord.x; + if (bmpX >= 0) and (bmpX < bmpWidth) then + AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); + inc(ppixel); + end; + AComputeAverage(AData, pDest); + end; + end else + begin + for xb := bounds.Left+1 to Bounds.Right - 1 do + begin + Inc(pdest, destPixSize); + inc(bmpXBase); + inc(psrc, srcPixSize); + + AClearSum(AData); + + ppixel:= @Pixel[nStart]; + for n := nCount-1 downto 0 do + begin + bmpX := bmpXBase+ppixel^.Coord.x; + //check horizontal range + if (bmpX >= 0) and (bmpX < bmpWidth) then + AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); + inc(ppixel); + end; + AComputeAverage(AData, pdest); + end; + end; + + inc(bmpYBase); + end; + ADestination.InvalidateBitmap; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/csscolorconst.inc b/vendor/kam_remake/src/ext/BGRABitmap/csscolorconst.inc new file mode 100644 index 0000000..d5a6c39 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/csscolorconst.inc @@ -0,0 +1,888 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{=== Color definitions ===} + +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +var + {* This is the value used for transparent pixels. In theory, any + color with alpha = 0 is transparent, however it is recommended to + use all other channels to zero as well. } + BGRAPixelTransparent: TBGRAPixel; + ExpandedPixelTransparent: TExpandedPixel; + + {* [#FFFFFF] White opaque } + BGRAWhite: TBGRAPixel; + {* [#000000] Black opaque } + BGRABlack: TBGRAPixel; + +const + {* This color [#000001] looks just like black. It is needed for drawing black + shapes using the ''Canvas'' property of ''TBGRABitmap''. This is a standard + ''TCanvas'' and when drawing with pure black (''clBlack''), there is no way to know if + something has been drawn or if it is transparent } + clBlackOpaque = TColor($010000); + +var + //VGA colors + VGABlack,VGAGray,VGASilver,VGAWhite, + VGAMaroon,VGARed,VGAPurple,VGAFuchsia, + VGAGreen,VGALime,VGAOlive,VGAYellow, + VGANavy,VGABlue,VGATeal,VGAAqua: TBGRAPixel; + + //Red colors + CSSIndianRed,CSSLightCoral,CSSSalmon,CSSDarkSalmon, + CSSRed,CSSCrimson,CSSFireBrick,CSSDarkRed: TBGRAPixel; + //Pink colors + CSSPink,CSSLightPink,CSSHotPink,CSSDeepPink, + CSSMediumVioletRed,CSSPaleVioletRed: TBGRAPixel; + //Orange colors + CSSLightSalmon,CSSCoral,CSSTomato,CSSOrangeRed, + CSSDarkOrange,CSSOrange: TBGRAPixel; + //Yellow colors + CSSGold,CSSYellow,CSSLightYellow,CSSLemonChiffon, + CSSLightGoldenrodYellow,CSSPapayaWhip,CSSMoccasin,CSSPeachPuff, + CSSPaleGoldenrod,CSSKhaki,CSSDarkKhaki: TBGRAPixel; + //Purple colors + CSSLavender,CSSThistle,CSSPlum,CSSViolet, + CSSOrchid,CSSFuchsia,CSSMagenta,CSSMediumOrchid, + CSSMediumPurple,CSSBlueViolet,CSSDarkViolet,CSSDarkOrchid, + CSSDarkMagenta,CSSPurple,CSSIndigo,CSSDarkSlateBlue, + CSSSlateBlue,CSSMediumSlateBlue: TBGRAPixel; + //Green colors + CSSGreenYellow,CSSChartreuse,CSSLawnGreen,CSSLime, + CSSLimeGreen,CSSPaleGreen,CSSLightGreen,CSSMediumSpringGreen, + CSSSpringGreen,CSSMediumSeaGreen,CSSSeaGreen,CSSForestGreen, + CSSGreen,CSSDarkGreen,CSSYellowGreen,CSSOliveDrab, + CSSOlive,CSSDarkOliveGreen,CSSMediumAquamarine,CSSDarkSeaGreen, + CSSLightSeaGreen,CSSDarkCyan,CSSTeal: TBGRAPixel; + //Blue/Cyan colors + CSSAqua,CSSCyan,CSSLightCyan,CSSPaleTurquoise, + CSSAquamarine,CSSTurquoise,CSSMediumTurquoise,CSSDarkTurquoise, + CSSCadetBlue,CSSSteelBlue,CSSLightSteelBlue,CSSPowderBlue, + CSSLightBlue,CSSSkyBlue,CSSLightSkyBlue,CSSDeepSkyBlue, + CSSDodgerBlue,CSSCornflowerBlue,CSSRoyalBlue,CSSBlue, + CSSMediumBlue,CSSDarkBlue,CSSNavy,CSSMidnightBlue: TBGRAPixel; + //Brown colors + CSSCornsilk, CSSBlanchedAlmond, CSSBisque, CSSNavajoWhite, + CSSWheat, CSSBurlyWood, CSSTan, CSSRosyBrown, + CSSSandyBrown, CSSGoldenrod, CSSDarkGoldenrod, CSSPeru, + CSSChocolate, CSSSaddleBrown, CSSSienna, CSSBrown, + CSSMaroon: TBGRAPixel; + //White colors + CSSWhite, CSSSnow, CSSHoneydew, CSSMintCream, + CSSAzure, CSSAliceBlue, CSSGhostWhite, CSSWhiteSmoke, + CSSSeashell, CSSBeige, CSSOldLace, CSSFloralWhite, + CSSIvory, CSSAntiqueWhite, CSSLinen, CSSLavenderBlush, + CSSMistyRose: TBGRAPixel; + //Gray colors + CSSGainsboro, CSSLightGray, CSSSilver, CSSDarkGray, + CSSGray, CSSDimGray, CSSLightSlateGray, CSSSlateGray, + CSSDarkSlateGray, CSSBlack: TBGRAPixel; + +type + TBGRAColorDefinition = record + Name: string; + Color: TBGRAPixel; + end; + + { TBGRAColorList } + {* Contains a fixed list of colors } + TBGRAColorList = class + protected + FFinished: boolean; + FNbColors: integer; + FColors: array of TBGRAColorDefinition; + function GetByIndex(Index: integer): TBGRAPixel; + function GetByName(Name: string): TBGRAPixel; + function GetName(Index: integer): string; + procedure Add(Name: string; out Color: TBGRAPixel; red,green,blue: byte); overload; + public + {** Creates an empty color list } + constructor Create; + {** Add a color to the list } + procedure Add(Name: string; const Color: TBGRAPixel); overload; + {** Ends the color list and prevents further modifications } + procedure Finished; + {** Returns the index of a color with a given name } + function IndexOf(Name: string): integer; + {** Returns the index of a color. Colors are considered to match if + the difference is less than or equal to ''AMaxDiff'' } + function IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer; + + {** Gets the color associated with a color name } + property ByName[Name: string]: TBGRAPixel read GetByName; + {** Gets the color at the specified index } + property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default; + {** Gets the name of the color at the specified index } + property Name[Index: integer]: string read GetName; + {** Gets the number of colors } + property Count: integer read FNbColors; + end; + +var + {* List of VGA colors: + * [#000000] Black, [#808080] Gray, [#C0C0C0] Silver, [#FFFFFF] White, + * [#800000] Maroon, [#FF0000] Red, [#800080] Purple, [#FF00FF] Fuchsia, + * [#008000] Green, [#00FF00] Lime, [#808000] Olive, [#FFFF00] Yellow, + * [#000080] Navy, [#0000FF] Blue, [#008080] Teal, [#00FFFF] Aqua. + * Shortcut constants are provided: [#000000] ''VGABlack'', [#808080] ''VGAGray''... } + VGAColors: TBGRAColorList; + {* List of [https://www.w3schools.com/cssref/css_colors.asp web colors]. + Shortcut constants are provided: [#000000] ''CSSBlack'', [#FF0000] ''CSSRed''... } + CSSColors: TBGRAColorList; + +{------------------- string conversion ------------------------} + +{* Converts a ''TBGRAPixel'' value into a string, using color names provided in ''AColorList'', and + considering that a color matches in the color list if its difference is within ''AMaxDiff'' } +function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; + AMaxDiff: Word= 0; AOptionalAlpha: boolean = false; AHashTagPrefix: boolean = false): string; +{* Converts a fully defined string into a ''TBGRAPixel'' value. Color names from ''VGAColors'' and ''CSSColors'' + are used if there is an exact match } +function StrToBGRA(str: string): TBGRAPixel; overload; +{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined or that + there is an error, ''DefaultColor'' is returned. + Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } +function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; overload; +{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined, missing channels (expressed with '?') + are filled with fallbackValues. You can check if there was an error with the provided boolean. + Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } +function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out error: boolean): TBGRAPixel; +{* Converts a string into a ''TBGRAPixel'' value into ''parsedValue''. ''parsedValue'' is not changed if + some channels are missing (expressed with '?'). You can check if there was an error with the provided boolean. + Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } +procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean); +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} +{ TBGRAColorList } + +function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel; +begin + if (Index < 0) or (Index >= FNbColors) then + result := BGRAPixelTransparent + else + result := FColors[Index].Color; +end; + +function TBGRAColorList.GetByName(Name: string): TBGRAPixel; +var i: integer; +begin + i := IndexOf(Name); + if i = -1 then + result := BGRAPixelTransparent + else + result := FColors[i].Color; +end; + +function TBGRAColorList.GetName(Index: integer): string; +begin + if (Index < 0) or (Index >= FNbColors) then + result := '' + else + result := FColors[Index].Name; +end; + +procedure TBGRAColorList.Add(Name: string; out Color: TBGRAPixel; red, green, + blue: byte); +begin + Color := BGRA(red,green,blue); + Add(Name,Color); +end; + +constructor TBGRAColorList.Create; +begin + FNbColors:= 0; + FColors := nil; + FFinished:= false; +end; + +procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel); +begin + if FFinished then + raise Exception.Create('This list is already finished'); + if length(FColors) = FNbColors then + SetLength(FColors, FNbColors*2+1); + FColors[FNbColors].Name := Name; + FColors[FNbColors].Color := Color; + inc(FNbColors); +end; + +procedure TBGRAColorList.Finished; +begin + if FFinished then exit; + FFinished := true; + SetLength(FColors, FNbColors); +end; + +function TBGRAColorList.IndexOf(Name: string): integer; +var i: integer; +begin + for i := 0 to FNbColors-1 do + if CompareText(Name, FColors[i].Name) = 0 then + begin + result := i; + exit; + end; + result := -1; +end; + +function TBGRAColorList.IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer; +var i: integer; + MinDiff,CurDiff: Word; +begin + if AMaxDiff = 0 then + begin + for i := 0 to FNbColors-1 do + if AColor = FColors[i].Color then + begin + result := i; + exit; + end; + result := -1; + end else + begin + MinDiff := AMaxDiff; + result := -1; + for i := 0 to FNbColors-1 do + begin + CurDiff := BGRAWordDiff(AColor,FColors[i].Color); + if CurDiff <= MinDiff then + begin + result := i; + MinDiff := CurDiff; + if MinDiff = 0 then exit; + end; + end; + end; +end; + +{------------------- string conversion ---------------------------------} + +{ Write a color in hexadecimal format RRGGBBAA or using the name in a color list } +function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList; + AMaxDiff: Word; AOptionalAlpha: boolean; AHashTagPrefix: boolean): string; +var idx: integer; +begin + if Assigned(AColorList) then + begin + idx := AColorList.IndexOfColor(c, AMaxDiff); + if idx<> -1 then + begin + result := AColorList.Name[idx]; + exit; + end; + end; + if AOptionalAlpha and (c.alpha = 255) then + result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2) + else + result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2); + if AHashTagPrefix then result := '#' + result; +end; + +type + arrayOfString = array of string; + +function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString; +var idxOpen,start,cur: integer; +begin + result := nil; + idxOpen := pos('(',str); + if idxOpen = 0 then + begin + start := 1; + //find first space + while (start <= length(str)) and (str[start]<>' ') do inc(start); + end else + start := idxOpen+1; + cur := start; + while cur <= length(str) do + begin + if str[cur] in[',',')'] then + begin + setlength(result,length(result)+1); + result[high(result)] := trim(copy(str,start,cur-start)); + start := cur+1; + if str[cur] = ')' then exit; + end; + inc(cur); + end; + if idxOpen <> 0 then flagError := true; //should exit on ')' + if start <= length(str) then + begin + setlength(result,length(result)+1); + result[high(result)] := copy(str,start,length(str)-start+1); + end; +end; + +function ParseColorValue(str: string; var flagError: boolean): byte; +var pourcent,unclipped,{%H-}errPos: integer; + pourcentF: single; + pourcentStr: string; +begin + if str = '' then result := 0 else + begin + if str[length(str)]='%' then + begin + pourcentStr := copy(str,1,length(str)-1); + val(pourcentStr,pourcent,errPos); + if errPos <> 0 then + begin + val(pourcentStr,pourcentF,errPos); + if errPos <> 0 then + begin + flagError := true; + result := 0; + end + else + begin + if pourcentF < 0 then result := 0 else + if pourcentF > 100 then result := 255 else + result := round(pourcentF*255 / 100); + end; + end else + begin + if pourcent < 0 then result := 0 else + if pourcent > 100 then result := 255 else + result := pourcent*255 div 100; + end; + end else + begin + val(str,unclipped,errPos); + if errPos <> 0 then flagError := true; + if unclipped < 0 then result := 0 else + if unclipped > 255 then result := 255 else + result := unclipped; + end; + end; +end; + +//this function returns the parsed value only if it contains no error nor missing values, otherwise +//it returns BGRAPixelTransparent +function StrToBGRA(str: string): TBGRAPixel; +var missingValues, error: boolean; +begin + result := BGRABlack; + TryStrToBGRA(str, result, missingValues, error); + if missingValues or error then result := BGRAPixelTransparent; +end; + +//this function changes the content of parsedValue depending on available and parsable information. +//set parsedValue to the fallback values before calling this function. +//missing values are expressed by empty string or by '?', for example 'rgb(255,?,?,?)' will change only the red value. +//note that if alpha is not expressed by the string format, it will be opaque. So 'rgb(255,?,?)' will change the red value and the alpha value. +//the last parameter of rgba() is a floating point number where 1 is opaque and 0 is transparent. +procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean); +var errPos: integer; + values: array of string; + alphaF: single; + idx: integer; +begin + str := Trim(str); + error := false; + if (str = '') or (str = '?') then + begin + missingValues := true; + exit; + end else + missingValues := false; + str := StringReplace(lowerCase(str),'grey','gray',[]); + + //VGA color names + idx := VGAColors.IndexOf(str); + if idx <> -1 then + begin + parsedValue := VGAColors[idx]; + exit; + end; + if str='transparent' then parsedValue := BGRAPixelTransparent else + begin + //check CSS color + idx := CSSColors.IndexOf(str); + if idx <> -1 then + begin + parsedValue := CSSColors[idx]; + exit; + end; + + //CSS RGB notation + if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') or + (copy(str,1,4)='rgb ') or (copy(str,1,5)='rgba ') then + begin + values := SimpleParseFuncParam(str,error); + if (length(values)=3) or (length(values)=4) then + begin + if (values[0] <> '') and (values[0] <> '?') then + parsedValue.red := ParseColorValue(values[0], error) + else + missingValues := true; + if (values[1] <> '') and (values[1] <> '?') then + parsedValue.green := ParseColorValue(values[1], error) + else + missingValues := true; + if (values[2] <> '') and (values[2] <> '?') then + parsedValue.blue := ParseColorValue(values[2], error) + else + missingValues := true; + if length(values)=4 then + begin + if (values[3] <> '') and (values[3] <> '?') then + begin + val(values[3],alphaF,errPos); + if errPos <> 0 then + begin + parsedValue.alpha := 255; + error := true; + end + else + begin + if alphaF < 0 then + parsedValue.alpha := 0 else + if alphaF > 1 then + parsedValue.alpha := 255 + else + parsedValue.alpha := round(alphaF*255); + end; + end else + missingValues := true; + end else + parsedValue.alpha := 255; + end else + error := true; + exit; + end; + + //remove HTML notation header + if str[1]='#' then delete(str,1,1); + + //add alpha if missing (if you want an undefined alpha use '??' or '?') + if length(str)=6 then AppendStr(str, 'FF') + else if length(str)=3 then AppendStr(str, 'F'); + + //hex notation + if length(str)=8 then + begin + if copy(str,1,2) <> '??' then + begin + val('$'+copy(str,1,2),parsedValue.red,errPos); + if errPos <> 0 then error := true; + end else missingValues := true; + if copy(str,3,2) <> '??' then + begin + val('$'+copy(str,3,2),parsedValue.green,errPos); + if errPos <> 0 then error := true; + end else missingValues := true; + if copy(str,5,2) <> '??' then + begin + val('$'+copy(str,5,2),parsedValue.blue,errPos); + if errPos <> 0 then error := true; + end else missingValues := true; + if copy(str,7,2) <> '??' then + begin + val('$'+copy(str,7,2),parsedValue.alpha,errPos); + if errPos <> 0 then + begin + error := true; + parsedValue.alpha := 255; + end; + end else missingValues := true; + end else + if length(str)=4 then + begin + if str[1] <> '?' then + begin + val('$'+str[1],parsedValue.red,errPos); + if errPos <> 0 then error := true; + parsedValue.red := parsedValue.red * $11; + end else missingValues := true; + if str[2] <> '?' then + begin + val('$'+str[2],parsedValue.green,errPos); + if errPos <> 0 then error := true; + parsedValue.green := parsedValue.green * $11; + end else missingValues := true; + if str[3] <> '?' then + begin + val('$'+str[3],parsedValue.blue,errPos); + if errPos <> 0 then error := true; + parsedValue.blue := parsedValue.blue * $11; + end else missingValues := true; + if str[4] <> '?' then + begin + val('$'+str[4],parsedValue.alpha,errPos); + if errPos <> 0 then + begin + error := true; + parsedValue.alpha := 255; + end else + parsedValue.alpha := parsedValue.alpha * $11; + end else missingValues := true; + end else + error := true; //string format not recognised + end; + +end; + +//this function returns the values that can be read from the string, otherwise +//it fills the gaps with the fallback values. The error boolean is True only +//if there was invalid values, it is not set to True if there was missing values. +function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out + error: boolean): TBGRAPixel; +var missingValues: boolean; +begin + result := fallbackValues; + TryStrToBGRA(str, result, missingValues, error); +end; + +{ Read a color, for example in hexadecimal format RRGGBB(AA) or RGB(A). Partial colors are not accepted by this function. } +function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; +var missingValues, error: boolean; +begin + result := BGRABlack; + TryStrToBGRA(str, result, missingValues, error); + if missingValues or error then result := DefaultColor; +end; + +function BlueGreenRedToBGRA(blue,green,red: byte): TBGRAPixel; +begin + result := BGRA(red,green,blue); +end; + +{$ENDIF} + +{$IFDEF INCLUDE_INIT} +{$UNDEF INCLUDE_INIT} + BGRAPixelTransparent := BGRA(0,0,0,0); + ExpandedPixelTransparent := BGRAPixelTransparent.ToExpanded; + BGRAWhite := BGRA(255,255,255); + BGRABlack := BGRA(0,0,0); + + VGAColors := TBGRAColorList.Create; + VGAColors.Add('Black',VGABlack,0,0,0); + VGAColors.Add('Gray',VGAGray,128,128,128); + VGAColors.Add('Silver',VGASilver,192,192,192); + VGAColors.Add('White',VGAWhite,255,255,255); + VGAColors.Add('Maroon',VGAMaroon,128,0,0); + VGAColors.Add('Red',VGARed,255,0,0); + VGAColors.Add('Purple',VGAPurple,128,0,128); + VGAColors.Add('Fuchsia',VGAFuchsia,255,0,255); + VGAColors.Add('Green',VGAGreen,0,128,0); + VGAColors.Add('Lime',VGALime,0,255,0); + VGAColors.Add('Olive',VGAOlive,128,128,0); + VGAColors.Add('Yellow',VGAYellow,255,255,0); + VGAColors.Add('Navy',VGANavy,0,0,128); + VGAColors.Add('Blue',VGABlue,0,0,255); + VGAColors.Add('Teal',VGATeal,0,128,128); + VGAColors.Add('Aqua',VGAAqua,0,255,255); + VGAColors.Finished; + + //Red colors + CSSIndianRed:= BlueGreenRedToBGRA(92, 92, 205); + CSSLightCoral:= BlueGreenRedToBGRA(128, 128, 240); + CSSSalmon:= BlueGreenRedToBGRA(114, 128, 250); + CSSDarkSalmon:= BlueGreenRedToBGRA(122, 150, 233); + CSSRed:= BlueGreenRedToBGRA(0, 0, 255); + CSSCrimson:= BlueGreenRedToBGRA(60, 20, 220); + CSSFireBrick:= BlueGreenRedToBGRA(34, 34, 178); + CSSDarkRed:= BlueGreenRedToBGRA(0, 0, 139); + + //Pink colors + CSSPink:= BlueGreenRedToBGRA(203, 192, 255); + CSSLightPink:= BlueGreenRedToBGRA(193, 182, 255); + CSSHotPink:= BlueGreenRedToBGRA(180, 105, 255); + CSSDeepPink:= BlueGreenRedToBGRA(147, 20, 255); + CSSMediumVioletRed:= BlueGreenRedToBGRA(133, 21, 199); + CSSPaleVioletRed:= BlueGreenRedToBGRA(147, 112, 219); + + //Orange colors + CSSLightSalmon:= BlueGreenRedToBGRA(122, 160, 255); + CSSCoral:= BlueGreenRedToBGRA(80, 127, 255); + CSSTomato:= BlueGreenRedToBGRA(71, 99, 255); + CSSOrangeRed:= BlueGreenRedToBGRA(0, 69, 255); + CSSDarkOrange:= BlueGreenRedToBGRA(0, 140, 255); + CSSOrange:= BlueGreenRedToBGRA(0, 165, 255); + + //Yellow colors + CSSGold:= BlueGreenRedToBGRA(0, 215, 255); + CSSYellow:= BlueGreenRedToBGRA(0, 255, 255); + CSSLightYellow:= BlueGreenRedToBGRA(224, 255, 255); + CSSLemonChiffon:= BlueGreenRedToBGRA(205, 250, 255); + CSSLightGoldenrodYellow:= BlueGreenRedToBGRA(210, 250, 250); + CSSPapayaWhip:= BlueGreenRedToBGRA(213, 239, 255); + CSSMoccasin:= BlueGreenRedToBGRA(181, 228, 255); + CSSPeachPuff:= BlueGreenRedToBGRA(185, 218, 255); + CSSPaleGoldenrod:= BlueGreenRedToBGRA(170, 232, 238); + CSSKhaki:= BlueGreenRedToBGRA(140, 230, 240); + CSSDarkKhaki:= BlueGreenRedToBGRA(107, 183, 189); + + //Purple colors + CSSLavender:= BlueGreenRedToBGRA(250, 230, 230); + CSSThistle:= BlueGreenRedToBGRA(216, 191, 216); + CSSPlum:= BlueGreenRedToBGRA(221, 160, 221); + CSSViolet:= BlueGreenRedToBGRA(238, 130, 238); + CSSOrchid:= BlueGreenRedToBGRA(214, 112, 218); + CSSFuchsia:= BlueGreenRedToBGRA(255, 0, 255); + CSSMagenta:= BlueGreenRedToBGRA(255, 0, 255); + CSSMediumOrchid:= BlueGreenRedToBGRA(211, 85, 186); + CSSMediumPurple:= BlueGreenRedToBGRA(219, 112, 147); + CSSBlueViolet:= BlueGreenRedToBGRA(226, 43, 138); + CSSDarkViolet:= BlueGreenRedToBGRA(211, 0, 148); + CSSDarkOrchid:= BlueGreenRedToBGRA(204, 50, 153); + CSSDarkMagenta:= BlueGreenRedToBGRA(139, 0, 139); + CSSPurple:= BlueGreenRedToBGRA(128, 0, 128); + CSSIndigo:= BlueGreenRedToBGRA(130, 0, 75); + CSSDarkSlateBlue:= BlueGreenRedToBGRA(139, 61, 72); + CSSSlateBlue:= BlueGreenRedToBGRA(205, 90, 106); + CSSMediumSlateBlue:= BlueGreenRedToBGRA(238, 104, 123); + + //Green colors + CSSGreenYellow:= BlueGreenRedToBGRA(47, 255, 173); + CSSChartreuse:= BlueGreenRedToBGRA(0, 255, 127); + CSSLawnGreen:= BlueGreenRedToBGRA(0, 252, 124); + CSSLime:= BlueGreenRedToBGRA(0, 255, 0); + CSSLimeGreen:= BlueGreenRedToBGRA(50, 205, 50); + CSSPaleGreen:= BlueGreenRedToBGRA(152, 251, 152); + CSSLightGreen:= BlueGreenRedToBGRA(144, 238, 144); + CSSMediumSpringGreen:= BlueGreenRedToBGRA(154, 250, 0); + CSSSpringGreen:= BlueGreenRedToBGRA(127, 255, 0); + CSSMediumSeaGreen:= BlueGreenRedToBGRA(113, 179, 60); + CSSSeaGreen:= BlueGreenRedToBGRA(87, 139, 46); + CSSForestGreen:= BlueGreenRedToBGRA(34, 139, 34); + CSSGreen:= BlueGreenRedToBGRA(0, 128, 0); + CSSDarkGreen:= BlueGreenRedToBGRA(0, 100, 0); + CSSYellowGreen:= BlueGreenRedToBGRA(50, 205, 154); + CSSOliveDrab:= BlueGreenRedToBGRA(35, 142, 107); + CSSOlive:= BlueGreenRedToBGRA(0, 128, 128); + CSSDarkOliveGreen:= BlueGreenRedToBGRA(47, 107, 85); + CSSMediumAquamarine:= BlueGreenRedToBGRA(170, 205, 102); + CSSDarkSeaGreen:= BlueGreenRedToBGRA(143, 188, 143); + CSSLightSeaGreen:= BlueGreenRedToBGRA(170, 178, 32); + CSSDarkCyan:= BlueGreenRedToBGRA(139, 139, 0); + CSSTeal:= BlueGreenRedToBGRA(128, 128, 0); + + //Blue/Cyan colors + CSSAqua:= BlueGreenRedToBGRA(255, 255, 0); + CSSCyan:= BlueGreenRedToBGRA(255, 255, 0); + CSSLightCyan:= BlueGreenRedToBGRA(255, 255, 224); + CSSPaleTurquoise:= BlueGreenRedToBGRA(238, 238, 175); + CSSAquamarine:= BlueGreenRedToBGRA(212, 255, 127); + CSSTurquoise:= BlueGreenRedToBGRA(208, 224, 64); + CSSMediumTurquoise:= BlueGreenRedToBGRA(204, 209, 72); + CSSDarkTurquoise:= BlueGreenRedToBGRA(209, 206, 0); + CSSCadetBlue:= BlueGreenRedToBGRA(160, 158, 95); + CSSSteelBlue:= BlueGreenRedToBGRA(180, 130, 70); + CSSLightSteelBlue:= BlueGreenRedToBGRA(222, 196, 176); + CSSPowderBlue:= BlueGreenRedToBGRA(230, 224, 176); + CSSLightBlue:= BlueGreenRedToBGRA(230, 216, 173); + CSSSkyBlue:= BlueGreenRedToBGRA(235, 206, 135); + CSSLightSkyBlue:= BlueGreenRedToBGRA(250, 206, 135); + CSSDeepSkyBlue:= BlueGreenRedToBGRA(255, 191, 0); + CSSDodgerBlue:= BlueGreenRedToBGRA(255, 144, 30); + CSSCornflowerBlue:= BlueGreenRedToBGRA(237, 149, 100); + CSSRoyalBlue:= BlueGreenRedToBGRA(255, 105, 65); + CSSBlue:= BlueGreenRedToBGRA(255, 0, 0); + CSSMediumBlue:= BlueGreenRedToBGRA(205, 0, 0); + CSSDarkBlue:= BlueGreenRedToBGRA(139, 0, 0); + CSSNavy:= BlueGreenRedToBGRA(128, 0, 0); + CSSMidnightBlue:= BlueGreenRedToBGRA(112, 25, 25); + + //Brown colors + CSSCornsilk:= BlueGreenRedToBGRA(220, 248, 255); + CSSBlanchedAlmond:= BlueGreenRedToBGRA(205, 235, 255); + CSSBisque:= BlueGreenRedToBGRA(196, 228, 255); + CSSNavajoWhite:= BlueGreenRedToBGRA(173, 222, 255); + CSSWheat:= BlueGreenRedToBGRA(179, 222, 245); + CSSBurlyWood:= BlueGreenRedToBGRA(135, 184, 222); + CSSTan:= BlueGreenRedToBGRA(140, 180, 210); + CSSRosyBrown:= BlueGreenRedToBGRA(143, 143, 188); + CSSSandyBrown:= BlueGreenRedToBGRA(96, 164, 244); + CSSGoldenrod:= BlueGreenRedToBGRA(32, 165, 218); + CSSDarkGoldenrod:= BlueGreenRedToBGRA(11, 134, 184); + CSSPeru:= BlueGreenRedToBGRA(63, 133, 205); + CSSChocolate:= BlueGreenRedToBGRA(30, 105, 210); + CSSSaddleBrown:= BlueGreenRedToBGRA(19, 69, 139); + CSSSienna:= BlueGreenRedToBGRA(45, 82, 160); + CSSBrown:= BlueGreenRedToBGRA(42, 42, 165); + CSSMaroon:= BlueGreenRedToBGRA(0, 0, 128); + + //White colors + CSSWhite:= BlueGreenRedToBGRA(255, 255, 255); + CSSSnow:= BlueGreenRedToBGRA(250, 250, 255); + CSSHoneydew:= BlueGreenRedToBGRA(240, 255, 250); + CSSMintCream:= BlueGreenRedToBGRA(250, 255, 245); + CSSAzure:= BlueGreenRedToBGRA(255, 255, 240); + CSSAliceBlue:= BlueGreenRedToBGRA(255, 248, 240); + CSSGhostWhite:= BlueGreenRedToBGRA(255, 248, 248); + CSSWhiteSmoke:= BlueGreenRedToBGRA(245, 245, 245); + CSSSeashell:= BlueGreenRedToBGRA(255, 245, 238); + CSSBeige:= BlueGreenRedToBGRA(220, 245, 245); + CSSOldLace:= BlueGreenRedToBGRA(230, 245, 253); + CSSFloralWhite:= BlueGreenRedToBGRA(240, 250, 255); + CSSIvory:= BlueGreenRedToBGRA(240, 255, 255); + CSSAntiqueWhite:= BlueGreenRedToBGRA(215, 235, 250); + CSSLinen:= BlueGreenRedToBGRA(230, 240, 250); + CSSLavenderBlush:= BlueGreenRedToBGRA(245, 240, 255); + CSSMistyRose:= BlueGreenRedToBGRA(255, 228, 255); + + //Gray colors + CSSGainsboro:= BlueGreenRedToBGRA(220, 220, 220); + CSSLightGray:= BlueGreenRedToBGRA(211, 211, 211); + CSSSilver:= BlueGreenRedToBGRA(192, 192, 192); + CSSDarkGray:= BlueGreenRedToBGRA(169, 169, 169); + CSSGray:= BlueGreenRedToBGRA(128, 128, 128); + CSSDimGray:= BlueGreenRedToBGRA(105, 105, 105); + CSSLightSlateGray:= BlueGreenRedToBGRA(153, 136, 119); + CSSSlateGray:= BlueGreenRedToBGRA(144, 128, 112); + CSSDarkSlateGray:= BlueGreenRedToBGRA(79, 79, 47); + CSSBlack:= BlueGreenRedToBGRA(0, 0, 0); + + CSSColors := TBGRAColorList.Create; + CSSColors.Add('AliceBlue',CSSAliceBlue); + CSSColors.Add('AntiqueWhite',CSSAntiqueWhite); + CSSColors.Add('Aqua',CSSAqua); + CSSColors.Add('Aquamarine',CSSAquamarine); + CSSColors.Add('Azure',CSSAzure); + CSSColors.Add('Beige',CSSBeige); + CSSColors.Add('Bisque',CSSBisque); + CSSColors.Add('Black',CSSBlack); + CSSColors.Add('BlanchedAlmond',CSSBlanchedAlmond); + CSSColors.Add('Blue',CSSBlue); + CSSColors.Add('BlueViolet',CSSBlueViolet); + CSSColors.Add('Brown',CSSBrown); + CSSColors.Add('BurlyWood',CSSBurlyWood); + CSSColors.Add('CadetBlue',CSSCadetBlue); + CSSColors.Add('Chartreuse',CSSChartreuse); + CSSColors.Add('Chocolate',CSSChocolate); + CSSColors.Add('Coral',CSSCoral); + CSSColors.Add('CornflowerBlue',CSSCornflowerBlue); + CSSColors.Add('Cornsilk',CSSCornsilk); + CSSColors.Add('Crimson',CSSCrimson); + CSSColors.Add('Cyan',CSSCyan); + CSSColors.Add('DarkBlue',CSSDarkBlue); + CSSColors.Add('DarkCyan',CSSDarkCyan); + CSSColors.Add('DarkGoldenrod',CSSDarkGoldenrod); + CSSColors.Add('DarkGray',CSSDarkGray); + CSSColors.Add('DarkGreen',CSSDarkGreen); + CSSColors.Add('DarkKhaki',CSSDarkKhaki); + CSSColors.Add('DarkMagenta',CSSDarkMagenta); + CSSColors.Add('DarkOliveGreen',CSSDarkOliveGreen); + CSSColors.Add('DarkOrange',CSSDarkOrange); + CSSColors.Add('DarkOrchid',CSSDarkOrchid); + CSSColors.Add('DarkRed',CSSDarkRed); + CSSColors.Add('DarkSalmon',CSSDarkSalmon); + CSSColors.Add('DarkSeaGreen',CSSDarkSeaGreen); + CSSColors.Add('DarkSlateBlue',CSSDarkSlateBlue); + CSSColors.Add('DarkSlateGray',CSSDarkSlateGray); + CSSColors.Add('DarkTurquoise',CSSDarkTurquoise); + CSSColors.Add('DarkViolet',CSSDarkViolet); + CSSColors.Add('DeepPink',CSSDeepPink); + CSSColors.Add('DeepSkyBlue',CSSDeepSkyBlue); + CSSColors.Add('DimGray',CSSDimGray); + CSSColors.Add('DodgerBlue',CSSDodgerBlue); + CSSColors.Add('FireBrick',CSSFireBrick); + CSSColors.Add('FloralWhite',CSSFloralWhite); + CSSColors.Add('ForestGreen',CSSForestGreen); + CSSColors.Add('Fuchsia',CSSFuchsia); + CSSColors.Add('Gainsboro',CSSGainsboro); + CSSColors.Add('GhostWhite',CSSGhostWhite); + CSSColors.Add('Gold',CSSGold); + CSSColors.Add('Goldenrod',CSSGoldenrod); + CSSColors.Add('Gray',CSSGray); + CSSColors.Add('Green',CSSGreen); + CSSColors.Add('GreenYellow',CSSGreenYellow); + CSSColors.Add('Honeydew',CSSHoneydew); + CSSColors.Add('HotPink',CSSHotPink); + CSSColors.Add('IndianRed',CSSIndianRed); + CSSColors.Add('Indigo',CSSIndigo); + CSSColors.Add('Ivory',CSSIvory); + CSSColors.Add('Khaki',CSSKhaki); + CSSColors.Add('Lavender',CSSLavender); + CSSColors.Add('LavenderBlush',CSSLavenderBlush); + CSSColors.Add('LawnGreen',CSSLawnGreen); + CSSColors.Add('LemonChiffon',CSSLemonChiffon); + CSSColors.Add('LightBlue',CSSLightBlue); + CSSColors.Add('LightCoral',CSSLightCoral); + CSSColors.Add('LightCyan',CSSLightCyan); + CSSColors.Add('LightGoldenrodYellow',CSSLightGoldenrodYellow); + CSSColors.Add('LightGray',CSSLightGray); + CSSColors.Add('LightGreen',CSSLightGreen); + CSSColors.Add('LightPink',CSSLightPink); + CSSColors.Add('LightSalmon',CSSLightSalmon); + CSSColors.Add('LightSeaGreen',CSSLightSeaGreen); + CSSColors.Add('LightSkyBlue',CSSLightSkyBlue); + CSSColors.Add('LightSlateGray',CSSLightSlateGray); + CSSColors.Add('LightSteelBlue',CSSLightSteelBlue); + CSSColors.Add('LightYellow',CSSLightYellow); + CSSColors.Add('Lime',CSSLime); + CSSColors.Add('LimeGreen',CSSLimeGreen); + CSSColors.Add('Linen',CSSLinen); + CSSColors.Add('Magenta',CSSMagenta); + CSSColors.Add('Maroon',CSSMaroon); + CSSColors.Add('MediumAquamarine',CSSMediumAquamarine); + CSSColors.Add('MediumBlue',CSSMediumBlue); + CSSColors.Add('MediumOrchid',CSSMediumOrchid); + CSSColors.Add('MediumPurple',CSSMediumPurple); + CSSColors.Add('MediumSeaGreen',CSSMediumSeaGreen); + CSSColors.Add('MediumSlateBlue',CSSMediumSlateBlue); + CSSColors.Add('MediumSpringGreen',CSSMediumSpringGreen); + CSSColors.Add('MediumTurquoise',CSSMediumTurquoise); + CSSColors.Add('MediumVioletRed',CSSMediumVioletRed); + CSSColors.Add('MidnightBlue',CSSMidnightBlue); + CSSColors.Add('MintCream',CSSMintCream); + CSSColors.Add('MistyRose',CSSMistyRose); + CSSColors.Add('Moccasin',CSSMoccasin); + CSSColors.Add('NavajoWhite',CSSNavajoWhite); + CSSColors.Add('Navy',CSSNavy); + CSSColors.Add('OldLace',CSSOldLace); + CSSColors.Add('Olive',CSSOlive); + CSSColors.Add('OliveDrab',CSSOliveDrab); + CSSColors.Add('Orange',CSSOrange); + CSSColors.Add('OrangeRed',CSSOrangeRed); + CSSColors.Add('Orchid',CSSOrchid); + CSSColors.Add('PaleGoldenrod',CSSPaleGoldenrod); + CSSColors.Add('PaleGreen',CSSPaleGreen); + CSSColors.Add('PaleTurquoise',CSSPaleTurquoise); + CSSColors.Add('PaleVioletRed',CSSPaleVioletRed); + CSSColors.Add('PapayaWhip',CSSPapayaWhip); + CSSColors.Add('PeachPuff',CSSPeachPuff); + CSSColors.Add('Peru',CSSPeru); + CSSColors.Add('Pink',CSSPink); + CSSColors.Add('Plum',CSSPlum); + CSSColors.Add('PowderBlue',CSSPowderBlue); + CSSColors.Add('Purple',CSSPurple); + CSSColors.Add('Red',CSSRed); + CSSColors.Add('RosyBrown',CSSRosyBrown); + CSSColors.Add('RoyalBlue',CSSRoyalBlue); + CSSColors.Add('SaddleBrown',CSSSaddleBrown); + CSSColors.Add('Salmon',CSSSalmon); + CSSColors.Add('SandyBrown',CSSSandyBrown); + CSSColors.Add('SeaGreen',CSSSeaGreen); + CSSColors.Add('Seashell',CSSSeashell); + CSSColors.Add('Sienna',CSSSienna); + CSSColors.Add('Silver',CSSSilver); + CSSColors.Add('SkyBlue',CSSSkyBlue); + CSSColors.Add('SlateBlue',CSSSlateBlue); + CSSColors.Add('SlateGray',CSSSlateGray); + CSSColors.Add('Snow',CSSSnow); + CSSColors.Add('SpringGreen',CSSSpringGreen); + CSSColors.Add('SteelBlue',CSSSteelBlue); + CSSColors.Add('Tan',CSSTan); + CSSColors.Add('Teal',CSSTeal); + CSSColors.Add('Thistle',CSSThistle); + CSSColors.Add('Tomato',CSSTomato); + CSSColors.Add('Turquoise',CSSTurquoise); + CSSColors.Add('Violet',CSSViolet); + CSSColors.Add('Wheat',CSSWheat); + CSSColors.Add('White',CSSWhite); + CSSColors.Add('WhiteSmoke',CSSWhiteSmoke); + CSSColors.Add('Yellow',CSSYellow); + CSSColors.Add('YellowGreen',CSSYellowGreen); + CSSColors.Finished; +{$ENDIF} + +{$IFDEF INCLUDE_FINAL} +{$UNDEF INCLUDE_FINAL} + CSSColors.Free; + VGAColors.Free; +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/density256.inc b/vendor/kam_remake/src/ext/BGRABitmap/density256.inc new file mode 100644 index 0000000..fd132a4 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/density256.inc @@ -0,0 +1,98 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_FILLDENSITY} +{$UNDEF INCLUDE_FILLDENSITY} + + {$IFNDEF PARAM_SINGLESEGMENT} + begin + { this loops fill one scanline of densities by adding 256 for full horizontal pixels } + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i + 1].interX; + {$ENDIF} + + if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then + begin + if x1 < minx then + x1 := minx; + if x2 >= maxx + 1 then + x2 := maxx + 1; + ix1 := floor(x1); + ix2 := floor(x2); + + //here it may go one pixel further if x2 is an integer + if ix1 < densMinx then densMinx := ix1; + if ix2 > densMaxx then densMaxx := ix2; + + if ix1 = ix2 then + inc( (density + (ix1 - minx))^, round((x2-ix2)*256) - round((x1-ix1)*256) ) + else + begin + inc( (density + (ix1 - minx))^, 256 - round((x1 - ix1)*256) ); + if (ix2 <= maxx) then + inc( (density + (ix2 - minx))^, round((x2 - ix2)*256) ); + end; + if ix2 > ix1 + 1 then + begin + AddDensity(density, ix1+1 - minx, ix2-(ix1+1), 256); + end; + end; + + {$IFNDEF PARAM_SINGLESEGMENT} + end; + end; + {$ENDIF} + +{$UNDEF PARAM_SINGLESEGMENT} +{$ENDIF} + +{$IFDEF INCLUDE_RENDERDENSITY} +{$UNDEF INCLUDE_RENDERDENSITY} + begin + if densMinX <= densMaxX then + begin + if densMinX < minx then densMinX := minx; + if densMaxX > maxx then densMaxX := maxx; + xb := densMinX; + pdens := density + (densMinX-minx); + pDest := bmp.GetPixelAddress(densMinX,yb); + brush.MoveTo(@ctx, pDest,xb,yb); + while xb<=densMaxX do + begin + tempDensity:= pDens^; + inc(pDens); + inc(xb); + drawCount := 1; + if tempDensity>=256{$ifdef PARAM_ANTIALIASINGFACTOR} shl AntialiasPrecisionShift{$endif} then + begin + while (xb<=densMaxX) and (pDens^ >= 256{$ifdef PARAM_ANTIALIASINGFACTOR} shl AntialiasPrecisionShift{$endif}) do + begin + inc(xb); + inc(pDens); + inc(drawCount); + end; + brush.PutNextPixels(@ctx, 65535, drawCount); + end else + begin + while (xb<=densMaxX) and (pDens^ = tempDensity) do + begin + inc(xb); + inc(pDens); + inc(drawCount); + end; + if tempDensity = 0 then + brush.PutNextPixels(@ctx, 0, drawCount ) + else + begin + dec(tempDensity); + brush.PutNextPixels(@ctx, (tempDensity shl (8{$ifdef PARAM_ANTIALIASINGFACTOR}-AntialiasPrecisionShift{$endif})) + + (tempDensity{$ifdef PARAM_ANTIALIASINGFACTOR} shr (2*AntialiasPrecisionShift){$endif}), drawCount ); + end; + end; + end; + end; + end + +{$undef PARAM_ANTIALIASINGFACTOR} +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/expandedbitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/expandedbitmap.pas new file mode 100644 index 0000000..1c23368 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/expandedbitmap.pas @@ -0,0 +1,762 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit ExpandedBitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; + +type + + { TExpandedBitmap } + + TExpandedBitmap = class(specialize TGenericUniversalBitmap) + protected + function InternalNew: TCustomUniversalBitmap; override; + procedure AssignTransparentPixel(out ADest); override; + public + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TExpandedPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + end; + +const + ExpandedPixelTransparent : TExpandedPixel = (red:0; green:0; blue:0; alpha:0); + +operator = (const c1, c2: TExpandedPixel): boolean; inline; + +implementation + +uses XYZABitmap; + +operator = (const c1, c2: TExpandedPixel): boolean; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + Result := True + else + Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and + (c1.green = c2.green) and (c1.blue = c2.blue); +end; + +procedure ExpandedSolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PExpandedPixel(AContextData^.Dest), ACount); +end; + +procedure ExpandedChunkSetPixels( + ASource: PExpandedPixel; ADest: PExpandedPixel; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + ((ASource^.alpha*alphaOver+32768) shr 16); + if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure ExpandedSolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; +begin + pDest := PExpandedPixel(AContextData^.Dest); + ExpandedChunkSetPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure ExpandedChunkDrawPixels( + ASource: PExpandedPixel; ADest: PExpandedPixel; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver, srcAlphaOver, finalAlpha, finalAlphaDiv2, residualAlpha: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha >= 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + srcAlphaOver := (ASource^.alpha*alphaOver+32768) shr 16; + if srcAlphaOver >= 65535 then + ADest^ := ASource^ + else + begin + if srcAlphaOver >= 32768 then inc(srcAlphaOver); + residualAlpha := (ADest^.alpha*UInt32or64(65536-srcAlphaOver)+32768) shr 16; + finalAlpha := residualAlpha + srcAlphaOver; + if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + ADest^.alpha:= finalAlpha; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; +end; + +procedure ExpandedSolidBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; +begin + pDest := PExpandedPixel(AContextData^.Dest); + ExpandedChunkDrawPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure ExpandedChunkXorPixels( + ASource: PExpandedPixel; ADest: PExpandedPixel; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; + xored: TExpandedPixel; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + PQWord(ADest)^ := PQWord(ADest)^ xor PQWord(ASource)^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + PQWord(@xored)^ := PQWord(ADest)^ xor PQWord(ASource)^; + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + ((xored.alpha*alphaOver+32768) shr 16); + if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + xored.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.green := (ADest^.green*residualAlpha + + xored.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.blue := (ADest^.blue*residualAlpha + + xored.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure ExpandedSolidBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; +begin + pDest := PExpandedPixel(AContextData^.Dest); + ExpandedChunkXorPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +type + PExpandedPixelScannerBrushFixedData = ^TExpandedScannerBrushFixedData; + TExpandedScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + Conversion: TBridgedConversion; + end; + +procedure ExpandedScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure ExpandedScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PExpandedPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); + ExpandedChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerChunkBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PExpandedPixel; + qty: Integer; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ExpandedChunkSetPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedChunkSetPixelsExceptTransparent( + ASource: PExpandedPixel; ADest: PExpandedPixel; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + if ASource^.alpha = 65535 then ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + if ASource^.alpha = 65535 then + begin + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + AAlpha; + if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure ExpandedScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; + qty: Integer; + psrc: Pointer; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ExpandedChunkSetPixelsExceptTransparent(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PExpandedPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); + ExpandedChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerChunkBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ExpandedChunkDrawPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerConvertBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PExpandedPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); + ExpandedChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerChunkBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + ExpandedChunkXorPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedScannerConvertBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PExpandedPixel; + qty, pixSize: Integer; + buf: packed array[0..7] of TExpandedPixel; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); + ExpandedChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure ExpandedMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; + qty, maskStride: Integer; + pMask: PByteMask; + factor: UInt32or64; +begin + with PExpandedPixelScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + if AAlpha = 65535 then + begin + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + if pMask^.gray >= 128 then + pDest^.alpha := (pDest^.alpha*(pMask^.gray+1)) shr 8 + else pDest^.alpha := pDest^.alpha*pMask^.gray shr 8; + if pDest^.alpha = 0 then pDest^ := ExpandedPixelTransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end else + begin + factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := (pDest^.alpha*((factor*pMask^.gray+128) shr 8)) shr 16; + if pDest^.alpha = 0 then pDest^ := ExpandedPixelTransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end; + PExpandedPixel(AContextData^.Dest) := pDest; + end; +end; + +procedure ExpandedAlphaBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; + alphaOver, residualAlpha, finalAlpha: UInt32or64; +begin + if AAlpha=0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + if AAlpha=65535 then + begin + finalAlpha := PWord(AFixedData)^; + while ACount > 0 do + begin + pDest^.alpha := finalAlpha; + inc(pDest); + dec(ACount); + end; + end else + begin + if AAlpha >= 32768 then alphaOver := AAlpha+1 + else alphaOver := AAlpha; + while ACount > 0 do + begin + residualAlpha := (pDest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + (PWord(AFixedData)^*alphaOver+32768) shr 16; + if finalAlpha > 65535 then finalAlpha := 65535; + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + end; + PExpandedPixel(AContextData^.Dest) := pDest; +end; + +procedure ExpandedAlphaBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PExpandedPixel; + alphaMul, finalAlpha: UInt32or64; +begin + if AAlpha=0 then + begin + inc(PExpandedPixel(AContextData^.Dest), ACount); + exit; + end; + pDest := PExpandedPixel(AContextData^.Dest); + if AAlpha<>65535 then + alphaMul := 65535-((PWord(AFixedData)^*AAlpha+32767) div 65535) + else + alphaMul := 65535-PWord(AFixedData)^; + if alphaMul >= 32768 then inc(alphaMul); + while ACount > 0 do + begin + finalAlpha := (pDest^.alpha*alphaMul+32768) shr 16; + if finalAlpha <= 0 then pDest^ := ExpandedPixelTransparent else + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + PExpandedPixel(AContextData^.Dest) := pDest; +end; + +{ TExpandedBitmap } + +function TExpandedBitmap.InternalNew: TCustomUniversalBitmap; +begin + Result:= TExpandedBitmap.Create; +end; + +procedure TExpandedBitmap.AssignTransparentPixel(out ADest); +begin + TExpandedPixel(ADest) := ExpandedPixelTransparent; +end; + +class procedure TExpandedBitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TExpandedPixel; ADrawMode: TDrawMode); +begin + ABrush.Colorspace:= TExpandedPixelColorspace; + PExpandedPixel(@ABrush.FixedData)^ := AColor; + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels; + + dmSetExceptTransparent: + if AColor.alpha < 65535 then + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels + else + begin + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels; + ABrush.DoesNothing := true; + end; + + dmDrawWithTransparency,dmLinearBlend: + if AColor.alpha<=0 then + begin + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels; + ABrush.DoesNothing := true; + end + else if AColor.alpha>=1 then + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels + else + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushDrawPixels; + + dmXor: if PQWord(@AColor)^ = 0 then + begin + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels; + ABrush.DoesNothing := true; + end else + ABrush.InternalPutNextPixels:= @ExpandedSolidBrushXorPixels; + end; +end; + +class procedure TExpandedBitmap.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer; AOffsetY: integer); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TExpandedPixelColorspace; + with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @ExpandedScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if sourceSpace = TExpandedPixelColorspace then + begin + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushXorPixels; + end; + end else + begin + with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TExpandedPixelColorspace); + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushXorPixels; + end; + end; +end; + +class procedure TExpandedBitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TExpandedPixelColorspace; + with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @ExpandedScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @ExpandedMaskBrushApply; +end; + +class procedure TExpandedBitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, ExpandedPixelTransparent, dmDrawWithTransparency); + exit; + end; + ABrush.Colorspace:= TExpandedPixelColorspace; + PWord(@ABrush.FixedData)^ := AAlpha; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @ExpandedAlphaBrushErasePixels; +end; + +class procedure TExpandedBitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, ExpandedPixelTransparent, dmSet); + exit; + end; + ABrush.Colorspace:= TExpandedPixelColorspace; + PWord(@ABrush.FixedData)^ := AAlpha; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @ExpandedAlphaBrushSetPixels; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/extendedcolorspace.inc b/vendor/kam_remake/src/ext/BGRABitmap/extendedcolorspace.inc new file mode 100644 index 0000000..7bbd22a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/extendedcolorspace.inc @@ -0,0 +1,1454 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} + +type + TSpectralLocusPoint = record + W,X,Y,Z: Single; + end; + TIlluminantSpectrumPoint = record + W,Y: Single; + end; + +{$I spectraldata.inc} + +type + PXYZReferenceWhite = ^TXYZReferenceWhite; + TXYZReferenceWhite = packed record + X, Y, Z: single; + ObserverAngle: integer; + Illuminant: string; + L,M,S: single; + end; + + TCustomColorspace = class; + TColorspaceAny = class of TCustomColorspace; + + TColorspaceConvertArrayProc = procedure(ASource: pointer; ADest: Pointer; ACount: integer; + ASourceStride:integer; ADestStride:integer; AReferenceWhite: PXYZReferenceWhite); + + { TBridgedConversion } + + TBridgedConversion = record + ConvertToBridge,FinalConvert: TColorspaceConvertArrayProc; + procedure Convert(ASource: pointer; ADest: Pointer; ACount: integer; + ASourceStride:integer; ADestStride:integer; AReferenceWhite: PXYZReferenceWhite); inline; + end; + + TColorTransparency = (ctFullyTransparent, ctSemiTransparent, ctFullyOpaque); + TColorspaceFlag = (cfFixedReferenceWhite, // ex: sRGB, AdobeRGB fixed at D65 + cfMovableReferenceWhite, // XYZ + cfReferenceWhiteIndependent, // L*a*b*, LCh + cfHasImaginaryColors); // XYZ, L*a*b*, LCh + TColorspaceFlags = set of TColorspaceFlag; + + { TCustomColorspace } + + TCustomColorspace = class + class function GetChannelName(AIndex: integer): string; virtual; abstract; + class function GetChannelCount: integer; virtual; abstract; + class function IndexOfChannel(AName: string): integer; + class function IndexOfAlphaChannel: integer; virtual; abstract; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; virtual; abstract; + class function GetMaxValue(AIndex: integer): single; virtual; abstract; + class function GetMinValue(AIndex: integer): single; virtual; abstract; + class function GetChannelBitDepth(AIndex: integer): byte; virtual; abstract; + class function GetName: string; virtual; abstract; + class function GetSize: integer; virtual; abstract; + class function GetChannel(AColor: Pointer; AIndex: integer): single; virtual; abstract; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); virtual; abstract; + class procedure Convert(const ASource; out ADest; ADestColorspace: TColorspaceAny; + ACount: integer = 1; AReferenceWhite: PXYZReferenceWhite = nil); + class function GetDirectConversion(ADestColorspace: TColorspaceAny): TColorspaceConvertArrayProc; + class function GetBridgedConversion(ADestColorspace: TColorspaceAny): TBridgedConversion; + class function GetFlags: TColorspaceFlags; virtual; abstract; + end; + + { ColorspaceCollection } + + ColorspaceCollection = class + protected + class var FColorspaces : array of TColorspaceAny; + class var FColorspaceCount: integer; + class var FColorspaceConversions: array of array of TColorspaceConvertArrayProc; + public + class function GetCount: integer; static; + class function GetItem(AIndex: integer): TColorspaceAny; static; + class function IndexOf(AColorspace: TColorspaceAny): integer; static; + class procedure Add(AColorspace: TColorspaceAny); static; + class procedure AddConversion(ASource: TColorspaceAny; ADest: TColorspaceAny; AConversion: TColorspaceConvertArrayProc); static; + class function GetDirectConversion(ASource: TColorspaceAny; ADest: TColorspaceAny): TColorspaceConvertArrayProc; static; + class function GetBridgedConversion(ASource: TColorspaceAny; ADest: TColorspaceAny): TBridgedConversion; static; + end; + +type {* How to handle overflow when converting from XYZ } + TColorspaceOverflow = + {** Colors outside of target colorspace are converted to transparent } + (xroClipToTarget, + {** Each color channel is saturated independently (hue may be lost) } + xroSaturateEachChannel, + {** Hue is preserved by reducing intensity or saturation } + xroPreserveHue); + +var + XYZToRGBOverflowMin : TColorspaceOverflow = xroSaturateEachChannel; + XYZToRGBOverflowMax : TColorspaceOverflow = xroSaturateEachChannel; + +{$DEFINE INCLUDE_INTERFACE} +{$I generatedcolorspace.inc} + +function BGRAToMask(const ABGRAPixel: TBGRAPixel): TByteMask; +function ExpandedPixelToByteMask(const AExpandedPixel: TExpandedPixel): TByteMask; +function MaskToBGRA(const AMask: TByteMask; AAlpha: byte = 255): TBGRAPixel; +function ByteMaskToExpandedPixel(const AMask: TByteMask; AAlpha: byte = 255): TExpandedPixel; +function StdRGBAToBGRAPixel(const AStdRGBA: TStdRGBA): TBGRAPixel; +function BGRAPixelToStdRGBA(const ABGRAPixel: TBGRAPixel): TStdRGBA; +function LinearRGBAToExpandedPixel(const ALinearRGBA: TLinearRGBA): TExpandedPixel; +function ExpandedPixelToLinearRGBA(const AExpandedPixel: TExpandedPixel): TLinearRGBA; +function ExpandedPixelToStdRGBA(const AExpandedPixel: TExpandedPixel): TStdRGBA; +function GammaCompressionWF(AValue: Word): single; +function StdRGBAToExpandedPixel(const AStdRGBA: TStdRGBA): TExpandedPixel; +function GammaExpansionFW(AValue: single): word; +function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA): TXYZA; overload; +function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; +function XYZAToLinearRGBA(const AXYZA: TXYZA): TLinearRGBA; overload; +function XYZAToLinearRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA; overload; +function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel): TWordXYZA; overload; +function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA; overload; +function XYZAToWordXYZA(const AXYZA: TXYZA): TWordXYZA; +function WordXYZAToXYZA(const AWordXYZA: TWordXYZA): TXYZA; +function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA): TExpandedPixel; overload; +function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel; overload; +function XYZAToLabA(const AXYZA: TXYZA): TLabA; overload; +function XYZAToLabA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA; overload; +function LabAToXYZA(const ALabA: TLabA): TXYZA; overload; +function LabAToXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; +function StdRGBAToLinearRGBA(const AStdRGBA: TStdRGBA): TLinearRGBA; +function LinearRGBAToStdRGBA(const ALinearRGBA: TLinearRGBA): TStdRGBA; +function StdRGBAToStdHSLA(const AStdRGBA: TStdRGBA): TStdHSLA; +function StdHSLAToStdRGBA(const AStdHSLA: TStdHSLA): TStdRGBA; +function StdRGBAToStdHSVA(const AStdRGBA: TStdRGBA): TStdHSVA; +function StdHSVAToStdRGBA(const AStdHSVA: TStdHSVA): TStdRGBA; +function StdHSLAToStdHSVA(const AStdHSLA: TStdHSLA): TStdHSVA; +function StdHSVAToStdHSLA(const AStdHSVA: TStdHSVA): TStdHSLA; +function StdRGBAToStdCMYK(const AStdRGBA: TStdRGBA): TStdCMYK; +function StdCMYKToStdRGBA(const AStdCMYK: TStdCMYK; AAlpha: Single = 1): TStdRGBA; +function LabAToLChA(const ALabA: TLabA): TLChA; +function LChAToLabA(const ALChA: TLChA): TLabA; +function AdobeRGBAToXYZA(const ASource: TAdobeRGBA): TXYZA; overload; +function AdobeRGBAToXYZA(const ASource: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; +function XYZAToAdobeRGBA(const AXYZA: TXYZA): TAdobeRGBA; overload; +function XYZAToAdobeRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA; overload; +function SpectrumRangeReflectToXYZA(reflectance,wavelen1,wavelen2,alpha: single): TXYZA; +procedure XYZToLMS(const X,Y,Z: Single; out L,M,S: single); +procedure LMSToXYZ(const L,M,S: Single; out X,Y,Z: single); +procedure ChromaticAdaptXYZ(var X,Y,Z: single; const AFrom, ATo: TXYZReferenceWhite); inline; +procedure ChromaticAdaptWordXYZ(var X,Y,Z: word; const AFrom, ATo: TXYZReferenceWhite); inline; + +procedure SetReferenceWhite(AObserverAngle: integer; AIlluminant: string); overload; +procedure SetReferenceWhite(AReferenceWhite: TXYZReferenceWhite); overload; +function GetReferenceWhite: TXYZReferenceWhite; overload; +function GetReferenceWhiteIndirect: PXYZReferenceWhite; overload; +function GetReferenceWhite(AObserverAngle: integer; AIlluminant: string): TXYZReferenceWhite; overload; +function GetReferenceWhiteIndirect(AObserverAngle: integer; AIlluminant: string): PXYZReferenceWhite; overload; + +procedure AddReferenceWhite(const AReferenceWhite: TXYZReferenceWhite); overload; +procedure AddReferenceWhite(AObserverAngle: integer; AIlluminant: string; AX, AY, AZ: single); overload; +function GetReferenceWhiteCount: integer; +function GetReferenceWhiteByIndex(AIndex: integer): TXYZReferenceWhite; + +var + ReferenceWhite2D50, ReferenceWhite2D65, ReferenceWhite2E: TXYZReferenceWhite; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{ TBridgedConversion } + +procedure TBridgedConversion.Convert(ASource: pointer; ADest: Pointer; + ACount: integer; ASourceStride: integer; ADestStride: integer; + AReferenceWhite: PXYZReferenceWhite); +const + bufSize = 512; + bufCount = 512 div sizeof(TExpandedPixel); +var + buf: array[0..bufSize-1] of byte; + psrc, pdest: PByte; +begin + if Assigned(ConvertToBridge) then + begin + psrc := PByte(ASource); + pdest := PByte(ADest); + while ACount > 0 do + begin + if ACount > bufCount then + begin + ConvertToBridge(psrc, @buf, bufCount, ASourceStride, sizeof(TExpandedPixel), AReferenceWhite); + FinalConvert(@buf, pdest, bufCount, sizeof(TExpandedPixel), ADestStride, AReferenceWhite); + inc(psrc, ASourceStride*bufCount); + inc(pdest, ADestStride*bufCount); + dec(ACount,bufCount); + end + else + begin + ConvertToBridge(psrc, @buf, ACount, ASourceStride, sizeof(TExpandedPixel), AReferenceWhite); + FinalConvert(@buf, pdest, ACount, sizeof(TExpandedPixel), ADestStride, AReferenceWhite); + break; + end; + end; + end else + FinalConvert(ASource,ADest,ACount,ASourceStride,ADestStride,AReferenceWhite); +end; + +{ TCustomColorspace } + +class function TCustomColorspace.IndexOfChannel(AName: string): integer; +var + i: Integer; +begin + for i := 0 to GetChannelCount-1 do + if GetChannelName(i) = AName then exit(i); + exit(-1); +end; + +class procedure TCustomColorspace.Convert(const ASource; + out ADest; ADestColorspace: TColorspaceAny; + ACount: integer; AReferenceWhite: PXYZReferenceWhite); +var + conv: TBridgedConversion; +begin + if self = TCustomColorspace then + raise exception.Create('Cannot convert from abstract colorspace'); + if self = ADestColorspace then + move(ASource, {%H-}ADest, self.GetSize * ACount) + else + begin + conv := ColorspaceCollection.GetBridgedConversion(self, ADestColorspace); + conv.Convert(@ASource,@ADest,ACount,self.GetSize,ADestColorspace.GetSize,AReferenceWhite); + end; +end; + +class function TCustomColorspace.GetDirectConversion(ADestColorspace: TColorspaceAny): TColorspaceConvertArrayProc; +begin + result := ColorspaceCollection.GetDirectConversion(self, ADestColorspace); +end; + +class function TCustomColorspace.GetBridgedConversion( + ADestColorspace: TColorspaceAny): TBridgedConversion; +begin + result := ColorspaceCollection.GetBridgedConversion(self, ADestColorspace); +end; + +{ ColorspaceCollection } + +class function ColorspaceCollection.GetCount: integer; +begin + result := FColorspaceCount; +end; + +class function ColorspaceCollection.GetItem(AIndex: integer): TColorspaceAny; +begin + if (AIndex < 0) or (AIndex >= FColorspaceCount) then + raise ERangeError.Create('Index out of bounds'); + result := FColorspaces[AIndex]; +end; + +class function ColorspaceCollection.IndexOf(AColorspace: TColorspaceAny): integer; +var + i: Integer; +begin + for i := 0 to FColorspaceCount-1 do + if FColorspaces[i] = AColorspace then exit(i); + result := -1; +end; + +class procedure ColorspaceCollection.Add(AColorspace: TColorspaceAny); +var + i: Integer; +begin + for i := 0 to high(FColorspaces) do + if FColorspaces[i] = AColorspace then exit; + + if FColorspaceCount >= length(FColorspaces) then + setlength(FColorspaces, FColorspaceCount*2+8); + FColorspaces[FColorspaceCount] := AColorspace; + inc(FColorspaceCount); +end; + +class procedure ColorspaceCollection.AddConversion(ASource: TColorspaceAny; + ADest: TColorspaceAny; AConversion: TColorspaceConvertArrayProc); +var + idxSource, idxDest: Integer; +begin + idxSource := IndexOf(ASource); + if idxSource = -1 then raise exception.Create('Colorspace not registered'); + idxDest := IndexOf(ADest); + if idxDest = -1 then raise exception.Create('Colorspace not registered'); + if idxSource >= length(FColorspaceConversions) then + setlength(FColorspaceConversions, FColorspaceCount+4); + if idxDest >= length(FColorspaceConversions[idxSource]) then + setlength(FColorspaceConversions[idxSource], FColorspaceCount+4); + FColorspaceConversions[idxSource][idxDest] := AConversion; +end; + +procedure CopyColorsAny(ASource: pointer; ADest: Pointer; ACount: integer; + {%H-}ASourceStride:integer; ADestStride:integer; {%H-}AReferenceWhite: PXYZReferenceWhite); +begin + move(ASource^, ADest^, ADestStride * ACount); +end; + +class function ColorspaceCollection.GetDirectConversion(ASource: TColorspaceAny; + ADest: TColorspaceAny): TColorspaceConvertArrayProc; +var + idxSource, idxDest: Integer; +begin + if ASource = ADest then + exit(@CopyColorsAny); + + idxSource := IndexOf(ASource); + if idxSource = -1 then raise exception.Create('Colorspace not registered'); + idxDest := IndexOf(ADest); + if idxDest = -1 then raise exception.Create('Colorspace not registered'); + + if (idxSource < length(FColorspaceConversions)) and + (idxDest < length(FColorspaceConversions[idxSource])) then + result := FColorspaceConversions[idxSource][idxDest] + else + result := nil; +end; + +class function ColorspaceCollection.GetBridgedConversion( + ASource: TColorspaceAny; ADest: TColorspaceAny): TBridgedConversion; +begin + result.FinalConvert:= GetDirectConversion(ASource,ADest); + if result.FinalConvert<>nil then + begin // direct conversion so no bridge needed + result.ConvertToBridge:= nil; + end else + begin + result.ConvertToBridge:= GetDirectConversion(ASource,TExpandedPixelColorspace); + if result.ConvertToBridge=nil then raise exception.Create('Cannot convert '+ASource.GetName+' to bridge'); + result.FinalConvert:= GetDirectConversion(TExpandedPixelColorspace,ADest); + if result.FinalConvert=nil then raise exception.Create('Cannot convert '+ADest.GetName+' from bridge'); + end; +end; + +var + CurrentReferenceWhite: TXYZReferenceWhite; + ReferenceWhiteArray: array of TXYZReferenceWhite; + +function Clamp(const V, Min, Max: single): single; +begin + Result := V; + if Result < Min then + Result := Min + else if Result > Max then + Result := Max + else Result := V; +end; + +function ClampInt(V, Min, Max: integer): integer; +begin + Result := V; + if Result < Min then + Result := Min + else if Result > Max then + Result := Max + else Result := V; +end; + +function PositiveModSingle(x, cycle: single): single; +begin + if (x < 0) or (x >= cycle) then + Result := x - cycle * floor(x / cycle) + else + result := x; +end; + +procedure PrepareReferenceWhiteArray; +begin + //Source:http://www.easyrgb.com/index.php?X=MATH&H=15#text15 + //domestic, tungsten-filament lighting + AddReferenceWhite(2, 'A', 1.09850, 1.00, 0.35585); + AddReferenceWhite(10, 'A', 1.11144, 1.00, 0.35200); + //deprecated daylight + AddReferenceWhite(2, 'C', 0.98074, 1.00, 1.18232); + AddReferenceWhite(10, 'C', 0.97285, 1.00, 1.16145); + //daylight + AddReferenceWhite(2, 'D50', 0.96422, 1.00, 0.82521); + AddReferenceWhite(10, 'D50', 0.96720, 1.00, 0.81427); + AddReferenceWhite(2, 'D55', 0.95682, 1.00, 0.92149); + AddReferenceWhite(10, 'D55', 0.95799, 1.00, 0.90926); + AddReferenceWhite(2, 'D65', 0.95047, 1.00, 1.08883); + AddReferenceWhite(10, 'D65', 0.94811, 1.00, 1.07304); + AddReferenceWhite(2, 'D75', 0.94972, 1.00, 1.22638); + AddReferenceWhite(10, 'D75', 0.94416, 1.00, 1.20641); + //equal energy + AddReferenceWhite(2, 'E', 1,1,1); + AddReferenceWhite(10, 'E', 1,1,1); + //fluorescent light + AddReferenceWhite(2, 'F2', 0.99187, 1.00, 0.67395); + AddReferenceWhite(10, 'F2', 1.03280, 1.00, 0.69026); + AddReferenceWhite(2, 'F7', 0.95044, 1.00, 1.08755); + AddReferenceWhite(10, 'F7', 0.95792, 1.00, 1.07687); + AddReferenceWhite(2, 'F11', 1.00966, 1.00, 0.64370); + AddReferenceWhite(10, 'F11', 1.03866, 1.00, 0.65627); +end; + +procedure SetReferenceWhite(AObserverAngle: integer; AIlluminant: string); +var + rp: TXYZReferenceWhite; + i: integer; +begin + for i := 0 to Length(ReferenceWhiteArray) - 1 do + begin + rp := ReferenceWhiteArray[i]; + if (rp.ObserverAngle = AObserverAngle) and (rp.Illuminant = AIlluminant) then + begin + CurrentReferenceWhite := rp; + Break; + end; + end; +end; + +procedure SetReferenceWhite(AReferenceWhite: TXYZReferenceWhite); +begin + CurrentReferenceWhite := AReferenceWhite; +end; + +function GetReferenceWhite: TXYZReferenceWhite; +begin + Result := CurrentReferenceWhite; +end; + +function GetReferenceWhiteIndirect: PXYZReferenceWhite; +begin + result := @CurrentReferenceWhite; +end; + +function GetReferenceWhite(AObserverAngle: integer; AIlluminant: string): TXYZReferenceWhite; +var + p: PXYZReferenceWhite; +begin + p := GetReferenceWhiteIndirect(AObserverAngle, AIlluminant); + if p = nil then raise exception.Create('Reference white not found'); + result := p^; +end; + +function GetReferenceWhiteIndirect(AObserverAngle: integer; AIlluminant: string): PXYZReferenceWhite; +var + rp: PXYZReferenceWhite; + i: integer; +begin + for i := 0 to Length(ReferenceWhiteArray) - 1 do + begin + rp := @ReferenceWhiteArray[i]; + if (rp^.ObserverAngle = AObserverAngle) and (rp^.Illuminant = AIlluminant) then + begin + result := rp; + exit; + end; + end; + result := nil; +end; + +procedure AddReferenceWhite(const AReferenceWhite: TXYZReferenceWhite); +begin + if GetReferenceWhiteIndirect(AReferenceWhite.ObserverAngle, AReferenceWhite.Illuminant)<>nil then + raise exception.Create('Reference white already defined'); + SetLength(ReferenceWhiteArray, Length(ReferenceWhiteArray) + 1); + ReferenceWhiteArray[Length(ReferenceWhiteArray) - 1] := AReferenceWhite; + with ReferenceWhiteArray[Length(ReferenceWhiteArray) - 1] do + XYZToLMS(X,Y,Z, L,M,S); +end; + +procedure AddReferenceWhite(AObserverAngle: integer; AIlluminant: string; AX, AY, AZ: single); +var + rp: TXYZReferenceWhite; +begin + rp.Illuminant := AIlluminant; + rp.ObserverAngle := AObserverAngle; + rp.X := AX; + rp.Y := AY; + rp.Z := AZ; + AddReferenceWhite(rp); +end; + +function GetReferenceWhiteCount: integer; +begin + result := length(ReferenceWhiteArray); +end; + +function GetReferenceWhiteByIndex(AIndex: integer): TXYZReferenceWhite; +begin + if (AIndex < 0) or (AIndex >= length(ReferenceWhiteArray)) then + raise ERangeError.Create('Index out of bounds'); + result := ReferenceWhiteArray[AIndex]; +end; + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I generatedcolorspace.inc} + +function BGRAToMask(const ABGRAPixel: TBGRAPixel): TByteMask; +var + ec: TExpandedPixel; +begin + ec := GammaExpansion(ABGRAPixel); + result.gray:= (ec.red * redWeightShl10 + ec.green * greenWeightShl10 + + ec.blue * blueWeightShl10 + (1 shl 9)) shr 18; +end; + +function ExpandedPixelToByteMask(const AExpandedPixel: TExpandedPixel): TByteMask; +begin + result.gray:= (AExpandedPixel.red * redWeightShl10 + AExpandedPixel.green * greenWeightShl10 + + AExpandedPixel.blue * blueWeightShl10 + (1 shl 9)) shr 18; +end; + +function MaskToBGRA(const AMask: TByteMask; AAlpha: byte): TBGRAPixel; +begin + result.red := GammaCompressionTab[AMask.gray+(AMask.gray shl 8)]; + result.green := result.red; + result.blue := result.red; + result.alpha := AAlpha; +end; + +function ByteMaskToExpandedPixel(const AMask: TByteMask; AAlpha: byte = 255): TExpandedPixel; +begin + result.red := AMask.gray+(AMask.gray shl 8); + result.green := result.red; + result.blue := result.red; + result.alpha := AAlpha; +end; + +function StdRGBAToBGRAPixel(const AStdRGBA: TStdRGBA): TBGRAPixel; +begin + with AStdRGBA do + begin + result.red := ClampInt(round(red * 255), 0, 255); + result.green := ClampInt(round(green * 255), 0, 255); + result.blue := ClampInt(round(blue * 255), 0, 255); + result.alpha := ClampInt(round(alpha * 255), 0, 255); + end; +end; + +function BGRAPixelToStdRGBA(const ABGRAPixel: TBGRAPixel): TStdRGBA; +const oneOver255 = 1/255; +begin + with ABGRAPixel do + begin + result.red := red * oneOver255; + result.green := green * oneOver255; + result.blue := blue * oneOver255; + result.alpha := alpha * oneOver255; + end; +end; + +function LinearRGBAToExpandedPixel(const ALinearRGBA: TLinearRGBA): TExpandedPixel; +begin + with ALinearRGBA do + begin + result.red := ClampInt(round(red * 65535), 0, 65535); + result.green := ClampInt(round(green * 65535), 0, 65535); + result.blue := ClampInt(round(blue * 65535), 0, 65535); + result.alpha := ClampInt(round(alpha * 65535), 0, 65535); + end; +end; + +function ExpandedPixelToLinearRGBA(const AExpandedPixel: TExpandedPixel): TLinearRGBA; +begin + with AExpandedPixel do + begin + result.red := red / 65535; + result.green := green / 65535; + result.blue := blue / 65535; + result.alpha := alpha / 65535; + end; +end; + +function GammaCompressionWF(AValue: Word): single; +const + oneOver255 = 1/255; +var + compByte: Byte; + reExp, reExp2: Word; +begin + if AValue=0 then exit(0) else + if AValue=65535 then exit(1) else + begin + compByte := GammaCompressionTab[AValue]; + reExp := GammaExpansionTab[compByte]; + if reExp = AValue then + result := compByte * oneOver255 + else + if reExp < AValue then + begin + reExp2 := GammaExpansionTabHalf[compByte]; + if reExp2<>reExp then + result := (compByte + (AValue-reExp)/(reExp2-reExp)*0.5)*oneOver255; + end else + begin + reExp2 := GammaExpansionTabHalf[compByte-1]; + if reExp2<>reExp then + result := (compByte - (reExp-AValue)/(reExp-reExp2)*0.5)*oneOver255; + end; + end; +end; + +function ExpandedPixelToStdRGBA(const AExpandedPixel: TExpandedPixel): TStdRGBA; +begin + result.red := GammaCompressionWF(AExpandedPixel.red); + result.green := GammaCompressionWF(AExpandedPixel.green); + result.blue := GammaCompressionWF(AExpandedPixel.blue); + result.alpha := AExpandedPixel.alpha/65535; +end; + +function GammaExpansionFW(AValue: single): word; +const + fracShift = 10; + intRange = 255 shl fracShift; + fracAnd = (1 shl fracShift)-1; + fracHalf = 1 shl (fracShift-1); + fracQuarter = 1 shl (fracShift-2); +var + valInt, byteVal, fracPart: integer; + half: Word; +begin + if AValue <= 0 then exit(0) + else if AValue >= 1 then exit(65535); + + valInt := round(AValue*intRange); + byteVal := valInt shr fracShift; + fracPart := valInt and fracAnd; + if fracPart >= fracHalf then + begin + result := GammaExpansionTab[byteVal+1]; + half := GammaExpansionTabHalf[byteVal]; + dec(result, ((result-half)*((1 shl fracShift)-fracPart)+fracQuarter) shr (fracShift-1)); + end + else + begin + result := GammaExpansionTab[byteVal]; + if fracPart > 0 then + begin + half := GammaExpansionTabHalf[byteVal]; + inc(result, ((half-result)*fracPart+fracQuarter) shr (fracShift-1)); + end; + end; +end; + +function StdRGBAToExpandedPixel(const AStdRGBA: TStdRGBA): TExpandedPixel; +begin + result.red := GammaExpansionFW(AStdRGBA.red); + result.green := GammaExpansionFW(AStdRGBA.green); + result.blue := GammaExpansionFW(AStdRGBA.blue); + result.alpha:= round(AStdRGBA.alpha*65535); +end; + +function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA): TXYZA; +begin + result := LinearRGBAToXYZA(ALinearRGBA, GetReferenceWhiteIndirect^); +end; + +function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA; + const AReferenceWhite: TXYZReferenceWhite): TXYZA; +begin + if AReferenceWhite.Illuminant = 'D50' then + begin + with ALinearRGBA do + begin + result.X := red * 0.4360746 + green * 0.3850649 + blue * 0.1430804; + result.Y := red * 0.2225045 + green * 0.7168786 + blue * 0.0606169; + result.Z := red * 0.0139322 + green * 0.0971045 + blue * 0.7141733; + end; + result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); + end else + begin + with ALinearRGBA do + begin + result.X := red * 0.4124564 + green * 0.3575761 + blue * 0.1804375; + result.Y := red * 0.2126729 + green * 0.7151522 + blue * 0.0721750; + result.Z := red * 0.0193339 + green * 0.1191920 + blue * 0.9503041; + end; + result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); + end; + Result.alpha := ALinearRGBA.alpha; +end; + +function XYZAToLinearRGBA(const AXYZA: TXYZA): TLinearRGBA; +begin + result := XYZAToLinearRGBA(AXYZA, GetReferenceWhiteIndirect^); +end; + +function XYZAToLinearRGBA(const AXYZA: TXYZA; + const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA; +var + minVal, lightVal, maxVal: single; + ad: TXYZA; +begin + ad := AXYZA; + if AReferenceWhite.Illuminant = 'D50' then + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); + with ad do + begin + result.red := X * 3.1338561 + Y * (-1.6168667) + Z * (-0.4906146); + result.green := X * (-0.9787684) + Y * 1.9161415 + Z * 0.0334540; + result.blue := X * 0.0719453 + Y * (-0.2289914) + Z * 1.4052427; + end; + end else + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); + with ad do + begin + result.red := X * 3.2404542 + Y * (-1.5371385) + Z * (-0.4985314); + result.green := X * (-0.9692660) + Y * 1.8760108 + Z * 0.0415560; + result.blue := X * 0.0556434 + Y * (-0.2040259) + Z * 1.0572252; + end; + end; + if ( (XYZToRGBOverflowMin = xroClipToTarget) and ((result.red < 0) or + (result.green < 0) or (result.blue < 0)) ) or + ( (XYZToRGBOverflowMax = xroClipToTarget) and ((result.red > 1) or + (result.green > 1) or (result.blue > 1)) ) then + begin + result.red := 0; + result.green := 0; + result.blue := 0; + result.alpha := 0; + exit; + end; + case XYZToRGBOverflowMin of + xroPreserveHue: begin + minVal := min(min(result.red,result.green),result.blue); + if minVal<0 then + begin + lightVal := result.red*0.299+result.green*0.587+result.blue*0.114; + if lightVal <= 0 then + begin + result.red := 0; + result.green := 0; + result.blue := 0; + end else + begin + result.red := (result.red-minVal)*lightVal/(lightVal-minVal); + result.green := (result.green-minVal)*lightVal/(lightVal-minVal); + result.blue := (result.blue-minVal)*lightVal/(lightVal-minVal); + end; + end; + end; + end; + case XYZToRGBOverflowMax of + xroPreserveHue: + begin + maxVal := max(max(result.red,result.green),result.blue); + if maxVal > 1 then + begin + result.red := result.red/maxVal; + result.green := result.green/maxVal; + result.blue := result.blue/maxVal; + end; + end; + xroSaturateEachChannel: + begin + if result.red > 1 then result.red := 1; + if result.green > 1 then result.green := 1; + if result.blue > 1 then result.blue := 1; + end; + end; + if XYZToRGBOverflowMin = xroSaturateEachChannel then + begin + if result.red < 0 then result.red := 0; + if result.green < 0 then result.green := 0; + if result.blue < 0 then result.blue := 0; + end; + Result.alpha := AXYZA.alpha; +end; + +function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel): TWordXYZA; overload; +begin + result := ExpandedPixelToWordXYZA(AExpandedPixel, GetReferenceWhiteIndirect^); +end; + +function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA; overload; +begin + if AReferenceWhite.Illuminant = 'D50' then + begin + with AExpandedPixel do + begin + result.X := ClampInt(round((red * 0.4360746 + green * 0.3850649 + blue * 0.1430804)*(50000/65535)),0,65535); + result.Y := ClampInt(round((red * 0.2225045 + green * 0.7168786 + blue * 0.0606169)*(50000/65535)),0,65535); + result.Z := ClampInt(round((red * 0.0139322 + green * 0.0971045 + blue * 0.7141733)*(50000/65535)),0,65535); + end; + result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); + end else + begin + with AExpandedPixel do + begin + result.X := ClampInt(round((red * 0.4124564 + green * 0.3575761 + blue * 0.1804375)*(50000/65535)),0,65535); + result.Y := ClampInt(round((red * 0.2126729 + green * 0.7151522 + blue * 0.0721750)*(50000/65535)),0,65535); + result.Z := ClampInt(round((red * 0.0193339 + green * 0.1191920 + blue * 0.9503041)*(50000/65535)),0,65535); + end; + result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); + end; + Result.alpha := AExpandedPixel.alpha; +end; + +function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA): TExpandedPixel; overload; +begin + result := WordXYZAToExpandedPixel(AXYZA, GetReferenceWhiteIndirect^); +end; + +function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel; overload; +var + minVal, lightVal, maxVal, + r,g,b, valRangeDiv2: Int32or64; + ad: TWordXYZA; +begin + ad := AXYZA; + if AReferenceWhite.Illuminant = 'D50' then + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); + with ad do + begin + r := round((X * 3.1338561 + Y * (-1.6168667) + Z * (-0.4906146))*(65535/50000)); + g := round((X * (-0.9787684) + Y * 1.9161415 + Z * 0.0334540)*(65535/50000)); + b := round((X * 0.0719453 + Y * (-0.2289914) + Z * 1.4052427)*(65535/50000)); + end; + end else + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); + with ad do + begin + r := round((X * 3.2404542 + Y * (-1.5371385) + Z * (-0.4985314))*(65535/50000)); + g := round((X * (-0.9692660) + Y * 1.8760108 + Z * 0.0415560)*(65535/50000)); + b := round((X * 0.0556434 + Y * (-0.2040259) + Z * 1.0572252)*(65535/50000)); + end; + end; + if ( (XYZToRGBOverflowMin = xroClipToTarget) and ((r < 0) or + (g < 0) or (b < 0)) ) or + ( (XYZToRGBOverflowMax = xroClipToTarget) and ((r > 65535) or + (g > 65535) or (b > 65535)) ) then + begin + result.red := 0; + result.green := 0; + result.blue := 0; + result.alpha := 0; + exit; + end; + case XYZToRGBOverflowMin of + xroPreserveHue: begin + minVal := min(min(r,g),b); + if minVal<0 then + begin + lightVal := r*redWeightShl10 + g*greenWeightShl10 + + b*blueWeightShl10; + if lightVal <= 0 then + begin + result.red := 0; + result.green := 0; + result.blue := 0; + Result.alpha := AXYZA.alpha; + exit; + end else + begin + lightVal := (lightVal+512) shr 10; + valRangeDiv2 := (lightVal-minVal) shr 1; + r := (int64(r-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); + g := (int64(g-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); + b := (int64(b-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); + end; + end; + end; + end; + case XYZToRGBOverflowMax of + xroPreserveHue: + begin + maxVal := max(max(r,g),b); + if maxVal > 65535 then + begin + r := (int64(r)*65535+(maxVal shr 1)) div maxVal; + g := (int64(g)*65535+(maxVal shr 1)) div maxVal; + b := (int64(b)*65535+(maxVal shr 1)) div maxVal; + end; + end; + xroSaturateEachChannel: + begin + if r > 65535 then r := 65535; + if g > 65535 then g := 65535; + if b > 65535 then b := 65535; + end; + end; + if XYZToRGBOverflowMin = xroSaturateEachChannel then + begin + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + end; + result.red := r; + result.green := g; + result.blue := b; + Result.alpha := AXYZA.alpha; +end; + +function XYZAToWordXYZA(const AXYZA: TXYZA): TWordXYZA; +begin + result.X := ClampInt(round(AXYZA.X*50000),0,65535); + result.Y := ClampInt(round(AXYZA.Y*50000),0,65535); + result.Z := ClampInt(round(AXYZA.Z*50000),0,65535); + result.alpha := round(AXYZA.alpha*65535); +end; + +function WordXYZAToXYZA(const AWordXYZA: TWordXYZA): TXYZA; +const oneOver50000 = 1/50000; +begin + result.X := AWordXYZA.X*oneOver50000; + result.Y := AWordXYZA.Y*oneOver50000; + result.Z := AWordXYZA.Z*oneOver50000; + result.alpha:= AWordXYZA.alpha*(1/65535); +end; + +function XYZAToLabA(const AXYZA: TXYZA): TLabA; +begin + Result := XYZAToLabA(AXYZA, GetReferenceWhiteIndirect^); +end; + +function XYZAToLabA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA; +var + xp, yp, zp: double; +begin + xp := AXYZA.X / AReferenceWhite.X; + yp := AXYZA.Y / AReferenceWhite.Y; + zp := AXYZA.Z / AReferenceWhite.Z; + if xp > 0.008856 then + xp := Power(xp, 1 / 3) + else + xp := (7.787 * xp) + 0.138; + if yp > 0.008856 then + yp := Power(yp, 1 / 3) + else + yp := (7.787 * yp) + 0.138; + if zp > 0.008856 then + zp := Power(zp, 1 / 3) + else + zp := (7.787 * zp) + 0.138; + + result.L := Clamp((116 * yp) - 16, 0, 100); + result.a := 500 * (xp - yp); + result.b := 200 * (yp - zp); + Result.Alpha := AXYZA.alpha; +end; + +function LabAToXYZA(const ALabA: TLabA): TXYZA; +begin + Result := LabAToXYZA(ALabA, GetReferenceWhiteIndirect^); +end; + +function LabAToXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; +var + xp, yp, zp: double; +begin + yp := (ALabA.L + 16) / 116; + xp := ALabA.a / 500 + yp; + zp := yp - ALabA.b / 200; + if yp > 0.2069 then + yp := IntPower(yp, 3) + else + yp := (yp - 0.138) / 7.787; + if xp > 0.2069 then + xp := IntPower(xp, 3) + else + xp := (xp - 0.138) / 7.787; + if zp > 0.2069 then + zp := IntPower(zp, 3) + else + zp := (zp - 0.138) / 7.787; + Result.X := AReferenceWhite.X * xp; + Result.Y := AReferenceWhite.Y * yp; + Result.Z := AReferenceWhite.Z * zp; + Result.alpha := ALabA.Alpha; +end; + +function StdRGBAToStdHSVA(const AStdRGBA: TStdRGBA): TStdHSVA; +var + Delta, mini: single; +begin + with AStdRGBA do + begin + result.value := max(max(red, green), blue); + mini := min(min(red, green), blue); + Delta := result.value - mini; + + if result.value = 0.0 then + result.saturation := 0 + else + result.saturation := Delta / result.value; + + if result.saturation = 0.0 then + result.hue := 0 + else + begin + if red = result.value then + result.hue := 60.0 * (green - blue) / Delta + else + if green = result.value then + result.hue := 120.0 + 60.0 * (blue - red) / Delta + else + {if blue = result.value then} + result.hue := 240.0 + 60.0 * (red - green) / Delta; + + if result.hue < 0.0 then + IncF(result.hue, 360.0); + end; + result.alpha := alpha; + end; +end; + +function StdHSVAToStdRGBA(const AStdHSVA: TStdHSVA): TStdRGBA; +var + C, X, M, rp, gp, bp, sp, vp: single; + h360: single; +begin + vp := AStdHSVA.value; + sp := AStdHSVA.saturation; + C := Vp * sp; + h360 := PositiveModSingle(AStdHSVA.hue, 360); + X := C * (1 - abs(PositiveModSingle(h360 / 60, 2) - 1)); + m := vp - c; + rp := 0; + gp := 0; + bp := 0; + case floor(h360) of + -1..59: + begin + rp := C; + gp := X; + bp := 0; + end; + 60..119: + begin + rp := X; + gp := C; + bp := 0; + end; + 120..179: + begin + rp := 0; + gp := C; + bp := X; + end; + 180..239: + begin + rp := 0; + gp := X; + bp := C; + end; + 240..299: + begin + rp := X; + gp := 0; + bp := C; + end; + 300..359: + begin + rp := C; + gp := 0; + bp := X; + end; + end; + result.red := rp + m; + result.green := gp + m; + result.blue := bp + m; + result.alpha := AStdHSVA.alpha; +end; + +function StdHSLAToStdHSVA(const AStdHSLA: TStdHSLA): TStdHSVA; +var + s, l, v: single; +begin + Result.hue := AStdHSLA.hue; + s := AStdHSLA.saturation; + l := AStdHSLA.lightness; + v := (2 * l + s * (1 - abs(2 * l - 1))) / 2; + if v <> 0 then + Result.saturation := 2 * (v - l) / v + else + Result.saturation := 0; + Result.value := v; +end; + +function StdHSVAToStdHSLA(const AStdHSVA: TStdHSVA): TStdHSLA; +var + s, v, l: single; +begin + Result.hue := AStdHSVA.hue; + s := AStdHSVA.saturation; + v := AStdHSVA.value; + l := 0.5 * v * (2 - s); + if l <> 0 then + Result.saturation := v * s / (1 - abs(2 * l - 1)) + else + Result.saturation := 0; + Result.lightness := l; +end; + +function StdRGBAToStdCMYK(const AStdRGBA: TStdRGBA): TStdCMYK; +begin + with AStdRGBA do + begin + result.K := 1 - max(max(red, green), blue); + if result.K >= 1 then + begin + result.C := 0; + result.M := 0; + result.Y := 0; + end + else + begin + result.C := 1 - red / (1 - result.K); + result.M := 1 - green / (1 - result.K); + result.Y := 1 - blue / (1 - result.K); + end; + end; +end; + +function StdCMYKToStdRGBA(const AStdCMYK: TStdCMYK; AAlpha: Single = 1): TStdRGBA; +begin + with AStdCMYK do + begin + result.red := (1 - C) * (1 - K); + result.green := (1 - M) * (1 - K); + result.blue := (1 - Y) * (1 - K); + result.alpha := AAlpha; + end; +end; + +function LabAToLChA(const ALabA: TLabA): TLChA; +var + a, b, HRad: single; +begin + a := ALabA.a; + b := ALabA.b; + HRad := ArcTan2(b, a); + if HRad >= 0 then + result.H := (HRad / PI) * 180 + else + result.H := 360 - (ABS(HRad) / PI) * 180; + result.L := ALabA.L; + result.C := SQRT(a*a + b*b); + result.alpha := ALabA.Alpha; +end; + +function LChAToLabA(const ALChA: TLChA): TLabA; +begin + result.L := ALChA.L; + result.a := cos(DegToRad(ALChA.h)) * ALChA.C; + result.b := sin(DegToRad(ALChA.h)) * ALChA.C; + result.Alpha:= ALChA.alpha; +end; + +function AdobeRGBAToXYZA(const ASource: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; +var R,G,B: single; +begin + R := GammaExpansionTab[ASource.red]/65535; + G := GammaExpansionTab[ASource.green]/65535; + B := GammaExpansionTab[ASource.blue]/65535; + if AReferenceWhite.Illuminant = 'D50' then + begin + result.X := R*0.6097559 + G*0.2052401 + B*0.1492240; + result.Y := R*0.3111242 + G*0.6256560 + B*0.0632197; + result.Z := R*0.0194811 + G*0.0608902 + B*0.7448387; + result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); + end else + begin + result.X := R*0.5767309 + G*0.1855540 + B*0.1881852; + result.Y := R*0.2973769 + G*0.6273491 + B*0.0752741; + result.Z := R*0.0270343 + G*0.0706872 + B*0.9911085; + result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); + end; + result.alpha := ASource.alpha/255; +end; + +function AdobeRGBAToXYZA(const ASource: TAdobeRGBA): TXYZA; +begin + result := AdobeRGBAToXYZA(ASource, GetReferenceWhiteIndirect^); +end; + +function XYZAToAdobeRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA; +var R,G,B: single; + ad: TXYZA; +begin + ad := AXYZA; + if AReferenceWhite.Illuminant = 'D50' then + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); + with ad do + begin + R := Clamp(1.9624274*X - 0.6105343*Y - 0.3413404*Z,0,1); + G := Clamp(-0.9787684*X + 1.9161415*Y + 0.0334540*Z,0,1); + B := Clamp(0.0286869*X - 0.1406752*Y + 1.3487655*Z,0,1); + end; + end else + begin + ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); + with ad do + begin + R := Clamp(2.0413690*X - 0.5649464*Y - 0.3446944*Z,0,1); + G := Clamp(-0.9692660*X + 1.8760108*Y + 0.0415560*Z,0,1); + B := Clamp(0.0134474*X - 0.1183897*Y + 1.0154096*Z,0,1); + end; + end; + result.red := GammaCompressionTab[round(R*65535)]; + result.green := GammaCompressionTab[round(G*65535)]; + result.blue := GammaCompressionTab[round(B*65535)]; + result.alpha := ClampInt(round(AXYZA.alpha*255),0,255); +end; + +function XYZAToAdobeRGBA(const AXYZA: TXYZA): TAdobeRGBA; +begin + result := XYZAToAdobeRGBA(AXYZA, GetReferenceWhiteIndirect^); +end; + +function StdRGBAToLinearRGBA(const AStdRGBA: TStdRGBA): TLinearRGBA; +var + ec: TExpandedPixel; +begin + ec := StdRGBAToExpandedPixel(AStdRGBA); + result := ExpandedPixelToLinearRGBA(ec); + result.alpha := AStdRGBA.alpha; +end; + +function LinearRGBAToStdRGBA(const ALinearRGBA: TLinearRGBA): TStdRGBA; +var + ec: TExpandedPixel; +begin + ec := LinearRGBAToExpandedPixel(ALinearRGBA); + result := ExpandedPixelToStdRGBA(ec); + result.alpha := ALinearRGBA.alpha; +end; + +function StdRGBAToStdHSLA(const AStdRGBA: TStdRGBA): TStdHSLA; +var + d, cmax, cmin: double; +begin + with AStdRGBA do + begin + cmax := Max(red, Max(green, blue)); + cmin := Min(red, Min(green, blue)); + result.lightness := (cmax + cmin) / 2; + + if cmax = cmin then + begin + result.hue := 0; + result.saturation := 0; + end + else + begin + d := cmax - cmin; + if result.lightness < 0.5 then + result.saturation := d / (cmax + cmin) + else + result.saturation := d / (2 - cmax - cmin); + + if red = cmax then + result.hue := (green - blue) / d + else + if green = cmax then + result.hue := 2 + (blue - red) / d + else + result.hue := 4 + (red - green) / d; + if result.hue < 0 then IncF(result.hue, 6); + result.hue := result.hue * 60; + end; + result.alpha := alpha; + end; +end; + +function StdHSLAToStdRGBA(const AStdHSLA: TStdHSLA): TStdRGBA; +var + C, X, M, rp, gp, bp, sp, lp, h360: single; +begin + lp := AStdHSLA.lightness; + sp := AStdHSLA.saturation; + C := (1 - abs(2 * Lp - 1)) * Sp; + h360 := PositiveModSingle(AStdHSLA.hue, 360); + X := C * (1 - abs(PositiveModSingle(h360 / 60, 2) - 1)); + m := Lp - C / 2; + rp := 0; + gp := 0; + bp := 0; + case floor(h360) of + -1..59: + begin + rp := C; + gp := X; + bp := 0; + end; + 60..119: + begin + rp := X; + gp := C; + bp := 0; + end; + 120..179: + begin + rp := 0; + gp := C; + bp := X; + end; + 180..239: + begin + rp := 0; + gp := X; + bp := C; + end; + 240..299: + begin + rp := X; + gp := 0; + bp := C; + end; + 300..359: + begin + rp := C; + gp := 0; + bp := X; + end; + end; + result.red := rp + m; + result.green := gp + m; + result.blue := bp + m; + result.alpha := AStdHSLA.alpha; +end; + +function SpectrumRangeReflectToXYZA(reflectance,wavelen1,wavelen2,alpha: single): TXYZA; +var isEqualEnergy: boolean; + fromRefWhite: PXYZReferenceWhite; + + function GetIlluminantSpectrum(AIndex: integer): single; + begin + if isEqualEnergy then result := 1 else + result := IlluminantSpectrumD65[AIndex].Y; + end; + + procedure IncludeWavelength(fromWavelen, toWavelen: single); + var i: integer; + factor, ill: single; + begin + for i := 0 to high(SpectralLocus) do + if (SpectralLocus[i].W+2.5 >= fromWavelen) and + (SpectralLocus[i].W-2.5 < toWavelen) then + begin + factor := 1; + if SpectralLocus[i].W-2.5 < fromWavelen then + DecF(factor, (fromWavelen - (SpectralLocus[i].W-2.5))/5); + if SpectralLocus[i].W+2.5 > toWavelen then + DecF(factor, ((SpectralLocus[i].W+2.5) - toWavelen)/5); + if factor > 0 then + begin + ill := GetIlluminantSpectrum(i); + IncF(result.X, SpectralLocus[i].X*factor*ill); + IncF(result.Y, SpectralLocus[i].Y*factor*ill); + IncF(result.Z, SpectralLocus[i].Z*factor*ill); + end; + end; + end; + +var + minWavelen, maxWavelen, ill: single; + totalXYZ: TXYZA; + i: Integer; +begin + result.X := 0; + result.Y := 0; + result.Z := 0; + result.alpha:= alpha; + + with GetReferenceWhiteIndirect^ do + isEqualEnergy := (X = 1) and (Y = 1) and (Z = 1); + if isEqualEnergy then fromRefWhite := @ReferenceWhite2E + else fromRefWhite := @ReferenceWhite2D65; + + totalXYZ := BGRABlack; + for i := 0 to high(SpectralLocus) do + begin + ill := GetIlluminantSpectrum(i); + IncF(totalXYZ.X, SpectralLocus[i].X*ill); + IncF(totalXYZ.Y, SpectralLocus[i].Y*ill); + IncF(totalXYZ.Z, SpectralLocus[i].Z*ill); + end; + + minWavelen := SpectralLocus[0].W; + maxWavelen := SpectralLocus[high(SpectralLocus)].W; + + if wavelen1 <= minWavelen then wavelen1 := minWavelen-2.5; + if wavelen2 >= maxWavelen then wavelen2 := maxWavelen+2.5; + + if wavelen2 > wavelen1 then + IncludeWavelength(wavelen1, wavelen2) + else + begin + IncludeWavelength(wavelen1, maxWavelen+2.5); + IncludeWavelength(minWavelen-2.5, wavelen2); + end; + + result.X := result.X * fromRefWhite^.X/totalXYZ.X * reflectance; + result.Y := result.Y * fromRefWhite^.Y/totalXYZ.Y * reflectance; + result.Z := result.Z * fromRefWhite^.Z/totalXYZ.Z * reflectance; + result.ChromaticAdapt(fromRefWhite^, GetReferenceWhiteIndirect^); +end; + +procedure XYZToLMS(const X,Y,Z: Single; out L,M,S: single); +begin + L := max(0.8951*X+0.2664*Y-0.1615*Z, 0); + M := max(-0.7502*X+1.7135*Y+0.0367*Z, 0); + S := max(0.0389*X-0.0685*Y+1.0296*Z, 0); +end; + +procedure LMSToXYZ(const L,M,S: Single; out X,Y,Z: single); +begin + X := 0.98699*L-0.14705*M+0.16006*S; + Y := 0.43230*L+0.51836*M+0.04933*S; + Z := -0.00853*L+0.04004*M+0.96849*S; +end; + +procedure ChromaticAdaptXYZ(var X,Y,Z: Single; const AFrom, ATo: TXYZReferenceWhite); +var + L, M, S: single; +begin + if (AFrom.L=ATo.L) and (AFrom.M=ATo.M) and (AFrom.S=ATo.S) then exit; + XYZToLMS(X,Y,Z, L,M,S); + L := L * ATo.L/AFrom.L; + M := M * ATo.M/AFrom.M; + S := S * ATo.S/AFrom.S; + LMSToXYZ(L,M,S, X,Y,Z); +end; + +procedure ChromaticAdaptWordXYZ(var X,Y,Z: Word; const AFrom, ATo: TXYZReferenceWhite); +const oneOver50000 = 1/50000; +var Xf,Yf,Zf: Single; +begin + Xf := X*oneOver50000; + Yf := Y*oneOver50000; + Zf := Z*oneOver50000; + ChromaticAdaptXYZ(Xf,Yf,Zf, AFrom,ATo); + X := min(round(Xf*50000),65535); + Y := min(round(Yf*50000),65535); + Z := min(round(Zf*50000),65535); +end; + +{$ENDIF} + +{$IFDEF INCLUDE_INITIALIZATION} +{$UNDEF INCLUDE_INITIALIZATION} + + PrepareReferenceWhiteArray; + ReferenceWhite2D50 := GetReferenceWhite(2, 'D50'); + ReferenceWhite2D65 := GetReferenceWhite(2, 'D65'); + ReferenceWhite2E := GetReferenceWhite(2, 'E'); + SetReferenceWhite(ReferenceWhite2D50); + + {$DEFINE INCLUDE_INITIALIZATION} + {$I generatedcolorspace.inc} + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/face3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/face3d.inc new file mode 100644 index 0000000..6bdfc20 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/face3d.inc @@ -0,0 +1,505 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + PBGRAFaceVertexDescription = ^TBGRAFaceVertexDescription; + TBGRAFaceVertexDescription = record + Vertex: IBGRAVertex3D; + Normal: IBGRANormal3D; + Color: TBGRAPixel; + TexCoord: TPointF; + ColorOverride: boolean; + TexCoordOverride: boolean; + ActualColor: TBGRAPixel; + ActualTexCoord: TPointF; + end; + + { TBGRAFace3D } + + TBGRAFace3D = class(TInterfacedObject,IBGRAFace3D) + private + FVertices: packed array of TBGRAFaceVertexDescription; + FVertexCount: integer; + FTexture, FActualTexture: IBGRAScanner; + FMaterial: IBGRAMaterial3D; + FActualMaterial: TBGRAMaterial3D; + FMaterialName: string; + FParentTexture: boolean; + FViewNormal: TPoint3D_128; + FViewCenter: TPoint3D_128; + FObject3D : IBGRAObject3D; + FBiface: boolean; + FLightThroughFactor: single; + FLightThroughFactorOverride: boolean; + FCustomFlags: LongWord; + function GetCustomFlags: LongWord; + function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription; + procedure SetCustomFlags(AValue: LongWord); + procedure ComputeActualVertexColor(AIndex: integer); + procedure ComputeActualTexCoord(AMinIndex, AMaxIndex: integer); + procedure UpdateTexture; + public + function GetObject3D: IBGRAObject3D; + constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D); + destructor Destroy; override; + procedure ComputeVertexColors; + procedure UpdateMaterial; + procedure FlipFace; + function AddVertex(AVertex: IBGRAVertex3D): integer; + function GetParentTexture: boolean; + function GetTexture: IBGRAScanner; + function GetVertex(AIndex: Integer): IBGRAVertex3D; + function GetVertexColor(AIndex: Integer): TBGRAPixel; + function GetVertexColorOverride(AIndex: Integer): boolean; + function GetVertexCount: integer; + function GetNormal(AIndex: Integer): IBGRANormal3D; + function GetMaterial: IBGRAMaterial3D; + function GetMaterialName: string; + function GetTexCoord(AIndex: Integer): TPointF; + function GetTexCoordOverride(AIndex: Integer): boolean; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + function GetViewCenter: TPoint3D; + function GetViewCenter_128: TPoint3D_128; + function GetViewCenterZ: single; + function GetBiface: boolean; + function GetLightThroughFactor: single; + function GetLightThroughFactorOverride: boolean; + procedure SetParentTexture(const AValue: boolean); + procedure SetTexture(const AValue: IBGRAScanner); + procedure SetColor(AColor: TBGRAPixel); + procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel); + procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean); + procedure SetTexCoord(AIndex: Integer; const AValue: TPointF); + procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean); + procedure SetBiface(const AValue: boolean); + procedure SetLightThroughFactor(const AValue: single); + procedure SetLightThroughFactorOverride(const AValue: boolean); + procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); + procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); + procedure ComputeViewNormalAndCenter; + procedure SetMaterial(const AValue: IBGRAMaterial3D); + procedure SetMaterialName(const AValue: string); + function GetAsObject: TObject; + property Texture: IBGRAScanner read GetTexture write SetTexture; + property ParentTexture: boolean read GetParentTexture write SetParentTexture; + property VertexCount: integer read GetVertexCount; + property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; + property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal; + property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor; + property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride; + property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord; + property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride; + property ViewNormal: TPoint3D read GetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128; + property ViewCenter: TPoint3D read GetViewCenter; + property ViewCenter_128: TPoint3D_128 read GetViewCenter_128; + property ViewCenterZ: single read GetViewCenterZ; + property Object3D: IBGRAObject3D read GetObject3D; + property Biface: boolean read GetBiface write SetBiface; + property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; + property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride; + property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; + property ActualMaterial: TBGRAMaterial3D read FActualMaterial; + property ActualTexture: IBGRAScanner read FActualTexture; + property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription; + property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; + end; + +{ TBGRAFace3D } + +function TBGRAFace3D.GetVertexDescription(AIndex : integer + ): PBGRAFaceVertexDescription; +begin + result := @FVertices[AIndex]; +end; + +function TBGRAFace3D.GetCustomFlags: LongWord; +begin + result := FCustomFlags; +end; + +function TBGRAFace3D.GetNormal(AIndex: Integer): IBGRANormal3D; +begin + result := FVertices[AIndex].Normal; +end; + +procedure TBGRAFace3D.SetCustomFlags(AValue: LongWord); +begin + FCustomFlags:= AValue; +end; + +procedure TBGRAFace3D.ComputeActualVertexColor(AIndex: integer); +begin + with FVertices[AIndex] do + begin + if ColorOverride then + ActualColor := Color + else + if Vertex.ParentColor then + ActualColor := FObject3D.Color + else + ActualColor := Vertex.Color; + end; +end; + +procedure TBGRAFace3D.ComputeActualTexCoord(AMinIndex, AMaxIndex: integer); +var + i: Integer; + zoom: TPointF; + m: IBGRAMaterial3D; +begin + m := ActualMaterial; + if m <> nil then zoom := m.TextureZoom + else zoom := PointF(1,1); + for i := AMinIndex to AMaxIndex do + with FVertices[i] do + begin + if TexCoordOverride then + ActualTexCoord := TexCoord + else + ActualTexCoord := Vertex.TexCoord; + ActualTexCoord.x := ActualTexCoord.x * zoom.x; + ActualTexCoord.y := ActualTexCoord.y * zoom.y; + end; +end; + +procedure TBGRAFace3D.UpdateTexture; +begin + if FParentTexture then + begin + FActualTexture := nil; + if FActualMaterial <> nil then + FActualTexture := FActualMaterial.GetTexture; + if FActualTexture = nil then + FActualTexture := FObject3D.Texture + end + else + FActualTexture := FTexture; +end; + +procedure TBGRAFace3D.SetNormal(AIndex: Integer; AValue: IBGRANormal3D); +begin + FVertices[AIndex].Normal := AValue; +end; + +function TBGRAFace3D.GetObject3D: IBGRAObject3D; +begin + result := FObject3D; +end; + +constructor TBGRAFace3D.Create(AObject3D: IBGRAObject3D; + AVertices: array of IBGRAVertex3D); +var + i: Integer; +begin + FObject3D := AObject3D; + FBiface := false; + FParentTexture := True; + FLightThroughFactor:= 0; + FLightThroughFactorOverride:= false; + + UpdateMaterial; + + SetLength(FVertices, length(AVertices)); + for i:= 0 to high(AVertices) do + AddVertex(AVertices[i]); +end; + +destructor TBGRAFace3D.Destroy; +begin + FMaterial := nil; + fillchar(FTexture,sizeof(FTexture),0); + fillchar(FActualTexture,sizeof(FActualTexture),0); + inherited Destroy; +end; + +procedure TBGRAFace3D.ComputeVertexColors; +var + i: Integer; +begin + for i := 0 to FVertexCount-1 do + ComputeActualVertexColor(i); +end; + +procedure TBGRAFace3D.UpdateMaterial; +begin + if Material <> nil then + FActualMaterial := TBGRAMaterial3D(Material.GetAsObject) + else if FObject3D.Material <> nil then + FActualMaterial := TBGRAMaterial3D(FObject3D.Material.GetAsObject) + else if TBGRAScene3D(FObject3D.Scene).DefaultMaterial <> nil then + FActualMaterial := TBGRAMaterial3D(TBGRAScene3D(FObject3D.Scene).DefaultMaterial.GetAsObject); + + UpdateTexture; + + ComputeActualTexCoord(0,FVertexCount-1); +end; + +procedure TBGRAFace3D.FlipFace; +var i: integer; + temp: TBGRAFaceVertexDescription; +begin + for i := 0 to (VertexCount div 2)-1 do + begin + temp := FVertices[i]; + FVertices[i] := FVertices[VertexCount-1-i]; + FVertices[VertexCount-1-i] := temp; + end; +end; + +function TBGRAFace3D.AddVertex(AVertex: IBGRAVertex3D): integer; +begin + if FVertexCount = length(FVertices) then + setlength(FVertices, FVertexCount*2+3); + result := FVertexCount; + with FVertices[result] do + begin + Color := BGRAWhite; + ColorOverride := false; + TexCoord := PointF(0,0); + TexCoordOverride := false; + Vertex := AVertex; + Normal := nil; + end; + ComputeActualVertexColor(result); + ComputeActualTexCoord(result,result); + inc(FVertexCount); +end; + +function TBGRAFace3D.GetParentTexture: boolean; +begin + result := FParentTexture; +end; + +function TBGRAFace3D.GetTexture: IBGRAScanner; +begin + result := FTexture; +end; + +function TBGRAFace3D.GetVertex(AIndex: Integer): IBGRAVertex3D; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + result := FVertices[AIndex].Vertex; +end; + +procedure TBGRAFace3D.SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + FVertices[AIndex].Vertex := AValue; + ComputeActualVertexColor(AIndex); +end; + +function TBGRAFace3D.GetVertexColor(AIndex: Integer): TBGRAPixel; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + result := FVertices[AIndex].ActualColor; +end; + +function TBGRAFace3D.GetVertexColorOverride(AIndex: Integer): boolean; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + result := FVertices[AIndex].ColorOverride; +end; + +function TBGRAFace3D.GetVertexCount: integer; +begin + result := FVertexCount; +end; + +function TBGRAFace3D.GetMaterial: IBGRAMaterial3D; +begin + result := FMaterial; +end; + +function TBGRAFace3D.GetMaterialName: string; +begin + result := FMaterialName; +end; + +procedure TBGRAFace3D.SetParentTexture(const AValue: boolean); +begin + FParentTexture := AValue; + UpdateTexture; +end; + +procedure TBGRAFace3D.SetTexture(const AValue: IBGRAScanner); +begin + FTexture := AValue; + FParentTexture := false; + UpdateTexture; +end; + +procedure TBGRAFace3D.SetColor(AColor: TBGRAPixel); +var i: integer; +begin + for i := 0 to GetVertexCount-1 do + SetVertexColor(i,AColor); +end; + +procedure TBGRAFace3D.SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel + ); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + with FVertices[AIndex] do + begin + Color := AValue; + ColorOverride := true; + end; + ComputeActualVertexColor(AIndex); +end; + +procedure TBGRAFace3D.SetVertexColorOverride(AIndex: Integer; + const AValue: boolean); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + FVertices[AIndex].ColorOverride := AValue; + ComputeActualVertexColor(AIndex); +end; + +function TBGRAFace3D.GetTexCoord(AIndex: Integer): TPointF; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + result := FVertices[AIndex].TexCoord; +end; + +function TBGRAFace3D.GetTexCoordOverride(AIndex: Integer): boolean; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + result := FVertices[AIndex].TexCoordOverride; +end; + +procedure TBGRAFace3D.SetTexCoord(AIndex: Integer; const AValue: TPointF); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + FVertices[AIndex].TexCoord := AValue; + FVertices[AIndex].TexCoordOverride := true; + ComputeActualTexCoord(AIndex, AIndex); +end; + +procedure TBGRAFace3D.SetTexCoordOverride(AIndex: Integer; const AValue: boolean + ); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise Exception.Create('Index out of bounds'); + FVertices[AIndex].TexCoordOverride := AValue; +end; + +function TBGRAFace3D.GetViewNormal: TPoint3D; +begin + result := Point3D(FViewNormal); +end; + +function TBGRAFace3D.GetViewNormal_128: TPoint3D_128; +begin + result := FViewNormal; +end; + +function TBGRAFace3D.GetViewCenter: TPoint3D; +begin + result := Point3D(FViewCenter); +end; + +function TBGRAFace3D.GetViewCenter_128: TPoint3D_128; +begin + result := FViewCenter; +end; + +function TBGRAFace3D.GetViewCenterZ: single; +begin + result := FViewCenter.Z; +end; + +function TBGRAFace3D.GetBiface: boolean; +begin + result := FBiface; +end; + +procedure TBGRAFace3D.SetBiface(const AValue: boolean); +begin + FBiface := AValue; +end; + +function TBGRAFace3D.GetLightThroughFactor: single; +begin + result := FLightThroughFactor; +end; + +function TBGRAFace3D.GetLightThroughFactorOverride: boolean; +begin + result := FLightThroughFactorOverride; +end; + +procedure TBGRAFace3D.SetLightThroughFactor(const AValue: single); +begin + if AValue < 0 then + FLightThroughFactor := 0 + else + FLightThroughFactor:= AValue; + FLightThroughFactorOverride := true; +end; + +procedure TBGRAFace3D.SetLightThroughFactorOverride(const AValue: boolean); +begin + FLightThroughFactorOverride := AValue; +end; + +procedure TBGRAFace3D.ComputeViewNormalAndCenter; +var v1,v2: TPoint3D_128; + i: Integer; + p0,p1,p2: IBGRAVertex3D; +begin + if FVertexCount < 3 then + ClearPoint3D_128(FViewNormal) + else + begin + p0 := FVertices[0].Vertex; + p1 := FVertices[1].Vertex; + p2 := FVertices[2].Vertex; + v1 := p1.ViewCoord_128 - p0.ViewCoord_128; + v2 := p2.ViewCoord_128 - p1.ViewCoord_128; + VectProduct3D_128(v2,v1,FViewNormal); + Normalize3D_128(FViewNormal); + for i := 0 to FVertexCount-1 do + FVertices[i].Vertex.AddViewNormal(FViewNormal); + end; + ClearPoint3D_128(FViewCenter); + if FVertexCount > 0 then + begin + for i := 0 to FVertexCount-1 do + FViewCenter.Offset(FVertices[i].Vertex.ViewCoord_128); + FViewCenter.Scale(1/FVertexCount); + end; +end; + +procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D); +begin + if AValue <> FMaterial then + begin + FMaterial := AValue; + UpdateMaterial; + end; +end; + +procedure TBGRAFace3D.SetMaterialName(const AValue: string); +begin + if AValue <> FMaterialName then + begin + FMaterialName := AValue; + TBGRAScene3D(FObject3D.Scene).UseMaterial(FMaterialName, self); + end; +end; + +function TBGRAFace3D.GetAsObject: TObject; +begin + result := self; +end; + + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/generatedcolorspace.inc b/vendor/kam_remake/src/ext/BGRABitmap/generatedcolorspace.inc new file mode 100644 index 0000000..feab5f4 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/generatedcolorspace.inc @@ -0,0 +1,7103 @@ +{ This file is generated by dev/colorspace/UnitMaker program } + +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +type + + { TStdRGBA } + + PStdRGBA = ^TStdRGBA; + TStdRGBA = packed record + red,green,blue,alpha: single; + class function New(const ARed,AGreen,ABlue,AAlpha:single): TStdRGBA;overload;static; + class function New(const ARed,AGreen,ABlue:single): TStdRGBA;overload;static; + end; + + { TAdobeRGBA } + + PAdobeRGBA = ^TAdobeRGBA; + TAdobeRGBA = packed record + red,green,blue,alpha: byte; + class function New(const ARed,AGreen,ABlue,AAlpha:byte): TAdobeRGBA;overload;static; + class function New(const ARed,AGreen,ABlue:byte): TAdobeRGBA;overload;static; + end; + + { TStdHSLA } + + PStdHSLA = ^TStdHSLA; + TStdHSLA = packed record + hue,saturation,lightness,alpha: single; + class function New(const AHue,ASaturation,ALightness,AAlpha:single): TStdHSLA;overload;static; + class function New(const AHue,ASaturation,ALightness:single): TStdHSLA;overload;static; + end; + + { TStdHSVA } + + PStdHSVA = ^TStdHSVA; + TStdHSVA = packed record + hue,saturation,value,alpha: single; + class function New(const AHue,ASaturation,AValue,AAlpha:single): TStdHSVA;overload;static; + class function New(const AHue,ASaturation,AValue:single): TStdHSVA;overload;static; + end; + + { TStdCMYK } + + PStdCMYK = ^TStdCMYK; + TStdCMYK = packed record + C,M,Y,K: single; + class function New(const ACyan,AMagenta,AYellow,ABlack:single): TStdCMYK;static; + end; + + { TByteMask } + + PByteMask = ^TByteMask; + TByteMask = packed record + gray: byte; + class function New(const AGray:byte): TByteMask;static; + end; + + { TLinearRGBA } + + PLinearRGBA = ^TLinearRGBA; + TLinearRGBA = packed record + red,green,blue,alpha: single; + class function New(const ARed,AGreen,ABlue,AAlpha:single): TLinearRGBA;overload;static; + class function New(const ARed,AGreen,ABlue:single): TLinearRGBA;overload;static; + end; + + { TXYZA } + + PXYZA = ^TXYZA; + TXYZA = packed record + X,Y,Z,alpha: single; + class function New(const AX,AY,AZ,AAlpha:single): TXYZA;overload;static; + class function New(const AX,AY,AZ:single): TXYZA;overload;static; + end; + + { TWordXYZA } + + PWordXYZA = ^TWordXYZA; + TWordXYZA = packed record + X,Y,Z,alpha: word; + class function New(const AX,AY,AZ,AAlpha:word): TWordXYZA;overload;static; + class function New(const AX,AY,AZ:word): TWordXYZA;overload;static; + end; + + { TLabA } + + PLabA = ^TLabA; + TLabA = packed record + L,a,b,alpha: single; + class function New(const ALightness,Aa,Ab,AAlpha:single): TLabA;overload;static; + class function New(const ALightness,Aa,Ab:single): TLabA;overload;static; + end; + + { TLChA } + + PLChA = ^TLChA; + TLChA = packed record + L,C,h,alpha: single; + class function New(const ALightness,AChroma,AHue,AAlpha:single): TLChA;overload;static; + class function New(const ALightness,AChroma,AHue:single): TLChA;overload;static; + end; + + { TColorColorspace } + + TColorColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TBGRAPixelColorspace } + + TBGRAPixelColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TFPColorColorspace } + + TFPColorColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TStdRGBAColorspace } + + TStdRGBAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TAdobeRGBAColorspace } + + TAdobeRGBAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TStdHSLAColorspace } + + TStdHSLAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TStdHSVAColorspace } + + TStdHSVAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TStdCMYKColorspace } + + TStdCMYKColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TByteMaskColorspace } + + TByteMaskColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TExpandedPixelColorspace } + + TExpandedPixelColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TLinearRGBAColorspace } + + TLinearRGBAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { THSLAPixelColorspace } + + THSLAPixelColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TGSBAPixelColorspace } + + TGSBAPixelColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TXYZAColorspace } + + TXYZAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TWordXYZAColorspace } + + TWordXYZAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TLabAColorspace } + + TLabAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TLChAColorspace } + + TLChAColorspace = class(TCustomColorspace) + class function GetChannelName(AIndex: integer): string; override; + class function GetChannelCount: integer; override; + class function IndexOfAlphaChannel: integer; override; + class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; + class function GetMaxValue(AIndex: integer): single; override; + class function GetMinValue(AIndex: integer): single; override; + class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; + class function GetName: string; override; + class function GetSize: integer; override; + class function GetChannel(AColor: Pointer; AIndex: integer): single; override; + class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; + class function GetFlags: TColorspaceFlags; override; + end; + + { TColorHelper } + + TColorHelper = type helper for TColor + class function New(const ARed,AGreen,ABlue:byte): TColor;static; + class function Colorspace: TColorspaceAny; static; + private + function GetRed: byte; + function GetGreen: byte; + function GetBlue: byte; + procedure SetRed(AValue: byte); + procedure SetGreen(AValue: byte); + procedure SetBlue(AValue: byte); + public + function ToBGRAPixel: TBGRAPixel;overload; + function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; + function ToFPColor: TFPColor;overload; + function ToFPColor(AAlpha: word): TFPColor;overload; + function ToStdRGBA: TStdRGBA;overload; + function ToStdRGBA(AAlpha: single): TStdRGBA;overload; + function ToAdobeRGBA: TAdobeRGBA;overload; + function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; + function ToStdHSLA: TStdHSLA;overload; + function ToStdHSLA(AAlpha: single): TStdHSLA;overload; + function ToStdHSVA: TStdHSVA;overload; + function ToStdHSVA(AAlpha: single): TStdHSVA;overload; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel;overload; + function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; + function ToLinearRGBA: TLinearRGBA;overload; + function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; + function ToHSLAPixel: THSLAPixel;overload; + function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; + function ToGSBAPixel: TGSBAPixel;overload; + function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; + function ToXYZA: TXYZA;overload; + function ToXYZA(AAlpha: single): TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(AAlpha: word): TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA;overload; + function ToLabA(AAlpha: single): TLabA;overload; + function ToLChA: TLChA;overload; + function ToLChA(AAlpha: single): TLChA;overload; + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + property red: byte read GetRed write SetRed; + property green: byte read GetGreen write SetGreen; + property blue: byte read GetBlue write SetBlue; + end; + + { TBGRAPixelHelper } + + TBGRAPixelHelper = record helper(TBGRAPixelBasicHelper) for TBGRAPixel + class function New(const ARed,AGreen,ABlue,AAlpha:byte): TBGRAPixel;overload;static; + class function New(const ARed,AGreen,ABlue:byte): TBGRAPixel;overload;static; + class function Colorspace: TColorspaceAny; static; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToLinearRGBA: TLinearRGBA; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TFPColorHelper } + + TFPColorHelper = record helper(TFPColorBasicHelper) for TFPColor + class function New(const ARed,AGreen,ABlue,AAlpha:word): TFPColor;overload;static; + class function New(const ARed,AGreen,ABlue:word): TFPColor;overload;static; + class function Colorspace: TColorspaceAny; static; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToLinearRGBA: TLinearRGBA; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TStdRGBAHelper } + + TStdRGBAHelper = record helper for TStdRGBA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TAdobeRGBAHelper } + + TAdobeRGBAHelper = record helper for TAdobeRGBA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TStdHSLAHelper } + + TStdHSLAHelper = record helper for TStdHSLA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TStdHSVAHelper } + + TStdHSVAHelper = record helper for TStdHSVA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TStdCMYKHelper } + + TStdCMYKHelper = record helper for TStdCMYK + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel;overload; + function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; + function ToFPColor: TFPColor;overload; + function ToFPColor(AAlpha: word): TFPColor;overload; + function ToStdRGBA: TStdRGBA;overload; + function ToStdRGBA(AAlpha: single): TStdRGBA;overload; + function ToAdobeRGBA: TAdobeRGBA;overload; + function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; + function ToStdHSLA: TStdHSLA;overload; + function ToStdHSLA(AAlpha: single): TStdHSLA;overload; + function ToStdHSVA: TStdHSVA;overload; + function ToStdHSVA(AAlpha: single): TStdHSVA;overload; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel;overload; + function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; + function ToLinearRGBA: TLinearRGBA;overload; + function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; + function ToHSLAPixel: THSLAPixel;overload; + function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; + function ToGSBAPixel: TGSBAPixel;overload; + function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; + function ToXYZA: TXYZA;overload; + function ToXYZA(AAlpha: single): TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(AAlpha: word): TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA;overload; + function ToLabA(AAlpha: single): TLabA;overload; + function ToLChA: TLChA;overload; + function ToLChA(AAlpha: single): TLChA;overload; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TByteMaskHelper } + + TByteMaskHelper = record helper for TByteMask + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel;overload; + function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; + function ToFPColor: TFPColor;overload; + function ToFPColor(AAlpha: word): TFPColor;overload; + function ToStdRGBA: TStdRGBA;overload; + function ToStdRGBA(AAlpha: single): TStdRGBA;overload; + function ToAdobeRGBA: TAdobeRGBA;overload; + function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; + function ToStdHSLA: TStdHSLA;overload; + function ToStdHSLA(AAlpha: single): TStdHSLA;overload; + function ToStdHSVA: TStdHSVA;overload; + function ToStdHSVA(AAlpha: single): TStdHSVA;overload; + function ToStdCMYK: TStdCMYK; + function ToExpandedPixel: TExpandedPixel;overload; + function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; + function ToLinearRGBA: TLinearRGBA;overload; + function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; + function ToHSLAPixel: THSLAPixel;overload; + function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; + function ToGSBAPixel: TGSBAPixel;overload; + function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; + function ToXYZA: TXYZA;overload; + function ToXYZA(AAlpha: single): TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(AAlpha: word): TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA;overload; + function ToLabA(AAlpha: single): TLabA;overload; + function ToLChA: TLChA;overload; + function ToLChA(AAlpha: single): TLChA;overload; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TExpandedPixelHelper } + + TExpandedPixelHelper = record helper(TExpandedPixelBasicHelper) for TExpandedPixel + class function New(const ARed,AGreen,ABlue,AAlpha:word): TExpandedPixel;overload;static; + class function New(const ARed,AGreen,ABlue:word): TExpandedPixel;overload;static; + class function Colorspace: TColorspaceAny; static; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToLinearRGBA: TLinearRGBA; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TLinearRGBAHelper } + + TLinearRGBAHelper = record helper for TLinearRGBA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { THSLAPixelHelper } + + THSLAPixelHelper = record helper(THSLAPixelBasicHelper) for THSLAPixel + class function New(const AHue,ASaturation,ALightness,AAlpha:word): THSLAPixel;overload;static; + class function New(const AHue,ASaturation,ALightness:word): THSLAPixel;overload;static; + class function Colorspace: TColorspaceAny; static; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToLinearRGBA: TLinearRGBA; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TGSBAPixelHelper } + + TGSBAPixelHelper = record helper(TGSBAPixelBasicHelper) for TGSBAPixel + class function New(const AHue,ASaturation,ABrightness,AAlpha:word): TGSBAPixel;overload;static; + class function New(const AHue,ASaturation,ABrightness:word): TGSBAPixel;overload;static; + class function Colorspace: TColorspaceAny; static; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToLinearRGBA: TLinearRGBA; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + function ToLChA: TLChA; + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + procedure FromLChA(AValue: TLChA); + end; + + { TXYZAHelper } + + TXYZAHelper = record helper for TXYZA + class function Colorspace: TColorspaceAny; static; + procedure ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); + function ToColor: TColor;overload; + function ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; + function ToBGRAPixel: TBGRAPixel;overload; + function ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; + function ToFPColor: TFPColor;overload; + function ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; + function ToStdRGBA: TStdRGBA;overload; + function ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; + function ToAdobeRGBA: TAdobeRGBA;overload; + function ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; + function ToStdHSLA: TStdHSLA;overload; + function ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; + function ToStdHSVA: TStdHSVA;overload; + function ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; + function ToStdCMYK: TStdCMYK;overload; + function ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; + function ToByteMask: TByteMask;overload; + function ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; + function ToExpandedPixel: TExpandedPixel;overload; + function ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; + function ToLinearRGBA: TLinearRGBA;overload; + function ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; + function ToHSLAPixel: THSLAPixel;overload; + function ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; + function ToGSBAPixel: TGSBAPixel;overload; + function ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; + function ToWordXYZA: TWordXYZA; + function ToLabA: TLabA;overload; + function ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; + function ToLChA: TLChA;overload; + function ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; + procedure FromColor(AValue: TColor); overload; + procedure FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromBGRAPixel(AValue: TBGRAPixel); overload; + procedure FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromFPColor(AValue: TFPColor); overload; + procedure FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdRGBA(AValue: TStdRGBA); overload; + procedure FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromAdobeRGBA(AValue: TAdobeRGBA); overload; + procedure FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdHSLA(AValue: TStdHSLA); overload; + procedure FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdHSVA(AValue: TStdHSVA); overload; + procedure FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdCMYK(AValue: TStdCMYK); overload; + procedure FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromByteMask(AValue: TByteMask); overload; + procedure FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromExpandedPixel(AValue: TExpandedPixel); overload; + procedure FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLinearRGBA(AValue: TLinearRGBA); overload; + procedure FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromHSLAPixel(AValue: THSLAPixel); overload; + procedure FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromGSBAPixel(AValue: TGSBAPixel); overload; + procedure FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); + procedure FromLabA(AValue: TLabA); overload; + procedure FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLChA(AValue: TLChA); overload; + procedure FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; + end; + + { TWordXYZAHelper } + + TWordXYZAHelper = record helper for TWordXYZA + class function Colorspace: TColorspaceAny; static; + procedure ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); + function ToColor: TColor;overload; + function ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; + function ToBGRAPixel: TBGRAPixel;overload; + function ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; + function ToFPColor: TFPColor;overload; + function ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; + function ToStdRGBA: TStdRGBA;overload; + function ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; + function ToAdobeRGBA: TAdobeRGBA;overload; + function ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; + function ToStdHSLA: TStdHSLA;overload; + function ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; + function ToStdHSVA: TStdHSVA;overload; + function ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; + function ToStdCMYK: TStdCMYK;overload; + function ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; + function ToByteMask: TByteMask;overload; + function ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; + function ToExpandedPixel: TExpandedPixel;overload; + function ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; + function ToLinearRGBA: TLinearRGBA;overload; + function ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; + function ToHSLAPixel: THSLAPixel;overload; + function ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; + function ToGSBAPixel: TGSBAPixel;overload; + function ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; + function ToXYZA: TXYZA; + function ToLabA: TLabA;overload; + function ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; + function ToLChA: TLChA;overload; + function ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; + procedure FromColor(AValue: TColor); overload; + procedure FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromBGRAPixel(AValue: TBGRAPixel); overload; + procedure FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromFPColor(AValue: TFPColor); overload; + procedure FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdRGBA(AValue: TStdRGBA); overload; + procedure FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromAdobeRGBA(AValue: TAdobeRGBA); overload; + procedure FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdHSLA(AValue: TStdHSLA); overload; + procedure FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdHSVA(AValue: TStdHSVA); overload; + procedure FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromStdCMYK(AValue: TStdCMYK); overload; + procedure FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromByteMask(AValue: TByteMask); overload; + procedure FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromExpandedPixel(AValue: TExpandedPixel); overload; + procedure FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLinearRGBA(AValue: TLinearRGBA); overload; + procedure FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromHSLAPixel(AValue: THSLAPixel); overload; + procedure FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromGSBAPixel(AValue: TGSBAPixel); overload; + procedure FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromXYZA(AValue: TXYZA); + procedure FromLabA(AValue: TLabA); overload; + procedure FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLChA(AValue: TLChA); overload; + procedure FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; + end; + + { TLabAHelper } + + TLabAHelper = record helper for TLabA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLChA: TLChA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLChA(AValue: TLChA); + end; + + { TLChAHelper } + + TLChAHelper = record helper for TLChA + class function Colorspace: TColorspaceAny; static; + function ToColor: TColor; + function ToBGRAPixel: TBGRAPixel; + function ToFPColor: TFPColor; + function ToStdRGBA: TStdRGBA; + function ToAdobeRGBA: TAdobeRGBA; + function ToStdHSLA: TStdHSLA; + function ToStdHSVA: TStdHSVA; + function ToStdCMYK: TStdCMYK; + function ToByteMask: TByteMask; + function ToExpandedPixel: TExpandedPixel; + function ToLinearRGBA: TLinearRGBA; + function ToHSLAPixel: THSLAPixel; + function ToGSBAPixel: TGSBAPixel; + function ToXYZA: TXYZA;overload; + function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; + function ToWordXYZA: TWordXYZA;overload; + function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; + function ToLabA: TLabA; + procedure FromColor(AValue: TColor); + procedure FromBGRAPixel(AValue: TBGRAPixel); + procedure FromFPColor(AValue: TFPColor); + procedure FromStdRGBA(AValue: TStdRGBA); + procedure FromAdobeRGBA(AValue: TAdobeRGBA); + procedure FromStdHSLA(AValue: TStdHSLA); + procedure FromStdHSVA(AValue: TStdHSVA); + procedure FromStdCMYK(AValue: TStdCMYK); + procedure FromByteMask(AValue: TByteMask); + procedure FromExpandedPixel(AValue: TExpandedPixel); + procedure FromLinearRGBA(AValue: TLinearRGBA); + procedure FromHSLAPixel(AValue: THSLAPixel); + procedure FromGSBAPixel(AValue: TGSBAPixel); + procedure FromXYZA(AValue: TXYZA); overload; + procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromWordXYZA(AValue: TWordXYZA); overload; + procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; + procedure FromLabA(AValue: TLabA); + end; + +operator := (const AValue: TColor): TStdRGBA; +operator := (const AValue: TColor): TAdobeRGBA; +operator := (const AValue: TColor): TStdHSLA; +operator := (const AValue: TColor): TStdHSVA; +operator := (const AValue: TColor): TStdCMYK; +operator := (const AValue: TColor): TByteMask; +operator := (const AValue: TColor): TLinearRGBA; +operator := (const AValue: TColor): TXYZA; +operator := (const AValue: TColor): TWordXYZA; +operator := (const AValue: TColor): TLabA; +operator := (const AValue: TColor): TLChA; +operator := (const AValue: TBGRAPixel): TStdRGBA; +operator := (const AValue: TBGRAPixel): TAdobeRGBA; +operator := (const AValue: TBGRAPixel): TStdHSLA; +operator := (const AValue: TBGRAPixel): TStdHSVA; +operator := (const AValue: TBGRAPixel): TStdCMYK; +operator := (const AValue: TBGRAPixel): TByteMask; +operator := (const AValue: TBGRAPixel): TLinearRGBA; +operator := (const AValue: TBGRAPixel): TXYZA; +operator := (const AValue: TBGRAPixel): TWordXYZA; +operator := (const AValue: TBGRAPixel): TLabA; +operator := (const AValue: TBGRAPixel): TLChA; +operator := (const AValue: TFPColor): TStdRGBA; +operator := (const AValue: TFPColor): TAdobeRGBA; +operator := (const AValue: TFPColor): TStdHSLA; +operator := (const AValue: TFPColor): TStdHSVA; +operator := (const AValue: TFPColor): TStdCMYK; +operator := (const AValue: TFPColor): TByteMask; +operator := (const AValue: TFPColor): TLinearRGBA; +operator := (const AValue: TFPColor): TXYZA; +operator := (const AValue: TFPColor): TWordXYZA; +operator := (const AValue: TFPColor): TLabA; +operator := (const AValue: TFPColor): TLChA; +operator := (const AValue: TStdRGBA): TColor; +operator := (const AValue: TStdRGBA): TBGRAPixel; +operator := (const AValue: TStdRGBA): TFPColor; +operator := (const AValue: TStdRGBA): TAdobeRGBA; +operator := (const AValue: TStdRGBA): TStdHSLA; +operator := (const AValue: TStdRGBA): TStdHSVA; +operator := (const AValue: TStdRGBA): TStdCMYK; +operator := (const AValue: TStdRGBA): TByteMask; +operator := (const AValue: TStdRGBA): TExpandedPixel; +operator := (const AValue: TStdRGBA): TLinearRGBA; +operator := (const AValue: TStdRGBA): THSLAPixel; +operator := (const AValue: TStdRGBA): TGSBAPixel; +operator := (const AValue: TStdRGBA): TXYZA; +operator := (const AValue: TStdRGBA): TWordXYZA; +operator := (const AValue: TStdRGBA): TLabA; +operator := (const AValue: TStdRGBA): TLChA; +operator := (const AValue: TAdobeRGBA): TColor; +operator := (const AValue: TAdobeRGBA): TBGRAPixel; +operator := (const AValue: TAdobeRGBA): TFPColor; +operator := (const AValue: TAdobeRGBA): TStdRGBA; +operator := (const AValue: TAdobeRGBA): TStdHSLA; +operator := (const AValue: TAdobeRGBA): TStdHSVA; +operator := (const AValue: TAdobeRGBA): TStdCMYK; +operator := (const AValue: TAdobeRGBA): TByteMask; +operator := (const AValue: TAdobeRGBA): TExpandedPixel; +operator := (const AValue: TAdobeRGBA): TLinearRGBA; +operator := (const AValue: TAdobeRGBA): THSLAPixel; +operator := (const AValue: TAdobeRGBA): TGSBAPixel; +operator := (const AValue: TAdobeRGBA): TXYZA; +operator := (const AValue: TAdobeRGBA): TWordXYZA; +operator := (const AValue: TAdobeRGBA): TLabA; +operator := (const AValue: TAdobeRGBA): TLChA; +operator := (const AValue: TStdHSLA): TColor; +operator := (const AValue: TStdHSLA): TBGRAPixel; +operator := (const AValue: TStdHSLA): TFPColor; +operator := (const AValue: TStdHSLA): TStdRGBA; +operator := (const AValue: TStdHSLA): TAdobeRGBA; +operator := (const AValue: TStdHSLA): TStdHSVA; +operator := (const AValue: TStdHSLA): TStdCMYK; +operator := (const AValue: TStdHSLA): TByteMask; +operator := (const AValue: TStdHSLA): TExpandedPixel; +operator := (const AValue: TStdHSLA): TLinearRGBA; +operator := (const AValue: TStdHSLA): THSLAPixel; +operator := (const AValue: TStdHSLA): TGSBAPixel; +operator := (const AValue: TStdHSLA): TXYZA; +operator := (const AValue: TStdHSLA): TWordXYZA; +operator := (const AValue: TStdHSLA): TLabA; +operator := (const AValue: TStdHSLA): TLChA; +operator := (const AValue: TStdHSVA): TColor; +operator := (const AValue: TStdHSVA): TBGRAPixel; +operator := (const AValue: TStdHSVA): TFPColor; +operator := (const AValue: TStdHSVA): TStdRGBA; +operator := (const AValue: TStdHSVA): TAdobeRGBA; +operator := (const AValue: TStdHSVA): TStdHSLA; +operator := (const AValue: TStdHSVA): TStdCMYK; +operator := (const AValue: TStdHSVA): TByteMask; +operator := (const AValue: TStdHSVA): TExpandedPixel; +operator := (const AValue: TStdHSVA): TLinearRGBA; +operator := (const AValue: TStdHSVA): THSLAPixel; +operator := (const AValue: TStdHSVA): TGSBAPixel; +operator := (const AValue: TStdHSVA): TXYZA; +operator := (const AValue: TStdHSVA): TWordXYZA; +operator := (const AValue: TStdHSVA): TLabA; +operator := (const AValue: TStdHSVA): TLChA; +operator := (const AValue: TStdCMYK): TColor; +operator := (const AValue: TStdCMYK): TBGRAPixel; +operator := (const AValue: TStdCMYK): TFPColor; +operator := (const AValue: TStdCMYK): TStdRGBA; +operator := (const AValue: TStdCMYK): TAdobeRGBA; +operator := (const AValue: TStdCMYK): TStdHSLA; +operator := (const AValue: TStdCMYK): TStdHSVA; +operator := (const AValue: TStdCMYK): TByteMask; +operator := (const AValue: TStdCMYK): TExpandedPixel; +operator := (const AValue: TStdCMYK): TLinearRGBA; +operator := (const AValue: TStdCMYK): THSLAPixel; +operator := (const AValue: TStdCMYK): TGSBAPixel; +operator := (const AValue: TStdCMYK): TXYZA; +operator := (const AValue: TStdCMYK): TWordXYZA; +operator := (const AValue: TStdCMYK): TLabA; +operator := (const AValue: TStdCMYK): TLChA; +operator := (const AValue: TByteMask): TColor; +operator := (const AValue: TByteMask): TBGRAPixel; +operator := (const AValue: TByteMask): TFPColor; +operator := (const AValue: TByteMask): TStdRGBA; +operator := (const AValue: TByteMask): TAdobeRGBA; +operator := (const AValue: TByteMask): TStdHSLA; +operator := (const AValue: TByteMask): TStdHSVA; +operator := (const AValue: TByteMask): TStdCMYK; +operator := (const AValue: TByteMask): TExpandedPixel; +operator := (const AValue: TByteMask): TLinearRGBA; +operator := (const AValue: TByteMask): THSLAPixel; +operator := (const AValue: TByteMask): TGSBAPixel; +operator := (const AValue: TByteMask): TXYZA; +operator := (const AValue: TByteMask): TWordXYZA; +operator := (const AValue: TByteMask): TLabA; +operator := (const AValue: TByteMask): TLChA; +operator := (const AValue: TExpandedPixel): TStdRGBA; +operator := (const AValue: TExpandedPixel): TAdobeRGBA; +operator := (const AValue: TExpandedPixel): TStdHSLA; +operator := (const AValue: TExpandedPixel): TStdHSVA; +operator := (const AValue: TExpandedPixel): TStdCMYK; +operator := (const AValue: TExpandedPixel): TByteMask; +operator := (const AValue: TExpandedPixel): TLinearRGBA; +operator := (const AValue: TExpandedPixel): TXYZA; +operator := (const AValue: TExpandedPixel): TWordXYZA; +operator := (const AValue: TExpandedPixel): TLabA; +operator := (const AValue: TExpandedPixel): TLChA; +operator := (const AValue: TLinearRGBA): TColor; +operator := (const AValue: TLinearRGBA): TBGRAPixel; +operator := (const AValue: TLinearRGBA): TFPColor; +operator := (const AValue: TLinearRGBA): TStdRGBA; +operator := (const AValue: TLinearRGBA): TAdobeRGBA; +operator := (const AValue: TLinearRGBA): TStdHSLA; +operator := (const AValue: TLinearRGBA): TStdHSVA; +operator := (const AValue: TLinearRGBA): TStdCMYK; +operator := (const AValue: TLinearRGBA): TByteMask; +operator := (const AValue: TLinearRGBA): TExpandedPixel; +operator := (const AValue: TLinearRGBA): THSLAPixel; +operator := (const AValue: TLinearRGBA): TGSBAPixel; +operator := (const AValue: TLinearRGBA): TXYZA; +operator := (const AValue: TLinearRGBA): TWordXYZA; +operator := (const AValue: TLinearRGBA): TLabA; +operator := (const AValue: TLinearRGBA): TLChA; +operator := (const AValue: THSLAPixel): TStdRGBA; +operator := (const AValue: THSLAPixel): TAdobeRGBA; +operator := (const AValue: THSLAPixel): TStdHSLA; +operator := (const AValue: THSLAPixel): TStdHSVA; +operator := (const AValue: THSLAPixel): TStdCMYK; +operator := (const AValue: THSLAPixel): TByteMask; +operator := (const AValue: THSLAPixel): TLinearRGBA; +operator := (const AValue: THSLAPixel): TXYZA; +operator := (const AValue: THSLAPixel): TWordXYZA; +operator := (const AValue: THSLAPixel): TLabA; +operator := (const AValue: THSLAPixel): TLChA; +operator := (const AValue: TGSBAPixel): TStdRGBA; +operator := (const AValue: TGSBAPixel): TAdobeRGBA; +operator := (const AValue: TGSBAPixel): TStdHSLA; +operator := (const AValue: TGSBAPixel): TStdHSVA; +operator := (const AValue: TGSBAPixel): TStdCMYK; +operator := (const AValue: TGSBAPixel): TByteMask; +operator := (const AValue: TGSBAPixel): TLinearRGBA; +operator := (const AValue: TGSBAPixel): TXYZA; +operator := (const AValue: TGSBAPixel): TWordXYZA; +operator := (const AValue: TGSBAPixel): TLabA; +operator := (const AValue: TGSBAPixel): TLChA; +operator := (const AValue: TXYZA): TColor; +operator := (const AValue: TXYZA): TBGRAPixel; +operator := (const AValue: TXYZA): TFPColor; +operator := (const AValue: TXYZA): TStdRGBA; +operator := (const AValue: TXYZA): TAdobeRGBA; +operator := (const AValue: TXYZA): TStdHSLA; +operator := (const AValue: TXYZA): TStdHSVA; +operator := (const AValue: TXYZA): TStdCMYK; +operator := (const AValue: TXYZA): TByteMask; +operator := (const AValue: TXYZA): TExpandedPixel; +operator := (const AValue: TXYZA): TLinearRGBA; +operator := (const AValue: TXYZA): THSLAPixel; +operator := (const AValue: TXYZA): TGSBAPixel; +operator := (const AValue: TXYZA): TWordXYZA; +operator := (const AValue: TXYZA): TLabA; +operator := (const AValue: TXYZA): TLChA; +operator := (const AValue: TWordXYZA): TColor; +operator := (const AValue: TWordXYZA): TBGRAPixel; +operator := (const AValue: TWordXYZA): TFPColor; +operator := (const AValue: TWordXYZA): TStdRGBA; +operator := (const AValue: TWordXYZA): TAdobeRGBA; +operator := (const AValue: TWordXYZA): TStdHSLA; +operator := (const AValue: TWordXYZA): TStdHSVA; +operator := (const AValue: TWordXYZA): TStdCMYK; +operator := (const AValue: TWordXYZA): TByteMask; +operator := (const AValue: TWordXYZA): TExpandedPixel; +operator := (const AValue: TWordXYZA): TLinearRGBA; +operator := (const AValue: TWordXYZA): THSLAPixel; +operator := (const AValue: TWordXYZA): TGSBAPixel; +operator := (const AValue: TWordXYZA): TXYZA; +operator := (const AValue: TWordXYZA): TLabA; +operator := (const AValue: TWordXYZA): TLChA; +operator := (const AValue: TLabA): TColor; +operator := (const AValue: TLabA): TBGRAPixel; +operator := (const AValue: TLabA): TFPColor; +operator := (const AValue: TLabA): TStdRGBA; +operator := (const AValue: TLabA): TAdobeRGBA; +operator := (const AValue: TLabA): TStdHSLA; +operator := (const AValue: TLabA): TStdHSVA; +operator := (const AValue: TLabA): TStdCMYK; +operator := (const AValue: TLabA): TByteMask; +operator := (const AValue: TLabA): TExpandedPixel; +operator := (const AValue: TLabA): TLinearRGBA; +operator := (const AValue: TLabA): THSLAPixel; +operator := (const AValue: TLabA): TGSBAPixel; +operator := (const AValue: TLabA): TXYZA; +operator := (const AValue: TLabA): TWordXYZA; +operator := (const AValue: TLabA): TLChA; +operator := (const AValue: TLChA): TColor; +operator := (const AValue: TLChA): TBGRAPixel; +operator := (const AValue: TLChA): TFPColor; +operator := (const AValue: TLChA): TStdRGBA; +operator := (const AValue: TLChA): TAdobeRGBA; +operator := (const AValue: TLChA): TStdHSLA; +operator := (const AValue: TLChA): TStdHSVA; +operator := (const AValue: TLChA): TStdCMYK; +operator := (const AValue: TLChA): TByteMask; +operator := (const AValue: TLChA): TExpandedPixel; +operator := (const AValue: TLChA): TLinearRGBA; +operator := (const AValue: TLChA): THSLAPixel; +operator := (const AValue: TLChA): TGSBAPixel; +operator := (const AValue: TLChA): TXYZA; +operator := (const AValue: TLChA): TWordXYZA; +operator := (const AValue: TLChA): TLabA; +{$ENDIF} +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{Converters} + +procedure ConvertColorArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := ColorToBGRA(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToFPColor(const AColor: TColor;const AAlpha: word=65535): TFPColor; +begin Result := BGRAToFPColor(ColorToBGRA(AColor)); + Result.alpha := AAlpha end; + +procedure ConvertColorArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TFPColor(ADest^) := ColorToFPColor(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToStdRGBA(const AColor: TColor;const AAlpha: single=1): TStdRGBA; +begin Result := BGRAPixelToStdRGBA(ColorToBGRA(AColor)); + Result.alpha := AAlpha end; + +procedure ConvertColorArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := ColorToStdRGBA(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToStdHSLA(const AColor: TColor;const AAlpha: single=1): TStdHSLA; +begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(ColorToBGRA(AColor))); + Result.alpha := AAlpha end; + +procedure ConvertColorArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := ColorToStdHSLA(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToStdHSVA(const AColor: TColor;const AAlpha: single=1): TStdHSVA; +begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(ColorToBGRA(AColor))); + Result.alpha := AAlpha end; + +procedure ConvertColorArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := ColorToStdHSVA(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToStdCMYK(const AColor: TColor): TStdCMYK; +begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(ColorToBGRA(AColor))) end; + +procedure ConvertColorArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := ColorToStdCMYK(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToByteMask(const AColor: TColor): TByteMask; +begin Result := BGRAToMask(ColorToBGRA(AColor)) end; + +procedure ConvertColorArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := ColorToByteMask(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ColorToExpandedPixel(const AColor: TColor;const AAlpha: word=65535): TExpandedPixel; +begin Result := GammaExpansion(ColorToBGRA(AColor)); + Result.alpha := AAlpha end; + +procedure ConvertColorArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := ColorToExpandedPixel(TColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertBGRAPixelArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := BGRAToColor(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertBGRAPixelArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TFPColor(ADest^) := BGRAToFPColor(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertBGRAPixelArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := BGRAPixelToStdRGBA(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function BGRAPixelToStdHSLA(const ABGRAPixel: TBGRAPixel): TStdHSLA; +begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(ABGRAPixel)) end; + +procedure ConvertBGRAPixelArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := BGRAPixelToStdHSLA(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function BGRAPixelToStdHSVA(const ABGRAPixel: TBGRAPixel): TStdHSVA; +begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(ABGRAPixel)) end; + +procedure ConvertBGRAPixelArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := BGRAPixelToStdHSVA(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function BGRAPixelToStdCMYK(const ABGRAPixel: TBGRAPixel): TStdCMYK; +begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(ABGRAPixel)) end; + +procedure ConvertBGRAPixelArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := BGRAPixelToStdCMYK(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertBGRAPixelArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := BGRAToMask(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertBGRAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := GammaExpansion(TBGRAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function FPColorToColor(const AFPColor: TFPColor): TColor; +begin Result := BGRAToColor(FPColorToBGRA(AFPColor)) end; + +procedure ConvertFPColorArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := FPColorToColor(TFPColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertFPColorArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := FPColorToBGRA(TFPColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function FPColorToByteMask(const AFPColor: TFPColor): TByteMask; +begin Result := BGRAToMask(FPColorToBGRA(AFPColor)) end; + +procedure ConvertFPColorArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := FPColorToByteMask(TFPColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertFPColorArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := FPColorToExpanded(TFPColor(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdRGBAToColor(const AStdRGBA: TStdRGBA): TColor; +begin Result := BGRAToColor(StdRGBAToBGRAPixel(AStdRGBA)) end; + +procedure ConvertStdRGBAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := StdRGBAToColor(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdRGBAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := StdRGBAToBGRAPixel(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdRGBAArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := StdRGBAToStdHSLA(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdRGBAArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := StdRGBAToStdHSVA(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdRGBAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := StdRGBAToStdCMYK(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdRGBAToByteMask(const AStdRGBA: TStdRGBA): TByteMask; +begin Result := BGRAToMask(StdRGBAToBGRAPixel(AStdRGBA)) end; + +procedure ConvertStdRGBAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := StdRGBAToByteMask(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := StdRGBAToExpandedPixel(TStdRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function AdobeRGBAToExpandedPixel(const AAdobeRGBA: TAdobeRGBA): TExpandedPixel; +begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AdobeRGBAToXYZA(AAdobeRGBA))) end; + +procedure ConvertAdobeRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := AdobeRGBAToExpandedPixel(TAdobeRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function AdobeRGBAToLinearRGBA(const AAdobeRGBA: TAdobeRGBA): TLinearRGBA; +begin Result := XYZAToLinearRGBA(AdobeRGBAToXYZA(AAdobeRGBA)) end; + +procedure ConvertAdobeRGBAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLinearRGBA(ADest^) := AdobeRGBAToLinearRGBA(TAdobeRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertAdobeRGBAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TXYZA(ADest^) := AdobeRGBAToXYZA(TAdobeRGBA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function AdobeRGBAToWordXYZA(const AAdobeRGBA: TAdobeRGBA): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(AdobeRGBAToXYZA(AAdobeRGBA)) end; + +function AdobeRGBAToWordXYZA(const AAdobeRGBA: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(AdobeRGBAToXYZA(AAdobeRGBA,AReferenceWhite)) end; + +procedure ConvertAdobeRGBAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TWordXYZA(ADest^) := AdobeRGBAToWordXYZA(TAdobeRGBA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function AdobeRGBAToLabA(const AAdobeRGBA: TAdobeRGBA): TLabA; +begin Result := XYZAToLabA(AdobeRGBAToXYZA(AAdobeRGBA)) end; + +procedure ConvertAdobeRGBAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLabA(ADest^) := AdobeRGBAToLabA(TAdobeRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function AdobeRGBAToLChA(const AAdobeRGBA: TAdobeRGBA): TLChA; +begin Result := LabAToLChA(XYZAToLabA(AdobeRGBAToXYZA(AAdobeRGBA))) end; + +procedure ConvertAdobeRGBAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLChA(ADest^) := AdobeRGBAToLChA(TAdobeRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSLAToColor(const AStdHSLA: TStdHSLA): TColor; +begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA))) end; + +procedure ConvertStdHSLAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := StdHSLAToColor(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSLAToBGRAPixel(const AStdHSLA: TStdHSLA): TBGRAPixel; +begin Result := StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA)) end; + +procedure ConvertStdHSLAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := StdHSLAToBGRAPixel(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdHSLAArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := StdHSLAToStdRGBA(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdHSLAArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := StdHSLAToStdHSVA(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSLAToStdCMYK(const AStdHSLA: TStdHSLA): TStdCMYK; +begin Result := StdRGBAToStdCMYK(StdHSLAToStdRGBA(AStdHSLA)) end; + +procedure ConvertStdHSLAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := StdHSLAToStdCMYK(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSLAToByteMask(const AStdHSLA: TStdHSLA): TByteMask; +begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA))) end; + +procedure ConvertStdHSLAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := StdHSLAToByteMask(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSLAToExpandedPixel(const AStdHSLA: TStdHSLA): TExpandedPixel; +begin Result := StdRGBAToExpandedPixel(StdHSLAToStdRGBA(AStdHSLA)) end; + +procedure ConvertStdHSLAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := StdHSLAToExpandedPixel(TStdHSLA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSVAToColor(const AStdHSVA: TStdHSVA): TColor; +begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA))) end; + +procedure ConvertStdHSVAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := StdHSVAToColor(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSVAToBGRAPixel(const AStdHSVA: TStdHSVA): TBGRAPixel; +begin Result := StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA)) end; + +procedure ConvertStdHSVAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := StdHSVAToBGRAPixel(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdHSVAArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := StdHSVAToStdRGBA(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdHSVAArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := StdHSVAToStdHSLA(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSVAToStdCMYK(const AStdHSVA: TStdHSVA): TStdCMYK; +begin Result := StdRGBAToStdCMYK(StdHSVAToStdRGBA(AStdHSVA)) end; + +procedure ConvertStdHSVAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := StdHSVAToStdCMYK(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSVAToByteMask(const AStdHSVA: TStdHSVA): TByteMask; +begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA))) end; + +procedure ConvertStdHSVAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := StdHSVAToByteMask(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdHSVAToExpandedPixel(const AStdHSVA: TStdHSVA): TExpandedPixel; +begin Result := StdRGBAToExpandedPixel(StdHSVAToStdRGBA(AStdHSVA)) end; + +procedure ConvertStdHSVAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := StdHSVAToExpandedPixel(TStdHSVA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToColor(const AStdCMYK: TStdCMYK): TColor; +begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK))) end; + +procedure ConvertStdCMYKArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := StdCMYKToColor(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToBGRAPixel(const AStdCMYK: TStdCMYK;const AAlpha: byte=255): TBGRAPixel; +begin Result := StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK)); + Result.alpha := AAlpha end; + +procedure ConvertStdCMYKArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := StdCMYKToBGRAPixel(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertStdCMYKArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := StdCMYKToStdRGBA(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToStdHSLA(const AStdCMYK: TStdCMYK;const AAlpha: single=1): TStdHSLA; +begin Result := StdRGBAToStdHSLA(StdCMYKToStdRGBA(AStdCMYK)); + Result.alpha := AAlpha end; + +procedure ConvertStdCMYKArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := StdCMYKToStdHSLA(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToStdHSVA(const AStdCMYK: TStdCMYK;const AAlpha: single=1): TStdHSVA; +begin Result := StdRGBAToStdHSVA(StdCMYKToStdRGBA(AStdCMYK)); + Result.alpha := AAlpha end; + +procedure ConvertStdCMYKArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := StdCMYKToStdHSVA(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToByteMask(const AStdCMYK: TStdCMYK): TByteMask; +begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK))) end; + +procedure ConvertStdCMYKArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := StdCMYKToByteMask(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function StdCMYKToExpandedPixel(const AStdCMYK: TStdCMYK;const AAlpha: word=65535): TExpandedPixel; +begin Result := StdRGBAToExpandedPixel(StdCMYKToStdRGBA(AStdCMYK)); + Result.alpha := AAlpha end; + +procedure ConvertStdCMYKArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := StdCMYKToExpandedPixel(TStdCMYK(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToColor(const AByteMask: TByteMask): TColor; +begin Result := BGRAToColor(MaskToBGRA(AByteMask)) end; + +procedure ConvertByteMaskArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := ByteMaskToColor(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertByteMaskArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := MaskToBGRA(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToFPColor(const AByteMask: TByteMask;const AAlpha: word=65535): TFPColor; +begin Result := BGRAToFPColor(MaskToBGRA(AByteMask)); + Result.alpha := AAlpha end; + +procedure ConvertByteMaskArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TFPColor(ADest^) := ByteMaskToFPColor(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToStdRGBA(const AByteMask: TByteMask;const AAlpha: single=1): TStdRGBA; +begin Result := BGRAPixelToStdRGBA(MaskToBGRA(AByteMask)); + Result.alpha := AAlpha end; + +procedure ConvertByteMaskArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := ByteMaskToStdRGBA(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToStdHSLA(const AByteMask: TByteMask;const AAlpha: single=1): TStdHSLA; +begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))); + Result.alpha := AAlpha end; + +procedure ConvertByteMaskArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := ByteMaskToStdHSLA(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToStdHSVA(const AByteMask: TByteMask;const AAlpha: single=1): TStdHSVA; +begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))); + Result.alpha := AAlpha end; + +procedure ConvertByteMaskArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := ByteMaskToStdHSVA(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ByteMaskToStdCMYK(const AByteMask: TByteMask): TStdCMYK; +begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))) end; + +procedure ConvertByteMaskArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := ByteMaskToStdCMYK(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertByteMaskArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := ByteMaskToExpandedPixel(TByteMask(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToColor(const AExpandedPixel: TExpandedPixel): TColor; +begin Result := BGRAToColor(GammaCompression(AExpandedPixel)) end; + +procedure ConvertExpandedPixelArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TColor(ADest^) := ExpandedPixelToColor(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TBGRAPixel(ADest^) := GammaCompression(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TFPColor(ADest^) := ExpandedToFPColor(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdRGBA(ADest^) := ExpandedPixelToStdRGBA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToAdobeRGBA(const AExpandedPixel: TExpandedPixel): TAdobeRGBA; +begin Result := XYZAToAdobeRGBA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel))) end; + +procedure ConvertExpandedPixelArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TAdobeRGBA(ADest^) := ExpandedPixelToAdobeRGBA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToStdHSLA(const AExpandedPixel: TExpandedPixel): TStdHSLA; +begin Result := StdRGBAToStdHSLA(ExpandedPixelToStdRGBA(AExpandedPixel)) end; + +procedure ConvertExpandedPixelArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSLA(ADest^) := ExpandedPixelToStdHSLA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToStdHSVA(const AExpandedPixel: TExpandedPixel): TStdHSVA; +begin Result := StdRGBAToStdHSVA(ExpandedPixelToStdRGBA(AExpandedPixel)) end; + +procedure ConvertExpandedPixelArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdHSVA(ADest^) := ExpandedPixelToStdHSVA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToStdCMYK(const AExpandedPixel: TExpandedPixel): TStdCMYK; +begin Result := StdRGBAToStdCMYK(ExpandedPixelToStdRGBA(AExpandedPixel)) end; + +procedure ConvertExpandedPixelArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TStdCMYK(ADest^) := ExpandedPixelToStdCMYK(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TByteMask(ADest^) := ExpandedPixelToByteMask(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLinearRGBA(ADest^) := ExpandedPixelToLinearRGBA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToHSLAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(THSLAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + THSLAPixel(ADest^) := ExpandedToHSLA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToGSBAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TGSBAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TGSBAPixel(ADest^) := ExpandedToGSBA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToXYZA(const AExpandedPixel: TExpandedPixel): TXYZA;overload; +begin Result := LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel)) end; + +function ExpandedPixelToXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel),AReferenceWhite) end; + +procedure ConvertExpandedPixelArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TXYZA(ADest^) := ExpandedPixelToXYZA(TExpandedPixel(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertExpandedPixelArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TWordXYZA(ADest^) := ExpandedPixelToWordXYZA(TExpandedPixel(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToLabA(const AExpandedPixel: TExpandedPixel): TLabA; +begin Result := XYZAToLabA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel))) end; + +procedure ConvertExpandedPixelArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLabA(ADest^) := ExpandedPixelToLabA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function ExpandedPixelToLChA(const AExpandedPixel: TExpandedPixel): TLChA; +begin Result := LabAToLChA(XYZAToLabA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel)))) end; + +procedure ConvertExpandedPixelArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLChA(ADest^) := ExpandedPixelToLChA(TExpandedPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LinearRGBAToAdobeRGBA(const ALinearRGBA: TLinearRGBA): TAdobeRGBA; +begin Result := XYZAToAdobeRGBA(LinearRGBAToXYZA(ALinearRGBA)) end; + +procedure ConvertLinearRGBAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TAdobeRGBA(ADest^) := LinearRGBAToAdobeRGBA(TLinearRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertLinearRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := LinearRGBAToExpandedPixel(TLinearRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertLinearRGBAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TXYZA(ADest^) := LinearRGBAToXYZA(TLinearRGBA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LinearRGBAToLabA(const ALinearRGBA: TLinearRGBA): TLabA; +begin Result := XYZAToLabA(LinearRGBAToXYZA(ALinearRGBA)) end; + +procedure ConvertLinearRGBAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLabA(ADest^) := LinearRGBAToLabA(TLinearRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LinearRGBAToLChA(const ALinearRGBA: TLinearRGBA): TLChA; +begin Result := LabAToLChA(XYZAToLabA(LinearRGBAToXYZA(ALinearRGBA))) end; + +procedure ConvertLinearRGBAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLChA(ADest^) := LinearRGBAToLChA(TLinearRGBA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertHSLAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(THSLAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := HSLAToExpanded(THSLAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertHSLAPixelArrayToGSBAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(THSLAPixel); ADestStride:integer=sizeOf(TGSBAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TGSBAPixel(ADest^) := HSLAToGSBA(THSLAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertGSBAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TGSBAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := GSBAToExpanded(TGSBAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertGSBAPixelArrayToHSLAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TGSBAPixel); ADestStride:integer=sizeOf(THSLAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + THSLAPixel(ADest^) := GSBAToHSLA(TGSBAPixel(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertXYZAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TAdobeRGBA(ADest^) := XYZAToAdobeRGBA(TXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function XYZAToExpandedPixel(const AXYZA: TXYZA): TExpandedPixel;overload; +begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AXYZA)) end; + +function XYZAToExpandedPixel(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; +begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AXYZA,AReferenceWhite)) end; + +procedure ConvertXYZAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TExpandedPixel(ADest^) := XYZAToExpandedPixel(TXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertXYZAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TLinearRGBA(ADest^) := XYZAToLinearRGBA(TXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertXYZAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TWordXYZA(ADest^) := XYZAToWordXYZA(TXYZA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertXYZAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TLabA(ADest^) := XYZAToLabA(TXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function XYZAToLChA(const AXYZA: TXYZA): TLChA;overload; +begin Result := LabAToLChA(XYZAToLabA(AXYZA)) end; + +function XYZAToLChA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; +begin Result := LabAToLChA(XYZAToLabA(AXYZA,AReferenceWhite)) end; + +procedure ConvertXYZAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TLChA(ADest^) := XYZAToLChA(TXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function WordXYZAToAdobeRGBA(const AWordXYZA: TWordXYZA): TAdobeRGBA;overload; +begin Result := XYZAToAdobeRGBA(WordXYZAToXYZA(AWordXYZA)) end; + +function WordXYZAToAdobeRGBA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; +begin Result := XYZAToAdobeRGBA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite) end; + +procedure ConvertWordXYZAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TAdobeRGBA(ADest^) := WordXYZAToAdobeRGBA(TWordXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertWordXYZAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TExpandedPixel(ADest^) := WordXYZAToExpandedPixel(TWordXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertWordXYZAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TXYZA(ADest^) := WordXYZAToXYZA(TWordXYZA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function WordXYZAToLabA(const AWordXYZA: TWordXYZA): TLabA;overload; +begin Result := XYZAToLabA(WordXYZAToXYZA(AWordXYZA)) end; + +function WordXYZAToLabA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; +begin Result := XYZAToLabA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite) end; + +procedure ConvertWordXYZAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TLabA(ADest^) := WordXYZAToLabA(TWordXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function WordXYZAToLChA(const AWordXYZA: TWordXYZA): TLChA;overload; +begin Result := LabAToLChA(XYZAToLabA(WordXYZAToXYZA(AWordXYZA))) end; + +function WordXYZAToLChA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; +begin Result := LabAToLChA(XYZAToLabA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite)) end; + +procedure ConvertWordXYZAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TLChA(ADest^) := WordXYZAToLChA(TWordXYZA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LabAToAdobeRGBA(const ALabA: TLabA): TAdobeRGBA; +begin Result := XYZAToAdobeRGBA(LabAToXYZA(ALabA)) end; + +procedure ConvertLabAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TAdobeRGBA(ADest^) := LabAToAdobeRGBA(TLabA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LabAToExpandedPixel(const ALabA: TLabA): TExpandedPixel; +begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(LabAToXYZA(ALabA))) end; + +procedure ConvertLabAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := LabAToExpandedPixel(TLabA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LabAToLinearRGBA(const ALabA: TLabA): TLinearRGBA; +begin Result := XYZAToLinearRGBA(LabAToXYZA(ALabA)) end; + +procedure ConvertLabAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLinearRGBA(ADest^) := LabAToLinearRGBA(TLabA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertLabAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TXYZA(ADest^) := LabAToXYZA(TLabA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LabAToWordXYZA(const ALabA: TLabA): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(LabAToXYZA(ALabA)) end; + +function LabAToWordXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(LabAToXYZA(ALabA,AReferenceWhite)) end; + +procedure ConvertLabAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TWordXYZA(ADest^) := LabAToWordXYZA(TLabA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertLabAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLChA(ADest^) := LabAToLChA(TLabA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LChAToAdobeRGBA(const ALChA: TLChA): TAdobeRGBA; +begin Result := XYZAToAdobeRGBA(LabAToXYZA(LChAToLabA(ALChA))) end; + +procedure ConvertLChAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TAdobeRGBA(ADest^) := LChAToAdobeRGBA(TLChA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LChAToExpandedPixel(const ALChA: TLChA): TExpandedPixel; +begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(LabAToXYZA(LChAToLabA(ALChA)))) end; + +procedure ConvertLChAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TExpandedPixel(ADest^) := LChAToExpandedPixel(TLChA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LChAToLinearRGBA(const ALChA: TLChA): TLinearRGBA; +begin Result := XYZAToLinearRGBA(LabAToXYZA(LChAToLabA(ALChA))) end; + +procedure ConvertLChAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLinearRGBA(ADest^) := LChAToLinearRGBA(TLChA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LChAToXYZA(const ALChA: TLChA): TXYZA;overload; +begin Result := LabAToXYZA(LChAToLabA(ALChA)) end; + +function LChAToXYZA(const ALChA: TLChA; const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := LabAToXYZA(LChAToLabA(ALChA),AReferenceWhite) end; + +procedure ConvertLChAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TXYZA(ADest^) := LChAToXYZA(TLChA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +function LChAToWordXYZA(const ALChA: TLChA): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(LabAToXYZA(LChAToLabA(ALChA))) end; + +function LChAToWordXYZA(const ALChA: TLChA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := XYZAToWordXYZA(LabAToXYZA(LChAToLabA(ALChA),AReferenceWhite)) end; + +procedure ConvertLChAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; + while ACount > 0 do begin + TWordXYZA(ADest^) := LChAToWordXYZA(TLChA(ASource^), AReferenceWhite^); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +procedure ConvertLChAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); +begin + while ACount > 0 do begin + TLabA(ADest^) := LChAToLabA(TLChA(ASource^)); + inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; +end; + +{ TStdRGBA } + +class function TStdRGBA.New(const ARed,AGreen,ABlue,AAlpha:single): TStdRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TStdRGBA.New(const ARed,AGreen,ABlue:single): TStdRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 1; +end; + +{ TAdobeRGBA } + +class function TAdobeRGBA.New(const ARed,AGreen,ABlue,AAlpha:byte): TAdobeRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TAdobeRGBA.New(const ARed,AGreen,ABlue:byte): TAdobeRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 255; +end; + +{ TStdHSLA } + +class function TStdHSLA.New(const AHue,ASaturation,ALightness,AAlpha:single): TStdHSLA;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ALightness; + Result.alpha := AAlpha; +end; + +class function TStdHSLA.New(const AHue,ASaturation,ALightness:single): TStdHSLA;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ALightness; + Result.alpha := 1; +end; + +{ TStdHSVA } + +class function TStdHSVA.New(const AHue,ASaturation,AValue,AAlpha:single): TStdHSVA;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.value := AValue; + Result.alpha := AAlpha; +end; + +class function TStdHSVA.New(const AHue,ASaturation,AValue:single): TStdHSVA;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.value := AValue; + Result.alpha := 1; +end; + +{ TStdCMYK } + +class function TStdCMYK.New(const ACyan,AMagenta,AYellow,ABlack:single): TStdCMYK; +begin + Result.C := ACyan; + Result.M := AMagenta; + Result.Y := AYellow; + Result.K := ABlack; +end; + +{ TByteMask } + +class function TByteMask.New(const AGray:byte): TByteMask; +begin + Result.gray := AGray; +end; + +{ TLinearRGBA } + +class function TLinearRGBA.New(const ARed,AGreen,ABlue,AAlpha:single): TLinearRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TLinearRGBA.New(const ARed,AGreen,ABlue:single): TLinearRGBA;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 1; +end; + +{ TXYZA } + +class function TXYZA.New(const AX,AY,AZ,AAlpha:single): TXYZA;overload; +begin + Result.X := AX; + Result.Y := AY; + Result.Z := AZ; + Result.alpha := AAlpha; +end; + +class function TXYZA.New(const AX,AY,AZ:single): TXYZA;overload; +begin + Result.X := AX; + Result.Y := AY; + Result.Z := AZ; + Result.alpha := 1; +end; + +{ TWordXYZA } + +class function TWordXYZA.New(const AX,AY,AZ,AAlpha:word): TWordXYZA;overload; +begin + Result.X := AX; + Result.Y := AY; + Result.Z := AZ; + Result.alpha := AAlpha; +end; + +class function TWordXYZA.New(const AX,AY,AZ:word): TWordXYZA;overload; +begin + Result.X := AX; + Result.Y := AY; + Result.Z := AZ; + Result.alpha := 65535; +end; + +{ TLabA } + +class function TLabA.New(const ALightness,Aa,Ab,AAlpha:single): TLabA;overload; +begin + Result.L := ALightness; + Result.a := Aa; + Result.b := Ab; + Result.alpha := AAlpha; +end; + +class function TLabA.New(const ALightness,Aa,Ab:single): TLabA;overload; +begin + Result.L := ALightness; + Result.a := Aa; + Result.b := Ab; + Result.alpha := 1; +end; + +{ TLChA } + +class function TLChA.New(const ALightness,AChroma,AHue,AAlpha:single): TLChA;overload; +begin + Result.L := ALightness; + Result.C := AChroma; + Result.h := AHue; + Result.alpha := AAlpha; +end; + +class function TLChA.New(const ALightness,AChroma,AHue:single): TLChA;overload; +begin + Result.L := ALightness; + Result.C := AChroma; + Result.h := AHue; + Result.alpha := 1; +end; + +{ TColorColorspace } + +class function TColorColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TColorColorspace.GetChannelCount: integer; +begin result := 3 end; + +class function TColorColorspace.IndexOfAlphaChannel: integer; +begin result := -1 end; + +class function TColorColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin result := ctFullyOpaque end; + +class function TColorColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 255; + 1: result := 255; + 2: result := 255; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TColorColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TColorColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 8 end; + +class function TColorColorspace.GetName: string; +begin result := 'Color' end; + +class function TColorColorspace.GetSize: integer; +begin result := sizeof(TColor) end; + +class function TColorColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TColor(AColor^).red; + 1: result := TColor(AColor^).green; + 2: result := TColor(AColor^).blue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TColorColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TColor(AColor^).red := Round(Clamp(AValue,0,255)); + 1: TColor(AColor^).green := Round(Clamp(AValue,0,255)); + 2: TColor(AColor^).blue := Round(Clamp(AValue,0,255)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TColorColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TBGRAPixelColorspace } + +class function TBGRAPixelColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TBGRAPixelColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TBGRAPixelColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TBGRAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TBGRAPixel(AColor^).alpha >= 255 then exit(ctFullyOpaque) else + if TBGRAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TBGRAPixelColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 255; + 1: result := 255; + 2: result := 255; + 3: result := 255; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TBGRAPixelColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TBGRAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 8 end; + +class function TBGRAPixelColorspace.GetName: string; +begin result := 'BGRAPixel' end; + +class function TBGRAPixelColorspace.GetSize: integer; +begin result := sizeof(TBGRAPixel) end; + +class function TBGRAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TBGRAPixel(AColor^).red; + 1: result := TBGRAPixel(AColor^).green; + 2: result := TBGRAPixel(AColor^).blue; + 3: result := TBGRAPixel(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TBGRAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TBGRAPixel(AColor^).red := Round(Clamp(AValue,0,255)); + 1: TBGRAPixel(AColor^).green := Round(Clamp(AValue,0,255)); + 2: TBGRAPixel(AColor^).blue := Round(Clamp(AValue,0,255)); + 3: TBGRAPixel(AColor^).alpha := Round(Clamp(AValue,0,255)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TBGRAPixelColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TFPColorColorspace } + +class function TFPColorColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TFPColorColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TFPColorColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TFPColorColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TFPColor(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else + if TFPColor(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TFPColorColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 65535; + 1: result := 65535; + 2: result := 65535; + 3: result := 65535; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TFPColorColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TFPColorColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 16 end; + +class function TFPColorColorspace.GetName: string; +begin result := 'FPColor' end; + +class function TFPColorColorspace.GetSize: integer; +begin result := sizeof(TFPColor) end; + +class function TFPColorColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TFPColor(AColor^).red; + 1: result := TFPColor(AColor^).green; + 2: result := TFPColor(AColor^).blue; + 3: result := TFPColor(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TFPColorColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TFPColor(AColor^).red := Round(Clamp(AValue,0,65535)); + 1: TFPColor(AColor^).green := Round(Clamp(AValue,0,65535)); + 2: TFPColor(AColor^).blue := Round(Clamp(AValue,0,65535)); + 3: TFPColor(AColor^).alpha := Round(Clamp(AValue,0,65535)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TFPColorColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TStdRGBAColorspace } + +class function TStdRGBAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdRGBAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TStdRGBAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TStdRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TStdRGBA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TStdRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TStdRGBAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 1; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdRGBAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TStdRGBAColorspace.GetName: string; +begin result := 'StdRGBA' end; + +class function TStdRGBAColorspace.GetSize: integer; +begin result := sizeof(TStdRGBA) end; + +class function TStdRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TStdRGBA(AColor^).red; + 1: result := TStdRGBA(AColor^).green; + 2: result := TStdRGBA(AColor^).blue; + 3: result := TStdRGBA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TStdRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TStdRGBA(AColor^).red := AValue; + 1: TStdRGBA(AColor^).green := AValue; + 2: TStdRGBA(AColor^).blue := AValue; + 3: TStdRGBA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdRGBAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TAdobeRGBAColorspace } + +class function TAdobeRGBAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TAdobeRGBAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TAdobeRGBAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TAdobeRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TAdobeRGBA(AColor^).alpha >= 255 then exit(ctFullyOpaque) else + if TAdobeRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TAdobeRGBAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 255; + 1: result := 255; + 2: result := 255; + 3: result := 255; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TAdobeRGBAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TAdobeRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 8 end; + +class function TAdobeRGBAColorspace.GetName: string; +begin result := 'AdobeRGBA' end; + +class function TAdobeRGBAColorspace.GetSize: integer; +begin result := sizeof(TAdobeRGBA) end; + +class function TAdobeRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TAdobeRGBA(AColor^).red; + 1: result := TAdobeRGBA(AColor^).green; + 2: result := TAdobeRGBA(AColor^).blue; + 3: result := TAdobeRGBA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TAdobeRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TAdobeRGBA(AColor^).red := Round(Clamp(AValue,0,255)); + 1: TAdobeRGBA(AColor^).green := Round(Clamp(AValue,0,255)); + 2: TAdobeRGBA(AColor^).blue := Round(Clamp(AValue,0,255)); + 3: TAdobeRGBA(AColor^).alpha := Round(Clamp(AValue,0,255)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TAdobeRGBAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TStdHSLAColorspace } + +class function TStdHSLAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Hue'; + 1: result := 'Saturation'; + 2: result := 'Lightness'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSLAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TStdHSLAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TStdHSLAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TStdHSLA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TStdHSLA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TStdHSLAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 360; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSLAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSLAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TStdHSLAColorspace.GetName: string; +begin result := 'StdHSLA' end; + +class function TStdHSLAColorspace.GetSize: integer; +begin result := sizeof(TStdHSLA) end; + +class function TStdHSLAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TStdHSLA(AColor^).hue; + 1: result := TStdHSLA(AColor^).saturation; + 2: result := TStdHSLA(AColor^).lightness; + 3: result := TStdHSLA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TStdHSLAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TStdHSLA(AColor^).hue := AValue; + 1: TStdHSLA(AColor^).saturation := AValue; + 2: TStdHSLA(AColor^).lightness := AValue; + 3: TStdHSLA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSLAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TStdHSVAColorspace } + +class function TStdHSVAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Hue'; + 1: result := 'Saturation'; + 2: result := 'Value'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSVAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TStdHSVAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TStdHSVAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TStdHSVA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TStdHSVA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TStdHSVAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 360; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSVAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSVAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TStdHSVAColorspace.GetName: string; +begin result := 'StdHSVA' end; + +class function TStdHSVAColorspace.GetSize: integer; +begin result := sizeof(TStdHSVA) end; + +class function TStdHSVAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TStdHSVA(AColor^).hue; + 1: result := TStdHSVA(AColor^).saturation; + 2: result := TStdHSVA(AColor^).value; + 3: result := TStdHSVA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TStdHSVAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TStdHSVA(AColor^).hue := AValue; + 1: TStdHSVA(AColor^).saturation := AValue; + 2: TStdHSVA(AColor^).value := AValue; + 3: TStdHSVA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdHSVAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TStdCMYKColorspace } + +class function TStdCMYKColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Cyan'; + 1: result := 'Magenta'; + 2: result := 'Yellow'; + 3: result := 'Black'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdCMYKColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TStdCMYKColorspace.IndexOfAlphaChannel: integer; +begin result := -1 end; + +class function TStdCMYKColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin result := ctFullyOpaque end; + +class function TStdCMYKColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 1; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdCMYKColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdCMYKColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TStdCMYKColorspace.GetName: string; +begin result := 'StdCMYK' end; + +class function TStdCMYKColorspace.GetSize: integer; +begin result := sizeof(TStdCMYK) end; + +class function TStdCMYKColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TStdCMYK(AColor^).C; + 1: result := TStdCMYK(AColor^).M; + 2: result := TStdCMYK(AColor^).Y; + 3: result := TStdCMYK(AColor^).K; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TStdCMYKColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TStdCMYK(AColor^).C := AValue; + 1: TStdCMYK(AColor^).M := AValue; + 2: TStdCMYK(AColor^).Y := AValue; + 3: TStdCMYK(AColor^).K := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TStdCMYKColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TByteMaskColorspace } + +class function TByteMaskColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Gray'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TByteMaskColorspace.GetChannelCount: integer; +begin result := 1 end; + +class function TByteMaskColorspace.IndexOfAlphaChannel: integer; +begin result := -1 end; + +class function TByteMaskColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin result := ctFullyOpaque end; + +class function TByteMaskColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 255; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TByteMaskColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TByteMaskColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 8 end; + +class function TByteMaskColorspace.GetName: string; +begin result := 'ByteMask' end; + +class function TByteMaskColorspace.GetSize: integer; +begin result := sizeof(TByteMask) end; + +class function TByteMaskColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TByteMask(AColor^).gray; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TByteMaskColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TByteMask(AColor^).gray := Round(Clamp(AValue,0,255)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TByteMaskColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TExpandedPixelColorspace } + +class function TExpandedPixelColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TExpandedPixelColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TExpandedPixelColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TExpandedPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TExpandedPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else + if TExpandedPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TExpandedPixelColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 65535; + 1: result := 65535; + 2: result := 65535; + 3: result := 65535; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TExpandedPixelColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TExpandedPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 16 end; + +class function TExpandedPixelColorspace.GetName: string; +begin result := 'ExpandedPixel' end; + +class function TExpandedPixelColorspace.GetSize: integer; +begin result := sizeof(TExpandedPixel) end; + +class function TExpandedPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TExpandedPixel(AColor^).red; + 1: result := TExpandedPixel(AColor^).green; + 2: result := TExpandedPixel(AColor^).blue; + 3: result := TExpandedPixel(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TExpandedPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TExpandedPixel(AColor^).red := Round(Clamp(AValue,0,65535)); + 1: TExpandedPixel(AColor^).green := Round(Clamp(AValue,0,65535)); + 2: TExpandedPixel(AColor^).blue := Round(Clamp(AValue,0,65535)); + 3: TExpandedPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TExpandedPixelColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TLinearRGBAColorspace } + +class function TLinearRGBAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Red'; + 1: result := 'Green'; + 2: result := 'Blue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLinearRGBAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TLinearRGBAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TLinearRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TLinearRGBA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TLinearRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TLinearRGBAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 1; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLinearRGBAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLinearRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TLinearRGBAColorspace.GetName: string; +begin result := 'LinearRGBA' end; + +class function TLinearRGBAColorspace.GetSize: integer; +begin result := sizeof(TLinearRGBA) end; + +class function TLinearRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TLinearRGBA(AColor^).red; + 1: result := TLinearRGBA(AColor^).green; + 2: result := TLinearRGBA(AColor^).blue; + 3: result := TLinearRGBA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TLinearRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TLinearRGBA(AColor^).red := AValue; + 1: TLinearRGBA(AColor^).green := AValue; + 2: TLinearRGBA(AColor^).blue := AValue; + 3: TLinearRGBA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLinearRGBAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ THSLAPixelColorspace } + +class function THSLAPixelColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Hue'; + 1: result := 'Saturation'; + 2: result := 'Lightness'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function THSLAPixelColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function THSLAPixelColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function THSLAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if THSLAPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else + if THSLAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function THSLAPixelColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 65535; + 1: result := 65535; + 2: result := 65535; + 3: result := 65535; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function THSLAPixelColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function THSLAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 16 end; + +class function THSLAPixelColorspace.GetName: string; +begin result := 'HSLAPixel' end; + +class function THSLAPixelColorspace.GetSize: integer; +begin result := sizeof(THSLAPixel) end; + +class function THSLAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := THSLAPixel(AColor^).hue; + 1: result := THSLAPixel(AColor^).saturation; + 2: result := THSLAPixel(AColor^).lightness; + 3: result := THSLAPixel(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure THSLAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: THSLAPixel(AColor^).hue := Round(Clamp(AValue,0,65535)); + 1: THSLAPixel(AColor^).saturation := Round(Clamp(AValue,0,65535)); + 2: THSLAPixel(AColor^).lightness := Round(Clamp(AValue,0,65535)); + 3: THSLAPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function THSLAPixelColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TGSBAPixelColorspace } + +class function TGSBAPixelColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Hue'; + 1: result := 'Saturation'; + 2: result := 'Brightness'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TGSBAPixelColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TGSBAPixelColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TGSBAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TGSBAPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else + if TGSBAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TGSBAPixelColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 65535; + 1: result := 65535; + 2: result := 65535; + 3: result := 65535; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TGSBAPixelColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TGSBAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 16 end; + +class function TGSBAPixelColorspace.GetName: string; +begin result := 'GSBAPixel' end; + +class function TGSBAPixelColorspace.GetSize: integer; +begin result := sizeof(TGSBAPixel) end; + +class function TGSBAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TGSBAPixel(AColor^).hue; + 1: result := TGSBAPixel(AColor^).saturation; + 2: result := TGSBAPixel(AColor^).lightness; + 3: result := TGSBAPixel(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TGSBAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TGSBAPixel(AColor^).hue := Round(Clamp(AValue,0,65535)); + 1: TGSBAPixel(AColor^).saturation := Round(Clamp(AValue,0,65535)); + 2: TGSBAPixel(AColor^).lightness := Round(Clamp(AValue,0,65535)); + 3: TGSBAPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TGSBAPixelColorspace.GetFlags: TColorspaceFlags; +begin result := [cfFixedReferenceWhite] end; + + +{ TXYZAColorspace } + +class function TXYZAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'X'; + 1: result := 'Y'; + 2: result := 'Z'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TXYZAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TXYZAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TXYZAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TXYZA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TXYZA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TXYZAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 1; + 1: result := 1; + 2: result := 1; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TXYZAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TXYZAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TXYZAColorspace.GetName: string; +begin result := 'XYZA' end; + +class function TXYZAColorspace.GetSize: integer; +begin result := sizeof(TXYZA) end; + +class function TXYZAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TXYZA(AColor^).X; + 1: result := TXYZA(AColor^).Y; + 2: result := TXYZA(AColor^).Z; + 3: result := TXYZA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TXYZAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TXYZA(AColor^).X := AValue; + 1: TXYZA(AColor^).Y := AValue; + 2: TXYZA(AColor^).Z := AValue; + 3: TXYZA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TXYZAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfMovableReferenceWhite,cfHasImaginaryColors] end; + + +{ TWordXYZAColorspace } + +class function TWordXYZAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'X'; + 1: result := 'Y'; + 2: result := 'Z'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TWordXYZAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TWordXYZAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TWordXYZAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TWordXYZA(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else + if TWordXYZA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TWordXYZAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 50000; + 1: result := 50000; + 2: result := 50000; + 3: result := 65535; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TWordXYZAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TWordXYZAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 16 end; + +class function TWordXYZAColorspace.GetName: string; +begin result := 'WordXYZA' end; + +class function TWordXYZAColorspace.GetSize: integer; +begin result := sizeof(TWordXYZA) end; + +class function TWordXYZAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TWordXYZA(AColor^).X; + 1: result := TWordXYZA(AColor^).Y; + 2: result := TWordXYZA(AColor^).Z; + 3: result := TWordXYZA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TWordXYZAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TWordXYZA(AColor^).X := Round(Clamp(AValue,0,50000)); + 1: TWordXYZA(AColor^).Y := Round(Clamp(AValue,0,50000)); + 2: TWordXYZA(AColor^).Z := Round(Clamp(AValue,0,50000)); + 3: TWordXYZA(AColor^).alpha := Round(Clamp(AValue,0,65535)); + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TWordXYZAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfMovableReferenceWhite,cfHasImaginaryColors] end; + + +{ TLabAColorspace } + +class function TLabAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Lightness'; + 1: result := 'a'; + 2: result := 'b'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLabAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TLabAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TLabAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TLabA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TLabA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TLabAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 100; + 1: result := 142; + 2: result := 147; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLabAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := -166; + 2: result := -132; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLabAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TLabAColorspace.GetName: string; +begin result := 'LabA' end; + +class function TLabAColorspace.GetSize: integer; +begin result := sizeof(TLabA) end; + +class function TLabAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TLabA(AColor^).L; + 1: result := TLabA(AColor^).a; + 2: result := TLabA(AColor^).b; + 3: result := TLabA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TLabAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TLabA(AColor^).L := AValue; + 1: TLabA(AColor^).a := AValue; + 2: TLabA(AColor^).b := AValue; + 3: TLabA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLabAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfReferenceWhiteIndependent,cfHasImaginaryColors] end; + + +{ TLChAColorspace } + +class function TLChAColorspace.GetChannelName(AIndex: integer): string; +begin + case AIndex of + 0: result := 'Lightness'; + 1: result := 'Chroma'; + 2: result := 'Hue'; + 3: result := 'Alpha'; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLChAColorspace.GetChannelCount: integer; +begin result := 4 end; + +class function TLChAColorspace.IndexOfAlphaChannel: integer; +begin result := 3 end; + +class function TLChAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; +begin + if TLChA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else + if TLChA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else + exit(ctSemiTransparent) +end; + +class function TLChAColorspace.GetMaxValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 100; + 1: result := 192; + 2: result := 360; + 3: result := 1; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLChAColorspace.GetMinValue(AIndex: integer): single; +begin + case AIndex of + 0: result := 0; + 1: result := 0; + 2: result := 0; + 3: result := 0; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLChAColorspace.GetChannelBitDepth(AIndex: integer): byte; +begin result := 28 end; + +class function TLChAColorspace.GetName: string; +begin result := 'LChA' end; + +class function TLChAColorspace.GetSize: integer; +begin result := sizeof(TLChA) end; + +class function TLChAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; +begin + case AIndex of + 0: result := TLChA(AColor^).L; + 1: result := TLChA(AColor^).C; + 2: result := TLChA(AColor^).h; + 3: result := TLChA(AColor^).alpha; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class procedure TLChAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); +begin + case AIndex of + 0: TLChA(AColor^).L := AValue; + 1: TLChA(AColor^).C := AValue; + 2: TLChA(AColor^).h := AValue; + 3: TLChA(AColor^).alpha := AValue; + else raise ERangeError.Create('Index out of bounds'); + end; +end; + +class function TLChAColorspace.GetFlags: TColorspaceFlags; +begin result := [cfReferenceWhiteIndependent,cfHasImaginaryColors] end; + + +{ TColorHelper } + +class function TColorHelper.New(const ARed,AGreen,ABlue:byte): TColor; +begin Result := BGRAGraphics.RGBToColor(ARed,AGreen,ABlue) end; + +class function TColorHelper.Colorspace: TColorspaceAny; static; +begin result := TColorColorspace end; + +function TColorHelper.GetRed: byte; +begin result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}(self shr 16) and $ff{$ELSE}self and $ff{$ENDIF} end; + +function TColorHelper.GetGreen: byte; +begin result := (self shr 8) and $ff end; + +function TColorHelper.GetBlue: byte; +begin result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}self and $ff{$ELSE}(self shr 16) and $ff{$ENDIF} end; + +procedure TColorHelper.SetRed(AValue: byte); +begin self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $00ffff) or (AValue shl 16){$ELSE}LongWord(self and $ffff00) or AValue{$ENDIF} end; + +procedure TColorHelper.SetGreen(AValue: byte); +begin self := LongWord(self and $ff00ff) or (AValue shl 8) end; + +procedure TColorHelper.SetBlue(AValue: byte); +begin self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $ffff00) or AValue{$ELSE}LongWord(self and $00ffff) or (AValue shl 16){$ENDIF} end; + +function TColorHelper.ToBGRAPixel: TBGRAPixel;overload; +begin Result := ColorToBGRA(Self) end; + +function TColorHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; +begin result := ColorToBGRA(Self, AAlpha) end; + +function TColorHelper.ToFPColor: TFPColor;overload; +begin Result := ColorToFPColor(Self) end; + +function TColorHelper.ToFPColor(AAlpha: word): TFPColor;overload; +begin result := ColorToFPColor(Self, AAlpha) end; + +function TColorHelper.ToStdRGBA: TStdRGBA;overload; +begin Result := ColorToStdRGBA(Self) end; + +function TColorHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; +begin result := ColorToStdRGBA(Self, AAlpha) end; + +function TColorHelper.ToAdobeRGBA: TAdobeRGBA;overload; +begin Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; +begin + Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToStdHSLA: TStdHSLA;overload; +begin Result := ColorToStdHSLA(Self) end; + +function TColorHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; +begin result := ColorToStdHSLA(Self, AAlpha) end; + +function TColorHelper.ToStdHSVA: TStdHSVA;overload; +begin Result := ColorToStdHSVA(Self) end; + +function TColorHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; +begin result := ColorToStdHSVA(Self, AAlpha) end; + +function TColorHelper.ToStdCMYK: TStdCMYK; +begin Result := ColorToStdCMYK(Self) end; + +function TColorHelper.ToByteMask: TByteMask; +begin Result := ColorToByteMask(Self) end; + +function TColorHelper.ToExpandedPixel: TExpandedPixel;overload; +begin Result := ColorToExpandedPixel(Self) end; + +function TColorHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; +begin result := ColorToExpandedPixel(Self, AAlpha) end; + +function TColorHelper.ToLinearRGBA: TLinearRGBA;overload; +begin Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; +begin + Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToHSLAPixel: THSLAPixel;overload; +begin Result := ExpandedToHSLA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; +begin + Result := ExpandedToHSLA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToGSBAPixel: TGSBAPixel;overload; +begin Result := ExpandedToGSBA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; +begin + Result := ExpandedToGSBA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToXYZA(AAlpha: single): TXYZA;overload; +begin + Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self),AReferenceWhite) end; + +function TColorHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; +begin + Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self),AReferenceWhite) end; + +function TColorHelper.ToLabA: TLabA;overload; +begin Result := ExpandedPixelToLabA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToLabA(AAlpha: single): TLabA;overload; +begin + Result := ExpandedPixelToLabA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TColorHelper.ToLChA: TLChA;overload; +begin Result := ExpandedPixelToLChA(ColorToExpandedPixel(Self)) end; + +function TColorHelper.ToLChA(AAlpha: single): TLChA;overload; +begin + Result := ExpandedPixelToLChA(ColorToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +procedure TColorHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAToColor(AValue) end; + +procedure TColorHelper.FromFPColor(AValue: TFPColor); +begin Self := FPColorToColor(AValue) end; + +procedure TColorHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToColor(AValue) end; + +procedure TColorHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TColorHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToColor(AValue) end; + +procedure TColorHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToColor(AValue) end; + +procedure TColorHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToColor(AValue) end; + +procedure TColorHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToColor(AValue) end; + +procedure TColorHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToColor(AValue) end; + +procedure TColorHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToColor(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TColorHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToColor(HSLAToExpanded(AValue)) end; + +procedure TColorHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToColor(GSBAToExpanded(AValue)) end; + +procedure TColorHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToColor(XYZAToExpandedPixel(AValue)) end; + +procedure TColorHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToColor(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TColorHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue)) end; + +procedure TColorHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TColorHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToColor(LabAToExpandedPixel(AValue)) end; + +procedure TColorHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToColor(LChAToExpandedPixel(AValue)) end; + +{ TBGRAPixelHelper } + +class function TBGRAPixelHelper.New(const ARed,AGreen,ABlue,AAlpha:byte): TBGRAPixel;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TBGRAPixelHelper.New(const ARed,AGreen,ABlue:byte): TBGRAPixel;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 255; +end; + +class function TBGRAPixelHelper.Colorspace: TColorspaceAny; static; +begin result := TBGRAPixelColorspace end; + +function TBGRAPixelHelper.ToStdRGBA: TStdRGBA; +begin Result := BGRAPixelToStdRGBA(Self) end; + +function TBGRAPixelHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(GammaExpansion(Self)) end; + +function TBGRAPixelHelper.ToStdHSLA: TStdHSLA; +begin Result := BGRAPixelToStdHSLA(Self) end; + +function TBGRAPixelHelper.ToStdHSVA: TStdHSVA; +begin Result := BGRAPixelToStdHSVA(Self) end; + +function TBGRAPixelHelper.ToStdCMYK: TStdCMYK; +begin Result := BGRAPixelToStdCMYK(Self) end; + +function TBGRAPixelHelper.ToByteMask: TByteMask; +begin Result := BGRAToMask(Self) end; + +function TBGRAPixelHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(GammaExpansion(Self)) end; + +function TBGRAPixelHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(GammaExpansion(Self)) end; + +function TBGRAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(GammaExpansion(Self),AReferenceWhite) end; + +function TBGRAPixelHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(GammaExpansion(Self)) end; + +function TBGRAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(GammaExpansion(Self),AReferenceWhite) end; + +function TBGRAPixelHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(GammaExpansion(Self)) end; + +function TBGRAPixelHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(GammaExpansion(Self)) end; + +procedure TBGRAPixelHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToBGRAPixel(AValue) end; + +procedure TBGRAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := GammaCompression(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TBGRAPixelHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToBGRAPixel(AValue) end; + +procedure TBGRAPixelHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToBGRAPixel(AValue) end; + +procedure TBGRAPixelHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToBGRAPixel(AValue) end; + +procedure TBGRAPixelHelper.FromByteMask(AValue: TByteMask); +begin Self := MaskToBGRA(AValue) end; + +procedure TBGRAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := GammaCompression(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TBGRAPixelHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := GammaCompression(XYZAToExpandedPixel(AValue)) end; + +procedure TBGRAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := GammaCompression(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TBGRAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := GammaCompression(WordXYZAToExpandedPixel(AValue)) end; + +procedure TBGRAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := GammaCompression(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TBGRAPixelHelper.FromLabA(AValue: TLabA); +begin Self := GammaCompression(LabAToExpandedPixel(AValue)) end; + +procedure TBGRAPixelHelper.FromLChA(AValue: TLChA); +begin Self := GammaCompression(LChAToExpandedPixel(AValue)) end; + +{ TFPColorHelper } + +class function TFPColorHelper.New(const ARed,AGreen,ABlue,AAlpha:word): TFPColor;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TFPColorHelper.New(const ARed,AGreen,ABlue:word): TFPColor;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 65535; +end; + +class function TFPColorHelper.Colorspace: TColorspaceAny; static; +begin result := TFPColorColorspace end; + +function TFPColorHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToByteMask: TByteMask; +begin Result := FPColorToByteMask(Self) end; + +function TFPColorHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(FPColorToExpanded(Self),AReferenceWhite) end; + +function TFPColorHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(Self),AReferenceWhite) end; + +function TFPColorHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(FPColorToExpanded(Self)) end; + +function TFPColorHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(FPColorToExpanded(Self)) end; + +procedure TFPColorHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedToFPColor(StdRGBAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedToFPColor(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedToFPColor(StdHSLAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedToFPColor(StdHSVAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedToFPColor(StdCMYKToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToFPColor(AValue) end; + +procedure TFPColorHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedToFPColor(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedToFPColor(XYZAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToFPColor(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TFPColorHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TFPColorHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedToFPColor(LabAToExpandedPixel(AValue)) end; + +procedure TFPColorHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedToFPColor(LChAToExpandedPixel(AValue)) end; + +{ TStdRGBAHelper } + +class function TStdRGBAHelper.Colorspace: TColorspaceAny; static; +begin result := TStdRGBAColorspace end; + +function TStdRGBAHelper.ToColor: TColor; +begin Result := StdRGBAToColor(Self) end; + +function TStdRGBAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := StdRGBAToBGRAPixel(Self) end; + +function TStdRGBAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToStdHSLA: TStdHSLA; +begin Result := StdRGBAToStdHSLA(Self) end; + +function TStdRGBAHelper.ToStdHSVA: TStdHSVA; +begin Result := StdRGBAToStdHSVA(Self) end; + +function TStdRGBAHelper.ToStdCMYK: TStdCMYK; +begin Result := StdRGBAToStdCMYK(Self) end; + +function TStdRGBAHelper.ToByteMask: TByteMask; +begin Result := StdRGBAToByteMask(Self) end; + +function TStdRGBAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := StdRGBAToExpandedPixel(Self) end; + +function TStdRGBAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdRGBAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdRGBAHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(StdRGBAToExpandedPixel(Self)) end; + +function TStdRGBAHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(StdRGBAToExpandedPixel(Self)) end; + +procedure TStdRGBAHelper.FromColor(AValue: TColor); +begin Self := ColorToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAPixelToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToStdRGBA(FPColorToExpanded(AValue)) end; + +procedure TStdRGBAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TStdRGBAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToStdRGBA(AValue) end; + +procedure TStdRGBAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TStdRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToStdRGBA(HSLAToExpanded(AValue)) end; + +procedure TStdRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToStdRGBA(GSBAToExpanded(AValue)) end; + +procedure TStdRGBAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue)) end; + +procedure TStdRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue)) end; + +procedure TStdRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdRGBAHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToStdRGBA(LabAToExpandedPixel(AValue)) end; + +procedure TStdRGBAHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToStdRGBA(LChAToExpandedPixel(AValue)) end; + +{ TAdobeRGBAHelper } + +class function TAdobeRGBAHelper.Colorspace: TColorspaceAny; static; +begin result := TAdobeRGBAColorspace end; + +function TAdobeRGBAHelper.ToColor: TColor; +begin Result := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := GammaCompression(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := AdobeRGBAToExpandedPixel(Self) end; + +function TAdobeRGBAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := AdobeRGBAToLinearRGBA(Self) end; + +function TAdobeRGBAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(AdobeRGBAToExpandedPixel(Self)) end; + +function TAdobeRGBAHelper.ToXYZA: TXYZA;overload; +begin Result := AdobeRGBAToXYZA(Self) end; + +function TAdobeRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := AdobeRGBAToXYZA(Self,AReferenceWhite) end; + +function TAdobeRGBAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := AdobeRGBAToWordXYZA(Self) end; + +function TAdobeRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := AdobeRGBAToWordXYZA(Self,AReferenceWhite) end; + +function TAdobeRGBAHelper.ToLabA: TLabA; +begin Result := AdobeRGBAToLabA(Self) end; + +function TAdobeRGBAHelper.ToLChA: TLChA; +begin Result := AdobeRGBAToLChA(Self) end; + +procedure TAdobeRGBAHelper.FromColor(AValue: TColor); +begin Self := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := ExpandedPixelToAdobeRGBA(GammaExpansion(AValue)) end; + +procedure TAdobeRGBAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToAdobeRGBA(FPColorToExpanded(AValue)) end; + +procedure TAdobeRGBAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TAdobeRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToAdobeRGBA(AValue) end; + +procedure TAdobeRGBAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := LinearRGBAToAdobeRGBA(AValue) end; + +procedure TAdobeRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToAdobeRGBA(HSLAToExpanded(AValue)) end; + +procedure TAdobeRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToAdobeRGBA(GSBAToExpanded(AValue)) end; + +procedure TAdobeRGBAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := XYZAToAdobeRGBA(AValue) end; + +procedure TAdobeRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := XYZAToAdobeRGBA(AValue,AReferenceWhite) end; + +procedure TAdobeRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := WordXYZAToAdobeRGBA(AValue) end; + +procedure TAdobeRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := WordXYZAToAdobeRGBA(AValue,AReferenceWhite) end; + +procedure TAdobeRGBAHelper.FromLabA(AValue: TLabA); +begin Self := LabAToAdobeRGBA(AValue) end; + +procedure TAdobeRGBAHelper.FromLChA(AValue: TLChA); +begin Self := LChAToAdobeRGBA(AValue) end; + +{ TStdHSLAHelper } + +class function TStdHSLAHelper.Colorspace: TColorspaceAny; static; +begin result := TStdHSLAColorspace end; + +function TStdHSLAHelper.ToColor: TColor; +begin Result := StdHSLAToColor(Self) end; + +function TStdHSLAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := StdHSLAToBGRAPixel(Self) end; + +function TStdHSLAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToStdRGBA: TStdRGBA; +begin Result := StdHSLAToStdRGBA(Self) end; + +function TStdHSLAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToStdHSVA: TStdHSVA; +begin Result := StdHSLAToStdHSVA(Self) end; + +function TStdHSLAHelper.ToStdCMYK: TStdCMYK; +begin Result := StdHSLAToStdCMYK(Self) end; + +function TStdHSLAHelper.ToByteMask: TByteMask; +begin Result := StdHSLAToByteMask(Self) end; + +function TStdHSLAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := StdHSLAToExpandedPixel(Self) end; + +function TStdHSLAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdHSLAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdHSLAHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(StdHSLAToExpandedPixel(Self)) end; + +function TStdHSLAHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(StdHSLAToExpandedPixel(Self)) end; + +procedure TStdHSLAHelper.FromColor(AValue: TColor); +begin Self := ColorToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAPixelToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToStdHSLA(FPColorToExpanded(AValue)) end; + +procedure TStdHSLAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TStdHSLAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToStdHSLA(AValue) end; + +procedure TStdHSLAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TStdHSLAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToStdHSLA(HSLAToExpanded(AValue)) end; + +procedure TStdHSLAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToStdHSLA(GSBAToExpanded(AValue)) end; + +procedure TStdHSLAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue)) end; + +procedure TStdHSLAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdHSLAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue)) end; + +procedure TStdHSLAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdHSLAHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToStdHSLA(LabAToExpandedPixel(AValue)) end; + +procedure TStdHSLAHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToStdHSLA(LChAToExpandedPixel(AValue)) end; + +{ TStdHSVAHelper } + +class function TStdHSVAHelper.Colorspace: TColorspaceAny; static; +begin result := TStdHSVAColorspace end; + +function TStdHSVAHelper.ToColor: TColor; +begin Result := StdHSVAToColor(Self) end; + +function TStdHSVAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := StdHSVAToBGRAPixel(Self) end; + +function TStdHSVAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToStdRGBA: TStdRGBA; +begin Result := StdHSVAToStdRGBA(Self) end; + +function TStdHSVAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToStdHSLA: TStdHSLA; +begin Result := StdHSVAToStdHSLA(Self) end; + +function TStdHSVAHelper.ToStdCMYK: TStdCMYK; +begin Result := StdHSVAToStdCMYK(Self) end; + +function TStdHSVAHelper.ToByteMask: TByteMask; +begin Result := StdHSVAToByteMask(Self) end; + +function TStdHSVAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := StdHSVAToExpandedPixel(Self) end; + +function TStdHSVAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdHSVAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(Self),AReferenceWhite) end; + +function TStdHSVAHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(StdHSVAToExpandedPixel(Self)) end; + +function TStdHSVAHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(StdHSVAToExpandedPixel(Self)) end; + +procedure TStdHSVAHelper.FromColor(AValue: TColor); +begin Self := ColorToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAPixelToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToStdHSVA(FPColorToExpanded(AValue)) end; + +procedure TStdHSVAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TStdHSVAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToStdHSVA(AValue) end; + +procedure TStdHSVAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TStdHSVAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToStdHSVA(HSLAToExpanded(AValue)) end; + +procedure TStdHSVAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToStdHSVA(GSBAToExpanded(AValue)) end; + +procedure TStdHSVAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue)) end; + +procedure TStdHSVAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdHSVAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue)) end; + +procedure TStdHSVAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdHSVAHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToStdHSVA(LabAToExpandedPixel(AValue)) end; + +procedure TStdHSVAHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToStdHSVA(LChAToExpandedPixel(AValue)) end; + +{ TStdCMYKHelper } + +class function TStdCMYKHelper.Colorspace: TColorspaceAny; static; +begin result := TStdCMYKColorspace end; + +function TStdCMYKHelper.ToColor: TColor; +begin Result := StdCMYKToColor(Self) end; + +function TStdCMYKHelper.ToBGRAPixel: TBGRAPixel;overload; +begin Result := StdCMYKToBGRAPixel(Self) end; + +function TStdCMYKHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; +begin result := StdCMYKToBGRAPixel(Self, AAlpha) end; + +function TStdCMYKHelper.ToFPColor: TFPColor;overload; +begin Result := ExpandedToFPColor(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToFPColor(AAlpha: word): TFPColor;overload; +begin + Result := ExpandedToFPColor(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToStdRGBA: TStdRGBA;overload; +begin Result := StdCMYKToStdRGBA(Self) end; + +function TStdCMYKHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; +begin result := StdCMYKToStdRGBA(Self, AAlpha) end; + +function TStdCMYKHelper.ToAdobeRGBA: TAdobeRGBA;overload; +begin Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; +begin + Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToStdHSLA: TStdHSLA;overload; +begin Result := StdCMYKToStdHSLA(Self) end; + +function TStdCMYKHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; +begin result := StdCMYKToStdHSLA(Self, AAlpha) end; + +function TStdCMYKHelper.ToStdHSVA: TStdHSVA;overload; +begin Result := StdCMYKToStdHSVA(Self) end; + +function TStdCMYKHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; +begin result := StdCMYKToStdHSVA(Self, AAlpha) end; + +function TStdCMYKHelper.ToByteMask: TByteMask; +begin Result := StdCMYKToByteMask(Self) end; + +function TStdCMYKHelper.ToExpandedPixel: TExpandedPixel;overload; +begin Result := StdCMYKToExpandedPixel(Self) end; + +function TStdCMYKHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; +begin result := StdCMYKToExpandedPixel(Self, AAlpha) end; + +function TStdCMYKHelper.ToLinearRGBA: TLinearRGBA;overload; +begin Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; +begin + Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToHSLAPixel: THSLAPixel;overload; +begin Result := ExpandedToHSLA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; +begin + Result := ExpandedToHSLA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToGSBAPixel: TGSBAPixel;overload; +begin Result := ExpandedToGSBA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; +begin + Result := ExpandedToGSBA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToXYZA(AAlpha: single): TXYZA;overload; +begin + Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self),AReferenceWhite) end; + +function TStdCMYKHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; +begin + Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self),AReferenceWhite) end; + +function TStdCMYKHelper.ToLabA: TLabA;overload; +begin Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToLabA(AAlpha: single): TLabA;overload; +begin + Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TStdCMYKHelper.ToLChA: TLChA;overload; +begin Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(Self)) end; + +function TStdCMYKHelper.ToLChA(AAlpha: single): TLChA;overload; +begin + Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +procedure TStdCMYKHelper.FromColor(AValue: TColor); +begin Self := ColorToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAPixelToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToStdCMYK(FPColorToExpanded(AValue)) end; + +procedure TStdCMYKHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TStdCMYKHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToStdCMYK(AValue) end; + +procedure TStdCMYKHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TStdCMYKHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToStdCMYK(HSLAToExpanded(AValue)) end; + +procedure TStdCMYKHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToStdCMYK(GSBAToExpanded(AValue)) end; + +procedure TStdCMYKHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue)) end; + +procedure TStdCMYKHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdCMYKHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue)) end; + +procedure TStdCMYKHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TStdCMYKHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToStdCMYK(LabAToExpandedPixel(AValue)) end; + +procedure TStdCMYKHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToStdCMYK(LChAToExpandedPixel(AValue)) end; + +{ TByteMaskHelper } + +class function TByteMaskHelper.Colorspace: TColorspaceAny; static; +begin result := TByteMaskColorspace end; + +function TByteMaskHelper.ToColor: TColor; +begin Result := ByteMaskToColor(Self) end; + +function TByteMaskHelper.ToBGRAPixel: TBGRAPixel;overload; +begin Result := MaskToBGRA(Self) end; + +function TByteMaskHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; +begin result := MaskToBGRA(Self, AAlpha) end; + +function TByteMaskHelper.ToFPColor: TFPColor;overload; +begin Result := ByteMaskToFPColor(Self) end; + +function TByteMaskHelper.ToFPColor(AAlpha: word): TFPColor;overload; +begin result := ByteMaskToFPColor(Self, AAlpha) end; + +function TByteMaskHelper.ToStdRGBA: TStdRGBA;overload; +begin Result := ByteMaskToStdRGBA(Self) end; + +function TByteMaskHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; +begin result := ByteMaskToStdRGBA(Self, AAlpha) end; + +function TByteMaskHelper.ToAdobeRGBA: TAdobeRGBA;overload; +begin Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; +begin + Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToStdHSLA: TStdHSLA;overload; +begin Result := ByteMaskToStdHSLA(Self) end; + +function TByteMaskHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; +begin result := ByteMaskToStdHSLA(Self, AAlpha) end; + +function TByteMaskHelper.ToStdHSVA: TStdHSVA;overload; +begin Result := ByteMaskToStdHSVA(Self) end; + +function TByteMaskHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; +begin result := ByteMaskToStdHSVA(Self, AAlpha) end; + +function TByteMaskHelper.ToStdCMYK: TStdCMYK; +begin Result := ByteMaskToStdCMYK(Self) end; + +function TByteMaskHelper.ToExpandedPixel: TExpandedPixel;overload; +begin Result := ByteMaskToExpandedPixel(Self) end; + +function TByteMaskHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; +begin result := ByteMaskToExpandedPixel(Self, AAlpha) end; + +function TByteMaskHelper.ToLinearRGBA: TLinearRGBA;overload; +begin Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; +begin + Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToHSLAPixel: THSLAPixel;overload; +begin Result := ExpandedToHSLA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; +begin + Result := ExpandedToHSLA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToGSBAPixel: TGSBAPixel;overload; +begin Result := ExpandedToGSBA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; +begin + Result := ExpandedToGSBA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToXYZA(AAlpha: single): TXYZA;overload; +begin + Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self),AReferenceWhite) end; + +function TByteMaskHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; +begin + Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self),AReferenceWhite) end; + +function TByteMaskHelper.ToLabA: TLabA;overload; +begin Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToLabA(AAlpha: single): TLabA;overload; +begin + Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +function TByteMaskHelper.ToLChA: TLChA;overload; +begin Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(Self)) end; + +function TByteMaskHelper.ToLChA(AAlpha: single): TLChA;overload; +begin + Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(Self)); + result.alpha := AAlpha; +end; + +procedure TByteMaskHelper.FromColor(AValue: TColor); +begin Self := ColorToByteMask(AValue) end; + +procedure TByteMaskHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := BGRAToMask(AValue) end; + +procedure TByteMaskHelper.FromFPColor(AValue: TFPColor); +begin Self := FPColorToByteMask(AValue) end; + +procedure TByteMaskHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToByteMask(AValue) end; + +procedure TByteMaskHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TByteMaskHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToByteMask(AValue) end; + +procedure TByteMaskHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToByteMask(AValue) end; + +procedure TByteMaskHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToByteMask(AValue) end; + +procedure TByteMaskHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToByteMask(AValue) end; + +procedure TByteMaskHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TByteMaskHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToByteMask(HSLAToExpanded(AValue)) end; + +procedure TByteMaskHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToByteMask(GSBAToExpanded(AValue)) end; + +procedure TByteMaskHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue)) end; + +procedure TByteMaskHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TByteMaskHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue)) end; + +procedure TByteMaskHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TByteMaskHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedPixelToByteMask(LabAToExpandedPixel(AValue)) end; + +procedure TByteMaskHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedPixelToByteMask(LChAToExpandedPixel(AValue)) end; + +{ TExpandedPixelHelper } + +class function TExpandedPixelHelper.New(const ARed,AGreen,ABlue,AAlpha:word): TExpandedPixel;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := AAlpha; +end; + +class function TExpandedPixelHelper.New(const ARed,AGreen,ABlue:word): TExpandedPixel;overload; +begin + Result.red := ARed; + Result.green := AGreen; + Result.blue := ABlue; + Result.alpha := 65535; +end; + +class function TExpandedPixelHelper.Colorspace: TColorspaceAny; static; +begin result := TExpandedPixelColorspace end; + +function TExpandedPixelHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(Self) end; + +function TExpandedPixelHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(Self) end; + +function TExpandedPixelHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(Self) end; + +function TExpandedPixelHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(Self) end; + +function TExpandedPixelHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(Self) end; + +function TExpandedPixelHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(Self) end; + +function TExpandedPixelHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(Self) end; + +function TExpandedPixelHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(Self) end; + +function TExpandedPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(Self,AReferenceWhite) end; + +function TExpandedPixelHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(Self) end; + +function TExpandedPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(Self,AReferenceWhite) end; + +function TExpandedPixelHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(Self) end; + +function TExpandedPixelHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(Self) end; + +procedure TExpandedPixelHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := StdRGBAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := AdobeRGBAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := StdHSLAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := StdHSVAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := StdCMYKToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromByteMask(AValue: TByteMask); +begin Self := ByteMaskToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := LinearRGBAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := XYZAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := XYZAToExpandedPixel(AValue,AReferenceWhite) end; + +procedure TExpandedPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := WordXYZAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := WordXYZAToExpandedPixel(AValue,AReferenceWhite) end; + +procedure TExpandedPixelHelper.FromLabA(AValue: TLabA); +begin Self := LabAToExpandedPixel(AValue) end; + +procedure TExpandedPixelHelper.FromLChA(AValue: TLChA); +begin Self := LChAToExpandedPixel(AValue) end; + +{ TLinearRGBAHelper } + +class function TLinearRGBAHelper.Colorspace: TColorspaceAny; static; +begin result := TLinearRGBAColorspace end; + +function TLinearRGBAHelper.ToColor: TColor; +begin Result := ExpandedPixelToColor(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := GammaCompression(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := LinearRGBAToAdobeRGBA(Self) end; + +function TLinearRGBAHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := LinearRGBAToExpandedPixel(Self) end; + +function TLinearRGBAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToXYZA: TXYZA;overload; +begin Result := LinearRGBAToXYZA(Self) end; + +function TLinearRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := LinearRGBAToXYZA(Self,AReferenceWhite) end; + +function TLinearRGBAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(Self)) end; + +function TLinearRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(Self),AReferenceWhite) end; + +function TLinearRGBAHelper.ToLabA: TLabA; +begin Result := LinearRGBAToLabA(Self) end; + +function TLinearRGBAHelper.ToLChA: TLChA; +begin Result := LinearRGBAToLChA(Self) end; + +procedure TLinearRGBAHelper.FromColor(AValue: TColor); +begin Self := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := ExpandedPixelToLinearRGBA(GammaExpansion(AValue)) end; + +procedure TLinearRGBAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToLinearRGBA(FPColorToExpanded(AValue)) end; + +procedure TLinearRGBAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := AdobeRGBAToLinearRGBA(AValue) end; + +procedure TLinearRGBAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToLinearRGBA(AValue) end; + +procedure TLinearRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToLinearRGBA(HSLAToExpanded(AValue)) end; + +procedure TLinearRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToLinearRGBA(GSBAToExpanded(AValue)) end; + +procedure TLinearRGBAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := XYZAToLinearRGBA(AValue) end; + +procedure TLinearRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := XYZAToLinearRGBA(AValue,AReferenceWhite) end; + +procedure TLinearRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue)) end; + +procedure TLinearRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TLinearRGBAHelper.FromLabA(AValue: TLabA); +begin Self := LabAToLinearRGBA(AValue) end; + +procedure TLinearRGBAHelper.FromLChA(AValue: TLChA); +begin Self := LChAToLinearRGBA(AValue) end; + +{ THSLAPixelHelper } + +class function THSLAPixelHelper.New(const AHue,ASaturation,ALightness,AAlpha:word): THSLAPixel;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ALightness; + Result.alpha := AAlpha; +end; + +class function THSLAPixelHelper.New(const AHue,ASaturation,ALightness:word): THSLAPixel;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ALightness; + Result.alpha := 65535; +end; + +class function THSLAPixelHelper.Colorspace: TColorspaceAny; static; +begin result := THSLAPixelColorspace end; + +function THSLAPixelHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(HSLAToExpanded(Self),AReferenceWhite) end; + +function THSLAPixelHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(Self),AReferenceWhite) end; + +function THSLAPixelHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(HSLAToExpanded(Self)) end; + +function THSLAPixelHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(HSLAToExpanded(Self)) end; + +procedure THSLAPixelHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedToHSLA(StdRGBAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedToHSLA(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedToHSLA(StdHSLAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedToHSLA(StdHSVAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedToHSLA(StdCMYKToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedToHSLA(ByteMaskToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedToHSLA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedToHSLA(XYZAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToHSLA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure THSLAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure THSLAPixelHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedToHSLA(LabAToExpandedPixel(AValue)) end; + +procedure THSLAPixelHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedToHSLA(LChAToExpandedPixel(AValue)) end; + +{ TGSBAPixelHelper } + +class function TGSBAPixelHelper.New(const AHue,ASaturation,ABrightness,AAlpha:word): TGSBAPixel;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ABrightness; + Result.alpha := AAlpha; +end; + +class function TGSBAPixelHelper.New(const AHue,ASaturation,ABrightness:word): TGSBAPixel;overload; +begin + Result.hue := AHue; + Result.saturation := ASaturation; + Result.lightness := ABrightness; + Result.alpha := 65535; +end; + +class function TGSBAPixelHelper.Colorspace: TColorspaceAny; static; +begin result := TGSBAPixelColorspace end; + +function TGSBAPixelHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToLinearRGBA: TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToXYZA: TXYZA;overload; +begin Result := ExpandedPixelToXYZA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := ExpandedPixelToXYZA(GSBAToExpanded(Self),AReferenceWhite) end; + +function TGSBAPixelHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(Self),AReferenceWhite) end; + +function TGSBAPixelHelper.ToLabA: TLabA; +begin Result := ExpandedPixelToLabA(GSBAToExpanded(Self)) end; + +function TGSBAPixelHelper.ToLChA: TLChA; +begin Result := ExpandedPixelToLChA(GSBAToExpanded(Self)) end; + +procedure TGSBAPixelHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedToGSBA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := ExpandedToGSBA(AdobeRGBAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedToGSBA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedToGSBA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedToGSBA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedToGSBA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := ExpandedToGSBA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := ExpandedToGSBA(XYZAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToGSBA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TGSBAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; + +procedure TGSBAPixelHelper.FromLabA(AValue: TLabA); +begin Self := ExpandedToGSBA(LabAToExpandedPixel(AValue)) end; + +procedure TGSBAPixelHelper.FromLChA(AValue: TLChA); +begin Self := ExpandedToGSBA(LChAToExpandedPixel(AValue)) end; + +{ TXYZAHelper } + +class function TXYZAHelper.Colorspace: TColorspaceAny; static; +begin result := TXYZAColorspace end; + +procedure TXYZAHelper.ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); +begin ChromaticAdaptXYZ(self.X,self.Y,self.Z, AFrom,ATo) end; + +function TXYZAHelper.ToColor: TColor;overload; +begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; +begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToBGRAPixel: TBGRAPixel;overload; +begin Result := GammaCompression(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; +begin Result := GammaCompression(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToFPColor: TFPColor;overload; +begin Result := ExpandedToFPColor(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; +begin Result := ExpandedToFPColor(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToStdRGBA: TStdRGBA;overload; +begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; +begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToAdobeRGBA: TAdobeRGBA;overload; +begin Result := XYZAToAdobeRGBA(Self) end; + +function TXYZAHelper.ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; +begin Result := XYZAToAdobeRGBA(Self,AReferenceWhite) end; + +function TXYZAHelper.ToStdHSLA: TStdHSLA;overload; +begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; +begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToStdHSVA: TStdHSVA;overload; +begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; +begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToStdCMYK: TStdCMYK;overload; +begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; +begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToByteMask: TByteMask;overload; +begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; +begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToExpandedPixel: TExpandedPixel;overload; +begin Result := XYZAToExpandedPixel(Self) end; + +function TXYZAHelper.ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; +begin Result := XYZAToExpandedPixel(Self,AReferenceWhite) end; + +function TXYZAHelper.ToLinearRGBA: TLinearRGBA;overload; +begin Result := XYZAToLinearRGBA(Self) end; + +function TXYZAHelper.ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; +begin Result := XYZAToLinearRGBA(Self,AReferenceWhite) end; + +function TXYZAHelper.ToHSLAPixel: THSLAPixel;overload; +begin Result := ExpandedToHSLA(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; +begin Result := ExpandedToHSLA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToGSBAPixel: TGSBAPixel;overload; +begin Result := ExpandedToGSBA(XYZAToExpandedPixel(Self)) end; + +function TXYZAHelper.ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; +begin Result := ExpandedToGSBA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TXYZAHelper.ToWordXYZA: TWordXYZA; +begin Result := XYZAToWordXYZA(Self) end; + +function TXYZAHelper.ToLabA: TLabA;overload; +begin Result := XYZAToLabA(Self) end; + +function TXYZAHelper.ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; +begin Result := XYZAToLabA(Self,AReferenceWhite) end; + +function TXYZAHelper.ToLChA: TLChA;overload; +begin Result := XYZAToLChA(Self) end; + +function TXYZAHelper.ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; +begin Result := XYZAToLChA(Self,AReferenceWhite) end; + +procedure TXYZAHelper.FromColor(AValue: TColor); overload; +begin Self := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel); overload; +begin Self := ExpandedPixelToXYZA(GammaExpansion(AValue)) end; + +procedure TXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(GammaExpansion(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromFPColor(AValue: TFPColor); overload; +begin Self := ExpandedPixelToXYZA(FPColorToExpanded(AValue)) end; + +procedure TXYZAHelper.FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(FPColorToExpanded(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromStdRGBA(AValue: TStdRGBA); overload; +begin Self := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); overload; +begin Self := AdobeRGBAToXYZA(AValue) end; + +procedure TXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := AdobeRGBAToXYZA(AValue,AReferenceWhite) end; + +procedure TXYZAHelper.FromStdHSLA(AValue: TStdHSLA); overload; +begin Self := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromStdHSVA(AValue: TStdHSVA); overload; +begin Self := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromStdCMYK(AValue: TStdCMYK); overload; +begin Self := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromByteMask(AValue: TByteMask); overload; +begin Self := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TXYZAHelper.FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel); overload; +begin Self := ExpandedPixelToXYZA(AValue) end; + +procedure TXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(AValue,AReferenceWhite) end; + +procedure TXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA); overload; +begin Self := LinearRGBAToXYZA(AValue) end; + +procedure TXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := LinearRGBAToXYZA(AValue,AReferenceWhite) end; + +procedure TXYZAHelper.FromHSLAPixel(AValue: THSLAPixel); overload; +begin Self := ExpandedPixelToXYZA(HSLAToExpanded(AValue)) end; + +procedure TXYZAHelper.FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(HSLAToExpanded(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel); overload; +begin Self := ExpandedPixelToXYZA(GSBAToExpanded(AValue)) end; + +procedure TXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToXYZA(GSBAToExpanded(AValue),AReferenceWhite) end; + +procedure TXYZAHelper.FromWordXYZA(AValue: TWordXYZA); +begin Self := WordXYZAToXYZA(AValue) end; + +procedure TXYZAHelper.FromLabA(AValue: TLabA); overload; +begin Self := LabAToXYZA(AValue) end; + +procedure TXYZAHelper.FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := LabAToXYZA(AValue,AReferenceWhite) end; + +procedure TXYZAHelper.FromLChA(AValue: TLChA); overload; +begin Self := LChAToXYZA(AValue) end; + +procedure TXYZAHelper.FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := LChAToXYZA(AValue,AReferenceWhite) end; + +{ TWordXYZAHelper } + +class function TWordXYZAHelper.Colorspace: TColorspaceAny; static; +begin result := TWordXYZAColorspace end; + +procedure TWordXYZAHelper.ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); +begin ChromaticAdaptWordXYZ(self.X,self.Y,self.Z, AFrom,ATo) end; + +function TWordXYZAHelper.ToColor: TColor;overload; +begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; +begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToBGRAPixel: TBGRAPixel;overload; +begin Result := GammaCompression(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; +begin Result := GammaCompression(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToFPColor: TFPColor;overload; +begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; +begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToStdRGBA: TStdRGBA;overload; +begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; +begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToAdobeRGBA: TAdobeRGBA;overload; +begin Result := WordXYZAToAdobeRGBA(Self) end; + +function TWordXYZAHelper.ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; +begin Result := WordXYZAToAdobeRGBA(Self,AReferenceWhite) end; + +function TWordXYZAHelper.ToStdHSLA: TStdHSLA;overload; +begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; +begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToStdHSVA: TStdHSVA;overload; +begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; +begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToStdCMYK: TStdCMYK;overload; +begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; +begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToByteMask: TByteMask;overload; +begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; +begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToExpandedPixel: TExpandedPixel;overload; +begin Result := WordXYZAToExpandedPixel(Self) end; + +function TWordXYZAHelper.ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; +begin Result := WordXYZAToExpandedPixel(Self,AReferenceWhite) end; + +function TWordXYZAHelper.ToLinearRGBA: TLinearRGBA;overload; +begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; +begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToHSLAPixel: THSLAPixel;overload; +begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; +begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToGSBAPixel: TGSBAPixel;overload; +begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(Self)) end; + +function TWordXYZAHelper.ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; +begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; + +function TWordXYZAHelper.ToXYZA: TXYZA; +begin Result := WordXYZAToXYZA(Self) end; + +function TWordXYZAHelper.ToLabA: TLabA;overload; +begin Result := WordXYZAToLabA(Self) end; + +function TWordXYZAHelper.ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; +begin Result := WordXYZAToLabA(Self,AReferenceWhite) end; + +function TWordXYZAHelper.ToLChA: TLChA;overload; +begin Result := WordXYZAToLChA(Self) end; + +function TWordXYZAHelper.ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; +begin Result := WordXYZAToLChA(Self,AReferenceWhite) end; + +procedure TWordXYZAHelper.FromColor(AValue: TColor); overload; +begin Self := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel); overload; +begin Self := ExpandedPixelToWordXYZA(GammaExpansion(AValue)) end; + +procedure TWordXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(GammaExpansion(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromFPColor(AValue: TFPColor); overload; +begin Self := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue)) end; + +procedure TWordXYZAHelper.FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromStdRGBA(AValue: TStdRGBA); overload; +begin Self := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); overload; +begin Self := AdobeRGBAToWordXYZA(AValue) end; + +procedure TWordXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := AdobeRGBAToWordXYZA(AValue,AReferenceWhite) end; + +procedure TWordXYZAHelper.FromStdHSLA(AValue: TStdHSLA); overload; +begin Self := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromStdHSVA(AValue: TStdHSVA); overload; +begin Self := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromStdCMYK(AValue: TStdCMYK); overload; +begin Self := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromByteMask(AValue: TByteMask); overload; +begin Self := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel); overload; +begin Self := ExpandedPixelToWordXYZA(AValue) end; + +procedure TWordXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(AValue,AReferenceWhite) end; + +procedure TWordXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA); overload; +begin Self := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue)) end; + +procedure TWordXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromHSLAPixel(AValue: THSLAPixel); overload; +begin Self := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue)) end; + +procedure TWordXYZAHelper.FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel); overload; +begin Self := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue)) end; + +procedure TWordXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue),AReferenceWhite) end; + +procedure TWordXYZAHelper.FromXYZA(AValue: TXYZA); +begin Self := XYZAToWordXYZA(AValue) end; + +procedure TWordXYZAHelper.FromLabA(AValue: TLabA); overload; +begin Self := LabAToWordXYZA(AValue) end; + +procedure TWordXYZAHelper.FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := LabAToWordXYZA(AValue,AReferenceWhite) end; + +procedure TWordXYZAHelper.FromLChA(AValue: TLChA); overload; +begin Self := LChAToWordXYZA(AValue) end; + +procedure TWordXYZAHelper.FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := LChAToWordXYZA(AValue,AReferenceWhite) end; + +{ TLabAHelper } + +class function TLabAHelper.Colorspace: TColorspaceAny; static; +begin result := TLabAColorspace end; + +function TLabAHelper.ToColor: TColor; +begin Result := ExpandedPixelToColor(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := GammaCompression(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := LabAToAdobeRGBA(Self) end; + +function TLabAHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := LabAToExpandedPixel(Self) end; + +function TLabAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := LabAToLinearRGBA(Self) end; + +function TLabAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(LabAToExpandedPixel(Self)) end; + +function TLabAHelper.ToXYZA: TXYZA;overload; +begin Result := LabAToXYZA(Self) end; + +function TLabAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := LabAToXYZA(Self,AReferenceWhite) end; + +function TLabAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := LabAToWordXYZA(Self) end; + +function TLabAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := LabAToWordXYZA(Self,AReferenceWhite) end; + +function TLabAHelper.ToLChA: TLChA; +begin Result := LabAToLChA(Self) end; + +procedure TLabAHelper.FromColor(AValue: TColor); +begin Self := ExpandedPixelToLabA(ColorToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := ExpandedPixelToLabA(GammaExpansion(AValue)) end; + +procedure TLabAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToLabA(FPColorToExpanded(AValue)) end; + +procedure TLabAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedPixelToLabA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := AdobeRGBAToLabA(AValue) end; + +procedure TLabAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedPixelToLabA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedPixelToLabA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedPixelToLabA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedPixelToLabA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TLabAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToLabA(AValue) end; + +procedure TLabAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := LinearRGBAToLabA(AValue) end; + +procedure TLabAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToLabA(HSLAToExpanded(AValue)) end; + +procedure TLabAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToLabA(GSBAToExpanded(AValue)) end; + +procedure TLabAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := XYZAToLabA(AValue) end; + +procedure TLabAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := XYZAToLabA(AValue,AReferenceWhite) end; + +procedure TLabAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := WordXYZAToLabA(AValue) end; + +procedure TLabAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := WordXYZAToLabA(AValue,AReferenceWhite) end; + +procedure TLabAHelper.FromLChA(AValue: TLChA); +begin Self := LChAToLabA(AValue) end; + +{ TLChAHelper } + +class function TLChAHelper.Colorspace: TColorspaceAny; static; +begin result := TLChAColorspace end; + +function TLChAHelper.ToColor: TColor; +begin Result := ExpandedPixelToColor(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToBGRAPixel: TBGRAPixel; +begin Result := GammaCompression(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToFPColor: TFPColor; +begin Result := ExpandedToFPColor(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToStdRGBA: TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToAdobeRGBA: TAdobeRGBA; +begin Result := LChAToAdobeRGBA(Self) end; + +function TLChAHelper.ToStdHSLA: TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToStdHSVA: TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToStdCMYK: TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToByteMask: TByteMask; +begin Result := ExpandedPixelToByteMask(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToExpandedPixel: TExpandedPixel; +begin Result := LChAToExpandedPixel(Self) end; + +function TLChAHelper.ToLinearRGBA: TLinearRGBA; +begin Result := LChAToLinearRGBA(Self) end; + +function TLChAHelper.ToHSLAPixel: THSLAPixel; +begin Result := ExpandedToHSLA(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToGSBAPixel: TGSBAPixel; +begin Result := ExpandedToGSBA(LChAToExpandedPixel(Self)) end; + +function TLChAHelper.ToXYZA: TXYZA;overload; +begin Result := LChAToXYZA(Self) end; + +function TLChAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; +begin Result := LChAToXYZA(Self,AReferenceWhite) end; + +function TLChAHelper.ToWordXYZA: TWordXYZA;overload; +begin Result := LChAToWordXYZA(Self) end; + +function TLChAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; +begin Result := LChAToWordXYZA(Self,AReferenceWhite) end; + +function TLChAHelper.ToLabA: TLabA; +begin Result := LChAToLabA(Self) end; + +procedure TLChAHelper.FromColor(AValue: TColor); +begin Self := ExpandedPixelToLChA(ColorToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromBGRAPixel(AValue: TBGRAPixel); +begin Self := ExpandedPixelToLChA(GammaExpansion(AValue)) end; + +procedure TLChAHelper.FromFPColor(AValue: TFPColor); +begin Self := ExpandedPixelToLChA(FPColorToExpanded(AValue)) end; + +procedure TLChAHelper.FromStdRGBA(AValue: TStdRGBA); +begin Self := ExpandedPixelToLChA(StdRGBAToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); +begin Self := AdobeRGBAToLChA(AValue) end; + +procedure TLChAHelper.FromStdHSLA(AValue: TStdHSLA); +begin Self := ExpandedPixelToLChA(StdHSLAToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromStdHSVA(AValue: TStdHSVA); +begin Self := ExpandedPixelToLChA(StdHSVAToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromStdCMYK(AValue: TStdCMYK); +begin Self := ExpandedPixelToLChA(StdCMYKToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromByteMask(AValue: TByteMask); +begin Self := ExpandedPixelToLChA(ByteMaskToExpandedPixel(AValue)) end; + +procedure TLChAHelper.FromExpandedPixel(AValue: TExpandedPixel); +begin Self := ExpandedPixelToLChA(AValue) end; + +procedure TLChAHelper.FromLinearRGBA(AValue: TLinearRGBA); +begin Self := LinearRGBAToLChA(AValue) end; + +procedure TLChAHelper.FromHSLAPixel(AValue: THSLAPixel); +begin Self := ExpandedPixelToLChA(HSLAToExpanded(AValue)) end; + +procedure TLChAHelper.FromGSBAPixel(AValue: TGSBAPixel); +begin Self := ExpandedPixelToLChA(GSBAToExpanded(AValue)) end; + +procedure TLChAHelper.FromXYZA(AValue: TXYZA); overload; +begin Self := XYZAToLChA(AValue) end; + +procedure TLChAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := XYZAToLChA(AValue,AReferenceWhite) end; + +procedure TLChAHelper.FromWordXYZA(AValue: TWordXYZA); overload; +begin Self := WordXYZAToLChA(AValue) end; + +procedure TLChAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; +begin Self := WordXYZAToLChA(AValue,AReferenceWhite) end; + +procedure TLChAHelper.FromLabA(AValue: TLabA); +begin Self := LabAToLChA(AValue) end; + +{Operators} + +operator := (const AValue: TColor): TStdRGBA; +begin Result := ColorToStdRGBA(AValue) end; + +operator := (const AValue: TColor): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TColor): TStdHSLA; +begin Result := ColorToStdHSLA(AValue) end; + +operator := (const AValue: TColor): TStdHSVA; +begin Result := ColorToStdHSVA(AValue) end; + +operator := (const AValue: TColor): TStdCMYK; +begin Result := ColorToStdCMYK(AValue) end; + +operator := (const AValue: TColor): TByteMask; +begin Result := ColorToByteMask(AValue) end; + +operator := (const AValue: TColor): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TColor): TXYZA; +begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TColor): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TColor): TLabA; +begin Result := ExpandedPixelToLabA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TColor): TLChA; +begin Result := ExpandedPixelToLChA(ColorToExpandedPixel(AValue)) end; + +operator := (const AValue: TBGRAPixel): TStdRGBA; +begin Result := BGRAPixelToStdRGBA(AValue) end; + +operator := (const AValue: TBGRAPixel): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(GammaExpansion(AValue)) end; + +operator := (const AValue: TBGRAPixel): TStdHSLA; +begin Result := BGRAPixelToStdHSLA(AValue) end; + +operator := (const AValue: TBGRAPixel): TStdHSVA; +begin Result := BGRAPixelToStdHSVA(AValue) end; + +operator := (const AValue: TBGRAPixel): TStdCMYK; +begin Result := BGRAPixelToStdCMYK(AValue) end; + +operator := (const AValue: TBGRAPixel): TByteMask; +begin Result := BGRAToMask(AValue) end; + +operator := (const AValue: TBGRAPixel): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(GammaExpansion(AValue)) end; + +operator := (const AValue: TBGRAPixel): TXYZA; +begin Result := ExpandedPixelToXYZA(GammaExpansion(AValue)) end; + +operator := (const AValue: TBGRAPixel): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(GammaExpansion(AValue)) end; + +operator := (const AValue: TBGRAPixel): TLabA; +begin Result := ExpandedPixelToLabA(GammaExpansion(AValue)) end; + +operator := (const AValue: TBGRAPixel): TLChA; +begin Result := ExpandedPixelToLChA(GammaExpansion(AValue)) end; + +operator := (const AValue: TFPColor): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TByteMask; +begin Result := FPColorToByteMask(AValue) end; + +operator := (const AValue: TFPColor): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TXYZA; +begin Result := ExpandedPixelToXYZA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TLabA; +begin Result := ExpandedPixelToLabA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TFPColor): TLChA; +begin Result := ExpandedPixelToLChA(FPColorToExpanded(AValue)) end; + +operator := (const AValue: TStdRGBA): TColor; +begin Result := StdRGBAToColor(AValue) end; + +operator := (const AValue: TStdRGBA): TBGRAPixel; +begin Result := StdRGBAToBGRAPixel(AValue) end; + +operator := (const AValue: TStdRGBA): TFPColor; +begin Result := ExpandedToFPColor(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TStdHSLA; +begin Result := StdRGBAToStdHSLA(AValue) end; + +operator := (const AValue: TStdRGBA): TStdHSVA; +begin Result := StdRGBAToStdHSVA(AValue) end; + +operator := (const AValue: TStdRGBA): TStdCMYK; +begin Result := StdRGBAToStdCMYK(AValue) end; + +operator := (const AValue: TStdRGBA): TByteMask; +begin Result := StdRGBAToByteMask(AValue) end; + +operator := (const AValue: TStdRGBA): TExpandedPixel; +begin Result := StdRGBAToExpandedPixel(AValue) end; + +operator := (const AValue: TStdRGBA): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): THSLAPixel; +begin Result := ExpandedToHSLA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TGSBAPixel; +begin Result := ExpandedToGSBA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TXYZA; +begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TLabA; +begin Result := ExpandedPixelToLabA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdRGBA): TLChA; +begin Result := ExpandedPixelToLChA(StdRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TColor; +begin Result := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TBGRAPixel; +begin Result := GammaCompression(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TFPColor; +begin Result := ExpandedToFPColor(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TByteMask; +begin Result := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TExpandedPixel; +begin Result := AdobeRGBAToExpandedPixel(AValue) end; + +operator := (const AValue: TAdobeRGBA): TLinearRGBA; +begin Result := AdobeRGBAToLinearRGBA(AValue) end; + +operator := (const AValue: TAdobeRGBA): THSLAPixel; +begin Result := ExpandedToHSLA(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TGSBAPixel; +begin Result := ExpandedToGSBA(AdobeRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TAdobeRGBA): TXYZA; +begin Result := AdobeRGBAToXYZA(AValue) end; + +operator := (const AValue: TAdobeRGBA): TWordXYZA; +begin Result := AdobeRGBAToWordXYZA(AValue) end; + +operator := (const AValue: TAdobeRGBA): TLabA; +begin Result := AdobeRGBAToLabA(AValue) end; + +operator := (const AValue: TAdobeRGBA): TLChA; +begin Result := AdobeRGBAToLChA(AValue) end; + +operator := (const AValue: TStdHSLA): TColor; +begin Result := StdHSLAToColor(AValue) end; + +operator := (const AValue: TStdHSLA): TBGRAPixel; +begin Result := StdHSLAToBGRAPixel(AValue) end; + +operator := (const AValue: TStdHSLA): TFPColor; +begin Result := ExpandedToFPColor(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TStdRGBA; +begin Result := StdHSLAToStdRGBA(AValue) end; + +operator := (const AValue: TStdHSLA): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TStdHSVA; +begin Result := StdHSLAToStdHSVA(AValue) end; + +operator := (const AValue: TStdHSLA): TStdCMYK; +begin Result := StdHSLAToStdCMYK(AValue) end; + +operator := (const AValue: TStdHSLA): TByteMask; +begin Result := StdHSLAToByteMask(AValue) end; + +operator := (const AValue: TStdHSLA): TExpandedPixel; +begin Result := StdHSLAToExpandedPixel(AValue) end; + +operator := (const AValue: TStdHSLA): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): THSLAPixel; +begin Result := ExpandedToHSLA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TGSBAPixel; +begin Result := ExpandedToGSBA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TXYZA; +begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TLabA; +begin Result := ExpandedPixelToLabA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSLA): TLChA; +begin Result := ExpandedPixelToLChA(StdHSLAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TColor; +begin Result := StdHSVAToColor(AValue) end; + +operator := (const AValue: TStdHSVA): TBGRAPixel; +begin Result := StdHSVAToBGRAPixel(AValue) end; + +operator := (const AValue: TStdHSVA): TFPColor; +begin Result := ExpandedToFPColor(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TStdRGBA; +begin Result := StdHSVAToStdRGBA(AValue) end; + +operator := (const AValue: TStdHSVA): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TStdHSLA; +begin Result := StdHSVAToStdHSLA(AValue) end; + +operator := (const AValue: TStdHSVA): TStdCMYK; +begin Result := StdHSVAToStdCMYK(AValue) end; + +operator := (const AValue: TStdHSVA): TByteMask; +begin Result := StdHSVAToByteMask(AValue) end; + +operator := (const AValue: TStdHSVA): TExpandedPixel; +begin Result := StdHSVAToExpandedPixel(AValue) end; + +operator := (const AValue: TStdHSVA): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): THSLAPixel; +begin Result := ExpandedToHSLA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TGSBAPixel; +begin Result := ExpandedToGSBA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TXYZA; +begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TLabA; +begin Result := ExpandedPixelToLabA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdHSVA): TLChA; +begin Result := ExpandedPixelToLChA(StdHSVAToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TColor; +begin Result := StdCMYKToColor(AValue) end; + +operator := (const AValue: TStdCMYK): TBGRAPixel; +begin Result := StdCMYKToBGRAPixel(AValue) end; + +operator := (const AValue: TStdCMYK): TFPColor; +begin Result := ExpandedToFPColor(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TStdRGBA; +begin Result := StdCMYKToStdRGBA(AValue) end; + +operator := (const AValue: TStdCMYK): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TStdHSLA; +begin Result := StdCMYKToStdHSLA(AValue) end; + +operator := (const AValue: TStdCMYK): TStdHSVA; +begin Result := StdCMYKToStdHSVA(AValue) end; + +operator := (const AValue: TStdCMYK): TByteMask; +begin Result := StdCMYKToByteMask(AValue) end; + +operator := (const AValue: TStdCMYK): TExpandedPixel; +begin Result := StdCMYKToExpandedPixel(AValue) end; + +operator := (const AValue: TStdCMYK): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): THSLAPixel; +begin Result := ExpandedToHSLA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TGSBAPixel; +begin Result := ExpandedToGSBA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TXYZA; +begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TLabA; +begin Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TStdCMYK): TLChA; +begin Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TColor; +begin Result := ByteMaskToColor(AValue) end; + +operator := (const AValue: TByteMask): TBGRAPixel; +begin Result := MaskToBGRA(AValue) end; + +operator := (const AValue: TByteMask): TFPColor; +begin Result := ByteMaskToFPColor(AValue) end; + +operator := (const AValue: TByteMask): TStdRGBA; +begin Result := ByteMaskToStdRGBA(AValue) end; + +operator := (const AValue: TByteMask): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TStdHSLA; +begin Result := ByteMaskToStdHSLA(AValue) end; + +operator := (const AValue: TByteMask): TStdHSVA; +begin Result := ByteMaskToStdHSVA(AValue) end; + +operator := (const AValue: TByteMask): TStdCMYK; +begin Result := ByteMaskToStdCMYK(AValue) end; + +operator := (const AValue: TByteMask): TExpandedPixel; +begin Result := ByteMaskToExpandedPixel(AValue) end; + +operator := (const AValue: TByteMask): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): THSLAPixel; +begin Result := ExpandedToHSLA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TGSBAPixel; +begin Result := ExpandedToGSBA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TXYZA; +begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TLabA; +begin Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TByteMask): TLChA; +begin Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(AValue)) end; + +operator := (const AValue: TExpandedPixel): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(AValue) end; + +operator := (const AValue: TExpandedPixel): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(AValue) end; + +operator := (const AValue: TExpandedPixel): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(AValue) end; + +operator := (const AValue: TExpandedPixel): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(AValue) end; + +operator := (const AValue: TExpandedPixel): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(AValue) end; + +operator := (const AValue: TExpandedPixel): TByteMask; +begin Result := ExpandedPixelToByteMask(AValue) end; + +operator := (const AValue: TExpandedPixel): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(AValue) end; + +operator := (const AValue: TExpandedPixel): TXYZA; +begin Result := ExpandedPixelToXYZA(AValue) end; + +operator := (const AValue: TExpandedPixel): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(AValue) end; + +operator := (const AValue: TExpandedPixel): TLabA; +begin Result := ExpandedPixelToLabA(AValue) end; + +operator := (const AValue: TExpandedPixel): TLChA; +begin Result := ExpandedPixelToLChA(AValue) end; + +operator := (const AValue: TLinearRGBA): TColor; +begin Result := ExpandedPixelToColor(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TBGRAPixel; +begin Result := GammaCompression(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TFPColor; +begin Result := ExpandedToFPColor(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TAdobeRGBA; +begin Result := LinearRGBAToAdobeRGBA(AValue) end; + +operator := (const AValue: TLinearRGBA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TByteMask; +begin Result := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TExpandedPixel; +begin Result := LinearRGBAToExpandedPixel(AValue) end; + +operator := (const AValue: TLinearRGBA): THSLAPixel; +begin Result := ExpandedToHSLA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TGSBAPixel; +begin Result := ExpandedToGSBA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TXYZA; +begin Result := LinearRGBAToXYZA(AValue) end; + +operator := (const AValue: TLinearRGBA): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLinearRGBA): TLabA; +begin Result := LinearRGBAToLabA(AValue) end; + +operator := (const AValue: TLinearRGBA): TLChA; +begin Result := LinearRGBAToLChA(AValue) end; + +operator := (const AValue: THSLAPixel): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TByteMask; +begin Result := ExpandedPixelToByteMask(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TXYZA; +begin Result := ExpandedPixelToXYZA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TLabA; +begin Result := ExpandedPixelToLabA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: THSLAPixel): TLChA; +begin Result := ExpandedPixelToLChA(HSLAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TAdobeRGBA; +begin Result := ExpandedPixelToAdobeRGBA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TByteMask; +begin Result := ExpandedPixelToByteMask(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TXYZA; +begin Result := ExpandedPixelToXYZA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TWordXYZA; +begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TLabA; +begin Result := ExpandedPixelToLabA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TGSBAPixel): TLChA; +begin Result := ExpandedPixelToLChA(GSBAToExpanded(AValue)) end; + +operator := (const AValue: TXYZA): TColor; +begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TBGRAPixel; +begin Result := GammaCompression(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TFPColor; +begin Result := ExpandedToFPColor(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TAdobeRGBA; +begin Result := XYZAToAdobeRGBA(AValue) end; + +operator := (const AValue: TXYZA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TByteMask; +begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TExpandedPixel; +begin Result := XYZAToExpandedPixel(AValue) end; + +operator := (const AValue: TXYZA): TLinearRGBA; +begin Result := XYZAToLinearRGBA(AValue) end; + +operator := (const AValue: TXYZA): THSLAPixel; +begin Result := ExpandedToHSLA(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TGSBAPixel; +begin Result := ExpandedToGSBA(XYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TXYZA): TWordXYZA; +begin Result := XYZAToWordXYZA(AValue) end; + +operator := (const AValue: TXYZA): TLabA; +begin Result := XYZAToLabA(AValue) end; + +operator := (const AValue: TXYZA): TLChA; +begin Result := XYZAToLChA(AValue) end; + +operator := (const AValue: TWordXYZA): TColor; +begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TBGRAPixel; +begin Result := GammaCompression(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TFPColor; +begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TAdobeRGBA; +begin Result := WordXYZAToAdobeRGBA(AValue) end; + +operator := (const AValue: TWordXYZA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TByteMask; +begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TExpandedPixel; +begin Result := WordXYZAToExpandedPixel(AValue) end; + +operator := (const AValue: TWordXYZA): TLinearRGBA; +begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): THSLAPixel; +begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TGSBAPixel; +begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue)) end; + +operator := (const AValue: TWordXYZA): TXYZA; +begin Result := WordXYZAToXYZA(AValue) end; + +operator := (const AValue: TWordXYZA): TLabA; +begin Result := WordXYZAToLabA(AValue) end; + +operator := (const AValue: TWordXYZA): TLChA; +begin Result := WordXYZAToLChA(AValue) end; + +operator := (const AValue: TLabA): TColor; +begin Result := ExpandedPixelToColor(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TBGRAPixel; +begin Result := GammaCompression(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TFPColor; +begin Result := ExpandedToFPColor(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TAdobeRGBA; +begin Result := LabAToAdobeRGBA(AValue) end; + +operator := (const AValue: TLabA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TByteMask; +begin Result := ExpandedPixelToByteMask(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TExpandedPixel; +begin Result := LabAToExpandedPixel(AValue) end; + +operator := (const AValue: TLabA): TLinearRGBA; +begin Result := LabAToLinearRGBA(AValue) end; + +operator := (const AValue: TLabA): THSLAPixel; +begin Result := ExpandedToHSLA(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TGSBAPixel; +begin Result := ExpandedToGSBA(LabAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLabA): TXYZA; +begin Result := LabAToXYZA(AValue) end; + +operator := (const AValue: TLabA): TWordXYZA; +begin Result := LabAToWordXYZA(AValue) end; + +operator := (const AValue: TLabA): TLChA; +begin Result := LabAToLChA(AValue) end; + +operator := (const AValue: TLChA): TColor; +begin Result := ExpandedPixelToColor(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TBGRAPixel; +begin Result := GammaCompression(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TFPColor; +begin Result := ExpandedToFPColor(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TStdRGBA; +begin Result := ExpandedPixelToStdRGBA(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TAdobeRGBA; +begin Result := LChAToAdobeRGBA(AValue) end; + +operator := (const AValue: TLChA): TStdHSLA; +begin Result := ExpandedPixelToStdHSLA(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TStdHSVA; +begin Result := ExpandedPixelToStdHSVA(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TStdCMYK; +begin Result := ExpandedPixelToStdCMYK(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TByteMask; +begin Result := ExpandedPixelToByteMask(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TExpandedPixel; +begin Result := LChAToExpandedPixel(AValue) end; + +operator := (const AValue: TLChA): TLinearRGBA; +begin Result := LChAToLinearRGBA(AValue) end; + +operator := (const AValue: TLChA): THSLAPixel; +begin Result := ExpandedToHSLA(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TGSBAPixel; +begin Result := ExpandedToGSBA(LChAToExpandedPixel(AValue)) end; + +operator := (const AValue: TLChA): TXYZA; +begin Result := LChAToXYZA(AValue) end; + +operator := (const AValue: TLChA): TWordXYZA; +begin Result := LChAToWordXYZA(AValue) end; + +operator := (const AValue: TLChA): TLabA; +begin Result := LChAToLabA(AValue) end; + +{$ENDIF} +{$IFDEF INCLUDE_INITIALIZATION} +{$UNDEF INCLUDE_INITIALIZATION} + ColorspaceCollection.Add(TColorColorspace); + ColorspaceCollection.Add(TBGRAPixelColorspace); + ColorspaceCollection.Add(TFPColorColorspace); + ColorspaceCollection.Add(TStdRGBAColorspace); + ColorspaceCollection.Add(TAdobeRGBAColorspace); + ColorspaceCollection.Add(TStdHSLAColorspace); + ColorspaceCollection.Add(TStdHSVAColorspace); + ColorspaceCollection.Add(TStdCMYKColorspace); + ColorspaceCollection.Add(TByteMaskColorspace); + ColorspaceCollection.Add(TExpandedPixelColorspace); + ColorspaceCollection.Add(TLinearRGBAColorspace); + ColorspaceCollection.Add(THSLAPixelColorspace); + ColorspaceCollection.Add(TGSBAPixelColorspace); + ColorspaceCollection.Add(TXYZAColorspace); + ColorspaceCollection.Add(TWordXYZAColorspace); + ColorspaceCollection.Add(TLabAColorspace); + ColorspaceCollection.Add(TLChAColorspace); + ColorspaceCollection.AddConversion(TColorColorspace, TBGRAPixelColorspace, @ConvertColorArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TColorColorspace, TFPColorColorspace, @ConvertColorArrayToFPColorArray); + ColorspaceCollection.AddConversion(TColorColorspace, TStdRGBAColorspace, @ConvertColorArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TColorColorspace, TStdHSLAColorspace, @ConvertColorArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TColorColorspace, TStdHSVAColorspace, @ConvertColorArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TColorColorspace, TStdCMYKColorspace, @ConvertColorArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TColorColorspace, TByteMaskColorspace, @ConvertColorArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TColorColorspace, TExpandedPixelColorspace, @ConvertColorArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TColorColorspace, @ConvertBGRAPixelArrayToColorArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TFPColorColorspace, @ConvertBGRAPixelArrayToFPColorArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdRGBAColorspace, @ConvertBGRAPixelArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdHSLAColorspace, @ConvertBGRAPixelArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdHSVAColorspace, @ConvertBGRAPixelArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdCMYKColorspace, @ConvertBGRAPixelArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TByteMaskColorspace, @ConvertBGRAPixelArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TExpandedPixelColorspace, @ConvertBGRAPixelArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TFPColorColorspace, TColorColorspace, @ConvertFPColorArrayToColorArray); + ColorspaceCollection.AddConversion(TFPColorColorspace, TBGRAPixelColorspace, @ConvertFPColorArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TFPColorColorspace, TByteMaskColorspace, @ConvertFPColorArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TFPColorColorspace, TExpandedPixelColorspace, @ConvertFPColorArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TColorColorspace, @ConvertStdRGBAArrayToColorArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TBGRAPixelColorspace, @ConvertStdRGBAArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdHSLAColorspace, @ConvertStdRGBAArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdHSVAColorspace, @ConvertStdRGBAArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdCMYKColorspace, @ConvertStdRGBAArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TByteMaskColorspace, @ConvertStdRGBAArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TStdRGBAColorspace, TExpandedPixelColorspace, @ConvertStdRGBAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TExpandedPixelColorspace, @ConvertAdobeRGBAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLinearRGBAColorspace, @ConvertAdobeRGBAArrayToLinearRGBAArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TXYZAColorspace, @ConvertAdobeRGBAArrayToXYZAArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TWordXYZAColorspace, @ConvertAdobeRGBAArrayToWordXYZAArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLabAColorspace, @ConvertAdobeRGBAArrayToLabAArray); + ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLChAColorspace, @ConvertAdobeRGBAArrayToLChAArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TColorColorspace, @ConvertStdHSLAArrayToColorArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TBGRAPixelColorspace, @ConvertStdHSLAArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdRGBAColorspace, @ConvertStdHSLAArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdHSVAColorspace, @ConvertStdHSLAArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdCMYKColorspace, @ConvertStdHSLAArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TByteMaskColorspace, @ConvertStdHSLAArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TStdHSLAColorspace, TExpandedPixelColorspace, @ConvertStdHSLAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TColorColorspace, @ConvertStdHSVAArrayToColorArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TBGRAPixelColorspace, @ConvertStdHSVAArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdRGBAColorspace, @ConvertStdHSVAArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdHSLAColorspace, @ConvertStdHSVAArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdCMYKColorspace, @ConvertStdHSVAArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TByteMaskColorspace, @ConvertStdHSVAArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TStdHSVAColorspace, TExpandedPixelColorspace, @ConvertStdHSVAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TColorColorspace, @ConvertStdCMYKArrayToColorArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TBGRAPixelColorspace, @ConvertStdCMYKArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdRGBAColorspace, @ConvertStdCMYKArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdHSLAColorspace, @ConvertStdCMYKArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdHSVAColorspace, @ConvertStdCMYKArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TByteMaskColorspace, @ConvertStdCMYKArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TStdCMYKColorspace, TExpandedPixelColorspace, @ConvertStdCMYKArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TColorColorspace, @ConvertByteMaskArrayToColorArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TBGRAPixelColorspace, @ConvertByteMaskArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TFPColorColorspace, @ConvertByteMaskArrayToFPColorArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdRGBAColorspace, @ConvertByteMaskArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdHSLAColorspace, @ConvertByteMaskArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdHSVAColorspace, @ConvertByteMaskArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdCMYKColorspace, @ConvertByteMaskArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TByteMaskColorspace, TExpandedPixelColorspace, @ConvertByteMaskArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TColorColorspace, @ConvertExpandedPixelArrayToColorArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TBGRAPixelColorspace, @ConvertExpandedPixelArrayToBGRAPixelArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TFPColorColorspace, @ConvertExpandedPixelArrayToFPColorArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdRGBAColorspace, @ConvertExpandedPixelArrayToStdRGBAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TAdobeRGBAColorspace, @ConvertExpandedPixelArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdHSLAColorspace, @ConvertExpandedPixelArrayToStdHSLAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdHSVAColorspace, @ConvertExpandedPixelArrayToStdHSVAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdCMYKColorspace, @ConvertExpandedPixelArrayToStdCMYKArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TByteMaskColorspace, @ConvertExpandedPixelArrayToByteMaskArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLinearRGBAColorspace, @ConvertExpandedPixelArrayToLinearRGBAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, THSLAPixelColorspace, @ConvertExpandedPixelArrayToHSLAPixelArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TGSBAPixelColorspace, @ConvertExpandedPixelArrayToGSBAPixelArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TXYZAColorspace, @ConvertExpandedPixelArrayToXYZAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TWordXYZAColorspace, @ConvertExpandedPixelArrayToWordXYZAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLabAColorspace, @ConvertExpandedPixelArrayToLabAArray); + ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLChAColorspace, @ConvertExpandedPixelArrayToLChAArray); + ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TAdobeRGBAColorspace, @ConvertLinearRGBAArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TExpandedPixelColorspace, @ConvertLinearRGBAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TXYZAColorspace, @ConvertLinearRGBAArrayToXYZAArray); + ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TLabAColorspace, @ConvertLinearRGBAArrayToLabAArray); + ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TLChAColorspace, @ConvertLinearRGBAArrayToLChAArray); + ColorspaceCollection.AddConversion(THSLAPixelColorspace, TExpandedPixelColorspace, @ConvertHSLAPixelArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(THSLAPixelColorspace, TGSBAPixelColorspace, @ConvertHSLAPixelArrayToGSBAPixelArray); + ColorspaceCollection.AddConversion(TGSBAPixelColorspace, TExpandedPixelColorspace, @ConvertGSBAPixelArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TGSBAPixelColorspace, THSLAPixelColorspace, @ConvertGSBAPixelArrayToHSLAPixelArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TAdobeRGBAColorspace, @ConvertXYZAArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TExpandedPixelColorspace, @ConvertXYZAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TLinearRGBAColorspace, @ConvertXYZAArrayToLinearRGBAArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TWordXYZAColorspace, @ConvertXYZAArrayToWordXYZAArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TLabAColorspace, @ConvertXYZAArrayToLabAArray); + ColorspaceCollection.AddConversion(TXYZAColorspace, TLChAColorspace, @ConvertXYZAArrayToLChAArray); + ColorspaceCollection.AddConversion(TWordXYZAColorspace, TAdobeRGBAColorspace, @ConvertWordXYZAArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TWordXYZAColorspace, TExpandedPixelColorspace, @ConvertWordXYZAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TWordXYZAColorspace, TXYZAColorspace, @ConvertWordXYZAArrayToXYZAArray); + ColorspaceCollection.AddConversion(TWordXYZAColorspace, TLabAColorspace, @ConvertWordXYZAArrayToLabAArray); + ColorspaceCollection.AddConversion(TWordXYZAColorspace, TLChAColorspace, @ConvertWordXYZAArrayToLChAArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TAdobeRGBAColorspace, @ConvertLabAArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TExpandedPixelColorspace, @ConvertLabAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TLinearRGBAColorspace, @ConvertLabAArrayToLinearRGBAArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TXYZAColorspace, @ConvertLabAArrayToXYZAArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TWordXYZAColorspace, @ConvertLabAArrayToWordXYZAArray); + ColorspaceCollection.AddConversion(TLabAColorspace, TLChAColorspace, @ConvertLabAArrayToLChAArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TAdobeRGBAColorspace, @ConvertLChAArrayToAdobeRGBAArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TExpandedPixelColorspace, @ConvertLChAArrayToExpandedPixelArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TLinearRGBAColorspace, @ConvertLChAArrayToLinearRGBAArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TXYZAColorspace, @ConvertLChAArrayToXYZAArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TWordXYZAColorspace, @ConvertLChAArrayToWordXYZAArray); + ColorspaceCollection.AddConversion(TLChAColorspace, TLabAColorspace, @ConvertLChAArrayToLabAArray); +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/generatedunicode.inc b/vendor/kam_remake/src/ext/BGRABitmap/generatedunicode.inc new file mode 100644 index 0000000..3a9845e --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/generatedunicode.inc @@ -0,0 +1,1209 @@ +{ This file is generated by dev/parseunicode/parseunicodeclasses program } + +function GetUnicodeBidiClassEx(u: LongWord): TUnicodeBidiClass; +begin + case u of + $00000..$07FFF: + case u of + $00000..$003FF: + case u of + $00..$08, $0E..$1B, $7F..$84, $86..$9F, $AD: result := ubcBoundaryNeutral; + $09, $0B, $1F: result := ubcSegmentSeparator; + $0A, $0D, $1C..$1E, $85: result := ubcParagraphSeparator; + $0C, $20: result := ubcWhiteSpace; + $41..$5A, $61..$7A, $AA, $B5, $BA, $C0..$D6, $D8..$F6, $F8..$2B8, $2BB..$2C1, $2D0, $2D1, + $2E0..$2E4, $2EE, $370..$373, $376, $377, $37A..$37D, $37F, $386, $388..$38A, $38C, $38E..$3A1, + $3A3..$3F5, $3F7: result := ubcLeftToRight; + $3F8..$3FF: result := ubcLeftToRight; + $30..$39, $B2, $B3, $B9: result := ubcEuropeanNumber; + $2B, $2D: result := ubcEuropeanNumberSeparator; + $23..$25, $A2..$A5, $B0, $B1: result := ubcEuropeanNumberTerminator; + $2C, $2E, $2F, $3A, $A0: result := ubcCommonSeparator; + $300..$36F: result := ubcNonSpacingMark; + $21, $22, $26, $27, $2A, $3B, $3D, $3F, $40, $5C, $5E..$60, $7C, $7E, $A1, $A6..$A9, $AC, + $AE, $AF, $B4, $B6..$B8, $BC..$BF, $D7, $F7, $2B9, $2BA, $2C2..$2CF, $2D2: result := ubcOtherNeutrals; + $2D3..$2DF, $2E5..$2ED, $2EF..$2FF, $374, $375, $37E, $384, $385, $387, $3F6: result := ubcOtherNeutrals; + $28, $29, $3C, $3E, $5B, $5D, $7B, $7D, $AB, $BB: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + $00400..$007FF: + case u of + $400..$482, $48A..$52F, $531..$556, $559..$589: result := ubcLeftToRight; + $5BE, $5C0, $5C3, $5C6, $5D0..$5EA, $5EF..$5F4, $7C0..$7EA, $7F4, $7F5, $7FA, $7FE, $7FF: result := ubcRightToLeft; + $608, $60B, $60D, $61B, $61C, $61E..$64A, $66D..$66F, $671..$6D5, $6E5, $6E6, $6EE, $6EF, + $6FA..$70D, $70F, $710, $712..$72F, $74D..$7A5, $7B1: result := ubcArabicLetter; + $6F0..$6F9: result := ubcEuropeanNumber; + $58F, $609, $60A, $66A: result := ubcEuropeanNumberTerminator; + $600..$605, $660..$669, $66B, $66C, $6DD: result := ubcArabicNumber; + $60C: result := ubcCommonSeparator; + $483..$489, $591..$5BD, $5BF, $5C1, $5C2, $5C4, $5C5, $5C7, $610..$61A, $64B..$65F, $670, + $6D6..$6DC, $6DF..$6E4, $6E7, $6E8, $6EA..$6ED, $711, $730..$74A, $7A6..$7B0, $7EB..$7F3, + $7FD: result := ubcNonSpacingMark; + $58A, $58D, $58E, $606, $607, $60E, $60F, $6DE, $6E9, $7F6..$7F9: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $00800..$00BFF: + case u of + $904..$939, $93D, $950, $958..$961, $964..$980, $985..$98C, $98F, $990, $993..$9A8, $9AA..$9B0, + $9B2, $9B6..$9B9, $9BD, $9CE, $9DC, $9DD, $9DF..$9E1, $9E6..$9F1, $9F4..$9FA, $9FC, $9FD, + $A05..$A0A, $A0F, $A10, $A13..$A28, $A2A: result := ubcLeftToRight; + $A2B..$A30, $A32, $A33, $A35, $A36, $A38, $A39, $A59..$A5C, $A5E, $A66..$A6F, $A72..$A74, + $A76, $A85..$A8D, $A8F..$A91, $A93..$AA8, $AAA..$AB0, $AB2, $AB3, $AB5..$AB9, $ABD, $AD0, + $AE0, $AE1, $AE6..$AF0, $AF9, $B05..$B0C, $B0F: result := ubcLeftToRight; + $903, $93B, $93E..$940, $949..$94C, $94E, $94F, $982, $983, $9BE..$9C0, $9C7, $9C8, $9CB, + $9CC, $9D7, $A03, $A3E..$A40, $A83, $ABE..$AC0, $AC9, $ACB, $ACC, $B02, $B03, $B3E, $B40, + $B47, $B48, $B4B, $B4C, $B57: result := ubcCombiningLeftToRight; + $B10, $B13..$B28, $B2A..$B30, $B32, $B33, $B35..$B39, $B3D, $B5C, $B5D, $B5F..$B61, $B66..$B77, + $B83, $B85..$B8A, $B8E..$B90, $B92..$B95, $B99, $B9A, $B9C, $B9E, $B9F, $BA3, $BA4, $BA8..$BAA, + $BAE..$BB9, $BD0, $BE6..$BF2: result := ubcLeftToRight; + $800..$815, $81A, $824, $828, $830..$83E, $840..$858, $85E: result := ubcRightToLeft; + $860..$86A, $8A0..$8B4, $8B6..$8C7: result := ubcArabicLetter; + $BBE, $BBF, $BC1, $BC2, $BC6..$BC8, $BCA..$BCC, $BD7: result := ubcCombiningLeftToRight; + $9F2, $9F3, $9FB, $AF1, $BF9: result := ubcEuropeanNumberTerminator; + $8E2: result := ubcArabicNumber; + $816..$819, $81B..$823, $825..$827, $829..$82D, $859..$85B, $8D3..$8E1, $8E3..$902, $93A, + $93C, $941..$948, $94D, $951..$957, $962, $963, $981, $9BC, $9C1..$9C4, $9CD, $9E2, $9E3, + $9FE, $A01, $A02, $A3C, $A41: result := ubcNonSpacingMark; + $A42, $A47, $A48, $A4B..$A4D, $A51, $A70, $A71, $A75, $A81, $A82, $ABC, $AC1..$AC5, $AC7, + $AC8, $ACD, $AE2, $AE3, $AFA..$AFF, $B01, $B3C, $B3F, $B41..$B44, $B4D, $B55, $B56, $B62, + $B63, $B82, $BC0: result := ubcNonSpacingMark; + $BCD: result := ubcNonSpacingMark; + $BF3..$BF8, $BFA: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $00C00..$00FFF: + case u of + $C05..$C0C, $C0E..$C10, $C12..$C28, $C2A..$C39, $C3D, $C58..$C5A, $C60, $C61, $C66..$C6F, + $C77, $C7F, $C80, $C84..$C8C, $C8E..$C90, $C92..$CA8, $CAA..$CB3, $CB5..$CB9, $CBD, $CBF, + $CC6, $CDE, $CE0, $CE1, $CE6..$CEF, $CF1: result := ubcLeftToRight; + $CF2, $D04..$D0C, $D0E..$D10, $D12..$D3A, $D3D, $D4E, $D4F, $D54..$D56, $D58..$D61, $D66..$D7F, + $D85..$D96, $D9A..$DB1, $DB3..$DBB, $DBD, $DC0..$DC6, $DE6..$DEF, $DF4, $E01..$E30, $E32, + $E33, $E40..$E46, $E4F..$E5B, $E81, $E82, $E84: result := ubcLeftToRight; + $E86..$E8A, $E8C..$EA3, $EA5, $EA7..$EB0, $EB2, $EB3, $EBD, $EC0..$EC4, $EC6, $ED0..$ED9, + $EDC..$EDF, $F00..$F17, $F1A..$F34, $F36, $F38, $F40..$F47, $F49..$F6C, $F85, $F88..$F8C, + $FBE..$FC5, $FC7..$FCC, $FCE..$FDA: result := ubcLeftToRight; + $C01..$C03, $C41..$C44, $C82, $C83, $CBE, $CC0..$CC4, $CC7, $CC8, $CCA, $CCB, $CD5, $CD6, + $D02, $D03, $D3E..$D40, $D46..$D48, $D4A..$D4C, $D57, $D82, $D83, $DCF..$DD1, $DD8..$DDF, + $DF2, $DF3, $F3E, $F3F, $F7F: result := ubcCombiningLeftToRight; + $E3F: result := ubcEuropeanNumberTerminator; + $C00, $C04, $C3E..$C40, $C46..$C48, $C4A..$C4D, $C55, $C56, $C62, $C63, $C81, $CBC, $CCC, + $CCD, $CE2, $CE3, $D00, $D01, $D3B, $D3C, $D41..$D44, $D4D, $D62, $D63, $D81, $DCA, $DD2..$DD4, + $DD6, $E31, $E34: result := ubcNonSpacingMark; + $E35..$E3A, $E47..$E4E, $EB1, $EB4..$EBC, $EC8..$ECD, $F18, $F19, $F35, $F37, $F39, $F71..$F7E, + $F80..$F84, $F86, $F87, $F8D..$F97, $F99..$FBC, $FC6: result := ubcNonSpacingMark; + $C78..$C7E: result := ubcOtherNeutrals; + $F3A..$F3D: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + $01000..$017FF: + case u of + $1680: result := ubcWhiteSpace; + $1000..$102A, $103F..$1055, $105A..$105D, $1061, $1065, $1066, $106E..$1070, $1075..$1081, + $108E, $1090..$1099, $109E..$10C5, $10C7, $10CD, $10D0..$1248, $124A..$124D, $1250..$1256, + $1258, $125A..$125D, $1260..$1288, $128A..$128D, $1290..$12B0, $12B2..$12B5, $12B8: result := ubcLeftToRight; + $12B9..$12BE, $12C0, $12C2..$12C5, $12C8..$12D6, $12D8..$1310, $1312..$1315, $1318..$135A, + $1360..$137C, $1380..$138F, $13A0..$13F5, $13F8..$13FD, $1401..$167F, $1681..$169A, $16A0..$16F8, + $1700..$170C, $170E..$1711, $1720..$1731, $1735, $1736, $1740..$1751, $1760..$176C, $176E..$1770, + $1780: result := ubcLeftToRight; + $1781..$17B3, $17D4..$17DA, $17DC, $17E0..$17E9: result := ubcLeftToRight; + $102B, $102C, $1031, $1038, $103B, $103C, $1056, $1057, $1062..$1064, $1067..$106D, $1083, + $1084, $1087..$108C, $108F, $109A..$109C, $17B6, $17BE..$17C5, $17C7, $17C8: result := ubcCombiningLeftToRight; + $17DB: result := ubcEuropeanNumberTerminator; + $102D..$1030, $1032..$1037, $1039, $103A, $103D, $103E, $1058, $1059, $105E..$1060, $1071..$1074, + $1082, $1085, $1086, $108D, $109D, $135D..$135F, $1712..$1714, $1732..$1734, $1752, $1753, + $1772, $1773, $17B4, $17B5, $17B7..$17BD, $17C6, $17C9..$17D3, $17DD: result := ubcNonSpacingMark; + $1390..$1399, $1400, $17F0..$17F9: result := ubcOtherNeutrals; + $169B, $169C: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + $01800..$01FFF: + case u of + $180E: result := ubcBoundaryNeutral; + $1810..$1819, $1820..$1878, $1880..$1884, $1887..$18A8, $18AA, $18B0..$18F5, $1900..$191E, + $1946..$196D, $1970..$1974, $1980..$19AB, $19B0..$19C9, $19D0..$19DA, $1A00..$1A16, $1A1E..$1A54, + $1A80..$1A89, $1A90..$1A99, $1AA0..$1AAD, $1B05..$1B33, $1B45..$1B4B, $1B50..$1B6A, $1B74..$1B7C, + $1B83: result := ubcLeftToRight; + $1923..$1926, $1929..$192B, $1930, $1931, $1933..$1938, $1A19, $1A1A, $1A55, $1A57, $1A61, + $1A63, $1A64, $1A6D..$1A72, $1B04, $1B35, $1B3B, $1B3D..$1B41, $1B43, $1B44, $1B82, $1BA1, + $1BA6, $1BA7, $1BAA, $1BE7, $1BEA..$1BEC, $1BEE: result := ubcCombiningLeftToRight; + $1B84..$1BA0, $1BAE..$1BE5, $1BFC..$1C23, $1C3B..$1C49, $1C4D..$1C88, $1C90..$1CBA, $1CBD..$1CC7, + $1CD3, $1CE9..$1CEC, $1CEE..$1CF3, $1CF5, $1CF6, $1CFA, $1D00..$1DBF, $1E00..$1F15, $1F18..$1F1D, + $1F20..$1F45, $1F48..$1F4D, $1F50..$1F57, $1F59, $1F5B, $1F5D, $1F5F: result := ubcLeftToRight; + $1F60..$1F7D, $1F80..$1FB4, $1FB6..$1FBC, $1FBE, $1FC2..$1FC4, $1FC6..$1FCC, $1FD0..$1FD3, + $1FD6..$1FDB, $1FE0..$1FEC, $1FF2..$1FF4, $1FF6..$1FFC: result := ubcLeftToRight; + $1BF2, $1BF3, $1C24..$1C2B, $1C34, $1C35, $1CE1, $1CF7: result := ubcCombiningLeftToRight; + $180B..$180D, $1885, $1886, $18A9, $1920..$1922, $1927, $1928, $1932, $1939..$193B, $1A17, + $1A18, $1A1B, $1A56, $1A58..$1A5E, $1A60, $1A62, $1A65..$1A6C, $1A73..$1A7C, $1A7F, $1AB0..$1AC0, + $1B00..$1B03, $1B34, $1B36..$1B3A, $1B3C, $1B42: result := ubcNonSpacingMark; + $1B6B..$1B73, $1B80, $1B81, $1BA2..$1BA5, $1BA8, $1BA9, $1BAB..$1BAD, $1BE6, $1BE8, $1BE9, + $1BED, $1BEF..$1BF1, $1C2C..$1C33, $1C36, $1C37, $1CD0..$1CD2, $1CD4..$1CE0, $1CE2..$1CE8, + $1CED, $1CF4, $1CF8, $1CF9, $1DC0..$1DF9, $1DFB..$1DFF: result := ubcNonSpacingMark; + $1800..$180A, $1940, $1944, $1945, $19DE..$19FF, $1FBD, $1FBF..$1FC1, $1FCD..$1FCF, $1FDD..$1FDF, + $1FED..$1FEF, $1FFD, $1FFE: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $02000..$02FFF: + case u of + $200B..$200D, $2060..$2064, $206A..$206F: result := ubcBoundaryNeutral; + $2029: result := ubcParagraphSeparator; + $2000..$200A, $2028, $205F: result := ubcWhiteSpace; + $200E, $2071, $207F, $2090..$209C, $2102, $2107, $210A..$2113, $2115, $2119..$211D, $2124, + $2126, $2128, $212A..$212D, $212F..$2139, $213C..$213F, $2145..$2149, $214E, $214F, $2160..$2188, + $2336..$237A, $2395, $249C..$24E9, $26AC: result := ubcLeftToRight; + $2800..$28FF, $2C00..$2C2E, $2C30..$2C5E, $2C60..$2CE4, $2CEB..$2CEE, $2CF2, $2CF3, $2D00..$2D25, + $2D27, $2D2D, $2D30..$2D67, $2D6F, $2D70, $2D80..$2D96, $2DA0..$2DA6, $2DA8..$2DAE, $2DB0..$2DB6, + $2DB8..$2DBE, $2DC0..$2DC6, $2DC8..$2DCE, $2DD0..$2DD6, $2DD8..$2DDE: result := ubcLeftToRight; + $200F: result := ubcRightToLeft; + $2070, $2074..$2079, $2080..$2089, $2488..$249B: result := ubcEuropeanNumber; + $207A, $207B, $208A, $208B, $2212: result := ubcEuropeanNumberSeparator; + $2030..$2034, $20A0..$20BF, $212E, $2213: result := ubcEuropeanNumberTerminator; + $202F, $2044: result := ubcCommonSeparator; + $20D0..$20F0, $2CEF..$2CF1, $2D7F, $2DE0..$2DFF: result := ubcNonSpacingMark; + $2010..$2027, $2035..$2038, $203B..$2043, $2047..$205E, $207C, $208C, $2100, $2101, $2103..$2106, + $2108, $2109, $2114, $2116..$2118, $211E..$2123, $2125, $2127, $2129, $213A, $213B, $2141..$2144, + $214A..$214D, $2150..$215F, $2189..$218B, $2190..$2200, $2205: result := ubcOtherNeutrals; + $2039, $203A, $2045, $2046, $207D, $207E, $208D, $208E, $2140, $2201..$2204, $2208..$220D, + $2211, $2215, $2216, $221A..$221D, $221F..$2222, $2224, $2226, $222B..$2233, $2239, $223B..$224C, + $2252..$2255, $225F, $2260, $2262, $2264..$226B, $226E..$228C, $228F: result := ubcMirroredNeutral; + $2206, $2207, $220E..$2210, $2214, $2217..$2219, $221E, $2223, $2225, $2227..$222A, $2234..$2238, + $223A, $224D..$2251, $2256..$225E, $2261, $2263, $226C, $226D, $228D, $228E, $2293..$2297, + $2299..$22A1, $22A4, $22A5, $22B9..$22BD, $22C0..$22C8, $22CE: result := ubcOtherNeutrals; + $22CF, $22D2..$22D5, $22EE, $22EF, $2300..$2307, $230C..$231F, $2322..$2328, $232B..$2335, + $237B..$2394, $2396..$2426, $2440..$244A, $2460..$2487, $24EA..$26AB, $26AD..$2767, $2776..$27BF, + $27C1, $27C2, $27C7, $27CA, $27CE..$27D2, $27D7..$27DB, $27DF..$27E1, $27F0..$27FF, $2900: result := ubcOtherNeutrals; + $2290..$2292, $2298, $22A2, $22A3, $22A6..$22B8, $22BE, $22BF, $22C9..$22CD, $22D0, $22D1, + $22D6..$22ED, $22F0..$22FF, $2308..$230B, $2320, $2321, $2329, $232A, $2768..$2775, $27C0, + $27C3..$27C6, $27C8, $27C9, $27CB..$27CD, $27D3..$27D6, $27DC..$27DE, $27E2..$27EF, $2983..$2998, + $299B: result := ubcMirroredNeutral; + $2901..$2982, $2999, $299A, $29A1, $29B0..$29B7, $29B9..$29BF, $29C6..$29C8, $29CA..$29CD, + $29D3, $29D6, $29D7, $29DD..$29E0, $29E2, $29E6, $29E7, $29EA..$29F3, $29FA, $29FB, $29FE..$2A09, + $2A1D, $2A22, $2A23, $2A25, $2A27, $2A28, $2A2A, $2A2F..$2A33, $2A36: result := ubcOtherNeutrals; + $299C..$29A0, $29A2..$29AF, $29B8, $29C0..$29C5, $29C9, $29CE..$29D2, $29D4, $29D5, $29D8..$29DC, + $29E1, $29E3..$29E5, $29E8, $29E9, $29F4..$29F9, $29FC, $29FD, $2A0A..$2A1C, $2A1E..$2A21, + $2A24, $2A26, $2A29, $2A2B..$2A2E, $2A34, $2A35, $2A3C..$2A3E, $2A57: result := ubcMirroredNeutral; + $2A37..$2A3B, $2A3F..$2A56, $2A59..$2A63, $2A66..$2A69, $2A6E, $2A71, $2A72, $2A75..$2A78, + $2AA4, $2AA5, $2AAE, $2AD7..$2ADB, $2ADD, $2ADF..$2AE1, $2AE7..$2AEB, $2AEF..$2AF2, $2AF4..$2AF6, + $2AFC, $2AFE..$2B73, $2B76..$2B95, $2B97..$2BFD, $2BFF, $2CE5..$2CEA, $2CF9: result := ubcOtherNeutrals; + $2CFA..$2CFF, $2E00, $2E01, $2E06..$2E08, $2E0B, $2E0E..$2E1B, $2E1E, $2E1F, $2E2A..$2E52, + $2E80..$2E99, $2E9B..$2EF3, $2F00..$2FD5, $2FF0..$2FFB: result := ubcOtherNeutrals; + $2A58, $2A64, $2A65, $2A6A..$2A6D, $2A6F, $2A70, $2A73, $2A74, $2A79..$2AA3, $2AA6..$2AAD, + $2AAF..$2AD6, $2ADC, $2ADE, $2AE2..$2AE6, $2AEC..$2AEE, $2AF3, $2AF7..$2AFB, $2AFD, $2BFE, + $2E02..$2E05, $2E09, $2E0A, $2E0C, $2E0D, $2E1C, $2E1D, $2E20..$2E29: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + else + case u of + $3000: result := ubcWhiteSpace; + $3005..$3007, $3021..$3029, $3031..$3035, $3038..$303C, $3041..$3096, $309D..$309F, $30A1..$30FA, + $30FC..$30FF, $3105..$312F, $3131..$318E, $3190..$31BF, $31F0..$321C, $3220..$324F, $3260..$327B, + $327F..$32B0, $32C0..$32CB, $32D0..$3376, $337B..$33DD, $33E0..$33FE, $3400, $4DBF, $4E00: result := ubcLeftToRight; + $302E, $302F: result := ubcCombiningLeftToRight; + $302A..$302D, $3099, $309A: result := ubcNonSpacingMark; + $3001..$3004, $3012, $3013, $301C..$3020, $3030, $3036, $3037, $303D..$303F, $309B, $309C, + $30A0, $30FB, $31C0..$31E3, $321D, $321E, $3250..$325F, $327C..$327E, $32B1..$32BF, $32CC..$32CF, + $3377..$337A, $33DE, $33DF, $33FF, $4DC0..$4DFF: result := ubcOtherNeutrals; + $3008..$3011, $3014..$301B: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + end; + $08000..$0BFFF: + case u of + $9FFC, $A000..$A48C, $A4D0..$A60C, $A610..$A62B, $A640..$A66E, $A680..$A69D, $A6A0..$A6EF, + $A6F2..$A6F7, $A722..$A787, $A789..$A7BF, $A7C2..$A7CA, $A7F5..$A801, $A803..$A805, $A807..$A80A, + $A80C..$A822, $A830..$A837, $A840..$A873, $A882..$A8B3, $A8CE..$A8D9, $A8F2..$A8FE, $A900..$A925, + $A92E: result := ubcLeftToRight; + $A92F..$A946, $A95F..$A97C, $A984..$A9B2, $A9C1..$A9CD, $A9CF..$A9D9, $A9DE..$A9E4, $A9E6..$A9FE, + $AA00..$AA28, $AA40..$AA42, $AA44..$AA4B, $AA50..$AA59, $AA5C..$AA7A, $AA7E..$AAAF, $AAB1, + $AAB5, $AAB6, $AAB9..$AABD, $AAC0, $AAC2, $AADB..$AAEA, $AAF0..$AAF4, $AB01..$AB06, $AB09: result := ubcLeftToRight; + $AB0A..$AB0E, $AB11..$AB16, $AB20..$AB26, $AB28..$AB2E, $AB30..$AB69, $AB70..$ABE2, $ABEB, + $ABF0..$ABF9, $AC00: result := ubcLeftToRight; + $A823, $A824, $A827, $A880, $A881, $A8B4..$A8C3, $A952, $A953, $A983, $A9B4, $A9B5, $A9BA, + $A9BB, $A9BE..$A9C0, $AA2F, $AA30, $AA33, $AA34, $AA4D, $AA7B, $AA7D, $AAEB, $AAEE, $AAEF, + $AAF5, $ABE3, $ABE4, $ABE6, $ABE7, $ABE9, $ABEA, $ABEC: result := ubcCombiningLeftToRight; + $A838, $A839: result := ubcEuropeanNumberTerminator; + $A66F..$A672, $A674..$A67D, $A69E, $A69F, $A6F0, $A6F1, $A802, $A806, $A80B, $A825, $A826, + $A82C, $A8C4, $A8C5, $A8E0..$A8F1, $A8FF, $A926..$A92D, $A947..$A951, $A980..$A982, $A9B3, + $A9B6..$A9B9, $A9BC, $A9BD, $A9E5, $AA29..$AA2E, $AA31, $AA32, $AA35: result := ubcNonSpacingMark; + $AA36, $AA43, $AA4C, $AA7C, $AAB0, $AAB2..$AAB4, $AAB7, $AAB8, $AABE, $AABF, $AAC1, $AAEC, + $AAED, $AAF6, $ABE5, $ABE8, $ABED: result := ubcNonSpacingMark; + $A490..$A4C6, $A60D..$A60F, $A673, $A67E, $A67F, $A700..$A721, $A788, $A828..$A82B, $A874..$A877, + $AB6A, $AB6B: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $0C000..$0FFFF: + case u of + $FEFF: result := ubcBoundaryNeutral; + $D7A3, $D7B0..$D7C6, $D7CB..$D7FB, $D800, $DB7F, $DB80, $DBFF, $DC00, $DFFF, $E000, $F8FF..$FA6D, + $FA70..$FAD9, $FB00..$FB06, $FB13..$FB17, $FF21..$FF3A, $FF41..$FF5A, $FF66..$FFBE, $FFC2..$FFC7, + $FFCA..$FFCF, $FFD2..$FFD7, $FFDA..$FFDC: result := ubcLeftToRight; + $FB1D, $FB1F..$FB28, $FB2A..$FB36, $FB38..$FB3C, $FB3E, $FB40, $FB41, $FB43, $FB44, $FB46..$FB4F: result := ubcRightToLeft; + $FB50..$FBC1, $FBD3..$FD3D, $FD50..$FD8F, $FD92..$FDC7, $FDF0..$FDFC, $FE70..$FE74, $FE76..$FEFC: result := ubcArabicLetter; + $FF10..$FF19: result := ubcEuropeanNumber; + $FB29, $FE62, $FE63, $FF0B, $FF0D: result := ubcEuropeanNumberSeparator; + $FE5F, $FE69, $FE6A, $FF03..$FF05, $FFE0, $FFE1, $FFE5, $FFE6: result := ubcEuropeanNumberTerminator; + $FE50, $FE52, $FE55, $FF0C, $FF0E, $FF0F, $FF1A: result := ubcCommonSeparator; + $FB1E, $FE00..$FE0F, $FE20..$FE2F: result := ubcNonSpacingMark; + $FD3E, $FD3F, $FDFD, $FE10..$FE19, $FE30..$FE4F, $FE51, $FE54, $FE56..$FE58, $FE60, $FE61, + $FE66, $FE68, $FE6B, $FF01, $FF02, $FF06, $FF07, $FF0A, $FF1B, $FF1D, $FF1F, $FF20, $FF3C, + $FF3E..$FF40, $FF5C, $FF5E, $FF61: result := ubcOtherNeutrals; + $FF64, $FF65, $FFE2..$FFE4, $FFE8..$FFEE, $FFF9..$FFFD: result := ubcOtherNeutrals; + $FE59..$FE5E, $FE64, $FE65, $FF08, $FF09, $FF1C, $FF1E, $FF3B, $FF3D, $FF5B, $FF5D, $FF5F, + $FF60, $FF62, $FF63: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + else + case u of + $10000..$107FF: + case u of + $10000..$1000B, $1000D..$10026, $10028..$1003A, $1003C, $1003D, $1003F..$1004D, $10050..$1005D, + $10080..$100FA, $10100, $10102, $10107..$10133, $10137..$1013F, $1018D, $1018E, $101D0..$101FC, + $10280..$1029C, $102A0..$102D0, $10300..$10323, $1032D..$1034A, $10350..$10375, $10380..$1039D, + $1039F..$103C3, $103C8..$103D5, $10400: result := ubcLeftToRight; + $10401..$1049D, $104A0..$104A9, $104B0..$104D3, $104D8..$104FB, $10500..$10527, $10530..$10563, + $1056F, $10600..$10736, $10740..$10755, $10760..$10767: result := ubcLeftToRight; + $102E1..$102FB: result := ubcEuropeanNumber; + $101FD, $102E0, $10376..$1037A: result := ubcNonSpacingMark; + $10101, $10140..$1018C, $10190..$1019C, $101A0: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $10800..$10FFF: + case u of + $10800..$10805, $10808, $1080A..$10835, $10837, $10838, $1083C, $1083F..$10855, $10857..$1089E, + $108A7..$108AF, $108E0..$108F2, $108F4, $108F5, $108FB..$1091B, $10920..$10939, $1093F, + $10980..$109B7, $109BC..$109CF, $109D2..$10A00, $10A10..$10A13, $10A15..$10A17, $10A19..$10A35, + $10A40..$10A48, $10A50..$10A58, $10A60: result := ubcRightToLeft; + $10A61..$10A9F, $10AC0..$10AE4, $10AEB..$10AF6, $10B00..$10B35, $10B40..$10B55, $10B58..$10B72, + $10B78..$10B91, $10B99..$10B9C, $10BA9..$10BAF, $10C00..$10C48, $10C80..$10CB2, $10CC0..$10CF2, + $10CFA..$10CFF, $10E80..$10EA9, $10EAD, $10EB0, $10EB1, $10F00..$10F27, $10FB0..$10FCB, + $10FE0..$10FF6: result := ubcRightToLeft; + $10D00..$10D23, $10F30..$10F45, $10F51..$10F59: result := ubcArabicLetter; + $10D30..$10D39, $10E60..$10E7E: result := ubcArabicNumber; + $10A01..$10A03, $10A05, $10A06, $10A0C..$10A0F, $10A38..$10A3A, $10A3F, $10AE5, $10AE6, + $10D24..$10D27, $10EAB, $10EAC, $10F46..$10F50: result := ubcNonSpacingMark; + $1091F, $10B39..$10B3F: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $11000..$117FF: + case u of + $11003..$11037, $11047..$1104D, $11066..$1106F, $11083..$110AF, $110BB..$110C1, $110CD, + $110D0..$110E8, $110F0..$110F9, $11103..$11126, $11136..$11144, $11147, $11150..$11172, + $11174..$11176, $11183..$111B2, $111C1..$111C8, $111CD, $111D0..$111DF, $111E1..$111F4, + $11200..$11211, $11213..$1122B, $11238..$1123D, $11280: result := ubcLeftToRight; + $11000, $11002, $11082, $110B0..$110B2, $110B7, $110B8, $1112C, $11145, $11146, $11182, + $111B3..$111B5, $111BF, $111C0, $111CE, $1122C..$1122E, $11232, $11233, $11235, $112E0..$112E2, + $11302, $11303, $1133E, $1133F, $11341..$11344, $11347, $11348, $1134B..$1134D, $11357, + $11362: result := ubcCombiningLeftToRight; + $11281..$11286, $11288, $1128A..$1128D, $1128F..$1129D, $1129F..$112A9, $112B0..$112DE, + $112F0..$112F9, $11305..$1130C, $1130F, $11310, $11313..$11328, $1132A..$11330, $11332, + $11333, $11335..$11339, $1133D, $11350, $1135D..$11361, $11400..$11434, $11447..$1145B, + $1145D, $1145F..$11461, $11480..$114AF, $114C4: result := ubcLeftToRight; + $114C5..$114C7, $114D0..$114D9, $11580..$115AE, $115C1..$115DB, $11600..$1162F, $11641..$11644, + $11650..$11659, $11680..$116AA, $116B8, $116C0..$116C9, $11700..$1171A, $11730..$1173F: result := ubcLeftToRight; + $11363, $11435..$11437, $11440, $11441, $11445, $114B0..$114B2, $114B9, $114BB..$114BE, + $114C1, $115AF..$115B1, $115B8..$115BB, $115BE, $11630..$11632, $1163B, $1163C, $1163E, + $116AC, $116AE, $116AF, $116B6, $11720, $11721, $11726: result := ubcCombiningLeftToRight; + $11001, $11038..$11046, $1107F..$11081, $110B3..$110B6, $110B9, $110BA, $11100..$11102, + $11127..$1112B, $1112D..$11134, $11173, $11180, $11181, $111B6..$111BE, $111C9..$111CC, + $111CF, $1122F..$11231, $11234, $11236, $11237, $1123E, $112DF, $112E3..$112EA, $11300, + $11301, $1133B, $1133C, $11340: result := ubcNonSpacingMark; + $11366..$1136C, $11370..$11374, $11438..$1143F, $11442..$11444, $11446, $1145E, $114B3..$114B8, + $114BA, $114BF, $114C0, $114C2, $114C3, $115B2..$115B5, $115BC, $115BD, $115BF, $115C0, + $115DC, $115DD, $11633..$1163A, $1163D, $1163F, $11640, $116AB, $116AD, $116B0..$116B5, + $116B7, $1171D: result := ubcNonSpacingMark; + $1171E, $1171F, $11722..$11725, $11727..$1172B: result := ubcNonSpacingMark; + $11052..$11065, $11660..$1166C: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $11800..$17FFF: + case u of + $11800..$1182B, $1183B, $118A0..$118F2, $118FF..$11906, $11909, $1190C..$11913, $11915, + $11916, $11918..$1192F, $1193F, $11941, $11944..$11946, $11950..$11959, $119A0..$119A7, + $119AA..$119D0, $119E1..$119E3, $11A00, $11A07, $11A08, $11A0B..$11A32, $11A3A, $11A3F..$11A46, + $11A50, $11A5C: result := ubcLeftToRight; + $1182C..$1182E, $11838, $11930..$11935, $11937, $11938, $1193D, $11940, $11942, $119D1..$119D3, + $119DC..$119DF, $119E4, $11A39, $11A57, $11A58, $11A97, $11C2F, $11C3E, $11CA9, $11CB1, + $11CB4, $11D8A..$11D8E, $11D93, $11D94, $11D96, $11EF5: result := ubcCombiningLeftToRight; + $11A5D..$11A89, $11A9A..$11AA2, $11AC0..$11AF8, $11C00..$11C08, $11C0A..$11C2E, $11C3F..$11C45, + $11C50..$11C6C, $11C70..$11C8F, $11D00..$11D06, $11D08, $11D09, $11D0B..$11D30, $11D46, + $11D50..$11D59, $11D60..$11D65, $11D67, $11D68, $11D6A..$11D89, $11D98, $11DA0..$11DA9, + $11EE0..$11EF2, $11EF7, $11EF8, $11FB0, $11FC0: result := ubcLeftToRight; + $11FC1..$11FD4, $11FFF..$12399, $12400..$1246E, $12470..$12474, $12480..$12543, $13000..$1342E, + $13430..$13438, $14400..$14646, $16800..$16A38, $16A40..$16A5E, $16A60..$16A69, $16A6E, + $16A6F, $16AD0..$16AED, $16AF5, $16B00..$16B2F, $16B37..$16B45, $16B50..$16B59, $16B5B..$16B61, + $16B63..$16B77, $16B7D..$16B8F, $16E40..$16E9A, $16F00: result := ubcLeftToRight; + $16F01..$16F4A, $16F50, $16F93..$16F9F, $16FE0, $16FE1, $16FE3, $17000: result := ubcLeftToRight; + $11EF6, $16F51..$16F87, $16FF0, $16FF1: result := ubcCombiningLeftToRight; + $11FDD..$11FE0: result := ubcEuropeanNumberTerminator; + $1182F..$11837, $11839, $1183A, $1193B, $1193C, $1193E, $11943, $119D4..$119D7, $119DA, + $119DB, $119E0, $11A01..$11A06, $11A09, $11A0A, $11A33..$11A38, $11A3B..$11A3E, $11A47, + $11A51..$11A56, $11A59..$11A5B, $11A8A..$11A96, $11A98, $11A99, $11C30..$11C36, $11C38..$11C3D, + $11C92..$11CA7, $11CAA..$11CB0, $11CB2: result := ubcNonSpacingMark; + $11CB3, $11CB5, $11CB6, $11D31..$11D36, $11D3A, $11D3C, $11D3D, $11D3F..$11D45, $11D47, + $11D90, $11D91, $11D95, $11D97, $11EF3, $11EF4, $16AF0..$16AF4, $16B30..$16B36, $16F4F, + $16F8F..$16F92, $16FE4: result := ubcNonSpacingMark; + $11FD5..$11FDC, $11FE1..$11FF1, $16FE2: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + $18000..$1DFFF: + case u of + $1BCA0..$1BCA3, $1D173..$1D17A: result := ubcBoundaryNeutral; + $187F7, $18800..$18CD5, $18D00, $18D08, $1B000..$1B11E, $1B150..$1B152, $1B164..$1B167, + $1B170..$1B2FB, $1BC00..$1BC6A, $1BC70..$1BC7C, $1BC80..$1BC88, $1BC90..$1BC99, $1BC9C, + $1BC9F, $1D000..$1D0F5, $1D100..$1D126, $1D129..$1D164, $1D16A..$1D16C, $1D183, $1D184, + $1D18C..$1D1A9, $1D1AE..$1D1E8, $1D2E0: result := ubcLeftToRight; + $1D2E1..$1D2F3, $1D360..$1D378, $1D400..$1D454, $1D456..$1D49C, $1D49E, $1D49F, $1D4A2, + $1D4A5, $1D4A6, $1D4A9..$1D4AC, $1D4AE..$1D4B9, $1D4BB, $1D4BD..$1D4C3, $1D4C5..$1D505, + $1D507..$1D50A, $1D50D..$1D514, $1D516..$1D51C, $1D51E..$1D539, $1D53B..$1D53E, $1D540..$1D544, + $1D546, $1D54A..$1D550, $1D552..$1D6A5, $1D6A8: result := ubcLeftToRight; + $1D6A9..$1D6DA, $1D6DC..$1D714, $1D716..$1D74E, $1D750..$1D788, $1D78A..$1D7C2, $1D7C4..$1D7CB, + $1D800..$1D9FF, $1DA37..$1DA3A, $1DA6D..$1DA74, $1DA76..$1DA83, $1DA85..$1DA8B: result := ubcLeftToRight; + $1D165, $1D166, $1D16D..$1D172: result := ubcCombiningLeftToRight; + $1D7CE..$1D7FF: result := ubcEuropeanNumber; + $1BC9D, $1BC9E, $1D167..$1D169, $1D17B..$1D182, $1D185..$1D18B, $1D1AA..$1D1AD, $1D242..$1D244, + $1DA00..$1DA36, $1DA3B..$1DA6C, $1DA75, $1DA84, $1DA9B..$1DA9F, $1DAA1..$1DAAF: result := ubcNonSpacingMark; + $1D200..$1D241, $1D245, $1D300..$1D356: result := ubcOtherNeutrals; + $1D6DB, $1D715, $1D74F, $1D789, $1D7C3: result := ubcMirroredNeutral; + else result := ubcUnknown; + end; + $1E000..$FFFFF: + case u of + $E0001, $E0020..$E007F: result := ubcBoundaryNeutral; + $1EC71..$1ECB4, $1ED01..$1ED3D, $1EE00..$1EE03, $1EE05..$1EE1F, $1EE21, $1EE22, $1EE24, + $1EE27, $1EE29..$1EE32, $1EE34..$1EE37, $1EE39, $1EE3B, $1EE42, $1EE47, $1EE49, $1EE4B, + $1EE4D..$1EE4F, $1EE51, $1EE52, $1EE54, $1EE57, $1EE59, $1EE5B, $1EE5D: result := ubcArabicLetter; + $1E100..$1E12C, $1E137..$1E13D, $1E140..$1E149, $1E14E, $1E14F, $1E2C0..$1E2EB, $1E2F0..$1E2F9, + $1F110..$1F12E, $1F130..$1F169, $1F170..$1F1AC, $1F1E6..$1F202, $1F210..$1F23B, $1F240..$1F248, + $1F250, $1F251, $20000, $2A6DD, $2A700, $2B734, $2B740, $2B81D, $2B820, $2CEA1, $2CEB0: result := ubcLeftToRight; + $2EBE0, $2F800..$2FA1D, $30000, $3134A, $F0000, $FFFFD: result := ubcLeftToRight; + $1E800..$1E8C4, $1E8C7..$1E8CF, $1E900..$1E943, $1E94B, $1E950..$1E959, $1E95E, $1E95F: result := ubcRightToLeft; + $1EE5F, $1EE61, $1EE62, $1EE64, $1EE67..$1EE6A, $1EE6C..$1EE72, $1EE74..$1EE77, $1EE79..$1EE7C, + $1EE7E, $1EE80..$1EE89, $1EE8B..$1EE9B, $1EEA1..$1EEA3, $1EEA5..$1EEA9, $1EEAB..$1EEBB: result := ubcArabicLetter; + $1F100..$1F10A, $1FBF0..$1FBF9: result := ubcEuropeanNumber; + $1E2FF: result := ubcEuropeanNumberTerminator; + $1E000..$1E006, $1E008..$1E018, $1E01B..$1E021, $1E023, $1E024, $1E026..$1E02A, $1E130..$1E136, + $1E2EC..$1E2EF, $1E8D0..$1E8D6, $1E944..$1E94A, $E0100..$E01EF: result := ubcNonSpacingMark; + $1EEF0, $1EEF1, $1F000..$1F02B, $1F030..$1F093, $1F0A0..$1F0AE, $1F0B1..$1F0BF, $1F0C1..$1F0CF, + $1F0D1..$1F0F5, $1F10B..$1F10F, $1F12F, $1F16A..$1F16F, $1F1AD, $1F260..$1F265, $1F300..$1F6D7, + $1F6E0..$1F6EC, $1F6F0..$1F6FC, $1F700..$1F773, $1F780..$1F7D8, $1F7E0..$1F7EB, $1F800..$1F80B, + $1F810..$1F847, $1F850..$1F859, $1F860: result := ubcOtherNeutrals; + $1F861..$1F887, $1F890..$1F8AD, $1F8B0, $1F8B1, $1F900..$1F978, $1F97A..$1F9CB, $1F9CD..$1FA53, + $1FA60..$1FA6D, $1FA70..$1FA74, $1FA78..$1FA7A, $1FA80..$1FA86, $1FA90..$1FAA8, $1FAB0..$1FAB6, + $1FAC0..$1FAC2, $1FAD0..$1FAD6, $1FB00..$1FB92, $1FB94..$1FBCA: result := ubcOtherNeutrals; + else result := ubcUnknown; + end; + else result := ubcUnknown; + end + end +end; + +function GetUnicodeBracketInfo(u: LongWord): TUnicodeBracketInfo; + procedure Bracket(AOpening,AClosing: LongWord); + begin + result.IsBracket := true; + result.OpeningBracket := AOpening; + result.ClosingBracket := AClosing; + end; +begin + case u of + $0028, $0029: Bracket($0028, $0029); + $005B, $005D: Bracket($005B, $005D); + $007B, $007D: Bracket($007B, $007D); + $0F3A, $0F3B: Bracket($0F3A, $0F3B); + $0F3C, $0F3D: Bracket($0F3C, $0F3D); + $169B, $169C: Bracket($169B, $169C); + $2045, $2046: Bracket($2045, $2046); + $207D, $207E: Bracket($207D, $207E); + $208D, $208E: Bracket($208D, $208E); + $2308, $2309: Bracket($2308, $2309); + $230A, $230B: Bracket($230A, $230B); + $2329, $232A: Bracket($2329, $232A); + $2768, $2769: Bracket($2768, $2769); + $276A, $276B: Bracket($276A, $276B); + $276C, $276D: Bracket($276C, $276D); + $276E, $276F: Bracket($276E, $276F); + $2770, $2771: Bracket($2770, $2771); + $2772, $2773: Bracket($2772, $2773); + $2774, $2775: Bracket($2774, $2775); + $27C5, $27C6: Bracket($27C5, $27C6); + $27E6, $27E7: Bracket($27E6, $27E7); + $27E8, $27E9: Bracket($27E8, $27E9); + $27EA, $27EB: Bracket($27EA, $27EB); + $27EC, $27ED: Bracket($27EC, $27ED); + $27EE, $27EF: Bracket($27EE, $27EF); + $2983, $2984: Bracket($2983, $2984); + $2985, $2986: Bracket($2985, $2986); + $2987, $2988: Bracket($2987, $2988); + $2989, $298A: Bracket($2989, $298A); + $298B, $298C: Bracket($298B, $298C); + $298D, $2990: Bracket($298D, $2990); + $298F, $298E: Bracket($298F, $298E); + $2991, $2992: Bracket($2991, $2992); + $2993, $2994: Bracket($2993, $2994); + $2995, $2996: Bracket($2995, $2996); + $2997, $2998: Bracket($2997, $2998); + $29D8, $29D9: Bracket($29D8, $29D9); + $29DA, $29DB: Bracket($29DA, $29DB); + $29FC, $29FD: Bracket($29FC, $29FD); + $2E22, $2E23: Bracket($2E22, $2E23); + $2E24, $2E25: Bracket($2E24, $2E25); + $2E26, $2E27: Bracket($2E26, $2E27); + $2E28, $2E29: Bracket($2E28, $2E29); + $3008, $3009: Bracket($3008, $3009); + $300A, $300B: Bracket($300A, $300B); + $300C, $300D: Bracket($300C, $300D); + $300E, $300F: Bracket($300E, $300F); + $3010, $3011: Bracket($3010, $3011); + $3014, $3015: Bracket($3014, $3015); + $3016, $3017: Bracket($3016, $3017); + $3018, $3019: Bracket($3018, $3019); + $301A, $301B: Bracket($301A, $301B); + $FE59, $FE5A: Bracket($FE59, $FE5A); + $FE5B, $FE5C: Bracket($FE5B, $FE5C); + $FE5D, $FE5E: Bracket($FE5D, $FE5E); + $FF08, $FF09: Bracket($FF08, $FF09); + $FF3B, $FF3D: Bracket($FF3B, $FF3D); + $FF5B, $FF5D: Bracket($FF5B, $FF5D); + $FF5F, $FF60: Bracket($FF5F, $FF60); + $FF62, $FF63: Bracket($FF62, $FF63); + else + begin + result.IsBracket := false; + result.OpeningBracket := 0; + result.ClosingBracket := 0; + end; + end; +end; + +function GetUnicodeJoiningType(u: LongWord): TUnicodeJoiningType; +begin + result := ujtNonJoining; + if u <= $001BE8 then begin + if u <= $0009CD then begin + if u <= $00072C then begin + if u <= $00069A then + case u of + $AD, $300..$36F, $483..$489, $591..$5BD, $5BF, $5C1, $5C2, $5C4, $5C5, $5C7, $610..$61A, + $61C, $64B..$65F, $670: result := ujtTransparent; + $622..$625, $627, $629, $62F..$632, $648, $671..$673, $675..$677, $688..$699: result := ujtRightJoining; + $620, $626, $628, $62A..$62E, $633..$63F, $641..$647, $649, $64A, $66E, $66F, $678..$687, + $69A: result := ujtDualJoining; + $640: result := ujtJoinCausing; + end + else + case u of + $6D6..$6DC, $6DF..$6E4, $6E7, $6E8, $6EA..$6ED, $70F, $711: result := ujtTransparent; + $6C0, $6C3..$6CB, $6CD, $6CF, $6D2, $6D3, $6D5, $6EE, $6EF, $710, $715..$719, $71E, + $728, $72A, $72C: result := ujtRightJoining; + $69B..$6BF, $6C1, $6C2, $6CC, $6CE, $6D0, $6D1, $6FA..$6FC, $6FF, $712..$714, $71A..$71D, + $71F..$727, $729, $72B: result := ujtDualJoining; + end + end else begin + if u <= $00084A then + case u of + $730..$74A, $7A6..$7B0, $7EB..$7F3, $7FD, $816..$819, $81B..$823, $825..$827, $829..$82D: result := ujtTransparent; + $72F, $74D, $759..$75B, $76B, $76C, $771, $773, $774, $778, $779, $840, $846, $847, + $849: result := ujtRightJoining; + $72D, $72E, $74E..$758, $75C..$76A, $76D..$770, $772, $775..$777, $77A..$77F, $7CA..$7EA, + $841..$845, $848, $84A: result := ujtDualJoining; + $7FA: result := ujtJoinCausing; + end + else + case u of + $859..$85B, $8D3..$8E1, $8E3..$902, $93A, $93C, $941..$948, $94D, $951..$957, $962, + $963, $981, $9BC, $9C1..$9C4, $9CD: result := ujtTransparent; + $854, $856..$858, $867, $869, $86A, $8AA..$8AC, $8AE, $8B1, $8B2, $8B9: result := ujtRightJoining; + $84B..$853, $855, $860, $862..$865, $868, $8A0..$8A9, $8AF, $8B0, $8B3, $8B4, $8B6..$8B8, + $8BA..$8C7: result := ujtDualJoining; + end + end + end else begin + if u <= $000F71 then begin + if u <= $000C3E then + case u of + $9E2, $9E3, $9FE, $A01, $A02, $A3C, $A41, $A42, $A47, $A48, $A4B..$A4D, $A51, $A70, + $A71, $A75, $A81, $A82, $ABC, $AC1..$AC5, $AC7, $AC8, $ACD, $AE2, $AE3, $AFA..$AFF, + $B01, $B3C, $B3F, $B41..$B44, $B4D, $B55, $B56, $B62, $B63, $B82, $BC0, $BCD, $C00, + $C04, $C3E: result := ujtTransparent; + end + else + case u of + $C3F, $C40, $C46..$C48, $C4A..$C4D, $C55, $C56, $C62, $C63, $C81, $CBC, $CBF, $CC6, + $CCC, $CCD, $CE2, $CE3, $D00, $D01, $D3B, $D3C, $D41..$D44, $D4D, $D62, $D63, $D81, + $DCA, $DD2..$DD4, $DD6, $E31, $E34..$E3A, $E47..$E4E, $EB1, $EB4..$EBC, $EC8..$ECD, + $F18, $F19, $F35, $F37, $F39, $F71: result := ujtTransparent; + end + end else begin + if u <= $001820 then + case u of + $F72..$F7E, $F80..$F84, $F86, $F87, $F8D..$F97, $F99..$FBC, $FC6, $102D..$1030, $1032..$1037, + $1039, $103A, $103D, $103E, $1058, $1059, $105E..$1060, $1071..$1074, $1082, $1085, + $1086, $108D, $109D, $135D..$135F, $1712..$1714, $1732..$1734, $1752, $1753, $1772, + $1773, $17B4, $17B5, $17B7..$17BD, $17C6, $17C9..$17D3, $17DD, $180B..$180D: result := ujtTransparent; + $1807, $1820: result := ujtDualJoining; + $180A: result := ujtJoinCausing; + end + else + case u of + $1885, $1886, $18A9, $1920..$1922, $1927, $1928, $1932, $1939..$193B, $1A17, $1A18, + $1A1B, $1A56, $1A58..$1A5E, $1A60, $1A62, $1A65..$1A6C, $1A73..$1A7C, $1A7F, $1AB0..$1AC0, + $1B00..$1B03, $1B34, $1B36..$1B3A, $1B3C, $1B42, $1B6B..$1B73, $1B80, $1B81, $1BA2..$1BA5, + $1BA8, $1BA9, $1BAB..$1BAD, $1BE6, $1BE8: result := ujtTransparent; + $1821..$1878, $1887..$18A8, $18AA: result := ujtDualJoining; + end + end + end + end else begin + if u <= $010FB8 then begin + if u <= $00ABE8 then begin + if u <= $00A806 then + case u of + $1BE9, $1BED, $1BEF..$1BF1, $1C2C..$1C33, $1C36, $1C37, $1CD0..$1CD2, $1CD4..$1CE0, + $1CE2..$1CE8, $1CED, $1CF4, $1CF8, $1CF9, $1DC0..$1DF9, $1DFB..$1DFF, $200B, $200E, + $200F, $202A..$202E, $2060..$2064, $206A..$206F, $20D0..$20F0, $2CEF..$2CF1, $2D7F, + $2DE0..$2DFF, $302A..$302D, $3099, $309A, $A66F..$A672, $A674..$A67D, $A69E, $A69F, + $A6F0, $A6F1, $A802, $A806: result := ujtTransparent; + $200D: result := ujtJoinCausing; + end + else + case u of + $A80B, $A825, $A826, $A82C, $A8C4, $A8C5, $A8E0..$A8F1, $A8FF, $A926..$A92D, $A947..$A951, + $A980..$A982, $A9B3, $A9B6..$A9B9, $A9BC, $A9BD, $A9E5, $AA29..$AA2E, $AA31, $AA32, + $AA35, $AA36, $AA43, $AA4C, $AA7C, $AAB0, $AAB2..$AAB4, $AAB7, $AAB8, $AABE, $AABF, + $AAC1, $AAEC, $AAED, $AAF6, $ABE5, $ABE8: result := ujtTransparent; + $A872: result := ujtLeftJoining; + $A840..$A871: result := ujtDualJoining; + end + end else begin + if u <= $010AEF then + case u of + $ABED, $FB1E, $FE00..$FE0F, $FE20..$FE2F, $FEFF, $FFF9..$FFFB, $101FD, $102E0, $10376..$1037A, + $10A01..$10A03, $10A05, $10A06, $10A0C..$10A0F, $10A38..$10A3A, $10A3F, $10AE5, $10AE6: result := ujtTransparent; + $10AC5, $10AC7, $10AC9, $10ACA, $10ACE..$10AD2, $10ADD, $10AE1, $10AE4, $10AEF: result := ujtRightJoining; + $10ACD, $10AD7: result := ujtLeftJoining; + $10AC0..$10AC4, $10AD3..$10AD6, $10AD8..$10ADC, $10ADE..$10AE0, $10AEB..$10AEE: result := ujtDualJoining; + end + else + case u of + $10D24..$10D27, $10EAB, $10EAC, $10F46..$10F50: result := ujtTransparent; + $10B81, $10B83..$10B85, $10B89, $10B8C, $10B8E, $10B8F, $10B91, $10BA9..$10BAC, $10D22, + $10F33, $10F54, $10FB4..$10FB6: result := ujtRightJoining; + $10D00: result := ujtLeftJoining; + $10B80, $10B82, $10B86..$10B88, $10B8A, $10B8B, $10B8D, $10B90, $10BAD, $10BAE, $10D01..$10D21, + $10D23, $10F30..$10F32, $10F34..$10F44, $10F51..$10F53, $10FB0, $10FB2, $10FB3, $10FB8: result := ujtDualJoining; + end + end + end else begin + if u <= $01193E then begin + if u <= $011300 then + case u of + $11001, $11038..$11046, $1107F..$11081, $110B3..$110B6, $110B9, $110BA, $11100..$11102, + $11127..$1112B, $1112D..$11134, $11173, $11180, $11181, $111B6..$111BE, $111C9..$111CC, + $111CF, $1122F..$11231, $11234, $11236, $11237, $1123E, $112DF, $112E3..$112EA, $11300: result := ujtTransparent; + $10FB9, $10FBA, $10FBD, $10FC2, $10FC3, $10FC9: result := ujtRightJoining; + $10FCB: result := ujtLeftJoining; + $10FBB, $10FBC, $10FBE, $10FBF, $10FC1, $10FC4, $10FCA: result := ujtDualJoining; + end + else + case u of + $11301, $1133B, $1133C, $11340, $11366..$1136C, $11370..$11374, $11438..$1143F, $11442..$11444, + $11446, $1145E, $114B3..$114B8, $114BA, $114BF, $114C0, $114C2, $114C3, $115B2..$115B5, + $115BC, $115BD, $115BF, $115C0, $115DC, $115DD, $11633..$1163A, $1163D, $1163F, $11640, + $116AB, $116AD, $116B0..$116B5, $116B7, $1171D..$1171F, $11722..$11725, $11727..$1172B, + $1182F..$11837, $11839, $1183A, $1193B, $1193C, $1193E: result := ujtTransparent; + end + end else begin + if u <= $016AF0 then + case u of + $11943, $119D4..$119D7, $119DA, $119DB, $119E0, $11A01..$11A0A, $11A33..$11A38, $11A3B..$11A3E, + $11A47, $11A51..$11A56, $11A59..$11A5B, $11A8A..$11A96, $11A98, $11A99, $11C30..$11C36, + $11C38..$11C3D, $11C3F, $11C92..$11CA7, $11CAA..$11CB0, $11CB2, $11CB3, $11CB5, $11CB6, + $11D31..$11D36, $11D3A, $11D3C, $11D3D, $11D3F..$11D45, $11D47, $11D90, $11D91, $11D95, + $11D97, $11EF3, $11EF4, $13430..$13438, $16AF0: result := ujtTransparent; + end + else + case u of + $16AF1..$16AF4, $16B30..$16B36, $16F4F, $16F8F..$16F92, $16FE4, $1BC9D, $1BC9E, $1BCA0..$1BCA3, + $1D167..$1D169, $1D173..$1D182, $1D185..$1D18B, $1D1AA..$1D1AD, $1D242..$1D244, $1DA00..$1DA36, + $1DA3B..$1DA6C, $1DA75, $1DA84, $1DA9B..$1DA9F, $1DAA1..$1DAAF, $1E000..$1E006, $1E008..$1E018, + $1E01B..$1E021, $1E023, $1E024, $1E026..$1E02A, $1E130..$1E136, $1E2EC..$1E2EF, $1E8D0..$1E8D6, + $1E944..$1E94B, $E0001, $E0020..$E007F, $E0100..$E01EF: result := ujtTransparent; + $1E900..$1E943: result := ujtDualJoining; + end + end + end + end +end; + +type + TUnicodeCombiningInfo = record + u: LongWord; + c: Byte; + end; +const + UnicodeCombiningInfos: array[0..2289] of TUnicodeCombiningInfo = + ( (u:$300; c:230), (u:$301; c:230), (u:$302; c:230), (u:$303; c:230), + (u:$304; c:230), (u:$305; c:230), (u:$306; c:230), (u:$307; c:230), + (u:$308; c:230), (u:$309; c:230), (u:$30A; c:230), (u:$30B; c:230), + (u:$30C; c:230), (u:$30D; c:230), (u:$30E; c:230), (u:$30F; c:230), + (u:$310; c:230), (u:$311; c:230), (u:$312; c:230), (u:$313; c:230), + (u:$314; c:230), (u:$315; c:232), (u:$316; c:220), (u:$317; c:220), + (u:$318; c:220), (u:$319; c:220), (u:$31A; c:232), (u:$31B; c:216), + (u:$31C; c:220), (u:$31D; c:220), (u:$31E; c:220), (u:$31F; c:220), + (u:$320; c:220), (u:$321; c:202), (u:$322; c:202), (u:$323; c:220), + (u:$324; c:220), (u:$325; c:220), (u:$326; c:220), (u:$327; c:202), + (u:$328; c:202), (u:$329; c:220), (u:$32A; c:220), (u:$32B; c:220), + (u:$32C; c:220), (u:$32D; c:220), (u:$32E; c:220), (u:$32F; c:220), + (u:$330; c:220), (u:$331; c:220), (u:$332; c:220), (u:$333; c:220), + (u:$334; c:1), (u:$335; c:1), (u:$336; c:1), (u:$337; c:1), (u:$338; c:1), + (u:$339; c:220), (u:$33A; c:220), (u:$33B; c:220), (u:$33C; c:220), + (u:$33D; c:230), (u:$33E; c:230), (u:$33F; c:230), (u:$340; c:230), + (u:$341; c:230), (u:$342; c:230), (u:$343; c:230), (u:$344; c:230), + (u:$345; c:240), (u:$346; c:230), (u:$347; c:220), (u:$348; c:220), + (u:$349; c:220), (u:$34A; c:230), (u:$34B; c:230), (u:$34C; c:230), + (u:$34D; c:220), (u:$34E; c:220), (u:$34F; c:0), (u:$350; c:230), + (u:$351; c:230), (u:$352; c:230), (u:$353; c:220), (u:$354; c:220), + (u:$355; c:220), (u:$356; c:220), (u:$357; c:230), (u:$358; c:232), + (u:$359; c:220), (u:$35A; c:220), (u:$35B; c:230), (u:$35C; c:233), + (u:$35D; c:234), (u:$35E; c:234), (u:$35F; c:233), (u:$360; c:234), + (u:$361; c:234), (u:$362; c:233), (u:$363; c:230), (u:$364; c:230), + (u:$365; c:230), (u:$366; c:230), (u:$367; c:230), (u:$368; c:230), + (u:$369; c:230), (u:$36A; c:230), (u:$36B; c:230), (u:$36C; c:230), + (u:$36D; c:230), (u:$36E; c:230), (u:$36F; c:230), (u:$483; c:230), + (u:$484; c:230), (u:$485; c:230), (u:$486; c:230), (u:$487; c:230), + (u:$488; c:0), (u:$489; c:0), (u:$591; c:220), (u:$592; c:230), + (u:$593; c:230), (u:$594; c:230), (u:$595; c:230), (u:$596; c:220), + (u:$597; c:230), (u:$598; c:230), (u:$599; c:230), (u:$59A; c:222), + (u:$59B; c:220), (u:$59C; c:230), (u:$59D; c:230), (u:$59E; c:230), + (u:$59F; c:230), (u:$5A0; c:230), (u:$5A1; c:230), (u:$5A2; c:220), + (u:$5A3; c:220), (u:$5A4; c:220), (u:$5A5; c:220), (u:$5A6; c:220), + (u:$5A7; c:220), (u:$5A8; c:230), (u:$5A9; c:230), (u:$5AA; c:220), + (u:$5AB; c:230), (u:$5AC; c:230), (u:$5AD; c:222), (u:$5AE; c:228), + (u:$5AF; c:230), (u:$5B0; c:10), (u:$5B1; c:11), (u:$5B2; c:12), + (u:$5B3; c:13), (u:$5B4; c:14), (u:$5B5; c:15), (u:$5B6; c:16), + (u:$5B7; c:17), (u:$5B8; c:18), (u:$5B9; c:19), (u:$5BA; c:19), + (u:$5BB; c:20), (u:$5BC; c:21), (u:$5BD; c:22), (u:$5BF; c:23), + (u:$5C1; c:24), (u:$5C2; c:25), (u:$5C4; c:230), (u:$5C5; c:220), + (u:$5C7; c:18), (u:$610; c:230), (u:$611; c:230), (u:$612; c:230), + (u:$613; c:230), (u:$614; c:230), (u:$615; c:230), (u:$616; c:230), + (u:$617; c:230), (u:$618; c:30), (u:$619; c:31), (u:$61A; c:32), + (u:$64B; c:27), (u:$64C; c:28), (u:$64D; c:29), (u:$64E; c:30), + (u:$64F; c:31), (u:$650; c:32), (u:$651; c:33), (u:$652; c:34), + (u:$653; c:230), (u:$654; c:230), (u:$655; c:220), (u:$656; c:220), + (u:$657; c:230), (u:$658; c:230), (u:$659; c:230), (u:$65A; c:230), + (u:$65B; c:230), (u:$65C; c:220), (u:$65D; c:230), (u:$65E; c:230), + (u:$65F; c:220), (u:$670; c:35), (u:$6D6; c:230), (u:$6D7; c:230), + (u:$6D8; c:230), (u:$6D9; c:230), (u:$6DA; c:230), (u:$6DB; c:230), + (u:$6DC; c:230), (u:$6DF; c:230), (u:$6E0; c:230), (u:$6E1; c:230), + (u:$6E2; c:230), (u:$6E3; c:220), (u:$6E4; c:230), (u:$6E7; c:230), + (u:$6E8; c:230), (u:$6EA; c:220), (u:$6EB; c:230), (u:$6EC; c:230), + (u:$6ED; c:220), (u:$711; c:36), (u:$730; c:230), (u:$731; c:220), + (u:$732; c:230), (u:$733; c:230), (u:$734; c:220), (u:$735; c:230), + (u:$736; c:230), (u:$737; c:220), (u:$738; c:220), (u:$739; c:220), + (u:$73A; c:230), (u:$73B; c:220), (u:$73C; c:220), (u:$73D; c:230), + (u:$73E; c:220), (u:$73F; c:230), (u:$740; c:230), (u:$741; c:230), + (u:$742; c:220), (u:$743; c:230), (u:$744; c:220), (u:$745; c:230), + (u:$746; c:220), (u:$747; c:230), (u:$748; c:220), (u:$749; c:230), + (u:$74A; c:230), (u:$7A6; c:0), (u:$7A7; c:0), (u:$7A8; c:0), (u:$7A9; c:0), + (u:$7AA; c:0), (u:$7AB; c:0), (u:$7AC; c:0), (u:$7AD; c:0), (u:$7AE; c:0), + (u:$7AF; c:0), (u:$7B0; c:0), (u:$7EB; c:230), (u:$7EC; c:230), + (u:$7ED; c:230), (u:$7EE; c:230), (u:$7EF; c:230), (u:$7F0; c:230), + (u:$7F1; c:230), (u:$7F2; c:220), (u:$7F3; c:230), (u:$7FD; c:220), + (u:$816; c:230), (u:$817; c:230), (u:$818; c:230), (u:$819; c:230), + (u:$81B; c:230), (u:$81C; c:230), (u:$81D; c:230), (u:$81E; c:230), + (u:$81F; c:230), (u:$820; c:230), (u:$821; c:230), (u:$822; c:230), + (u:$823; c:230), (u:$825; c:230), (u:$826; c:230), (u:$827; c:230), + (u:$829; c:230), (u:$82A; c:230), (u:$82B; c:230), (u:$82C; c:230), + (u:$82D; c:230), (u:$859; c:220), (u:$85A; c:220), (u:$85B; c:220), + (u:$8D3; c:220), (u:$8D4; c:230), (u:$8D5; c:230), (u:$8D6; c:230), + (u:$8D7; c:230), (u:$8D8; c:230), (u:$8D9; c:230), (u:$8DA; c:230), + (u:$8DB; c:230), (u:$8DC; c:230), (u:$8DD; c:230), (u:$8DE; c:230), + (u:$8DF; c:230), (u:$8E0; c:230), (u:$8E1; c:230), (u:$8E3; c:220), + (u:$8E4; c:230), (u:$8E5; c:230), (u:$8E6; c:220), (u:$8E7; c:230), + (u:$8E8; c:230), (u:$8E9; c:220), (u:$8EA; c:230), (u:$8EB; c:230), + (u:$8EC; c:230), (u:$8ED; c:220), (u:$8EE; c:220), (u:$8EF; c:220), + (u:$8F0; c:27), (u:$8F1; c:28), (u:$8F2; c:29), (u:$8F3; c:230), + (u:$8F4; c:230), (u:$8F5; c:230), (u:$8F6; c:220), (u:$8F7; c:230), + (u:$8F8; c:230), (u:$8F9; c:220), (u:$8FA; c:220), (u:$8FB; c:230), + (u:$8FC; c:230), (u:$8FD; c:230), (u:$8FE; c:230), (u:$8FF; c:230), + (u:$900; c:0), (u:$901; c:0), (u:$902; c:0), (u:$903; c:210), (u:$93A; c:0), + (u:$93B; c:210), (u:$93C; c:7), (u:$93E; c:210), (u:$93F; c:208), + (u:$940; c:210), (u:$941; c:0), (u:$942; c:0), (u:$943; c:0), (u:$944; c:0), + (u:$945; c:0), (u:$946; c:0), (u:$947; c:0), (u:$948; c:0), (u:$949; c:210), + (u:$94A; c:210), (u:$94B; c:210), (u:$94C; c:210), (u:$94D; c:9), + (u:$94E; c:208), (u:$94F; c:210), (u:$951; c:230), (u:$952; c:220), + (u:$953; c:230), (u:$954; c:230), (u:$955; c:0), (u:$956; c:0), + (u:$957; c:0), (u:$962; c:0), (u:$963; c:0), (u:$981; c:0), (u:$982; c:210), + (u:$983; c:210), (u:$9BC; c:7), (u:$9BE; c:210), (u:$9BF; c:208), + (u:$9C0; c:210), (u:$9C1; c:0), (u:$9C2; c:0), (u:$9C3; c:0), (u:$9C4; c:0), + (u:$9C7; c:208), (u:$9C8; c:208), (u:$9CB; c:0), (u:$9CC; c:0), + (u:$9CD; c:9), (u:$9D7; c:210), (u:$9E2; c:0), (u:$9E3; c:0), + (u:$9FE; c:230), (u:$A01; c:0), (u:$A02; c:0), (u:$A03; c:210), + (u:$A3C; c:7), (u:$A3E; c:210), (u:$A3F; c:208), (u:$A40; c:210), + (u:$A41; c:0), (u:$A42; c:0), (u:$A47; c:0), (u:$A48; c:0), (u:$A4B; c:0), + (u:$A4C; c:0), (u:$A4D; c:9), (u:$A51; c:0), (u:$A70; c:0), (u:$A71; c:0), + (u:$A75; c:0), (u:$A81; c:0), (u:$A82; c:0), (u:$A83; c:210), (u:$ABC; c:7), + (u:$ABE; c:210), (u:$ABF; c:208), (u:$AC0; c:210), (u:$AC1; c:0), + (u:$AC2; c:0), (u:$AC3; c:0), (u:$AC4; c:0), (u:$AC5; c:0), (u:$AC7; c:0), + (u:$AC8; c:0), (u:$AC9; c:210), (u:$ACB; c:210), (u:$ACC; c:210), + (u:$ACD; c:9), (u:$AE2; c:0), (u:$AE3; c:0), (u:$AFA; c:0), (u:$AFB; c:0), + (u:$AFC; c:0), (u:$AFD; c:0), (u:$AFE; c:0), (u:$AFF; c:0), (u:$B01; c:0), + (u:$B02; c:210), (u:$B03; c:210), (u:$B3C; c:7), (u:$B3E; c:210), + (u:$B3F; c:0), (u:$B40; c:210), (u:$B41; c:0), (u:$B42; c:0), (u:$B43; c:0), + (u:$B44; c:0), (u:$B47; c:208), (u:$B48; c:208), (u:$B4B; c:208), + (u:$B4C; c:208), (u:$B4D; c:9), (u:$B55; c:0), (u:$B56; c:0), + (u:$B57; c:210), (u:$B62; c:0), (u:$B63; c:0), (u:$B82; c:0), + (u:$BBE; c:210), (u:$BBF; c:210), (u:$BC0; c:0), (u:$BC1; c:210), + (u:$BC2; c:210), (u:$BC6; c:208), (u:$BC7; c:208), (u:$BC8; c:208), + (u:$BCA; c:0), (u:$BCB; c:0), (u:$BCC; c:0), (u:$BCD; c:9), (u:$BD7; c:210), + (u:$C00; c:0), (u:$C01; c:210), (u:$C02; c:210), (u:$C03; c:210), + (u:$C04; c:0), (u:$C3E; c:0), (u:$C3F; c:0), (u:$C40; c:0), (u:$C41; c:210), + (u:$C42; c:210), (u:$C43; c:210), (u:$C44; c:210), (u:$C46; c:0), + (u:$C47; c:0), (u:$C48; c:0), (u:$C4A; c:0), (u:$C4B; c:0), (u:$C4C; c:0), + (u:$C4D; c:9), (u:$C55; c:84), (u:$C56; c:91), (u:$C62; c:0), (u:$C63; c:0), + (u:$C81; c:0), (u:$C82; c:210), (u:$C83; c:210), (u:$CBC; c:7), + (u:$CBE; c:210), (u:$CC0; c:210), (u:$CC1; c:210), (u:$CC2; c:210), + (u:$CC3; c:210), (u:$CC4; c:210), (u:$CC7; c:210), (u:$CC8; c:210), + (u:$CCA; c:210), (u:$CCB; c:210), (u:$CCC; c:0), (u:$CCD; c:9), + (u:$CD5; c:210), (u:$CD6; c:210), (u:$CE2; c:0), (u:$CE3; c:0), + (u:$D00; c:0), (u:$D01; c:0), (u:$D02; c:210), (u:$D03; c:210), + (u:$D3B; c:9), (u:$D3C; c:9), (u:$D3E; c:210), (u:$D3F; c:210), + (u:$D40; c:210), (u:$D41; c:0), (u:$D42; c:0), (u:$D43; c:0), (u:$D44; c:0), + (u:$D46; c:208), (u:$D47; c:208), (u:$D48; c:208), (u:$D4A; c:0), + (u:$D4B; c:0), (u:$D4C; c:0), (u:$D4D; c:9), (u:$D57; c:210), (u:$D62; c:0), + (u:$D63; c:0), (u:$D81; c:0), (u:$D82; c:210), (u:$D83; c:210), + (u:$DCA; c:9), (u:$DCF; c:210), (u:$DD0; c:210), (u:$DD1; c:210), + (u:$DD2; c:0), (u:$DD3; c:0), (u:$DD4; c:0), (u:$DD6; c:0), (u:$DD8; c:210), + (u:$DD9; c:208), (u:$DDA; c:208), (u:$DDB; c:208), (u:$DDC; c:208), + (u:$DDD; c:208), (u:$DDE; c:208), (u:$DDF; c:210), (u:$DF2; c:210), + (u:$DF3; c:210), (u:$E31; c:0), (u:$E34; c:0), (u:$E35; c:0), (u:$E36; c:0), + (u:$E37; c:0), (u:$E38; c:103), (u:$E39; c:103), (u:$E3A; c:9), + (u:$E47; c:0), (u:$E48; c:107), (u:$E49; c:107), (u:$E4A; c:107), + (u:$E4B; c:107), (u:$E4C; c:0), (u:$E4D; c:0), (u:$E4E; c:0), (u:$EB1; c:0), + (u:$EB4; c:0), (u:$EB5; c:0), (u:$EB6; c:0), (u:$EB7; c:0), (u:$EB8; c:118), + (u:$EB9; c:118), (u:$EBA; c:9), (u:$EBB; c:0), (u:$EBC; c:0), + (u:$EC8; c:122), (u:$EC9; c:122), (u:$ECA; c:122), (u:$ECB; c:122), + (u:$ECC; c:0), (u:$ECD; c:0), (u:$F18; c:220), (u:$F19; c:220), + (u:$F35; c:220), (u:$F37; c:220), (u:$F39; c:216), (u:$F3E; c:210), + (u:$F3F; c:210), (u:$F71; c:129), (u:$F72; c:130), (u:$F73; c:0), + (u:$F74; c:132), (u:$F75; c:0), (u:$F76; c:0), (u:$F77; c:0), (u:$F78; c:0), + (u:$F79; c:0), (u:$F7A; c:130), (u:$F7B; c:130), (u:$F7C; c:130), + (u:$F7D; c:130), (u:$F7E; c:0), (u:$F7F; c:210), (u:$F80; c:130), + (u:$F81; c:0), (u:$F82; c:230), (u:$F83; c:230), (u:$F84; c:9), + (u:$F86; c:230), (u:$F87; c:230), (u:$F8D; c:0), (u:$F8E; c:0), + (u:$F8F; c:0), (u:$F90; c:0), (u:$F91; c:0), (u:$F92; c:0), (u:$F93; c:0), + (u:$F94; c:0), (u:$F95; c:0), (u:$F96; c:0), (u:$F97; c:0), (u:$F99; c:0), + (u:$F9A; c:0), (u:$F9B; c:0), (u:$F9C; c:0), (u:$F9D; c:0), (u:$F9E; c:0), + (u:$F9F; c:0), (u:$FA0; c:0), (u:$FA1; c:0), (u:$FA2; c:0), (u:$FA3; c:0), + (u:$FA4; c:0), (u:$FA5; c:0), (u:$FA6; c:0), (u:$FA7; c:0), (u:$FA8; c:0), + (u:$FA9; c:0), (u:$FAA; c:0), (u:$FAB; c:0), (u:$FAC; c:0), (u:$FAD; c:0), + (u:$FAE; c:0), (u:$FAF; c:0), (u:$FB0; c:0), (u:$FB1; c:0), (u:$FB2; c:0), + (u:$FB3; c:0), (u:$FB4; c:0), (u:$FB5; c:0), (u:$FB6; c:0), (u:$FB7; c:0), + (u:$FB8; c:0), (u:$FB9; c:0), (u:$FBA; c:0), (u:$FBB; c:0), (u:$FBC; c:0), + (u:$FC6; c:220), (u:$102B; c:210), (u:$102C; c:210), (u:$102D; c:0), + (u:$102E; c:0), (u:$102F; c:0), (u:$1030; c:0), (u:$1031; c:208), + (u:$1032; c:0), (u:$1033; c:0), (u:$1034; c:0), (u:$1035; c:0), + (u:$1036; c:0), (u:$1037; c:7), (u:$1038; c:210), (u:$1039; c:9), + (u:$103A; c:9), (u:$103B; c:210), (u:$103C; c:208), (u:$103D; c:0), + (u:$103E; c:0), (u:$1056; c:210), (u:$1057; c:210), (u:$1058; c:0), + (u:$1059; c:0), (u:$105E; c:0), (u:$105F; c:0), (u:$1060; c:0), + (u:$1062; c:210), (u:$1063; c:210), (u:$1064; c:210), (u:$1067; c:210), + (u:$1068; c:210), (u:$1069; c:210), (u:$106A; c:210), (u:$106B; c:210), + (u:$106C; c:210), (u:$106D; c:210), (u:$1071; c:0), (u:$1072; c:0), + (u:$1073; c:0), (u:$1074; c:0), (u:$1082; c:0), (u:$1083; c:210), + (u:$1084; c:208), (u:$1085; c:0), (u:$1086; c:0), (u:$1087; c:210), + (u:$1088; c:210), (u:$1089; c:210), (u:$108A; c:210), (u:$108B; c:210), + (u:$108C; c:210), (u:$108D; c:220), (u:$108F; c:210), (u:$109A; c:210), + (u:$109B; c:210), (u:$109C; c:210), (u:$109D; c:0), (u:$135D; c:230), + (u:$135E; c:230), (u:$135F; c:230), (u:$1712; c:0), (u:$1713; c:0), + (u:$1714; c:9), (u:$1732; c:0), (u:$1733; c:0), (u:$1734; c:9), + (u:$1752; c:0), (u:$1753; c:0), (u:$1772; c:0), (u:$1773; c:0), + (u:$17B4; c:0), (u:$17B5; c:0), (u:$17B6; c:210), (u:$17B7; c:0), + (u:$17B8; c:0), (u:$17B9; c:0), (u:$17BA; c:0), (u:$17BB; c:0), + (u:$17BC; c:0), (u:$17BD; c:0), (u:$17BE; c:208), (u:$17BF; c:0), + (u:$17C0; c:0), (u:$17C1; c:208), (u:$17C2; c:208), (u:$17C3; c:208), + (u:$17C4; c:0), (u:$17C5; c:0), (u:$17C6; c:0), (u:$17C7; c:210), + (u:$17C8; c:210), (u:$17C9; c:0), (u:$17CA; c:0), (u:$17CB; c:0), + (u:$17CC; c:0), (u:$17CD; c:0), (u:$17CE; c:0), (u:$17CF; c:0), + (u:$17D0; c:0), (u:$17D1; c:0), (u:$17D2; c:9), (u:$17D3; c:0), + (u:$17DD; c:230), (u:$180B; c:0), (u:$180C; c:0), (u:$180D; c:0), + (u:$1885; c:0), (u:$1886; c:0), (u:$18A9; c:228), (u:$1920; c:0), + (u:$1921; c:0), (u:$1922; c:0), (u:$1923; c:210), (u:$1924; c:210), + (u:$1925; c:210), (u:$1926; c:210), (u:$1927; c:0), (u:$1928; c:0), + (u:$1929; c:210), (u:$192A; c:210), (u:$192B; c:210), (u:$1930; c:210), + (u:$1931; c:210), (u:$1932; c:0), (u:$1933; c:210), (u:$1934; c:210), + (u:$1935; c:210), (u:$1936; c:210), (u:$1937; c:210), (u:$1938; c:210), + (u:$1939; c:222), (u:$193A; c:230), (u:$193B; c:220), (u:$1A17; c:230), + (u:$1A18; c:220), (u:$1A19; c:208), (u:$1A1A; c:210), (u:$1A1B; c:0), + (u:$1A55; c:210), (u:$1A56; c:0), (u:$1A57; c:210), (u:$1A58; c:0), + (u:$1A59; c:0), (u:$1A5A; c:0), (u:$1A5B; c:0), (u:$1A5C; c:0), + (u:$1A5D; c:0), (u:$1A5E; c:0), (u:$1A60; c:9), (u:$1A61; c:210), + (u:$1A62; c:0), (u:$1A63; c:210), (u:$1A64; c:210), (u:$1A65; c:0), + (u:$1A66; c:0), (u:$1A67; c:0), (u:$1A68; c:0), (u:$1A69; c:0), + (u:$1A6A; c:0), (u:$1A6B; c:0), (u:$1A6C; c:0), (u:$1A6D; c:210), + (u:$1A6E; c:210), (u:$1A6F; c:210), (u:$1A70; c:210), (u:$1A71; c:210), + (u:$1A72; c:210), (u:$1A73; c:0), (u:$1A74; c:0), (u:$1A75; c:230), + (u:$1A76; c:230), (u:$1A77; c:230), (u:$1A78; c:230), (u:$1A79; c:230), + (u:$1A7A; c:230), (u:$1A7B; c:230), (u:$1A7C; c:230), (u:$1A7F; c:220), + (u:$1AB0; c:230), (u:$1AB1; c:230), (u:$1AB2; c:230), (u:$1AB3; c:230), + (u:$1AB4; c:230), (u:$1AB5; c:220), (u:$1AB6; c:220), (u:$1AB7; c:220), + (u:$1AB8; c:220), (u:$1AB9; c:220), (u:$1ABA; c:220), (u:$1ABB; c:230), + (u:$1ABC; c:230), (u:$1ABD; c:220), (u:$1ABE; c:0), (u:$1ABF; c:220), + (u:$1AC0; c:220), (u:$1B00; c:0), (u:$1B01; c:0), (u:$1B02; c:0), + (u:$1B03; c:0), (u:$1B04; c:210), (u:$1B34; c:7), (u:$1B35; c:210), + (u:$1B36; c:0), (u:$1B37; c:0), (u:$1B38; c:0), (u:$1B39; c:0), + (u:$1B3A; c:0), (u:$1B3B; c:210), (u:$1B3C; c:0), (u:$1B3D; c:0), + (u:$1B3E; c:208), (u:$1B3F; c:208), (u:$1B40; c:0), (u:$1B41; c:0), + (u:$1B42; c:0), (u:$1B43; c:210), (u:$1B44; c:9), (u:$1B6B; c:230), + (u:$1B6C; c:220), (u:$1B6D; c:230), (u:$1B6E; c:230), (u:$1B6F; c:230), + (u:$1B70; c:230), (u:$1B71; c:230), (u:$1B72; c:230), (u:$1B73; c:230), + (u:$1B80; c:0), (u:$1B81; c:0), (u:$1B82; c:210), (u:$1BA1; c:210), + (u:$1BA2; c:0), (u:$1BA3; c:0), (u:$1BA4; c:0), (u:$1BA5; c:0), + (u:$1BA6; c:210), (u:$1BA7; c:210), (u:$1BA8; c:0), (u:$1BA9; c:0), + (u:$1BAA; c:9), (u:$1BAB; c:9), (u:$1BAC; c:0), (u:$1BAD; c:0), + (u:$1BE6; c:7), (u:$1BE7; c:210), (u:$1BE8; c:0), (u:$1BE9; c:0), + (u:$1BEA; c:210), (u:$1BEB; c:210), (u:$1BEC; c:210), (u:$1BED; c:0), + (u:$1BEE; c:210), (u:$1BEF; c:0), (u:$1BF0; c:0), (u:$1BF1; c:0), + (u:$1BF2; c:9), (u:$1BF3; c:9), (u:$1C24; c:210), (u:$1C25; c:210), + (u:$1C26; c:210), (u:$1C27; c:210), (u:$1C28; c:210), (u:$1C29; c:210), + (u:$1C2A; c:210), (u:$1C2B; c:210), (u:$1C2C; c:0), (u:$1C2D; c:0), + (u:$1C2E; c:0), (u:$1C2F; c:0), (u:$1C30; c:0), (u:$1C31; c:0), + (u:$1C32; c:0), (u:$1C33; c:0), (u:$1C34; c:210), (u:$1C35; c:210), + (u:$1C36; c:0), (u:$1C37; c:7), (u:$1CD0; c:230), (u:$1CD1; c:230), + (u:$1CD2; c:230), (u:$1CD4; c:1), (u:$1CD5; c:220), (u:$1CD6; c:220), + (u:$1CD7; c:220), (u:$1CD8; c:220), (u:$1CD9; c:220), (u:$1CDA; c:230), + (u:$1CDB; c:230), (u:$1CDC; c:220), (u:$1CDD; c:220), (u:$1CDE; c:220), + (u:$1CDF; c:220), (u:$1CE0; c:230), (u:$1CE1; c:210), (u:$1CE2; c:1), + (u:$1CE3; c:1), (u:$1CE4; c:1), (u:$1CE5; c:1), (u:$1CE6; c:1), + (u:$1CE7; c:1), (u:$1CE8; c:1), (u:$1CED; c:220), (u:$1CF4; c:230), + (u:$1CF7; c:210), (u:$1CF8; c:230), (u:$1CF9; c:230), (u:$1DC0; c:230), + (u:$1DC1; c:230), (u:$1DC2; c:220), (u:$1DC3; c:230), (u:$1DC4; c:230), + (u:$1DC5; c:230), (u:$1DC6; c:230), (u:$1DC7; c:230), (u:$1DC8; c:230), + (u:$1DC9; c:230), (u:$1DCA; c:220), (u:$1DCB; c:230), (u:$1DCC; c:230), + (u:$1DCD; c:234), (u:$1DCE; c:214), (u:$1DCF; c:220), (u:$1DD0; c:202), + (u:$1DD1; c:230), (u:$1DD2; c:230), (u:$1DD3; c:230), (u:$1DD4; c:230), + (u:$1DD5; c:230), (u:$1DD6; c:230), (u:$1DD7; c:230), (u:$1DD8; c:230), + (u:$1DD9; c:230), (u:$1DDA; c:230), (u:$1DDB; c:230), (u:$1DDC; c:230), + (u:$1DDD; c:230), (u:$1DDE; c:230), (u:$1DDF; c:230), (u:$1DE0; c:230), + (u:$1DE1; c:230), (u:$1DE2; c:230), (u:$1DE3; c:230), (u:$1DE4; c:230), + (u:$1DE5; c:230), (u:$1DE6; c:230), (u:$1DE7; c:230), (u:$1DE8; c:230), + (u:$1DE9; c:230), (u:$1DEA; c:230), (u:$1DEB; c:230), (u:$1DEC; c:230), + (u:$1DED; c:230), (u:$1DEE; c:230), (u:$1DEF; c:230), (u:$1DF0; c:230), + (u:$1DF1; c:230), (u:$1DF2; c:230), (u:$1DF3; c:230), (u:$1DF4; c:230), + (u:$1DF5; c:230), (u:$1DF6; c:232), (u:$1DF7; c:228), (u:$1DF8; c:228), + (u:$1DF9; c:220), (u:$1DFB; c:230), (u:$1DFC; c:233), (u:$1DFD; c:220), + (u:$1DFE; c:230), (u:$1DFF; c:220), (u:$20D0; c:230), (u:$20D1; c:230), + (u:$20D2; c:1), (u:$20D3; c:1), (u:$20D4; c:230), (u:$20D5; c:230), + (u:$20D6; c:230), (u:$20D7; c:230), (u:$20D8; c:1), (u:$20D9; c:1), + (u:$20DA; c:1), (u:$20DB; c:230), (u:$20DC; c:230), (u:$20DD; c:0), + (u:$20DE; c:0), (u:$20DF; c:0), (u:$20E0; c:0), (u:$20E1; c:230), + (u:$20E2; c:0), (u:$20E3; c:0), (u:$20E4; c:0), (u:$20E5; c:1), + (u:$20E6; c:1), (u:$20E7; c:230), (u:$20E8; c:220), (u:$20E9; c:230), + (u:$20EA; c:1), (u:$20EB; c:1), (u:$20EC; c:220), (u:$20ED; c:220), + (u:$20EE; c:220), (u:$20EF; c:220), (u:$20F0; c:230), (u:$2CEF; c:230), + (u:$2CF0; c:230), (u:$2CF1; c:230), (u:$2D7F; c:9), (u:$2DE0; c:230), + (u:$2DE1; c:230), (u:$2DE2; c:230), (u:$2DE3; c:230), (u:$2DE4; c:230), + (u:$2DE5; c:230), (u:$2DE6; c:230), (u:$2DE7; c:230), (u:$2DE8; c:230), + (u:$2DE9; c:230), (u:$2DEA; c:230), (u:$2DEB; c:230), (u:$2DEC; c:230), + (u:$2DED; c:230), (u:$2DEE; c:230), (u:$2DEF; c:230), (u:$2DF0; c:230), + (u:$2DF1; c:230), (u:$2DF2; c:230), (u:$2DF3; c:230), (u:$2DF4; c:230), + (u:$2DF5; c:230), (u:$2DF6; c:230), (u:$2DF7; c:230), (u:$2DF8; c:230), + (u:$2DF9; c:230), (u:$2DFA; c:230), (u:$2DFB; c:230), (u:$2DFC; c:230), + (u:$2DFD; c:230), (u:$2DFE; c:230), (u:$2DFF; c:230), (u:$302A; c:218), + (u:$302B; c:228), (u:$302C; c:232), (u:$302D; c:222), (u:$302E; c:224), + (u:$302F; c:224), (u:$3099; c:8), (u:$309A; c:8), (u:$A66F; c:230), + (u:$A670; c:0), (u:$A671; c:0), (u:$A672; c:0), (u:$A674; c:230), + (u:$A675; c:230), (u:$A676; c:230), (u:$A677; c:230), (u:$A678; c:230), + (u:$A679; c:230), (u:$A67A; c:230), (u:$A67B; c:230), (u:$A67C; c:230), + (u:$A67D; c:230), (u:$A69E; c:230), (u:$A69F; c:230), (u:$A6F0; c:230), + (u:$A6F1; c:230), (u:$A802; c:0), (u:$A806; c:9), (u:$A80B; c:0), + (u:$A823; c:210), (u:$A824; c:210), (u:$A825; c:0), (u:$A826; c:0), + (u:$A827; c:210), (u:$A82C; c:9), (u:$A880; c:210), (u:$A881; c:210), + (u:$A8B4; c:210), (u:$A8B5; c:210), (u:$A8B6; c:210), (u:$A8B7; c:210), + (u:$A8B8; c:210), (u:$A8B9; c:210), (u:$A8BA; c:210), (u:$A8BB; c:210), + (u:$A8BC; c:210), (u:$A8BD; c:210), (u:$A8BE; c:210), (u:$A8BF; c:210), + (u:$A8C0; c:210), (u:$A8C1; c:210), (u:$A8C2; c:210), (u:$A8C3; c:210), + (u:$A8C4; c:9), (u:$A8C5; c:0), (u:$A8E0; c:230), (u:$A8E1; c:230), + (u:$A8E2; c:230), (u:$A8E3; c:230), (u:$A8E4; c:230), (u:$A8E5; c:230), + (u:$A8E6; c:230), (u:$A8E7; c:230), (u:$A8E8; c:230), (u:$A8E9; c:230), + (u:$A8EA; c:230), (u:$A8EB; c:230), (u:$A8EC; c:230), (u:$A8ED; c:230), + (u:$A8EE; c:230), (u:$A8EF; c:230), (u:$A8F0; c:230), (u:$A8F1; c:230), + (u:$A8FF; c:0), (u:$A926; c:0), (u:$A927; c:0), (u:$A928; c:0), + (u:$A929; c:0), (u:$A92A; c:0), (u:$A92B; c:220), (u:$A92C; c:220), + (u:$A92D; c:220), (u:$A947; c:0), (u:$A948; c:0), (u:$A949; c:0), + (u:$A94A; c:0), (u:$A94B; c:0), (u:$A94C; c:0), (u:$A94D; c:0), + (u:$A94E; c:0), (u:$A94F; c:0), (u:$A950; c:0), (u:$A951; c:0), + (u:$A952; c:210), (u:$A953; c:9), (u:$A980; c:0), (u:$A981; c:0), + (u:$A982; c:0), (u:$A983; c:210), (u:$A9B3; c:7), (u:$A9B4; c:210), + (u:$A9B5; c:210), (u:$A9B6; c:0), (u:$A9B7; c:0), (u:$A9B8; c:0), + (u:$A9B9; c:0), (u:$A9BA; c:208), (u:$A9BB; c:208), (u:$A9BC; c:0), + (u:$A9BD; c:0), (u:$A9BE; c:210), (u:$A9BF; c:208), (u:$A9C0; c:9), + (u:$A9E5; c:0), (u:$AA29; c:0), (u:$AA2A; c:0), (u:$AA2B; c:0), + (u:$AA2C; c:0), (u:$AA2D; c:0), (u:$AA2E; c:0), (u:$AA2F; c:208), + (u:$AA30; c:208), (u:$AA31; c:0), (u:$AA32; c:0), (u:$AA33; c:210), + (u:$AA34; c:208), (u:$AA35; c:0), (u:$AA36; c:0), (u:$AA43; c:0), + (u:$AA4C; c:0), (u:$AA4D; c:210), (u:$AA7B; c:210), (u:$AA7C; c:0), + (u:$AA7D; c:210), (u:$AAB0; c:230), (u:$AAB2; c:230), (u:$AAB3; c:230), + (u:$AAB4; c:220), (u:$AAB7; c:230), (u:$AAB8; c:230), (u:$AABE; c:230), + (u:$AABF; c:230), (u:$AAC1; c:230), (u:$AAEB; c:210), (u:$AAEC; c:0), + (u:$AAED; c:0), (u:$AAEE; c:210), (u:$AAEF; c:210), (u:$AAF5; c:210), + (u:$AAF6; c:9), (u:$ABE3; c:210), (u:$ABE4; c:210), (u:$ABE5; c:0), + (u:$ABE6; c:210), (u:$ABE7; c:210), (u:$ABE8; c:0), (u:$ABE9; c:210), + (u:$ABEA; c:210), (u:$ABEC; c:210), (u:$ABED; c:9), (u:$FB1E; c:26), + (u:$FE00; c:0), (u:$FE01; c:0), (u:$FE02; c:0), (u:$FE03; c:0), + (u:$FE04; c:0), (u:$FE05; c:0), (u:$FE06; c:0), (u:$FE07; c:0), + (u:$FE08; c:0), (u:$FE09; c:0), (u:$FE0A; c:0), (u:$FE0B; c:0), + (u:$FE0C; c:0), (u:$FE0D; c:0), (u:$FE0E; c:0), (u:$FE0F; c:0), + (u:$FE20; c:230), (u:$FE21; c:230), (u:$FE22; c:230), (u:$FE23; c:230), + (u:$FE24; c:230), (u:$FE25; c:230), (u:$FE26; c:230), (u:$FE27; c:220), + (u:$FE28; c:220), (u:$FE29; c:220), (u:$FE2A; c:220), (u:$FE2B; c:220), + (u:$FE2C; c:220), (u:$FE2D; c:220), (u:$FE2E; c:230), (u:$FE2F; c:230), + (u:$101FD; c:220), (u:$102E0; c:220), (u:$10376; c:230), (u:$10377; c:230), + (u:$10378; c:230), (u:$10379; c:230), (u:$1037A; c:230), (u:$10A01; c:0), + (u:$10A02; c:0), (u:$10A03; c:0), (u:$10A05; c:0), (u:$10A06; c:0), + (u:$10A0C; c:0), (u:$10A0D; c:220), (u:$10A0E; c:0), (u:$10A0F; c:230), + (u:$10A38; c:230), (u:$10A39; c:1), (u:$10A3A; c:220), (u:$10A3F; c:9), + (u:$10AE5; c:230), (u:$10AE6; c:220), (u:$10D24; c:230), (u:$10D25; c:230), + (u:$10D26; c:230), (u:$10D27; c:230), (u:$10EAB; c:230), (u:$10EAC; c:230), + (u:$10F46; c:220), (u:$10F47; c:220), (u:$10F48; c:230), (u:$10F49; c:230), + (u:$10F4A; c:230), (u:$10F4B; c:220), (u:$10F4C; c:230), (u:$10F4D; c:220), + (u:$10F4E; c:220), (u:$10F4F; c:220), (u:$10F50; c:220), (u:$11000; c:210), + (u:$11001; c:0), (u:$11002; c:210), (u:$11038; c:0), (u:$11039; c:0), + (u:$1103A; c:0), (u:$1103B; c:0), (u:$1103C; c:0), (u:$1103D; c:0), + (u:$1103E; c:0), (u:$1103F; c:0), (u:$11040; c:0), (u:$11041; c:0), + (u:$11042; c:0), (u:$11043; c:0), (u:$11044; c:0), (u:$11045; c:0), + (u:$11046; c:9), (u:$1107F; c:9), (u:$11080; c:0), (u:$11081; c:0), + (u:$11082; c:210), (u:$110B0; c:210), (u:$110B1; c:210), (u:$110B2; c:210), + (u:$110B3; c:0), (u:$110B4; c:0), (u:$110B5; c:0), (u:$110B6; c:0), + (u:$110B7; c:210), (u:$110B8; c:210), (u:$110B9; c:9), (u:$110BA; c:7), + (u:$11100; c:230), (u:$11101; c:230), (u:$11102; c:230), (u:$11127; c:0), + (u:$11128; c:0), (u:$11129; c:0), (u:$1112A; c:0), (u:$1112B; c:0), + (u:$1112C; c:210), (u:$1112D; c:0), (u:$1112E; c:0), (u:$1112F; c:0), + (u:$11130; c:0), (u:$11131; c:0), (u:$11132; c:0), (u:$11133; c:9), + (u:$11134; c:9), (u:$11145; c:210), (u:$11146; c:210), (u:$11173; c:7), + (u:$11180; c:0), (u:$11181; c:0), (u:$11182; c:210), (u:$111B3; c:210), + (u:$111B4; c:210), (u:$111B5; c:210), (u:$111B6; c:0), (u:$111B7; c:0), + (u:$111B8; c:0), (u:$111B9; c:0), (u:$111BA; c:0), (u:$111BB; c:0), + (u:$111BC; c:0), (u:$111BD; c:0), (u:$111BE; c:0), (u:$111BF; c:210), + (u:$111C0; c:9), (u:$111C9; c:0), (u:$111CA; c:7), (u:$111CB; c:0), + (u:$111CC; c:0), (u:$111CE; c:210), (u:$111CF; c:0), (u:$1122C; c:210), + (u:$1122D; c:210), (u:$1122E; c:210), (u:$1122F; c:0), (u:$11230; c:0), + (u:$11231; c:0), (u:$11232; c:210), (u:$11233; c:210), (u:$11234; c:0), + (u:$11235; c:9), (u:$11236; c:7), (u:$11237; c:0), (u:$1123E; c:0), + (u:$112DF; c:0), (u:$112E0; c:210), (u:$112E1; c:210), (u:$112E2; c:210), + (u:$112E3; c:0), (u:$112E4; c:0), (u:$112E5; c:0), (u:$112E6; c:0), + (u:$112E7; c:0), (u:$112E8; c:0), (u:$112E9; c:7), (u:$112EA; c:9), + (u:$11300; c:0), (u:$11301; c:0), (u:$11302; c:210), (u:$11303; c:210), + (u:$1133B; c:7), (u:$1133C; c:7), (u:$1133E; c:210), (u:$1133F; c:210), + (u:$11340; c:0), (u:$11341; c:210), (u:$11342; c:210), (u:$11343; c:210), + (u:$11344; c:210), (u:$11347; c:210), (u:$11348; c:210), (u:$1134B; c:210), + (u:$1134C; c:210), (u:$1134D; c:9), (u:$11357; c:210), (u:$11362; c:210), + (u:$11363; c:210), (u:$11366; c:230), (u:$11367; c:230), (u:$11368; c:230), + (u:$11369; c:230), (u:$1136A; c:230), (u:$1136B; c:230), (u:$1136C; c:230), + (u:$11370; c:230), (u:$11371; c:230), (u:$11372; c:230), (u:$11373; c:230), + (u:$11374; c:230), (u:$11435; c:210), (u:$11436; c:210), (u:$11437; c:210), + (u:$11438; c:0), (u:$11439; c:0), (u:$1143A; c:0), (u:$1143B; c:0), + (u:$1143C; c:0), (u:$1143D; c:0), (u:$1143E; c:0), (u:$1143F; c:0), + (u:$11440; c:210), (u:$11441; c:210), (u:$11442; c:9), (u:$11443; c:0), + (u:$11444; c:0), (u:$11445; c:210), (u:$11446; c:7), (u:$1145E; c:230), + (u:$114B0; c:210), (u:$114B1; c:210), (u:$114B2; c:210), (u:$114B3; c:0), + (u:$114B4; c:0), (u:$114B5; c:0), (u:$114B6; c:0), (u:$114B7; c:0), + (u:$114B8; c:0), (u:$114B9; c:210), (u:$114BA; c:0), (u:$114BB; c:210), + (u:$114BC; c:210), (u:$114BD; c:210), (u:$114BE; c:210), (u:$114BF; c:0), + (u:$114C0; c:0), (u:$114C1; c:210), (u:$114C2; c:9), (u:$114C3; c:7), + (u:$115AF; c:210), (u:$115B0; c:210), (u:$115B1; c:210), (u:$115B2; c:0), + (u:$115B3; c:0), (u:$115B4; c:0), (u:$115B5; c:0), (u:$115B8; c:210), + (u:$115B9; c:210), (u:$115BA; c:210), (u:$115BB; c:210), (u:$115BC; c:0), + (u:$115BD; c:0), (u:$115BE; c:210), (u:$115BF; c:9), (u:$115C0; c:7), + (u:$115DC; c:0), (u:$115DD; c:0), (u:$11630; c:210), (u:$11631; c:210), + (u:$11632; c:210), (u:$11633; c:0), (u:$11634; c:0), (u:$11635; c:0), + (u:$11636; c:0), (u:$11637; c:0), (u:$11638; c:0), (u:$11639; c:0), + (u:$1163A; c:0), (u:$1163B; c:210), (u:$1163C; c:210), (u:$1163D; c:0), + (u:$1163E; c:210), (u:$1163F; c:9), (u:$11640; c:0), (u:$116AB; c:0), + (u:$116AC; c:210), (u:$116AD; c:0), (u:$116AE; c:210), (u:$116AF; c:210), + (u:$116B0; c:0), (u:$116B1; c:0), (u:$116B2; c:0), (u:$116B3; c:0), + (u:$116B4; c:0), (u:$116B5; c:0), (u:$116B6; c:9), (u:$116B7; c:7), + (u:$1171D; c:0), (u:$1171E; c:0), (u:$1171F; c:0), (u:$11720; c:210), + (u:$11721; c:210), (u:$11722; c:0), (u:$11723; c:0), (u:$11724; c:0), + (u:$11725; c:0), (u:$11726; c:210), (u:$11727; c:0), (u:$11728; c:0), + (u:$11729; c:0), (u:$1172A; c:0), (u:$1172B; c:9), (u:$1182C; c:210), + (u:$1182D; c:210), (u:$1182E; c:210), (u:$1182F; c:0), (u:$11830; c:0), + (u:$11831; c:0), (u:$11832; c:0), (u:$11833; c:0), (u:$11834; c:0), + (u:$11835; c:0), (u:$11836; c:0), (u:$11837; c:0), (u:$11838; c:210), + (u:$11839; c:9), (u:$1183A; c:7), (u:$11930; c:210), (u:$11931; c:210), + (u:$11932; c:210), (u:$11933; c:210), (u:$11934; c:210), (u:$11935; c:210), + (u:$11937; c:210), (u:$11938; c:210), (u:$1193B; c:0), (u:$1193C; c:0), + (u:$1193D; c:9), (u:$1193E; c:9), (u:$11940; c:210), (u:$11942; c:210), + (u:$11943; c:7), (u:$119D1; c:210), (u:$119D2; c:210), (u:$119D3; c:210), + (u:$119D4; c:0), (u:$119D5; c:0), (u:$119D6; c:0), (u:$119D7; c:0), + (u:$119DA; c:0), (u:$119DB; c:0), (u:$119DC; c:210), (u:$119DD; c:210), + (u:$119DE; c:210), (u:$119DF; c:210), (u:$119E0; c:9), (u:$119E4; c:210), + (u:$11A01; c:0), (u:$11A02; c:0), (u:$11A03; c:0), (u:$11A04; c:0), + (u:$11A05; c:0), (u:$11A06; c:0), (u:$11A09; c:0), (u:$11A0A; c:0), + (u:$11A33; c:0), (u:$11A34; c:9), (u:$11A35; c:0), (u:$11A36; c:0), + (u:$11A37; c:0), (u:$11A38; c:0), (u:$11A39; c:210), (u:$11A3B; c:0), + (u:$11A3C; c:0), (u:$11A3D; c:0), (u:$11A3E; c:0), (u:$11A47; c:9), + (u:$11A51; c:0), (u:$11A52; c:0), (u:$11A53; c:0), (u:$11A54; c:0), + (u:$11A55; c:0), (u:$11A56; c:0), (u:$11A57; c:210), (u:$11A58; c:210), + (u:$11A59; c:0), (u:$11A5A; c:0), (u:$11A5B; c:0), (u:$11A8A; c:0), + (u:$11A8B; c:0), (u:$11A8C; c:0), (u:$11A8D; c:0), (u:$11A8E; c:0), + (u:$11A8F; c:0), (u:$11A90; c:0), (u:$11A91; c:0), (u:$11A92; c:0), + (u:$11A93; c:0), (u:$11A94; c:0), (u:$11A95; c:0), (u:$11A96; c:0), + (u:$11A97; c:210), (u:$11A98; c:0), (u:$11A99; c:9), (u:$11C2F; c:210), + (u:$11C30; c:0), (u:$11C31; c:0), (u:$11C32; c:0), (u:$11C33; c:0), + (u:$11C34; c:0), (u:$11C35; c:0), (u:$11C36; c:0), (u:$11C38; c:0), + (u:$11C39; c:0), (u:$11C3A; c:0), (u:$11C3B; c:0), (u:$11C3C; c:0), + (u:$11C3D; c:0), (u:$11C3E; c:210), (u:$11C92; c:0), (u:$11C93; c:0), + (u:$11C94; c:0), (u:$11C95; c:0), (u:$11C96; c:0), (u:$11C97; c:0), + (u:$11C98; c:0), (u:$11C99; c:0), (u:$11C9A; c:0), (u:$11C9B; c:0), + (u:$11C9C; c:0), (u:$11C9D; c:0), (u:$11C9E; c:0), (u:$11C9F; c:0), + (u:$11CA0; c:0), (u:$11CA1; c:0), (u:$11CA2; c:0), (u:$11CA3; c:0), + (u:$11CA4; c:0), (u:$11CA5; c:0), (u:$11CA6; c:0), (u:$11CA7; c:0), + (u:$11CA9; c:210), (u:$11CAA; c:0), (u:$11CAB; c:0), (u:$11CAC; c:0), + (u:$11CAD; c:0), (u:$11CAE; c:0), (u:$11CAF; c:0), (u:$11CB0; c:0), + (u:$11CB1; c:210), (u:$11CB2; c:0), (u:$11CB3; c:0), (u:$11CB4; c:210), + (u:$11CB5; c:0), (u:$11CB6; c:0), (u:$11D31; c:0), (u:$11D32; c:0), + (u:$11D33; c:0), (u:$11D34; c:0), (u:$11D35; c:0), (u:$11D36; c:0), + (u:$11D3A; c:0), (u:$11D3C; c:0), (u:$11D3D; c:0), (u:$11D3F; c:0), + (u:$11D40; c:0), (u:$11D41; c:0), (u:$11D42; c:7), (u:$11D43; c:0), + (u:$11D44; c:9), (u:$11D45; c:9), (u:$11D47; c:0), (u:$11D8A; c:210), + (u:$11D8B; c:210), (u:$11D8C; c:210), (u:$11D8D; c:210), (u:$11D8E; c:210), + (u:$11D90; c:0), (u:$11D91; c:0), (u:$11D93; c:210), (u:$11D94; c:210), + (u:$11D95; c:0), (u:$11D96; c:210), (u:$11D97; c:9), (u:$11EF3; c:0), + (u:$11EF4; c:0), (u:$11EF5; c:210), (u:$11EF6; c:210), (u:$16AF0; c:1), + (u:$16AF1; c:1), (u:$16AF2; c:1), (u:$16AF3; c:1), (u:$16AF4; c:1), + (u:$16B30; c:230), (u:$16B31; c:230), (u:$16B32; c:230), (u:$16B33; c:230), + (u:$16B34; c:230), (u:$16B35; c:230), (u:$16B36; c:230), (u:$16F4F; c:0), + (u:$16F51; c:210), (u:$16F52; c:210), (u:$16F53; c:210), (u:$16F54; c:210), + (u:$16F55; c:210), (u:$16F56; c:210), (u:$16F57; c:210), (u:$16F58; c:210), + (u:$16F59; c:210), (u:$16F5A; c:210), (u:$16F5B; c:210), (u:$16F5C; c:210), + (u:$16F5D; c:210), (u:$16F5E; c:210), (u:$16F5F; c:210), (u:$16F60; c:210), + (u:$16F61; c:210), (u:$16F62; c:210), (u:$16F63; c:210), (u:$16F64; c:210), + (u:$16F65; c:210), (u:$16F66; c:210), (u:$16F67; c:210), (u:$16F68; c:210), + (u:$16F69; c:210), (u:$16F6A; c:210), (u:$16F6B; c:210), (u:$16F6C; c:210), + (u:$16F6D; c:210), (u:$16F6E; c:210), (u:$16F6F; c:210), (u:$16F70; c:210), + (u:$16F71; c:210), (u:$16F72; c:210), (u:$16F73; c:210), (u:$16F74; c:210), + (u:$16F75; c:210), (u:$16F76; c:210), (u:$16F77; c:210), (u:$16F78; c:210), + (u:$16F79; c:210), (u:$16F7A; c:210), (u:$16F7B; c:210), (u:$16F7C; c:210), + (u:$16F7D; c:210), (u:$16F7E; c:210), (u:$16F7F; c:210), (u:$16F80; c:210), + (u:$16F81; c:210), (u:$16F82; c:210), (u:$16F83; c:210), (u:$16F84; c:210), + (u:$16F85; c:210), (u:$16F86; c:210), (u:$16F87; c:210), (u:$16F8F; c:0), + (u:$16F90; c:0), (u:$16F91; c:0), (u:$16F92; c:0), (u:$16FE4; c:0), + (u:$16FF0; c:6), (u:$16FF1; c:6), (u:$1BC9D; c:0), (u:$1BC9E; c:1), + (u:$1D165; c:216), (u:$1D166; c:216), (u:$1D167; c:1), (u:$1D168; c:1), + (u:$1D169; c:1), (u:$1D16D; c:226), (u:$1D16E; c:216), (u:$1D16F; c:216), + (u:$1D170; c:216), (u:$1D171; c:216), (u:$1D172; c:216), (u:$1D17B; c:220), + (u:$1D17C; c:220), (u:$1D17D; c:220), (u:$1D17E; c:220), (u:$1D17F; c:220), + (u:$1D180; c:220), (u:$1D181; c:220), (u:$1D182; c:220), (u:$1D185; c:230), + (u:$1D186; c:230), (u:$1D187; c:230), (u:$1D188; c:230), (u:$1D189; c:230), + (u:$1D18A; c:220), (u:$1D18B; c:220), (u:$1D1AA; c:230), (u:$1D1AB; c:230), + (u:$1D1AC; c:230), (u:$1D1AD; c:230), (u:$1D242; c:230), (u:$1D243; c:230), + (u:$1D244; c:230), (u:$1DA00; c:0), (u:$1DA01; c:0), (u:$1DA02; c:0), + (u:$1DA03; c:0), (u:$1DA04; c:0), (u:$1DA05; c:0), (u:$1DA06; c:0), + (u:$1DA07; c:0), (u:$1DA08; c:0), (u:$1DA09; c:0), (u:$1DA0A; c:0), + (u:$1DA0B; c:0), (u:$1DA0C; c:0), (u:$1DA0D; c:0), (u:$1DA0E; c:0), + (u:$1DA0F; c:0), (u:$1DA10; c:0), (u:$1DA11; c:0), (u:$1DA12; c:0), + (u:$1DA13; c:0), (u:$1DA14; c:0), (u:$1DA15; c:0), (u:$1DA16; c:0), + (u:$1DA17; c:0), (u:$1DA18; c:0), (u:$1DA19; c:0), (u:$1DA1A; c:0), + (u:$1DA1B; c:0), (u:$1DA1C; c:0), (u:$1DA1D; c:0), (u:$1DA1E; c:0), + (u:$1DA1F; c:0), (u:$1DA20; c:0), (u:$1DA21; c:0), (u:$1DA22; c:0), + (u:$1DA23; c:0), (u:$1DA24; c:0), (u:$1DA25; c:0), (u:$1DA26; c:0), + (u:$1DA27; c:0), (u:$1DA28; c:0), (u:$1DA29; c:0), (u:$1DA2A; c:0), + (u:$1DA2B; c:0), (u:$1DA2C; c:0), (u:$1DA2D; c:0), (u:$1DA2E; c:0), + (u:$1DA2F; c:0), (u:$1DA30; c:0), (u:$1DA31; c:0), (u:$1DA32; c:0), + (u:$1DA33; c:0), (u:$1DA34; c:0), (u:$1DA35; c:0), (u:$1DA36; c:0), + (u:$1DA3B; c:0), (u:$1DA3C; c:0), (u:$1DA3D; c:0), (u:$1DA3E; c:0), + (u:$1DA3F; c:0), (u:$1DA40; c:0), (u:$1DA41; c:0), (u:$1DA42; c:0), + (u:$1DA43; c:0), (u:$1DA44; c:0), (u:$1DA45; c:0), (u:$1DA46; c:0), + (u:$1DA47; c:0), (u:$1DA48; c:0), (u:$1DA49; c:0), (u:$1DA4A; c:0), + (u:$1DA4B; c:0), (u:$1DA4C; c:0), (u:$1DA4D; c:0), (u:$1DA4E; c:0), + (u:$1DA4F; c:0), (u:$1DA50; c:0), (u:$1DA51; c:0), (u:$1DA52; c:0), + (u:$1DA53; c:0), (u:$1DA54; c:0), (u:$1DA55; c:0), (u:$1DA56; c:0), + (u:$1DA57; c:0), (u:$1DA58; c:0), (u:$1DA59; c:0), (u:$1DA5A; c:0), + (u:$1DA5B; c:0), (u:$1DA5C; c:0), (u:$1DA5D; c:0), (u:$1DA5E; c:0), + (u:$1DA5F; c:0), (u:$1DA60; c:0), (u:$1DA61; c:0), (u:$1DA62; c:0), + (u:$1DA63; c:0), (u:$1DA64; c:0), (u:$1DA65; c:0), (u:$1DA66; c:0), + (u:$1DA67; c:0), (u:$1DA68; c:0), (u:$1DA69; c:0), (u:$1DA6A; c:0), + (u:$1DA6B; c:0), (u:$1DA6C; c:0), (u:$1DA75; c:0), (u:$1DA84; c:0), + (u:$1DA9B; c:0), (u:$1DA9C; c:0), (u:$1DA9D; c:0), (u:$1DA9E; c:0), + (u:$1DA9F; c:0), (u:$1DAA1; c:0), (u:$1DAA2; c:0), (u:$1DAA3; c:0), + (u:$1DAA4; c:0), (u:$1DAA5; c:0), (u:$1DAA6; c:0), (u:$1DAA7; c:0), + (u:$1DAA8; c:0), (u:$1DAA9; c:0), (u:$1DAAA; c:0), (u:$1DAAB; c:0), + (u:$1DAAC; c:0), (u:$1DAAD; c:0), (u:$1DAAE; c:0), (u:$1DAAF; c:0), + (u:$1E000; c:230), (u:$1E001; c:230), (u:$1E002; c:230), (u:$1E003; c:230), + (u:$1E004; c:230), (u:$1E005; c:230), (u:$1E006; c:230), (u:$1E008; c:230), + (u:$1E009; c:230), (u:$1E00A; c:230), (u:$1E00B; c:230), (u:$1E00C; c:230), + (u:$1E00D; c:230), (u:$1E00E; c:230), (u:$1E00F; c:230), (u:$1E010; c:230), + (u:$1E011; c:230), (u:$1E012; c:230), (u:$1E013; c:230), (u:$1E014; c:230), + (u:$1E015; c:230), (u:$1E016; c:230), (u:$1E017; c:230), (u:$1E018; c:230), + (u:$1E01B; c:230), (u:$1E01C; c:230), (u:$1E01D; c:230), (u:$1E01E; c:230), + (u:$1E01F; c:230), (u:$1E020; c:230), (u:$1E021; c:230), (u:$1E023; c:230), + (u:$1E024; c:230), (u:$1E026; c:230), (u:$1E027; c:230), (u:$1E028; c:230), + (u:$1E029; c:230), (u:$1E02A; c:230), (u:$1E130; c:230), (u:$1E131; c:230), + (u:$1E132; c:230), (u:$1E133; c:230), (u:$1E134; c:230), (u:$1E135; c:230), + (u:$1E136; c:230), (u:$1E2EC; c:230), (u:$1E2ED; c:230), (u:$1E2EE; c:230), + (u:$1E2EF; c:230), (u:$1E8D0; c:220), (u:$1E8D1; c:220), (u:$1E8D2; c:220), + (u:$1E8D3; c:220), (u:$1E8D4; c:220), (u:$1E8D5; c:220), (u:$1E8D6; c:220), + (u:$1E944; c:230), (u:$1E945; c:230), (u:$1E946; c:230), (u:$1E947; c:230), + (u:$1E948; c:230), (u:$1E949; c:230), (u:$1E94A; c:7), (u:$E0100; c:0), + (u:$E0101; c:0), (u:$E0102; c:0), (u:$E0103; c:0), (u:$E0104; c:0), + (u:$E0105; c:0), (u:$E0106; c:0), (u:$E0107; c:0), (u:$E0108; c:0), + (u:$E0109; c:0), (u:$E010A; c:0), (u:$E010B; c:0), (u:$E010C; c:0), + (u:$E010D; c:0), (u:$E010E; c:0), (u:$E010F; c:0), (u:$E0110; c:0), + (u:$E0111; c:0), (u:$E0112; c:0), (u:$E0113; c:0), (u:$E0114; c:0), + (u:$E0115; c:0), (u:$E0116; c:0), (u:$E0117; c:0), (u:$E0118; c:0), + (u:$E0119; c:0), (u:$E011A; c:0), (u:$E011B; c:0), (u:$E011C; c:0), + (u:$E011D; c:0), (u:$E011E; c:0), (u:$E011F; c:0), (u:$E0120; c:0), + (u:$E0121; c:0), (u:$E0122; c:0), (u:$E0123; c:0), (u:$E0124; c:0), + (u:$E0125; c:0), (u:$E0126; c:0), (u:$E0127; c:0), (u:$E0128; c:0), + (u:$E0129; c:0), (u:$E012A; c:0), (u:$E012B; c:0), (u:$E012C; c:0), + (u:$E012D; c:0), (u:$E012E; c:0), (u:$E012F; c:0), (u:$E0130; c:0), + (u:$E0131; c:0), (u:$E0132; c:0), (u:$E0133; c:0), (u:$E0134; c:0), + (u:$E0135; c:0), (u:$E0136; c:0), (u:$E0137; c:0), (u:$E0138; c:0), + (u:$E0139; c:0), (u:$E013A; c:0), (u:$E013B; c:0), (u:$E013C; c:0), + (u:$E013D; c:0), (u:$E013E; c:0), (u:$E013F; c:0), (u:$E0140; c:0), + (u:$E0141; c:0), (u:$E0142; c:0), (u:$E0143; c:0), (u:$E0144; c:0), + (u:$E0145; c:0), (u:$E0146; c:0), (u:$E0147; c:0), (u:$E0148; c:0), + (u:$E0149; c:0), (u:$E014A; c:0), (u:$E014B; c:0), (u:$E014C; c:0), + (u:$E014D; c:0), (u:$E014E; c:0), (u:$E014F; c:0), (u:$E0150; c:0), + (u:$E0151; c:0), (u:$E0152; c:0), (u:$E0153; c:0), (u:$E0154; c:0), + (u:$E0155; c:0), (u:$E0156; c:0), (u:$E0157; c:0), (u:$E0158; c:0), + (u:$E0159; c:0), (u:$E015A; c:0), (u:$E015B; c:0), (u:$E015C; c:0), + (u:$E015D; c:0), (u:$E015E; c:0), (u:$E015F; c:0), (u:$E0160; c:0), + (u:$E0161; c:0), (u:$E0162; c:0), (u:$E0163; c:0), (u:$E0164; c:0), + (u:$E0165; c:0), (u:$E0166; c:0), (u:$E0167; c:0), (u:$E0168; c:0), + (u:$E0169; c:0), (u:$E016A; c:0), (u:$E016B; c:0), (u:$E016C; c:0), + (u:$E016D; c:0), (u:$E016E; c:0), (u:$E016F; c:0), (u:$E0170; c:0), + (u:$E0171; c:0), (u:$E0172; c:0), (u:$E0173; c:0), (u:$E0174; c:0), + (u:$E0175; c:0), (u:$E0176; c:0), (u:$E0177; c:0), (u:$E0178; c:0), + (u:$E0179; c:0), (u:$E017A; c:0), (u:$E017B; c:0), (u:$E017C; c:0), + (u:$E017D; c:0), (u:$E017E; c:0), (u:$E017F; c:0), (u:$E0180; c:0), + (u:$E0181; c:0), (u:$E0182; c:0), (u:$E0183; c:0), (u:$E0184; c:0), + (u:$E0185; c:0), (u:$E0186; c:0), (u:$E0187; c:0), (u:$E0188; c:0), + (u:$E0189; c:0), (u:$E018A; c:0), (u:$E018B; c:0), (u:$E018C; c:0), + (u:$E018D; c:0), (u:$E018E; c:0), (u:$E018F; c:0), (u:$E0190; c:0), + (u:$E0191; c:0), (u:$E0192; c:0), (u:$E0193; c:0), (u:$E0194; c:0), + (u:$E0195; c:0), (u:$E0196; c:0), (u:$E0197; c:0), (u:$E0198; c:0), + (u:$E0199; c:0), (u:$E019A; c:0), (u:$E019B; c:0), (u:$E019C; c:0), + (u:$E019D; c:0), (u:$E019E; c:0), (u:$E019F; c:0), (u:$E01A0; c:0), + (u:$E01A1; c:0), (u:$E01A2; c:0), (u:$E01A3; c:0), (u:$E01A4; c:0), + (u:$E01A5; c:0), (u:$E01A6; c:0), (u:$E01A7; c:0), (u:$E01A8; c:0), + (u:$E01A9; c:0), (u:$E01AA; c:0), (u:$E01AB; c:0), (u:$E01AC; c:0), + (u:$E01AD; c:0), (u:$E01AE; c:0), (u:$E01AF; c:0), (u:$E01B0; c:0), + (u:$E01B1; c:0), (u:$E01B2; c:0), (u:$E01B3; c:0), (u:$E01B4; c:0), + (u:$E01B5; c:0), (u:$E01B6; c:0), (u:$E01B7; c:0), (u:$E01B8; c:0), + (u:$E01B9; c:0), (u:$E01BA; c:0), (u:$E01BB; c:0), (u:$E01BC; c:0), + (u:$E01BD; c:0), (u:$E01BE; c:0), (u:$E01BF; c:0), (u:$E01C0; c:0), + (u:$E01C1; c:0), (u:$E01C2; c:0), (u:$E01C3; c:0), (u:$E01C4; c:0), + (u:$E01C5; c:0), (u:$E01C6; c:0), (u:$E01C7; c:0), (u:$E01C8; c:0), + (u:$E01C9; c:0), (u:$E01CA; c:0), (u:$E01CB; c:0), (u:$E01CC; c:0), + (u:$E01CD; c:0), (u:$E01CE; c:0), (u:$E01CF; c:0), (u:$E01D0; c:0), + (u:$E01D1; c:0), (u:$E01D2; c:0), (u:$E01D3; c:0), (u:$E01D4; c:0), + (u:$E01D5; c:0), (u:$E01D6; c:0), (u:$E01D7; c:0), (u:$E01D8; c:0), + (u:$E01D9; c:0), (u:$E01DA; c:0), (u:$E01DB; c:0), (u:$E01DC; c:0), + (u:$E01DD; c:0), (u:$E01DE; c:0), (u:$E01DF; c:0), (u:$E01E0; c:0), + (u:$E01E1; c:0), (u:$E01E2; c:0), (u:$E01E3; c:0), (u:$E01E4; c:0), + (u:$E01E5; c:0), (u:$E01E6; c:0), (u:$E01E7; c:0), (u:$E01E8; c:0), + (u:$E01E9; c:0), (u:$E01EA; c:0), (u:$E01EB; c:0), (u:$E01EC; c:0), + (u:$E01ED; c:0), (u:$E01EE; c:0), (u:$E01EF; c:0) + ); + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/generatedutf8.inc b/vendor/kam_remake/src/ext/BGRABitmap/generatedutf8.inc new file mode 100644 index 0000000..d3db417 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/generatedutf8.inc @@ -0,0 +1,1231 @@ +{ This file is generated by dev/parseunicode/parseunicodeclasses program } +type + TArabicJoin = (arNone, arInitial, arMedial, arFinal, arIsolated); + TUTF8Decomposition = record + de, re: string; //decomposed, recomposed UTF8 + join: TArabicJoin; + end; +const + UTF8Decomposition : array[0..1219] of TUTF8Decomposition = ( + (de:'≮'; re:'≮'; join:arNone), + (de:'≠'; re:'≠'; join:arNone), + (de:'≯'; re:'≯'; join:arNone), + (de:'AÌ€'; re:'À'; join:arNone), + (de:'AÌ'; re:'Ã'; join:arNone), + (de:'AÌ‚'; re:'Â'; join:arNone), + (de:'Ã'; re:'Ã'; join:arNone), + (de:'AÌ„'; re:'Ä€'; join:arNone), + (de:'Ă'; re:'Ä‚'; join:arNone), + (de:'Ȧ'; re:'Ȧ'; join:arNone), + (de:'Ä'; re:'Ä'; join:arNone), + (de:'Ả'; re:'Ả'; join:arNone), + (de:'AÌŠ'; re:'Ã…'; join:arNone), + (de:'AÌŒ'; re:'Ç'; join:arNone), + (de:'AÌ'; re:'È€'; join:arNone), + (de:'AÌ‘'; re:'È‚'; join:arNone), + (de:'AÌ£'; re:'Ạ'; join:arNone), + (de:'AÌ¥'; re:'Ḁ'; join:arNone), + (de:'Ą'; re:'Ä„'; join:arNone), + (de:'Ḃ'; re:'Ḃ'; join:arNone), + (de:'BÌ£'; re:'Ḅ'; join:arNone), + (de:'Ḇ'; re:'Ḇ'; join:arNone), + (de:'CÌ'; re:'Ć'; join:arNone), + (de:'CÌ‚'; re:'Ĉ'; join:arNone), + (de:'Ċ'; re:'ÄŠ'; join:arNone), + (de:'CÌŒ'; re:'ÄŒ'; join:arNone), + (de:'Ç'; re:'Ç'; join:arNone), + (de:'Ḋ'; re:'Ḋ'; join:arNone), + (de:'DÌŒ'; re:'ÄŽ'; join:arNone), + (de:'DÌ£'; re:'Ḍ'; join:arNone), + (de:'Ḑ'; re:'á¸'; join:arNone), + (de:'DÌ­'; re:'Ḓ'; join:arNone), + (de:'Ḏ'; re:'Ḏ'; join:arNone), + (de:'EÌ€'; re:'È'; join:arNone), + (de:'EÌ'; re:'É'; join:arNone), + (de:'EÌ‚'; re:'Ê'; join:arNone), + (de:'Ẽ'; re:'Ẽ'; join:arNone), + (de:'EÌ„'; re:'Ä’'; join:arNone), + (de:'Ĕ'; re:'Ä”'; join:arNone), + (de:'Ė'; re:'Ä–'; join:arNone), + (de:'Ë'; re:'Ë'; join:arNone), + (de:'Ẻ'; re:'Ẻ'; join:arNone), + (de:'EÌŒ'; re:'Äš'; join:arNone), + (de:'EÌ'; re:'È„'; join:arNone), + (de:'EÌ‘'; re:'Ȇ'; join:arNone), + (de:'EÌ£'; re:'Ẹ'; join:arNone), + (de:'Ȩ'; re:'Ȩ'; join:arNone), + (de:'Ę'; re:'Ę'; join:arNone), + (de:'EÌ­'; re:'Ḙ'; join:arNone), + (de:'EÌ°'; re:'Ḛ'; join:arNone), + (de:'Ḟ'; re:'Ḟ'; join:arNone), + (de:'GÌ'; re:'Ç´'; join:arNone), + (de:'GÌ‚'; re:'Äœ'; join:arNone), + (de:'GÌ„'; re:'Ḡ'; join:arNone), + (de:'Ğ'; re:'Äž'; join:arNone), + (de:'Ġ'; re:'Ä '; join:arNone), + (de:'GÌŒ'; re:'Ǧ'; join:arNone), + (de:'Ģ'; re:'Ä¢'; join:arNone), + (de:'HÌ‚'; re:'Ĥ'; join:arNone), + (de:'Ḣ'; re:'Ḣ'; join:arNone), + (de:'Ḧ'; re:'Ḧ'; join:arNone), + (de:'HÌŒ'; re:'Èž'; join:arNone), + (de:'HÌ£'; re:'Ḥ'; join:arNone), + (de:'Ḩ'; re:'Ḩ'; join:arNone), + (de:'HÌ®'; re:'Ḫ'; join:arNone), + (de:'IÌ€'; re:'ÃŒ'; join:arNone), + (de:'IÌ'; re:'Ã'; join:arNone), + (de:'IÌ‚'; re:'ÃŽ'; join:arNone), + (de:'Ĩ'; re:'Ĩ'; join:arNone), + (de:'IÌ„'; re:'Ī'; join:arNone), + (de:'Ĭ'; re:'Ĭ'; join:arNone), + (de:'İ'; re:'Ä°'; join:arNone), + (de:'Ï'; re:'Ã'; join:arNone), + (de:'Ỉ'; re:'Ỉ'; join:arNone), + (de:'IÌŒ'; re:'Ç'; join:arNone), + (de:'IÌ'; re:'Ȉ'; join:arNone), + (de:'IÌ‘'; re:'ÈŠ'; join:arNone), + (de:'IÌ£'; re:'Ị'; join:arNone), + (de:'Į'; re:'Ä®'; join:arNone), + (de:'IÌ°'; re:'Ḭ'; join:arNone), + (de:'JÌ‚'; re:'Ä´'; join:arNone), + (de:'KÌ'; re:'Ḱ'; join:arNone), + (de:'KÌŒ'; re:'Ǩ'; join:arNone), + (de:'KÌ£'; re:'Ḳ'; join:arNone), + (de:'Ķ'; re:'Ķ'; join:arNone), + (de:'Ḵ'; re:'Ḵ'; join:arNone), + (de:'LÌ'; re:'Ĺ'; join:arNone), + (de:'LÌŒ'; re:'Ľ'; join:arNone), + (de:'LÌ£'; re:'Ḷ'; join:arNone), + (de:'Ļ'; re:'Ä»'; join:arNone), + (de:'LÌ­'; re:'Ḽ'; join:arNone), + (de:'Ḻ'; re:'Ḻ'; join:arNone), + (de:'MÌ'; re:'Ḿ'; join:arNone), + (de:'Ṁ'; re:'á¹€'; join:arNone), + (de:'MÌ£'; re:'Ṃ'; join:arNone), + (de:'NÌ€'; re:'Ǹ'; join:arNone), + (de:'NÌ'; re:'Ń'; join:arNone), + (de:'Ñ'; re:'Ñ'; join:arNone), + (de:'Ṅ'; re:'Ṅ'; join:arNone), + (de:'NÌŒ'; re:'Ň'; join:arNone), + (de:'NÌ£'; re:'Ṇ'; join:arNone), + (de:'Ņ'; re:'Å…'; join:arNone), + (de:'NÌ­'; re:'Ṋ'; join:arNone), + (de:'Ṉ'; re:'Ṉ'; join:arNone), + (de:'OÌ€'; re:'Ã’'; join:arNone), + (de:'OÌ'; re:'Ó'; join:arNone), + (de:'OÌ‚'; re:'Ô'; join:arNone), + (de:'Õ'; re:'Õ'; join:arNone), + (de:'OÌ„'; re:'ÅŒ'; join:arNone), + (de:'Ŏ'; re:'ÅŽ'; join:arNone), + (de:'Ȯ'; re:'È®'; join:arNone), + (de:'Ö'; re:'Ö'; join:arNone), + (de:'Ỏ'; re:'Ỏ'; join:arNone), + (de:'OÌ‹'; re:'Å'; join:arNone), + (de:'OÌŒ'; re:'Ç‘'; join:arNone), + (de:'OÌ'; re:'ÈŒ'; join:arNone), + (de:'OÌ‘'; re:'ÈŽ'; join:arNone), + (de:'OÌ›'; re:'Æ '; join:arNone), + (de:'OÌ£'; re:'Ọ'; join:arNone), + (de:'Ǫ'; re:'Ǫ'; join:arNone), + (de:'PÌ'; re:'á¹”'; join:arNone), + (de:'Ṗ'; re:'á¹–'; join:arNone), + (de:'RÌ'; re:'Å”'; join:arNone), + (de:'Ṙ'; re:'Ṙ'; join:arNone), + (de:'RÌŒ'; re:'Ř'; join:arNone), + (de:'RÌ'; re:'È'; join:arNone), + (de:'RÌ‘'; re:'È’'; join:arNone), + (de:'RÌ£'; re:'Ṛ'; join:arNone), + (de:'Ŗ'; re:'Å–'; join:arNone), + (de:'Ṟ'; re:'Ṟ'; join:arNone), + (de:'SÌ'; re:'Åš'; join:arNone), + (de:'SÌ‚'; re:'Åœ'; join:arNone), + (de:'Ṡ'; re:'á¹ '; join:arNone), + (de:'SÌŒ'; re:'Å '; join:arNone), + (de:'SÌ£'; re:'á¹¢'; join:arNone), + (de:'Ș'; re:'Ș'; join:arNone), + (de:'Ş'; re:'Åž'; join:arNone), + (de:'Ṫ'; re:'Ṫ'; join:arNone), + (de:'TÌŒ'; re:'Ť'; join:arNone), + (de:'TÌ£'; re:'Ṭ'; join:arNone), + (de:'Ț'; re:'Èš'; join:arNone), + (de:'Ţ'; re:'Å¢'; join:arNone), + (de:'TÌ­'; re:'á¹°'; join:arNone), + (de:'Ṯ'; re:'á¹®'; join:arNone), + (de:'UÌ€'; re:'Ù'; join:arNone), + (de:'UÌ'; re:'Ú'; join:arNone), + (de:'UÌ‚'; re:'Û'; join:arNone), + (de:'Ũ'; re:'Ũ'; join:arNone), + (de:'UÌ„'; re:'Ū'; join:arNone), + (de:'Ŭ'; re:'Ŭ'; join:arNone), + (de:'Ü'; re:'Ãœ'; join:arNone), + (de:'Ủ'; re:'Ủ'; join:arNone), + (de:'UÌŠ'; re:'Å®'; join:arNone), + (de:'UÌ‹'; re:'Å°'; join:arNone), + (de:'UÌŒ'; re:'Ç“'; join:arNone), + (de:'UÌ'; re:'È”'; join:arNone), + (de:'UÌ‘'; re:'È–'; join:arNone), + (de:'UÌ›'; re:'Ư'; join:arNone), + (de:'UÌ£'; re:'Ụ'; join:arNone), + (de:'Ṳ'; re:'á¹²'; join:arNone), + (de:'Ų'; re:'Ų'; join:arNone), + (de:'UÌ­'; re:'Ṷ'; join:arNone), + (de:'UÌ°'; re:'á¹´'; join:arNone), + (de:'Ṽ'; re:'á¹¼'; join:arNone), + (de:'VÌ£'; re:'á¹¾'; join:arNone), + (de:'WÌ€'; re:'Ẁ'; join:arNone), + (de:'WÌ'; re:'Ẃ'; join:arNone), + (de:'WÌ‚'; re:'Å´'; join:arNone), + (de:'Ẇ'; re:'Ẇ'; join:arNone), + (de:'Ẅ'; re:'Ẅ'; join:arNone), + (de:'WÌ£'; re:'Ẉ'; join:arNone), + (de:'Ẋ'; re:'Ẋ'; join:arNone), + (de:'Ẍ'; re:'Ẍ'; join:arNone), + (de:'YÌ€'; re:'Ỳ'; join:arNone), + (de:'YÌ'; re:'Ã'; join:arNone), + (de:'YÌ‚'; re:'Ŷ'; join:arNone), + (de:'Ỹ'; re:'Ỹ'; join:arNone), + (de:'YÌ„'; re:'Ȳ'; join:arNone), + (de:'Ẏ'; re:'Ẏ'; join:arNone), + (de:'Ÿ'; re:'Ÿ'; join:arNone), + (de:'Ỷ'; re:'Ỷ'; join:arNone), + (de:'YÌ£'; re:'á»´'; join:arNone), + (de:'ZÌ'; re:'Ź'; join:arNone), + (de:'ZÌ‚'; re:'áº'; join:arNone), + (de:'Ż'; re:'Å»'; join:arNone), + (de:'ZÌŒ'; re:'Ž'; join:arNone), + (de:'ZÌ£'; re:'Ẓ'; join:arNone), + (de:'Ẕ'; re:'Ẕ'; join:arNone), + (de:'aÌ€'; re:'à'; join:arNone), + (de:'aÌ'; re:'á'; join:arNone), + (de:'aÌ‚'; re:'â'; join:arNone), + (de:'ã'; re:'ã'; join:arNone), + (de:'aÌ„'; re:'Ä'; join:arNone), + (de:'ă'; re:'ă'; join:arNone), + (de:'ȧ'; re:'ȧ'; join:arNone), + (de:'ä'; re:'ä'; join:arNone), + (de:'ả'; re:'ả'; join:arNone), + (de:'aÌŠ'; re:'Ã¥'; join:arNone), + (de:'aÌŒ'; re:'ÇŽ'; join:arNone), + (de:'aÌ'; re:'È'; join:arNone), + (de:'aÌ‘'; re:'ȃ'; join:arNone), + (de:'aÌ£'; re:'ạ'; join:arNone), + (de:'aÌ¥'; re:'á¸'; join:arNone), + (de:'ą'; re:'Ä…'; join:arNone), + (de:'ḃ'; re:'ḃ'; join:arNone), + (de:'bÌ£'; re:'ḅ'; join:arNone), + (de:'ḇ'; re:'ḇ'; join:arNone), + (de:'cÌ'; re:'ć'; join:arNone), + (de:'cÌ‚'; re:'ĉ'; join:arNone), + (de:'ċ'; re:'Ä‹'; join:arNone), + (de:'cÌŒ'; re:'Ä'; join:arNone), + (de:'ç'; re:'ç'; join:arNone), + (de:'ḋ'; re:'ḋ'; join:arNone), + (de:'dÌŒ'; re:'Ä'; join:arNone), + (de:'dÌ£'; re:'á¸'; join:arNone), + (de:'ḑ'; re:'ḑ'; join:arNone), + (de:'dÌ­'; re:'ḓ'; join:arNone), + (de:'ḏ'; re:'á¸'; join:arNone), + (de:'eÌ€'; re:'è'; join:arNone), + (de:'eÌ'; re:'é'; join:arNone), + (de:'eÌ‚'; re:'ê'; join:arNone), + (de:'ẽ'; re:'ẽ'; join:arNone), + (de:'eÌ„'; re:'Ä“'; join:arNone), + (de:'ĕ'; re:'Ä•'; join:arNone), + (de:'ė'; re:'Ä—'; join:arNone), + (de:'ë'; re:'ë'; join:arNone), + (de:'ẻ'; re:'ẻ'; join:arNone), + (de:'eÌŒ'; re:'Ä›'; join:arNone), + (de:'eÌ'; re:'È…'; join:arNone), + (de:'eÌ‘'; re:'ȇ'; join:arNone), + (de:'eÌ£'; re:'ẹ'; join:arNone), + (de:'ȩ'; re:'È©'; join:arNone), + (de:'ę'; re:'Ä™'; join:arNone), + (de:'eÌ­'; re:'ḙ'; join:arNone), + (de:'eÌ°'; re:'ḛ'; join:arNone), + (de:'ff'; re:'ff'; join:arNone), + (de:'ffi'; re:'ffi'; join:arNone), + (de:'ffl'; re:'ffl'; join:arNone), + (de:'fi'; re:'ï¬'; join:arNone), + (de:'fl'; re:'fl'; join:arNone), + (de:'ḟ'; re:'ḟ'; join:arNone), + (de:'gÌ'; re:'ǵ'; join:arNone), + (de:'gÌ‚'; re:'Ä'; join:arNone), + (de:'gÌ„'; re:'ḡ'; join:arNone), + (de:'ğ'; re:'ÄŸ'; join:arNone), + (de:'ġ'; re:'Ä¡'; join:arNone), + (de:'gÌŒ'; re:'ǧ'; join:arNone), + (de:'ģ'; re:'Ä£'; join:arNone), + (de:'hÌ‚'; re:'Ä¥'; join:arNone), + (de:'ḣ'; re:'ḣ'; join:arNone), + (de:'ḧ'; re:'ḧ'; join:arNone), + (de:'hÌŒ'; re:'ÈŸ'; join:arNone), + (de:'hÌ£'; re:'ḥ'; join:arNone), + (de:'ḩ'; re:'ḩ'; join:arNone), + (de:'hÌ®'; re:'ḫ'; join:arNone), + (de:'ẖ'; re:'ẖ'; join:arNone), + (de:'iÌ€'; re:'ì'; join:arNone), + (de:'iÌ'; re:'í'; join:arNone), + (de:'iÌ‚'; re:'î'; join:arNone), + (de:'ĩ'; re:'Ä©'; join:arNone), + (de:'iÌ„'; re:'Ä«'; join:arNone), + (de:'ĭ'; re:'Ä­'; join:arNone), + (de:'ï'; re:'ï'; join:arNone), + (de:'ỉ'; re:'ỉ'; join:arNone), + (de:'iÌŒ'; re:'Ç'; join:arNone), + (de:'iÌ'; re:'ȉ'; join:arNone), + (de:'iÌ‘'; re:'È‹'; join:arNone), + (de:'iÌ£'; re:'ị'; join:arNone), + (de:'į'; re:'į'; join:arNone), + (de:'iÌ°'; re:'ḭ'; join:arNone), + (de:'jÌ‚'; re:'ĵ'; join:arNone), + (de:'jÌŒ'; re:'Ç°'; join:arNone), + (de:'kÌ'; re:'ḱ'; join:arNone), + (de:'kÌŒ'; re:'Ç©'; join:arNone), + (de:'kÌ£'; re:'ḳ'; join:arNone), + (de:'ķ'; re:'Ä·'; join:arNone), + (de:'ḵ'; re:'ḵ'; join:arNone), + (de:'lÌ'; re:'ĺ'; join:arNone), + (de:'lÌŒ'; re:'ľ'; join:arNone), + (de:'lÌ£'; re:'ḷ'; join:arNone), + (de:'ļ'; re:'ļ'; join:arNone), + (de:'lÌ­'; re:'ḽ'; join:arNone), + (de:'ḻ'; re:'ḻ'; join:arNone), + (de:'mÌ'; re:'ḿ'; join:arNone), + (de:'ṁ'; re:'á¹'; join:arNone), + (de:'mÌ£'; re:'ṃ'; join:arNone), + (de:'nÌ€'; re:'ǹ'; join:arNone), + (de:'nÌ'; re:'Å„'; join:arNone), + (de:'ñ'; re:'ñ'; join:arNone), + (de:'ṅ'; re:'á¹…'; join:arNone), + (de:'nÌŒ'; re:'ň'; join:arNone), + (de:'nÌ£'; re:'ṇ'; join:arNone), + (de:'ņ'; re:'ņ'; join:arNone), + (de:'nÌ­'; re:'ṋ'; join:arNone), + (de:'ṉ'; re:'ṉ'; join:arNone), + (de:'oÌ€'; re:'ò'; join:arNone), + (de:'oÌ'; re:'ó'; join:arNone), + (de:'oÌ‚'; re:'ô'; join:arNone), + (de:'õ'; re:'õ'; join:arNone), + (de:'oÌ„'; re:'Å'; join:arNone), + (de:'ŏ'; re:'Å'; join:arNone), + (de:'ȯ'; re:'ȯ'; join:arNone), + (de:'ö'; re:'ö'; join:arNone), + (de:'ỏ'; re:'á»'; join:arNone), + (de:'oÌ‹'; re:'Å‘'; join:arNone), + (de:'oÌŒ'; re:'Ç’'; join:arNone), + (de:'oÌ'; re:'È'; join:arNone), + (de:'oÌ‘'; re:'È'; join:arNone), + (de:'oÌ›'; re:'Æ¡'; join:arNone), + (de:'oÌ£'; re:'á»'; join:arNone), + (de:'ǫ'; re:'Ç«'; join:arNone), + (de:'pÌ'; re:'ṕ'; join:arNone), + (de:'ṗ'; re:'á¹—'; join:arNone), + (de:'rÌ'; re:'Å•'; join:arNone), + (de:'ṙ'; re:'á¹™'; join:arNone), + (de:'rÌŒ'; re:'Å™'; join:arNone), + (de:'rÌ'; re:'È‘'; join:arNone), + (de:'rÌ‘'; re:'È“'; join:arNone), + (de:'rÌ£'; re:'á¹›'; join:arNone), + (de:'ŗ'; re:'Å—'; join:arNone), + (de:'ṟ'; re:'ṟ'; join:arNone), + (de:'sÌ'; re:'Å›'; join:arNone), + (de:'sÌ‚'; re:'Å'; join:arNone), + (de:'ṡ'; re:'ṡ'; join:arNone), + (de:'sÌŒ'; re:'Å¡'; join:arNone), + (de:'sÌ£'; re:'á¹£'; join:arNone), + (de:'ș'; re:'È™'; join:arNone), + (de:'ş'; re:'ÅŸ'; join:arNone), + (de:'ṫ'; re:'ṫ'; join:arNone), + (de:'ẗ'; re:'ẗ'; join:arNone), + (de:'tÌŒ'; re:'Å¥'; join:arNone), + (de:'tÌ£'; re:'á¹­'; join:arNone), + (de:'ț'; re:'È›'; join:arNone), + (de:'ţ'; re:'Å£'; join:arNone), + (de:'tÌ­'; re:'á¹±'; join:arNone), + (de:'ṯ'; re:'ṯ'; join:arNone), + (de:'uÌ€'; re:'ù'; join:arNone), + (de:'uÌ'; re:'ú'; join:arNone), + (de:'uÌ‚'; re:'û'; join:arNone), + (de:'ũ'; re:'Å©'; join:arNone), + (de:'uÌ„'; re:'Å«'; join:arNone), + (de:'ŭ'; re:'Å­'; join:arNone), + (de:'ü'; re:'ü'; join:arNone), + (de:'ủ'; re:'ủ'; join:arNone), + (de:'uÌŠ'; re:'ů'; join:arNone), + (de:'uÌ‹'; re:'ű'; join:arNone), + (de:'uÌŒ'; re:'Ç”'; join:arNone), + (de:'uÌ'; re:'È•'; join:arNone), + (de:'uÌ‘'; re:'È—'; join:arNone), + (de:'uÌ›'; re:'Æ°'; join:arNone), + (de:'uÌ£'; re:'ụ'; join:arNone), + (de:'ṳ'; re:'á¹³'; join:arNone), + (de:'ų'; re:'ų'; join:arNone), + (de:'uÌ­'; re:'á¹·'; join:arNone), + (de:'uÌ°'; re:'á¹µ'; join:arNone), + (de:'ṽ'; re:'á¹½'; join:arNone), + (de:'vÌ£'; re:'ṿ'; join:arNone), + (de:'wÌ€'; re:'áº'; join:arNone), + (de:'wÌ'; re:'ẃ'; join:arNone), + (de:'wÌ‚'; re:'ŵ'; join:arNone), + (de:'ẇ'; re:'ẇ'; join:arNone), + (de:'ẅ'; re:'ẅ'; join:arNone), + (de:'wÌŠ'; re:'ẘ'; join:arNone), + (de:'wÌ£'; re:'ẉ'; join:arNone), + (de:'ẋ'; re:'ẋ'; join:arNone), + (de:'ẍ'; re:'áº'; join:arNone), + (de:'yÌ€'; re:'ỳ'; join:arNone), + (de:'yÌ'; re:'ý'; join:arNone), + (de:'yÌ‚'; re:'Å·'; join:arNone), + (de:'ỹ'; re:'ỹ'; join:arNone), + (de:'yÌ„'; re:'ȳ'; join:arNone), + (de:'ẏ'; re:'áº'; join:arNone), + (de:'ÿ'; re:'ÿ'; join:arNone), + (de:'ỷ'; re:'á»·'; join:arNone), + (de:'yÌŠ'; re:'ẙ'; join:arNone), + (de:'yÌ£'; re:'ỵ'; join:arNone), + (de:'zÌ'; re:'ź'; join:arNone), + (de:'zÌ‚'; re:'ẑ'; join:arNone), + (de:'ż'; re:'ż'; join:arNone), + (de:'zÌŒ'; re:'ž'; join:arNone), + (de:'zÌ£'; re:'ẓ'; join:arNone), + (de:'ẕ'; re:'ẕ'; join:arNone), + (de:'῭'; re:'á¿­'; join:arNone), + (de:'¨Ì'; re:'Î…'; join:arNone), + (de:'῁'; re:'á¿'; join:arNone), + (de:'Ầ'; re:'Ầ'; join:arNone), + (de:'ÂÌ'; re:'Ấ'; join:arNone), + (de:'Ẫ'; re:'Ẫ'; join:arNone), + (de:'Ẩ'; re:'Ẩ'; join:arNone), + (de:'Ǟ'; re:'Çž'; join:arNone), + (de:'Ã…Ì'; re:'Ǻ'; join:arNone), + (de:'ÆÌ'; re:'Ǽ'; join:arNone), + (de:'Ǣ'; re:'Ç¢'; join:arNone), + (de:'ÇÌ'; re:'Ḉ'; join:arNone), + (de:'Ề'; re:'Ề'; join:arNone), + (de:'ÊÌ'; re:'Ế'; join:arNone), + (de:'Ễ'; re:'Ễ'; join:arNone), + (de:'Ể'; re:'Ể'; join:arNone), + (de:'ÃÌ'; re:'Ḯ'; join:arNone), + (de:'Ồ'; re:'á»’'; join:arNone), + (de:'ÔÌ'; re:'á»'; join:arNone), + (de:'Ỗ'; re:'á»–'; join:arNone), + (de:'Ổ'; re:'á»”'; join:arNone), + (de:'ÕÌ'; re:'Ṍ'; join:arNone), + (de:'Ȭ'; re:'Ȭ'; join:arNone), + (de:'Ṏ'; re:'Ṏ'; join:arNone), + (de:'Ȫ'; re:'Ȫ'; join:arNone), + (de:'ØÌ'; re:'Ǿ'; join:arNone), + (de:'Ǜ'; re:'Ç›'; join:arNone), + (de:'ÃœÌ'; re:'Ç—'; join:arNone), + (de:'Ǖ'; re:'Ç•'; join:arNone), + (de:'Ǚ'; re:'Ç™'; join:arNone), + (de:'ầ'; re:'ầ'; join:arNone), + (de:'âÌ'; re:'ấ'; join:arNone), + (de:'ẫ'; re:'ẫ'; join:arNone), + (de:'ẩ'; re:'ẩ'; join:arNone), + (de:'ǟ'; re:'ÇŸ'; join:arNone), + (de:'Ã¥Ì'; re:'Ç»'; join:arNone), + (de:'æÌ'; re:'ǽ'; join:arNone), + (de:'ǣ'; re:'Ç£'; join:arNone), + (de:'çÌ'; re:'ḉ'; join:arNone), + (de:'ề'; re:'á»'; join:arNone), + (de:'êÌ'; re:'ế'; join:arNone), + (de:'ễ'; re:'á»…'; join:arNone), + (de:'ể'; re:'ể'; join:arNone), + (de:'ïÌ'; re:'ḯ'; join:arNone), + (de:'ồ'; re:'ồ'; join:arNone), + (de:'ôÌ'; re:'ố'; join:arNone), + (de:'ỗ'; re:'á»—'; join:arNone), + (de:'ổ'; re:'ổ'; join:arNone), + (de:'õÌ'; re:'á¹'; join:arNone), + (de:'ȭ'; re:'È­'; join:arNone), + (de:'ṏ'; re:'á¹'; join:arNone), + (de:'ȫ'; re:'È«'; join:arNone), + (de:'øÌ'; re:'Ç¿'; join:arNone), + (de:'ǜ'; re:'Çœ'; join:arNone), + (de:'üÌ'; re:'ǘ'; join:arNone), + (de:'ǖ'; re:'Ç–'; join:arNone), + (de:'ǚ'; re:'Çš'; join:arNone), + (de:'Ä‚Ì€'; re:'Ằ'; join:arNone), + (de:'Ä‚Ì'; re:'Ắ'; join:arNone), + (de:'Ẵ'; re:'Ẵ'; join:arNone), + (de:'Ẳ'; re:'Ẳ'; join:arNone), + (de:'ằ'; re:'ằ'; join:arNone), + (de:'ăÌ'; re:'ắ'; join:arNone), + (de:'ẵ'; re:'ẵ'; join:arNone), + (de:'ẳ'; re:'ẳ'; join:arNone), + (de:'Ä’Ì€'; re:'Ḕ'; join:arNone), + (de:'Ä’Ì'; re:'Ḗ'; join:arNone), + (de:'Ä“Ì€'; re:'ḕ'; join:arNone), + (de:'Ä“Ì'; re:'ḗ'; join:arNone), + (de:'Ṑ'; re:'á¹'; join:arNone), + (de:'ÅŒÌ'; re:'á¹’'; join:arNone), + (de:'ÅÌ€'; re:'ṑ'; join:arNone), + (de:'ÅÌ'; re:'ṓ'; join:arNone), + (de:'Ṥ'; re:'Ṥ'; join:arNone), + (de:'ṥ'; re:'á¹¥'; join:arNone), + (de:'Ṧ'; re:'Ṧ'; join:arNone), + (de:'ṧ'; re:'ṧ'; join:arNone), + (de:'ŨÌ'; re:'Ṹ'; join:arNone), + (de:'Å©Ì'; re:'á¹¹'; join:arNone), + (de:'Ṻ'; re:'Ṻ'; join:arNone), + (de:'ṻ'; re:'á¹»'; join:arNone), + (de:'ẛ'; re:'ẛ'; join:arNone), + (de:'Ờ'; re:'Ờ'; join:arNone), + (de:'Æ Ì'; re:'Ớ'; join:arNone), + (de:'Ỡ'; re:'á» '; join:arNone), + (de:'Ở'; re:'Ở'; join:arNone), + (de:'Ợ'; re:'Ợ'; join:arNone), + (de:'Æ¡Ì€'; re:'á»'; join:arNone), + (de:'Æ¡Ì'; re:'á»›'; join:arNone), + (de:'ỡ'; re:'ỡ'; join:arNone), + (de:'ở'; re:'ở'; join:arNone), + (de:'Æ¡Ì£'; re:'ợ'; join:arNone), + (de:'Ừ'; re:'Ừ'; join:arNone), + (de:'ƯÌ'; re:'Ứ'; join:arNone), + (de:'Ữ'; re:'á»®'; join:arNone), + (de:'Ử'; re:'Ử'; join:arNone), + (de:'Ự'; re:'á»°'; join:arNone), + (de:'Æ°Ì€'; re:'ừ'; join:arNone), + (de:'Æ°Ì'; re:'ứ'; join:arNone), + (de:'ữ'; re:'ữ'; join:arNone), + (de:'ử'; re:'á»­'; join:arNone), + (de:'Æ°Ì£'; re:'á»±'; join:arNone), + (de:'Æ·ÌŒ'; re:'Ç®'; join:arNone), + (de:'Ǭ'; re:'Ǭ'; join:arNone), + (de:'Ç«Ì„'; re:'Ç­'; join:arNone), + (de:'Ǡ'; re:'Ç '; join:arNone), + (de:'ǡ'; re:'Ç¡'; join:arNone), + (de:'Ḝ'; re:'Ḝ'; join:arNone), + (de:'ḝ'; re:'á¸'; join:arNone), + (de:'Ȱ'; re:'È°'; join:arNone), + (de:'ȱ'; re:'ȱ'; join:arNone), + (de:'Ê’ÌŒ'; re:'ǯ'; join:arNone), + (de:'Ὰ'; re:'Ὰ'; join:arNone), + (de:'ΑÌ'; re:'Ά'; join:arNone), + (de:'Ᾱ'; re:'á¾¹'; join:arNone), + (de:'Ᾰ'; re:'Ᾰ'; join:arNone), + (de:'Ἀ'; re:'Ἀ'; join:arNone), + (de:'Ἁ'; re:'Ἁ'; join:arNone), + (de:'ᾼ'; re:'á¾¼'; join:arNone), + (de:'Ὲ'; re:'Ὲ'; join:arNone), + (de:'ΕÌ'; re:'Έ'; join:arNone), + (de:'Ἐ'; re:'Ἐ'; join:arNone), + (de:'Ἑ'; re:'á¼™'; join:arNone), + (de:'Ὴ'; re:'á¿Š'; join:arNone), + (de:'ΗÌ'; re:'Ή'; join:arNone), + (de:'Ἠ'; re:'Ἠ'; join:arNone), + (de:'Ἡ'; re:'Ἡ'; join:arNone), + (de:'ῌ'; re:'á¿Œ'; join:arNone), + (de:'Ὶ'; re:'á¿š'; join:arNone), + (de:'ΙÌ'; re:'Ί'; join:arNone), + (de:'Ῑ'; re:'á¿™'; join:arNone), + (de:'Ῐ'; re:'Ῐ'; join:arNone), + (de:'Ϊ'; re:'Ϊ'; join:arNone), + (de:'Ἰ'; re:'Ἰ'; join:arNone), + (de:'Ἱ'; re:'á¼¹'; join:arNone), + (de:'Ὸ'; re:'Ὸ'; join:arNone), + (de:'ΟÌ'; re:'ÎŒ'; join:arNone), + (de:'Ὀ'; re:'Ὀ'; join:arNone), + (de:'Ὁ'; re:'Ὁ'; join:arNone), + (de:'Ῥ'; re:'Ῥ'; join:arNone), + (de:'Ὺ'; re:'Ὺ'; join:arNone), + (de:'Î¥Ì'; re:'ÎŽ'; join:arNone), + (de:'Ῡ'; re:'á¿©'; join:arNone), + (de:'Ῠ'; re:'Ῠ'; join:arNone), + (de:'Ϋ'; re:'Ϋ'; join:arNone), + (de:'Ὑ'; re:'á½™'; join:arNone), + (de:'Ὼ'; re:'Ὼ'; join:arNone), + (de:'ΩÌ'; re:'Î'; join:arNone), + (de:'Ὠ'; re:'Ὠ'; join:arNone), + (de:'Ὡ'; re:'Ὡ'; join:arNone), + (de:'ῼ'; re:'ῼ'; join:arNone), + (de:'ᾴ'; re:'á¾´'; join:arNone), + (de:'ῄ'; re:'á¿„'; join:arNone), + (de:'ὰ'; re:'á½°'; join:arNone), + (de:'αÌ'; re:'ά'; join:arNone), + (de:'ᾱ'; re:'á¾±'; join:arNone), + (de:'ᾰ'; re:'á¾°'; join:arNone), + (de:'ἀ'; re:'á¼€'; join:arNone), + (de:'ἁ'; re:'á¼'; join:arNone), + (de:'ᾶ'; re:'ᾶ'; join:arNone), + (de:'ᾳ'; re:'á¾³'; join:arNone), + (de:'ὲ'; re:'á½²'; join:arNone), + (de:'εÌ'; re:'έ'; join:arNone), + (de:'ἐ'; re:'á¼'; join:arNone), + (de:'ἑ'; re:'ἑ'; join:arNone), + (de:'ὴ'; re:'á½´'; join:arNone), + (de:'ηÌ'; re:'ή'; join:arNone), + (de:'ἠ'; re:'á¼ '; join:arNone), + (de:'ἡ'; re:'ἡ'; join:arNone), + (de:'ῆ'; re:'ῆ'; join:arNone), + (de:'ῃ'; re:'ῃ'; join:arNone), + (de:'ὶ'; re:'ὶ'; join:arNone), + (de:'ιÌ'; re:'ί'; join:arNone), + (de:'ῑ'; re:'á¿‘'; join:arNone), + (de:'ῐ'; re:'á¿'; join:arNone), + (de:'ϊ'; re:'ÏŠ'; join:arNone), + (de:'ἰ'; re:'á¼°'; join:arNone), + (de:'ἱ'; re:'á¼±'; join:arNone), + (de:'ῖ'; re:'á¿–'; join:arNone), + (de:'ὸ'; re:'ὸ'; join:arNone), + (de:'οÌ'; re:'ÏŒ'; join:arNone), + (de:'ὀ'; re:'á½€'; join:arNone), + (de:'ὁ'; re:'á½'; join:arNone), + (de:'ÏÌ“'; re:'ῤ'; join:arNone), + (de:'ÏÌ”'; re:'á¿¥'; join:arNone), + (de:'Ï…Ì€'; re:'ὺ'; join:arNone), + (de:'Ï…Ì'; re:'Ï'; join:arNone), + (de:'Ï…Ì„'; re:'á¿¡'; join:arNone), + (de:'ῠ'; re:'á¿ '; join:arNone), + (de:'ϋ'; re:'Ï‹'; join:arNone), + (de:'Ï…Ì“'; re:'á½'; join:arNone), + (de:'Ï…Ì”'; re:'ὑ'; join:arNone), + (de:'Ï…Í‚'; re:'ῦ'; join:arNone), + (de:'ὼ'; re:'á½¼'; join:arNone), + (de:'ωÌ'; re:'ÏŽ'; join:arNone), + (de:'ὠ'; re:'á½ '; join:arNone), + (de:'ὡ'; re:'ὡ'; join:arNone), + (de:'ῶ'; re:'ῶ'; join:arNone), + (de:'ῳ'; re:'ῳ'; join:arNone), + (de:'ÏŠÌ€'; re:'á¿’'; join:arNone), + (de:'ÏŠÌ'; re:'Î'; join:arNone), + (de:'ÏŠÍ‚'; re:'á¿—'; join:arNone), + (de:'Ï‹Ì€'; re:'á¿¢'; join:arNone), + (de:'Ï‹Ì'; re:'ΰ'; join:arNone), + (de:'Ï‹Í‚'; re:'ῧ'; join:arNone), + (de:'ÏŽÍ…'; re:'á¿´'; join:arNone), + (de:'Ï’Ì'; re:'Ï“'; join:arNone), + (de:'ϔ'; re:'Ï”'; join:arNone), + (de:'Ї'; re:'Ї'; join:arNone), + (de:'Ð̆'; re:'Ó'; join:arNone), + (de:'Ð̈'; re:'Ó’'; join:arNone), + (de:'ГÌ'; re:'Ѓ'; join:arNone), + (de:'Ѐ'; re:'Ѐ'; join:arNone), + (de:'Ӗ'; re:'Ó–'; join:arNone), + (de:'Ё'; re:'Ð'; join:arNone), + (de:'Ӂ'; re:'Ó'; join:arNone), + (de:'Ӝ'; re:'Óœ'; join:arNone), + (de:'Ӟ'; re:'Óž'; join:arNone), + (de:'Ѝ'; re:'Ð'; join:arNone), + (de:'Ӣ'; re:'Ó¢'; join:arNone), + (de:'Й'; re:'Й'; join:arNone), + (de:'Ӥ'; re:'Ó¤'; join:arNone), + (de:'КÌ'; re:'ÐŒ'; join:arNone), + (de:'Ӧ'; re:'Ó¦'; join:arNone), + (de:'Ӯ'; re:'Ó®'; join:arNone), + (de:'Ў'; re:'ÐŽ'; join:arNone), + (de:'Ӱ'; re:'Ó°'; join:arNone), + (de:'Ӳ'; re:'Ó²'; join:arNone), + (de:'Ӵ'; re:'Ó´'; join:arNone), + (de:'Ӹ'; re:'Ó¸'; join:arNone), + (de:'Ӭ'; re:'Ó¬'; join:arNone), + (de:'ӑ'; re:'Ó‘'; join:arNone), + (de:'ӓ'; re:'Ó“'; join:arNone), + (de:'гÌ'; re:'Ñ“'; join:arNone), + (de:'ѐ'; re:'Ñ'; join:arNone), + (de:'ӗ'; re:'Ó—'; join:arNone), + (de:'ё'; re:'Ñ‘'; join:arNone), + (de:'ӂ'; re:'Ó‚'; join:arNone), + (de:'ӝ'; re:'Ó'; join:arNone), + (de:'ӟ'; re:'ÓŸ'; join:arNone), + (de:'ѝ'; re:'Ñ'; join:arNone), + (de:'ӣ'; re:'Ó£'; join:arNone), + (de:'й'; re:'й'; join:arNone), + (de:'ӥ'; re:'Ó¥'; join:arNone), + (de:'кÌ'; re:'Ñœ'; join:arNone), + (de:'ӧ'; re:'Ó§'; join:arNone), + (de:'ӯ'; re:'Ó¯'; join:arNone), + (de:'ў'; re:'Ñž'; join:arNone), + (de:'ӱ'; re:'Ó±'; join:arNone), + (de:'ӳ'; re:'Ó³'; join:arNone), + (de:'ӵ'; re:'Óµ'; join:arNone), + (de:'ӹ'; re:'Ó¹'; join:arNone), + (de:'Ñ̈'; re:'Ó­'; join:arNone), + (de:'ї'; re:'Ñ—'; join:arNone), + (de:'Ñ´Ì'; re:'Ѷ'; join:arNone), + (de:'ѵÌ'; re:'Ñ·'; join:arNone), + (de:'Ӛ'; re:'Óš'; join:arNone), + (de:'ӛ'; re:'Ó›'; join:arNone), + (de:'Ӫ'; re:'Óª'; join:arNone), + (de:'ӫ'; re:'Ó«'; join:arNone), + (de:'×Ö·'; re:'אַ'; join:arNone), + (de:'×Ö¸'; re:'אָ'; join:arNone), + (de:'×Ö¼'; re:'אּ'; join:arNone), + (de:'בּ'; re:'בּ'; join:arNone), + (de:'בֿ'; re:'ï­Œ'; join:arNone), + (de:'×’Ö¼'; re:'גּ'; join:arNone), + (de:'דּ'; re:'דּ'; join:arNone), + (de:'×”Ö¼'; re:'הּ'; join:arNone), + (de:'וֹ'; re:'ï­‹'; join:arNone), + (de:'וּ'; re:'וּ'; join:arNone), + (de:'×–Ö¼'; re:'זּ'; join:arNone), + (de:'טּ'; re:'טּ'; join:arNone), + (de:'×™Ö´'; re:'ï¬'; join:arNone), + (de:'×™Ö¼'; re:'יּ'; join:arNone), + (de:'ךּ'; re:'ךּ'; join:arNone), + (de:'×›Ö¼'; re:'כּ'; join:arNone), + (de:'×›Ö¿'; re:'ï­'; join:arNone), + (de:'לּ'; re:'לּ'; join:arNone), + (de:'מּ'; re:'מּ'; join:arNone), + (de:'× Ö¼'; re:'ï­€'; join:arNone), + (de:'סּ'; re:'ï­'; join:arNone), + (de:'×£Ö¼'; re:'ï­ƒ'; join:arNone), + (de:'פּ'; re:'ï­„'; join:arNone), + (de:'פֿ'; re:'ï­Ž'; join:arNone), + (de:'צּ'; re:'ï­†'; join:arNone), + (de:'קּ'; re:'ï­‡'; join:arNone), + (de:'רּ'; re:'ï­ˆ'; join:arNone), + (de:'שּ'; re:'ï­‰'; join:arNone), + (de:'ש×'; re:'שׁ'; join:arNone), + (de:'שׂ'; re:'שׂ'; join:arNone), + (de:'תּ'; re:'ï­Š'; join:arNone), + (de:'ײַ'; re:'ײַ'; join:arNone), + (de:'Ø¡'; re:'ﺀ'; join:arIsolated), + (de:'Ø¢'; re:'ïº'; join:arIsolated), + (de:'Ø¢'; re:'ﺂ'; join:arFinal), + (de:'Ø£'; re:'ﺃ'; join:arIsolated), + (de:'Ø£'; re:'ﺄ'; join:arFinal), + (de:'ؤ'; re:'ﺅ'; join:arIsolated), + (de:'ؤ'; re:'ﺆ'; join:arFinal), + (de:'Ø¥'; re:'ﺇ'; join:arIsolated), + (de:'Ø¥'; re:'ﺈ'; join:arFinal), + (de:'ئ'; re:'ﺉ'; join:arIsolated), + (de:'ئ'; re:'ﺊ'; join:arFinal), + (de:'ئ'; re:'ﺋ'; join:arInitial), + (de:'ئ'; re:'ﺌ'; join:arMedial), + (de:'ا'; re:'ïº'; join:arIsolated), + (de:'ا'; re:'ﺎ'; join:arFinal), + (de:'آ'; re:'Ø¢'; join:arNone), + (de:'أ'; re:'Ø£'; join:arNone), + (de:'إ'; re:'Ø¥'; join:arNone), + (de:'ب'; re:'ïº'; join:arIsolated), + (de:'ب'; re:'ïº'; join:arFinal), + (de:'ب'; re:'ﺑ'; join:arInitial), + (de:'ب'; re:'ﺒ'; join:arMedial), + (de:'Ø©'; re:'ﺓ'; join:arIsolated), + (de:'Ø©'; re:'ﺔ'; join:arFinal), + (de:'ت'; re:'ﺕ'; join:arIsolated), + (de:'ت'; re:'ﺖ'; join:arFinal), + (de:'ت'; re:'ﺗ'; join:arInitial), + (de:'ت'; re:'ﺘ'; join:arMedial), + (de:'Ø«'; re:'ﺙ'; join:arIsolated), + (de:'Ø«'; re:'ﺚ'; join:arFinal), + (de:'Ø«'; re:'ﺛ'; join:arInitial), + (de:'Ø«'; re:'ﺜ'; join:arMedial), + (de:'ج'; re:'ïº'; join:arIsolated), + (de:'ج'; re:'ﺞ'; join:arFinal), + (de:'ج'; re:'ﺟ'; join:arInitial), + (de:'ج'; re:'ﺠ'; join:arMedial), + (de:'Ø­'; re:'ﺡ'; join:arIsolated), + (de:'Ø­'; re:'ﺢ'; join:arFinal), + (de:'Ø­'; re:'ﺣ'; join:arInitial), + (de:'Ø­'; re:'ﺤ'; join:arMedial), + (de:'Ø®'; re:'ﺥ'; join:arIsolated), + (de:'Ø®'; re:'ﺦ'; join:arFinal), + (de:'Ø®'; re:'ﺧ'; join:arInitial), + (de:'Ø®'; re:'ﺨ'; join:arMedial), + (de:'د'; re:'ﺩ'; join:arIsolated), + (de:'د'; re:'ﺪ'; join:arFinal), + (de:'Ø°'; re:'ﺫ'; join:arIsolated), + (de:'Ø°'; re:'ﺬ'; join:arFinal), + (de:'ر'; re:'ﺭ'; join:arIsolated), + (de:'ر'; re:'ﺮ'; join:arFinal), + (de:'ز'; re:'ﺯ'; join:arIsolated), + (de:'ز'; re:'ﺰ'; join:arFinal), + (de:'س'; re:'ﺱ'; join:arIsolated), + (de:'س'; re:'ﺲ'; join:arFinal), + (de:'س'; re:'ﺳ'; join:arInitial), + (de:'س'; re:'ﺴ'; join:arMedial), + (de:'Ø´'; re:'ﺵ'; join:arIsolated), + (de:'Ø´'; re:'ﺶ'; join:arFinal), + (de:'Ø´'; re:'ﺷ'; join:arInitial), + (de:'Ø´'; re:'ﺸ'; join:arMedial), + (de:'ص'; re:'ﺹ'; join:arIsolated), + (de:'ص'; re:'ﺺ'; join:arFinal), + (de:'ص'; re:'ﺻ'; join:arInitial), + (de:'ص'; re:'ﺼ'; join:arMedial), + (de:'ض'; re:'ﺽ'; join:arIsolated), + (de:'ض'; re:'ﺾ'; join:arFinal), + (de:'ض'; re:'ﺿ'; join:arInitial), + (de:'ض'; re:'ﻀ'; join:arMedial), + (de:'Ø·'; re:'ï»'; join:arIsolated), + (de:'Ø·'; re:'ﻂ'; join:arFinal), + (de:'Ø·'; re:'ﻃ'; join:arInitial), + (de:'Ø·'; re:'ﻄ'; join:arMedial), + (de:'ظ'; re:'ï»…'; join:arIsolated), + (de:'ظ'; re:'ﻆ'; join:arFinal), + (de:'ظ'; re:'ﻇ'; join:arInitial), + (de:'ظ'; re:'ﻈ'; join:arMedial), + (de:'ع'; re:'ﻉ'; join:arIsolated), + (de:'ع'; re:'ﻊ'; join:arFinal), + (de:'ع'; re:'ﻋ'; join:arInitial), + (de:'ع'; re:'ﻌ'; join:arMedial), + (de:'غ'; re:'ï»'; join:arIsolated), + (de:'غ'; re:'ﻎ'; join:arFinal), + (de:'غ'; re:'ï»'; join:arInitial), + (de:'غ'; re:'ï»'; join:arMedial), + (de:'Ù'; re:'ﻑ'; join:arIsolated), + (de:'Ù'; re:'ï»’'; join:arFinal), + (de:'Ù'; re:'ﻓ'; join:arInitial), + (de:'Ù'; re:'ï»”'; join:arMedial), + (de:'Ù‚'; re:'ﻕ'; join:arIsolated), + (de:'Ù‚'; re:'ï»–'; join:arFinal), + (de:'Ù‚'; re:'ï»—'; join:arInitial), + (de:'Ù‚'; re:'ﻘ'; join:arMedial), + (de:'Ùƒ'; re:'ï»™'; join:arIsolated), + (de:'Ùƒ'; re:'ﻚ'; join:arFinal), + (de:'Ùƒ'; re:'ï»›'; join:arInitial), + (de:'Ùƒ'; re:'ﻜ'; join:arMedial), + (de:'Ù„'; re:'ï»'; join:arIsolated), + (de:'Ù„'; re:'ﻞ'; join:arFinal), + (de:'Ù„'; re:'ﻟ'; join:arInitial), + (de:'Ù„'; re:'ï» '; join:arMedial), + (de:'لآ'; re:'ﻵ'; join:arIsolated), + (de:'لآ'; re:'ﻶ'; join:arFinal), + (de:'لأ'; re:'ï»·'; join:arIsolated), + (de:'لأ'; re:'ﻸ'; join:arFinal), + (de:'لإ'; re:'ﻹ'; join:arIsolated), + (de:'لإ'; re:'ﻺ'; join:arFinal), + (de:'لا'; re:'ï»»'; join:arIsolated), + (de:'لا'; re:'ﻼ'; join:arFinal), + (de:'Ù…'; re:'ﻡ'; join:arIsolated), + (de:'Ù…'; re:'ﻢ'; join:arFinal), + (de:'Ù…'; re:'ﻣ'; join:arInitial), + (de:'Ù…'; re:'ﻤ'; join:arMedial), + (de:'Ù†'; re:'ﻥ'; join:arIsolated), + (de:'Ù†'; re:'ﻦ'; join:arFinal), + (de:'Ù†'; re:'ﻧ'; join:arInitial), + (de:'Ù†'; re:'ﻨ'; join:arMedial), + (de:'Ù‡'; re:'ﻩ'; join:arIsolated), + (de:'Ù‡'; re:'ﻪ'; join:arFinal), + (de:'Ù‡'; re:'ﻫ'; join:arInitial), + (de:'Ù‡'; re:'ﻬ'; join:arMedial), + (de:'Ùˆ'; re:'ï»­'; join:arIsolated), + (de:'Ùˆ'; re:'ï»®'; join:arFinal), + (de:'ÙˆÙ”'; re:'ؤ'; join:arNone), + (de:'Ù‰'; re:'ﯨ'; join:arInitial), + (de:'Ù‰'; re:'ﯩ'; join:arMedial), + (de:'Ù‰'; re:'ﻯ'; join:arIsolated), + (de:'Ù‰'; re:'ï»°'; join:arFinal), + (de:'ÙŠ'; re:'ï»±'; join:arIsolated), + (de:'ÙŠ'; re:'ﻲ'; join:arFinal), + (de:'ÙŠ'; re:'ﻳ'; join:arInitial), + (de:'ÙŠ'; re:'ï»´'; join:arMedial), + (de:'ÙŠÙ”'; re:'ئ'; join:arNone), + (de:'Ù±'; re:'ï­'; join:arIsolated), + (de:'Ù±'; re:'ï­‘'; join:arFinal), + (de:'Ù·'; re:'ï¯'; join:arIsolated), + (de:'Ù¹'; re:'ï­¦'; join:arIsolated), + (de:'Ù¹'; re:'ï­§'; join:arFinal), + (de:'Ù¹'; re:'ï­¨'; join:arInitial), + (de:'Ù¹'; re:'ï­©'; join:arMedial), + (de:'Ùº'; re:'ï­ž'; join:arIsolated), + (de:'Ùº'; re:'ï­Ÿ'; join:arFinal), + (de:'Ùº'; re:'ï­ '; join:arInitial), + (de:'Ùº'; re:'ï­¡'; join:arMedial), + (de:'Ù»'; re:'ï­’'; join:arIsolated), + (de:'Ù»'; re:'ï­“'; join:arFinal), + (de:'Ù»'; re:'ï­”'; join:arInitial), + (de:'Ù»'; re:'ï­•'; join:arMedial), + (de:'Ù¾'; re:'ï­–'; join:arIsolated), + (de:'Ù¾'; re:'ï­—'; join:arFinal), + (de:'Ù¾'; re:'ï­˜'; join:arInitial), + (de:'Ù¾'; re:'ï­™'; join:arMedial), + (de:'Ù¿'; re:'ï­¢'; join:arIsolated), + (de:'Ù¿'; re:'ï­£'; join:arFinal), + (de:'Ù¿'; re:'ï­¤'; join:arInitial), + (de:'Ù¿'; re:'ï­¥'; join:arMedial), + (de:'Ú€'; re:'ï­š'; join:arIsolated), + (de:'Ú€'; re:'ï­›'; join:arFinal), + (de:'Ú€'; re:'ï­œ'; join:arInitial), + (de:'Ú€'; re:'ï­'; join:arMedial), + (de:'Úƒ'; re:'ï­¶'; join:arIsolated), + (de:'Úƒ'; re:'ï­·'; join:arFinal), + (de:'Úƒ'; re:'ï­¸'; join:arInitial), + (de:'Úƒ'; re:'ï­¹'; join:arMedial), + (de:'Ú„'; re:'ï­²'; join:arIsolated), + (de:'Ú„'; re:'ï­³'; join:arFinal), + (de:'Ú„'; re:'ï­´'; join:arInitial), + (de:'Ú„'; re:'ï­µ'; join:arMedial), + (de:'Ú†'; re:'ï­º'; join:arIsolated), + (de:'Ú†'; re:'ï­»'; join:arFinal), + (de:'Ú†'; re:'ï­¼'; join:arInitial), + (de:'Ú†'; re:'ï­½'; join:arMedial), + (de:'Ú‡'; re:'ï­¾'; join:arIsolated), + (de:'Ú‡'; re:'ï­¿'; join:arFinal), + (de:'Ú‡'; re:'ﮀ'; join:arInitial), + (de:'Ú‡'; re:'ï®'; join:arMedial), + (de:'Úˆ'; re:'ﮈ'; join:arIsolated), + (de:'Úˆ'; re:'ﮉ'; join:arFinal), + (de:'ÚŒ'; re:'ﮄ'; join:arIsolated), + (de:'ÚŒ'; re:'ï®…'; join:arFinal), + (de:'Ú'; re:'ﮂ'; join:arIsolated), + (de:'Ú'; re:'ﮃ'; join:arFinal), + (de:'ÚŽ'; re:'ﮆ'; join:arIsolated), + (de:'ÚŽ'; re:'ﮇ'; join:arFinal), + (de:'Ú‘'; re:'ﮌ'; join:arIsolated), + (de:'Ú‘'; re:'ï®'; join:arFinal), + (de:'Ú˜'; re:'ﮊ'; join:arIsolated), + (de:'Ú˜'; re:'ﮋ'; join:arFinal), + (de:'Ú¤'; re:'ï­ª'; join:arIsolated), + (de:'Ú¤'; re:'ï­«'; join:arFinal), + (de:'Ú¤'; re:'ï­¬'; join:arInitial), + (de:'Ú¤'; re:'ï­­'; join:arMedial), + (de:'Ú¦'; re:'ï­®'; join:arIsolated), + (de:'Ú¦'; re:'ï­¯'; join:arFinal), + (de:'Ú¦'; re:'ï­°'; join:arInitial), + (de:'Ú¦'; re:'ï­±'; join:arMedial), + (de:'Ú©'; re:'ﮎ'; join:arIsolated), + (de:'Ú©'; re:'ï®'; join:arFinal), + (de:'Ú©'; re:'ï®'; join:arInitial), + (de:'Ú©'; re:'ﮑ'; join:arMedial), + (de:'Ú­'; re:'ﯓ'; join:arIsolated), + (de:'Ú­'; re:'ﯔ'; join:arFinal), + (de:'Ú­'; re:'ﯕ'; join:arInitial), + (de:'Ú­'; re:'ﯖ'; join:arMedial), + (de:'Ú¯'; re:'ï®’'; join:arIsolated), + (de:'Ú¯'; re:'ﮓ'; join:arFinal), + (de:'Ú¯'; re:'ï®”'; join:arInitial), + (de:'Ú¯'; re:'ﮕ'; join:arMedial), + (de:'Ú±'; re:'ﮚ'; join:arIsolated), + (de:'Ú±'; re:'ï®›'; join:arFinal), + (de:'Ú±'; re:'ﮜ'; join:arInitial), + (de:'Ú±'; re:'ï®'; join:arMedial), + (de:'Ú³'; re:'ï®–'; join:arIsolated), + (de:'Ú³'; re:'ï®—'; join:arFinal), + (de:'Ú³'; re:'ﮘ'; join:arInitial), + (de:'Ú³'; re:'ï®™'; join:arMedial), + (de:'Úº'; re:'ﮞ'; join:arIsolated), + (de:'Úº'; re:'ﮟ'; join:arFinal), + (de:'Ú»'; re:'ï® '; join:arIsolated), + (de:'Ú»'; re:'ﮡ'; join:arFinal), + (de:'Ú»'; re:'ﮢ'; join:arInitial), + (de:'Ú»'; re:'ﮣ'; join:arMedial), + (de:'Ú¾'; re:'ﮪ'; join:arIsolated), + (de:'Ú¾'; re:'ﮫ'; join:arFinal), + (de:'Ú¾'; re:'ﮬ'; join:arInitial), + (de:'Ú¾'; re:'ï®­'; join:arMedial), + (de:'Û€'; re:'ﮤ'; join:arIsolated), + (de:'Û€'; re:'ﮥ'; join:arFinal), + (de:'Û'; re:'ﮦ'; join:arIsolated), + (de:'Û'; re:'ﮧ'; join:arFinal), + (de:'Û'; re:'ﮨ'; join:arInitial), + (de:'Û'; re:'ﮩ'; join:arMedial), + (de:'ÛÙ”'; re:'Û‚'; join:arNone), + (de:'Û…'; re:'ﯠ'; join:arIsolated), + (de:'Û…'; re:'ﯡ'; join:arFinal), + (de:'Û†'; re:'ﯙ'; join:arIsolated), + (de:'Û†'; re:'ﯚ'; join:arFinal), + (de:'Û‡'; re:'ﯗ'; join:arIsolated), + (de:'Û‡'; re:'ﯘ'; join:arFinal), + (de:'Ûˆ'; re:'ﯛ'; join:arIsolated), + (de:'Ûˆ'; re:'ﯜ'; join:arFinal), + (de:'Û‰'; re:'ﯢ'; join:arIsolated), + (de:'Û‰'; re:'ﯣ'; join:arFinal), + (de:'Û‹'; re:'ﯞ'; join:arIsolated), + (de:'Û‹'; re:'ﯟ'; join:arFinal), + (de:'ÛŒ'; re:'ﯼ'; join:arIsolated), + (de:'ÛŒ'; re:'ﯽ'; join:arFinal), + (de:'ÛŒ'; re:'ﯾ'; join:arInitial), + (de:'ÛŒ'; re:'ﯿ'; join:arMedial), + (de:'Û'; re:'ﯤ'; join:arIsolated), + (de:'Û'; re:'ﯥ'; join:arFinal), + (de:'Û'; re:'ﯦ'; join:arInitial), + (de:'Û'; re:'ﯧ'; join:arMedial), + (de:'Û’'; re:'ï®®'; join:arIsolated), + (de:'Û’'; re:'ﮯ'; join:arFinal), + (de:'Û’Ù”'; re:'Û“'; join:arNone), + (de:'Û“'; re:'ï®°'; join:arIsolated), + (de:'Û“'; re:'ï®±'; join:arFinal), + (de:'Û•Ù”'; re:'Û€'; join:arNone), + (de:'क़'; re:'क़'; join:arNone), + (de:'ख़'; re:'ख़'; join:arNone), + (de:'ग़'; re:'ग़'; join:arNone), + (de:'ज़'; re:'ज़'; join:arNone), + (de:'ड़'; re:'ड़'; join:arNone), + (de:'ढ़'; re:'à¥'; join:arNone), + (de:'ऩ'; re:'ऩ'; join:arNone), + (de:'फ़'; re:'फ़'; join:arNone), + (de:'य़'; re:'य़'; join:arNone), + (de:'ऱ'; re:'ऱ'; join:arNone), + (de:'ऴ'; re:'ऴ'; join:arNone), + (de:'ড়'; re:'ড়'; join:arNone), + (de:'ঢ়'; re:'à§'; join:arNone), + (de:'য়'; re:'য়'; join:arNone), + (de:'ਖ਼'; re:'à©™'; join:arNone), + (de:'ਗ਼'; re:'à©š'; join:arNone), + (de:'ਜ਼'; re:'à©›'; join:arNone), + (de:'ਫ਼'; re:'à©ž'; join:arNone), + (de:'ਲ਼'; re:'ਲ਼'; join:arNone), + (de:'ਸ਼'; re:'ਸ਼'; join:arNone), + (de:'ଡ଼'; re:'à­œ'; join:arNone), + (de:'ଢ଼'; re:'à­'; join:arNone), + (de:'ୈ'; re:'à­ˆ'; join:arNone), + (de:'ේ'; re:'à·š'; join:arNone), + (de:'ෝ'; re:'à·'; join:arNone), + (de:'ཀྵ'; re:'ཀྵ'; join:arNone), + (de:'གྷ'; re:'གྷ'; join:arNone), + (de:'ཌྷ'; re:'à½'; join:arNone), + (de:'དྷ'; re:'དྷ'; join:arNone), + (de:'བྷ'; re:'བྷ'; join:arNone), + (de:'ཛྷ'; re:'ཛྷ'; join:arNone), + (de:'ဦ'; re:'ဦ'; join:arNone), + (de:'ᬻ'; re:'ᬻ'; join:arNone), + (de:'ᬽ'; re:'ᬽ'; join:arNone), + (de:'ᭃ'; re:'á­ƒ'; join:arNone), + (de:'Ḹ'; re:'Ḹ'; join:arNone), + (de:'ḹ'; re:'ḹ'; join:arNone), + (de:'Ṝ'; re:'Ṝ'; join:arNone), + (de:'ṝ'; re:'á¹'; join:arNone), + (de:'Ṩ'; re:'Ṩ'; join:arNone), + (de:'ṩ'; re:'ṩ'; join:arNone), + (de:'Ậ'; re:'Ậ'; join:arNone), + (de:'Ặ'; re:'Ặ'; join:arNone), + (de:'ậ'; re:'ậ'; join:arNone), + (de:'ặ'; re:'ặ'; join:arNone), + (de:'Ệ'; re:'Ệ'; join:arNone), + (de:'ệ'; re:'ệ'; join:arNone), + (de:'Ộ'; re:'Ộ'; join:arNone), + (de:'á»Ì‚'; re:'á»™'; join:arNone), + (de:'ἂ'; re:'ἂ'; join:arNone), + (de:'á¼€Ì'; re:'ἄ'; join:arNone), + (de:'ἆ'; re:'ἆ'; join:arNone), + (de:'ᾀ'; re:'á¾€'; join:arNone), + (de:'á¼Ì€'; re:'ἃ'; join:arNone), + (de:'á¼Ì'; re:'á¼…'; join:arNone), + (de:'á¼Í‚'; re:'ἇ'; join:arNone), + (de:'á¼Í…'; re:'á¾'; join:arNone), + (de:'ᾂ'; re:'ᾂ'; join:arNone), + (de:'ᾃ'; re:'ᾃ'; join:arNone), + (de:'ᾄ'; re:'ᾄ'; join:arNone), + (de:'á¼…Í…'; re:'á¾…'; join:arNone), + (de:'ᾆ'; re:'ᾆ'; join:arNone), + (de:'ᾇ'; re:'ᾇ'; join:arNone), + (de:'Ἂ'; re:'Ἂ'; join:arNone), + (de:'ἈÌ'; re:'Ἄ'; join:arNone), + (de:'Ἆ'; re:'Ἆ'; join:arNone), + (de:'ᾈ'; re:'ᾈ'; join:arNone), + (de:'Ἃ'; re:'Ἃ'; join:arNone), + (de:'ἉÌ'; re:'á¼'; join:arNone), + (de:'Ἇ'; re:'á¼'; join:arNone), + (de:'ᾉ'; re:'ᾉ'; join:arNone), + (de:'ᾊ'; re:'ᾊ'; join:arNone), + (de:'ᾋ'; re:'ᾋ'; join:arNone), + (de:'ᾌ'; re:'ᾌ'; join:arNone), + (de:'á¼Í…'; re:'á¾'; join:arNone), + (de:'ᾎ'; re:'ᾎ'; join:arNone), + (de:'á¼Í…'; re:'á¾'; join:arNone), + (de:'á¼Ì€'; re:'á¼’'; join:arNone), + (de:'á¼Ì'; re:'á¼”'; join:arNone), + (de:'ἓ'; re:'ἓ'; join:arNone), + (de:'ἑÌ'; re:'ἕ'; join:arNone), + (de:'Ἒ'; re:'Ἒ'; join:arNone), + (de:'ἘÌ'; re:'Ἔ'; join:arNone), + (de:'Ἓ'; re:'á¼›'; join:arNone), + (de:'á¼™Ì'; re:'á¼'; join:arNone), + (de:'ἢ'; re:'á¼¢'; join:arNone), + (de:'á¼ Ì'; re:'ἤ'; join:arNone), + (de:'á¼ Í‚'; re:'ἦ'; join:arNone), + (de:'á¼ Í…'; re:'á¾'; join:arNone), + (de:'ἣ'; re:'á¼£'; join:arNone), + (de:'ἡÌ'; re:'á¼¥'; join:arNone), + (de:'ἧ'; re:'ἧ'; join:arNone), + (de:'ᾑ'; re:'ᾑ'; join:arNone), + (de:'ᾒ'; re:'á¾’'; join:arNone), + (de:'ᾓ'; re:'ᾓ'; join:arNone), + (de:'ᾔ'; re:'á¾”'; join:arNone), + (de:'ᾕ'; re:'ᾕ'; join:arNone), + (de:'ᾖ'; re:'á¾–'; join:arNone), + (de:'ᾗ'; re:'á¾—'; join:arNone), + (de:'Ἢ'; re:'Ἢ'; join:arNone), + (de:'ἨÌ'; re:'Ἤ'; join:arNone), + (de:'Ἦ'; re:'á¼®'; join:arNone), + (de:'ᾘ'; re:'ᾘ'; join:arNone), + (de:'Ἣ'; re:'Ἣ'; join:arNone), + (de:'ἩÌ'; re:'á¼­'; join:arNone), + (de:'Ἧ'; re:'Ἧ'; join:arNone), + (de:'ᾙ'; re:'á¾™'; join:arNone), + (de:'ᾚ'; re:'ᾚ'; join:arNone), + (de:'ᾛ'; re:'á¾›'; join:arNone), + (de:'ᾜ'; re:'ᾜ'; join:arNone), + (de:'á¼­Í…'; re:'á¾'; join:arNone), + (de:'ᾞ'; re:'ᾞ'; join:arNone), + (de:'ᾟ'; re:'ᾟ'; join:arNone), + (de:'á¼°Ì€'; re:'á¼²'; join:arNone), + (de:'á¼°Ì'; re:'á¼´'; join:arNone), + (de:'á¼°Í‚'; re:'ἶ'; join:arNone), + (de:'ἳ'; re:'á¼³'; join:arNone), + (de:'á¼±Ì'; re:'á¼µ'; join:arNone), + (de:'ἷ'; re:'á¼·'; join:arNone), + (de:'Ἲ'; re:'Ἲ'; join:arNone), + (de:'ἸÌ'; re:'á¼¼'; join:arNone), + (de:'Ἶ'; re:'á¼¾'; join:arNone), + (de:'Ἳ'; re:'á¼»'; join:arNone), + (de:'á¼¹Ì'; re:'á¼½'; join:arNone), + (de:'Ἷ'; re:'Ἷ'; join:arNone), + (de:'ὂ'; re:'ὂ'; join:arNone), + (de:'á½€Ì'; re:'ὄ'; join:arNone), + (de:'á½Ì€'; re:'ὃ'; join:arNone), + (de:'á½Ì'; re:'á½…'; join:arNone), + (de:'Ὂ'; re:'Ὂ'; join:arNone), + (de:'ὈÌ'; re:'Ὄ'; join:arNone), + (de:'Ὃ'; re:'Ὃ'; join:arNone), + (de:'ὉÌ'; re:'á½'; join:arNone), + (de:'á½Ì€'; re:'á½’'; join:arNone), + (de:'á½Ì'; re:'á½”'; join:arNone), + (de:'á½Í‚'; re:'á½–'; join:arNone), + (de:'ὓ'; re:'ὓ'; join:arNone), + (de:'ὑÌ'; re:'ὕ'; join:arNone), + (de:'ὗ'; re:'á½—'; join:arNone), + (de:'Ὓ'; re:'á½›'; join:arNone), + (de:'á½™Ì'; re:'á½'; join:arNone), + (de:'Ὗ'; re:'Ὗ'; join:arNone), + (de:'ὢ'; re:'á½¢'; join:arNone), + (de:'á½ Ì'; re:'ὤ'; join:arNone), + (de:'á½ Í‚'; re:'ὦ'; join:arNone), + (de:'á½ Í…'; re:'á¾ '; join:arNone), + (de:'ὣ'; re:'á½£'; join:arNone), + (de:'ὡÌ'; re:'á½¥'; join:arNone), + (de:'ὧ'; re:'ὧ'; join:arNone), + (de:'ᾡ'; re:'ᾡ'; join:arNone), + (de:'ᾢ'; re:'á¾¢'; join:arNone), + (de:'ᾣ'; re:'á¾£'; join:arNone), + (de:'ᾤ'; re:'ᾤ'; join:arNone), + (de:'ᾥ'; re:'á¾¥'; join:arNone), + (de:'ᾦ'; re:'ᾦ'; join:arNone), + (de:'ᾧ'; re:'ᾧ'; join:arNone), + (de:'Ὢ'; re:'Ὢ'; join:arNone), + (de:'ὨÌ'; re:'Ὤ'; join:arNone), + (de:'Ὦ'; re:'á½®'; join:arNone), + (de:'ᾨ'; re:'ᾨ'; join:arNone), + (de:'Ὣ'; re:'Ὣ'; join:arNone), + (de:'ὩÌ'; re:'á½­'; join:arNone), + (de:'Ὧ'; re:'Ὧ'; join:arNone), + (de:'ᾩ'; re:'ᾩ'; join:arNone), + (de:'ᾪ'; re:'ᾪ'; join:arNone), + (de:'ᾫ'; re:'ᾫ'; join:arNone), + (de:'ᾬ'; re:'ᾬ'; join:arNone), + (de:'á½­Í…'; re:'á¾­'; join:arNone), + (de:'ᾮ'; re:'á¾®'; join:arNone), + (de:'ᾯ'; re:'ᾯ'; join:arNone), + (de:'á½°Í…'; re:'á¾²'; join:arNone), + (de:'á½´Í…'; re:'á¿‚'; join:arNone), + (de:'ῲ'; re:'ῲ'; join:arNone), + (de:'ᾷ'; re:'á¾·'; join:arNone), + (de:'῍'; re:'á¿'; join:arNone), + (de:'᾿Ì'; re:'á¿Ž'; join:arNone), + (de:'῏'; re:'á¿'; join:arNone), + (de:'ῇ'; re:'ῇ'; join:arNone), + (de:'ῷ'; re:'á¿·'; join:arNone), + (de:'῝'; re:'á¿'; join:arNone), + (de:'῾Ì'; re:'á¿ž'; join:arNone), + (de:'῟'; re:'á¿Ÿ'; join:arNone), + (de:'â†Ì¸'; re:'↚'; join:arNone), + (de:'↛'; re:'↛'; join:arNone), + (de:'↮'; re:'↮'; join:arNone), + (de:'â‡Ì¸'; re:'â‡'; join:arNone), + (de:'⇏'; re:'â‡'; join:arNone), + (de:'⇎'; re:'⇎'; join:arNone), + (de:'∄'; re:'∄'; join:arNone), + (de:'∉'; re:'∉'; join:arNone), + (de:'∌'; re:'∌'; join:arNone), + (de:'∤'; re:'∤'; join:arNone), + (de:'∦'; re:'∦'; join:arNone), + (de:'≁'; re:'â‰'; join:arNone), + (de:'≄'; re:'≄'; join:arNone), + (de:'≇'; re:'≇'; join:arNone), + (de:'≉'; re:'≉'; join:arNone), + (de:'â‰Ì¸'; re:'≭'; join:arNone), + (de:'≢'; re:'≢'; join:arNone), + (de:'≰'; re:'≰'; join:arNone), + (de:'≱'; re:'≱'; join:arNone), + (de:'≴'; re:'≴'; join:arNone), + (de:'≵'; re:'≵'; join:arNone), + (de:'≸'; re:'≸'; join:arNone), + (de:'≹'; re:'≹'; join:arNone), + (de:'⊀'; re:'⊀'; join:arNone), + (de:'⊁'; re:'âŠ'; join:arNone), + (de:'⋠'; re:'â‹ '; join:arNone), + (de:'⋡'; re:'â‹¡'; join:arNone), + (de:'⊄'; re:'⊄'; join:arNone), + (de:'⊅'; re:'⊅'; join:arNone), + (de:'⊈'; re:'⊈'; join:arNone), + (de:'⊉'; re:'⊉'; join:arNone), + (de:'⋢'; re:'â‹¢'; join:arNone), + (de:'⋣'; re:'â‹£'; join:arNone), + (de:'⊬'; re:'⊬'; join:arNone), + (de:'⊭'; re:'⊭'; join:arNone), + (de:'⊮'; re:'⊮'; join:arNone), + (de:'⊯'; re:'⊯'; join:arNone), + (de:'⋪'; re:'⋪'; join:arNone), + (de:'⋫'; re:'â‹«'; join:arNone), + (de:'⋬'; re:'⋬'; join:arNone), + (de:'⋭'; re:'â‹­'; join:arNone), + (de:'â«Ì¸'; re:'â«œ'; join:arNone), + (de:'ã†ã‚™'; re:'ã‚”'; join:arNone), + (de:'ã‹ã‚™'; re:'ãŒ'; join:arNone), + (de:'ãã‚™'; re:'ãŽ'; join:arNone), + (de:'ãã‚™'; re:'ã'; join:arNone), + (de:'ã‘ã‚™'; re:'ã’'; join:arNone), + (de:'ã“ã‚™'; re:'ã”'; join:arNone), + (de:'ã•ã‚™'; re:'ã–'; join:arNone), + (de:'ã—ã‚™'; re:'ã˜'; join:arNone), + (de:'ã™ã‚™'; re:'ãš'; join:arNone), + (de:'ã›ã‚™'; re:'ãœ'; join:arNone), + (de:'ãã‚™'; re:'ãž'; join:arNone), + (de:'ãŸã‚™'; re:'ã '; join:arNone), + (de:'ã¡ã‚™'; re:'ã¢'; join:arNone), + (de:'ã¤ã‚™'; re:'ã¥'; join:arNone), + (de:'ã¦ã‚™'; re:'ã§'; join:arNone), + (de:'ã¨ã‚™'; re:'ã©'; join:arNone), + (de:'ã¯ã‚™'; re:'ã°'; join:arNone), + (de:'ã¯ã‚š'; re:'ã±'; join:arNone), + (de:'ã²ã‚™'; re:'ã³'; join:arNone), + (de:'ã²ã‚š'; re:'ã´'; join:arNone), + (de:'ãµã‚™'; re:'ã¶'; join:arNone), + (de:'ãµã‚š'; re:'ã·'; join:arNone), + (de:'ã¸ã‚™'; re:'ã¹'; join:arNone), + (de:'ã¸ã‚š'; re:'ãº'; join:arNone), + (de:'ã»ã‚™'; re:'ã¼'; join:arNone), + (de:'ã»ã‚š'; re:'ã½'; join:arNone), + (de:'ã‚ã‚™'; re:'ã‚ž'; join:arNone), + (de:'ヴ'; re:'ヴ'; join:arNone), + (de:'ã‚«ã‚™'; re:'ガ'; join:arNone), + (de:'ã‚­ã‚™'; re:'ã‚®'; join:arNone), + (de:'グ'; re:'ã‚°'; join:arNone), + (de:'ゲ'; re:'ゲ'; join:arNone), + (de:'ゴ'; re:'ã‚´'; join:arNone), + (de:'ザ'; re:'ザ'; join:arNone), + (de:'ã‚·ã‚™'; re:'ジ'; join:arNone), + (de:'ズ'; re:'ズ'; join:arNone), + (de:'ゼ'; re:'ゼ'; join:arNone), + (de:'ゾ'; re:'ゾ'; join:arNone), + (de:'ã‚¿ã‚™'; re:'ダ'; join:arNone), + (de:'ãƒã‚™'; re:'ヂ'; join:arNone), + (de:'ヅ'; re:'ヅ'; join:arNone), + (de:'デ'; re:'デ'; join:arNone), + (de:'ド'; re:'ド'; join:arNone), + (de:'ãƒã‚™'; re:'ãƒ'; join:arNone), + (de:'ãƒã‚š'; re:'パ'; join:arNone), + (de:'ビ'; re:'ビ'; join:arNone), + (de:'ピ'; re:'ピ'; join:arNone), + (de:'ブ'; re:'ブ'; join:arNone), + (de:'プ'; re:'プ'; join:arNone), + (de:'ベ'; re:'ベ'; join:arNone), + (de:'ペ'; re:'ペ'; join:arNone), + (de:'ボ'; re:'ボ'; join:arNone), + (de:'ポ'; re:'ãƒ'; join:arNone), + (de:'ヷ'; re:'ヷ'; join:arNone), + (de:'ヸ'; re:'ヸ'; join:arNone), + (de:'ヹ'; re:'ヹ'; join:arNone), + (de:'ヺ'; re:'ヺ'; join:arNone), + (de:'ヾ'; re:'ヾ'; join:arNone), + (de:'ï­‰×'; re:'שּׁ'; join:arNone), + (de:'שּׂ'; re:'שּׂ'; join:arNone), + (de:'𑂚'; re:'ð‘‚š'; join:arNone), + (de:'𑂜'; re:'ð‘‚œ'; join:arNone), + (de:'𑂫'; re:'ð‘‚«'; join:arNone), + (de:'𑒻'; re:'ð‘’»'; join:arNone) + ); + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/geometrytypes.inc b/vendor/kam_remake/src/ext/BGRABitmap/geometrytypes.inc new file mode 100644 index 0000000..e2d04b2 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/geometrytypes.inc @@ -0,0 +1,1686 @@ +{=== Geometry types ===} + +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} +const + {* Value indicating that there is nothing in the single-precision floating point value. + It is also used as a separator in lists } + EmptySingle = single(-3.402823e38); + +type + TPoint = BGRAClasses.TPoint; + TSize = BGRAClasses.TSize; + + {* Pointer to a ''TPointF'' structure } + PPointF = ^BGRAClasses.TPointF; + {* Contains a point with single-precision floating point coordinates } + TPointF = BGRAClasses.TPointF; + {* Contains an array of points with single-precision floating point coordinates } + ArrayOfTPointF = array of TPointF; + + {* An affine matrix contains three 2D vectors: the image of x, the image of y and the translation } + TAffineMatrix = array[1..2,1..3] of single; + TRectF = BGRAClasses.TRectF; + +{$if FPC_FULLVERSION<030001} + {$define BGRA_DEFINE_TRECTHELPER} + { TRectHelper } + + TRectHelper = record helper for TRect + private + function GetHeight: integer; + function GetIsEmpty: boolean; + function GetWidth: integer; + procedure SetHeight(AValue: integer); + procedure SetWidth(AValue: integer); + public + constructor Create(Origin: TPoint; AWidth, AHeight: Longint); overload; + constructor Create(ALeft, ATop, ARight, ABottom: Longint); overload; + procedure Intersect(R: TRect); + class function Intersect(R1: TRect; R2: TRect): TRect; static; + function IntersectsWith(R: TRect): Boolean; + class function Union(R1, R2: TRect): TRect; static; + procedure Union(R: TRect); + procedure Offset(DX, DY: Longint); + procedure Inflate(DX, DY: Longint); + function Contains(const APoint: TPoint): boolean; overload; + function Contains(const ARect: TRect): boolean; overload; + property Width: integer read GetWidth write SetWidth; + property Height: integer read GetHeight write SetHeight; + property IsEmpty: boolean read GetIsEmpty; + end; + +operator=(const ARect1,ARect2: TRect): boolean; +{$endif} + +{$if (FPC_FULLVERSION<030001) or defined(BGRABITMAP_USE_MSEGUI)} +type + {$define BGRA_DEFINE_TSIZEHELPER} + { TSizeHelper } + + TSizeHelper = record helper for TSize + private + function GetHeight: integer; + function GetWidth: integer; + public + property Width: integer read GetWidth; + property Height: integer read GetHeight; + end; +{$ENDIF} + +const + EmptyPoint : TPoint = (X: -2147483648; Y: -2147483648); + +function IsEmptyPoint(const APoint: TPoint): boolean; + +type + + { TPointFHelper } + + TPointFHelper = record helper for TPointF + procedure Offset(const apt : TPointF); overload; + procedure Offset(const apt : TPoint); overload; + procedure Offset(dx,dy : longint); overload; + procedure Offset(dx,dy : single); overload; + procedure Scale(AScale: single); + procedure Normalize; + + function Ceiling: TPoint; + function Truncate: TPoint; + function Floor: TPoint; + function Round: TPoint; + function Length: Single; + function IsEmpty: boolean; + end; + +type + PRectF = ^TRectF; + + { TRectFHelper } + + TRectFHelper = record helper for TRectF + class function Intersect(const R1: TRectF; const R2: TRectF): TRectF; overload; static; + class function Union(const R1: TRectF; const R2: TRectF): TRectF; overload; static; + class function Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF; overload; static; + function Union(const r: TRectF):TRectF; overload; + function Union(const r: TRectF; ADiscardEmpty: boolean):TRectF; overload; + procedure Include(const APoint: TPointF); + function Contains(const APoint: TPointF; AIncludeBottomRight: boolean = false): boolean; + function IntersectsWith(const r: TRectF): boolean; + function IsEmpty: boolean; + end; + +const + {* A value for an empty rectangle } + EmptyRectF : TRectF = (left:0; top:0; right:0; bottom: 0); + + function RectF(Left, Top, Right, Bottom: Single): TRectF; + function RectF(const ATopLeft,ABottomRight: TPointF): TRectF; + function RectF(const ARect: TRect): TRectF; + function RectWithSizeF(left,top,width,height: Single): TRectF; + function IsEmptyRectF(const ARect:TRectF): boolean; + +type + { TAffineBox } + + TAffineBox = object + private + function GetAsPolygon: ArrayOfTPointF; + function GetBottomRight: TPointF; + function GetCenter: TPointF; + function GetHeight: single; + function GetIsEmpty: boolean; + function GetRectBounds: TRect; + function GetRectBoundsF: TRectF; + function GetSurface: single; + function GetWidth: single; + public + TopLeft, TopRight, + BottomLeft: TPointF; + class function EmptyBox: TAffineBox; static; + class function AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox; overload; static; + class function AffineBox(ARectF: TRectF): TAffineBox; overload; static; + procedure Offset(AOfsX, AOfsY: single); overload; + procedure Offset(AOfs: TPointF); overload; + procedure Inflate(AHoriz, AVert: single); //inflates along axes + function Contains(APoint: TPointF): boolean; + property RectBounds: TRect read GetRectBounds; + property RectBoundsF: TRectF read GetRectBoundsF; + property BottomRight: TPointF read GetBottomRight; + property IsEmpty: boolean read GetIsEmpty; + property AsPolygon: ArrayOfTPointF read GetAsPolygon; + property Width: single read GetWidth; + property Height: single read GetHeight; + property Surface: single read GetSurface; + property Center: TPointF read GetCenter; + end; + + const + {** Value indicating that there is an empty ''TPointF'' structure. + It is also used as a separator in lists of points } + EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38); + + {----------------- Operators for TPointF --------------------} + {** Creates a new structure with values ''x'' and ''y'' } + function PointF(x, y: single): TPointF; overload; + function PointF(pt: TPoint): TPointF; overload; + {** Checks if the structure is empty (equal to ''EmptyPointF'') } + function isEmptyPointF(const pt: TPointF): boolean; + {** Checks if both ''x'' and ''y'' are equal } + operator = (const pt1, pt2: TPointF): boolean; inline; + {** Adds ''x'' and ''y'' components separately. It is like adding vectors } + operator + (const pt1, pt2: TPointF): TPointF; inline; + {** Subtract ''x'' and ''y'' components separately. It is like subtracting vectors } + operator - (const pt1, pt2: TPointF): TPointF; inline; + {** Returns a point with opposite values for ''x'' and ''y'' components } + operator - (const pt2: TPointF): TPointF; inline; + {** Scalar product: multiplies ''x'' and ''y'' components and returns the sum } + operator * (const pt1, pt2: TPointF): single; inline; + {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') } + operator * (const pt1: TPointF; factor: single): TPointF; inline; + {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') } + operator * (factor: single; const pt1: TPointF): TPointF; inline; + {** Returns the length of the vector (''dx'',''dy'') } + function VectLen(dx,dy: single): single; overload; + {** Returns the length of the vector represented by (''x'',''y'') } + function VectLen(v: TPointF): single; overload; + function VectDet(v1,v2: TPointF): double; inline; + +type + TFaceCulling = (fcNone, fcKeepCW, fcKeepCCW); + + {** Creates an array of ''TPointF'' } + function PointsF(const pts: array of TPointF): ArrayOfTPointF; + {** Concatenates arrays of ''TPointF'' } + function ConcatPointsF(const APolylines: array of ArrayOfTPointF; AInsertEmptyPointInBetween: boolean = false): ArrayOfTPointF; + {** Compute the length of the polyline contained in the array. + ''AClosed'' specifies if the last point is to be joined to the first one } + function PolylineLen(const pts: array of TPointF; AClosed: boolean = false): single; + +type + {* A pen style can be dashed, dotted, etc. It is defined as a list of floating point number. + The first number is the length of the first dash, + the second number is the length of the first gap, + the third number is the length of the second dash... + It must have an even number of values. This is used as a complement + to [[BGRABitmap Types imported from Graphics|TPenStyle]] } + TBGRAPenStyle = array Of Single; + + {** Creates a pen style with the specified length for the dashes and the spaces } + function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle; + +type + {* Different types of spline. A spline is a series of points that are used + as control points to draw a curve. The first point and last point may + or may not be the starting and ending point } + TSplineStyle = ( + {** The curve is drawn inside the polygonal envelope without reaching the starting and ending points } + ssInside, + {** The curve is drawn inside the polygonal envelope and the starting and ending points are reached } + ssInsideWithEnds, + {** The curve crosses the polygonal envelope without reaching the starting and ending points } + ssCrossing, + {** The curve crosses the polygonal envelope and the starting and ending points are reached } + ssCrossingWithEnds, + {** The curve is outside the polygonal envelope (starting and ending points are reached) } + ssOutside, + {** The curve expands outside the polygonal envelope (starting and ending points are reached) } + ssRoundOutside, + {** The curve is outside the polygonal envelope and there is a tangeant at vertices (starting and ending points are reached) } + ssVertexToSide, + {** The curve is rounded using Bezier curves when the angle is less than or equal to 45° } + ssEasyBezier); + +type + {* Pointer to an arc definition } + PArcDef = ^TArcDef; + {* Definition of an arc of an ellipse } + TArcDef = record + {** Center of the ellipse } + center: TPointF; + {** Horizontal and vertical of the ellipse before rotation } + radius: TPointF; + {** Rotation of the ellipse } + xAngleRadCW: single; + {** Start and end angle, in radian and clockwise. See angle convention in ''BGRAPath'' } + startAngleRadCW, endAngleRadCW: single; + {** Specifies if the arc goes anticlockwise } + anticlockwise: boolean + end; + + {** Creates a structure for an arc definition } + function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef; + +type + {* Possible options for drawing an arc of an ellipse (used in ''BGRACanvas'') } + TArcOption = ( + {** Close the path by joining the ending and starting point together } + aoClosePath, + {** Draw a pie shape by joining the ending and starting point to the center of the ellipse } + aoPie, + {** Fills the shape } + aoFillPath); + {** Set of options for drawing an arc } + TArcOptions = set of TArcOption; + + TBGRAArrowStyle = (asNone, asNormal, asCut, asTriangle, asHollowTriangle, asFlipped, asFlippedCut, asTail, asTailRepeat); + + { TBGRACustomArrow } + + TBGRACustomArrow = class + protected + function GetEndOffsetX: single; virtual; abstract; + function GetEndRepeatCount: integer; virtual; abstract; + function GetEndSizeFactor: TPointF; virtual; abstract; + function GetIsEndDefined: boolean; virtual; abstract; + function GetIsStartDefined: boolean; virtual; abstract; + function GetStartOffsetX: single; virtual; abstract; + function GetStartRepeatCount: integer; virtual; abstract; + function GetStartSizeFactor: TPointF; virtual; abstract; + procedure SetEndOffsetX(AValue: single); virtual; abstract; + procedure SetEndRepeatCount(AValue: integer); virtual; abstract; + procedure SetEndSizeFactor(AValue: TPointF); virtual; abstract; + procedure SetStartOffsetX(AValue: single); virtual; abstract; + procedure SetStartRepeatCount(AValue: integer); virtual; abstract; + procedure SetStartSizeFactor(AValue: TPointF); virtual; abstract; + function GetLineCap: TPenEndCap; virtual; abstract; + procedure SetLineCap(AValue: TPenEndCap); virtual; abstract; + public + function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract; + function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract; + procedure StartAsNone; virtual; abstract; + procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; + procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; + procedure StartAsTail; virtual; abstract; + procedure EndAsNone; virtual; abstract; + procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; + procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; + procedure EndAsTail; virtual; abstract; + property IsStartDefined: boolean read GetIsStartDefined; + property IsEndDefined: boolean read GetIsEndDefined; + property StartOffsetX: single read GetStartOffsetX write SetStartOffsetX; + property EndOffsetX: single read GetEndOffsetX write SetEndOffsetX; + property LineCap: TPenEndCap read GetLineCap write SetLineCap; + property StartSize: TPointF read GetStartSizeFactor write SetStartSizeFactor; + property EndSize: TPointF read GetEndSizeFactor write SetEndSizeFactor; + property StartRepeatCount: integer read GetStartRepeatCount write SetStartRepeatCount; + property EndRepeatCount: integer read GetEndRepeatCount write SetEndRepeatCount; + end; + + { TBGRACustomPenStroker } + + TBGRACustomPenStroker = class + protected + function GetArrow: TBGRACustomArrow; virtual; abstract; + function GetArrowOwned: boolean; virtual; abstract; + function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract; + function GetJoinStyle: TPenJoinStyle; virtual; abstract; + function GetLineCap: TPenEndCap; virtual; abstract; + function GetMiterLimit: single; virtual; abstract; + function GetPenStyle: TPenStyle; virtual; abstract; + function GetStrokeMatrix: TAffineMatrix; virtual; abstract; + procedure SetArrow(AValue: TBGRACustomArrow); virtual; abstract; + procedure SetArrowOwned(AValue: boolean); virtual; abstract; + procedure SetCustomPenStyle(AValue: TBGRAPenStyle); virtual; abstract; + procedure SetJoinStyle(AValue: TPenJoinStyle); virtual; abstract; + procedure SetLineCap(AValue: TPenEndCap); virtual; abstract; + procedure SetMiterLimit(AValue: single); virtual; abstract; + procedure SetPenStyle(AValue: TPenStyle); virtual; abstract; + procedure SetStrokeMatrix(const AValue: TAffineMatrix); virtual; abstract; + public + function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract; + function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract; + function ComputePolylineAutoCycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract; + function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract; + property Style: TPenStyle read GetPenStyle write SetPenStyle; + property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; + property Arrow: TBGRACustomArrow read GetArrow write SetArrow; + property ArrowOwned: boolean read GetArrowOwned write SetArrowOwned; + property StrokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix; + property LineCap: TPenEndCap read GetLineCap write SetLineCap; + property JoinStyle: TPenJoinStyle read GetJoinStyle write SetJoinStyle; + property MiterLimit: single read GetMiterLimit write SetMiterLimit; + end; + +type + {* Point in 3D with single-precision floating point coordinates } + + PPoint3D = ^TPoint3D; + + { TPoint3D } + + TPoint3D = record + x,y,z: single; + procedure Offset(const point3D: TPoint3D); + procedure Scale(AScale: single); + end; + + {----------------- Operators for TPoint3D ---------------} + {** Creates a new structure with values (''x'',''y'',''z'') } + function Point3D(x,y,z: single): TPoint3D; + {** Checks if all components ''x'', ''y'' and ''z'' are equal } + operator = (const v1,v2: TPoint3D): boolean; inline; + {** Adds components separately. It is like adding vectors } + operator + (const v1,v2: TPoint3D): TPoint3D; inline; + {** Subtract components separately. It is like subtracting vectors } + operator - (const v1,v2: TPoint3D): TPoint3D; inline; + {** Returns a point with opposite values for all components } + operator - (const v: TPoint3D): TPoint3D; inline; + {** Scalar product: multiplies components and returns the sum } + operator * (const v1,v2: TPoint3D): single; inline; + {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') } + operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline; + {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') } + operator * (const factor: single; const v1: TPoint3D): TPoint3D; inline; + {** Computes the vectorial product ''w''. It is perpendicular to both ''u'' and ''v'' } + procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D); + {** Normalize the vector, i.e. scale it so that its length be 1 } + procedure Normalize3D(var v: TPoint3D); inline; + function VectLen3D(const v: TPoint3D): single; + +type + {* Defition of a line in the euclidian plane } + TLineDef = record + {** Some point in the line } + origin: TPointF; + {** Vector indicating the direction } + dir: TPointF; + end; + + {----------- Line and polygon functions -----------} + {** Computes the intersection of two lines. If they are parallel, returns + the middle of the segment between the two origins } + function IntersectLine(line1, line2: TLineDef): TPointF; overload; + {** Computes the intersection of two lines. If they are parallel, returns + the middle of the segment between the two origins. The value ''parallel'' + is set to indicate if the lines were parallel } + function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; overload; + {** Checks if the polygon formed by the given points is convex. ''IgnoreAlign'' + specifies that if the points are aligned, it should still be considered as convex } + function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean; + function IsClockwise(const pts: array of TPointF): boolean; + {** Checks if the quad formed by the 4 given points intersects itself } + function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; + {** Checks if two segment intersect } + function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; + +type + TBGRACustomPathCursor = class; + TBGRAPathDrawProc = procedure(const APoints: array of TPointF; AClosed: boolean; AData: Pointer) of object; + TBGRAPathFillProc = procedure(const APoints: array of TPointF; AData: pointer) of object; + + {* A path is the ability to define a contour with ''moveTo'', ''lineTo''... + Even if it is an interface, it must not implement reference counting. } + IBGRAPath = interface + {** Closes the current path with a line to the starting point } + procedure closePath; + {** Moves to a location, disconnected from previous points } + procedure moveTo(constref pt: TPointF); + {** Adds a line from the current point } + procedure lineTo(constref pt: TPointF); + {** Adds a polyline from the current point } + procedure polylineTo(const pts: array of TPointF); + {** Adds a quadratic Bézier curve from the current point } + procedure quadraticCurveTo(constref cp,pt: TPointF); + {** Adds a cubic Bézier curve from the current point } + procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); + {** Adds an arc. If there is a current point, it is connected to the beginning of the arc } + procedure arc(constref arcDef: TArcDef); + {** Adds an opened spline. If there is a current point, it is connected to the beginning of the spline } + procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); + {** Adds an closed spline. If there is a current point, it is connected to the beginning of the spline } + procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); + {** Copy the content of this path to the specified destination } + procedure copyTo(dest: IBGRAPath); + {** Returns the content of the path as an array of points } + function getPoints: ArrayOfTPointF; overload; + {** Returns the content of the path as an array of points with the transformation specified by ''AMatrix'' } + function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload; + {** Calls a given draw procedure for each sub path with computed coordinates for rendering } + procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; + procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; + {** Calls a given fill procedure for each sub path with computed coordinates for rendering } + procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; + procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; + {** Returns a cursor to go through the path. The cursor must be freed by calling ''Free''. } + function getCursor: TBGRACustomPathCursor; + end; + + { TBGRACustomPath } + + TBGRACustomPath = class(IBGRAPath) + constructor Create; virtual; abstract; + procedure beginPath; virtual; abstract; + procedure closePath; virtual; abstract; + procedure moveTo(constref pt: TPointF); virtual; abstract; + procedure lineTo(constref pt: TPointF); virtual; abstract; + procedure polylineTo(const pts: array of TPointF); virtual; abstract; + procedure quadraticCurveTo(constref cp,pt: TPointF); virtual; abstract; + procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); virtual; abstract; + procedure arc(constref arcDef: TArcDef); virtual; abstract; + procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract; + procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract; + procedure copyTo(dest: IBGRAPath); virtual; abstract; + protected + function getPoints: ArrayOfTPointF; overload; virtual; abstract; + function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload; virtual; abstract; + procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; virtual; abstract; + procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract; + procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; virtual; abstract; + procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract; + function getLength: single; virtual; abstract; + function getCursor: TBGRACustomPathCursor; virtual; abstract; + protected + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + end; + + TBGRAPathAny = class of TBGRACustomPath; + + { TBGRACustomPathCursor } + {* Class that contains a cursor to browse an existing path } + TBGRACustomPathCursor = class + protected + function GetArcPos: single; virtual; abstract; + function GetCurrentCoord: TPointF; virtual; abstract; + function GetCurrentTangent: TPointF; virtual; abstract; + function GetLoopClosedShapes: boolean; virtual; abstract; + function GetLoopPath: boolean; virtual; abstract; + function GetPathLength: single; virtual; abstract; + function GetBounds: TRectF; virtual; abstract; + function GetStartCoordinate: TPointF; virtual; abstract; + procedure SetArcPos(AValue: single); virtual; abstract; + procedure SetLoopClosedShapes(AValue: boolean); virtual; abstract; + procedure SetLoopPath(AValue: boolean); virtual; abstract; + public + {** Go forward in the path, increasing the value of ''Position''. If ''ADistance'' is negative, then + it goes backward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another + without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than + the value ''ADistance'' provided. If all the way has been travelled, the + return value is equal to ''ADistance'' } + function MoveForward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract; + {** Go backward, decreasing the value of ''Position''. If ''ADistance'' is negative, then it goes + forward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another + without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than + the value ''ADistance'' provided. If all the way has been travelled, the + return value is equal to ''ADistance'' } + function MoveBackward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract; + {** Returns the current coordinate in the path } + property CurrentCoordinate: TPointF read GetCurrentCoord; + {** Returns the tangent vector. It is a vector of length one that is parallel to the curve + at the current point. A normal vector is easily deduced as PointF(y,-x) } + property CurrentTangent: TPointF read GetCurrentTangent; + {** Current position in the path, as a distance along the arc from the starting point of the path } + property Position: single read GetArcPos write SetArcPos; + {** Full arc length of the path } + property PathLength: single read GetPathLength; + {** Starting coordinate of the path } + property StartCoordinate: TPointF read GetStartCoordinate; + {** Specifies if the cursor loops when there is a closed shape } + property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes; + {** Specifies if the cursor loops at the end of the path. Note that if it needs to jump to go + to the beginning, it will be only possible if the parameter ''ACanJump'' is set to True + when moving along the path } + property LoopPath: boolean read GetLoopPath write SetLoopPath; + end; + +var + BGRAPathFactory: TBGRAPathAny; + +const + {* A value for an empty rectangle } + EmptyRect : TRect = (left:0; top:0; right:0; bottom: 0); +{* Checks if a point is in a rectangle. This follows usual convention: ''r.Right'' and + ''r.Bottom'' are not considered to be included in the rectangle. } +function PtInRect(const pt: TPoint; r: TRect): boolean; overload; +{* Creates a rectangle with the specified ''width'' and ''height'' } +function RectWithSize(left,top,width,height: integer): TRect; + +{$DEFINE INCLUDE_INTERFACE} +{$I bezier.inc} + +type + {* Possible options for a round rectangle } + TRoundRectangleOption = ( + {** specify that a corner is a square (not rounded) } + rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare, + {** specify that a corner is a bevel (cut) } + rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel, + {** default option, does nothing particular } + rrDefault); + {** A set of options for a round rectangle } + TRoundRectangleOptions = set of TRoundRectangleOption; + {* Order of polygons when rendered using ''TBGRAMultiShapeFiller'' + (in unit ''BGRAPolygon'') } + TPolygonOrder = ( + {** No order, colors are mixed together } + poNone, + {** First polygon is on top } + poFirstOnTop, + {** Last polygon is on top } + poLastOnTop); + + PIntersectionInfo = ^TIntersectionInfo; + { TIntersectionInfo } + {* Contains an intersection between an horizontal line and any shape. It + is used when filling shapes } + TIntersectionInfo = class + interX: single; + winding: integer; + numSegment: integer; + procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer); + end; + {** An array of intersections between an horizontal line and any shape } + ArrayOfTIntersectionInfo = array of TIntersectionInfo; + + {* Abstract class defining any shape that can be filled } + TBGRACustomFillInfo = class + public + {** Returns true if one segment number can represent a curve and + thus cannot be considered exactly straight } + function SegmentsCurved: boolean; virtual; abstract; + + {** Returns integer bounds for the shape } + function GetBounds: TRect; virtual; abstract; + + {** Check if the point is inside the shape } + function IsPointInside(x,y: single; windingMode: boolean): boolean; virtual; abstract; + + {** Create an array that will contain computed intersections. + To augment that array, use ''CreateIntersectionInfo'' for new items } + function CreateIntersectionArray: ArrayOfTIntersectionInfo; virtual; abstract; + {** Create a structure to define one single intersection } + function CreateIntersectionInfo: TIntersectionInfo; virtual; abstract; + {** Free an array of intersections } + procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); virtual; abstract; + + {** Fill an array ''inter'' with actual intersections with the shape at the y coordinate ''cury''. + ''nbInter'' receives the number of computed intersections. ''windingMode'' specifies if + the winding method must be used to determine what is inside of the shape } + procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); virtual; abstract; + + function GetSliceIndex: integer; virtual; abstract; + end; + +type + {* Shape of a gradient } + TGradientType = ( + {** The color changes along a certain vector and does not change along its perpendicular direction } + gtLinear, + {** The color changes like in ''gtLinear'' however it is symmetrical to a specified direction } + gtReflected, + {** The color changes along a diamond shape } + gtDiamond, + {** The color changes in a radial way from a given center } + gtRadial, + {** The color changes according to the angle relative to a given center } + gtAngular); +const + {** List of string to represent gradient types } + GradientTypeStr : array[TGradientType] of string + = ('Linear','Reflected','Diamond','Radial','Angular'); + {** Returns the gradient type represented by the given string } + function StrToGradientType(str: string): TGradientType; + +type + TBGRAGradientGetColorAtFunc = function(position: integer): TBGRAPixel of object; + TBGRAGradientGetColorAtFloatFunc = function(position: single): TBGRAPixel of object; + TBGRAGradientGetExpandedColorAtFunc = function(position: integer): TExpandedPixel of object; + TBGRAGradientGetExpandedColorAtFloatFunc = function(position: single): TExpandedPixel of object; + + { TBGRACustomGradient } + {* Defines a gradient of color, not specifying its shape but only the + series of colors } + TBGRACustomGradient = class + public + {** Returns the color at a given ''position''. The reference range is + from 0 to 65535, however values beyond are possible as well } + function GetColorAt(position: integer): TBGRAPixel; virtual; abstract; + function GetExpandedColorAt(position: integer): TExpandedPixel; virtual; + {** Returns the color at a given ''position''. The reference range is + from 0 to 1, however values beyond are possible as well } + function GetColorAtF(position: single): TBGRAPixel; virtual; + function GetExpandedColorAtF(position: single): TExpandedPixel; virtual; + {** Returns the average color of the gradient } + function GetAverageColor: TBGRAPixel; virtual; abstract; + function GetAverageExpandedColor: TExpandedPixel; virtual; + function GetMonochrome: boolean; virtual; abstract; + {** This property is True if the gradient contains only one color, + and thus is not really a gradient } + property Monochrome: boolean read GetMonochrome; + end; + +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////// + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{$IFDEF BGRA_DEFINE_TRECTHELPER} +{ TRectHelper } + +function TRectHelper.GetHeight: integer; +begin + result := Bottom-Top; +end; + +function TRectHelper.GetIsEmpty: boolean; +begin + result := (Width = 0) and (Height = 0) +end; + +function TRectHelper.GetWidth: integer; +begin + result := Right-Left; +end; + +procedure TRectHelper.SetHeight(AValue: integer); +begin + Bottom := Top+AValue; +end; + +procedure TRectHelper.SetWidth(AValue: integer); +begin + Right := Left+AValue; +end; + +constructor TRectHelper.Create(Origin: TPoint; AWidth, AHeight: Longint); +begin + self.Left := Origin.X; + self.Top := Origin.Y; + self.Right := Origin.X+AWidth; + self.Bottom := Origin.Y+AHeight; +end; + +constructor TRectHelper.Create(ALeft, ATop, ARight, ABottom: Longint); +begin + self.Left := ALeft; + self.Top := ATop; + self.Right := ARight; + self.Bottom := ABottom; +end; + +procedure TRectHelper.Intersect(R: TRect); +begin + self := TRect.Intersect(self, R); +end; + +class function TRectHelper.Intersect(R1: TRect; R2: TRect): TRect; +begin + if R1.Left >= R2.Left then result.Left := R1.Left else result.Left := R2.Left; + if R1.Top >= R2.Top then result.Top := R1.Top else result.Top := R2.Top; + if R1.Right <= R2.Right then result.Right := R1.Right else result.Right := R2.Right; + if R1.Bottom <= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom; + if result.IsEmpty then fillchar(result, sizeof(result), 0); +end; + +function TRectHelper.IntersectsWith(R: TRect): Boolean; +begin + Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom); +end; + +class function TRectHelper.Union(R1, R2: TRect): TRect; +begin + if R1.Left <= R2.Left then result.Left := R1.Left else result.Left := R2.Left; + if R1.Top <= R2.Top then result.Top := R1.Top else result.Top := R2.Top; + if R1.Right >= R2.Right then result.Right := R1.Right else result.Right := R2.Right; + if R1.Bottom >= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom; + if result.IsEmpty then fillchar(result, sizeof(result), 0); +end; + +procedure TRectHelper.Union(R: TRect); +begin + self := TRect.Union(self, R); +end; + +procedure TRectHelper.Offset(DX, DY: Longint); +begin + Inc(Left, DX); + Inc(Top, DY); + Inc(Right, DX); + Inc(Bottom, DY); +end; + +procedure TRectHelper.Inflate(DX, DY: Longint); +begin + Dec(Left, DX); + Dec(Top, DY); + Inc(Right, DX); + Inc(Bottom, DY); +end; + +function TRectHelper.Contains(const APoint: TPoint): boolean; +begin + result := (APoint.X >= Left) and (APoint.X < Right) and + (APoint.Y >= Top) and (APoint.Y < Bottom); +end; + +function TRectHelper.Contains(const ARect: TRect): boolean; +begin + Result := (Left <= ARect.Left) and (ARect.Right <= Right) and (Top <= ARect.Top) and (ARect.Bottom <= Bottom); +end; + +operator =(const ARect1, ARect2: TRect): boolean; +begin + result:= (ARect1.Left = ARect2.Left) and (ARect1.Top = ARect2.Top) and + (ARect1.Right = ARect2.Right) and (ARect1.Bottom = ARect2.Bottom); +end; +{$ENDIF} + +{$ifdef BGRA_DEFINE_TSIZEHELPER} +{ TSizeHelper } + +function TSizeHelper.GetHeight: integer; +begin + result := cy; +end; + +function TSizeHelper.GetWidth: integer; +begin + result := cx; +end; +{$ENDIF} + +function IsEmptyPoint(const APoint: TPoint): boolean; +begin + result := (APoint.x = -2147483648) or (APoint.y = -2147483648); +end; + +procedure TPointFHelper.Offset(const apt: TPointF); +begin + if isEmptyPointF(self) then exit; + IncF(self.x, apt.x); + IncF(self.y, apt.y); +end; + +procedure TPointFHelper.Offset(const apt: TPoint); +begin + if isEmptyPointF(self) then exit; + IncF(self.x, apt.x); + IncF(self.y, apt.y); +end; + +procedure TPointFHelper.Offset(dx, dy: longint); +begin + if isEmptyPointF(self) then exit; + IncF(self.x, dx); + IncF(self.y, dy); +end; + +procedure TPointFHelper.Offset(dx, dy: single); +begin + if isEmptyPointF(self) then exit; + IncF(self.x, dx); + IncF(self.y, dy); +end; + +procedure TPointFHelper.Scale(AScale: single); +begin + if not isEmptyPointF(self) then + begin + self.x := self.x * AScale; + self.y := self.y * AScale; + end; +end; + +procedure TPointFHelper.Normalize; +var + len: Single; +begin + len := Length; + if len > 0 then self := self*(1/len); +end; + +function TPointFHelper.Ceiling: TPoint; +begin + if isEmptyPointF(self) then + result := EmptyPoint + else + begin + result.x:=ceil(x); + result.y:=ceil(y); + end; +end; + +function TPointFHelper.Truncate: TPoint; +begin + if isEmptyPointF(self) then + result := EmptyPoint + else + begin + result.x:=trunc(x); + result.y:=trunc(y); + end; +end; + +function TPointFHelper.Floor: TPoint; +begin + if isEmptyPointF(self) then + result := EmptyPoint + else + begin + result.x:=Math.floor(x); + result.y:=Math.floor(y); + end; +end; + +function TPointFHelper.Round: TPoint; +begin + if isEmptyPointF(self) then + result := EmptyPoint + else + begin + result.x:=System.round(x); + result.y:=System.round(y); + end; +end; + +function TPointFHelper.Length: Single; +begin + result:= VectLen(self); +end; + +function TPointFHelper.IsEmpty: boolean; +begin + result := isEmptyPointF(self); +end; + +class function TRectFHelper.Intersect(const R1: TRectF; const R2: TRectF): TRectF; +begin + result.left:=max(R1.left,R2.left); + result.top:=max(R1.top,R2.top); + result.right:=min(R1.right,R2.right); + result.bottom:=min(R1.bottom,R2.bottom); + if (result.left >= result.right) or (result.top >= result.bottom) then + result := EmptyRectF; +end; + +class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF): TRectF; +begin + result.left:=min(R1.left,R2.left); + result.top:=min(R1.top,R2.top); + result.right:=max(R1.right,R2.right); + result.bottom:=max(R1.bottom,R2.bottom); +end; + +class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF; +begin + if ADiscardEmpty and IsEmptyRectF(R1) then result:= R2 else + if ADiscardEmpty and IsEmptyRectF(R2) then result:= R1 else + result := Union(R1,R2); +end; + +function TRectFHelper.Union(const r: TRectF): TRectF; +begin + result := TRectF.Union(self, r); +end; + +function TRectFHelper.Union(const r: TRectF; ADiscardEmpty: boolean): TRectF; +begin + result := TRectF.Union(self, r, ADiscardEmpty); +end; + +procedure TRectFHelper.Include(const APoint: TPointF); +begin + if APoint.x <> EmptySingle then + begin + if APoint.x < Left then Left := APoint.x else + if APoint.x > Right then Right := APoint.x; + end; + if APoint.y <> EmptySingle then + begin + if APoint.y < Top then Top := APoint.y else + if APoint.y > Bottom then Bottom := APoint.y; + end; +end; + +function TRectFHelper.Contains(const APoint: TPointF; + AIncludeBottomRight: boolean): boolean; +begin + if isEmptyPointF(APoint) then result := false else + if (APoint.x < Left) or (APoint.y < Top) then result := false else + if AIncludeBottomRight and ((APoint.x > Right) or (APoint.y > Bottom)) then result := false else + if not AIncludeBottomRight and ((APoint.x >= Right) or (APoint.y >= Bottom)) then result := false + else result := true; +end; + +function TRectFHelper.IntersectsWith(const r: TRectF): boolean; +begin + result:= not TRectF.Intersect(self, r).IsEmpty; +end; + +function TRectFHelper.IsEmpty: boolean; +begin + result:= IsEmptyRectF(self); +end; + +{ TAffineBox } + +function TAffineBox.GetAsPolygon: ArrayOfTPointF; +begin + result := PointsF([TopLeft,TopRight,BottomRight,BottomLeft]); +end; + +function TAffineBox.GetBottomRight: TPointF; +begin + if IsEmpty then + result := EmptyPointF + else + result := TopRight + (BottomLeft-TopLeft); +end; + +function TAffineBox.GetCenter: TPointF; +begin + result := (TopLeft + BottomRight)*0.5; +end; + +function TAffineBox.GetHeight: single; +begin + if isEmptyPointF(TopLeft) or isEmptyPointF(BottomLeft) then + result := 0 + else + result := VectLen(BottomLeft-TopLeft); +end; + +function TAffineBox.GetIsEmpty: boolean; +begin + result := isEmptyPointF(TopRight) or isEmptyPointF(BottomLeft) or isEmptyPointF(TopLeft); +end; + +function TAffineBox.GetRectBounds: TRect; +begin + with GetRectBoundsF do + result := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); +end; + +function TAffineBox.GetRectBoundsF: TRectF; +var + x1,y1,x2,y2: single; +begin + x1 := TopLeft.x; x2 := x1; + y1 := TopLeft.y; y2 := y1; + if TopRight.x > x2 then x2 := TopRight.x; + if TopRight.x < x1 then x1 := TopRight.x; + if TopRight.y > y2 then y2 := TopRight.y; + if TopRight.y < y1 then y1 := TopRight.y; + if BottomLeft.x > x2 then x2 := BottomLeft.x; + if BottomLeft.x < x1 then x1 := BottomLeft.x; + if BottomLeft.y > y2 then y2 := BottomLeft.y; + if BottomLeft.y < y1 then y1 := BottomLeft.y; + if BottomRight.x > x2 then x2 := BottomRight.x; + if BottomRight.x < x1 then x1 := BottomRight.x; + if BottomRight.y > y2 then y2 := BottomRight.y; + if BottomRight.y < y1 then y1 := BottomRight.y; + result := RectF(x1,y1,x2,y2); +end; + +function TAffineBox.GetSurface: single; +var + u, v: TPointF; + lenU, lenH: Single; +begin + u := TopRight-TopLeft; + lenU := VectLen(u); + if lenU = 0 then exit(0); + u.Scale(1/lenU); + v := BottomLeft-TopLeft; + lenH := PointF(-u.y,u.x)*v; + result := abs(lenU*lenH); +end; + +function TAffineBox.GetWidth: single; +begin + if isEmptyPointF(TopLeft) or isEmptyPointF(TopRight) then + result := 0 + else + result := VectLen(TopRight-TopLeft); +end; + +class function TAffineBox.EmptyBox: TAffineBox; +begin + result.TopLeft := EmptyPointF; + result.TopRight := EmptyPointF; + result.BottomLeft := EmptyPointF; +end; + +class function TAffineBox.AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox; +begin + result.TopLeft := ATopLeft; + result.TopRight := ATopRight; + result.BottomLeft := ABottomLeft; +end; + +class function TAffineBox.AffineBox(ARectF: TRectF): TAffineBox; +begin + result.TopLeft := ARectF.TopLeft; + result.TopRight := PointF(ARectF.Right, ARectF.Top); + result.BottomLeft := PointF(ARectF.Left, ARectF.Bottom); +end; + +procedure TAffineBox.Offset(AOfsX, AOfsY: single); +begin + TopLeft.Offset(AOfsX,AOfsY); + TopRight.Offset(AOfsX,AOfsY); + BottomLeft.Offset(AOfsX,AOfsY); +end; + +procedure TAffineBox.Offset(AOfs: TPointF); +begin + Offset(AOfs.X,AOfs.Y); +end; + +procedure TAffineBox.Inflate(AHoriz, AVert: single); +var + u, v, ofs_horiz, ofs_vert: TPointF; + lenU, lenV: Single; +begin + u := TopRight-TopLeft; + v := BottomLeft-TopLeft; + lenU := VectLen(u); + if lenU > 0 then u := u*(1/lenU); + lenV := VectLen(v); + if lenV > 0 then v := v*(1/lenV); + ofs_horiz := u*AHoriz; + ofs_vert := v*AVert; + TopLeft := TopLeft - ofs_horiz - ofs_vert; + TopRight := TopRight + ofs_horiz - ofs_vert; + BottomLeft := BottomLeft - ofs_horiz + ofs_vert; +end; + +function TAffineBox.Contains(APoint: TPointF): boolean; +var + u,v,perpU,perpV: TPointF; + posV1, posV2, posU1, posU2: single; +begin + if IsEmpty then exit(false); + + u := TopRight-TopLeft; + perpU := PointF(-u.y,u.x); + v := BottomLeft-TopLeft; + perpV := PointF(v.y,-v.x); + + //reverse normal if not in the same direction as other side + if perpU*v < 0 then + begin + perpU := -perpU; + perpV := -perpV; + end; + + //determine position along normals + posU1 := (APoint-TopLeft)*perpU; + posU2 := (APoint-BottomLeft)*perpU; + posV1 := (APoint-TopLeft)*perpV; + posV2 := (APoint-TopRight)*perpV; + + result := (posU1 >= 0) and (posU2 < 0) and (posV1 >= 0) and (posV2 < 0); +end; + +function StrToGradientType(str: string): TGradientType; +var gt: TGradientType; +begin + result := gtLinear; + str := LowerCase(str); + for gt := low(TGradientType) to high(TGradientType) do + if str = LowerCase(GradientTypeStr[gt]) then + begin + result := gt; + exit; + end; +end; + +{ TBGRACustomGradient } + +function TBGRACustomGradient.GetExpandedColorAt(position: integer + ): TExpandedPixel; +begin + result := GammaExpansion(GetColorAt(position)); +end; + +function TBGRACustomGradient.GetColorAtF(position: single): TBGRAPixel; +begin + if position = EmptySingle then exit(BGRAPixelTransparent); + position := position * 65536; + if position < low(integer) then + result := GetColorAt(low(Integer)) + else if position > high(integer) then + result := GetColorAt(high(Integer)) + else + result := GetColorAt(round(position)); +end; + +function TBGRACustomGradient.GetExpandedColorAtF(position: single): TExpandedPixel; +begin + if position = EmptySingle then exit(BGRAPixelTransparent); + position := position * 65536; + if position < low(integer) then + result := GetExpandedColorAt(low(Integer)) + else if position > high(integer) then + result := GetExpandedColorAt(high(Integer)) + else + result := GetExpandedColorAt(round(position)); +end; + +function TBGRACustomGradient.GetAverageExpandedColor: TExpandedPixel; +begin + result := GammaExpansion(GetAverageColor); +end; + +{ TIntersectionInfo } + +procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding, + ANumSegment: integer); +begin + interX := AInterX; + winding := AWinding; + numSegment := ANumSegment; +end; + +{********************** TRect functions **************************} + +function PtInRect(const pt: TPoint; r: TRect): boolean; +var + temp: integer; +begin + if r.right < r.left then + begin + temp := r.left; + r.left := r.right; + r.Right := temp; + end; + if r.bottom < r.top then + begin + temp := r.top; + r.top := r.bottom; + r.bottom := temp; + end; + Result := (pt.X >= r.left) and (pt.Y >= r.top) and (pt.X < r.right) and + (pt.y < r.bottom); +end; + +function RectWithSize(left, top, width, height: integer): TRect; +begin + result.left := left; + result.top := top; + result.right := left+width; + result.bottom := top+height; +end; + +{ Make a pen style. Need an even number of values. See TBGRAPenStyle } +function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single; + dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle; +var + i: Integer; +begin + if dash4 <> 0 then + begin + setlength(result,8); + result[6] := dash4; + result[7] := space4; + result[4] := dash3; + result[5] := space3; + result[2] := dash2; + result[3] := space2; + end else + if dash3 <> 0 then + begin + setlength(result,6); + result[4] := dash3; + result[5] := space3; + result[2] := dash2; + result[3] := space2; + end else + if dash2 <> 0 then + begin + setlength(result,4); + result[2] := dash2; + result[3] := space2; + end else + begin + setlength(result,2); + end; + result[0] := dash1; + result[1] := space1; + for i := 0 to high(result) do + if result[i]=0 then + raise exception.Create('Zero is not a valid value'); +end; + +{ TBGRACustomPath } + +function TBGRACustomPath.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + if GetInterface(iid, obj) then + Result := S_OK + else + Result := longint(E_NOINTERFACE); +end; + +{ There is no automatic reference counting, but it is compulsory to define these functions } +function TBGRACustomPath._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +function TBGRACustomPath._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +function ArcDef(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; + anticlockwise: boolean): TArcDef; +begin + result.center := PointF(cx,cy); + result.radius := PointF(rx,ry); + result.xAngleRadCW:= xAngleRadCW; + result.startAngleRadCW := startAngleRadCW; + result.endAngleRadCW:= endAngleRadCW; + result.anticlockwise:= anticlockwise; +end; + +{----------------- Operators for TPoint3D ---------------} +operator = (const v1, v2: TPoint3D): boolean; inline; +begin + result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z); +end; + +operator * (const v1,v2: TPoint3D): single; inline; +begin + result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z; +end; + +operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline; +begin + result.x := v1.x*factor; + result.y := v1.y*factor; + result.z := v1.z*factor; +end; + +operator - (const v1,v2: TPoint3D): TPoint3D; inline; +begin + result.x := v1.x-v2.x; + result.y := v1.y-v2.y; + result.z := v1.z-v2.z; +end; + +operator -(const v: TPoint3D): TPoint3D; inline; +begin + result.x := -v.x; + result.y := -v.y; + result.z := -v.z; +end; + +operator + (const v1,v2: TPoint3D): TPoint3D; inline; +begin + result.x := v1.x+v2.x; + result.y := v1.y+v2.y; + result.z := v1.z+v2.z; +end; + +operator*(const factor: single; const v1: TPoint3D): TPoint3D; +begin + result.x := v1.x*factor; + result.y := v1.y*factor; + result.z := v1.z*factor; +end; + +{ TPoint3D } + +procedure TPoint3D.Offset(const point3D: TPoint3D); +begin + IncF(self.x, point3d.x); + IncF(self.y, point3d.y); + IncF(self.z, point3d.z); +end; + +procedure TPoint3D.Scale(AScale: single); +begin + self.x := self.x * AScale; + self.y := self.y * AScale; + self.z := self.z * AScale; +end; + +function Point3D(x, y, z: single): TPoint3D; +begin + result.x := x; + result.y := y; + result.z := z; +end; + +procedure Normalize3D(var v: TPoint3D); inline; +var len: double; +begin + len := v*v; + if len = 0 then exit; + len := sqrt(len); + v.x := v.x / len; + v.y := v.y / len; + v.z := v.z / len; +end; + +function VectLen3D(const v: TPoint3D): single; +begin + result := sqrt(v.x*v.x + v.y*v.y + v.z*v.z); +end; + +procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D); +begin + w.x := u.y*v.z-u.z*v.y; + w.y := u.z*v.x-u.x*v.z; + w.z := u.x*v.Y-u.y*v.x; +end; + +{----------------- Operators for TPointF --------------------} +operator =(const pt1, pt2: TPointF): boolean; +begin + result := (pt1.x = pt2.x) and (pt1.y = pt2.y); +end; + +operator -(const pt1, pt2: TPointF): TPointF; +begin + result.x := pt1.x-pt2.x; + result.y := pt1.y-pt2.y; +end; + +operator -(const pt2: TPointF): TPointF; +begin + result.x := -pt2.x; + result.y := -pt2.y; +end; + +operator +(const pt1, pt2: TPointF): TPointF; +begin + result.x := pt1.x+pt2.x; + result.y := pt1.y+pt2.y; +end; + +operator *(const pt1, pt2: TPointF): single; +begin + result := pt1.x*pt2.x + pt1.y*pt2.y; +end; + +operator *(const pt1: TPointF; factor: single): TPointF; +begin + result.x := pt1.x*factor; + result.y := pt1.y*factor; +end; + +operator *(factor: single; const pt1: TPointF): TPointF; +begin + result.x := pt1.x*factor; + result.y := pt1.y*factor; +end; + +function RectF(Left, Top, Right, Bottom: Single): TRectF; +begin + result.Left:= Left; + result.Top:= Top; + result.Right:= Right; + result.Bottom:= Bottom; +end; + +function RectF(const ATopLeft, ABottomRight: TPointF): TRectF; +begin + result.TopLeft:= ATopLeft; + result.BottomRight:= ABottomRight; +end; + +function RectF(const ARect: TRect): TRectF; +begin + result.Left := ARect.Left; + result.Top := ARect.Top; + result.Right := ARect.Right; + result.Bottom := ARect.Bottom; +end; + +function RectWithSizeF(left, top, width, height: Single): TRectF; +begin + result.Left:= Left; + result.Top:= Top; + result.Right:= left+width; + result.Bottom:= top+height; +end; + +function IsEmptyRectF(const ARect: TRectF): boolean; +begin + result:= (ARect.Width = 0) and (ARect.Height = 0); +end; + +function PointF(x, y: single): TPointF; +begin + Result.x := x; + Result.y := y; +end; + +function PointF(pt: TPoint): TPointF; +begin + if IsEmptyPoint(pt) then + result:= EmptyPointF + else + begin + Result.x := pt.x; + Result.y := pt.y; + end; +end; + +function PointsF(const pts: array of TPointF): ArrayOfTPointF; +var + i: Integer; +begin + setlength(result, length(pts)); + for i := 0 to high(pts) do result[i] := pts[i]; +end; + +function ConcatPointsF(const APolylines: array of ArrayOfTPointF; + AInsertEmptyPointInBetween: boolean): ArrayOfTPointF; +var + i,pos,count:integer; + j: Integer; +begin + count := 0; + for i := 0 to high(APolylines) do + inc(count,length(APolylines[i])); + if AInsertEmptyPointInBetween then inc(count, length(APolylines)-1); + setlength(result,count); + pos := 0; + for i := 0 to high(APolylines) do + begin + if AInsertEmptyPointInBetween and (i > 0) then + begin + result[pos] := EmptyPointF; + inc(pos); + end; + for j := 0 to high(APolylines[i]) do + begin + result[pos] := APolylines[i][j]; + inc(pos); + end; + end; +end; + +function VectLen(v: TPointF): single; +begin + if isEmptyPointF(v) then + result := EmptySingle + else + result := sqrt(v*v); +end; + +function VectDet(v1, v2: TPointF): double; +begin + result := v1.x*v2.y - v1.y*v2.x; +end; + +function VectLen(dx, dy: single): single; +begin + result := sqrt(dx*dx+dy*dy); +end; + +function PolylineLen(const pts: array of TPointF; AClosed: boolean): single; +var + i: Int32or64; +begin + result := 0; + for i := 0 to high(pts)-1 do + IncF(result, VectLen(pts[i+1] - pts[i]) ); + if AClosed then + incF(result, VectLen(pts[0] - pts[high(pts)]) ); +end; + +{ Check if a PointF structure is empty or should be treated as a list separator } +function isEmptyPointF(const pt: TPointF): boolean; +begin + Result := (pt.x = EmptySingle) and (pt.y = EmptySingle); +end; + +{----------- Line and polygon functions -----------} +{$PUSH}{$OPTIMIZATION OFF} +function IntersectLine(line1, line2: TLineDef): TPointF; +var parallel: boolean; +begin + result := IntersectLine(line1,line2,parallel); +end; +{$POP} + +function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; + procedure SetParallel; + begin + parallel := true; + //return the center of the segment between line origins + result.x := (line1.origin.x+line2.origin.x)/2; + result.y := (line1.origin.y+line2.origin.y)/2; + end; +var pos, step: single; + n: TPointF; +begin + parallel := false; + n := PointF(-line2.dir.y, line2.dir.x); + step := line1.dir*n; + if step = 0 then begin SetParallel; exit; end; + pos := (line2.origin - line1.origin)*n; + result := line1.origin + line1.dir * (pos/step); +end; + +{ Check if a polygon is convex, i.e. it always turns in the same direction } +function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean; +var + positive,negative,zero: boolean; + product: single; + i: Integer; +begin + positive := false; + negative := false; + zero := false; + for i := 0 to high(pts) do + begin + product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) - + (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x); + if product > 0 then + begin + if negative then + begin + result := false; + exit; + end; + positive := true; + end else + if product < 0 then + begin + if positive then + begin + result := false; + exit; + end; + negative := true; + end else + zero := true; + end; + if not IgnoreAlign and zero then + result := false + else + result := true; +end; + +{ Check if two segments intersect } +function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; +var + seg1: TLineDef; + seg1len: single; + seg2: TLineDef; + seg2len: single; + inter: TPointF; + pos1,pos2: single; + para: boolean; + +begin + { Determine line definitions } + seg1.origin := pt1; + seg1.dir := pt2-pt1; + seg1len := VectLen(seg1.dir); + if seg1len = 0 then + begin + result := false; + exit; + end; + seg1.dir.Scale(1/seg1len); + + seg2.origin := pt3; + seg2.dir := pt4-pt3; + seg2len := VectLen(seg2.dir); + if seg2len = 0 then + begin + result := false; + exit; + end; + seg2.dir.Scale(1/seg2len); + + //obviously parallel + if seg1.dir = seg2.dir then + result := false + else + begin + //try to compute intersection + inter := IntersectLine(seg1,seg2,para); + if para then + result := false + else + begin + //check if intersections are inside the segments + pos1 := (inter-seg1.origin)*seg1.dir; + pos2 := (inter-seg2.origin)*seg2.dir; + if (pos1 >= 0) and (pos1 <= seg1len) and + (pos2 >= 0) and (pos2 <= seg2len) then + result := true + else + result := false; + end; + end; +end; + +function IsClockwise(const pts: array of TPointF): boolean; +var + i: Integer; +begin + for i := 0 to high(pts) do + begin + if (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) - + (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x) < 0 then + begin + result := false; + exit; + end; + end; + result := true; +end; + +{ Check if a quaduadrilateral intersects itself } +function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; +begin + result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1); +end; + +{$DEFINE INCLUDE_IMPLEMENTATION} +{$I bezier.inc} + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/libwebp.pas b/vendor/kam_remake/src/ext/BGRABitmap/libwebp.pas new file mode 100644 index 0000000..c673cd1 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/libwebp.pas @@ -0,0 +1,649 @@ +unit libwebp; + +// Copyright 2010 Google Inc. +// +// This code is licensed under the same terms as WebM: +// Software License Agreement: http://www.webmproject.org/license/software/ +// Additional IP Rights Grant: http://www.webmproject.org/license/additional/ +// +// Delphi API by Henri Gourvest +// ----------------------------------------------------------------------------- +// This is the dynamic loader version of libwebp.pas by fredvs + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface + +uses + dynlibs; + +var + LibWebPFilename : string = + {$if defined(Win32)} + 'libwebp32.dll' + {$elseif defined(Win64)} + 'libwebp64.dll' + {$elseif defined(Darwin)} + 'libwebp.6.dylib' + {$elseif defined(Unix)} + 'libwebp.so.6' + {$else} + '' + {$endif}; + +//----------------------------------------------------------------------------- + +type +// Output colorspaces + WEBP_CSP_MODE = ( + MODE_RGB = 0, + MODE_RGBA = 1, + MODE_BGR = 2, + MODE_BGRA = 3, + MODE_YUV = 4); + +// Enumeration of the status codes + TVP8StatusCode = ( + VP8_STATUS_OK = 0, + VP8_STATUS_OUT_OF_MEMORY, + VP8_STATUS_INVALID_PARAM, + VP8_STATUS_BITSTREAM_ERROR, + VP8_STATUS_UNSUPPORTED_FEATURE, + VP8_STATUS_SUSPENDED, + VP8_STATUS_USER_ABORT, + VP8_STATUS_NOT_ENOUGH_DATA + ); + + TDecState = ( + STATE_HEADER = 0, + STATE_PARTS0 = 1, + STATE_DATA = 2, + STATE_DONE = 3, + STATE_ERROR = 4); + + // Decoding output parameters. + PWebPDecParams = ^TWebPDecParams; + TWebPDecParams = record + output: PByte; // rgb(a) or luma + u, v: PByte; // chroma u/v + top_y, top_u, top_v: PByte; // cache for the fancy upscaler + stride: Integer; // rgb(a) stride or luma stride + u_stride: Integer; // chroma-u stride + v_stride: Integer; // chroma-v stride + mode: WEBP_CSP_MODE; // rgb(a) or yuv + last_y: Integer; // coordinate of the line that was last output + output_size: Integer; // size of 'output' buffer + output_u_size: Integer; // size of 'u' buffer + output_v_size: Integer; // size of 'v' buffer + external_buffer: Integer; // If true, the output buffers are externally owned + end; + + PWebPIDecoder = ^TWebPIDecoder; + TWebPIDecoder = record + state_: TDecState; // current decoding state + w_, h_: integer; // width and height + params_: TWebPDecParams; // Params to store output info + dec_: Pointer; + end; + + // Input / Output + PVP8Io = ^VP8Io; + VP8Io = record + // set by VP8GetHeaders() + width, height: Integer; // picture dimensions, in pixels + + // set before calling put() + mb_y: Integer; // position of the current rows (in pixels) + mb_h: Integer; // number of rows in the sample + y, u, v: PByte; // rows to copy (in yuv420 format) + y_stride: Integer; // row stride for luma + uv_stride: Integer; // row stride for chroma + + opaque: Pointer; // user data + + // called when fresh samples are available. Currently, samples are in + // YUV420 format, and can be up to width x 24 in size (depending on the + // in-loop filtering level, e.g.). Should return false in case of error + // or abort request. + put: function(const io: PVP8Io): Integer; cdecl; + + // called just before starting to decode the blocks. + // Should returns 0 in case of error. + setup: function(io: PVP8Io): Integer; cdecl; + + // called just after block decoding is finished (or when an error occurred). + teardown: procedure(const io: PVP8Io); cdecl; + + // this is a recommendation for the user-side yuv->rgb converter. This flag + // is set when calling setup() hook and can be overwritten by it. It then + // can be taken into consideration during the put() method. + fancy_upscaling: Integer; + + // Input buffer. + data_size: LongWord; + data: PByte; + + // If true, in-loop filtering will not be performed even if present in the + // bitstream. Switching off filtering may speed up decoding at the expense + // of more visible blocking. Note that output will also be non-compliant + // with the VP8 specifications. + bypass_filtering: Integer; + end; + + // Main decoding object. This is an opaque structure. + PVP8Decoder = ^VP8Decoder; + VP8Decoder = record end; + +//----------------------------------------------------------------------------- +// Coding parameters + + PWebPConfig = ^TWebPConfig; + TWebPConfig = record + quality: Single; // between 0 (smallest file) and 100 (biggest) + target_size: Integer; // if non-zero, set the desired target size in bytes. + // Takes precedence over the 'compression' parameter. + target_PSNR: Single; // if non-zero, specifies the minimal distortion to + // try to achieve. Takes precedence over target_size. + method: Integer; // quality/speed trade-off (0=fast, 6=slower-better) + segments: Integer; // maximum number of segments to use, in [1..4] + sns_strength: Integer; // Spatial Noise Shaping. 0=off, 100=maximum. + filter_strength: Integer; // range: [0 = off .. 100 = strongest] + filter_sharpness: Integer; // range: [0 = off .. 7 = least sharp] + filter_type: Integer; // filtering type: 0 = simple, 1 = strong + // (only used if filter_strength > 0 or autofilter > 0) + autofilter: Integer; // Auto adjust filter's strength [0 = off, 1 = on] + pass: Integer; // number of entropy-analysis passes (in [1..10]). + + show_compressed: Integer; // if true, export the compressed picture back. + // In-loop filtering is not applied. + preprocessing: Integer; // preprocessing filter (0=none, 1=segment-smooth) + partitions: Integer; // log2(number of token partitions) in [0..3] + // Default is set to 0 for easier progressive decoding. + end; + +// Enumerate some predefined settings for WebPConfig, depending on the type +// of source picture. These presets are used when calling WebPConfigPreset(). + TWebPPreset = ( + WEBP_PRESET_DEFAULT = 0, // default preset. + WEBP_PRESET_PICTURE, // digital picture, like portrait, inner shot + WEBP_PRESET_PHOTO, // outdoor photograph, with natural lighting + WEBP_PRESET_DRAWING, // hand or line drawing, with high-contrast details + WEBP_PRESET_ICON, // small-sized colorful images + WEBP_PRESET_TEXT // text-like + ); + + PWebPPicture = ^TWebPPicture; + //TWebPPicture = record end; // main structure for I/O + + // non-essential structure for storing auxilliary statistics + PWebPAuxStats = ^TWebPAuxStats; + TWebPAuxStats = record + PSNR: array[0..3] of Single; // peak-signal-to-noise ratio for Y/U/V/All + coded_size: Integer; // final size + block_count: array[0..2] of Integer; // number of intra4/intra16/skipped macroblocks + header_bytes: array[0..1] of Integer; // approximative number of bytes spent for header + // and mode-partition #0 + residual_bytes: array[0..2, 0..3] of Integer; // approximative number of bytes spent for + // DC/AC/uv coefficients for each (0..3) segments. + segment_size: array[0..3] of Integer; // number of macroblocks in each segments + segment_quant: array[0..3] of Integer; // quantizer values for each segments + segment_level: array[0..3] of Integer; // filtering strength for each segments [0..63] + end; + + // Signature for output function. Should return 1 if writing was successful. + // data/data_size is the segment of data to write, and 'picture' is for + // reference (and so one can make use of picture->custom_ptr). + TWebPWriterFunction = function(const data: PByte; data_size: LongWord; + const picture: PWebPPicture): Integer; cdecl; + + TWebPPicture = record + // input + colorspace: Integer; // colorspace: should be 0 for now (=Y'CbCr). + width, height: Integer; // dimensions. + y, u, v: PByte; // pointers to luma/chroma planes. + y_stride, uv_stride: Integer; // luma/chroma strides. + a: PByte; // pointer to the alpha plane (unused for now). + + // output + writer: TWebPWriterFunction ; // can be NULL + custom_ptr: Pointer; // can be used by the writer. + + // map for extra information + extra_info_type: Integer; // 1: intra type, 2: segment, 3: quant + // 4: intra-16 prediction mode, + // 5: chroma prediction mode, + // 6: bit cost, 7: distortion + extra_info: PByte; // if not NULL, points to an array of size + // ((width + 15) / 16) * ((height + 15) / 16) that + // will be filled with a macroblock map, depending + // on extra_info_type. + + // where to store statistics, if not NULL: + stats: PWebPAuxStats; + end; + + +(****************************************************************************** + decode.h + Main decoding functions for WEBP images. + ******************************************************************************) + // Dynamic load : Vars that will hold our dynamically loaded functions... + + +// *************************** functions ******************************* +var + +// Return the decoder's version number, packed in hexadecimal using 8bits for +// each of major/minor/revision. E.g: v2.5.7 is 0x020507. +WebPGetDecoderVersion: function(): Integer; cdecl; + +// Retrieve basic header information: width, height. +// This function will also validate the header and return 0 in +// case of formatting error. +// Pointers *width/*height can be passed NULL if deemed irrelevant. +WebPGetInfo: function(const data: PByte; data_size: LongWord; + width, height: PInteger): Integer; cdecl; + +// Decodes WEBP images pointed to by *data and returns RGB samples, along +// with the dimensions in *width and *height. +// The returned pointer should be deleted calling free(). +// Returns NULL in case of error. +WebPDecodeRGB: function(const data: PByte; data_size: LongWord; + width, height: PInteger): PByte; cdecl; + +// Same as WebPDecodeRGB, but returning RGBA data. +WebPDecodeRGBA: function(const data: PByte; data_size: LongWord; + width, height: PInteger): PByte; cdecl; + +// This variant decode to BGR instead of RGB. +WebPDecodeBGR: function(const data: PByte; data_size: LongWord; + width, height: PInteger): PByte; cdecl; +// This variant decodes to BGRA instead of RGBA. +WebPDecodeBGRA: function(const data: PByte; data_size: LongWord; + width, height: PInteger): PByte; cdecl; + +// Decode WEBP images stored in *data in Y'UV format(*). The pointer returned is +// the Y samples buffer. Upon return, *u and *v will point to the U and V +// chroma data. These U and V buffers need NOT be free()'d, unlike the returned +// Y luma one. The dimension of the U and V planes are both (*width + 1) / 2 +// and (*height + 1)/ 2. +// Upon return, the Y buffer has a stride returned as '*stride', while U and V +// have a common stride returned as '*uv_stride'. +// Return NULL in case of error. +// (*) Also named Y'CbCr. See: http://en.wikipedia.org/wiki/YCbCr +WebPDecodeYUV: function(const data: PByte; data_size: LongWord; width, height: PInteger; + var u, v: PByte; stride, uv_stride: PInteger): PByte; cdecl; + +// Releases memory returned by the WebPDecode*() functions above. +WebPFree: procedure(const data: PByte); cdecl; + +// These three functions are variants of the above ones, that decode the image +// directly into a pre-allocated buffer 'output_buffer'. The maximum storage +// available in this buffer is indicated by 'output_buffer_size'. If this +// storage is not sufficient (or an error occurred), NULL is returned. +// Otherwise, output_buffer is returned, for convenience. +// The parameter 'output_stride' specifies the distance (in bytes) +// between scanlines. Hence, output_buffer_size is expected to be at least +// output_stride x picture-height. +WebPDecodeRGBInto: function(const data: PByte; data_size: LongWord; + output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; + +WebPDecodeRGBAInto: function(const data: PByte; data_size: LongWord; + output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; + +// BGR variants +WebPDecodeBGRInto: function(const data: PByte; data_size: LongWord; + output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; + +WebPDecodeBGRAInto: function(const data: PByte; data_size: LongWord; + output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; + +// WebPDecodeYUVInto() is a variant of WebPDecodeYUV() that operates directly +// into pre-allocated luma/chroma plane buffers. This function requires the +// strides to be passed: one for the luma plane and one for each of the +// chroma ones. The size of each plane buffer is passed as 'luma_size', +// 'u_size' and 'v_size' respectively. +// Pointer to the luma plane ('*luma') is returned or NULL if an error occurred +// during decoding (or because some buffers were found to be too small). +WebPDecodeYUVInto: function(const data: PByte; data_size: LongWord; + luma: PByte; luma_size, luma_stride: Integer; + u: PByte; u_size, u_stride: Integer; + v: PByte; v_size, v_stride: Integer): PByte; cdecl; + +//----------------------------------------------------------------------------- +// Incremental decoding +// +// This API allows streamlined decoding of partial data. +// Picture can be incrementally decoded as data become available thanks to the +// WebPIDecoder object. This object can be left in a SUSPENDED state if the +// picture is only partially decoded, pending additional input. +// Code example: +// +// WebPIDecoder* const idec = WebPINew(mode); +// while (has_more_data) { +// // ... (get additional data) +// status = WebPIAppend(idec, new_data, new_data_size); +// if (status != VP8_STATUS_SUSPENDED || +// break; +// } +// +// // The above call decodes the current available buffer. +// // Part of the image can now be refreshed by calling to +// // WebPIDecGetRGB()/WebPIDecGetYUV() etc. +// } +// WebPIDelete(idec); + +// Creates a WebPIDecoder object. Returns NULL in case of failure. +WebPINew: function(mode: WEBP_CSP_MODE): PWebPIDecoder; cdecl; + +// This function allocates and initializes an incremental-decoder object, which +// will output the r/g/b(/a) samples specified by 'mode' into a preallocated +// buffer 'output_buffer'. The size of this buffer is at least +// 'output_buffer_size' and the stride (distance in bytes between two scanlines) +// is specified by 'output_stride'. Returns NULL if the allocation failed. +WebPINewRGB: function(mode: WEBP_CSP_MODE; output_buffer: PByte; + output_buffer_size, output_stride: Integer): PWebPIDecoder; cdecl; + +// This function allocates and initializes an incremental-decoder object, which +// will output the raw luma/chroma samples into a preallocated planes. The luma +// plane is specified by its pointer 'luma', its size 'luma_size' and its stride +// 'luma_stride'. Similarly, the chroma-u plane is specified by the 'u', +// 'u_size' and 'u_stride' parameters, and the chroma-v plane by 'v', 'v_size' +// and 'v_size'. +// Returns NULL if the allocation failed. +WebPINewYUV: function(luma: PByte; luma_size, luma_stride: Integer; + u: PByte; u_size, u_stride: Integer; + v: PByte; v_size, v_stride: Integer): PWebPIDecoder; cdecl; + +// Deletes the WebpBuffer object and associated memory. Must always be called +// if WebPINew, WebPINewRGB or WebPINewYUV succeeded. +WebPIDelete: procedure(const idec: PWebPIDecoder); cdecl; + +// Copies and decodes the next available data. Returns VP8_STATUS_OK when +// the image is successfully decoded. Returns VP8_STATUS_SUSPENDED when more +// data is expected. Returns error in other cases. +WebPIAppend: function(const idec: PWebPIDecoder; const data: PByte; + data_size: LongWord): TVP8StatusCode; cdecl; + +// A variant of the above function to be used when data buffer contains +// partial data from the beginning. In this case data buffer is not copied +// to the internal memory. +// Note that the value of the 'data' pointer can change between calls to +// WebPIUpdate, for instance when the data buffer is resized to fit larger data. +WebPIUpdate: function(const idec: PWebPIDecoder; const data: PByte; + data_size: LongWord): TVP8StatusCode; cdecl; + +// Returns the RGB image decoded so far. Returns NULL if output params are not +// initialized yet. *last_y is the index of last decoded row in raster scan +// order. Some pointers (*last_y, *width etc.) can be NULL if corresponding +// information is not needed. +WebPIDecGetRGB: function(const idec: PWebPIDecoder; last_y, width, + height, stride: PInteger): PByte; cdecl; + +// Same as above function to get YUV image. Returns pointer to the luma plane +// or NULL in case of error. +WebPIDecGetYUV: function(const idec: PWebPIDecoder; last_y: PInteger; + var u, v: PByte; width, height, stride, uv_stride: PInteger): PByte; cdecl; + +(****************************************************************************** + WebP encoder: main interface + ******************************************************************************) + +// Return the encoder's version number, packed in hexadecimal using 8bits for +// each of major/minor/revision. E.g: v2.5.7 is 0x020507. +WebPGetEncoderVersion: function(): Integer; cdecl; + +//----------------------------------------------------------------------------- +// One-stop-shop call! No questions asked: + +// Returns the size of the compressed data (pointed to by *output), or 0 if +// an error occurred. The compressed data must be released by the caller +// using the call 'WebPFree(*output)'. +// These functions compress using the lossy format, and the quality_factor +// can go from 0 (smaller output, lower quality) to 100 (best quality, +// larger output). + +WebPEncodeRGB: function(const rgb: PByte; width, height, stride: Integer; + quality_factor: single; var output: PByte): LongWord; cdecl; + +WebPEncodeBGR: function(const bgr: PByte; width, height, stride: Integer; + quality_factor: Single; var output: PByte): LongWord; cdecl; + +WebPEncodeRGBA: function(const rgba: PByte; width, height, stride: Integer; + quality_factor: Single; var output: PByte): LongWord; cdecl; + +WebPEncodeBGRA: function(const bgra: PByte; width, height, stride: Integer; + quality_factor: Single; var output: PByte): LongWord; cdecl; + +// These functions are the equivalent of the above, but compressing in a +// lossless manner. Files are usually larger than lossy format, but will +// not suffer any compression loss. +// Note these functions, like the lossy versions, use the library's default +// settings. For lossless this means 'exact' is disabled. RGB values in +// transparent areas will be modified to improve compression. To avoid this, +// use WebPEncode() and set WebPConfig::exact to 1. + +WebPEncodeLosslessRGB: function(const rgb: PByte; width, height, stride: Integer; + var output: PByte): LongWord; cdecl; + +WebPEncodeLosslessBGR: function(const bgr: PByte; width, height, stride: Integer; + var output: PByte): LongWord; cdecl; + +WebPEncodeLosslessRGBA: function(const rgba: PByte; width, height, stride: Integer; + var output: PByte): LongWord; cdecl; + +WebPEncodeLosslessBGRA: function(const bgra: PByte; width, height, stride: Integer; + var output: PByte): LongWord; cdecl; + +// Should always be called, to initialize a fresh WebPConfig structure before +// modification. Returns 0 in case of version mismatch. WebPConfigInit() must +// have succeeded before using the 'config' object. +function WebPConfigInit(const config: PWebPConfig): Integer; + +// This function will initialize the configuration according to a predefined +// set of parameters (referred to by 'preset') and a given quality factor. +// This function can be called as a replacement to WebPConfigInit(). Will +// return 0 in case of error. +function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; + quality: Single): Integer; + +var +// Returns 1 if all parameters are in valid range and the configuration is OK. +WebPValidateConfig: function(const config: PWebPConfig): Integer; cdecl; + +// Should always be called, to initialize the structure. Returns 0 in case of +// version mismatch. WebPPictureInit() must have succeeded before using the +// 'picture' object. +function WebPPictureInit(const picture: PWebPPicture): Integer; + +//----------------------------------------------------------------------------- +// WebPPicture utils +var +// Convenience allocation / deallocation based on picture->width/height: +// Allocate y/u/v buffers as per width/height specification. +// Note! This function will free the previous buffer if needed. +// Returns 0 in case of memory error. +WebPPictureAlloc: function(const picture: PWebPPicture): Integer; cdecl; + +// Release memory allocated by WebPPictureAlloc() or WebPPictureImport*() +// Note that this function does _not_ free the memory pointed to by 'picture'. +WebPPictureFree: procedure(const picture: PWebPPicture); cdecl; + +// Copy the pixels of *src into *dst, using WebPPictureAlloc. +// Returns 0 in case of memory allocation error. +WebPPictureCopy: function(const src, dst: PWebPPicture): Integer; cdecl; + +// self-crops a picture to the rectangle defined by top/left/width/height. +// Returns 0 in case of memory allocation error, or if the rectangle is +// outside of the source picture. +WebPPictureCrop: function(const picture: PWebPPicture; + left, top, width, height: Integer): Integer; cdecl; + +// Colorspace conversion function. Previous buffer will be free'd, if any. +// *rgb buffer should have a size of at least height * rgb_stride. +// Returns 0 in case of memory error. +WebPPictureImportRGB: function(const picture: PWebPPicture; + const rgb: PByte; rgb_stride: Integer): Integer; cdecl; + +// Same, but for RGBA buffer. Alpha information is ignored. +WebPPictureImportRGBA: function(const picture: PWebPPicture; + const rgba: PByte; rgba_stride: Integer): Integer; cdecl; + +// Variant of the above, but taking BGR input: +WebPPictureImportBGR: function(const picture: PWebPPicture; + const bgr: PByte; bgr_stride: Integer): Integer; cdecl; + +WebPPictureImportBGRA: function(const picture: PWebPPicture; + const bgra: PByte; bgra_stride: Integer): Integer; cdecl; + +//----------------------------------------------------------------------------- +// Main call + +// Main encoding call, after config and picture have been initialiazed. +// 'picture' must be less than 16384x16384 in dimension, and the 'config' object +// must be a valid one. +// Returns false in case of error, true otherwise. +WebPEncode: function(const config: PWebPConfig; const picture: PWebPPicture): Integer; cdecl; + +WebPConfigInitInternal: function(const conf: PWebPConfig; preset: TWebPPreset; + quality: single; version: Integer): Integer; cdecl; + +// Internal, version-checked, entry point +WebPPictureInitInternal: function(const picture: PWebPPicture; version: Integer): Integer; cdecl; +{Special methods for dynamic loading of lib ...} + +var + LibWebPHandle: TLibHandle = dynlibs.NilHandle; // this will hold our handle for the lib; it functions nicely as a mutli-lib prevention unit as well... + LibWebPRefCount : LongWord = 0; // Reference counter + +function LibWebPLoaded : boolean; inline; +Function LibWebPLoad(const libfilename:string = ''): boolean; // load the lib +Procedure LibWebPUnload; // unload and frees the lib from memory : do not forget to call it before close application. + +implementation + +uses sysutils; + +// Internal, version-checked, entry point +const + WEBP_ENCODER_ABI_VERSION = $0001; + +function WebPConfigInit(const config: PWebPConfig): Integer; +begin + Result := WebPConfigInitInternal(config, WEBP_PRESET_DEFAULT, 75.0, WEBP_ENCODER_ABI_VERSION); +end; + +function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; + quality: Single): Integer; +begin + Result := WebPConfigInitInternal(config, preset, quality, WEBP_ENCODER_ABI_VERSION); +end; + +function WebPPictureInit(const picture: PWebPPicture): Integer; +begin + Result := WebPPictureInitInternal(picture, WEBP_ENCODER_ABI_VERSION); +end; + +function LibWebPLoaded: boolean; +begin + Result := (LibWebPHandle <> dynlibs.NilHandle); +end; + +Function LibWebPLoad (const libfilename:string) :boolean; +var + thelib: string; +begin + Result := False; + if LibWebPHandle<>0 then + begin + Inc(LibWebPRefCount); + result:=true {is it already there ?} + end else + begin {go & load the library} + if Length(libfilename) = 0 then + begin + thelib := LibWebPFilename; + if thelib = '' then exit(false); + thelib := ExtractFilePath(ParamStr(0)) + DirectorySeparator + thelib; + end else thelib := libfilename; + LibWebPHandle := DynLibs.SafeLoadLibrary(thelib); // obtain the handle we want + {$IFDEF WINDOWS} + // second try on Windows without 32/64 suffix + if LibWebPHandle = DynLibs.NilHandle then + begin + thelib := ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'libwebp.dll'; + LibWebPHandle := DynLibs.SafeLoadLibrary(thelib); // obtain the handle we want + end; + {$ENDIF} + if LibWebPHandle <> DynLibs.NilHandle then + begin {now we tie the functions to the VARs from above} + +Pointer(WebPGetDecoderVersion):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetDecoderVersion')); +Pointer(WebPGetInfo):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetInfo')); +Pointer(WebPDecodeRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGB')); +Pointer(WebPDecodeRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBA')); +Pointer(WebPDecodeBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGR')); +Pointer(WebPDecodeBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRA')); +Pointer(WebPDecodeYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeYUV')); +Pointer(WebPFree):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPFree')); +Pointer(WebPDecodeRGBInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBInto')); +Pointer(WebPDecodeRGBAInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBAInto')); +Pointer(WebPDecodeBGRInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRInto')); +Pointer(WebPDecodeBGRAInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRAInto')); +Pointer(WebPDecodeYUVInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeYUVInto')); +Pointer(WebPINew):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINew')); +Pointer(WebPINewRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINewRGB')); +Pointer(WebPINewYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINewYUV')); +Pointer(WebPIDelete):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDelete')); +Pointer(WebPIAppend):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIAppend')); +Pointer(WebPIUpdate):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIUpdate')); +Pointer(WebPIDecGetRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDecGetRGB')); +Pointer(WebPIDecGetYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDecGetYUV')); +Pointer(WebPGetEncoderVersion):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetEncoderVersion')); +Pointer(WebPEncodeRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeRGB')); +Pointer(WebPEncodeBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeBGR')); +Pointer(WebPEncodeRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeRGBA')); +Pointer(WebPEncodeBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeBGRA')); +Pointer(WebPEncodeLosslessRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessRGB')); +Pointer(WebPEncodeLosslessBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessBGR')); +Pointer(WebPEncodeLosslessRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessRGBA')); +Pointer(WebPEncodeLosslessBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessBGRA')); +//Pointer(WebPConfigInit):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigInit')); +//Pointer(WebPConfigPreset):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigPreset')); +//Pointer(WebPPictureInit):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureInit')); +Pointer(WebPPictureAlloc):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureAlloc')); +Pointer(WebPPictureFree):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureFree')); +Pointer(WebPPictureCopy):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureCopy')); +Pointer(WebPPictureCrop):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureCrop')); +Pointer(WebPPictureImportRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportRGB')); +Pointer(WebPPictureImportRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportRGBA')); +Pointer(WebPPictureImportBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportBGR')); +Pointer(WebPPictureImportBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportBGRA')); +Pointer(WebPEncode):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncode')); +Pointer(WebPConfigInitInternal):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigInitInternal')); +Pointer(WebPPictureInitInternal):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureInitInternal')); + + end; + Result := LibWebPLoaded; + LibWebPRefCount:=1; + end; +end; + +Procedure LibWebPUnload; +begin + // < Reference counting + if LibWebPRefCount > 0 then + dec(LibWebPRefCount); + if LibWebPRefCount > 0 then + exit; + // > + if LibWebPLoaded then + begin + DynLibs.UnloadLibrary(LibWebPHandle); + LibWebPHandle:=DynLibs.NilHandle; + end; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/lightingclasses3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/lightingclasses3d.inc new file mode 100644 index 0000000..409f223 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/lightingclasses3d.inc @@ -0,0 +1,174 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + { TBGRADirectionalLight3D } + + TBGRADirectionalLight3D = class(TBGRALight3D,IBGRADirectionalLight3D) + protected + FDirection, FBetweenDirectionAndObserver: TPoint3D_128; + public + constructor Create(ADirection: TPoint3D); + function GetDirection: TPoint3D; override; + procedure SetDirection(const AValue: TPoint3D); + + procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override; + procedure ComputeDiffuseColor(Context: PSceneLightingContext); override; + procedure ComputeDiffuseLightness(Context: PSceneLightingContext); override; + function IsDirectional: boolean; override; + end; + + { TBGRAPointLight3D } + + TBGRAPointLight3D = class(TBGRALight3D,IBGRAPointLight3D) + protected + FVertex: IBGRAVertex3D; + FIntensity: single; + public + constructor Create(AVertex: IBGRAVertex3D; AIntensity: single); + function GetIntensity: single; override; + procedure SetIntensity(const AValue: single); + + function GetVertex: IBGRAVertex3D; + procedure SetVertex(const AValue: IBGRAVertex3D); + function GetPosition: TPoint3D; override; + + procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override; + procedure ComputeDiffuseLightness(Context: PSceneLightingContext); override; + procedure ComputeDiffuseColor(Context: PSceneLightingContext); override; + function IsDirectional: boolean; override; + end; + +{ TBGRAPointLight3D } + +constructor TBGRAPointLight3D.Create(AVertex: IBGRAVertex3D; AIntensity: single); +begin + inherited Create; + FVertex:= AVertex; + FIntensity := AIntensity; +end; + +function TBGRAPointLight3D.GetIntensity: single; +begin + result := FIntensity; +end; + +procedure TBGRAPointLight3D.SetIntensity(const AValue: single); +begin + FIntensity:= AValue; +end; + +function TBGRAPointLight3D.GetVertex: IBGRAVertex3D; +begin + result := FVertex; +end; + +procedure TBGRAPointLight3D.SetVertex(const AValue: IBGRAVertex3D); +begin + FVertex := AValue; +end; + +function TBGRAPointLight3D.GetPosition: TPoint3D; +begin + Result:= FVertex.GetViewCoord; +end; + +procedure TBGRAPointLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); + {$DEFINE PARAM_POINTLIGHT} + {$i phonglight.inc} + +procedure TBGRAPointLight3D.ComputeDiffuseLightness(Context: PSceneLightingContext); +const maxValue = 100*32768; +var + vect: TPoint3D_128; + dist2,intensity: single; +begin + vect := FVertex.ViewCoord_128 - Context^.basic.Position; + dist2 := DotProduct3D_128(vect,vect); + if dist2 = 0 then + TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,maxValue,FLightness) + else + begin + intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity; + if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; + if intensity > 100 then intensity := 100; + if intensity < FMinIntensity then intensity := FMinIntensity; + TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,round(intensity*32768),FLightness); + end; +end; + +procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext); +var + vect: TPoint3D_128; + intensity,dist2: single; +begin + vect := FVertex.ViewCoord_128 - Context^.basic.Position; + dist2 := DotProduct3D_128(vect,vect); + if dist2 = 0 then + intensity := 100 + else + begin + intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity; + if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; + if intensity > 100 then intensity := 100; + if intensity < FMinIntensity then intensity := FMinIntensity; + end; + + TBGRAMaterial3D(Context^.material).ComputeDiffuseColor(Context,intensity, FColorInt); +end; + +function TBGRAPointLight3D.IsDirectional: boolean; +begin + result := false; +end; + +{ TBGRADirectionalLight3D } + +constructor TBGRADirectionalLight3D.Create(ADirection: TPoint3D); +begin + inherited Create; + SetDirection(ADirection); +end; + +function TBGRADirectionalLight3D.GetDirection: TPoint3D; +begin + result := Point3D(-FDirection.x,-FDirection.y,-FDirection.z); +end; + +procedure TBGRADirectionalLight3D.SetDirection(const AValue: TPoint3D); +begin + FDirection := -Point3D_128(AValue.x,AValue.y,AValue.z); + Normalize3D_128(FDirection); + FBetweenDirectionAndObserver := FDirection + FViewVector; + Normalize3D_128(FBetweenDirectionAndObserver); +end; + +procedure TBGRADirectionalLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); + {$i phonglight.inc} + +procedure TBGRADirectionalLight3D.ComputeDiffuseColor(Context: PSceneLightingContext); +var + intensity: single; +begin + intensity:= DotProduct3D_128(Context^.basic.Normal, FDirection); + if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; + if intensity < FMinIntensity then intensity := FMinIntensity; + + TBGRAMaterial3D(Context^.material).ComputeDiffuseColor(Context,intensity,FColorInt); +end; + +procedure TBGRADirectionalLight3D.ComputeDiffuseLightness( + Context: PSceneLightingContext); +var + intensity: single; +begin + intensity:= DotProduct3D_128(Context^.basic.Normal, FDirection); + if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; + if intensity < FMinIntensity then intensity := FMinIntensity; + + TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,round(intensity*32768),FLightness); +end; + +function TBGRADirectionalLight3D.IsDirectional: boolean; +begin + result := true; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/linearrgbabitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/linearrgbabitmap.pas new file mode 100644 index 0000000..6ce76e3 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/linearrgbabitmap.pas @@ -0,0 +1,616 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit LinearRGBABitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; + +type + + { TLinearRGBABitmap } + + TLinearRGBABitmap = class(specialize TGenericUniversalBitmap) + protected + function InternalNew: TCustomUniversalBitmap; override; + procedure AssignTransparentPixel(out ADest); override; + public + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TLinearRGBA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + end; + +const + LinearRGBATransparent : TLinearRGBA = (red:0; green:0; blue:0; alpha:0); + +operator = (const c1, c2: TLinearRGBA): boolean; inline; + +implementation + +operator = (const c1, c2: TLinearRGBA): boolean; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + Result := True + else + Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and + (c1.green = c2.green) and (c1.blue = c2.blue); +end; + +procedure LinearRGBASolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PLinearRGBA(AContextData^.Dest), ACount); +end; + +procedure LinearRGBAChunkSetPixels( + ASource: PLinearRGBA; ADest: PLinearRGBA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + residualAlpha := ADest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + ASource^.alpha*alphaOver; + if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else + begin + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*(finalAlpha-residualAlpha) ) * finalAlphaInv; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure LinearRGBASolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PLinearRGBA; +begin + pDest := PLinearRGBA(AContextData^.Dest); + LinearRGBAChunkSetPixels( PLinearRGBA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure LinearRGBAChunkDrawPixels( + ASource: PLinearRGBA; ADest: PLinearRGBA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, srcAlphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + srcAlphaOver := ASource^.alpha*alphaOver; + if srcAlphaOver >= 1 then + ADest^ := ASource^ + else + begin + residualAlpha := ADest^.alpha*(1-srcAlphaOver); + finalAlpha := residualAlpha + srcAlphaOver; + if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else + begin + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*srcAlphaOver ) * finalAlphaInv; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*srcAlphaOver ) * finalAlphaInv; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*srcAlphaOver ) * finalAlphaInv; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; +end; + +procedure LinearRGBASolidBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PLinearRGBA; +begin + pDest := PLinearRGBA(AContextData^.Dest); + LinearRGBAChunkDrawPixels( PLinearRGBA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +type + PLinearRGBAScannerBrushFixedData = ^TLinearRGBAScannerBrushFixedData; + TLinearRGBAScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + Conversion: TBridgedConversion; + end; + +procedure LinearRGBAScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure LinearRGBAScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PLinearRGBA; + qty, pixSize: Integer; + buf: packed array[0..7] of TLinearRGBA; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); + LinearRGBAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAScannerChunkBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PLinearRGBA; + qty: Integer; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + LinearRGBAChunkSetPixels(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAChunkSetPixelsExceptTransparent( + ASource: PLinearRGBA; ADest: PLinearRGBA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + if ASource^.alpha >= 1 then + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + if ASource^.alpha >= 1 then + begin + residualAlpha := ADest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + ASource^.alpha*alphaOver; + if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else + begin + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.red := (ADest^.red*residualAlpha + + ASource^.red*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.green := (ADest^.green*residualAlpha + + ASource^.green*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.blue := (ADest^.blue*residualAlpha + + ASource^.blue*(finalAlpha-residualAlpha) ) * finalAlphaInv; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure LinearRGBAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PLinearRGBA; + qty: Integer; + psrc: Pointer; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + LinearRGBAChunkSetPixelsExceptTransparent(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PLinearRGBA; + qty, pixSize: Integer; + buf: packed array[0..7] of TLinearRGBA; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); + LinearRGBAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAScannerChunkBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PLinearRGBA; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + LinearRGBAChunkDrawPixels(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAScannerConvertBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PLinearRGBA; + qty, pixSize: Integer; + buf: packed array[0..7] of TLinearRGBA; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); + LinearRGBAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure LinearRGBAMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PLinearRGBA; + qty, maskStride: Integer; + pMask: PByteMask; + factor: single; +begin + with PLinearRGBAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + factor := AAlpha/(65535*255); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := pDest^.alpha*pMask^.gray*factor; + if pDest^.alpha = 0 then pDest^ := LinearRGBATransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + PLinearRGBA(AContextData^.Dest) := pDest; + end; +end; + +procedure LinearRGBAAlphaBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +const oneOver65535 = 1/65535; +var + pDest: PLinearRGBA; + alphaOver, residualAlpha, finalAlpha: single; +begin + if AAlpha=0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + if AAlpha=65535 then + begin + finalAlpha := PSingle(AFixedData)^; + while ACount > 0 do + begin + pDest^.alpha := finalAlpha; + inc(pDest); + dec(ACount); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + residualAlpha := pDest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + PSingle(AFixedData)^*alphaOver; + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + end; + PLinearRGBA(AContextData^.Dest) := pDest; +end; + +procedure LinearRGBAAlphaBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +const oneOver65535 = 1/65535; +var + pDest: PLinearRGBA; + alphaMul, finalAlpha: single; +begin + if AAlpha=0 then + begin + inc(PLinearRGBA(AContextData^.Dest), ACount); + exit; + end; + pDest := PLinearRGBA(AContextData^.Dest); + if AAlpha<>65535 then + alphaMul := 1-PSingle(AFixedData)^*AAlpha*single(oneOver65535) + else + alphaMul := 1-PSingle(AFixedData)^; + while ACount > 0 do + begin + finalAlpha := pDest^.alpha*alphaMul; + if finalAlpha <= 0 then pDest^ := LinearRGBATransparent else + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + PLinearRGBA(AContextData^.Dest) := pDest; +end; + +{ TLinearRGBABitmap } + +function TLinearRGBABitmap.InternalNew: TCustomUniversalBitmap; +begin + Result:= TLinearRGBABitmap.Create; +end; + +procedure TLinearRGBABitmap.AssignTransparentPixel(out ADest); +begin + TLinearRGBA(ADest) := LinearRGBATransparent; +end; + +class procedure TLinearRGBABitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TLinearRGBA; ADrawMode: TDrawMode); +begin + ABrush.Colorspace:= TLinearRGBAColorspace; + PLinearRGBA(@ABrush.FixedData)^ := AColor; + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels; + + dmSetExceptTransparent: + if AColor.alpha < 1 then + ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSkipPixels + else + begin + ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels; + ABrush.DoesNothing := true; + end; + + dmDrawWithTransparency,dmLinearBlend: + if AColor.alpha<=0 then + begin + ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end + else if AColor.alpha>=1 then + ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels + else + ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushDrawPixels; + + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; +end; + +class procedure TLinearRGBABitmap.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer; AOffsetY: integer); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TLinearRGBAColorspace; + with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @LinearRGBAScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if sourceSpace = TLinearRGBAColorspace then + begin + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushDrawPixels; + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; + end else + begin + with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TLinearRGBAColorspace); + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushDrawPixels; + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; + end; +end; + +class procedure TLinearRGBABitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TLinearRGBAColorspace; + with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @LinearRGBAScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @LinearRGBAMaskBrushApply; +end; + +class procedure TLinearRGBABitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, LinearRGBATransparent, dmDrawWithTransparency); + exit; + end; + ABrush.Colorspace:= TLinearRGBAColorspace; + PSingle(@ABrush.FixedData)^ := AAlpha/65535; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @LinearRGBAAlphaBrushErasePixels; +end; + +class procedure TLinearRGBABitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, LinearRGBATransparent, dmSet); + exit; + end; + ABrush.Colorspace:= TLinearRGBAColorspace; + PSingle(@ABrush.FixedData)^ := AAlpha/65535; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @LinearRGBAAlphaBrushSetPixels; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan.inc b/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan.inc new file mode 100644 index 0000000..1724212 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan.inc @@ -0,0 +1,114 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$i bgrasse.inc} + + var + xLen: single; //horizontal length in pixels + t: single; //initial horizontal position in [0..1] + texVect: TPointF; //texture vector between start and end of line + texPos: TPointF; //texture start position + texStep: TPointF; //texture step + intTexPos: packed record + x,y: integer; + end; + + //loop variables + pdest: PBGRAPixel; + i: LongInt; + + {$IFDEF PARAM_USELIGHTING} + light,lightStep,lightDiff,lightAcc,lightMod: word; + lightLen: integer; + + procedure NextLight; inline; + begin + light := (light+lightStep) and 65535; + inc(lightAcc,lightDiff); + if lightAcc >= lightMod then + begin + dec(lightAcc,lightMod); + light := (light + 1) and 65535; + end; + end; + {$ENDIF} + + begin + xLen := info2.interX - info1.interX; + t := ((ix1+0.5)-info1.interX)/xLen; + + texVect := info2.texCoord-info1.texCoord; + texPos := info1.texCoord + texVect*t; + texStep := texVect*(1/xLen); + + pdest := bmp.ScanLine[yb]+ix1; + + {$IFDEF PARAM_USELIGHTING} + if ix2 = ix1 then + begin + light := (info1.lightness+info2.lightness) div 2; + lightStep := 0; + lightDiff := 0; + lightMod := 1; + end + else + begin + light := info1.lightness; + lightLen := info2.lightness-info1.lightness; + if lightLen >= 0 then + begin + lightStep := lightLen div (ix2-ix1); + lightMod := ix2-ix1; + lightDiff := lightLen - lightStep*(ix2-ix1); + end else + begin + lightStep := (-lightLen+(ix2-ix1-1)) div (ix2-ix1); + lightMod := ix2-ix1; + lightDiff := lightLen + lightStep*(ix2-ix1); + lightStep := 65536 - lightStep; + end; + end; + lightAcc := lightDiff div 2; + {$ENDIF} + + {$IFDEF BGRASSE_AVAILABLE} + if UseSSE then + begin + {$DEFINE PARAM_USESSE} + if UseSSE2 then + begin + {$DEFINE PARAM_USESSE2} + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i lineartexscan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i lineartexscan2.inc} + end; + {$UNDEF PARAM_USESSE2} + end else + begin + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i lineartexscan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i lineartexscan2.inc} + end; + end; + {$UNDEF PARAM_USESSE} + end else + {$ENDIF} + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i lineartexscan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i lineartexscan2.inc} + end; + end; +{$undef PARAM_USELIGHTING} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan2.inc b/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan2.inc new file mode 100644 index 0000000..0bb7c23 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/lineartexscan2.inc @@ -0,0 +1,54 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception + {$IFDEF PARAM_USESSE} {$asmmode intel} + asm + xorps xmm4,xmm4 + xorps xmm5,xmm5 + movlps xmm4, texPos + movlps xmm5, texStep + {$IFNDEF PARAM_USEINTERPOLATION} + {$IFDEF PARAM_USESSE2} + cvtps2dq xmm3,xmm4 + movlps intTexPos,xmm3 + {$ENDIF} + {$ENDIF} + end; + {$ENDIF} + + for i := ix1 to ix2 do + begin + DrawPixelInlineWithAlphaCheck(pdest, + {$IFDEF PARAM_USELIGHTING} ApplyLightnessFast( {$ENDIF} + {$IFDEF PARAM_USEINTERPOLATION} + scanAtFunc(texPos.x,texPos.y) + {$ELSE} + {$IFDEF PARAM_USESSE2} + scanAtIntegerFunc(intTexPos.x,intTexPos.y) + {$ELSE} + scanAtIntegerFunc(round(texPos.x),round(texPos.y)) + {$ENDIF} + {$ENDIF} + {$IFDEF PARAM_USELIGHTING} ,light) {$ENDIF} + ); + {$IFDEF PARAM_USESSE} + asm + addps xmm4,xmm5 + {$IFNDEF PARAM_USEINTERPOLATION} + {$IFDEF PARAM_USESSE2} + cvtps2dq xmm3,xmm4 + movlps intTexPos,xmm3 + {$ELSE} + movlps texPos,xmm4 + {$ENDIF} + {$ELSE} + movlps texPos,xmm4 + {$ENDIF} + end; + {$ELSE} + texPos.Offset(texStep); + {$ENDIF} + + {$IFDEF PARAM_USELIGHTING} + NextLight; + {$ENDIF} + inc(pdest); + end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/linuxlib.pas b/vendor/kam_remake/src/ext/BGRABitmap/linuxlib.pas new file mode 100644 index 0000000..623e473 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/linuxlib.pas @@ -0,0 +1,114 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit linuxlib; + +{$mode objfpc}{$H+} + +{ This unit allows to find the implementation of a library from its + "linker name" whatever its version. Note that between different versions, + there may be incompatibilities (in the signature of the functions or the + record types). So make sure the functions you are calling are stable or + check the version of the library once its loaded using one of its functions. + + + Linker name + ----------- + The linker name normally can only be used when compiling a program. + It ends up with .so and does not have any version number. There isn't + necessarily a file with this name though it may be provided in the + development package (ending with -dev). + - libwebp.so + - libportaudio.so + - libtiff.so + - libpython.so + + + Soname (qualified with a version number) + ---------------------------------------- + The soname can be supplied to the LoadLibray function to load at runtime, + without specifying any path. It is the same as the linker name, but with + a version number. The file exists most of the time and it is generally + a symbolic link to the implementation (or "real name"). + - libwebp.so.6 + - libportaudio.so.2 + - libtiff.so.5 + - libpython2.7.so + + + Implementation or real name (with minor number) + ----------------------------------------------- + The real name contains the implementation. It has a minor number and + an optional release number. Most of the time, you don't need to know this + name to use the library. + - libwebp.so.6.0.2 + - libportaudio.so.2.0.0 + - libtiff.so.5.3.0 + - libpython2.7.so.1.0 + + + See: http://tldp.org/HOWTO/Program-Library-HOWTO/shared-libraries.html } + +interface + +uses + BGRAClasses, SysUtils; + +function FindLinuxLibrary(ALinkerName: string; AMinimumVersion: integer = 0): string; + +implementation + +uses process; + +function FindLinuxLibrary(ALinkerName: string; AMinimumVersion: integer): string; +const + OpenBracket = ' ('; + Arrow = ') => '; +var + dataText, s, fileName, flags, path, versionStr: string; + dataList, flagList: TStringList; + openBracketPos, arrowPos, posDot: SizeInt; + versionInt, errPos, i: integer; + maxVersionInt: integer; +begin + result := ''; + maxVersionInt := AMinimumVersion-1; + RunCommand('ldconfig', ['-p'], dataText, []); + dataList := TStringList.Create; + dataList.Text := dataText; + flagList := TStringList.Create; + for i := 0 to dataList.Count-1 do + begin + s := dataList[i]; + openBracketPos := pos(OpenBracket, s); + arrowPos := pos(Arrow,s); + if (openBracketPos <> 0) and (arrowPos <> 0) then + begin + fileName := trim(copy(s,1,openBracketPos-1)); + if fileName.StartsWith(ALinkerName+'.') then + begin + versionStr := copy(fileName, length(ALinkerName)+2, length(fileName)-length(ALinkerName)-1); + posDot := pos('.', versionStr); + if posDot > 0 then versionStr := copy(versionStr, posDot-1); + val(versionStr, versionInt, errPos); + if errPos = 0 then + begin + flags := copy(s, openBracketPos+length(OpenBracket), arrowPos-openBracketPos-length(OpenBracket)); + flagList.CommaText := flags; + if {$IFNDEF CPU64}not{$ENDIF} (flagList.IndexOf('x86-64') <> -1) then + begin + path := copy(s, arrowPos+length(Arrow), length(s)-arrowPos-length(Arrow)+1); + if versionInt > maxVersionInt then + begin + maxVersionInt := versionInt; + result := path; + end; + end; + end; + end; + end; + end; + flagList.Free; + dataList.Free; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/multishapeline.inc b/vendor/kam_remake/src/ext/BGRABitmap/multishapeline.inc new file mode 100644 index 0000000..19ac4ef --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/multishapeline.inc @@ -0,0 +1,65 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception + begin + for k := 0 to NbShapeRows-1 do + with shapeRow[shapeRowsList[k]],shapes[shapeRowsList[k]] do + if densMinx <= densMaxx then + begin + if densMinx < minx then densMinx := minx; + if densMaxx > maxx then densMaxx := maxx; + + if texture <> nil then + begin + texture.ScanMoveTo(densMinx,yb); + ScanNextFunc := @texture.ScanNextPixel; + pdens := density+(densMinX-minx); + for xb := densMinx to densMaxx do + with sums[xb-minx] do + begin + if pdens^ <> 0 then + begin + ec := GammaExpansion(ScanNextFunc()); + {$ifdef PARAM_ANTIALIASINGFACTOR} + w := DivByAntialiasPrecision65536(pdens^ * ec.alpha); + {$else} + w := (pdens^ * ec.alpha) shr 16; + {$endif} + if w <> 0 then + begin + inc(sumR,ec.red*w); + inc(sumG,ec.green*w); + inc(sumB,ec.blue*w); + inc(sumA,w); + end; + end else + ScanNextFunc(); + inc(pdens); + end; + end else + begin + ec := color; + pdens := density+(densMinX-minx); + for xb := densMinx to densMaxx do + with sums[xb-minx] do + begin + if pdens^ <> 0 then + begin + {$ifdef PARAM_ANTIALIASINGFACTOR} + w := DivByAntialiasPrecision65536(pdens^ * ec.alpha); + {$else} + w := (pdens^ * ec.alpha) shr 16; + {$endif} + if w <> 0 then + begin + inc(sumR,ec.red*w); + inc(sumG,ec.green*w); + inc(sumB,ec.blue*w); + inc(sumA,w); + end; + end; + inc(pdens); + end; + end; + end; + + end +{$undef PARAM_ANTIALIASINGFACTOR} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/object3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/object3d.inc new file mode 100644 index 0000000..59ed8ad --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/object3d.inc @@ -0,0 +1,310 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{ TBGRAObject3D } + +procedure TBGRAObject3D.AddFace(AFace: IBGRAFace3D); +begin + if FFaceCount = length(FFaces) then + setlength(FFaces,FFaceCount*2+3); + FFaces[FFaceCount] := AFace; + inc(FFaceCount); +end; + +constructor TBGRAObject3D.Create(AScene: TBGRAScene3D); +begin + FColor := BGRAWhite; + FLight := 1; + FTexture := nil; + FMainPart := TBGRAPart3D.Create(self,nil); + FLightingNormal:= AScene.DefaultLightingNormal; + FParentLighting:= True; + FScene := AScene; + FFaceColorsInvalidated := true; + FMaterialInvalidated := false; +end; + +destructor TBGRAObject3D.Destroy; +begin + FMaterial := nil; + fillchar(FTexture,sizeof(FTexture),0); + inherited Destroy; +end; + +procedure TBGRAObject3D.Clear; +begin + FFaces := nil; + FFaceCount := 0; + FMainPart.Clear(True); +end; + +procedure TBGRAObject3D.InvalidateColor; +begin + FFaceColorsInvalidated := true; +end; + +procedure TBGRAObject3D.InvalidateMaterial; +begin + FMaterialInvalidated := true; +end; + +function TBGRAObject3D.GetColor: TBGRAPixel; +begin + result := FColor; +end; + +function TBGRAObject3D.GetLight: Single; +begin + result := FLight; +end; + +function TBGRAObject3D.GetTexture: IBGRAScanner; +begin + result := FTexture; +end; + +function TBGRAObject3D.GetMainPart: IBGRAPart3D; +begin + result := FMainPart; +end; + +procedure TBGRAObject3D.SetColor(const AValue: TBGRAPixel); +begin + FColor := AValue; + FTexture := nil; + InvalidateColor; +end; + +procedure TBGRAObject3D.SetLight(const AValue: Single); +begin + FLight := AValue; +end; + +procedure TBGRAObject3D.SetTexture(const AValue: IBGRAScanner); +begin + FTexture := AValue; + InvalidateMaterial; +end; + +procedure TBGRAObject3D.SetMaterial(const AValue: IBGRAMaterial3D); +begin + FMaterial := AValue; + InvalidateMaterial; +end; + +procedure TBGRAObject3D.RemoveUnusedVertices; +begin + GetMainPart.RemoveUnusedVertices; +end; + +procedure TBGRAObject3D.SeparatePart(APart: IBGRAPart3D); +var + vertexInfo: array of record + orig,dup: IBGRAVertex3D; + end; + + i,j: integer; + inPart,outPart: boolean; + idxV: integer; +begin + setlength(vertexInfo, APart.VertexCount); + for i := 0 to high(vertexInfo) do + with vertexInfo[i] do + begin + orig := APart.Vertex[i]; + dup := APart.Add(orig.SceneCoord_128); + end; + + for i := 0 to GetFaceCount-1 do + with GetFace(i) do + begin + inPart := false; + outPart := false; + for j := 0 to VertexCount-1 do + if (APart.IndexOf(Vertex[j]) <> -1) then + inPart := true + else + outPart := true; + + if inPart and not outPart then + begin + for j := 0 to VertexCount-1 do + begin + idxV := APart.IndexOf(Vertex[j]); + if idxV <> -1 then + Vertex[j] := vertexInfo[idxV].dup; + end; + end; + end; + + for i := APart.VertexCount-1 downto 0 do + APart.RemoveVertex(i); +end; + +function TBGRAObject3D.GetScene: TObject; +begin + result := FScene; +end; + +function TBGRAObject3D.GetRefCount: integer; +begin + result := RefCount; +end; + +procedure TBGRAObject3D.SetBiface(AValue: boolean); +var i: integer; +begin + for i := 0 to GetFaceCount-1 do + GetFace(i).Biface := AValue; +end; + +procedure TBGRAObject3D.ForEachVertex(ACallback: TVertex3DCallback); +begin + FMainPart.ForEachVertex(ACallback); +end; + +procedure TBGRAObject3D.ForEachFace(ACallback: TFace3DCallback); +var i: integer; +begin + for i := 0 to GetFaceCount-1 do + ACallback(GetFace(i)); +end; + +procedure TBGRAObject3D.Update; +var + i: Integer; +begin + if FParentLighting and (FLightingNormal <> FScene.DefaultLightingNormal) then + FLightingNormal := FScene.DefaultLightingNormal; + + if FFaceColorsInvalidated then + begin + for i := 0 to FFaceCount-1 do + FFaces[i].ComputeVertexColors; + FFaceColorsInvalidated := false; + end; + + if FMaterialInvalidated then + begin + for i := 0 to FFaceCount-1 do + FFaces[i].UpdateMaterial; + FMaterialInvalidated := false; + end; +end; + +function TBGRAObject3D.GetLightingNormal: TLightingNormal3D; +begin + result := FLightingNormal; +end; + +function TBGRAObject3D.GetParentLighting: boolean; +begin + result := FParentLighting; +end; + +procedure TBGRAObject3D.SetLightingNormal(const AValue: TLightingNormal3D); +begin + FLightingNormal := AValue; + FParentLighting:= False; +end; + +procedure TBGRAObject3D.SetParentLighting(const AValue: boolean); +begin + FParentLighting:= AValue; +end; + +procedure TBGRAObject3D.ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); +var + i: Integer; +begin + FMainPart.ComputeWithMatrix(AMatrix,AProjection); + for i := 0 to FFaceCount-1 do + FFaces[i].ComputeViewNormalAndCenter; + FMainPart.NormalizeViewNormal; +end; + +function TBGRAObject3D.AddFaceReversed(const AVertices: array of IBGRAVertex3D + ): IBGRAFace3D; +var + tempVertices: array of IBGRAVertex3D; + i: Integer; +begin + setlength(tempVertices,length(AVertices)); + for i := 0 to high(tempVertices) do + tempVertices[i] := AVertices[high(AVertices)-i]; + result := AddFace(tempVertices); +end; + +function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; +begin + result := TBGRAFace3D.Create(self,AVertices); + AddFace(result); +end; + +function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; + ABiface: boolean): IBGRAFace3D; +begin + result := TBGRAFace3D.Create(self,AVertices); + result.Biface := ABiface; + AddFace(result); +end; + +function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; +var Face: IBGRAFace3D; +begin + Face := TBGRAFace3D.Create(self,AVertices); + Face.Texture := ATexture; + AddFace(Face); + result := face; +end; + +function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; + AColor: TBGRAPixel): IBGRAFace3D; +var Face: IBGRAFace3D; +begin + Face := TBGRAFace3D.Create(self,AVertices); + Face.SetColor(AColor); + Face.Texture := nil; + AddFace(Face); + result := face; +end; + +function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; + AColors: array of TBGRAPixel): IBGRAFace3D; +var + i: Integer; +begin + if length(AColors) <> length(AVertices) then + raise Exception.Create('Dimension mismatch'); + result := TBGRAFace3D.Create(self,AVertices); + for i := 0 to high(AColors) do + result.VertexColor[i] := AColors[i]; + AddFace(result); +end; + +function TBGRAObject3D.GetFace(AIndex: integer): IBGRAFace3D; +begin + if (AIndex < 0) or (AIndex >= FFaceCount) then + raise Exception.Create('Index out of bounds'); + result := FFaces[AIndex]; +end; + +function TBGRAObject3D.GetFaceCount: integer; +begin + result := FFaceCount; +end; + +function TBGRAObject3D.GetTotalVertexCount: integer; +begin + result := GetMainPart.TotalVertexCount; +end; + +function TBGRAObject3D.GetTotalNormalCount: integer; +begin + result := GetMainPart.TotalNormalCount; +end; + +function TBGRAObject3D.GetMaterial: IBGRAMaterial3D; +begin + result := FMaterial; +end; + + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/paletteformats.inc b/vendor/kam_remake/src/ext/BGRABitmap/paletteformats.inc new file mode 100644 index 0000000..5687200 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/paletteformats.inc @@ -0,0 +1,643 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +var + PaletteFormats : array of record + formatIndex: TBGRAPaletteFormat; + ext: string; + description: string; + reader: TPaletteReaderProc; + writer: TPaletteWriterProc; + checkFormat: TCheckPaletteFormatProc; + end; + +const + GimpPaletteHeader : string = 'GIMP Palette'; + KOfficePaletteHeader : string = 'KDE RGB Palette'; + AdobeSwatchExchangeHeader : string = 'ASEF'; + JascPaletteHeader : string = 'JASC-PAL'; + PaintDotNetPaletteHeader : string = '; paint.net Palette File'; + PaintDotNetPaletteHeaderUTF8 : string = #$EF#$BB#$BF + '; paint.net Palette File'; + +procedure SaveToStreamAsPaintDotNet(APalette: TBGRAPalette; AStream: TStream); + + procedure WriteStr(s: string); + begin + AStream.WriteBuffer(s[1],length(S)); + end; + procedure WriteStrLn(s: string); + begin + WriteStr(s+#$0D#$0A); + end; + +var + i: Integer; + +begin + WriteStrLn(PaintDotNetPaletteHeaderUTF8); + for i := 0 to APalette.Count-1 do + with APalette.Color[i] do + WriteStrLn(IntToHex(alpha,2)+IntToHex(red,2)+IntToHex(green,2)+IntToHex(blue,2)); +end; + +procedure SaveToStreamAsGimp(APalette: TBGRAPalette; AStream: TStream); + procedure WriteStr(s: string); + begin + AStream.WriteBuffer(s[1],length(S)); + end; + procedure WriteStrLn(s: string); + begin + WriteStr(s+#$0A); + end; + + procedure WriteChannelValue(AValue: byte); + var s: string; + begin + s := IntToStr(AValue); + while length(s) < 3 do s := ' '+s; + WriteStr(s); + end; + +var + i: Integer; + +begin + WriteStrLn(GimpPaletteHeader); + WriteStrLn('Name: Palette'); + WriteStrLn('Columns: 3'); + WriteStrLn('#'); + for i := 0 to APalette.Count-1 do + with APalette.Color[i] do + begin + WriteChannelValue(red); + WriteStr(' '); + WriteChannelValue(green); + WriteStr(' '); + WriteChannelValue(blue); + WriteStrLn(#$09+BGRAToStr(APalette.Color[i],CSSColors)); + end; +end; + +procedure SaveToStreamAsAdobeSwatchExchange(APalette: TBGRAPalette; AStream: TStream); + procedure WriteStr(s: string); + begin + AStream.WriteBuffer(s[1],length(S)); + end; + procedure WriteInt32(AValue: Int32); + begin + AValue := NtoBE(AValue); + AStream.WriteBuffer(AValue,sizeof(AValue)); + end; + procedure WriteInt16(AValue: Int16); + begin + AValue := NtoBE(AValue); + AStream.WriteBuffer(AValue,sizeof(AValue)); + end; + procedure WriteSingle(AValue: Single); + begin + LongWord(AValue) := BEtoN(LongWord(AValue)); + AStream.WriteBuffer(AValue,sizeof(AValue)); + end; + procedure WriteBlock(ABlockType: Int16; AContentLength: Int32); overload; + begin + WriteInt16(ABlockType); + WriteInt32(AContentLength); + end; + + procedure WriteBlock(ABlockType: Int16; AName: string; AExtraContentLength: Int32); overload; + var contentLength: Int32; + wideName: UnicodeString; + nameBuf: array of byte; + i: Integer; + begin + wideName := UTF8Decode(AName); + setlength(nameBuf, (length(wideName)+1)*2); + contentLength:= AExtraContentLength + 2 + length(nameBuf); + WriteBlock(ABlockType, contentLength); + WriteInt16(length(nameBuf) shr 1); + for i := 1 to length(wideName) do + begin + nameBuf[((i-1) shl 1)] := ord(wideName[i]) shr 8; + nameBuf[((i-1) shl 1)+1] := ord(wideName[i]) and 255; + end; + AStream.WriteBuffer(nameBuf[0],length(namebuf)); + end; + +var + i: Integer; + +begin + WriteStr(AdobeSwatchExchangeHeader+#$00#$01+#$00#$00); + WriteInt32(APalette.Count+2); //number of blocks + WriteBlock($1c0, 'Palette', 0); //group start + for i := 0 to APalette.Count-1 do + with APalette.Color[i] do + begin + WriteBlock(1, BGRAToStr(APalette.Color[i],CSSColors), 4+4*3+2); + WriteStr('RGB '); + WriteSingle(red/255); + WriteSingle(green/255); + WriteSingle(blue/255); + WriteInt16(2); //normal + end; + WriteBlock($2c0, 0); //group end +end; + +procedure SaveToStreamAsKOffice(APalette: TBGRAPalette; AStream: TStream); + procedure WriteStr(s: string); + begin + AStream.WriteBuffer(s[1],length(S)); + end; + procedure WriteStrLn(s: string); + begin + WriteStr(s+#$0A); + end; + + procedure WriteChannelValue(AValue: byte); + begin + WriteStr(IntToStr(AValue)); + end; + +var + i: Integer; + +begin + WriteStrLn(KOfficePaletteHeader); + for i := 0 to APalette.Count-1 do + with APalette.Color[i] do + begin + WriteChannelValue(red); + WriteStr(' '); + WriteChannelValue(green); + WriteStr(' '); + WriteChannelValue(blue); + WriteStrLn(#$09+BGRAToStr(APalette.Color[i],CSSColors)); + end; +end; + +procedure SaveToStreamAsJasc(APalette: TBGRAPalette; AStream: TStream); + procedure WriteStr(s: string); + begin + AStream.WriteBuffer(s[1],length(S)); + end; + procedure WriteStrLn(s: string); + begin + WriteStr(s+#$0D#$0A); + end; + +var + i: Integer; + +begin + WriteStrLn(JascPaletteHeader); + WriteStrLn('0100'); + WriteStrLn(IntToStr(APalette.Count)); + for i := 0 to APalette.Count-1 do + with APalette.Color[i] do + WriteStrLn(IntToStr(red)+' '+IntToStr(green)+' '+IntToStr(blue)); +end; + +function LoadFromStreamAsPaintDotNet(APalette: TBGRAPalette; AStream: TStream): boolean; +var lines: TStringList; + header,s: string; + idxComment: integer; + code: integer; + hexArgb: int32; + i: Integer; +begin + result := false; + lines := TStringList.Create; + try + lines.LoadFromStream(AStream); + if lines.Count = 0 then + begin + lines.Free; + exit; + end; + header := lines[0]; + if (header <> PaintDotNetPaletteHeader) and (header <> PaintDotNetPaletteHeaderUTF8) then + begin + lines.Free; + exit; + end; + + for i := 0 to lines.Count-1 do + begin + s := lines[i]; + idxComment := pos(';',s); + if idxComment<>0 then s := copy(s,1,idxComment-1); + s := trim(s); + if length(s)> 0 then + begin + val('$'+s, hexArgb, code); + if code = 0 then + APalette.AddColor(BGRA((hexArgb shr 16) and 255, + (hexArgb shr 8) and 255, + hexArgb and 255, + (hexArgb shr 24) and 255)); + end; + end; + result := true; + finally + lines.Free; + end; +end; + +function LoadFromStreamAsGimp(APalette: TBGRAPalette; AStream: TStream): boolean; +var lines,line: TStringList; + s: string; + idxComment: integer; + code: integer; + c: TBGRAPixel; + i: Integer; +begin + result := false; + lines := TStringList.Create; + line := TStringList.Create; + try + lines.LoadFromStream(AStream); + if (lines.Count < 3) or (lines[0] <> GimpPaletteHeader) or + (copy(lines[1],1,6) <> 'Name: ') or + (copy(lines[2],1,9) <> 'Columns: ') then + begin + lines.Free; + line.Free; + exit; + end; + for i := 3 to lines.Count-1 do + begin + s := lines[i]; + idxComment := pos('#',s); + if idxComment<>0 then s := copy(s,1,idxComment-1); + s := trim(s); + if length(s)> 0 then + begin + line.CommaText := s; + if line.Count >= 3 then + begin + c.alpha:= 255; + val(line[0],c.red,code); + if code <> 0 then continue; + val(line[1],c.green,code); + if code <> 0 then continue; + val(line[2],c.blue,code); + if code <> 0 then continue; + APalette.AddColor(c); + end; + end; + end; + result := true; + finally + lines.Free; + line.Free; + end; +end; + +function clamp(AValue, AMax: integer): integer; +begin + if AValue < 0 then result := 0 else + if AValue > AMax then result := AMax else + result := AValue;; +end; + +function LabToRGB(L,a,b: single): TBGRAPixel; overload; +var r,g,blue: single; +begin + if a < 0 then + r := L + a + 0.5*b + else + r := L + 0.75*a + 0.5*b; + g := L - 0.5*a; + blue := L - b; + Result.red:= clamp(round((r)*255),255); + Result.green:= clamp(round((g)*255),255); + Result.blue:= clamp(round((blue)*255),255); + result.alpha := 255; +end; + +function LoadFromStreamAsAdobeSwatchExchange(APalette: TBGRAPalette; AStream: TStream): boolean; + function ReadInt16: int16; + begin + {$PUSH}{$HINTS OFF} + AStream.Read(result, sizeof(result)); + {$POP} + result := BEtoN(result); + end; + function ReadInt32: int32; + begin + {$PUSH}{$HINTS OFF} + AStream.Read(result, sizeof(result)); + {$POP} + result := BEtoN(result); + end; + function ReadStr(ALength: integer): string; + begin + setlength(result, ALength); + ALength := AStream.Read(result[1], ALength); + setlength(result, ALength); + end; + function ReadSingle: single; + begin + {$PUSH}{$HINTS OFF} + AStream.Read(Result, sizeof(result)); + {$POP} + LongWord(Result) := BEtoN(LongWord(Result)); + end; + function DblToByte(AValue: double): byte; + begin + if AValue < 0 then result := 0 + else if AValue > 1 then result := 255 else + result := round(AValue*255); + end; + +var header: string; + nbBlocks,blockSize: int32; + blockType,nameLength: int16; + nextPos: int64; + colorFormat: string; + colorF: TColorF; + i: Integer; +begin + result := false; + header := ReadStr(length(AdobeSwatchExchangeHeader)+4); + if header <> AdobeSwatchExchangeHeader+#$00#$01+#$00#$00 then exit; + nbBlocks := ReadInt32; + for i := 0 to nbBlocks-1 do + begin + blockType := ReadInt16; + blockSize := ReadInt32; + nextPos := AStream.Position + blockSize; + if blockType = 1 then + begin + nameLength := ReadInt16; + ReadStr(nameLength*2); + colorFormat := ReadStr(4); + if colorFormat = 'RGB ' then + begin + colorF[1] := ReadSingle; + colorF[2] := ReadSingle; + colorF[3] := ReadSingle; + colorF[4] := 1; + APalette.AddColor(BGRA(DblToByte(colorF[1]),DblToByte(colorF[2]),DblToByte(colorF[3]))); + ReadInt16; //ignore color type + end else + if colorFormat = 'CMYK' then + begin + colorF[1] := ReadSingle; + colorF[2] := ReadSingle; + colorF[3] := ReadSingle; + colorF[4] := ReadSingle; + + APalette.AddColor(BGRA(DblToByte(1 - colorF[1] + ColorF[2]/10 + ColorF[3]/10 - ColorF[4]), + DblToByte(1 - colorF[2] + ColorF[1]/10 + ColorF[3]/10 - ColorF[4]), + DblToByte(1 - colorF[3] + ColorF[1]/10 + ColorF[2]/10 - ColorF[4]))); + ReadInt16; //ignore color type + end else + if colorFormat = 'LAB ' then + begin + colorF[1] := ReadSingle; + colorF[2] := ReadSingle; + colorF[3] := ReadSingle; + colorF[4] := 1; + + APalette.AddColor(LabToRGB(colorF[1],colorF[2]/128,colorF[3]/128)); + ReadInt16; //ignore color type + end else + if colorFormat = 'GRAY' then + begin + colorF[1] := ReadSingle; + colorF[2] := colorF[1]; + colorF[3] := colorF[1]; + colorF[4] := 1; + APalette.AddColor(BGRA(DblToByte(colorF[1]),DblToByte(colorF[2]),DblToByte(colorF[3]))); + ReadInt16; //ignore color type + end; + end; + if AStream.Position<>nextPos then + AStream.Position:= nextPos; + end; + result := true; +end; + +function LoadFromStreamAsKOffice(APalette: TBGRAPalette; AStream: TStream): boolean; +var lines,line: TStringList; + s: string; + idxComment: integer; + code: integer; + c: TBGRAPixel; + i: Integer; +begin + result := false; + lines := TStringList.Create; + line := TStringList.Create; + try + lines.LoadFromStream(AStream); + if (lines.Count < 1) or (lines[0] <> KOfficePaletteHeader) then + begin + lines.Free; + line.Free; + exit; + end; + for i := 3 to lines.Count-1 do + begin + s := lines[i]; + idxComment := pos('#',s); + if idxComment<>0 then s := copy(s,1,idxComment-1); + s := trim(s); + if length(s)> 0 then + begin + line.CommaText := s; + if line.Count >= 3 then + begin + c.alpha:= 255; + val(line[0],c.red,code); + if code <> 0 then continue; + val(line[1],c.green,code); + if code <> 0 then continue; + val(line[2],c.blue,code); + if code <> 0 then continue; + APalette.AddColor(c); + end; + end; + end; + result := true; + finally + lines.Free; + line.Free; + end; +end; + +function LoadFromStreamAsJasc(APalette: TBGRAPalette; AStream: TStream): boolean; +var lines,line: TStringList; + s: string; + idxComment: integer; + code: integer; + c: TBGRAPixel; + i: Integer; +begin + result := false; + lines := TStringList.Create; + line := TStringList.Create; + try + lines.LoadFromStream(AStream); + if (lines.Count < 2) or (lines[0] <> JascPaletteHeader) or + (lines[1] <> '0100') then + begin + lines.Free; + line.Free; + exit; + end; + for i := 2 to lines.Count-1 do + begin + s := lines[i]; + idxComment := pos('#',s); + if idxComment<>0 then s := copy(s,1,idxComment-1); + s := trim(s); + if length(s)> 0 then + begin + line.CommaText := s; + if line.Count >= 3 then + begin + c.alpha:= 255; + val(line[0],c.red,code); + if code <> 0 then continue; + val(line[1],c.green,code); + if code <> 0 then continue; + val(line[2],c.blue,code); + if code <> 0 then continue; + APalette.AddColor(c); + end; + end; + end; + result := true; + finally + lines.Free; + line.Free; + end; +end; + +function CheckPaletteFormatAsJasc(ABuf256: string): boolean; +begin + result := (copy(ABuf256,1,length(JascPaletteHeader)+1) = JascPaletteHeader+#$0A) or + (copy(ABuf256,1,length(JascPaletteHeader)+2) = JascPaletteHeader+#$0D#$0A); +end; + +function CheckPaletteFormatAsGimp(ABuf256: string): boolean; +begin + result := (copy(ABuf256,1,length(GimpPaletteHeader)+1) = GimpPaletteHeader+#$0A) or + (copy(ABuf256,1,length(GimpPaletteHeader)+2) = GimpPaletteHeader+#$0D#$0A); +end; + +function CheckPaletteFormatAsKOffice(ABuf256: string): boolean; +begin + result := (copy(ABuf256,1,length(KOfficePaletteHeader)+1) = KOfficePaletteHeader+#$0A) or + (copy(ABuf256,1,length(KOfficePaletteHeader)+2) = KOfficePaletteHeader+#$0D#$0A); +end; + +function CheckPaletteFormatAsPaintDotNet(ABuf256: string): boolean; +begin + result := (copy(ABuf256,1,length(PaintDotNetPaletteHeader)+1) = PaintDotNetPaletteHeader+#$0A) or + (copy(ABuf256,1,length(PaintDotNetPaletteHeader)+2) = PaintDotNetPaletteHeader+#$0D#$0A) or + (copy(ABuf256,1,length(PaintDotNetPaletteHeaderUTF8)+1) = PaintDotNetPaletteHeaderUTF8+#$0A) or + (copy(ABuf256,1,length(PaintDotNetPaletteHeaderUTF8)+2) = PaintDotNetPaletteHeaderUTF8+#$0D#$0A); +end; + +function CheckPaletteFormatAsAdobeSwatchExchange(ABuf256: string): boolean; +begin + result := copy(ABuf256,1,length(AdobeSwatchExchangeHeader)) = AdobeSwatchExchangeHeader; +end; + + +procedure RegisterDefaultPaletteFormats; forward; + +procedure BGRARegisterPaletteFormat(AFormatIndex: TBGRAPaletteFormat; AExtension: string; + ADescription: string; AReadProc: TPaletteReaderProc; AWriteProc: TPaletteWriterProc; + ACheckFormatProc: TCheckPaletteFormatProc); +var + i: Integer; +begin + RegisterDefaultPaletteFormats; + if AFormatIndex = palUnknown then + raise Exception.Create('Invalid format index'); + for i := 0 to high(PaletteFormats) do + if PaletteFormats[i].formatIndex = AFormatIndex then + with PaletteFormats[i] do + begin + ext := AExtension; + description := ADescription; + reader := AReadProc; + writer := AWriteProc; + checkFormat := ACheckFormatProc; + exit; + end; + setlength(PaletteFormats,length(PaletteFormats)+1); + with PaletteFormats[high(PaletteFormats)] do + begin + formatIndex:= AFormatIndex; + ext := AExtension; + description := ADescription; + reader := AReadProc; + writer := AWriteProc; + checkFormat := ACheckFormatProc; + end; +end; + +function BGRARegisteredPaletteFormatFilter(AAllSupportedDescription: string): string; +var allExt: TStringList; + allDesc: string; + i: Integer; +begin + result := ''; + RegisterDefaultPaletteFormats; + allExt := TStringList.Create; + allExt.CaseSensitive := false; + for i := 0 to high(PaletteFormats) do + with PaletteFormats[i] do + begin + if allExt.IndexOf(ext) = -1 then allExt.Add(ext); + if length(result)>0 then AppendStr(result, '|'); + AppendStr(result, description + ' (*'+ext+')|*'+ext); + end; + if allExt.Count > 0 then + begin + allDesc := AAllSupportedDescription + ' ('; + for i := 0 to allExt.count-1 do + begin + if i > 0 then + AppendStr(allDesc, '; '); + AppendStr(allDesc, '*' + allExt[i]); + end; + AppendStr(allDesc, ')'); + AppendStr(allDesc, '|'); + for i := 0 to allExt.count-1 do + begin + if i > 0 then + AppendStr(allDesc, '; '); + AppendStr(allDesc, '*' + allExt[i]); + end; + result := allDesc + '|' + result; + end; + allExt.Free; +end; + +var DefaultPaletteFormatsRegistered: boolean; + +procedure RegisterDefaultPaletteFormats; +begin + if DefaultPaletteFormatsRegistered then exit; + DefaultPaletteFormatsRegistered := true; + BGRARegisterPaletteFormat(palPaintDotNet, '.txt', 'Paint.NET', + @LoadFromStreamAsPaintDotNet, @SaveToStreamAsPaintDotNet, + @CheckPaletteFormatAsPaintDotNet); + BGRARegisterPaletteFormat(palGimp, '.gpl', 'GIMP', + @LoadFromStreamAsGimp, @SaveToStreamAsGimp, + @CheckPaletteFormatAsGimp); + BGRARegisterPaletteFormat(palAdobeSwatchExchange, '.ase', 'Adobe Swatch Exchange', + @LoadFromStreamAsAdobeSwatchExchange, @SaveToStreamAsAdobeSwatchExchange, + @CheckPaletteFormatAsAdobeSwatchExchange); + BGRARegisterPaletteFormat(palKOffice, '.colors', 'KOffice', + @LoadFromStreamAsKOffice, @SaveToStreamAsKOffice, + @CheckPaletteFormatAsKOffice); + BGRARegisterPaletteFormat(palJascPSP, '.pal', 'Jasc Paint Shop Pro', + @LoadFromStreamAsJasc, @SaveToStreamAsJasc, + @CheckPaletteFormatAsJasc); +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/part3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/part3d.inc new file mode 100644 index 0000000..755d435 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/part3d.inc @@ -0,0 +1,581 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + { TBGRAPart3D } + + TBGRAPart3D = class(TInterfacedObject,IBGRAPart3D) + private + FVertices: array of IBGRAVertex3D; + FVertexCount: integer; + FNormals: array of IBGRANormal3D; + FNormalCount: integer; + FMatrix: TMatrix3D; + FParts: array of IBGRAPart3D; + FPartCount: integer; + FContainer: IBGRAPart3D; + FCoordPool: TBGRACoordPool3D; + FNormalPool: TBGRANormalPool3D; + FObject3D: TBGRAObject3D; + public + constructor Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D); + destructor Destroy; override; + procedure Clear(ARecursive: boolean); + function Add(x,y,z: single): IBGRAVertex3D; overload; + function Add(pt: TPoint3D): IBGRAVertex3D; overload; + function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload; + function Add(pt: TPoint3D_128): IBGRAVertex3D; overload; + function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload; + function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload; + function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload; + function Add(const pts: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload; + procedure Add(const pts: array of IBGRAVertex3D); overload; + procedure Add(AVertex: IBGRAVertex3D); overload; + function AddNormal(x,y,z: single): IBGRANormal3D; overload; + function AddNormal(pt: TPoint3D): IBGRANormal3D; overload; + function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload; + procedure AddNormal(ANormal: IBGRANormal3D); overload; + procedure RemoveVertex(Index: integer); + procedure RemoveNormal(Index: integer); + function GetBoundingBox: TBox3D; + function GetRadius: single; + function GetMatrix: TMatrix3D; + function GetPart(AIndex: Integer): IBGRAPart3D; + function GetPartCount: integer; + function GetVertex(AIndex: Integer): IBGRAVertex3D; + function GetVertexCount: integer; + function GetNormal(AIndex: Integer): IBGRANormal3D; + function GetNormalCount: integer; + function GetTotalVertexCount: integer; + function GetTotalNormalCount: integer; + function GetContainer: IBGRAPart3D; + procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); + procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); + procedure ResetTransform; + procedure Translate(x,y,z: single; Before: boolean = true); overload; + procedure Translate(ofs: TPoint3D; Before: boolean = true); overload; + procedure Scale(size: single; Before: boolean = true); overload; + procedure Scale(x,y,z: single; Before: boolean = true); overload; + procedure Scale(size: TPoint3D; Before: boolean = true); overload; + procedure RotateXDeg(angle: single; Before: boolean = true); + procedure RotateYDeg(angle: single; Before: boolean = true); + procedure RotateZDeg(angle: single; Before: boolean = true); + procedure RotateXRad(angle: single; Before: boolean = true); + procedure RotateYRad(angle: single; Before: boolean = true); + procedure RotateZRad(angle: single; Before: boolean = true); + procedure SetMatrix(const AValue: TMatrix3D); + procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); + function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; + procedure NormalizeViewNormal; + function CreatePart: IBGRAPart3D; + procedure LookAt(ALookWhere,ATopDir: TPoint3D); + procedure RemoveUnusedVertices; + function IndexOf(AVertex: IBGRAVertex3D): integer; + procedure ForEachVertex(ACallback: TVertex3DCallback); + end; + +{ TBGRAPart3D } + +procedure TBGRAPart3D.LookAt(ALookWhere,ATopDir: TPoint3D); +var ZDir, XDir, YDir: TPoint3D_128; + ViewPoint: TPoint3D_128; + CurPart: IBGRAPart3D; + ComposedMatrix: TMatrix3D; +begin + YDir := -Point3D_128(ATopDir); + if IsPoint3D_128_Zero(YDir) then exit; + Normalize3D_128(YDir); + + ComposedMatrix := FMatrix; + CurPart := self.FContainer; + while CurPart <> nil do + begin + ComposedMatrix := CurPart.Matrix*ComposedMatrix; + CurPart := CurPart.Container; + end; + ViewPoint := ComposedMatrix*Point3D_128_Zero; + + ZDir := Point3D_128(ALookWhere)-ViewPoint; + if IsPoint3D_128_Zero(ZDir) then exit; + Normalize3D_128(ZDir); + + VectProduct3D_128(YDir,ZDir,XDir); + VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir + + FMatrix := Matrix3D(XDir,YDir,ZDir,ViewPoint); + ComposedMatrix := MatrixIdentity3D; + CurPart := self.FContainer; + while CurPart <> nil do + begin + ComposedMatrix := CurPart.Matrix*ComposedMatrix; + CurPart := CurPart.Container; + end; + FMatrix := MatrixInverse3D(ComposedMatrix)*FMatrix; +end; + +procedure TBGRAPart3D.RemoveUnusedVertices; +var + i: Integer; +begin + for i := FVertexCount-1 downto 0 do + if FVertices[i].Usage <= 2 then RemoveVertex(i); + for i := 0 to FPartCount-1 do + FParts[i].RemoveUnusedVertices; +end; + +function TBGRAPart3D.IndexOf(AVertex: IBGRAVertex3D): integer; +var i: integer; +begin + for i := 0 to FVertexCount-1 do + if FVertices[i] = AVertex then + begin + result := i; + exit; + end; + result := -1; +end; + +procedure TBGRAPart3D.ForEachVertex(ACallback: TVertex3DCallback); +var i: integer; +begin + for i := 0 to FVertexCount-1 do + ACallback(FVertices[i]); +end; + +procedure TBGRAPart3D.Add(AVertex: IBGRAVertex3D); +begin + if FVertexCount = length(FVertices) then + setlength(FVertices, FVertexCount*2+3); + FVertices[FVertexCount] := AVertex; + inc(FVertexCount); +end; + +function TBGRAPart3D.AddNormal(x, y, z: single): IBGRANormal3D; +begin + if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); + result := TBGRANormal3D.Create(FNormalPool,Point3D_128(x,y,z)); + AddNormal(result); +end; + +function TBGRAPart3D.AddNormal(pt: TPoint3D): IBGRANormal3D; +begin + if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); + result := TBGRANormal3D.Create(FNormalPool,pt); + AddNormal(result); +end; + +function TBGRAPart3D.AddNormal(pt: TPoint3D_128): IBGRANormal3D; +begin + if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); + result := TBGRANormal3D.Create(FNormalPool,pt); + AddNormal(result); +end; + +procedure TBGRAPart3D.AddNormal(ANormal: IBGRANormal3D); +begin + if FNormalCount = length(FNormals) then + setlength(FNormals, FNormalCount*2+3); + FNormals[FNormalCount] := ANormal; + inc(FNormalCount); +end; + +procedure TBGRAPart3D.RemoveVertex(Index: integer); +var i: integer; +begin + if (Index >= 0) and (Index < FVertexCount) then + begin + for i := Index to FVertexCount-2 do + FVertices[i] := FVertices[i+1]; + FVertices[FVertexCount-1] := nil; + dec(FVertexCount); + end; +end; + +procedure TBGRAPart3D.RemoveNormal(Index: integer); +var i: integer; +begin + if (Index >= 0) and (Index < FNormalCount) then + begin + for i := Index to FNormalCount-2 do + FNormals[i] := FNormals[i+1]; + FNormals[FNormalCount-1] := nil; + dec(FNormalCount); + end; +end; + +function TBGRAPart3D.GetRadius: single; +var i: integer; + pt: TPoint3D_128; + d: single; +begin + result := 0; + for i := 0 to GetVertexCount-1 do + begin + pt := GetVertex(i).SceneCoord_128; + d:= sqrt(DotProduct3D_128(pt,pt)); + if d > result then result := d; + end; +end; + +constructor TBGRAPart3D.Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D); +begin + FObject3D := AObject3D; + FContainer := AContainer; + FMatrix := MatrixIdentity3D; + FCoordPool := TBGRACoordPool3D.Create(4); + FNormalPool := nil; + FNormalCount:= 0; + FVertexCount := 0; +end; + +destructor TBGRAPart3D.Destroy; +begin + FVertices := nil; + FVertexCount := 0; + if FCoordPool.UsedCapacity > 0 then + raise Exception.Create('Coordinate pool still used. Please set vertex references to nil before destroying the scene.'); + FreeAndNil(FCoordPool); + if Assigned(FNormalPool) then + begin + if FNormalPool.UsedCapacity > 0 then + raise Exception.Create('Normal pool still used'); + FreeAndNil(FNormalPool); + end; + inherited Destroy; +end; + +procedure TBGRAPart3D.Clear(ARecursive: boolean); +var i: integer; +begin + FVertices := nil; + FVertexCount := 0; + FNormals := nil; + FNormalCount := 0; + if ARecursive then + begin + for i := 0 to FPartCount-1 do + FParts[i].Clear(ARecursive); + FParts := nil; + FPartCount := 0; + end; +end; + +function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D; +begin + result := TBGRAVertex3D.Create(FObject3D,FCoordPool,Point3D(x,y,z)); + Add(result); +end; + +function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D; +begin + result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); + Add(result); +end; + +function TBGRAPart3D.Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; +begin + result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); + result.CustomNormal := normal; + Add(result); +end; + +function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D; +begin + result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); + Add(result); +end; + +function TBGRAPart3D.Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; +begin + result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); + result.CustomNormal := Point3D(normal); + Add(result); +end; + +function TBGRAPart3D.Add(const coords: array of single + ): arrayOfIBGRAVertex3D; +var pts: array of TPoint3D; + CoordsIdx: integer; + i: Integer; +begin + if length(coords) mod 3 <> 0 then + raise exception.Create('Array size must be a multiple of 3'); + setlength(pts, length(coords) div 3); + coordsIdx := 0; + for i := 0 to high(pts) do + begin + pts[i] := Point3D(coords[CoordsIdx],coords[CoordsIdx+1],coords[CoordsIdx+2]); + inc(coordsIdx,3); + end; + result := Add(pts); +end; + +function TBGRAPart3D.Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; +var + i: Integer; +begin + setlength(result, length(pts)); + for i := 0 to high(pts) do + result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]); + Add(result); +end; + +function TBGRAPart3D.Add(const pts: array of TPoint3D_128 + ): arrayOfIBGRAVertex3D; +var + i: Integer; +begin + setlength(result, length(pts)); + for i := 0 to high(pts) do + result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]); + Add(result); +end; + +procedure TBGRAPart3D.Add(const pts: array of IBGRAVertex3D); +var + i: Integer; +begin + if FVertexCount + length(pts) > length(FVertices) then + setlength(FVertices, (FVertexCount*2 + length(pts))+1); + for i := 0 to high(pts) do + begin + FVertices[FVertexCount] := pts[i]; + inc(FVertexCount); + end; +end; + +function TBGRAPart3D.GetBoundingBox: TBox3D; +var i: integer; + pt: TPoint3D_128; +begin + if GetVertexCount > 0 then + begin + result.min := GetVertex(0).SceneCoord; + result.max := result.min; + end else + begin + result.min := Point3D(0,0,0); + result.max := Point3D(0,0,0); + exit; + end; + for i := 1 to GetVertexCount-1 do + begin + pt := GetVertex(i).SceneCoord_128; + if pt.x < result.min.x then result.min.x := pt.x else + if pt.x > result.max.x then result.max.x := pt.x; + if pt.y < result.min.y then result.min.y := pt.y else + if pt.y > result.max.y then result.max.y := pt.y; + if pt.z < result.min.z then result.min.z := pt.z else + if pt.z > result.max.z then result.max.z := pt.z; + end; +end; + +function TBGRAPart3D.GetMatrix: TMatrix3D; +begin + result := FMatrix; +end; + +function TBGRAPart3D.GetPart(AIndex: Integer): IBGRAPart3D; +begin + if (AIndex < 0) or (AIndex >= FPartCount) then + raise ERangeError.Create('Index of out bounds'); + result := FParts[AIndex]; +end; + +function TBGRAPart3D.GetPartCount: integer; +begin + result := FPartCount; +end; + +function TBGRAPart3D.GetVertex(AIndex: Integer): IBGRAVertex3D; +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise ERangeError.Create('Index of out bounds'); + result := FVertices[AIndex]; +end; + +function TBGRAPart3D.GetVertexCount: integer; +begin + result := FVertexCount; +end; + +function TBGRAPart3D.GetNormal(AIndex: Integer): IBGRANormal3D; +begin + if (AIndex < 0) or (AIndex >= FNormalCount) then + raise ERangeError.Create('Index of out bounds'); + result := FNormals[AIndex]; +end; + +function TBGRAPart3D.GetNormalCount: integer; +begin + result := FNormalCount; +end; + +function TBGRAPart3D.GetTotalVertexCount: integer; +var i: integer; +begin + result := GetVertexCount; + for i := 0 to GetPartCount-1 do + inc(result, GetPart(i).GetTotalVertexCount); +end; + +function TBGRAPart3D.GetTotalNormalCount: integer; +var i: integer; +begin + result := GetNormalCount; + for i := 0 to GetPartCount-1 do + inc(result, GetPart(i).GetTotalNormalCount); +end; + +procedure TBGRAPart3D.ResetTransform; +begin + FMatrix := MatrixIdentity3D; +end; + +procedure TBGRAPart3D.Scale(size: single; Before: boolean = true); +begin + Scale(size,size,size,Before); +end; + +procedure TBGRAPart3D.Scale(x, y, z: single; Before: boolean = true); +begin + Scale(Point3D(x,y,z),Before); +end; + +procedure TBGRAPart3D.Scale(size: TPoint3D; Before: boolean = true); +begin + if Before then + FMatrix := FMatrix * MatrixScale3D(size) + else + FMatrix := MatrixScale3D(size)*FMatrix; +end; + +procedure TBGRAPart3D.RotateXDeg(angle: single; Before: boolean = true); +begin + RotateXRad(-angle*Pi/180, Before); +end; + +procedure TBGRAPart3D.RotateYDeg(angle: single; Before: boolean = true); +begin + RotateYRad(-angle*Pi/180, Before); +end; + +procedure TBGRAPart3D.RotateZDeg(angle: single; Before: boolean = true); +begin + RotateZRad(-angle*Pi/180, Before); +end; + +procedure TBGRAPart3D.RotateXRad(angle: single; Before: boolean = true); +begin + if Before then + FMatrix := FMatrix * MatrixRotateX(angle) + else + FMatrix := MatrixRotateX(angle) * FMatrix; +end; + +procedure TBGRAPart3D.RotateYRad(angle: single; Before: boolean = true); +begin + if Before then + FMatrix := FMatrix * MatrixRotateY(angle) + else + FMatrix := MatrixRotateY(angle) * FMatrix; +end; + +procedure TBGRAPart3D.RotateZRad(angle: single; Before: boolean = true); +begin + if Before then + FMatrix := FMatrix * MatrixRotateZ(angle) + else + FMatrix := MatrixRotateZ(angle) * FMatrix; +end; + +procedure TBGRAPart3D.SetMatrix(const AValue: TMatrix3D); +begin + FMatrix := AValue; +end; + +{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607 +procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); +var + i: Integer; + Composed: TMatrix3D; +begin + Composed := AMatrix* self.FMatrix; + FCoordPool.ComputeWithMatrix(Composed, AProjection); + if Assigned(FNormalPool) then FNormalPool.ComputeWithMatrix(Composed); + for i := 0 to FPartCount-1 do + FParts[i].ComputeWithMatrix(Composed,AProjection); +end; +{$POP} + +function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; +var part: IBGRAPart3D; + newViewCoord: TPoint3D_128; + InvZ: single; +begin + newViewCoord := FMatrix * ASceneCoord; + part := FContainer; + while part <> nil do + begin + newViewCoord := part.Matrix * newViewCoord; + part := part.Container; + end; + if NewViewCoord.z > 0 then + begin + InvZ := 1/NewViewCoord.z; + result := PointF(NewViewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, + NewViewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); + end else + result := PointF(0,0); +end; + +procedure TBGRAPart3D.NormalizeViewNormal; +var + i: Integer; +begin + for i := 0 to FVertexCount-1 do + FVertices[i].NormalizeViewNormal; + for i := 0 to FPartCount-1 do + FParts[i].NormalizeViewNormal; +end; + +procedure TBGRAPart3D.Translate(x, y, z: single; Before: boolean = true); +begin + Translate(Point3D(x,y,z),Before); +end; + +procedure TBGRAPart3D.Translate(ofs: TPoint3D; Before: boolean = true); +begin + if Before then + FMatrix := FMatrix * MatrixTranslation3D(ofs) + else + FMatrix := MatrixTranslation3D(ofs)*FMatrix; +end; + +function TBGRAPart3D.CreatePart: IBGRAPart3D; +begin + if FPartCount = length(FParts) then + setlength(FParts, FPartCount*2+1); + result := TBGRAPart3D.Create(FObject3D,self); + FParts[FPartCount] := result; + inc(FPartCount); +end; + +function TBGRAPart3D.GetContainer: IBGRAPart3D; +begin + result := FContainer; +end; + +procedure TBGRAPart3D.SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); +begin + if (AIndex < 0) or (AIndex >= FVertexCount) then + raise ERangeError.Create('Index of out bounds'); + FVertices[AIndex] := AValue; +end; + +procedure TBGRAPart3D.SetNormal(AIndex: Integer; AValue: IBGRANormal3D); +begin + if (AIndex < 0) or (AIndex >= FNormalCount) then + raise ERangeError.Create('Index of out bounds'); + FNormals[AIndex] := AValue; +end; + + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/perspectivecolorscan.inc b/vendor/kam_remake/src/ext/BGRABitmap/perspectivecolorscan.inc new file mode 100644 index 0000000..1355626 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/perspectivecolorscan.inc @@ -0,0 +1,104 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception + {$IFDEF PARAM_USESSE} {$asmmode intel} + minVal := 0; + maxVal := 65535; + asm + movss xmm6, invZ + shufps xmm6,xmm6,0 //xmm6 = invZ + movss xmm7, invZStep + shufps xmm7,xmm7,0 //xmm7 = invZStep + movups xmm4, colorPos + movups xmm5, colorStep + + movss xmm2, minVal + shufps xmm2,xmm2,0 //xmm2 = minVal + movss xmm3, maxVal + shufps xmm3,xmm3,0 //xmm3 = maxVal + end; + + for i := ix1 to ix2 do + begin + {$IFDEF PARAM_USEZBUFFER} + if invZ > zbufferpos^ then + {$ENDIF} + begin + {$IFDEF PARAM_USEZBUFFER} + zbufferpos^ := invz; + {$ENDIF} + asm + movaps xmm0,xmm6 + rcpps xmm0,xmm0 + mulps xmm0, xmm4 + minps xmm0, xmm3 + maxps xmm0, xmm2 + {$IFDEF PARAM_USESSE2} + cvtps2dq xmm0,xmm0 + movups cInt, xmm0 + {$ELSE} + movups colorPosByZ, xmm0 + {$ENDIF} + end; + {$IFDEF PARAM_USESSE2} + c.red := GammaCompressionTab[cInt.r]; + c.green := GammaCompressionTab[cInt.g]; + c.blue := GammaCompressionTab[cInt.b]; + c.alpha := GammaCompressionTab[cInt.a]; + DrawPixelInlineWithAlphaCheck(pdest, c); + {$ELSE} + ec.red := round(colorPosByZ[1]); + ec.green := round(colorPosByZ[2]); + ec.blue := round(colorPosByZ[3]); + ec.alpha := round(colorPosByZ[4]); + DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); + {$ENDIF} + end; + asm + addps xmm6,xmm7 + addps xmm4,xmm5 + {$IFDEF PARAM_USEZBUFFER} + movss invZ,xmm6 + {$ENDIF} + end; + inc(pdest); + {$IFDEF PARAM_USEZBUFFER} + inc(zbufferpos); + {$ENDIF} + end; + {$ELSE} + for i := ix1 to ix2 do + begin + {$IFDEF PARAM_USEZBUFFER} + if invZ > zbufferpos^ then + {$ENDIF} + begin + {$IFDEF PARAM_USEZBUFFER} + zbufferpos^ := invz; + {$ENDIF} + z := 1/invZ; + r := round(z*colorPos[1]); + g := round(z*colorPos[2]); + b := round(z*colorPos[3]); + a := round(z*colorPos[4]); + if r < 0 then ec.red := 0 else + if r > 65535 then ec.red := 65535 + else ec.red := r; + if g < 0 then ec.green := 0 else + if g > 65535 then ec.green := 65535 + else ec.green := g; + if b < 0 then ec.blue := 0 else + if b > 65535 then ec.blue := 65535 + else ec.blue := b; + if a < 0 then ec.alpha := 0 else + if a > 65535 then ec.alpha := 65535 + else ec.alpha := a; + DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); + end; + colorPos := colorPos + colorStep; + IncF(invZ, invZStep); + inc(pdest); + {$IFDEF PARAM_USEZBUFFER} + inc(zbufferpos); + {$ENDIF} + end; + {$ENDIF} + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan.inc b/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan.inc new file mode 100644 index 0000000..ac9686f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan.inc @@ -0,0 +1,168 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$i bgrasse.inc} + + var + //loop variables + pdest: PBGRAPixel; + i: LongInt; + + InvXLen: single; //inverse of horizontal length in pixels + t: single; //initial horizontal position in [0..1] + {$IFNDEF PARAM_USESOLIDCOLOR} + texPosByZ: TPointF; + intTexPos: packed record + x,y: integer; + end; + texPos: TPoint3D_128; //texture start position + {$ENDIF} + InvZPos: single; //Z: depth start position + + {$IFNDEF PARAM_USESOLIDCOLOR} + texStep: TPoint3D_128; //texture step + {$ENDIF} + zStep: single; //depth step + + {$IFNDEF PARAM_USESOLIDCOLOR} + texVect: TPointF; //texture vector between start and end of line + {$ENDIF} + zLen: single; //depth difference + {$IFDEF PARAM_USESHADER} + tempVect3D: TPoint3D_128; + {$ENDIF} + + {$IFNDEF PARAM_USESOLIDCOLOR} + {$DEFINE PARAM_USEZPOS} + {$ENDIF} + {$IFDEF PARAM_USESHADER} + {$DEFINE PARAM_USEZPOS} + {$ENDIF} + + {$IFDEF PARAM_USEZPOS} + zPos: single; + {$ENDIF} + + {$IFDEF PARAM_USEZBUFFER} + pzbuffer: PSingle; + {$ENDIF} + + {$IFDEF PARAM_USELIGHTING} + light,lightStep,lightDiff,lightAcc,lightMod: word; + lightLen: integer; + + procedure NextLight; inline; + begin + light := (light+lightStep) and 65535; + inc(lightAcc,lightDiff); + if lightAcc >= lightMod then + begin + dec(lightAcc,lightMod); + light := (light + 1) and 65535; + end; + end; + {$ENDIF} + + begin + InvXLen := 1/(info2.interX - info1.interX); + t := ((ix1+0.5)-info1.interX)*InvXLen; + + {$IFNDEF PARAM_USESOLIDCOLOR} + texVect := info2.texCoordDivByZ-info1.texCoordDivByZ; + texPos := Point3D_128(info1.texCoordDivByZ + texVect*t); + texStep := Point3D_128(texVect*InvXLen); + {$ENDIF} + zLen := info2.coordInvZ-info1.coordInvZ; + InvZPos := info1.coordInvZ+t*zLen; + zStep := zLen*InvXLen; + + {$IFDEF PARAM_USESHADER} + tempVect3D := info2.Position3D - info1.Position3D; + ShaderContext^.PositionInvZ := info1.Position3D + tempVect3D*t; + ShaderContext^.PositionStepInvZ := tempVect3D*InvXLen; + + tempVect3D := info2.Normal3D - info1.Normal3D; + ShaderContext^.NormalInvZ := info1.Normal3D + tempVect3D*t; + ShaderContext^.NormalStepInvZ := tempVect3D*InvXLen; + {$endif} + + pdest := bmp.ScanLine[yb]+ix1; + {$IFDEF PARAM_USEZBUFFER} + pzbuffer := zbuffer + yb*bmp.Width + ix1; + {$ENDIF} + + {$IFDEF PARAM_USELIGHTING} + if ix2 = ix1 then + begin + light := (info1.lightness+info2.lightness) div 2; + lightStep := 0; + lightDiff := 0; + lightMod := 1; + end + else + begin + light := info1.lightness; + lightLen := info2.lightness-info1.lightness; + if lightLen >= 0 then + begin + lightStep := lightLen div (ix2-ix1); + lightMod := ix2-ix1; + lightDiff := lightLen - lightStep*(ix2-ix1); + end else + begin + lightStep := (-lightLen+(ix2-ix1-1)) div (ix2-ix1); + lightMod := ix2-ix1; + lightDiff := lightLen + lightStep*(ix2-ix1); + lightStep := 65536 - lightStep; + end; + end; + lightAcc := lightDiff div 2; + {$ENDIF} + + {$IFDEF BGRASSE_AVAILABLE} + if UseSSE then + begin + {$DEFINE PARAM_USESSE} + if UseSSE3 then + begin + {$DEFINE PARAM_USESSE3} + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i perspectivescan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i perspectivescan2.inc} + end; + {$UNDEF PARAM_USESSE3} + end else + begin + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i perspectivescan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i perspectivescan2.inc} + end; + end; + {$UNDEF PARAM_USESSE} + end else + {$ENDIF} + begin + if WithInterpolation then + begin + {$DEFINE PARAM_USEINTERPOLATION} + {$i perspectivescan2.inc} + {$UNDEF PARAM_USEINTERPOLATION} + end else + begin + {$i perspectivescan2.inc} + end; + end; + end; +{$undef PARAM_USELIGHTING} +{$undef PARAM_USESHADER} +{$undef PARAM_USESOLIDCOLOR} +{$undef PARAM_USEZBUFFER} +{$undef PARAM_USEZPOS} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan2.inc b/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan2.inc new file mode 100644 index 0000000..87d80f9 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/perspectivescan2.inc @@ -0,0 +1,205 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$i bgrasse.inc} + +{$ifdef BGRASSE_AVAILABLE}{$asmmode intel}{$endif} + {$IFDEF PARAM_USESSE} + asm + {$IFDEF PARAM_USESHADER} + {$IFDEF cpux86_64} + mov rax, ShaderContext + movaps xmm2, [rax+32] //positionInvZ + movaps xmm3, [rax+48] //normalInvZ + {$ELSE} + mov eax, ShaderContext + movaps xmm2, [eax+32] //positionInvZ + movaps xmm3, [eax+48] //normalInvZ + {$ENDIF} + {$ENDIF} + {$IFNDEF PARAM_USESOLIDCOLOR} + xorps xmm5,xmm5 + movlps xmm5, texPos + {$ENDIF} + end; + {$ENDIF} + for i := ix1 to ix2 do + begin + {$IFDEF PARAM_USESSE} + {$IFDEF PARAM_USEZBUFFER} + if InvZPos > pzbuffer^ then + begin + pzbuffer^ := InvZPos; + {$ENDIF} + asm + movss xmm4, InvZPos + rcpss xmm4,xmm4 //zPos + shufps xmm4,xmm4,0 //broadcast + + {$IFDEF PARAM_USESHADER} + {$ifdef cpux86_64} + mov rax, ShaderContext + {$else} + mov eax, ShaderContext + {$endif} + + mulps xmm2, xmm4 //positionInvZ*zPos (A) + mulps xmm3, xmm4 //normalInvZ*zPos + {$ifdef cpux86_64} + movaps [rax+0], xmm2 //(A) Position + {$else} + movaps [eax+0], xmm2 //(A) Position + {$endif} + + //normalize + movaps xmm1, xmm3 + mulps xmm3, xmm3 + + {$IFDEF PARAM_USESSE3} + haddps xmm3,xmm3 + haddps xmm3,xmm3 + {$ELSE} + //mix1 + movaps xmm7, xmm3 + shufps xmm7, xmm7, $4e + addps xmm3, xmm7 + //mix2 + movaps xmm7, xmm3 + shufps xmm7, xmm7, $11 + addps xmm3, xmm7 + {$ENDIF} + + xorps xmm7,xmm7 + comiss xmm3,xmm7 + jna @skipnormal + + rsqrtps xmm3,xmm3 + mulps xmm3, xmm1 //apply + @skipnormal: + + {$ifdef cpux86_64} + movaps [rax+16], xmm3 //Normal + {$else} + movaps [eax+16], xmm3 //Normal + {$endif} + {$ENDIF} + + {$IFNDEF PARAM_USESOLIDCOLOR} + mulps xmm5, xmm4 + {$IFDEF PARAM_USEINTERPOLATION} + movlps texPosByZ, xmm5 + {$ELSE} + cvtps2dq xmm1,xmm5 + movlps intTexPos,xmm1 + {$ENDIF} + {$ENDIF} + end; + {$ELSE} + {$IFDEF PARAM_USEZBUFFER} + if InvZPos > pzbuffer^ then + begin + pzbuffer^ := InvZPos; + {$ENDIF} + {$IFDEF PARAM_USESHADER} + zPos := 1/InvZPos; + with ShaderContext^ do + begin + Normal := NormalInvZ*zPos; + Normalize3D_128(Normal); + Position := PositionInvZ*zPos; + end; + {$ELSE} + {$IFNDEF PARAM_USESOLIDCOLOR} + zPos := 1/InvZPos; + {$ENDIF} + {$ENDIF} + {$ENDIF} + DrawPixelInlineWithAlphaCheck(pdest, + {$IFDEF PARAM_USESHADER} ShaderFunction(ShaderContext, {$ENDIF} + {$IFDEF PARAM_USELIGHTING} ApplyLightnessFast( {$ENDIF} + {$IFDEF PARAM_USESOLIDCOLOR} + solidColor + {$ELSE} + {$IFNDEF PARAM_USESSE} + {$IFDEF PARAM_USEINTERPOLATION} + scanAtFunc(texPos.x*zPos,texPos.y*zPos) + {$ELSE} + scanAtIntegerFunc(round(texPos.x*zPos),round(texPos.y*zPos)) + {$ENDIF} + {$ELSE} + {$IFDEF PARAM_USEINTERPOLATION} + scanAtFunc(texPosByZ.x,texPosByZ.y) + {$ELSE} + scanAtIntegerFunc(intTexPos.x,intTexPos.y) + {$ENDIF} + {$ENDIF} + {$ENDIF} + {$IFDEF PARAM_USELIGHTING} ,light) {$ENDIF} + {$IFDEF PARAM_USESHADER} ) {$ENDIF} + ); + {$IFDEF PARAM_USEZBUFFER} + end; + inc(pzbuffer); + {$ENDIF} + + {$IFDEF PARAM_USESSE} + {$IFNDEF PARAM_USESOLIDCOLOR} + asm + movups xmm5, texPos + movups xmm1, texStep + end; + IncF(InvZPos, zStep); + asm + addps xmm5, xmm1 + movlps texPos, xmm5 + end; + {$ELSE} + IncF(InvZPos, zStep); + {$ENDIF} + {$ELSE} + {$IFNDEF PARAM_USESOLIDCOLOR} + IncF(texPos.x, texStep.x); + IncF(texPos.y, texStep.y); + {$ENDIF} + IncF(InvZPos, zStep); + {$ENDIF} + + {$IFDEF PARAM_USESHADER} + {$IFDEF PARAM_USESSE} + {$ifdef cpux86_64} + asm + mov rax, ShaderContext + movaps xmm2, [rax+32] //PositionInvZ + movaps xmm1, [rax+64] //PositionStepInvZ + movaps xmm3, [rax+48] //NormalInvZ + movaps xmm0, [rax+80] //NormalStepInvZ + addps xmm2, xmm1 + addps xmm3, xmm0 + movaps [rax+32], xmm2 + movaps [rax+48], xmm3 + end; + {$else} + asm + mov eax, ShaderContext + movaps xmm2, [eax+32] //PositionInvZ + movaps xmm1, [eax+64] //PositionStepInvZ + movaps xmm3, [eax+48] //NormalInvZ + movaps xmm0, [eax+80] //NormalStepInvZ + addps xmm2, xmm1 + addps xmm3, xmm0 + movaps [eax+32], xmm2 + movaps [eax+48], xmm3 + end; + {$endif} + {$ELSE} + with ShaderContext^ do + begin + PositionInvZ.Offset(PositionStepInvZ); + NormalInvZ.Offset(NormalStepInvZ); + end; + {$ENDIF} + {$ENDIF} + + {$IFDEF PARAM_USELIGHTING} + NextLight; + {$ENDIF} + inc(pdest); + end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/phongdraw.inc b/vendor/kam_remake/src/ext/BGRABitmap/phongdraw.inc new file mode 100644 index 0000000..b4d771a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/phongdraw.inc @@ -0,0 +1,289 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$ifdef PARAM_PHONGSSE} + {$asmmode intel} + //SSE rotate singles + const Shift231 = 1 + 8; + Shift312 = 2 + 16; +{$endif} + +var + //Light source normal. + vL: TPoint3D_128; {xmm0} + //Light source position. + vLS: TPoint3D_128; {xmm1} + //Vector H is the unit normal to the hypothetical surface oriented + //halfway between the light direction vector (L) and the viewing vector (V). + vH: TPoint3D_128; {xmm2} + + vN: TPoint3D_128; {xmm3} // surface normal + vP: TPoint3D_128; {xmm4} // position of lighted pixel + vV: TPoint3D_128; // viewer direction +{$ifdef PARAM_PHONGSSE} + LightDestFactor4: TPoint3D_128; // for multiplication +{$endif} + + //Calculate LdotN and NnH + NH: Single; +{$ifndef PARAM_PHONGSSE} + vD: TPoint3D_128; +{$endif} + + Iw, Ic: integer; // Iw: specular intensity, Ic: ambient+diffuse intensity + sIw: single; // floating point value for Iw + + z, LdotN, NnH, + dist, distfactor, diffuseterm, specularterm: single; + eLight: TExpandedPixel; + mc,mcLeft,mcRight,mcTop,mcBottom: TBGRAPixel; ///map values + +{$ifdef PARAM_SIMPLECOLOR} + eColor: TExpandedPixel; +{$else} + {$ifndef PARAM_SCANNER} + pcolormap: PBGRAPixel; + {$endif} +{$endif} + + {$hints off} + function ComputePixel(x,y: integer; DiffuseLight, SpecularLight: Word; Alpha: Byte): TBGRAPixel; inline; + var ec: TExpandedPixel; + {$ifndef PARAM_SIMPLECOLOR} + eColor: TExpandedPixel; + {$endif} + begin + {$ifndef PARAM_SIMPLECOLOR} + {$ifdef PARAM_SCANNER} + eColor := GammaExpansion(ColorScan.ScanNextPixel); + {$else} + eColor := GammaExpansion(pcolormap^); + {$endif} + {$endif} + Alpha := ApplyOpacity(Alpha, eColor.alpha shr 8); + ec.red := (eColor.Red*DiffuseLight+eLight.Red*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; + ec.green := (eColor.Green*DiffuseLight+eLight.Green*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; + ec.blue := (eColor.Blue*DiffuseLight+eLight.Blue*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; + ec.alpha := Alpha shl 8+Alpha; + result := GammaCompression(ec); + end; + {$hints on} + +var + minx,miny,maxx,maxy: integer; + pmap: PBGRAPixel; + pdest: PBGRAPixel; + x,y : integer; // Coordinates of point in height map. + vS1,vS2: TPoint3D_128; // surface vectors (plane) + deltaDown: Int32or64; + IsLineUp,IsLineDown: boolean; + +begin + if map = nil then exit; + {$ifndef PARAM_SIMPLECOLOR} + {$ifndef PARAM_SCANNER} + if (colorMap.Width < map.width) or (colorMap.Height < map.height) then + raise Exception.Create('Dimension mismatch'); + {$endif} + {$endif} + + if (map.width = 0) or (map.Height = 0) then exit; + if ofsX >= dest.ClipRect.Right then exit; + if ofsY >= dest.ClipRect.Bottom then exit; + if ofsX <= dest.ClipRect.Left-map.Width then exit; + if ofsY <= dest.ClipRect.Top-map.Height then exit; + + minx := 0; + miny := 0; + maxx := map.Width-1; + maxy := map.Height-1; + if ofsX < dest.clipRect.Left then minx := dest.clipRect.Left-ofsX; + if ofsY < dest.clipRect.Top then miny := dest.clipRect.Top-ofsY; + if OfsX+maxx > dest.ClipRect.Right-1 then maxx := dest.ClipRect.Right-1-ofsX; + if OfsY+maxy > dest.ClipRect.Bottom-1 then maxy := dest.ClipRect.Bottom-1-ofsY; + + eLight := GammaExpansion(LightColor); + {$ifdef PARAM_SIMPLECOLOR} + eColor := GammaExpansion(color); + {$endif} + + //light origin + vLS := Point3D_128(FLightPosition3D.X-ofsX, + FLightPosition3D.Y-ofsY, + FLightPosition3D.Z); + + //surface vectors + vS1 := Point3D_128(1,0,0); + vS2 := Point3D_128(0,1,0); + + vV := Point3D_128(0,0,1); + + dist := 0; + LdotN := 0; + NnH := 0; + + {$ifdef PARAM_PHONGSSE} + LightDestFactor4 := Point3D_128(LightDestFactor,LightDestFactor,LightDestFactor,LightDestFactor); + {$endif} + + if map.LineOrder = riloTopToBottom then + deltaDown := map.Width*sizeof(TBGRAPixel) + else + deltaDown := -map.Width*sizeof(TBGRAPixel); + for y := miny to maxy do + begin + //read map values + pmap := map.ScanLine[y]+minx; + mc := BGRAPixelTransparent; + mcRight := pmap^; + pdest := dest.ScanLine[y+ofsY]+ofsX+minx; + {$ifndef PARAM_SIMPLECOLOR} + {$ifdef PARAM_SCANNER} + ColorScan.ScanMoveTo(OfsX+minx,OfsY+Y); + {$else} + pcolormap := ColorMap.ScanLine[y]; + {$endif} + {$endif} + IsLineUp := y > 0; + IsLineDown := y < map.Height-1; + mcTop := BGRAPixelTransparent; + mcBottom := BGRAPixelTransparent; + for x := minx to maxx do + begin + mcLeft := mc; + mc := mcRight; + if x < map.width-1 then + mcRight := (pmap+1)^ else + mcRight := BGRAPixelTransparent; + if mc.alpha = 0 then + begin + {$ifndef PARAM_SIMPLECOLOR} + {$ifdef PARAM_SCANNER} + ColorScan.ScanNextPixel; + {$else} + inc(pcolormap); + {$endif} + {$endif} + inc(pdest); + inc(pmap); + continue; + end; + + //compute surface vectors + if IsLineUp then mcTop := pbgrapixel(pbyte(pmap)-deltaDown)^; + if IsLineDown then mcBottom := pbgrapixel(pbyte(pmap)+deltaDown)^; + inc(pmap); + + z := MapHeight(mc)*mapAltitude; + if mcLeft.alpha = 0 then + begin + if mcRight.alpha = 0 then + vS1.z := 0 + else + vS1.z := (MapHeight(mcRight)-MapHeight(mc))*mapAltitude*2; + end else + begin + if mcRight.alpha = 0 then + vS1.z := (MapHeight(mc)-MapHeight(mcLeft))*mapAltitude*2 + else + vS1.z := (MapHeight(mcRight)-MapHeight(mcLeft))*mapAltitude; + end; + if mcTop.alpha = 0 then + begin + if mcBottom.alpha = 0 then + vS2.z := 0 + else + vS2.z := (MapHeight(mcBottom)-MapHeight(mc))*mapAltitude*2; + end else + begin + if mcBottom.alpha = 0 then + vS2.z := (MapHeight(mc)-MapHeight(mcTop))*mapAltitude*2 + else + vS2.z := (MapHeight(mcBottom)-MapHeight(mcTop))*mapAltitude; + end; + + //position vector + vP := Point3D_128(x, y, z); + {$ifdef PARAM_PHONGSSE} + if UseSSE3 then + begin + {$DEFINE PARAM_USESSE3} + asm + movups xmm1, vLS + end; + {$i phongdrawsse.inc} + {$UNDEF PARAM_USESSE3} + end else + begin + asm + movups xmm1, vLS + end; + {$i phongdrawsse.inc} + end; + {$else} + vP := Point3D_128(x, y, z); + vL := vLS- vP*LightDestFactor; + Normalize3D_128(vL); + + //compute bisector of angle between light and observer + vH := vL + vV; + Normalize3D_128(vH); + + // compute normal vector to the surface + VectProduct3D_128(vS1,vS2,vN); + Normalize3D_128(vN); + + //Calculate LdotN and NnH + LdotN := DotProduct3D_128(vN,vL); + vD := vLS-vP; + dist := sqrt(DotProduct3D_128(vD,vD)); + + NH := DotProduct3D_128(vH,vN); + {$endif} + + if NH <= 0 then + NnH := 0 + else + NnH := exp(SpecularIndex*ln(NH)); //to be optimized + + distfactor := LightSourceIntensity / (dist*LightSourceDistanceFactor + LightSourceDistanceTerm); + + if (LdotN <= 0) then //Point is not illuminated by light source. + //Use negative diffuse for contrast + diffuseterm := distfactor * NegativeDiffusionFactor * LdotN + else + diffuseterm := distfactor * DiffusionFactor * LdotN; + Ic := round((AmbientFactor + diffuseterm)*PhongLightPrecision); + + //specular (reflection) + specularterm := distfactor * SpecularFactor * NnH; + sIw := specularterm*PhongLightPrecision; + if sIw > PhongLightPrecision then Iw := PhongLightPrecision else + Iw := round(sIw); + + //intensity bounds (0..PhongLightPrecision) + If Ic < 0 then Ic := 0; + If Ic > PhongLightPrecision then + begin + If DiffuseSaturation then + begin + Iw := Iw+(Ic-PhongLightPrecision); + if Iw > PhongLightPrecision then Iw := PhongLightPrecision; + end; + Ic := PhongLightPrecision; + end; + Ic := Ic*(PhongLightPrecision-Iw) shr PhongLightPrecisionSh; + + DrawPixelInlineWithAlphaCheck(pdest, ComputePixel(x,y,Ic,Iw,mc.alpha)); + {$ifndef PARAM_SIMPLECOLOR} + {$ifndef PARAM_SCANNER} + inc(pcolormap); + {$endif} + {$endif} + inc(pdest); //go to next pixel + end; + end; +end; + +{$undef PARAM_PHONGSSE} +{$undef PARAM_SIMPLECOLOR} +{$undef PARAM_SCANNER} + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/phongdrawsse.inc b/vendor/kam_remake/src/ext/BGRABitmap/phongdrawsse.inc new file mode 100644 index 0000000..50ffc25 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/phongdrawsse.inc @@ -0,0 +1,164 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +asm + //vL := vLS- vP*LightDestFactor; + movups xmm4, vP + movups xmm6,LightDestFactor4 + mulps xmm6, xmm4 //keep xmm4 = vP + movaps xmm0, xmm1 + subps xmm0, xmm6 + + movups xmm2, vV //preload xmm2 (A) + + //normalize(vL); + movaps xmm6, xmm0 //save + mulps xmm0, xmm0 + + {$IFDEF PARAM_USESSE3} + haddps xmm0,xmm0 + haddps xmm0,xmm0 + {$ELSE} + //mix1 + movaps xmm7, xmm0 + shufps xmm7, xmm7, $4e + addps xmm0, xmm7 + //mix2 + movaps xmm7, xmm0 + shufps xmm7, xmm7, $11 + addps xmm0, xmm7 + {$ENDIF} + + //1/sqrt + rsqrtps xmm0, xmm0 + mulps xmm0, xmm6 //apply + + + //vH := vL + vV; (A) + //xmm2 = vV + addps xmm2, xmm0 + + + + //vectproduct(vS1,vS2,vN); + movups xmm6, vS1 + shufps xmm6, xmm6, Shift231 + + movups xmm7, vS2 + shufps xmm7, xmm7, Shift312 + + movaps xmm3,xmm6 + mulps xmm3,xmm7 + + movups xmm6, vS1 + shufps xmm6, xmm6, Shift312 + + movups xmm7, vS2 + shufps xmm7, xmm7, Shift231 + + mulps xmm7,xmm6 + subps xmm3,xmm7 + //end of vectproduct + + + //normalize(vH); + movaps xmm6, xmm2 //save + mulps xmm2, xmm2 + + {$IFDEF PARAM_USESSE3} + haddps xmm2,xmm2 + haddps xmm2,xmm2 + {$ELSE} + //mix1 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $4e + addps xmm2, xmm7 + //mix2 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $11 + addps xmm2, xmm7 + {$ENDIF} + + //1/sqrt + rsqrtps xmm2, xmm2 + mulps xmm2, xmm6 //apply + + //normalize(vN); + movaps xmm6, xmm3 //save + mulps xmm3, xmm3 + + {$IFDEF PARAM_USESSE3} + haddps xmm3,xmm3 + haddps xmm3,xmm3 + {$ELSE} + //mix1 + movaps xmm7, xmm3 + shufps xmm7, xmm7, $4e + addps xmm3, xmm7 + //mix2 + movaps xmm7, xmm3 + shufps xmm7, xmm7, $11 + addps xmm3, xmm7 + {$ENDIF} + + //1/sqrt + rsqrtps xmm3, xmm3 + mulps xmm3, xmm6 //apply + + //LdotN := vN * vL; + movups xmm5, xmm3 + mulps xmm5, xmm0 + //mix1 + movaps xmm7, xmm5 + shufps xmm7, xmm7, $4e + addps xmm5, xmm7 + //mix2 + movaps xmm7, xmm5 + shufps xmm7, xmm7, $11 + addps xmm5, xmm7 + //:= + movss LdotN, xmm5 + + //vD := vLS-vP; + movaps xmm5, xmm1 + subps xmm5, xmm4 + + //dist := sqrt(vD*vD); + mulps xmm5, xmm5 + + {$IFDEF PARAM_USESSE3} + haddps xmm5,xmm5 + haddps xmm5,xmm5 + {$ELSE} + //mix1 + movaps xmm7, xmm5 + shufps xmm7, xmm7, $4e + addps xmm5, xmm7 + //mix2 + movaps xmm7, xmm5 + shufps xmm7, xmm7, $11 + addps xmm5, xmm7 + {$ENDIF} + + //:= sqrt + sqrtss xmm5,xmm5 + movss dist, xmm5 + + //NH := vH * vN; + movups xmm6, xmm2 + mulps xmm6, xmm3 + + {$IFDEF PARAM_USESSE3} + haddps xmm6,xmm6 + haddps xmm6,xmm6 + {$ELSE} + //mix1 + movaps xmm7, xmm6 + shufps xmm7, xmm7, $4e + addps xmm6, xmm7 + //mix2 + movaps xmm7, xmm6 + shufps xmm7, xmm7, $11 + addss xmm6, xmm7 + {$ENDIF} + //:= + movss NH, xmm6 + end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/phonglight.inc b/vendor/kam_remake/src/ext/BGRABitmap/phonglight.inc new file mode 100644 index 0000000..5fcbb65 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/phonglight.inc @@ -0,0 +1,62 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$i bgrasse.inc} +var + {%H-}dist2,LdotN,NdotH,lightEnergy,diffuse : single; +begin + {$IFDEF BGRASSE_AVAILABLE}If UseSSE then + begin + with Context^ do + begin + {$IFDEF PARAM_POINTLIGHT} + vL := FVertex.ViewCoord_128; + vH := FViewVector; + {$ELSE} + vL := FDirection; + vH := FBetweenDirectionAndObserver; + {$ENDIF} + end; + if UseSSE3 then + begin + {$DEFINE PARAM_USESSE3} + {$i phonglightsse.inc} + {$UNDEF PARAM_USESSE3} + end else + begin + {$i phonglightsse.inc} + end; + end else + {$ENDIF} + with Context^ do + begin + {$IFDEF PARAM_POINTLIGHT} + vL := FVertex.ViewCoord_128 - basic.Position; + Normalize3D_128_SqLen(vL, dist2); + //compute bisector of angle between light and observer + vH := vL + FViewVector; + Normalize3D_128(vH); + //Calculate LdotN and NnH + LdotN := DotProduct3D_128(basic.Normal, vL); + NdotH := DotProduct3D_128(basic.Normal, vH); + {$ELSE} + LdotN := DotProduct3D_128(basic.Normal, FDirection); + NdotH := DotProduct3D_128(basic.Normal, FBetweenDirectionAndObserver); + {$ENDIF} + end; + + {$IFDEF PARAM_POINTLIGHT} + if dist2 = 0 then + lightEnergy := 0 + else + lightEnergy := FIntensity / dist2; + diffuse := LdotN*lightEnergy; + {$ELSE} + lightEnergy := 1; + diffuse := LdotN; + {$ENDIF} + if diffuse < FMinIntensity then diffuse:= FMinIntensity; + + if Context^.LightThrough and (diffuse < 0) then diffuse := -diffuse*Context^.LightThroughFactor; + TBGRAMaterial3D(Context^.material).ComputeDiffuseAndSpecularColor(Context, diffuse, lightEnergy, NdotH, FColorInt); +end; + +{$UNDEF PARAM_POINTLIGHT} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/phonglightsse.inc b/vendor/kam_remake/src/ext/BGRABitmap/phonglightsse.inc new file mode 100644 index 0000000..6e2bc7a --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/phonglightsse.inc @@ -0,0 +1,105 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception + {$asmmode intel} + asm + {$ifdef cpux86_64} + mov rax, Context + movaps xmm0,[rax+160] //Context^.vL + movaps xmm2,[rax+192] //Context^.vH + movaps xmm1,[rax+16] //Context^.Normal + {$else} + mov eax, Context + movaps xmm0,[eax+160] //Context^.vL + movaps xmm2,[eax+192] //Context^.vH + movaps xmm1,[eax+16] //Context^.Normal + {$endif} + + {$IFDEF PARAM_POINTLIGHT} + {$ifdef cpux86_64} + movaps xmm6,[rax+0] //Context^.Position + {$else} + movaps xmm6,[eax+0] //Context^.Position + {$endif} + subps xmm0,xmm6 //xmm0 = vL + movaps xmm6, xmm0 + mulps xmm6, xmm6 + + {$IFDEF PARAM_USESSE3} + haddps xmm6,xmm6 + haddps xmm6,xmm6 + {$ELSE} + //mix1 + movaps xmm7, xmm6 + shufps xmm7, xmm7, $4e + addps xmm6, xmm7 + //mix2 + movaps xmm7, xmm6 + shufps xmm7, xmm7, $11 + addps xmm6, xmm7 + {$ENDIF} + + movss dist2, xmm6 //dist2 := vL*vL; + + rsqrtps xmm6, xmm6 + mulps xmm0, xmm6 //xmm0 = normalized vL + {$ENDIF} + + {$IFDEF PARAM_POINTLIGHT} + addps xmm2,xmm0 //vH += normalized vL + movaps xmm6, xmm2 + mulps xmm2, xmm2 + + {$IFDEF PARAM_USESSE3} + haddps xmm2,xmm2 + haddps xmm2,xmm2 + {$ELSE} + //mix1 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $4e + addps xmm2, xmm7 + //mix2 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $11 + addps xmm2, xmm7 + {$ENDIF} + + rsqrtps xmm2, xmm2 + mulps xmm2, xmm6 //xmm2 = normalized vH + {$ENDIF} + + //vL*Normal + mulps xmm0, xmm1 + //vH*Normal + mulps xmm2, xmm1 + + {$IFDEF PARAM_USESSE3} + haddps xmm0,xmm0 + haddps xmm0,xmm0 + {$ELSE} + //mix1 + movaps xmm7, xmm0 + shufps xmm7, xmm7, $4e + addps xmm0, xmm7 + //mix2 + movaps xmm7, xmm0 + shufps xmm7, xmm7, $11 + addps xmm0, xmm7 + {$ENDIF} + + {$IFDEF PARAM_USESSE3} + haddps xmm2,xmm2 + haddps xmm2,xmm2 + {$ELSE} + //mix1 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $4e + addps xmm2, xmm7 + //mix2 + movaps xmm7, xmm2 + shufps xmm7, xmm7, $11 + addps xmm2, xmm7 + {$ENDIF} + + movss LdotN, xmm0 + movss NdotH, xmm2 + end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/polyaliaspersp.inc b/vendor/kam_remake/src/ext/BGRABitmap/polyaliaspersp.inc new file mode 100644 index 0000000..d20daec --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/polyaliaspersp.inc @@ -0,0 +1,605 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{*****************************************TEXTURE WITHOUT SHADING *********************************} +{with shading: second part of this file} + +{ TPolygonPerspectiveTextureMappingInfo } + +procedure TPolygonPerspectiveTextureMappingInfo.SetIntersectionValues( + AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; + dy: single; AData: pointer); +var info: PPerspectiveTextureInfo; +begin + AInter.SetValues(AInterX,AWinding,ANumSegment); + info := PPerspectiveTextureInfo(AData); + TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; + TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy; + if FLightnesses<>nil then + TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy) + else + TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := 32768; +end; + +constructor TPolygonPerspectiveTextureMappingInfo.Create( + const points: array of TPointF; const pointsZ: array of single; + const texCoords: array of TPointF); +var + i: Integer; + lPoints: array of TPointF; + nbP: integer; +begin + if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) then + raise Exception.Create('Dimensions mismatch'); + + setlength(lPoints, length(points)); + SetLength(FTexCoords, length(points)); + SetLength(FPointsZ, length(points)); + nbP := 0; + for i := 0 to high(points) do + if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then + begin + lPoints[nbP] := points[i]; + FTexCoords[nbP] := texCoords[i]; + FPointsZ[nbP] := abs(pointsZ[i]); + inc(nbP); + end; + if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); + setlength(lPoints, nbP); + SetLength(FTexCoords, nbP); + SetLength(FPointsZ, nbP); + + inherited Create(lPoints); +end; + +constructor TPolygonPerspectiveTextureMappingInfo.Create( + const points: array of TPointF; const pointsZ: array of single; + const texCoords: array of TPointF; const lightnesses: array of word); +var + i: Integer; + lPoints: array of TPointF; + nbP: integer; +begin + if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) or + (length(lightnesses) <> length(points)) then + raise Exception.Create('Dimensions mismatch'); + + setlength(lPoints, length(points)); + SetLength(FTexCoords, length(points)); + SetLength(FPointsZ, length(points)); + setLength(FLightnesses, length(points)); + nbP := 0; + for i := 0 to high(points) do + if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then + begin + lPoints[nbP] := points[i]; + FTexCoords[nbP] := texCoords[i]; + FPointsZ[nbP] := abs(pointsZ[i]); + FLightnesses[nbP] := lightnesses[i]; + inc(nbP); + end; + if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); + setlength(lPoints, nbP); + SetLength(FTexCoords, nbP); + SetLength(FPointsZ, nbP); + SetLength(FLightnesses, nbP); + + inherited Create(lPoints); +end; + +{$hints off} + +function TPolygonPerspectiveTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +var + info: PPerspectiveTextureInfo; + ty: single; + CurInvZ,NextInvZ: single; + CurTexCoordDivByZ: TPointF; + NextTexCoordDivByZ: TPointF; +begin + New(info); + ty := ASeg^.y2-ASeg^.y; + CurInvZ := 1/FPointsZ[numPt]; + CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ; + NextInvZ := 1/FPointsZ[nextPt]; + NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ; + info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty); + info^.TexCoordDivByZ := CurTexCoordDivByZ; + info^.InvZSlope := (NextInvZ-CurInvZ)/ty; + info^.InvZ := CurInvZ; + if FLightnesses <> nil then + begin + info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty); + info^.lightness := FLightnesses[numPt]; + end else + begin + info^.lightness := 32768; + info^.lightnessSlope := 0; + end; + Result:= info; +end; +{$hints on} + +function TPolygonPerspectiveTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + Result:= TPerspectiveTextureMappingIntersectionInfo.Create; +end; + +{$hints off} +procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; + polyInfo: TPolygonPerspectiveTextureMappingInfo; texture: IBGRAScanner; + TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle); +var + inter: array of TIntersectionInfo; + nbInter: integer; + + scanAtFunc: TScanAtFunction; + scanAtIntegerFunc: TScanAtIntegerFunction; + + procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$i perspectivescan.inc} + + procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USELIGHTING} + {$i perspectivescan.inc} + + procedure DrawTextureLineWithoutLightZBuffer(yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USEZBUFFER} + {$i perspectivescan.inc} + + procedure DrawTextureLineWithLightZBuffer(yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USEZBUFFER} + {$define PARAM_USELIGHTING} + {$i perspectivescan.inc} + +var + miny, maxy, minx, maxx: integer; + + yb, i : integer; + x1, x2: single; + + ix1, ix2: integer; + +begin + If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; + + inter := polyInfo.CreateIntersectionArray; + scanAtFunc := @texture.ScanAt; + scanAtIntegerFunc := @texture.ScanAtInteger; + + if zbuffer = nil then + begin + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i+ 1].interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + begin + if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and + (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then + DrawTextureLineWithoutLight(yb,ix1,ix2, + TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), + TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation) + else + DrawTextureLineWithLight(yb,ix1,ix2, + TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), + TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation); + end; + end; + end; + end; + end else + begin + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + x1 := inter[i + i].interX; + x2 := inter[i + i+ 1].interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + begin + if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and + (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then + DrawTextureLineWithoutLightZBuffer(yb,ix1,ix2, + TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), + TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation) + else + DrawTextureLineWithLightZBuffer(yb,ix1,ix2, + TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), + TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), + TextureInterpolation); + end; + end; + end; + end; + end; + + polyInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; +end; +{$hints on} + +procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; const pointsZ: array of single; + texture: IBGRAScanner; const texCoords: array of TPointF; + TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle); +var polyInfo: TPolygonPerspectiveTextureMappingInfo; +begin + polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords); + PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer); + polyInfo.Free; +end; + +procedure PolygonPerspectiveTextureMappingAliasedWithLightness( + bmp: TBGRACustomBitmap; const points: array of TPointF; + const pointsZ: array of single; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; + lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle); +var polyInfo: TPolygonPerspectiveTextureMappingInfo; +begin + polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords,lightnesses); + PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer); + polyInfo.Free; +end; + +{****************************************** WITH SHADING ******************************************} + +{$hints off} +procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESHADER} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESOLIDCOLOR} + {$define PARAM_USESHADER} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESHADER} + {$define PARAM_USEZBUFFER} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESOLIDCOLOR} + {$define PARAM_USESHADER} + {$define PARAM_USEZBUFFER} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESOLIDCOLOR} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USEZBUFFER} + {$i perspectivescan.inc} + +procedure PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + {$define PARAM_USESOLIDCOLOR} + {$define PARAM_USEZBUFFER} + {$i perspectivescan.inc} +{$hints on} + +{$hints off} +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; + polyInfo: TPolygonPerspectiveMappingShaderInfo; texture: IBGRAScanner; + TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; + NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); +var + inter: array of TIntersectionInfo; + nbInter: integer; + + scanAtFunc: TScanAtFunction; + scanAtIntegerFunc: TScanAtIntegerFunction; + + drawFunc : procedure(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; + solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; + yb: integer; ix1: integer; ix2: integer; + info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); + +var + miny, maxy, minx, maxx: integer; + + yb, i : integer; + x1, x2: single; + + ix1, ix2: integer; + shaderContextMem: TMemoryBlockAlign128; + shaderContextPtr: PBasicLightingContext; + + inter1,inter2: TPerspectiveTextureMappingIntersectionInfo; + +begin + If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; + + inter := polyInfo.CreateIntersectionArray; + + if texture <> nil then + begin + scanAtFunc := @texture.ScanAt; + scanAtIntegerFunc := @texture.ScanAtInteger; + end else + begin + scanAtFunc := nil; + scanAtIntegerFunc := nil; + end; + + shaderContextMem := nil; + shaderContextPtr := nil; + + if ShaderFunction <> nil then + begin + if ShaderContext = nil then + begin + shaderContextMem := TMemoryBlockAlign128.Create(sizeof(TBasicLightingContext)); + shaderContextPtr := PBasicLightingContext( shaderContextMem.Data); + end + else + shaderContextPtr := shaderContext; + if texture <> nil then + begin + if zbuffer = nil then + drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLine + else + drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer; + end + else + begin + if zbuffer = nil then + drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine + else + drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer; + end; + end else + begin + if texture <> nil then + begin + if zbuffer = nil then + drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLine + else + drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer; + end + else + begin + if zbuffer = nil then + drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLine + else + drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer; + end; + end; + + //vertical scan + for yb := miny to maxy do + begin + //find intersections + polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); + + for i := 0 to nbinter div 2 - 1 do + begin + inter1 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i]); + inter2 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]); + x1 := inter1.interX; + x2 := inter2.interX; + + if x1 <> x2 then + begin + ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); + if ix1 <= ix2 then + begin + drawFunc(bmp,ShaderFunction,shaderContextPtr, + solidColor,scanAtFunc,scanAtIntegerFunc,zbuffer, + yb,ix1,ix2, + inter1,inter2,TextureInterpolation); + end; + end; + end; + end; + + polyInfo.FreeIntersectionArray(inter); + bmp.InvalidateBitmap; + shaderContextMem.Free; +end; +{$hints on} + +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; const points3D: array of TPoint3D; + const normals: array of TPoint3D; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; + ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); +var polyInfo: TPolygonPerspectiveMappingShaderInfo; +begin + polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords); + PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext); + polyInfo.Free; +end; + +procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; + const points: array of TPointF; const points3D: array of TPoint3D_128; + const normals: array of TPoint3D_128; texture: IBGRAScanner; + const texCoords: array of TPointF; TextureInterpolation: Boolean; + ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; + solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); +var polyInfo: TPolygonPerspectiveMappingShaderInfo; +begin + polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords); + PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext); + polyInfo.Free; +end; + +{ TPolygonPerspectiveMappingShaderInfo } + +procedure TPolygonPerspectiveMappingShaderInfo.SetIntersectionValues( + AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; + dy: single; AData: pointer); +var info : PPerspectiveTextureInfo; +begin + AInter.SetValues(AInterX,AWinding,ANumSegment); + info := PPerspectiveTextureInfo(AData); + TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; + TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy; + TPerspectiveTextureMappingIntersectionInfo(AInter).Position3D := info^.Position3D + info^.Position3DSlope*dy; + TPerspectiveTextureMappingIntersectionInfo(AInter).Normal3D := info^.Normal3D + info^.Normal3DSlope*dy; +end; + +constructor TPolygonPerspectiveMappingShaderInfo.Create( + const points: array of TPointF; const points3D: array of TPoint3D; + const normals: array of TPoint3D; const texCoords: array of TPointF); +var + i: Integer; + lPoints: array of TPointF; + nbP: integer; +begin + if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then + raise Exception.Create('Dimensions mismatch'); + + setlength(lPoints, length(points)); + SetLength(FTexCoords, length(points)); + SetLength(FPositions3D, length(points)); + SetLength(FNormals3D, length(points)); + nbP := 0; + for i := 0 to high(points) do + if (i=0) or (points[i]<>points[i-1]) then + begin + lPoints[nbP] := points[i]; + FTexCoords[nbP] := texCoords[i]; + FPositions3D[nbP] := Point3D_128(points3D[i]); + FNormals3D[nbP] := Point3D_128(normals[i]); + inc(nbP); + end; + if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); + setlength(lPoints, nbP); + SetLength(FTexCoords, nbP); + SetLength(FPositions3D, nbP); + SetLength(FNormals3D, nbP); + + inherited Create(lPoints); +end; + +constructor TPolygonPerspectiveMappingShaderInfo.Create( + const points: array of TPointF; const points3D: array of TPoint3D_128; + const normals: array of TPoint3D_128; const texCoords: array of TPointF); +var + i: Integer; + lPoints: array of TPointF; + nbP: integer; +begin + if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then + raise Exception.Create('Dimensions mismatch'); + + setlength(lPoints, length(points)); + SetLength(FTexCoords, length(points)); + SetLength(FPositions3D, length(points)); + SetLength(FNormals3D, length(points)); + nbP := 0; + for i := 0 to high(points) do + if (i=0) or (points[i]<>points[i-1]) then + begin + lPoints[nbP] := points[i]; + FTexCoords[nbP] := texCoords[i]; + FPositions3D[nbP] := points3D[i]; + FNormals3D[nbP] := normals[i]; + inc(nbP); + end; + if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); + setlength(lPoints, nbP); + SetLength(FTexCoords, nbP); + SetLength(FPositions3D, nbP); + SetLength(FNormals3D, nbP); + + inherited Create(lPoints); +end; + +{$hints off} +function TPolygonPerspectiveMappingShaderInfo.CreateSegmentData(numPt, nextPt: integer; + ASeg: PCustomPointRecord): pointer; +var + info: PPerspectiveTextureInfo; + ty: single; + CurInvZ,NextInvZ: single; + CurTexCoordDivByZ: TPointF; + NextTexCoordDivByZ: TPointF; + + Cur3DDivByZ,Next3DDivByZ: TPoint3D_128; +begin + New(info); + ty := ASeg^.y2-ASeg^.y; + CurInvZ := FPositions3D[numPt].z; + if CurInvZ = 0 then CurInvZ := 1 else CurInvZ := 1/CurInvZ; + CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ; + NextInvZ := FPositions3D[nextPt].z; + if NextInvZ = 0 then NextInvZ := 1 else NextInvZ := 1/NextInvZ; + NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ; + info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty); + info^.TexCoordDivByZ := CurTexCoordDivByZ; + info^.InvZSlope := (NextInvZ-CurInvZ)/ty; + info^.InvZ := CurInvZ; + + Cur3DDivByZ := FPositions3D[numPt]*CurInvZ; + Next3DDivByZ := FPositions3D[nextPt]*NextInvZ; + info^.Position3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty); + info^.Position3D := Cur3DDivByZ; + + Cur3DDivByZ := FNormals3D[numPt]*CurInvZ; + Next3DDivByZ := FNormals3D[nextPt]*NextInvZ; + info^.Normal3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty); + info^.Normal3D := Cur3DDivByZ; + + Result:= info; +end; +{$hints on} + +function TPolygonPerspectiveMappingShaderInfo.CreateIntersectionInfo: TIntersectionInfo; +begin + Result:= TPerspectiveTextureMappingIntersectionInfo.Create; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/shapes3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/shapes3d.inc new file mode 100644 index 0000000..04bdd0d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/shapes3d.inc @@ -0,0 +1,79 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + + { TBGRASphere3D } + + TBGRASphere3D = class(TBGRAObject3D) + constructor Create(AScene: TBGRAScene3D; ARadius: single; HorizPrecision: integer = 8; VerticalPrecision : integer = 6; HalfSphere: boolean = false); + end; + +{ TBGRASphere3D } + +constructor TBGRASphere3D.Create(AScene: TBGRAScene3D; ARadius: single; HorizPrecision: integer; VerticalPrecision : integer; HalfSphere: boolean); +var prevAlpha,prevBeta,alpha,beta,NbAlpha,NbBeta: integer; + sinBeta,cosBeta: single; + sinAlpha,cosAlpha: single; + v: IBGRAPart3D; + vTop,vBottom: IBGRAVertex3D; + alphaFactor: single; + startAlpha: integer; +begin + inherited Create(AScene); + NbAlpha := HorizPrecision; + if NbAlpha < 4 then NbAlpha := 4; + NbBeta := VerticalPrecision-1; + if NbBeta < 2 then NbBeta := 2; + v := GetMainPart; + + + if halfSphere then + alphaFactor := Pi/(NbAlpha-1) + else + alphaFactor := (2*Pi)/NbAlpha; + + for beta := 1 to NbBeta-1 do + begin + sinBeta := sin(beta*Pi/NbBeta); + cosBeta := -cos(beta*Pi/NbBeta); + for alpha := 0 to NbAlpha-1 do + begin + sinAlpha := -sin(alpha*alphaFactor); + cosAlpha := -cos(alpha*alphaFactor); + v.Add( cosAlpha*sinBeta*ARadius, cosBeta*ARadius, sinAlpha*sinBeta*ARadius ); + end; + end; + + if halfSphere then + startAlpha := 1 + else + startAlpha := 0; + + vTop := v.Add(0,-ARadius,0); + prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; + for alpha := startAlpha to NbAlpha-1 do + begin + AddFace( [v.Vertex[prevAlpha], vTop, v.Vertex[alpha]], HalfSphere ); + prevAlpha := alpha; + end; + + prevBeta := 0; + for beta := 1 to NbBeta-2 do + begin + prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; + for alpha := startAlpha to NbAlpha-1 do + begin + AddFace( [v.Vertex[prevAlpha + prevBeta*NbAlpha], v.Vertex[alpha + prevBeta*NbAlpha], + v.Vertex[alpha + beta*NbAlpha], v.Vertex[prevAlpha + beta*NbAlpha]], HalfSphere ); + prevAlpha := alpha; + end; + prevBeta := beta; + end; + + vBottom := v.Add(0,ARadius,0); + prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; + for alpha := startAlpha to NbAlpha-1 do + begin + AddFace( [v.Vertex[prevAlpha + prevBeta*NbAlpha], v.Vertex[alpha + prevBeta*NbAlpha], vBottom], HalfSphere ); + prevAlpha := alpha; + end; +end; diff --git a/vendor/kam_remake/src/ext/BGRABitmap/spectraldata.inc b/vendor/kam_remake/src/ext/BGRABitmap/spectraldata.inc new file mode 100644 index 0000000..d464275 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/spectraldata.inc @@ -0,0 +1,197 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +const //horseshoe shape of visible colors at 2° (illuminant E) + SpectralLocus: array[0..94] of TSpectralLocusPoint = + ((W:360; X:0.0001299; Y:0.000003917; Z:0.0006061), + (W:365; X:0.0002321; Y:0.000006965; Z:0.001086), + (W:370; X:0.0004149; Y:0.00001239; Z:0.001946), + (W:375; X:0.0007416; Y:0.00002202; Z:0.003486), + (W:380; X:0.001368; Y:0.000039; Z:0.006450001), + (W:385; X:0.002236; Y:0.000064; Z:0.01054999), + (W:390; X:0.004243; Y:0.00012; Z:0.02005001), + (W:395; X:0.00765; Y:0.000217; Z:0.03621), + (W:400; X:0.01431; Y:0.000396; Z:0.06785001), + (W:405; X:0.02319; Y:0.00064; Z:0.1102), + (W:410; X:0.04351; Y:0.00121; Z:0.2074), + (W:415; X:0.07763; Y:0.00218; Z:0.3713), + (W:420; X:0.13438; Y:0.004; Z:0.6456), + (W:425; X:0.21477; Y:0.0073; Z:1.0390501), + (W:430; X:0.2839; Y:0.0116; Z:1.3856), + (W:435; X:0.3285; Y:0.01684; Z:1.62296), + (W:440; X:0.34828; Y:0.023; Z:1.74706), + (W:445; X:0.34806; Y:0.0298; Z:1.7826), + (W:450; X:0.3362; Y:0.038; Z:1.77211), + (W:455; X:0.3187; Y:0.048; Z:1.7441), + (W:460; X:0.2908; Y:0.06; Z:1.6692), + (W:465; X:0.2511; Y:0.0739; Z:1.5281), + (W:470; X:0.19536; Y:0.09098; Z:1.28764), + (W:475; X:0.1421; Y:0.1126; Z:1.0419), + (W:480; X:0.09564; Y:0.13902; Z:0.8129501), + (W:485; X:0.05795001; Y:0.1693; Z:0.6162), + (W:490; X:0.03201; Y:0.20802; Z:0.46518), + (W:495; X:0.0147; Y:0.2586; Z:0.3533), + (W:500; X:0.0049; Y:0.323; Z:0.272), + (W:505; X:0.0024; Y:0.4073; Z:0.2123), + (W:510; X:0.0093; Y:0.503; Z:0.1582), + (W:515; X:0.0291; Y:0.6082; Z:0.1117), + (W:520; X:0.06327; Y:0.71; Z:0.07824999), + (W:525; X:0.1096; Y:0.7932; Z:0.05725001), + (W:530; X:0.1655; Y:0.862; Z:0.04216), + (W:535; X:0.2257499; Y:0.9148501; Z:0.02984), + (W:540; X:0.2904; Y:0.954; Z:0.0203), + (W:545; X:0.3597; Y:0.9803; Z:0.0134), + (W:550; X:0.4334499; Y:0.9949501; Z:0.008749999), + (W:555; X:0.5120501; Y:1; Z:0.005749999), + (W:560; X:0.5945; Y:0.995; Z:0.0039), + (W:565; X:0.6784; Y:0.9786; Z:0.002749999), + (W:570; X:0.7621; Y:0.952; Z:0.0021), + (W:575; X:0.8425; Y:0.9154; Z:0.0018), + (W:580; X:0.9163; Y:0.87; Z:0.001650001), + (W:585; X:0.9786; Y:0.8163; Z:0.0014), + (W:590; X:1.0263; Y:0.757; Z:0.0011), + (W:595; X:1.0567; Y:0.6949; Z:0.001), + (W:600; X:1.0622; Y:0.631; Z:0.0008), + (W:605; X:1.0456; Y:0.5668; Z:0.0006), + (W:610; X:1.0026; Y:0.503; Z:0.00034), + (W:615; X:0.9384; Y:0.4412; Z:0.00024), + (W:620; X:0.8544499; Y:0.381; Z:0.00019), + (W:625; X:0.7514; Y:0.321; Z:0.0001), + (W:630; X:0.6424; Y:0.265; Z:0.00005), + (W:635; X:0.5419; Y:0.217; Z:0.00003), + (W:640; X:0.4479; Y:0.175; Z:0.00002), + (W:645; X:0.3608; Y:0.1382; Z:0.00001), + (W:650; X:0.2835; Y:0.107; Z:0), + (W:655; X:0.2187; Y:0.0816; Z:0), + (W:660; X:0.1649; Y:0.061; Z:0), + (W:665; X:0.1212; Y:0.04458; Z:0), + (W:670; X:0.0874; Y:0.032; Z:0), + (W:675; X:0.0636; Y:0.0232; Z:0), + (W:680; X:0.04677; Y:0.017; Z:0), + (W:685; X:0.0329; Y:0.01192; Z:0), + (W:690; X:0.0227; Y:0.00821; Z:0), + (W:695; X:0.01584; Y:0.005723; Z:0), + (W:700; X:0.01135916; Y:0.004102; Z:0), + (W:705; X:0.008110916; Y:0.002929; Z:0), + (W:710; X:0.005790346; Y:0.002091; Z:0), + (W:715; X:0.004106457; Y:0.001484; Z:0), + (W:720; X:0.002899327; Y:0.001047; Z:0), + (W:725; X:0.00204919; Y:0.00074; Z:0), + (W:730; X:0.001439971; Y:0.00052; Z:0), + (W:735; X:0.0009999493; Y:0.0003611; Z:0), + (W:740; X:0.0006900786; Y:0.0002492; Z:0), + (W:745; X:0.0004760213; Y:0.0001719; Z:0), + (W:750; X:0.0003323011; Y:0.00012; Z:0), + (W:755; X:0.0002348261; Y:0.0000848; Z:0), + (W:760; X:0.0001661505; Y:0.00006; Z:0), + (W:765; X:0.000117413; Y:0.0000424; Z:0), + (W:770; X:8.307527E-05; Y:0.00003; Z:0), + (W:775; X:5.870652E-05; Y:0.0000212; Z:0), + (W:780; X:4.150994E-05; Y:0.00001499; Z:0), + (W:785; X:2.935326E-05; Y:0.0000106; Z:0), + (W:790; X:2.067383E-05; Y:7.4657E-06; Z:0), + (W:795; X:1.455977E-05; Y:5.2578E-06; Z:0), + (W:800; X:0.000010254; Y:3.7029E-06; Z:0), + (W:805; X:7.221456E-06; Y:2.6078E-06; Z:0), + (W:810; X:5.085868E-06; Y:1.8366E-06; Z:0), + (W:815; X:3.581652E-06; Y:1.2934E-06; Z:0), + (W:820; X:2.522525E-06; Y:9.1093E-07; Z:0), + (W:825; X:1.776509E-06; Y:6.4153E-07; Z:0), + (W:830; X:1.251141E-06; Y:4.5181E-07; Z:0)); + +const //D65 illuminant + IlluminantSpectrumD65: array[0..94] of TIlluminantSpectrumPoint = + ((W:360; Y:46.6383), + (W:365; Y:49.3637), + (W:370; Y:52.0891), + (W:375; Y:51.0323), + (W:380; Y:49.9755), + (W:385; Y:52.3118), + (W:390; Y:54.6482), + (W:395; Y:68.7015), + (W:400; Y:82.7549), + (W:405; Y:87.1204), + (W:410; Y:91.486), + (W:415; Y:92.4589), + (W:420; Y:93.4318), + (W:425; Y:90.057), + (W:430; Y:86.6823), + (W:435; Y:95.7736), + (W:440; Y:104.865), + (W:445; Y:110.936), + (W:450; Y:117.008), + (W:455; Y:117.41), + (W:460; Y:117.812), + (W:465; Y:116.336), + (W:470; Y:114.861), + (W:475; Y:115.392), + (W:480; Y:115.923), + (W:485; Y:112.367), + (W:490; Y:108.811), + (W:495; Y:109.082), + (W:500; Y:109.354), + (W:505; Y:108.578), + (W:510; Y:107.802), + (W:515; Y:106.296), + (W:520; Y:104.79), + (W:525; Y:106.239), + (W:530; Y:107.689), + (W:535; Y:106.047), + (W:540; Y:104.405), + (W:545; Y:104.225), + (W:550; Y:104.046), + (W:555; Y:102.023), + (W:560; Y:100), + (W:565; Y:98.1671), + (W:570; Y:96.3342), + (W:575; Y:96.0611), + (W:580; Y:95.788), + (W:585; Y:92.2368), + (W:590; Y:88.6856), + (W:595; Y:89.3459), + (W:600; Y:90.0062), + (W:605; Y:89.8026), + (W:610; Y:89.5991), + (W:615; Y:88.6489), + (W:620; Y:87.6987), + (W:625; Y:85.4936), + (W:630; Y:83.2886), + (W:635; Y:83.4939), + (W:640; Y:83.6992), + (W:645; Y:81.863), + (W:650; Y:80.0268), + (W:655; Y:80.1207), + (W:660; Y:80.2146), + (W:665; Y:81.2462), + (W:670; Y:82.2778), + (W:675; Y:80.281), + (W:680; Y:78.2842), + (W:685; Y:74.0027), + (W:690; Y:69.7213), + (W:695; Y:70.6652), + (W:700; Y:71.6091), + (W:705; Y:72.979), + (W:710; Y:74.349), + (W:715; Y:67.9765), + (W:720; Y:61.604), + (W:725; Y:65.7448), + (W:730; Y:69.8856), + (W:735; Y:72.4863), + (W:740; Y:75.087), + (W:745; Y:69.3398), + (W:750; Y:63.5927), + (W:755; Y:55.0054), + (W:760; Y:46.4182), + (W:765; Y:56.6118), + (W:770; Y:66.8054), + (W:775; Y:65.0941), + (W:780; Y:63.3828), + (W:785; Y:63.8434), + (W:790; Y:64.304), + (W:795; Y:61.8779), + (W:800; Y:59.4519), + (W:805; Y:55.7054), + (W:810; Y:51.959), + (W:815; Y:54.6998), + (W:820; Y:57.4406), + (W:825; Y:58.8765), + (W:830; Y:60.3125)); + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/unibitmap.inc b/vendor/kam_remake/src/ext/BGRABitmap/unibitmap.inc new file mode 100644 index 0000000..dbdc23b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/unibitmap.inc @@ -0,0 +1,3995 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} + +type + { Working area to be provided to a brush } + PUniBrushContext = ^TUniBrushContext; + TUniBrushContext = record + Dest: Pointer; //target pixels + Ofs: TPoint; //offset within image (used with textured/gradient brush) + Custom: array[0..15] of byte; //custom context information + end; + + { Additional initialization of the brush context (optional) } + TUniBrushInitContextProc = procedure + (AFixedData: Pointer; //address of brush fixed data + AContextData: PUniBrushContext); //address of brush contextual data + + { Outputs pixels from current position defined in context } + TUniBrushPutNextPixelsProc = procedure + (AFixedData: Pointer; //address of brush data + AContextData: PUniBrushContext; //address of brush contextual data + AAlpha: Word; //global alpha modifier (0 to draw nothing, + // 65535 to draw without opacity adjustment) + ACount: integer); //number of pixels to output + +const + UniversalBrushFlag_DoNothing = 1; //the brush does nothing at all and can be skipped + UniversalBrushFlag_Reserved1 = 2; + UniversalBrushFlag_Reserved2 = 4; + UniversalBrushFlag_Reserved3 = 8; + UniversalBrushFlag_Reserved4 = 16; + UniversalBrushFlag_Reserved5 = 32; + UniversalBrushFlag_Reserved6 = 64; + UniversalBrushFlag_Reserved7 = 128; + //you can define your custom flags from 256 on + +type + { TUniversalBrush } + + PUniversalBrush = ^TUniversalBrush; + TUniversalBrush = record + private + FColorspace: TColorspaceAny; + function GetDoesNothing: boolean; inline; + procedure SetColorspace(AValue: TColorspaceAny); + procedure SetDoesNothing(AValue: boolean); inline; + public + FixedData: array[0..31] of byte; + InternalInitContext: TUniBrushInitContextProc; //do not call directly + InternalPutNextPixels: TUniBrushPutNextPixelsProc; //do not call directly + Flags: LongWord; + procedure MoveTo(AContext: PUniBrushContext; ADest: pointer; AOfsX,AOfsY: integer); inline; + procedure PutNextPixels(AContext: PUniBrushContext; AAlpha: Word; ACount: integer); inline; + property Colorspace: TColorspaceAny read FColorspace write SetColorspace; + property DoesNothing: boolean read GetDoesNothing write SetDoesNothing; + end; + +type + PDefaultSolidBrushIndirectFixedData = ^TDefaultSolidBrushIndirectFixedData; + TDefaultSolidBrushIndirectFixedData = packed record + PixelSize: integer; + Color: packed array[0..23] of byte; + end; + +procedure DefaultSolidBrushIndirectSkipPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +procedure DefaultSolidBrushIndirectSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); + +type + TPathCallbackData = record + BrushAddress: PUniversalBrush; + Alpha: Word; + Width: single; + PixelCenteredCoords: boolean; + end; + + { TCustomUniversalBitmap } + + TCustomUniversalBitmap = class(TFPCustomImage, IBGRAScanner) + private + procedure PathStrokeAliasedCallback(const APoints: array of TPointF; + AClosed: boolean; AData: Pointer); + procedure PathStrokeAntialiasCallback(const APoints: array of TPointF; + AClosed: boolean; AData: Pointer); + + protected + FRefCount: integer; + FColorspace: TColorspaceAny; + FReferenceWhite: PXYZReferenceWhite; + FWidth: integer; + FHeight: integer; + FNbPixels: integer; + FPixelSize: integer; + FRowSize: PtrInt; + FDataByte: PByte; + FLineOrder: TRawImageLineOrder; + + //Scan + FScanWidth, FScanHeight: integer; //possibility to reduce the zone being scanned + FScanPtr : PByte; //current scan address + FScanCurX,FScanCurY: integer; //current scan coordinates + + FClipRect: TRect; + FConvertToFPColor, FConvertFromFPColor, + FConvertToBGRA, FConvertFromBGRA, + FConvertToExpanded, FConvertFromExpanded: TBridgedConversion; + FPenStroker: TBGRACustomPenStroker; + + {** Specifies if linear antialiasing must be used when drawing + antialiased shapes } + FAntialiasingDrawMode: TDrawMode; + + procedure Init; virtual; + procedure ReallocData; virtual; + procedure FreeData; virtual; + + {TFPCustomImage} + procedure SetInternalColor(x, y: integer; const Value: TFPColor); override; + function GetInternalColor(x, y: integer): TFPColor; override; + procedure SetInternalPixel(x, y: integer; Value: integer); override; + function GetInternalPixel(x, y: integer): integer; override; + + function CheckEmpty: boolean; virtual; + function CheckIsZero: boolean; virtual; + function GetClipRect: TRect; virtual; + function GetDataBytePtr: PByte; virtual; + function GetHasSemiTransparentPixels: boolean; virtual; + function GetHasTransparentPixels: boolean; virtual; + function GetHeight: integer; virtual; + function GetLineOrder: TRawImageLineOrder; virtual; + procedure SetLineOrder(AValue: TRawImageLineOrder); virtual; + function GetNbPixels: integer; virtual; + function GetRefCount: integer; virtual; + function GetScanLineByte(y: integer): PByte; virtual; + function GetWidth: integer; virtual; + procedure SetClipRect(const AValue: TRect); virtual; + procedure RaiseInvalidBrushColorspace; virtual; + procedure RaiseMissingUniDrawer; virtual; + function CheckHorizLineBounds(var x:int32or64; y: int32or64; var x2: int32or64): boolean; inline; + function CheckVertLineBounds(x: int32or64; var y, y2: int32or64): boolean; inline; + class function DefaultColorspace: TColorspaceAny; virtual; + function InternalDuplicate(ACopyProperties: boolean=false): TCustomUniversalBitmap; virtual; + function InternalNew: TCustomUniversalBitmap; virtual; + procedure InternalCopyPixels(ASource,ADest: PByte; ASourceStride,ADestStride: PtrInt; ACount: integer); virtual; + procedure InternalSwapPixels(ABuf1,ABuf2: PByte; AStride1,AStride2: PtrInt; ACount: integer); virtual; + procedure InternalSetPixels(ASource,ADest: PByte; ADestStride: PtrInt; ACount: integer); virtual; + procedure AssignTransparentPixel(out ADest); virtual; + function GetLinearAntialiasing: boolean; virtual; + procedure SetLinearAntialiasing(AValue: boolean); virtual; + procedure SetAntialiasingDrawMode(AValue: TDrawMode); virtual; + + public + + {** User defined caption. It does not appear on the image } + Caption: string; + + {** Method to use when filling polygons (winding or alternate). + See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } + FillMode: TFillMode; + + {** Creates an image of width and height equal to zero. In this case, + ''DataByte'' = '''nil''' } + constructor Create; overload; + constructor Create(AColorspace: TColorspaceAny; ALineOrder: TRawImageLineOrder); overload; + constructor Create(AColorspace: TColorspaceAny; AWidth, AHeight: integer; + ALineOrder: TRawImageLineOrder); overload; + + procedure Assign(Source: TPersistent); override; + function NewBitmap: TCustomUniversalBitmap; overload; virtual; + function NewBitmap(AWidth, AHeight: integer): TCustomUniversalBitmap; overload; virtual; + function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TCustomUniversalBitmap; overload; virtual; + + {** Adds a reference (this reference count is not the same as + the reference count of an interface, it changes only by + explicit calls } + function NewReference: TCustomUniversalBitmap; virtual; + {** Free a reference. When the resulting reference count gets + to zero, the image is freed. The initial reference count + is equal to 1 } + procedure FreeReference; + {** Returns an object with a reference count equal to 1. Duplicate + this bitmap if necessary } + function GetUnique: TCustomUniversalBitmap; virtual; + function Duplicate(ACopyProperties: boolean=false): TCustomUniversalBitmap; virtual; + procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); virtual; + {** Get a part of the image with repetition in both directions. It means + that if the bounds are within the image, the result is just that part + of the image, but if the bounds are bigger than the image, the image + is tiled. } + function GetPart(const ARect: TRect): TCustomUniversalBitmap; virtual; + + procedure InvalidateBitmap; virtual; //call if you modify with Scanline + procedure LoadFromBitmapIfNeeded; virtual; //call to ensure that data is up to date + + {** Clear all channels of transparent pixels } + procedure ClearTransparentPixels; virtual; + + class procedure EraseBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AAlpha: Word); virtual; + class procedure AlphaBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AAlpha: Word); virtual; + procedure SolidBrushBGRA(out ABrush: TUniversalBrush; ARed,AGreen,ABlue,AAlpha: Byte; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; + procedure SolidBrushBGRA(out ABrush: TUniversalBrush; AColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; + procedure SolidBrushExpanded(out ABrush: TUniversalBrush; ARed,AGreen,ABlue,AAlpha: Word; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; + procedure SolidBrushExpanded(out ABrush: TUniversalBrush; AColor: TExpandedPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; + procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; + class procedure ScannerBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AScanner: IBGRAScanner; {%H-}ADrawMode: TDrawMode = dmDrawWithTransparency; + {%H-}AOffsetX: integer = 0; {%H-}AOffsetY: integer = 0); virtual; + class procedure MaskBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AScanner: IBGRAScanner; + {%H-}AOffsetX: integer = 0; {%H-}AOffsetY: integer = 0); virtual; + + {TFPCustomImage} + {** Creates a new bitmap, initialize properties and bitmap data } + constructor Create(AWidth, AHeight: integer); overload; override; + {** Sets the dimension of an existing bitmap /!\ Data can be random } + procedure SetSize(AWidth, AHeight: integer); override; + destructor Destroy; override; + + {==== Load and save files ====} + + {** Stores the image in the stream without compression nor header } + procedure Serialize(AStream: TStream); virtual; + {** Reads the image in a stream that was previously serialized } + procedure Deserialize(AStream: TStream); virtual; + {** Stores an empty image (of size zero) } + class procedure SerializeEmpty(AStream: TStream); static; + + //there are UTF8 functions that are different from standard function as those + //depend on TFPCustomImage that does not clearly handle UTF8 + + {** Load image from a file. ''filename'' is an ANSI string } + procedure LoadFromFile(const AFilename: string); overload; virtual; + procedure LoadFromFile(const AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; + {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } + procedure LoadFromFile(const AFilename:String; AHandler:TFPCustomImageReader); overload; virtual; + procedure LoadFromFile(const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; + {** Load image from a file. ''filename'' is an UTF8 string } + procedure LoadFromFileUTF8(const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; virtual; + {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } + procedure LoadFromFileUTF8(const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; virtual; + {** Load image from a stream. Format is detected automatically } + procedure LoadFromStream(AStream: TStream);overload; virtual; + procedure LoadFromStream(AStream: TStream; AOptions: TBGRALoadingOptions);overload; virtual; + {** Load image from a stream. The specified image reader is used } + procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader);overload; virtual; + procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);overload; virtual; + {** Load image from an embedded Lazarus resource. Format is detected automatically } + procedure LoadFromResource(AFilename: string); overload; virtual; + procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; + {** Load image from an embedded Lazarus resource. The specified image reader is used } + procedure LoadFromResource(AFilename: string; AHandler: TFPCustomImageReader); overload; virtual; + procedure LoadFromResource(AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; + + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + procedure SaveToFile(const AFilename: string);overload; virtual; + {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } + procedure SaveToFile(const AFilename: string; AHandler:TFPCustomImageWriter);overload; virtual; + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + procedure SaveToFileUTF8(const AFilenameUTF8: string);overload; virtual; + {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } + procedure SaveToFileUTF8(const AFilenameUTF8: string; AHandler:TFPCustomImageWriter);overload; virtual; + + {** Save image to a stream with the specified image writer }{inherited + procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter); + }{** Save image to a stream in the specified image format } + procedure SaveToStreamAs(AStream: TStream; AFormat: TBGRAImageFormat); virtual; + {** Save image to a stream in PNG format } + procedure SaveToStreamAsPng(AStream: TStream); virtual; + + {==== Clipping ====} + + {** Stop clipping (clipping rectangle becomes the whole image) } + procedure NoClip; virtual; + {** Reduce the clipping region further by intersection and returns the previous clipping rectangle } + function IntersectClip(const ARect: TRect): TRect; + {** Checks if the specified point is in the clipping rectangle ''ClipRect'' } + function PtInClipRect(x, y: int32or64): boolean; inline; + {** Check if the bounds are within the clipping rectangle and adjust the coordinates to fit + (similar to IntersectRect but may flip the coordinates) } + function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean; + + {==== Basic drawing functions ====} + + {** Fill the whole image regardless of clipping rect } + procedure Fill(const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure Fill(ATexture: IBGRAScanner; AMode: TDrawMode); overload; virtual; + procedure Fill(ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); overload; virtual; + procedure FillTransparent; virtual; + procedure AlphaFill(alpha: byte); virtual; + + {** Masking } + procedure ApplyMask(mask: TCustomUniversalBitmap; AAlpha: Word = 65535); overload; + procedure ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AAlpha: Word = 65535); overload; + procedure ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AMaskRectTopLeft: TPoint; AAlpha: Word = 65535); overload; virtual; + procedure ApplyGlobalOpacity(alpha: byte); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const ABrush: TUniversalBrush); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint); overload; virtual; + + {** Fills completely a rectangle, without any border } + procedure FillRect(ALeft, ATop, ARight, ABottom: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(const ARect: TRect; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(ALeft, ATop, ARight, ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(ALeft, ATop, ARight, ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word = 65535); overload; virtual; + procedure EraseRect(ALeft, ATop, ARight, ABottom: integer; alpha: byte); virtual; + procedure EraseRect(const ARect: TRect; alpha: byte); virtual; + procedure AlphaFillRect(ALeft, ATop, ARight, ABottom: integer; alpha: byte); virtual; + procedure AlphaFillRect(const ARect: TRect; alpha: byte); virtual; + procedure ApplyGlobalOpacity(ARect: TRect; alpha: byte); overload; virtual; + procedure DrawCheckers(ARect: TRect; const ABrushEven,ABrushOdd: TUniversalBrush; AGridWidth: integer = 8; AGridHeight: integer = 8); overload; virtual; + + {** Returns the address of a pixel. /!\ Does not check if the coordinates are valid. } + function GetPixelAddress(x,y: integer): PByte; virtual; + procedure SetPixelIndirect(x,y: int32or64; AColor: pointer); virtual; + procedure GetPixelIndirect(x,y: int32or64; AColor: pointer); virtual; + procedure GetPixelCycleIndirect(x,y: int32or64; AColor: pointer); virtual; + procedure DrawPixel(x,y: Int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure DrawPixel(x,y: Int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure DrawPixelF(x,y: single; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure DrawPixelF(x,y: single; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + {** Erase the content of the pixel by reducing the value of the + alpha channel. ''alpha'' specifies how much to decrease. + If the resulting alpha reaches zero, the content + is replaced by the transparent pixel } + procedure ErasePixel(x, y: int32or64; alpha: byte); virtual; + procedure ErasePixelF(x, y: single; alpha: byte); virtual; + {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the + pixel is replaced by the transparent pixel } + procedure AlphaPixel(x, y: int32or64; alpha: byte); virtual; + procedure AlphaPixelF(x, y: single; alpha: byte); virtual; + procedure HorizLine(x, y, x2: int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; + {** Draws an horizontal line at line ''y'' and + at columns ''x'' to ''x2'' included, using specified scanner + and the specified ''AMode'' } + procedure HorizLine(x, y, x2: int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure EraseHorizLine(x,y,x2: int32or64; alpha: byte); virtual; + procedure AlphaHorizLine(x,y,x2: int32or64; alpha: byte); virtual; + procedure VertLine(x, y, y2: int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure VertLine(x, y, y2: int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure EraseVertLine(x, y, y2: int32or64; alpha: byte); virtual; + procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); virtual; + + {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. + ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } + procedure DrawLine(x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawLine(x1, y1, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm + ''DrawLastPixel'' specifies if (x2,y2) must be drawn } + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + {** Draws an antialiased line with two brushes as dashes of length ''ADashLen''. + ''ADashPos'' can be used to specify the start dash position and to retrieve the dash position at the end + of the line, in order to draw a polyline with consistent dashes } + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + + {** Erases the line from (x1,y1) to (x2,y2) using Bresenham's algorithm. + ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing + is changed and if ''alpha'' = 255, all pixels become transparent. + ''DrawListPixel'' specifies if (x2,y2) must be changed } + procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; + {** Erases the line from (x1,y1) to (x2,y2) width antialiasing. + ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing + is changed and if ''alpha'' = 255, all pixels become transparent. + ''DrawListPixel'' specifies if (x2,y2) must be changed } + procedure EraseLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; + procedure AlphaLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; + procedure AlphaLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; + + procedure DrawPolyLine(const points: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); + procedure DrawPolyLineAntialias(const points: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; + procedure DrawPolyLineAntialias(const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; + procedure ErasePolyLine(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); + procedure ErasePolyLineAntialias(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); + procedure AlphaPolyLine(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); + procedure AlphaPolyLineAntialias(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); + + procedure DrawPolygon(const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); + procedure DrawPolygonAntialias(const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; + procedure DrawPolygonAntialias(const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; + procedure ErasePolygonOutline(const points: array of TPoint; alpha: byte); + procedure ErasePolygonOutlineAntialias(const points: array of TPoint; alpha: byte); + procedure AlphaPolygonOutline(const points: array of TPoint; alpha: byte); + procedure AlphaPolygonOutlineAntialias(const points: array of TPoint; alpha: byte); + + procedure DrawPathAliased(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure DrawPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + + {==== Rectangles (integer coordinates) ====} + {* The integer coordinates of rectangles interpreted such that + that the bottom/right pixels are not drawn. The width is equal + to x2-x, and pixels are drawn from x to x2-1. If x = x2, then nothing + is drawn. See [[BGRABitmap tutorial 13|coordinate system]]. + * These functions do not take into account current pen style/cap/join. + They draw a continuous 1-pixel width border } + + {** Draw the border of a rectangle } + procedure Rectangle(x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(x, y, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(const ARect: TRect; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + {** Draw a filled rectangle with a border } + procedure Rectangle(x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(const ARect: TRect; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + + procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure EraseRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; alpha: byte); virtual; + procedure AlphaFillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; alpha: byte); virtual; + + procedure EllipseInRect(ARect: TRect; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure EllipseInRect(ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure EllipseInRect(ARect: TRect; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillEllipseInRect(ARect: TRect; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; + procedure FillEllipseInRect(ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure EraseEllipseInRect(ARect: TRect; alpha: byte); virtual; + procedure AlphaFillEllipseInRect(ARect: TRect; alpha: byte); virtual; + + procedure FillShape(AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; + procedure FillShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); virtual; + procedure EraseShape(AShape: TBGRACustomFillInfo; alpha: byte); virtual; + procedure AlphaFillShape(AShape: TBGRACustomFillInfo; alpha: byte); virtual; + + procedure FillPoly(const APoints: array of TPointF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; + procedure FillPoly(const APoints: array of TPointF; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; + procedure ErasePoly(const APoints: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); virtual; + procedure AlphaFillPoly(const APoints: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); virtual; + + procedure FillPathAliased(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure FillPathAliased(APath: IBGRAPath; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure ErasePathAliased(APath: IBGRAPath; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; + procedure ErasePathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; + procedure AlphaFillPathAliased(APath: IBGRAPath; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; + procedure AlphaFillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; + + property Colorspace: TColorspaceAny read FColorspace; + + procedure VerticalFlip; overload; virtual; + procedure VerticalFlip(ARect: TRect); overload; virtual; + procedure HorizontalFlip; overload; virtual; + procedure HorizontalFlip(ARect: TRect); overload; virtual; + procedure RotateUDInplace; overload; virtual; + procedure RotateUDInplace(ARect: TRect); overload; virtual; + + { Return a new bitmap rotated in a clock wise direction. } + function RotateCW: TCustomUniversalBitmap; virtual; + { Return a new bitmap rotated in a counter clock wise direction. } + function RotateCCW: TCustomUniversalBitmap; virtual; + { Return a new bitmap rotated 180° (upside down). } + function RotateUD: TCustomUniversalBitmap; virtual; + + {** Width of the image in pixels } + property Width: integer Read GetWidth; + {** Height of the image in pixels } + property Height: integer Read GetHeight; + + {** Size in bytes of a row of pixels } + property RowSize: PtrInt read FRowSize; + + {** Clipping rectangle for all drawing functions } + property ClipRect: TRect read GetClipRect write SetClipRect; + + property LinearAntialiasing: boolean read GetLinearAntialiasing write SetLinearAntialiasing; + property AntialiasingDrawMode: TDrawMode read FAntialiasingDrawMode write SetAntialiasingDrawMode; + + {** Total number of pixels. It is always true that ''NbPixels'' = ''Width'' * ''Height'' } + property NbPixels: integer Read GetNbPixels; + + {** Returns the address of the left-most pixel of any line. + The parameter y ranges from 0 to Height-1 } + property ScanLineByte[y: integer]: PByte Read GetScanLineByte; + + {** Indicates the order in which lines are stored in memory. + If it is equal to ''riloTopToBottom'', the first line is the top line. + If it is equal to ''riloBottomToTop'', the first line is the bottom line. + See [[BGRABitmap Miscellaneous types|miscellaneous types]] } + property LineOrder: TRawImageLineOrder Read GetLineOrder write SetLineOrder; + + {** Provides a pointer to the first pixel in memory. + Depending on the ''LineOrder'' property, this can be the top-left pixel or the bottom-left pixel. + There is no padding between scanlines. + See [[BGRABitmap tutorial 4]] } + property DataByte: PByte Read GetDataBytePtr; + + {** Number of references to this image. It is increased by the function + ''NewReference'' and decreased by the function ''FreeReference'' } + property RefCount: integer Read GetRefCount; + + {** Returns True if the bitmap only contains transparent pixels or has a size of zero } + property Empty: boolean Read CheckEmpty; + + {** Returns True if the bitmap is filled with zero values or has a size of zero } + property IsZero: boolean Read CheckIsZero; + + {** Returns True if there are transparent and so if the image would + be stored at least with an alpha channel of 1 bit } + property HasTransparentPixels: boolean Read GetHasTransparentPixels; + + {** Returns True if there are semitransparent pixels + and so if the image would be stored with an alpha channel of at least 8 bit } + property HasSemiTransparentPixels: boolean Read GetHasSemiTransparentPixels; + + {** Current reference white used for color conversion } + property ReferenceWhite: PXYZReferenceWhite read FReferenceWhite write FReferenceWhite; + + + {==== Pen style ====} + protected + function GetArrow: TBGRACustomArrow; virtual; + function GetLineCap: TPenEndCap; virtual; + function GetInternalPen: TBGRACustomPenStroker; virtual; + function GetPenStroker: TBGRACustomPenStroker; virtual; + procedure SetLineCap(AValue: TPenEndCap); virtual; + + public + {** You can use this class set pen style and generate strokes polygonal representations } + property Pen: TBGRACustomPenStroker read GetPenStroker; + {** How to draw the ends of a line (applies to arrow as well) } + property LineCap: TPenEndCap read GetLineCap write SetLineCap; + {** Properties of arrow ends } + property Arrow: TBGRACustomArrow read GetArrow; + + {==== Drawing lines and paths (floating point coordinates) ====} + {* These functions use the current pen style/cap/join. The parameter ''APenWidth'' + specifies the width of the line and the base unit for dashes. + See [[BGRABitmap tutorial 13|coordinate system]]. + * The coordinates are pixel-centered by default, so that when filling a rectangle, + if the supplied values are integers, the border will be half transparent. + If you want the border to be completely filled, you can subtract/add + 0.5 to the coordinates to include the remaining thin border. + See [[BGRABitmap tutorial 13|coordinate system]]. } + + {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join } + procedure DrawLineAntialias(x1, y1, x2, y2: single; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; + {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join. + ''texture'' specifies the source color to use when filling the line } + procedure DrawLineAntialias(x1, y1, x2, y2: single; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; + {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join. + ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, + a space is left so that the next line can fit } + procedure DrawLineAntialias(x1, y1, x2, y2: single; const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); overload; virtual; + {** Same as above with ''texture'' specifying the source color to use when filling the line } + procedure DrawLineAntialias(x1, y1, x2, y2: single; ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); overload; virtual; + {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join } + procedure EraseLineAntialias(x1, y1, x2, y2: single; AAlpha: Byte; APenWidth: single); overload; virtual; + {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join. + ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, + a space is left so that the next line can fit } + procedure EraseLineAntialias(x1, y1, x2, y2: single; AAlpha: Byte; APenWidth: single; AClosedCap: boolean); overload; virtual; + + {** Draws a polyline using current pen style/cap/join } + procedure DrawPolyLineAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; + {** Draws a polyline using current pen style/cap/join. + ''texture'' specifies the source color to use when filling the line } + procedure DrawPolyLineAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; + {** Erases a polyline using current pen style/cap/join } + procedure ErasePolyLineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; + + {** Draws a polyline using current pen style/cap/join. + ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, + a space is left so that the next line can fit } + procedure DrawPolyLineAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); overload; virtual; + procedure DrawPolyLineAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); overload; virtual; + procedure ErasePolyLineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single; AClosedCap: boolean); overload; virtual; + + {** Draws a polyline using current pen style/cap/join. + The last point considered as a join with the first point if it has + the same coordinate } + procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; + {** Draws a polygon using current pen style/cap/join. Use a texture to fill the line. + The polygon is always closed. You don't need to set the last point + to be the same as the first point } + procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; + procedure ErasePolyLineAntialiasAutocycle(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; + + {** Draws a polygon using current pen style/cap/join. + The polygon is always closed. You don't need to set the last point + to be the same as the first point } + procedure DrawPolygonAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; + procedure DrawPolygonAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; + procedure ErasePolygonOutlineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; + + procedure RectangleAntialias(x, y, x2, y2: single; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; + procedure RectangleAntialias(x, y, x2, y2: single; ATexture: IBGRAScanner; AWidth: single); overload; virtual; + + {** Draws an ellipse without antialising. ''rx'' is the horizontal radius and + ''ry'' the vertical radius } + procedure Ellipse(x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word = 65535); overload; virtual; + procedure Ellipse(x, y, rx, ry: single; ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word = 65535); overload; virtual; + procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and + ''ry'' the vertical radius } + procedure EllipseAntialias(x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; + procedure EllipseAntialias(x, y, rx, ry: single; ATexture: IBGRAScanner; AWidth: single); overload; virtual; + procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; + procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single); overload; virtual; + + procedure DrawPath(APath: IBGRAPath; const ABrush: TUniversalBrush; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure DrawPath(APath: IBGRAPath; ATexture: IBGRAScanner; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + + {==== Antialias fill ====} + procedure FillShapeAntialias(AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush); overload; virtual; + procedure FillShapeAntialias(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner); overload; virtual; + procedure EraseShapeAntialias(AShape: TBGRACustomFillInfo; AAlpha: Byte); overload; virtual; + procedure FillPolyAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPolyAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure ErasePolyAntialias(const APoints: array of TPointF; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; + {** Fills an ellipse which axes are parallel to X and Y axes } + procedure FillEllipseAntialias(x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; virtual; + procedure FillEllipseAntialias(x, y, rx, ry: single; ATexture: IBGRAScanner); overload; virtual; + {** Erases the content of an ellipse which axes are parallel to X and Y axes } + procedure EraseEllipseAntialias(x, y, rx, ry: single; AAlpha: Byte); overload; virtual; + {** Fills an ellipse with any axes } + procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; virtual; + procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner); overload; virtual; + {** Erases the content of an ellipse with any axes } + procedure EraseEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; AAlpha: Byte); overload; virtual; + {** Fills a rectangle with antialiasing. Note that the pixel (x2,y2) is + included contrary to integer coordinates. For example (-0.5,-0.5,0.5,0.5) + with pixel-centered coords fills one pixel } + procedure FillRectAntialias(x, y, x2, y2: single; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRectAntialias(x, y, x2, y2: single; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure EraseRectAntialias(x, y, x2, y2: single; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRectAntialias(const ARectF: TRectF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRectAntialias(const ARectF: TRectF; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure EraseRectAntialias(const ARectF: TRectF; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; ATexture: IBGRAScanner; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure EraseRoundRectAntialias(x, y, x2, y2, rx, ry: single; AAlpha: Byte; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPath(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPath(APath: IBGRAPath; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure ErasePath(APath: IBGRAPath; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure ErasePath(APath: IBGRAPath; const AMatrix: TAffineMatrix; AAlpha: byte; APixelCenteredCoordinates: boolean = true); overload; virtual; + + protected {==== 'IBGRAScanner'' interface ====} + function ProvidesScanline({%H-}ARect: TRect): boolean; virtual; + function GetScanlineAt({%H-}X, {%H-}Y: integer): PBGRAPixel; virtual; + function GetTextureGL: IUnknown; virtual; + public + {** Offset to apply when the image is scanned } + ScanOffset: TPoint; + + function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual; + function ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; virtual; + procedure ScanMoveTo(X,Y: Integer); virtual; + function ScanNextPixel: TBGRAPixel; virtual; + function ScanNextExpandedPixel: TExpandedPixel; virtual; + function ScanAt(X,Y: Single): TBGRAPixel; virtual; + function ScanAtExpanded(X, Y: Single): TExpandedPixel; virtual; + function IsScanPutPixelsDefined: boolean; virtual; + procedure ScanPutPixels({%H-}pdest: PBGRAPixel; {%H-}count: integer; {%H-}mode: TDrawMode); virtual; + procedure ScanSkipPixels(ACount: integer); virtual; + function GetImageBounds: TRect; overload; virtual; + function GetImageBounds(Channel: TChannel; ANothingValue: Byte = 0): TRect; overload; + function GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; + function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; virtual; + function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; virtual; + function GetScanCustomColorspace: TColorspaceAny; virtual; + procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); virtual; + procedure ScanNextMaskChunk(var {%H-}ACount: integer; out {%H-}AMask: PByteMask; out {%H-}AStride: integer); virtual; + function ScanAtIntegerMask(X,Y: integer): TByteMask; virtual; + function ScanAtMask({%H-}X,{%H-}Y: Single): TByteMask; virtual; + + protected + //interface + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; + + public + procedure PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte = 255); virtual; + + public + //filters + function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; + function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; + function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; + function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; + function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; overload; virtual; + function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; overload; virtual; + function FilterCustomBlur(mask: TCustomUniversalBitmap): TCustomUniversalBitmap; overload; virtual; + function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TCustomUniversalBitmap; overload; virtual; + + end; + + { TCustomUniversalDrawer } + + TCustomUniversalDrawer = class + + {==== Load and save files ====} + + //there are UTF8 functions that are different from standard function as those + //depend on TFPCustomImage that does not clearly handle UTF8 + + {** Load image from a file. ''filename'' is an ANSI string } + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string); overload; virtual; abstract; + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader); overload; virtual; abstract; + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + {** Load image from a file. ''filename'' is an UTF8 string } + class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; virtual; abstract; + {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } + class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; virtual; abstract; + {** Load image from a stream. Format is detected automatically } + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream);overload; virtual; abstract; + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AOptions: TBGRALoadingOptions);overload; virtual; abstract; + {** Load image from a stream. The specified image reader is used } + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader);overload; virtual; abstract; + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + {** Load image from an embedded Lazarus resource. Format is detected automatically } + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string); overload; virtual; abstract; + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + {** Load image from an embedded Lazarus resource. The specified image reader is used } + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader); overload; virtual; abstract; + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; + + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string); overload; virtual; abstract; + {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } + class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string; AHandler:TFPCustomImageWriter); overload; virtual; abstract; + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); overload; virtual; abstract; + {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } + class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler:TFPCustomImageWriter); overload; virtual; abstract; + + {** Save image to a stream in the specified image format } + class procedure SaveToStreamAs(ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); virtual; abstract; + {** Save image to a stream in PNG format } + class procedure SaveToStreamAsPng(ASource: TCustomUniversalBitmap; AStream: TStream); virtual; abstract; + + {==== Pixelwise drawing ====} + + {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. + ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } + class procedure DrawLine(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); virtual; abstract; + {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm + ''DrawLastPixel'' specifies if (x2,y2) must be drawn } + class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; + {** Draws an antialiased line with two brushes as dashes of length ''ADashLen''. + ''ADashPos'' specifies the start dash position and allows to retrieve the dash position at the end + of the line, in order to draw a polyline with consistent dashes } + class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; + + class procedure DrawPolyLine(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); virtual; abstract; + class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; + class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; + + class procedure DrawPolygon(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; virtual; abstract; + + {** Draw the border of a rectangle } + class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; + {** Draw a filled rectangle with a border } + class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; + + class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; + class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; + class procedure FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; + + class procedure FillShape(ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; + class procedure FillPoly(ADest: TCustomUniversalBitmap; const APoints: array of TPointF; AFillMode: TFillMode; ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); virtual; abstract; + + {==== Using pen ====} + class function CreatePenStroker: TBGRACustomPenStroker; virtual; abstract; + class function CreateArrow: TBGRACustomArrow; virtual; abstract; + + class procedure RectangleAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; + const ABrush: TUniversalBrush; AWidth: single); virtual; abstract; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; + const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; + + class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; virtual; abstract; + class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; virtual; abstract; + class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; + class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; + + {==== Filling ====} + class procedure FillRectAntialias(ADest: TCustomUniversalBitmap; + x, y, x2, y2: single; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean = true); virtual; abstract; + class procedure FillRoundRectAntialias(ADest: TCustomUniversalBitmap; + x,y,x2,y2, rx,ry: single; const ABrush: TUniversalBrush; + AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); virtual; abstract; + class procedure FillShapeAntialias(ADest: TCustomUniversalBitmap; + AShape: TBGRACustomFillInfo; AFillMode: TFillMode; + ABrush: TUniversalBrush); virtual; abstract; + class procedure FillPolyAntialias(ADest: TCustomUniversalBitmap; + const APoints: array of TPointF; AFillMode: TFillMode; + ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); virtual; abstract; + class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; + x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; virtual; abstract; + class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; + const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; virtual; abstract; + + //filters + class procedure FilterBlurRadial(ASource: TCustomUniversalBitmap; const ABounds: TRect; + radiusX, radiusY: single; blurType: TRadialBlurType; + ADest: TCustomUniversalBitmap); virtual; abstract; + class procedure FilterBlurMotion(ASource: TCustomUniversalBitmap; const ABounds: TRect; + distance: single; angle: single; oriented: boolean; + ADest: TCustomUniversalBitmap); virtual; abstract; + class procedure FilterCustomBlur(ASource: TCustomUniversalBitmap; const ABounds: TRect; + mask: TCustomUniversalBitmap; + ADest: TCustomUniversalBitmap); virtual; abstract; + + end; + TUniversalDrawerAny = class of TCustomUniversalDrawer; + +var + UniDrawerClass: TUniversalDrawerAny; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{ TUniversalBrush } + +function TUniversalBrush.GetDoesNothing: boolean; +begin + result := (Flags and UniversalBrushFlag_DoNothing) <> 0; +end; + +procedure TUniversalBrush.SetColorspace(AValue: TColorspaceAny); +begin + FColorspace:=AValue; + InternalInitContext:= nil; + InternalPutNextPixels := nil; + Flags := 0; +end; + +procedure TUniversalBrush.SetDoesNothing(AValue: boolean); +begin + if AValue then Flags := Flags or UniversalBrushFlag_DoNothing + else Flags := Flags and not UniversalBrushFlag_DoNothing; +end; + +procedure TUniversalBrush.MoveTo(AContext: PUniBrushContext; ADest: pointer; + AOfsX, AOfsY: integer); +begin + with AContext^ do + begin + AContext^.Dest:= ADest; + AContext^.Ofs.X := AOfsX; + AContext^.Ofs.Y := AOfsY; + end; + if Assigned(InternalInitContext) then + InternalInitContext(@FixedData, AContext); +end; + +procedure TUniversalBrush.PutNextPixels(AContext: PUniBrushContext; + AAlpha: Word; ACount: integer); +begin + InternalPutNextPixels(@FixedData, AContext, AAlpha, ACount); +end; + +{ TCustomUniversalBitmap } + +function TCustomUniversalBitmap.CheckEmpty: boolean; +var + alphaIdx, i: Integer; + p: PByte; +begin + alphaIdx := Colorspace.IndexOfAlphaChannel; + if (alphaIdx=-1) or (FDataByte=nil) then exit(false); + p := FDataByte; + for i := NbPixels-1 downto 0 do + begin + if Colorspace.GetColorTransparency(p) <> ctFullyTransparent then exit(true); + inc(p, FPixelSize); + end; + exit(false); +end; + +function TCustomUniversalBitmap.CheckIsZero: boolean; +var + i, dataSize: PtrInt; + p: PByte; +begin + p := DataByte; + if p = nil then exit(true); + dataSize := FNbPixels*IntPtr(FPixelSize); + for i := (dataSize shr 3) - 1 downto 0 do + begin + if PQWord(p)^ <> 0 then exit(false); + Inc(p,8); + end; + for i := (dataSize and 7) - 1 downto 0 do + begin + if PByte(p)^ <> 0 then exit(false); + inc(p); + end; + Result := True; +end; + +function TCustomUniversalBitmap.GetClipRect: TRect; +begin + result := FClipRect; +end; + +function TCustomUniversalBitmap.GetDataBytePtr: PByte; +begin + LoadFromBitmapIfNeeded; + result := FDataByte; +end; + +function TCustomUniversalBitmap.GetHasSemiTransparentPixels: boolean; +var + alphaIdx, i: Integer; + p: PByte; +begin + alphaIdx := Colorspace.IndexOfAlphaChannel; + if (alphaIdx=-1) or (FDataByte=nil) then exit(false); + p := FDataByte; + for i := NbPixels-1 downto 0 do + begin + if Colorspace.GetColorTransparency(p) = ctSemiTransparent then exit(true); + inc(p, FPixelSize); + end; + exit(false); +end; + +function TCustomUniversalBitmap.GetHasTransparentPixels: boolean; +var + alphaIdx, i: Integer; + p: PByte; +begin + alphaIdx := Colorspace.IndexOfAlphaChannel; + if (alphaIdx=-1) or (FDataByte=nil) then exit(false); + p := FDataByte; + for i := NbPixels-1 downto 0 do + begin + if Colorspace.GetColorTransparency(p) <> ctFullyOpaque then exit(true); + inc(p, FPixelSize); + end; + exit(false); +end; + +function TCustomUniversalBitmap.GetHeight: integer; +begin + result := FHeight; +end; + +function TCustomUniversalBitmap.GetLineOrder: TRawImageLineOrder; +begin + result := FLineOrder; +end; + +function TCustomUniversalBitmap.GetNbPixels: integer; +begin + result := FNbPixels; +end; + +function TCustomUniversalBitmap.GetRefCount: integer; +begin + result := FRefCount; +end; + +function TCustomUniversalBitmap.GetPixelAddress(x,y: integer): PByte; +begin + Result := FDataByte; + if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; + Inc(Result, FRowSize * y + IntPtr(FPixelSize)*x); +end; + +function TCustomUniversalBitmap.GetScanLineByte(y: integer): PByte; +begin + if (y < 0) or (y >= FHeight) then + raise ERangeError.Create('Scanline: out of bounds') + else + begin + LoadFromBitmapIfNeeded; + if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; + Result := FDataByte + FRowSize*y; + end; +end; + +function TCustomUniversalBitmap.GetWidth: integer; +begin + result := FWidth; +end; + +procedure TCustomUniversalBitmap.SetClipRect(const AValue: TRect); +begin + FClipRect := TRect.Intersect(AValue, Rect(0,0,Width,Height)); +end; + +procedure TCustomUniversalBitmap.RaiseInvalidBrushColorspace; +begin + raise exception.Create('Brush is not in '+Colorspace.GetName+' colorspace.'); +end; + +procedure TCustomUniversalBitmap.RaiseMissingUniDrawer; +begin + raise exception.Create('Universal drawer not found. Add UniversalDrawer to the uses clause.'); +end; + +function TCustomUniversalBitmap.CheckHorizLineBounds(var x:int32or64; y: int32or64; var x2: int32or64): boolean; +var + temp: int32or64; +begin + if (y < FClipRect.Top) or (y >= FClipRect.Bottom) then exit(false); + if (x2 < x) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (x >= FClipRect.Right) or (x2 < FClipRect.Left) then exit(false); + if x < FClipRect.Left then x := FClipRect.Left; + if x2 >= FClipRect.Right then x2 := FClipRect.Right - 1; + result := true; +end; + +function TCustomUniversalBitmap.CheckVertLineBounds(x: int32or64; var y,y2: int32or64): boolean; inline; +var + temp: int32or64; +begin + if (x < FClipRect.Left) or (x >= FClipRect.Right) then exit(false); + if (y2 < y) then + begin + temp := y; + y := y2; + y2 := temp; + end; + if (y >= FClipRect.Bottom) or (y2 < FClipRect.Top) then exit(false); + if y < FClipRect.Top then y := FClipRect.Top; + if y2 >= FClipRect.Bottom then y2 := FClipRect.Bottom - 1; + result := true; +end; + +class function TCustomUniversalBitmap.DefaultColorspace: TColorspaceAny; +begin + result := TBGRAPixelColorspace; +end; + +function TCustomUniversalBitmap.InternalDuplicate(ACopyProperties: boolean): TCustomUniversalBitmap; +begin + LoadFromBitmapIfNeeded; + result := InternalNew; + result.SetSize(FWidth,FHeight); + Move(FDataByte^, result.FDataByte^, FRowSize*FHeight); + result.InvalidateBitmap; + result.Caption := Caption; + if ACopyProperties then + CopyPropertiesTo(result); +end; + +function TCustomUniversalBitmap.InternalNew: TCustomUniversalBitmap; +begin + result := TCustomUniversalBitmap.Create(Colorspace, LineOrder); +end; + +procedure TCustomUniversalBitmap.ClearTransparentPixels; +var + alphaIdx, i: Integer; + p: PByte; +begin + alphaIdx := Colorspace.IndexOfAlphaChannel; + if (alphaIdx=-1) or (FDataByte=nil) then exit; + LoadFromBitmapIfNeeded; + p := FDataByte; + for i := NbPixels-1 downto 0 do + begin + if Colorspace.GetColorTransparency(p) = ctFullyTransparent then + AssignTransparentPixel(p^); + inc(p, FPixelSize); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.InternalCopyPixels(ASource, ADest: PByte; + ASourceStride, ADestStride: PtrInt; ACount: integer); +begin + while ACount>0 do + begin + move(ASource^, ADest^, FPixelSize); + inc(ASource, ASourceStride); + inc(ADest, ADestStride); + dec(ACount); + end; +end; + +procedure TCustomUniversalBitmap.InternalSwapPixels(ABuf1, ABuf2: PByte; + AStride1, AStride2: PtrInt; ACount: integer); +var temp: array[0..31] of byte; +begin + while ACount>0 do + begin + move(ABuf1^, {%H-}temp, FPixelSize); + move(ABuf2^, ABuf1^, FPixelSize); + move(temp, ABuf2^, FPixelSize); + inc(ABuf1, AStride1); + inc(ABuf2, AStride2); + dec(ACount); + end; +end; + +procedure TCustomUniversalBitmap.InternalSetPixels(ASource, ADest: PByte; + ADestStride: PtrInt; ACount: integer); +begin + while ACount>0 do + begin + move(ASource^, ADest^, FPixelSize); + inc(ADest, ADestStride); + dec(ACount); + end; +end; + +procedure TCustomUniversalBitmap.AssignTransparentPixel(out ADest); +begin + FillByte({%H-}ADest, FPixelSize, 0); +end; + +function TCustomUniversalBitmap.GetArrow: TBGRACustomArrow; +var + p: TBGRACustomPenStroker; +begin + p := GetInternalPen; + if p.Arrow = nil then + begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + p.Arrow := UniDrawerClass.CreateArrow; + p.Arrow.LineCap := LineCap; + p.ArrowOwned := true; + end; + result := p.Arrow; +end; + +function TCustomUniversalBitmap.GetLinearAntialiasing: boolean; +begin + result := FAntialiasingDrawMode in[dmLinearBlend,dmXor]; +end; + +function TCustomUniversalBitmap.GetLineCap: TPenEndCap; +begin + result := GetInternalPen.LineCap; +end; + +function TCustomUniversalBitmap.GetInternalPen: TBGRACustomPenStroker; +begin + if FPenStroker = nil then + begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + FPenStroker := UniDrawerClass.CreatePenStroker; + end; + result := FPenStroker; +end; + +function TCustomUniversalBitmap.GetPenStroker: TBGRACustomPenStroker; +begin + result := GetInternalPen; + if result.Arrow = nil then GetArrow; +end; + +procedure TCustomUniversalBitmap.PathStrokeAliasedCallback( + const APoints: array of TPointF; AClosed: boolean; AData: Pointer); +var pts: array of TPoint; + i: Integer; +begin + with TPathCallbackData(AData^) do + begin + setlength(pts, length(APoints)); + if PixelCenteredCoords then + begin + for i := 0 to high(pts) do + pts[i]:= APoints[i].Round; + end else + begin + for i := 0 to high(pts) do + pts[i]:= APoints[i].Floor; + end; + if AClosed then + UniDrawerClass.DrawPolygon(self, pts, BrushAddress^, Alpha) + else + UniDrawerClass.DrawPolyLine(self, pts, BrushAddress^, true, Alpha); + end; +end; + +procedure TCustomUniversalBitmap.PathStrokeAntialiasCallback( + const APoints: array of TPointF; AClosed: boolean; AData: Pointer); +var pts: array of TPointF; +begin + with TPathCallbackData(AData^) do + begin + if AClosed then + pts := GetInternalPen.ComputePolygon(APoints, Width) + else + pts := GetInternalPen.ComputePolyline(APoints, Width); + FillPolyAntialias(pts, BrushAddress^, PixelCenteredCoords); + end; +end; + +procedure TCustomUniversalBitmap.SetAntialiasingDrawMode(AValue: TDrawMode); +begin + if FAntialiasingDrawMode=AValue then Exit; + FAntialiasingDrawMode:=AValue; +end; + +procedure TCustomUniversalBitmap.SetLinearAntialiasing(AValue: boolean); +begin + if AValue then AntialiasingDrawMode:= dmLinearBlend + else AntialiasingDrawMode:= dmDrawWithTransparency; +end; + +procedure TCustomUniversalBitmap.SetLineCap(AValue: TPenEndCap); +begin + if AValue <> GetInternalPen.LineCap then + begin + GetInternalPen.LineCap := AValue; + if Assigned(GetInternalPen.Arrow) then + GetInternalPen.Arrow.LineCap := AValue; + end; +end; + +procedure TCustomUniversalBitmap.FillPolyAntialias( + const APoints: array of TPointF; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillPolyAntialias(self, APoints, FillMode, + ABrush, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPolyAntialias( + const APoints: array of TPointF; ATexture: IBGRAScanner; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillPolyAntialias(APoints, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.ErasePolyAntialias( + const APoints: array of TPointF; AAlpha: Byte; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillPolyAntialias(APoints, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; + const ABrush: TUniversalBrush); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillEllipseAntialias(self, x,y,rx,ry, ABrush); +end; + +procedure TCustomUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; + ATexture: IBGRAScanner); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillEllipseAntialias(x, y, rx, ry, b); +end; + +procedure TCustomUniversalBitmap.EraseEllipseAntialias(x, y, rx, ry: single; + AAlpha: Byte); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillEllipseAntialias(x, y, rx, ry, b); +end; + +procedure TCustomUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; const ABrush: TUniversalBrush); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillEllipseAntialias(self, AOrigin, AXAxis, AYAxis, ABrush); +end; + +procedure TCustomUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; ATexture: IBGRAScanner); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); +end; + +procedure TCustomUniversalBitmap.EraseEllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; AAlpha: Byte); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); +end; + +procedure TCustomUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillRectAntialias(self, x,y,x2,y2, ABrush,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; + ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AntialiasingDrawMode); + FillRectAntialias(x,y,x2,y2, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.EraseRectAntialias(x, y, x2, y2: single; + AAlpha: Byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillRectAntialias(x,y,x2,y2, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillRectAntialias(const ARectF: TRectF; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); +begin + FillRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, + ABrush, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillRectAntialias(const ARectF: TRectF; + ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); +begin + FillRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, + ATexture, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.EraseRectAntialias(const ARectF: TRectF; + AAlpha: Byte; APixelCenteredCoordinates: boolean); +begin + EraseRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, + AAlpha, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, + ry: single; const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions; + APixelCenteredCoordinates: boolean); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillRoundRectAntialias(self, x,y,x2,y2, rx,ry, ABrush, AOptions, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, + ry: single; ATexture: IBGRAScanner; AOptions: TRoundRectangleOptions; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AntialiasingDrawMode, 0, 0); + FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx, + ry: single; AAlpha: Byte; AOptions: TRoundRectangleOptions; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); +begin + FillPolyAntialias(APath.getPoints,ABrush,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; + ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillPath(APath, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean); +begin + FillPolyAntialias(APath.getPoints(AMatrix), ABrush,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillPath(APath,AMatrix, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.ErasePath(APath: IBGRAPath; AAlpha: Byte; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillPath(APath, b, APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.ErasePath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; AAlpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillPath(APath,AMatrix, b, APixelCenteredCoordinates); +end; + +function TCustomUniversalBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + FConvertToBGRA.Convert(GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), + PositiveMod(Y+ScanOffset.Y, FScanHeight)), + @result, 1, FPixelSize, sizeof(TBGRAPixel), nil) + else + result := BGRAPixelTransparent; +end; + +function TCustomUniversalBitmap.ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + FConvertToExpanded.Convert(GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), + PositiveMod(Y+ScanOffset.Y, FScanHeight)), + @result, 1, FPixelSize, sizeof(TExpandedPixel), nil) + else + result := ExpandedPixelTransparent; +end; + +procedure TCustomUniversalBitmap.ScanMoveTo(X, Y: Integer); +begin + if (FScanWidth = 0) or (FScanHeight = 0) then exit; + LoadFromBitmapIfNeeded; + FScanCurX := PositiveMod(X+ScanOffset.X, FScanWidth); + FScanCurY := PositiveMod(Y+ScanOffset.Y, FScanHeight); + FScanPtr := GetPixelAddress(FScanCurX,FScanCurY); +end; + +function TCustomUniversalBitmap.ScanNextPixel: TBGRAPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + begin + FConvertToBGRA.Convert(FScanPtr, @result, 1, FPixelSize, sizeof(TBGRAPixel), nil); + inc(FScanCurX); + inc(FScanPtr, FPixelSize); + if FScanCurX = FScanWidth then //cycle + begin + FScanCurX := 0; + dec(FScanPtr, FRowSize); + end; + end + else + result := BGRAPixelTransparent; +end; + +function TCustomUniversalBitmap.ScanNextExpandedPixel: TExpandedPixel; +begin + if (FScanWidth <> 0) and (FScanHeight <> 0) then + begin + FConvertToExpanded.Convert(FScanPtr, @result, 1, FPixelSize, sizeof(TExpandedPixel), nil); + inc(FScanCurX); + inc(FScanPtr, FPixelSize); + if FScanCurX = FScanWidth then //cycle + begin + FScanCurX := 0; + dec(FScanPtr, FRowSize); + end; + end + else + result := BGRAPixelTransparent; +end; + +function TCustomUniversalBitmap.ScanAt(X, Y: Single): TBGRAPixel; +begin + result := ScanAtInteger(round(X),round(Y)); +end; + +function TCustomUniversalBitmap.ScanAtExpanded(X, Y: Single): TExpandedPixel; +begin + result := ScanAtIntegerExpanded(round(X),round(Y)); +end; + +function TCustomUniversalBitmap.IsScanPutPixelsDefined: boolean; +begin + result := False; +end; + +procedure TCustomUniversalBitmap.ScanPutPixels(pdest: PBGRAPixel; + count: integer; mode: TDrawMode); +begin + //do nothing +end; + +procedure TCustomUniversalBitmap.ScanSkipPixels(ACount: integer); +var + fit: Integer; +begin + if (FScanWidth <= 0) or (FScanHeight <= 0) then exit; + if ACount >= FScanWidth then ACount := PositiveMod(ACount, FScanWidth); + fit := FScanWidth-FScanCurX; + if ACount >= fit then + begin + dec(ACount, fit); + dec(FScanPtr, FScanCurX*PtrInt(FPixelSize)); + FScanCurX := 0; + end; + inc(FScanCurX, ACount); + inc(FScanPtr, ACount*PtrInt(FPixelSize)); +end; + +function TCustomUniversalBitmap.GetImageBounds: TRect; +begin + result := GetImageBounds(cAlpha); +end; + +function TCustomUniversalBitmap.GetImageBounds(Channel: TChannel; + ANothingValue: Byte): TRect; +begin + result := GetImageBoundsWithin(rect(0,0,Width,Height), Channel, ANothingValue); +end; + +function TCustomUniversalBitmap.GetImageBounds(Channels: TChannels; + ANothingValue: Byte): TRect; +begin + result := GetImageBoundsWithin(rect(0,0,Width,Height), Channels, ANothingValue); +end; + +function TCustomUniversalBitmap.ProvidesScanline(ARect: TRect): boolean; +begin + result := false; +end; + +function TCustomUniversalBitmap.GetScanlineAt(X, Y: integer): PBGRAPixel; +begin + result := nil; +end; + +function TCustomUniversalBitmap.GetTextureGL: IUnknown; +begin + result := nil; +end; + +function TCustomUniversalBitmap.GetImageBoundsWithin(const ARect: TRect; + Channel: TChannel; ANothingValue: Byte): TRect; +var + idxChannel: Integer; + actualRect: TRect; + maxx, maxy, minx, miny, yb, xb, xb2: LongInt; + p: PByte; + minValueF, nothingValueF: Single; +begin + case Channel of + cAlpha: idxChannel := Colorspace.IndexOfAlphaChannel; + cRed: idxChannel := Colorspace.IndexOfChannel('Red'); + cGreen: idxChannel := Colorspace.IndexOfChannel('Green'); + cBlue: idxChannel := Colorspace.IndexOfChannel('Blue'); + else raise exception.Create('Unexpected channel'); + end; + if (idxChannel = -1) and (Channel in [cRed,cGreen,cBlue]) then + idxChannel := Colorspace.IndexOfChannel('Gray'); + if idxChannel = -1 then raise exception.Create('Channel not found'); + minValueF := Colorspace.GetMinValue(idxChannel); + nothingValueF := (ANothingValue - minValueF)/(Colorspace.GetMaxValue(idxChannel)-minValueF); + actualRect := TRect.Intersect(ARect, rect(0,0,Width,Height)); + maxx := actualRect.Left-1; + maxy := actualRect.Top-1; + minx := actualRect.Right; + miny := actualRect.Bottom; + for yb := actualRect.Top to actualRect.Bottom-1 do + begin + p := GetPixelAddress(actualRect.Left,yb); + for xb := actualRect.Left to actualRect.Right - 1 do + begin + if Colorspace.GetChannel(p, idxChannel) <> nothingValueF then + begin + if xb < minx then + minx := xb; + if yb < miny then + miny := yb; + if xb > maxx then + maxx := xb; + if yb > maxy then + maxy := yb; + + inc(p, (actualRect.Right-1-xb)*FPixelSize); + for xb2 := actualRect.Right-1 downto xb+1 do + begin + if Colorspace.GetChannel(p, idxChannel) <> nothingValueF then + begin + if xb2 > maxx then + maxx := xb2; + break; + end; + dec(p, FPixelSize); + end; + break; + end; + Inc(p, FPixelSize); + end; + end; + if minx > maxx then + begin + Result.left := 0; + Result.top := 0; + Result.right := 0; + Result.bottom := 0; + end + else + begin + Result.left := minx; + Result.top := miny; + Result.right := maxx + 1; + Result.bottom := maxy + 1; + end; +end; + +function TCustomUniversalBitmap.GetImageBoundsWithin(const ARect: TRect; + Channels: TChannels; ANothingValue: Byte): TRect; +var + c: TChannel; + resultForChannel: TRect; +begin + result := EmptyRect; + for c := low(TChannel) to high(TChannel) do + begin + if c in Channels then + begin + resultForChannel := GetImageBoundsWithin(ARect, c, ANothingValue); + if result.IsEmpty then result := resultForChannel + else result.Union(resultForChannel); + end; + end; +end; + +function TCustomUniversalBitmap.GetScanCustomColorspace: TColorspaceAny; +begin + result := Colorspace; +end; + +procedure TCustomUniversalBitmap.ScanNextCustomChunk(var ACount: integer; out + APixels: Pointer); +var + quantity: Integer; +begin + if (FScanWidth = 0) or (FScanHeight = 0) then raise exception.Create('Zero size scanner'); + APixels := FScanPtr; + quantity := FScanWidth-FScanCurX; + if ACount <= quantity then + quantity := ACount + else ACount := quantity; + Inc(FScanPtr, quantity*PtrInt(FPixelSize)); + inc(FScanCurX, quantity); + if FScanCurX = FWidth then + begin + FScanCurX := 0; + Dec(FScanPtr, RowSize); + end; +end; + +procedure TCustomUniversalBitmap.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); +begin + raise exception.Create('This bitmap does not provide a mask.'); +end; + +function TCustomUniversalBitmap.ScanAtIntegerMask(X,Y: integer): TByteMask; +begin + result := ScanAtMask(X,Y); +end; + +function TCustomUniversalBitmap.ScanAtMask(X,Y: Single): TByteMask; +begin + result.gray := 0; + raise exception.Create('This bitmap does not provide a mask.'); +end; + +{ Interface gateway } +function TCustomUniversalBitmap.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + if GetInterface(iid, obj) then + Result := S_OK + else + Result := longint(E_NOINTERFACE); +end; + +{ There is no automatic reference counting, but it is compulsory to define these functions } +function TCustomUniversalBitmap._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +function TCustomUniversalBitmap._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; +begin + result := 0; +end; + +procedure TCustomUniversalBitmap.PutImage(X, Y: integer; + ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte); +var + oldOfs: TPoint; +begin + if (ASource = nil) or (AOpacity = 0) then exit; + oldOfs := ASource.ScanOffset; + ASource.ScanOffset := Point(-X,-Y); + FillRect(RectWithSize(X,Y,ASource.Width,ASource.Height), ASource, AMode, AOpacity + (AOpacity shl 8)); + ASource.ScanOffset := oldOfs; +end; + +function TCustomUniversalBitmap.FilterBlurRadial(radius: single; + blurType: TRadialBlurType): TCustomUniversalBitmap; +begin + Result := FilterBlurRadial(rect(0,0,Width,Height), radius,radius, blurType); +end; + +function TCustomUniversalBitmap.FilterBlurRadial(const ABounds: TRect; + radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; +begin + Result := FilterBlurRadial(ABounds, radius,radius, blurType); +end; + +function TCustomUniversalBitmap.FilterBlurRadial(radiusX, radiusY: single; + blurType: TRadialBlurType): TCustomUniversalBitmap; +begin + Result := FilterBlurRadial(rect(0,0,Width,Height), radiusX,radiusY, blurType); +end; + +function TCustomUniversalBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, + radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); + UniDrawerClass.FilterBlurRadial(self, ABounds, radiusX,radiusY, blurType, result); +end; + +function TCustomUniversalBitmap.FilterBlurMotion(distance: single; + angle: single; oriented: boolean): TCustomUniversalBitmap; +begin + result := FilterBlurMotion(rect(0,0,Width,Height), distance, angle, oriented); +end; + +function TCustomUniversalBitmap.FilterBlurMotion(const ABounds: TRect; + distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); + UniDrawerClass.FilterBlurMotion(self, ABounds, distance, angle, oriented, result); +end; + +function TCustomUniversalBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap): TCustomUniversalBitmap; +begin + result := FilterCustomBlur(rect(0,0,Width,Height), mask); +end; + +function TCustomUniversalBitmap.FilterCustomBlur(const ABounds: TRect; + mask: TCustomUniversalBitmap): TCustomUniversalBitmap; +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); + UniDrawerClass.FilterCustomBlur(self, ABounds, mask, result); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + const ABrush: TUniversalBrush; APenWidth: single); +begin + FillPolyAntialias(GetInternalPen.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth), ABrush); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + ATexture: IBGRAScanner; APenWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawLineAntialias(x1,y1,x2,y2, b,APenWidth); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); +begin + FillPolyAntialias(GetInternalPen.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,AClosedCap), ABrush); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawLineAntialias(x1,y1,x2,y2, b,APenWidth, AClosedCap); +end; + +procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: single; + AAlpha: Byte; APenWidth: single); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + DrawLineAntialias(x1,y1,x2,y2, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: single; + AAlpha: Byte; APenWidth: single; AClosedCap: boolean); +var + b: TUniversalBrush; + c: TBGRAPixel; + p: TBGRACustomPenStroker; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + c := BGRA(0,0,0, AAlpha); + p := GetInternalPen; + FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c,AClosedCap), b); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; const ABrush: TUniversalBrush; + APenWidth: single); +begin + FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth),ABrush); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPolyLineAntialias(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.ErasePolyLineAntialias( + const APoints: array of TPointF; AAlpha: byte; APenWidth: single); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + DrawPolyLineAntialias(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; const ABrush: TUniversalBrush; + APenWidth: single; AClosedCap: boolean); +begin + FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth,AClosedCap),ABrush); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single; + AClosedCap: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPolyLineAntialias(APoints, b, APenWidth, AClosedCap); +end; + +procedure TCustomUniversalBitmap.ErasePolyLineAntialias( + const APoints: array of TPointF; AAlpha: byte; APenWidth: single; + AClosedCap: boolean); +var + b: TUniversalBrush; + c: TBGRAPixel; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + c := BGRA(0,0,0, AAlpha); + FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth,c,AClosedCap), b); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialiasAutocycle( + const APoints: array of TPointF; const ABrush: TUniversalBrush; + APenWidth: single); +begin + FillPolyAntialias(GetInternalPen.ComputePolylineAutoCycle(APoints,APenWidth),ABrush); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialiasAutocycle( + const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.ErasePolyLineAntialiasAutocycle( + const APoints: array of TPointF; AAlpha: byte; APenWidth: single); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.DrawPolygonAntialias( + const APoints: array of TPointF; const ABrush: TUniversalBrush; + APenWidth: single); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolygonAntialias(self, GetInternalPen, APoints, ABrush, APenWidth); +end; + +procedure TCustomUniversalBitmap.DrawPolygonAntialias( + const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPolygonAntialias(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.ErasePolygonOutlineAntialias( + const APoints: array of TPointF; AAlpha: byte; APenWidth: single); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + DrawPolygonAntialias(APoints, b, APenWidth); +end; + +procedure TCustomUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; + const ABrush: TUniversalBrush; AWidth: single); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.RectangleAntialias(self, GetInternalPen, x, y, x2, y2, ABrush, AWidth); +end; + +procedure TCustomUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; + ATexture: IBGRAScanner; AWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AntialiasingDrawMode); + RectangleAntialias(x,y,x2,y2, b, AWidth); +end; + +procedure TCustomUniversalBitmap.Ellipse(x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.Ellipse(self, GetInternalPen, x,y,rx,ry, ABrush, AWidth, AAlpha); +end; + +procedure TCustomUniversalBitmap.Ellipse(x, y, rx, ry: single; + ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode); + Ellipse(x,y,rx,ry, b, AWidth, AAlpha); +end; + +procedure TCustomUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.Ellipse(self, GetInternalPen, AOrigin, AXAxis, AYAxis, ABrush, AWidth, AAlpha); +end; + +procedure TCustomUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; + ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode); + Ellipse(AOrigin, AXAxis, AYAxis, b,AWidth,AAlpha); +end; + +procedure TCustomUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.EllipseAntialias(self, GetInternalPen, x,y,rx,ry, ABrush, AWidth); +end; + +procedure TCustomUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; + ATexture: IBGRAScanner; AWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + EllipseAntialias(x,y,rx,ry, b, AWidth); +end; + +procedure TCustomUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.EllipseAntialias(self, GetInternalPen, AOrigin, AXAxis, AYAxis, ABrush, AWidth); +end; + +procedure TCustomUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + EllipseAntialias(AOrigin, AXAxis, AYAxis, b,AWidth); +end; + +procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; + const ABrush: TUniversalBrush; AWidth: single; + APixelCenteredCoordinates: boolean); +var + data: TPathCallbackData; +begin + if ABrush.DoesNothing then exit; + if UniDrawerClass=nil then RaiseMissingUniDrawer; + data.BrushAddress := @ABrush; + data.Alpha:= 65535; + data.Width:= AWidth; + data.PixelCenteredCoords := APixelCenteredCoordinates; + APath.stroke(@PathStrokeAntialiasCallback, @data); +end; + +procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; + ATexture: IBGRAScanner; AWidth: single; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPath(APath, b,AWidth,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; AWidth: single; + APixelCenteredCoordinates: boolean); +var + data: TPathCallbackData; +begin + if ABrush.DoesNothing then exit; + if UniDrawerClass=nil then RaiseMissingUniDrawer; + data.BrushAddress := @ABrush; + data.Alpha:= 65535; + data.Width:= AWidth; + data.PixelCenteredCoords := APixelCenteredCoordinates; + APath.stroke(@PathStrokeAntialiasCallback, AMatrix, @data); +end; + +procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + DrawPath(APath,AMatrix, b,AWidth,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillShapeAntialias( + AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillShapeAntialias(self, AShape, FillMode, + ABrush); +end; + +procedure TCustomUniversalBitmap.FillShapeAntialias( + AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AntialiasingDrawMode); + FillShapeAntialias(AShape, b); +end; + +procedure TCustomUniversalBitmap.EraseShapeAntialias( + AShape: TBGRACustomFillInfo; AAlpha: Byte); +var + b: TUniversalBrush; +begin + EraseBrush(b, AAlpha + (AAlpha shl 8)); + FillShapeAntialias(AShape, b); +end; + +procedure TCustomUniversalBitmap.SetLineOrder(AValue: TRawImageLineOrder); +begin + FLineOrder:= AValue; +end; + +procedure TCustomUniversalBitmap.Init; +begin + FRefCount := 1; + if FColorspace = nil then FColorspace := DefaultColorspace; + FPixelSize := FColorspace.GetSize; + FConvertToFPColor:= FColorspace.GetBridgedConversion(TFPColorColorspace); + FConvertFromFPColor:= TFPColorColorspace.GetBridgedConversion(FColorspace); + FConvertToBGRA := FColorspace.GetBridgedConversion(TBGRAPixelColorspace); + FConvertFromBGRA := TBGRAPixelColorspace.GetBridgedConversion(FColorspace); + FConvertToExpanded := FColorspace.GetBridgedConversion(TExpandedPixelColorspace); + FConvertFromExpanded := TExpandedPixelColorspace.GetBridgedConversion(FColorspace); + FReferenceWhite := nil; + FWidth := 0; + FHeight := 0; + + FScanWidth := 0; + FScanHeight:= 0; + ScanOffset := Point(0,0); + FScanPtr := nil; + FScanCurX:= 0; + FScanCurY:= 0; + + FNbPixels := 0; + FRowSize := 0; + FDataByte := nil; + FLineOrder := riloTopToBottom; + FClipRect := EmptyRect; + FillMode := fmWinding; + FAntialiasingDrawMode:= dmDrawWithTransparency; + FPenStroker := nil; +end; + +procedure TCustomUniversalBitmap.InvalidateBitmap; +begin + //not linked to a bitmap +end; + +procedure TCustomUniversalBitmap.LoadFromBitmapIfNeeded; +begin + //not linked to a bitmap +end; + +class procedure TCustomUniversalBitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + raise exception.Create('Erase brush not implemented'); +end; + +class procedure TCustomUniversalBitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + raise exception.Create('Alpha brush not implemented'); +end; + +procedure TCustomUniversalBitmap.SolidBrushBGRA(out ABrush: TUniversalBrush; + ARed, AGreen, ABlue, AAlpha: Byte; ADrawMode: TDrawMode); +var c: TBGRAPixel; + c2: array[0..31] of byte; +begin + c.red := ARed; c.green := AGreen; c.blue := ABlue; c.alpha := AAlpha; + FConvertFromBGRA.Convert(@c,@c2,1,sizeof(c),FPixelSize,FReferenceWhite); + SolidBrushIndirect(ABrush, @c2, ADrawMode); +end; + +procedure TCustomUniversalBitmap.SolidBrushBGRA(out ABrush: TUniversalBrush; + AColor: TBGRAPixel; ADrawMode: TDrawMode); +var + c2: array[0..31] of byte; +begin + FConvertFromBGRA.Convert(@AColor,@c2,1,sizeof(AColor),FPixelSize,FReferenceWhite); + SolidBrushIndirect(ABrush, @c2, ADrawMode); +end; + +procedure TCustomUniversalBitmap.SolidBrushExpanded(out + ABrush: TUniversalBrush; ARed, AGreen, ABlue, AAlpha: Word; + ADrawMode: TDrawMode); +var c: TExpandedPixel; + c2: array[0..31] of byte; +begin + c.red := ARed; c.green := AGreen; c.blue := ABlue; c.alpha := AAlpha; + FConvertFromExpanded.Convert(@c,@c2,1,sizeof(c),FPixelSize,FReferenceWhite); + SolidBrushIndirect(ABrush, @c2, ADrawMode); +end; + +procedure TCustomUniversalBitmap.SolidBrushExpanded(out + ABrush: TUniversalBrush; AColor: TExpandedPixel; ADrawMode: TDrawMode); +var + c2: array[0..31] of byte; +begin + FConvertFromExpanded.Convert(@AColor,@c2,1,sizeof(AColor),FPixelSize,FReferenceWhite); + SolidBrushIndirect(ABrush, @c2, ADrawMode); +end; + +procedure DefaultSolidBrushIndirectSkipPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +begin + inc(AContextData^.Dest, ACount*PtrInt(PDefaultSolidBrushIndirectFixedData(AFixedData)^.PixelSize)); +end; + +procedure DefaultSolidBrushIndirectSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PByte; +begin + if AAlpha < 32768 then + begin + inc(AContextData^.Dest, ACount*PtrInt(PDefaultSolidBrushIndirectFixedData(AFixedData)^.PixelSize)); + exit; + end; + pDest := AContextData^.Dest; + while ACount > 0 do + begin + with PDefaultSolidBrushIndirectFixedData(AFixedData)^ do + begin + move(Color, pDest^, PixelSize); + inc(pDest, PixelSize); + end; + dec(ACount); + end; + AContextData^.Dest := pDest; +end; + +procedure TCustomUniversalBitmap.SolidBrushIndirect(out ABrush: TUniversalBrush; + AColor: Pointer; ADrawMode: TDrawMode); +var + ct: TColorTransparency; +begin + if FPixelSize+4 > sizeof(ABrush.FixedData) then + raise exception.Create('Brush fixed data size too small'); + + ct := Colorspace.GetColorTransparency(AColor); + if (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and + (ct = ctSemiTransparent) then + raise exception.Create('Semi-tranparent drawing not handled by default brush') + else if ADrawMode = dmXor then + raise exception.Create('Xor mode not handled by default brush'); + + ABrush.Colorspace := Colorspace; + PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= FPixelSize; + + if (ADrawMode <> dmSet) and (ct <> ctFullyOpaque) then + begin + ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; + ABrush.DoesNothing:= true; + end + else + begin + move(AColor^, PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.Color, FPixelSize); + ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSetPixels + end; +end; + +class procedure TCustomUniversalBitmap.ScannerBrush(out + ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer = 0; AOffsetY: integer = 0); +begin + raise exception.Create('Scanner brush not implemented'); +end; + +class procedure TCustomUniversalBitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + raise exception.Create('Mask brush not implemented'); +end; + +procedure TCustomUniversalBitmap.ReallocData; +begin + ReAllocMem(FDataByte, FHeight * FRowSize); + if (FNbPixels > 0) and (FDataByte = nil) then + raise EOutOfMemory.Create('TUniversalBitmap: Not enough memory'); + InvalidateBitmap; + FScanPtr:= nil; +end; + +procedure TCustomUniversalBitmap.FreeData; +begin + Freemem(FDataByte); + FDataByte := nil; + FScanPtr:= nil; +end; + +function TCustomUniversalBitmap.CheckClippedRectBounds(var x, y, x2, y2: integer): boolean; +var + temp: integer; +begin + if (x > x2) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (y > y2) then + begin + temp := y; + y := y2; + y2 := temp; + end; + if (x >= FClipRect.Right) or (x2 <= FClipRect.Left) or (y >= FClipRect.Bottom) or (y2 <= FClipRect.Top) then + begin + result := false; + exit; + end; + if x < FClipRect.Left then + x := FClipRect.Left; + if x2 > FClipRect.Right then + x2 := FClipRect.Right; + if y < FClipRect.Top then + y := FClipRect.Top; + if y2 > FClipRect.Bottom then + y2 := FClipRect.Bottom; + if (x2 - x <= 0) or (y2 - y <= 0) then + begin + result := false; + exit; + end else + result := true; +end; + +function TCustomUniversalBitmap.PtInClipRect(x, y: int32or64): boolean; +begin + result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom); +end; + +procedure TCustomUniversalBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + FConvertFromFPColor.Convert(@Value, GetPixelAddress(x,y), + 1, sizeof(TFPColor), FPixelSize, FReferenceWhite); + InvalidateBitmap; +end; + +function TCustomUniversalBitmap.GetInternalColor(x, y: integer): TFPColor; +begin + if not PtInClipRect(x,y) then exit(colTransparent); + LoadFromBitmapIfNeeded; + FConvertToFPColor.Convert(GetPixelAddress(x,y), @result, + 1, FPixelSize, sizeof(TFPColor), FReferenceWhite); +end; + +procedure TCustomUniversalBitmap.SetInternalPixel(x, y: integer; Value: integer); +begin + SetInternalColor(x,y, Palette.Color[Value]); +end; + +function TCustomUniversalBitmap.GetInternalPixel(x, y: integer): integer; +begin + result := Palette.IndexOf(GetInternalColor(x,y)); +end; + +constructor TCustomUniversalBitmap.Create; +begin + Init; + inherited Create(0, 0); +end; + +constructor TCustomUniversalBitmap.Create(AColorspace: TColorspaceAny; + ALineOrder: TRawImageLineOrder); +begin + FColorspace := AColorspace; + Init; + FLineOrder:= ALineOrder; + inherited Create(0,0); +end; + +constructor TCustomUniversalBitmap.Create(AWidth, AHeight: integer); +begin + Init; + inherited Create(AWidth, AHeight); + if FDataByte<>nil then FillByte(FDataByte^, FHeight*FRowSize, 0); +end; + +constructor TCustomUniversalBitmap.Create(AColorspace: TColorspaceAny; AWidth, + AHeight: integer; ALineOrder: TRawImageLineOrder); +begin + FColorspace := AColorspace; + Init; + FLineOrder:= ALineOrder; + inherited Create(AWidth, AHeight); + if FDataByte<>nil then FillByte(FDataByte^, FHeight*FRowSize, 0); +end; + +procedure TCustomUniversalBitmap.Assign(Source: TPersistent); +var pdest: PByte; + x,y: Int32or64; + col: TFPColor; +begin + if Source is TCustomUniversalBitmap then + begin + SetSize(TCustomUniversalBitmap(Source).Width, TCustomUniversalBitmap(Source).Height); + PutImage(0, 0, TCustomUniversalBitmap(Source), dmSet); + end else + if Source is TFPCustomImage then + begin + SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height); + for y := 0 to TFPCustomImage(Source).Height-1 do + begin + pdest := GetPixelAddress(0,y); + for x := 0 to TFPCustomImage(Source).Width-1 do + begin + col := TFPCustomImage(Source).Colors[x,y]; + FConvertFromFPColor.Convert(@col, pdest, 1, sizeof(TFPColor), FPixelSize, nil); + inc(pdest); + end; + end; + end else + inherited Assign(Source); +end; + +function TCustomUniversalBitmap.NewBitmap: TCustomUniversalBitmap; +begin + result := InternalNew; +end; + +function TCustomUniversalBitmap.NewBitmap(AWidth, AHeight: integer): TCustomUniversalBitmap; +var + c: array[0..23] of byte; +begin + AssignTransparentPixel(c); + result := NewBitmap(AWidth, AHeight, @c); +end; + +function TCustomUniversalBitmap.NewBitmap(AWidth, AHeight: integer; + AColor: Pointer): TCustomUniversalBitmap; +var + b: TUniversalBrush; +begin + result := InternalNew; + result.SetSize(AWidth,AHeight); + SolidBrushIndirect(b, AColor, dmSet); + result.Fill(b); +end; + +function TCustomUniversalBitmap.NewReference: TCustomUniversalBitmap; +begin + if self <> nil then Inc(FRefCount); + Result := self; +end; + +procedure TCustomUniversalBitmap.FreeReference; +begin + if self = nil then + exit; + + if FRefCount > 0 then + begin + Dec(FRefCount); + if FRefCount = 0 then + begin + self.Destroy; + end; + end; +end; + +function TCustomUniversalBitmap.GetUnique: TCustomUniversalBitmap; +begin + if FRefCount > 1 then + begin + Dec(FRefCount); + Result := self.Duplicate; + end + else + Result := self; +end; + +function TCustomUniversalBitmap.Duplicate(ACopyProperties: boolean): TCustomUniversalBitmap; +begin + result := InternalDuplicate(ACopyProperties); +end; + +procedure TCustomUniversalBitmap.CopyPropertiesTo( + ABitmap: TCustomUniversalBitmap); +begin + ABitmap.FillMode := FillMode; + ABitmap.ClipRect := ClipRect; + ABitmap.ScanOffset := ScanOffset; +end; + +function TCustomUniversalBitmap.GetPart(const ARect: TRect): TCustomUniversalBitmap; +var + sx, sy: integer; + xSrc0, ySrc, remainX, xSrc, yDest, copyCount, copyByte: integer; + pSrc, pDest, pSrcLine: PByte; +begin + sx := ARect.Width; + sy := ARect.Height; + if (sx = 0) or (sy = 0) then exit(nil); + result := InternalNew; + result.SetSize(sx,sy); + if (FWidth = 0) or (FHeight = 0) then + begin + result.FillTransparent; + exit; + end; + LoadFromBitmapIfNeeded; + xSrc0 := PositiveMod(ARect.Left, FWidth); + ySrc := PositiveMod(ARect.Top, FHeight); + for yDest := 0 to sy-1 do + begin + xSrc := xSrc0; + pSrcLine := GetScanLineByte(ySrc); + pSrc := pSrcLine + xSrc*FPixelSize; + pDest := result.GetScanLineByte(yDest); + remainX := sx; + while remainX > 0 do + begin + if xSrc+remainX > FWidth then + begin + copyCount := FWidth-xSrc; + copyByte := copyCount*FPixelSize; + move(pSrc^, pDest^, copyByte); + inc(pDest, copyByte); + xSrc := 0; + pSrc := pSrcLine; + dec(remainX, copyCount); + end + else + begin + move(pSrc^, pDest^, remainX*FPixelSize); + break; + end; + end; + inc(ySrc); + if ySrc = FHeight then ySrc := 0; + end; + result.InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.SetSize(AWidth, AHeight: integer); +var + nbPixels64: Int64; +begin + if AWidth < 0 then AWidth := 0; + if AHeight < 0 then AHeight := 0; + if (AWidth = Width) and (AHeight = Height) then exit; + inherited SetSize(AWidth, AHeight); + FWidth := AWidth; + FHeight := AHeight; + FScanWidth := AWidth; + FScanHeight:= AHeight; + nbPixels64 := int64(AWidth) * int64(AHeight); + if nbPixels64 > maxLongint then + begin + // 2 gigapixels limit + raise EOutOfMemory.Create('Image too big'); + end; + FNbPixels := nbPixels64; + FRowSize := PtrInt(FWidth)*FPixelSize; + ReallocData; + NoClip; +end; + +destructor TCustomUniversalBitmap.Destroy; +begin + FreeData; + FreeAndNil(FPenStroker); + inherited Destroy; +end; + +procedure TCustomUniversalBitmap.Serialize(AStream: TStream); +var lWidth,lHeight,y: integer; +begin + lWidth := NtoLE(Width); + lHeight := NtoLE(Height); + AStream.Write(lWidth,sizeof(lWidth)); + AStream.Write(lHeight,sizeof(lHeight)); + for y := 0 to Height-1 do + AStream.Write(GetPixelAddress(0,y)^, RowSize); +end; + +procedure TCustomUniversalBitmap.Deserialize(AStream: TStream); +var lWidth,lHeight,y: integer; +begin + lWidth := 0; + lHeight := 0; + AStream.Read(lWidth,sizeof(lWidth)); + AStream.Read(lHeight,sizeof(lHeight)); + lWidth := LEtoN(lWidth); + lHeight := LEtoN(lHeight); + SetSize(lWidth,lHeight); + for y := 0 to Height-1 do + AStream.Read(GetPixelAddress(0,y)^, RowSize); + InvalidateBitmap; +end; + +class procedure TCustomUniversalBitmap.SerializeEmpty(AStream: TStream); +var zero: integer; +begin + zero := 0; + AStream.Write(zero,sizeof(zero)); + AStream.Write(zero,sizeof(zero)); +end; + +procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: string); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFile(self, AFilename); +end; + +procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: string; + AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFile(self, AFilename, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: String; + AHandler: TFPCustomImageReader); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFile(self, AFilename, AHandler); +end; + +procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: String; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFile(self, AFilename, AHandler, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromFileUTF8(const AFilenameUTF8: string; + AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFileUTF8(self, AFilenameUTF8, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromFileUTF8(const AFilenameUTF8: string; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromFileUTF8(self, AFilenameUTF8, AHandler, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromStream(self, AStream); +end; + +procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; + AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromStream(self, AStream, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; + AHandler: TFPCustomImageReader); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromStream(self, AStream, AHandler); +end; + +procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromStream(self, AStream, AHandler, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromResource(self, AFilename); +end; + +procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; + AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromResource(self, AFilename, AOptions); +end; + +procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; + AHandler: TFPCustomImageReader); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromResource(self, AFilename, AHandler); +end; + +procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.LoadFromResource(self, AFilename, AHandler, AOptions); +end; + +procedure TCustomUniversalBitmap.SaveToFile(const AFilename: string); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToFile(self, AFilename); +end; + +procedure TCustomUniversalBitmap.SaveToFile(const AFilename: string; + AHandler: TFPCustomImageWriter); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToFile(self, AFilename, AHandler); +end; + +procedure TCustomUniversalBitmap.SaveToFileUTF8(const AFilenameUTF8: string); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToFileUTF8(self, AFilenameUTF8); +end; + +procedure TCustomUniversalBitmap.SaveToFileUTF8(const AFilenameUTF8: string; + AHandler: TFPCustomImageWriter); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToFile(self, AFilenameUTF8, AHandler); +end; + +procedure TCustomUniversalBitmap.SaveToStreamAs(AStream: TStream; + AFormat: TBGRAImageFormat); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToStreamAs(self, AStream, AFormat); +end; + +procedure TCustomUniversalBitmap.SaveToStreamAsPng(AStream: TStream); +begin + if UniDrawerClass = nil then RaiseMissingUniDrawer; + UniDrawerClass.SaveToStreamAsPng(self, AStream); +end; + +procedure TCustomUniversalBitmap.NoClip; +begin + FClipRect := rect(0,0,FWidth,FHeight); +end; + +function TCustomUniversalBitmap.IntersectClip(const ARect: TRect): TRect; +var + remain: TRect; +begin + result := ClipRect; + remain := TRect.Intersect(ARect, result); + ClipRect := remain; +end; + +procedure TCustomUniversalBitmap.Fill(const ABrush: TUniversalBrush; AAlpha: Word = 65535); +var + pDest: PByte; + delta: PtrInt; + yb: Integer; + ctx: TUniBrushContext; +begin + if ABrush.DoesNothing or (NbPixels = 0) then exit; + LoadFromBitmapIfNeeded; + if LineOrder = riloBottomToTop then + delta := -RowSize + else + delta := RowSize; + pDest := GetPixelAddress(0,0); + for yb := 0 to Height-1 do + begin + ABrush.MoveTo(@ctx, pDest,0,yb); + ABrush.PutNextPixels(@ctx, AAlpha,Width); + inc(pDest, delta); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.Fill(ATexture: IBGRAScanner; AMode: TDrawMode); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + Fill(b); +end; + +procedure TCustomUniversalBitmap.Fill(ATexture: IBGRAScanner; AMode: TDrawMode; + AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + Fill(b, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillTransparent; +var + b: TUniversalBrush; +begin + EraseBrush(b, 65535); + Fill(b); +end; + +procedure TCustomUniversalBitmap.AlphaFill(alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + Fill(b); +end; + +procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; AAlpha: Word); +begin + ApplyMask(mask, Rect(0,0,Width,Height), Point(0,0), AAlpha); +end; + +procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AAlpha: Word); +begin + ApplyMask(mask, ARect, ARect.TopLeft, AAlpha); +end; + +{ Apply a mask to the bitmap. It means that alpha channel is + changed according to grayscale values of the mask. + + See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 } +procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; + ARect: TRect; AMaskRectTopLeft: TPoint; AAlpha: Word); +var + b: TUniversalBrush; +begin + MaskBrush(b, mask, AMaskRectTopLeft.X-ARect.Left, AMaskRectTopLeft.Y-ARect.Top); + FillRect(ARect, b, AAlpha); +end; + +procedure TCustomUniversalBitmap.ApplyGlobalOpacity(alpha: byte); +begin + ApplyGlobalOpacity(ClipRect, alpha); +end; + +procedure TCustomUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; const ABrush: TUniversalBrush); +var + yb, remain: integer; + pScan: PByte; + delta: PtrInt; + ctx: TUniBrushContext; + r: TRect; + chunkCount, maskStride: integer; + maskSrc: PByteMask; + curVal: byte; + brushCount: integer; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + r := RectWithSize(x,y,AMask.Width,AMask.Height); + + if not CheckClippedRectBounds(r.Left,r.Top,r.Right,r.Bottom) + or ABrush.DoesNothing then exit; + + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(r.Left, r.Top); + if LineOrder = riloBottomToTop then + delta := -RowSize + else delta := RowSize; + + for yb := r.Top to r.Bottom-1 do + begin + ABrush.MoveTo(@ctx, pScan, r.Left, yb); + AMask.ScanMoveTo(r.Left - x, yb - y); + remain := r.Width; + while remain > 0 do + begin + chunkCount := remain; + AMask.ScanNextMaskChunk(chunkCount, maskSrc, maskStride); + dec(remain, chunkCount); + while chunkCount > 0 do + begin + curVal := maskSrc^.gray; + inc(maskSrc, maskStride); + dec(chunkCount); + brushCount := 1; + while (chunkCount > 0) and (maskSrc^.gray = curVal) do + begin + inc(maskSrc, maskStride); + dec(chunkCount); + inc(brushCount); + end; + ABrush.PutNextPixels(@ctx, curVal + (curVal shl 8), brushCount); + end; + end; + inc(pScan, delta); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner); +begin + FillMask(x,y, AMask, ATexture, dmDrawWithTransparency); +end; + +procedure TCustomUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode); +begin + FillMask(x,y, AMask, ATexture, AMode, Point(0,0)); +end; + +procedure TCustomUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode; + AScanOffset: TPoint); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode, AScanOffset.X, AScanOffset.Y); + FillMask(x,y, AMask, b); +end; + +procedure TCustomUniversalBitmap.ApplyGlobalOpacity(ARect: TRect; alpha: byte); +begin + EraseRect(ARect, 255-alpha); +end; + +procedure TCustomUniversalBitmap.DrawCheckers(ARect: TRect; const ABrushEven, + ABrushOdd: TUniversalBrush; AGridWidth: integer; AGridHeight: integer); +var xcount,patY,yb,w,n,patX,patX1,patX1b: Int32or64; + pdest: PByte; + delta: PtrInt; + actualRect: TRect; + ctxEven,ctxOdd: TUniBrushContext; +begin + actualRect := TRect.Intersect(ARect, ClipRect); + if actualRect.IsEmpty then exit; + w := actualRect.Right-actualRect.Left; + delta := self.RowSize; + if self.LineOrder = riloBottomToTop then delta := -delta; + pdest := self.GetPixelAddress(actualRect.left, actualRect.Top); + patY := (actualRect.Top - ARect.Top) mod (AGridHeight shl 1); + patX1 := (actualRect.Left - ARect.Left) mod (AGridWidth shl 1); + patX1b := (patX1+AGridWidth) mod (AGridWidth shl 1); + for yb := actualRect.Top to actualRect.Bottom-1 do + begin + if patY < AGridHeight then + patX := patX1 + else patX := patX1b; + ABrushEven.MoveTo(@ctxEven, pdest, actualRect.Left,yb); + ABrushOdd.MoveTo(@ctxOdd, pdest, actualRect.Left,yb); + xcount := w; + if patX >= AGridWidth then + begin + n := (AGridWidth shl 1) - patX; + if n > xcount then n := xcount; + ABrushEven.PutNextPixels(@ctxEven, $ffff, n); + ABrushOdd.PutNextPixels(@ctxOdd, 0, n); + dec(xcount,n); + patX := 0; + end; + while xcount > 0 do + begin + n := AGridWidth - patX; + if n > xcount then n := xcount; + ABrushOdd.PutNextPixels(@ctxOdd, $ffff, n); + ABrushOdd.PutNextPixels(@ctxEven, 0, n); + dec(xcount, n); + patX := AGridWidth; + + if xcount > 0 then + begin + n := (AGridWidth shl 1) - patX; + if n > xcount then n := xcount; + ABrushEven.PutNextPixels(@ctxEven, $ffff, n); + ABrushOdd.PutNextPixels(@ctxOdd, 0, n); + dec(xcount, n); + patX := 0; + end; + end; + inc(pbyte(pdest), delta); + inc(patY); + if patY = AGridHeight shl 1 then patY := 0; + end; + self.InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, ABottom: integer; + const ABrush: TUniversalBrush; AAlpha: Word); +var + yb, sx: integer; + pScan: PByte; + delta: PtrInt; + ctx: TUniBrushContext; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + if not CheckClippedRectBounds({%H-}ALeft,{%H-}ATop,{%H-}ARight,{%H-}ABottom) or + (AAlpha = 0) or ABrush.DoesNothing then exit; + + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(ALeft, ATop); + if LineOrder = riloBottomToTop then + delta := -RowSize + else + delta := RowSize; + sx := ARight - ALeft; + + for yb := ATop to ABottom-1 do + begin + ABrush.MoveTo(@ctx, pScan,ALeft,yb); + ABrush.PutNextPixels(@ctx, AAlpha,sx); + inc(pScan, delta); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ABrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, + ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + FillRect(ALeft, ATop, ARight, ABottom, b, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +begin + FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ATexture, AMode, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, + ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; + AScanOffset: TPoint; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode,AScanOffset.X,AScanOffset.Y); + FillRect(ALeft,ATop,ARight,ABottom, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; + ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode,AScanOffset.X,AScanOffset.Y); + FillRect(ARect, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseRect(ALeft, ATop, ARight, + ABottom: integer; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillRect(ALeft, ATop, ARight, ABottom, b); +end; + +procedure TCustomUniversalBitmap.EraseRect(const ARect: TRect; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillRect(ARect, b); +end; + +procedure TCustomUniversalBitmap.AlphaFillRect(ALeft, ATop, ARight, + ABottom: integer; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillRect(ALeft, ATop, ARight, ABottom, b); +end; + +procedure TCustomUniversalBitmap.AlphaFillRect(const ARect: TRect; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillRect(ARect, b); +end; + +procedure TCustomUniversalBitmap.SetPixelIndirect(x, y: int32or64; AColor: pointer); +var + pScan: PByte; +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + move(AColor^, pScan^, FPixelSize); + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.GetPixelIndirect(x, y: int32or64; AColor: pointer); +var + pScan: Pointer; +begin + if (x < 0) or (x >= FWidth) or (y < 0) or (y >= FHeight) then //it is possible to read pixels outside of the cliprect + AssignTransparentPixel(AColor^) + else + begin + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + move(pScan^, AColor^, FPixelSize); + end; +end; + +procedure TCustomUniversalBitmap.GetPixelCycleIndirect(x, y: int32or64; + AColor: pointer); +var + pScan: PByte; +begin + if (FWidth=0) or (FHeight=0) then AssignTransparentPixel(AColor^) + else + begin + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(PositiveMod(x, Width), PositiveMod(y, Height)); + move(pScan^, AColor^, FPixelSize); + end; +end; + +procedure TCustomUniversalBitmap.DrawPixel(x, y: Int32or64; + const ABrush: TUniversalBrush; AAlpha: Word); +var + pScan: Pointer; + ctx: TUniBrushContext; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + if not PtInClipRect(x,y) or (AAlpha = 0) then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + ABrush.MoveTo(@ctx, pScan,x,y); + ABrush.PutNextPixels(@ctx, AAlpha,1); + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.DrawPixel(x, y: Int32or64; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + DrawPixel(x,y, b, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawPixelF(x, y: single; + const ABrush: TUniversalBrush; AAlpha: Word); +var + ix, iy: integer; + fracX, fracY: longword; + aFracX, aFracY: word; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + ix := floor(x); fracX := round((x-ix)*65536); + if fracX = 65536 then begin fracX := 0; inc(ix); end; + iy := floor(y); fracY := round((y-iy)*65536); + if fracY = 65536 then begin fracY := 0; inc(iy); end; + if (ix >= Width) or (iy >= Height) then exit; + if (ix < -integer(fracX <> 0)) or (iy < -integer(fracy <> 0)) then exit; + aFracX := (AAlpha*fracX+32768) shr 16; + DrawPixel(ix,iy, ABrush, ((not aFracX)*longword(65536-fracY)+32768) shr 16); + DrawPixel(ix+1,iy, ABrush, (aFracX*longword(65536-fracY)+32768) shr 16); + DrawPixel(ix,iy+1, ABrush, ((not aFracX)*fracY+32768) shr 16); + DrawPixel(ix+1,iy+1, ABrush, (aFracX*fracY+32768) shr 16); +end; + +procedure TCustomUniversalBitmap.DrawPixelF(x, y: single; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + DrawPixelF(x,y, b, AAlpha); +end; + +procedure TCustomUniversalBitmap.ErasePixel(x, y: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + DrawPixel(x,y, b); +end; + +procedure TCustomUniversalBitmap.ErasePixelF(x, y: single; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + DrawPixelF(x,y, b); +end; + +procedure TCustomUniversalBitmap.AlphaPixel(x, y: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + DrawPixel(x,y, b); +end; + +procedure TCustomUniversalBitmap.AlphaPixelF(x, y: single; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + DrawPixelF(x,y, b); +end; + +procedure TCustomUniversalBitmap.HorizLine(x, y, x2: int32or64; + const ABrush: TUniversalBrush; AAlpha: Word); +var + pScan: Pointer; + ctx: TUniBrushContext; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + if not CheckHorizLineBounds(x,y,x2) then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + ABrush.MoveTo(@ctx, pScan,x,y); + ABrush.PutNextPixels(@ctx, AAlpha,x2-x+1); + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.HorizLine(x, y, x2: int32or64; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + HorizLine(x,y,x2, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseHorizLine(x, y, x2: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + HorizLine(x,y,x2, b); +end; + +procedure TCustomUniversalBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + HorizLine(x,y,x2, b); +end; + +procedure TCustomUniversalBitmap.VertLine(x, y, y2: int32or64; + const ABrush: TUniversalBrush; AAlpha: Word); +var + pScan: PByte; + delta: PtrInt; + yb: Int32or64; + ctx: TUniBrushContext; +begin + if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; + if not CheckVertLineBounds(x,y,y2) or ABrush.DoesNothing then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + if LineOrder = riloTopToBottom then delta := RowSize else delta := -rowSize; + for yb := y to y2 do + begin + ABrush.MoveTo(@ctx, pScan,x,y); + ABrush.PutNextPixels(@ctx, AAlpha,1); + inc(pScan, delta); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.VertLine(x, y, y2: int32or64; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + VertLine(x,y,y2, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseVertLine(x, y, y2: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + VertLine(x,y,y2, b); +end; + +procedure TCustomUniversalBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + VertLine(x,y,y2, b); +end; + +procedure TCustomUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; + const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawLine(self, x1,y1,x2,y2, ABrush, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; + ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + DrawLine(x1,y1,x2,y2, b,ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; + AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + DrawLineAntialias(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; + ADrawLastPixel: boolean; AAlpha: Word); +var + dashPos: integer; +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + dashPos := 0; + UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush1,ABrush2, ADashLen, dashPos, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; + var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush1,ABrush2, ADashLen, ADashPos, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseLine(x1, y1, x2, y2: integer; + alpha: byte; DrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + DrawLine(x1,y1,x2,y2,b,DrawLastPixel); +end; + +procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: integer; + alpha: byte; DrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha+(alpha shl 8)); + DrawLineAntialias(x1,y1,x2,y2,b,DrawLastPixel); +end; + +procedure TCustomUniversalBitmap.AlphaLine(x1, y1, x2, y2: integer; + alpha: byte; DrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + DrawLine(x1,y1,x2,y2,b,DrawLastPixel); +end; + +procedure TCustomUniversalBitmap.AlphaLineAntialias(x1, y1, x2, y2: integer; + alpha: byte; DrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha+(alpha shl 8)); + DrawLineAntialias(x1,y1,x2,y2,b,DrawLastPixel); +end; + +procedure TCustomUniversalBitmap.DrawPolyLine(const points: array of TPoint; + const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolyLine(self, points, ABrush, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const points: array of TPoint; const ABrush: TUniversalBrush; + ADrawLastPixel: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolyLineAntialias(self, points, ABrush, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawPolyLineAntialias( + const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; + ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolyLineAntialias(self, points, ABrush1, ABrush2, ADashLen, ADrawLastPixel, AAlpha); +end; + +procedure TCustomUniversalBitmap.ErasePolyLine(const points: array of TPoint; + alpha: byte; ADrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + DrawPolyLine(points, b, ADrawLastPixel); +end; + +procedure TCustomUniversalBitmap.ErasePolyLineAntialias( + const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + DrawPolyLineAntialias(points, b, ADrawLastPixel); +end; + +procedure TCustomUniversalBitmap.AlphaPolyLine(const points: array of TPoint; + alpha: byte; ADrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + DrawPolyLine(points, b, ADrawLastPixel); +end; + +procedure TCustomUniversalBitmap.AlphaPolyLineAntialias( + const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + DrawPolyLineAntialias(points, b, ADrawLastPixel); +end; + +procedure TCustomUniversalBitmap.DrawPolygon(const points: array of TPoint; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolygon(self, points, ABrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawPolygonAntialias( + const points: array of TPoint; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolygonAntialias(self, points, ABrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.DrawPolygonAntialias( + const points: array of TPoint; const ABrush1, + ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.DrawPolygonAntialias(self, points, ABrush1,ABrush2, ADashLen, AAlpha); +end; + +procedure TCustomUniversalBitmap.ErasePolygonOutline(const points: array of TPoint; + alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + DrawPolygon(points, b); +end; + +procedure TCustomUniversalBitmap.ErasePolygonOutlineAntialias( + const points: array of TPoint; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + DrawPolygonAntialias(points, b); +end; + +procedure TCustomUniversalBitmap.AlphaPolygonOutline(const points: array of TPoint; + alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + DrawPolygon(points, b); +end; + +procedure TCustomUniversalBitmap.AlphaPolygonOutlineAntialias( + const points: array of TPoint; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + DrawPolygonAntialias(points, b); +end; + +procedure TCustomUniversalBitmap.DrawPathAliased(APath: IBGRAPath; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; AAlpha: Word); +var + data: TPathCallbackData; +begin + if ABrush.DoesNothing then exit; + if UniDrawerClass=nil then RaiseMissingUniDrawer; + data.BrushAddress := @ABrush; + data.Alpha:= AAlpha; + data.PixelCenteredCoords := APixelCenteredCoordinates; + APath.stroke(@PathStrokeAliasedCallback, @data); +end; + +procedure TCustomUniversalBitmap.DrawPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + data: TPathCallbackData; +begin + if ABrush.DoesNothing then exit; + if UniDrawerClass=nil then RaiseMissingUniDrawer; + data.BrushAddress := @ABrush; + data.Alpha:= AAlpha; + data.PixelCenteredCoords := APixelCenteredCoordinates; + APath.stroke(@PathStrokeAliasedCallback, AMatrix, @data); +end; + +procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.Rectangle(self, x,y,x2,y2, ABrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + Rectangle(x,y,x2,y2, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABrush,AAlpha); +end; + +procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +begin + Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ATexture,AMode,AAlpha); +end; + +procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; const ABorderBrush, + AFillBrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.Rectangle(self, x,y,x2,y2, ABorderBrush,AFillBrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; + const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); +begin + Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABorderBrush,AFillBrush,AAlpha); +end; + +procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, ABorderBrush,AFillBrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, ABorderBrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + RoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, AFillBrush, AFillBrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + FillRoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseRoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillRoundRect(X1,Y1,X2,Y2,DX,DY,b); +end; + +procedure TCustomUniversalBitmap.AlphaFillRoundRect(X1, Y1, X2, Y2: integer; + DX, DY: integer; alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillRoundRect(X1,Y1,X2,Y2,DX,DY,b); +end; + +procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; + const ABorderBrush: TUniversalBrush; AAlpha: Word); +begin + RoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, + abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), + ABorderBrush,AAlpha); +end; + +procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + EllipseInRect(ARect, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; const ABorderBrush, + AFillBrush: TUniversalBrush; AAlpha: Word); +begin + RoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, + abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), + ABorderBrush,AFillBrush,AAlpha); +end; + +procedure TCustomUniversalBitmap.FillEllipseInRect(ARect: TRect; + const AFillBrush: TUniversalBrush; AAlpha: Word); +begin + FillRoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, + abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), + AFillBrush,AAlpha); +end; + +procedure TCustomUniversalBitmap.FillEllipseInRect(ARect: TRect; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode); + FillEllipseInRect(ARect, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseEllipseInRect(ARect: TRect; alpha: byte); +var + b: TUniversalBrush; +begin + EraseBrush(b, alpha + (alpha shl 8)); + FillEllipseInRect(ARect,b); +end; + +procedure TCustomUniversalBitmap.AlphaFillEllipseInRect(ARect: TRect; + alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillEllipseInRect(ARect,b); +end; + +procedure TCustomUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillShape(self, AShape, FillMode, ABrush, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; + ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture,AMode); + FillShape(AShape, b,AAlpha); +end; + +procedure TCustomUniversalBitmap.EraseShape(AShape: TBGRACustomFillInfo; + alpha: byte); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillShape(AShape,b); +end; + +procedure TCustomUniversalBitmap.AlphaFillShape(AShape: TBGRACustomFillInfo; + alpha: byte); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillShape(AShape,b); +end; + +procedure TCustomUniversalBitmap.FillPoly(const APoints: array of TPointF; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; + AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + UniDrawerClass.FillPoly(self, APoints, FillMode, ABrush, APixelCenteredCoordinates, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillPoly(const APoints: array of TPointF; + ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean; + AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + FillPoly(APoints, b,APixelCenteredCoordinates,AAlpha); +end; + +procedure TCustomUniversalBitmap.ErasePoly(const APoints: array of TPointF; + alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillPoly(APoints,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.AlphaFillPoly(const APoints: array of TPointF; + alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillPoly(APoints,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; + AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + FillPoly(APath.getPoints, ABrush, APixelCenteredCoordinates, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean; AAlpha: Word); +begin + if UniDrawerClass=nil then RaiseMissingUniDrawer; + FillPoly(APath.getPoints(AMatrix), ABrush, APixelCenteredCoordinates, AAlpha); +end; + +procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; + ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean; + AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + FillPathAliased(APath, b,APixelCenteredCoordinates,AAlpha); +end; + +procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AMode: TDrawMode; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + b: TUniversalBrush; +begin + ScannerBrush(b, ATexture, AMode); + FillPathAliased(APath,AMatrix, b,APixelCenteredCoordinates,AAlpha); +end; + +procedure TCustomUniversalBitmap.ErasePathAliased(APath: IBGRAPath; + alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillPathAliased(APath,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.ErasePathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + if alpha = 0 then exit; + EraseBrush(b, alpha + (alpha shl 8)); + FillPathAliased(APath,AMatrix,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.AlphaFillPathAliased(APath: IBGRAPath; + alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillPathAliased(APath,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.AlphaFillPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + AlphaBrush(b, alpha + (alpha shl 8)); + FillPathAliased(APath,AMatrix,b,APixelCenteredCoordinates); +end; + +procedure TCustomUniversalBitmap.VerticalFlip; +begin + VerticalFlip(rect(0,0,Width,Height)); +end; + +procedure TCustomUniversalBitmap.VerticalFlip(ARect: TRect); +var + yb,h2: integer; + line: Pointer; + linesize, delta: PtrInt; + PStart,PEnd: Pointer; +begin + if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; + ARect.Intersect(rect(0,0,Width,Height)); + if ARect.IsEmpty then exit; + LoadFromBitmapIfNeeded; + linesize := (ARect.Right-ARect.Left) * FPixelSize; + line := nil; + getmem(line, linesize); + PStart := GetPixelAddress(ARect.Left, ARect.Top); + PEnd := GetPixelAddress(ARect.Left,ARect.Bottom-1); + h2 := (ARect.Bottom-ARect.Top) div 2; + if LineOrder = riloTopToBottom then delta := +RowSize else delta := -RowSize; + for yb := h2-1 downto 0 do + begin + move(PStart^, line^, linesize); + move(PEnd^, PStart^, linesize); + move(line^, PEnd^, linesize); + Inc(PStart, delta); + Dec(PEnd, delta); + end; + freemem(line); + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.HorizontalFlip; +begin + HorizontalFlip(rect(0,0,Width,Height)); +end; + +procedure TCustomUniversalBitmap.HorizontalFlip(ARect: TRect); +var + yb, w: integer; + PStart: PByte; + PEnd: PByte; +begin + if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; + ARect.Intersect(rect(0,0,Width,Height)); + if ARect.IsEmpty then exit; + w := ARect.Right-ARect.Left; + LoadFromBitmapIfNeeded; + for yb := ARect.Top to ARect.Bottom-1 do + begin + PStart := GetPixelAddress(ARect.Left,yb); + PEnd := PStart + (w-1)*FPixelSize; + InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w shr 1); + end; + InvalidateBitmap; +end; + +procedure TCustomUniversalBitmap.RotateUDInplace; +begin + RotateUDInplace(rect(0,0,Width,Height)); +end; + +procedure TCustomUniversalBitmap.RotateUDInplace(ARect: TRect); +var + yb,h,h2: integer; + line: PByte; + linesize, delta: IntPtr; + PStart: PByte; + PEnd: PByte; + w: integer; +begin + if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; + ARect.Intersect(rect(0,0,Width,Height)); + if ARect.IsEmpty then exit; + LoadFromBitmapIfNeeded; + w := ARect.Right-ARect.Left; + linesize := w * FPixelSize; + line := nil; + getmem(line, linesize); + PStart := GetPixelAddress(ARect.Left, ARect.Top); + PEnd := GetPixelAddress(ARect.Right-1, ARect.Bottom-1); + h := ARect.Bottom-ARect.Top; + h2 := h div 2; + if LineOrder = riloTopToBottom then delta := +RowSize else delta := -RowSize; + for yb := h2-1 downto 0 do + begin + InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w); + Inc(PStart, delta); + Dec(PEnd, delta); + end; + if odd(h) then + InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w shr 1); + freemem(line); + InvalidateBitmap; +end; + +function TCustomUniversalBitmap.RotateCW: TCustomUniversalBitmap; +var + psrc, pdest: PByte; + yb: integer; + delta: PtrInt; +begin + LoadFromBitmapIfNeeded; + result := InternalNew; + result.SetSize(Height, Width); + if Result.LineOrder = riloTopToBottom then + delta := Result.RowSize + else + delta := -Result.RowSize; + for yb := 0 to Height - 1 do + begin + psrc := ScanLineByte[yb]; + pdest := Result.GetPixelAddress(Height-1-yb, 0); + InternalCopyPixels(psrc, pdest, FPixelSize, delta, Width); + end; +end; + +function TCustomUniversalBitmap.RotateCCW: TCustomUniversalBitmap; +var + psrc, pdest: PByte; + yb: integer; + delta: PtrInt; +begin + LoadFromBitmapIfNeeded; + result := InternalNew; + result.SetSize(Height, Width); + if Result.LineOrder = riloTopToBottom then + delta := Result.RowSize + else + delta := -Result.RowSize; + for yb := 0 to Height - 1 do + begin + psrc := ScanLineByte[yb]; + pdest := Result.GetPixelAddress(yb, Width - 1); + InternalCopyPixels(psrc, pdest, FPixelSize,-delta, Width); + end; +end; + +function TCustomUniversalBitmap.RotateUD: TCustomUniversalBitmap; +var + yb: Integer; + psrc, pdest: PByte; +begin + LoadFromBitmapIfNeeded; + result := InternalNew; + result.SetSize(Width, Height); + for yb := 0 to Height-1 do + begin + psrc := ScanLineByte[yb]; + pdest := result.GetPixelAddress(Width-1,Height-1-yb); + InternalCopyPixels(psrc, pdest, FPixelSize, -FPixelSize, Width); + end; +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/unibitmapgeneric.inc b/vendor/kam_remake/src/ext/BGRABitmap/unibitmapgeneric.inc new file mode 100644 index 0000000..04fc32b --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/unibitmapgeneric.inc @@ -0,0 +1,1141 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +{$IFDEF INCLUDE_INTERFACE} +{$UNDEF INCLUDE_INTERFACE} + +type + { TGenericUniversalBitmap } + + generic TGenericUniversalBitmap = class(TCustomUniversalBitmap) + private + type PPixel = ^TPixel; + function GetDataPtr: PPixel; inline; + function GetScanLine(y: integer): PPixel; inline; + protected + class function DefaultColorspace: TColorspaceAny; override; + procedure Init; override; //ensure colorspace + function GetScanlineFast(y: integer): PPixel; inline; //typed function + procedure InternalCopyPixels(ASource,ADest: PByte; ASourceStride,ADestStride: PtrInt; ACount: integer); override; + procedure InternalSwapPixels(ABuf1,ABuf2: PByte; AStride1,AStride2: PtrInt; ACount: integer); override; + procedure InternalSetPixels(ASource,ADest: PByte; ADestStride: PtrInt; ACount: integer); override; + public + //typed functions + + {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with ''Color'' } + constructor Create(AWidth, AHeight: integer; const AColor: TPixel); virtual; + function NewBitmap(AWidth, AHeight: integer; const AColor: TPixel): TCustomUniversalBitmap; overload; virtual; + + function Equals(comp: TCustomUniversalBitmap): boolean; overload; + function Equals(const comp: TPixel): boolean; overload; + function GetDifferenceBounds(ABitmap: TCustomUniversalBitmap): TRect; + + procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure IdleBrush(out ABrush: TUniversalBrush); virtual; + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; + function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TPixel; + AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TCustomUniversalBitmap; virtual; + + procedure SetPixel(x,y: int32or64; const AColor: TPixel); overload; virtual; + function GetPixel(x,y: int32or64): TPixel; inline; + function GetPixelCycle(x,y: int32or64): TPixel; inline; + {** Returns the address of the left-most pixel of any line. + The parameter y ranges from 0 to Height-1 } + property ScanLine[y: integer]: PPixel Read GetScanLine; + property Data: PPixel read GetDataPtr; + + procedure Fill(const AColor: TPixel); overload; virtual; + procedure Fill(const AColor: TPixel; AMode : TDrawMode; AAlpha : Word = 65535); overload; virtual; + procedure ReplaceColor(const ABefore, AAfter: TPixel); overload; virtual; + procedure ReplaceColor(ARect: TRect; const ABefore, AAfter: TPixel); overload; virtual; + procedure ReplaceTransparent(const AAfter: TBGRAPixel); overload; virtual; + procedure ReplaceTransparent(ARect: TRect; const AAfter: TPixel); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TPixel); overload; virtual; + procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TPixel; ADrawMode: TDrawMode); overload; virtual; + procedure FillRect(ALeft, ATop, ARight, ABottom: integer; const AColor: TPixel; ADrawMode: TDrawMode = dmSet; AAlpha: Word = 65535); overload; virtual; + procedure FillRect(const ARect: TRect; const AColor: TPixel; ADrawMode: TDrawMode = dmSet; AAlpha: Word = 65535); overload; virtual; + procedure DrawCheckers(ARect: TRect; const AColorEven,AColorOdd: TPixel; AGridWidth: integer = 8; AGridHeight: integer = 8; ADrawMode: TDrawMode = dmSet); virtual; + procedure DrawPixel(x,y: Int32or64; const AColor: TPixel); overload; virtual; + procedure DrawPixel(x,y: Int32or64; const AColor: TPixel; ADrawMode: TDrawMode); overload; virtual; + procedure DrawPixel(x,y: Int32or64; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); overload; virtual; + procedure DrawPixelF(x,y: single; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + {** Replaces the content of the pixels at line ''y'' and + at columns ''x'' to ''x2'' included, using specified color } + procedure SetHorizLine(x, y, x2: int32or64; const AColor: TPixel); virtual; + procedure HorizLine(x, y, x2: int32or64; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + {** Replaces a vertical line at column ''x'' and at row ''y'' to ''y2'' } + procedure SetVertLine(x, y, y2: int32or64; const AColor: TPixel); virtual; + procedure VertLine(x, y, y2: int32or64; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure DrawLine(x1, y1, x2, y2: integer; const AColor: TPixel; ADrawLastPixel: boolean; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor1, AColor2: TPixel; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor1, AColor2: TPixel; ADashLen: integer; var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; + procedure DrawPolyLine(const points: array of TPoint; const AColor: TPixel; ADrawLastPixel: boolean; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; + procedure DrawPolyLineAntialias(const points: array of TPoint; const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; + procedure DrawPolyLineAntialias(const points: array of TPoint; const AColor1, AColor2: TPixel; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; + procedure DrawPolygon(const points: array of TPoint; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; + procedure DrawPolygonAntialias(const points: array of TPoint; const AColor: TPixel; AAlpha: Word = 65535); overload; + procedure DrawPolygonAntialias(const points: array of TPoint; const AColor1, AColor2: TPixel; ADashLen: integer; AAlpha: Word = 65535); overload; + procedure DrawPathAliased(APath: IBGRAPath; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure DrawPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure Rectangle(x, y, x2, y2: integer; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(x, y, x2, y2: integer; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(const ARect: TRect; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure Rectangle(const ARect: TRect; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure EllipseInRect(ARect: TRect; const ABorderColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure EllipseInRect(ARect: TRect; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure FillEllipseInRect(ARect: TRect; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure FillShape(AShape: TBGRACustomFillInfo; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; + procedure FillPoly(const APoints: array of TPointF; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; + procedure FillPathAliased(APath: IBGRAPath; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; + + //optimized + procedure SetPixelIndirect(x,y: int32or64; AColor: pointer); override; + procedure GetPixelIndirect(x,y: int32or64; AColor: pointer); override; + procedure GetPixelCycleIndirect(x,y: int32or64; AColor: pointer); override; + function GetPixelAddress(x, y: integer): PByte; override; + + {==== Drawing lines and paths (floating point coordinates) ====} + {* These functions use the current pen style/cap/join. The parameter ''APenWidth'' + specifies the width of the line and the base unit for dashes. + See [[BGRABitmap tutorial 13|coordinate system]]. + * The coordinates are pixel-centered by default, so that when filling a rectangle, + if the supplied values are integers, the border will be half transparent. + If you want the border to be completely filled, you can subtract/add + 0.5 to the coordinates to include the remaining thin border. + See [[BGRABitmap tutorial 13|coordinate system]]. } + + procedure DrawLineAntialias(x1, y1, x2, y2: single; const AColor: TPixel; APenWidth: single); overload; virtual; + procedure DrawLineAntialias(x1, y1, x2, y2: single; const AColor: TPixel; APenWidth: single; AClosedCap: boolean); overload; virtual; + + {** Draws a polyline using current pen style/cap/join } + procedure DrawPolyLineAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; + {** Draws a polyline using current pen style/cap/join. + ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, + a space is left so that the next line can fit } + procedure DrawPolyLineAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single; AClosedCap: boolean); overload; virtual; + {** Draws a polyline using current pen style/cap/join. + The last point considered as a join with the first point if it has + the same coordinate } + procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; + {** Draws a polygon using current pen style/cap/join. + The polygon is always closed. You don't need to set the last point + to be the same as the first point } + procedure DrawPolygonAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; + + procedure RectangleAntialias(x, y, x2, y2: single; const AColor: TPixel; AWidth: single); overload; virtual; + + {** Draws an ellipse without antialising. ''rx'' is the horizontal radius and + ''ry'' the vertical radius } + procedure Ellipse(x, y, rx, ry: single; const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; + {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and + ''ry'' the vertical radius } + procedure EllipseAntialias(x, y, rx, ry: single; const AColor: TPixel; AWidth: single); overload; virtual; + procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel; AWidth: single); overload; virtual; + + procedure DrawPath(APath: IBGRAPath; const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; + + //-------------------------------- antialias fill --------------------------------------------- + procedure FillPolyAntialias(const APoints: array of TPointF; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillEllipseAntialias(x, y, rx, ry: single; const AColor: TPixel); overload; virtual; + procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel); overload; virtual; + procedure FillPath(APath: IBGRAPath; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRectAntialias(x, y, x2, y2: single; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + procedure FillRectAntialias(const ARectF: TRectF; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; + + {** Fills a rounded rectangle with antialiasing. The corners have an + elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to + draw the corners. See [[BGRABitmap Geometry types|geometry types]] } + procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; const AColor: TPixel; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; + + end; + +{$ENDIF} + +{$IFDEF INCLUDE_IMPLEMENTATION} +{$UNDEF INCLUDE_IMPLEMENTATION} + +{ TGenericUniversalBitmap } + +function TGenericUniversalBitmap.GetDataPtr: PPixel; +begin + result := PPixel(GetDataBytePtr); +end; + +function TGenericUniversalBitmap.GetScanLine(y: integer): PPixel; +begin + result := PPixel(GetScanLineByte(y)); +end; + +class function TGenericUniversalBitmap.DefaultColorspace: TColorspaceAny; +begin + Result:= TColorspace; +end; + +procedure TGenericUniversalBitmap.Init; +begin + inherited Init; + if FColorspace <> DefaultColorspace then raise exception.Create('Unexpected colorspace'); +end; + +{ Get scanline without checking bounds nor updated from bitmap } +function TGenericUniversalBitmap.GetScanlineFast(y: integer): PPixel; +begin + if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; + result := PPixel(FDataByte+FRowSize*y); +end; + +procedure TGenericUniversalBitmap.InternalCopyPixels(ASource, ADest: PByte; + ASourceStride, ADestStride: PtrInt; ACount: integer); +begin + while ACount>0 do + begin + PPixel(ADest)^ := PPixel(ASource)^; + inc(ASource, ASourceStride); + inc(ADest, ADestStride); + dec(ACount); + end; +end; + +procedure TGenericUniversalBitmap.InternalSwapPixels(ABuf1, ABuf2: PByte; + AStride1, AStride2: PtrInt; ACount: integer); +var temp: TPixel; +begin + while ACount>0 do + begin + temp := PPixel(ABuf1)^; + PPixel(ABuf1)^ := PPixel(ABuf2)^; + PPixel(ABuf2)^ := temp; + inc(ABuf1, AStride1); + inc(ABuf2, AStride2); + dec(ACount); + end; +end; + +procedure TGenericUniversalBitmap.InternalSetPixels(ASource, ADest: PByte; + ADestStride: PtrInt; ACount: integer); +begin + while ACount>0 do + begin + PPixel(ADest)^ := PPixel(ASource)^; + inc(ADest, ADestStride); + dec(ACount); + end; +end; + +constructor TGenericUniversalBitmap.Create(AWidth, AHeight: integer; + const AColor: TPixel); +var + p: PByte; + i: Integer; +begin + inherited Create(0, 0); + SetSize(AWidth,AHeight); + p := DataByte; + for i := NbPixels-1 downto 0 do + begin + PPixel(p)^ := AColor; + inc(p, sizeof(TPixel)); + end; +end; + +function TGenericUniversalBitmap.NewBitmap(AWidth, AHeight: integer; + const AColor: TPixel): TCustomUniversalBitmap; +var + b: TUniversalBrush; +begin + result := InternalNew; + result.SetSize(AWidth,AHeight); + SolidBrush(b, AColor, dmSet); + result.Fill(b); +end; + +function TGenericUniversalBitmap.Equals(comp: TCustomUniversalBitmap): boolean; +var + p,pComp: PByte; + y, x: Integer; + delta, compDelta: PtrInt; +begin + if (comp.Colorspace<>Colorspace) or + (comp.Width <> Width) or (comp.Height <> Height) then exit(false); + p := GetPixelAddress(0,0); + if LineOrder = riloTopToBottom then delta := 0 else delta := -RowSize*2; + pComp := comp.GetPixelAddress(0,0); + if comp.LineOrder = riloTopToBottom then compDelta := 0 else compDelta := -comp.RowSize*2; + for y := 0 to Height-1 do + begin + for x := Width-1 downto 0 do + begin + if PPixel(p)^ <> PPixel(pComp)^ then exit(false); + inc(p, sizeof(TPixel)); + inc(pComp, sizeof(TPixel)); + end; + inc(p, delta); + inc(pComp, compDelta); + end; + result := true; +end; + +function TGenericUniversalBitmap.Equals(const comp: TPixel): boolean; +var + p: PByte; + i: Integer; +begin + p := DataByte; + for i := NbPixels-1 downto 0 do + begin + if PPixel(p)^ <> comp then exit(false); + inc(p, sizeof(TPixel)); + end; + result := true; +end; + +function TGenericUniversalBitmap.GetDifferenceBounds( + ABitmap: TCustomUniversalBitmap): TRect; +var + minx, miny, maxx, maxy: integer; + xb, yb: integer; + p, p2: PPixel; +begin + if (ABitmap.Width <> Width) or (ABitmap.Height <> Height) + or (ABitmap.Colorspace <> Colorspace) then + begin + result := rect(0,0,Width,Height); + if ABitmap.Width > result.Right then result.Right := ABitmap.Width; + if ABitmap.Height > result.bottom then result.bottom := ABitmap.Height; + exit; + end; + maxx := -1; + maxy := -1; + minx := self.Width; + miny := self.Height; + for yb := 0 to self.Height - 1 do + begin + p := self.ScanLine[yb]; + p2 := PPixel(ABitmap.ScanLineByte[yb]); + for xb := 0 to self.Width - 1 do + begin + if p^ <> p2^ then + begin + if xb < minx then + minx := xb; + if yb < miny then + miny := yb; + if xb > maxx then + maxx := xb; + if yb > maxy then + maxy := yb; + end; + Inc(p); + Inc(p2); + end; + end; + if minx > maxx then + begin + Result.left := 0; + Result.top := 0; + Result.right := 0; + Result.bottom := 0; + end + else + begin + Result.left := minx; + Result.top := miny; + Result.right := maxx + 1; + Result.bottom := maxy + 1; + end; +end; + +procedure TGenericUniversalBitmap.SolidBrushIndirect(out + ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode); +begin + SolidBrush(ABrush, PPixel(AColor)^, ADrawMode); +end; + +class procedure TGenericUniversalBitmap.IdleBrush(out ABrush: TUniversalBrush); +begin + ABrush.Colorspace := TColorspace; + ABrush.InternalInitContext:= nil; + PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= sizeof(TPixel); + ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; + ABrush.DoesNothing:= true; +end; + +class procedure TGenericUniversalBitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TPixel; ADrawMode: TDrawMode); +var + ct: TColorTransparency; +begin + ct := TColorspace.GetColorTransparency(@AColor); + if (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and + (ct = ctSemiTransparent) then + raise exception.Create('Semi-tranparent drawing not handled by default brush') + else if ADrawMode = dmXor then + raise exception.Create('Xor mode not handled by default brush'); + + ABrush.Colorspace := TColorspace; + ABrush.InternalInitContext:= nil; + PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= sizeof(TPixel); + + if (ADrawMode <> dmSet) and (ct <> ctFullyOpaque) then + begin + ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; + ABrush.DoesNothing:= true; + end + else + begin + PPixel(@PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.Color)^ := AColor; + ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSetPixels + end; +end; + +function TGenericUniversalBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; + APatternColor, ABackgroundColor: TPixel; AWidth: integer; AHeight: integer; + APenWidth: single): TCustomUniversalBitmap; +var + b: TUniversalBrush; +begin + result := InternalNew; + result.SetSize(AWidth,AHeight); + if ABrushStyle=bsClear then + result.FillTransparent + else + begin + SolidBrush(b, ABackgroundColor, dmSet); + result.Fill(b); + SolidBrush(b, APatternColor,dmDrawWithTransparency); + if ABrushStyle in[bsDiagCross,bsBDiagonal] then + begin + result.DrawLineAntialias(-1,AHeight,AWidth,-1, b,APenWidth); + result.DrawLineAntialias(-1-APenWidth,0+APenWidth,0+APenWidth,-1-APenWidth, b,APenWidth); + result.DrawLineAntialias(AWidth-1-APenWidth,AHeight+APenWidth,AWidth+APenWidth,AHeight-1-APenWidth, b,APenWidth); + end; + if ABrushStyle in[bsDiagCross,bsFDiagonal] then + begin + result.DrawLineAntialias(-1,-1,AWidth,AHeight, b,APenWidth); + result.DrawLineAntialias(AWidth-1-APenWidth,-1-APenWidth,AWidth+APenWidth,0+APenWidth, b,APenWidth); + result.DrawLineAntialias(-1-APenWidth,AHeight-1-APenWidth,0+APenWidth,AHeight+APenWidth, b,APenWidth); + end; + if ABrushStyle in[bsHorizontal,bsCross] then + result.DrawLineAntialias(-1,AHeight div 2,AWidth,AHeight div 2, b,APenWidth); + if ABrushStyle in[bsVertical,bsCross] then + result.DrawLineAntialias(AWidth div 2,-1,AWidth div 2,AHeight, b,APenWidth); + end; +end; + +procedure TGenericUniversalBitmap.SetPixelIndirect(x, y: int32or64; + AColor: pointer); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + (GetScanlineFast(y)+x)^ := PPixel(AColor)^; + InvalidateBitmap; +end; + +procedure TGenericUniversalBitmap.GetPixelIndirect(x, y: int32or64; + AColor: pointer); +begin + if (x < 0) or (x >= FWidth) or (y < 0) or (y >= FHeight) then //it is possible to read pixels outside of the cliprect + AssignTransparentPixel(AColor^) else + begin + LoadFromBitmapIfNeeded; + PPixel(AColor)^ := (GetScanlineFast(y)+x)^; + end; +end; + +procedure TGenericUniversalBitmap.GetPixelCycleIndirect(x, y: int32or64; + AColor: pointer); +begin + if (Width = 0) or (Height = 0) then AssignTransparentPixel(AColor^) else + begin + LoadFromBitmapIfNeeded; + PPixel(AColor)^ := (GetScanlineFast(PositiveMod(y, Height)) + PositiveMod(x, Width))^; + end; +end; + +procedure TGenericUniversalBitmap.SetPixel(x, y: int32or64; const AColor: TPixel); +begin + if not PtInClipRect(x,y) then exit; + LoadFromBitmapIfNeeded; + (GetScanlineFast(y)+x)^ := AColor; + InvalidateBitmap; +end; + +function TGenericUniversalBitmap.GetPixel(x, y: int32or64): TPixel; +begin + GetPixelIndirect(x,y, @result); +end; + +function TGenericUniversalBitmap.GetPixelCycle(x, y: int32or64): TPixel; +begin + GetPixelCycleIndirect(x,y, @result); +end; + +procedure TGenericUniversalBitmap.Fill(const AColor: TPixel); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, dmSet); + Fill(b); +end; + +procedure TGenericUniversalBitmap.Fill(const AColor: TPixel; AMode : TDrawMode; AAlpha : Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + Fill(b, AAlpha); +end; + +procedure TGenericUniversalBitmap.ReplaceColor(const ABefore, AAfter: TPixel); +var + p: PPixel; + n: integer; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if p^ = ABefore then p^ := AAfter; + Inc(p); + end; + InvalidateBitmap; +end; + +procedure TGenericUniversalBitmap.ReplaceColor(ARect: TRect; + const ABefore,AAfter: TPixel); +var + p: PPixel; + n,w,yb: integer; +begin + if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; + LoadFromBitmapIfNeeded; + w := ARect.Width-1; + for yb := ARect.Top to ARect.Bottom-1 do + begin + p := GetScanlineFast(yb)+ARect.Left; + for n := w downto 0 do + begin + if p^ = ABefore then p^ := AAfter; + Inc(p); + end; + end; + InvalidateBitmap; +end; + +procedure TGenericUniversalBitmap.ReplaceTransparent(const AAfter: TBGRAPixel); +var before: TPixel; +begin + AssignTransparentPixel(before); + ReplaceColor(before, AAfter); +end; + +procedure TGenericUniversalBitmap.ReplaceTransparent(ARect: TRect; + const AAfter: TPixel); +var before: TPixel; +begin + AssignTransparentPixel(before); + ReplaceColor(ARect, before, AAfter); +end; + +procedure TGenericUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; const AColor: TPixel); +begin + FillMask(x,y, AMask, AColor, dmDrawWithTransparency); +end; + +procedure TGenericUniversalBitmap.FillMask(x, y: integer; + AMask: TCustomUniversalBitmap; const AColor: TPixel; ADrawMode: TDrawMode); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + FillMask(x,y, AMask, b); +end; + +procedure TGenericUniversalBitmap.FillRect(ALeft, ATop, ARight, + ABottom: integer; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + FillRect(ALeft,ATop,ARight,ABottom, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillRect(const ARect: TRect; + const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + FillRect(ARect, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawCheckers(ARect: TRect; const AColorEven, + AColorOdd: TPixel; AGridWidth: integer; AGridHeight: integer; ADrawMode: TDrawMode); +var + bEven, bOdd: TUniversalBrush; +begin + SolidBrush(bEven, AColorEven, ADrawMode); + SolidBrush(bOdd, AColorOdd, ADrawMode); + DrawCheckers(ARect, bEven, bOdd, AGridWidth, AGridHeight); +end; + +procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; + const AColor: TPixel); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, dmDrawWithTransparency); + DrawPixel(x,y, b); +end; + +procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; + const AColor: TPixel; ADrawMode: TDrawMode); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + DrawPixel(x,y, b); +end; + +procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; + const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + DrawPixel(x,y, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPixelF(x, y: single; + const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, ADrawMode); + DrawPixelF(x,y, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.SetHorizLine(x, y, x2: int32or64; + const AColor: TPixel); +var + pScan: PByte; +begin + if not CheckHorizLineBounds(x,y,x2) then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + InternalSetPixels(@AColor, pScan, sizeof(TPixel), x2-x+1); + InvalidateBitmap; +end; + +procedure TGenericUniversalBitmap.HorizLine(x, y, x2: int32or64; + const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + HorizLine(x,y,x2, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.SetVertLine(x, y, y2: int32or64; + const AColor: TPixel); +var + pScan: PByte; + delta: PtrInt; + yb: Int32or64; +begin + if not CheckVertLineBounds(x,y,y2) then exit; + LoadFromBitmapIfNeeded; + pScan := GetPixelAddress(x,y); + if LineOrder = riloTopToBottom then delta := RowSize else delta := -rowSize; + for yb := y to y2 do + begin + PPixel(pScan)^ := AColor; + inc(pScan, delta); + end; + InvalidateBitmap; +end; + +procedure TGenericUniversalBitmap.VertLine(x, y, y2: int32or64; + const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + VertLine(x,y,y2, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; + const AColor: TPixel; ADrawLastPixel: boolean; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + DrawLine(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AntialiasingDrawMode); + DrawLineAntialias(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const AColor1, AColor2: TPixel; ADashLen: integer; + ADrawLastPixel: boolean; AAlpha: Word); +var + b1, b2: TUniversalBrush; +begin + SolidBrush(b1, AColor1, AntialiasingDrawMode); + SolidBrush(b2, AColor2, AntialiasingDrawMode); + DrawLineAntialias(x1,y1,x2,y2, b1,b2, ADashLen, ADrawLastPixel, AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; + const AColor1, AColor2: TPixel; ADashLen: integer; + var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word); +var + b1, b2: TUniversalBrush; +begin + SolidBrush(b1, AColor1, AntialiasingDrawMode); + SolidBrush(b2, AColor2, AntialiasingDrawMode); + DrawLineAntialias(x1,y1,x2,y2, b1,b2, ADashLen,ADashPos, ADrawLastPixel, AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolyLine(const points: array of TPoint; + const AColor: TPixel; ADrawLastPixel: boolean; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + DrawPolyLine(points, b, ADrawLastPixel, AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolyLineAntialias( + const points: array of TPoint; const AColor: TPixel; + ADrawLastPixel: boolean; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AntialiasingDrawMode); + DrawPolyLineAntialias(points, b,ADrawLastPixel,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolyLineAntialias( + const points: array of TPoint; const AColor1, AColor2: TPixel; + ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word); +var + b1, b2: TUniversalBrush; +begin + SolidBrush(b1, AColor1, AntialiasingDrawMode); + SolidBrush(b2, AColor2, AntialiasingDrawMode); + DrawPolyLineAntialias(points, b1,b2,ADashLen, ADrawLastPixel,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolygon(const points: array of TPoint; + const AColor: TPixel; AMode : TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + DrawPolygon(points, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolygonAntialias( + const points: array of TPoint; const AColor: TPixel; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AntialiasingDrawMode); + DrawPolygonAntialias(points, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPolygonAntialias( + const points: array of TPoint; const AColor1, AColor2: TPixel; + ADashLen: integer; AAlpha: Word); +var + b1, b2: TUniversalBrush; +begin + SolidBrush(b1, AColor1, AntialiasingDrawMode); + SolidBrush(b2, AColor2, AntialiasingDrawMode); + DrawPolygonAntialias(points, b1,b2,ADashLen, AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPathAliased(APath: IBGRAPath; + const AColor: TPixel; AMode: TDrawMode; APixelCenteredCoordinates: boolean; + AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor,AMode); + DrawPathAliased(APath, b,APixelCenteredCoordinates,AAlpha); +end; + +procedure TGenericUniversalBitmap.DrawPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const AColor: TPixel; AMode: TDrawMode; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor,AMode); + DrawPathAliased(APath,AMatrix, b,APixelCenteredCoordinates,AAlpha); +end; + +procedure TGenericUniversalBitmap.Rectangle(x, y, x2, y2: integer; + const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, AColor, AMode); + Rectangle(x,y,x2,y2, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.Rectangle(x, y, x2, y2: integer; + const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + bBorder,bFill: TUniversalBrush; +begin + SolidBrush(bBorder, ABorderColor, AMode); + SolidBrush(bFill, AFillColor, AMode); + Rectangle(x,y,x2,y2, bBorder,bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.Rectangle(const ARect: TRect; + const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); +begin + Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, AColor,AMode,AAlpha); +end; + +procedure TGenericUniversalBitmap.Rectangle(const ARect: TRect; + const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +begin + Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABorderColor,AFillColor,AMode,AAlpha); +end; + +procedure TGenericUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const ABorderColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, ABorderColor,AMode); + RoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; + AAlpha: Word); +var + bBorder, bFill: TUniversalBrush; +begin + SolidBrush(bBorder, ABorderColor,AMode); + SolidBrush(bFill, AFillColor,AMode); + RoundRect(X1,Y1,X2,Y2,DX,DY, bBorder,bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, + DY: integer; const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillRoundRect(X1,Y1,X2,Y2,DX,DY, bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.EllipseInRect(ARect: TRect; + const ABorderColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b, ABorderColor,AMode); + EllipseInRect(ARect, b,AAlpha); +end; + +procedure TGenericUniversalBitmap.EllipseInRect(ARect: TRect; + const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + bBorder, bFill: TUniversalBrush; +begin + SolidBrush(bBorder, ABorderColor,AMode); + SolidBrush(bFill, AFillColor,AMode); + EllipseInRect(ARect, bBorder,bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillEllipseInRect(ARect: TRect; + const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillEllipseInRect(ARect, bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; + const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillShape(AShape, bFill,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillPoly(const APoints: array of TPointF; + const AFillColor: TPixel; AMode: TDrawMode; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillPoly(APoints,bFill,APixelCenteredCoordinates,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillPathAliased(APath: IBGRAPath; + const AFillColor: TPixel; AMode: TDrawMode; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillPathAliased(APath,bFill,APixelCenteredCoordinates,AAlpha); +end; + +procedure TGenericUniversalBitmap.FillPathAliased(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const AFillColor: TPixel; AMode: TDrawMode; + APixelCenteredCoordinates: boolean; AAlpha: Word); +var + bFill: TUniversalBrush; +begin + SolidBrush(bFill, AFillColor,AMode); + FillPathAliased(APath,AMatrix, bFill,APixelCenteredCoordinates,AAlpha); +end; + +function TGenericUniversalBitmap.GetPixelAddress(x, y: integer): PByte; +begin + if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; + result := FDataByte + FRowSize * y + IntPtr(x)*sizeof(TPixel); +end; + +procedure TGenericUniversalBitmap.FillPolyAntialias( + const APoints: array of TPointF; const AColor: TPixel; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillPolyAntialias(APoints, b, APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; + const AColor: TPixel); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillEllipseAntialias(x,y,rx,ry, b); +end; + +procedure TGenericUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; const AColor: TPixel); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + {$PUSH}{$R-} + FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); + {$POP} +end; + +procedure TGenericUniversalBitmap.FillPath(APath: IBGRAPath; + const AColor: TPixel; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillPath(APath, b, APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.FillPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const AColor: TPixel; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillPath(APath,AMatrix, b, APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; + const AColor: TPixel; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillRectAntialias(x,y,x2,y2,b,APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.FillRectAntialias(const ARectF: TRectF; + const AColor: TPixel; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillRectAntialias(ARectF,b,APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, + ry: single; const AColor: TPixel; AOptions: TRoundRectangleOptions; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + const AColor: TPixel; APenWidth: single); +var + b: TUniversalBrush; + c: TBGRAPixel; + p: TBGRACustomPenStroker; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + c := AColor; + p := GetInternalPen; + FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c), b); +end; + +procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; + const AColor: TPixel; APenWidth: single; AClosedCap: boolean); +var + b: TUniversalBrush; + c: TBGRAPixel; + p: TBGRACustomPenStroker; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + c := AColor; + p := GetInternalPen; + FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c,AClosedCap), b); +end; + +procedure TGenericUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); +var + b: TUniversalBrush; + c: TBGRAPixel; + p: TBGRACustomPenStroker; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + c := AColor; + p := GetInternalPen; + FillPolyAntialias(p.ComputePolyline(APoints,APenWidth,c),b); +end; + +procedure TGenericUniversalBitmap.DrawPolyLineAntialias( + const APoints: array of TPointF; const AColor: TPixel; APenWidth: single; + AClosedCap: boolean); +var + b: TUniversalBrush; + c: TBGRAPixel; + p: TBGRACustomPenStroker; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + c := AColor; + p := GetInternalPen; + FillPolyAntialias(p.ComputePolyline(APoints,APenWidth,c,AClosedCap),b); +end; + +procedure TGenericUniversalBitmap.DrawPolyLineAntialiasAutocycle( + const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); +end; + +procedure TGenericUniversalBitmap.DrawPolygonAntialias( + const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + DrawPolygonAntialias(APoints, b, APenWidth); +end; + +procedure TGenericUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; + const AColor: TPixel; AWidth: single); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + RectangleAntialias(x,y,x2,y2, b, AWidth); +end; + +procedure TGenericUniversalBitmap.Ellipse(x, y, rx, ry: single; + const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AMode); + Ellipse(x,y,rx,ry, b, AWidth,AAlpha); +end; + +procedure TGenericUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; + const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AMode); + {$PUSH}{$R-} + Ellipse(AOrigin, AXAxis, AYAxis, b, AWidth,AAlpha); + {$POP} +end; + +procedure TGenericUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; + const AColor: TPixel; AWidth: single); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + EllipseAntialias(x,y,rx,ry, b, AWidth); +end; + +procedure TGenericUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, + AYAxis: TPointF; const AColor: TPixel; AWidth: single); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + {$PUSH}{$R-} + EllipseAntialias(AOrigin, AXAxis, AYAxis, b, AWidth); + {$POP} +end; + +procedure TGenericUniversalBitmap.DrawPath(APath: IBGRAPath; + const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + DrawPath(APath, b, AWidth, APixelCenteredCoordinates); +end; + +procedure TGenericUniversalBitmap.DrawPath(APath: IBGRAPath; + const AMatrix: TAffineMatrix; const AColor: TPixel; AWidth: single; + APixelCenteredCoordinates: boolean); +var + b: TUniversalBrush; +begin + SolidBrush(b,AColor,AntialiasingDrawMode); + DrawPath(APath,AMatrix, b, AWidth, APixelCenteredCoordinates); +end; + +{$ENDIF} diff --git a/vendor/kam_remake/src/ext/BGRABitmap/universaldrawer.pas b/vendor/kam_remake/src/ext/BGRABitmap/universaldrawer.pas new file mode 100644 index 0000000..9e6e702 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/universaldrawer.pas @@ -0,0 +1,1177 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit UniversalDrawer; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, FPImage, BGRABitmapTypes, BGRAGraphics, BGRAPen, BGRAArrow; + +type + + { TUniversalDrawer } + + TUniversalDrawer = class(TCustomUniversalDrawer) + + class function GetMaxColorChannelDepth(ADest: TCustomUniversalBitmap): byte; + + {==== Load and save files ====} + + //there are UTF8 functions that are different from standard function as those + //depend on TFPCustomImage that does not clearly handle UTF8 + + {** Load image from a file. ''filename'' is an ANSI string } + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string); overload; override; + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string; AOptions: TBGRALoadingOptions); overload; override; + {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader); overload; override; + class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; + {** Load image from a file. ''filename'' is an UTF8 string } + class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; override; + {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } + class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; override; + {** Load image from a stream. Format is detected automatically } + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream); overload; override; + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AOptions: TBGRALoadingOptions); overload; override; + {** Load image from a stream. The specified image reader is used } + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader); overload; override; + class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; + {** Load image from an embedded Lazarus resource. Format is detected automatically } + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string); overload; override; + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AOptions: TBGRALoadingOptions); overload; override; + {** Load image from an embedded Lazarus resource. The specified image reader is used } + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader); overload; override; + class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; + + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string); overload; override; + {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } + class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string; AHandler:TFPCustomImageWriter); overload; override; + {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } + class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); overload; override; + {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } + class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler:TFPCustomImageWriter); overload; override; + + {** Save image to a stream in the specified image format } + class procedure SaveToStreamAs(ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override; + {** Save image to a stream in PNG format } + class procedure SaveToStreamAsPng(ASource: TCustomUniversalBitmap; AStream: TStream); override; + + {==== Pixelwise drawing ====} + + class function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; + class function CheckAntialiasRectBounds(var x, y, x2, y2: single; w: single): boolean; + + {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. + ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } + class procedure DrawLine(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); override; + {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm + ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn } + class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; + {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of length ''dashLen''. + ''DashPos'' can be used to specify the start dash position and to retrieve the dash position at the end + of the line, in order to draw a polyline with consistent dashes } + class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); override; + + class procedure DrawPolyLine(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); override; + class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; + class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; + + class procedure DrawPolygon(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); override; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; override; + + {** Draw the border of a rectangle } + class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; + {** Draw a filled rectangle with a border } + class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; + + class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; + class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; + class procedure FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); override; + + class procedure FillShape(ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; AAlpha: Word = 65535); override; + class procedure FillPoly(ADest: TCustomUniversalBitmap; const APoints: array of TPointF; AFillMode: TFillMode; ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); override; + + {==== Using pen ====} + class function CreatePenStroker: TBGRACustomPenStroker; override; + class function CreateArrow: TBGRACustomArrow; override; + + class procedure RectangleAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; + const ABrush: TUniversalBrush; AWidth: single); override; + class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; + const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; override; + + class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; override; + class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; override; + class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single); overload; override; + class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single); overload; override; + + {==== Filling ====} + class procedure FillRectAntialias(ADest: TCustomUniversalBitmap; + x, y, x2, y2: single; const ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean = true); override; + class procedure FillRoundRectAntialias(ADest: TCustomUniversalBitmap; + x,y,x2,y2, rx,ry: single; const ABrush: TUniversalBrush; + AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); override; + class procedure FillShapeAntialias(ADest: TCustomUniversalBitmap; + AShape: TBGRACustomFillInfo; AFillMode: TFillMode; + ABrush: TUniversalBrush); override; + class procedure FillPolyAntialias(ADest: TCustomUniversalBitmap; + const APoints: array of TPointF; AFillMode: TFillMode; + ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); override; + class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; + x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; override; + class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; + const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; override; + + //filters + class procedure FilterBlurRadial(ASource: TCustomUniversalBitmap; const ABounds: TRect; + radiusX, radiusY: single; blurType: TRadialBlurType; + ADest: TCustomUniversalBitmap); override; + class procedure FilterBlurMotion(ASource: TCustomUniversalBitmap; const ABounds: TRect; + distance: single; angle: single; oriented: boolean; + ADest: TCustomUniversalBitmap); override; + class procedure FilterCustomBlur(ASource: TCustomUniversalBitmap; const ABounds: TRect; + mask: TCustomUniversalBitmap; + ADest: TCustomUniversalBitmap); override; + + end; + +implementation + +uses BGRAPolygon, BGRAPolygonAliased, BGRAPath, BGRAFillInfo, BGRAUTF8, + BGRAReadBMP, BGRAReadJpeg, BGRAWritePNG, BGRAWriteTiff, + BGRAFilterBlur, Math, FPWritePNM; + +{ TUniversalDrawer } + +class function TUniversalDrawer.GetMaxColorChannelDepth(ADest: TCustomUniversalBitmap): byte; +var + idxAlpha, i: Integer; + bits: Byte; +begin + result := 0; + idxAlpha := ADest.Colorspace.IndexOfAlphaChannel; + for i := 0 to ADest.Colorspace.GetChannelCount-1 do + if i <> idxAlpha then + begin + bits := ADest.Colorspace.GetChannelBitDepth(i); + if bits > result then result := bits; + end; +end; + +class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; + const AFilename: string); +begin + LoadFromFileUTF8(ADest, SysToUtf8(AFilename)); +end; + +class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; + const AFilename: string; AOptions: TBGRALoadingOptions); +begin + LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AOptions); +end; + +class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; + const AFilename: String; AHandler: TFPCustomImageReader); +begin + LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AHandler); +end; + +class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; + const AFilename: String; AHandler: TFPCustomImageReader; + AOptions: TBGRALoadingOptions); +begin + LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AHandler, AOptions); +end; + +class procedure TUniversalDrawer.LoadFromFileUTF8( + ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; + AOptions: TBGRALoadingOptions); +var + stream: TStream; + format: TBGRAImageFormat; + reader: TFPCustomImageReader; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite); + try + format := DetectFileFormat(Stream, ExtractFileExt(AFilenameUTF8)); + reader := CreateBGRAImageReader(format); + try + ADest.LoadFromStream(stream, reader, AOptions); + finally + reader.Free; + end; + finally + stream.Free; + end; +end; + +class procedure TUniversalDrawer.LoadFromFileUTF8( + ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +var + stream: TStream; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite); + try + ADest.LoadFromStream(stream, AHandler, AOptions); + finally + stream.Free; + end; +end; + +class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; + AStream: TStream); +begin + ADest.LoadFromStream(AStream, [loKeepTransparentRGB]); +end; + +class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; + AStream: TStream; AOptions: TBGRALoadingOptions); +var + format: TBGRAImageFormat; + reader: TFPCustomImageReader; +begin + format := DetectFileFormat(AStream); + reader := CreateBGRAImageReader(format); + try + ADest.LoadFromStream(AStream, reader, AOptions); + finally + reader.Free; + end; +end; + +class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; + AStream: TStream; AHandler: TFPCustomImageReader); +begin + ADest.LoadFromStream(AStream, AHandler, [loKeepTransparentRGB]); +end; + +class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +var OldBmpOption: TBMPTransparencyOption; + OldJpegPerf: TJPEGReadPerformance; +begin + if (loBmpAutoOpaque in AOptions) and (AHandler is TBGRAReaderBMP) then + begin + OldBmpOption := TBGRAReaderBMP(AHandler).TransparencyOption; + TBGRAReaderBMP(AHandler).TransparencyOption := toAuto; + TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); + TBGRAReaderBMP(AHandler).TransparencyOption := OldBmpOption; + end else + if (loJpegQuick in AOptions) and (AHandler is TBGRAReaderJpeg) then + begin + OldJpegPerf := TBGRAReaderJpeg(AHandler).Performance; + TBGRAReaderJpeg(AHandler).Performance := jpBestSpeed; + TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); + TBGRAReaderJpeg(AHandler).Performance := OldJpegPerf; + end else + TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); + if not (loKeepTransparentRGB in AOptions) then + ADest.ClearTransparentPixels; +end; + +class procedure TUniversalDrawer.LoadFromResource( + ADest: TCustomUniversalBitmap; AFilename: string); +begin + LoadFromResource(ADest, AFilename, [loKeepTransparentRGB]); +end; + +class procedure TUniversalDrawer.LoadFromResource( + ADest: TCustomUniversalBitmap; AFilename: string; + AOptions: TBGRALoadingOptions); +var + stream: TStream; + format: TBGRAImageFormat; + reader: TFPCustomImageReader; + ext: String; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + ext := Uppercase(ExtractFileExt(AFilename)); + if (ext = '.BMP') and BGRAResource.IsWinResource(AFilename) then + begin + reader := TBGRAReaderBMP.Create; + TBGRAReaderBMP(reader).Subformat := bsfHeaderless; + end else + begin + format := DetectFileFormat(stream, ext); + reader := CreateBGRAImageReader(format); + end; + try + ADest.LoadFromStream(stream, reader, AOptions); + finally + reader.Free; + end; + finally + stream.Free; + end; +end; + +class procedure TUniversalDrawer.LoadFromResource( + ADest: TCustomUniversalBitmap; AFilename: string; + AHandler: TFPCustomImageReader); +begin + LoadFromResource(ADest, AFilename, AHandler, [loKeepTransparentRGB]); +end; + +class procedure TUniversalDrawer.LoadFromResource( + ADest: TCustomUniversalBitmap; AFilename: string; + AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); +var + stream: TStream; +begin + stream := BGRAResource.GetResourceStream(AFilename); + try + ADest.LoadFromStream(stream, AHandler, AOptions); + finally + stream.Free; + end; +end; + +class procedure TUniversalDrawer.SaveToFile(ASource: TCustomUniversalBitmap; + const AFilename: string); +begin + SaveToFileUTF8(ASource, SysToUtf8(AFilename)); +end; + +class procedure TUniversalDrawer.SaveToFile(ASource: TCustomUniversalBitmap; + const AFilename: string; AHandler: TFPCustomImageWriter); +begin + SaveToFileUTF8(ASource, SysToUtf8(AFilename), AHandler); +end; + +class procedure TUniversalDrawer.SaveToFileUTF8( + ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); +var + writer: TFPCustomImageWriter; + format: TBGRAImageFormat; + ext: String; +begin + format := SuggestImageFormat(AFilenameUTF8); + if (format = ifXPixMap) and (ASource.NbPixels > 32768) then //xpm is slow so avoid big images + raise exception.Create('Image is too big to be saved as XPM'); + writer := CreateBGRAImageWriter(Format, ASource.HasTransparentPixels); + if GetMaxColorChannelDepth(ASource) > 8 then + begin + if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).WordSized := true; + end; + if writer is TFPWriterPNM then + begin + ext := LowerCase(ExtractFileExt(AFilenameUTF8)); + if ext = '.pbm' then TFPWriterPNM(writer).ColorDepth:= pcdBlackWhite else + if ext = '.pgm' then TFPWriterPNM(writer).ColorDepth:= pcdGrayscale else + if ext = '.ppm' then TFPWriterPNM(writer).ColorDepth:= pcdRGB; + end; + try + SaveToFileUTF8(ASource, AFilenameUTF8, writer); + finally + writer.free; + end; +end; + +class procedure TUniversalDrawer.SaveToFileUTF8( + ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; + AHandler: TFPCustomImageWriter); +var + stream: TFileStreamUTF8; +begin + stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); + try + TFPCustomImage(ASource).SaveToStream(stream, AHandler); + finally + stream.Free; + end; +end; + +class procedure TUniversalDrawer.SaveToStreamAs( + ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); +var writer: TFPCustomImageWriter; +begin + writer := CreateBGRAImageWriter(AFormat, ASource.HasTransparentPixels); + if GetMaxColorChannelDepth(ASource) > 8 then + begin + if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).WordSized := true; + end; + try + TFPCustomImage(ASource).SaveToStream(AStream, writer) + finally + writer.Free; + end; +end; + +class procedure TUniversalDrawer.SaveToStreamAsPng( + ASource: TCustomUniversalBitmap; AStream: TStream); +begin + SaveToStreamAs(ASource, AStream, ifPNG); +end; + +class function TUniversalDrawer.CheckRectBounds( + var x, y, x2, y2: integer; minsize: integer): boolean; +var + temp: integer; +begin + //swap coordinates if needed + if (x > x2) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (y > y2) then + begin + temp := y; + y := y2; + y2 := temp; + end; + result := (x2 - x > minsize) and (y2 - y > minsize); +end; + +class function TUniversalDrawer.CheckAntialiasRectBounds(var x, y, x2, + y2: single; w: single): boolean; +var + temp: Single; +begin + if (x > x2) then + begin + temp := x; + x := x2; + x2 := temp; + end; + if (y > y2) then + begin + temp := y; + y := y2; + y2 := temp; + end; + + result := (x2 - x > w) and (y2 - y > w); +end; + +class procedure TUniversalDrawer.DrawLine(ADest: TCustomUniversalBitmap; x1, + y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; + AAlpha: Word); +type + TDrawPixelProc = procedure(x,y: Int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535) of object; +var + Y, X: integer; + DX, DY, SX, SY, E: integer; + drawPixelProc: TDrawPixelProc; + skip: Boolean; + r: TRect; + E64: Int64; +begin + r := ADest.ClipRect; + skip := false; + if ABrush.DoesNothing or (AAlpha= 0) then skip := true; + if (x1 < r.Left) and (x2 < r.Left) then skip := true; + if (x1 >= r.Right) and (x2 >= r.Right) then skip := true; + if (y1 < r.Top) and (y2 < r.Top) then skip := true; + if (y1 >= r.Bottom) and (y2 >= r.Bottom) then skip := true; + if skip then exit; + + if (Y1 = Y2) then + begin + if (X1 = X2) then + begin + if DrawLastPixel then ADest.DrawPixel(X1, Y1, ABrush, AAlpha); + end else + begin + if not DrawLastPixel then + begin + if X2 > X1 then dec(X2) else inc(X2); + end; + ADest.HorizLine(X1,Y1,X2, ABrush, AAlpha); + end; + Exit; + end else + if (X1 = X2) then + begin + if not DrawLastPixel then + begin + if Y2 > Y1 then dec(Y2) else inc(Y2); + end; + ADest.VertLine(X1,Y1,Y2, ABrush, AAlpha); + Exit; + end; + + DX := X2 - X1; + DY := Y2 - Y1; + + if DX < 0 then + begin + SX := -1; + DX := -DX; + end + else SX := 1; + + if DY < 0 then + begin + SY := -1; + DY := -DY; + end + else SY := 1; + + DX := DX shl 1; + DY := DY shl 1; + + drawPixelProc := @ADest.DrawPixel; + X := X1; + Y := Y1; + if DX > DY then + begin + E := DY - DX shr 1; + if (X < r.Left) and (SX > 0) then + begin + E64 := E+int64(DY)*(r.Left-X)+DX; + E := (E64 mod DX)-DX; + Inc(Y, (E64 div DX)*SY); + X := r.Left; + end; + if (X >= r.Right) and (SX < 0) then + begin + E64 := E+int64(DY)*(X-(r.Right-1))+DX; + E := (E64 mod DX)-DX; + Inc(Y, (E64 div DX)*SY); + X := r.Right-1; + end; + if (X2 < r.Left-1) and (SX < 0) then X2 := r.Left-1; + if (X2 > r.Right) and (SX > 0) then X2 := r.Right; + while X <> X2 do + begin + drawPixelProc(X, Y, ABrush, AAlpha); + if E >= 0 then + begin + Inc(Y, SY); + Dec(E, DX); + end; + Inc(X, SX); + Inc(E, DY); + end; + end + else + begin + E := DX - DY shr 1; + if (Y < r.Top) and (SY > 0) then + begin + E64 := E+int64(DX)*(r.Top-Y)+DY; + E := (E64 mod DY)-DY; + Inc(X, (E64 div DY)*SX); + Y := r.Top; + end; + if (Y >= r.Bottom) and (SY < 0) then + begin + E64 := E+int64(DX)*(Y-(r.Bottom-1))+DY; + E := (E64 mod DY)-DY; + Inc(X, (E64 div DY)*SX); + Y := r.Bottom-1; + end; + if (Y2 < r.Top-1) and (SY < 0) then Y2 := r.Top-1; + if (Y2 > r.Bottom) and (SY > 0) then Y2 := r.Bottom; + while Y <> Y2 do + begin + drawPixelProc(X, Y, ABrush, AAlpha); + if E >= 0 then + begin + Inc(X, SX); + Dec(E, DY); + end; + Inc(Y, SY); + Inc(E, DX); + end; + end; + + if DrawLastPixel then + drawPixelProc(X2, Y2, ABrush, AAlpha); +end; + +class procedure TUniversalDrawer.DrawLineAntialias(ADest: TCustomUniversalBitmap; + x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; + DrawLastPixel: boolean; AAlpha: Word = 65535); +var + dashPos: integer; +begin + dashPos := 0; + DrawLineAntialias(ADest,x1,y1,x2,y2, ABrush,ABrush,$1000000,dashPos,DrawLastPixel,AAlpha); +end; + +class procedure TUniversalDrawer.DrawLineAntialias(ADest: TCustomUniversalBitmap; + x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; + ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; + AAlpha: Word = 65535); +var + curBrush: PUniversalBrush; + + procedure SkipDash(ACount: integer); + begin + if ACount = 0 then exit; + DashPos := PositiveMod(DashPos+ACount, ADashLen+ADashLen); + if DashPos < ADashLen then curBrush := @ABrush1 else curBrush := @ABrush2; + end; + +var + X, Y, DX, DY, SX, SY, E,count, skipAfter: integer; + curAlpha: Word; + skip: Boolean; + r: TRect; + E64: Int64; +begin + r := ADest.ClipRect; + skip := false; + if (ABrush1.DoesNothing and ABrush2.DoesNothing) or (AAlpha=0) then skip := true; + if (x1 < r.Left) and (x2 < r.Left) then skip := true; + if (x1 >= r.Right) and (x2 >= r.Right) then skip := true; + if (y1 < r.Top) and (y2 < r.Top) then skip := true; + if (y1 >= r.Bottom) and (y2 >= r.Bottom) then skip := true; + + if ADashLen<=0 then ADashLen := 1; + if skip then + begin + count := max(abs(x2-x1),abs(y2-y1)); + if DrawLastPixel then inc(count); + SkipDash(count); + exit; + end; + + DashPos := PositiveMod(DashPos,ADashLen+ADashLen); + if DashPos < ADashLen then curBrush := @ABrush1 else curBrush := @ABrush2; + + if (Y1 = Y2) and (X1 = X2) then + begin + if DrawLastPixel then + begin + ADest.DrawPixel(X1, Y1, curBrush^, AAlpha); + inc(DashPos); + if DashPos = ADashLen + ADashLen then DashPos := 0; + end; + Exit; + end; + + DX := X2 - X1; + DY := Y2 - Y1; + if DX < 0 then + begin + SX := -1; + DX := -DX; + end else SX := 1; + + if DY < 0 then + begin + SY := -1; + DY := -DY; + end else SY := 1; + + DX := DX shl 1; + DY := DY shl 1; + X := X1; + Y := Y1; + if DX > DY then + begin + E := 0; + if (X < r.Left) and (SX > 0) then + begin + E64 := E+int64(DY)*(r.Left-X); + E := E64 mod DX; + Inc(Y, (E64 div DX)*SY); + SkipDash(r.Left-X); + X := r.Left; + end; + if (X >= r.Right) and (SX < 0) then + begin + E64 := E+int64(DY)*(X-(r.Right-1)); + E := E64 mod DX; + Inc(Y, (E64 div DX)*SY); + SkipDash(X-(r.Right-1)); + X := r.Right-1; + end; + if (X2 < r.Left-1) and (SX < 0) then + begin + skipAfter := (r.Left-1)-X2; + X2 := r.Left-1; + end else + if (X2 > r.Right) and (SX > 0) then + begin + skipAfter := X2-r.Right; + X2 := r.Right; + end else + skipAfter := 0; + while X <> X2 do + begin + curAlpha := AAlpha * E div DX; + ADest.DrawPixel(X, Y, curBrush^, AAlpha - curAlpha); + ADest.DrawPixel(X, Y + SY, curBrush^, curAlpha); + Inc(E, DY); + if E >= DX then + begin + Inc(Y, SY); + Dec(E, DX); + end; + Inc(X, SX); + + Inc(DashPos); + if DashPos = ADashLen then + curBrush := @ABrush2 + else + if DashPos = ADashLen + ADashLen then + begin + curBrush := @ABrush1; + DashPos := 0; + end; + end; + end + else + begin + E := 0; + if (Y < r.Top) and (SY > 0) then + begin + E64 := E+int64(DX)*(r.Top-Y); + E := E64 mod DY; + Inc(X, (E64 div DY)*SX); + SkipDash(r.Top-Y); + Y := r.Top; + end; + if (Y >= r.Bottom) and (SY < 0) then + begin + E64 := E+int64(DX)*(Y-(r.Bottom-1)); + E := E64 mod DY; + Inc(X, (E64 div DY)*SX); + SkipDash(Y-(r.Bottom-1)); + Y := r.Bottom-1; + end; + if (Y2 < r.Top-1) and (SY < 0) then + begin + skipAfter := (r.Top-1)-Y2; + Y2 := r.Top-1; + end else + if (Y2 > r.Bottom) and (SY > 0) then + begin + skipAfter := Y2-r.Bottom; + Y2 := r.Bottom; + end else + skipAfter := 0; + while Y <> Y2 do + begin + curAlpha := AAlpha * E div DY; + ADest.DrawPixel(X, Y, curBrush^, AAlpha - curAlpha); + ADest.DrawPixel(X + SX, Y, curBrush^, curAlpha); + Inc(E, DX); + if E >= DY then + begin + Inc(X, SX); + Dec(E, DY); + end; + Inc(Y, SY); + + Inc(DashPos); + if DashPos = ADashLen then + curBrush := @ABrush2 + else + if DashPos = ADashLen + ADashLen then + begin + curBrush := @ABrush1; + DashPos := 0; + end; + end; + end; + if DrawLastPixel then + begin + ADest.DrawPixel(X2, Y2, curBrush^, AAlpha); + inc(DashPos); + if DashPos = ADashLen + ADashLen then DashPos := 0; + end; + SkipDash(skipAfter); +end; + +class procedure TUniversalDrawer.DrawPolyLine(ADest: TCustomUniversalBitmap; + const points: array of TPoint; const ABrush: TUniversalBrush; + DrawLastPixel: boolean; AAlpha: Word); +var i,start: integer; +begin + if ABrush.DoesNothing then exit; + start := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if (i = start) and DrawLastPixel then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha); + end else + DrawLine(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, + DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); + end; +end; + +class procedure TUniversalDrawer.DrawPolyLineAntialias( + ADest: TCustomUniversalBitmap; const points: array of TPoint; + const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word); +var i,start: integer; +begin + if ABrush.DoesNothing then exit; + start := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if (i = start) and DrawLastPixel then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha); + end else + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, + DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); + end; +end; + +class procedure TUniversalDrawer.DrawPolyLineAntialias( + ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, + ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; + AAlpha: Word); +var i,start, dashPos: integer; +begin + if ABrush1.DoesNothing and ABrush2.DoesNothing then exit; + start := 0; + dashPos := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if (i = start) and DrawLastPixel then + begin + if dashPos < ADashLen then + ADest.DrawPixel(points[i].x,points[i].y, ABrush1,AAlpha) + else + ADest.DrawPixel(points[i].x,points[i].y, ABrush2,AAlpha); + inc(dashPos); + if dashPos = ADashLen*2 then dashPos := 0; + end; + end else + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, + ABrush1,ABrush2,ADashLen,dashPos, + DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); + end; +end; + +class procedure TUniversalDrawer.DrawPolygon(ADest: TCustomUniversalBitmap; + const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word); +var i,start: integer; +begin + if ABrush.DoesNothing then exit; + start := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if i = start then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha) + else if (i > start) then + DrawLine(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, ABrush, false, AAlpha); + end else + DrawLine(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, false, AAlpha); + end; +end; + +class procedure TUniversalDrawer.DrawPolygonAntialias( + ADest: TCustomUniversalBitmap; const points: array of TPoint; + const ABrush: TUniversalBrush; AAlpha: Word); +var i,start: integer; +begin + if ABrush.DoesNothing then exit; + start := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if i = start then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha) + else if (i > start) then + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, ABrush, false, AAlpha); + end else + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, false, AAlpha); + end; +end; + +class procedure TUniversalDrawer.DrawPolygonAntialias( + ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, + ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word); +var i,start, dashPos: integer; +begin + if ABrush1.DoesNothing and ABrush2.DoesNothing then exit; + start := 0; + dashPos := 0; + for i := 0 to high(points) do + if IsEmptyPoint(points[i]) then start := i+1 else + begin + if (i = high(points)) or IsEmptyPoint(points[i+1]) then + begin + if i = start then + begin + if dashPos < ADashLen then + ADest.DrawPixel(points[i].x,points[i].y, ABrush1,AAlpha) + else + ADest.DrawPixel(points[i].x,points[i].y, ABrush2,AAlpha); + inc(dashPos); + if dashPos = ADashLen*2 then dashPos := 0; + end + else if (i > start) then + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, + ABrush1,ABrush2,ADashLen,dashPos, false, AAlpha); + end else + DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, + ABrush1,ABrush2,ADashLen,dashPos, false, AAlpha); + end; +end; + +class procedure TUniversalDrawer.Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; + const ABrush: TUniversalBrush; AAlpha: Word); +begin + if not CheckRectBounds({%H-}x,{%H-}y,{%H-}x2,{%H-}y2,1) or ABrush.DoesNothing then exit; + ADest.HorizLine(x, y, x2-1, ABrush, AAlpha); + if y2-y > 2 then + begin + ADest.VertLine(x, y+1, y2-2, ABrush, AAlpha); + ADest.VertLine(x2-1, y+1, y2-2, ABrush, AAlpha); + end; + ADest.HorizLine(x, y2-1, x2-1, ABrush, AAlpha); +end; + +class procedure TUniversalDrawer.Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; + const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); +begin + if not CheckRectBounds({%H-}x,{%H-}y,{%H-}x2,{%H-}y2,1) then exit; + Rectangle(ADest, x, y, x2, y2, ABorderBrush, AAlpha); + ADest.FillRect(x+1, y+1, x2-1, y2-1, AFillBrush, AAlpha); +end; + +class procedure TUniversalDrawer.RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; + const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); +begin + BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,ABorderBrush,AFillBrush,AAlpha); +end; + +class procedure TUniversalDrawer.RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; + const ABorderBrush: TUniversalBrush; AAlpha: Word); +begin + BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,ABorderBrush,ABorderBrush,AAlpha,false,true); +end; + +class procedure TUniversalDrawer.FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, + DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word); +begin + BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,AFillBrush,AFillBrush,AAlpha); +end; + +class procedure TUniversalDrawer.FillShape(ADest: TCustomUniversalBitmap; + AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; + AAlpha: Word); +begin + BGRAPolygon.FillShapeAliased(ADest, AShape, ABrush, AAlpha, AFillMode = fmWinding); +end; + +class procedure TUniversalDrawer.FillPoly(ADest: TCustomUniversalBitmap; + const APoints: array of TPointF; AFillMode: TFillMode; + ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; AAlpha: Word); +begin + BGRAPolygon.FillPolyAliased(ADest, APoints, ABrush, AAlpha, AFillMode = fmWinding, APixelCenteredCoordinates); +end; + +class function TUniversalDrawer.CreatePenStroker: TBGRACustomPenStroker; +begin + result := TBGRAPenStroker.Create; +end; + +class function TUniversalDrawer.CreateArrow: TBGRACustomArrow; +begin + result := TBGRAArrow.Create; +end; + +class procedure TUniversalDrawer.RectangleAntialias( + ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; + const ABrush: TUniversalBrush; AWidth: single); +var + hw, bevel: Single; +begin + if (APen.Style = psClear) or (AWidth = 0) then exit; + + if not CheckAntialiasRectBounds(x,y,x2,y2, AWidth) then + begin + hw := AWidth/2; + if APen.JoinStyle = pjsBevel then + begin + bevel := (2 - sqrt(2)) * hw; + FillRoundRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, ABrush, + [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]); + end else + if APen.JoinStyle = pjsRound then + FillRoundRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, ABrush) + else + FillRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, ABrush); + end else + if (APen.JoinStyle = pjsMiter) and (APen.Style = psSolid) and (APen.MiterLimit > 1.4142) then + begin + hw := AWidth/2; + FillPolyAntialias(ADest, [PointF(x-hw,y-hw),PointF(x2+hw,y-hw),PointF(x2+hw,y2+hw),PointF(x-hw,y2+hw),EmptyPointF, + PointF(x+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y+hw),PointF(x+hw,y+hw)], + fmWinding, ABrush, true); + end else + DrawPolygonAntialias(ADest, APen, [Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)], ABrush, AWidth); +end; + +class procedure TUniversalDrawer.DrawPolygonAntialias( + ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; + const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); +begin + FillPolyAntialias(ADest, APen.ComputePolygon(APoints, AWidth), ADest.FillMode, ABrush, true); +end; + +class procedure TUniversalDrawer.Ellipse(ADest: TCustomUniversalBitmap; + APen: TBGRACustomPenStroker; x, y,rx, ry: single; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); +begin + if (APen.Style = psClear) or (AWidth = 0) then exit; + if (APen.Style = psSolid) then + BGRAPolygon.BorderEllipse(ADest, x, y, rx, ry, AWidth, ABrush, AAlpha) + else + begin + if ABrush.DoesNothing then exit; + FillPoly(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(x,y,rx,ry),AWidth), + ADest.FillMode, ABrush, true, AAlpha); + end; +end; + +class procedure TUniversalDrawer.Ellipse(ADest: TCustomUniversalBitmap; + APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); +begin + if (APen.Style = psClear) or (AWidth = 0) or ABrush.DoesNothing then exit; + FillPoly(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(AOrigin, AXAxis, AYAxis), AWidth), + ADest.FillMode, ABrush, true, AAlpha); +end; + +class procedure TUniversalDrawer.EllipseAntialias( + ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; + x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single); +begin + if (APen.Style = psClear) or (AWidth = 0) then exit; + if (APen.Style = psSolid) then + BGRAPolygon.BorderEllipseAntialias(ADest, x, y, rx, ry, AWidth, ABrush) + else + begin + if ABrush.DoesNothing then exit; + FillPolyAntialias(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(x,y,rx,ry),AWidth), + ADest.FillMode, ABrush, true); + end; +end; + +class procedure TUniversalDrawer.EllipseAntialias( + ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, + AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); +begin + if (APen.Style = psClear) or (AWidth = 0) or ABrush.DoesNothing then exit; + FillPolyAntialias(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(AOrigin, AXAxis, AYAxis), AWidth), + ADest.FillMode, ABrush, true); +end; + +class procedure TUniversalDrawer.FillRectAntialias( + ADest: TCustomUniversalBitmap; x, y, x2, y2: single; + const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); +var + fi: TFillRectangleInfo; +begin + if ABrush.DoesNothing then exit; + fi := TFillRectangleInfo.Create(x,y,x2,y2,APixelCenteredCoordinates); + FillShapeAntialias(ADest, fi, fmAlternate, ABrush); + fi.Free; +end; + +class procedure TUniversalDrawer.FillRoundRectAntialias( + ADest: TCustomUniversalBitmap; x, y, x2, y2, rx, ry: single; + const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions; + APixelCenteredCoordinates: boolean); +var + fi: TFillRoundRectangleInfo; +begin + if ABrush.DoesNothing or (x = x2) or (y = y2) then exit; + fi := TFillRoundRectangleInfo.Create(x,y,x2,y2, rx,ry, AOptions, APixelCenteredCoordinates); + FillShapeAntialias(ADest, fi, fmAlternate, ABrush); + fi.Free; +end; + +class procedure TUniversalDrawer.FillShapeAntialias( + ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; + AFillMode: TFillMode; ABrush: TUniversalBrush); +begin + BGRAPolygon.FillShapeAntialias(ADest, AShape, ABrush, AFillMode = fmWinding); +end; + +class procedure TUniversalDrawer.FillPolyAntialias( + ADest: TCustomUniversalBitmap; const APoints: array of TPointF; + AFillMode: TFillMode; ABrush: TUniversalBrush; + APixelCenteredCoordinates: boolean); +begin + BGRAPolygon.FillPolyAntialias(ADest, APoints, ABrush, + AFillMode = fmWinding, APixelCenteredCoordinates); +end; + +class procedure TUniversalDrawer.FillEllipseAntialias( + ADest: TCustomUniversalBitmap; x, y, rx, ry: single; + const ABrush: TUniversalBrush); +begin + BGRAPolygon.FillEllipseAntialias(ADest, x, y, rx, ry, ABrush); +end; + +class procedure TUniversalDrawer.FillEllipseAntialias( + ADest: TCustomUniversalBitmap; const AOrigin, AXAxis, AYAxis: TPointF; + const ABrush: TUniversalBrush); +var + pts: array of TPointF; +begin + if (AOrigin.y = AXAxis.y) and (AOrigin.x = AYAxis.x) then + FillEllipseAntialias(ADest, AOrigin.x,AOrigin.y, + abs(AXAxis.x-AOrigin.x),abs(AYAxis.y-AOrigin.y), ABrush) + else + if (AOrigin.x = AXAxis.x) and (AOrigin.y = AYAxis.y) then + FillEllipseAntialias(ADest, AOrigin.x,AOrigin.y, + abs(AYAxis.x-AOrigin.x),abs(AXAxis.y-AOrigin.y), ABrush) + else + begin + if ABrush.DoesNothing then exit; + pts := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis); + FillPolyAntialias(ADest, pts, fmAlternate, ABrush, true); + end; +end; + +class procedure TUniversalDrawer.FilterBlurRadial( + ASource: TCustomUniversalBitmap; const ABounds: TRect; radiusX, + radiusY: single; blurType: TRadialBlurType; ADest: TCustomUniversalBitmap); +begin + BGRAFilterBlur.FilterBlurRadial(ASource, ABounds, + radiusX,radiusY, blurType, ADest, nil); +end; + +class procedure TUniversalDrawer.FilterBlurMotion( + ASource: TCustomUniversalBitmap; const ABounds: TRect; + distance: single; angle: single; oriented: boolean; + ADest: TCustomUniversalBitmap); +begin + BGRAFilterBlur.FilterBlurMotion(ASource, ABounds, + distance, angle, oriented, ADest, nil); +end; + +class procedure TUniversalDrawer.FilterCustomBlur( + ASource: TCustomUniversalBitmap; const ABounds: TRect; + mask: TCustomUniversalBitmap; ADest: TCustomUniversalBitmap); +begin + BGRAFilterBlur.FilterBlurCustom(ASource, ABounds, + mask, ADest, nil); +end; + +initialization + + UniDrawerClass := TUniversalDrawer; + +end. diff --git a/vendor/kam_remake/src/ext/BGRABitmap/unzipperext.pas b/vendor/kam_remake/src/ext/BGRABitmap/unzipperext.pas new file mode 100644 index 0000000..1b1e67d --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/unzipperext.pas @@ -0,0 +1,129 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit UnzipperExt; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, zipper; + +type + + { TUnzipperStreamUtf8 } + + TUnzipperStreamUtf8 = class(TUnZipper) + private + FCustomOutputStream: TStream; + FCustomInputStream: TStream; + procedure SetInputStream(AValue: TStream); + protected + Procedure CustomOpenInput(Sender: TObject; var AStream: TStream); + procedure CustomCloseInput(Sender: TObject; var AStream: TStream); + procedure CustomCreateOutput(Sender : TObject; var AStream : TStream; {%H-}AItem : TFullZipFileEntry); + procedure CustomCloseOutput(Sender : TObject; var AStream : TStream; {%H-}AItem : TFullZipFileEntry); + public + function UnzipFileToStream(AFilename: string; AStream: TStream; ACaseSensitive: boolean= true): boolean; + function UnzipFileToString(AFilename:string): string; + constructor Create; + property InputStream: TStream read FCustomInputStream write SetInputStream; + end; + +implementation + +uses BGRAUTF8; + +{ TUnzipperStreamUtf8 } + +procedure TUnzipperStreamUtf8.SetInputStream(AValue: TStream); +begin + if FCustomInputStream=AValue then Exit; + FCustomInputStream:=AValue; +end; + +procedure TUnzipperStreamUtf8.CustomOpenInput(Sender: TObject; var AStream: TStream); +begin + if Assigned(FCustomInputStream) then + AStream := FCustomInputStream + else + AStream := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); +end; + +procedure TUnzipperStreamUtf8.CustomCloseInput(Sender: TObject; var AStream: TStream); +begin + if AStream = FCustomInputStream then + AStream := nil + else + FreeAndNil(AStream); +end; + +procedure TUnzipperStreamUtf8.CustomCreateOutput(Sender: TObject; + var AStream: TStream; AItem: TFullZipFileEntry); +begin + AStream := FCustomOutputStream; +end; + +procedure TUnzipperStreamUtf8.CustomCloseOutput(Sender: TObject; + var AStream: TStream; AItem: TFullZipFileEntry); +begin + AStream := nil; +end; + +function TUnzipperStreamUtf8.UnzipFileToStream(AFilename: string; AStream: TStream; + ACaseSensitive: boolean): boolean; +var + i: integer; + entryName: string; +begin + OpenInput; + AFilename := StringReplace(AFilename,'/','\',[rfReplaceAll]); + Try + ReadZipDirectory; + for i := 0 to Entries.count-1 do + begin + entryName := Entries.FullEntries[i].ArchiveFileName; + entryName:= StringReplace(entryName,'/','\',[rfReplaceAll]); + if (entryName = AFilename) or + (not ACaseSensitive and (CompareText(entryName,AFilename)=0)) then + begin + OnCreateStream := @CustomCreateOutput; + OnDoneStream := @CustomCloseOutput; + FCustomOutputStream := AStream; + UnZipOneFile(Entries.FullEntries[i]); + OnCreateStream := nil; + OnDoneStream := nil; + FCustomOutputStream := nil; + result := true; + exit; + end; + end; + Finally + CloseInput; + end; + result := false; +end; + +function TUnzipperStreamUtf8.UnzipFileToString(AFilename: string): string; +var mem: TMemoryStream; +begin + mem := TMemoryStream.Create; + try + UnzipFileToStream(AFilename,mem); + setlength(result,mem.Size); + mem.Position:= 0; + mem.Read(result[1], length(result)); + finally + mem.Free; + end; +end; + +constructor TUnzipperStreamUtf8.Create; +begin + inherited Create; + OnOpenInputStream := @CustomOpenInput; + OnCloseInputStream:= @CustomCloseInput; +end; + + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/uunittest.pas b/vendor/kam_remake/src/ext/BGRABitmap/uunittest.pas new file mode 100644 index 0000000..df2c3a8 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/uunittest.pas @@ -0,0 +1,47 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit UUnitTest; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes; + +implementation + +procedure Test(AExpression: boolean; ADescription: string); +begin + if not AExpression then + raise EAssertionFailed.Create('Assertion failed: '+ADescription); +end; + +var error: boolean; + +initialization + + Test(StrToBGRA('red ')=CSSRed,'ignore spaces'); + Test(StrToBGRA('red@')=BGRAPixelTransparent,'error fallback to transparent'); + Test(StrToBGRA('red@',CSSYellow)=CSSYellow,'error fallback to transparent'); + Test(StrToBGRA('rgb(255,0,0)')=CSSRed,'rgb format'); + Test(StrToBGRA('rgb(255,0,0,0.502)')=BGRA(255,0,0,128),'rgba format'); + Test(StrToBGRA('rgb(255,0,?)')=BGRAPixelTransparent,'missing as an error'); + Test(StrToBGRA('rgb(255,0,?)',CSSYellow)=CSSYellow,'missing as an error'); + Test(PartialStrToBGRA('rgb(255,?,?,?)',BGRA(128,128,128,128),error)=BGRA(255,128,128,128),'missing values replacement'); + Test(not error, 'missing is not an error'); + Test(PartialStrToBGRA('rgb(255,?,?)',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'implicit rgb alpha'); + Test(not error, 'missing is not an error'); + Test(PartialStrToBGRA('rgb(255,abc,0)',BGRA(128,128,128,128),error)=BGRA(255,0,0,255),'error replaced by 0 for rgb'); + Test(error, 'non numeric error'); + Test(PartialStrToBGRA('#ff????',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'missing values replacement'); + Test(not error, 'missing is not an error'); + Test(PartialStrToBGRA('#f??',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'missing values replacement'); + Test(not error, 'missing is not an error'); + Test(PartialStrToBGRA('#12??3456',BGRA(128,128,128,128),error)=BGRA($12,128,$34,$56),'html color with missing values'); + Test(not error, 'missing is not an error'); + Test(BGRAToStr(VGARed)='FF0000FF','Default color format'); + Test(BGRAToStr(BGRA(255,0,0), VGAColors)='Red','VGA color names'); + Test(BGRAToStr(BGRA(255,255,0), CSSColors)='Yellow','CSS color names'); + Test(BGRAToStr(BGRA(250,128,114), CSSColors)='Salmon','CSS color names'); +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/vertex3d.inc b/vendor/kam_remake/src/ext/BGRABitmap/vertex3d.inc new file mode 100644 index 0000000..bff9fdf --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/vertex3d.inc @@ -0,0 +1,457 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +type + { TBGRAObject3D } + + TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D) + private + FColor: TBGRAPixel; + FLight: Single; + FTexture: IBGRAScanner; + FMainPart: IBGRAPart3D; + FFaces: array of IBGRAFace3D; + FFaceCount: integer; + FLightingNormal : TLightingNormal3D; + FParentLighting: boolean; + FMaterial: IBGRAMaterial3D; + FScene: TBGRAScene3D; + FFaceColorsInvalidated, + FMaterialInvalidated: boolean; + procedure AddFace(AFace: IBGRAFace3D); overload; + public + constructor Create(AScene: TBGRAScene3D); + destructor Destroy; override; + procedure Clear; + procedure InvalidateColor; + procedure InvalidateMaterial; + function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload; + function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload; + function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; + procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); + function GetColor: TBGRAPixel; + function GetLight: Single; + function GetTexture: IBGRAScanner; + function GetMainPart: IBGRAPart3D; + function GetLightingNormal: TLightingNormal3D; + function GetParentLighting: boolean; + function GetFace(AIndex: integer): IBGRAFace3D; + function GetFaceCount: integer; + function GetTotalVertexCount: integer; + function GetTotalNormalCount: integer; + function GetMaterial: IBGRAMaterial3D; + procedure SetLightingNormal(const AValue: TLightingNormal3D); + procedure SetParentLighting(const AValue: boolean); + procedure SetColor(const AValue: TBGRAPixel); + procedure SetLight(const AValue: Single); + procedure SetTexture(const AValue: IBGRAScanner); + procedure SetMaterial(const AValue: IBGRAMaterial3D); + procedure RemoveUnusedVertices; + procedure SeparatePart(APart: IBGRAPart3D); + function GetScene: TObject; + function GetRefCount: integer; + procedure SetBiface(AValue : boolean); + procedure ForEachVertex(ACallback: TVertex3DCallback); + procedure ForEachFace(ACallback: TFace3DCallback); + procedure Update; + end; + + { TBGRAVertex3D } + + TBGRAVertex3D = class(TInterfacedObject,IBGRAVertex3D) + private + FColor: TBGRAPixel; + FParentColor: boolean; + FLight: Single; + FTexCoord: TPointF; + FCoordPool: TBGRACoordPool3D; + FCoordPoolIndex: integer; + FCustomFlags: LongWord; + FObject3D: TBGRAObject3D; + function GetCoordData: PBGRACoordData3D; + procedure Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); + public + constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload; + constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload; + destructor Destroy; override; + function GetColor: TBGRAPixel; + function GetLight: Single; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + function GetCustomNormal: TPoint3D; + function GetCustomNormal_128: TPoint3D_128; + function GetSceneCoord: TPoint3D; + function GetSceneCoord_128: TPoint3D_128; + function GetTexCoord: TPointF; + function GetViewCoord: TPoint3D; + function GetViewCoord_128: TPoint3D_128; + function GetUsage: integer; + function GetCustomFlags: LongWord; + procedure SetColor(const AValue: TBGRAPixel); + procedure SetLight(const AValue: Single); + procedure SetViewNormal(const AValue: TPoint3D); + procedure SetViewNormal_128(const AValue: TPoint3D_128); + procedure SetCustomNormal(AValue: TPoint3D); + procedure SetCustomNormal_128(AValue: TPoint3D_128); + procedure NormalizeViewNormal; + procedure AddViewNormal(const AValue: TPoint3D_128); + procedure SetCustomFlags(AValue: LongWord); + procedure SetSceneCoord(const AValue: TPoint3D); + procedure SetSceneCoord_128(const AValue: TPoint3D_128); + procedure SetTexCoord(const AValue: TPointF); + procedure SetViewCoord(const AValue: TPoint3D); + procedure SetViewCoord_128(const AValue: TPoint3D_128); + function GetViewCoordZ: single; + function GetParentColor: Boolean; + procedure SetParentColor(const AValue: Boolean); + function GetProjectedCoord: TPointF; + procedure SetProjectedCoord(const AValue: TPointF); + procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D); + property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord; + property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128; + property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord; + property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128; + property ViewCoordZ: single read GetViewCoordZ; + property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord; + property TexCoord: TPointF read GetTexCoord write SetTexCoord; + property Color: TBGRAPixel read GetColor write SetColor; + property ParentColor: Boolean read GetParentColor write SetParentColor; + property Light: Single read GetLight write SetLight; + property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; + property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; + property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; + property Usage: integer read GetUsage; + property CoordData: PBGRACoordData3D read GetCoordData; + function GetAsObject: TObject; + end; + + { TBGRANormal3D } + + TBGRANormal3D = class(TInterfacedObject,IBGRANormal3D) + private + FPool: TBGRANormalPool3D; + FPoolIndex: integer; + function GetCustomNormal: TPoint3D; + function GetCustomNormal_128: TPoint3D_128; + function GetUsage: integer; + function GetViewNormal: TPoint3D; + function GetViewNormal_128: TPoint3D_128; + procedure SetCustomNormal(AValue: TPoint3D); + procedure SetCustomNormal_128(AValue: TPoint3D_128); + procedure SetViewNormal(AValue: TPoint3D); + procedure SetViewNormal_128(AValue: TPoint3D_128); + public + constructor Create(ANormalPool: TBGRANormalPool3D; ACustomNormal: TPoint3D); overload; + constructor Create(ANormalPool: TBGRANormalPool3D; ACustomNormal: TPoint3D_128); overload; + destructor Destroy; override; + property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; + property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; + property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; + property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; + property Usage: integer read GetUsage; + end; + +{ TBGRANormal3D } + +function TBGRANormal3D.GetCustomNormal: TPoint3D; +begin + result := Point3D((FPool.NormalData[FPoolIndex])^.customNormal); +end; + +function TBGRANormal3D.GetCustomNormal_128: TPoint3D_128; +begin + result := (FPool.NormalData[FPoolIndex])^.customNormal; +end; + +function TBGRANormal3D.GetUsage: integer; +begin + result := frefcount; +end; + +function TBGRANormal3D.GetViewNormal: TPoint3D; +begin + result := Point3D((FPool.NormalData[FPoolIndex])^.viewNormal); +end; + +function TBGRANormal3D.GetViewNormal_128: TPoint3D_128; +begin + result := (FPool.NormalData[FPoolIndex])^.viewNormal; +end; + +procedure TBGRANormal3D.SetCustomNormal(AValue: TPoint3D); +begin + (FPool.NormalData[FPoolIndex])^.customNormal := Point3D_128(AValue); +end; + +procedure TBGRANormal3D.SetCustomNormal_128(AValue: TPoint3D_128); +begin + (FPool.NormalData[FPoolIndex])^.customNormal := AValue; +end; + +procedure TBGRANormal3D.SetViewNormal(AValue: TPoint3D); +begin + (FPool.NormalData[FPoolIndex])^.viewNormal := Point3D_128(AValue); +end; + +procedure TBGRANormal3D.SetViewNormal_128(AValue: TPoint3D_128); +begin + (FPool.NormalData[FPoolIndex])^.viewNormal := AValue; +end; + +constructor TBGRANormal3D.Create(ANormalPool: TBGRANormalPool3D; + ACustomNormal: TPoint3D); +begin + FPool := ANormalPool; + FPoolIndex:= FPool.Add; + CustomNormal := ACustomNormal; +end; + +constructor TBGRANormal3D.Create(ANormalPool: TBGRANormalPool3D; + ACustomNormal: TPoint3D_128); +begin + FPool := ANormalPool; + FPoolIndex:= FPool.Add; + CustomNormal_128 := ACustomNormal; +end; + +destructor TBGRANormal3D.Destroy; +begin + FPool.Remove(FPoolIndex); + inherited Destroy; +end; + +{ TBGRAVertex3D } + +procedure TBGRAVertex3D.Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); +begin + FObject3D := AObject3D; + FCoordPool := ACoordPool; + FCoordPoolIndex := FCoordPool.Add; + FColor := BGRAWhite; + FParentColor := True; + FLight := 1; + SceneCoord_128 := ASceneCoord; +end; + +procedure TBGRAVertex3D.SetCustomNormal(AValue: TPoint3D); +begin + with FCoordPool.CoordData[FCoordPoolIndex]^ do + begin + customNormal := Point3D_128(AValue); + customNormalUsed := not CompareMem(@customNormal,@Point3D_128_Zero,sizeof(Point3D_128_Zero)); + end; +end; + +procedure TBGRAVertex3D.SetCustomNormal_128(AValue: TPoint3D_128); +begin + with FCoordPool.CoordData[FCoordPoolIndex]^ do + begin + customNormal := AValue; + customNormalUsed := not CompareMem(@customNormal,@Point3D_128_Zero,sizeof(Point3D_128_Zero)); + end; +end; + +function TBGRAVertex3D.GetCoordData: PBGRACoordData3D; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]; +end; + +function TBGRAVertex3D.GetCustomNormal: TPoint3D; +begin + result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.customNormal); +end; + +function TBGRAVertex3D.GetCustomNormal_128: TPoint3D_128; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.customNormal; +end; + +constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); +begin + Init(AObject3D, ACoordPool, Point3D_128(ASceneCoord)); +end; + +constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); +begin + Init(AObject3D, ACoordPool, ASceneCoord); +end; + +destructor TBGRAVertex3D.Destroy; +begin + FCoordPool.Remove(FCoordPoolIndex); + inherited Destroy; +end; + +function TBGRAVertex3D.GetColor: TBGRAPixel; +begin + result := FColor; +end; + +function TBGRAVertex3D.GetLight: Single; +begin + result := FLight; +end; + +function TBGRAVertex3D.GetViewNormal: TPoint3D; +begin + result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal); +end; + +function TBGRAVertex3D.GetViewNormal_128: TPoint3D_128; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal; +end; + +function TBGRAVertex3D.GetSceneCoord: TPoint3D; +begin + result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord); +end; + +function TBGRAVertex3D.GetSceneCoord_128: TPoint3D_128; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord; +end; + +function TBGRAVertex3D.GetTexCoord: TPointF; +begin + result := FTexCoord; +end; + +function TBGRAVertex3D.GetViewCoord: TPoint3D; +begin + result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord); +end; + +function TBGRAVertex3D.GetViewCoord_128: TPoint3D_128; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord; +end; + +function TBGRAVertex3D.GetUsage: integer; +begin + result := frefcount; +end; + +function TBGRAVertex3D.GetCustomFlags: LongWord; +begin + result := FCustomFlags; +end; + +procedure TBGRAVertex3D.SetColor(const AValue: TBGRAPixel); +begin + FColor := AValue; + FParentColor := false; + FObject3D.InvalidateColor; +end; + +procedure TBGRAVertex3D.SetLight(const AValue: Single); +begin + FLight := AValue; +end; + +procedure TBGRAVertex3D.SetViewNormal(const AValue: TPoint3D); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := Point3D_128(AValue); +end; + +procedure TBGRAVertex3D.SetViewNormal_128(const AValue: TPoint3D_128); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := AValue; +end; + +procedure TBGRAVertex3D.SetSceneCoord(const AValue: TPoint3D); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := Point3D_128(AValue); +end; + +procedure TBGRAVertex3D.SetSceneCoord_128(const AValue: TPoint3D_128); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := AValue; +end; + +procedure TBGRAVertex3D.SetTexCoord(const AValue: TPointF); +begin + FTexCoord := AValue; +end; + +procedure TBGRAVertex3D.SetViewCoord(const AValue: TPoint3D); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := Point3D_128(AValue); +end; + +procedure TBGRAVertex3D.SetViewCoord_128(const AValue: TPoint3D_128); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := AValue; +end; + +function TBGRAVertex3D.GetViewCoordZ: single; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord.Z; +end; + +function TBGRAVertex3D.GetParentColor: Boolean; +begin + result := FParentColor; +end; + +procedure TBGRAVertex3D.SetParentColor(const AValue: Boolean); +begin + FParentColor := AValue; + FObject3D.InvalidateColor; +end; + +function TBGRAVertex3D.GetProjectedCoord: TPointF; +begin + result := FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord; +end; + +procedure TBGRAVertex3D.SetProjectedCoord(const AValue: TPointF); +begin + FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord := AValue; +end; + +procedure TBGRAVertex3D.ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection : TProjection3D); +var P: PBGRACoordData3D; +begin + P := FCoordPool.CoordData[FCoordPoolIndex]; + with p^ do + begin + viewCoord := AMatrix*sceneCoord; + if customNormalUsed then + viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal) + else + ClearPoint3D_128(viewNormal); + if viewCoord.z > 0 then + begin + InvZ := 1/viewCoord.z; + projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, + viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); + end else + projectedCoord := PointF(0,0); + end; +end; + +function TBGRAVertex3D.GetAsObject: TObject; +begin + result := self; +end; + +procedure TBGRAVertex3D.NormalizeViewNormal; +begin + Normalize3D_128(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal); +end; + +procedure TBGRAVertex3D.AddViewNormal(const AValue: TPoint3D_128); +begin + with FCoordPool.CoordData[FCoordPoolIndex]^ do + if not customNormalUsed then + Add3D_Aligned(viewNormal, AValue); +end; + +procedure TBGRAVertex3D.SetCustomFlags(AValue: LongWord); +begin + FCustomFlags:= AValue; +end; + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/wordxyzabitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/wordxyzabitmap.pas new file mode 100644 index 0000000..74aae80 --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/wordxyzabitmap.pas @@ -0,0 +1,777 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit WordXYZABitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; + +type + + { TWordXYZABitmap } + + TWordXYZABitmap = class(specialize TGenericUniversalBitmap) + protected + function InternalNew: TCustomUniversalBitmap; override; + procedure AssignTransparentPixel(out ADest); override; + public + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TWordXYZA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + procedure ReplaceImaginary(const AAfter: TWordXYZA); + end; + +const + WordXYZATransparent : TWordXYZA = (X:0; Y:0; Z:0; alpha:0); + +operator = (const c1, c2: TWordXYZA): boolean; inline; + +implementation + +uses XYZABitmap; + +operator = (const c1, c2: TWordXYZA): boolean; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + Result := True + else + Result := (c1.alpha = c2.alpha) and (c1.X = c2.X) and + (c1.Y = c2.Y) and (c1.Z = c2.Z); +end; + +procedure WordXYZASolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PWordXYZA(AContextData^.Dest), ACount); +end; + +procedure WordXYZAChunkSetPixels( + ASource: PWordXYZA; ADest: PWordXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + ((ASource^.alpha*alphaOver+32768) shr 16); + if finalAlpha <= 0 then ADest^ := WordXYZATransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure WordXYZASolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; +begin + pDest := PWordXYZA(AContextData^.Dest); + WordXYZAChunkSetPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure WordXYZAChunkDrawPixels( + ASource: PWordXYZA; ADest: PWordXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver, srcAlphaOver, finalAlpha, finalAlphaDiv2, residualAlpha: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha >= 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + srcAlphaOver := (ASource^.alpha*alphaOver+32768) shr 16; + if srcAlphaOver >= 65535 then + ADest^ := ASource^ + else + begin + if srcAlphaOver >= 32768 then inc(srcAlphaOver); + residualAlpha := (ADest^.alpha*UInt32or64(65536-srcAlphaOver)+32768) shr 16; + finalAlpha := residualAlpha + srcAlphaOver; + if finalAlpha <= 0 then ADest^ := WordXYZATransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + ADest^.alpha:= finalAlpha; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*srcAlphaOver + finalAlphaDiv2) div finalAlpha; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; +end; + +procedure WordXYZASolidBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; +begin + pDest := PWordXYZA(AContextData^.Dest); + WordXYZAChunkDrawPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure WordXYZAChunkXorPixels( + ASource: PWordXYZA; ADest: PWordXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; + xored: TWordXYZA; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + PQWord(ADest)^ := PQWord(ADest)^ xor PQWord(ASource)^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + PQWord(@xored)^ := PQWord(ADest)^ xor PQWord(ASource)^; + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + ((xored.alpha*alphaOver+32768) shr 16); + if finalAlpha <= 0 then ADest^ := WordXYZATransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + xored.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Y := (ADest^.Y*residualAlpha + + xored.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Z := (ADest^.Z*residualAlpha + + xored.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure WordXYZASolidBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; +begin + pDest := PWordXYZA(AContextData^.Dest); + WordXYZAChunkXorPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +type + PWordXYZAScannerBrushFixedData = ^TWordXYZAScannerBrushFixedData; + TWordXYZAScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + Conversion: TBridgedConversion; + end; + +procedure WordXYZAScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure WordXYZAScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PWordXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); + WordXYZAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerChunkBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PWordXYZA; + qty: Integer; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + WordXYZAChunkSetPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAChunkSetPixelsExceptTransparent( + ASource: PWordXYZA; ADest: PWordXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +var + alphaOver: UInt32or64; + finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + if ASource^.alpha = 65535 then ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; + while ACount > 0 do + begin + if ASource^.alpha = 65535 then + begin + residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + AAlpha; + if finalAlpha <= 0 then ADest^ := WordXYZATransparent else + begin + if finalAlpha > 65535 then finalAlpha := 65535; + finalAlphaDiv2 := finalAlpha shr 1; + ADest^.alpha:= finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure WordXYZAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; + qty: Integer; + psrc: Pointer; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + WordXYZAChunkSetPixelsExceptTransparent(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PWordXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); + WordXYZAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerChunkBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + WordXYZAChunkDrawPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerConvertBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PWordXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); + WordXYZAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerChunkBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + WordXYZAChunkXorPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAScannerConvertBrushXorPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PWordXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TWordXYZA; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); + WordXYZAChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure WordXYZAMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; + qty, maskStride: Integer; + pMask: PByteMask; + factor: UInt32or64; +begin + with PWordXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + if AAlpha = 65535 then + begin + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + if pMask^.gray >= 128 then + pDest^.alpha := (pDest^.alpha*(pMask^.gray+1)) shr 8 + else pDest^.alpha := pDest^.alpha*pMask^.gray shr 8; + if pDest^.alpha = 0 then pDest^ := WordXYZATransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end else + begin + factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := (pDest^.alpha*((factor*pMask^.gray+128) shr 8)) shr 16; + if pDest^.alpha = 0 then pDest^ := WordXYZATransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + end; + PWordXYZA(AContextData^.Dest) := pDest; + end; +end; + +procedure WordXYZAAlphaBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; + alphaOver, residualAlpha, finalAlpha: UInt32or64; +begin + if AAlpha=0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + if AAlpha=65535 then + begin + finalAlpha := PWord(AFixedData)^; + while ACount > 0 do + begin + pDest^.alpha := finalAlpha; + inc(pDest); + dec(ACount); + end; + end else + begin + if AAlpha >= 32768 then alphaOver := AAlpha+1 + else alphaOver := AAlpha; + while ACount > 0 do + begin + residualAlpha := (pDest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; + finalAlpha := residualAlpha + (PWord(AFixedData)^*alphaOver+32768) shr 16; + if finalAlpha > 65535 then finalAlpha := 65535; + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + end; + PWordXYZA(AContextData^.Dest) := pDest; +end; + +procedure WordXYZAAlphaBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PWordXYZA; + alphaMul, finalAlpha: UInt32or64; +begin + if AAlpha=0 then + begin + inc(PWordXYZA(AContextData^.Dest), ACount); + exit; + end; + pDest := PWordXYZA(AContextData^.Dest); + if AAlpha<>65535 then + alphaMul := 65535-((PWord(AFixedData)^*AAlpha+32767) div 65535) + else + alphaMul := 65535-PWord(AFixedData)^; + if alphaMul >= 32768 then inc(alphaMul); + while ACount > 0 do + begin + finalAlpha := (pDest^.alpha*alphaMul+32768) shr 16; + if finalAlpha <= 0 then pDest^ := WordXYZATransparent else + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + PWordXYZA(AContextData^.Dest) := pDest; +end; + +{ TWordXYZABitmap } + +function TWordXYZABitmap.InternalNew: TCustomUniversalBitmap; +begin + Result:= TWordXYZABitmap.Create; +end; + +procedure TWordXYZABitmap.AssignTransparentPixel(out ADest); +begin + TWordXYZA(ADest) := WordXYZATransparent; +end; + +class procedure TWordXYZABitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TWordXYZA; ADrawMode: TDrawMode); +begin + ABrush.Colorspace:= TWordXYZAColorspace; + PWordXYZA(@ABrush.FixedData)^ := AColor; + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels; + + dmSetExceptTransparent: + if AColor.alpha < 65535 then + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels + else + begin + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels; + ABrush.DoesNothing := true; + end; + + dmDrawWithTransparency,dmLinearBlend: + if AColor.alpha<=0 then + begin + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end + else if AColor.alpha>=1 then + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels + else + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushDrawPixels; + + dmXor: if PQWord(@AColor)^ = 0 then + begin + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end else + ABrush.InternalPutNextPixels:= @WordXYZASolidBrushXorPixels; + end; +end; + +class procedure TWordXYZABitmap.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer; AOffsetY: integer); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TWordXYZAColorspace; + with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @WordXYZAScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if sourceSpace = TWordXYZAColorspace then + begin + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushXorPixels; + end; + end else + begin + with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TWordXYZAColorspace); + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushDrawPixels; + dmXor: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushXorPixels; + end; + end; +end; + +class procedure TWordXYZABitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TWordXYZAColorspace; + with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @WordXYZAScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @WordXYZAMaskBrushApply; +end; + +class procedure TWordXYZABitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, WordXYZATransparent, dmDrawWithTransparency); + exit; + end; + ABrush.Colorspace:= TWordXYZAColorspace; + PWord(@ABrush.FixedData)^ := AAlpha; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @WordXYZAAlphaBrushErasePixels; +end; + +class procedure TWordXYZABitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, WordXYZATransparent, dmSet); + exit; + end; + ABrush.Colorspace:= TWordXYZAColorspace; + PWord(@ABrush.FixedData)^ := AAlpha; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @WordXYZAAlphaBrushSetPixels; +end; + +procedure TWordXYZABitmap.ReplaceImaginary(const AAfter: TWordXYZA); +var + p: PWordXYZA; + n: integer; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if (p^.alpha>0) and not IsRealColor(p^) then p^ := AAfter; + Inc(p); + end; + InvalidateBitmap; +end; + +end. + diff --git a/vendor/kam_remake/src/ext/BGRABitmap/xyzabitmap.pas b/vendor/kam_remake/src/ext/BGRABitmap/xyzabitmap.pas new file mode 100644 index 0000000..8dc2a4f --- /dev/null +++ b/vendor/kam_remake/src/ext/BGRABitmap/xyzabitmap.pas @@ -0,0 +1,673 @@ +// SPDX-License-Identifier: LGPL-3.0-linking-exception +unit XYZABitmap; + +{$mode objfpc}{$H+} + +interface + +uses + BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; + +type + + { TXYZABitmap } + + TXYZABitmap = class(specialize TGenericUniversalBitmap) + protected + function InternalNew: TCustomUniversalBitmap; override; + procedure AssignTransparentPixel(out ADest); override; + public + class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TXYZA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; + class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; + AOffsetX: integer = 0; AOffsetY: integer = 0); override; + class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; + procedure ReplaceImaginary(const AAfter: TXYZA); + end; + +const + XYZATransparent : TXYZA = (X:0; Y:0; Z:0; alpha:0); + +operator = (const c1, c2: TXYZA): boolean; inline; +function IsRealColor(xyza: TXYZA): boolean; + +implementation + +uses BGRAFillInfo; + +operator = (const c1, c2: TXYZA): boolean; +begin + if (c1.alpha = 0) and (c2.alpha = 0) then + Result := True + else + Result := (c1.alpha = c2.alpha) and (c1.X = c2.X) and + (c1.Y = c2.Y) and (c1.Z = c2.Z); +end; + +var + xyHorseshoePolygon: TFillShapeInfo; + +procedure MakeXYHorseshoePolygon; +var + pts: array of TPointF; + i: Integer; + n: Single; +begin + setlength(pts, length(SpectralLocus)); + for i := 0 to high(pts) do + begin + n := SpectralLocus[i].X+SpectralLocus[i].Y+SpectralLocus[i].Z; + pts[i].x := SpectralLocus[i].X/n; + pts[i].y := SpectralLocus[i].Y/n; + end; + xyHorseshoePolygon := TFillPolyInfo.Create(pts, false); + pts := nil; +end; + +function IsRealColor(xyza: TXYZA): boolean; +const dim = 0.015; +var + n: Single; +begin + xyza.ChromaticAdapt(GetReferenceWhiteIndirect^, ReferenceWhite2E); + if (xyza.Y < 0) or (xyza.Y > 1) or (xyza.X < 0) or (xyza.Z < 0) then exit(false); + if (xyza.Y = 0) then exit((xyza.X=0) and (xyza.Z=0)); + if xyHorseshoePolygon = nil then MakeXYHorseshoePolygon; + n := xyza.X + xyza.Y + xyza.Z; + result := xyHorseshoePolygon.IsPointInside(xyza.X/n*(1-dim)+1/3*dim, xyza.Y/n*(1-dim)+1/3*dim, false); +end; + +procedure XYZASolidBrushSkipPixels({%H-}AFixedData: Pointer; + AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); +begin + inc(PXYZA(AContextData^.Dest), ACount); +end; + +procedure XYZAChunkSetPixels( + ASource: PXYZA; ADest: PXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + residualAlpha := ADest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + ASource^.alpha*alphaOver; + if finalAlpha <= 0 then ADest^ := XYZATransparent else + begin + if finalAlpha > 1 then finalAlpha := 1; + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*(finalAlpha-residualAlpha) ) * finalAlphaInv; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure XYZASolidBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PXYZA; +begin + pDest := PXYZA(AContextData^.Dest); + XYZAChunkSetPixels( PXYZA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +procedure XYZAChunkDrawPixels( + ASource: PXYZA; ADest: PXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, srcAlphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + srcAlphaOver := ASource^.alpha*alphaOver; + if srcAlphaOver >= 1 then + ADest^ := ASource^ + else + begin + residualAlpha := ADest^.alpha*(1-srcAlphaOver); + finalAlpha := residualAlpha + srcAlphaOver; + if finalAlpha <= 0 then ADest^ := XYZATransparent else + begin + if finalAlpha > 1 then finalAlpha := 1; + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*srcAlphaOver ) * finalAlphaInv; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*srcAlphaOver ) * finalAlphaInv; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*srcAlphaOver ) * finalAlphaInv; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; +end; + +procedure XYZASolidBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PXYZA; +begin + pDest := PXYZA(AContextData^.Dest); + XYZAChunkDrawPixels( PXYZA(AFixedData), pDest, AAlpha, ACount, 0); + inc(pDest, ACount); + AContextData^.Dest := pDest; +end; + +type + PXYZAScannerBrushFixedData = ^TXYZAScannerBrushFixedData; + TXYZAScannerBrushFixedData = record + Scanner: Pointer; //avoid ref count by using pointer type + OffsetX, OffsetY: integer; + Conversion: TBridgedConversion; + end; + +procedure XYZAScannerBrushInitContext(AFixedData: Pointer; + AContextData: PUniBrushContext); +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, + AContextData^.Ofs.Y + OffsetY); +end; + +procedure XYZAScannerConvertBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TXYZA; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); + XYZAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAScannerChunkBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PXYZA; + qty: Integer; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + XYZAChunkSetPixels(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAChunkSetPixelsExceptTransparent( + ASource: PXYZA; ADest: PXYZA; + AAlpha: Word; ACount: integer; ASourceStride: integer); inline; +const oneOver65535 = 1/65535; +var + alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; +begin + if AAlpha=0 then exit; + if AAlpha=65535 then + begin + while ACount > 0 do + begin + if ASource^.alpha >= 1 then + ADest^ := ASource^; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + if ASource^.alpha >= 1 then + begin + residualAlpha := ADest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + alphaOver; + if finalAlpha <= 0 then ADest^ := XYZATransparent else + begin + ADest^.alpha:= finalAlpha; + finalAlphaInv := 1/finalAlpha; + ADest^.X := (ADest^.X*residualAlpha + + ASource^.X*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.Y := (ADest^.Y*residualAlpha + + ASource^.Y*(finalAlpha-residualAlpha) ) * finalAlphaInv; + ADest^.Z := (ADest^.Z*residualAlpha + + ASource^.Z*(finalAlpha-residualAlpha) ) * finalAlphaInv; + end; + end; + inc(ADest); + dec(ACount); + inc(PByte(ASource), ASourceStride); + end; + end; +end; + +procedure XYZAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PXYZA; + qty: Integer; + psrc: Pointer; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + XYZAChunkSetPixelsExceptTransparent(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TXYZA; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); + XYZAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAScannerChunkBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + qty: Integer; + pDest: PXYZA; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + XYZAChunkDrawPixels(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAScannerConvertBrushDrawPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + psrc: Pointer; + pDest: PXYZA; + qty, pixSize: Integer; + buf: packed array[0..7] of TXYZA; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; + while ACount > 0 do + begin + if ACount > length(buf) then qty := length(buf) else qty := ACount; + IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); + Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); + XYZAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); + inc(pDest, qty); + dec(ACount, qty); + end; + AContextData^.Dest := pDest; + end; +end; + +procedure XYZAMaskBrushApply(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +var + pDest: PXYZA; + qty, maskStride: Integer; + pMask: PByteMask; + factor: single; +begin + with PXYZAScannerBrushFixedData(AFixedData)^ do + begin + if AAlpha = 0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + IBGRAScanner(Scanner).ScanSkipPixels(ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + factor := AAlpha/(65535*255); + while ACount > 0 do + begin + qty := ACount; + IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); + dec(ACount,qty); + while qty > 0 do + begin + pDest^.alpha := pDest^.alpha*pMask^.gray*factor; + if pDest^.alpha = 0 then pDest^ := XYZATransparent; + inc(pDest); + inc(pMask, maskStride); + dec(qty); + end; + end; + PXYZA(AContextData^.Dest) := pDest; + end; +end; + +procedure XYZAAlphaBrushSetPixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +const oneOver65535 = 1/65535; +var + pDest: PXYZA; + alphaOver, residualAlpha, finalAlpha: single; +begin + if AAlpha=0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + if AAlpha=65535 then + begin + finalAlpha := PSingle(AFixedData)^; + while ACount > 0 do + begin + pDest^.alpha := finalAlpha; + inc(pDest); + dec(ACount); + end; + end else + begin + alphaOver := AAlpha*single(oneOver65535); + while ACount > 0 do + begin + residualAlpha := pDest^.alpha*(1-alphaOver); + finalAlpha := residualAlpha + PSingle(AFixedData)^*alphaOver; + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + end; + PXYZA(AContextData^.Dest) := pDest; +end; + +procedure XYZAAlphaBrushErasePixels(AFixedData: Pointer; + AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); +const oneOver65535 = 1/65535; +var + pDest: PXYZA; + alphaMul, finalAlpha: single; +begin + if AAlpha=0 then + begin + inc(PXYZA(AContextData^.Dest), ACount); + exit; + end; + pDest := PXYZA(AContextData^.Dest); + if AAlpha<>65535 then + alphaMul := 1-PSingle(AFixedData)^*AAlpha*single(oneOver65535) + else + alphaMul := 1-PSingle(AFixedData)^; + while ACount > 0 do + begin + finalAlpha := pDest^.alpha*alphaMul; + if finalAlpha <= 0 then pDest^ := XYZATransparent else + pDest^.alpha:= finalAlpha; + inc(pDest); + dec(ACount); + end; + PXYZA(AContextData^.Dest) := pDest; +end; + +{ TXYZABitmap } + +function TXYZABitmap.InternalNew: TCustomUniversalBitmap; +begin + Result:= TXYZABitmap.Create; +end; + +procedure TXYZABitmap.AssignTransparentPixel(out ADest); +begin + TXYZA(ADest) := XYZATransparent; +end; + +class procedure TXYZABitmap.SolidBrush(out ABrush: TUniversalBrush; + const AColor: TXYZA; ADrawMode: TDrawMode); +begin + ABrush.Colorspace:= TXYZAColorspace; + PXYZA(@ABrush.FixedData)^ := AColor; + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels; + + dmSetExceptTransparent: + if AColor.alpha < 1 then + ABrush.InternalPutNextPixels:= @XYZASolidBrushSkipPixels + else + begin + ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels; + ABrush.DoesNothing := true; + end; + + dmDrawWithTransparency,dmLinearBlend: + if AColor.alpha<=0 then + begin + ABrush.InternalPutNextPixels:= @XYZASolidBrushSkipPixels; + ABrush.DoesNothing := true; + end + else if AColor.alpha>=1 then + ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels + else + ABrush.InternalPutNextPixels:= @XYZASolidBrushDrawPixels; + + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; +end; + +class procedure TXYZABitmap.ScannerBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; ADrawMode: TDrawMode; + AOffsetX: integer; AOffsetY: integer); +var + sourceSpace: TColorspaceAny; +begin + ABrush.Colorspace:= TXYZAColorspace; + with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @XYZAScannerBrushInitContext; + sourceSpace := AScanner.GetScanCustomColorspace; + if sourceSpace = TXYZAColorspace then + begin + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushDrawPixels; + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; + end else + begin + with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + Conversion := sourceSpace.GetBridgedConversion(TXYZAColorspace); + case ADrawMode of + dmSet: ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushSetPixels; + dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushSetPixelsExceptTransparent; + dmDrawWithTransparency,dmLinearBlend: + ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushDrawPixels; + dmXor: raise exception.Create('Xor mode not available with floating point values'); + end; + end; +end; + +class procedure TXYZABitmap.MaskBrush(out ABrush: TUniversalBrush; + AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); +begin + ABrush.Colorspace:= TXYZAColorspace; + with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do + begin + Scanner := Pointer(AScanner); + OffsetX := AOffsetX; + OffsetY := AOffsetY; + end; + ABrush.InternalInitContext:= @XYZAScannerBrushInitContext; + ABrush.InternalPutNextPixels:= @XYZAMaskBrushApply; +end; + +class procedure TXYZABitmap.EraseBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, XYZATransparent, dmDrawWithTransparency); + exit; + end; + ABrush.Colorspace:= TXYZAColorspace; + PSingle(@ABrush.FixedData)^ := AAlpha/65535; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @XYZAAlphaBrushErasePixels; +end; + +class procedure TXYZABitmap.AlphaBrush(out ABrush: TUniversalBrush; + AAlpha: Word); +begin + if AAlpha = 0 then + begin + SolidBrush(ABrush, XYZATransparent, dmSet); + exit; + end; + ABrush.Colorspace:= TXYZAColorspace; + PSingle(@ABrush.FixedData)^ := AAlpha/65535; + ABrush.InternalInitContext:= nil; + ABrush.InternalPutNextPixels:= @XYZAAlphaBrushSetPixels; +end; + +procedure TXYZABitmap.ReplaceImaginary(const AAfter: TXYZA); +var + p: PXYZA; + n: integer; +begin + p := Data; + for n := NbPixels - 1 downto 0 do + begin + if (p^.alpha>0) and not IsRealColor(p^) then p^ := AAfter; + Inc(p); + end; + InvalidateBitmap; +end; + +finalization + + xyHorseshoePolygon.Free; + +end. + diff --git a/vendor/kam_remake/src/ext/BinaryHeapStub.pas b/vendor/kam_remake/src/ext/BinaryHeapStub.pas new file mode 100644 index 0000000..8746ed9 --- /dev/null +++ b/vendor/kam_remake/src/ext/BinaryHeapStub.pas @@ -0,0 +1,81 @@ +unit BinaryHeapStub; +interface +uses Types, Math, SysUtils; + + +type + TComparator = function(A, B: Pointer): Boolean of object; + + TBinaryHeap = class + private + fCount: Cardinal; + fItems: array of Pointer; + public + Cmp: TComparator; + constructor Create(aSize: Cardinal); + procedure Clear; + function IsEmpty: Boolean; + function Pop: Pointer; + procedure Push(x: Pointer); + procedure UpdateItem(x: Pointer); + end; + + +implementation + + +{ TBinaryHeap } +constructor TBinaryHeap.Create(aSize: Cardinal); +begin + inherited Create; + + SetLength(fItems, aSize); +end; + + +procedure TBinaryHeap.Clear; +begin + fCount := 0; +end; + + +function TBinaryHeap.IsEmpty: Boolean; +begin + Result := (fCount = 0); +end; + + +procedure TBinaryHeap.Push(x: Pointer); +begin + fItems[fCount] := x; + Inc(fCount); +end; + + +function TBinaryHeap.Pop: Pointer; +var + I: Integer; + Best: Integer; +begin + //Return smallest + Best := 0; + for I := 1 to fCount - 1 do + if Cmp(fItems[I], fItems[Best]) then + Best := I; + + Result := fItems[Best]; + + if Best <> fCount then + Move(fItems[Best + 1], fItems[Best], (fCount - Best) * SizeOf(fItems[0])); + + Dec(fCount); +end; + + +procedure TBinaryHeap.UpdateItem(x: Pointer); +begin + //Placeholder for compatibility with true TBinaryHeap +end; + + +end. diff --git a/vendor/kam_remake/src/ext/Delaunay.pas b/vendor/kam_remake/src/ext/Delaunay.pas new file mode 100644 index 0000000..10039e7 --- /dev/null +++ b/vendor/kam_remake/src/ext/Delaunay.pas @@ -0,0 +1,399 @@ +//Credit to Paul Bourke (pbourke@swin.edu.au) for the original Fortran 77 Program :)) +//Conversion to Visual Basic by EluZioN (EluZioN@casesladder.com) +//Conversion from VB to Delphi6 by Dr Steve Evans (steve@lociuk.com) +/////////////////////////////////////////////////////////////////////////////// +//June 2002 Update by Dr Steve Evans (steve@lociuk.com): Heap memory allocation +//added to prevent stack overflow when MaxVertices and MaxTriangles are very large. +//Additional Updates in June 2002: +//Bug in InCircle function fixed. Radius r := Sqrt(rsqr). +//Check for duplicate points added when inserting new point. +//For speed, all points pre-sorted in x direction using quicksort algorithm and +//triangles flagged when no longer needed. The circumcircle centre and radius of +//the triangles are now stored to improve calculation time. +/////////////////////////////////////////////////////////////////////////////// +//You can use this code however you like providing the above credits remain in tact + +unit Delaunay; +interface +uses KM_Points; + +//Set these as applicable +const + MAX_VERTICES = 5000; + MAX_TRIANGLES = 10000; + + +//Created Triangles, vv# are the vertex pointers +type + TDTriangle = record + vv0: Word; + vv1: Word; + vv2: Word; + PreCalc: Byte; + xc,yc,r: Double; + end; + + TDVertexArray = array [0..MAX_VERTICES] of TKMPoint; + PVertexArray = ^TDVertexArray; + + TDTriangleArray = array [0..MAX_TRIANGLES] of TDTriangle; + PTriangleArray = ^TDTriangleArray; + +type + TDelaunay = class + private + fTolerance: Single; + fPolyCount: Integer; + fVerticeCount: Integer; + function InCircle(xp, yp, x1, y1, x2, y2, x3, y3: Double; + var xc: Double; var yc: Double; var r: Double; j: Integer): Boolean; + function WhichSide(xp, yp, x1, y1, x2, y2: Double): Integer; + function Triangulate(aVertCount: Integer): Integer; + procedure QuickSort(var A: PVertexArray; aLow, aHigh: Integer); + public + Vertex: PVertexArray; + Triangle: PTriangleArray; + constructor Create(x1,y1,x2,y2: Integer); + destructor Destroy; override; + procedure AddPoint(x,y: Integer); + procedure Mesh; + property PolyCount: Integer read fPolyCount; + property Tolerance: Single read fTolerance write fTolerance; + property VerticeCount: Integer read fVerticeCount; + end; + + +implementation + + +type + TDComplete = array [0..MAX_TRIANGLES] of Boolean; + PComplete = ^TDComplete; + + TDEdges = array [0..1, 0..MAX_TRIANGLES * 3] of SmallInt; + PEdges = ^TDEdges; + + +//Constructor must setup bounding rectangle for all points +constructor TDelaunay.Create(x1,y1,x2,y2: Integer); +begin + inherited Create; + + //Allocate memory for arrays + GetMem(Vertex, SizeOf(Vertex^)); + GetMem(Triangle, SizeOf(Triangle^)); + + Assert((x2>x1) and (y2>y1), 'Bounding rect must have positive area'); + + fTolerance := 0.01; + + //Points added in counter-clockwise order: + // 1 3 + // 2 4 + AddPoint(x1,y1); + AddPoint(x1,y2); + AddPoint(x2,y2); + AddPoint(x2,y1); +end; + + +destructor TDelaunay.Destroy; +begin + //Free memory for arrays + FreeMem(Vertex, SizeOf(Vertex^)); + FreeMem(Triangle, SizeOf(Triangle^)); + + inherited; +end; + + +function TDelaunay.InCircle(xp, yp, x1, y1, x2, y2, x3, y3: Double; + var xc: Double; var yc: Double; var r: Double; j: Integer): Boolean; +//Return TRUE if the point (xp,yp) lies inside the circumcircle +//made up by points (x1,y1) (x2,y2) (x3,y3) +//The circumcircle centre is returned in (xc,yc) and the radius r +//NOTE: A point on the edge is inside the circumcircle +var + eps: Double; + m1: Double; + m2: Double; + mx1: Double; + mx2: Double; + my1: Double; + my2: Double; + dx: Double; + dy: Double; + rsqr: Double; + drsqr: Double; +begin + + eps:= 0.000001; + Result := False; + + //Check if xc,yc and r have already been calculated + if Triangle^[j].PreCalc = 1 then + begin + xc := Triangle^[j].xc; + yc := Triangle^[j].yc; + r := Triangle^[j].r; + rsqr := r*r; + dx := xp - xc; + dy := yp - yc; + drsqr := dx * dx + dy * dy; + end else + begin + if (Abs(y1 - y2) < eps) And (Abs(y2 - y3) < eps) then + Assert(False, 'INCIRCUM - F - Points are coincident !!'); + + if Abs(y2 - y1) < eps then + begin + m2 := -(x3 - x2) / (y3 - y2); + mx2 := (x2 + x3) / 2; + my2 := (y2 + y3) / 2; + xc := (x2 + x1) / 2; + yc := m2 * (xc - mx2) + my2; + end + else if Abs(y3 - y2) < eps then + begin + m1 := -(x2 - x1) / (y2 - y1); + mx1 := (x1 + x2) / 2; + my1 := (y1 + y2) / 2; + xc := (x3 + x2) / 2; + yc := m1 * (xc - mx1) + my1; + end + else + begin + m1 := -(x2 - x1) / (y2 - y1); + m2 := -(x3 - x2) / (y3 - y2); + mx1 := (x1 + x2) / 2; + mx2 := (x2 + x3) / 2; + my1 := (y1 + y2) / 2; + my2 := (y2 + y3) / 2; + if (m1-m2)<>0 then //se + begin + xc := (m1 * mx1 - m2 * mx2 + my2 - my1) / (m1 - m2); + yc := m1 * (xc - mx1) + my1; + end else + begin + xc:= (x1+x2+x3)/3; + yc:= (y1+y2+y3)/3; + end; + + end; + + dx := x2 - xc; + dy := y2 - yc; + rsqr := dx * dx + dy * dy; + r := Sqrt(rsqr); + dx := xp - xc; + dy := yp - yc; + drsqr := dx * dx + dy * dy; + + //store the xc,yc and r for later use + Triangle^[j].PreCalc:=1; + Triangle^[j].xc:=xc; + Triangle^[j].yc:=yc; + Triangle^[j].r:=r; + end; + + if drsqr <= rsqr then + Result := True; +end; + + +function TDelaunay.WhichSide(xp, yp, x1, y1, x2, y2: Double): Integer; +//Determines which side of a line the point (xp,yp) lies. +//The line goes from (x1,y1) to (x2,y2) +//Returns -1 for a point to the left +// 0 for a point on the line +// +1 for a point to the right +var + equation: Double; +begin + equation := ((yp - y1) * (x2 - x1)) - ((y2 - y1) * (xp - x1)); + + If equation > 0 then + WhichSide := -1 + else If equation = 0 then + WhichSide := 0 + else + WhichSide := 1; +end; + + +function TDelaunay.Triangulate(aVertCount: Integer): Integer; +//Takes as input NVERT vertices in arrays Vertex() +//Returned is a list of NTRI triangular faces in the array +//Triangle(). These triangles are arranged in clockwise order. +var + Complete: PComplete; + Edges: PEdges; + Nedge: LongInt; + + //General Variables + VertID : Integer; + j : Integer; + k : Integer; + oPolyCount : Integer; + xc : Double; + yc : Double; + r : Double; + InCir : Boolean; +begin + //Allocate memory + GetMem(Complete, sizeof(Complete^)); + GetMem(Edges, sizeof(Edges^)); + + Triangle^[0].vv0 := 0; + Triangle^[0].vv1 := 1; + Triangle^[0].vv2 := 2; + Triangle^[0].Precalc := 0; + Triangle^[1].vv0 := 0; + Triangle^[1].vv1 := 2; + Triangle^[1].vv2 := 3; + Triangle^[1].Precalc := 0; + Complete^[0] := False; + Complete^[1] := False; + oPolyCount := 2; + + //Include each point one at a time into the existing mesh + for VertID := 4 to aVertCount - 1 do + begin + Nedge := 0; + //Set up the edge buffer. + //If the point (Vertex(i).x,Vertex(i).y) lies inside the circumcircle then the + //three edges of that triangle are added to the edge buffer. + J := 0; + repeat + if not Complete^[J] then + begin + InCir := InCircle(Vertex^[VertID].x, Vertex^[VertID].y, Vertex^[Triangle^[J].vv0].x, + Vertex^[Triangle^[J].vv0].y, Vertex^[Triangle^[J].vv1].x, + Vertex^[Triangle^[J].vv1].y, Vertex^[Triangle^[J].vv2].x, + Vertex^[Triangle^[J].vv2].y, xc, yc, r, J); + //Include this if points are sorted by X + if (xc + r) < Vertex^[VertID].x then // + Complete^[J] := True // + else // + if InCir then + begin + Edges^[0, Nedge + 0] := Triangle^[J].vv0; + Edges^[1, Nedge + 0] := Triangle^[J].vv1; + Edges^[0, Nedge + 1] := Triangle^[J].vv1; + Edges^[1, Nedge + 1] := Triangle^[J].vv2; + Edges^[0, Nedge + 2] := Triangle^[J].vv2; + Edges^[1, Nedge + 2] := Triangle^[J].vv0; + Nedge := Nedge + 3; + //Move last triangle to J + Triangle^[J].vv0 := Triangle^[oPolyCount - 1].vv0; + Triangle^[J].vv1 := Triangle^[oPolyCount - 1].vv1; + Triangle^[J].vv2 := Triangle^[oPolyCount - 1].vv2; + Triangle^[J].PreCalc:=Triangle^[oPolyCount - 1].PreCalc; + Triangle^[J].xc:=Triangle^[oPolyCount - 1].xc; + Triangle^[J].yc:=Triangle^[oPolyCount - 1].yc; + Triangle^[J].r:=Triangle^[oPolyCount - 1].r; + Triangle^[oPolyCount - 1].PreCalc:=0; + Complete^[J] := Complete^[oPolyCount - 1]; + J := J - 1; + oPolyCount := oPolyCount - 1; + end; + end; + J := J + 1; + until(J >= oPolyCount); + + // Tag multiple edges + // Note: if all triangles are specified anticlockwise then all + // interior edges are opposite pointing in direction. + for J := 0 to Nedge - 1 do + if not (Edges^[0, J] = -1) and not (Edges^[1, J] = -1) then + for K := J + 1 to Nedge - 1 do + if not (Edges^[0, K] = -1) and not (Edges^[1, K] = -1) then + if (Edges^[0, J] = Edges^[1, K]) and (Edges^[1, J] = Edges^[0, K]) then + begin + Edges^[0, J] := -1; + Edges^[1, J] := -1; + Edges^[0, K] := -1; + Edges^[1, K] := -1; + end; + + // Form new triangles for the current point + // Skipping over any tagged edges. + // All edges are arranged in clockwise order. + for J := 0 to Nedge - 1 do + if not (Edges^[0, J] = -1) and not (Edges^[1, J] = -1) then + begin + Triangle^[oPolyCount].vv0 := Edges^[0, J]; + Triangle^[oPolyCount].vv1 := Edges^[1, J]; + Triangle^[oPolyCount].vv2 := VertID; + Triangle^[oPolyCount].PreCalc := 0; + Complete^[oPolyCount] := False; + oPolyCount := oPolyCount + 1; + end; + end; + + Result := oPolyCount; + + //Free memory + FreeMem(Complete, sizeof(Complete^)); + FreeMem(Edges, sizeof(Edges^)); +end; + + +procedure TDelaunay.AddPoint(x,y: Integer); +var + I: Integer; +begin + //Skip duplicate points + for I := 0 to fVerticeCount - 1 do + if (Abs(x-Vertex^[I].x) < fTolerance) + and(Abs(y-Vertex^[I].y) < fTolerance) then + Exit; + + Vertex^[fVerticeCount].x := x; + Vertex^[fVerticeCount].y := y; + Inc(fVerticeCount); +end; + + +procedure TDelaunay.Mesh; +begin + if fVerticeCount < 4 then Exit; + //Sort added points, skip bounding rect (first 4 points) + QuickSort(Vertex, 4, fVerticeCount - 1); + fPolyCount := Triangulate(fVerticeCount); //Returns number of triangles created +end; + + +procedure TDelaunay.QuickSort(var A: PVertexArray; aLow,aHigh: Integer); +//Sort all points by x + procedure DoQuickSort(var A: PVertexArray; iLo, iHi: Integer); + var + Lo, Hi: Integer; + Mid: Double; + T: TKMPoint; + begin + Lo := iLo; + Hi := iHi; + Mid := A^[(Lo + Hi) div 2].x; + repeat + while A^[Lo].x < Mid do Inc(Lo); + while A^[Hi].x > Mid do Dec(Hi); + if Lo <= Hi then + begin + T := A^[Lo]; + A^[Lo] := A^[Hi]; + A^[Hi] := T; + Inc(Lo); + Dec(Hi); + end; + until Lo > Hi; + if Hi > iLo then DoQuickSort(A, iLo, Hi); + if Lo < iHi then DoQuickSort(A, Lo, iHi); + end; +begin + if aHigh > aLow then + DoQuickSort(A, aLow, aHigh); +end; + + +end. diff --git a/vendor/kam_remake/src/ext/FastMM4.pas b/vendor/kam_remake/src/ext/FastMM4.pas new file mode 100644 index 0000000..ebfda7e --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM4.pas @@ -0,0 +1,12979 @@ +(* + +Fast Memory Manager 4.992 + +Description: + A fast replacement memory manager for Embarcadero Delphi Win32 applications + that scales well under multi-threaded usage, is not prone to memory + fragmentation, and supports shared memory without the use of external .DLL + files. + +Homepage: + https://github.com/pleriche/FastMM4 + +Advantages: + - Fast + - Low overhead. FastMM is designed for an average of 5% and maximum of 10% + overhead per block. + - Supports up to 3GB of user mode address space under Windows 32-bit and 4GB + under Windows 64-bit. Add the "$SetPEFlags $20" option (in curly braces) + to your .dpr to enable this. + - Highly aligned memory blocks. Can be configured for either 8-byte or 16-byte + alignment. + - Good scaling under multi-threaded applications + - Intelligent reallocations. Avoids slow memory move operations through + not performing unneccesary downsizes and by having a minimum percentage + block size growth factor when an in-place block upsize is not possible. + - Resistant to address space fragmentation + - No external DLL required when sharing memory between the application and + external libraries (provided both use this memory manager) + - Optionally reports memory leaks on program shutdown. (This check can be set + to be performed only if Delphi is currently running on the machine, so end + users won't be bothered by the error message.) + - Supports Delphi 4 (or later), C++ Builder 4 (or later), Kylix 3. + +Usage: + Delphi: + Place this unit as the very first unit under the "uses" section in your + project's .dpr file. When sharing memory between an application and a DLL + (e.g. when passing a long string or dynamic array to a DLL function), both the + main application and the DLL must be compiled using this memory manager (with + the required conditional defines set). There are some conditional defines + (inside FastMM4Options.inc) that may be used to tweak the memory manager. To + enable support for a user mode address space greater than 2GB you will have to + use the EditBin* tool to set the LARGE_ADDRESS_AWARE flag in the EXE header. + This informs Windows x64 or Windows 32-bit (with the /3GB option set) that the + application supports an address space larger than 2GB (up to 4GB). In Delphi 6 + and later you can also specify this flag through the compiler directive + {$SetPEFlags $20} + *The EditBin tool ships with the MS Visual C compiler. + C++ Builder 6: + Refer to the instructions inside FastMM4BCB.cpp. + +License: + This work is copyright Professional Software Development / Pierre le Riche. It + is released under a dual license, and you may choose to use it under either the + Mozilla Public License 1.1 (MPL 1.1, available from + http://www.mozilla.org/MPL/MPL-1.1.html) or the GNU Lesser General Public + License 2.1 (LGPL 2.1, available from + http://www.opensource.org/licenses/lgpl-license.php). If you find FastMM useful + or you would like to support further development, a donation would be much + appreciated. My banking details are: + Country: South Africa + Bank: ABSA Bank Ltd + Branch: Somerset West + Branch Code: 334-712 + Account Name: PSD (Distribution) + Account No.: 4041827693 + Swift Code: ABSAZAJJ + My PayPal account is: + bof@psd.co.za + +Contact Details: + My contact details are shown below if you would like to get in touch with me. + If you use this memory manager I would like to hear from you: please e-mail me + your comments - good and bad. + Snailmail: + PO Box 2514 + Somerset West + 7129 + South Africa + E-mail: + plr@psd.co.za + +Support: + If you have trouble using FastMM, you are welcome to drop me an e-mail at the + address above, or you may post your questions in the BASM newsgroup on the + Embarcadero news server (which is where I hang out quite frequently). + +Disclaimer: + FastMM has been tested extensively with both single and multithreaded + applications on various hardware platforms, but unfortunately I am not in a + position to make any guarantees. Use it at your own risk. + +Acknowledgements (for version 4): + - Eric Grange for his RecyclerMM on which the earlier versions of FastMM were + based. RecyclerMM was what inspired me to try and write my own memory + manager back in early 2004. + - Primoz Gabrijelcic for several bugfixes and enhancements. + - Dennis Christensen for his tireless efforts with the Fastcode project: + helping to develop, optimize and debug the growing Fastcode library. + - JiYuan Xie for implementing the leak reporting code for C++ Builder. + - Sebastian Zierer for implementing the OS X support. + - Pierre Y. for his suggestions regarding the extension of the memory leak + checking options. + - Hanspeter Widmer for his suggestion to have an option to display install and + uninstall debug messages and moving options to a separate file, as well as + the new usage tracker. + - Anders Isaksson and Greg for finding and identifying the "DelphiIsRunning" + bug under Delphi 5. + - Francois Malan for various suggestions and bug reports. + - Craig Peterson for helping me identify the cache associativity issues that + could arise due to medium blocks always being an exact multiple of 256 bytes. + Also for various other bug reports and enhancement suggestions. + - Jarek Karciarz, Vladimir Ulchenko (Vavan) and Bob Gonder for their help in + implementing the BCB support. + - Ben Taylor for his suggestion to display the object class of all memory + leaks. + - Jean Marc Eber and Vincent Mahon (the Memcheck guys) for the call stack + trace code and also the method used to catch virtual method calls on freed + objects. + - Nahan Hyn for the suggestion to be able to enable or disable memory leak + reporting through a global variable (the "ManualLeakReportingControl" + option.) + - Leonel Togniolli for various suggestions with regard to enhancing the bug + tracking features of FastMM and other helpful advice. + - Joe Bain and Leonel Togniolli for the workaround to QC#10922 affecting + compilation under Delphi 2005. + - Robert Marquardt for the suggestion to make localisation of FastMM easier by + having all string constants together. + - Simon Kissel and Fikret Hasovic for their help in implementing Kylix support. + - Matthias Thoma, Petr Vones, Robert Rossmair and the rest of the JCL team for + their debug info library used in the debug info support DLL and also the + code used to check for a valid call site in the "raw" stack trace code. + - Andreas Hausladen for the suggestion to use an external DLL to enable the + reporting of debug information. + - Alexander Tabakov for various good suggestions regarding the debugging + facilities of FastMM. + - M. Skloff for some useful suggestions and bringing to my attention some + compiler warnings. + - Martin Aignesberger for the code to use madExcept instead of the JCL library + inside the debug info support DLL. + - Diederik and Dennis Passmore for the suggestion to be able to register + expected leaks. + - Dario Tiraboschi and Mark Gebauer for pointing out the problems that occur + when range checking and complete boolean evaluation is turned on. + - Arthur Hoornweg for notifying me of the image base being incorrect for + borlndmm.dll. + - Theo Carr-Brion and Hanspeter Widmer for finding the false alarm error + message "Block Header Has Been Corrupted" bug in FullDebugMode. + - Danny Heijl for reporting the compiler error in "release" mode. + - Omar Zelaya for reporting the BCB support regression bug. + - Dan Miser for various good suggestions, e.g. not logging expected leaks to + file, enhancements the stack trace and messagebox functionality, etc. + - Arjen de Ruijter for fixing the bug in GetMemoryLeakType that caused it + to not properly detect expected leaks registered by class when in + "FullDebugMode". + - Aleksander Oven for reporting the installation problem when trying to use + FastMM in an application together with libraries that all use runtime + packages. + - Kristofer Skaug for reporting the bug that sometimes causes the leak report + to be shown, even when all the leaks have been registered as expected leaks. + Also for some useful enhancement suggestions. + - Günther Schoch for the "RequireDebuggerPresenceForLeakReporting" option. + - Jan Schlüter for the "ForceMMX" option. + - Hallvard Vassbotn for various good enhancement suggestions. + - Mark Edington for some good suggestions and bug reports. + - Paul Ishenin for reporting the compilation error when the NoMessageBoxes + option is set and also the missing call stack entries issue when "raw" stack + traces are enabled, as well as for the Russian translation. + - Cristian Nicola for reporting the compilation bug when the + CatchUseOfFreedInterfaces option was enabled (4.40). + - Mathias Rauen (madshi) for improving the support for madExcept in the debug + info support DLL. + - Roddy Pratt for the BCB5 support code. + - Rene Mihula for the Czech translation and the suggestion to have dynamic + loading of the FullDebugMode DLL as an option. + - Artur Redzko for the Polish translation. + - Bart van der Werf for helping me solve the DLL unload order problem when + using the debug mode borlndmm.dll library, as well as various other + suggestions. + - JRG ("The Delphi Guy") for the Spanish translation. + - Justus Janssen for Delphi 4 support. + - Vadim Lopushansky and Charles Vinal for reporting the Delphi 5 compiler + error in version 4.50. + - Johni Jeferson Capeletto for the Brazilian Portuguese translation. + - Kurt Fitzner for reporting the BCB6 compiler error in 4.52. + - Michal Niklas for reporting the Kylix compiler error in 4.54. + - Thomas Speck and Uwe Queisser for German translations. + - Zaenal Mutaqin for the Indonesian translation. + - Carlos Macao for the Portuguese translation. + - Michael Winter for catching the performance issue when reallocating certain + block sizes. + - dzmitry[li] for the Belarussian translation. + - Marcelo Montenegro for the updated Spanish translation. + - Jud Cole for finding and reporting the bug which may trigger a read access + violation when upsizing certain small block sizes together with the + "UseCustomVariableSizeMoveRoutines" option. + - Zdenek Vasku for reporting and fixing the memory manager sharing bug + affecting Windows 95/98/Me. + - RB Winston for suggesting the improvement to GExperts "backup" support. + - Thomas Schulz for reporting the bug affecting large address space support + under FullDebugMode, as well as the recursive call bug when attempting to + report memory leaks when EnableMemoryLeakReporting is disabled. + - Luigi Sandon for the Italian translation. + - Werner Bochtler for various suggestions and bug reports. + - Markus Beth for suggesting the "NeverSleepOnThreadContention" option. + - JiYuan Xie for the Simplified Chinese translation. + - Andrey Shtukaturov for the updated Russian translation, as well as the + Ukrainian translation. + - Dimitry Timokhov for finding two elusive bugs in the memory leak class + detection code. + - Paulo Moreno for fixing the AllocMem bug in FullDebugMode that prevented + large blocks from being cleared. + - Vladimir Bochkarev for the suggestion to remove some unnecessary code if the + MM sharing mechanism is disabled. + - Loris Luise for the version constant suggestion. + - J.W. de Bokx for the MessageBox bugfix. + - Igor Lindunen for reporting the bug that caused the Align16Bytes option to + not work in FullDebugMode. + - Ionut Muntean for the Romanian translation. + - Florent Ouchet for the French translation. + - Marcus Mönnig for the ScanMemoryPoolForCorruptions suggestion and the + suggestion to have the option to scan the memory pool before every + operation when in FullDebugMode. + - Francois Piette for bringing under my attention that + ScanMemoryPoolForCorruption was not thread safe. + - Michael Rabatscher for reporting some compiler warnings. + - QianYuan Wang for the Simplified Chinese translation of FastMM4Options.inc. + - Maurizio Lotauro and Christian-W. Budde for reporting some Delphi 5 + compiler errors. + - Patrick van Logchem for the DisableLoggingOfMemoryDumps option. + - Norbert Spiegel for the BCB4 support code. + - Uwe Schuster for the improved string leak detection code. + - Murray McGowan for improvements to the usage tracker. + - Michael Hieke for the SuppressFreeMemErrorsInsideException option as well + as a bugfix to GetMemoryMap. + - Richard Bradbrook for fixing the Windows 95 FullDebugMode support that was + broken in version 4.94. + - Zach Saw for the suggestion to (optionally) use SwitchToThread when + waiting for a lock on a shared resource to be released. + - Everyone who have made donations. Thanks! + - Any other Fastcoders or supporters that I have forgotten, and also everyone + that helped with the older versions. + +Change log: + Version 1.00 (28 June 2004): + - First version (called PSDMemoryManager). Based on RecyclerMM (free block + stack approach) by Eric Grange. + Version 2.00 (3 November 2004): + - Complete redesign and rewrite from scratch. Name changed to FastMM to + reflect this fact. Uses a linked-list approach. Is faster, has less memory + overhead, and will now catch most bad pointers on FreeMem calls. + Version 3.00 (1 March 2005): + - Another rewrite. Reduced the memory overhead by: (a) not having a separate + memory area for the linked list of free blocks (uses space inside free + blocks themselves) (b) batch managers are allocated as part of chunks (c) + block size lookup table size reduced. This should make FastMM more CPU + cache friendly. + Version 4.00 (7 June 2005): + - Yet another rewrite. FastMM4 is in fact three memory managers in one: Small + blocks (up to a few KB) are managed through the binning model in the same + way as previous versions, medium blocks (from a few KB up to approximately + 256K) are allocated in a linked-list fashion, and large blocks are grabbed + directly from the system through VirtualAlloc. This 3-layered design allows + very fast operation with the most frequently used block sizes (small + blocks), while also minimizing fragmentation and imparting significant + overhead savings with blocks larger than a few KB. + Version 4.01 (8 June 2005): + - Added the options "RequireDebugInfoForLeakReporting" and + "RequireIDEPresenceForLeakReporting" as suggested by Pierre Y. + - Fixed the "DelphiIsRunning" function not working under Delphi 5, and + consequently no leak checking. (Reported by Anders Isaksson and Greg.) + Version 4.02 (8 June 2005): + - Fixed the compilation error when both the "AssumeMultiThreaded" and + "CheckHeapForCorruption options were set. (Reported by Francois Malan.) + Version 4.03 (9 June 2005): + - Added descriptive error messages when FastMM4 cannot be installed because + another MM has already been installed or memory has already been allocated. + Version 4.04 (13 June 2005): + - Added a small fixed offset to the size of medium blocks (previously always + exact multiples of 256 bytes). This makes performance problems due to CPU + cache associativity limitations much less likely. (Reported by Craig + Peterson.) + Version 4.05 (17 June 2005): + - Added the Align16Bytes option. Disable this option to drop the 16 byte + alignment restriction and reduce alignment to 8 bytes for the smallest + block sizes. Disabling Align16Bytes should lower memory consumption at the + cost of complicating the use of aligned SSE move instructions. (Suggested + by Craig Peterson.) + - Added a support unit for C++ Builder 6 - Add FastMM4BCB.cpp and + FastMM4.pas to your BCB project to use FastMM instead of the RTL MM. Memory + leak checking is not supported because (unfortunately) once an MM is + installed under BCB you cannot uninstall it... at least not without + modifying the RTL code in exit.c or patching the RTL code runtime. (Thanks + to Jarek Karciarz, Vladimir Ulchenko and Bob Gonder.) + Version 4.06 (22 June 2005): + - Displays the class of all leaked objects on the memory leak report and also + tries to identify leaked long strings. Previously it only displayed the + sizes of all leaked blocks. (Suggested by Ben Taylor.) + - Added support for displaying the sizes of medium and large block memory + leaks. Previously it only displayed details for small block leaks. + Version 4.07 (22 June 2005): + - Fixed the detection of the class of leaked objects not working under + Windows 98/Me. + Version 4.08 (27 June 2005): + - Added a BorlndMM.dpr project to allow you to build a borlndmm.dll that uses + FastMM4 instead of the default memory manager. You may replace the old + DLL in the Delphi \Bin directory to make the IDE use this memory manager + instead. + Version 4.09 (30 June 2005): + - Included a patch fix for the bug affecting replacement borlndmm.dll files + with Delphi 2005 (QC#14007). Compile the patch, close Delphi, and run it + once to patch your vclide90.bpl. You will now be able to use the + replacement borlndmm.dll to speed up the Delphi 2005 IDE as well. + Version 4.10 (7 July 2005): + - Due to QC#14070 ("Delphi IDE attempts to free memory after the shutdown + code of borlndmm.dll has been called"), FastMM cannot be uninstalled + safely when used inside a replacement borlndmm.dll for the IDE. Added a + conditional define "NeverUninstall" for this purpose. + - Added the "FullDebugMode" option to pad all blocks with a header and footer + to help you catch memory overwrite bugs in your applications. All blocks + returned to freemem are also zeroed out to help catch bugs involving the + use of previously freed blocks. Also catches attempts at calling virtual + methods of freed objects provided the block in question has not been reused + since the object was freed. Displays stack traces on error to aid debugging. + - Added the "LogErrorsToFile" option to log all errors to a text file in the + same folder as the application. + - Added the "ManualLeakReportingControl" option (suggested by Nahan Hyn) to + enable control over whether the memory leak report should be done or not + via a global variable. + Version 4.11 (7 July 2005): + - Fixed a compilation error under Delphi 2005 due to QC#10922. (Thanks to Joe + Bain and Leonel Togniolli.) + - Fixed leaked object classes not displaying in the leak report in + "FullDebugMode". + Version 4.12 (8 July 2005): + - Moved all the string constants to one place to make it easier to do + translations into other languages. (Thanks to Robert Marquardt.) + - Added support for Kylix. Some functionality is currently missing: No + support for detecting the object class on leaks and also no MM sharing. + (Thanks to Simon Kissel and Fikret Hasovic). + Version 4.13 (11 July 2005): + - Added the FastMM_DebugInfo.dll support library to display debug info for + stack traces. + - Stack traces for the memory leak report is now logged to the log file in + "FullDebugMode". + Version 4.14 (14 July 2005): + - Fixed string leaks not being detected as such in "FullDebugMode". (Thanks + to Leonel Togniolli.) + - Fixed the compilation error in "FullDebugMode" when "LogErrorsToFile" is + not set. (Thanks to Leonel Togniolli.) + - Added a "Release" option to allow the grouping of various options and to + make it easier to make debug and release builds. (Thanks to Alexander + Tabakov.) + - Added a "HideMemoryLeakHintMessage" option to not display the hint below + the memory leak message. (Thanks to Alexander Tabakov.) + - Changed the fill character for "FullDebugMode" from zero to $80 to be able + to differentiate between invalid memory accesses using nil pointers to + invalid memory accesses using fields of freed objects. FastMM tries to + reserve the 64K block starting at $80800000 at startup to ensure that an + A/V will occur when this block is accessed. (Thanks to Alexander Tabakov.) + - Fixed some compiler warnings. (Thanks to M. Skloff) + - Fixed some display bugs in the memory leak report. (Thanks to Leonel + Togniolli.) + - Added a "LogMemoryLeakDetailToFile" option. Some applications leak a lot of + memory and can make the log file grow very large very quickly. + - Added the option to use madExcept instead of the JCL Debug library in the + debug info support DLL. (Thanks to Martin Aignesberger.) + - Added procedures "GetMemoryManagerState" and "GetMemoryMap" to retrieve + statistics about the current state of the memory manager and memory pool. + (A usage tracker form together with a demo is also available.) + Version 4.15 (14 July 2005): + - Fixed a false 4GB(!) memory leak reported in some instances. + Version 4.16 (15 July 2005): + - Added the "CatchUseOfFreedInterfaces" option to catch the use of interfaces + of freed objects. This option is not compatible with checking that a freed + block has not been modified, so enable this option only when hunting an + invalid interface reference. (Only relevant if "FullDebugMode" is set.) + - During shutdown FastMM now checks that all free blocks have not been + modified since being freed. (Only when "FullDebugMode" is set and + "CatchUseOfFreedInterfaces" is disabled.) + Version 4.17 (15 July 2005): + - Added the AddExpectedMemoryLeaks and RemoveExpectedMemoryLeaks procedures to + register/unregister expected leaks, thus preventing the leak report from + displaying if only expected leaks occurred. (Thanks to Diederik and Dennis + Passmore for the suggestion.) (Note: these functions were renamed in later + versions.) + - Fixed the "LogMemoryLeakDetailToFile" not logging memory leak detail to file + as it is supposed to. (Thanks to Leonel Togniolli.) + Version 4.18 (18 July 2005): + - Fixed some issues when range checking or complete boolean evaluation is + switched on. (Thanks to Dario Tiraboschi and Mark Gebauer.) + - Added the "OutputInstallUninstallDebugString" option to display a message when + FastMM is installed or uninstalled. (Thanks to Hanspeter Widmer.) + - Moved the options to a separate include file. (Thanks to Hanspeter Widmer.) + - Moved message strings to a separate file for easy translation. + Version 4.19 (19 July 2005): + - Fixed Kylix support that was broken in 4.14. + Version 4.20 (20 July 2005): + - Fixed a false memory overwrite report at shutdown in "FullDebugMode". If you + consistently got a "Block Header Has Been Corrupted" error message during + shutdown at address $xxxx0070 then it was probably a false alarm. (Thanks to + Theo Carr-Brion and Hanspeter Widmer.} + Version 4.21 (27 July 2005): + - Minor change to the block header flags to make it possible to immediately + tell whether a medium block is being used as a small block pool or not. + (Simplifies the leak checking and status reporting code.) + - Expanded the functionality around the management of expected memory leaks. + - Added the "ClearLogFileOnStartup" option. Deletes the log file during + initialization. (Thanks to M. Skloff.) + - Changed "OutputInstallUninstallDebugString" to use OutputDebugString instead + of MessageBox. (Thanks to Hanspeter Widmer.) + Version 4.22 (1 August 2005): + - Added a FastAllocMem function that avoids an unnecessary FillChar call with + large blocks. + - Changed large block resizing behavior to be a bit more conservative. Large + blocks will be downsized if the new size is less than half of the old size + (the threshold was a quarter previously). + Version 4.23 (6 August 2005): + - Fixed BCB6 support (Thanks to Omar Zelaya). + - Renamed "OutputInstallUninstallDebugString" to "UseOutputDebugString", and + added debug string output on memory leak or error detection. + Version 4.24 (11 August 2005): + - Added the "NoMessageBoxes" option to suppress the display of message boxes, + which is useful for services that should not be interrupted. (Thanks to Dan + Miser). + - Changed the stack trace code to return the line number of the caller and not + the line number of the return address. (Thanks to Dan Miser). + Version 4.25 (15 August 2005): + - Fixed GetMemoryLeakType not detecting expected leaks registered by class + when in "FullDebugMode". (Thanks to Arjen de Ruijter). + Version 4.26 (18 August 2005): + - Added a "UseRuntimePackages" option that allows FastMM to be used in a main + application together with DLLs that all use runtime packages. (Thanks to + Aleksander Oven.) + Version 4.27 (24 August 2005): + - Fixed a bug that sometimes caused the leak report to be shown even though all + leaks were registered as expected leaks. (Thanks to Kristofer Skaug.) + Version 4.29 (30 September 2005): + - Added the "RequireDebuggerPresenceForLeakReporting" option to only display + the leak report if the application is run inside the IDE. (Thanks to Günther + Schoch.) + - Added the "ForceMMX" option, which when disabled will check the CPU for + MMX compatibility before using MMX. (Thanks to Jan Schlüter.) + - Added the module name to the title of error dialogs to more easily identify + which application caused the error. (Thanks to Kristofer Skaug.) + - Added an ASCII dump to the "FullDebugMode" memory dumps. (Thanks to Hallvard + Vassbotn.) + - Added the option "HideExpectedLeaksRegisteredByPointer" to suppress the + display and logging of expected memory leaks that were registered by pointer. + (Thanks to Dan Miser.) Leaks registered by size or class are often ambiguous, + so these expected leaks are always logged to file (in FullDebugMode) and are + never hidden from the leak display (only displayed if there is at least one + unexpected leak). + - Added a procedure "GetRegisteredMemoryLeaks" to return a list of all + registered memory leaks. (Thanks to Dan Miser.) + - Added the "RawStackTraces" option to perform "raw" stack traces, negating + the need for stack frames. This will usually result in more complete stack + traces in FullDebugMode error reports, but it is significantly slower. + (Thanks to Hallvard Vassbotn, Dan Miser and the JCL team.) + Version 4.31 (2 October 2005): + - Fixed the crash bug when both "RawStackTraces" and "FullDebugMode" were + enabled. (Thanks to Dan Miser and Mark Edington.) + Version 4.33 (6 October 2005): + - Added a header corruption check to all memory blocks that are identified as + leaks in FullDebugMode. This allows better differentiation between memory + pool corruption bugs and actual memory leaks. + - Fixed the stack overflow bug when using "RawStackTraces". + Version 4.35 (6 October 2005): + - Fixed a compilation error when the "NoMessageBoxes" option is set. (Thanks + to Paul Ishenin.) + - Before performing a "raw" stack trace, FastMM now checks whether exception + handling is in place. If exception handling is not in place FastMM falls + back to stack frame tracing. (Exception handling is required to handle the + possible A/Vs when reading invalid call addresses. Exception handling is + usually always available except when SysUtils hasn't been initialized yet or + after SysUtils has been finalized.) + Version 4.37 (8 October 2005): + - Fixed the missing call stack trace entry issue when dynamically loading DLLs. + (Thanks to Paul Ishenin.) + Version 4.39 (12 October 2005): + - Restored the performance with "RawStackTraces" enabled back to the level it + was in 4.35. + - Fixed the stack overflow error when using "RawStackTraces" that I thought I + had fixed in 4.31, but unfortunately didn't. (Thanks to Craig Peterson.) + Version 4.40 (13 October 2005): + - Improved "RawStackTraces" to have less incorrect extra entries. (Thanks to + Craig Peterson.) + - Added the Russian (by Paul Ishenin) and Afrikaans translations of + FastMM4Messages.pas. + Version 4.42 (13 October 2005): + - Fixed the compilation error when "CatchUseOfFreedInterfaces" is enabled. + (Thanks to Cristian Nicola.) + Version 4.44 (25 October 2005): + - Implemented a FastGetHeapStatus function in analogy with GetHeapStatus. + (Suggested by Cristian Nicola.) + - Shifted more of the stack trace code over to the support dll to allow third + party vendors to make available their own stack tracing and stack trace + logging facilities. + - Mathias Rauen (madshi) improved the support for madExcept in the debug info + support DLL. Thanks! + - Added support for BCB5. (Thanks to Roddy Pratt.) + - Added the Czech translation by Rene Mihula. + - Added the "DetectMMOperationsAfterUninstall" option. This will catch + attempts to use the MM after FastMM has been uninstalled, and is useful for + debugging. + Version 4.46 (26 October 2005): + - Renamed FastMM_DebugInfo.dll to FastMM_FullDebugMode.dll and made the + dependency on this library a static one. This solves a DLL unload order + problem when using FullDebugMode together with the replacement + borlndmm.dll. (Thanks to Bart van der Werf.) + - Added the Polish translation by Artur Redzko. + Version 4.48 (10 November 2005): + - Fixed class detection for objects leaked in dynamically loaded DLLs that + were relocated. + - Fabio Dell'Aria implemented support for EurekaLog in the FullDebugMode + support DLL. Thanks! + - Added the Spanish translation by JRG ("The Delphi Guy"). + Version 4.49 (10 November 2005): + - Implemented support for installing replacement AllocMem and leak + registration mechanisms for Delphi/BCB versions that support it. + - Added support for Delphi 4. (Thanks to Justus Janssen.) + Version 4.50 (5 December 2005): + - Renamed the ReportMemoryLeaks global variable to ReportMemoryLeaksOnShutdown + to be more consistent with the Delphi 2006 memory manager. + - Improved the handling of large blocks. Large blocks can now consist of + several consecutive segments allocated through VirtualAlloc. This + significantly improves speed when frequently resizing large blocks, since + these blocks can now often be upsized in-place. + Version 4.52 (7 December 2005): + - Fixed the compilation error with Delphi 5. (Thanks to Vadim Lopushansky and + Charles Vinal for reporting the error.) + Version 4.54 (15 December 2005): + - Added the Brazilian Portuguese translation by Johni Jeferson Capeletto. + - Fixed the compilation error with BCB6. (Thanks to Kurt Fitzner.) + Version 4.56 (20 December 2005): + - Fixed the Kylix compilation problem. (Thanks to Michal Niklas.) + Version 4.58 (1 February 2006): + - Added the German translations by Thomas Speck and Uwe Queisser. + - Added the Indonesian translation by Zaenal Mutaqin. + - Added the Portuguese translation by Carlos Macao. + Version 4.60 (21 February 2006): + - Fixed a performance issue due to an unnecessary block move operation when + allocating a block in the range 1261-1372 bytes and then reallocating it in + the range 1373-1429 bytes twice. (Thanks to Michael Winter.) + - Added the Belarussian translation by dzmitry[li]. + - Added the updated Spanish translation by Marcelo Montenegro. + - Added a new option "EnableSharingWithDefaultMM". This option allows FastMM + to be shared with the default MM of Delphi 2006. It is on by default, but + MM sharing has to be enabled otherwise it has no effect (refer to the + documentation for the "ShareMM" and "AttemptToUseSharedMM" options). + Version 4.62 (22 February 2006): + - Fixed a possible read access violation in the MoveX16LP routine when the + UseCustomVariableSizeMoveRoutines option is enabled. (Thanks to Jud Cole for + some great detective work in finding this bug.) + - Improved the downsizing behaviour of medium blocks to better correlate with + the reallocation behaviour of small blocks. This change reduces the number + of transitions between small and medium block types when reallocating blocks + in the 0.7K to 2.6K range. It cuts down on the number of memory move + operations and improves performance. + Version 4.64 (31 March 2006): + - Added the following functions for use with FullDebugMode (and added the + exports to the replacement BorlndMM.dll): SetMMLogFileName, + GetCurrentAllocationGroup, PushAllocationGroup, PopAllocationGroup and + LogAllocatedBlocksToFile. The purpose of these functions are to allow you to + identify and log related memory leaks while your application is still + running. + - Fixed a bug in the memory manager sharing mechanism affecting Windows + 95/98/ME. (Thanks to Zdenek Vasku.) + Version 4.66 (9 May 2006): + - Added a hint comment in this file so that FastMM4Messages.pas will also be + backed up by GExperts. (Thanks to RB Winston.) + - Fixed a bug affecting large address space (> 2GB) support under + FullDebugMode. (Thanks to Thomas Schulz.) + Version 4.68 (3 July 2006): + - Added the Italian translation by Luigi Sandon. + - If FastMM is used inside a DLL it will now use the name of the DLL as base + for the log file name. (Previously it always used the name of the main + application executable file.) + - Fixed a rare A/V when both the FullDebugMode and RawStackTraces options were + enabled. (Thanks to Primoz Gabrijelcic.) + - Added the "NeverSleepOnThreadContention" option. This option may improve + performance if the ratio of the the number of active threads to the number + of CPU cores is low (typically < 2). This option is only useful for 4+ CPU + systems, it almost always hurts performance on single and dual CPU systems. + (Thanks to Werner Bochtler and Markus Beth.) + Version 4.70 (4 August 2006): + - Added the Simplified Chinese translation by JiYuan Xie. + - Added the updated Russian as well as the Ukrainian translation by Andrey + Shtukaturov. + - Fixed two bugs in the leak class detection code that would sometimes fail + to detect the class of leaked objects and strings, and report them as + 'unknown'. (Thanks to Dimitry Timokhov) + Version 4.72 (24 September 2006): + - Fixed a bug that caused AllocMem to not clear blocks > 256K in + FullDebugMode. (Thanks to Paulo Moreno.) + Version 4.74 (9 November 2006): + - Fixed a bug in the segmented large block functionality that could lead to + an application freeze when upsizing blocks greater than 256K in a + multithreaded application (one of those "what the heck was I thinking?" + type bugs). + Version 4.76 (12 January 2007): + - Changed the RawStackTraces code in the FullDebugMode DLL + to prevent it from modifying the Windows "GetLastError" error code. + (Thanks to Primoz Gabrijelcic.) + - Fixed a threading issue when the "CheckHeapForCorruption" option was + enabled, but the "FullDebugMode" option was disabled. (Thanks to Primoz + Gabrijelcic.) + - Removed some unnecessary startup code when the MM sharing mechanism is + disabled. (Thanks to Vladimir Bochkarev.) + - In FullDebugMode leaked blocks would sometimes be reported as belonging to + the class "TFreedObject" if they were allocated but never used. Such blocks + will now be reported as "unknown". (Thanks to Francois Malan.) + - In recent versions the replacement borlndmm.dll created a log file (when + enabled) that used the "borlndmm" prefix instead of the application name. + It is now fixed to use the application name, however if FastMM is used + inside other DLLs the name of those DLLs will be used. (Thanks to Bart van + der Werf.) + - Added a "FastMMVersion" constant. (Suggested by Loris Luise.) + - Fixed an issue with error message boxes not displaying under certain + configurations. (Thanks to J.W. de Bokx.) + - FastMM will now display only one error message at a time. If many errors + occur in quick succession, only the first error will be shown (but all will + be logged). This avoids a stack overflow with badly misbehaved programs. + (Thanks to Bart van der Werf.) + - Added a LoadDebugDLLDynamically option to be used in conjunction with + FullDebugMode. In this mode FastMM_FullDebugMode.dll is loaded dynamically. + If the DLL cannot be found, stack traces will not be available. (Thanks to + Rene Mihula.) + Version 4.78 (1 March 2007): + - The MB_DEFAULT_DESKTOP_ONLY constant that is used when displaying messages + boxes since 4.76 is not defined under Kylix, and the source would thus not + compile. That constant is now defined. (Thanks to Werner Bochtler.) + - Moved the medium block locking code that was duplicated in several places + to a subroutine to reduce code size. (Thanks to Hallvard Vassbotn.) + - Fixed a bug in the leak registration code that sometimes caused registered + leaks to be reported erroneously. (Thanks to Primoz Gabrijelcic.) + - Added the NoDebugInfo option (on by default) that suppresses the generation + of debug info for the FastMM4.pas unit. This will prevent the integrated + debugger from stepping into the memory manager. (Thanks to Primoz + Gabrijelcic.) + - Increased the default stack trace depth in FullDebugMode from 9 to 10 to + ensure that the Align16Bytes setting works in FullDebugMode. (Thanks to + Igor Lindunen.) + - Updated the Czech translation. (Thanks to Rene Mihula.) + Version 4.84 (7 July 2008): + - Added the Romanian translation. (Thanks to Ionut Muntean.) + - Optimized the GetMemoryMap procedure to improve speed. + - Added the GetMemoryManagerUsageSummary function that returns a summary of + the GetMemoryManagerState call. (Thanks to Hallvard Vassbotn.) + - Added the French translation. (Thanks to Florent Ouchet.) + - Added the "AlwaysAllocateTopDown" FullDebugMode option to help with + catching bad pointer arithmetic code in an address space > 2GB. This option + is enabled by default. + - Added the "InstallOnlyIfRunningInIDE" option. Enable this option to + only install FastMM as the memory manager when the application is run + inside the Delphi IDE. This is useful when you want to deploy the same EXE + that you use for testing, but only want the debugging features active on + development machines. When this option is enabled and the application is + not being run inside the IDE, then the default Delphi memory manager will + be used (which, since Delphi 2006, is FastMM without FullDebugMode.) This + option is off by default. + - Added the "FullDebugModeInIDE" option. This is a convenient shorthand for + enabling FullDebugMode, InstallOnlyIfRunningInIDE and + LoadDebugDLLDynamically. This causes FastMM to be used in FullDebugMode + when the application is being debugged on development machines, and the + default memory manager when the same executable is deployed. This allows + the debugging and deployment of an application without having to compile + separate executables. This option is off by default. + - Added a ScanMemoryPoolForCorruptions procedure that checks the entire + memory pool for corruptions and raises an exception if one is found. It can + be called at any time, but is only available in FullDebugMode. (Thanks to + Marcus Mönnig.) + - Added a global variable "FullDebugModeScanMemoryPoolBeforeEveryOperation". + When this variable is set to true and FullDebugMode is enabled, then the + entire memory pool is checked for consistency before every GetMem, FreeMem + and ReallocMem operation. An "Out of Memory" error is raised if a + corruption is found (and this variable is set to false to prevent recursive + errors). This obviously incurs a massive performance hit, so enable it only + when hunting for elusive memory corruption bugs. (Thanks to Marcus Mönnig.) + - Fixed a bug in AllocMem that caused the FPU stack to be shifted by one + position. + - Changed the default for option "EnableMMX" to false, since using MMX may + cause unexpected behaviour in code that passes parameters on the FPU stack + (like some "compiler magic" routines, e.g. VarFromReal). + - Removed the "EnableSharingWithDefaultMM" option. This is now the default + behaviour and cannot be disabled. (FastMM will always try to share memory + managers between itself and the default memory manager when memory manager + sharing is enabled.) + - Introduced a new memory manager sharing mechanism based on memory mapped + files. This solves compatibility issues with console and service + applications. This sharing mechanism currently runs in parallel with the + old mechanism, but the old mechanism can be disabled by undefining + "EnableBackwardCompatibleMMSharing" in FastMM4Options.inc. + - Fixed the recursive call error when the EnableMemoryLeakReporting option + is disabled and an attempt is made to register a memory leak under Delphi + 2006 or later. (Thanks to Thomas Schulz.) + - Added a global variable "SuppressMessageBoxes" to enable or disable + messageboxes at runtime. (Thanks to Craig Peterson.) + - Added the leak reporting code for C++ Builder, as well as various other + C++ Builder bits written by JiYuan Xie. (Thank you!) + - Added the new Usage Tracker written by Hanspeter Widmer. (Thank you!) + Version 4.86 (31 July 2008): + - Tweaked the string detection algorithm somewhat to be less strict, and + allow non-class leaks to be more often categorized as strings. + - Fixed a compilation error under Delphi 5. + - Made LogAllocatedBlocksToFile and ScanMemoryPoolForCorruptions thread + safe. (Thanks to Francois Piette.) + Version 4.88 (13 August 2008): + - Fixed compiler warnings in NoOpRegisterExpectedMemoryLeak and + NoOpUnRegisterExpectedMemoryLeak. (Thanks to Michael Rabatscher.) + - Added the Simplified Chinese translation of FastMM4Options.inc by + QianYuan Wang. (Thank you!) + - Included the updated C++ Builder files with support for BCB6 without + update 4 applied. (Submitted by JiYuan Xie. Thanks!) + - Fixed a compilation error under Delphi 5. + - Made LogAllocatedBlocksToFile and ScanMemoryPoolForCorruptions thread + safe - for real this time. (Thanks to Francois Piette.) + Version 4.90 (9 September 2008): + - Added logging of the thread ID when capturing and displaying stack + traces. (Suggested by Allen Bauer and Mark Edington.) + - Fixed a Delphi 5 compiler error under FullDebugMode. (Thanks to Maurizio + Lotauro and Christian-W. Budde.) + - Changed a default setting in FastMM4Options.inc: RawStackTraces is now + off by default due to the high number of support requests I receive with + regards to the false postives it may cause. I recommend compiling debug + builds of applications with the "Stack Frames" option enabled. + - Fixed a compilation error under Kylix. (Thanks to Werner Bochtler.) + - Official support for Delphi 2009. + Version 4.92 (25 November 2008): + - Added the DisableLoggingOfMemoryDumps option under FullDebugMode. When + this option is set, memory dumps will not be logged for memory leaks or + errors. (Thanks to Patrick van Logchem.) + - Exposed the class and string type detection code in the interface section + for use in application code (if required). (Requested by Patrick van + Logchem.) + - Fixed a bug in SetMMLogFileName that could cause the log file name to be + set incorrectly. + - Added BCB4 support. (Thanks to Norbert Spiegel.) + - Included the updated Czech translation by Rene Mihula. + - When FastMM raises an error due to a freed block being modified, it now + logs detail about which bytes in the block were modified. + Version 4.94 (28 August 2009): + - Added the DoNotInstallIfDLLMissing option that prevents FastMM from + installing itself if the FastMM_FullDebugMode.dll library is not + available. (Only applicable when FullDebugMode and LoadDebugDLLDynamically + are both enabled.) This is useful when the same executable will be used for + both debugging and deployment - when the debug support DLL is available + FastMM will be installed in FullDebugMode, and otherwise the default memory + manager will be used. + - Added the FullDebugModeWhenDLLAvailable option that combines the + FullDebugMode, LoadDebugDLLDynamically and DoNotInstallIfDLLMissing options. + - Re-enabled RawStackTraces by default. The frame based stack traces (even + when compiling with stack frames enabled) are generally too incomplete. + - Improved the speed of large block operations under FullDebugMode: Since + large blocks are never reused, there is no point in clearing them before + and after use (so it does not do that anymore). + - If an error occurs in FullDebugMode and FastMM is unable to append to the + log file, it will attempt to write to a log file of the same name in the + "My Documents" folder. This feature is helpful when the executable resides + in a read-only location and the default log file, which is derived from the + executable name, would thus not be writeable. + - Added support for controlling the error log file location through an + environment variable. If the 'FastMMLogFilePath' environment variable is + set then any generated error logs will be written to the specified folder + instead of the default location (which is the same folder as the + application). + - Improved the call instruction detection code in the FastMM_FullDebugMode + library. (Thanks to the JCL team.) + - Improved the string leak detection and reporting code. (Thanks to Uwe + Schuster.) + - New FullDebugMode feature: Whenever FreeMem or ReallocMem is called, FastMM + will check that the block was actually allocated through the same FastMM + instance. This is useful for tracking down memory manager sharing issues. + - Compatible with Delphi 2010. + Version 4.96 (31 August 2010): + - Reduced the minimum block size to 4 bytes from the previous value of 12 + bytes (only applicable to 8 byte alignment). This reduces memory usage if + the application allocates many blocks <= 4 bytes in size. + - Added colour-coded change indication to the FastMM usage tracker, making + it easier to spot changes in the memory usage grid. (Thanks to Murray + McGowan.) + - Added the SuppressFreeMemErrorsInsideException FullDebugMode option: If + FastMM encounters a problem with a memory block inside the FullDebugMode + FreeMem handler then an "invalid pointer operation" exception will usually + be raised. If the FreeMem occurs while another exception is being handled + (perhaps in the try.. finally code) then the original exception will be + lost. With this option set FastMM will ignore errors inside FreeMem when an + exception is being handled, thus allowing the original exception to + propagate. This option is on by default. (Thanks to Michael Hieke.) + - Fixed Windows 95 FullDebugMode support that was broken in 4.94. (Thanks to + Richard Bradbrook.) + - Fixed a bug affecting GetMemoryMap performance and accuracy of measurements + above 2GB if a large address space is not enabled for the project. (Thanks + to Michael Hieke.) + - Added the FullDebugModeRegisterAllAllocsAsExpectedMemoryLeak boolean flag. + When set, all allocations are automatically registered as expected memory + leaks. Only available in FullDebugMode. (Thanks to Brian Cook.) + - Compatible with Delphi XE. + Version 4.97 (30 September 2010): + - Fixed a crash bug (that crept in in 4.96) that may manifest itself when + resizing a block to 4 bytes or less. + - Added the UseSwitchToThread option. Set this option to call SwitchToThread + instead of sitting in a "busy waiting" loop when a thread contention + occurs. This is used in conjunction with the NeverSleepOnThreadContention + option, and has no effect unless NeverSleepOnThreadContention is also + defined. This option may improve performance with many CPU cores and/or + threads of different priorities. Note that the SwitchToThread API call is + only available on Windows 2000 and later. (Thanks to Zach Saw.) + Version 4.98 (23 September 2011): + - Added the FullDebugModeCallBacks define which adds support for memory + manager event callbacks. This allows the application to be notified of + memory allocations, frees and reallocations as they occur. (Thanks to + Jeroen Pluimers.) + - Added security options ClearMemoryBeforeReturningToOS and + AlwaysClearFreedMemory to force the clearing of memory blocks after being + freed. This could possibly provide some protection against information + theft, but at a significant performance penalty. (Thanks to Andrey + Sozonov.) + - Shifted the code in the initialization section to a procedure + RunInitializationCode. This allows the startup code to be called before + InitUnits, which is required by some software protection tools. + - Added support for Delphi XE2 (Windows 32-bit and Windows 64-bit platforms + only). + Version 4.99 (6 November 2011): + - Fixed crashes in the 64-bit BASM codepath when more than 4GB of memory is + allocated. + - Fixed bad record alignment under 64-bit that affected performance. + - Fixed compilation errors with some older compilers. + Version 4.991 (3 September 2012) + - Added the LogMemoryManagerStateToFile call. This call logs a summary of + the memory manager state to file: The total allocated memory, overhead, + efficiency, and a breakdown of allocated memory by class and string type. + This call may be useful to catch objects that do not necessarily leak, but + do linger longer than they should. + - OS X support added by Sebastian Zierer + - Compatible with Delphi XE3 + Version 4.992 (21 October 2016) + - OS X full debug mode added by Sebastian Zierer + - Included the average block size in the memory state log file. (Thanks to + Hallvard Vassbotn) + - Support added for Free Pascal's OS X and Linux targets, both i386 and + x86-64. (Thanks to Zoë Peterson - some fixes by Arnaud Bouchez) + - Added the LogLockContention option which may be used to track down areas + in the application that lead to frequent lock contentions in the memory + manager. (Primoz Gabrijelcic) + - Support for release stacks added by Primoz Gabrijelcic. Define + "UseReleaseStack" to use this new feature: If a block cannot be released + immediately during a FreeMem call the block will added to a list of blocks + that will be freed later, either in the background cleanup thread or during + the next call to FreeMem. + +*) + +unit FastMM4; + +interface + +{$Include FastMM4Options.inc} + +{$RANGECHECKS OFF} +{$BOOLEVAL OFF} +{$OVERFLOWCHECKS OFF} +{$OPTIMIZATION ON} +{$TYPEDADDRESS OFF} +{$LONGSTRINGS ON} + +{Compiler version defines} +{$ifndef fpc} + {$ifndef BCB} + {$ifdef ver120} + {$define Delphi4or5} + {$endif} + {$ifdef ver130} + {$define Delphi4or5} + {$endif} + {$ifdef ver140} + {$define Delphi6} + {$endif} + {$ifdef ver150} + {$define Delphi7} + {$endif} + {$ifdef ver170} + {$define Delphi2005} + {$endif} + {$else} + {for BCB4, use the Delphi 5 codepath} + {$ifdef ver120} + {$define Delphi4or5} + {$define BCB4} + {$endif} + {for BCB5, use the Delphi 5 codepath} + {$ifdef ver130} + {$define Delphi4or5} + {$endif} + {$endif} + {$ifdef ver180} + {$define BDS2006} + {$endif} + {$define 32Bit} + {$ifndef Delphi4or5} + {$if SizeOf(Pointer) = 8} + {$define 64Bit} + {$undef 32Bit} + {$ifend} + {$if CompilerVersion >= 23} + {$define XE2AndUp} + {$ifend} + {$define BCB6OrDelphi6AndUp} + {$ifndef BCB} + {$define Delphi6AndUp} + {$endif} + {$ifndef Delphi6} + {$define BCB6OrDelphi7AndUp} + {$ifndef BCB} + {$define Delphi7AndUp} + {$endif} + {$ifndef BCB} + {$ifndef Delphi7} + {$ifndef Delphi2005} + {$define BDS2006AndUp} + {$endif} + {$endif} + {$endif} + {$endif} + {$endif} +{$else} + {$mode delphi} + {$ifdef CPUX64} + {$asmmode intel} + {$define 64bit} + {$define fpc64bit} + {$undef 32bit} + {$else} + {$define 32bit} + {$undef 64bit} + {$endif} +{$endif} + +{$ifdef 64Bit} + {Under 64 bit memory blocks must always be 16-byte aligned} + {$define Align16Bytes} + {No need for MMX under 64-bit, since SSE2 is available} + {$undef EnableMMX} + {There is little need for raw stack traces under 64-bit, since frame based + stack traces are much more accurate than under 32-bit. (And frame based + stack tracing is much faster.)} + {$undef RawStackTraces} +{$endif} + +{Lock contention logging requires ~ASMVersion.} +{$ifdef LogLockContention} + {$undef ASMVersion} +{$endif} + +{Release stack requires ~ASMVersion (for now).} +{$ifdef UseReleaseStack} + {$undef ASMVersion} + {$ifdef FullDebugMode} + {$message error 'UseReleaseStack is not compatible with FullDebugMode'} + {$endif} +{$endif} + +{IDE debug mode always enables FullDebugMode and dynamic loading of the FullDebugMode DLL.} +{$ifdef FullDebugModeInIDE} + {$define InstallOnlyIfRunningInIDE} + {$define FullDebugMode} + {$define LoadDebugDLLDynamically} +{$endif} + +{Install in FullDebugMode only when the DLL is available?} +{$ifdef FullDebugModeWhenDLLAvailable} + {$define FullDebugMode} + {$define LoadDebugDLLDynamically} + {$define DoNotInstallIfDLLMissing} +{$endif} + +{$ifdef Linux} + {$define POSIX} + {$ifdef 64Bit} + {$define PIC} // Linux 64bit ASM is PIC + {$endif} + {$ifndef FPC} + {$define KYLIX} + {$endif} +{$endif} + +{$ifdef DARWIN} + {$define POSIX} + {$define PIC} +{$endif} + +{Some features not currently supported under Kylix / OS X} +{$ifdef POSIX} + {$ifndef MACOS} + {$undef FullDebugMode} + {$undef LogErrorsToFile} + {$undef LogMemoryLeakDetailToFile} + {$endif} + {$undef ShareMM} + {$undef AttemptToUseSharedMM} + {$undef RequireIDEPresenceForLeakReporting} + {$undef UseOutputDebugString} + {$ifdef PIC} + {BASM version does not support position independent code} + {$undef ASMVersion} + {$endif} + {$ifndef FPC} + {$define MACOS_OR_KYLIX} + {$endif} +{$endif} + +{Do we require debug info for leak checking?} +{$ifdef RequireDebugInfoForLeakReporting} + {$ifopt D-} + {$undef EnableMemoryLeakReporting} + {$endif} +{$endif} + +{Enable heap checking and leak reporting in full debug mode} +{$ifdef FullDebugMode} + {$STACKFRAMES ON} + {$define CheckHeapForCorruption} + {$ifndef CatchUseOfFreedInterfaces} + {$define CheckUseOfFreedBlocksOnShutdown} + {$endif} +{$else} + {Error logging requires FullDebugMode} + {$undef LogErrorsToFile} + {$undef CatchUseOfFreedInterfaces} + {$undef RawStackTraces} + {$undef AlwaysAllocateTopDown} +{$endif} + +{Set defines for security options} +{$ifdef FullDebugMode} + {In FullDebugMode small and medium blocks are always cleared when calling + FreeMem. Large blocks are always returned to the OS immediately.} + {$ifdef ClearMemoryBeforeReturningToOS} + {$define ClearLargeBlocksBeforeReturningToOS} + {$endif} + {$ifdef AlwaysClearFreedMemory} + {$define ClearLargeBlocksBeforeReturningToOS} + {$endif} +{$else} + {If memory blocks are cleared in FreeMem then they do not need to be cleared + before returning the memory to the OS.} + {$ifdef AlwaysClearFreedMemory} + {$define ClearSmallAndMediumBlocksInFreeMem} + {$define ClearLargeBlocksBeforeReturningToOS} + {$else} + {$ifdef ClearMemoryBeforeReturningToOS} + {$define ClearMediumBlockPoolsBeforeReturningToOS} + {$define ClearLargeBlocksBeforeReturningToOS} + {$endif} + {$endif} +{$endif} + +{Only the Pascal version supports extended heap corruption checking.} +{$ifdef CheckHeapForCorruption} + {$undef ASMVersion} +{$endif} + +{For BASM bits that are not implemented in 64-bit.} +{$ifdef 32Bit} + {$ifdef ASMVersion} + {$define Use32BitAsm} + {$endif} +{$endif} + +{$ifdef UseRuntimePackages} + {$define AssumeMultiThreaded} +{$endif} + +{$ifdef BCB6OrDelphi6AndUp} + {$WARN SYMBOL_PLATFORM OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$endif} + +{Leak detail logging requires error logging} +{$ifndef LogErrorsToFile} + {$undef LogMemoryLeakDetailToFile} + {$undef ClearLogFileOnStartup} +{$endif} + +{$ifndef EnableMemoryLeakReporting} + {Manual leak reporting control requires leak reporting to be enabled} + {$undef ManualLeakReportingControl} +{$endif} + +{$ifndef EnableMMX} + {$undef ForceMMX} +{$endif} + +{Are any of the MM sharing options enabled?} +{$ifdef ShareMM} + {$define MMSharingEnabled} +{$endif} +{$ifdef AttemptToUseSharedMM} + {$define MMSharingEnabled} +{$endif} + +{Instruct GExperts to back up the messages file as well.} +{#BACKUP FastMM4Messages.pas} + +{Should debug info be disabled?} +{$ifdef NoDebugInfo} + {$DEBUGINFO OFF} +{$endif} + +{$ifdef BCB} + {$ifdef borlndmmdll} + {$OBJEXPORTALL OFF} + {$endif} + {$ifndef PatchBCBTerminate} + {Cannot uninstall safely under BCB} + {$define NeverUninstall} + {Disable memory leak reporting} + {$undef EnableMemoryLeakReporting} + {$endif} +{$endif} + +{Stack tracer is needed for LogLockContention and for FullDebugMode.} +{$undef _StackTracer} +{$undef _EventLog} +{$ifdef FullDebugMode}{$define _StackTracer}{$define _EventLog}{$endif} +{$ifdef LogLockContention}{$define _StackTracer}{$define _EventLog}{$endif} +{$ifdef UseReleaseStack}{$ifdef DebugReleaseStack}{$define _EventLog}{$endif}{$endif} + +{-------------------------Public constants-----------------------------} +const + {The current version of FastMM} + FastMMVersion = '4.991'; + {The number of small block types} +{$ifdef Align16Bytes} + NumSmallBlockTypes = 46; +{$else} + NumSmallBlockTypes = 56; +{$endif} + +{----------------------------Public types------------------------------} +type + + {Make sure all the required types are available} +{$ifdef BCB6OrDelphi6AndUp} + {$if CompilerVersion < 20} + PByte = PAnsiChar; + {NativeInt didn't exist or was broken before Delphi 2009.} + NativeInt = Integer; + {$ifend} + {$if CompilerVersion < 21} + {NativeUInt didn't exist or was broken before Delphi 2010.} + NativeUInt = Cardinal; + {$ifend} + {$if CompilerVersion < 22} + {PNativeUInt didn't exist before Delphi XE.} + PNativeUInt = ^Cardinal; + {$ifend} + {$if CompilerVersion < 23} + {IntPtr and UIntPtr didn't exist before Delphi XE2.} + IntPtr = Integer; + UIntPtr = Cardinal; + {$ifend} +{$else} + {$ifndef fpc} + PByte = PAnsiChar; + NativeInt = Integer; + NativeUInt = Cardinal; + PNativeUInt = ^Cardinal; + IntPtr = Integer; + UIntPtr = Cardinal; + {$endif} +{$endif} + + TSmallBlockTypeState = record + {The internal size of the block type} + InternalBlockSize: Cardinal; + {Useable block size: The number of non-reserved bytes inside the block.} + UseableBlockSize: Cardinal; + {The number of allocated blocks} + AllocatedBlockCount: NativeUInt; + {The total address space reserved for this block type (both allocated and + free blocks)} + ReservedAddressSpace: NativeUInt; + end; + TSmallBlockTypeStates = array[0..NumSmallBlockTypes - 1] of TSmallBlockTypeState; + + TMemoryManagerState = record + {Small block type states} + SmallBlockTypeStates: TSmallBlockTypeStates; + {Medium block stats} + AllocatedMediumBlockCount: Cardinal; + TotalAllocatedMediumBlockSize: NativeUInt; + ReservedMediumBlockAddressSpace: NativeUInt; + {Large block stats} + AllocatedLargeBlockCount: Cardinal; + TotalAllocatedLargeBlockSize: NativeUInt; + ReservedLargeBlockAddressSpace: NativeUInt; + end; + + TMemoryManagerUsageSummary = record + {The total number of bytes allocated by the application.} + AllocatedBytes: NativeUInt; + {The total number of address space bytes used by control structures, or + lost due to fragmentation and other overhead.} + OverheadBytes: NativeUInt; + {The efficiency of the memory manager expressed as a percentage. This is + 100 * AllocatedBytes / (AllocatedBytes + OverheadBytes).} + EfficiencyPercentage: Double; + end; + + {Memory map} + TChunkStatus = (csUnallocated, csAllocated, csReserved, csSysAllocated, + csSysReserved); + TMemoryMap = array[0..65535] of TChunkStatus; + +{$ifdef EnableMemoryLeakReporting} + {List of registered leaks} + TRegisteredMemoryLeak = record + LeakAddress: Pointer; + LeakedClass: TClass; + {$ifdef CheckCppObjectTypeEnabled} + LeakedCppTypeIdPtr: Pointer; + {$endif} + LeakSize: NativeInt; + LeakCount: Integer; + end; + TRegisteredMemoryLeaks = array of TRegisteredMemoryLeak; +{$endif} + + {Used by the DetectStringData routine to detect whether a leaked block + contains string data.} + TStringDataType = (stUnknown, stAnsiString, stUnicodeString); + + {The callback procedure for WalkAllocatedBlocks.} + TWalkAllocatedBlocksCallback = procedure(APBlock: Pointer; ABlockSize: NativeInt; AUserData: Pointer); + +{--------------------------Public variables----------------------------} +var + {If this variable is set to true and FullDebugMode is enabled, then the + entire memory pool is checked for consistency before every memory + operation. Note that this incurs a massive performance hit on top of + the already significant FullDebugMode overhead, so enable this option + only when absolutely necessary.} + FullDebugModeScanMemoryPoolBeforeEveryOperation: Boolean = False; + FullDebugModeRegisterAllAllocsAsExpectedMemoryLeak: Boolean = False; +{$ifdef ManualLeakReportingControl} + {Variable is declared in system.pas in newer Delphi versions.} + {$ifndef BDS2006AndUp} + ReportMemoryLeaksOnShutdown: Boolean; + {$endif} +{$endif} + {If set to True, disables the display of all messageboxes} + SuppressMessageBoxes: Boolean; + +{-------------------------Public procedures----------------------------} +{Executes the code normally run in the initialization section. Running it + earlier may be required with e.g. some software protection tools.} +procedure RunInitializationCode; +{Installation procedures must be exposed for the BCB helper unit FastMM4BCB.cpp} +{$ifdef BCB} +procedure InitializeMemoryManager; +function CheckCanInstallMemoryManager: Boolean; +procedure InstallMemoryManager; + +{$ifdef FullDebugMode} +(*$HPPEMIT '#define FullDebugMode' *) + +{$ifdef ClearLogFileOnStartup} +(*$HPPEMIT ' #define ClearLogFileOnStartup' *) +procedure DeleteEventLog; +{$endif} + +{$ifdef LoadDebugDLLDynamically} +(*$HPPEMIT ' #define LoadDebugDLLDynamically' *) +{$endif} + +{$ifdef RawStackTraces} +(*$HPPEMIT ' #define RawStackTraces' *) +{$endif} + +{$endif} + +{$ifdef PatchBCBTerminate} +(*$HPPEMIT ''#13#10 *) +(*$HPPEMIT '#define PatchBCBTerminate' *) + +{$ifdef EnableMemoryLeakReporting} +(*$HPPEMIT ''#13#10 *) +(*$HPPEMIT '#define EnableMemoryLeakReporting' *) +{$endif} + +{$ifdef DetectMMOperationsAfterUninstall} +(*$HPPEMIT ''#13#10 *) +(*$HPPEMIT '#define DetectMMOperationsAfterUninstall' *) +{$endif} + +{Called in FastMM4BCB.cpp, should contain codes of original "finalization" section} +procedure FinalizeMemoryManager; + +{For completion of "RequireDebuggerPresenceForLeakReporting" checking in "FinalizeMemoryManager"} +var + pCppDebugHook: ^Integer = nil; //PInteger not defined in BCB5 + +{$ifdef CheckCppObjectTypeEnabled} +(*$HPPEMIT ''#13#10 *) +(*$HPPEMIT '#define CheckCppObjectTypeEnabled' *) + +type + TGetCppVirtObjSizeByTypeIdPtrFunc = function(APointer: Pointer): Cardinal; + TGetCppVirtObjTypeIdPtrFunc = function(APointer: Pointer; ASize: Cardinal): Pointer; + TGetCppVirtObjTypeNameFunc = function(APointer: Pointer; ASize: Cardinal): PAnsiChar; + TGetCppVirtObjTypeNameByTypeIdPtrFunc = function (APointer: Pointer): PAnsiChar; + TGetCppVirtObjTypeNameByVTablePtrFunc = function(AVTablePtr: Pointer; AVTablePtrOffset: Cardinal): PAnsiChar; +var + {Return virtual object's size from typeId pointer} + GetCppVirtObjSizeByTypeIdPtrFunc: TGetCppVirtObjSizeByTypeIdPtrFunc = nil; + {Retrieve virtual object's typeId pointer} + GetCppVirtObjTypeIdPtrFunc: TGetCppVirtObjTypeIdPtrFunc = nil; + {Retrieve virtual object's type name} + GetCppVirtObjTypeNameFunc: TGetCppVirtObjTypeNameFunc = nil; + {Return virtual object's type name from typeId pointer} + GetCppVirtObjTypeNameByTypeIdPtrFunc: TGetCppVirtObjTypeNameByTypeIdPtrFunc = nil; + {Retrieve virtual object's typeId pointer from it's virtual table pointer} + GetCppVirtObjTypeNameByVTablePtrFunc: TGetCppVirtObjTypeNameByVTablePtrFunc = nil; +{$endif} +{$endif} +{$endif} + +{$ifndef FullDebugMode} +{The standard memory manager functions} +function FastGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; +function FastFreeMem(APointer: Pointer): {$ifdef fpc}NativeUInt{$else}Integer{$endif}; +function FastReallocMem({$ifdef fpc}var {$endif}APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; +function FastAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Cardinal{$endif}{$endif}): Pointer; +{$else} +{The FullDebugMode memory manager functions} +function DebugGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}Integer{$endif}): Pointer; +function DebugFreeMem(APointer: Pointer): Integer; +function DebugReallocMem(APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}Integer{$endif}): Pointer; +function DebugAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}Cardinal{$endif}): Pointer; +{Scans the memory pool for any corruptions. If a corruption is encountered an "Out of Memory" exception is + raised.} +procedure ScanMemoryPoolForCorruptions; +{Returns the current "allocation group". Whenever a GetMem request is serviced + in FullDebugMode, the current "allocation group" is stored in the block header. + This may help with debugging. Note that if a block is subsequently reallocated + that it keeps its original "allocation group" and "allocation number" (all + allocations are also numbered sequentially).} +function GetCurrentAllocationGroup: Cardinal; +{Allocation groups work in a stack like fashion. Group numbers are pushed onto + and popped off the stack. Note that the stack size is limited, so every push + should have a matching pop.} +procedure PushAllocationGroup(ANewCurrentAllocationGroup: Cardinal); +procedure PopAllocationGroup; +{Logs detail about currently allocated memory blocks for the specified range of + allocation groups. if ALastAllocationGroupToLog is less than + AFirstAllocationGroupToLog or it is zero, then all allocation groups are + logged. This routine also checks the memory pool for consistency at the same + time, raising an "Out of Memory" error if the check fails.} +procedure LogAllocatedBlocksToFile(AFirstAllocationGroupToLog, ALastAllocationGroupToLog: Cardinal); +{$endif} +{$ifdef _EventLog} +{Specify the full path and name for the filename to be used for logging memory + errors, etc. If ALogFileName is nil or points to an empty string it will + revert to the default log file name.} +procedure SetMMLogFileName(ALogFileName: PAnsiChar = nil); +{$endif} + +{Releases all allocated memory (use with extreme care)} +procedure FreeAllMemory; + +{Returns summarised information about the state of the memory manager. (For + backward compatibility.)} +function FastGetHeapStatus: THeapStatus; +{Returns statistics about the current state of the memory manager} +procedure GetMemoryManagerState(var AMemoryManagerState: TMemoryManagerState); +{Returns a summary of the information returned by GetMemoryManagerState} +procedure GetMemoryManagerUsageSummary( + var AMemoryManagerUsageSummary: TMemoryManagerUsageSummary); +{$ifndef POSIX} +{Gets the state of every 64K block in the 4GB address space} +procedure GetMemoryMap(var AMemoryMap: TMemoryMap); +{$endif} + +{$ifdef EnableMemoryLeakReporting} +{Registers expected memory leaks. Returns true on success. The list of leaked + blocks is limited, so failure is possible if the list is full.} +function RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +function RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +function RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +{$ifdef CheckCppObjectTypeEnabled} +{Registers expected memory leaks by virtual object's typeId pointer. + Usage: RegisterExpectedMemoryLeak(typeid(ACppObject).tpp, Count);} +function RegisterExpectedMemoryLeak(ALeakedCppVirtObjTypeIdPtr: Pointer; ACount: Integer): boolean; overload; +{$endif} +{Removes expected memory leaks. Returns true on success.} +function UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +function UnregisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +function UnregisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +{$ifdef CheckCppObjectTypeEnabled} +{Usage: UnregisterExpectedMemoryLeak(typeid(ACppObject).tpp, Count);} +function UnregisterExpectedMemoryLeak(ALeakedCppVirtObjTypeIdPtr: Pointer; ACount: Integer): boolean; overload; +{$endif} +{Returns a list of all expected memory leaks} +function GetRegisteredMemoryLeaks: TRegisteredMemoryLeaks; +{$endif} + +{Returns the class for a memory block. Returns nil if it is not a valid class. + Used by the leak detection code.} +function DetectClassInstance(APointer: Pointer): TClass; +{Detects the probable string data type for a memory block. Used by the leak + classification code when a block cannot be identified as a known class + instance.} +function DetectStringData(APMemoryBlock: Pointer; + AAvailableSpaceInBlock: NativeInt): TStringDataType; +{Walks all allocated blocks, calling ACallBack for each. Passes the user block size and AUserData to the callback. + Important note: All block types will be locked during the callback, so the memory manager cannot be used inside it.} +procedure WalkAllocatedBlocks(ACallBack: TWalkAllocatedBlocksCallback; AUserData: Pointer); +{Writes a log file containing a summary of the memory manager state and a summary of allocated blocks grouped by + class. The file will be saved in UTF-8 encoding (in supported Delphi versions). Returns True on success. } +function LogMemoryManagerStateToFile(const AFileName: string; const AAdditionalDetails: string = ''): Boolean; + +{$ifdef UseReleaseStack} +{$ifdef DebugReleaseStack} +procedure LogReleaseStackUsage; +{$endif} +{$endif} + +{$ifdef _StackTracer} +{------------- FullDebugMode/LogLockContention constants---------------} +const + {The stack trace depth. (Must be an *uneven* number to ensure that the + Align16Bytes option works in FullDebugMode.)} + StackTraceDepth = 11; + +type + PStackTrace = ^TStackTrace; + TStackTrace = array[0..StackTraceDepth - 1] of NativeUInt; +{$endif} + +{$ifdef FullDebugMode} +{-------------FullDebugMode constants---------------} +const + {The number of entries in the allocation group stack} + AllocationGroupStackSize = 1000; + {The number of fake VMT entries - used to track virtual method calls on + freed objects. Do not change this value without also updating TFreedObject.GetVirtualMethodIndex} + MaxFakeVMTEntries = 200; + {The pattern used to fill unused memory} + DebugFillByte = $80; +{$ifdef 32Bit} + DebugFillPattern = $01010101 * Cardinal(DebugFillByte); + {The address that is reserved so that accesses to the address of the fill + pattern will result in an A/V. (Not used under 64-bit, since the upper half + of the address space is always reserved by the OS.)} + DebugReservedAddress = $01010000 * Cardinal(DebugFillByte); +{$else} + DebugFillPattern = $8080808080808080; +{$endif} + +{-------------------------FullDebugMode structures--------------------} +type + TBlockOperation = (boBlockCheck, boGetMem, boFreeMem, boReallocMem); + + {The header placed in front of blocks in FullDebugMode (just after the + standard header). Must be a multiple of 16 bytes in size otherwise the + Align16Bytes option will not work. Current size = 128 bytes under 32-bit, + and 240 bytes under 64-bit.} + PFullDebugBlockHeader = ^TFullDebugBlockHeader; + TFullDebugBlockHeader = record + {Space used by the medium block manager for previous/next block management. + If a medium block is binned then these two fields will be modified.} + Reserved1: Pointer; + Reserved2: Pointer; + {Is the block currently allocated? If it is allocated this will be the + address of the getmem routine through which it was allocated, otherwise it + will be nil.} + AllocatedByRoutine: Pointer; + {The allocation group: Can be used in the debugging process to group + related memory leaks together} + AllocationGroup: Cardinal; + {The allocation number: All new allocations are numbered sequentially. This + number may be useful in memory leak analysis. If it reaches 4G it wraps + back to 0.} + AllocationNumber: Cardinal; + {The call stack when the block was allocated} + AllocationStackTrace: TStackTrace; + {The thread that allocated the block} + AllocatedByThread: Cardinal; + {The thread that freed the block} + FreedByThread: Cardinal; + {The call stack when the block was freed} + FreeStackTrace: TStackTrace; + {The user requested size for the block. 0 if this is the first time the + block is used.} + UserSize: NativeUInt; + {The object class this block was used for the previous time it was + allocated. When a block is freed, the pointer that would normally be in the + space of the class pointer is copied here, so if it is detected that + the block was used after being freed we have an idea what class it is.} + PreviouslyUsedByClass: NativeUInt; + {The sum of all the dwords(32-bit)/qwords(64-bit) in this structure + excluding the initial two reserved fields and this field.} + HeaderCheckSum: NativeUInt; + end; + {The NativeUInt following the user area of the block is the inverse of + HeaderCheckSum. This is used to catch buffer overrun errors.} + + {The class used to catch attempts to execute a virtual method of a freed + object} + TFreedObject = class + public + procedure GetVirtualMethodIndex; + procedure VirtualMethodError; +{$ifdef CatchUseOfFreedInterfaces} + procedure InterfaceError; +{$endif} + end; + +{$ifdef FullDebugModeCallBacks} + {FullDebugMode memory manager event callbacks. Note that APHeaderFreedBlock in the TOnDebugFreeMemFinish + will not be valid for large (>260K) blocks.} + TOnDebugGetMemFinish = procedure(APHeaderNewBlock: PFullDebugBlockHeader; ASize: NativeInt); + TOnDebugFreeMemStart = procedure(APHeaderBlockToFree: PFullDebugBlockHeader); + TOnDebugFreeMemFinish = procedure(APHeaderFreedBlock: PFullDebugBlockHeader; AResult: Integer); + TOnDebugReallocMemStart = procedure(APHeaderBlockToReallocate: PFullDebugBlockHeader; ANewSize: NativeInt); + TOnDebugReallocMemFinish = procedure(APHeaderReallocatedBlock: PFullDebugBlockHeader; ANewSize: NativeInt); + +var + {Note: FastMM will not catch exceptions inside these hooks, so make sure your hook code runs without + exceptions.} + OnDebugGetMemFinish: TOnDebugGetMemFinish = nil; + OnDebugFreeMemStart: TOnDebugFreeMemStart = nil; + OnDebugFreeMemFinish: TOnDebugFreeMemFinish = nil; + OnDebugReallocMemStart: TOnDebugReallocMemStart = nil; + OnDebugReallocMemFinish: TOnDebugReallocMemFinish = nil; +{$endif} +{$endif} + +implementation + +uses +{$ifndef POSIX} + Windows, + {$ifdef _EventLog} + {$ifdef Delphi4or5} + ShlObj, + {$else} + SHFolder, + {$endif} + {$endif} +{$else} + {$ifdef MACOS} + Posix.Stdlib, Posix.Unistd, Posix.Fcntl, Posix.PThread, FastMM_OSXUtil, + {$ELSE} + {$ifdef fpc} + BaseUnix, + {$else} + Libc, + {$endif} + {$endif} +{$endif} +{$ifdef LogLockContention} + FastMM4DataCollector, +{$endif} +{$ifdef UseReleaseStack} + FastMM4LockFreeStack, +{$endif} + FastMM4Messages; + +{$ifdef fpc} +function valloc(__size:size_t):pointer;cdecl;external clib name 'valloc'; +procedure free(__ptr:pointer);cdecl;external clib name 'free'; +function usleep(__useconds:dword):longint;cdecl;external clib name 'usleep'; +{$endif} + +{Fixed size move procedures. The 64-bit versions assume 16-byte alignment.} +procedure Move4(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move12(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move20(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move28(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move36(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move44(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move52(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move60(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move68(const ASource; var ADest; ACount: NativeInt); forward; +{$ifdef 64Bit} +{These are not needed and thus unimplemented under 32-bit} +procedure Move8(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move24(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move40(const ASource; var ADest; ACount: NativeInt); forward; +procedure Move56(const ASource; var ADest; ACount: NativeInt); forward; +{$endif} + +{$ifdef DetectMMOperationsAfterUninstall} +{Invalid handlers to catch MM operations after uninstall} +function InvalidFreeMem(APointer: Pointer): {$ifdef fpc}NativeUInt{$else}Integer{$endif}; forward; +function InvalidGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; forward; +function InvalidReallocMem({$ifdef fpc}var {$endif}APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; forward; +function InvalidAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUint{$else}Cardinal{$endif}{$endif}): Pointer; forward; +function InvalidRegisterAndUnRegisterMemoryLeak(APointer: Pointer): Boolean; forward; +{$endif} + +{-------------------------Private constants----------------------------} +const + {The size of a medium block pool. This is allocated through VirtualAlloc and + is used to serve medium blocks. The size must be a multiple of 16 and at + least 4 bytes less than a multiple of 4K (the page size) to prevent a + possible read access violation when reading past the end of a memory block + in the optimized move routine (MoveX16LP). In Full Debug mode we leave a + trailing 256 bytes to be able to safely do a memory dump.} + MediumBlockPoolSize = 20 * 64 * 1024{$ifndef FullDebugMode} - 16{$else} - 256{$endif}; + {The granularity of small blocks} +{$ifdef Align16Bytes} + SmallBlockGranularity = 16; +{$else} + SmallBlockGranularity = 8; +{$endif} + {The granularity of medium blocks. Newly allocated medium blocks are + a multiple of this size plus MediumBlockSizeOffset, to avoid cache line + conflicts} + MediumBlockGranularity = 256; + MediumBlockSizeOffset = 48; + {The granularity of large blocks} + LargeBlockGranularity = 65536; + {The maximum size of a small block. Blocks Larger than this are either + medium or large blocks.} + MaximumSmallBlockSize = 2608; + {The smallest medium block size. (Medium blocks are rounded up to the nearest + multiple of MediumBlockGranularity plus MediumBlockSizeOffset)} + MinimumMediumBlockSize = 11 * 256 + MediumBlockSizeOffset; + {The number of bins reserved for medium blocks} + MediumBlockBinsPerGroup = 32; + MediumBlockBinGroupCount = 32; + MediumBlockBinCount = MediumBlockBinGroupCount * MediumBlockBinsPerGroup; + {The maximum size allocatable through medium blocks. Blocks larger than this + fall through to VirtualAlloc ( = large blocks).} + MaximumMediumBlockSize = MinimumMediumBlockSize + (MediumBlockBinCount - 1) * MediumBlockGranularity; + {The target number of small blocks per pool. The actual number of blocks per + pool may be much greater for very small sizes and less for larger sizes. The + cost of allocating the small block pool is amortized across all the small + blocks in the pool, however the blocks may not all end up being used so they + may be lying idle.} + TargetSmallBlocksPerPool = 48; + {The minimum number of small blocks per pool. Any available medium block must + have space for roughly this many small blocks (or more) to be useable as a + small block pool.} + MinimumSmallBlocksPerPool = 12; + {The lower and upper limits for the optimal small block pool size} + OptimalSmallBlockPoolSizeLowerLimit = 29 * 1024 - MediumBlockGranularity + MediumBlockSizeOffset; + OptimalSmallBlockPoolSizeUpperLimit = 64 * 1024 - MediumBlockGranularity + MediumBlockSizeOffset; + {The maximum small block pool size. If a free block is this size or larger + then it will be split.} + MaximumSmallBlockPoolSize = OptimalSmallBlockPoolSizeUpperLimit + MinimumMediumBlockSize; + {-------------Block type flags--------------} + {The lower 3 bits in the dword header of small blocks (4 bits in medium and + large blocks) are used as flags to indicate the state of the block} + {Set if the block is not in use} + IsFreeBlockFlag = 1; + {Set if this is a medium block} + IsMediumBlockFlag = 2; + {Set if it is a medium block being used as a small block pool. Only valid if + IsMediumBlockFlag is set.} + IsSmallBlockPoolInUseFlag = 4; + {Set if it is a large block. Only valid if IsMediumBlockFlag is not set.} + IsLargeBlockFlag = 4; + {Is the medium block preceding this block available? (Only used by medium + blocks)} + PreviousMediumBlockIsFreeFlag = 8; + {Is this large block segmented? I.e. is it actually built up from more than + one chunk allocated through VirtualAlloc? (Only used by large blocks.)} + LargeBlockIsSegmented = 8; + {The flags masks for small blocks} + DropSmallFlagsMask = -8; + ExtractSmallFlagsMask = 7; + {The flags masks for medium and large blocks} + DropMediumAndLargeFlagsMask = -16; + ExtractMediumAndLargeFlagsMask = 15; + {-------------Block resizing constants---------------} + SmallBlockDownsizeCheckAdder = 64; + SmallBlockUpsizeAdder = 32; + {When a medium block is reallocated to a size smaller than this, then it must + be reallocated to a small block and the data moved. If not, then it is + shrunk in place down to MinimumMediumBlockSize. Currently the limit is set + at a quarter of the minimum medium block size.} + MediumInPlaceDownsizeLimit = MinimumMediumBlockSize div 4; + {-------------Memory leak reporting constants---------------} + ExpectedMemoryLeaksListSize = 64 * 1024; + {-------------Other constants---------------} +{$ifndef NeverSleepOnThreadContention} + {Sleep time when a resource (small/medium/large block manager) is in use} + InitialSleepTime = 0; + {Used when the resource is still in use after the first sleep} + AdditionalSleepTime = 1; +{$endif} + {Hexadecimal characters} + HexTable: array[0..15] of AnsiChar = ('0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); + {Copyright message - not used anywhere in the code} + Copyright: AnsiString = 'FastMM4 (c) 2004 - 2011 Pierre le Riche / Professional Software Development'; +{$ifdef FullDebugMode} + {Virtual Method Called On Freed Object Errors} + StandardVirtualMethodNames: array[1 + vmtParent div SizeOf(Pointer) .. vmtDestroy div SizeOf(Pointer)] of PAnsiChar = ( +{$ifdef BCB6OrDelphi6AndUp} + {$if RTLVersion >= 20} + 'Equals', + 'GetHashCode', + 'ToString', + {$ifend} +{$endif} + 'SafeCallException', + 'AfterConstruction', + 'BeforeDestruction', + 'Dispatch', + 'DefaultHandler', + 'NewInstance', + 'FreeInstance', + 'Destroy'); + {The name of the FullDebugMode support DLL. The support DLL implements stack + tracing and the conversion of addresses to unit and line number information.} +{$endif} +{$ifdef UseReleaseStack} + ReleaseStackSize = 16; + NumStacksPerBlock = 64; //should be power of 2 +{$endif} + +{$ifdef _StackTracer} +{$ifdef 32Bit} + FullDebugModeLibraryName = FullDebugModeLibraryName32Bit; +{$else} + FullDebugModeLibraryName = FullDebugModeLibraryName64Bit; +{$endif} +{$endif} + +{-------------------------Private types----------------------------} +type + +{$ifdef Delphi4or5} + {Delphi 5 Compatibility} + PCardinal = ^Cardinal; + PPointer = ^Pointer; +{$endif} +{$ifdef BCB4} + {Define some additional types for BCB4} + PInteger = ^Integer; +{$endif} + + {Move procedure type} + TMoveProc = procedure(const ASource; var ADest; ACount: NativeInt); + + {Registers structure (for GetCPUID)} + TRegisters = record + RegEAX, RegEBX, RegECX, RegEDX: Integer; + end; + + {The layout of a string allocation. Used to detect string leaks.} + PStrRec = ^StrRec; + StrRec = packed record +{$ifdef 64Bit} + _Padding: Integer; +{$endif} +{$ifdef BCB6OrDelphi6AndUp} + {$if RTLVersion >= 20} + codePage: Word; + elemSize: Word; + {$ifend} +{$endif} + refCnt: Integer; + length: Integer; + end; + +{$ifdef EnableMemoryLeakReporting} + {Different kinds of memory leaks} + TMemoryLeakType = (mltUnexpectedLeak, mltExpectedLeakRegisteredByPointer, + mltExpectedLeakRegisteredByClass, mltExpectedLeakRegisteredBySize); +{$endif} + + {---------------Small block structures-------------} + + {Pointer to the header of a small block pool} + PSmallBlockPoolHeader = ^TSmallBlockPoolHeader; + + {Small block type (Size = 32 bytes for 32-bit, 64 bytes for 64-bit).} + PSmallBlockType = ^TSmallBlockType; + TSmallBlockType = record + {True = Block type is locked} + BlockTypeLocked: Boolean; + {Bitmap indicating which of the first 8 medium block groups contain blocks + of a suitable size for a block pool.} + AllowedGroupsForBlockPoolBitmap: Byte; + {The block size for this block type} + BlockSize: Word; + {The minimum and optimal size of a small block pool for this block type} + MinimumBlockPoolSize: Word; + OptimalBlockPoolSize: Word; + {The first partially free pool for the given small block. This field must + be at the same offset as TSmallBlockPoolHeader.NextPartiallyFreePool.} + NextPartiallyFreePool: PSmallBlockPoolHeader; + {The last partially free pool for the small block type. This field must + be at the same offset as TSmallBlockPoolHeader.PreviousPartiallyFreePool.} + PreviousPartiallyFreePool: PSmallBlockPoolHeader; + {The offset of the last block that was served sequentially. The field must + be at the same offset as TSmallBlockPoolHeader.FirstFreeBlock.} + NextSequentialFeedBlockAddress: Pointer; + {The last block that can be served sequentially.} + MaxSequentialFeedBlockAddress: Pointer; + {The pool that is current being used to serve blocks in sequential order} + CurrentSequentialFeedPool: PSmallBlockPoolHeader; +{$ifdef UseCustomFixedSizeMoveRoutines} + {The fixed size move procedure used to move data for this block size when + it is upsized. When a block is downsized (which usually does not occur + that often) the variable size move routine is used.} + UpsizeMoveProcedure: TMoveProc; +{$else} + Reserved1: Pointer; +{$endif} +{$ifdef 64Bit} + {Pad to 64 bytes for 64-bit} + Reserved2: Pointer; +{$endif} +{$ifdef UseReleaseStack} + ReleaseStack: array [0..NumStacksPerBlock - 1] of TLFStack; +{$endif} +{$ifdef LogLockContention} + BlockCollector: TStaticCollector; +{$endif} + end; + + {Small block pool (Size = 32 bytes for 32-bit, 48 bytes for 64-bit).} + TSmallBlockPoolHeader = record + {BlockType} + BlockType: PSmallBlockType; +{$ifdef 32Bit} + {Align the next fields to the same fields in TSmallBlockType and pad this + structure to 32 bytes for 32-bit} + Reserved1: Cardinal; +{$endif} + {The next and previous pool that has free blocks of this size. Do not + change the position of these two fields: They must be at the same offsets + as the fields in TSmallBlockType of the same name.} + NextPartiallyFreePool: PSmallBlockPoolHeader; + PreviousPartiallyFreePool: PSmallBlockPoolHeader; + {Pointer to the first free block inside this pool. This field must be at + the same offset as TSmallBlockType.NextSequentialFeedBlockAddress.} + FirstFreeBlock: Pointer; + {The number of blocks allocated in this pool.} + BlocksInUse: Cardinal; + {Padding} + Reserved2: Cardinal; + {The pool pointer and flags of the first block} + FirstBlockPoolPointerAndFlags: NativeUInt; + end; + + {Small block layout: + At offset -SizeOf(Pointer) = Flags + address of the small block pool. + At offset BlockSize - SizeOf(Pointer) = Flags + address of the small block + pool for the next small block. + } + + {------------------------Medium block structures------------------------} + + {The medium block pool from which medium blocks are drawn. Size = 16 bytes + for 32-bit and 32 bytes for 64-bit.} + PMediumBlockPoolHeader = ^TMediumBlockPoolHeader; + TMediumBlockPoolHeader = record + {Points to the previous and next medium block pools. This circular linked + list is used to track memory leaks on program shutdown.} + PreviousMediumBlockPoolHeader: PMediumBlockPoolHeader; + NextMediumBlockPoolHeader: PMediumBlockPoolHeader; + {Padding} + Reserved1: NativeUInt; + {The block size and flags of the first medium block in the block pool} + FirstMediumBlockSizeAndFlags: NativeUInt; + end; + + {Medium block layout: + Offset: -2 * SizeOf(Pointer) = Previous Block Size (only if the previous block is free) + Offset: -SizeOf(Pointer) = This block size and flags + Offset: 0 = User data / Previous Free Block (if this block is free) + Offset: SizeOf(Pointer) = Next Free Block (if this block is free) + Offset: BlockSize - 2*SizeOf(Pointer) = Size of this block (if this block is free) + Offset: BlockSize - SizeOf(Pointer) = Size of the next block and flags + + {A medium block that is unused} + PMediumFreeBlock = ^TMediumFreeBlock; + TMediumFreeBlock = record + PreviousFreeBlock: PMediumFreeBlock; + NextFreeBlock: PMediumFreeBlock; + end; + + {-------------------------Large block structures------------------------} + + {Large block header record (Size = 16 for 32-bit, 32 for 64-bit)} + PLargeBlockHeader = ^TLargeBlockHeader; + TLargeBlockHeader = record + {Points to the previous and next large blocks. This circular linked + list is used to track memory leaks on program shutdown.} + PreviousLargeBlockHeader: PLargeBlockHeader; + NextLargeBlockHeader: PLargeBlockHeader; + {The user allocated size of the Large block} + UserAllocatedSize: NativeUInt; + {The size of this block plus the flags} + BlockSizeAndFlags: NativeUInt; + end; + + {-------------------------Expected Memory Leak Structures--------------------} +{$ifdef EnableMemoryLeakReporting} + + {The layout of an expected leak. All fields may not be specified, in which + case it may be harder to determine which leaks are expected and which are + not.} + PExpectedMemoryLeak = ^TExpectedMemoryLeak; + PPExpectedMemoryLeak = ^PExpectedMemoryLeak; + TExpectedMemoryLeak = record + {Linked list pointers} + PreviousLeak, NextLeak: PExpectedMemoryLeak; + {Information about the expected leak} + LeakAddress: Pointer; + LeakedClass: TClass; + {$ifdef CheckCppObjectTypeEnabled} + LeakedCppTypeIdPtr: Pointer; + {$endif} + LeakSize: NativeInt; + LeakCount: Integer; + end; + + TExpectedMemoryLeaks = record + {The number of entries used in the expected leaks buffer} + EntriesUsed: Integer; + {Freed entries} + FirstFreeSlot: PExpectedMemoryLeak; + {Entries with the address specified} + FirstEntryByAddress: PExpectedMemoryLeak; + {Entries with no address specified, but with the class specified} + FirstEntryByClass: PExpectedMemoryLeak; + {Entries with only size specified} + FirstEntryBySizeOnly: PExpectedMemoryLeak; + {The expected leaks buffer (Need to leave space for this header)} + ExpectedLeaks: array[0..(ExpectedMemoryLeaksListSize - 64) div SizeOf(TExpectedMemoryLeak) - 1] of TExpectedMemoryLeak; + end; + PExpectedMemoryLeaks = ^TExpectedMemoryLeaks; + +{$endif} + +{-------------------------Private constants----------------------------} +const +{$ifndef BCB6OrDelphi7AndUp} + reOutOfMemory = 1; + reInvalidPtr = 2; +{$endif} + {The size of the block header in front of small and medium blocks} + BlockHeaderSize = SizeOf(Pointer); + {The size of a small block pool header} + SmallBlockPoolHeaderSize = SizeOf(TSmallBlockPoolHeader); + {The size of a medium block pool header} + MediumBlockPoolHeaderSize = SizeOf(TMediumBlockPoolHeader); + {The size of the header in front of Large blocks} + LargeBlockHeaderSize = SizeOf(TLargeBlockHeader); +{$ifdef FullDebugMode} + {We need space for the header, the trailer checksum and the trailing block + size (only used by freed medium blocks).} + FullDebugBlockOverhead = SizeOf(TFullDebugBlockHeader) + SizeOf(NativeUInt) + SizeOf(Pointer); +{$endif} + +{-------------------------Private variables----------------------------} +var + {-----------------Small block management------------------} + {The small block types. Sizes include the leading header. Sizes are + picked to limit maximum wastage to about 10% or 256 bytes (whichever is + less) where possible.} + SmallBlockTypes: array[0..NumSmallBlockTypes - 1] of TSmallBlockType =( + {8/16 byte jumps} +{$ifndef Align16Bytes} + (BlockSize: 8 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: Move4{$endif}), +{$endif} + (BlockSize: 16 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: {$ifdef 32Bit}Move12{$else}Move8{$endif}{$endif}), +{$ifndef Align16Bytes} + (BlockSize: 24 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: Move20{$endif}), +{$endif} + (BlockSize: 32 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: {$ifdef 32Bit}Move28{$else}Move24{$endif}{$endif}), +{$ifndef Align16Bytes} + (BlockSize: 40 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: Move36{$endif}), +{$endif} + (BlockSize: 48 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: {$ifdef 32Bit}Move44{$else}Move40{$endif}{$endif}), +{$ifndef Align16Bytes} + (BlockSize: 56 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: Move52{$endif}), +{$endif} + (BlockSize: 64 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: {$ifdef 32Bit}Move60{$else}Move56{$endif}{$endif}), +{$ifndef Align16Bytes} + (BlockSize: 72 {$ifdef UseCustomFixedSizeMoveRoutines}; UpsizeMoveProcedure: Move68{$endif}), +{$endif} + (BlockSize: 80), +{$ifndef Align16Bytes} + (BlockSize: 88), +{$endif} + (BlockSize: 96), +{$ifndef Align16Bytes} + (BlockSize: 104), +{$endif} + (BlockSize: 112), +{$ifndef Align16Bytes} + (BlockSize: 120), +{$endif} + (BlockSize: 128), +{$ifndef Align16Bytes} + (BlockSize: 136), +{$endif} + (BlockSize: 144), +{$ifndef Align16Bytes} + (BlockSize: 152), +{$endif} + (BlockSize: 160), + {16 byte jumps} + (BlockSize: 176), + (BlockSize: 192), + (BlockSize: 208), + (BlockSize: 224), + (BlockSize: 240), + (BlockSize: 256), + (BlockSize: 272), + (BlockSize: 288), + (BlockSize: 304), + (BlockSize: 320), + {32 byte jumps} + (BlockSize: 352), + (BlockSize: 384), + (BlockSize: 416), + (BlockSize: 448), + (BlockSize: 480), + {48 byte jumps} + (BlockSize: 528), + (BlockSize: 576), + (BlockSize: 624), + (BlockSize: 672), + {64 byte jumps} + (BlockSize: 736), + (BlockSize: 800), + {80 byte jumps} + (BlockSize: 880), + (BlockSize: 960), + {96 byte jumps} + (BlockSize: 1056), + (BlockSize: 1152), + {112 byte jumps} + (BlockSize: 1264), + (BlockSize: 1376), + {128 byte jumps} + (BlockSize: 1504), + {144 byte jumps} + (BlockSize: 1648), + {160 byte jumps} + (BlockSize: 1808), + {176 byte jumps} + (BlockSize: 1984), + {192 byte jumps} + (BlockSize: 2176), + {208 byte jumps} + (BlockSize: 2384), + {224 byte jumps} + (BlockSize: MaximumSmallBlockSize), + {The last block size occurs three times. If, during a GetMem call, the + requested block size is already locked by another thread then up to two + larger block sizes may be used instead. Having the last block size occur + three times avoids the need to have a size overflow check.} + (BlockSize: MaximumSmallBlockSize), + (BlockSize: MaximumSmallBlockSize)); + {Size to small block type translation table} + AllocSize2SmallBlockTypeIndX4: array[0..(MaximumSmallBlockSize - 1) div SmallBlockGranularity] of Byte; + {-----------------Medium block management------------------} + {A dummy medium block pool header: Maintains a circular list of all medium + block pools to enable memory leak detection on program shutdown.} + MediumBlockPoolsCircularList: TMediumBlockPoolHeader; + {Are medium blocks locked?} + MediumBlocksLocked: Boolean; + {The sequential feed medium block pool.} + LastSequentiallyFedMediumBlock: Pointer; + MediumSequentialFeedBytesLeft: Cardinal; + {The medium block bins are divided into groups of 32 bins. If a bit + is set in this group bitmap, then at least one bin in the group has free + blocks.} + MediumBlockBinGroupBitmap: Cardinal; + {The medium block bins: total of 32 * 32 = 1024 bins of a certain + minimum size.} + MediumBlockBinBitmaps: array[0..MediumBlockBinGroupCount - 1] of Cardinal; + {The medium block bins. There are 1024 LIFO circular linked lists each + holding blocks of a specified minimum size. The sizes vary in size from + MinimumMediumBlockSize to MaximumMediumBlockSize. The bins are treated as + type TMediumFreeBlock to avoid pointer checks.} + MediumBlockBins: array[0..MediumBlockBinCount - 1] of TMediumFreeBlock; + {-----------------Large block management------------------} + {Are large blocks locked?} + LargeBlocksLocked: Boolean; + {A dummy large block header: Maintains a list of all allocated large blocks + to enable memory leak detection on program shutdown.} + LargeBlocksCircularList: TLargeBlockHeader; + {-------------------------Expected Memory Leak Structures--------------------} +{$ifdef EnableMemoryLeakReporting} + {The expected memory leaks} + ExpectedMemoryLeaks: PExpectedMemoryLeaks; + ExpectedMemoryLeaksListLocked: Boolean; +{$endif} + {---------------------EventLog-------------------} +{$ifdef _EventLog} + {The current log file name} + MMLogFileName: array[0..1023] of AnsiChar; +{$endif} + {---------------------Full Debug Mode structures--------------------} +{$ifdef FullDebugMode} + {The allocation group stack} + AllocationGroupStack: array[0..AllocationGroupStackSize - 1] of Cardinal; + {The allocation group stack top (it is an index into AllocationGroupStack)} + AllocationGroupStackTop: Cardinal; + {The last allocation number used} + CurrentAllocationNumber: Cardinal; + {This is a count of the number of threads currently inside any of the + FullDebugMode GetMem, Freemem or ReallocMem handlers. If this value + is negative then a block scan is in progress and no thread may + allocate, free or reallocate any block or modify any FullDebugMode + block header or footer.} + ThreadsInFullDebugModeRoutine: Integer; + {The 64K block of reserved memory used to trap invalid memory accesses using + fields in a freed object.} + ReservedBlock: Pointer; + {The virtual method index count - used to get the virtual method index for a + virtual method call on a freed object.} + VMIndex: Integer; + {The fake VMT used to catch virtual method calls on freed objects.} + FreedObjectVMT: packed record + VMTData: array[vmtSelfPtr .. vmtParent + SizeOf(Pointer) - 1] of byte; + VMTMethods: array[SizeOf(Pointer) + vmtParent .. vmtParent + MaxFakeVMTEntries * SizeOf(Pointer) + SizeOf(Pointer) - 1] of Byte; + end; + {$ifdef CatchUseOfFreedInterfaces} + VMTBadInterface: array[0..MaxFakeVMTEntries - 1] of Pointer; + {$endif} +{$endif} + + {---------------------Lock contention logging--------------------} +{$ifdef LogLockContention} + MediumBlockCollector: TStaticCollector; + LargeBlockCollector: TStaticCollector; +{$endif} + + {---------------------Release stack------------------------} +{$ifdef UseReleaseStack} + MediumReleaseStack: array [0..NumStacksPerBlock - 1] of TLFStack; + LargeReleaseStack: array [0..NumStacksPerBlock - 1] of TLFStack; + ReleaseStackCleanupThread: THandle = 0; + ReleaseStackCleanupThreadTerminate: THandle = 0; +{$endif} + + {--------------Other info--------------} + {The memory manager that was replaced} + OldMemoryManager: {$ifndef BDS2006AndUp}TMemoryManager{$else}TMemoryManagerEx{$endif}; + {The replacement memory manager} + NewMemoryManager: {$ifndef BDS2006AndUp}TMemoryManager{$else}TMemoryManagerEx{$endif}; +{$ifdef DetectMMOperationsAfterUninstall} + {Invalid handlers to catch MM operations after uninstall} + InvalidMemoryManager: {$ifndef BDS2006AndUp}TMemoryManager{$else}TMemoryManagerEx{$endif} = ( + GetMem: InvalidGetMem; + FreeMem: InvalidFreeMem; + ReallocMem: InvalidReallocMem + {$ifdef BDS2006AndUp}; + AllocMem: InvalidAllocMem; + RegisterExpectedMemoryLeak: InvalidRegisterAndUnRegisterMemoryLeak; + UnRegisterExpectedMemoryLeak: InvalidRegisterAndUnRegisterMemoryLeak; + {$endif} + ); +{$endif} + +{$ifdef MMSharingEnabled} + {A string uniquely identifying the current process (for sharing the memory + manager between DLLs and the main application)} + MappingObjectName: array[0..25] of AnsiChar = ('L', 'o', 'c', 'a', 'l', '\', + 'F', 'a', 's', 't', 'M', 'M', '_', 'P', 'I', 'D', '_', '?', '?', '?', '?', + '?', '?', '?', '?', #0); +{$ifdef EnableBackwardCompatibleMMSharing} + UniqueProcessIDString: array[1..20] of AnsiChar = ('?', '?', '?', '?', '?', + '?', '?', '?', '_', 'P', 'I', 'D', '_', 'F', 'a', 's', 't', 'M', 'M', #0); + UniqueProcessIDStringBE: array[1..23] of AnsiChar = ('?', '?', '?', '?', '?', + '?', '?', '?', '_', 'P', 'I', 'D', '_', 'F', 'a', 's', 't', 'M', 'M', '_', + 'B', 'E', #0); + {The handle of the MM window} + MMWindow: HWND; + {The handle of the MM window (for default MM of Delphi 2006 compatibility)} + MMWindowBE: HWND; +{$endif} + {The handle of the memory mapped file} + MappingObjectHandle: NativeUInt; +{$endif} + {Has FastMM been installed?} + FastMMIsInstalled: Boolean; + {Is the MM in place a shared memory manager?} + IsMemoryManagerOwner: Boolean; + {Must MMX be used for move operations?} +{$ifdef EnableMMX} + {$ifndef ForceMMX} + UseMMX: Boolean; + {$endif} +{$endif} + {Is a MessageBox currently showing? If so, do not show another one.} + ShowingMessageBox: Boolean; + {True if RunInitializationCode has been called already.} + InitializationCodeHasRun: Boolean = False; + +{----------------Utility Functions------------------} + +{A copy of StrLen in order to avoid the SysUtils unit, which would have + introduced overhead like exception handling code.} +function StrLen(const AStr: PAnsiChar): NativeUInt; +{$ifndef Use32BitAsm} +begin + Result := 0; + while AStr[Result] <> #0 do + Inc(Result); +end; +{$else} +asm + {Check the first byte} + cmp byte ptr [eax], 0 + je @ZeroLength + {Get the negative of the string start in edx} + mov edx, eax + neg edx + {Word align} + add eax, 1 + and eax, -2 +@ScanLoop: + mov cx, [eax] + add eax, 2 + test cl, ch + jnz @ScanLoop + test cl, cl + jz @ReturnLess2 + test ch, ch + jnz @ScanLoop + lea eax, [eax + edx - 1] + ret +@ReturnLess2: + lea eax, [eax + edx - 2] + ret +@ZeroLength: + xor eax, eax +end; +{$endif} + +{$ifdef EnableMMX} +{$ifndef ForceMMX} +{Returns true if the CPUID instruction is supported} +function CPUID_Supported: Boolean; +asm + pushfd + pop eax + mov edx, eax + xor eax, $200000 + push eax + popfd + pushfd + pop eax + xor eax, edx + setnz al +end; + +{Gets the CPUID} +function GetCPUID(AInfoRequired: Integer): TRegisters; +asm + push ebx + push esi + mov esi, edx + {cpuid instruction} +{$ifdef Delphi4or5} + db $0f, $a2 +{$else} + cpuid +{$endif} + {Save registers} + mov TRegisters[esi].RegEAX, eax + mov TRegisters[esi].RegEBX, ebx + mov TRegisters[esi].RegECX, ecx + mov TRegisters[esi].RegEDX, edx + pop esi + pop ebx +end; + +{Returns true if the CPU supports MMX} +function MMX_Supported: Boolean; +var + LReg: TRegisters; +begin + if CPUID_Supported then + begin + {Get the CPUID} + LReg := GetCPUID(1); + {Bit 23 must be set for MMX support} + Result := LReg.RegEDX and $800000 <> 0; + end + else + Result := False; +end; +{$endif} +{$endif} + +{Compare [AAddress], CompareVal: + If Equal: [AAddress] := NewVal and result = CompareVal + If Unequal: Result := [AAddress]} +function LockCmpxchg(CompareVal, NewVal: Byte; AAddress: PByte): Byte; {$ifdef fpc64bit}nostackframe;{$endif} +asm +{$ifdef 32Bit} + {On entry: + al = CompareVal, + dl = NewVal, + ecx = AAddress} + {$ifndef LINUX} + lock cmpxchg [ecx], dl + {$else} + {Workaround for Kylix compiler bug} + db $F0, $0F, $B0, $11 + {$endif} +{$else} + {On entry: + cl = CompareVal + dl = NewVal + r8 = AAddress} + {$ifndef unix} + .noframe + mov rax, rcx + lock cmpxchg [r8], dl + {$else} + mov rax, rdi + lock cmpxchg [rdx], sil + {$endif} +{$endif} +end; + +{$ifndef ASMVersion} +{Gets the first set bit in the 32-bit number, returning the bit index} +function FindFirstSetBit(ACardinal: Cardinal): Cardinal; {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 64Bit} + {$ifndef unix} + .noframe + mov rax, rcx + {$else} + mov rax, rdi + {$endif} +{$endif} + bsf eax, eax +end; +{$endif} + +{$ifdef MACOS_OR_KYLIX} + +function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; +var + Len: Cardinal; +begin + Result := Dest; + Len := StrLen(Source); + if Len > MaxLen then + Len := MaxLen; + Move(Source^, Dest^, Len * SizeOf(AnsiChar)); + Dest[Len] := #0; +end; + +function GetModuleFileName(Module: HMODULE; Buffer: PAnsiChar; BufLen: Integer): Integer; +const + CUnknown: AnsiString = 'unknown'; +var + tmp: array[0..512] of Char; +begin + if FastMMIsInstalled then + begin + Result := System.GetModuleFileName(Module, tmp, BufLen); + StrLCopy(Buffer, PAnsiChar(AnsiString(tmp)), BufLen); + end + else + begin + Result := Length(CUnknown); + StrLCopy(Buffer, PAnsiChar(CUnknown), Result + 1); + end; +end; + +const + INVALID_HANDLE_VALUE = THandle(-1); + +function FileCreate(const FileName: string): THandle; +begin + Result := THandle({$ifdef MACOS}__open{$else}open{$endif}( + PAnsiChar(UTF8String(FileName)), O_RDWR or O_CREAT or O_TRUNC or O_EXCL, FileAccessRights)); +end; + +{$endif} + +{$ifdef FPC} +function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; +var + Len: Cardinal; +begin + Result := Dest; + Len := StrLen(Source); + if Len > MaxLen then + Len := MaxLen; + Move(Source^, Dest^, Len * SizeOf(AnsiChar)); + Dest[Len] := #0; +end; + +function GetModuleFileName(Module: HMODULE; Buffer: PAnsiChar; BufLen: Integer): Integer; +const + CUnknown: AnsiString = 'unknown'; +var + tmp: array[0..512] of Char; +begin + Result := Length(CUnknown); + StrLCopy(Buffer, PAnsiChar(CUnknown), Result + 1); +end; + +const + INVALID_HANDLE_VALUE = THandle(-1); + FileAcc = (S_IRUSR or S_IWUSR or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH); + +function FileCreate(const FileName: string): THandle; +begin + Result := THandle(fpopen(PAnsiChar(UTF8String(FileName)), O_RDWR or O_CREAT or O_TRUNC or O_EXCL, FileAcc)); +end; +{$endif} + +{Writes the module filename to the specified buffer and returns the number of + characters written.} +function AppendModuleFileName(ABuffer: PAnsiChar): Integer; +var + LModuleHandle: HModule; +begin + {Get the module handle} +{$ifndef borlndmmdll} + if IsLibrary then + LModuleHandle := HInstance + else +{$endif} + LModuleHandle := 0; + {Get the module name} +{$ifndef POSIX} + Result := GetModuleFileNameA(LModuleHandle, ABuffer, 512); +{$else} + Result := GetModuleFileName(LModuleHandle, ABuffer, 512); +{$endif} +end; + +{Copies the name of the module followed by the given string to the buffer, + returning the pointer following the buffer.} +function AppendStringToModuleName(AString, ABuffer: PAnsiChar): PAnsiChar; +var + LModuleNameLength: Cardinal; + LCopyStart: PAnsiChar; +begin + {Get the name of the application} + LModuleNameLength := AppendModuleFileName(ABuffer); + {Replace the last few characters} + if LModuleNameLength > 0 then + begin + {Find the last backslash} + LCopyStart := PAnsiChar(PByte(ABuffer) + LModuleNameLength - 1); + LModuleNameLength := 0; + while (UIntPtr(LCopyStart) >= UIntPtr(ABuffer)) + and (LCopyStart^ <> '\') do + begin + Inc(LModuleNameLength); + Dec(LCopyStart); + end; + {Copy the name to the start of the buffer} + Inc(LCopyStart); + System.Move(LCopyStart^, ABuffer^, LModuleNameLength); + Inc(ABuffer, LModuleNameLength); + ABuffer^ := ':'; + Inc(ABuffer); + ABuffer^ := ' '; + Inc(ABuffer); + end; + {Append the string} + while AString^ <> #0 do + begin + ABuffer^ := AString^; + Inc(ABuffer); + {Next char} + Inc(AString); + end; + ABuffer^ := #0; + Result := ABuffer; +end; + +{----------------Faster Move Procedures-------------------} + +{Fixed size move operations ignore the size parameter. All moves are assumed to + be non-overlapping.} + +procedure Move4(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + mov eax, [eax] + mov [edx], eax +{$else} + {$ifndef unix} +.noframe + mov eax, [rcx] + mov [rdx], eax + {$else} + mov eax, [rdi] + mov [rsi], eax + {$endif} +{$endif} +end; + +{$ifdef 64Bit} +procedure Move8(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifndef unix} +.noframe + mov rax, [rcx] + mov [rdx], rax +{$else} + mov rax, [rdi] + mov [rsi], rax +{$endif} +end; +{$endif} + +procedure Move12(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + mov ecx, [eax] + mov [edx], ecx + mov ecx, [eax + 4] + mov eax, [eax + 8] + mov [edx + 4], ecx + mov [edx + 8], eax +{$else} + {$ifndef unix} +.noframe + mov rax, [rcx] + mov ecx, [rcx + 8] + mov [rdx], rax + mov [rdx + 8], ecx + {$else} + mov rax, [rdi] + mov edi, [rdi + 8] + mov [rsi], rax + mov [rsi + 8], edi + {$endif} +{$endif} +end; + +procedure Move20(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + mov ecx, [eax] + mov [edx], ecx + mov ecx, [eax + 4] + mov [edx + 4], ecx + mov ecx, [eax + 8] + mov [edx + 8], ecx + mov ecx, [eax + 12] + mov eax, [eax + 16] + mov [edx + 12], ecx + mov [edx + 16], eax +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + mov ecx, [rcx + 16] + movdqa [rdx], xmm0 + mov [rdx + 16], ecx + {$else} + movdqa xmm0, [rdi] + mov edi, [rdi + 16] + movdqa [rsi], xmm0 + mov [rsi + 16], edi + {$endif} +{$endif} +end; + +{$ifdef 64Bit} +procedure Move24(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + mov r8, [rcx + 16] + movdqa [rdx], xmm0 + mov [rdx + 16], r8 + {$else} + movdqa xmm0, [rdi] + mov rdx, [rdi + 16] + movdqa [rsi], xmm0 + mov [rsi + 16], rdx + {$endif} +end; +{$endif} + +procedure Move28(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + mov ecx, [eax] + mov [edx], ecx + mov ecx, [eax + 4] + mov [edx + 4], ecx + mov ecx, [eax + 8] + mov [edx + 8], ecx + mov ecx, [eax + 12] + mov [edx + 12], ecx + mov ecx, [eax + 16] + mov [edx + 16], ecx + mov ecx, [eax + 20] + mov eax, [eax + 24] + mov [edx + 20], ecx + mov [edx + 24], eax +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + mov r8, [rcx + 16] + mov ecx, [rcx + 24] + movdqa [rdx], xmm0 + mov [rdx + 16], r8 + mov [rdx + 24], ecx + {$else} + movdqa xmm0, [rdi] + mov rdx, [rdi + 16] + mov edi, [rdi + 24] + movdqa [rsi], xmm0 + mov [rsi + 16], rdx + mov [rsi + 24], edi + {$endif} +{$endif} +end; + +procedure Move36(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + mov ecx, [eax + 32] + mov [edx + 32], ecx + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + mov ecx, [rcx + 32] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + mov [rdx + 32], ecx + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + mov edi, [rdi + 32] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + mov [rsi + 32], edi + {$endif} +{$endif} +end; + +{$ifdef 64Bit} +procedure Move40(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + mov r8, [rcx + 32] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + mov [rdx + 32], r8 + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + mov rdx, [rdi + 32] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + mov [rsi + 32], rdx + {$endif} +end; +{$endif} + +procedure Move44(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + mov ecx, [eax + 40] + mov [edx + 40], ecx + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + mov r8, [rcx + 32] + mov ecx, [rcx + 40] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + mov [rdx + 32], r8 + mov [rdx + 40], ecx + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + mov rdx, [rdi + 32] + mov edi, [rdi + 40] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + mov [rsi + 32], rdx + mov [rsi + 40], edi + {$endif} +{$endif} +end; + +procedure Move52(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + mov ecx, [eax + 48] + mov [edx + 48], ecx + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + mov ecx, [rcx + 48] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 + mov [rdx + 48], ecx + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + movdqa xmm2, [rdi + 32] + mov edi, [rdi + 48] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + movdqa [rsi + 32], xmm2 + mov [rsi + 48], edi + {$endif} +{$endif} +end; + +{$ifdef 64Bit} +procedure Move56(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + mov r8, [rcx + 48] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 + mov [rdx + 48], r8 + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + movdqa xmm2, [rdi + 32] + mov rdx, [rdi + 48] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + movdqa [rsi + 32], xmm2 + mov [rsi + 48], rdx + {$endif} +end; +{$endif} + +procedure Move60(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + fild qword ptr [eax + 48] + mov ecx, [eax + 56] + mov [edx + 56], ecx + fistp qword ptr [edx + 48] + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + mov r8, [rcx + 48] + mov ecx, [rcx + 56] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 + mov [rdx + 48], r8 + mov [rdx + 56], ecx + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + movdqa xmm2, [rdi + 32] + mov rdx, [rdi + 48] + mov edi, [rdi + 56] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + movdqa [rsi + 32], xmm2 + mov [rsi + 48], rdx + mov [rsi + 56], edi + {$endif} +{$endif} +end; + +procedure Move68(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + fild qword ptr [eax + 48] + fild qword ptr [eax + 56] + mov ecx, [eax + 64] + mov [edx + 64], ecx + fistp qword ptr [edx + 56] + fistp qword ptr [edx + 48] + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + {$ifndef unix} +.noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + movdqa xmm3, [rcx + 48] + mov ecx, [rcx + 64] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 + movdqa [rdx + 48], xmm3 + mov [rdx + 64], ecx + {$else} + movdqa xmm0, [rdi] + movdqa xmm1, [rdi + 16] + movdqa xmm2, [rdi + 32] + movdqa xmm3, [rdi + 48] + mov edi, [rdi + 64] + movdqa [rsi], xmm0 + movdqa [rsi + 16], xmm1 + movdqa [rsi + 32], xmm2 + movdqa [rsi + 48], xmm3 + mov [rsi + 64], edi + {$endif} +{$endif} +end; + +{Variable size move procedure: Rounds ACount up to the next multiple of 16 less + SizeOf(Pointer). Important note: Always moves at least 16 - SizeOf(Pointer) + bytes (the minimum small block size with 16 byte alignment), irrespective of + ACount.} +procedure MoveX16LP(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + {Make the counter negative based: The last 12 bytes are moved separately} + sub ecx, 12 + add eax, ecx + add edx, ecx +{$ifdef EnableMMX} + {$ifndef ForceMMX} + cmp UseMMX, True + jne @FPUMove + {$endif} + {Make the counter negative based: The last 12 bytes are moved separately} + neg ecx + jns @MMXMoveLast12 +@MMXMoveLoop: + {Move a 16 byte block} + {$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $6f, $04, $01 + db $0f, $6f, $4c, $01, $08 + db $0f, $7f, $04, $11 + db $0f, $7f, $4c, $11, $08 + {$else} + movq mm0, [eax + ecx] + movq mm1, [eax + ecx + 8] + movq [edx + ecx], mm0 + movq [edx + ecx + 8], mm1 + {$endif} + {Are there another 16 bytes to move?} + add ecx, 16 + js @MMXMoveLoop +@MMXMoveLast12: + {Do the last 12 bytes} + {$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $6f, $04, $01 + {$else} + movq mm0, [eax + ecx] + {$endif} + mov eax, [eax + ecx + 8] + {$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $7f, $04, $11 + {$else} + movq [edx + ecx], mm0 + {$endif} + mov [edx + ecx + 8], eax + {Exit MMX state} + {$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $77 + {$else} + emms + {$endif} + {$ifndef ForceMMX} + ret + {$endif} +{$endif} +{FPU code is only used if MMX is not forced} +{$ifndef ForceMMX} +@FPUMove: + neg ecx + jns @FPUMoveLast12 +@FPUMoveLoop: + {Move a 16 byte block} + fild qword ptr [eax + ecx] + fild qword ptr [eax + ecx + 8] + fistp qword ptr [edx + ecx + 8] + fistp qword ptr [edx + ecx] + {Are there another 16 bytes to move?} + add ecx, 16 + js @FPUMoveLoop +@FPUMoveLast12: + {Do the last 12 bytes} + fild qword ptr [eax + ecx] + fistp qword ptr [edx + ecx] + mov eax, [eax + ecx + 8] + mov [edx + ecx + 8], eax +{$endif} +{$else} + {$ifndef unix} +.noframe + {Make the counter negative based: The last 8 bytes are moved separately} + sub r8, 8 + add rcx, r8 + add rdx, r8 + neg r8 + jns @MoveLast12 +@MoveLoop: + {Move a 16 byte block} + movdqa xmm0, [rcx + r8] + movdqa [rdx + r8], xmm0 + {Are there another 16 bytes to move?} + add r8, 16 + js @MoveLoop +@MoveLast12: + {Do the last 8 bytes} + mov r9, [rcx + r8] + mov [rdx + r8], r9 + {$else} + {Make the counter negative based: The last 8 bytes are moved separately} + sub rdx, 8 + add rdi, rdx + add rsi, rdx + neg rdx + jns @MoveLast12 +@MoveLoop: + {Move a 16 byte block} + movdqa xmm0, [rdi + rdx] + movdqa [rsi + rdx], xmm0 + {Are there another 16 bytes to move?} + add rdx, 16 + js @MoveLoop +@MoveLast12: + {Do the last 8 bytes} + mov rcx, [rdi + rdx] + mov [rsi + rdx], rcx + {$endif} +{$endif} +end; + +{Variable size move procedure: Rounds ACount up to the next multiple of 8 less + SizeOf(Pointer). Important note: Always moves at least 8 - SizeOf(Pointer) + bytes (the minimum small block size with 8 byte alignment), irrespective of + ACount.} +procedure MoveX8LP(const ASource; var ADest; ACount: NativeInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + {Make the counter negative based: The last 4 bytes are moved separately} + sub ecx, 4 + {4 bytes or less? -> Use the Move4 routine.} + jle @FourBytesOrLess + add eax, ecx + add edx, ecx + neg ecx +{$ifdef EnableMMX} + {$ifndef ForceMMX} + cmp UseMMX, True + jne @FPUMoveLoop + {$endif} +@MMXMoveLoop: + {Move an 8 byte block} +{$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $6f, $04, $01 + db $0f, $7f, $04, $11 +{$else} + movq mm0, [eax + ecx] + movq [edx + ecx], mm0 +{$endif} + {Are there another 8 bytes to move?} + add ecx, 8 + js @MMXMoveLoop + {Exit MMX state} +{$ifdef Delphi4or5} + {Delphi 5 compatibility} + db $0f, $77 +{$else} + emms +{$endif} + {Do the last 4 bytes} + mov eax, [eax + ecx] + mov [edx + ecx], eax + ret +{$endif} +{FPU code is only used if MMX is not forced} +{$ifndef ForceMMX} +@FPUMoveLoop: + {Move an 8 byte block} + fild qword ptr [eax + ecx] + fistp qword ptr [edx + ecx] + {Are there another 8 bytes to move?} + add ecx, 8 + js @FPUMoveLoop + {Do the last 4 bytes} + mov eax, [eax + ecx] + mov [edx + ecx], eax + ret +{$endif} +@FourBytesOrLess: + {Four or less bytes to move} + mov eax, [eax] + mov [edx], eax +{$else} + {$ifndef unix} +.noframe + {Make the counter negative based} + add rcx, r8 + add rdx, r8 + neg r8 +@MoveLoop: + {Move an 8 byte block} + mov r9, [rcx + r8] + mov [rdx + r8], r9 + {Are there another 8 bytes to move?} + add r8, 8 + js @MoveLoop + {$else} + {Make the counter negative based} + add rdi, rdx + add rsi, rdx + neg rdx +@MoveLoop: + {Move an 8 byte block} + mov rcx, [rdi + rdx] + mov [rsi + rdx], rcx + {Are there another 8 bytes to move?} + add rdx, 8 + js @MoveLoop + {$Endif} +{$endif} +end; + +{----------------Windows Emulation Functions for Kylix / OS X Support-----------------} + +{$ifdef POSIX} + +const + {Messagebox constants} + MB_OK = 0; + MB_ICONERROR = $10; + MB_TASKMODAL = $2000; + MB_DEFAULT_DESKTOP_ONLY = $20000; + {Virtual memory constants} + MEM_COMMIT = $1000; + MEM_RELEASE = $8000; + MEM_TOP_DOWN = $100000; + PAGE_READWRITE = 4; + +procedure MessageBoxA(hWnd: Cardinal; AMessageText, AMessageTitle: PAnsiChar; uType: Cardinal); stdcall; +begin + if FastMMIsInstalled then + writeln(AMessageText) + else + {$ifndef fpc} + __write(STDERR_FILENO, AMessageText, StrLen(AMessageText)); + {$else} + FpWrite(StdErrorHandle, AMessageText, StrLen(AMessageText)); + {$endif} +end; + +{$IFNDEF MACOS} +function VirtualAlloc(lpvAddress: Pointer; dwSize, flAllocationType, flProtect: Cardinal): Pointer; stdcall; +begin + Result := valloc(dwSize); +end; + +function VirtualFree(lpAddress: Pointer; dwSize, dwFreeType: Cardinal): LongBool; stdcall; +begin + free(lpAddress); + Result := True; +end; +{$ENDIF} + +function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: Cardinal; + var lpNumberOfBytesWritten: Cardinal; lpOverlapped: Pointer): Boolean; stdcall; +begin + {$ifndef fpc} + lpNumberOfBytesWritten := __write(hFile, {$ifdef MACOS}@Buffer{$else}Buffer{$endif}, + nNumberOfBytesToWrite); + {$else} + lpNumberOfBytesWritten := fpwrite(hFile, Buffer, nNumberOfBytesToWrite); + {$endif} + if lpNumberOfBytesWritten = Cardinal(-1) then + begin + lpNumberOfBytesWritten := 0; + Result := False; + end + else + Result := True; +end; + +{$ifndef NeverSleepOnThreadContention} +procedure Sleep(dwMilliseconds: Cardinal); stdcall; +begin + {Convert to microseconds (more or less)} + usleep(dwMilliseconds shl 10); +end; +{$endif} +{$endif} + +{-----------------Debugging Support Functions and Procedures------------------} + +{$ifdef FullDebugMode} + +{Returns the current thread ID} +function GetThreadID: Cardinal; +{$ifdef WIN32} +asm + mov eax, FS:[$24] +end; +{$else} +begin + Result := GetCurrentThreadId; +end; +{$endif} + +{Fills a block of memory with the given dword (32-bit) or qword (64-bit). + Always fills a multiple of SizeOf(Pointer) bytes} +procedure DebugFillMem(var AAddress; AByteCount: NativeInt; AFillValue: NativeUInt); {$ifdef fpc64bit} nostackframe; {$endif} +asm +{$ifdef 32Bit} + {On Entry: + eax = AAddress + edx = AByteCount + ecx = AFillValue} + add eax, edx + neg edx + jns @Done +@FillLoop: + mov [eax + edx], ecx + add edx, 4 + js @FillLoop +@Done: +{$else} + {$ifndef unix} +.noframe + {On Entry: + rcx = AAddress + rdx = AByteCount + r8 = AFillValue} + add rcx, rdx + neg rdx + jns @Done +@FillLoop: + mov [rcx + rdx], r8 + add rdx, 8 + js @FillLoop +@Done: + {$else} + {On Entry: + rdi = AAddress + rsi = AByteCount + rdx = AFillValue} + add rdi, rsi + neg rsi + jns @Done +@FillLoop: + mov [rdi + rsi], rdx + add rsi, 8 + js @FillLoop +@Done: + {$endif} +{$endif} +end; +{$endif} + +{$ifdef _StackTracer} +{------------------------Stack tracer---------------------------} + + {$ifndef LoadDebugDLLDynamically} + +{The stack trace procedure. The stack trace module is external since it may + raise handled access violations that result in the creation of exception + objects and the stack trace code is not re-entrant.} +procedure GetStackTrace(AReturnAddresses: PNativeUInt; + AMaxDepth, ASkipFrames: Cardinal); external FullDebugModeLibraryName + name {$ifdef RawStackTraces}'GetRawStackTrace'{$else}'GetFrameBasedStackTrace'{$endif}; + +{The exported procedure in the FastMM_FullDebugMode.dll library used to convert + the return addresses of a stack trace to a text string.} +function LogStackTrace(AReturnAddresses: PNativeUInt; + AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; external FullDebugModeLibraryName + name 'LogStackTrace'; + + {$else} + + {Default no-op stack trace and logging handlers} + procedure NoOpGetStackTrace(AReturnAddresses: PNativeUInt; + AMaxDepth, ASkipFrames: Cardinal); + begin + DebugFillMem(AReturnAddresses^, AMaxDepth * SizeOf(Pointer), 0); + end; + + function NoOpLogStackTrace(AReturnAddresses: PNativeUInt; + AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; + begin + Result := ABuffer; + end; + +var + + {Handle to the FullDebugMode DLL} + FullDebugModeDLL: HMODULE; + + GetStackTrace: procedure (AReturnAddresses: PNativeUInt; + AMaxDepth, ASkipFrames: Cardinal) = NoOpGetStackTrace; + + LogStackTrace: function (AReturnAddresses: PNativeUInt; + AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar = NoOpLogStackTrace; + + {$endif} + +{$endif} + +{$ifdef UseReleaseStack } +function GetStackSlot: DWORD; +begin +// http://burtleburtle.net/bob/hash/integer.html + Result := GetCurrentThreadID; + Result := (Result xor 61) xor (Result shr 16); + Result := Result + (Result shl 3); + Result := Result xor (Result shr 4); + Result := Result * $27d4eb2d; + Result := Result xor (Result shr 15); + Result := Result and (NumStacksPerBlock - 1); +end; +{$endif} + +{$ifndef POSIX} +function DelphiIsRunning: Boolean; +begin + Result := FindWindowA('TAppBuilder', nil) <> 0; +end; +{$endif} + +{Converts an unsigned integer to string at the buffer location, returning the + new buffer position. Note: The 32-bit asm version only supports numbers up to + 2^31 - 1.} +function NativeUIntToStrBuf(ANum: NativeUInt; APBuffer: PAnsiChar): PAnsiChar; +{$ifndef Use32BitAsm} +const + MaxDigits = 20; +var + LDigitBuffer: array[0..MaxDigits - 1] of AnsiChar; + LCount: Cardinal; + LDigit: NativeUInt; +begin + {Generate the digits in the local buffer} + LCount := 0; + repeat + LDigit := ANum; + ANum := ANum div 10; + LDigit := LDigit - ANum * 10; + Inc(LCount); + LDigitBuffer[MaxDigits - LCount] := AnsiChar(Ord('0') + LDigit); + until ANum = 0; + {Copy the digits to the output buffer and advance it} + System.Move(LDigitBuffer[MaxDigits - LCount], APBuffer^, LCount); + Result := APBuffer + LCount; +end; +{$else} +asm + {On entry: eax = ANum, edx = ABuffer} + push edi + mov edi, edx //Pointer to the first character in edi + {Calculate leading digit: divide the number by 1e9} + add eax, 1 //Increment the number + mov edx, $89705F41 //1e9 reciprocal + mul edx //Multplying with reciprocal + shr eax, 30 //Save fraction bits + mov ecx, edx //First digit in bits <31:29> + and edx, $1FFFFFFF //Filter fraction part edx<28:0> + shr ecx, 29 //Get leading digit into accumulator + lea edx, [edx + 4 * edx] //Calculate ... + add edx, eax //... 5*fraction + mov eax, ecx //Copy leading digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #2} + mov eax, edx //Point format such that 1.0 = 2^28 + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 28 //Next digit + and edx, $0fffffff //Fraction part edx<27:0> + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #3} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:27> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<26:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 27 //Next digit + and edx, $07ffffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #4} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:26> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<25:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 26 //Next digit + and edx, $03ffffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #5} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:25> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<24:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 25 //Next digit + and edx, $01ffffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #6} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:24> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<23:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 24 //Next digit + and edx, $00ffffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #7} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:23> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<31:23> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 23 //Next digit + and edx, $007fffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #8} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:22> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<22:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 22 //Next digit + and edx, $003fffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #9} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:21> + lea edx, [edx * 4 + edx] //5*fraction, new fraction edx<21:0> + cmp ecx, 1 //Any non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 21 //Next digit + and edx, $001fffff //Fraction part + or ecx, eax //Accumulate next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store digit out to memory + {Calculate digit #10} + lea eax, [edx * 4 + edx] //5*fraction, new digit eax<31:20> + cmp ecx, 1 //Any-non-zero digit yet ? + sbb edi, -1 //Yes->increment ptr, No->keep old ptr + shr eax, 20 //Next digit + or eax, '0' //Convert digit to ASCII + mov [edi], al //Store last digit and end marker out to memory + {Return a pointer to the next character} + lea eax, [edi + 1] + {Restore edi} + pop edi +end; +{$endif} + +{Converts an unsigned integer to a hexadecimal string at the buffer location, + returning the new buffer position.} +function NativeUIntToHexBuf(ANum: NativeUInt; APBuffer: PAnsiChar): PAnsiChar; +{$ifndef Use32BitAsm} +const + MaxDigits = 16; +var + LDigitBuffer: array[0..MaxDigits - 1] of AnsiChar; + LCount: Cardinal; + LDigit: NativeUInt; +begin + {Generate the digits in the local buffer} + LCount := 0; + repeat + LDigit := ANum; + ANum := ANum div 16; + LDigit := LDigit - ANum * 16; + Inc(LCount); + LDigitBuffer[MaxDigits - LCount] := HexTable[LDigit]; + until ANum = 0; + {Copy the digits to the output buffer and advance it} + System.Move(LDigitBuffer[MaxDigits - LCount], APBuffer^, LCount); + Result := APBuffer + LCount; +end; +{$else} +asm + {On entry: + eax = ANum + edx = ABuffer} + push ebx + push edi + {Save ANum in ebx} + mov ebx, eax + {Get a pointer to the first character in edi} + mov edi, edx + {Get the number in ecx as well} + mov ecx, eax + {Keep the low nibbles in ebx and the high nibbles in ecx} + and ebx, $0f0f0f0f + and ecx, $f0f0f0f0 + {Swap the bytes into the right order} + ror ebx, 16 + ror ecx, 20 + {Get nibble 7} + movzx eax, ch + mov dl, ch + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 6} + movzx eax, bh + or dl, bh + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 5} + movzx eax, cl + or dl, cl + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 4} + movzx eax, bl + or dl, bl + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Rotate ecx and ebx so we get access to the rest} + shr ebx, 16 + shr ecx, 16 + {Get nibble 3} + movzx eax, ch + or dl, ch + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 2} + movzx eax, bh + or dl, bh + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 1} + movzx eax, cl + or dl, cl + mov al, byte ptr HexTable[eax] + mov [edi], al + cmp dl, 1 + sbb edi, -1 + {Get nibble 0} + movzx eax, bl + mov al, byte ptr HexTable[eax] + mov [edi], al + {Return a pointer to the end of the string} + lea eax, [edi + 1] + {Restore registers} + pop edi + pop ebx +end; +{$endif} + +{Appends the source text to the destination and returns the new destination + position} +function AppendStringToBuffer(const ASource, ADestination: PAnsiChar; ACount: Cardinal): PAnsiChar; +begin + System.Move(ASource^, ADestination^, ACount); + Result := Pointer(PByte(ADestination) + ACount); +end; + +{Appends the name of the class to the destination buffer and returns the new + destination position} +function AppendClassNameToBuffer(AClass: TClass; ADestination: PAnsiChar): PAnsiChar; +var + LPClassName: PShortString; +begin + {Get a pointer to the class name} + if AClass <> nil then + begin + LPClassName := PShortString(PPointer(PByte(AClass) + vmtClassName)^); + {Append the class name} + Result := AppendStringToBuffer(@LPClassName^[1], ADestination, Length(LPClassName^)); + end + else + begin + Result := AppendStringToBuffer(UnknownClassNameMsg, ADestination, Length(UnknownClassNameMsg)); + end; +end; + +{Shows a message box if the program is not showing one already.} +procedure ShowMessageBox(AText, ACaption: PAnsiChar); +begin + if (not ShowingMessageBox) and (not SuppressMessageBoxes) then + begin + ShowingMessageBox := True; + MessageBoxA(0, AText, ACaption, + MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_DEFAULT_DESKTOP_ONLY); + ShowingMessageBox := False; + end; +end; + +{Returns the class for a memory block. Returns nil if it is not a valid class} +function DetectClassInstance(APointer: Pointer): TClass; +{$ifndef POSIX} +var + LMemInfo: TMemoryBasicInformation; + + {Checks whether the given address is a valid address for a VMT entry.} + function IsValidVMTAddress(APAddress: Pointer): Boolean; + begin + {Do some basic pointer checks: Must be dword aligned and beyond 64K} + if (UIntPtr(APAddress) > 65535) + and (UIntPtr(APAddress) and 3 = 0) then + begin + {Do we need to recheck the virtual memory?} + if (UIntPtr(LMemInfo.BaseAddress) > UIntPtr(APAddress)) + or ((UIntPtr(LMemInfo.BaseAddress) + LMemInfo.RegionSize) < (UIntPtr(APAddress) + 4)) then + begin + {Get the VM status for the pointer} + LMemInfo.RegionSize := 0; + VirtualQuery(APAddress, LMemInfo, SizeOf(LMemInfo)); + end; + {Check the readability of the memory address} + Result := (LMemInfo.RegionSize >= 4) + and (LMemInfo.State = MEM_COMMIT) + and (LMemInfo.Protect and (PAGE_READONLY or PAGE_READWRITE or PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0) + and (LMemInfo.Protect and PAGE_GUARD = 0); + end + else + Result := False; + end; + + {Returns true if AClassPointer points to a class VMT} + function InternalIsValidClass(AClassPointer: Pointer; ADepth: Integer = 0): Boolean; + var + LParentClassSelfPointer: PPointer; + begin + {Check that the self pointer as well as parent class self pointer addresses + are valid} + if (ADepth < 1000) + and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtSelfPtr)) + and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtParent)) then + begin + {Get a pointer to the parent class' self pointer} + LParentClassSelfPointer := PPointer(PByte(AClassPointer) + vmtParent)^; + {Check that the self pointer as well as the parent class is valid} + Result := (PPointer(PByte(AClassPointer) + vmtSelfPtr)^ = AClassPointer) + and ((LParentClassSelfPointer = nil) + or (IsValidVMTAddress(LParentClassSelfPointer) + and InternalIsValidClass(LParentClassSelfPointer^, ADepth + 1))); + end + else + Result := False; + end; + +begin + {Get the class pointer from the (suspected) object} + Result := TClass(PPointer(APointer)^); + {No VM info yet} + LMemInfo.RegionSize := 0; + {Check the block} + if (not InternalIsValidClass(Pointer(Result), 0)) +{$ifdef FullDebugMode} + or (Result = @FreedObjectVMT.VMTMethods[0]) +{$endif} + then + Result := nil; +end; +{$else} +begin + {Not currently supported under Linux / OS X} + Result := nil; +end; +{$endif} + +{Gets the available size inside a block} +function GetAvailableSpaceInBlock(APointer: Pointer): NativeUInt; +var + LBlockHeader: NativeUInt; + LPSmallBlockPool: PSmallBlockPoolHeader; +begin + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + if LBlockHeader and (IsMediumBlockFlag or IsLargeBlockFlag) = 0 then + begin + LPSmallBlockPool := PSmallBlockPoolHeader(LBlockHeader and DropSmallFlagsMask); + Result := LPSmallBlockPool.BlockType.BlockSize - BlockHeaderSize; + end + else + begin + Result := (LBlockHeader and DropMediumAndLargeFlagsMask) - BlockHeaderSize; + if (LBlockHeader and IsMediumBlockFlag) = 0 then + Dec(Result, LargeBlockHeaderSize); + end; +end; + +{-----------------Small Block Management------------------} + +{$ifdef KYLIX} +procedure SwitchToThread; +begin + sched_yield; +end; +{$endif} + +{Locks all small block types} +procedure LockAllSmallBlockTypes; +var + LInd: Cardinal; +begin + {Lock the medium blocks} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + for LInd := 0 to NumSmallBlockTypes - 1 do + begin + while LockCmpxchg(0, 1, @SmallBlockTypes[LInd].BlockTypeLocked) <> 0 do + begin +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + if LockCmpxchg(0, 1, @SmallBlockTypes[LInd].BlockTypeLocked) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; + end; + end; +end; + +{Gets the first and last block pointer for a small block pool} +procedure GetFirstAndLastSmallBlockInPool(APSmallBlockPool: PSmallBlockPoolHeader; + var AFirstPtr, ALastPtr: Pointer); +var + LBlockSize: NativeUInt; +begin + {Get the pointer to the first block} + AFirstPtr := Pointer(PByte(APSmallBlockPool) + SmallBlockPoolHeaderSize); + {Get a pointer to the last block} + if (APSmallBlockPool.BlockType.CurrentSequentialFeedPool <> APSmallBlockPool) + or (UIntPtr(APSmallBlockPool.BlockType.NextSequentialFeedBlockAddress) > UIntPtr(APSmallBlockPool.BlockType.MaxSequentialFeedBlockAddress)) then + begin + {Not the sequential feed - point to the end of the block} + LBlockSize := PNativeUInt(PByte(APSmallBlockPool) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask; + ALastPtr := Pointer(PByte(APSmallBlockPool) + LBlockSize - APSmallBlockPool.BlockType.BlockSize); + end + else + begin + {The sequential feed pool - point to before the next sequential feed block} + ALastPtr := Pointer(PByte(APSmallBlockPool.BlockType.NextSequentialFeedBlockAddress) - 1); + end; +end; + +{-----------------Medium Block Management------------------} + +{Advances to the next medium block. Returns nil if the end of the medium block + pool has been reached} +function NextMediumBlock(APMediumBlock: Pointer): Pointer; +var + LBlockSize: NativeUInt; +begin + {Get the size of this block} + LBlockSize := PNativeUInt(PByte(APMediumBlock) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask; + {Advance the pointer} + Result := Pointer(PByte(APMediumBlock) + LBlockSize); + {Is the next block the end of medium pool marker?} + LBlockSize := PNativeUInt(PByte(Result) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask; + if LBlockSize = 0 then + Result := nil; +end; + +{Gets the first medium block in the medium block pool} +function GetFirstMediumBlockInPool(APMediumBlockPoolHeader: PMediumBlockPoolHeader): Pointer; +begin + if (MediumSequentialFeedBytesLeft = 0) + or (UIntPtr(LastSequentiallyFedMediumBlock) < UIntPtr(APMediumBlockPoolHeader)) + or (UIntPtr(LastSequentiallyFedMediumBlock) > UIntPtr(APMediumBlockPoolHeader) + MediumBlockPoolSize) then + begin + Result := Pointer(PByte(APMediumBlockPoolHeader) + MediumBlockPoolHeaderSize); + end + else + begin + {Is the sequential feed pool empty?} + if MediumSequentialFeedBytesLeft <> MediumBlockPoolSize - MediumBlockPoolHeaderSize then + Result := LastSequentiallyFedMediumBlock + else + Result := nil; + end; +end; + +{Locks the medium blocks. Note that the 32-bit asm version is assumed to + preserve all registers except eax.} +{$ifndef Use32BitAsm} +procedure LockMediumBlocks( + {$ifdef LogLockContention}var ADidSleep: Boolean{$ifdef UseReleaseStack};{$endif}{$endif} + {$ifdef UseReleaseStack}APointer: Pointer = nil; APDelayRelease: PBoolean = nil{$endif}); +{$ifdef UseReleaseStack} +var + LPReleaseStack: ^TLFStack; +{$endif} +begin + {Lock the medium blocks} +{$ifdef LogLockContention} + ADidSleep := False; +{$endif} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while LockCmpxchg(0, 1, @MediumBlocksLocked) <> 0 do + begin +{$ifdef UseReleaseStack} + if Assigned(APointer) then + begin + LPReleaseStack := @MediumReleaseStack[GetStackSlot]; + if (not LPReleaseStack^.IsFull) and LPReleaseStack.Push(APointer) then + begin + APointer := nil; + APDelayRelease^ := True; + Exit; + end; + end; +{$endif} +{$ifdef LogLockContention} + ADidSleep := True; +{$endif} +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + if LockCmpxchg(0, 1, @MediumBlocksLocked) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; + end; +{$ifdef UseReleaseStack} + if Assigned(APDelayRelease) then + APDelayRelease^ := False; +{$endif} +end; +{$else} +procedure LockMediumBlocks; +asm + {Note: This routine is assumed to preserve all registers except eax} +@MediumBlockLockLoop: + mov eax, $100 + {Attempt to lock the medium blocks} + lock cmpxchg MediumBlocksLocked, ah + je @Done +{$ifdef NeverSleepOnThreadContention} + {Pause instruction (improves performance on P4)} + rep nop + {$ifdef UseSwitchToThread} + push ecx + push edx + call SwitchToThread + pop edx + pop ecx + {$endif} + {Try again} + jmp @MediumBlockLockLoop +{$else} + {Couldn't lock the medium blocks - sleep and try again} + push ecx + push edx + push InitialSleepTime + call Sleep + pop edx + pop ecx + {Try again} + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg MediumBlocksLocked, ah + je @Done + {Couldn't lock the medium blocks - sleep and try again} + push ecx + push edx + push AdditionalSleepTime + call Sleep + pop edx + pop ecx + {Try again} + jmp @MediumBlockLockLoop +{$endif} +@Done: +end; +{$endif} + +{Removes a medium block from the circular linked list of free blocks. + Does not change any header flags. Medium blocks should be locked + before calling this procedure.} +procedure RemoveMediumFreeBlock(APMediumFreeBlock: PMediumFreeBlock); +{$ifndef ASMVersion} +var + LPreviousFreeBlock, LNextFreeBlock: PMediumFreeBlock; + LBinNumber, LBinGroupNumber: Cardinal; +begin + {Get the current previous and next blocks} + LNextFreeBlock := APMediumFreeBlock.NextFreeBlock; + LPreviousFreeBlock := APMediumFreeBlock.PreviousFreeBlock; + {Remove this block from the linked list} + LPreviousFreeBlock.NextFreeBlock := LNextFreeBlock; + LNextFreeBlock.PreviousFreeBlock := LPreviousFreeBlock; + {Is this bin now empty? If the previous and next free block pointers are + equal, they must point to the bin.} + if LPreviousFreeBlock = LNextFreeBlock then + begin + {Get the bin number for this block size} + LBinNumber := (UIntPtr(LNextFreeBlock) - UIntPtr(@MediumBlockBins)) div SizeOf(TMediumFreeBlock); + LBinGroupNumber := LBinNumber div 32; + {Flag this bin as empty} + MediumBlockBinBitmaps[LBinGroupNumber] := MediumBlockBinBitmaps[LBinGroupNumber] + and (not (1 shl (LBinNumber and 31))); + {Is the group now entirely empty?} + if MediumBlockBinBitmaps[LBinGroupNumber] = 0 then + begin + {Flag this group as empty} + MediumBlockBinGroupBitmap := MediumBlockBinGroupBitmap + and (not (1 shl LBinGroupNumber)); + end; + end; +end; +{$else} +{$ifdef 32Bit} +asm + {On entry: eax = APMediumFreeBlock} + {Get the current previous and next blocks} + mov ecx, TMediumFreeBlock[eax].NextFreeBlock + mov edx, TMediumFreeBlock[eax].PreviousFreeBlock + {Is this bin now empty? If the previous and next free block pointers are + equal, they must point to the bin.} + cmp ecx, edx + {Remove this block from the linked list} + mov TMediumFreeBlock[ecx].PreviousFreeBlock, edx + mov TMediumFreeBlock[edx].NextFreeBlock, ecx + {Is this bin now empty? If the previous and next free block pointers are + equal, they must point to the bin.} + je @BinIsNowEmpty +@Done: + ret + {Align branch target} + nop +@BinIsNowEmpty: + {Get the bin number for this block size in ecx} + sub ecx, offset MediumBlockBins + mov edx, ecx + shr ecx, 3 + {Get the group number in edx} + movzx edx, dh + {Flag this bin as empty} + mov eax, -2 + rol eax, cl + and dword ptr [MediumBlockBinBitmaps + edx * 4], eax + jnz @Done + {Flag this group as empty} + mov eax, -2 + mov ecx, edx + rol eax, cl + and MediumBlockBinGroupBitmap, eax +end; +{$else} +asm + {On entry: rcx = APMediumFreeBlock} + mov rax, rcx + {Get the current previous and next blocks} + mov rcx, TMediumFreeBlock[rax].NextFreeBlock + mov rdx, TMediumFreeBlock[rax].PreviousFreeBlock + {Is this bin now empty? If the previous and next free block pointers are + equal, they must point to the bin.} + cmp rcx, rdx + {Remove this block from the linked list} + mov TMediumFreeBlock[rcx].PreviousFreeBlock, rdx + mov TMediumFreeBlock[rdx].NextFreeBlock, rcx + {Is this bin now empty? If the previous and next free block pointers are + equal, they must point to the bin.} + jne @Done + {Get the bin number for this block size in rcx} + lea r8, MediumBlockBins + sub rcx, r8 + mov edx, ecx + shr ecx, 4 + {Get the group number in edx} + shr edx, 9 + {Flag this bin as empty} + mov eax, -2 + rol eax, cl + lea r8, MediumBlockBinBitmaps + and dword ptr [r8 + rdx * 4], eax + jnz @Done + {Flag this group as empty} + mov eax, -2 + mov ecx, edx + rol eax, cl + and MediumBlockBinGroupBitmap, eax +@Done: +end; +{$endif} +{$endif} + +{Inserts a medium block into the appropriate medium block bin.} +procedure InsertMediumBlockIntoBin(APMediumFreeBlock: PMediumFreeBlock; AMediumBlockSize: Cardinal); +{$ifndef ASMVersion} +var + LBinNumber, LBinGroupNumber: Cardinal; + LPBin, LPFirstFreeBlock: PMediumFreeBlock; +begin + {Get the bin number for this block size. Get the bin that holds blocks of at + least this size.} + LBinNumber := (AMediumBlockSize - MinimumMediumBlockSize) div MediumBlockGranularity; + if LBinNumber >= MediumBlockBinCount then + LBinNumber := MediumBlockBinCount - 1; + {Get the bin} + LPBin := @MediumBlockBins[LBinNumber]; + {Bins are LIFO, se we insert this block as the first free block in the bin} + LPFirstFreeBlock := LPBin.NextFreeBlock; + APMediumFreeBlock.PreviousFreeBlock := LPBin; + APMediumFreeBlock.NextFreeBlock := LPFirstFreeBlock; + LPFirstFreeBlock.PreviousFreeBlock := APMediumFreeBlock; + LPBin.NextFreeBlock := APMediumFreeBlock; + {Was this bin empty?} + if LPFirstFreeBlock = LPBin then + begin + {Get the group number} + LBinGroupNumber := LBinNumber div 32; + {Flag this bin as used} + MediumBlockBinBitmaps[LBinGroupNumber] := MediumBlockBinBitmaps[LBinGroupNumber] + or (1 shl (LBinNumber and 31)); + {Flag the group as used} + MediumBlockBinGroupBitmap := MediumBlockBinGroupBitmap + or (1 shl LBinGroupNumber); + end; +end; +{$else} +{$ifdef 32Bit} +asm + {On entry: eax = APMediumFreeBlock, edx = AMediumBlockSize} + {Get the bin number for this block size. Get the bin that holds blocks of at + least this size.} + sub edx, MinimumMediumBlockSize + shr edx, 8 + {Validate the bin number} + sub edx, MediumBlockBinCount - 1 + sbb ecx, ecx + and edx, ecx + add edx, MediumBlockBinCount - 1 + {Get the bin in ecx} + lea ecx, [MediumBlockBins + edx * 8] + {Bins are LIFO, se we insert this block as the first free block in the bin} + mov edx, TMediumFreeBlock[ecx].NextFreeBlock + {Was this bin empty?} + cmp edx, ecx + mov TMediumFreeBlock[eax].PreviousFreeBlock, ecx + mov TMediumFreeBlock[eax].NextFreeBlock, edx + mov TMediumFreeBlock[edx].PreviousFreeBlock, eax + mov TMediumFreeBlock[ecx].NextFreeBlock, eax + {Was this bin empty?} + je @BinWasEmpty + ret + {Align branch target} + nop + nop +@BinWasEmpty: + {Get the bin number in ecx} + sub ecx, offset MediumBlockBins + mov edx, ecx + shr ecx, 3 + {Get the group number in edx} + movzx edx, dh + {Flag this bin as not empty} + mov eax, 1 + shl eax, cl + or dword ptr [MediumBlockBinBitmaps + edx * 4], eax + {Flag the group as not empty} + mov eax, 1 + mov ecx, edx + shl eax, cl + or MediumBlockBinGroupBitmap, eax +end; +{$else} +asm + {On entry: rax = APMediumFreeBlock, edx = AMediumBlockSize} + mov rax, rcx + {Get the bin number for this block size. Get the bin that holds blocks of at + least this size.} + sub edx, MinimumMediumBlockSize + shr edx, 8 + {Validate the bin number} + sub edx, MediumBlockBinCount - 1 + sbb ecx, ecx + and edx, ecx + add edx, MediumBlockBinCount - 1 + mov r9, rdx + {Get the bin address in rcx} + lea rcx, MediumBlockBins + shl edx, 4 + add rcx, rdx + {Bins are LIFO, se we insert this block as the first free block in the bin} + mov rdx, TMediumFreeBlock[rcx].NextFreeBlock + {Was this bin empty?} + cmp rdx, rcx + mov TMediumFreeBlock[rax].PreviousFreeBlock, rcx + mov TMediumFreeBlock[rax].NextFreeBlock, rdx + mov TMediumFreeBlock[rdx].PreviousFreeBlock, rax + mov TMediumFreeBlock[rcx].NextFreeBlock, rax + {Was this bin empty?} + jne @Done + {Get the bin number in ecx} + mov rcx, r9 + {Get the group number in edx} + mov rdx, r9 + shr edx, 5 + {Flag this bin as not empty} + mov eax, 1 + shl eax, cl + lea r8, MediumBlockBinBitmaps + or dword ptr [r8 + rdx * 4], eax + {Flag the group as not empty} + mov eax, 1 + mov ecx, edx + shl eax, cl + or MediumBlockBinGroupBitmap, eax +@Done: +end; +{$endif} +{$endif} + +{Bins what remains in the current sequential feed medium block pool. Medium + blocks must be locked.} +procedure BinMediumSequentialFeedRemainder; +{$ifndef ASMVersion} +var + LSequentialFeedFreeSize, LNextBlockSizeAndFlags: NativeUInt; + LPRemainderBlock, LNextMediumBlock: Pointer; +begin + LSequentialFeedFreeSize := MediumSequentialFeedBytesLeft; + if LSequentialFeedFreeSize > 0 then + begin + {Get the block after the open space} + LNextMediumBlock := LastSequentiallyFedMediumBlock; + LNextBlockSizeAndFlags := PNativeUInt(PByte(LNextMediumBlock) - BlockHeaderSize)^; + {Point to the remainder} + LPRemainderBlock := Pointer(PByte(LNextMediumBlock) - LSequentialFeedFreeSize); +{$ifndef FullDebugMode} + {Can the next block be combined with the remainder?} + if (LNextBlockSizeAndFlags and IsFreeBlockFlag) <> 0 then + begin + {Increase the size of this block} + Inc(LSequentialFeedFreeSize, LNextBlockSizeAndFlags and DropMediumAndLargeFlagsMask); + {Remove the next block as well} + if (LNextBlockSizeAndFlags and DropMediumAndLargeFlagsMask) >= MinimumMediumBlockSize then + RemoveMediumFreeBlock(LNextMediumBlock); + end + else + begin +{$endif} + {Set the "previous block is free" flag of the next block} + PNativeUInt(PByte(LNextMediumBlock) - BlockHeaderSize)^ := LNextBlockSizeAndFlags or PreviousMediumBlockIsFreeFlag; +{$ifndef FullDebugMode} + end; +{$endif} + {Store the size of the block as well as the flags} + PNativeUInt(PByte(LPRemainderBlock) - BlockHeaderSize)^ := LSequentialFeedFreeSize or IsMediumBlockFlag or IsFreeBlockFlag; + {Store the trailing size marker} + PNativeUInt(PByte(LPRemainderBlock) + LSequentialFeedFreeSize - BlockHeaderSize * 2)^ := LSequentialFeedFreeSize; +{$ifdef FullDebugMode} + {In full debug mode the sequential feed remainder will never be too small to + fit a full debug header.} + {Clear the user area of the block} + DebugFillMem(Pointer(PByte(LPRemainderBlock) + SizeOf(TFullDebugBlockHeader) + SizeOf(NativeUInt))^, + LSequentialFeedFreeSize - FullDebugBlockOverhead - SizeOf(NativeUInt), + {$ifndef CatchUseOfFreedInterfaces}DebugFillPattern{$else}NativeUInt(@VMTBadInterface){$endif}); + {We need to set a valid debug header and footer in the remainder} + PFullDebugBlockHeader(LPRemainderBlock).HeaderCheckSum := NativeUInt(LPRemainderBlock); + PNativeUInt(PByte(LPRemainderBlock) + SizeOf(TFullDebugBlockHeader))^ := not NativeUInt(LPRemainderBlock); +{$endif} + {Bin this medium block} + if LSequentialFeedFreeSize >= MinimumMediumBlockSize then + InsertMediumBlockIntoBin(LPRemainderBlock, LSequentialFeedFreeSize); + end; +end; +{$else} +{$ifdef 32Bit} +asm + cmp MediumSequentialFeedBytesLeft, 0 + jne @MustBinMedium + {Nothing to bin} + ret + {Align branch target} + nop + nop +@MustBinMedium: + {Get a pointer to the last sequentially allocated medium block} + mov eax, LastSequentiallyFedMediumBlock + {Is the block that was last fed sequentially free?} + test byte ptr [eax - 4], IsFreeBlockFlag + jnz @LastBlockFedIsFree + {Set the "previous block is free" flag in the last block fed} + or dword ptr [eax - 4], PreviousMediumBlockIsFreeFlag + {Get the remainder in edx} + mov edx, MediumSequentialFeedBytesLeft + {Point eax to the start of the remainder} + sub eax, edx +@BinTheRemainder: + {Status: eax = start of remainder, edx = size of remainder} + {Store the size of the block as well as the flags} + lea ecx, [edx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [eax - 4], ecx + {Store the trailing size marker} + mov [eax + edx - 8], edx + {Bin this medium block} + cmp edx, MinimumMediumBlockSize + jnb InsertMediumBlockIntoBin + ret + {Align branch target} + nop + nop +@LastBlockFedIsFree: + {Drop the flags} + mov edx, DropMediumAndLargeFlagsMask + and edx, [eax - 4] + {Free the last block fed} + cmp edx, MinimumMediumBlockSize + jb @DontRemoveLastFed + {Last fed block is free - remove it from its size bin} + call RemoveMediumFreeBlock + {Re-read eax and edx} + mov eax, LastSequentiallyFedMediumBlock + mov edx, DropMediumAndLargeFlagsMask + and edx, [eax - 4] +@DontRemoveLastFed: + {Get the number of bytes left in ecx} + mov ecx, MediumSequentialFeedBytesLeft + {Point eax to the start of the remainder} + sub eax, ecx + {edx = total size of the remainder} + add edx, ecx + jmp @BinTheRemainder +@Done: +end; +{$else} +asm + .params 2 + xor eax, eax + cmp MediumSequentialFeedBytesLeft, eax + je @Done + {Get a pointer to the last sequentially allocated medium block} + mov rax, LastSequentiallyFedMediumBlock + {Is the block that was last fed sequentially free?} + test byte ptr [rax - BlockHeaderSize], IsFreeBlockFlag + jnz @LastBlockFedIsFree + {Set the "previous block is free" flag in the last block fed} + or qword ptr [rax - BlockHeaderSize], PreviousMediumBlockIsFreeFlag + {Get the remainder in edx} + mov edx, MediumSequentialFeedBytesLeft + {Point eax to the start of the remainder} + sub rax, rdx +@BinTheRemainder: + {Status: rax = start of remainder, edx = size of remainder} + {Store the size of the block as well as the flags} + lea rcx, [rdx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [rax - BlockHeaderSize], rcx + {Store the trailing size marker} + mov [rax + rdx - 2 * BlockHeaderSize], rdx + {Bin this medium block} + cmp edx, MinimumMediumBlockSize + jb @Done + mov rcx, rax + call InsertMediumBlockIntoBin + jmp @Done +@LastBlockFedIsFree: + {Drop the flags} + mov rdx, DropMediumAndLargeFlagsMask + and rdx, [rax - BlockHeaderSize] + {Free the last block fed} + cmp edx, MinimumMediumBlockSize + jb @DontRemoveLastFed + {Last fed block is free - remove it from its size bin} + mov rcx, rax + call RemoveMediumFreeBlock + {Re-read rax and rdx} + mov rax, LastSequentiallyFedMediumBlock + mov rdx, DropMediumAndLargeFlagsMask + and rdx, [rax - BlockHeaderSize] +@DontRemoveLastFed: + {Get the number of bytes left in ecx} + mov ecx, MediumSequentialFeedBytesLeft + {Point rax to the start of the remainder} + sub rax, rcx + {edx = total size of the remainder} + add edx, ecx + jmp @BinTheRemainder +@Done: +end; +{$endif} +{$endif} + +{Allocates a new sequential feed medium block pool and immediately splits off a + block of the requested size. The block size must be a multiple of 16 and + medium blocks must be locked.} +function AllocNewSequentialFeedMediumPool(AFirstBlockSize: Cardinal): Pointer; +var + LOldFirstMediumBlockPool: PMediumBlockPoolHeader; + LNewPool: Pointer; +begin + {Bin the current sequential feed remainder} + BinMediumSequentialFeedRemainder; + {Allocate a new sequential feed block pool} + LNewPool := VirtualAlloc(nil, MediumBlockPoolSize, + MEM_COMMIT{$ifdef AlwaysAllocateTopDown} or MEM_TOP_DOWN{$endif}, PAGE_READWRITE); + if LNewPool <> nil then + begin + {Insert this block pool into the list of block pools} + LOldFirstMediumBlockPool := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + PMediumBlockPoolHeader(LNewPool).PreviousMediumBlockPoolHeader := @MediumBlockPoolsCircularList; + MediumBlockPoolsCircularList.NextMediumBlockPoolHeader := LNewPool; + PMediumBlockPoolHeader(LNewPool).NextMediumBlockPoolHeader := LOldFirstMediumBlockPool; + LOldFirstMediumBlockPool.PreviousMediumBlockPoolHeader := LNewPool; + {Store the sequential feed pool trailer} + PNativeUInt(PByte(LNewPool) + MediumBlockPoolSize - BlockHeaderSize)^ := IsMediumBlockFlag; + {Get the number of bytes still available} + MediumSequentialFeedBytesLeft := (MediumBlockPoolSize - MediumBlockPoolHeaderSize) - AFirstBlockSize; + {Get the result} + Result := Pointer(PByte(LNewPool) + MediumBlockPoolSize - AFirstBlockSize); + LastSequentiallyFedMediumBlock := Result; + {Store the block header} + PNativeUInt(PByte(Result) - BlockHeaderSize)^ := AFirstBlockSize or IsMediumBlockFlag; + end + else + begin + {Out of memory} + MediumSequentialFeedBytesLeft := 0; + Result := nil; + end; +end; + +{-----------------Large Block Management------------------} + +{Locks the large blocks} +procedure LockLargeBlocks({$ifdef LogLockContention}var ADidSleep: Boolean{$ifdef UseReleaseStack};{$endif}{$endif} + {$ifdef UseReleaseStack}APointer: Pointer = nil; APDelayRelease: PBoolean = nil{$endif}); +{$ifdef UseReleaseStack} +var + LPReleaseStack: ^TLFStack; +{$endif} +begin + {Lock the large blocks} +{$ifdef LogLockContention} + ADidSleep := False; +{$endif} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while LockCmpxchg(0, 1, @LargeBlocksLocked) <> 0 do + begin +{$ifdef UseReleaseStack} + if Assigned(APointer) then + begin + LPReleaseStack := @LargeReleaseStack[GetStackSlot]; + if (not LPReleaseStack^.IsFull) and LPReleaseStack.Push(APointer) then + begin + APointer := nil; + APDelayRelease^ := True; + Exit; + end; + end; +{$endif} +{$ifdef LogLockContention} + ADidSleep := True; +{$endif} +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + if LockCmpxchg(0, 1, @LargeBlocksLocked) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; + end; +{$ifdef UseReleaseStack} + if Assigned(APDelayRelease) then + APDelayRelease^ := False; +{$endif} +end; + +{Allocates a Large block of at least ASize (actual size may be larger to + allow for alignment etc.). ASize must be the actual user requested size. This + procedure will pad it to the appropriate page boundary and also add the space + required by the header.} +function AllocateLargeBlock(ASize: NativeUInt {$ifdef LogLockContention}; var ADidSleep: Boolean{$endif}): Pointer; +var + LLargeUsedBlockSize: NativeUInt; + LOldFirstLargeBlock: PLargeBlockHeader; +begin + {Pad the block size to include the header and granularity. We also add a + SizeOf(Pointer) overhead so a huge block size is a multiple of 16 bytes less + SizeOf(Pointer) (so we can use a single move function for reallocating all + block types)} + LLargeUsedBlockSize := (ASize + LargeBlockHeaderSize + LargeBlockGranularity - 1 + BlockHeaderSize) + and -LargeBlockGranularity; + {Get the Large block} + Result := VirtualAlloc(nil, LLargeUsedBlockSize, MEM_COMMIT or MEM_TOP_DOWN, + PAGE_READWRITE); + {Set the Large block fields} + if Result <> nil then + begin + {Set the large block size and flags} + PLargeBlockHeader(Result).UserAllocatedSize := ASize; + PLargeBlockHeader(Result).BlockSizeAndFlags := LLargeUsedBlockSize or IsLargeBlockFlag; + {Insert the large block into the linked list of large blocks} + LockLargeBlocks({$ifdef LogLockContention}ADidSleep{$endif}); + LOldFirstLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + PLargeBlockHeader(Result).PreviousLargeBlockHeader := @LargeBlocksCircularList; + LargeBlocksCircularList.NextLargeBlockHeader := Result; + PLargeBlockHeader(Result).NextLargeBlockHeader := LOldFirstLargeBlock; + LOldFirstLargeBlock.PreviousLargeBlockHeader := Result; + LargeBlocksLocked := False; + {Add the size of the header} + Inc(PByte(Result), LargeBlockHeaderSize); +{$ifdef FullDebugMode} + {Since large blocks are never reused, the user area is not initialized to + the debug fill pattern, but the debug header and footer must be set.} + PFullDebugBlockHeader(Result).HeaderCheckSum := NativeUInt(Result); + PNativeUInt(PByte(Result) + SizeOf(TFullDebugBlockHeader))^ := not NativeUInt(Result); +{$endif} + end; +end; + +{Frees a large block, returning 0 on success, -1 otherwise} +function FreeLargeBlock(APointer: Pointer + {$ifdef UseReleaseStack}; ACleanupOperation: Boolean = False{$endif}): Integer; +var + LPreviousLargeBlockHeader, LNextLargeBlockHeader: PLargeBlockHeader; +{$ifndef POSIX} + LRemainingSize: NativeUInt; + LCurrentSegment: Pointer; + LMemInfo: TMemoryBasicInformation; +{$endif} +{$ifdef LogLockContention} + LDidSleep: Boolean; + LStackTrace: TStackTrace; +{$endif} +{$ifdef UseReleaseStack} + LDelayRelease: Boolean; + LPReleaseStack: ^TLFStack; +{$endif} +begin +{$ifdef ClearLargeBlocksBeforeReturningToOS} + FillChar(APointer^, + (PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).BlockSizeAndFlags + and DropMediumAndLargeFlagsMask) - LargeBlockHeaderSize, 0); +{$endif} + {When running a cleanup operation, large blocks are already locked} +{$ifdef UseReleaseStack} + if not ACleanupOperation then + begin +{$endif} + LockLargeBlocks({$ifdef LogLockContention}LDidSleep{$ifdef UseReleaseStack},{$endif}{$endif} + {$ifdef UseReleaseStack}APointer, @LDelayRelease{$endif}); +{$ifdef UseReleaseStack} + if LDelayRelease then + begin + Result := 0; + Exit; + end; + {$ifdef LogLockContention} + end + else + LDidSleep := False; + {$else} + end; + {$endif} +{$endif} +{$ifdef LogLockContention} + if LDidSleep then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + LargeBlockCollector.Add(@LStackTrace[0], StackTraceDepth); + end; +{$endif} +{$ifdef UseReleaseStack} + repeat +{$endif} + {Point to the start of the large block} + APointer := Pointer(PByte(APointer) - LargeBlockHeaderSize); + {Get the previous and next large blocks} + LPreviousLargeBlockHeader := PLargeBlockHeader(APointer).PreviousLargeBlockHeader; + LNextLargeBlockHeader := PLargeBlockHeader(APointer).NextLargeBlockHeader; + {$ifndef POSIX} + {Is the large block segmented?} + if PLargeBlockHeader(APointer).BlockSizeAndFlags and LargeBlockIsSegmented = 0 then + begin + {$endif} + {Single segment large block: Try to free it} + if VirtualFree(APointer, 0, MEM_RELEASE) then + Result := 0 + else + Result := -1; + {$ifndef POSIX} + end + else + begin + {The large block is segmented - free all segments} + LCurrentSegment := APointer; + LRemainingSize := PLargeBlockHeader(APointer).BlockSizeAndFlags and DropMediumAndLargeFlagsMask; + Result := 0; + while True do + begin + {Get the size of the current segment} + VirtualQuery(LCurrentSegment, LMemInfo, SizeOf(LMemInfo)); + {Free the segment} + if not VirtualFree(LCurrentSegment, 0, MEM_RELEASE) then + begin + Result := -1; + Break; + end; + {Done?} + if NativeUInt(LMemInfo.RegionSize) >= LRemainingSize then + Break; + {Decrement the remaining size} + Dec(LRemainingSize, NativeUInt(LMemInfo.RegionSize)); + Inc(PByte(LCurrentSegment), NativeUInt(LMemInfo.RegionSize)); + end; + end; + {$endif} + {Success?} + if Result = 0 then + begin + {Remove the large block from the linked list} + LNextLargeBlockHeader.PreviousLargeBlockHeader := LPreviousLargeBlockHeader; + LPreviousLargeBlockHeader.NextLargeBlockHeader := LNextLargeBlockHeader; + end; +{$ifdef UseReleaseStack} + if (Result <> 0) or ACleanupOperation then + Break; + LPReleaseStack := @LargeReleaseStack[GetStackSlot]; + if LPReleaseStack^.IsEmpty or (not LPReleaseStack.Pop(APointer)) then + Break; + {$ifdef ClearLargeBlocksBeforeReturningToOS} + FillChar(APointer^, + (PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).BlockSizeAndFlags + and DropMediumAndLargeFlagsMask) - LargeBlockHeaderSize, 0); + {$endif} + until False; +{$endif} + {Unlock the large blocks} + LargeBlocksLocked := False; +end; + +{$ifndef FullDebugMode} +{Reallocates a large block to at least the requested size. Returns the new + pointer, or nil on error} +function ReallocateLargeBlock(APointer: Pointer; ANewSize: NativeUInt): Pointer; +var + LOldAvailableSize, LBlockHeader, LOldUserSize, LMinimumUpsize, + LNewAllocSize: NativeUInt; +{$ifndef POSIX} + LNewSegmentSize: NativeUInt; + LNextSegmentPointer: Pointer; + LMemInfo: TMemoryBasicInformation; +{$endif} +begin + {Get the block header} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + {Large block - size is (16 + 4) less than the allocated size} + LOldAvailableSize := (LBlockHeader and DropMediumAndLargeFlagsMask) - (LargeBlockHeaderSize + BlockHeaderSize); + {Is it an upsize or a downsize?} + if ANewSize > LOldAvailableSize then + begin + {This pointer is being reallocated to a larger block and therefore it is + logical to assume that it may be enlarged again. Since reallocations are + expensive, there is a minimum upsize percentage to avoid unnecessary + future move operations.} + {Add 25% for large block upsizes} + LMinimumUpsize := LOldAvailableSize + (LOldAvailableSize shr 2); + if ANewSize < LMinimumUpsize then + LNewAllocSize := LMinimumUpsize + else + LNewAllocSize := ANewSize; +{$ifndef POSIX} + {Can another large block segment be allocated directly after this segment, + thus negating the need to move the data?} + LNextSegmentPointer := Pointer(PByte(APointer) - LargeBlockHeaderSize + (LBlockHeader and DropMediumAndLargeFlagsMask)); + VirtualQuery(LNextSegmentPointer, LMemInfo, SizeOf(LMemInfo)); + if LMemInfo.State = MEM_FREE then + begin + {Round the region size to the previous 64K} + LMemInfo.RegionSize := LMemInfo.RegionSize and -LargeBlockGranularity; + {Enough space to grow in place?} + if NativeUInt(LMemInfo.RegionSize) > (ANewSize - LOldAvailableSize) then + begin + {There is enough space after the block to extend it - determine by how + much} + LNewSegmentSize := (LNewAllocSize - LOldAvailableSize + LargeBlockGranularity - 1) and -LargeBlockGranularity; + if LNewSegmentSize > LMemInfo.RegionSize then + LNewSegmentSize := LMemInfo.RegionSize; + {Attempy to reserve the address range (which will fail if another + thread has just reserved it) and commit it immediately afterwards.} + if (VirtualAlloc(LNextSegmentPointer, LNewSegmentSize, MEM_RESERVE, PAGE_READWRITE) <> nil) + and (VirtualAlloc(LNextSegmentPointer, LNewSegmentSize, MEM_COMMIT, PAGE_READWRITE) <> nil) then + begin + {Update the requested size} + PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).BlockSizeAndFlags := + (PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).BlockSizeAndFlags + LNewSegmentSize) + or LargeBlockIsSegmented; + {Success} + Result := APointer; + Exit; + end; + end; + end; +{$endif} + {Could not resize in place: Allocate the new block} + Result := FastGetMem(LNewAllocSize); + if Result <> nil then + begin + {If it's a large block - store the actual user requested size (it may + not be if the block that is being reallocated from was previously + downsized)} + if LNewAllocSize > (MaximumMediumBlockSize - BlockHeaderSize) then + PLargeBlockHeader(PByte(Result) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + {The user allocated size is stored for large blocks} + LOldUserSize := PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).UserAllocatedSize; + {The number of bytes to move is the old user size.} +{$ifdef UseCustomVariableSizeMoveRoutines} + MoveX16LP(APointer^, Result^, LOldUserSize); +{$else} + System.Move(APointer^, Result^, LOldUserSize); +{$endif} + {Free the old block} + FastFreeMem(APointer); + end; + end + else + begin + {It's a downsize: do we need to reallocate? Only if the new size is less + than half the old size} + if ANewSize >= (LOldAvailableSize shr 1) then + begin + {No need to reallocate} + Result := APointer; + {Update the requested size} + PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + end + else + begin + {The block is less than half the old size, and the current size is + greater than the minimum block size allowing a downsize: reallocate} + Result := FastGetMem(ANewSize); + if Result <> nil then + begin + {Still a large block? -> Set the user size} + if ANewSize > (MaximumMediumBlockSize - BlockHeaderSize) then + PLargeBlockHeader(PByte(APointer) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} +{$ifdef Align16Bytes} + MoveX16LP(APointer^, Result^, ANewSize); +{$else} + MoveX8LP(APointer^, Result^, ANewSize); +{$endif} +{$else} + System.Move(APointer^, Result^, ANewSize); +{$endif} + {Free the old block} + FastFreeMem(APointer); + end; + end; + end; +end; +{$endif} + +{---------------------Replacement Memory Manager Interface---------------------} + +{Replacement for SysGetMem} + +function FastGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif} + {$ifdef FullDebugMode}{$ifdef LogLockContention}; var ACollector: PStaticCollector{$endif}{$endif}): Pointer; +{$ifndef ASMVersion} +var + LMediumBlock{$ifndef FullDebugMode}, LNextFreeBlock, LSecondSplit{$endif}: PMediumFreeBlock; + LNextMediumBlockHeader: PNativeUInt; + LBlockSize, LAvailableBlockSize{$ifndef FullDebugMode}, LSecondSplitSize{$endif}, + LSequentialFeedFreeSize: NativeUInt; + LPSmallBlockType: PSmallBlockType; + LPSmallBlockPool, LPNewFirstPool: PSmallBlockPoolHeader; + LNewFirstFreeBlock: Pointer; + LPMediumBin: PMediumFreeBlock; + LBinNumber, {$ifndef FullDebugMode}LBinGroupsMasked, {$endif}LBinGroupMasked, + LBinGroupNumber: Cardinal; +{$ifdef LogLockContention} + LDidSleep: Boolean; +{$ifndef FullDebugMode} + ACollector: PStaticCollector; + LStackTrace: TStackTrace; +{$endif} +{$endif} +{$ifdef UseReleaseStack} + LPReleaseStack: ^TLFStack; +{$endif} +begin +{$ifdef LogLockContention} + ACollector := nil; +{$endif} + {Is it a small block? -> Take the header size into account when + determining the required block size} + if NativeUInt(ASize) <= (MaximumSmallBlockSize - BlockHeaderSize) then + begin + {-------------------------Allocate a small block---------------------------} + {Get the block type from the size} + LPSmallBlockType := PSmallBlockType(AllocSize2SmallBlockTypeIndX4[ + (NativeUInt(ASize) + (BlockHeaderSize - 1)) div SmallBlockGranularity] + * (SizeOf(TSmallBlockType) div 4) + + UIntPtr(@SmallBlockTypes)); +{$ifdef UseReleaseStack} + LPReleaseStack := @LPSmallBlockType.ReleaseStack[GetStackSlot]; + if (not LPReleaseStack^.IsEmpty) and LPReleaseStack^.Pop(Result) then + Exit; +{$endif} + {Lock the block type} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while True do + begin + {Try to lock the small block type} + if LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) = 0 then + Break; + {Try the next block type} + Inc(PByte(LPSmallBlockType), SizeOf(TSmallBlockType)); + if LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) = 0 then + Break; + {Try up to two sizes past the requested size} + Inc(PByte(LPSmallBlockType), SizeOf(TSmallBlockType)); + if LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) = 0 then + Break; + {All three sizes locked - given up and sleep} + Dec(PByte(LPSmallBlockType), 2 * SizeOf(TSmallBlockType)); +{$ifdef LogLockContention} + ACollector := @LPSmallBlockType.BlockCollector; +{$endif} +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + {Both this block type and the next is in use: sleep} + Sleep(InitialSleepTime); + {Try the lock again} + if LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) = 0 then + Break; + {Sleep longer} + Sleep(AdditionalSleepTime); +{$endif} + end; + end; + {Get the first pool with free blocks} + LPSmallBlockPool := LPSmallBlockType.NextPartiallyFreePool; + {Is the pool valid?} + if UIntPtr(LPSmallBlockPool) <> UIntPtr(LPSmallBlockType) then + begin + {Get the first free offset} + Result := LPSmallBlockPool.FirstFreeBlock; + {Get the new first free block} + LNewFirstFreeBlock := PPointer(PByte(Result) - BlockHeaderSize)^; +{$ifdef CheckHeapForCorruption} + {The block should be free} + if (NativeUInt(LNewFirstFreeBlock) and ExtractSmallFlagsMask) <> IsFreeBlockFlag then + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} +{$endif} + LNewFirstFreeBlock := Pointer(UIntPtr(LNewFirstFreeBlock) and DropSmallFlagsMask); + {Increment the number of used blocks} + Inc(LPSmallBlockPool.BlocksInUse); + {Set the new first free block} + LPSmallBlockPool.FirstFreeBlock := LNewFirstFreeBlock; + {Is the pool now full?} + if LNewFirstFreeBlock = nil then + begin + {Pool is full - remove it from the partially free list} + LPNewFirstPool := LPSmallBlockPool.NextPartiallyFreePool; + LPSmallBlockType.NextPartiallyFreePool := LPNewFirstPool; + LPNewFirstPool.PreviousPartiallyFreePool := PSmallBlockPoolHeader(LPSmallBlockType); + end; + end + else + begin + {Try to feed a small block sequentially} + Result := LPSmallBlockType.NextSequentialFeedBlockAddress; + {Can another block fit?} + if UIntPtr(Result) <= UIntPtr(LPSmallBlockType.MaxSequentialFeedBlockAddress) then + begin + {Get the sequential feed block pool} + LPSmallBlockPool := LPSmallBlockType.CurrentSequentialFeedPool; + {Increment the number of used blocks in the sequential feed pool} + Inc(LPSmallBlockPool.BlocksInUse); + {Store the next sequential feed block address} + LPSmallBlockType.NextSequentialFeedBlockAddress := Pointer(PByte(Result) + LPSmallBlockType.BlockSize); + end + else + begin + {Need to allocate a pool: Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); +{$ifdef LogLockContention} + if LDidSleep then + ACollector := @MediumBlockCollector; +{$endif} +{$ifndef FullDebugMode} + {Are there any available blocks of a suitable size?} + LBinGroupsMasked := MediumBlockBinGroupBitmap and ($ffffff00 or LPSmallBlockType.AllowedGroupsForBlockPoolBitmap); + if LBinGroupsMasked <> 0 then + begin + {Get the bin group with free blocks} + LBinGroupNumber := FindFirstSetBit(LBinGroupsMasked); + {Get the bin in the group with free blocks} + LBinNumber := FindFirstSetBit(MediumBlockBinBitmaps[LBinGroupNumber]) + + LBinGroupNumber * 32; + LPMediumBin := @MediumBlockBins[LBinNumber]; + {Get the first block in the bin} + LMediumBlock := LPMediumBin.NextFreeBlock; + {Remove the first block from the linked list (LIFO)} + LNextFreeBlock := LMediumBlock.NextFreeBlock; + LPMediumBin.NextFreeBlock := LNextFreeBlock; + LNextFreeBlock.PreviousFreeBlock := LPMediumBin; + {Is this bin now empty?} + if LNextFreeBlock = LPMediumBin then + begin + {Flag this bin as empty} + MediumBlockBinBitmaps[LBinGroupNumber] := MediumBlockBinBitmaps[LBinGroupNumber] + and (not (1 shl (LBinNumber and 31))); + {Is the group now entirely empty?} + if MediumBlockBinBitmaps[LBinGroupNumber] = 0 then + begin + {Flag this group as empty} + MediumBlockBinGroupBitmap := MediumBlockBinGroupBitmap + and (not (1 shl LBinGroupNumber)); + end; + end; + {Get the size of the available medium block} + LBlockSize := PNativeUInt(PByte(LMediumBlock) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask; + {$ifdef CheckHeapForCorruption} + {Check that this block is actually free and the next and previous blocks + are both in use.} + if ((PNativeUInt(PByte(LMediumBlock) - BlockHeaderSize)^ and ExtractMediumAndLargeFlagsMask) <> (IsMediumBlockFlag or IsFreeBlockFlag)) + or ((PNativeUInt(PByte(LMediumBlock) + (PNativeUInt(PByte(LMediumBlock) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask) - BlockHeaderSize)^ and IsFreeBlockFlag) <> 0) + then + begin + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; + {$endif} + {Should the block be split?} + if LBlockSize >= MaximumSmallBlockPoolSize then + begin + {Get the size of the second split} + LSecondSplitSize := LBlockSize - LPSmallBlockType.OptimalBlockPoolSize; + {Adjust the block size} + LBlockSize := LPSmallBlockType.OptimalBlockPoolSize; + {Split the block in two} + LSecondSplit := PMediumFreeBlock(PByte(LMediumBlock) + LBlockSize); + PNativeUInt(PByte(LSecondSplit) - BlockHeaderSize)^ := LSecondSplitSize or (IsMediumBlockFlag or IsFreeBlockFlag); + {Store the size of the second split as the second last dword/qword} + PNativeUInt(PByte(LSecondSplit) + LSecondSplitSize - 2 * BlockHeaderSize)^ := LSecondSplitSize; + {Put the remainder in a bin (it will be big enough)} + InsertMediumBlockIntoBin(LSecondSplit, LSecondSplitSize); + end + else + begin + {Mark this block as used in the block following it} + LNextMediumBlockHeader := PNativeUInt(PByte(LMediumBlock) + LBlockSize - BlockHeaderSize); + LNextMediumBlockHeader^ := LNextMediumBlockHeader^ and (not PreviousMediumBlockIsFreeFlag); + end; + end + else + begin +{$endif} + {Check the sequential feed medium block pool for space} + LSequentialFeedFreeSize := MediumSequentialFeedBytesLeft; + if LSequentialFeedFreeSize >= LPSmallBlockType.MinimumBlockPoolSize then + begin + {Enough sequential feed space: Will the remainder be usable?} + if LSequentialFeedFreeSize >= (LPSmallBlockType.OptimalBlockPoolSize + MinimumMediumBlockSize) then + begin + LBlockSize := LPSmallBlockType.OptimalBlockPoolSize; + end + else + LBlockSize := LSequentialFeedFreeSize; + {Get the block} + LMediumBlock := Pointer(PByte(LastSequentiallyFedMediumBlock) - LBlockSize); + {Update the sequential feed parameters} + LastSequentiallyFedMediumBlock := LMediumBlock; + MediumSequentialFeedBytesLeft := LSequentialFeedFreeSize - LBlockSize; + end + else + begin + {Need to allocate a new sequential feed medium block pool: use the + optimal size for this small block pool} + LBlockSize := LPSmallBlockType.OptimalBlockPoolSize; + {Allocate the medium block pool} + LMediumBlock := AllocNewSequentialFeedMediumPool(LBlockSize); + if LMediumBlock = nil then + begin + {Out of memory} + {Unlock the medium blocks} + MediumBlocksLocked := False; + {Unlock the block type} + LPSmallBlockType.BlockTypeLocked := False; + {Failed} + Result := nil; + {done} + Exit; + end; + end; +{$ifndef FullDebugMode} + end; +{$endif} + {Mark this block as in use} + {Set the size and flags for this block} + PNativeUInt(PByte(LMediumBlock) - BlockHeaderSize)^ := LBlockSize or IsMediumBlockFlag or IsSmallBlockPoolInUseFlag; + {Unlock medium blocks} + MediumBlocksLocked := False; + {Set up the block pool} + LPSmallBlockPool := PSmallBlockPoolHeader(LMediumBlock); + LPSmallBlockPool.BlockType := LPSmallBlockType; + LPSmallBlockPool.FirstFreeBlock := nil; + LPSmallBlockPool.BlocksInUse := 1; + {Set it up for sequential block serving} + LPSmallBlockType.CurrentSequentialFeedPool := LPSmallBlockPool; + Result := Pointer(PByte(LPSmallBlockPool) + SmallBlockPoolHeaderSize); + LPSmallBlockType.NextSequentialFeedBlockAddress := Pointer(PByte(Result) + LPSmallBlockType.BlockSize); + LPSmallBlockType.MaxSequentialFeedBlockAddress := Pointer(PByte(LPSmallBlockPool) + LBlockSize - LPSmallBlockType.BlockSize); + end; +{$ifdef FullDebugMode} + {Clear the user area of the block} + DebugFillMem(Pointer(PByte(Result) + (SizeOf(TFullDebugBlockHeader) + SizeOf(NativeUInt)))^, + LPSmallBlockType.BlockSize - FullDebugBlockOverhead - SizeOf(NativeUInt), + {$ifndef CatchUseOfFreedInterfaces}DebugFillPattern{$else}NativeUInt(@VMTBadInterface){$endif}); + {Block was fed sequentially - we need to set a valid debug header. Use + the block address.} + PFullDebugBlockHeader(Result).HeaderCheckSum := NativeUInt(Result); + PNativeUInt(PByte(Result) + SizeOf(TFullDebugBlockHeader))^ := not NativeUInt(Result); +{$endif} + end; + {Unlock the block type} + LPSmallBlockType.BlockTypeLocked := False; + {Set the block header} + PNativeUInt(PByte(Result) - BlockHeaderSize)^ := UIntPtr(LPSmallBlockPool); + end + else + begin + {Medium block or Large block?} + if NativeUInt(ASize) <= (MaximumMediumBlockSize - BlockHeaderSize) then + begin + {------------------------Allocate a medium block--------------------------} + {Get the block size and bin number for this block size. Block sizes are + rounded up to the next bin size.} + LBlockSize := ((NativeUInt(ASize) + (MediumBlockGranularity - 1 + BlockHeaderSize - MediumBlockSizeOffset)) + and -MediumBlockGranularity) + MediumBlockSizeOffset; + {Get the bin number} + LBinNumber := (LBlockSize - MinimumMediumBlockSize) div MediumBlockGranularity; + {Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); +{$ifdef LogLockContention} + if LDidSleep then + ACollector := @MediumBlockCollector; +{$endif} + {Calculate the bin group} + LBinGroupNumber := LBinNumber div 32; + {Is there a suitable block inside this group?} + LBinGroupMasked := MediumBlockBinBitmaps[LBinGroupNumber] and -(1 shl (LBinNumber and 31)); + if LBinGroupMasked <> 0 then + begin + {Get the actual bin number} + LBinNumber := FindFirstSetBit(LBinGroupMasked) + LBinGroupNumber * 32; + end + else + begin +{$ifndef FullDebugMode} + {Try all groups greater than this group} + LBinGroupsMasked := MediumBlockBinGroupBitmap and -(2 shl LBinGroupNumber); + if LBinGroupsMasked <> 0 then + begin + {There is a suitable group with space: get the bin number} + LBinGroupNumber := FindFirstSetBit(LBinGroupsMasked); + {Get the bin in the group with free blocks} + LBinNumber := FindFirstSetBit(MediumBlockBinBitmaps[LBinGroupNumber]) + + LBinGroupNumber * 32; + end + else + begin +{$endif} + {There are no bins with a suitable block: Sequentially feed the required block} + LSequentialFeedFreeSize := MediumSequentialFeedBytesLeft; + if LSequentialFeedFreeSize >= LBlockSize then + begin +{$ifdef FullDebugMode} + {In full debug mode a medium block must have enough bytes to fit + all the debug info, so we must make sure there are no tiny medium + blocks at the start of the pool.} + if LSequentialFeedFreeSize - LBlockSize < (FullDebugBlockOverhead + BlockHeaderSize) then + LBlockSize := LSequentialFeedFreeSize; +{$endif} + {Block can be fed sequentially} + Result := Pointer(PByte(LastSequentiallyFedMediumBlock) - LBlockSize); + {Store the last sequentially fed block} + LastSequentiallyFedMediumBlock := Result; + {Store the remaining bytes} + MediumSequentialFeedBytesLeft := LSequentialFeedFreeSize - LBlockSize; + {Set the flags for the block} + PNativeUInt(PByte(Result) - BlockHeaderSize)^ := LBlockSize or IsMediumBlockFlag; + end + else + begin + {Need to allocate a new sequential feed block} + Result := AllocNewSequentialFeedMediumPool(LBlockSize); + end; +{$ifdef FullDebugMode} + {Block was fed sequentially - we need to set a valid debug header} + if Result <> nil then + begin + PFullDebugBlockHeader(Result).HeaderCheckSum := NativeUInt(Result); + PNativeUInt(PByte(Result) + SizeOf(TFullDebugBlockHeader))^ := not NativeUInt(Result); + {Clear the user area of the block} + DebugFillMem(Pointer(PByte(Result) + SizeOf(TFullDebugBlockHeader) + SizeOf(NativeUInt))^, + LBlockSize - FullDebugBlockOverhead - SizeOf(NativeUInt), + {$ifndef CatchUseOfFreedInterfaces}DebugFillPattern{$else}NativeUInt(@VMTBadInterface){$endif}); + end; +{$endif} + {Done} + MediumBlocksLocked := False; + Exit; +{$ifndef FullDebugMode} + end; +{$endif} + end; + {If we get here we have a valid LBinGroupNumber and LBinNumber: + Use the first block in the bin, splitting it if necessary} + {Get a pointer to the bin} + LPMediumBin := @MediumBlockBins[LBinNumber]; + {Get the result} + Result := LPMediumBin.NextFreeBlock; +{$ifdef CheckHeapForCorruption} + {Check that this block is actually free and the next and previous blocks + are both in use (except in full debug mode).} + if ((PNativeUInt(PByte(Result) - BlockHeaderSize)^ and {$ifndef FullDebugMode}ExtractMediumAndLargeFlagsMask{$else}(IsMediumBlockFlag or IsFreeBlockFlag){$endif}) <> (IsFreeBlockFlag or IsMediumBlockFlag)) + {$ifndef FullDebugMode} + or ((PNativeUInt(PByte(Result) + (PNativeUInt(PByte(Result) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask) - BlockHeaderSize)^ and (ExtractMediumAndLargeFlagsMask - IsSmallBlockPoolInUseFlag)) <> (IsMediumBlockFlag or PreviousMediumBlockIsFreeFlag)) + {$endif} + then + begin + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; +{$endif} + {Remove the block from the bin containing it} + RemoveMediumFreeBlock(Result); + {Get the block size} + LAvailableBlockSize := PNativeUInt(PByte(Result) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask; +{$ifndef FullDebugMode} + {Is it an exact fit or not?} + LSecondSplitSize := LAvailableBlockSize - LBlockSize; + if LSecondSplitSize <> 0 then + begin + {Split the block in two} + LSecondSplit := PMediumFreeBlock(PByte(Result) + LBlockSize); + {Set the size of the second split} + PNativeUInt(PByte(LSecondSplit) - BlockHeaderSize)^ := LSecondSplitSize or (IsMediumBlockFlag or IsFreeBlockFlag); + {Store the size of the second split} + PNativeUInt(PByte(LSecondSplit) + LSecondSplitSize - 2 * BlockHeaderSize)^ := LSecondSplitSize; + {Put the remainder in a bin if it is big enough} + if LSecondSplitSize >= MinimumMediumBlockSize then + InsertMediumBlockIntoBin(LSecondSplit, LSecondSplitSize); + end + else + begin +{$else} + {In full debug mode blocks are never split or coalesced} + LBlockSize := LAvailableBlockSize; +{$endif} + {Mark this block as used in the block following it} + LNextMediumBlockHeader := Pointer(PByte(Result) + LBlockSize - BlockHeaderSize); +{$ifndef FullDebugMode} + {$ifdef CheckHeapForCorruption} + {The next block must be in use} + if (LNextMediumBlockHeader^ and (ExtractMediumAndLargeFlagsMask - IsSmallBlockPoolInUseFlag)) <> (IsMediumBlockFlag or PreviousMediumBlockIsFreeFlag) then + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + {$endif} +{$endif} + LNextMediumBlockHeader^ := + LNextMediumBlockHeader^ and (not PreviousMediumBlockIsFreeFlag); +{$ifndef FullDebugMode} + end; + {Set the size and flags for this block} + PNativeUInt(PByte(Result) - BlockHeaderSize)^ := LBlockSize or IsMediumBlockFlag; +{$else} + {In full debug mode blocks are never split or coalesced} + Dec(PNativeUInt(PByte(Result) - BlockHeaderSize)^, IsFreeBlockFlag); +{$endif} + {Unlock the medium blocks} + MediumBlocksLocked := False; + end + else + begin + {Allocate a Large block} + if ASize > 0 then + begin + Result := AllocateLargeBlock(ASize {$ifdef LogLockContention}, LDidSleep{$endif}); +{$ifdef LogLockContention} + if LDidSleep then + ACollector := @LargeBlockCollector; +{$endif} + end + else + Result := nil; + end; + end; +{$ifdef LogLockContention} +{$ifndef FullDebugMode} + if Assigned(ACollector) then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + MediumBlockCollector.Add(@LStackTrace[0], StackTraceDepth); + end; +{$endif} +{$endif} +end; +{$else} +{$ifdef 32Bit} +asm + {On entry: + eax = ASize} + {Since most allocations are for small blocks, determine the small block type + index so long} + lea edx, [eax + BlockHeaderSize - 1] +{$ifdef Align16Bytes} + shr edx, 4 +{$else} + shr edx, 3 +{$endif} + {Is it a small block?} + cmp eax, (MaximumSmallBlockSize - BlockHeaderSize) + {Save ebx} + push ebx + {Get the IsMultiThread variable so long} +{$ifndef AssumeMultiThreaded} + {$ifndef fpc} + mov cl, IsMultiThread + {$else} + mov cl, BYTE IsMultiThread + {$endif} +{$endif} + {Is it a small block?} + ja @NotASmallBlock + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + test cl, cl +{$endif} + {Get the small block type in ebx} + movzx eax, byte ptr [AllocSize2SmallBlockTypeIndX4 + edx] + lea ebx, [SmallBlockTypes + eax * 8] + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + jnz @LockBlockTypeLoop +{$else} + jmp @LockBlockTypeLoop + {Align branch target} + nop + nop +{$endif} +@GotLockOnSmallBlockType: + {Find the next free block: Get the first pool with free blocks in edx} + mov edx, TSmallBlockType[ebx].NextPartiallyFreePool + {Get the first free block (or the next sequential feed address if edx = ebx)} + mov eax, TSmallBlockPoolHeader[edx].FirstFreeBlock + {Get the drop flags mask in ecx so long} + mov ecx, DropSmallFlagsMask + {Is there a pool with free blocks?} + cmp edx, ebx + je @TrySmallSequentialFeed + {Increment the number of used blocks} + add TSmallBlockPoolHeader[edx].BlocksInUse, 1 + {Get the new first free block} + and ecx, [eax - 4] + {Set the new first free block} + mov TSmallBlockPoolHeader[edx].FirstFreeBlock, ecx + {Set the block header} + mov [eax - 4], edx + {Is the chunk now full?} + jz @RemoveSmallPool + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, False + {Restore ebx} + pop ebx + {All done} + ret + {Align branch target} +{$ifndef AssumeMultiThreaded} + nop + nop +{$endif} + nop +@TrySmallSequentialFeed: + {Try to feed a small block sequentially: Get the sequential feed block pool} + mov edx, TSmallBlockType[ebx].CurrentSequentialFeedPool + {Get the next sequential feed address so long} + movzx ecx, TSmallBlockType[ebx].BlockSize + add ecx, eax + {Can another block fit?} + cmp eax, TSmallBlockType[ebx].MaxSequentialFeedBlockAddress + ja @AllocateSmallBlockPool + {Increment the number of used blocks in the sequential feed pool} + add TSmallBlockPoolHeader[edx].BlocksInUse, 1 + {Store the next sequential feed block address} + mov TSmallBlockType[ebx].NextSequentialFeedBlockAddress, ecx + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, False + {Set the block header} + mov [eax - 4], edx + {Restore ebx} + pop ebx + {All done} + ret + {Align branch target} + nop + nop + nop +@RemoveSmallPool: + {Pool is full - remove it from the partially free list} + mov ecx, TSmallBlockPoolHeader[edx].NextPartiallyFreePool + mov TSmallBlockPoolHeader[ecx].PreviousPartiallyFreePool, ebx + mov TSmallBlockType[ebx].NextPartiallyFreePool, ecx + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, False + {Restore ebx} + pop ebx + {All done} + ret + {Align branch target} + nop + nop +@LockBlockTypeLoop: + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Try the next size} + add ebx, Type(TSmallBlockType) + mov eax, $100 + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Try the next size (up to two sizes larger)} + add ebx, Type(TSmallBlockType) + mov eax, $100 + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Block type and two sizes larger are all locked - give up and sleep} + sub ebx, 2 * Type(TSmallBlockType) +{$ifdef NeverSleepOnThreadContention} + {Pause instruction (improves performance on P4)} + rep nop + {$ifdef UseSwitchToThread} + call SwitchToThread + {$endif} + {Try again} + jmp @LockBlockTypeLoop + {Align branch target} + nop + {$ifndef UseSwitchToThread} + nop + {$endif} +{$else} + {Couldn't grab the block type - sleep and try again} + push InitialSleepTime + call Sleep + {Try again} + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Couldn't grab the block type - sleep and try again} + push AdditionalSleepTime + call Sleep + {Try again} + jmp @LockBlockTypeLoop + {Align branch target} + nop + nop + nop +{$endif} +@AllocateSmallBlockPool: + {save additional registers} + push esi + push edi + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + cmp IsMultiThread, False + je @MediumBlocksLockedForPool +{$endif} + call LockMediumBlocks +@MediumBlocksLockedForPool: + {Are there any available blocks of a suitable size?} + movsx esi, TSmallBlockType[ebx].AllowedGroupsForBlockPoolBitmap + and esi, MediumBlockBinGroupBitmap + jz @NoSuitableMediumBlocks + {Get the bin group number with free blocks in eax} + bsf eax, esi + {Get the bin number in ecx} + lea esi, [eax * 8] + mov ecx, dword ptr [MediumBlockBinBitmaps + eax * 4] + bsf ecx, ecx + lea ecx, [ecx + esi * 4] + {Get a pointer to the bin in edi} + lea edi, [MediumBlockBins + ecx * 8] + {Get the free block in esi} + mov esi, TMediumFreeBlock[edi].NextFreeBlock + {Remove the first block from the linked list (LIFO)} + mov edx, TMediumFreeBlock[esi].NextFreeBlock + mov TMediumFreeBlock[edi].NextFreeBlock, edx + mov TMediumFreeBlock[edx].PreviousFreeBlock, edi + {Is this bin now empty?} + cmp edi, edx + jne @MediumBinNotEmpty + {eax = bin group number, ecx = bin number, edi = @bin, esi = free block, ebx = block type} + {Flag this bin as empty} + mov edx, -2 + rol edx, cl + and dword ptr [MediumBlockBinBitmaps + eax * 4], edx + jnz @MediumBinNotEmpty + {Flag the group as empty} + btr MediumBlockBinGroupBitmap, eax +@MediumBinNotEmpty: + {esi = free block, ebx = block type} + {Get the size of the available medium block in edi} + mov edi, DropMediumAndLargeFlagsMask + and edi, [esi - 4] + cmp edi, MaximumSmallBlockPoolSize + jb @UseWholeBlock + {Split the block: get the size of the second part, new block size is the + optimal size} + mov edx, edi + movzx edi, TSmallBlockType[ebx].OptimalBlockPoolSize + sub edx, edi + {Split the block in two} + lea eax, [esi + edi] + lea ecx, [edx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [eax - 4], ecx + {Store the size of the second split as the second last dword} + mov [eax + edx - 8], edx + {Put the remainder in a bin (it will be big enough)} + call InsertMediumBlockIntoBin + jmp @GotMediumBlock + {Align branch target} +{$ifdef AssumeMultiThreaded} + nop +{$endif} +@NoSuitableMediumBlocks: + {Check the sequential feed medium block pool for space} + movzx ecx, TSmallBlockType[ebx].MinimumBlockPoolSize + mov edi, MediumSequentialFeedBytesLeft + cmp edi, ecx + jb @AllocateNewSequentialFeed + {Get the address of the last block that was fed} + mov esi, LastSequentiallyFedMediumBlock + {Enough sequential feed space: Will the remainder be usable?} + movzx ecx, TSmallBlockType[ebx].OptimalBlockPoolSize + lea edx, [ecx + MinimumMediumBlockSize] + cmp edi, edx + jb @NotMuchSpace + mov edi, ecx +@NotMuchSpace: + sub esi, edi + {Update the sequential feed parameters} + sub MediumSequentialFeedBytesLeft, edi + mov LastSequentiallyFedMediumBlock, esi + {Get the block pointer} + jmp @GotMediumBlock + {Align branch target} +@AllocateNewSequentialFeed: + {Need to allocate a new sequential feed medium block pool: use the + optimal size for this small block pool} + movzx eax, TSmallBlockType[ebx].OptimalBlockPoolSize + mov edi, eax + {Allocate the medium block pool} + call AllocNewSequentialFeedMediumPool + mov esi, eax + test eax, eax + jnz @GotMediumBlock + mov MediumBlocksLocked, al + mov TSmallBlockType[ebx].BlockTypeLocked, al + pop edi + pop esi + pop ebx + ret + {Align branch target} +@UseWholeBlock: + {esi = free block, ebx = block type, edi = block size} + {Mark this block as used in the block following it} + and byte ptr [esi + edi - 4], not PreviousMediumBlockIsFreeFlag +@GotMediumBlock: + {esi = free block, ebx = block type, edi = block size} + {Set the size and flags for this block} + lea ecx, [edi + IsMediumBlockFlag + IsSmallBlockPoolInUseFlag] + mov [esi - 4], ecx + {Unlock medium blocks} + xor eax, eax + mov MediumBlocksLocked, al + {Set up the block pool} + mov TSmallBlockPoolHeader[esi].BlockType, ebx + mov TSmallBlockPoolHeader[esi].FirstFreeBlock, eax + mov TSmallBlockPoolHeader[esi].BlocksInUse, 1 + {Set it up for sequential block serving} + mov TSmallBlockType[ebx].CurrentSequentialFeedPool, esi + {Return the pointer to the first block} + lea eax, [esi + SmallBlockPoolHeaderSize] + movzx ecx, TSmallBlockType[ebx].BlockSize + lea edx, [eax + ecx] + mov TSmallBlockType[ebx].NextSequentialFeedBlockAddress, edx + add edi, esi + sub edi, ecx + mov TSmallBlockType[ebx].MaxSequentialFeedBlockAddress, edi + {Unlock the small block type} + mov TSmallBlockType[ebx].BlockTypeLocked, False + {Set the small block header} + mov [eax - 4], esi + {Restore registers} + pop edi + pop esi + pop ebx + {Done} + ret +{-------------------Medium block allocation-------------------} + {Align branch target} + nop +@NotASmallBlock: + cmp eax, (MaximumMediumBlockSize - BlockHeaderSize) + ja @IsALargeBlockRequest + {Get the bin size for this block size. Block sizes are + rounded up to the next bin size.} + lea ebx, [eax + MediumBlockGranularity - 1 + BlockHeaderSize - MediumBlockSizeOffset] + and ebx, -MediumBlockGranularity + add ebx, MediumBlockSizeOffset + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + test cl, cl + jz @MediumBlocksLocked +{$endif} + call LockMediumBlocks +@MediumBlocksLocked: + {Get the bin number in ecx and the group number in edx} + lea edx, [ebx - MinimumMediumBlockSize] + mov ecx, edx + shr edx, 8 + 5 + shr ecx, 8 + {Is there a suitable block inside this group?} + mov eax, -1 + shl eax, cl + and eax, dword ptr [MediumBlockBinBitmaps + edx * 4] + jz @GroupIsEmpty + {Get the actual bin number} + and ecx, -32 + bsf eax, eax + or ecx, eax + jmp @GotBinAndGroup + {Align branch target} + nop +@GroupIsEmpty: + {Try all groups greater than this group} + mov eax, -2 + mov ecx, edx + shl eax, cl + and eax, MediumBlockBinGroupBitmap + jz @TrySequentialFeedMedium + {There is a suitable group with space: get the bin number} + bsf edx, eax + {Get the bin in the group with free blocks} + mov eax, dword ptr [MediumBlockBinBitmaps + edx * 4] + bsf ecx, eax + mov eax, edx + shl eax, 5 + or ecx, eax + jmp @GotBinAndGroup + {Align branch target} + nop +@TrySequentialFeedMedium: + mov ecx, MediumSequentialFeedBytesLeft + {Block can be fed sequentially?} + sub ecx, ebx + jc @AllocateNewSequentialFeedForMedium + {Get the block address} + mov eax, LastSequentiallyFedMediumBlock + sub eax, ebx + mov LastSequentiallyFedMediumBlock, eax + {Store the remaining bytes} + mov MediumSequentialFeedBytesLeft, ecx + {Set the flags for the block} + or ebx, IsMediumBlockFlag + mov [eax - 4], ebx + jmp @MediumBlockGetDone + {Align branch target} +@AllocateNewSequentialFeedForMedium: + mov eax, ebx + call AllocNewSequentialFeedMediumPool +@MediumBlockGetDone: + mov MediumBlocksLocked, False + pop ebx + ret + {Align branch target} +@GotBinAndGroup: + {ebx = block size, ecx = bin number, edx = group number} + push esi + push edi + {Get a pointer to the bin in edi} + lea edi, [MediumBlockBins + ecx * 8] + {Get the free block in esi} + mov esi, TMediumFreeBlock[edi].NextFreeBlock + {Remove the first block from the linked list (LIFO)} + mov eax, TMediumFreeBlock[esi].NextFreeBlock + mov TMediumFreeBlock[edi].NextFreeBlock, eax + mov TMediumFreeBlock[eax].PreviousFreeBlock, edi + {Is this bin now empty?} + cmp edi, eax + jne @MediumBinNotEmptyForMedium + {eax = bin group number, ecx = bin number, edi = @bin, esi = free block, ebx = block size} + {Flag this bin as empty} + mov eax, -2 + rol eax, cl + and dword ptr [MediumBlockBinBitmaps + edx * 4], eax + jnz @MediumBinNotEmptyForMedium + {Flag the group as empty} + btr MediumBlockBinGroupBitmap, edx +@MediumBinNotEmptyForMedium: + {esi = free block, ebx = block size} + {Get the size of the available medium block in edi} + mov edi, DropMediumAndLargeFlagsMask + and edi, [esi - 4] + {Get the size of the second split in edx} + mov edx, edi + sub edx, ebx + jz @UseWholeBlockForMedium + {Split the block in two} + lea eax, [esi + ebx] + lea ecx, [edx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [eax - 4], ecx + {Store the size of the second split as the second last dword} + mov [eax + edx - 8], edx + {Put the remainder in a bin} + cmp edx, MinimumMediumBlockSize + jb @GotMediumBlockForMedium + call InsertMediumBlockIntoBin + jmp @GotMediumBlockForMedium + {Align branch target} + nop + nop + nop +@UseWholeBlockForMedium: + {Mark this block as used in the block following it} + and byte ptr [esi + edi - 4], not PreviousMediumBlockIsFreeFlag +@GotMediumBlockForMedium: + {Set the size and flags for this block} + lea ecx, [ebx + IsMediumBlockFlag] + mov [esi - 4], ecx + {Unlock medium blocks} + mov MediumBlocksLocked, False + mov eax, esi + pop edi + pop esi + pop ebx + ret +{-------------------Large block allocation-------------------} + {Align branch target} +@IsALargeBlockRequest: + pop ebx + test eax, eax + jns AllocateLargeBlock + xor eax, eax +end; +{$else} +{64-bit BASM implementation} +asm + {On entry: + rcx = ASize} + .params 2 + .pushnv rbx + .pushnv rsi + .pushnv rdi + {Since most allocations are for small blocks, determine the small block type + index so long} + lea edx, [ecx + BlockHeaderSize - 1] +{$ifdef Align16Bytes} + shr edx, 4 +{$else} + shr edx, 3 +{$endif} + {Preload the addresses of some small block structures} + lea r8, AllocSize2SmallBlockTypeIndX4 + lea rbx, SmallBlockTypes +{$ifndef AssumeMultiThreaded} + {Get the IsMultiThread variable so long} + movzx esi, IsMultiThread +{$endif} + {Is it a small block?} + cmp rcx, (MaximumSmallBlockSize - BlockHeaderSize) + ja @NotASmallBlock + {Get the small block type pointer in rbx} + movzx ecx, byte ptr [r8 + rdx] + shl ecx, 4 //SizeOf(TSmallBlockType) = 64 + add rbx, rcx + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + test esi, esi + jnz @LockBlockTypeLoop +{$else} + jmp @LockBlockTypeLoop +{$endif} +@GotLockOnSmallBlockType: + {Find the next free block: Get the first pool with free blocks in rdx} + mov rdx, TSmallBlockType[rbx].NextPartiallyFreePool + {Get the first free block (or the next sequential feed address if rdx = rbx)} + mov rax, TSmallBlockPoolHeader[rdx].FirstFreeBlock + {Get the drop flags mask in rcx so long} + mov rcx, DropSmallFlagsMask + {Is there a pool with free blocks?} + cmp rdx, rbx + je @TrySmallSequentialFeed + {Increment the number of used blocks} + add TSmallBlockPoolHeader[rdx].BlocksInUse, 1 + {Get the new first free block} + and rcx, [rax - BlockHeaderSize] + {Set the new first free block} + mov TSmallBlockPoolHeader[rdx].FirstFreeBlock, rcx + {Set the block header} + mov [rax - BlockHeaderSize], rdx + {Is the chunk now full?} + jz @RemoveSmallPool + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, False + jmp @Done +@TrySmallSequentialFeed: + {Try to feed a small block sequentially: Get the sequential feed block pool} + mov rdx, TSmallBlockType[rbx].CurrentSequentialFeedPool + {Get the next sequential feed address so long} + movzx ecx, TSmallBlockType[rbx].BlockSize + add rcx, rax + {Can another block fit?} + cmp rax, TSmallBlockType[rbx].MaxSequentialFeedBlockAddress + ja @AllocateSmallBlockPool + {Increment the number of used blocks in the sequential feed pool} + add TSmallBlockPoolHeader[rdx].BlocksInUse, 1 + {Store the next sequential feed block address} + mov TSmallBlockType[rbx].NextSequentialFeedBlockAddress, rcx + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, False + {Set the block header} + mov [rax - BlockHeaderSize], rdx + jmp @Done +@RemoveSmallPool: + {Pool is full - remove it from the partially free list} + mov rcx, TSmallBlockPoolHeader[rdx].NextPartiallyFreePool + mov TSmallBlockPoolHeader[rcx].PreviousPartiallyFreePool, rbx + mov TSmallBlockType[rbx].NextPartiallyFreePool, rcx + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, False + jmp @Done +@LockBlockTypeLoop: + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Try the next size} + add rbx, Type(TSmallBlockType) + mov eax, $100 + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Try the next size (up to two sizes larger)} + add rbx, Type(TSmallBlockType) + mov eax, $100 + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Block type and two sizes larger are all locked - give up and sleep} + sub rbx, 2 * Type(TSmallBlockType) +{$ifdef NeverSleepOnThreadContention} + {Pause instruction (improves performance on P4)} + pause + {$ifdef UseSwitchToThread} + call SwitchToThread + {$endif} + {Try again} + jmp @LockBlockTypeLoop +{$else} + {Couldn't grab the block type - sleep and try again} + mov ecx, InitialSleepTime + call Sleep + {Try again} + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Couldn't grab the block type - sleep and try again} + mov ecx, AdditionalSleepTime + call Sleep + {Try again} + jmp @LockBlockTypeLoop +{$endif} +@AllocateSmallBlockPool: + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + test esi, esi + jz @MediumBlocksLockedForPool +{$endif} + call LockMediumBlocks +@MediumBlocksLockedForPool: + {Are there any available blocks of a suitable size?} + movsx esi, TSmallBlockType[rbx].AllowedGroupsForBlockPoolBitmap + and esi, MediumBlockBinGroupBitmap + jz @NoSuitableMediumBlocks + {Get the bin group number with free blocks in eax} + bsf eax, esi + {Get the bin number in ecx} + lea r8, MediumBlockBinBitmaps + lea r9, [rax * 4] + mov ecx, [r8 + r9] + bsf ecx, ecx + lea ecx, [ecx + r9d * 8] + {Get a pointer to the bin in edi} + lea rdi, MediumBlockBins + lea esi, [ecx * 8] + lea rdi, [rdi + rsi * 2] //SizeOf(TMediumBlockBin) = 16 + {Get the free block in rsi} + mov rsi, TMediumFreeBlock[rdi].NextFreeBlock + {Remove the first block from the linked list (LIFO)} + mov rdx, TMediumFreeBlock[rsi].NextFreeBlock + mov TMediumFreeBlock[rdi].NextFreeBlock, rdx + mov TMediumFreeBlock[rdx].PreviousFreeBlock, rdi + {Is this bin now empty?} + cmp rdi, rdx + jne @MediumBinNotEmpty + {r8 = @MediumBlockBinBitmaps, eax = bin group number, + r9 = bin group number * 4, ecx = bin number, edi = @bin, esi = free block, + ebx = block type} + {Flag this bin as empty} + mov edx, -2 + rol edx, cl + and [r8 + r9], edx + jnz @MediumBinNotEmpty + {Flag the group as empty} + btr MediumBlockBinGroupBitmap, eax +@MediumBinNotEmpty: + {esi = free block, ebx = block type} + {Get the size of the available medium block in edi} + mov rdi, DropMediumAndLargeFlagsMask + and rdi, [rsi - BlockHeaderSize] + cmp edi, MaximumSmallBlockPoolSize + jb @UseWholeBlock + {Split the block: get the size of the second part, new block size is the + optimal size} + mov edx, edi + movzx edi, TSmallBlockType[rbx].OptimalBlockPoolSize + sub edx, edi + {Split the block in two} + lea rcx, [rsi + rdi] + lea rax, [rdx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [rcx - BlockHeaderSize], rax + {Store the size of the second split as the second last qword} + mov [rcx + rdx - BlockHeaderSize * 2], rdx + {Put the remainder in a bin (it will be big enough)} + call InsertMediumBlockIntoBin + jmp @GotMediumBlock +@NoSuitableMediumBlocks: + {Check the sequential feed medium block pool for space} + movzx ecx, TSmallBlockType[rbx].MinimumBlockPoolSize + mov edi, MediumSequentialFeedBytesLeft + cmp edi, ecx + jb @AllocateNewSequentialFeed + {Get the address of the last block that was fed} + mov rsi, LastSequentiallyFedMediumBlock + {Enough sequential feed space: Will the remainder be usable?} + movzx ecx, TSmallBlockType[rbx].OptimalBlockPoolSize + lea edx, [ecx + MinimumMediumBlockSize] + cmp edi, edx + jb @NotMuchSpace + mov edi, ecx +@NotMuchSpace: + sub rsi, rdi + {Update the sequential feed parameters} + sub MediumSequentialFeedBytesLeft, edi + mov LastSequentiallyFedMediumBlock, rsi + {Get the block pointer} + jmp @GotMediumBlock + {Align branch target} +@AllocateNewSequentialFeed: + {Need to allocate a new sequential feed medium block pool: use the + optimal size for this small block pool} + movzx ecx, TSmallBlockType[rbx].OptimalBlockPoolSize + mov edi, ecx + {Allocate the medium block pool} + call AllocNewSequentialFeedMediumPool + mov rsi, rax + test rax, rax + jnz @GotMediumBlock + mov MediumBlocksLocked, al + mov TSmallBlockType[rbx].BlockTypeLocked, al + jmp @Done +@UseWholeBlock: + {rsi = free block, rbx = block type, edi = block size} + {Mark this block as used in the block following it} + and byte ptr [rsi + rdi - BlockHeaderSize], not PreviousMediumBlockIsFreeFlag +@GotMediumBlock: + {rsi = free block, rbx = block type, edi = block size} + {Set the size and flags for this block} + lea ecx, [edi + IsMediumBlockFlag + IsSmallBlockPoolInUseFlag] + mov [rsi - BlockHeaderSize], rcx + {Unlock medium blocks} + xor eax, eax + mov MediumBlocksLocked, al + {Set up the block pool} + mov TSmallBlockPoolHeader[rsi].BlockType, rbx + mov TSmallBlockPoolHeader[rsi].FirstFreeBlock, rax + mov TSmallBlockPoolHeader[rsi].BlocksInUse, 1 + {Set it up for sequential block serving} + mov TSmallBlockType[rbx].CurrentSequentialFeedPool, rsi + {Return the pointer to the first block} + lea rax, [rsi + SmallBlockPoolHeaderSize] + movzx ecx, TSmallBlockType[rbx].BlockSize + lea rdx, [rax + rcx] + mov TSmallBlockType[rbx].NextSequentialFeedBlockAddress, rdx + add rdi, rsi + sub rdi, rcx + mov TSmallBlockType[rbx].MaxSequentialFeedBlockAddress, rdi + {Unlock the small block type} + mov TSmallBlockType[rbx].BlockTypeLocked, False + {Set the small block header} + mov [rax - BlockHeaderSize], rsi + jmp @Done +{-------------------Medium block allocation-------------------} +@NotASmallBlock: + cmp rcx, (MaximumMediumBlockSize - BlockHeaderSize) + ja @IsALargeBlockRequest + {Get the bin size for this block size. Block sizes are + rounded up to the next bin size.} + lea ebx, [ecx + MediumBlockGranularity - 1 + BlockHeaderSize - MediumBlockSizeOffset] + and ebx, -MediumBlockGranularity + add ebx, MediumBlockSizeOffset + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + test esi, esi + jz @MediumBlocksLocked +{$endif} + call LockMediumBlocks +@MediumBlocksLocked: + {Get the bin number in ecx and the group number in edx} + lea edx, [ebx - MinimumMediumBlockSize] + mov ecx, edx + shr edx, 8 + 5 + shr ecx, 8 + {Is there a suitable block inside this group?} + mov eax, -1 + shl eax, cl + lea r8, MediumBlockBinBitmaps + and eax, [r8 + rdx * 4] + jz @GroupIsEmpty + {Get the actual bin number} + and ecx, -32 + bsf eax, eax + or ecx, eax + jmp @GotBinAndGroup +@GroupIsEmpty: + {Try all groups greater than this group} + mov eax, -2 + mov ecx, edx + shl eax, cl + and eax, MediumBlockBinGroupBitmap + jz @TrySequentialFeedMedium + {There is a suitable group with space: get the bin number} + bsf edx, eax + {Get the bin in the group with free blocks} + mov eax, [r8 + rdx * 4] + bsf ecx, eax + mov eax, edx + shl eax, 5 + or ecx, eax + jmp @GotBinAndGroup +@TrySequentialFeedMedium: + mov ecx, MediumSequentialFeedBytesLeft + {Block can be fed sequentially?} + sub ecx, ebx + jc @AllocateNewSequentialFeedForMedium + {Get the block address} + mov rax, LastSequentiallyFedMediumBlock + sub rax, rbx + mov LastSequentiallyFedMediumBlock, rax + {Store the remaining bytes} + mov MediumSequentialFeedBytesLeft, ecx + {Set the flags for the block} + or rbx, IsMediumBlockFlag + mov [rax - BlockHeaderSize], rbx + jmp @MediumBlockGetDone +@AllocateNewSequentialFeedForMedium: + mov ecx, ebx + call AllocNewSequentialFeedMediumPool +@MediumBlockGetDone: + xor cl, cl + mov MediumBlocksLocked, cl //workaround for QC99023 + jmp @Done +@GotBinAndGroup: + {ebx = block size, ecx = bin number, edx = group number} + {Get a pointer to the bin in edi} + lea rdi, MediumBlockBins + lea eax, [ecx + ecx] + lea rdi, [rdi + rax * 8] + {Get the free block in esi} + mov rsi, TMediumFreeBlock[rdi].NextFreeBlock + {Remove the first block from the linked list (LIFO)} + mov rax, TMediumFreeBlock[rsi].NextFreeBlock + mov TMediumFreeBlock[rdi].NextFreeBlock, rax + mov TMediumFreeBlock[rax].PreviousFreeBlock, rdi + {Is this bin now empty?} + cmp rdi, rax + jne @MediumBinNotEmptyForMedium + {edx = bin group number, ecx = bin number, rdi = @bin, rsi = free block, ebx = block size} + {Flag this bin as empty} + mov eax, -2 + rol eax, cl + lea r8, MediumBlockBinBitmaps + and [r8 + rdx * 4], eax + jnz @MediumBinNotEmptyForMedium + {Flag the group as empty} + btr MediumBlockBinGroupBitmap, edx +@MediumBinNotEmptyForMedium: + {rsi = free block, ebx = block size} + {Get the size of the available medium block in edi} + mov rdi, DropMediumAndLargeFlagsMask + and rdi, [rsi - BlockHeaderSize] + {Get the size of the second split in edx} + mov edx, edi + sub edx, ebx + jz @UseWholeBlockForMedium + {Split the block in two} + lea rcx, [rsi + rbx] + lea rax, [rdx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [rcx - BlockHeaderSize], rax + {Store the size of the second split as the second last dword} + mov [rcx + rdx - BlockHeaderSize * 2], rdx + {Put the remainder in a bin} + cmp edx, MinimumMediumBlockSize + jb @GotMediumBlockForMedium + call InsertMediumBlockIntoBin + jmp @GotMediumBlockForMedium +@UseWholeBlockForMedium: + {Mark this block as used in the block following it} + and byte ptr [rsi + rdi - BlockHeaderSize], not PreviousMediumBlockIsFreeFlag +@GotMediumBlockForMedium: + {Set the size and flags for this block} + lea rcx, [rbx + IsMediumBlockFlag] + mov [rsi - BlockHeaderSize], rcx + {Unlock medium blocks} + xor cl, cl + mov MediumBlocksLocked, cl //workaround for QC99023 + mov rax, rsi + jmp @Done +{-------------------Large block allocation-------------------} +@IsALargeBlockRequest: + xor rax, rax + test rcx, rcx + js @Done + call AllocateLargeBlock +@Done: +end; +{$endif} +{$endif} + +{$ifndef ASMVersion} +{Frees a medium block, returning 0 on success, -1 otherwise} +function FreeMediumBlock(APointer: Pointer + {$ifdef UseReleaseStack}; ACleanupOperation: Boolean = false{$endif}): Integer; +var + LNextMediumBlock{$ifndef FullDebugMode}, LPreviousMediumBlock{$endif}: PMediumFreeBlock; + LNextMediumBlockSizeAndFlags: NativeUInt; + LBlockSize{$ifndef FullDebugMode}, LPreviousMediumBlockSize{$endif}: Cardinal; +{$ifndef FullDebugMode} + LPPreviousMediumBlockPoolHeader, LPNextMediumBlockPoolHeader: PMediumBlockPoolHeader; +{$endif} + LBlockHeader: NativeUInt; +{$ifdef LogLockContention} + LDidSleep: Boolean; + LStackTrace: TStackTrace; +{$endif} +{$ifdef UseReleaseStack} + LDelayRelease: Boolean; + LPReleaseStack: ^TLFStack; +{$endif} +begin + {Get the block header} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + {Get the medium block size} + LBlockSize := LBlockHeader and DropMediumAndLargeFlagsMask; + {When running a cleanup operation, medium blocks are already locked.} +{$ifdef UseReleaseStack} + if not ACleanupOperation then + begin +{$endif} + {Lock the medium blocks} + LockMediumBlocks( + {$ifdef LogLockContention}LDidSleep{$ifdef UseReleaseStack},{$endif}{$endif} + {$ifdef UseReleaseStack}APointer, @LDelayRelease{$endif}); +{$ifdef UseReleaseStack} + if LDelayRelease then + begin + Result := 0; + Exit; + end; + {$ifdef LogLockContention} + end + else + LDidSleep := False; + {$else} + end; + {$endif} +{$endif} +{$ifdef LogLockContention} + if LDidSleep then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + MediumBlockCollector.Add(@LStackTrace[0], StackTraceDepth); + end; +{$endif} +{$ifdef UseReleaseStack} + repeat +{$endif} + {Can we combine this block with the next free block?} + LNextMediumBlock := PMediumFreeBlock(PByte(APointer) + LBlockSize); + LNextMediumBlockSizeAndFlags := PNativeUInt(PByte(LNextMediumBlock) - BlockHeaderSize)^; +{$ifndef FullDebugMode} +{$ifdef CheckHeapForCorruption} + {Check that this block was flagged as in use in the next block} + if (LNextMediumBlockSizeAndFlags and PreviousMediumBlockIsFreeFlag) <> 0 then +{$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); +{$else} + System.RunError(reInvalidPtr); +{$endif} +{$endif} + if (LNextMediumBlockSizeAndFlags and IsFreeBlockFlag) <> 0 then + begin + {Increase the size of this block} + Inc(LBlockSize, LNextMediumBlockSizeAndFlags and DropMediumAndLargeFlagsMask); + {Remove the next block as well} + if LNextMediumBlockSizeAndFlags >= MinimumMediumBlockSize then + RemoveMediumFreeBlock(LNextMediumBlock); + end + else + begin +{$endif} + {Reset the "previous in use" flag of the next block} + PNativeUInt(PByte(LNextMediumBlock) - BlockHeaderSize)^ := LNextMediumBlockSizeAndFlags or PreviousMediumBlockIsFreeFlag; +{$ifndef FullDebugMode} + end; + {Can we combine this block with the previous free block? We need to + re-read the flags since it could have changed before we could lock the + medium blocks.} + if (PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and PreviousMediumBlockIsFreeFlag) <> 0 then + begin + {Get the size of the free block just before this one} + LPreviousMediumBlockSize := PNativeUInt(PByte(APointer) - 2 * BlockHeaderSize)^; + {Get the start of the previous block} + LPreviousMediumBlock := PMediumFreeBlock(PByte(APointer) - LPreviousMediumBlockSize); +{$ifdef CheckHeapForCorruption} + {Check that the previous block is actually free} + if (PNativeUInt(PByte(LPreviousMediumBlock) - BlockHeaderSize)^ and ExtractMediumAndLargeFlagsMask) <> (IsMediumBlockFlag or IsFreeBlockFlag) then +{$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); +{$else} + System.RunError(reInvalidPtr); +{$endif} +{$endif} + {Set the new block size} + Inc(LBlockSize, LPreviousMediumBlockSize); + {This is the new current block} + APointer := LPreviousMediumBlock; + {Remove the previous block from the linked list} + if LPreviousMediumBlockSize >= MinimumMediumBlockSize then + RemoveMediumFreeBlock(LPreviousMediumBlock); + end; +{$ifdef CheckHeapForCorruption} + {Check that the previous block is currently flagged as in use} + if (PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and PreviousMediumBlockIsFreeFlag) <> 0 then +{$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); +{$else} + System.RunError(reInvalidPtr); +{$endif} +{$endif} + {Is the entire medium block pool free, and there are other free blocks + that can fit the largest possible medium block? -> free it. (Except in + full debug mode where medium pools are never freed.)} + if (LBlockSize <> (MediumBlockPoolSize - MediumBlockPoolHeaderSize)) then + begin + {Store the size of the block as well as the flags} + PNativeUInt(PByte(APointer) - BlockHeaderSize)^ := LBlockSize or (IsMediumBlockFlag or IsFreeBlockFlag); +{$else} + {Mark the block as free} + Inc(PNativeUInt(PByte(APointer) - BlockHeaderSize)^, IsFreeBlockFlag); +{$endif} + {Store the trailing size marker} + PNativeUInt(PByte(APointer) + LBlockSize - 2 * BlockHeaderSize)^ := LBlockSize; + {Insert this block back into the bins: Size check not required here, + since medium blocks that are in use are not allowed to be + shrunk smaller than MinimumMediumBlockSize} + InsertMediumBlockIntoBin(APointer, LBlockSize); +{$ifndef FullDebugMode} +{$ifdef CheckHeapForCorruption} + {Check that this block is actually free and the next and previous blocks are both in use.} + if ((PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and ExtractMediumAndLargeFlagsMask) <> (IsMediumBlockFlag or IsFreeBlockFlag)) + or ((PNativeUInt(PByte(APointer) + (PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and DropMediumAndLargeFlagsMask) - BlockHeaderSize)^ and IsFreeBlockFlag) <> 0) then + begin +{$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); +{$else} + System.RunError(reInvalidPtr); +{$endif} + end; +{$endif} +{$endif} +{$ifndef UseReleaseStack} + {Unlock medium blocks} + MediumBlocksLocked := False; +{$endif} + {All OK} + Result := 0; +{$ifndef FullDebugMode} + end + else + begin + {Should this become the new sequential feed?} + if MediumSequentialFeedBytesLeft <> MediumBlockPoolSize - MediumBlockPoolHeaderSize then + begin + {Bin the current sequential feed} + BinMediumSequentialFeedRemainder; + {Set this medium pool up as the new sequential feed pool: + Store the sequential feed pool trailer} + PNativeUInt(PByte(APointer) + LBlockSize - BlockHeaderSize)^ := IsMediumBlockFlag; + {Store the number of bytes available in the sequential feed chunk} + MediumSequentialFeedBytesLeft := MediumBlockPoolSize - MediumBlockPoolHeaderSize; + {Set the last sequentially fed block} + LastSequentiallyFedMediumBlock := Pointer(PByte(APointer) + LBlockSize); +{$ifndef UseReleaseStack} + {Unlock medium blocks} + MediumBlocksLocked := False; +{$endif} + {Success} + Result := 0; + end + else + begin + {Remove this medium block pool from the linked list} + Dec(PByte(APointer), MediumBlockPoolHeaderSize); + LPPreviousMediumBlockPoolHeader := PMediumBlockPoolHeader(APointer).PreviousMediumBlockPoolHeader; + LPNextMediumBlockPoolHeader := PMediumBlockPoolHeader(APointer).NextMediumBlockPoolHeader; + LPPreviousMediumBlockPoolHeader.NextMediumBlockPoolHeader := LPNextMediumBlockPoolHeader; + LPNextMediumBlockPoolHeader.PreviousMediumBlockPoolHeader := LPPreviousMediumBlockPoolHeader; + {Unlock medium blocks} + MediumBlocksLocked := False; +{$ifdef ClearMediumBlockPoolsBeforeReturningToOS} + FillChar(APointer^, MediumBlockPoolSize, 0); +{$endif} + {Free the medium block pool} + if VirtualFree(APointer, 0, MEM_RELEASE) then + Result := 0 + else + Result := -1; +{$ifdef UseReleaseStack} + {Medium blocks are already unlocked so we can't continue unwinding the release stack.} + Break; +{$endif UseReleaseStack} + end; + end; +{$endif} +{$ifdef UseReleaseStack} + if (Result <> 0) or ACleanupOperation then + begin + MediumBlocksLocked := False; + Break; + end; + LPReleaseStack := @MediumReleaseStack[GetStackSlot]; + if LPReleaseStack^.IsEmpty or (not LPReleaseStack.Pop(APointer)) then + begin + MediumBlocksLocked := False; + Break; + end; + {Get the block header} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + {Get the medium block size} + LBlockSize := LBlockHeader and DropMediumAndLargeFlagsMask; + until False; +{$endif} +end; +{$endif} + +{Replacement for SysFreeMem} +function FastFreeMem(APointer: Pointer): {$ifdef fpc}NativeUInt{$else}Integer{$endif}; +{$ifndef ASMVersion} +var + LPSmallBlockPool{$ifndef FullDebugMode}, LPPreviousPool, LPNextPool{$endif}, + LPOldFirstPool: PSmallBlockPoolHeader; + LPSmallBlockType: PSmallBlockType; + LOldFirstFreeBlock: Pointer; + LBlockHeader: NativeUInt; +{$ifdef LogLockContention} + LDidSleep: Boolean; + LStackTrace: TStackTrace; +{$endif} +{$ifdef UseReleaseStack} + LPReleaseStack: ^TLFStack; +{$endif} +begin + {$ifdef fpc} + if APointer = nil then + begin + Result := 0; + Exit; + end; + {$endif} + {Get the small block header: Is it actually a small block?} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + {Is it a small block that is in use?} + if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag or IsLargeBlockFlag) = 0 then + begin + {Get a pointer to the block pool} + LPSmallBlockPool := PSmallBlockPoolHeader(LBlockHeader); + {Get the block type} + LPSmallBlockType := LPSmallBlockPool.BlockType; +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + FillChar(APointer^, LPSmallBlockType.BlockSize - BlockHeaderSize, 0); +{$endif} + {Lock the block type} +{$ifdef LogLockContention} + LDidSleep := False; +{$endif} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while (LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) <> 0) do + begin +{$ifdef UseReleaseStack} + LPReleaseStack := @LPSmallBlockType.ReleaseStack[GetStackSlot]; + if (not LPReleaseStack^.IsFull) and LPReleaseStack^.Push(APointer) then + begin + {Block will be released later.} + Result := 0; + Exit; + end; +{$endif} +{$ifdef LogLockContention} + LDidSleep := True; +{$endif} +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + if LockCmpxchg(0, 1, @LPSmallBlockType.BlockTypeLocked) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; + end; +{$ifdef LogLockContention} + if LDidSleep then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + LPSmallBlockType.BlockCollector.Add(@LStackTrace[0], StackTraceDepth); + end; +{$endif} +{$ifdef UseReleaseStack} + while True do + begin +{$endif} + {Get the old first free block} + LOldFirstFreeBlock := LPSmallBlockPool.FirstFreeBlock; + {Was the pool manager previously full?} + if LOldFirstFreeBlock = nil then + begin + {Insert this as the first partially free pool for the block size} + LPOldFirstPool := LPSmallBlockType.NextPartiallyFreePool; + LPSmallBlockPool.NextPartiallyFreePool := LPOldFirstPool; + LPOldFirstPool.PreviousPartiallyFreePool := LPSmallBlockPool; + LPSmallBlockPool.PreviousPartiallyFreePool := PSmallBlockPoolHeader(LPSmallBlockType); + LPSmallBlockType.NextPartiallyFreePool := LPSmallBlockPool; + end; + {Store the old first free block} + PNativeUInt(PByte(APointer) - BlockHeaderSize)^ := UIntPtr(LOldFirstFreeBlock) or IsFreeBlockFlag; + {Store this as the new first free block} + LPSmallBlockPool.FirstFreeBlock := APointer; + {Decrement the number of allocated blocks} + Dec(LPSmallBlockPool.BlocksInUse); + {Small block pools are never freed in full debug mode. This increases the + likehood of success in catching objects still being used after being + destroyed.} +{$ifndef FullDebugMode} + {Is the entire pool now free? -> Free it.} + if LPSmallBlockPool.BlocksInUse = 0 then + begin + {Get the previous and next chunk managers} + LPPreviousPool := LPSmallBlockPool.PreviousPartiallyFreePool; + LPNextPool := LPSmallBlockPool.NextPartiallyFreePool; + {Remove this manager} + LPPreviousPool.NextPartiallyFreePool := LPNextPool; + LPNextPool.PreviousPartiallyFreePool := LPPreviousPool; + {Is this the sequential feed pool? If so, stop sequential feeding} + if (LPSmallBlockType.CurrentSequentialFeedPool = LPSmallBlockPool) then + LPSmallBlockType.MaxSequentialFeedBlockAddress := nil; + {Unlock this block type} + LPSmallBlockType.BlockTypeLocked := False; + {Free the block pool} + FreeMediumBlock(LPSmallBlockPool); +{$ifdef UseReleaseStack} + {Stop unwinding the release stack.} + Break; +{$endif} + end + else + begin +{$endif} +{$ifdef UseReleaseStack} + LPReleaseStack := @LPSmallBlockType.ReleaseStack[GetStackSlot]; + if LPReleaseStack^.IsEmpty or (not LPReleaseStack^.Pop(APointer)) then + begin +{$endif} + {Unlock this block type} + LPSmallBlockType.BlockTypeLocked := False; +{$ifdef UseReleaseStack} + Break; + end; + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + LPSmallBlockPool := PSmallBlockPoolHeader(LBlockHeader); +{$endif} +{$ifndef FullDebugMode} + end; +{$endif} +{$ifdef UseReleaseStack} + end; +{$endif} + {No error} + Result := 0; + end + else + begin + {Is this a medium block or a large block?} + if LBlockHeader and (IsFreeBlockFlag or IsLargeBlockFlag) = 0 then + begin +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + {Get the block header, extract the block size and clear the block it.} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + FillChar(APointer^, + (LBlockHeader and DropMediumAndLargeFlagsMask) - BlockHeaderSize, 0); +{$endif} + Result := FreeMediumBlock(APointer); + end + else + begin + {Validate: Is this actually a Large block, or is it an attempt to free an + already freed small block?} + if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag) = 0 then + Result := FreeLargeBlock(APointer) + else + Result := -1; + end; + end; +end; +{$else} +{$ifdef 32Bit} +asm + {$ifdef fpc} + test eax, eax + jne @PointerNotNil + ret +@PointerNotNil: + {$endif} + {Get the block header in edx} + mov edx, [eax - 4] + {Is it a small block in use?} + test dl, IsFreeBlockFlag + IsMediumBlockFlag + IsLargeBlockFlag + {Save the pointer in ecx} + mov ecx, eax + {Save ebx} + push ebx + {Get the IsMultiThread variable in bl} +{$ifndef AssumeMultiThreaded} + {$ifndef fpc} + mov bl, IsMultiThread + {$else} + mov bl, BYTE IsMultiThread + {$endif} +{$endif} + {Is it a small block that is in use?} + jnz @NotSmallBlockInUse +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + push edx + push ecx + mov edx, TSmallBlockPoolHeader[edx].BlockType + movzx edx, TSmallBlockType(edx).BlockSize + sub edx, BlockHeaderSize + xor ecx, ecx + call System.@FillChar + pop ecx + pop edx +{$endif} + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + test bl, bl +{$endif} + {Get the small block type in ebx} + mov ebx, TSmallBlockPoolHeader[edx].BlockType + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + jnz @LockBlockTypeLoop +{$else} + jmp @LockBlockTypeLoop + {Align branch target} + nop +{$endif} +@GotLockOnSmallBlockType: + {Current state: edx = @SmallBlockPoolHeader, ecx = APointer, ebx = @SmallBlockType} + {Decrement the number of blocks in use} + sub TSmallBlockPoolHeader[edx].BlocksInUse, 1 + {Get the old first free block} + mov eax, TSmallBlockPoolHeader[edx].FirstFreeBlock + {Is the pool now empty?} + jz @PoolIsNowEmpty + {Was the pool full?} + test eax, eax + {Store this as the new first free block} + mov TSmallBlockPoolHeader[edx].FirstFreeBlock, ecx + {Store the previous first free block as the block header} + lea eax, [eax + IsFreeBlockFlag] + mov [ecx - 4], eax + {Insert the pool back into the linked list if it was full} + jz @SmallPoolWasFull + {All ok} + xor eax, eax + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, al + {Restore registers} + pop ebx + {Done} + ret + {Align branch target} +{$ifndef AssumeMultiThreaded} + nop +{$endif} +@SmallPoolWasFull: + {Insert this as the first partially free pool for the block size} + mov ecx, TSmallBlockType[ebx].NextPartiallyFreePool + mov TSmallBlockPoolHeader[edx].PreviousPartiallyFreePool, ebx + mov TSmallBlockPoolHeader[edx].NextPartiallyFreePool, ecx + mov TSmallBlockPoolHeader[ecx].PreviousPartiallyFreePool, edx + mov TSmallBlockType[ebx].NextPartiallyFreePool, edx + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, False + {All ok} + xor eax, eax + {Restore registers} + pop ebx + {Done} + ret + {Align branch target} + nop + nop +@PoolIsNowEmpty: + {Was this pool actually in the linked list of pools with space? If not, it + can only be the sequential feed pool (it is the only pool that may contain + only one block, i.e. other blocks have not been split off yet)} + test eax, eax + jz @IsSequentialFeedPool + {Pool is now empty: Remove it from the linked list and free it} + mov eax, TSmallBlockPoolHeader[edx].PreviousPartiallyFreePool + mov ecx, TSmallBlockPoolHeader[edx].NextPartiallyFreePool + {Remove this manager} + mov TSmallBlockPoolHeader[eax].NextPartiallyFreePool, ecx + mov TSmallBlockPoolHeader[ecx].PreviousPartiallyFreePool, eax + {Zero out eax} + xor eax, eax + {Is this the sequential feed pool? If so, stop sequential feeding} + cmp TSmallBlockType[ebx].CurrentSequentialFeedPool, edx + jne @NotSequentialFeedPool +@IsSequentialFeedPool: + mov TSmallBlockType[ebx].MaxSequentialFeedBlockAddress, eax +@NotSequentialFeedPool: + {Unlock the block type} + mov TSmallBlockType[ebx].BlockTypeLocked, al + {Release this pool} + mov eax, edx + mov edx, [edx - 4] +{$ifndef AssumeMultiThreaded} + {$ifndef fpc} + mov bl, IsMultiThread + {$else} + mov bl, BYTE IsMultiThread + {$endif} +{$endif} + jmp @FreeMediumBlock + {Align branch target} +{$ifndef AssumeMultiThreaded} + nop + nop +{$endif} + nop +@LockBlockTypeLoop: + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType +{$ifdef NeverSleepOnThreadContention} + {Pause instruction (improves performance on P4)} + rep nop + {$ifdef UseSwitchToThread} + push ecx + push edx + call SwitchToThread + pop edx + pop ecx + {$endif} + {Try again} + jmp @LockBlockTypeLoop + {Align branch target} + {$ifndef UseSwitchToThread} + nop + {$endif} +{$else} + {Couldn't grab the block type - sleep and try again} + push ecx + push edx + push InitialSleepTime + call Sleep + pop edx + pop ecx + {Try again} + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([ebx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Couldn't grab the block type - sleep and try again} + push ecx + push edx + push AdditionalSleepTime + call Sleep + pop edx + pop ecx + {Try again} + jmp @LockBlockTypeLoop + {Align branch target} + nop + nop +{$endif} + {---------------------Medium blocks------------------------------} + {Align branch target} +@NotSmallBlockInUse: + {Not a small block in use: is it a medium or large block?} + test dl, IsFreeBlockFlag + IsLargeBlockFlag + jnz @NotASmallOrMediumBlock +@FreeMediumBlock: +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + push eax + push edx + and edx, DropMediumAndLargeFlagsMask + sub edx, BlockHeaderSize + xor ecx, ecx + call System.@FillChar + pop edx + pop eax +{$endif} + {Drop the flags} + and edx, DropMediumAndLargeFlagsMask + {Free the medium block pointed to by eax, header in edx, bl = IsMultiThread} +{$ifndef AssumeMultiThreaded} + {Do we need to lock the medium blocks?} + test bl, bl +{$endif} + {Block size in ebx} + mov ebx, edx + {Save registers} + push esi + {Pointer in esi} + mov esi, eax + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + jz @MediumBlocksLocked +{$endif} + call LockMediumBlocks +@MediumBlocksLocked: + {Can we combine this block with the next free block?} + test dword ptr [esi + ebx - 4], IsFreeBlockFlag + {Get the next block size and flags in ecx} + mov ecx, [esi + ebx - 4] + jnz @NextBlockIsFree + {Set the "PreviousIsFree" flag in the next block} + or ecx, PreviousMediumBlockIsFreeFlag + mov [esi + ebx - 4], ecx +@NextBlockChecked: + {Can we combine this block with the previous free block? We need to + re-read the flags since it could have changed before we could lock the + medium blocks.} + test byte ptr [esi - 4], PreviousMediumBlockIsFreeFlag + jnz @PreviousBlockIsFree +@PreviousBlockChecked: + {Is the entire medium block pool free, and there are other free blocks + that can fit the largest possible medium block -> free it.} + cmp ebx, (MediumBlockPoolSize - MediumBlockPoolHeaderSize) + je @EntireMediumPoolFree +@BinFreeMediumBlock: + {Store the size of the block as well as the flags} + lea eax, [ebx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [esi - 4], eax + {Store the trailing size marker} + mov [esi + ebx - 8], ebx + {Insert this block back into the bins: Size check not required here, + since medium blocks that are in use are not allowed to be + shrunk smaller than MinimumMediumBlockSize} + mov eax, esi + mov edx, ebx + {Insert into bin} + call InsertMediumBlockIntoBin + {Unlock medium blocks} + mov MediumBlocksLocked, False; + {All OK} + xor eax, eax + {Restore registers} + pop esi + pop ebx + {Return} + ret + {Align branch target} +@NextBlockIsFree: + {Get the next block address in eax} + lea eax, [esi + ebx] + {Increase the size of this block} + and ecx, DropMediumAndLargeFlagsMask + add ebx, ecx + {Was the block binned?} + cmp ecx, MinimumMediumBlockSize + jb @NextBlockChecked + call RemoveMediumFreeBlock + jmp @NextBlockChecked + {Align branch target} + nop +@PreviousBlockIsFree: + {Get the size of the free block just before this one} + mov ecx, [esi - 8] + {Include the previous block} + sub esi, ecx + {Set the new block size} + add ebx, ecx + {Remove the previous block from the linked list} + cmp ecx, MinimumMediumBlockSize + jb @PreviousBlockChecked + mov eax, esi + call RemoveMediumFreeBlock + jmp @PreviousBlockChecked + {Align branch target} +@EntireMediumPoolFree: + {Should we make this the new sequential feed medium block pool? If the + current sequential feed pool is not entirely free, we make this the new + sequential feed pool.} + cmp MediumSequentialFeedBytesLeft, MediumBlockPoolSize - MediumBlockPoolHeaderSize + jne @MakeEmptyMediumPoolSequentialFeed + {Point esi to the medium block pool header} + sub esi, MediumBlockPoolHeaderSize + {Remove this medium block pool from the linked list} + mov eax, TMediumBlockPoolHeader[esi].PreviousMediumBlockPoolHeader + mov edx, TMediumBlockPoolHeader[esi].NextMediumBlockPoolHeader + mov TMediumBlockPoolHeader[eax].NextMediumBlockPoolHeader, edx + mov TMediumBlockPoolHeader[edx].PreviousMediumBlockPoolHeader, eax + {Unlock medium blocks} + mov MediumBlocksLocked, False; +{$ifdef ClearMediumBlockPoolsBeforeReturningToOS} + mov eax, esi + mov edx, MediumBlockPoolSize + xor ecx, ecx + call System.@FillChar +{$endif} + {Free the medium block pool} + push MEM_RELEASE + push 0 + push esi + call VirtualFree + {VirtualFree returns >0 if all is ok} + cmp eax, 1 + {Return 0 on all ok} + sbb eax, eax + {Restore registers} + pop esi + pop ebx + ret + {Align branch target} + nop + nop + nop +@MakeEmptyMediumPoolSequentialFeed: + {Get a pointer to the end-marker block} + lea ebx, [esi + MediumBlockPoolSize - MediumBlockPoolHeaderSize] + {Bin the current sequential feed pool} + call BinMediumSequentialFeedRemainder + {Set this medium pool up as the new sequential feed pool: + Store the sequential feed pool trailer} + mov dword ptr [ebx - BlockHeaderSize], IsMediumBlockFlag + {Store the number of bytes available in the sequential feed chunk} + mov MediumSequentialFeedBytesLeft, MediumBlockPoolSize - MediumBlockPoolHeaderSize + {Set the last sequentially fed block} + mov LastSequentiallyFedMediumBlock, ebx + {Unlock medium blocks} + mov MediumBlocksLocked, False; + {Success} + xor eax, eax + {Restore registers} + pop esi + pop ebx + ret + {Align branch target} + nop + nop +@NotASmallOrMediumBlock: + {Restore ebx} + pop ebx + {Is it in fact a large block?} + test dl, IsFreeBlockFlag + IsMediumBlockFlag + jz FreeLargeBlock + {Attempt to free an already free block} + mov eax, -1 +end; + +{$else} + +{---------------64-bit BASM FastFreeMem---------------} +asm + .params 3 + .pushnv rbx + .pushnv rsi + {Get the block header in rdx} + mov rdx, [rcx - BlockHeaderSize] + {Is it a small block in use?} + test dl, IsFreeBlockFlag + IsMediumBlockFlag + IsLargeBlockFlag + {Get the IsMultiThread variable in bl} +{$ifndef AssumeMultiThreaded} + mov bl, IsMultiThread +{$endif} + {Is it a small block that is in use?} + jnz @NotSmallBlockInUse +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + mov rsi, rcx + mov rdx, TSmallBlockPoolHeader[rdx].BlockType + movzx edx, TSmallBlockType(rdx).BlockSize + sub edx, BlockHeaderSize + xor r8, r8 + call System.@FillChar + mov rcx, rsi + mov rdx, [rcx - BlockHeaderSize] +{$endif} + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + test bl, bl +{$endif} + {Get the small block type in rbx} + mov rbx, TSmallBlockPoolHeader[rdx].BlockType + {Do we need to lock the block type?} +{$ifndef AssumeMultiThreaded} + jnz @LockBlockTypeLoop +{$else} + jmp @LockBlockTypeLoop +{$endif} +@GotLockOnSmallBlockType: + {Current state: rdx = @SmallBlockPoolHeader, rcx = APointer, rbx = @SmallBlockType} + {Decrement the number of blocks in use} + sub TSmallBlockPoolHeader[rdx].BlocksInUse, 1 + {Get the old first free block} + mov rax, TSmallBlockPoolHeader[rdx].FirstFreeBlock + {Is the pool now empty?} + jz @PoolIsNowEmpty + {Was the pool full?} + test rax, rax + {Store this as the new first free block} + mov TSmallBlockPoolHeader[rdx].FirstFreeBlock, rcx + {Store the previous first free block as the block header} + lea rax, [rax + IsFreeBlockFlag] + mov [rcx - BlockHeaderSize], rax + {Insert the pool back into the linked list if it was full} + jz @SmallPoolWasFull + {All ok} + xor eax, eax + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, al + jmp @Done +@SmallPoolWasFull: + {Insert this as the first partially free pool for the block size} + mov rcx, TSmallBlockType[rbx].NextPartiallyFreePool + mov TSmallBlockPoolHeader[rdx].PreviousPartiallyFreePool, rbx + mov TSmallBlockPoolHeader[rdx].NextPartiallyFreePool, rcx + mov TSmallBlockPoolHeader[rcx].PreviousPartiallyFreePool, rdx + mov TSmallBlockType[rbx].NextPartiallyFreePool, rdx + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, False + {All ok} + xor eax, eax + jmp @Done +@PoolIsNowEmpty: + {Was this pool actually in the linked list of pools with space? If not, it + can only be the sequential feed pool (it is the only pool that may contain + only one block, i.e. other blocks have not been split off yet)} + test rax, rax + jz @IsSequentialFeedPool + {Pool is now empty: Remove it from the linked list and free it} + mov rax, TSmallBlockPoolHeader[rdx].PreviousPartiallyFreePool + mov rcx, TSmallBlockPoolHeader[rdx].NextPartiallyFreePool + {Remove this manager} + mov TSmallBlockPoolHeader[rax].NextPartiallyFreePool, rcx + mov TSmallBlockPoolHeader[rcx].PreviousPartiallyFreePool, rax + {Zero out eax} + xor rax, rax + {Is this the sequential feed pool? If so, stop sequential feeding} + cmp TSmallBlockType[rbx].CurrentSequentialFeedPool, rdx + jne @NotSequentialFeedPool +@IsSequentialFeedPool: + mov TSmallBlockType[rbx].MaxSequentialFeedBlockAddress, rax +@NotSequentialFeedPool: + {Unlock the block type} + mov TSmallBlockType[rbx].BlockTypeLocked, al + {Release this pool} + mov rcx, rdx + mov rdx, [rdx - BlockHeaderSize] +{$ifndef AssumeMultiThreaded} + mov bl, IsMultiThread +{$endif} + jmp @FreeMediumBlock +@LockBlockTypeLoop: + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType +{$ifdef NeverSleepOnThreadContention} + {Pause instruction (improves performance on P4)} + pause + {$ifdef UseSwitchToThread} + mov rsi, rcx + call SwitchToThread + mov rcx, rsi + mov rdx, [rcx - BlockHeaderSize] + {$endif} + {Try again} + jmp @LockBlockTypeLoop +{$else} + {Couldn't grab the block type - sleep and try again} + mov rsi, rcx + mov ecx, InitialSleepTime + call Sleep + mov rcx, rsi + mov rdx, [rcx - BlockHeaderSize] + {Try again} + mov eax, $100 + {Attempt to grab the block type} + lock cmpxchg TSmallBlockType([rbx]).BlockTypeLocked, ah + je @GotLockOnSmallBlockType + {Couldn't grab the block type - sleep and try again} + mov rsi, rcx + mov ecx, AdditionalSleepTime + call Sleep + mov rcx, rsi + mov rdx, [rcx - BlockHeaderSize] + {Try again} + jmp @LockBlockTypeLoop +{$endif} + {---------------------Medium blocks------------------------------} +@NotSmallBlockInUse: + {Not a small block in use: is it a medium or large block?} + test dl, IsFreeBlockFlag + IsLargeBlockFlag + jnz @NotASmallOrMediumBlock +@FreeMediumBlock: +{$ifdef ClearSmallAndMediumBlocksInFreeMem} + mov rsi, rcx + and rdx, DropMediumAndLargeFlagsMask + sub rdx, BlockHeaderSize + xor r8, r8 + call System.@FillChar + mov rcx, rsi + mov rdx, [rcx - BlockHeaderSize] +{$endif} + {Drop the flags} + and rdx, DropMediumAndLargeFlagsMask + {Free the medium block pointed to by eax, header in edx, bl = IsMultiThread} +{$ifndef AssumeMultiThreaded} + {Do we need to lock the medium blocks?} + test bl, bl +{$endif} + {Block size in rbx} + mov rbx, rdx + {Pointer in rsi} + mov rsi, rcx + {Do we need to lock the medium blocks?} +{$ifndef AssumeMultiThreaded} + jz @MediumBlocksLocked +{$endif} + call LockMediumBlocks +@MediumBlocksLocked: + {Can we combine this block with the next free block?} + test qword ptr [rsi + rbx - BlockHeaderSize], IsFreeBlockFlag + {Get the next block size and flags in rcx} + mov rcx, [rsi + rbx - BlockHeaderSize] + jnz @NextBlockIsFree + {Set the "PreviousIsFree" flag in the next block} + or rcx, PreviousMediumBlockIsFreeFlag + mov [rsi + rbx - BlockHeaderSize], rcx +@NextBlockChecked: + {Can we combine this block with the previous free block? We need to + re-read the flags since it could have changed before we could lock the + medium blocks.} + test byte ptr [rsi - BlockHeaderSize], PreviousMediumBlockIsFreeFlag + jnz @PreviousBlockIsFree +@PreviousBlockChecked: + {Is the entire medium block pool free, and there are other free blocks + that can fit the largest possible medium block -> free it.} + cmp ebx, (MediumBlockPoolSize - MediumBlockPoolHeaderSize) + je @EntireMediumPoolFree +@BinFreeMediumBlock: + {Store the size of the block as well as the flags} + lea rax, [rbx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [rsi - BlockHeaderSize], rax + {Store the trailing size marker} + mov [rsi + rbx - 2 * BlockHeaderSize], rbx + {Insert this block back into the bins: Size check not required here, + since medium blocks that are in use are not allowed to be + shrunk smaller than MinimumMediumBlockSize} + mov rcx, rsi + mov rdx, rbx + {Insert into bin} + call InsertMediumBlockIntoBin + {All OK} + xor eax, eax + {Unlock medium blocks} + mov MediumBlocksLocked, al + jmp @Done +@NextBlockIsFree: + {Get the next block address in rax} + lea rax, [rsi + rbx] + {Increase the size of this block} + and rcx, DropMediumAndLargeFlagsMask + add rbx, rcx + {Was the block binned?} + cmp rcx, MinimumMediumBlockSize + jb @NextBlockChecked + mov rcx, rax + call RemoveMediumFreeBlock + jmp @NextBlockChecked +@PreviousBlockIsFree: + {Get the size of the free block just before this one} + mov rcx, [rsi - 2 * BlockHeaderSize] + {Include the previous block} + sub rsi, rcx + {Set the new block size} + add rbx, rcx + {Remove the previous block from the linked list} + cmp ecx, MinimumMediumBlockSize + jb @PreviousBlockChecked + mov rcx, rsi + call RemoveMediumFreeBlock + jmp @PreviousBlockChecked +@EntireMediumPoolFree: + {Should we make this the new sequential feed medium block pool? If the + current sequential feed pool is not entirely free, we make this the new + sequential feed pool.} + lea r8, MediumSequentialFeedBytesLeft + cmp dword ptr [r8], MediumBlockPoolSize - MediumBlockPoolHeaderSize //workaround for QC99023 + jne @MakeEmptyMediumPoolSequentialFeed + {Point esi to the medium block pool header} + sub rsi, MediumBlockPoolHeaderSize + {Remove this medium block pool from the linked list} + mov rax, TMediumBlockPoolHeader[rsi].PreviousMediumBlockPoolHeader + mov rdx, TMediumBlockPoolHeader[rsi].NextMediumBlockPoolHeader + mov TMediumBlockPoolHeader[rax].NextMediumBlockPoolHeader, rdx + mov TMediumBlockPoolHeader[rdx].PreviousMediumBlockPoolHeader, rax + {Unlock medium blocks} + xor eax, eax + mov MediumBlocksLocked, al +{$ifdef ClearMediumBlockPoolsBeforeReturningToOS} + mov rcx, rsi + mov edx, MediumBlockPoolSize + xor r8, r8 + call System.@FillChar +{$endif} + {Free the medium block pool} + mov rcx, rsi + xor edx, edx + mov r8d, MEM_RELEASE + call VirtualFree + {VirtualFree returns >0 if all is ok} + cmp eax, 1 + {Return 0 on all ok} + sbb eax, eax + jmp @Done +@MakeEmptyMediumPoolSequentialFeed: + {Get a pointer to the end-marker block} + lea rbx, [rsi + MediumBlockPoolSize - MediumBlockPoolHeaderSize] + {Bin the current sequential feed pool} + call BinMediumSequentialFeedRemainder + {Set this medium pool up as the new sequential feed pool: + Store the sequential feed pool trailer} + mov qword ptr [rbx - BlockHeaderSize], IsMediumBlockFlag + {Store the number of bytes available in the sequential feed chunk} + lea rax, MediumSequentialFeedBytesLeft + mov dword ptr [rax], MediumBlockPoolSize - MediumBlockPoolHeaderSize //QC99023 workaround + {Set the last sequentially fed block} + mov LastSequentiallyFedMediumBlock, rbx + {Success} + xor eax, eax + {Unlock medium blocks} + mov MediumBlocksLocked, al + jmp @Done +@NotASmallOrMediumBlock: + {Attempt to free an already free block?} + mov eax, -1 + {Is it in fact a large block?} + test dl, IsFreeBlockFlag + IsMediumBlockFlag + jnz @Done + call FreeLargeBlock +@Done: +end; +{$endif} +{$endif} + +{$ifndef FullDebugMode} +{Replacement for SysReallocMem} +function FastReallocMem({$ifdef fpc}var {$endif}APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; +{$ifndef ASMVersion} +var + LBlockHeader, LNextBlockSizeAndFlags, LNewAllocSize, LBlockFlags, + LOldAvailableSize, LNextBlockSize, LNewAvailableSize, LMinimumUpsize, + LSecondSplitSize, LNewBlockSize: NativeUInt; + LPSmallBlockType: PSmallBlockType; + LPNextBlock, LPNextBlockHeader: Pointer; +{$ifdef LogLockContention} + LCollector: PStaticCollector; +{$endif} + + {Upsizes a large block in-place. The following variables are assumed correct: + LBlockFlags, LOldAvailableSize, LPNextBlock, LNextBlockSizeAndFlags, + LNextBlockSize, LNewAvailableSize. Medium blocks must be locked on entry if + required.} + procedure MediumBlockInPlaceUpsize; + begin + {Remove the next block} + if LNextBlockSizeAndFlags >= MinimumMediumBlockSize then + RemoveMediumFreeBlock(LPNextBlock); + {Add 25% for medium block in-place upsizes} + LMinimumUpsize := LOldAvailableSize + (LOldAvailableSize shr 2); + if NativeUInt(ANewSize) < LMinimumUpsize then + LNewAllocSize := LMinimumUpsize + else + LNewAllocSize := NativeUInt(ANewSize); + {Round up to the nearest block size granularity} + LNewBlockSize := ((LNewAllocSize + (BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset)) + and -MediumBlockGranularity) + MediumBlockSizeOffset; + {Calculate the size of the second split} + LSecondSplitSize := LNewAvailableSize + BlockHeaderSize - LNewBlockSize; + {Does it fit?} + if NativeInt(LSecondSplitSize) <= 0 then + begin + {The block size is the full available size plus header} + LNewBlockSize := LNewAvailableSize + BlockHeaderSize; + {Grab the whole block: Mark it as used in the block following it} + LPNextBlockHeader := Pointer(PByte(APointer) + LNewAvailableSize); + PNativeUInt(LPNextBlockHeader)^ := + PNativeUInt(LPNextBlockHeader)^ and (not PreviousMediumBlockIsFreeFlag); + end + else + begin + {Split the block in two} + LPNextBlock := PMediumFreeBlock(PByte(APointer) + LNewBlockSize); + {Set the size of the second split} + PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^ := LSecondSplitSize or (IsMediumBlockFlag or IsFreeBlockFlag); + {Store the size of the second split before the header of the next block} + PNativeUInt(PByte(LPNextBlock) + LSecondSplitSize - 2 * BlockHeaderSize)^ := LSecondSplitSize; + {Put the remainder in a bin if it is big enough} + if LSecondSplitSize >= MinimumMediumBlockSize then + InsertMediumBlockIntoBin(LPNextBlock, LSecondSplitSize); + end; + {Set the size and flags for this block} + PNativeUInt(PByte(APointer) - BlockHeaderSize)^ := LNewBlockSize or LBlockFlags; + end; + + {In-place downsize of a medium block. On entry Size must be less than half of + LOldAvailableSize.} + procedure MediumBlockInPlaceDownsize; +{$ifdef LogLockContention} + var + LDidSleep: Boolean; +{$endif} + begin + {Round up to the next medium block size} + LNewBlockSize := ((ANewSize + (BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset)) + and -MediumBlockGranularity) + MediumBlockSizeOffset; + {Get the size of the second split} + LSecondSplitSize := (LOldAvailableSize + BlockHeaderSize) - LNewBlockSize; + {Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); +{$ifdef LogLockContention} + if LDidSleep then + LCollector := @MediumBlockCollector; +{$endif} + {Set the new size} + PNativeUInt(PByte(APointer) - BlockHeaderSize)^ := + (PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and ExtractMediumAndLargeFlagsMask) + or LNewBlockSize; + {Is the next block in use?} + LPNextBlock := PNativeUInt(PByte(APointer) + LOldAvailableSize + BlockHeaderSize); + LNextBlockSizeAndFlags := PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^; + if LNextBlockSizeAndFlags and IsFreeBlockFlag = 0 then + begin + {The next block is in use: flag its previous block as free} + PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^ := + LNextBlockSizeAndFlags or PreviousMediumBlockIsFreeFlag; + end + else + begin + {The next block is free: combine it} + LNextBlockSizeAndFlags := LNextBlockSizeAndFlags and DropMediumAndLargeFlagsMask; + Inc(LSecondSplitSize, LNextBlockSizeAndFlags); + if LNextBlockSizeAndFlags >= MinimumMediumBlockSize then + RemoveMediumFreeBlock(LPNextBlock); + end; + {Set the split} + LPNextBlock := PNativeUInt(PByte(APointer) + LNewBlockSize); + {Store the free part's header} + PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^ := LSecondSplitSize or (IsMediumBlockFlag or IsFreeBlockFlag); + {Store the trailing size field} + PNativeUInt(PByte(LPNextBlock) + LSecondSplitSize - 2 * BlockHeaderSize)^ := LSecondSplitSize; + {Bin this free block} + if LSecondSplitSize >= MinimumMediumBlockSize then + InsertMediumBlockIntoBin(LPNextBlock, LSecondSplitSize); + {Unlock the medium blocks} + MediumBlocksLocked := False; + end; + +{$ifdef LogLockContention} +var + LDidSleep: Boolean; + LStackTrace: TStackTrace; +{$endif} + +begin +{$ifdef fpc} + if APointer = nil then + begin + if ANewSize <> 0 then + APointer := FastGetMem(ANewSize); + Result := APointer; + Exit; + end + else if ANewSize = 0 then + begin + FastFreeMem(APointer); + APointer := nil; + Result := APointer; + Exit; + end; +{$endif} +{$ifdef LogLockContention} + LCollector := nil; + try +{$endif} + {Get the block header: Is it actually a small block?} + LBlockHeader := PNativeUInt(PByte(APointer) - BlockHeaderSize)^; + {Is it a small block that is in use?} + if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag or IsLargeBlockFlag) = 0 then + begin + {-----------------------------------Small block-------------------------------------} + {The block header is a pointer to the block pool: Get the block type} + LPSmallBlockType := PSmallBlockPoolHeader(LBlockHeader).BlockType; + {Get the available size inside blocks of this type.} + LOldAvailableSize := LPSmallBlockType.BlockSize - BlockHeaderSize; + {Is it an upsize or a downsize?} + if LOldAvailableSize >= NativeUInt(ANewSize) then + begin + {It's a downsize. Do we need to allocate a smaller block? Only if the new + block size is less than a quarter of the available size less + SmallBlockDownsizeCheckAdder bytes} + if (NativeUInt(ANewSize) * 4 + SmallBlockDownsizeCheckAdder) >= LOldAvailableSize then + begin + {In-place downsize - return the pointer} + Result := APointer; + Exit; + end + else + begin + {Allocate a smaller block} + Result := FastGetMem(ANewSize); + {Allocated OK?} + if Result <> nil then + begin + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + MoveX16LP(APointer^, Result^, ANewSize); + {$else} + MoveX8LP(APointer^, Result^, ANewSize); + {$endif} +{$else} + System.Move(APointer^, Result^, ANewSize); +{$endif} + {Free the old pointer} + FastFreeMem(APointer); + end; + end; + end + else + begin + {This pointer is being reallocated to a larger block and therefore it is + logical to assume that it may be enlarged again. Since reallocations are + expensive, there is a minimum upsize percentage to avoid unnecessary + future move operations.} + {Must grow with at least 100% + x bytes} + LNewAllocSize := LOldAvailableSize * 2 + SmallBlockUpsizeAdder; + {Still not large enough?} + if LNewAllocSize < NativeUInt(ANewSize) then + LNewAllocSize := NativeUInt(ANewSize); + {Allocate the new block} + Result := FastGetMem(LNewAllocSize); + {Allocated OK?} + if Result <> nil then + begin + {Do we need to store the requested size? Only large blocks store the + requested size.} + if LNewAllocSize > (MaximumMediumBlockSize - BlockHeaderSize) then + PLargeBlockHeader(PByte(Result) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + {Move the data across} +{$ifdef UseCustomFixedSizeMoveRoutines} + LPSmallBlockType.UpsizeMoveProcedure(APointer^, Result^, LOldAvailableSize); +{$else} + System.Move(APointer^, Result^, LOldAvailableSize); +{$endif} + {Free the old pointer} + FastFreeMem(APointer); + end; + end; + end + else + begin + {Is this a medium block or a large block?} + if LBlockHeader and (IsFreeBlockFlag or IsLargeBlockFlag) = 0 then + begin + {-------------------------------Medium block--------------------------------------} + {What is the available size in the block being reallocated?} + LOldAvailableSize := (LBlockHeader and DropMediumAndLargeFlagsMask); + {Get a pointer to the next block} + LPNextBlock := PNativeUInt(PByte(APointer) + LOldAvailableSize); + {Subtract the block header size from the old available size} + Dec(LOldAvailableSize, BlockHeaderSize); + {Is it an upsize or a downsize?} + if NativeUInt(ANewSize) > LOldAvailableSize then + begin + {Can we do an in-place upsize?} + LNextBlockSizeAndFlags := PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^; + {Is the next block free?} + if LNextBlockSizeAndFlags and IsFreeBlockFlag <> 0 then + begin + LNextBlockSize := LNextBlockSizeAndFlags and DropMediumAndLargeFlagsMask; + {The available size including the next block} + LNewAvailableSize := LOldAvailableSize + LNextBlockSize; + {Can the block fit?} + if NativeUInt(ANewSize) <= LNewAvailableSize then + begin + {The next block is free and there is enough space to grow this + block in place.} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then + begin +{$endif} + {Multi-threaded application - lock medium blocks and re-read the + information on the blocks.} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); +{$ifdef LogLockContention} + if LDidSleep then + LCollector := @MediumBlockCollector; +{$endif} + {Re-read the info for this block} + LBlockFlags := PNativeUInt(PByte(APointer) - BlockHeaderSize)^ and ExtractMediumAndLargeFlagsMask; + {Re-read the info for the next block} + LNextBlockSizeAndFlags := PNativeUInt(PByte(LPNextBlock) - BlockHeaderSize)^; + {Recalculate the next block size} + LNextBlockSize := LNextBlockSizeAndFlags and DropMediumAndLargeFlagsMask; + {The available size including the next block} + LNewAvailableSize := LOldAvailableSize + LNextBlockSize; + {Is the next block still free and the size still sufficient?} + if (LNextBlockSizeAndFlags and IsFreeBlockFlag <> 0) + and (NativeUInt(ANewSize) <= LNewAvailableSize) then + begin + {Upsize the block in-place} + MediumBlockInPlaceUpsize; + {Unlock the medium blocks} + MediumBlocksLocked := False; + {Return the result} + Result := APointer; + {Done} + Exit; + end; + {Couldn't use the block: Unlock the medium blocks} + MediumBlocksLocked := False; +{$ifndef AssumeMultiThreaded} + end + else + begin + {Extract the block flags} + LBlockFlags := ExtractMediumAndLargeFlagsMask and LBlockHeader; + {Upsize the block in-place} + MediumBlockInPlaceUpsize; + {Return the result} + Result := APointer; + {Done} + Exit; + end; +{$endif} + end; + end; + {Couldn't upsize in place. Grab a new block and move the data across: + If we have to reallocate and move medium blocks, we grow by at + least 25%} + LMinimumUpsize := LOldAvailableSize + (LOldAvailableSize shr 2); + if NativeUInt(ANewSize) < LMinimumUpsize then + LNewAllocSize := LMinimumUpsize + else + LNewAllocSize := NativeUInt(ANewSize); + {Allocate the new block} + Result := FastGetMem(LNewAllocSize); + if Result <> nil then + begin + {If it's a large block - store the actual user requested size} + if LNewAllocSize > (MaximumMediumBlockSize - BlockHeaderSize) then + PLargeBlockHeader(PByte(Result) - LargeBlockHeaderSize).UserAllocatedSize := ANewSize; + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + MoveX16LP(APointer^, Result^, LOldAvailableSize); +{$else} + System.Move(APointer^, Result^, LOldAvailableSize); +{$endif} + {Free the old block} + FastFreeMem(APointer); + end; + end + else + begin + {Must be less than half the current size or we don't bother resizing.} + if NativeUInt(ANewSize * 2) >= LOldAvailableSize then + begin + Result := APointer; + end + else + begin + {In-place downsize? Balance the cost of moving the data vs. the cost + of fragmenting the memory pool. Medium blocks in use may never be + smaller than MinimumMediumBlockSize.} + if NativeUInt(ANewSize) >= (MinimumMediumBlockSize - BlockHeaderSize) then + begin + MediumBlockInPlaceDownsize; + Result := APointer; + end + else + begin + {The requested size is less than the minimum medium block size. If + the requested size is less than the threshold value (currently a + quarter of the minimum medium block size), move the data to a small + block, otherwise shrink the medium block to the minimum allowable + medium block size.} + if NativeUInt(ANewSize) >= MediumInPlaceDownsizeLimit then + begin + {The request is for a size smaller than the minimum medium block + size, but not small enough to justify moving data: Reduce the + block size to the minimum medium block size} + ANewSize := MinimumMediumBlockSize - BlockHeaderSize; + {Is it already at the minimum medium block size?} + if LOldAvailableSize > NativeUInt(ANewSize) then + MediumBlockInPlaceDownsize; + Result := APointer; + end + else + begin + {Allocate the new block} + Result := FastGetMem(ANewSize); + if Result <> nil then + begin + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + MoveX16LP(APointer^, Result^, ANewSize); + {$else} + MoveX8LP(APointer^, Result^, ANewSize); + {$endif} +{$else} + System.Move(APointer^, Result^, ANewSize); +{$endif} + {Free the old block} + FastFreeMem(APointer); + end; + end; + end; + end; + end; + end + else + begin + {Is this a valid large block?} + if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag) = 0 then + begin + {-----------------------Large block------------------------------} + Result := ReallocateLargeBlock(APointer, ANewSize); + end + else + begin + {-----------------------Invalid block------------------------------} + {Bad pointer: probably an attempt to reallocate a free memory block.} + Result := nil; + end; + end; + end; +{$ifdef fpc} + APointer := Result; +{$endif} +{$ifdef LogLockContention} + finally + if assigned(LCollector) then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + LPSmallBlockType.BlockCollector.Add(@LStackTrace[0], StackTraceDepth); + end; + end; +{$endif} +end; +{$else} +{$ifdef 32Bit} +asm +{$ifdef fpc} + push esi + mov esi, eax + mov eax, [esi] + test eax, eax + jne @PointerNotNil + test edx, edx + je @SizeIsZero + mov eax, edx + call FastGetMem + mov [esi], eax + nop + nop +@SizeIsZero: + pop esi + ret + nop + nop +@PointerNotNil: + test edx, edx + jne @GoRealloc + call FastFreeMem + mov [esi], 0 + pop esi + ret + nop + nop + nop +@GoRealloc: +{$endif} + {On entry: eax = APointer; edx = ANewSize} + {Get the block header: Is it actually a small block?} + mov ecx, [eax - 4] + {Is it a small block?} + test cl, IsFreeBlockFlag + IsMediumBlockFlag + IsLargeBlockFlag + {Save ebx} + push ebx + {Save esi} + push esi + {Save the original pointer in esi} + mov esi, eax + {Is it a small block?} + jnz @NotASmallBlock + {-----------------------------------Small block-------------------------------------} + {Get the block type in ebx} + mov ebx, TSmallBlockPoolHeader[ecx].BlockType + {Get the available size inside blocks of this type.} + movzx ecx, TSmallBlockType[ebx].BlockSize + sub ecx, 4 + {Is it an upsize or a downsize?} + cmp ecx, edx + jb @SmallUpsize + {It's a downsize. Do we need to allocate a smaller block? Only if the new + size is less than a quarter of the available size less + SmallBlockDownsizeCheckAdder bytes} + lea ebx, [edx * 4 + SmallBlockDownsizeCheckAdder] + cmp ebx, ecx + jb @NotSmallInPlaceDownsize + {In-place downsize - return the original pointer} + pop esi + pop ebx +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} + nop +@NotSmallInPlaceDownsize: + {Save the requested size} + mov ebx, edx + {Allocate a smaller block} + mov eax, edx + call FastGetMem + {Allocated OK?} + test eax, eax + jz @SmallDownsizeDone + {Move data across: count in ecx} + mov ecx, ebx + {Destination in edx} + mov edx, eax + {Save the result in ebx} + mov ebx, eax + {Original pointer in eax} + mov eax, esi + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + call MoveX16LP + {$else} + call MoveX8LP + {$endif} +{$else} + call System.Move +{$endif} + {Free the original pointer} + mov eax, esi + call FastFreeMem + {Return the pointer} + mov eax, ebx +@SmallDownsizeDone: + pop esi + pop ebx +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} + nop + nop +@SmallUpsize: + {State: esi = APointer, edx = ANewSize, ecx = Current Block Size, ebx = Current Block Type} + {This pointer is being reallocated to a larger block and therefore it is + logical to assume that it may be enlarged again. Since reallocations are + expensive, there is a minimum upsize percentage to avoid unnecessary + future move operations.} + {Small blocks always grow with at least 100% + SmallBlockUpsizeAdder bytes} + lea ecx, [ecx + ecx + SmallBlockUpsizeAdder] + {save edi} + push edi + {Save the requested size in edi} + mov edi, edx + {New allocated size is the maximum of the requested size and the minimum + upsize} + xor eax, eax + sub ecx, edx + adc eax, -1 + and eax, ecx + add eax, edx + {Allocate the new block} + call FastGetMem + {Allocated OK?} + test eax, eax + jz @SmallUpsizeDone + {Do we need to store the requested size? Only large blocks store the + requested size.} + cmp edi, MaximumMediumBlockSize - BlockHeaderSize + jbe @NotSmallUpsizeToLargeBlock + {Store the user requested size} + mov [eax - 8], edi +@NotSmallUpsizeToLargeBlock: + {Get the size to move across} + movzx ecx, TSmallBlockType[ebx].BlockSize + sub ecx, BlockHeaderSize + {Move to the new block} + mov edx, eax + {Save the result in edi} + mov edi, eax + {Move from the old block} + mov eax, esi + {Move the data across} +{$ifdef UseCustomFixedSizeMoveRoutines} + call TSmallBlockType[ebx].UpsizeMoveProcedure +{$else} + call System.Move +{$endif} + {Free the old pointer} + mov eax, esi + call FastFreeMem + {Done} + mov eax, edi +@SmallUpsizeDone: + pop edi + pop esi + pop ebx +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} + nop +@NotASmallBlock: + {Is this a medium block or a large block?} + test cl, IsFreeBlockFlag + IsLargeBlockFlag + jnz @PossibleLargeBlock + {-------------------------------Medium block--------------------------------------} + {Status: ecx = Current Block Size + Flags, eax/esi = APointer, + edx = Requested Size} + mov ebx, ecx + {Drop the flags from the header} + and ecx, DropMediumAndLargeFlagsMask + {Save edi} + push edi + {Get a pointer to the next block in edi} + lea edi, [eax + ecx] + {Subtract the block header size from the old available size} + sub ecx, BlockHeaderSize + {Get the complete flags in ebx} + and ebx, ExtractMediumAndLargeFlagsMask + {Is it an upsize or a downsize?} + cmp edx, ecx + {Save ebp} + push ebp + {Is it an upsize or a downsize?} + ja @MediumBlockUpsize + {Status: ecx = Current Block Size - 4, bl = Current Block Flags, + edi = @Next Block, eax/esi = APointer, edx = Requested Size} + {Must be less than half the current size or we don't bother resizing.} + lea ebp, [edx + edx] + cmp ebp, ecx + jb @MediumMustDownsize +@MediumNoResize: + {Restore registers} + pop ebp + pop edi + pop esi + pop ebx + {Return} +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} + nop + nop + nop +@MediumMustDownsize: + {In-place downsize? Balance the cost of moving the data vs. the cost of + fragmenting the memory pool. Medium blocks in use may never be smaller + than MinimumMediumBlockSize.} + cmp edx, MinimumMediumBlockSize - BlockHeaderSize + jae @MediumBlockInPlaceDownsize + {The requested size is less than the minimum medium block size. If the + requested size is less than the threshold value (currently a quarter of the + minimum medium block size), move the data to a small block, otherwise shrink + the medium block to the minimum allowable medium block size.} + cmp edx, MediumInPlaceDownsizeLimit + jb @MediumDownsizeRealloc + {The request is for a size smaller than the minimum medium block size, but + not small enough to justify moving data: Reduce the block size to the + minimum medium block size} + mov edx, MinimumMediumBlockSize - BlockHeaderSize + {Is it already at the minimum medium block size?} + cmp ecx, edx + jna @MediumNoResize +@MediumBlockInPlaceDownsize: + {Round up to the next medium block size} + lea ebp, [edx + BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset] + and ebp, -MediumBlockGranularity; + add ebp, MediumBlockSizeOffset + {Get the size of the second split} + add ecx, BlockHeaderSize + sub ecx, ebp + {Lock the medium blocks} +{$ifndef AssumeMultiThreaded} + cmp IsMultiThread, False + je @DoMediumInPlaceDownsize +{$endif} +@DoMediumLockForDownsize: + {Lock the medium blocks (ecx *must* be preserved)} + call LockMediumBlocks + {Reread the flags - they may have changed before medium blocks could be + locked.} + mov ebx, ExtractMediumAndLargeFlagsMask + and ebx, [esi - 4] +@DoMediumInPlaceDownsize: + {Set the new size} + or ebx, ebp + mov [esi - 4], ebx + {Get the second split size in ebx} + mov ebx, ecx + {Is the next block in use?} + mov edx, [edi - 4] + test dl, IsFreeBlockFlag + jnz @MediumDownsizeNextBlockFree + {The next block is in use: flag its previous block as free} + or edx, PreviousMediumBlockIsFreeFlag + mov [edi - 4], edx + jmp @MediumDownsizeDoSplit + {Align branch target} + nop + nop +{$ifdef AssumeMultiThreaded} + nop +{$endif} +@MediumDownsizeNextBlockFree: + {The next block is free: combine it} + mov eax, edi + and edx, DropMediumAndLargeFlagsMask + add ebx, edx + add edi, edx + cmp edx, MinimumMediumBlockSize + jb @MediumDownsizeDoSplit + call RemoveMediumFreeBlock +@MediumDownsizeDoSplit: + {Store the trailing size field} + mov [edi - 8], ebx + {Store the free part's header} + lea eax, [ebx + IsMediumBlockFlag + IsFreeBlockFlag]; + mov [esi + ebp - 4], eax + {Bin this free block} + cmp ebx, MinimumMediumBlockSize + jb @MediumBlockDownsizeDone + lea eax, [esi + ebp] + mov edx, ebx + call InsertMediumBlockIntoBin +@MediumBlockDownsizeDone: + {Unlock the medium blocks} + mov MediumBlocksLocked, False + {Result = old pointer} + mov eax, esi + {Restore registers} + pop ebp + pop edi + pop esi + pop ebx + {Return} +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} +@MediumDownsizeRealloc: + {Save the requested size} + mov edi, edx + mov eax, edx + {Allocate the new block} + call FastGetMem + test eax, eax + jz @MediumBlockDownsizeExit + {Save the result} + mov ebp, eax + mov edx, eax + mov eax, esi + mov ecx, edi + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + call MoveX16LP + {$else} + call MoveX8LP + {$endif} +{$else} + call System.Move +{$endif} + mov eax, esi + call FastFreeMem + {Return the result} + mov eax, ebp +@MediumBlockDownsizeExit: + pop ebp + pop edi + pop esi + pop ebx +{$ifdef fpc} + mov [esi], eax + pop esi + nop +{$endif} + ret + {Align branch target} +@MediumBlockUpsize: + {Status: ecx = Current Block Size - 4, bl = Current Block Flags, + edi = @Next Block, eax/esi = APointer, edx = Requested Size} + {Can we do an in-place upsize?} + mov eax, [edi - 4] + test al, IsFreeBlockFlag + jz @CannotUpsizeMediumBlockInPlace + {Get the total available size including the next block} + and eax, DropMediumAndLargeFlagsMask + {ebp = total available size including the next block (excluding the header)} + lea ebp, [eax + ecx] + {Can the block fit?} + cmp edx, ebp + ja @CannotUpsizeMediumBlockInPlace + {The next block is free and there is enough space to grow this + block in place.} +{$ifndef AssumeMultiThreaded} + cmp IsMultiThread, False + je @DoMediumInPlaceUpsize +{$endif} +@DoMediumLockForUpsize: + {Lock the medium blocks (ecx and edx *must* be preserved} + call LockMediumBlocks + {Re-read the info for this block (since it may have changed before the medium + blocks could be locked)} + mov ebx, ExtractMediumAndLargeFlagsMask + and ebx, [esi - 4] + {Re-read the info for the next block} + mov eax, [edi - 4] + {Next block still free?} + test al, IsFreeBlockFlag + jz @NextMediumBlockChanged + {Recalculate the next block size} + and eax, DropMediumAndLargeFlagsMask + {The available size including the next block} + lea ebp, [eax + ecx] + {Can the block still fit?} + cmp edx, ebp + ja @NextMediumBlockChanged +@DoMediumInPlaceUpsize: + {Is the next block binnable?} + cmp eax, MinimumMediumBlockSize + {Remove the next block} + jb @MediumInPlaceNoNextRemove + mov eax, edi + push ecx + push edx + call RemoveMediumFreeBlock + pop edx + pop ecx +@MediumInPlaceNoNextRemove: + {Medium blocks grow a minimum of 25% in in-place upsizes} + mov eax, ecx + shr eax, 2 + add eax, ecx + {Get the maximum of the requested size and the minimum growth size} + xor edi, edi + sub eax, edx + adc edi, -1 + and eax, edi + {Round up to the nearest block size granularity} + lea eax, [eax + edx + BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset] + and eax, -MediumBlockGranularity + add eax, MediumBlockSizeOffset + {Calculate the size of the second split} + lea edx, [ebp + BlockHeaderSize] + sub edx, eax + {Does it fit?} + ja @MediumInPlaceUpsizeSplit + {Grab the whole block: Mark it as used in the block following it} + and dword ptr [esi + ebp], not PreviousMediumBlockIsFreeFlag + {The block size is the full available size plus header} + add ebp, 4 + {Upsize done} + jmp @MediumUpsizeInPlaceDone + {Align branch target} +{$ifndef AssumeMultiThreaded} + nop + nop + nop +{$endif} +@MediumInPlaceUpsizeSplit: + {Store the size of the second split as the second last dword} + mov [esi + ebp - 4], edx + {Set the second split header} + lea edi, [edx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [esi + eax - 4], edi + mov ebp, eax + cmp edx, MinimumMediumBlockSize + jb @MediumUpsizeInPlaceDone + add eax, esi + call InsertMediumBlockIntoBin +@MediumUpsizeInPlaceDone: + {Set the size and flags for this block} + or ebp, ebx + mov [esi - 4], ebp + {Unlock the medium blocks} + mov MediumBlocksLocked, False + {Result = old pointer} + mov eax, esi +@MediumBlockResizeDone2: + {Restore registers} + pop ebp + pop edi + pop esi + pop ebx + {Return} +{$ifdef fpc} + mov [esi], eax + pop esi +{$endif} + ret + {Align branch target for "@CannotUpsizeMediumBlockInPlace"} + nop + nop +@NextMediumBlockChanged: + {The next medium block changed while the medium blocks were being locked} + mov MediumBlocksLocked, False +@CannotUpsizeMediumBlockInPlace: + {Couldn't upsize in place. Grab a new block and move the data across: + If we have to reallocate and move medium blocks, we grow by at + least 25%} + mov eax, ecx + shr eax, 2 + add eax, ecx + {Get the maximum of the requested size and the minimum growth size} + xor edi, edi + sub eax, edx + adc edi, -1 + and eax, edi + add eax, edx + {Save the size to allocate} + mov ebp, eax + {Save the size to move across} + mov edi, ecx + {Get the block} + push edx + call FastGetMem + pop edx + {Success?} + test eax, eax + jz @MediumBlockResizeDone2 + {If it's a Large block - store the actual user requested size} + cmp ebp, MaximumMediumBlockSize - BlockHeaderSize + jbe @MediumUpsizeNotLarge + mov [eax - 8], edx +@MediumUpsizeNotLarge: + {Save the result} + mov ebp, eax + {Move the data across} + mov edx, eax + mov eax, esi + mov ecx, edi +{$ifdef UseCustomVariableSizeMoveRoutines} + call MoveX16LP +{$else} + call System.Move +{$endif} + {Free the old block} + mov eax, esi + call FastFreeMem + {Restore the result} + mov eax, ebp + {Restore registers} + pop ebp + pop edi + pop esi + pop ebx + {Return} +{$ifdef fpc} + mov [esi], eax + pop esi + nop + nop +{$endif} + ret + {Align branch target} + nop +@PossibleLargeBlock: + {-----------------------Large block------------------------------} + {Restore registers} + pop esi + pop ebx + {Is this a valid large block?} + test cl, IsFreeBlockFlag + IsMediumBlockFlag +{$ifndef fpc} + jz ReallocateLargeBlock +{$else} + jnz @error + call ReallocateLargeBlock + jmp @Done + {-----------------------Invalid block------------------------------} +@error: +{$endif} + xor eax, eax +{$ifdef fpc} +@Done: + mov [esi], eax + pop esi +{$endif} +end; + +{$else} + +{-----------------64-bit BASM FastReallocMem-----------------} +asm + .params 3 + .pushnv rbx + .pushnv rsi + .pushnv rdi + .pushnv r14 + .pushnv r15 + {On entry: rcx = APointer; rdx = ANewSize} + {Save the original pointer in rsi} + mov rsi, rcx + {Get the block header} + mov rcx, [rcx - BlockHeaderSize] + {Is it a small block?} + test cl, IsFreeBlockFlag + IsMediumBlockFlag + IsLargeBlockFlag + jnz @NotASmallBlock + {-----------------------------------Small block-------------------------------------} + {Get the block type in rbx} + mov rbx, TSmallBlockPoolHeader[rcx].BlockType + {Get the available size inside blocks of this type.} + movzx ecx, TSmallBlockType[rbx].BlockSize + sub ecx, BlockHeaderSize + {Is it an upsize or a downsize?} + cmp rcx, rdx + jb @SmallUpsize + {It's a downsize. Do we need to allocate a smaller block? Only if the new + size is less than a quarter of the available size less + SmallBlockDownsizeCheckAdder bytes} + lea ebx, [edx * 4 + SmallBlockDownsizeCheckAdder] + cmp ebx, ecx + jb @NotSmallInPlaceDownsize + {In-place downsize - return the original pointer} + mov rax, rsi + jmp @Done +@NotSmallInPlaceDownsize: + {Save the requested size} + mov rbx, rdx + {Allocate a smaller block} + mov rcx, rdx + call FastGetMem + {Allocated OK?} + test rax, rax + jz @Done + {Move data across: count in r8} + mov r8, rbx + {Destination in edx} + mov rdx, rax + {Save the result in ebx} + mov rbx, rax + {Original pointer in ecx} + mov rcx, rsi + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + call MoveX16LP + {$else} + call MoveX8LP + {$endif} +{$else} + call System.Move +{$endif} + {Free the original pointer} + mov rcx, rsi + call FastFreeMem + {Return the pointer} + mov rax, rbx + jmp @Done +@SmallUpsize: + {State: rsi = APointer, rdx = ANewSize, rcx = Current Block Size, rbx = Current Block Type} + {This pointer is being reallocated to a larger block and therefore it is + logical to assume that it may be enlarged again. Since reallocations are + expensive, there is a minimum upsize percentage to avoid unnecessary + future move operations.} + {Small blocks always grow with at least 100% + SmallBlockUpsizeAdder bytes} + lea ecx, [ecx + ecx + SmallBlockUpsizeAdder] + {Save the requested size in rdi} + mov rdi, rdx + {New allocated size is the maximum of the requested size and the minimum + upsize} + xor rax, rax + sub rcx, rdx + adc rax, -1 + and rcx, rax + add rcx, rdx + {Allocate the new block} + call FastGetMem + {Allocated OK?} + test rax, rax + jz @Done + {Do we need to store the requested size? Only large blocks store the + requested size.} + cmp rdi, MaximumMediumBlockSize - BlockHeaderSize + jbe @NotSmallUpsizeToLargeBlock + {Store the user requested size} + mov [rax - 2 * BlockHeaderSize], rdi +@NotSmallUpsizeToLargeBlock: + {Get the size to move across} + movzx r8d, TSmallBlockType[rbx].BlockSize + sub r8d, BlockHeaderSize + {Move to the new block} + mov rdx, rax + {Save the result in edi} + mov rdi, rax + {Move from the old block} + mov rcx, rsi + {Move the data across} +{$ifdef UseCustomFixedSizeMoveRoutines} + call TSmallBlockType[rbx].UpsizeMoveProcedure +{$else} + call System.Move +{$endif} + {Free the old pointer} + mov rcx, rsi + call FastFreeMem + {Done} + mov rax, rdi + jmp @Done +@NotASmallBlock: + {Is this a medium block or a large block?} + test cl, IsFreeBlockFlag + IsLargeBlockFlag + jnz @PossibleLargeBlock + {-------------------------------Medium block--------------------------------------} + {Status: rcx = Current Block Size + Flags, rsi = APointer, + rdx = Requested Size} + mov rbx, rcx + {Drop the flags from the header} + and ecx, DropMediumAndLargeFlagsMask + {Get a pointer to the next block in rdi} + lea rdi, [rsi + rcx] + {Subtract the block header size from the old available size} + sub ecx, BlockHeaderSize + {Get the complete flags in ebx} + and ebx, ExtractMediumAndLargeFlagsMask + {Is it an upsize or a downsize?} + cmp rdx, rcx + ja @MediumBlockUpsize + {Status: ecx = Current Block Size - BlockHeaderSize, bl = Current Block Flags, + rdi = @Next Block, rsi = APointer, rdx = Requested Size} + {Must be less than half the current size or we don't bother resizing.} + lea r15, [rdx + rdx] + cmp r15, rcx + jb @MediumMustDownsize +@MediumNoResize: + mov rax, rsi + jmp @Done +@MediumMustDownsize: + {In-place downsize? Balance the cost of moving the data vs. the cost of + fragmenting the memory pool. Medium blocks in use may never be smaller + than MinimumMediumBlockSize.} + cmp edx, MinimumMediumBlockSize - BlockHeaderSize + jae @MediumBlockInPlaceDownsize + {The requested size is less than the minimum medium block size. If the + requested size is less than the threshold value (currently a quarter of the + minimum medium block size), move the data to a small block, otherwise shrink + the medium block to the minimum allowable medium block size.} + cmp edx, MediumInPlaceDownsizeLimit + jb @MediumDownsizeRealloc + {The request is for a size smaller than the minimum medium block size, but + not small enough to justify moving data: Reduce the block size to the + minimum medium block size} + mov edx, MinimumMediumBlockSize - BlockHeaderSize + {Is it already at the minimum medium block size?} + cmp ecx, edx + jna @MediumNoResize +@MediumBlockInPlaceDownsize: + {Round up to the next medium block size} + lea r15, [rdx + BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset] + and r15, -MediumBlockGranularity + add r15, MediumBlockSizeOffset + {Get the size of the second split} + add ecx, BlockHeaderSize + sub ecx, r15d + {Lock the medium blocks} +{$ifndef AssumeMultiThreaded} + lea r8, IsMultiThread + cmp byte ptr [r8], False + je @DoMediumInPlaceDownsize +{$endif} +@DoMediumLockForDownsize: + {Lock the medium blocks} + mov ebx, ecx + call LockMediumBlocks + mov ecx, ebx + {Reread the flags - they may have changed before medium blocks could be + locked.} + mov rbx, ExtractMediumAndLargeFlagsMask + and rbx, [rsi - BlockHeaderSize] +@DoMediumInPlaceDownsize: + {Set the new size} + or rbx, r15 + mov [rsi - BlockHeaderSize], rbx + {Get the second split size in ebx} + mov ebx, ecx + {Is the next block in use?} + mov rdx, [rdi - BlockHeaderSize] + test dl, IsFreeBlockFlag + jnz @MediumDownsizeNextBlockFree + {The next block is in use: flag its previous block as free} + or rdx, PreviousMediumBlockIsFreeFlag + mov [rdi - BlockHeaderSize], rdx + jmp @MediumDownsizeDoSplit +@MediumDownsizeNextBlockFree: + {The next block is free: combine it} + mov rcx, rdi + and rdx, DropMediumAndLargeFlagsMask + add rbx, rdx + add rdi, rdx + cmp edx, MinimumMediumBlockSize + jb @MediumDownsizeDoSplit + call RemoveMediumFreeBlock +@MediumDownsizeDoSplit: + {Store the trailing size field} + mov [rdi - 2 * BlockHeaderSize], rbx + {Store the free part's header} + lea rcx, [rbx + IsMediumBlockFlag + IsFreeBlockFlag]; + mov [rsi + r15 - BlockHeaderSize], rcx + {Bin this free block} + cmp rbx, MinimumMediumBlockSize + jb @MediumBlockDownsizeDone + lea rcx, [rsi + r15] + mov rdx, rbx + call InsertMediumBlockIntoBin +@MediumBlockDownsizeDone: + {Unlock the medium blocks} + lea rax, MediumBlocksLocked + mov byte ptr [rax], False + {Result = old pointer} + mov rax, rsi + jmp @Done +@MediumDownsizeRealloc: + {Save the requested size} + mov rdi, rdx + mov rcx, rdx + {Allocate the new block} + call FastGetMem + test rax, rax + jz @Done + {Save the result} + mov r15, rax + mov rdx, rax + mov rcx, rsi + mov r8, rdi + {Move the data across} +{$ifdef UseCustomVariableSizeMoveRoutines} + {$ifdef Align16Bytes} + call MoveX16LP + {$else} + call MoveX8LP + {$endif} +{$else} + call System.Move +{$endif} + mov rcx, rsi + call FastFreeMem + {Return the result} + mov rax, r15 + jmp @Done +@MediumBlockUpsize: + {Status: ecx = Current Block Size - BlockHeaderSize, bl = Current Block Flags, + rdi = @Next Block, rsi = APointer, rdx = Requested Size} + {Can we do an in-place upsize?} + mov rax, [rdi - BlockHeaderSize] + test al, IsFreeBlockFlag + jz @CannotUpsizeMediumBlockInPlace + {Get the total available size including the next block} + and rax, DropMediumAndLargeFlagsMask + {r15 = total available size including the next block (excluding the header)} + lea r15, [rax + rcx] + {Can the block fit?} + cmp rdx, r15 + ja @CannotUpsizeMediumBlockInPlace + {The next block is free and there is enough space to grow this + block in place.} +{$ifndef AssumeMultiThreaded} + lea r8, IsMultiThread + cmp byte ptr [r8], False + je @DoMediumInPlaceUpsize +{$endif} +@DoMediumLockForUpsize: + {Lock the medium blocks.} + mov rbx, rcx + mov r15, rdx + call LockMediumBlocks + mov rcx, rbx + mov rdx, r15 + {Re-read the info for this block (since it may have changed before the medium + blocks could be locked)} + mov rbx, ExtractMediumAndLargeFlagsMask + and rbx, [rsi - BlockHeaderSize] + {Re-read the info for the next block} + mov rax, [rdi - BlockheaderSize] + {Next block still free?} + test al, IsFreeBlockFlag + jz @NextMediumBlockChanged + {Recalculate the next block size} + and eax, DropMediumAndLargeFlagsMask + {The available size including the next block} + lea r15, [rax + rcx] + {Can the block still fit?} + cmp rdx, r15 + ja @NextMediumBlockChanged +@DoMediumInPlaceUpsize: + {Is the next block binnable?} + cmp eax, MinimumMediumBlockSize + {Remove the next block} + jb @MediumInPlaceNoNextRemove + mov r14, rcx + mov rcx, rdi + mov rdi, rdx + call RemoveMediumFreeBlock + mov rcx, r14 + mov rdx, rdi +@MediumInPlaceNoNextRemove: + {Medium blocks grow a minimum of 25% in in-place upsizes} + mov eax, ecx + shr eax, 2 + add eax, ecx + {Get the maximum of the requested size and the minimum growth size} + xor edi, edi + sub eax, edx + adc edi, -1 + and eax, edi + {Round up to the nearest block size granularity} + lea eax, [eax + edx + BlockHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset] + and eax, -MediumBlockGranularity + add eax, MediumBlockSizeOffset + {Calculate the size of the second split} + lea rdx, [r15 + BlockHeaderSize] + sub edx, eax + {Does it fit?} + ja @MediumInPlaceUpsizeSplit + {Grab the whole block: Mark it as used in the block following it} + and qword ptr [rsi + r15], not PreviousMediumBlockIsFreeFlag + {The block size is the full available size plus header} + add r15, BlockHeaderSize + {Upsize done} + jmp @MediumUpsizeInPlaceDone +@MediumInPlaceUpsizeSplit: + {Store the size of the second split as the second last dword} + mov [rsi + r15 - BlockHeaderSize], rdx + {Set the second split header} + lea edi, [edx + IsMediumBlockFlag + IsFreeBlockFlag] + mov [rsi + rax - BlockHeaderSize], rdi + mov r15, rax + cmp edx, MinimumMediumBlockSize + jb @MediumUpsizeInPlaceDone + lea rcx, [rsi + rax] + call InsertMediumBlockIntoBin +@MediumUpsizeInPlaceDone: + {Set the size and flags for this block} + or r15, rbx + mov [rsi - BlockHeaderSize], r15 + {Unlock the medium blocks} + lea rax, MediumBlocksLocked + mov byte ptr [rax], False + {Result = old pointer} + mov rax, rsi + jmp @Done +@NextMediumBlockChanged: + {The next medium block changed while the medium blocks were being locked} + lea rax, MediumBlocksLocked + mov byte ptr [rax], False +@CannotUpsizeMediumBlockInPlace: + {Couldn't upsize in place. Grab a new block and move the data across: + If we have to reallocate and move medium blocks, we grow by at + least 25%} + mov eax, ecx + shr eax, 2 + add eax, ecx + {Get the maximum of the requested size and the minimum growth size} + xor rdi, rdi + sub rax, rdx + adc rdi, -1 + and rax, rdi + add rax, rdx + {Save the size to allocate} + mov r15, rax + {Save the size to move across} + mov edi, ecx + {Save the requested size} + mov rbx, rdx + {Get the block} + mov rcx, rax + call FastGetMem + mov rdx, rbx + {Success?} + test eax, eax + jz @Done + {If it's a Large block - store the actual user requested size} + cmp r15, MaximumMediumBlockSize - BlockHeaderSize + jbe @MediumUpsizeNotLarge + mov [rax - 2 * BlockHeaderSize], rdx +@MediumUpsizeNotLarge: + {Save the result} + mov r15, rax + {Move the data across} + mov rdx, rax + mov rcx, rsi + mov r8, rdi +{$ifdef UseCustomVariableSizeMoveRoutines} + call MoveX16LP +{$else} + call System.Move +{$endif} + {Free the old block} + mov rcx, rsi + call FastFreeMem + {Restore the result} + mov rax, r15 + jmp @Done +@PossibleLargeBlock: + {-----------------------Large block------------------------------} + {Is this a valid large block?} + test cl, IsFreeBlockFlag + IsMediumBlockFlag + jnz @Error + mov rcx, rsi + call ReallocateLargeBlock + jmp @Done + {-----------------------Invalid block------------------------------} +@Error: + xor eax, eax +@Done: +end; +{$endif} +{$endif} +{$endif} + +{Allocates a block and fills it with zeroes} +function FastAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc} NativeUInt{$else}Cardinal{$endif}{$endif}): Pointer; +{$ifndef ASMVersion} +{$ifdef LogLockContention} +{$ifdef FullDebugMode} +var + LCollector: PStaticCollector; +{$endif} +{$endif} +begin + {DebugAllocMem does not call FastAllocMem so in this case we can ignore returned collector.} + Result := FastGetMem(ASize{$ifdef LogLockContention}{$ifdef FullDebugMode}, LCollector{$endif}{$endif}); + {Large blocks are already zero filled} + if (Result <> nil) and (ASize <= (MaximumMediumBlockSize - BlockHeaderSize)) then + FillChar(Result^, ASize, 0); +end; +{$else} +{$ifdef 32Bit} +asm + push ebx + {Get the size rounded down to the previous multiple of 4 into ebx} + lea ebx, [eax - 1] + and ebx, -4 + {Get the block} + call FastGetMem + {Could a block be allocated? ecx = 0 if yes, $ffffffff if no} + cmp eax, 1 + sbb ecx, ecx + {Point edx to the last dword} + lea edx, [eax + ebx] + {ebx = $ffffffff if no block could be allocated, otherwise size rounded down + to previous multiple of 4. If ebx = 0 then the block size is 1..4 bytes and + the FPU based clearing loop should not be used (since it clears 8 bytes per + iteration).} + or ebx, ecx + jz @ClearLastDWord + {Large blocks are already zero filled} + cmp ebx, MaximumMediumBlockSize - BlockHeaderSize + jae @Done + {Make the counter negative based} + neg ebx + {Load zero into st(0)} + fldz + {Clear groups of 8 bytes. Block sizes are always four less than a multiple + of 8.} +@FillLoop: + fst qword ptr [edx + ebx] + add ebx, 8 + js @FillLoop + {Clear st(0)} + ffree st(0) + {Correct the stack top} + fincstp + {Clear the last four bytes} +@ClearLastDWord: + mov [edx], ecx +@Done: + pop ebx +end; + +{$else} + +{---------------64-bit BASM FastAllocMem---------------} +asm + .params 1 + .pushnv rbx + {Get the size rounded down to the previous multiple of SizeOf(Pointer) into + ebx} + lea rbx, [rcx - 1] + and rbx, -8 + {Get the block} + call FastGetMem + {Could a block be allocated? rcx = 0 if yes, -1 if no} + cmp rax, 1 + sbb rcx, rcx + {Point rdx to the last dword} + lea rdx, [rax + rbx] + {rbx = -1 if no block could be allocated, otherwise size rounded down + to previous multiple of 8. If rbx = 0 then the block size is 1..8 bytes and + the SSE2 based clearing loop should not be used (since it clears 16 bytes per + iteration).} + or rbx, rcx + jz @ClearLastQWord + {Large blocks are already zero filled} + cmp rbx, MaximumMediumBlockSize - BlockHeaderSize + jae @Done + {Make the counter negative based} + neg rbx + {Load zero into xmm0} + pxor xmm0, xmm0 + {Clear groups of 16 bytes. Block sizes are always 8 less than a multiple of + 16.} +@FillLoop: + movdqa [rdx + rbx], xmm0 + add rbx, 16 + js @FillLoop + {Clear the last 8 bytes} +@ClearLastQWord: + xor rcx, rcx + mov [rdx], rcx +@Done: +end; +{$endif} +{$endif} + +{$ifdef fpc} +Function FastFreeMemSize(p: pointer; size: NativeUInt):NativeUInt; +{$ifndef ASMVersion} +begin + if size=0 then + exit(0); + { can't free partial blocks, ignore size } + result := FastFreeMem(p); +{$else} +asm + test edx, edx + jne @SizeNotZero + mov eax, 0 + ret +@SizeNotZero: + call FastFreeMem +{$endif} +end; + +function FastMemSize(p: pointer): NativeUInt; +{$ifndef ASMVersion} +begin + result := GetAvailableSpaceInBlock(p); +{$else} +asm + call GetAvailableSpaceInBlock +{$endif} +end; +{$endif} + +{-----------------Post Uninstall GetMem/FreeMem/ReallocMem-------------------} + +{$ifdef DetectMMOperationsAfterUninstall} + +function InvalidGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; +{$ifndef NoMessageBoxes} +var + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} +begin +{$ifdef UseOutputDebugString} + OutputDebugStringA(InvalidGetMemMsg); +{$endif} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(InvalidOperationTitle, LErrorMessageTitle); + ShowMessageBox(InvalidGetMemMsg, LErrorMessageTitle); +{$endif} + Result := nil; +end; + +function InvalidFreeMem(APointer: Pointer): {$ifdef fpc}NativeUInt{$else}Integer{$endif}; +{$ifndef NoMessageBoxes} +var + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} +begin +{$ifdef UseOutputDebugString} + OutputDebugStringA(InvalidFreeMemMsg); +{$endif} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(InvalidOperationTitle, LErrorMessageTitle); + ShowMessageBox(InvalidFreeMemMsg, LErrorMessageTitle); +{$endif} + Result := -1; +end; + +function InvalidReallocMem({$ifdef fpc}var {$endif}APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Integer{$endif}{$endif}): Pointer; +{$ifndef NoMessageBoxes} +var + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} +begin +{$ifdef UseOutputDebugString} + OutputDebugStringA(InvalidReallocMemMsg); +{$endif} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(InvalidOperationTitle, LErrorMessageTitle); + ShowMessageBox(InvalidReallocMemMsg, LErrorMessageTitle); +{$endif} + Result := nil; +end; + +function InvalidAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}{$ifdef fpc}NativeUInt{$else}Cardinal{$endif}{$endif}): Pointer; +{$ifndef NoMessageBoxes} +var + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} +begin +{$ifdef UseOutputDebugString} + OutputDebugStringA(InvalidAllocMemMsg); +{$endif} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(InvalidOperationTitle, LErrorMessageTitle); + ShowMessageBox(InvalidAllocMemMsg, LErrorMessageTitle); +{$endif} + Result := nil; +end; + +function InvalidRegisterAndUnRegisterMemoryLeak(APointer: Pointer): Boolean; +begin + Result := False; +end; + +{$endif} + +{------------------------EventLog handling------------------------} + +{$ifdef _EventLog} +procedure DeleteEventLog; +begin + {Delete the file} + DeleteFileA(MMLogFileName); +end; + +{Finds the start and length of the file name given a full path.} +procedure ExtractFileName(APFullPath: PAnsiChar; var APFileNameStart: PAnsiChar; var AFileNameLength: Integer); +var + LChar: AnsiChar; +begin + {Initialize} + APFileNameStart := APFullPath; + AFileNameLength := 0; + {Find the file } + while True do + begin + {Get the next character} + LChar := APFullPath^; + {End of the path string?} + if LChar = #0 then + Break; + {Advance the buffer position} + Inc(APFullPath); + {Found a backslash? -> May be the start of the file name} + if LChar = '\' then + APFileNameStart := APFullPath; + end; + {Calculate the length of the file name} + AFileNameLength := IntPtr(APFullPath) - IntPtr(APFileNameStart); +end; + +procedure AppendEventLog(ABuffer: Pointer; ACount: Cardinal); +const + {Declared here, because it is not declared in the SHFolder.pas unit of some older Delphi versions.} + SHGFP_TYPE_CURRENT = 0; +var + LFileHandle, LBytesWritten: Cardinal; + LEventHeader: array[0..1023] of AnsiChar; + LAlternateLogFileName: array[0..2047] of AnsiChar; + LPathLen, LNameLength: Integer; + LMsgPtr, LPFileName: PAnsiChar; + LSystemTime: TSystemTime; +begin + {Try to open the log file in read/write mode.} + LFileHandle := CreateFileA(MMLogFileName, GENERIC_READ or GENERIC_WRITE, + 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + {Did log file creation fail? If so, the destination folder is perhaps read-only: + Try to redirect logging to a file in the user's "My Documents" folder.} + if (LFileHandle = INVALID_HANDLE_VALUE) + {$IFNDEF MACOS} +{$ifdef Delphi4or5} + and SHGetSpecialFolderPathA(0, @LAlternateLogFileName, CSIDL_PERSONAL, True) then +{$else} + and (SHGetFolderPathA(0, CSIDL_PERSONAL or CSIDL_FLAG_CREATE, 0, + SHGFP_TYPE_CURRENT, @LAlternateLogFileName) = S_OK) then +{$endif} + {$ELSE} + then + {$ENDIF} + begin + {Extract the filename part from MMLogFileName and append it to the path of + the "My Documents" folder.} + LPathLen := StrLen(LAlternateLogFileName); + {Ensure that there is a trailing backslash in the path} + if (LPathLen = 0) or (LAlternateLogFileName[LPathLen - 1] <> '\') then + begin + LAlternateLogFileName[LPathLen] := '\'; + Inc(LPathLen); + end; + {Add the filename to the path} + ExtractFileName(@MMLogFileName, LPFileName, LNameLength); + System.Move(LPFileName^, LAlternateLogFileName[LPathLen], LNameLength + 1); + {Try to open the alternate log file} + LFileHandle := CreateFileA(LAlternateLogFileName, GENERIC_READ or GENERIC_WRITE, + 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + end; + {Was the log file opened/created successfully?} + if LFileHandle <> INVALID_HANDLE_VALUE then + begin + {Seek to the end of the file} + SetFilePointer(LFileHandle, 0, nil, FILE_END); + {Set the separator} + LMsgPtr := AppendStringToBuffer(CRLF, @LEventHeader[0], Length(CRLF)); + LMsgPtr := AppendStringToBuffer(EventSeparator, LMsgPtr, Length(EventSeparator)); + {Set the date & time} + GetLocalTime(LSystemTime); + LMsgPtr := NativeUIntToStrBuf(LSystemTime.wYear, LMsgPtr); + LMsgPtr^ := '/'; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LSystemTime.wMonth, LMsgPtr); + LMsgPtr^ := '/'; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LSystemTime.wDay, LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LSystemTime.wHour, LMsgPtr); + LMsgPtr^ := ':'; + Inc(LMsgPtr); + if LSystemTime.wMinute < 10 then + begin + LMsgPtr^ := '0'; + Inc(LMsgPtr); + end; + LMsgPtr := NativeUIntToStrBuf(LSystemTime.wMinute, LMsgPtr); + LMsgPtr^ := ':'; + Inc(LMsgPtr); + if LSystemTime.wSecond < 10 then + begin + LMsgPtr^ := '0'; + Inc(LMsgPtr); + end; + LMsgPtr := NativeUIntToStrBuf(LSystemTime.WSecond, LMsgPtr); + {Write the header} + LMsgPtr := AppendStringToBuffer(EventSeparator, LMsgPtr, Length(EventSeparator)); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + WriteFile(LFileHandle, LEventHeader[0], NativeUInt(LMsgPtr) - NativeUInt(@LEventHeader[0]), LBytesWritten, nil); + {Write the data} + WriteFile(LFileHandle, ABuffer^, ACount, LBytesWritten, nil); + {Close the file} + CloseHandle(LFileHandle); + end; +end; + +{Sets the default log filename} +procedure SetDefaultMMLogFileName; +const + LogFileExtAnsi: PAnsiChar = LogFileExtension; +var + LEnvVarLength, LModuleNameLength: Cardinal; + LPathOverride: array[0..2047] of AnsiChar; + LPFileName: PAnsiChar; + LFileNameLength: Integer; +begin + {Get the name of the application} + LModuleNameLength := AppendModuleFileName(@MMLogFileName[0]); + {Replace the last few characters of the module name, and optionally override + the path.} + if LModuleNameLength > 0 then + begin + {Change the filename} + System.Move(LogFileExtAnsi^, MMLogFileName[LModuleNameLength - 4], + StrLen(LogFileExtAnsi) + 1); + {Try to read the FastMMLogFilePath environment variable} + LEnvVarLength := GetEnvironmentVariableA('FastMMLogFilePath', + @LPathOverride, 1023); + {Does the environment variable exist? If so, override the log file path.} + if LEnvVarLength > 0 then + begin + {Ensure that there's a trailing backslash.} + if LPathOverride[LEnvVarLength - 1] <> '\' then + begin + LPathOverride[LEnvVarLength] := '\'; + Inc(LEnvVarLength); + end; + {Add the filename to the path override} + ExtractFileName(@MMLogFileName[0], LPFileName, LFileNameLength); + System.Move(LPFileName^, LPathOverride[LEnvVarLength], LFileNameLength + 1); + {Copy the override path back to the filename buffer} + System.Move(LPathOverride, MMLogFileName, SizeOf(MMLogFileName) - 1); + end; + end; +end; + +{Specify the full path and name for the filename to be used for logging memory + errors, etc. If ALogFileName is nil or points to an empty string it will + revert to the default log file name.} +procedure SetMMLogFileName(ALogFileName: PAnsiChar = nil); +var + LLogFileNameLen: Integer; +begin + {Is ALogFileName valid?} + if (ALogFileName <> nil) and (ALogFileName^ <> #0) then + begin + LLogFileNameLen := StrLen(ALogFileName); + if LLogFileNameLen < Length(MMLogFileName) then + begin + {Set the log file name} + System.Move(ALogFileName^, MMLogFileName, LLogFileNameLen + 1); + Exit; + end; + end; + {Invalid log file name} + SetDefaultMMLogFileName; +end; +{$endif} + +{-----------------Full Debug Mode Memory Manager Interface--------------------} + +{$ifdef FullDebugMode} + +{Compare [AAddress], CompareVal: + If Equal: [AAddress] := NewVal and result = CompareVal + If Unequal: Result := [AAddress]} +function LockCmpxchg32(CompareVal, NewVal: Integer; AAddress: PInteger): Integer; +asm +{$ifdef 32Bit} + {On entry: + eax = CompareVal, + edx = NewVal, + ecx = AAddress} + lock cmpxchg [ecx], edx +{$else} +.noframe + {On entry: + ecx = CompareVal, + edx = NewVal, + r8 = AAddress} + mov eax, ecx + lock cmpxchg [r8], edx +{$endif} +end; + +{Called by DebugGetMem, DebugFreeMem and DebugReallocMem in order to block a + free block scan operation while the memory pool is being modified.} +procedure StartChangingFullDebugModeBlock; +var + LOldCount: Integer; +begin + while True do + begin + {Get the old thread count} + LOldCount := ThreadsInFullDebugModeRoutine; + if (LOldCount >= 0) + and (LockCmpxchg32(LOldCount, LOldCount + 1, @ThreadsInFullDebugModeRoutine) = LOldCount) then + begin + Break; + end; + {$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} + {$else} + Sleep(InitialSleepTime); + {Try again} + LOldCount := ThreadsInFullDebugModeRoutine; + if (LOldCount >= 0) + and (LockCmpxchg32(LOldCount, LOldCount + 1, @ThreadsInFullDebugModeRoutine) = LOldCount) then + begin + Break; + end; + Sleep(AdditionalSleepTime); + {$endif} + end; +end; + +procedure DoneChangingFullDebugModeBlock; +asm +{$ifdef 32Bit} + lock dec ThreadsInFullDebugModeRoutine +{$else} +.noframe + lea rax, ThreadsInFullDebugModeRoutine + lock dec dword ptr [rax] +{$endif} +end; + +{Increments the allocation number} +procedure IncrementAllocationNumber; +asm +{$ifdef 32Bit} + lock inc CurrentAllocationNumber +{$else} +.noframe + lea rax, CurrentAllocationNumber + lock inc dword ptr [rax] +{$endif} +end; + +{Called by a routine wanting to lock the entire memory pool in FullDebugMode, e.g. before scanning the memory + pool for corruptions.} +procedure BlockFullDebugModeMMRoutines; +begin + while True do + begin + {Get the old thread count} + if LockCmpxchg32(0, -1, @ThreadsInFullDebugModeRoutine) = 0 then + Break; +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + {Try again} + if LockCmpxchg32(0, -1, @ThreadsInFullDebugModeRoutine) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; +end; + +procedure UnblockFullDebugModeMMRoutines; +begin + {Currently blocked? If so, unblock the FullDebugMode routines.} + if ThreadsInFullDebugModeRoutine = -1 then + ThreadsInFullDebugModeRoutine := 0; +end; + +{Returns the current "allocation group". Whenever a GetMem request is serviced + in FullDebugMode, the current "allocation group" is stored in the block header. + This may help with debugging. Note that if a block is subsequently reallocated + that it keeps its original "allocation group" and "allocation number" (all + allocations are also numbered sequentially).} +function GetCurrentAllocationGroup: Cardinal; +begin + Result := AllocationGroupStack[AllocationGroupStackTop]; +end; + +{Allocation groups work in a stack like fashion. Group numbers are pushed onto + and popped off the stack. Note that the stack size is limited, so every push + should have a matching pop.} +procedure PushAllocationGroup(ANewCurrentAllocationGroup: Cardinal); +begin + if AllocationGroupStackTop < AllocationGroupStackSize - 1 then + begin + Inc(AllocationGroupStackTop); + AllocationGroupStack[AllocationGroupStackTop] := ANewCurrentAllocationGroup; + end + else + begin + {Raise a runtime error if the stack overflows} + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; +end; + +procedure PopAllocationGroup; +begin + if AllocationGroupStackTop > 0 then + begin + Dec(AllocationGroupStackTop); + end + else + begin + {Raise a runtime error if the stack underflows} + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; +end; + +{Sums all the dwords starting at the given address. ACount must be > 0 and a + multiple of SizeOf(Pointer).} +function SumNativeUInts(AStartValue: NativeUInt; APointer: PNativeUInt; + ACount: NativeUInt): NativeUInt; +asm +{$ifdef 32Bit} + {On entry: eax = AStartValue, edx = APointer; ecx = ACount} + add edx, ecx + neg ecx +@AddLoop: + add eax, [edx + ecx] + add ecx, 4 + js @AddLoop +{$else} + {On entry: rcx = AStartValue, rdx = APointer; r8 = ACount} + add rdx, r8 + neg r8 + mov rax, rcx +@AddLoop: + add rax, [rdx + r8] + add r8, 8 + js @AddLoop +{$endif} +end; + +{Checks the memory starting at the given address for the fill pattern. + Returns True if all bytes are all valid. ACount must be >0 and a multiple of + SizeOf(Pointer).} +function CheckFillPattern(APointer: Pointer; ACount: NativeUInt; + AFillPattern: NativeUInt): Boolean; +asm +{$ifdef 32Bit} + {On entry: eax = APointer; edx = ACount; ecx = AFillPattern} + add eax, edx + neg edx +@CheckLoop: + cmp [eax + edx], ecx + jne @Done + add edx, 4 + js @CheckLoop +@Done: + sete al +{$else} + {On entry: rcx = APointer; rdx = ACount; r8 = AFillPattern} + add rcx, rdx + neg rdx +@CheckLoop: + cmp [rcx + rdx], r8 + jne @Done + add rdx, 8 + js @CheckLoop +@Done: + sete al +{$endif} +end; + +{Calculates the checksum for the debug header. Adds all dwords in the debug + header to the start address of the block.} +function CalculateHeaderCheckSum(APointer: PFullDebugBlockHeader): NativeUInt; +begin + Result := SumNativeUInts( + NativeUInt(APointer), + PNativeUInt(PByte(APointer) + 2 * SizeOf(Pointer)), + SizeOf(TFullDebugBlockHeader) - 2 * SizeOf(Pointer) - SizeOf(NativeUInt)); +end; + +procedure UpdateHeaderAndFooterCheckSums(APointer: PFullDebugBlockHeader); +var + LHeaderCheckSum: NativeUInt; +begin + LHeaderCheckSum := CalculateHeaderCheckSum(APointer); + APointer.HeaderCheckSum := LHeaderCheckSum; + PNativeUInt(PByte(APointer) + SizeOf(TFullDebugBlockHeader) + APointer.UserSize)^ := not LHeaderCheckSum; +end; + +function LogCurrentThreadAndStackTrace(ASkipFrames: Cardinal; ABuffer: PAnsiChar): PAnsiChar; +var + LCurrentStackTrace: TStackTrace; +begin + {Get the current call stack} + GetStackTrace(@LCurrentStackTrace[0], StackTraceDepth, ASkipFrames); + {Log the thread ID} + Result := AppendStringToBuffer(CurrentThreadIDMsg, ABuffer, Length(CurrentThreadIDMsg)); + Result := NativeUIntToHexBuf(GetThreadID, Result); + {List the stack trace} + Result := AppendStringToBuffer(CurrentStackTraceMsg, Result, Length(CurrentStackTraceMsg)); + Result := LogStackTrace(@LCurrentStackTrace, StackTraceDepth, Result); +end; + +{$ifndef DisableLoggingOfMemoryDumps} +function LogMemoryDump(APointer: PFullDebugBlockHeader; ABuffer: PAnsiChar): PAnsiChar; +var + LByteNum, LVal: Cardinal; + LDataPtr: PByte; +begin + Result := AppendStringToBuffer(MemoryDumpMsg, ABuffer, Length(MemoryDumpMsg)); + Result := NativeUIntToHexBuf(NativeUInt(APointer) + SizeOf(TFullDebugBlockHeader), Result); + Result^ := ':'; + Inc(Result); + {Add the bytes} + LDataPtr := PByte(PByte(APointer) + SizeOf(TFullDebugBlockHeader)); + for LByteNum := 0 to 255 do + begin + if LByteNum and 31 = 0 then + begin + Result^ := #13; + Inc(Result); + Result^ := #10; + Inc(Result); + end + else + begin + Result^ := ' '; + Inc(Result); + end; + {Set the hex data} + LVal := Byte(LDataPtr^); + Result^ := HexTable[LVal shr 4]; + Inc(Result); + Result^ := HexTable[LVal and $f]; + Inc(Result); + {Next byte} + Inc(LDataPtr); + end; + {Dump ASCII} + LDataPtr := PByte(PByte(APointer) + SizeOf(TFullDebugBlockHeader)); + for LByteNum := 0 to 255 do + begin + if LByteNum and 31 = 0 then + begin + Result^ := #13; + Inc(Result); + Result^ := #10; + Inc(Result); + end + else + begin + Result^ := ' '; + Inc(Result); + Result^ := ' '; + Inc(Result); + end; + {Set the hex data} + LVal := Byte(LDataPtr^); + if LVal < 32 then + Result^ := '.' + else + Result^ := AnsiChar(LVal); + Inc(Result); + {Next byte} + Inc(LDataPtr); + end; +end; +{$endif} + +{Rotates AValue ABitCount bits to the right} +function RotateRight(AValue, ABitCount: NativeUInt): NativeUInt; +asm +{$ifdef 32Bit} + mov ecx, edx + ror eax, cl +{$else} + mov rax, rcx + mov rcx, rdx + ror rax, cl +{$endif} +end; + +{Determines whether a byte in the user portion of the freed block has been modified. Does not work beyond + the end of the user portion (i.e. footer and beyond).} +function FreeBlockByteWasModified(APointer: PFullDebugBlockHeader; AUserOffset: NativeUInt): Boolean; +var + LFillPattern: NativeUInt; +begin + {Get the expected fill pattern} + if AUserOffset < SizeOf(Pointer) then + begin + LFillPattern := NativeUInt(@FreedObjectVMT.VMTMethods[0]); + end + else + begin +{$ifndef CatchUseOfFreedInterfaces} + LFillPattern := DebugFillPattern; +{$else} + LFillPattern := NativeUInt(@VMTBadInterface); +{$endif} + end; + {Compare the byte value} + Result := Byte(PByte(PByte(APointer) + SizeOf(TFullDebugBlockHeader) + AUserOffset)^) <> + Byte(RotateRight(LFillPattern, (AUserOffset and (SizeOf(Pointer) - 1)) * 8)); +end; + +function LogBlockChanges(APointer: PFullDebugBlockHeader; ABuffer: PAnsiChar): PAnsiChar; +var + LOffset, LChangeStart, LCount: NativeUInt; + LLogCount: Integer; +begin + {No errors logged so far} + LLogCount := 0; + {Log a maximum of 32 changes} + LOffset := 0; + while (LOffset < APointer.UserSize) and (LLogCount < 32) do + begin + {Has the byte been modified?} + if FreeBlockByteWasModified(APointer, LOffset) then + begin + {Found the start of a changed block, now find the length} + LChangeStart := LOffset; + LCount := 0; + while True do + begin + Inc(LCount); + Inc(LOffset); + if (LOffset >= APointer.UserSize) + or (not FreeBlockByteWasModified(APointer, LOffset)) then + begin + Break; + end; + end; + {Got the offset and length, now log it.} + if LLogCount = 0 then + begin + ABuffer := AppendStringToBuffer(FreeModifiedDetailMsg, ABuffer, Length(FreeModifiedDetailMsg)); + end + else + begin + ABuffer^ := ','; + Inc(ABuffer); + ABuffer^ := ' '; + Inc(ABuffer); + end; + ABuffer := NativeUIntToStrBuf(LChangeStart, ABuffer); + ABuffer^ := '('; + Inc(ABuffer); + ABuffer := NativeUIntToStrBuf(LCount, ABuffer); + ABuffer^ := ')'; + Inc(ABuffer); + {Increment the log count} + Inc(LLogCount); + end; + {Next byte} + Inc(LOffset); + end; + {Return the current buffer position} + Result := ABuffer; +end; + +procedure LogBlockError(APointer: PFullDebugBlockHeader; AOperation: TBlockOperation; LHeaderValid, LFooterValid: Boolean); +var + LMsgPtr: PAnsiChar; + LErrorMessage: array[0..32767] of AnsiChar; +{$ifndef NoMessageBoxes} + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} + LClass: TClass; + {$ifdef CheckCppObjectTypeEnabled} + LCppObjectTypeName: PAnsiChar; + {$endif} +begin + {Display the error header and the operation type.} + LMsgPtr := AppendStringToBuffer(ErrorMsgHeader, @LErrorMessage[0], Length(ErrorMsgHeader)); + case AOperation of + boGetMem: LMsgPtr := AppendStringToBuffer(GetMemMsg, LMsgPtr, Length(GetMemMsg)); + boFreeMem: LMsgPtr := AppendStringToBuffer(FreeMemMsg, LMsgPtr, Length(FreeMemMsg)); + boReallocMem: LMsgPtr := AppendStringToBuffer(ReallocMemMsg, LMsgPtr, Length(ReallocMemMsg)); + boBlockCheck: LMsgPtr := AppendStringToBuffer(BlockCheckMsg, LMsgPtr, Length(BlockCheckMsg)); + end; + LMsgPtr := AppendStringToBuffer(OperationMsg, LMsgPtr, Length(OperationMsg)); + {Is the header still intact?} + if LHeaderValid then + begin + {Is the footer still valid?} + if LFooterValid then + begin + {A freed block has been modified, a double free has occurred, or an + attempt was made to free a memory block allocated by a different + instance of FastMM.} + if AOperation <= boGetMem then + begin + LMsgPtr := AppendStringToBuffer(FreeModifiedErrorMsg, LMsgPtr, Length(FreeModifiedErrorMsg)); + {Log the exact changes that caused the error.} + LMsgPtr := LogBlockChanges(APointer, LMsgPtr); + end + else + begin + {It is either a double free, or an attempt was made to free a block + that was allocated via a different memory manager.} + if APointer.AllocatedByRoutine = nil then + LMsgPtr := AppendStringToBuffer(DoubleFreeErrorMsg, LMsgPtr, Length(DoubleFreeErrorMsg)) + else + LMsgPtr := AppendStringToBuffer(WrongMMFreeErrorMsg, LMsgPtr, Length(WrongMMFreeErrorMsg)); + end; + end + else + begin + LMsgPtr := AppendStringToBuffer(BlockFooterCorruptedMsg, LMsgPtr, Length(BlockFooterCorruptedMsg)) + end; + {Set the block size message} + if AOperation <= boGetMem then + LMsgPtr := AppendStringToBuffer(PreviousBlockSizeMsg, LMsgPtr, Length(PreviousBlockSizeMsg)) + else + LMsgPtr := AppendStringToBuffer(CurrentBlockSizeMsg, LMsgPtr, Length(CurrentBlockSizeMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.UserSize, LMsgPtr); + {The header is still intact - display info about the this/previous allocation} + if APointer.AllocationStackTrace[0] <> 0 then + begin + if AOperation <= boGetMem then + LMsgPtr := AppendStringToBuffer(ThreadIDPrevAllocMsg, LMsgPtr, Length(ThreadIDPrevAllocMsg)) + else + LMsgPtr := AppendStringToBuffer(ThreadIDAtAllocMsg, LMsgPtr, Length(ThreadIDAtAllocMsg)); + LMsgPtr := NativeUIntToHexBuf(APointer.AllocatedByThread, LMsgPtr); + LMsgPtr := AppendStringToBuffer(StackTraceMsg, LMsgPtr, Length(StackTraceMsg)); + LMsgPtr := LogStackTrace(@APointer.AllocationStackTrace, StackTraceDepth, LMsgPtr); + end; + {Get the class this block was used for previously} + LClass := DetectClassInstance(@APointer.PreviouslyUsedByClass); + if (LClass <> nil) and (IntPtr(LClass) <> IntPtr(@FreedObjectVMT.VMTMethods[0])) then + begin + LMsgPtr := AppendStringToBuffer(PreviousObjectClassMsg, LMsgPtr, Length(PreviousObjectClassMsg)); + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + end; + {$ifdef CheckCppObjectTypeEnabled} + if (LClass = nil) and Assigned(GetCppVirtObjTypeNameByVTablePtrFunc) then + begin + LCppObjectTypeName := GetCppVirtObjTypeNameByVTablePtrFunc(Pointer(APointer.PreviouslyUsedByClass), 0); + if Assigned(LCppObjectTypeName) then + begin + LMsgPtr := AppendStringToBuffer(PreviousObjectClassMsg, LMsgPtr, Length(PreviousObjectClassMsg)); + LMsgPtr := AppendStringToBuffer(LCppObjectTypeName, LMsgPtr, StrLen(LCppObjectTypeName)); + end; + end; + {$endif} + {Get the current class for this block} + if (AOperation > boGetMem) and (APointer.AllocatedByRoutine <> nil) then + begin + LMsgPtr := AppendStringToBuffer(CurrentObjectClassMsg, LMsgPtr, Length(CurrentObjectClassMsg)); + LClass := DetectClassInstance(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader))); + if IntPtr(LClass) = IntPtr(@FreedObjectVMT.VMTMethods[0]) then + LClass := nil; + {$ifndef CheckCppObjectTypeEnabled} + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + {$else} + if (LClass = nil) and Assigned(GetCppVirtObjTypeNameFunc) then + begin + LCppObjectTypeName := GetCppVirtObjTypeNameFunc(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader)), + APointer.UserSize); + if LCppObjectTypeName <> nil then + LMsgPtr := AppendStringToBuffer(LCppObjectTypeName, LMsgPtr, StrLen(LCppObjectTypeName)) + else + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + end + else + begin + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + end; + {$endif} + {Log the allocation group} + if APointer.AllocationGroup > 0 then + begin + LMsgPtr := AppendStringToBuffer(CurrentAllocationGroupMsg, LMsgPtr, Length(CurrentAllocationGroupMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationGroup, LMsgPtr); + end; + {Log the allocation number} + LMsgPtr := AppendStringToBuffer(CurrentAllocationNumberMsg, LMsgPtr, Length(CurrentAllocationNumberMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationNumber, LMsgPtr); + end + else + begin + {Log the allocation group} + if APointer.AllocationGroup > 0 then + begin + LMsgPtr := AppendStringToBuffer(PreviousAllocationGroupMsg, LMsgPtr, Length(PreviousAllocationGroupMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationGroup, LMsgPtr); + end; + {Log the allocation number} + LMsgPtr := AppendStringToBuffer(PreviousAllocationNumberMsg, LMsgPtr, Length(PreviousAllocationNumberMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationNumber, LMsgPtr); + end; + {Get the call stack for the previous free} + if APointer.FreeStackTrace[0] <> 0 then + begin + LMsgPtr := AppendStringToBuffer(ThreadIDAtFreeMsg, LMsgPtr, Length(ThreadIDAtFreeMsg)); + LMsgPtr := NativeUIntToHexBuf(APointer.FreedByThread, LMsgPtr); + LMsgPtr := AppendStringToBuffer(StackTraceMsg, LMsgPtr, Length(StackTraceMsg)); + LMsgPtr := LogStackTrace(@APointer.FreeStackTrace, StackTraceDepth, LMsgPtr); + end; + end + else + begin + {Header has been corrupted} + LMsgPtr := AppendStringToBuffer(BlockHeaderCorruptedMsg, LMsgPtr, Length(BlockHeaderCorruptedMsg)); + end; + {Add the current stack trace} + LMsgPtr := LogCurrentThreadAndStackTrace(3 + Ord(AOperation <> boGetMem) + Ord(AOperation = boReallocMem), LMsgPtr); +{$ifndef DisableLoggingOfMemoryDumps} + {Add the memory dump} + LMsgPtr := LogMemoryDump(APointer, LMsgPtr); +{$endif} + {Trailing CRLF} + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + {Trailing #0} + LMsgPtr^ := #0; +{$ifdef LogErrorsToFile} + {Log the error} + AppendEventLog(@LErrorMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LErrorMessage[0])); +{$endif} +{$ifdef UseOutputDebugString} + OutputDebugStringA(LErrorMessage); +{$endif} + {Show the message} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(BlockErrorMsgTitle, LErrorMessageTitle); + ShowMessageBox(LErrorMessage, LErrorMessageTitle); +{$endif} +end; + +{Logs the stack traces for a memory leak to file} +procedure LogMemoryLeakOrAllocatedBlock(APointer: PFullDebugBlockHeader; IsALeak: Boolean); +var + LHeaderValid: Boolean; + LMsgPtr: PAnsiChar; + LErrorMessage: array[0..32767] of AnsiChar; + LClass: TClass; + {$ifdef CheckCppObjectTypeEnabled} + LCppObjectTypeName: PAnsiChar; + {$endif} +begin + {Display the error header and the operation type.} + if IsALeak then + LMsgPtr := AppendStringToBuffer(LeakLogHeader, @LErrorMessage[0], Length(LeakLogHeader)) + else + LMsgPtr := AppendStringToBuffer(BlockScanLogHeader, @LErrorMessage[0], Length(BlockScanLogHeader)); + LMsgPtr := NativeUIntToStrBuf(GetAvailableSpaceInBlock(APointer) - FullDebugBlockOverhead, LMsgPtr); + {Is the debug info surrounding the block valid?} + LHeaderValid := CalculateHeaderCheckSum(APointer) = APointer.HeaderCheckSum; + {Is the header still intact?} + if LHeaderValid then + begin + {The header is still intact - display info about this/previous allocation} + if APointer.AllocationStackTrace[0] <> 0 then + begin + LMsgPtr := AppendStringToBuffer(ThreadIDAtAllocMsg, LMsgPtr, Length(ThreadIDAtAllocMsg)); + LMsgPtr := NativeUIntToHexBuf(APointer.AllocatedByThread, LMsgPtr); + LMsgPtr := AppendStringToBuffer(StackTraceMsg, LMsgPtr, Length(StackTraceMsg)); + LMsgPtr := LogStackTrace(@APointer.AllocationStackTrace, StackTraceDepth, LMsgPtr); + end; + LMsgPtr := AppendStringToBuffer(CurrentObjectClassMsg, LMsgPtr, Length(CurrentObjectClassMsg)); + {Get the current class for this block} + LClass := DetectClassInstance(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader))); + if IntPtr(LClass) = IntPtr(@FreedObjectVMT.VMTMethods[0]) then + LClass := nil; + {$ifndef CheckCppObjectTypeEnabled} + if LClass <> nil then + begin + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + end + else + begin + case DetectStringData(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader)), APointer.UserSize) of + stUnknown: LMsgPtr := AppendClassNameToBuffer(nil, LMsgPtr); + stAnsiString: LMsgPtr := AppendStringToBuffer(AnsiStringBlockMessage, LMsgPtr, Length(AnsiStringBlockMessage)); + stUnicodeString: LMsgPtr := AppendStringToBuffer(UnicodeStringBlockMessage, LMsgPtr, Length(UnicodeStringBlockMessage)); + end; + end; + {$else} + if (LClass = nil) and Assigned(GetCppVirtObjTypeNameFunc) then + begin + LCppObjectTypeName := GetCppVirtObjTypeNameFunc(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader)), + APointer.UserSize); + if LCppObjectTypeName <> nil then + LMsgPtr := AppendStringToBuffer(LCppObjectTypeName, LMsgPtr, StrLen(LCppObjectTypeName)) + else + begin + case DetectStringData(Pointer(PByte(APointer) + SizeOf(TFullDebugBlockHeader)), APointer.UserSize) of + stUnknown: LMsgPtr := AppendClassNameToBuffer(nil, LMsgPtr); + stAnsiString: LMsgPtr := AppendStringToBuffer(AnsiStringBlockMessage, LMsgPtr, Length(AnsiStringBlockMessage)); + stUnicodeString: LMsgPtr := AppendStringToBuffer(UnicodeStringBlockMessage, LMsgPtr, Length(UnicodeStringBlockMessage)); + end; + end; + end + else + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + {$endif} + {Log the allocation group} + if APointer.AllocationGroup > 0 then + begin + LMsgPtr := AppendStringToBuffer(CurrentAllocationGroupMsg, LMsgPtr, Length(CurrentAllocationGroupMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationGroup, LMsgPtr); + end; + {Log the allocation number} + LMsgPtr := AppendStringToBuffer(CurrentAllocationNumberMsg, LMsgPtr, Length(CurrentAllocationNumberMsg)); + LMsgPtr := NativeUIntToStrBuf(APointer.AllocationNumber, LMsgPtr); + end + else + begin + {Header has been corrupted} + LMsgPtr^ := '.'; + Inc(LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr := AppendStringToBuffer(BlockHeaderCorruptedMsg, LMsgPtr, Length(BlockHeaderCorruptedMsg)); + end; +{$ifndef DisableLoggingOfMemoryDumps} + {Add the memory dump} + LMsgPtr := LogMemoryDump(APointer, LMsgPtr); +{$endif} + {Trailing CRLF} + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + {Trailing #0} + LMsgPtr^ := #0; + {Log the error} + AppendEventLog(@LErrorMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LErrorMessage[0])); +end; + +{Checks that a free block is unmodified} +function CheckFreeBlockUnmodified(APBlock: PFullDebugBlockHeader; ABlockSize: NativeUInt; + AOperation: TBlockOperation): Boolean; +var + LHeaderCheckSum: NativeUInt; + LHeaderValid, LFooterValid, LBlockUnmodified: Boolean; +begin + LHeaderCheckSum := CalculateHeaderCheckSum(APBlock); + LHeaderValid := LHeaderCheckSum = APBlock.HeaderCheckSum; + {Is the footer itself still in place} + LFooterValid := LHeaderValid + and (PNativeUInt(PByte(APBlock) + SizeOf(TFullDebugBlockHeader) + APBlock.UserSize)^ = (not LHeaderCheckSum)); + {Is the footer and debug VMT in place? The debug VMT is only valid if the user size is greater than the size of a pointer.} + if LFooterValid + and (APBlock.UserSize < SizeOf(Pointer)) or (PNativeUInt(PByte(APBlock) + SizeOf(TFullDebugBlockHeader))^ = NativeUInt(@FreedObjectVMT.VMTMethods[0])) then + begin + {Store the debug fill pattern in place of the footer in order to simplify + checking for block modifications.} + PNativeUInt(PByte(APBlock) + SizeOf(TFullDebugBlockHeader) + APBlock.UserSize)^ := + {$ifndef CatchUseOfFreedInterfaces} + DebugFillPattern; + {$else} + RotateRight(NativeUInt(@VMTBadInterface), (APBlock.UserSize and (SizeOf(Pointer) - 1)) * 8); + {$endif} + {Check that all the filler bytes are valid inside the block, except for + the "dummy" class header} + LBlockUnmodified := CheckFillPattern(PNativeUInt(PByte(APBlock) + (SizeOf(TFullDebugBlockHeader) + SizeOf(Pointer))), + ABlockSize - (FullDebugBlockOverhead + SizeOf(Pointer)), + {$ifndef CatchUseOfFreedInterfaces}DebugFillPattern{$else}NativeUInt(@VMTBadInterface){$endif}); + {Reset the old footer} + PNativeUInt(PByte(APBlock) + SizeOf(TFullDebugBlockHeader) + APBlock.UserSize)^ := not LHeaderCheckSum; + end + else + LBlockUnmodified := False; + if (not LHeaderValid) or (not LFooterValid) or (not LBlockUnmodified) then + begin + LogBlockError(APBlock, AOperation, LHeaderValid, LFooterValid); + Result := False; + end + else + Result := True; +end; + +function DebugGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}Integer{$endif}): Pointer; +{$ifdef LogLockContention} +var + LCollector: PStaticCollector; + LStackTrace: TStackTrace; +{$endif} +begin + {Scan the entire memory pool first?} + if FullDebugModeScanMemoryPoolBeforeEveryOperation then + ScanMemoryPoolForCorruptions; + {Enter the memory manager: block scans may not be performed now} + StartChangingFullDebugModeBlock; + try + {We need extra space for (a) The debug header, (b) the block debug trailer + and (c) the trailing block size pointer for free blocks} + Result := FastGetMem(ASize + FullDebugBlockOverhead {$ifdef LogLockContention}, LCollector{$endif}); + if Result <> nil then + begin + {Large blocks are always newly allocated (and never reused), so checking + for a modify-after-free is not necessary.} + if (ASize > (MaximumMediumBlockSize - BlockHeaderSize - FullDebugBlockOverhead)) + or CheckFreeBlockUnmodified(Result, GetAvailableSpaceInBlock(Result) + BlockHeaderSize, boGetMem) then + begin + {Set the allocation call stack} + GetStackTrace(@PFullDebugBlockHeader(Result).AllocationStackTrace, StackTraceDepth, 1); +{$ifdef LogLockContention} + if assigned(LCollector) then + LCollector.Add(@PFullDebugBlockHeader(Result).AllocationStackTrace[0], StackTraceDepth); +{$endif LogLockContention} + {Set the thread ID of the thread that allocated the block} + PFullDebugBlockHeader(Result).AllocatedByThread := GetThreadID; + {Block is now in use: It was allocated by this routine} + PFullDebugBlockHeader(Result).AllocatedByRoutine := @DebugGetMem; + {Set the group number} + PFullDebugBlockHeader(Result).AllocationGroup := AllocationGroupStack[AllocationGroupStackTop]; + {Set the allocation number} + IncrementAllocationNumber; + PFullDebugBlockHeader(Result).AllocationNumber := CurrentAllocationNumber; + {Clear the previous block trailer} + PNativeUInt(PByte(Result) + SizeOf(TFullDebugBlockHeader) + PFullDebugBlockHeader(Result).UserSize)^ := + {$ifndef CatchUseOfFreedInterfaces} + DebugFillPattern; + {$else} + RotateRight(NativeUInt(@VMTBadInterface), (PFullDebugBlockHeader(Result).UserSize and (SizeOf(Pointer) - 1)) * 8); + {$endif} + {Set the user size for the block} + PFullDebugBlockHeader(Result).UserSize := ASize; + {Set the checksums} + UpdateHeaderAndFooterCheckSums(Result); + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugGetMemFinish) then + OnDebugGetMemFinish(PFullDebugBlockHeader(Result), ASize); + {$endif} + {Return the start of the actual block} + Result := Pointer(PByte(Result) + SizeOf(TFullDebugBlockHeader)); +{$ifdef EnableMemoryLeakReporting} + {Should this block be marked as an expected leak automatically?} + if FullDebugModeRegisterAllAllocsAsExpectedMemoryLeak then + RegisterExpectedMemoryLeak(Result); +{$endif} + end + else + begin +{$ifdef LogLockContention} + if assigned(LCollector) then + begin + GetStackTrace(@LStackTrace, StackTraceDepth, 1); + LCollector.Add(@LStackTrace[0], StackTraceDepth); + end; +{$endif LogLockContention} + Result := nil; + end; + end; + finally + {Leaving the memory manager routine: Block scans may be performed again.} + DoneChangingFullDebugModeBlock; + end; +end; + +function CheckBlockBeforeFreeOrRealloc(APBlock: PFullDebugBlockHeader; + AOperation: TBlockOperation): Boolean; +var + LHeaderValid, LFooterValid: Boolean; + LPFooter: PNativeUInt; +{$ifndef CatchUseOfFreedInterfaces} + LBlockSize: NativeUInt; + LPTrailingByte, LPFillPatternEnd: PByte; +{$endif} +begin + {Is the checksum for the block header valid?} + LHeaderValid := CalculateHeaderCheckSum(APBlock) = APBlock.HeaderCheckSum; + {If the header is corrupted then the footer is assumed to be corrupt too.} + if LHeaderValid then + begin + {Check the footer checksum: The footer checksum should equal the header + checksum with all bits inverted.} + LPFooter := PNativeUInt(PByte(APBlock) + SizeOf(TFullDebugBlockHeader) + PFullDebugBlockHeader(APBlock).UserSize); + if APBlock.HeaderCheckSum = (not (LPFooter^)) then + begin + LFooterValid := True; +{$ifndef CatchUseOfFreedInterfaces} + {Large blocks do not have the debug fill pattern, since they are never reused.} + if PNativeUInt(PByte(APBlock) - BlockHeaderSize)^ and (IsMediumBlockFlag or IsLargeBlockFlag) <> IsLargeBlockFlag then + begin + {Check that the application has not modified bytes beyond the block + footer. The $80 fill pattern should extend up to 2 nativeints before + the start of the next block (leaving space for the free block size and + next block header.)} + LBlockSize := GetAvailableSpaceInBlock(APBlock); + LPFillPatternEnd := PByte(PByte(APBlock) + LBlockSize - SizeOf(Pointer)); + LPTrailingByte := PByte(PByte(LPFooter) + SizeOf(NativeUInt)); + while UIntPtr(LPTrailingByte) < UIntPtr(LPFillPatternEnd) do + begin + if Byte(LPTrailingByte^) <> DebugFillByte then + begin + LFooterValid := False; + Break; + end; + Inc(LPTrailingByte); + end; + end; +{$endif} + end + else + LFooterValid := False; + end + else + LFooterValid := False; + {The header and footer must be intact and the block must have been allocated + by this memory manager instance.} + if LFooterValid and (APBlock.AllocatedByRoutine = @DebugGetMem) then + begin + Result := True; + end + else + begin + {Log the error} + LogBlockError(APBlock, AOperation, LHeaderValid, LFooterValid); + {Return an error} + Result := False; + end; +end; + +function DebugFreeMem(APointer: Pointer): Integer; +var + LActualBlock: PFullDebugBlockHeader; + LBlockHeader: NativeUInt; +begin + {Scan the entire memory pool first?} + if FullDebugModeScanMemoryPoolBeforeEveryOperation then + ScanMemoryPoolForCorruptions; + {Get a pointer to the start of the actual block} + LActualBlock := PFullDebugBlockHeader(PByte(APointer) + - SizeOf(TFullDebugBlockHeader)); + {Is the debug info surrounding the block valid?} + if CheckBlockBeforeFreeOrRealloc(LActualBlock, boFreeMem) then + begin + {Enter the memory manager: block scans may not be performed now} + StartChangingFullDebugModeBlock; + try + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugFreeMemStart) then + OnDebugFreeMemStart(LActualBlock); + {$endif} + {Large blocks are never reused, so there is no point in updating their + headers and fill pattern.} + LBlockHeader := PNativeUInt(PByte(LActualBlock) - BlockHeaderSize)^; + if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag or IsLargeBlockFlag) <> IsLargeBlockFlag then + begin + {Get the class the block was used for} + LActualBlock.PreviouslyUsedByClass := PNativeUInt(APointer)^; + {Set the free call stack} + GetStackTrace(@LActualBlock.FreeStackTrace, StackTraceDepth, 1); + {Set the thread ID of the thread that freed the block} + LActualBlock.FreedByThread := GetThreadID; + {Block is now free} + LActualBlock.AllocatedByRoutine := nil; + {Clear the user area of the block} + DebugFillMem(APointer^, LActualBlock.UserSize, + {$ifndef CatchUseOfFreedInterfaces}DebugFillPattern{$else}NativeUInt(@VMTBadInterface){$endif}); + {Set a pointer to the dummy VMT} + PNativeUInt(APointer)^ := NativeUInt(@FreedObjectVMT.VMTMethods[0]); + {Recalculate the checksums} + UpdateHeaderAndFooterCheckSums(LActualBlock); + end; +{$ifdef EnableMemoryLeakReporting} + {Automatically deregister the expected memory leak?} + if FullDebugModeRegisterAllAllocsAsExpectedMemoryLeak then + UnregisterExpectedMemoryLeak(APointer); +{$endif} + {Free the actual block} + Result := FastFreeMem(LActualBlock); + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugFreeMemFinish) then + OnDebugFreeMemFinish(LActualBlock, Result); + {$endif} + finally + {Leaving the memory manager routine: Block scans may be performed again.} + DoneChangingFullDebugModeBlock; + end; + end + else + begin +{$ifdef SuppressFreeMemErrorsInsideException} + if {$ifdef BDS2006AndUp}ExceptObject{$else}RaiseList{$endif} <> nil then + Result := 0 + else +{$endif} + Result := -1; + end; +end; + +function DebugReallocMem(APointer: Pointer; ANewSize: {$ifdef XE2AndUp}NativeInt{$else}Integer{$endif}): Pointer; +var + LMoveSize, LBlockSpace: NativeUInt; + LActualBlock, LNewActualBlock: PFullDebugBlockHeader; +begin + {Scan the entire memory pool first?} + if FullDebugModeScanMemoryPoolBeforeEveryOperation then + ScanMemoryPoolForCorruptions; + {Get a pointer to the start of the actual block} + LActualBlock := PFullDebugBlockHeader(PByte(APointer) + - SizeOf(TFullDebugBlockHeader)); + {Is the debug info surrounding the block valid?} + if CheckBlockBeforeFreeOrRealloc(LActualBlock, boReallocMem) then + begin + {Get the current block size} + LBlockSpace := GetAvailableSpaceInBlock(LActualBlock); + {Can the block fit? We need space for the debug overhead and the block header + of the next block} + if LBlockSpace < (NativeUInt(ANewSize) + FullDebugBlockOverhead) then + begin + {Get a new block of the requested size.} + Result := DebugGetMem(ANewSize); + if Result <> nil then + begin + {Block scans may not be performed now} + StartChangingFullDebugModeBlock; + try + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugReallocMemStart) then + OnDebugReallocMemStart(LActualBlock, ANewSize); + {$endif} + {We reuse the old allocation number. Since DebugGetMem always bumps + CurrentAllocationGroup, there may be gaps in the sequence of + allocation numbers.} + LNewActualBlock := PFullDebugBlockHeader(PByte(Result) + - SizeOf(TFullDebugBlockHeader)); + LNewActualBlock.AllocationGroup := LActualBlock.AllocationGroup; + LNewActualBlock.AllocationNumber := LActualBlock.AllocationNumber; + {Recalculate the header and footer checksums} + UpdateHeaderAndFooterCheckSums(LNewActualBlock); + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugReallocMemFinish) then + OnDebugReallocMemFinish(LNewActualBlock, ANewSize); + {$endif} + finally + {Block scans can again be performed safely} + DoneChangingFullDebugModeBlock; + end; + {How many bytes to move?} + LMoveSize := LActualBlock.UserSize; + if LMoveSize > NativeUInt(ANewSize) then + LMoveSize := ANewSize; + {Move the data across} + System.Move(APointer^, Result^, LMoveSize); + {Free the old block} + DebugFreeMem(APointer); + end + else + begin + Result := nil; + end; + end + else + begin + {Block scans may not be performed now} + StartChangingFullDebugModeBlock; + try + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugReallocMemStart) then + OnDebugReallocMemStart(LActualBlock, ANewSize); + {$endif} + {Clear all data after the new end of the block up to the old end of the + block, including the trailer.} + DebugFillMem(Pointer(PByte(APointer) + NativeUInt(ANewSize) + SizeOf(NativeUInt))^, + NativeInt(LActualBlock.UserSize) - ANewSize, +{$ifndef CatchUseOfFreedInterfaces} + DebugFillPattern); +{$else} + RotateRight(NativeUInt(@VMTBadInterface), (ANewSize and (SizeOf(Pointer) - 1)) * 8)); +{$endif} + {Update the user size} + LActualBlock.UserSize := ANewSize; + {Set the new checksums} + UpdateHeaderAndFooterCheckSums(LActualBlock); + {$ifdef FullDebugModeCallBacks} + if Assigned(OnDebugReallocMemFinish) then + OnDebugReallocMemFinish(LActualBlock, ANewSize); + {$endif} + finally + {Block scans can again be performed safely} + DoneChangingFullDebugModeBlock; + end; + {Return the old pointer} + Result := APointer; + end; + end + else + begin + Result := nil; + end; +end; + +{Allocates a block and fills it with zeroes} +function DebugAllocMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}Cardinal{$endif}): Pointer; +begin + Result := DebugGetMem(ASize); + {Clear the block} + if Result <> nil then + FillChar(Result^, ASize, 0); +end; + +{Raises a runtime error if a memory corruption was encountered. Subroutine for + InternalScanMemoryPool and InternalScanSmallBlockPool.} +procedure RaiseMemoryCorruptionError; +begin + {Disable exhaustive checking in order to prevent recursive exceptions.} + FullDebugModeScanMemoryPoolBeforeEveryOperation := False; + {Unblock the memory manager in case the creation of the exception below + causes an attempt to be made to allocate memory.} + UnblockFullDebugModeMMRoutines; + {Raise the runtime error} +{$ifdef BCB6OrDelphi7AndUp} + System.Error(reOutOfMemory); +{$else} + System.RunError(reOutOfMemory); +{$endif} +end; + +{Subroutine for InternalScanMemoryPool: Checks the given small block pool for + allocated blocks} +procedure InternalScanSmallBlockPool(APSmallBlockPool: PSmallBlockPoolHeader; + AFirstAllocationGroupToLog, ALastAllocationGroupToLog: Cardinal); +var + LCurPtr, LEndPtr: Pointer; +begin + {Get the first and last pointer for the pool} + GetFirstAndLastSmallBlockInPool(APSmallBlockPool, LCurPtr, LEndPtr); + {Step through all blocks} + while UIntPtr(LCurPtr) <= UIntPtr(LEndPtr) do + begin + {Is this block in use? If so, is the debug info intact?} + if ((PNativeUInt(PByte(LCurPtr) - BlockHeaderSize)^ and IsFreeBlockFlag) = 0) then + begin + if CheckBlockBeforeFreeOrRealloc(LCurPtr, boBlockCheck) then + begin + if (PFullDebugBlockHeader(LCurPtr).AllocationGroup >= AFirstAllocationGroupToLog) + and (PFullDebugBlockHeader(LCurPtr).AllocationGroup <= ALastAllocationGroupToLog) then + begin + LogMemoryLeakOrAllocatedBlock(LCurPtr, False); + end; + end + else + RaiseMemoryCorruptionError; + end + else + begin + {Check that the block has not been modified since being freed} + if not CheckFreeBlockUnmodified(LCurPtr, APSmallBlockPool.BlockType.BlockSize, boBlockCheck) then + RaiseMemoryCorruptionError; + end; + {Next block} + Inc(PByte(LCurPtr), APSmallBlockPool.BlockType.BlockSize); + end; +end; + +{Subroutine for LogAllocatedBlocksToFile and ScanMemoryPoolForCorruptions: + Scans the memory pool for corruptions and optionally logs allocated blocks + in the allocation group range.} +procedure InternalScanMemoryPool(AFirstAllocationGroupToLog, ALastAllocationGroupToLog: Cardinal); +var + LPLargeBlock: PLargeBlockHeader; + LPMediumBlock: Pointer; + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LMediumBlockHeader: NativeUInt; +begin + {Block all the memory manager routines while performing the scan. No memory + block may be allocated or freed, and no FullDebugMode block header or + footer may be modified, while the scan is in progress.} + BlockFullDebugModeMMRoutines; + try + {Step through all the medium block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + LPMediumBlock := GetFirstMediumBlockInPool(LPMediumBlockPoolHeader); + while LPMediumBlock <> nil do + begin + LMediumBlockHeader := PNativeUInt(PByte(LPMediumBlock) - BlockHeaderSize)^; + {Is the block in use?} + if LMediumBlockHeader and IsFreeBlockFlag = 0 then + begin + {Block is in use: Is it a medium block or small block pool?} + if (LMediumBlockHeader and IsSmallBlockPoolInUseFlag) <> 0 then + begin + {Get all the leaks for the small block pool} + InternalScanSmallBlockPool(LPMediumBlock, AFirstAllocationGroupToLog, ALastAllocationGroupToLog); + end + else + begin + if CheckBlockBeforeFreeOrRealloc(LPMediumBlock, boBlockCheck) then + begin + if (PFullDebugBlockHeader(LPMediumBlock).AllocationGroup >= AFirstAllocationGroupToLog) + and (PFullDebugBlockHeader(LPMediumBlock).AllocationGroup <= ALastAllocationGroupToLog) then + begin + LogMemoryLeakOrAllocatedBlock(LPMediumBlock, False); + end; + end + else + RaiseMemoryCorruptionError; + end; + end + else + begin + {Check that the block has not been modified since being freed} + if not CheckFreeBlockUnmodified(LPMediumBlock, LMediumBlockHeader and DropMediumAndLargeFlagsMask, boBlockCheck) then + RaiseMemoryCorruptionError; + end; + {Next medium block} + LPMediumBlock := NextMediumBlock(LPMediumBlock); + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; + {Scan large blocks} + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + if CheckBlockBeforeFreeOrRealloc(Pointer(PByte(LPLargeBlock) + LargeBlockHeaderSize), boBlockCheck) then + begin + if (PFullDebugBlockHeader(PByte(LPLargeBlock) + LargeBlockHeaderSize).AllocationGroup >= AFirstAllocationGroupToLog) + and (PFullDebugBlockHeader(PByte(LPLargeBlock) + LargeBlockHeaderSize).AllocationGroup <= ALastAllocationGroupToLog) then + begin + LogMemoryLeakOrAllocatedBlock(Pointer(PByte(LPLargeBlock) + LargeBlockHeaderSize), False); + end; + end + else + RaiseMemoryCorruptionError; + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + finally + {Unblock the FullDebugMode memory manager routines.} + UnblockFullDebugModeMMRoutines; + end; +end; + +{Logs detail about currently allocated memory blocks for the specified range of + allocation groups. if ALastAllocationGroupToLog is less than + AFirstAllocationGroupToLog or it is zero, then all allocation groups are + logged. This routine also checks the memory pool for consistency at the same + time, raising an "Out of Memory" error if the check fails.} +procedure LogAllocatedBlocksToFile(AFirstAllocationGroupToLog, ALastAllocationGroupToLog: Cardinal); +begin + {Validate input} + if (ALastAllocationGroupToLog = 0) or (ALastAllocationGroupToLog < AFirstAllocationGroupToLog) then + begin + {Bad input: log all groups} + AFirstAllocationGroupToLog := 0; + ALastAllocationGroupToLog := $ffffffff; + end; + {Scan the memory pool, logging allocated blocks in the requested range.} + InternalScanMemoryPool(AFirstAllocationGroupToLog, ALastAllocationGroupToLog); +end; + +{Scans the memory pool for any corruptions. If a corruption is encountered an "Out of Memory" exception is + raised.} +procedure ScanMemoryPoolForCorruptions; +begin + {Scan the memory pool for corruptions, but don't log any allocated blocks} + InternalScanMemoryPool($ffffffff, 0); +end; + +{-----------------------Invalid Virtual Method Calls-------------------------} + +{ TFreedObject } + +{Used to determine the index of the virtual method call on the freed object. + Do not change this without updating MaxFakeVMTEntries. Currently 200.} +procedure TFreedObject.GetVirtualMethodIndex; +asm + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); Inc(VMIndex); + + jmp TFreedObject.VirtualMethodError +end; + +procedure TFreedObject.VirtualMethodError; +var + LVMOffset: Integer; + LMsgPtr: PAnsiChar; + LErrorMessage: array[0..32767] of AnsiChar; +{$ifndef NoMessageBoxes} + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} + LClass: TClass; + LActualBlock: PFullDebugBlockHeader; +begin + {Get the offset of the virtual method} + LVMOffset := (MaxFakeVMTEntries - VMIndex) * SizeOf(Pointer) + vmtParent + SizeOf(Pointer); + {Reset the index for the next error} + VMIndex := 0; + {Get the address of the actual block} + LActualBlock := PFullDebugBlockHeader(PByte(Self) - SizeOf(TFullDebugBlockHeader)); + {Display the error header} + LMsgPtr := AppendStringToBuffer(VirtualMethodErrorHeader, @LErrorMessage[0], Length(VirtualMethodErrorHeader)); + {Is the debug info surrounding the block valid?} + if CalculateHeaderCheckSum(LActualBlock) = LActualBlock.HeaderCheckSum then + begin + {Get the class this block was used for previously} + LClass := DetectClassInstance(@LActualBlock.PreviouslyUsedByClass); + if (LClass <> nil) and (IntPtr(LClass) <> IntPtr(@FreedObjectVMT.VMTMethods[0])) then + begin + LMsgPtr := AppendStringToBuffer(FreedObjectClassMsg, LMsgPtr, Length(FreedObjectClassMsg)); + LMsgPtr := AppendClassNameToBuffer(LClass, LMsgPtr); + end; + {Get the virtual method name} + LMsgPtr := AppendStringToBuffer(VirtualMethodName, LMsgPtr, Length(VirtualMethodName)); + if LVMOffset < 0 then + begin + LMsgPtr := AppendStringToBuffer(StandardVirtualMethodNames[LVMOffset div SizeOf(Pointer)], LMsgPtr, Length(StandardVirtualMethodNames[LVMOffset div SizeOf(Pointer)])); + end + else + begin + LMsgPtr := AppendStringToBuffer(VirtualMethodOffset, LMsgPtr, Length(VirtualMethodOffset)); + LMsgPtr := NativeUIntToStrBuf(LVMOffset, LMsgPtr); + end; + {Virtual method address} + if (LClass <> nil) and (IntPtr(LClass) <> IntPtr(@FreedObjectVMT.VMTMethods[0])) then + begin + LMsgPtr := AppendStringToBuffer(VirtualMethodAddress, LMsgPtr, Length(VirtualMethodAddress)); + LMsgPtr := NativeUIntToHexBuf(PNativeUInt(PByte(LClass) + LVMOffset)^, LMsgPtr); + end; + {Log the allocation group} + if LActualBlock.AllocationGroup > 0 then + begin + LMsgPtr := AppendStringToBuffer(PreviousAllocationGroupMsg, LMsgPtr, Length(PreviousAllocationGroupMsg)); + LMsgPtr := NativeUIntToStrBuf(LActualBlock.AllocationGroup, LMsgPtr); + end; + {Log the allocation number} + LMsgPtr := AppendStringToBuffer(PreviousAllocationNumberMsg, LMsgPtr, Length(PreviousAllocationNumberMsg)); + LMsgPtr := NativeUIntToStrBuf(LActualBlock.AllocationNumber, LMsgPtr); + {The header is still intact - display info about the this/previous allocation} + if LActualBlock.AllocationStackTrace[0] <> 0 then + begin + LMsgPtr := AppendStringToBuffer(ThreadIDAtObjectAllocMsg, LMsgPtr, Length(ThreadIDAtObjectAllocMsg)); + LMsgPtr := NativeUIntToHexBuf(LActualBlock.AllocatedByThread, LMsgPtr); + LMsgPtr := AppendStringToBuffer(StackTraceMsg, LMsgPtr, Length(StackTraceMsg)); + LMsgPtr := LogStackTrace(@LActualBlock.AllocationStackTrace, StackTraceDepth, LMsgPtr); + end; + {Get the call stack for the previous free} + if LActualBlock.FreeStackTrace[0] <> 0 then + begin + LMsgPtr := AppendStringToBuffer(ThreadIDAtObjectFreeMsg, LMsgPtr, Length(ThreadIDAtObjectFreeMsg)); + LMsgPtr := NativeUIntToHexBuf(LActualBlock.FreedByThread, LMsgPtr); + LMsgPtr := AppendStringToBuffer(StackTraceMsg, LMsgPtr, Length(StackTraceMsg)); + LMsgPtr := LogStackTrace(@LActualBlock.FreeStackTrace, StackTraceDepth, LMsgPtr); + end; + end + else + begin + {Header has been corrupted} + LMsgPtr := AppendStringToBuffer(BlockHeaderCorruptedNoHistoryMsg, LMsgPtr, Length(BlockHeaderCorruptedNoHistoryMsg)); + end; + {Add the current stack trace} + LMsgPtr := LogCurrentThreadAndStackTrace(2, LMsgPtr); +{$ifndef DisableLoggingOfMemoryDumps} + {Add the pointer address} + LMsgPtr := LogMemoryDump(LActualBlock, LMsgPtr); +{$endif} + {Trailing CRLF} + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + {Trailing #0} + LMsgPtr^ := #0; +{$ifdef LogErrorsToFile} + {Log the error} + AppendEventLog(@LErrorMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LErrorMessage[0])); +{$endif} +{$ifdef UseOutputDebugString} + OutputDebugStringA(LErrorMessage); +{$endif} +{$ifndef NoMessageBoxes} + {Show the message} + AppendStringToModuleName(BlockErrorMsgTitle, LErrorMessageTitle); + ShowMessageBox(LErrorMessage, LErrorMessageTitle); +{$endif} + {Raise an access violation} + RaiseException(EXCEPTION_ACCESS_VIOLATION, 0, 0, nil); +end; + +{$ifdef CatchUseOfFreedInterfaces} +procedure TFreedObject.InterfaceError; +var + LMsgPtr: PAnsiChar; +{$ifndef NoMessageBoxes} + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} + LErrorMessage: array[0..4000] of AnsiChar; +begin + {Display the error header} + LMsgPtr := AppendStringToBuffer(InterfaceErrorHeader, @LErrorMessage[0], Length(InterfaceErrorHeader)); + {Add the current stack trace} + LMsgPtr := LogCurrentThreadAndStackTrace(2, LMsgPtr); + {Trailing CRLF} + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + {Trailing #0} + LMsgPtr^ := #0; +{$ifdef LogErrorsToFile} + {Log the error} + AppendEventLog(@LErrorMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LErrorMessage[0])); +{$endif} +{$ifdef UseOutputDebugString} + OutputDebugStringA(LErrorMessage); +{$endif} +{$ifndef NoMessageBoxes} + {Show the message} + AppendStringToModuleName(BlockErrorMsgTitle, LErrorMessageTitle); + ShowMessageBox(LErrorMessage, LErrorMessageTitle); +{$endif} + {Raise an access violation} + RaiseException(EXCEPTION_ACCESS_VIOLATION, 0, 0, nil); +end; +{$endif} + +{$endif} + +{----------------------------Memory Leak Checking-----------------------------} + +{$ifdef EnableMemoryLeakReporting} + +{Adds a leak to the specified list} +function UpdateExpectedLeakList(APLeakList: PPExpectedMemoryLeak; + APNewEntry: PExpectedMemoryLeak; AExactSizeMatch: Boolean = True): Boolean; +var + LPInsertAfter, LPNewEntry: PExpectedMemoryLeak; +begin + {Default to error} + Result := False; + {Find the insertion spot} + LPInsertAfter := APLeakList^; + while LPInsertAfter <> nil do + begin + {Too big?} + if LPInsertAfter.LeakSize > APNewEntry.LeakSize then + begin + LPInsertAfter := LPInsertAfter.PreviousLeak; + Break; + end; + {Find a matching entry. If an exact size match is not required and the leak + is larger than the current entry, use it if the expected size of the next + entry is too large.} + if (IntPtr(LPInsertAfter.LeakAddress) = IntPtr(APNewEntry.LeakAddress)) + and ((IntPtr(LPInsertAfter.LeakedClass) = IntPtr(APNewEntry.LeakedClass)) + {$ifdef CheckCppObjectTypeEnabled} + or (LPInsertAfter.LeakedCppTypeIdPtr = APNewEntry.LeakedCppTypeIdPtr) + {$endif} + ) + and ((LPInsertAfter.LeakSize = APNewEntry.LeakSize) + or ((not AExactSizeMatch) + and (LPInsertAfter.LeakSize < APNewEntry.LeakSize) + and ((LPInsertAfter.NextLeak = nil) + or (LPInsertAfter.NextLeak.LeakSize > APNewEntry.LeakSize)) + )) then + begin + if (LPInsertAfter.LeakCount + APNewEntry.LeakCount) >= 0 then + begin + Inc(LPInsertAfter.LeakCount, APNewEntry.LeakCount); + {Is the count now 0?} + if LPInsertAfter.LeakCount = 0 then + begin + {Delete the entry} + if LPInsertAfter.NextLeak <> nil then + LPInsertAfter.NextLeak.PreviousLeak := LPInsertAfter.PreviousLeak; + if LPInsertAfter.PreviousLeak <> nil then + LPInsertAfter.PreviousLeak.NextLeak := LPInsertAfter.NextLeak + else + APLeakList^ := LPInsertAfter.NextLeak; + {Insert it as the first free slot} + LPInsertAfter.NextLeak := ExpectedMemoryLeaks.FirstFreeSlot; + ExpectedMemoryLeaks.FirstFreeSlot := LPInsertAfter; + end; + Result := True; + end; + Exit; + end; + {Next entry} + if LPInsertAfter.NextLeak <> nil then + LPInsertAfter := LPInsertAfter.NextLeak + else + Break; + end; + if APNewEntry.LeakCount > 0 then + begin + {Get a position for the entry} + LPNewEntry := ExpectedMemoryLeaks.FirstFreeSlot; + if LPNewEntry <> nil then + begin + ExpectedMemoryLeaks.FirstFreeSlot := LPNewEntry.NextLeak; + end + else + begin + if ExpectedMemoryLeaks.EntriesUsed < Length(ExpectedMemoryLeaks.ExpectedLeaks) then + begin + LPNewEntry := @ExpectedMemoryLeaks.ExpectedLeaks[ExpectedMemoryLeaks.EntriesUsed]; + Inc(ExpectedMemoryLeaks.EntriesUsed); + end + else + begin + {No more space} + Exit; + end; + end; + {Set the entry} + LPNewEntry^ := APNewEntry^; + {Insert it into the list} + LPNewEntry.PreviousLeak := LPInsertAfter; + if LPInsertAfter <> nil then + begin + LPNewEntry.NextLeak := LPInsertAfter.NextLeak; + if LPNewEntry.NextLeak <> nil then + LPNewEntry.NextLeak.PreviousLeak := LPNewEntry; + LPInsertAfter.NextLeak := LPNewEntry; + end + else + begin + LPNewEntry.NextLeak := APLeakList^; + if LPNewEntry.NextLeak <> nil then + LPNewEntry.NextLeak.PreviousLeak := LPNewEntry; + APLeakList^ := LPNewEntry; + end; + Result := True; + end; +end; + +{Locks the expected leaks. Returns false if the list could not be allocated.} +function LockExpectedMemoryLeaksList: Boolean; +begin + {Lock the expected leaks list} +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while LockCmpxchg(0, 1, @ExpectedMemoryLeaksListLocked) <> 0 do + begin +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(InitialSleepTime); + if LockCmpxchg(0, 1, @ExpectedMemoryLeaksListLocked) = 0 then + Break; + Sleep(AdditionalSleepTime); +{$endif} + end; + end; + {Allocate the list if it does not exist} + if ExpectedMemoryLeaks = nil then + ExpectedMemoryLeaks := VirtualAlloc(nil, ExpectedMemoryLeaksListSize, MEM_COMMIT, PAGE_READWRITE); + {Done} + Result := ExpectedMemoryLeaks <> nil; +end; + +{Registers expected memory leaks. Returns true on success. The list of leaked + blocks is limited, so failure is possible if the list is full.} +function RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} +{$ifndef FullDebugMode} + LNewEntry.LeakAddress := ALeakedPointer; +{$else} + LNewEntry.LeakAddress := Pointer(PByte(ALeakedPointer) - SizeOf(TFullDebugBlockHeader)); +{$endif} + LNewEntry.LeakedClass := nil; + {$ifdef CheckCppObjectTypeEnabled} + LNewEntry.LeakedCppTypeIdPtr := nil; + {$endif} + LNewEntry.LeakSize := 0; + LNewEntry.LeakCount := 1; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LNewEntry); + ExpectedMemoryLeaksListLocked := False; +end; + +function RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := nil; + LNewEntry.LeakedClass := ALeakedObjectClass; + {$ifdef CheckCppObjectTypeEnabled} + LNewEntry.LeakedCppTypeIdPtr := nil; + {$endif} + LNewEntry.LeakSize := ALeakedObjectClass.InstanceSize; + LNewEntry.LeakCount := ACount; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByClass, @LNewEntry); + ExpectedMemoryLeaksListLocked := False; +end; + +{$ifdef CheckCppObjectTypeEnabled} +function RegisterExpectedMemoryLeak(ALeakedCppVirtObjTypeIdPtr: Pointer; ACount: Integer): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + if Assigned(GetCppVirtObjSizeByTypeIdPtrFunc) then + begin + //Return 0 if not a proper type + LNewEntry.LeakSize := GetCppVirtObjSizeByTypeIdPtrFunc(ALeakedCppVirtObjTypeIdPtr); + if LNewEntry.LeakSize > 0 then + begin + LNewEntry.LeakAddress := nil; + LNewEntry.LeakedClass := nil; + LNewEntry.LeakedCppTypeIdPtr := ALeakedCppVirtObjTypeIdPtr; + LNewEntry.LeakCount := ACount; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByClass, @LNewEntry); + ExpectedMemoryLeaksListLocked := False; + end + else + begin + Result := False; + end; + end + else + begin + Result := False; + end; +end; +{$endif} + +function RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := nil; + LNewEntry.LeakedClass := nil; + {$ifdef CheckCppObjectTypeEnabled} + LNewEntry.LeakedCppTypeIdPtr := nil; + {$endif} + LNewEntry.LeakSize := ALeakedBlockSize; + LNewEntry.LeakCount := ACount; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryBySizeOnly, @LNewEntry); + ExpectedMemoryLeaksListLocked := False; +end; + +function UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} +{$ifndef FullDebugMode} + LNewEntry.LeakAddress := ALeakedPointer; +{$else} + LNewEntry.LeakAddress := Pointer(PByte(ALeakedPointer) - SizeOf(TFullDebugBlockHeader)); +{$endif} + LNewEntry.LeakedClass := nil; + {$ifdef CheckCppObjectTypeEnabled} + LNewEntry.LeakedCppTypeIdPtr := nil; + {$endif} + LNewEntry.LeakSize := 0; + LNewEntry.LeakCount := -1; + {Remove it from the list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LNewEntry); + ExpectedMemoryLeaksListLocked := False; +end; + +function UnregisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +begin + Result := RegisterExpectedMemoryLeak(ALeakedObjectClass, - ACount); +end; + +{$ifdef CheckCppObjectTypeEnabled} +function UnregisterExpectedMemoryLeak(ALeakedCppVirtObjTypeIdPtr: Pointer; ACount: Integer): Boolean; overload; +begin + Result := RegisterExpectedMemoryLeak(ALeakedCppVirtObjTypeIdPtr, - ACount); +end; +{$endif} + +function UnregisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +begin + Result := RegisterExpectedMemoryLeak(ALeakedBlockSize, - ACount); +end; + +{Returns a list of all expected memory leaks} +function GetRegisteredMemoryLeaks: TRegisteredMemoryLeaks; + + procedure AddEntries(AEntry: PExpectedMemoryLeak); + var + LInd: Integer; + begin + while AEntry <> nil do + begin + LInd := Length(Result); + SetLength(Result, LInd + 1); + {Add the entry} +{$ifndef FullDebugMode} + Result[LInd].LeakAddress := AEntry.LeakAddress; +{$else} + Result[LInd].LeakAddress := Pointer(PByte(AEntry.LeakAddress) + SizeOf(TFullDebugBlockHeader)); +{$endif} + Result[LInd].LeakedClass := AEntry.LeakedClass; +{$ifdef CheckCppObjectTypeEnabled} + Result[LInd].LeakedCppTypeIdPtr := AEntry.LeakedCppTypeIdPtr; +{$endif} + Result[LInd].LeakSize := AEntry.LeakSize; + Result[LInd].LeakCount := AEntry.LeakCount; + {Next entry} + AEntry := AEntry.NextLeak; + end; + end; + +begin + SetLength(Result, 0); + if (ExpectedMemoryLeaks <> nil) and LockExpectedMemoryLeaksList then + begin + {Add all entries} + AddEntries(ExpectedMemoryLeaks.FirstEntryByAddress); + AddEntries(ExpectedMemoryLeaks.FirstEntryByClass); + AddEntries(ExpectedMemoryLeaks.FirstEntryBySizeOnly); + {Unlock the list} + ExpectedMemoryLeaksListLocked := False; + end; +end; + +{$else} + {$ifdef BDS2006AndUp} +function NoOpRegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; +begin + {Do nothing. Used when memory leak reporting is disabled under Delphi 2006 and later.} + Result := False; +end; + +function NoOpUnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; +begin + {Do nothing. Used when memory leak reporting is disabled under Delphi 2006 and later.} + Result := False; +end; + {$endif} +{$endif} + +{Detects the probable string data type for a memory block.} +function DetectStringData(APMemoryBlock: Pointer; + AAvailableSpaceInBlock: NativeInt): TStringDataType; +const + {If the string reference count field contains a value greater than this, + then it is assumed that the block is not a string.} + MaxRefCount = 255; + {The lowest ASCII character code considered valid string data. If there are + any characters below this code point then the data is assumed not to be a + string. #9 = Tab.} + MinCharCode = #9; +var + LStringLength, LElemSize, LCharInd: Integer; + LPAnsiStr: PAnsiChar; + LPUniStr: PWideChar; +begin + {Check that the reference count is within a reasonable range} + if PStrRec(APMemoryBlock).refCnt > MaxRefCount then + begin + Result := stUnknown; + Exit; + end; +{$ifdef BCB6OrDelphi6AndUp} + {$if RTLVersion >= 20} + LElemSize := PStrRec(APMemoryBlock).elemSize; + {Element size must be either 1 (Ansi) or 2 (Unicode)} + if (LElemSize <> 1) and (LElemSize <> 2) then + begin + Result := stUnknown; + Exit; + end; + {$ifend} + {$if RTLVersion < 20} + LElemSize := 1; + {$ifend} +{$else} + LElemSize := 1; +{$endif} + {Get the string length} + LStringLength := PStrRec(APMemoryBlock).length; + {Does the string fit?} + if (LStringLength <= 0) + or (LStringLength >= (AAvailableSpaceInBlock - SizeOf(StrRec)) div LElemSize) then + begin + Result := stUnknown; + Exit; + end; + {Check for no characters outside the expected range. If there are, + then it is probably not a string.} + if LElemSize = 1 then + begin + {Check that all characters are in the range considered valid.} + LPAnsiStr := PAnsiChar(PByte(APMemoryBlock) + SizeOf(StrRec)); + for LCharInd := 1 to LStringLength do + begin + if LPAnsiStr^ < MinCharCode then + begin + Result := stUnknown; + Exit; + end; + Inc(LPAnsiStr); + end; + {Must have a trailing #0} + if LPAnsiStr^ = #0 then + Result := stAnsiString + else + Result := stUnknown; + end + else + begin + {Check that all characters are in the range considered valid.} + LPUniStr := PWideChar(PByte(APMemoryBlock) + SizeOf(StrRec)); + for LCharInd := 1 to LStringLength do + begin + if LPUniStr^ < MinCharCode then + begin + Result := stUnknown; + Exit; + end; + Inc(LPUniStr); + end; + {Must have a trailing #0} + if LPUniStr^ = #0 then + Result := stUnicodeString + else + Result := stUnknown; + end; +end; + +{Walks all allocated blocks, calling ACallBack for each. Passes the user block size and AUserData to the callback. + Important note: All block types will be locked during the callback, so the memory manager cannot be used inside it.} +procedure WalkAllocatedBlocks(ACallBack: TWalkAllocatedBlocksCallback; AUserData: Pointer); +const + DebugHeaderSize = {$ifdef FullDebugMode}SizeOf(TFullDebugBlockHeader){$else}0{$endif}; + TotalDebugOverhead = {$ifdef FullDebugMode}FullDebugBlockOverhead{$else}0{$endif}; +var + LPMediumBlock: Pointer; + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LMediumBlockHeader: NativeUInt; + LPLargeBlock: PLargeBlockHeader; + LBlockSize: NativeInt; + LPSmallBlockPool: PSmallBlockPoolHeader; + LCurPtr, LEndPtr: Pointer; + LInd: Integer; +{$ifdef LogLockContention} + LDidSleep: Boolean; +{$endif} +begin + {Lock all small block types} + LockAllSmallBlockTypes; + {Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + try + {Step through all the medium block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + LPMediumBlock := GetFirstMediumBlockInPool(LPMediumBlockPoolHeader); + while LPMediumBlock <> nil do + begin + LMediumBlockHeader := PNativeUInt(PByte(LPMediumBlock) - BlockHeaderSize)^; + {Is the block in use?} + if LMediumBlockHeader and IsFreeBlockFlag = 0 then + begin + if (LMediumBlockHeader and IsSmallBlockPoolInUseFlag) <> 0 then + begin + {Step through all the blocks in the small block pool} + LPSmallBlockPool := LPMediumBlock; + {Get the useable size inside a block} + LBlockSize := LPSmallBlockPool.BlockType.BlockSize - BlockHeaderSize - TotalDebugOverhead; + {Get the first and last pointer for the pool} + GetFirstAndLastSmallBlockInPool(LPSmallBlockPool, LCurPtr, LEndPtr); + {Step through all blocks} + while UIntPtr(LCurPtr) <= UIntPtr(LEndPtr) do + begin + {Is this block in use?} + if (PNativeUInt(PByte(LCurPtr) - BlockHeaderSize)^ and IsFreeBlockFlag) = 0 then + begin + ACallBack(PByte(LCurPtr) + DebugHeaderSize, LBlockSize, AUserData); + end; + {Next block} + Inc(PByte(LCurPtr), LPSmallBlockPool.BlockType.BlockSize); + end; + end + else + begin + LBlockSize := (LMediumBlockHeader and DropMediumAndLargeFlagsMask) - BlockHeaderSize - TotalDebugOverhead; + ACallBack(PByte(LPMediumBlock) + DebugHeaderSize, LBlockSize, AUserData); + end; + end; + {Next medium block} + LPMediumBlock := NextMediumBlock(LPMediumBlock); + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; + finally + {Unlock medium blocks} + MediumBlocksLocked := False; + {Unlock all the small block types} + for LInd := 0 to NumSmallBlockTypes - 1 do + SmallBlockTypes[LInd].BlockTypeLocked := False; + end; + {Step through all the large blocks} + LockLargeBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + try + {Get all leaked large blocks} + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + LBlockSize := (LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask) - BlockHeaderSize - LargeBlockHeaderSize - TotalDebugOverhead; + ACallBack(PByte(LPLargeBlock) + LargeBlockHeaderSize + DebugHeaderSize, LBlockSize, AUserData); + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + finally + LargeBlocksLocked := False; + end; +end; + +{-----------LogMemoryManagerStateToFile implementation------------} +const + MaxMemoryLogNodes = 100000; + QuickSortMinimumItemsInPartition = 4; + +type + {While scanning the memory pool the list of classes is built up in a binary search tree.} + PMemoryLogNode = ^TMemoryLogNode; + TMemoryLogNode = record + {The left and right child nodes} + LeftAndRightNodePointers: array[Boolean] of PMemoryLogNode; + {The class this node belongs to} + ClassPtr: Pointer; + {The number of instances of the class} + InstanceCount: NativeInt; + {The total memory usage for this class} + TotalMemoryUsage: NativeInt; + end; + TMemoryLogNodes = array[0..MaxMemoryLogNodes - 1] of TMemoryLogNode; + PMemoryLogNodes = ^TMemoryLogNodes; + + TMemoryLogInfo = record + {The number of nodes in "Nodes" that are used.} + NodeCount: Integer; + {The root node of the binary search tree. The content of this node is not actually used, it just simplifies the + binary search code.} + RootNode: TMemoryLogNode; + Nodes: TMemoryLogNodes; + end; + PMemoryLogInfo = ^TMemoryLogInfo; + +{LogMemoryManagerStateToFile callback subroutine} +procedure LogMemoryManagerStateCallBack(APBlock: Pointer; ABlockSize: NativeInt; AUserData: Pointer); +var + LClass, LClassHashBits: NativeUInt; + LPLogInfo: PMemoryLogInfo; + LPParentNode, LPClassNode: PMemoryLogNode; + LChildNodeDirection: Boolean; +begin + LPLogInfo := AUserData; + {Detecting an object is very expensive (due to the VirtualQuery call), so we do some basic checks and try to find + the "class" in the tree first.} + LClass := PNativeUInt(APBlock)^; + {Do some basic pointer checks: The "class" must be dword aligned and beyond 64K} + if (LClass > 65535) + and (LClass and 3 = 0) then + begin + LPParentNode := @LPLogInfo.RootNode; + LClassHashBits := LClass; + repeat + LChildNodeDirection := Boolean(LClassHashBits and 1); + {Split off the next bit of the class pointer and traverse in the appropriate direction.} + LPClassNode := LPParentNode.LeftAndRightNodePointers[LChildNodeDirection]; + {Is this child node the node the class we're looking for?} + if (LPClassNode = nil) or (NativeUInt(LPClassNode.ClassPtr) = LClass) then + Break; + {The node was not found: Keep on traversing the tree.} + LClassHashBits := LClassHashBits shr 1; + LPParentNode := LPClassNode; + until False; + end + else + LPClassNode := nil; + {Was the "class" found?} + if LPClassNode = nil then + begin + {The "class" is not yet in the tree: Determine if it is actually a class.} + LClass := NativeUInt(DetectClassInstance(APBlock)); + {If it is not a class, try to detect the string type.} + if LClass = 0 then + LClass := Ord(DetectStringData(APBlock, ABlockSize)); + {Is this class already in the tree?} + LPParentNode := @LPLogInfo.RootNode; + LClassHashBits := LClass; + repeat + LChildNodeDirection := Boolean(LClassHashBits and 1); + {Split off the next bit of the class pointer and traverse in the appropriate direction.} + LPClassNode := LPParentNode.LeftAndRightNodePointers[LChildNodeDirection]; + {Is this child node the node the class we're looking for?} + if LPClassNode = nil then + begin + {The end of the tree was reached: Add a new child node.} + LPClassNode := @LPLogInfo.Nodes[LPLogInfo.NodeCount]; + Inc(LPLogInfo.NodeCount); + LPParentNode.LeftAndRightNodePointers[LChildNodeDirection] := LPClassNode; + LPClassNode.ClassPtr := Pointer(LClass); + Break; + end + else + begin + if NativeUInt(LPClassNode.ClassPtr) = LClass then + Break; + end; + {The node was not found: Keep on traversing the tree.} + LClassHashBits := LClassHashBits shr 1; + LPParentNode := LPClassNode; + until False; + end; + {Update the statistics for the class} + Inc(LPClassNode.InstanceCount); + Inc(LPClassNode.TotalMemoryUsage, ABlockSize); +end; + +{LogMemoryManagerStateToFile subroutine: A median-of-3 quicksort routine for sorting a TMemoryLogNodes array.} +procedure QuickSortLogNodes(APLeftItem: PMemoryLogNodes; ARightIndex: Integer); +var + M, I, J: Integer; + LPivot, LTempItem: TMemoryLogNode; +begin + while True do + begin + {Order the left, middle and right items in ascending order} + M := ARightIndex shr 1; + {Is the middle item larger than the left item?} + if APLeftItem[0].TotalMemoryUsage > APLeftItem[M].TotalMemoryUsage then + begin + {Swap items 0 and M} + LTempItem := APLeftItem[0]; + APLeftItem[0] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + end; + {Is the middle item larger than the right?} + if APLeftItem[M].TotalMemoryUsage > APLeftItem[ARightIndex].TotalMemoryUsage then + begin + {The right-hand item is not larger - swap it with the middle} + LTempItem := APLeftItem[ARightIndex]; + APLeftItem[ARightIndex] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + {Is the left larger than the new middle?} + if APLeftItem[0].TotalMemoryUsage > APLeftItem[M].TotalMemoryUsage then + begin + {Swap items 0 and M} + LTempItem := APLeftItem[0]; + APLeftItem[0] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + end; + end; + {Move the pivot item out of the way by swapping M with R - 1} + LPivot := APLeftItem[M]; + APLeftItem[M] := APLeftItem[ARightIndex - 1]; + APLeftItem[ARightIndex - 1] := LPivot; + {Set up the loop counters} + I := 0; + J := ARightIndex - 1; + while true do + begin + {Find the first item from the left that is not smaller than the pivot} + repeat + Inc(I); + until APLeftItem[I].TotalMemoryUsage >= LPivot.TotalMemoryUsage; + {Find the first item from the right that is not larger than the pivot} + repeat + Dec(J); + until APLeftItem[J].TotalMemoryUsage <= LPivot.TotalMemoryUsage; + {Stop the loop when the two indexes cross} + if J < I then + Break; + {Swap item I and J} + LTempItem := APLeftItem[I]; + APLeftItem[I] := APLeftItem[J]; + APLeftItem[J] := LTempItem; + end; + {Put the pivot item back in the correct position by swapping I with R - 1} + APLeftItem[ARightIndex - 1] := APLeftItem[I]; + APLeftItem[I] := LPivot; + {Sort the left-hand partition} + if J >= (QuickSortMinimumItemsInPartition - 1) then + QuickSortLogNodes(APLeftItem, J); + {Sort the right-hand partition} + APLeftItem := @APLeftItem[I + 1]; + ARightIndex := ARightIndex - I - 1; + if ARightIndex < (QuickSortMinimumItemsInPartition - 1) then + Break; + end; +end; + +{LogMemoryManagerStateToFile subroutine: An InsertionSort routine for sorting a TMemoryLogNodes array.} +procedure InsertionSortLogNodes(APLeftItem: PMemoryLogNodes; ARightIndex: Integer); +var + I, J: Integer; + LCurNode: TMemoryLogNode; +begin + for I := 1 to ARightIndex do + begin + LCurNode := APLeftItem[I]; + {Scan backwards to find the best insertion spot} + J := I; + while (J > 0) and (APLeftItem[J - 1].TotalMemoryUsage > LCurNode.TotalMemoryUsage) do + begin + APLeftItem[J] := APLeftItem[J - 1]; + Dec(J); + end; + APLeftItem[J] := LCurNode; + end; +end; + +{Writes a log file containing a summary of the memory mananger state and a summary of allocated blocks grouped by + class. The file will be saved in UTF-8 encoding (in supported Delphi versions). Returns True on success. } +function LogMemoryManagerStateToFile(const AFileName: string; const AAdditionalDetails: string): Boolean; +const + MsgBufferSize = 65536; + MaxLineLength = 512; + {Write the UTF-8 BOM in Delphi versions that support UTF-8 conversion.} + LogStateHeaderMsg = {$ifdef BCB6OrDelphi7AndUp}#$EF#$BB#$BF + {$endif} + 'FastMM State Capture:'#13#10'---------------------'#13#10#13#10; + LogStateAllocatedMsg = 'K Allocated'#13#10; + LogStateOverheadMsg = 'K Overhead'#13#10; + LogStateEfficiencyMsg = '% Efficiency'#13#10#13#10'Usage Detail:'#13#10; + LogStateAdditionalInfoMsg = #13#10'Additional Information:'#13#10'-----------------------'#13#10; + AverageSizeLeadText = ' ('; + AverageSizeTrailingText = ' bytes avg.)'#13#10; +var + LPLogInfo: PMemoryLogInfo; + LInd: Integer; + LPNode: PMemoryLogNode; + LMsgBuffer: array[0..MsgBufferSize - 1] of AnsiChar; + LPMsg: PAnsiChar; + LBufferSpaceUsed, LBytesWritten: Cardinal; + LFileHandle: NativeUInt; + LMemoryManagerUsageSummary: TMemoryManagerUsageSummary; + LUTF8Str: AnsiString; +begin + {Get the current memory manager usage summary.} + GetMemoryManagerUsageSummary(LMemoryManagerUsageSummary); + {Allocate the memory required to capture detailed allocation information.} + LPLogInfo := VirtualAlloc(nil, SizeOf(TMemoryLogInfo), MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE); + if LPLogInfo <> nil then + begin + try + {Log all allocated blocks by class.} + WalkAllocatedBlocks(LogMemoryManagerStateCallBack, LPLogInfo); + {Sort the classes by total memory usage: Do the initial QuickSort pass over the list to sort the list in groups + of QuickSortMinimumItemsInPartition size.} + if LPLogInfo.NodeCount >= QuickSortMinimumItemsInPartition then + QuickSortLogNodes(@LPLogInfo.Nodes[0], LPLogInfo.NodeCount - 1); + {Do the final InsertionSort pass.} + InsertionSortLogNodes(@LPLogInfo.Nodes[0], LPLogInfo.NodeCount - 1); + {Create the output file} + {$ifdef POSIX} + lFileHandle := FileCreate(AFilename); + {$else} + LFileHandle := CreateFile(PChar(AFilename), GENERIC_READ or GENERIC_WRITE, 0, + nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + {$endif} + if LFileHandle <> INVALID_HANDLE_VALUE then + begin + try + {Log the usage summary} + LPMsg := @LMsgBuffer; + LPMsg := AppendStringToBuffer(LogStateHeaderMsg, LPMsg, Length(LogStateHeaderMsg)); + LPMsg := NativeUIntToStrBuf(LMemoryManagerUsageSummary.AllocatedBytes shr 10, LPMsg); + LPMsg := AppendStringToBuffer(LogStateAllocatedMsg, LPMsg, Length(LogStateAllocatedMsg)); + LPMsg := NativeUIntToStrBuf(LMemoryManagerUsageSummary.OverheadBytes shr 10, LPMsg); + LPMsg := AppendStringToBuffer(LogStateOverheadMsg, LPMsg, Length(LogStateOverheadMsg)); + LPMsg := NativeUIntToStrBuf(Round(LMemoryManagerUsageSummary.EfficiencyPercentage), LPMsg); + LPMsg := AppendStringToBuffer(LogStateEfficiencyMsg, LPMsg, Length(LogStateEfficiencyMsg)); + {Log the allocation detail} + for LInd := LPLogInfo.NodeCount - 1 downto 0 do + begin + LPNode := @LPLogInfo.Nodes[LInd]; + {Add the allocated size} + LPMsg^ := ' '; + Inc(LPMsg); + LPMsg := NativeUIntToStrBuf(LPNode.TotalMemoryUsage, LPMsg); + LPMsg := AppendStringToBuffer(BytesMessage, LPMsg, Length(BytesMessage)); + {Add the class type} + case NativeInt(LPNode.ClassPtr) of + {Unknown} + 0: + begin + LPMsg := AppendStringToBuffer(UnknownClassNameMsg, LPMsg, Length(UnknownClassNameMsg)); + end; + {AnsiString} + 1: + begin + LPMsg := AppendStringToBuffer(AnsiStringBlockMessage, LPMsg, Length(AnsiStringBlockMessage)); + end; + {UnicodeString} + 2: + begin + LPMsg := AppendStringToBuffer(UnicodeStringBlockMessage, LPMsg, Length(UnicodeStringBlockMessage)); + end; + {Classes} + else + begin + LPMsg := AppendClassNameToBuffer(LPNode.ClassPtr, LPMsg); + end; + end; + {Add the count} + LPMsg^ := ' '; + Inc(LPMsg); + LPMsg^ := 'x'; + Inc(LPMsg); + LPMsg^ := ' '; + Inc(LPMsg); + LPMsg := NativeUIntToStrBuf(LPNode.InstanceCount, LPMsg); + LPMsg := AppendStringToBuffer(AverageSizeLeadText, LPMsg, Length(AverageSizeLeadText)); + LPMsg := NativeUIntToStrBuf(LPNode.TotalMemoryUsage div LPNode.InstanceCount, LPMsg); + LPMsg := AppendStringToBuffer(AverageSizeTrailingText, LPMsg, Length(AverageSizeTrailingText)); + {Flush the buffer?} + LBufferSpaceUsed := NativeInt(LPMsg) - NativeInt(@LMsgBuffer); + if LBufferSpaceUsed > (MsgBufferSize - MaxLineLength) then + begin + WriteFile(LFileHandle, LMsgBuffer, LBufferSpaceUsed, LBytesWritten, nil); + LPMsg := @LMsgBuffer; + end; + end; + if AAdditionalDetails <> '' then + LPMsg := AppendStringToBuffer(LogStateAdditionalInfoMsg, LPMsg, Length(LogStateAdditionalInfoMsg)); + {Flush any remaining bytes} + LBufferSpaceUsed := NativeInt(LPMsg) - NativeInt(@LMsgBuffer); + if LBufferSpaceUsed > 0 then + WriteFile(LFileHandle, LMsgBuffer, LBufferSpaceUsed, LBytesWritten, nil); + {Write the additional info} + if AAdditionalDetails <> '' then + begin + {$ifdef BCB6OrDelphi7AndUp} + LUTF8Str := UTF8Encode(AAdditionalDetails); + {$else} + LUTF8Str := AAdditionalDetails; + {$endif} + WriteFile(LFileHandle, LUTF8Str[1], Length(LUTF8Str), LBytesWritten, nil); + end; + {Success} + Result := True; + finally + {Close the file} + {$ifdef POSIX} + {$ifndef fpc} + __close(LFileHandle) + {$else} + fpclose(LFileHandle) + {$endif} + {$else} + CloseHandle(LFileHandle); + {$endif} + end; + end + else + Result := False; + finally + VirtualFree(LPLogInfo, 0, MEM_RELEASE); + end; + end + else + Result := False; +end; + +{-----------CheckBlocksOnShutdown implementation------------} + +{Checks blocks for modification after free and also for memory leaks} +procedure CheckBlocksOnShutdown(ACheckForLeakedBlocks: Boolean); +{$ifdef EnableMemoryLeakReporting} +type + {Leaked class type} + TLeakedClass = record + ClassPointer: TClass; + {$ifdef CheckCppObjectTypeEnabled} + CppTypeIdPtr: Pointer; + {$endif} + NumLeaks: Cardinal; + end; + TLeakedClasses = array[0..255] of TLeakedClass; + PLeakedClasses = ^TLeakedClasses; + {Leak statistics for a small block type} + TSmallBlockLeaks = array[0..NumSmallBlockTypes - 1] of TLeakedClasses; + {A leaked medium or large block} + TMediumAndLargeBlockLeaks = array[0..4095] of NativeUInt; +{$endif} +var +{$ifdef EnableMemoryLeakReporting} + {The leaked classes for small blocks} + LSmallBlockLeaks: TSmallBlockLeaks; + LLeakType: TMemoryLeakType; + {$ifdef CheckCppObjectTypeEnabled} + LLeakedCppTypeIdPtr: Pointer; + LCppTypeName: PAnsiChar; + {$endif} + LMediumAndLargeBlockLeaks: TMediumAndLargeBlockLeaks; + LNumMediumAndLargeLeaks: Integer; + LPLargeBlock: PLargeBlockHeader; + LLeakMessage: array[0..32767] of AnsiChar; + {$ifndef NoMessageBoxes} + LMessageTitleBuffer: array[0..1023] of AnsiChar; + {$endif} + LMsgPtr: PAnsiChar; + LExpectedLeaksOnly, LSmallLeakHeaderAdded, LBlockSizeHeaderAdded: Boolean; + LBlockTypeInd, LClassInd, LBlockInd: Cardinal; + LMediumBlockSize, LPreviousBlockSize, LLargeBlockSize, LThisBlockSize: NativeUInt; +{$endif} + LPMediumBlock: Pointer; + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LMediumBlockHeader: NativeUInt; + +{$ifdef EnableMemoryLeakReporting} + {Tries to account for a memory leak. Returns true if the leak is expected and + removes the leak from the list} + function GetMemoryLeakType(AAddress: Pointer; ASpaceInsideBlock: NativeUInt): TMemoryLeakType; + var + LLeak: TExpectedMemoryLeak; + begin + {Default to not found} + Result := mltUnexpectedLeak; + if ExpectedMemoryLeaks <> nil then + begin + {Check by pointer address} + LLeak.LeakAddress := AAddress; + LLeak.LeakedClass := nil; + {$ifdef CheckCppObjectTypeEnabled} + LLeak.LeakedCppTypeIdPtr := nil; + {$endif} + LLeak.LeakSize := 0; + LLeak.LeakCount := -1; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LLeak, False) then + begin + Result := mltExpectedLeakRegisteredByPointer; + Exit; + end; + {Check by class} + LLeak.LeakAddress := nil; + {$ifdef FullDebugMode} + LLeak.LeakedClass := TClass(PNativeUInt(PByte(AAddress)+ SizeOf(TFullDebugBlockHeader))^); + {$else} + LLeak.LeakedClass := TClass(PNativeUInt(AAddress)^); + {$endif} + {$ifdef CheckCppObjectTypeEnabled} + if Assigned(GetCppVirtObjTypeIdPtrFunc) then + begin + {$ifdef FullDebugMode} + LLeak.LeakedCppTypeIdPtr := GetCppVirtObjTypeIdPtrFunc(Pointer(PByte(AAddress) + + SizeOf(TFullDebugBlockHeader)), ASpaceInsideBlock); + {$else} + LLeak.LeakedCppTypeIdPtr := GetCppVirtObjTypeIdPtrFunc(AAddress, ASpaceInsideBlock); + {$endif} + end; + LLeakedCppTypeIdPtr := LLeak.LeakedCppTypeIdPtr; + {$endif} + LLeak.LeakSize := ASpaceInsideBlock; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByClass, @LLeak, False) then + begin + Result := mltExpectedLeakRegisteredByClass; + Exit; + end; + {Check by size: the block must be large enough to hold the leak} + LLeak.LeakedClass := nil; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryBySizeOnly, @LLeak, False) then + Result := mltExpectedLeakRegisteredBySize; + end; + end; + + {Checks the small block pool for leaks.} + procedure CheckSmallBlockPoolForLeaks(APSmallBlockPool: PSmallBlockPoolHeader); + var + LLeakedClass: TClass; + {$ifdef CheckCppObjectTypeEnabled} + LLeakedCppObjectTypeId: Pointer; + {$endif} + LSmallBlockLeakType: TMemoryLeakType; + LClassIndex: Integer; + LCurPtr, LEndPtr, LDataPtr: Pointer; + LBlockTypeIndex: Cardinal; + LPLeakedClasses: PLeakedClasses; + LSmallBlockSize: Cardinal; + begin + {Get the useable size inside a block} + LSmallBlockSize := APSmallBlockPool.BlockType.BlockSize - BlockHeaderSize; + {$ifdef FullDebugMode} + Dec(LSmallBlockSize, FullDebugBlockOverhead); + {$endif} + {Get the block type index} + LBlockTypeIndex := (UIntPtr(APSmallBlockPool.BlockType) - UIntPtr(@SmallBlockTypes[0])) div SizeOf(TSmallBlockType); + LPLeakedClasses := @LSmallBlockLeaks[LBlockTypeIndex]; + {Get the first and last pointer for the pool} + GetFirstAndLastSmallBlockInPool(APSmallBlockPool, LCurPtr, LEndPtr); + {Step through all blocks} + while UIntPtr(LCurPtr) <= UIntPtr(LEndPtr) do + begin + {Is this block in use? If so, is the debug info intact?} + if ((PNativeUInt(PByte(LCurPtr) - BlockHeaderSize)^ and IsFreeBlockFlag) = 0) then + begin + {$ifdef FullDebugMode} + if CheckBlockBeforeFreeOrRealloc(LCurPtr, boBlockCheck) then + {$endif} + begin + {$ifdef CheckCppObjectTypeEnabled} + LLeakedCppTypeIdPtr := nil; + {$endif} + {Get the leak type} + LSmallBlockLeakType := GetMemoryLeakType(LCurPtr, LSmallBlockSize); + {$ifdef LogMemoryLeakDetailToFile} + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LSmallBlockLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + LogMemoryLeakOrAllocatedBlock(LCurPtr, True); + {$endif} + {Only expected leaks?} + LExpectedLeaksOnly := LExpectedLeaksOnly and (LSmallBlockLeakType <> mltUnexpectedLeak); + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LSmallBlockLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + begin + {Get a pointer to the user data} + {$ifndef FullDebugMode} + LDataPtr := LCurPtr; + {$else} + LDataPtr := Pointer(PByte(LCurPtr) + SizeOf(TFullDebugBlockHeader)); + {$endif} + {Default to an unknown block} + LClassIndex := 0; + {Get the class contained by the block} + LLeakedClass := DetectClassInstance(LDataPtr); + {Not a Delphi class? -> is it perhaps a string or C++ object type?} + if LLeakedClass = nil then + begin + {$ifdef CheckCppObjectTypeEnabled} + LLeakedCppObjectTypeId := LLeakedCppTypeIdPtr; + if (LLeakedCppObjectTypeId = nil) and (ExpectedMemoryLeaks = nil) then + begin + if Assigned(GetCppVirtObjTypeIdPtrFunc) then + begin + LLeakedCppObjectTypeId := GetCppVirtObjTypeIdPtrFunc(LDataPtr, LSmallBlockSize); + end; + end; + if Assigned(LLeakedCppObjectTypeId) then + begin + LClassIndex := 3; + while LClassIndex <= High(TLeakedClasses) do + begin + if (Pointer(LPLeakedClasses[LClassIndex].CppTypeIdPtr) = LLeakedCppObjectTypeId) + or ((LPLeakedClasses[LClassIndex].CppTypeIdPtr = nil) + and (LPLeakedClasses[LClassIndex].ClassPointer = nil)) then + begin + Break; + end; + Inc(LClassIndex); + end; + if LClassIndex <= High(TLeakedClasses) then + Pointer(LPLeakedClasses[LClassIndex].CppTypeIdPtr) := LLeakedCppObjectTypeId + else + LClassIndex := 0; + end + else + begin + {$endif} + {Not a known class: Is it perhaps string data?} + case DetectStringData(LDataPtr, APSmallBlockPool.BlockType.BlockSize - (BlockHeaderSize {$ifdef FullDebugMode} + FullDebugBlockOverhead{$endif})) of + stAnsiString: LClassIndex := 1; + stUnicodeString: LClassIndex := 2; + end; + {$ifdef CheckCppObjectTypeEnabled} + end; + {$endif} + end + else + begin + LClassIndex := 3; + while LClassIndex <= High(TLeakedClasses) do + begin + if (LPLeakedClasses[LClassIndex].ClassPointer = LLeakedClass) + or ((LPLeakedClasses[LClassIndex].ClassPointer = nil) + {$ifdef CheckCppObjectTypeEnabled} + and (LPLeakedClasses[LClassIndex].CppTypeIdPtr = nil) + {$endif} + ) then + begin + Break; + end; + Inc(LClassIndex); + end; + if LClassIndex <= High(TLeakedClasses) then + LPLeakedClasses[LClassIndex].ClassPointer := LLeakedClass + else + LClassIndex := 0; + end; + {Add to the number of leaks for the class} + Inc(LPLeakedClasses[LClassIndex].NumLeaks); + end; + end; + end + else + begin + {$ifdef CheckUseOfFreedBlocksOnShutdown} + {Check that the block has not been modified since being freed} + CheckFreeBlockUnmodified(LCurPtr, APSmallBlockPool.BlockType.BlockSize, boBlockCheck); + {$endif} + end; + {Next block} + Inc(PByte(LCurPtr), APSmallBlockPool.BlockType.BlockSize); + end; + end; +{$endif} + +begin +{$ifdef EnableMemoryLeakReporting} + {Clear the leak arrays} + FillChar(LSmallBlockLeaks, SizeOf(LSmallBlockLeaks), 0); + FillChar(LMediumAndLargeBlockLeaks, SizeOf(LMediumAndLargeBlockLeaks), 0); + {Step through all the medium block pools} + LNumMediumAndLargeLeaks := 0; + {No unexpected leaks so far} + LExpectedLeaksOnly := True; +{$endif} + {Step through all the medium block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + LPMediumBlock := GetFirstMediumBlockInPool(LPMediumBlockPoolHeader); + while LPMediumBlock <> nil do + begin + LMediumBlockHeader := PNativeUInt(PByte(LPMediumBlock) - BlockHeaderSize)^; + {Is the block in use?} + if LMediumBlockHeader and IsFreeBlockFlag = 0 then + begin +{$ifdef EnableMemoryLeakReporting} + if ACheckForLeakedBlocks then + begin + if (LMediumBlockHeader and IsSmallBlockPoolInUseFlag) <> 0 then + begin + {Get all the leaks for the small block pool} + CheckSmallBlockPoolForLeaks(LPMediumBlock); + end + else + begin + if (LNumMediumAndLargeLeaks < Length(LMediumAndLargeBlockLeaks)) + {$ifdef FullDebugMode} + and CheckBlockBeforeFreeOrRealloc(LPMediumBlock, boBlockCheck) + {$endif} + then + begin + LMediumBlockSize := (LMediumBlockHeader and DropMediumAndLargeFlagsMask) - BlockHeaderSize; + {$ifdef FullDebugMode} + Dec(LMediumBlockSize, FullDebugBlockOverhead); + {$endif} + {Get the leak type} + LLeakType := GetMemoryLeakType(LPMediumBlock, LMediumBlockSize); + {Is it an expected leak?} + LExpectedLeaksOnly := LExpectedLeaksOnly and (LLeakType <> mltUnexpectedLeak); + {$ifdef LogMemoryLeakDetailToFile} + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + LogMemoryLeakOrAllocatedBlock(LPMediumBlock, True); + {$endif} + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + begin + {Add the leak to the list} + LMediumAndLargeBlockLeaks[LNumMediumAndLargeLeaks] := LMediumBlockSize; + Inc(LNumMediumAndLargeLeaks); + end; + end; + end; + end; +{$endif} + end + else + begin +{$ifdef CheckUseOfFreedBlocksOnShutdown} + {Check that the block has not been modified since being freed} + CheckFreeBlockUnmodified(LPMediumBlock, LMediumBlockHeader and DropMediumAndLargeFlagsMask, boBlockCheck); +{$endif} + end; + {Next medium block} + LPMediumBlock := NextMediumBlock(LPMediumBlock); + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; +{$ifdef EnableMemoryLeakReporting} + if ACheckForLeakedBlocks then + begin + {Get all leaked large blocks} + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + if (LNumMediumAndLargeLeaks < length(LMediumAndLargeBlockLeaks)) + {$ifdef FullDebugMode} + and CheckBlockBeforeFreeOrRealloc(Pointer(PByte(LPLargeBlock) + LargeBlockHeaderSize), boBlockCheck) + {$endif} + then + begin + LLargeBlockSize := (LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask) - BlockHeaderSize - LargeBlockHeaderSize; + {$ifdef FullDebugMode} + Dec(LLargeBlockSize, FullDebugBlockOverhead); + {$endif} + {Get the leak type} + LLeakType := GetMemoryLeakType(Pointer(PByte(LPLargeBlock) + LargeBlockHeaderSize), LLargeBlockSize); + {Is it an expected leak?} + LExpectedLeaksOnly := LExpectedLeaksOnly and (LLeakType <> mltUnexpectedLeak); + {$ifdef LogMemoryLeakDetailToFile} + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + LogMemoryLeakOrAllocatedBlock(Pointer(PByte(LPLargeBlock) + LargeBlockHeaderSize), True); + {$endif} + {$ifdef HideExpectedLeaksRegisteredByPointer} + if LLeakType <> mltExpectedLeakRegisteredByPointer then + {$endif} + begin + {Add the leak} + LMediumAndLargeBlockLeaks[LNumMediumAndLargeLeaks] := LLargeBlockSize; + Inc(LNumMediumAndLargeLeaks); + end; + end; + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + {Display the leak message if required} + if not LExpectedLeaksOnly then + begin + {Small leak header has not been added} + LSmallLeakHeaderAdded := False; + LPreviousBlockSize := 0; + {Set up the leak message header so long} + LMsgPtr := AppendStringToBuffer(LeakMessageHeader, @LLeakMessage[0], length(LeakMessageHeader)); + {Step through all the small block types} + for LBlockTypeInd := 0 to NumSmallBlockTypes - 1 do + begin + LThisBlockSize := SmallBlockTypes[LBlockTypeInd].BlockSize - BlockHeaderSize; + {$ifdef FullDebugMode} + Dec(LThisBlockSize, FullDebugBlockOverhead); + if NativeInt(LThisBlockSize) < 0 then + LThisBlockSize := 0; + {$endif} + LBlockSizeHeaderAdded := False; + {Any leaks?} + for LClassInd := High(LSmallBlockLeaks[LBlockTypeInd]) downto 0 do + begin + {Is there still space in the message buffer? Reserve space for the message + footer.} + if LMsgPtr > @LLeakMessage[High(LLeakMessage) - 2048] then + Break; + {Check the count} + if LSmallBlockLeaks[LBlockTypeInd][LClassInd].NumLeaks > 0 then + begin + {Need to add the header?} + if not LSmallLeakHeaderAdded then + begin + LMsgPtr := AppendStringToBuffer(SmallLeakDetail, LMsgPtr, Length(SmallLeakDetail)); + LSmallLeakHeaderAdded := True; + end; + {Need to add the size header?} + if not LBlockSizeHeaderAdded then + begin + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LPreviousBlockSize + 1, LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr^ := '-'; + Inc(LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LThisBlockSize, LMsgPtr); + LMsgPtr := AppendStringToBuffer(BytesMessage, LMsgPtr, Length(BytesMessage)); + LBlockSizeHeaderAdded := True; + end + else + begin + LMsgPtr^ := ','; + Inc(LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + end; + {Show the count} + case LClassInd of + {Unknown} + 0: + begin + LMsgPtr := AppendStringToBuffer(UnknownClassNameMsg, LMsgPtr, Length(UnknownClassNameMsg)); + end; + {AnsiString} + 1: + begin + LMsgPtr := AppendStringToBuffer(AnsiStringBlockMessage, LMsgPtr, Length(AnsiStringBlockMessage)); + end; + {UnicodeString} + 2: + begin + LMsgPtr := AppendStringToBuffer(UnicodeStringBlockMessage, LMsgPtr, Length(UnicodeStringBlockMessage)); + end; + {Classes} + else + begin + {$ifdef CheckCppObjectTypeEnabled} + if LSmallBlockLeaks[LBlockTypeInd][LClassInd].CppTypeIdPtr <> nil then + begin + if Assigned(GetCppVirtObjTypeNameByTypeIdPtrFunc) then + begin + LCppTypeName := GetCppVirtObjTypeNameByTypeIdPtrFunc(LSmallBlockLeaks[LBlockTypeInd][LClassInd].CppTypeIdPtr); + LMsgPtr := AppendStringToBuffer(LCppTypeName, LMsgPtr, StrLen(LCppTypeName)); + end + else + LMsgPtr := AppendClassNameToBuffer(nil, LMsgPtr); + end + else + begin + {$endif} + LMsgPtr := AppendClassNameToBuffer(LSmallBlockLeaks[LBlockTypeInd][LClassInd].ClassPointer, LMsgPtr); + {$ifdef CheckCppObjectTypeEnabled} + end; + {$endif} + end; + end; + {Add the count} + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr^ := 'x'; + Inc(LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LSmallBlockLeaks[LBlockTypeInd][LClassInd].NumLeaks, LMsgPtr); + end; + end; + LPreviousBlockSize := LThisBlockSize; + end; + {Add the medium/large block leak message} + if LNumMediumAndLargeLeaks > 0 then + begin + {Any non-small leaks?} + if LSmallLeakHeaderAdded then + begin + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + LMsgPtr^ := #13; + Inc(LMsgPtr); + LMsgPtr^ := #10; + Inc(LMsgPtr); + end; + {Add the medium/large block leak message} + LMsgPtr := AppendStringToBuffer(LargeLeakDetail, LMsgPtr, Length(LargeLeakDetail)); + {List all the blocks} + for LBlockInd := 0 to LNumMediumAndLargeLeaks - 1 do + begin + if LBlockInd <> 0 then + begin + LMsgPtr^ := ','; + Inc(LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + end; + LMsgPtr := NativeUIntToStrBuf(LMediumAndLargeBlockLeaks[LBlockInd], LMsgPtr); + {Is there still space in the message buffer? Reserve space for the + message footer.} + if LMsgPtr > @LLeakMessage[High(LLeakMessage) - 2048] then + Break; + end; + end; + {$ifdef LogErrorsToFile} + {Set the message footer} + LMsgPtr := AppendStringToBuffer(LeakMessageFooter, LMsgPtr, Length(LeakMessageFooter)); + {Append the message to the memory errors file} + AppendEventLog(@LLeakMessage[0], UIntPtr(LMsgPtr) - UIntPtr(@LLeakMessage[1])); + {$else} + {Set the message footer} + AppendStringToBuffer(LeakMessageFooter, LMsgPtr, Length(LeakMessageFooter)); + {$endif} + {$ifdef UseOutputDebugString} + OutputDebugStringA(LLeakMessage); + {$endif} + {$ifndef NoMessageBoxes} + {Show the message} + AppendStringToModuleName(LeakMessageTitle, LMessageTitleBuffer); + ShowMessageBox(LLeakMessage, LMessageTitleBuffer); + {$endif} + end; + end; +{$endif} +end; + +{Returns statistics about the current state of the memory manager} +procedure GetMemoryManagerState(var AMemoryManagerState: TMemoryManagerState); +var + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LPMediumBlock: Pointer; + LInd: Integer; + LBlockTypeIndex, LMediumBlockSize: Cardinal; + LMediumBlockHeader, LLargeBlockSize: NativeUInt; + LPLargeBlock: PLargeBlockHeader; +{$ifdef LogLockContention} + LDidSleep: Boolean; +{$endif} +begin + {Clear the structure} + FillChar(AMemoryManagerState, SizeOf(AMemoryManagerState), 0); + {Set the small block size stats} + for LInd := 0 to NumSmallBlockTypes - 1 do + begin + AMemoryManagerState.SmallBlockTypeStates[LInd].InternalBlockSize := + SmallBlockTypes[LInd].BlockSize; + AMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize := + SmallBlockTypes[LInd].BlockSize - BlockHeaderSize{$ifdef FullDebugMode} - FullDebugBlockOverhead{$endif}; + if NativeInt(AMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize) < 0 then + AMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize := 0; + end; + {Lock all small block types} + LockAllSmallBlockTypes; + {Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + {Step through all the medium block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + {Add to the medium block used space} + Inc(AMemoryManagerState.ReservedMediumBlockAddressSpace, MediumBlockPoolSize); + LPMediumBlock := GetFirstMediumBlockInPool(LPMediumBlockPoolHeader); + while LPMediumBlock <> nil do + begin + LMediumBlockHeader := PNativeUInt(PByte(LPMediumBlock) - BlockHeaderSize)^; + {Is the block in use?} + if LMediumBlockHeader and IsFreeBlockFlag = 0 then + begin + {Get the block size} + LMediumBlockSize := LMediumBlockHeader and DropMediumAndLargeFlagsMask; + if (LMediumBlockHeader and IsSmallBlockPoolInUseFlag) <> 0 then + begin + {Get the block type index} + LBlockTypeIndex := (UIntPtr(PSmallBlockPoolHeader(LPMediumBlock).BlockType) - UIntPtr(@SmallBlockTypes[0])) div SizeOf(TSmallBlockType); + {Subtract from medium block usage} + Dec(AMemoryManagerState.ReservedMediumBlockAddressSpace, LMediumBlockSize); + {Add it to the reserved space for the block size} + Inc(AMemoryManagerState.SmallBlockTypeStates[LBlockTypeIndex].ReservedAddressSpace, LMediumBlockSize); + {Add the usage for the pool} + Inc(AMemoryManagerState.SmallBlockTypeStates[LBlockTypeIndex].AllocatedBlockCount, + PSmallBlockPoolHeader(LPMediumBlock).BlocksInUse); + end + else + begin +{$ifdef FullDebugMode} + Dec(LMediumBlockSize, FullDebugBlockOverhead); +{$endif} + Inc(AMemoryManagerState.AllocatedMediumBlockCount); + Inc(AMemoryManagerState.TotalAllocatedMediumBlockSize, LMediumBlockSize - BlockHeaderSize); + end; + end; + {Next medium block} + LPMediumBlock := NextMediumBlock(LPMediumBlock); + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; + {Unlock medium blocks} + MediumBlocksLocked := False; + {Unlock all the small block types} + for LInd := 0 to NumSmallBlockTypes - 1 do + SmallBlockTypes[LInd].BlockTypeLocked := False; + {Step through all the large blocks} + LockLargeBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + LLargeBlockSize := LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask; + Inc(AMemoryManagerState.AllocatedLargeBlockCount); + Inc(AMemoryManagerState.ReservedLargeBlockAddressSpace, LLargeBlockSize); + Inc(AMemoryManagerState.TotalAllocatedLargeBlockSize, LPLargeBlock.UserAllocatedSize); + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + LargeBlocksLocked := False; +end; + +{Returns a summary of the information returned by GetMemoryManagerState} +procedure GetMemoryManagerUsageSummary( + var AMemoryManagerUsageSummary: TMemoryManagerUsageSummary); +var + LMMS: TMemoryManagerState; + LAllocatedBytes, LReservedBytes: NativeUInt; + LSBTIndex: Integer; +begin + {Get the memory manager state} + GetMemoryManagerState(LMMS); + {Add up the totals} + LAllocatedBytes := LMMS.TotalAllocatedMediumBlockSize + + LMMS.TotalAllocatedLargeBlockSize; + LReservedBytes := LMMS.ReservedMediumBlockAddressSpace + + LMMS.ReservedLargeBlockAddressSpace; + for LSBTIndex := 0 to NumSmallBlockTypes - 1 do + begin + Inc(LAllocatedBytes, LMMS.SmallBlockTypeStates[LSBTIndex].UseableBlockSize + * LMMS.SmallBlockTypeStates[LSBTIndex].AllocatedBlockCount); + Inc(LReservedBytes, LMMS.SmallBlockTypeStates[LSBTIndex].ReservedAddressSpace); + end; + {Set the structure values} + AMemoryManagerUsageSummary.AllocatedBytes := LAllocatedBytes; + AMemoryManagerUsageSummary.OverheadBytes := LReservedBytes - LAllocatedBytes; + if LReservedBytes > 0 then + begin + AMemoryManagerUsageSummary.EfficiencyPercentage := + LAllocatedBytes / LReservedBytes * 100; + end + else + AMemoryManagerUsageSummary.EfficiencyPercentage := 100; +end; + +{$ifndef POSIX} +{Gets the state of every 64K block in the 4GB address space. Under 64-bit this + returns only the state for the low 4GB.} +procedure GetMemoryMap(var AMemoryMap: TMemoryMap); +var + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LPLargeBlock: PLargeBlockHeader; + LInd, LChunkIndex, LNextChunk, LLargeBlockSize: NativeUInt; + LMBI: TMemoryBasicInformation; +{$ifdef LogLockContention} + LDidSleep: Boolean; +{$endif} +begin + {Clear the map} + FillChar(AMemoryMap, SizeOf(AMemoryMap), Ord(csUnallocated)); + {Step through all the medium block pools} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + {Add to the medium block used space} + LChunkIndex := NativeUInt(LPMediumBlockPoolHeader) shr 16; + for LInd := 0 to (MediumBlockPoolSize - 1) shr 16 do + begin + if (LChunkIndex + LInd) > High(AMemoryMap) then + Break; + AMemoryMap[LChunkIndex + LInd] := csAllocated; + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; + MediumBlocksLocked := False; + {Step through all the large blocks} + LockLargeBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + LChunkIndex := UIntPtr(LPLargeBlock) shr 16; + LLargeBlockSize := LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask; + for LInd := 0 to (LLargeBlockSize - 1) shr 16 do + begin + if (LChunkIndex + LInd) > High(AMemoryMap) then + Break; + AMemoryMap[LChunkIndex + LInd] := csAllocated; + end; + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + LargeBlocksLocked := False; + {Fill in the rest of the map} + LInd := 0; + while LInd <= 65535 do + begin + {If the chunk is not allocated by this MM, what is its status?} + if AMemoryMap[LInd] = csUnallocated then + begin + {Query the address space starting at the chunk boundary} + if VirtualQuery(Pointer(LInd * 65536), LMBI, SizeOf(LMBI)) = 0 then + begin + {VirtualQuery may fail for addresses >2GB if a large address space is + not enabled.} + FillChar(AMemoryMap[LInd], 65536 - LInd, csSysReserved); + Break; + end; + {Get the chunk number after the region} + LNextChunk := (LMBI.RegionSize - 1) shr 16 + LInd + 1; + {Validate} + if LNextChunk > 65536 then + LNextChunk := 65536; + {Set the status of all the chunks in the region} + if LMBI.State = MEM_COMMIT then + begin + FillChar(AMemoryMap[LInd], LNextChunk - LInd, csSysAllocated); + end + else + begin + if LMBI.State = MEM_RESERVE then + FillChar(AMemoryMap[LInd], LNextChunk - LInd, csSysReserved); + end; + {Point to the start of the next chunk} + LInd := LNextChunk; + end + else + begin + {Next chunk} + Inc(LInd); + end; + end; +end; +{$endif} + +{Returns summarised information about the state of the memory manager. (For + backward compatibility.)} +function FastGetHeapStatus: THeapStatus; +var + LPMediumBlockPoolHeader: PMediumBlockPoolHeader; + LPMediumBlock: Pointer; + LBlockTypeIndex, LMediumBlockSize: Cardinal; + LSmallBlockUsage, LSmallBlockOverhead, LMediumBlockHeader, LLargeBlockSize: NativeUInt; + LInd: Integer; + LPLargeBlock: PLargeBlockHeader; +{$ifdef LogLockContention} + LDidSleep: Boolean; +{$endif} +begin + {Clear the structure} + FillChar(Result, SizeOf(Result), 0); + {Lock all small block types} + LockAllSmallBlockTypes; + {Lock the medium blocks} + LockMediumBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + {Step through all the medium block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + {Add to the total and committed address space} + Inc(Result.TotalAddrSpace, ((MediumBlockPoolSize + $ffff) and $ffff0000)); + Inc(Result.TotalCommitted, ((MediumBlockPoolSize + $ffff) and $ffff0000)); + {Add the medium block pool overhead} + Inc(Result.Overhead, (((MediumBlockPoolSize + $ffff) and $ffff0000) + - MediumBlockPoolSize + MediumBlockPoolHeaderSize)); + {Get the first medium block in the pool} + LPMediumBlock := GetFirstMediumBlockInPool(LPMediumBlockPoolHeader); + while LPMediumBlock <> nil do + begin + {Get the block header} + LMediumBlockHeader := PNativeUInt(PByte(LPMediumBlock) - BlockHeaderSize)^; + {Get the block size} + LMediumBlockSize := LMediumBlockHeader and DropMediumAndLargeFlagsMask; + {Is the block in use?} + if LMediumBlockHeader and IsFreeBlockFlag = 0 then + begin + if (LMediumBlockHeader and IsSmallBlockPoolInUseFlag) <> 0 then + begin + {Get the block type index} + LBlockTypeIndex := (UIntPtr(PSmallBlockPoolHeader(LPMediumBlock).BlockType) - UIntPtr(@SmallBlockTypes[0])) div SizeOf(TSmallBlockType); + {Get the usage in the block} + LSmallBlockUsage := PSmallBlockPoolHeader(LPMediumBlock).BlocksInUse + * SmallBlockTypes[LBlockTypeIndex].BlockSize; + {Get the total overhead for all the small blocks} + LSmallBlockOverhead := PSmallBlockPoolHeader(LPMediumBlock).BlocksInUse + * (BlockHeaderSize{$ifdef FullDebugMode} + FullDebugBlockOverhead{$endif}); + {Add to the totals} + Inc(Result.FreeSmall, LMediumBlockSize - LSmallBlockUsage - BlockHeaderSize); + Inc(Result.Overhead, LSmallBlockOverhead + BlockHeaderSize); + Inc(Result.TotalAllocated, LSmallBlockUsage - LSmallBlockOverhead); + end + else + begin +{$ifdef FullDebugMode} + Dec(LMediumBlockSize, FullDebugBlockOverhead); + Inc(Result.Overhead, FullDebugBlockOverhead); +{$endif} + {Add to the result} + Inc(Result.TotalAllocated, LMediumBlockSize - BlockHeaderSize); + Inc(Result.Overhead, BlockHeaderSize); + end; + end + else + begin + {The medium block is free} + Inc(Result.FreeBig, LMediumBlockSize); + end; + {Next medium block} + LPMediumBlock := NextMediumBlock(LPMediumBlock); + end; + {Get the next medium block pool} + LPMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; + end; + {Add the sequential feed unused space} + Inc(Result.Unused, MediumSequentialFeedBytesLeft); + {Unlock the medium blocks} + MediumBlocksLocked := False; + {Unlock all the small block types} + for LInd := 0 to NumSmallBlockTypes - 1 do + SmallBlockTypes[LInd].BlockTypeLocked := False; + {Step through all the large blocks} + LockLargeBlocks({$ifdef LogLockContention}LDidSleep{$endif}); + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + LLargeBlockSize := LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask; + Inc(Result.TotalAddrSpace, LLargeBlockSize); + Inc(Result.TotalCommitted, LLargeBlockSize); + Inc(Result.TotalAllocated, LPLargeBlock.UserAllocatedSize + {$ifdef FullDebugMode} - FullDebugBlockOverhead{$endif}); + Inc(Result.Overhead, LLargeBlockSize - LPLargeBlock.UserAllocatedSize + {$ifdef FullDebugMode} + FullDebugBlockOverhead{$endif}); + {Get the next large block} + LPLargeBlock := LPLargeBlock.NextLargeBlockHeader; + end; + LargeBlocksLocked := False; + {Set the total number of free bytes} + Result.TotalFree := Result.FreeSmall + Result.FreeBig + Result.Unused; +end; + +{Frees all allocated memory. Does not support segmented large blocks (yet).} +procedure FreeAllMemory; +var + LPMediumBlockPoolHeader, LPNextMediumBlockPoolHeader: PMediumBlockPoolHeader; + LPMediumFreeBlock: PMediumFreeBlock; + LPLargeBlock, LPNextLargeBlock: PLargeBlockHeader; + LInd: Integer; +begin + {Free all block pools} + LPMediumBlockPoolHeader := MediumBlockPoolsCircularList.NextMediumBlockPoolHeader; + while LPMediumBlockPoolHeader <> @MediumBlockPoolsCircularList do + begin + {Get the next medium block pool so long} + LPNextMediumBlockPoolHeader := LPMediumBlockPoolHeader.NextMediumBlockPoolHeader; +{$ifdef ClearMediumBlockPoolsBeforeReturningToOS} + FillChar(LPMediumBlockPoolHeader^, MediumBlockPoolSize, 0); +{$else} + {$ifdef ClearSmallAndMediumBlocksInFreeMem} + FillChar(LPMediumBlockPoolHeader^, MediumBlockPoolSize, 0); + {$endif} +{$endif} + {Free this pool} + VirtualFree(LPMediumBlockPoolHeader, 0, MEM_RELEASE); + {Next pool} + LPMediumBlockPoolHeader := LPNextMediumBlockPoolHeader; + end; + {Clear all small block types} + for LInd := 0 to High(SmallBlockTypes) do + begin + SmallBlockTypes[Lind].PreviousPartiallyFreePool := @SmallBlockTypes[Lind]; + SmallBlockTypes[Lind].NextPartiallyFreePool := @SmallBlockTypes[Lind]; + SmallBlockTypes[Lind].NextSequentialFeedBlockAddress := Pointer(1); + SmallBlockTypes[Lind].MaxSequentialFeedBlockAddress := nil; + end; + {Clear all medium block pools} + MediumBlockPoolsCircularList.PreviousMediumBlockPoolHeader := @MediumBlockPoolsCircularList; + MediumBlockPoolsCircularList.NextMediumBlockPoolHeader := @MediumBlockPoolsCircularList; + {All medium bins are empty} + for LInd := 0 to High(MediumBlockBins) do + begin + LPMediumFreeBlock := @MediumBlockBins[LInd]; + LPMediumFreeBlock.PreviousFreeBlock := LPMediumFreeBlock; + LPMediumFreeBlock.NextFreeBlock := LPMediumFreeBlock; + end; + MediumBlockBinGroupBitmap := 0; + FillChar(MediumBlockBinBitmaps, SizeOf(MediumBlockBinBitmaps), 0); + MediumSequentialFeedBytesLeft := 0; + {Free all large blocks} + LPLargeBlock := LargeBlocksCircularList.NextLargeBlockHeader; + while LPLargeBlock <> @LargeBlocksCircularList do + begin + {Get the next large block} + LPNextLargeBlock := LPLargeBlock.NextLargeBlockHeader; +{$ifdef ClearLargeBlocksBeforeReturningToOS} + FillChar(LPLargeBlock^, + LPLargeBlock.BlockSizeAndFlags and DropMediumAndLargeFlagsMask, 0); +{$endif} + {Free this large block} + VirtualFree(LPLargeBlock, 0, MEM_RELEASE); + {Next large block} + LPLargeBlock := LPNextLargeBlock; + end; + {There are no large blocks allocated} + LargeBlocksCircularList.PreviousLargeBlockHeader := @LargeBlocksCircularList; + LargeBlocksCircularList.NextLargeBlockHeader := @LargeBlocksCircularList; +end; + +{$ifdef LogLockContention} +procedure ReportLockContention; +var + count: Integer; + data: TStaticCollector.TCollectedData; + i: Integer; + LErrorMessage: array[0..32767] of AnsiChar; + LMessageTitleBuffer: array[0..200] of AnsiChar; + LMsgPtr: PAnsiChar; + mergedCount: Integer; + mergedData: TStaticCollector.TCollectedData; +begin + LargeBlockCollector.GetData(mergedData, mergedCount); + MediumBlockCollector.GetData(data, count); + LargeBlockCollector.Merge(mergedData, mergedCount, data, count); + for i := 0 to High(SmallBlockTypes) do + begin + SmallBlockTypes[i].BlockCollector.GetData(data, count); + LargeBlockCollector.Merge(mergedData, mergedCount, data, count); + end; + + if mergedCount > 0 then + begin + FillChar(LErrorMessage, SizeOf(LErrorMessage), 0); + FillChar(LMessageTitleBuffer, SizeOf(LMessageTitleBuffer), 0); + LMsgPtr := @LErrorMessage[0]; + LMsgPtr := AppendStringToBuffer(LockingReportHeader, LMsgPtr, Length(LockingReportHeader)); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + for i := 1 to 3 do + begin + if i > mergedCount then + break; //for i + if i > 1 then + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + LMsgPtr := NativeUIntToStrBuf(mergedData[i].Count, LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr^ := 'x'; + Inc(LMsgPtr); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + LMsgPtr := LogStackTrace(@mergedData[i].Data.Pointers[1], mergedData[i].Data.Count, LMsgPtr); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + end; + AppendStringToModuleName(LockingReportTitle, LMessageTitleBuffer); + ShowMessageBox(LErrorMessage, LMessageTitleBuffer); + for i := 4 to 10 do + begin + if i > mergedCount then + break; //for i + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + LMsgPtr := NativeUIntToStrBuf(mergedData[i].Count, LMsgPtr); + LMsgPtr^ := ' '; + Inc(LMsgPtr); + LMsgPtr^ := 'x'; + Inc(LMsgPtr); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + LMsgPtr := LogStackTrace(@mergedData[i].Data.Pointers[1], mergedData[i].Data.Count, LMsgPtr); + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + end; + LMsgPtr := AppendStringToBuffer(CRLF, LMsgPtr, Length(CRLF)); + AppendEventLog(@LErrorMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LErrorMessage[0])); + end; +end; +{$endif} + +{$ifdef UseReleaseStack} +{$ifdef DebugReleaseStack} +procedure GetBlockSizeForStack(const AStack: TLFStack; var ABlockSize: NativeUInt; var ACount: integer); +var + LBlockHeader: NativeUInt; + LMemBlock: pointer; + LTmpStack: TLFStack; +begin + ABlockSize := 0; + ACount := 0; + LTmpStack.Initialize(ReleaseStackSize, SizeOf(pointer)); + while AStack.Pop(LMemBlock) do + begin + {Move each block to a temporary stack as we'll have to put them back later} + LTmpStack.Push(LMemBlock); + + Inc(ACount); + + LBlockHeader := PNativeUInt(PByte(LMemBlock) - BlockHeaderSize)^; + + {Block should always be in use!} + if (LBlockHeader and IsFreeBlockFlag) <> 0 then + begin + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end + {Is this a medium block?} + else if (LBlockHeader and IsMediumBlockFlag) <> 0 then + Inc(ABlockSize, LBlockHeader and DropMediumAndLargeFlagsMask) + {Is this a large block?} + else if (LBlockHeader and IsLargeBlockFlag) <> 0 then + Inc(ABlockSize, PLargeBlockHeader(Pointer(PByte(LMemBlock) - LargeBlockHeaderSize)).UserAllocatedSize) + {It must be a small block} + else + Inc(ABlockSize, PSmallBlockPoolHeader(LBlockHeader).BlockType.BlockSize); + end; + + {Cleanup, move memory blocks back to the release stack} + while LTmpStack.Pop(LMemBlock) do + AStack.Push(LMemBlock); + LTmpStack.Finalize; +end; + +procedure LogReleaseStackUsage; +var + LCount: integer; + LInd: Integer; + LMessage: array[0..32767] of AnsiChar; + LMsgPtr: PAnsiChar; + LSize: NativeUInt; + LSlot: Integer; + LSlotCount: array[0..NumStacksPerBlock-1] of integer; + LSlotSize: array[0..NumStacksPerBlock-1] of NativeUInt; + LTotalLarge: NativeUInt; + LTotalMedium: NativeUInt; + LTotalSmall: NativeUInt; + + procedure NewLine; + begin + LMsgPtr^ := #13; Inc(LMsgPtr); + LMsgPtr^ := #10; Inc(LMsgPtr); + end; + + procedure AppendMemorySize(ASize: NativeUInt); + begin + if ASize < 10*1024 then + begin + LMsgPtr := NativeUIntToStrBuf(Round(ASize/1024), LMsgPtr); + LMsgPtr^ := ' '; Inc(LMsgPtr); + LMsgPtr^ := 'K'; Inc(LMsgPtr); + LMsgPtr^ := 'B'; Inc(LMsgPtr); + end + else if ASize < 10*1024*1024 then + begin + LMsgPtr := NativeUIntToStrBuf(Round(ASize/1024), LMsgPtr); + LMsgPtr^ := ' '; Inc(LMsgPtr); + LMsgPtr^ := 'K'; Inc(LMsgPtr); + LMsgPtr^ := 'B'; Inc(LMsgPtr); + end + else if (ASize div 1024) < 10*1024*1024 then + begin + LMsgPtr := NativeUIntToStrBuf(Round(ASize/1024/1024), LMsgPtr); + LMsgPtr^ := ' '; Inc(LMsgPtr); + LMsgPtr^ := 'M'; Inc(LMsgPtr); + LMsgPtr^ := 'B'; Inc(LMsgPtr); + end + else + begin + LMsgPtr := NativeUIntToStrBuf(Round(ASize/1024/1024/1024), LMsgPtr); + LMsgPtr^ := ' '; Inc(LMsgPtr); + LMsgPtr^ := 'G'; Inc(LMsgPtr); + LMsgPtr^ := 'B'; Inc(LMsgPtr); + end; + end; + + procedure AppendSlotInfo(ABlockSize: Integer); + var + LCount: Integer; + LSlot: Integer; + LTotal: NativeUInt; + begin + if ABlockSize > 0 then + begin + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageSmallBlocksMsg1, LMsgPtr, Length(ReleaseStackUsageSmallBlocksMsg1)); + LMsgPtr := NativeUIntToStrBuf(ABlockSize, LMsgPtr); + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageSmallBlocksMsg2, LMsgPtr, Length(ReleaseStackUsageSmallBlocksMsg2)); + end + else if ABlockSize = -1 then + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageMediumBlocksMsg, LMsgPtr, Length(ReleaseStackUsageMediumBlocksMsg)) + else + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageLargeBlocksMsg, LMsgPtr, Length(ReleaseStackUsageLargeBlocksMsg)); + + LTotal := 0; + LCount := 0; + for LSlot := 0 to NumStacksPerBlock-1 do + begin + Inc(LTotal, LSlotSize[LSlot]); + Inc(LCount, LSlotCount[LSlot]); + end; + + AppendMemorySize(LTotal); + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageBuffers1Msg, LMsgPtr, Length(ReleaseStackUsageBuffers1Msg)); + LMsgPtr := NativeUIntToStrBuf(LCount, LMsgPtr); + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageBuffers2Msg, LMsgPtr, Length(ReleaseStackUsageBuffers2Msg)); + for LSlot := 0 to NumStacksPerBlock-1 do + begin + AppendMemorySize(LSlotSize[LSlot]); + LMsgPtr^ := '/'; + Inc(LMsgPtr); + LMsgPtr := NativeUIntToStrBuf(LSlotCount[LSlot], LMsgPtr); + if LSlot < (NumStacksPerBlock-1) then + begin + LMsgPtr^ := ' '; + Inc(LMsgPtr); + end; + end; + LMsgPtr^ := ']'; + Inc(LMsgPtr); + + NewLine; + end; + +begin + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageHeader, @LMessage[0], Length(ReleaseStackUsageHeader)); + NewLine; + NewLine; + + LockAllSmallBlockTypes; + LockMediumBlocks; + LockLargeBlocks; + + LTotalSmall := 0; + for LInd := 0 to High(SmallBlockTypes) do begin + for LSlot := 0 to NumStacksPerBlock-1 do begin + GetBlockSizeForStack(SmallBlockTypes[LInd].ReleaseStack[LSlot], LSize, LCount); + LSlotSize[LSlot] := LSize; + LSlotCount[LSlot] := LCount; + Inc(LTotalSmall, LSize); + end; + SmallBlockTypes[LInd].BlockTypeLocked := false; + AppendSlotInfo(SmallBlockTypes[LInd].BlockSize); + end; + + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageTotalSmallBlocksMsg, LMsgPtr, Length(ReleaseStackUsageTotalSmallBlocksMsg)); + AppendMemorySize(LTotalSmall); + NewLine; + + LTotalMedium := 0; + for LSlot := 0 to NumStacksPerBlock-1 do begin + GetBlockSizeForStack(MediumReleaseStack[LSlot], LSize, LCount); + LSlotSize[LSlot] := LSize; + LSlotCount[LSlot] := LCount; + Inc(LTotalMedium, LSize); + end; + MediumBlocksLocked := false; + AppendSlotInfo(-1); + + LTotalLarge := 0; + for LSlot := 0 to NumStacksPerBlock-1 do begin + GetBlockSizeForStack(LargeReleaseStack[LSlot], LSize, LCount); + LSlotSize[LSlot] := LSize; + LSlotCount[LSlot] := LCount; + Inc(LTotalLarge, LSize); + end; + LargeBlocksLocked := false; + AppendSlotInfo(-2); + + LMsgPtr := AppendStringToBuffer(ReleaseStackUsageTotalMemoryMsg, LMsgPtr, Length(ReleaseStackUsageTotalMemoryMsg)); + AppendMemorySize(LTotalSmall + LTotalMedium + LTotalLarge); + NewLine; + + {Trailing #0} + LMsgPtr^ := #0; + + AppendEventLog(@LMessage[0], NativeUInt(LMsgPtr) - NativeUInt(@LMessage[0])); +end; +{$endif} +{$endif} + +{----------------------------Memory Manager Setup-----------------------------} + +{Checks that no other memory manager has been installed after the RTL MM and + that there are currently no live pointers allocated through the RTL MM.} +function CheckCanInstallMemoryManager: Boolean; +{$ifndef NoMessageBoxes} +var + LErrorMessageTitle: array[0..1023] of AnsiChar; +{$endif} +begin + {Default to error} + Result := False; +{$ifdef FullDebugMode} + {$ifdef LoadDebugDLLDynamically} + {$ifdef DoNotInstallIfDLLMissing} + {Should FastMM be installed only if the FastMM_FullDebugMode.dll file is + available?} + if FullDebugModeDLL = 0 then + Exit; + {$endif} + {$endif} +{$endif} + {Is FastMM already installed?} + if FastMMIsInstalled then + begin +{$ifdef UseOutputDebugString} + OutputDebugStringA(AlreadyInstalledMsg); +{$endif} +{$ifndef NoMessageBoxes} + AppendStringToModuleName(AlreadyInstalledTitle, LErrorMessageTitle); + ShowMessageBox(AlreadyInstalledMsg, LErrorMessageTitle); +{$endif} + Exit; + end; + {Has another MM been set, or has the Embarcadero MM been used? If so, this + file is not the first unit in the uses clause of the project's .dpr file.} + if IsMemoryManagerSet then + begin + {When using runtime packages, another library may already have installed + FastMM: Silently ignore the installation request.} +{$ifndef UseRuntimePackages} + {Another memory manager has been set.} + {$ifdef UseOutputDebugString} + OutputDebugStringA(OtherMMInstalledMsg); + {$endif} + {$ifndef NoMessageBoxes} + AppendStringToModuleName(OtherMMInstalledTitle, LErrorMessageTitle); + ShowMessageBox(OtherMMInstalledMsg, LErrorMessageTitle); + {$endif} +{$endif} + Exit; + end; +{$ifndef POSIX} + if GetHeapStatus.TotalAllocated <> 0 then + begin + {Memory has been already been allocated with the RTL MM} +{$ifdef UseOutputDebugString} + OutputDebugStringA(MemoryAllocatedMsg); +{$endif} + {$ifndef NoMessageBoxes} + AppendStringToModuleName(MemoryAllocatedTitle, LErrorMessageTitle); + ShowMessageBox(MemoryAllocatedMsg, LErrorMessageTitle); + {$endif} + Exit; + end; +{$endif} + {All OK} + Result := True; +end; + +{Initializes the lookup tables for the memory manager} +procedure InitializeMemoryManager; +const + {The size of the Inc(VMTIndex) code in TFreedObject.GetVirtualMethodIndex} + VMTIndexIncCodeSize = 6; +var + LInd, LSizeInd, LMinimumPoolSize, LOptimalPoolSize, LGroupNumber, + LBlocksPerPool, LPreviousBlockSize: Cardinal; + LPMediumFreeBlock: PMediumFreeBlock; +{$ifdef UseReleaseStack} + LSlot: Integer; +{$endif} +begin +{$ifdef FullDebugMode} + {$ifdef LoadDebugDLLDynamically} + {Attempt to load the FullDebugMode DLL dynamically.} + FullDebugModeDLL := LoadLibrary(FullDebugModeLibraryName); + if FullDebugModeDLL <> 0 then + begin + GetStackTrace := GetProcAddress(FullDebugModeDLL, + {$ifdef RawStackTraces}'GetRawStackTrace'{$else}'GetFrameBasedStackTrace'{$endif}); + LogStackTrace := GetProcAddress(FullDebugModeDLL, 'LogStackTrace'); + end; + {$endif} +{$endif} +{$ifdef EnableMMX} + {$ifndef ForceMMX} + UseMMX := MMX_Supported; + {$endif} +{$endif} + {Initialize the memory manager} + {-------------Set up the small block types-------------} + LPreviousBlockSize := 0; + for LInd := 0 to High(SmallBlockTypes) do + begin + {Set the move procedure} +{$ifdef UseCustomFixedSizeMoveRoutines} + {The upsize move procedure may move chunks in 16 bytes even with 8-byte + alignment, since the new size will always be at least 8 bytes bigger than + the old size.} + if not Assigned(SmallBlockTypes[LInd].UpsizeMoveProcedure) then + {$ifdef UseCustomVariableSizeMoveRoutines} + SmallBlockTypes[LInd].UpsizeMoveProcedure := MoveX16LP; + {$else} + SmallBlockTypes[LInd].UpsizeMoveProcedure := @System.Move; + {$endif} +{$endif} +{$ifdef LogLockContention} + SmallBlockTypes[LInd].BlockCollector.Initialize; +{$endif} + {Set the first "available pool" to the block type itself, so that the + allocation routines know that there are currently no pools with free + blocks of this size.} + SmallBlockTypes[LInd].PreviousPartiallyFreePool := @SmallBlockTypes[LInd]; + SmallBlockTypes[LInd].NextPartiallyFreePool := @SmallBlockTypes[LInd]; + {Set the block size to block type index translation table} + for LSizeInd := (LPreviousBlockSize div SmallBlockGranularity) to ((SmallBlockTypes[LInd].BlockSize - 1) div SmallBlockGranularity) do + AllocSize2SmallBlockTypeIndX4[LSizeInd] := LInd * 4; + {Cannot sequential feed yet: Ensure that the next address is greater than + the maximum address} + SmallBlockTypes[LInd].MaxSequentialFeedBlockAddress := Pointer(0); + SmallBlockTypes[LInd].NextSequentialFeedBlockAddress := Pointer(1); + {Get the mask to use for finding a medium block suitable for a block pool} + LMinimumPoolSize := + ((SmallBlockTypes[LInd].BlockSize * MinimumSmallBlocksPerPool + + SmallBlockPoolHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset) + and -MediumBlockGranularity) + MediumBlockSizeOffset; + if LMinimumPoolSize < MinimumMediumBlockSize then + LMinimumPoolSize := MinimumMediumBlockSize; + {Get the closest group number for the minimum pool size} + LGroupNumber := (LMinimumPoolSize - MinimumMediumBlockSize + MediumBlockBinsPerGroup * MediumBlockGranularity div 2) + div (MediumBlockBinsPerGroup * MediumBlockGranularity); + {Too large?} + if LGroupNumber > 7 then + LGroupNumber := 7; + {Set the bitmap} + SmallBlockTypes[LInd].AllowedGroupsForBlockPoolBitmap := Byte(-(1 shl LGroupNumber)); + {Set the minimum pool size} + SmallBlockTypes[LInd].MinimumBlockPoolSize := MinimumMediumBlockSize + LGroupNumber * (MediumBlockBinsPerGroup * MediumBlockGranularity); + {Get the optimal block pool size} + LOptimalPoolSize := ((SmallBlockTypes[LInd].BlockSize * TargetSmallBlocksPerPool + + SmallBlockPoolHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset) + and -MediumBlockGranularity) + MediumBlockSizeOffset; + {Limit the optimal pool size to within range} + if LOptimalPoolSize < OptimalSmallBlockPoolSizeLowerLimit then + LOptimalPoolSize := OptimalSmallBlockPoolSizeLowerLimit; + if LOptimalPoolSize > OptimalSmallBlockPoolSizeUpperLimit then + LOptimalPoolSize := OptimalSmallBlockPoolSizeUpperLimit; + {How many blocks will fit in the adjusted optimal size?} + LBlocksPerPool := (LOptimalPoolSize - SmallBlockPoolHeaderSize) div SmallBlockTypes[LInd].BlockSize; + {Recalculate the optimal pool size to minimize wastage due to a partial + last block.} + SmallBlockTypes[LInd].OptimalBlockPoolSize := + ((LBlocksPerPool * SmallBlockTypes[LInd].BlockSize + SmallBlockPoolHeaderSize + MediumBlockGranularity - 1 - MediumBlockSizeOffset) and -MediumBlockGranularity) + MediumBlockSizeOffset; +{$ifdef UseReleaseStack} + for LSlot := 0 to NumStacksPerBlock - 1 do + SmallBlockTypes[LInd].ReleaseStack[LSlot].Initialize(ReleaseStackSize, SizeOf(Pointer)); +{$endif} +{$ifdef CheckHeapForCorruption} + {Debug checks} + if (SmallBlockTypes[LInd].OptimalBlockPoolSize < MinimumMediumBlockSize) + or (SmallBlockTypes[LInd].BlockSize div SmallBlockGranularity * SmallBlockGranularity <> SmallBlockTypes[LInd].BlockSize) then + begin + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; +{$endif} + {Set the previous small block size} + LPreviousBlockSize := SmallBlockTypes[LInd].BlockSize; + end; + {-------------------Set up the medium blocks-------------------} +{$ifdef CheckHeapForCorruption} + {Check that there are no gaps between where the small blocks end and the + medium blocks start} + if (((MaximumSmallBlockSize - 3) + (MediumBlockGranularity - 1 + BlockHeaderSize - MediumBlockSizeOffset)) + and -MediumBlockGranularity) + MediumBlockSizeOffset < MinimumMediumBlockSize then + begin + {$ifdef BCB6OrDelphi7AndUp} + System.Error(reInvalidPtr); + {$else} + System.RunError(reInvalidPtr); + {$endif} + end; +{$endif} + {There are currently no medium block pools} + MediumBlockPoolsCircularList.PreviousMediumBlockPoolHeader := @MediumBlockPoolsCircularList; + MediumBlockPoolsCircularList.NextMediumBlockPoolHeader := @MediumBlockPoolsCircularList; + {All medium bins are empty} + for LInd := 0 to High(MediumBlockBins) do + begin + LPMediumFreeBlock := @MediumBlockBins[LInd]; + LPMediumFreeBlock.PreviousFreeBlock := LPMediumFreeBlock; + LPMediumFreeBlock.NextFreeBlock := LPMediumFreeBlock; + end; + {------------------Set up the large blocks---------------------} + LargeBlocksCircularList.PreviousLargeBlockHeader := @LargeBlocksCircularList; + LargeBlocksCircularList.NextLargeBlockHeader := @LargeBlocksCircularList; + {------------------Set up the debugging structures---------------------} +{$ifdef FullDebugMode} + {Set up the fake VMT} + {Copy the basic info from the TFreedObject class} + System.Move(Pointer(PByte(TFreedObject) + vmtSelfPtr + SizeOf(Pointer))^, + FreedObjectVMT.VMTData[vmtSelfPtr + SizeOf(Pointer)], vmtParent - vmtSelfPtr); + PNativeUInt(@FreedObjectVMT.VMTData[vmtSelfPtr])^ := NativeUInt(@FreedObjectVMT.VMTMethods[0]); + {Set up the virtual method table} + for LInd := 0 to MaxFakeVMTEntries - 1 do + begin + PNativeUInt(@FreedObjectVMT.VMTMethods[Low(FreedObjectVMT.VMTMethods) + Integer(LInd * SizeOf(Pointer))])^ := + NativeUInt(@TFreedObject.GetVirtualMethodIndex) + LInd * VMTIndexIncCodeSize; + {$ifdef CatchUseOfFreedInterfaces} + VMTBadInterface[LInd] := @TFreedObject.InterfaceError; + {$endif} + end; + {Set up the default log file name} +{$endif} +{$ifdef _EventLog} + SetDefaultMMLogFileName; +{$endif} + {Initialize lock contention loggers for medium and large blocks} +{$ifdef LogLockContention} + MediumBlockCollector.Initialize; + LargeBlockCollector.Initialize; +{$endif} + {Initialize release stacks for medium and large blocks} +{$ifdef UseReleaseStack} + for LSlot := 0 to NumStacksPerBlock - 1 do + begin + MediumReleaseStack[LSlot].Initialize(ReleaseStackSize, SizeOf(pointer)); + LargeReleaseStack[LSlot].Initialize(ReleaseStackSize, SizeOf(pointer)); + end; +{$endif} +end; + +{Installs the memory manager (InitializeMemoryManager should be called first)} +procedure InstallMemoryManager; +{$ifdef MMSharingEnabled} +var + i, LCurrentProcessID: Cardinal; + LPMapAddress: PPointer; + LChar: AnsiChar; +{$endif} +begin + if not FastMMIsInstalled then + begin +{$ifdef FullDebugMode} + {$ifdef 32Bit} + {Try to reserve the 64K block covering address $80808080} + ReservedBlock := VirtualAlloc(Pointer(DebugReservedAddress), 65536, MEM_RESERVE, PAGE_NOACCESS); + {$endif} +{$endif} +{$ifdef MMSharingEnabled} + {Build a string identifying the current process} + LCurrentProcessID := GetCurrentProcessId; + for i := 0 to 7 do + begin + LChar := HexTable[((LCurrentProcessID shr (i * 4)) and $F)]; + MappingObjectName[(High(MappingObjectName) - 1) - i] := LChar; + {$ifdef EnableBackwardCompatibleMMSharing} + UniqueProcessIDString[8 - i] := LChar; + UniqueProcessIDStringBE[8 - i] := LChar; + {$endif} + end; +{$endif} +{$ifdef AttemptToUseSharedMM} + {Is the replacement memory manager already installed for this process?} +{$ifdef EnableBackwardCompatibleMMSharing} + MMWindow := FindWindowA('STATIC', PAnsiChar(@UniqueProcessIDString[1])); + MMWindowBE := FindWindowA('STATIC', PAnsiChar(@UniqueProcessIDStringBE[1])); +{$endif} + MappingObjectHandle := OpenFileMappingA(FILE_MAP_READ, False, MappingObjectName); + {Is no MM being shared?} +{$ifdef EnableBackwardCompatibleMMSharing} + if (MMWindow or MMWindowBE or MappingObjectHandle) = 0 then +{$else} + if MappingObjectHandle = 0 then +{$endif} + begin +{$endif} +{$ifdef ShareMM} + {Share the MM with other DLLs? - if this DLL is unloaded, then + dependent DLLs will cause a crash.} + {$ifndef ShareMMIfLibrary} + if not IsLibrary then + {$endif} + begin + {$ifdef EnableBackwardCompatibleMMSharing} + {No memory manager installed yet - create the invisible window} + MMWindow := CreateWindowA('STATIC', PAnsiChar(@UniqueProcessIDString[1]), + WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil); + MMWindowBE := CreateWindowA('STATIC', PAnsiChar(@UniqueProcessIDStringBE[1]), + WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil); + {The window data is a pointer to this memory manager} + if MMWindow <> 0 then + SetWindowLongA(MMWindow, GWL_USERDATA, NativeInt(@NewMemoryManager)); + if MMWindowBE <> 0 then + SetWindowLongA(MMWindowBE, GWL_USERDATA, NativeInt(@NewMemoryManager)); + {$endif} + {Create the memory mapped file} + MappingObjectHandle := CreateFileMappingA(INVALID_HANDLE_VALUE, nil, + PAGE_READWRITE, 0, SizeOf(Pointer), MappingObjectName); + {Map a view of the memory} + LPMapAddress := MapViewOfFile(MappingObjectHandle, FILE_MAP_WRITE, 0, 0, 0); + {Set a pointer to the new memory manager} + LPMapAddress^ := @NewMemoryManager; + {Unmap the file} + UnmapViewOfFile(LPMapAddress); + end; +{$endif} + {We will be using this memory manager} +{$ifndef FullDebugMode} + NewMemoryManager.GetMem := FastGetMem; + NewMemoryManager.FreeMem := FastFreeMem; + NewMemoryManager.ReallocMem := FastReallocMem; + {$ifdef fpc} + NewMemoryManager.FreememSize := FastFreeMemSize; + NewMemoryManager.AllocMem := FastAllocMem; + NewMemoryManager.MemSize := FastMemSize; + {$endif} +{$else} + NewMemoryManager.GetMem := DebugGetMem; + NewMemoryManager.FreeMem := DebugFreeMem; + NewMemoryManager.ReallocMem := DebugReallocMem; +{$endif} +{$ifdef BDS2006AndUp} + {$ifndef FullDebugMode} + NewMemoryManager.AllocMem := FastAllocMem; + {$else} + NewMemoryManager.AllocMem := DebugAllocMem; + {$endif} + {$ifdef EnableMemoryLeakReporting} + NewMemoryManager.RegisterExpectedMemoryLeak := RegisterExpectedMemoryLeak; + NewMemoryManager.UnRegisterExpectedMemoryLeak := UnRegisterExpectedMemoryLeak; + {$else} + NewMemoryManager.RegisterExpectedMemoryLeak := NoOpRegisterExpectedMemoryLeak; + NewMemoryManager.UnRegisterExpectedMemoryLeak := NoOpUnRegisterExpectedMemoryLeak; + {$endif} +{$endif} + {Owns the memory manager} + IsMemoryManagerOwner := True; +{$ifdef AttemptToUseSharedMM} + end + else + begin + {Get the address of the shared memory manager} + {$ifndef BDS2006AndUp} + {$ifdef EnableBackwardCompatibleMMSharing} + if MappingObjectHandle <> 0 then + begin + {$endif} + {Map a view of the memory} + LPMapAddress := MapViewOfFile(MappingObjectHandle, FILE_MAP_READ, 0, 0, 0); + {Set the new memory manager} + NewMemoryManager := PMemoryManager(LPMapAddress^)^; + {Unmap the file} + UnmapViewOfFile(LPMapAddress); + {$ifdef EnableBackwardCompatibleMMSharing} + end + else + begin + if MMWindow <> 0 then + begin + NewMemoryManager := PMemoryManager(GetWindowLong(MMWindow, GWL_USERDATA))^; + end + else + begin + NewMemoryManager := PMemoryManager(GetWindowLong(MMWindowBE, GWL_USERDATA))^; + end; + end; + {$endif} + {$else} + {$ifdef EnableBackwardCompatibleMMSharing} + if MappingObjectHandle <> 0 then + begin + {$endif} + {Map a view of the memory} + LPMapAddress := MapViewOfFile(MappingObjectHandle, FILE_MAP_READ, 0, 0, 0); + {Set the new memory manager} + NewMemoryManager := PMemoryManagerEx(LPMapAddress^)^; + {Unmap the file} + UnmapViewOfFile(LPMapAddress); + {$ifdef EnableBackwardCompatibleMMSharing} + end + else + begin + if MMWindow <> 0 then + begin + NewMemoryManager := PMemoryManagerEx(GetWindowLong(MMWindow, GWL_USERDATA))^; + end + else + begin + NewMemoryManager := PMemoryManagerEx(GetWindowLong(MMWindowBE, GWL_USERDATA))^; + end; + end; + {$endif} + {$endif} + {Close the file mapping handle} + CloseHandle(MappingObjectHandle); + MappingObjectHandle := 0; + {The memory manager is not owned by this module} + IsMemoryManagerOwner := False; + end; +{$endif} + {Save the old memory manager} + GetMemoryManager(OldMemoryManager); + {Replace the memory manager with either this one or the shared one.} + SetMemoryManager(NewMemoryManager); + {FastMM is now installed} + FastMMIsInstalled := True; +{$ifdef UseOutputDebugString} + if IsMemoryManagerOwner then + OutputDebugStringA(FastMMInstallMsg) + else + OutputDebugStringA(FastMMInstallSharedMsg); +{$endif} + end; +end; + +procedure UninstallMemoryManager; +begin + {Is this the owner of the shared MM window?} + if IsMemoryManagerOwner then + begin +{$ifdef ShareMM} + {$ifdef EnableBackwardCompatibleMMSharing} + {Destroy the window} + if MMWindow <> 0 then + begin + DestroyWindow(MMWindow); + MMWindow := 0; + end; + if MMWindowBE <> 0 then + begin + DestroyWindow(MMWindowBE); + MMWindowBE := 0; + end; + {$endif} + {Destroy the memory mapped file handle} + if MappingObjectHandle <> 0 then + begin + CloseHandle(MappingObjectHandle); + MappingObjectHandle := 0; + end; +{$endif} +{$ifdef FullDebugMode} + {Release the reserved block} + if ReservedBlock <> nil then + begin + VirtualFree(ReservedBlock, 0, MEM_RELEASE); + ReservedBlock := nil; + end; +{$endif} + end; +{$ifndef DetectMMOperationsAfterUninstall} + {Restore the old memory manager} + SetMemoryManager(OldMemoryManager); +{$else} + {Set the invalid memory manager: no more MM operations allowed} + SetMemoryManager(InvalidMemoryManager); +{$endif} + {Memory manager has been uninstalled} + FastMMIsInstalled := False; +{$ifdef UseOutputDebugString} + if IsMemoryManagerOwner then + OutputDebugStringA(FastMMUninstallMsg) + else + OutputDebugStringA(FastMMUninstallSharedMsg); +{$endif} +end; + +{$ifdef UseReleaseStack} +procedure CleanupReleaseStacks; +var + LInd: Integer; + LMemory: Pointer; + LSlot: Integer; +begin + for LInd := 0 to High(SmallBlockTypes) do begin + for LSlot := 0 to NumStacksPerBlock-1 do + while SmallBlockTypes[LInd].ReleaseStack[LSlot].Pop(LMemory) do + FastFreeMem(LMemory); + {Finalize all stacks only after all memory for this block has been freed.} + {Otherwise, FastFreeMem could try to access a stack that was already finalized.} + for LSlot := 0 to NumStacksPerBlock-1 do + SmallBlockTypes[LInd].ReleaseStack[LSlot].Finalize; + end; + for LSlot := 0 to NumStacksPerBlock-1 do + begin + while MediumReleaseStack[LSlot].Pop(LMemory) do + FastFreeMem(LMemory); + while LargeReleaseStack[LSlot].Pop(LMemory) do + FastFreeMem(LMemory); + end; + for LSlot := 0 to NumStacksPerBlock-1 do + begin + MediumReleaseStack[LSlot].Finalize; + LargeReleaseStack[LSlot].Finalize; + end; +end; + +function ReleaseStackCleanupThreadProc(const AParam: Pointer): Integer; +var + LMemBlock: Pointer; + LSlot: Integer; +begin + {Clean up 1 medium and 1 large block for every thread slot, every 100ms.} + while WaitForSingleObject(ReleaseStackCleanupThreadTerminate, 100) = WAIT_TIMEOUT do + begin + for LSlot := 0 to NumStacksPerBlock - 1 do + begin + if (not MediumReleaseStack[LSlot].IsEmpty) + and (LockCmpxchg(0, 1, @MediumBlocksLocked) = 0) then + begin + if MediumReleaseStack[LSlot].Pop(LMemBlock) then + FreeMediumBlock(LMemBlock, True) + else + MediumBlocksLocked := False; + end; + if (not LargeReleaseStack[LSlot].IsEmpty) + and (LockCmpxchg(0, 1, @LargeBlocksLocked) = 0) then + begin + if LargeReleaseStack[LSlot].Pop(LMemBlock) then + FreeLargeBlock(LMemBlock, True) + else + LargeBlocksLocked := False; + end; + end; + end; + Result := 0; +end; + +procedure CreateCleanupThread; +var + LThreadID: DWORD; +begin + ReleaseStackCleanupThreadTerminate := CreateEvent(nil, False, False, nil); + if ReleaseStackCleanupThreadTerminate = 0 then + {$ifdef BCB6OrDelphi7AndUp}System.Error(reInvalidPtr);{$else}System.RunError(reInvalidPtr);{$endif} + ReleaseStackCleanupThread := BeginThread(nil, 0, @ReleaseStackCleanupThreadProc, nil, 0, LThreadID); + if ReleaseStackCleanupThread = 0 then + {$ifdef BCB6OrDelphi7AndUp}System.Error(reInvalidPtr);{$else}System.RunError(reInvalidPtr);{$endif} + SetThreadPriority(ReleaseStackCleanupThread, THREAD_PRIORITY_LOWEST); +end; + +procedure DestroyCleanupThread; +begin + if ReleaseStackCleanupThread <> 0 then + begin + SetEvent(ReleaseStackCleanupThreadTerminate); + WaitForSingleObject(ReleaseStackCleanupThread, INFINITE); + CloseHandle(ReleaseStackCleanupThread); + ReleaseStackCleanupThread := 0; + CloseHandle(ReleaseStackCleanupThreadTerminate); + ReleaseStackCleanupThreadTerminate := 0; + end; +end; +{$endif} + +procedure FinalizeMemoryManager; +begin + {Restore the old memory manager if FastMM has been installed} + if FastMMIsInstalled then + begin +{$ifdef UseReleaseStack} + DestroyCleanupThread; + CleanupReleaseStacks; +{$endif} +{$ifndef NeverUninstall} + {Uninstall FastMM} + UninstallMemoryManager; +{$endif} + {Do we own the memory manager, or are we just sharing it?} + if IsMemoryManagerOwner then + begin +{$ifdef CheckUseOfFreedBlocksOnShutdown} + CheckBlocksOnShutdown( + {$ifdef EnableMemoryLeakReporting} + True + {$ifdef RequireIDEPresenceForLeakReporting} + and DelphiIsRunning + {$endif} + {$ifdef RequireDebuggerPresenceForLeakReporting} + and ((DebugHook <> 0) + {$ifdef PatchBCBTerminate} + or (Assigned(pCppDebugHook) and (pCppDebugHook^ <> 0)) + {$endif PatchBCBTerminate} + ) + {$endif} + {$ifdef ManualLeakReportingControl} + and ReportMemoryLeaksOnShutdown + {$endif} + {$else} + False + {$endif} + ); +{$else} + {$ifdef EnableMemoryLeakReporting} + if True + {$ifdef RequireIDEPresenceForLeakReporting} + and DelphiIsRunning + {$endif} + {$ifdef RequireDebuggerPresenceForLeakReporting} + and ((DebugHook <> 0) + {$ifdef PatchBCBTerminate} + or (Assigned(pCppDebugHook) and (pCppDebugHook^ <> 0)) + {$endif PatchBCBTerminate} + ) + {$endif} + {$ifdef ManualLeakReportingControl} + and ReportMemoryLeaksOnShutdown + {$endif} + then + CheckBlocksOnShutdown(True); + {$endif} +{$endif} +{$ifdef EnableMemoryLeakReporting} + {Free the expected memory leaks list} + if ExpectedMemoryLeaks <> nil then + begin + VirtualFree(ExpectedMemoryLeaks, 0, MEM_RELEASE); + ExpectedMemoryLeaks := nil; + end; +{$endif} +{$ifdef LogLockContention} + ReportLockContention; +{$endif} +{$ifndef NeverUninstall} + {Clean up: Free all memory. If this is a .DLL that owns its own MM, then + it is necessary to prevent the main application from running out of + address space.} + FreeAllMemory; +{$endif} + end; + end; +end; + +procedure RunInitializationCode; +begin + {Only run this code once during startup.} + if InitializationCodeHasRun then + Exit; + InitializationCodeHasRun := True; +{$ifndef BCB} + {$ifdef InstallOnlyIfRunningInIDE} + if (DebugHook <> 0) and DelphiIsRunning then + {$endif} + begin + {Initialize all the lookup tables, etc. for the memory manager} + InitializeMemoryManager; + {Has another MM been set, or has the Embarcadero MM been used? If so, this + file is not the first unit in the uses clause of the project's .dpr + file.} + if CheckCanInstallMemoryManager then + begin + {$ifdef ClearLogFileOnStartup} + DeleteEventLog; + {$endif} + InstallMemoryManager; + end; + {$ifdef UseReleaseStack} + {Release stack mechanism needs a cleanup thread} + CreateCleanupThread; + {$endif} + end; +{$endif} +end; + +initialization + RunInitializationCode; + +finalization +{$ifndef PatchBCBTerminate} + FinalizeMemoryManager; +{$endif} + +end. diff --git a/vendor/kam_remake/src/ext/FastMM4DataCollector.pas b/vendor/kam_remake/src/ext/FastMM4DataCollector.pas new file mode 100644 index 0000000..00f0611 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM4DataCollector.pas @@ -0,0 +1,401 @@ +unit FastMM4DataCollector; + +{$I FastMM4Options.inc} + +interface + +type + TStaticCollector = record + strict private const + CDefaultPromoteGen1_sec = 1; // promote every second + CDefaultPromoteGen1Count = 1; // promote allocations with Count > 1 + CGeneration1Size = 1024; + CGeneration2Size = 256; + CCollectedDataSize = CGeneration2Size; + CMaxPointers = 11; // same as in FastMM4 + public type + TPointers = record + Pointers: array [1..CMaxPointers] of pointer; + Count : integer; + class operator Equal(const a, b: TPointers): boolean; + end; + TDataInfo = record + Data : TPointers; + Count: integer; + end; + TCollectedData = array [1..CCollectedDataSize] of TDataInfo; + TGenerationOverflowCount = record + Generation1: integer; + Generation2: integer; + end; + strict private type + PDataInfo = ^TDataInfo; + TGenerationPlaceholder = array [1..1] of TDataInfo; + PGenerationPlaceholder = ^TGenerationPlaceholder; + TGenerationInfo = record + Data : PGenerationPlaceholder; + Size : integer; + Last : integer; + NextGeneration : integer; + PromoteEvery_sec: integer; + PromoteCountOver: integer; + OverflowCount : integer; + LastCheck_ms : int64; + end; + var + FGeneration1 : array [1..CGeneration1Size] of TDataInfo; + FGeneration2 : array [1..CGeneration2Size] of TDataInfo; + FGenerationInfo: array [0..2] of TGenerationInfo; //gen0 is used for merging + FLocked : boolean; + FPadding : array [1..3] of byte; + function GetGen1_PromoteCountOver: integer; + function GetGen1_PromoteEvery_sec: integer; + function GetOverflowCount: TGenerationOverflowCount; + procedure Lock; + function Now_ms: int64; inline; + procedure SetGen1_PromoteCountOver(const value: integer); + procedure SetGen1_PromoteEvery_sec(const value: integer); + private + procedure AddToGeneration(generation: integer; const aData: TPointers; + count: integer = 1); + procedure CheckPromoteGeneration(generation: integer); inline; + function FindInGeneration(generation: integer; const aData: TPointers): integer; inline; + function FindInsertionPoint(generation, count: integer): integer; inline; + procedure FlushAllGenerations; + function InsertIntoGeneration(generation: integer; const dataInfo: TDataInfo): boolean; + procedure PromoteGeneration(oldGen, newGen: integer); + procedure ResortGeneration(generation, idxData: integer); + public + procedure Initialize; + procedure Add(const pointers: pointer; count: integer); + procedure GetData(var data: TCollectedData; var count: integer); + procedure Merge(var mergedData: TCollectedData; var mergedCount: integer; + const newData: TCollectedData; newCount: integer); + property Gen1_PromoteCountOver: integer read GetGen1_PromoteCountOver + write SetGen1_PromoteCountOver; + property OverflowCount: TGenerationOverflowCount read GetOverflowCount; + property Gen1_PromoteEvery_sec: integer read GetGen1_PromoteEvery_sec write + SetGen1_PromoteEvery_sec; + end; + PStaticCollector = ^TStaticCollector; + +implementation + +uses + Winapi.Windows; //used in Now_ms + +{$RANGECHECKS OFF} + +// Copied from FastMM4.pas +function LockCmpxchg(CompareVal, NewVal: Byte; AAddress: PByte): Byte; +asm +{$if SizeOf(Pointer) = 4} + {On entry: + al = CompareVal, + dl = NewVal, + ecx = AAddress} + {$ifndef LINUX} + lock cmpxchg [ecx], dl + {$else} + {Workaround for Kylix compiler bug} + db $F0, $0F, $B0, $11 + {$endif} +{$else} + {On entry: + cl = CompareVal + dl = NewVal + r8 = AAddress} + .noframe + mov rax, rcx + lock cmpxchg [r8], dl +{$ifend} +end; + +{ TStaticCollector.TPointers } + +class operator TStaticCollector.TPointers.Equal(const a, b: TPointers): boolean; +var + i: integer; +begin + Result := a.Count = b.Count; + if Result then + for i := 1 to a.Count do + if a.Pointers[i] <> b.Pointers[i] then + Exit(false); +end; + +{ TStaticCollector } + +procedure TStaticCollector.Add(const pointers: pointer; count: integer); +var + ptrData: TPointers; +begin + Lock; + ptrData.Count := CMaxPointers; + if count < CMaxPointers then + ptrData.Count := count; + Move(pointers^, ptrData.Pointers[1], ptrData.Count * SizeOf(pointer)); + AddToGeneration(1, ptrData); + FLocked := false; +end; + +procedure TStaticCollector.AddToGeneration(generation: integer; const aData: TPointers; + count: integer = 1); +var + dataInfo: TDataInfo; + idxData : integer; +begin + CheckPromoteGeneration(generation); + + with FGenerationInfo[generation] do begin + idxData := FindInGeneration(generation, aData); + if idxData >= 1 then begin + Data^[idxData].Count := Data^[idxData].Count + count; + ResortGeneration(generation, idxData); + end + else begin + dataInfo.Data := aData; + dataInfo.Count := count; + InsertIntoGeneration(generation, dataInfo); + end; + end; +end; { TStaticCollector.AddToGeneration } + +procedure TStaticCollector.CheckPromoteGeneration(generation: integer); +begin + with FGenerationInfo[generation] do begin + if NextGeneration > 0 then begin + if LastCheck_ms = 0 then + LastCheck_ms := Now_ms + else if ((Now_ms - LastCheck_ms) div 1000) >= PromoteEvery_sec then begin + PromoteGeneration(generation, NextGeneration); + LastCheck_ms := Now_ms; + end; + end; + end; +end; + +function TStaticCollector.FindInGeneration(generation: integer; const aData: TPointers): + integer; +begin + with FGenerationInfo[generation] do begin + for Result := 1 to Last do + if Data^[Result].Data = aData then + Exit; + end; + Result := 0; +end; + +function TStaticCollector.FindInsertionPoint(generation, count: integer): integer; +var + insert: integer; +begin + with FGenerationInfo[generation] do begin + for insert := Last downto 1 do begin + if Data^[insert].Count > count then + Exit(insert+1); + end; + Result := 1; + end; +end; + +procedure TStaticCollector.FlushAllGenerations; +var + generation: integer; + nextGen : integer; +begin + generation := 1; + while generation <> 0 do begin + nextGen := FGenerationInfo[generation].NextGeneration; + if nextGen > 0 then + PromoteGeneration(generation, nextGen); + generation := nextGen; + end; +end; + +procedure TStaticCollector.GetData(var data: TCollectedData; var count: integer); +begin + Lock; + FlushAllGenerations; + Assert(Length(data) = Length(FGeneration2)); + count := FGenerationInfo[2].Last; + Move(FGeneration2[1], data[1], count * SizeOf(data[1])); + FLocked := false; +end; + +function TStaticCollector.GetGen1_PromoteCountOver: integer; +begin + Result := FGenerationInfo[1].PromoteCountOver; +end; + +function TStaticCollector.GetGen1_PromoteEvery_sec: integer; +begin + Result := FGenerationInfo[1].PromoteEvery_sec; +end; + +function TStaticCollector.GetOverflowCount: TGenerationOverflowCount; +begin + Result.Generation1 := FGenerationInfo[1].OverflowCount; + Result.Generation2 := FGenerationInfo[2].OverflowCount; +end; + +procedure TStaticCollector.Initialize; +begin + Assert(SizeOf(TStaticCollector) mod SizeOf(pointer) = 0); + with FGenerationInfo[1] do begin + Data := @FGeneration1; + Size := CGeneration1Size; + Last := 0; + NextGeneration := 2; + PromoteEvery_sec := CDefaultPromoteGen1_sec; + PromoteCountOver := CDefaultPromoteGen1Count; + LastCheck_ms := 0; + end; + with FGenerationInfo[2] do begin + Data := @FGeneration2; + Size := CGeneration2Size; + NextGeneration := 0; + end; +end; + +function TStaticCollector.InsertIntoGeneration(generation: integer; const dataInfo: + TDataInfo): boolean; +var + idx: integer; +begin + // We already know that this element does not exist in the generation. + + Result := true; + with FGenerationInfo[generation] do begin + idx := FindInsertionPoint(generation, dataInfo.Count); + if idx > Last then begin + if Last = Size then begin + Inc(OverflowCount); + Result := false; + end + else begin + Inc(Last); + Data^[Last] := dataInfo; + end; + end + else begin + if Last < Size then begin + Move(Data^[idx], Data^[idx+1], (Last-idx+1) * SizeOf(Data^[idx])); + Inc(Last); + end + else begin + if Last > idx then + Move(Data^[idx], Data^[idx+1], (Last-idx) * SizeOf(Data^[idx])); + Inc(OverflowCount); + end; + Data^[idx] := dataInfo; + end; + end; +end; + +procedure TStaticCollector.Lock; +begin +{$ifndef AssumeMultiThreaded} + if IsMultiThread then +{$endif} + begin + while LockCmpxchg(0, 1, @FLocked) <> 0 do + begin +{$ifdef NeverSleepOnThreadContention} + {$ifdef UseSwitchToThread} + SwitchToThread; + {$endif} +{$else} + Sleep(0); + if LockCmpxchg(0, 1, @FLocked) = 0 then + Break; + Sleep(1); +{$endif} + end; + end; +end; + +procedure TStaticCollector.Merge(var mergedData: TCollectedData; + var mergedCount: integer; const newData: TCollectedData; newCount: integer); +var + iNew: integer; +begin + // Merges two sorted arrays. + + FGenerationInfo[0].Data := @mergedData; + FGenerationInfo[0].Last := mergedCount; + FGenerationInfo[0].Size := CCollectedDataSize; + FGenerationInfo[0].NextGeneration := 0; + + for iNew := 1 to newCount do + AddToGeneration(0, newData[iNew].Data, newData[iNew].Count); + + mergedCount := FGenerationInfo[0].Last; +end; + +function TStaticCollector.Now_ms: int64; +var + st: TSystemTime; +begin + // We cannot use SysUtils as that gets memory allocator called before FastMM is initialized. + GetSystemTime(st); + SystemTimeToFileTime(st, TFileTime(Result)); + Result := Result div 10000; +end; + +procedure TStaticCollector.PromoteGeneration(oldGen, newGen: integer); +var + canInsert : boolean; + idxNew : integer; + idxOld : integer; + newGenData: PGenerationPlaceholder; + pOldData : PDataInfo; +begin + canInsert := true; + newGenData := FGenerationInfo[newGen].Data; + with FGenerationInfo[oldGen] do begin + for idxOld := 1 to Last do begin + pOldData := @Data^[idxOld]; + if pOldData^.Count <= PromoteCountOver then + break; //for idxOld + idxNew := FindInGeneration(newGen, pOldData^.Data); + if idxNew > 0 then begin + newGenData^[idxNew].Count := newGenData^[idxNew].Count + pOldData^.Count; + ResortGeneration(newGen, idxNew); + end + else if canInsert then + canInsert := InsertIntoGeneration(newGen, pOldData^) + else with FGenerationInfo[newGen] do + Inc(OverflowCount); + end; //for idxOld + Last := 0; + end; +end; + +procedure TStaticCollector.ResortGeneration(generation, idxData: integer); +var + dataInfo: TDataInfo; + idx : integer; +begin + // Data^[idxData].Count was just updated, resort the generation. + with FGenerationInfo[generation] do begin + idx := FindInsertionPoint(generation, Data^[idxData].Count); + if idx < idxData then begin + dataInfo := Data^[idxData]; + Move(Data^[idx], Data^[idx+1], (idxData-idx) * SizeOf(Data^[idx])); + Data^[idx] := dataInfo; + end; + end; +end; + +procedure TStaticCollector.SetGen1_PromoteCountOver(const value: integer); +begin + FGenerationInfo[1].PromoteCountOver := value; +end; + +procedure TStaticCollector.SetGen1_PromoteEvery_sec(const value: integer); +begin + FGenerationInfo[1].PromoteEvery_sec := value; +end; + +end. diff --git a/vendor/kam_remake/src/ext/FastMM4LockFreeStack.pas b/vendor/kam_remake/src/ext/FastMM4LockFreeStack.pas new file mode 100644 index 0000000..60d5395 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM4LockFreeStack.pas @@ -0,0 +1,352 @@ +// Based on TOmniBaseBoundedStack class from the OmniThreadLibrary, +// originally written by GJ and Primoz Gabrijelcic. + +unit FastMM4LockFreeStack; + +interface + +type + PReferencedPtr = ^TReferencedPtr; + TReferencedPtr = record + PData : pointer; + Reference: NativeInt; + end; + + PLinkedData = ^TLinkedData; + TLinkedData = packed record + Next: PLinkedData; + Data: record end; //user data, variable size + end; + + TLFStack = record + strict private + FDataBuffer : pointer; + FElementSize : integer; + FNumElements : integer; + FPublicChainP : PReferencedPtr; + FRecycleChainP: PReferencedPtr; + class var + class var obsIsInitialized: boolean; //default is false + class var obsTaskPopLoops : NativeInt; + class var obsTaskPushLoops: NativeInt; + class function PopLink(var chain: TReferencedPtr): PLinkedData; static; + class procedure PushLink(const link: PLinkedData; var chain: TReferencedPtr); static; + procedure MeasureExecutionTimes; + public + procedure Empty; + procedure Initialize(numElements, elementSize: integer); + procedure Finalize; + function IsEmpty: boolean; inline; + function IsFull: boolean; inline; + function Pop(var value): boolean; + function Push(const value): boolean; + property ElementSize: integer read FElementSize; + property NumElements: integer read FNumElements; + end; + +implementation + +uses + Windows; + +{$IF CompilerVersion < 23} +{$IFNDEF CPUX64} +type + NativeInt = integer; + NativeUInt = cardinal; +{$ENDIF} +{$IFEND} + +var + CASAlignment: integer; //required alignment for the CAS function - 8 or 16, depending on the platform + +function RoundUpTo(value: pointer; granularity: integer): pointer; +begin + Result := pointer((((NativeInt(value) - 1) div granularity) + 1) * granularity); +end; + +function GetCPUTimeStamp: int64; +asm + rdtsc +{$IFDEF CPUX64} + shl rdx, 32 + or rax, rdx +{$ENDIF CPUX64} +end; + +function GetThreadId: NativeInt; +//result := GetCurrentThreadId; +asm +{$IFNDEF CPUX64} + mov eax, fs:[$18] //eax := thread information block + mov eax, [eax + $24] //eax := thread id +{$ELSE CPUX64} + mov rax, gs:[abs $30] + mov eax, [rax + $48] +{$ENDIF CPUX64} +end; + +function CAS(const oldValue, newValue: NativeInt; var destination): boolean; overload; +asm +{$IFDEF CPUX64} + mov rax, oldValue +{$ENDIF CPUX64} + lock cmpxchg [destination], newValue + setz al +end; + +function CAS(const oldValue, newValue: pointer; var destination): boolean; overload; +asm +{$IFDEF CPUX64} + mov rax, oldValue +{$ENDIF CPUX64} + lock cmpxchg [destination], newValue + setz al +end; + +function CAS(const oldData: pointer; oldReference: NativeInt; newData: pointer; + newReference: NativeInt; var destination): boolean; overload; +asm +{$IFNDEF CPUX64} + push edi + push ebx + mov ebx, newData + mov ecx, newReference + mov edi, destination + lock cmpxchg8b qword ptr [edi] + pop ebx + pop edi +{$ELSE CPUX64} + .noframe + push rbx //rsp := rsp - 8 ! + mov rax, oldData + mov rbx, newData + mov rcx, newReference + mov r8, [destination + 8] //+8 with respect to .noframe + lock cmpxchg16b [r8] + pop rbx +{$ENDIF CPUX64} + setz al +end; + +{ TLFStack } + +procedure TLFStack.Empty; +var + linkedData: PLinkedData; +begin + repeat + linkedData := PopLink(FPublicChainP^); + if not assigned(linkedData) then + break; //repeat + PushLink(linkedData, FRecycleChainP^); + until false; +end; + +procedure TLFStack.Finalize; +begin + HeapFree(GetProcessHeap, 0, FDataBuffer); +end; + +procedure TLFStack.Initialize(numElements, elementSize: integer); +var + bufferElementSize : integer; + currElement : PLinkedData; + dataBuffer : pointer; + iElement : integer; + nextElement : PLinkedData; + roundedElementSize: integer; +begin + Assert(SizeOf(NativeInt) = SizeOf(pointer)); + Assert(numElements > 0); + Assert(elementSize > 0); + FNumElements := numElements; + FElementSize := elementSize; + //calculate element size, round up to next aligned value + roundedElementSize := (elementSize + SizeOf(pointer) - 1) AND NOT (SizeOf(pointer) - 1); + //calculate buffer element size, round up to next aligned value + bufferElementSize := ((SizeOf(TLinkedData) + roundedElementSize) + SizeOf(pointer) - 1) AND NOT (SizeOf(pointer) - 1); + //calculate DataBuffer + FDataBuffer := HeapAlloc(GetProcessHeap, HEAP_GENERATE_EXCEPTIONS, bufferElementSize * numElements + 2 * SizeOf(TReferencedPtr) + CASAlignment); + dataBuffer := RoundUpTo(FDataBuffer, CASAlignment); + if NativeInt(dataBuffer) AND (SizeOf(pointer) - 1) <> 0 then + // TODO 1 raise exception - how? + Halt; //raise Exception.Create('TOmniBaseContainer: obcBuffer is not aligned'); + FPublicChainP := dataBuffer; + inc(NativeInt(dataBuffer), SizeOf(TReferencedPtr)); + FRecycleChainP := dataBuffer; + inc(NativeInt(dataBuffer), SizeOf(TReferencedPtr)); + //Format buffer to recycleChain, init obsRecycleChain and obsPublicChain. + //At the beginning, all elements are linked into the recycle chain. + FRecycleChainP^.PData := dataBuffer; + currElement := FRecycleChainP^.PData; + for iElement := 0 to FNumElements - 2 do begin + nextElement := PLinkedData(NativeInt(currElement) + bufferElementSize); + currElement.Next := nextElement; + currElement := nextElement; + end; + currElement.Next := nil; // terminate the chain + FPublicChainP^.PData := nil; + MeasureExecutionTimes; +end; + +function TLFStack.IsEmpty: boolean; +begin + Result := not assigned(FPublicChainP^.PData); +end; + +function TLFStack.IsFull: boolean; +begin + Result := not assigned(FRecycleChainP^.PData); +end; + +procedure TLFStack.MeasureExecutionTimes; +const + NumOfSamples = 10; +var + TimeTestField: array [0..1] of array [1..NumOfSamples] of int64; + + function GetMinAndClear(routine, count: cardinal): int64; + var + m: cardinal; + n: integer; + x: integer; + begin + Result := 0; + for m := 1 to count do begin + x:= 1; + for n:= 2 to NumOfSamples do + if TimeTestField[routine, n] < TimeTestField[routine, x] then + x := n; + Inc(Result, TimeTestField[routine, x]); + TimeTestField[routine, x] := MaxLongInt; + end; + end; + +var + oldAffinity: NativeUInt; + currElement: PLinkedData; + n : integer; + +begin + if not obsIsInitialized then begin + oldAffinity := SetThreadAffinityMask(GetCurrentThread, 1); + try + //Calculate TaskPopDelay and TaskPushDelay counter values depend on CPU speed!!!} + obsTaskPopLoops := 1; + obsTaskPushLoops := 1; + for n := 1 to NumOfSamples do begin + SwitchToThread; + //Measure RemoveLink rutine delay + TimeTestField[0, n] := GetCPUTimeStamp; + currElement := PopLink(FRecycleChainP^); + TimeTestField[0, n] := GetCPUTimeStamp - TimeTestField[0, n]; + //Measure InsertLink rutine delay + TimeTestField[1, n] := GetCPUTimeStamp; + PushLink(currElement, FRecycleChainP^); + TimeTestField[1, n] := GetCPUTimeStamp - TimeTestField[1, n]; + end; + //Calculate first 4 minimum average for RemoveLink rutine + obsTaskPopLoops := GetMinAndClear(0, 4) div 4; + //Calculate first 4 minimum average for InsertLink rutine + obsTaskPushLoops := GetMinAndClear(1, 4) div 4; + + //This gives better performance (determined experimentally) + obsTaskPopLoops := obsTaskPopLoops * 2; + obsTaskPushLoops := obsTaskPushLoops * 2; + + obsIsInitialized := true; + finally SetThreadAffinityMask(GetCurrentThread, oldAffinity); end; + end; +end; + +function TLFStack.Pop(var value): boolean; +var + linkedData: PLinkedData; +begin + linkedData := PopLink(FPublicChainP^); + Result := assigned(linkedData); + if not Result then + Exit; + Move(linkedData.Data, value, ElementSize); + PushLink(linkedData, FRecycleChainP^); +end; + +class function TLFStack.PopLink(var chain: TReferencedPtr): PLinkedData; +//nil << Link.Next << Link.Next << ... << Link.Next +// ^------ < chainHead +var + AtStartReference: NativeInt; + CurrentReference: NativeInt; + TaskCounter : NativeInt; + ThreadReference : NativeInt; +label + TryAgain; +begin + ThreadReference := GetThreadId + 1; //Reference.bit0 := 1 + with chain do begin +TryAgain: + TaskCounter := obsTaskPopLoops; + AtStartReference := Reference OR 1; //Reference.bit0 := 1 + repeat + CurrentReference := Reference; + Dec(TaskCounter); + until (TaskCounter = 0) or (CurrentReference AND 1 = 0); + if (CurrentReference AND 1 <> 0) and (AtStartReference <> CurrentReference) or + not CAS(CurrentReference, ThreadReference, Reference) + then + goto TryAgain; + //Reference is set... + Result := PData; + //Empty test + if result = nil then + CAS(ThreadReference, 0, Reference) //Clear Reference if task own reference + else if not CAS(Result, ThreadReference, Result.Next, 0, chain) then + goto TryAgain; + end; //with chain +end; + +function TLFStack.Push(const value): boolean; +var + linkedData: PLinkedData; +begin + linkedData := PopLink(FRecycleChainP^); + Result := assigned(linkedData); + if not Result then + Exit; + Move(value, linkedData.Data, ElementSize); + PushLink(linkedData, FPublicChainP^); +end; + +class procedure TLFStack.PushLink(const link: PLinkedData; var chain: TReferencedPtr); +var + PMemData : pointer; + TaskCounter: NativeInt; +begin + with chain do begin + for TaskCounter := 0 to obsTaskPushLoops do + if (Reference AND 1 = 0) then + break; + repeat + PMemData := PData; + link.Next := PMemData; + until CAS(PMemData, link, PData); + end; +end; + +procedure InitializeTimingInfo; +var + stack: TLFStack; +begin + stack.Initialize(10, 4); // enough for initialization + stack.Finalize; +end; + +initialization + {$IFDEF CPUX64} + CASAlignment := 16; + {$ELSE} + CASAlignment := 8; + {$ENDIF CPUX64} + InitializeTimingInfo; +end. diff --git a/vendor/kam_remake/src/ext/FastMM4Messages.pas b/vendor/kam_remake/src/ext/FastMM4Messages.pas new file mode 100644 index 0000000..8df7cf9 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM4Messages.pas @@ -0,0 +1,158 @@ +{ + +Fast Memory Manager: Messages + +English translation by Pierre le Riche. + +} + +unit FastMM4Messages; + +interface + +{$Include FastMM4Options.inc} + +const + {The name of the debug info support DLL} + {$IFDEF MACOS} + FullDebugModeLibraryName32Bit = 'libFastMM_FullDebugMode.dylib'; + {$ELSE} + FullDebugModeLibraryName32Bit = 'FastMM_FullDebugMode.dll'; + {$ENDIF} + FullDebugModeLibraryName64Bit = 'FastMM_FullDebugMode64.dll'; + {Event log strings} + LogFileExtension = '_MemoryManager_EventLog.txt'#0; + CRLF = #13#10; + EventSeparator = '--------------------------------'; + {Class name messages} + UnknownClassNameMsg = 'Unknown'; + {Memory dump message} + MemoryDumpMsg = #13#10#13#10'Current memory dump of 256 bytes starting at pointer address '; + {Block Error Messages} + BlockScanLogHeader = 'Allocated block logged by LogAllocatedBlocksToFile. The size is: '; + ErrorMsgHeader = 'FastMM has detected an error during a '; + GetMemMsg = 'GetMem'; + FreeMemMsg = 'FreeMem'; + ReallocMemMsg = 'ReallocMem'; + BlockCheckMsg = 'free block scan'; + OperationMsg = ' operation. '; + BlockHeaderCorruptedMsg = 'The block header has been corrupted. '; + BlockFooterCorruptedMsg = 'The block footer has been corrupted. '; + FreeModifiedErrorMsg = 'FastMM detected that a block has been modified after being freed. '; + FreeModifiedDetailMsg = #13#10#13#10'Modified byte offsets (and lengths): '; + DoubleFreeErrorMsg = 'An attempt has been made to free/reallocate an unallocated block.'; + WrongMMFreeErrorMsg = 'An attempt has been made to free/reallocate a block that was allocated through a different FastMM instance. Check your memory manager sharing settings.'; + PreviousBlockSizeMsg = #13#10#13#10'The previous block size was: '; + CurrentBlockSizeMsg = #13#10#13#10'The block size is: '; + PreviousObjectClassMsg = #13#10#13#10'The block was previously used for an object of class: '; + CurrentObjectClassMsg = #13#10#13#10'The block is currently used for an object of class: '; + PreviousAllocationGroupMsg = #13#10#13#10'The allocation group was: '; + PreviousAllocationNumberMsg = #13#10#13#10'The allocation number was: '; + CurrentAllocationGroupMsg = #13#10#13#10'The allocation group is: '; + CurrentAllocationNumberMsg = #13#10#13#10'The allocation number is: '; + BlockErrorMsgTitle = 'Memory Error Detected'; + VirtualMethodErrorHeader = 'FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.'; + InterfaceErrorHeader = 'FastMM has detected an attempt to use an interface of a freed object. An access violation will now be raised in order to abort the current operation.'; + BlockHeaderCorruptedNoHistoryMsg = ' Unfortunately the block header has been corrupted so no history is available.'; + FreedObjectClassMsg = #13#10#13#10'Freed object class: '; + VirtualMethodName = #13#10#13#10'Virtual method: '; + VirtualMethodOffset = 'Offset +'; + VirtualMethodAddress = #13#10#13#10'Virtual method address: '; + {Stack trace messages} + CurrentThreadIDMsg = #13#10#13#10'The current thread ID is 0x'; + CurrentStackTraceMsg = ', and the stack trace (return addresses) leading to this error is:'; + ThreadIDPrevAllocMsg = #13#10#13#10'This block was previously allocated by thread 0x'; + ThreadIDAtAllocMsg = #13#10#13#10'This block was allocated by thread 0x'; + ThreadIDAtFreeMsg = #13#10#13#10'The block was previously freed by thread 0x'; + ThreadIDAtObjectAllocMsg = #13#10#13#10'The object was allocated by thread 0x'; + ThreadIDAtObjectFreeMsg = #13#10#13#10'The object was subsequently freed by thread 0x'; + StackTraceMsg = ', and the stack trace (return addresses) at the time was:'; + {Installation Messages} + AlreadyInstalledMsg = 'FastMM4 is already installed.'; + AlreadyInstalledTitle = 'Already installed.'; + OtherMMInstalledMsg = 'FastMM4 cannot be installed since another third party memory ' + + 'manager has already installed itself.'#13#10'If you want to use FastMM4, ' + + 'please make sure that FastMM4.pas is the very first unit in the "uses"' + + #13#10'section of your project''s .dpr file.'; + OtherMMInstalledTitle = 'Cannot install FastMM4 - Another memory manager is already installed'; + MemoryAllocatedMsg = 'FastMM4 cannot install since memory has already been ' + + 'allocated through the default memory manager.'#13#10'FastMM4.pas MUST ' + + 'be the first unit in your project''s .dpr file, otherwise memory may ' + + 'be allocated'#13#10'through the default memory manager before FastMM4 ' + + 'gains control. '#13#10#13#10'If you are using an exception trapper ' + + 'like MadExcept (or any tool that modifies the unit initialization ' + + 'order),'#13#10'go into its configuration page and ensure that the ' + + 'FastMM4.pas unit is initialized before any other unit.'; + MemoryAllocatedTitle = 'Cannot install FastMM4 - Memory has already been allocated'; + {Leak checking messages} + LeakLogHeader = 'A memory block has been leaked. The size is: '; + LeakMessageHeader = 'This application has leaked memory. '; + SmallLeakDetail = 'The small block leaks are' +{$ifdef HideExpectedLeaksRegisteredByPointer} + + ' (excluding expected leaks registered by pointer)' +{$endif} + + ':'#13#10; + LargeLeakDetail = 'The sizes of leaked medium and large blocks are' +{$ifdef HideExpectedLeaksRegisteredByPointer} + + ' (excluding expected leaks registered by pointer)' +{$endif} + + ': '; + BytesMessage = ' bytes: '; + AnsiStringBlockMessage = 'AnsiString'; + UnicodeStringBlockMessage = 'UnicodeString'; + LeakMessageFooter = #13#10 +{$ifndef HideMemoryLeakHintMessage} + + #13#10'Note: ' + {$ifdef RequireIDEPresenceForLeakReporting} + + 'This memory leak check is only performed if Delphi is currently running on the same computer. ' + {$endif} + {$ifdef FullDebugMode} + {$ifdef LogMemoryLeakDetailToFile} + + 'Memory leak detail is logged to a text file in the same folder as this application. ' + {$else} + + 'Enable the "LogMemoryLeakDetailToFile" to obtain a log file containing detail on memory leaks. ' + {$endif} + {$else} + + 'To obtain a log file containing detail on memory leaks, enable the "FullDebugMode" and "LogMemoryLeakDetailToFile" conditional defines. ' + {$endif} + + 'To disable this memory leak check, undefine "EnableMemoryLeakReporting".'#13#10 +{$endif} + + #0; + LeakMessageTitle = 'Memory Leak Detected'; +{$ifdef UseOutputDebugString} + FastMMInstallMsg = 'FastMM has been installed.'; + FastMMInstallSharedMsg = 'Sharing an existing instance of FastMM.'; + FastMMUninstallMsg = 'FastMM has been uninstalled.'; + FastMMUninstallSharedMsg = 'Stopped sharing an existing instance of FastMM.'; +{$endif} +{$ifdef DetectMMOperationsAfterUninstall} + InvalidOperationTitle = 'MM Operation after uninstall.'; + InvalidGetMemMsg = 'FastMM has detected a GetMem call after FastMM was uninstalled.'; + InvalidFreeMemMsg = 'FastMM has detected a FreeMem call after FastMM was uninstalled.'; + InvalidReallocMemMsg = 'FastMM has detected a ReallocMem call after FastMM was uninstalled.'; + InvalidAllocMemMsg = 'FastMM has detected an AllocMem call after FastMM was uninstalled.'; +{$endif} + +{$ifdef LogLockContention} + LockingReportTitle = 'Locking Report'; + LockingReportHeader = 'Top locking contention sites'; +{$endif} + +{$ifdef UseReleaseStack} +{$ifdef DebugReleaseStack} + ReleaseStackUsageHeader = 'Release stack usage statistics'; + ReleaseStackUsageSmallBlocksMsg1 = 'Small blocks ['; + ReleaseStackUsageSmallBlocksMsg2 = ']: '; + ReleaseStackUsageTotalSmallBlocksMsg = 'Total small blocks: '; + ReleaseStackUsageMediumBlocksMsg = 'Medium blocks: '; + ReleaseStackUsageLargeBlocksMsg = 'Large blocks: '; + ReleaseStackUsageTotalMemoryMsg = 'Total memory: '; + ReleaseStackUsageBuffers1Msg = ' in '; + ReleaseStackUsageBuffers2Msg = ' buffers ['; +{$endif} +{$endif} + +implementation + +end. + diff --git a/vendor/kam_remake/src/ext/FastMM4Options.inc b/vendor/kam_remake/src/ext/FastMM4Options.inc new file mode 100644 index 0000000..f12e4c1 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM4Options.inc @@ -0,0 +1,438 @@ +{ + +Fast Memory Manager: Options Include File + +Set the default options for FastMM here. + +} + +{---------------------------Miscellaneous Options-----------------------------} + +{Enable this define to align all blocks on 16 byte boundaries so aligned SSE + instructions can be used safely. If this option is disabled then some of the + smallest block sizes will be 8-byte aligned instead which may result in a + reduction in memory usage. Medium and large blocks are always 16-byte aligned + irrespective of this setting.} +{.$define Align16Bytes} + +{Enable to use faster fixed-size move routines when upsizing small blocks. + These routines are much faster than the Borland RTL move procedure since they + are optimized to move a fixed number of bytes. This option may be used + together with the FastMove library for even better performance.} +{$define UseCustomFixedSizeMoveRoutines} + +{Enable this option to use an optimized procedure for moving a memory block of + an arbitrary size. Disable this option when using the Fastcode move + ("FastMove") library. Using the Fastcode move library allows your whole + application to gain from faster move routines, not just the memory manager. It + is thus recommended that you use the Fastcode move library in conjunction with + this memory manager and disable this option.} +{$define UseCustomVariableSizeMoveRoutines} + +{Enable this option to only install FastMM as the memory manager when the + application is running inside the Delphi IDE. This is useful when you want + to deploy the same EXE that you use for testing, but only want the debugging + features active on development machines. When this option is enabled and + the application is not being run inside the IDE debugger, then the default + Delphi memory manager will be used (which, since Delphi 2006, is FastMM + without FullDebugMode.} +{.$define InstallOnlyIfRunningInIDE} + +{Due to QC#14070 ("Delphi IDE attempts to free memory after the shutdown code + of borlndmm.dll has been called"), FastMM cannot be uninstalled safely when + used inside a replacement borlndmm.dll for the IDE. Setting this option will + circumvent this problem by never uninstalling the memory manager.} +{.$define NeverUninstall} + +{Set this option when you use runtime packages in this application or library. + This will automatically set the "AssumeMultiThreaded" option. Note that you + have to ensure that FastMM is finalized after all live pointers have been + freed - failure to do so will result in a large leak report followed by a lot + of A/Vs. (See the FAQ for more detail.) You may have to combine this option + with the NeverUninstall option.} +{.$define UseRuntimePackages} + +{-----------------------Concurrency Management Options------------------------} + +{Enable to always assume that the application is multithreaded. Enabling this + option will cause a significant performance hit with single threaded + applications. Enable if you are using multi-threaded third party tools that do + not properly set the IsMultiThread variable. Also set this option if you are + going to share this memory manager between a single threaded application and a + multi-threaded DLL.} +{.$define AssumeMultiThreaded} + +{Enable this option to not call Sleep when a thread contention occurs. This + option will improve performance if the ratio of the number of active threads + to the number of CPU cores is low (typically < 2). With this option set a + thread will usually enter a "busy waiting" loop instead of relinquishing its + timeslice when a thread contention occurs, unless UseSwitchToThread is + also defined (see below) in which case it will call SwitchToThread instead of + Sleep.} +{.$define NeverSleepOnThreadContention} + + {Set this option to call SwitchToThread instead of sitting in a "busy waiting" + loop when a thread contention occurs. This is used in conjunction with the + NeverSleepOnThreadContention option, and has no effect unless + NeverSleepOnThreadContention is also defined. This option may improve + performance with many CPU cores and/or threads of different priorities. Note + that the SwitchToThread API call is only available on Windows 2000 and later.} + {.$define UseSwitchToThread} + +{-----------------------------Debugging Options-------------------------------} + +{Enable this option to suppress the generation of debug info for the + FastMM4.pas unit. This will prevent the integrated debugger from stepping into + the memory manager code.} +{.$define NoDebugInfo} + +{Enable this option to suppress the display of all message dialogs. This is + useful in service applications that should not be interrupted.} +{.$define NoMessageBoxes} + +{Set this option to use the Windows API OutputDebugString procedure to output + debug strings on startup/shutdown and when errors occur.} +{.$define UseOutputDebugString} + +{Set this option to use the assembly language version which is faster than the + pascal version. Disable only for debugging purposes. Setting the + CheckHeapForCorruption option automatically disables this option.} +{$define ASMVersion} + +{FastMM always catches attempts to free the same memory block twice, however it + can also check for corruption of the memory heap (typically due to the user + program overwriting the bounds of allocated memory). These checks are + expensive, and this option should thus only be used for debugging purposes. + If this option is set then the ASMVersion option is automatically disabled.} +{$define CheckHeapForCorruption} + +{Enable this option to catch attempts to perform MM operations after FastMM has + been uninstalled. With this option set when FastMM is uninstalled it will not + install the previous MM, but instead a dummy MM handler that throws an error + if any MM operation is attempted. This will catch attempts to use the MM + after FastMM has been uninstalled.} +{$define DetectMMOperationsAfterUninstall} + +{Set the following option to do extensive checking of all memory blocks. All + blocks are padded with both a header and trailer that are used to verify the + integrity of the heap. Freed blocks are also cleared to to ensure that they + cannot be reused after being freed. This option slows down memory operations + dramatically and should only be used to debug an application that is + overwriting memory or reusing freed pointers. Setting this option + automatically enables CheckHeapForCorruption and disables ASMVersion. + Very important: If you enable this option your application will require the + FastMM_FullDebugMode.dll library. If this library is not available you will + get an error on startup.} +{$define FullDebugMode} + + {Set this option to perform "raw" stack traces, i.e. check all entries on the + stack for valid return addresses. Note that this is significantly slower + than using the stack frame tracing method, but is usually more complete. Has + no effect unless FullDebugMode is enabled} + {$define RawStackTraces} + + {Set this option to check for user code that uses an interface of a freed + object. Note that this will disable the checking of blocks modified after + being freed (the two are not compatible). This option has no effect if + FullDebugMode is not also enabled.} + {.$define CatchUseOfFreedInterfaces} + + {Set this option to log all errors to a text file in the same folder as the + application. Memory errors (with the FullDebugMode option set) will be + appended to the log file. Has no effect if "FullDebugMode" is not set.} + {$define LogErrorsToFile} + + {Set this option to log all memory leaks to a text file in the same folder as + the application. Memory leak reports (with the FullDebugMode option set) + will be appended to the log file. Has no effect if "LogErrorsToFile" and + "FullDebugMode" are not also set. Note that usually all leaks are always + logged, even if they are "expected" leaks registered through + AddExpectedMemoryLeaks. Expected leaks registered by pointer may be excluded + through the HideExpectedLeaksRegisteredByPointer option.} + {$define LogMemoryLeakDetailToFile} + + {Deletes the error log file on startup. No effect if LogErrorsToFile is not + also set.} + {$define ClearLogFileOnStartup} + + {Loads the FASTMM_FullDebugMode.dll dynamically. If the DLL cannot be found + then stack traces will not be available. Note that this may cause problems + due to a changed DLL unload order when sharing the memory manager. Use with + care.} + {.$define LoadDebugDLLDynamically} + + {.$define DoNotInstallIfDLLMissing} + {If the FastMM_FullDebugMode.dll file is not available then FastMM will not + install itself. No effect unless FullDebugMode and LoadDebugDLLDynamically + are also defined.} + + {FastMM usually allocates large blocks from the topmost available address and + medium and small blocks from the lowest available address (This reduces + fragmentation somewhat). With this option set all blocks are always + allocated from the highest available address. If the process has a >2GB + address space and contains bad pointer arithmetic code, this option should + help to catch those errors sooner.} + {$define AlwaysAllocateTopDown} + + {Disables the logging of memory dumps together with the other detail for + memory errors.} + {.$define DisableLoggingOfMemoryDumps} + + {If FastMM encounters a problem with a memory block inside the FullDebugMode + FreeMem handler then an "invalid pointer operation" exception will usually + be raised. If the FreeMem occurs while another exception is being handled + (perhaps in the try.. finally code) then the original exception will be + lost. With this option set FastMM will ignore errors inside FreeMem when an + exception is being handled, thus allowing the original exception to + propagate.} + {$define SuppressFreeMemErrorsInsideException} + + {Adds support for notification of memory manager events in FullDebugMode. + With this define set, the application may assign the OnDebugGetMemFinish, + OnDebugFreeMemStart, etc. callbacks in order to be notified when the + particular memory manager event occurs.} + {.$define FullDebugModeCallBacks} + +{---------------------------Memory Leak Reporting-----------------------------} + +{Set this option to enable reporting of memory leaks. Combine it with the two + options below for further fine-tuning.} +{$define EnableMemoryLeakReporting} + + {Set this option to suppress the display and logging of expected memory leaks + that were registered by pointer. Leaks registered by size or class are often + ambiguous, so these expected leaks are always logged to file (in + FullDebugMode with the LogMemoryLeakDetailToFile option set) and are never + hidden from the leak display if there are more leaks than are expected.} + {$define HideExpectedLeaksRegisteredByPointer} + + {Set this option to require the presence of the Delphi IDE to report memory + leaks. This option has no effect if the option "EnableMemoryLeakReporting" + is not also set.} + {.$define RequireIDEPresenceForLeakReporting} + + {Set this option to require the program to be run inside the IDE debugger to + report memory leaks. This option has no effect if the option + "EnableMemoryLeakReporting" is not also set. Note that this option does not + work with libraries, only EXE projects.} + {$define RequireDebuggerPresenceForLeakReporting} + + {Set this option to require the presence of debug info ($D+ option) in the + compiled unit to perform memory leak checking. This option has no effect if + the option "EnableMemoryLeakReporting" is not also set.} + {.$define RequireDebugInfoForLeakReporting} + + {Set this option to enable manual control of the memory leak report. When + this option is set the ReportMemoryLeaksOnShutdown variable (default = false) + may be changed to select whether leak reporting should be done or not. When + this option is selected then both the variable must be set to true and the + other leak checking options must be applicable for the leak checking to be + done.} + {.$define ManualLeakReportingControl} + + {Set this option to disable the display of the hint below the memory leak + message.} + {.$define HideMemoryLeakHintMessage} + +{--------------------------Instruction Set Options----------------------------} + +{Set this option to enable the use of MMX instructions. Disabling this option + will result in a slight performance hit, but will enable compatibility with + AMD K5, Pentium I and earlier CPUs. MMX is currently only used in the variable + size move routines, so if UseCustomVariableSizeMoveRoutines is not set then + this option has no effect.} +{.$define EnableMMX} + + {Set this option to force the use of MMX instructions without checking + whether the CPU supports it. If this option is disabled then the CPU will be + checked for compatibility first, and if MMX is not supported it will fall + back to the FPU move code. Has no effect unless EnableMMX is also set.} + {$define ForceMMX} + +{-----------------------Memory Manager Sharing Options------------------------} + +{Allow sharing of the memory manager between a main application and DLLs that + were also compiled with FastMM. This allows you to pass dynamic arrays and + long strings to DLL functions provided both are compiled to use FastMM. + Sharing will only work if the library that is supposed to share the memory + manager was compiled with the "AttemptToUseSharedMM" option set. Note that if + the main application is single threaded and the DLL is multi-threaded that you + have to set the IsMultiThread variable in the main application to true or it + will crash when a thread contention occurs. Note that statically linked DLL + files are initialized before the main application, so the main application may + well end up sharing a statically loaded DLL's memory manager and not the other + way around. } +{.$define ShareMM} + + {Allow sharing of the memory manager by a DLL with other DLLs (or the main + application if this is a statically loaded DLL) that were also compiled with + FastMM. Set this option with care in dynamically loaded DLLs, because if the + DLL that is sharing its MM is unloaded and any other DLL is still sharing + the MM then the application will crash. This setting is only relevant for + DLL libraries and requires ShareMM to also be set to have any effect. + Sharing will only work if the library that is supposed to share the memory + manager was compiled with the "AttemptToUseSharedMM" option set. Note that + if DLLs are statically linked then they will be initialized before the main + application and then the DLL will in fact share its MM with the main + application. This option has no effect unless ShareMM is also set.} + {.$define ShareMMIfLibrary} + +{Define this to attempt to share the MM of the main application or other loaded + DLLs in the same process that were compiled with ShareMM set. When sharing a + memory manager, memory leaks caused by the sharer will not be freed + automatically. Take into account that statically linked DLLs are initialized + before the main application, so set the sharing options accordingly.} +{.$define AttemptToUseSharedMM} + +{Define this to enable backward compatibility for the memory manager sharing + mechanism used by Delphi 2006 and 2007, as well as older FastMM versions.} +{$define EnableBackwardCompatibleMMSharing} + +{-----------------------Security Options------------------------} + +{Windows clears physical memory before reusing it in another process. However, + it is not known how quickly this clearing is performed, so it is conceivable + that confidential data may linger in physical memory longer than absolutely + necessary. If you're paranoid about this kind of thing, enable this option to + clear all freed memory before returning it to the operating system. Note that + this incurs a noticeable performance hit.} +{.$define ClearMemoryBeforeReturningToOS} + +{With this option enabled freed memory will immediately be cleared inside the + FreeMem routine. This incurs a big performance hit, but may be worthwhile for + additional peace of mind when working with highly sensitive data. This option + supersedes the ClearMemoryBeforeReturningToOS option.} +{.$define AlwaysClearFreedMemory} + +{----------------------------Lock Contention Logging--------------------------} + +{Define this to lock stack traces for all occasions where GetMem/FreeMem + go to sleep because of lock contention (IOW, when memory manager is already + locked by another thread). At the end of the program execution top 10 sites + (locations with highest occurrence) will be logged to the _MemoryManager_EventLog.txt + file. + This options works with FullDebugMode or without it, but requires + FastMM_FullDebugMode.dll to be present in both cases. +} +{.$define LogLockContention} + +{--------------------------------Option Grouping------------------------------} + +{Enabling this option enables FullDebugMode, InstallOnlyIfRunningInIDE and + LoadDebugDLLDynamically. Consequently, FastMM will install itself in + FullDebugMode if the application is being debugged inside the Delphi IDE. + Otherwise the default Delphi memory manager will be used (which is equivalent + to the non-FullDebugMode FastMM since Delphi 2006.)} +{.$define FullDebugModeInIDE} + +{Combines the FullDebugMode, LoadDebugDLLDynamically and + DoNotInstallIfDLLMissing options. Consequently FastMM will only be installed + (In FullDebugMode) when the FastMM_FullDebugMode.dll file is available. This + is useful when the same executable will be distributed for both debugging as + well as deployment.} +{.$define FullDebugModeWhenDLLAvailable} + +{Group the options you use for release and debug versions below} +{$ifdef Release} + {Specify the options you use for release versions below} + {.$undef FullDebugMode} + {.$undef CheckHeapForCorruption} + {.$define ASMVersion} + {.$undef EnableMemoryLeakReporting} + {.$undef UseOutputDebugString} +{$else} + {Specify the options you use for debugging below} + {.$define FullDebugMode} + {.$define EnableMemoryLeakReporting} + {.$define UseOutputDebugString} +{$endif} + +{--------------------Compilation Options For borlndmm.dll---------------------} +{If you're compiling the replacement borlndmm.dll, set the defines below + for the kind of dll you require.} + +{Set this option when compiling the borlndmm.dll} +{.$define borlndmmdll} + +{Set this option if the dll will be used by the Delphi IDE} +{.$define dllforide} + +{Set this option if you're compiling a debug dll} +{.$define debugdll} + +{Do not change anything below this line} +{$ifdef borlndmmdll} + {$define AssumeMultiThreaded} + {$undef HideExpectedLeaksRegisteredByPointer} + {$undef RequireDebuggerPresenceForLeakReporting} + {$undef RequireDebugInfoForLeakReporting} + {$define DetectMMOperationsAfterUninstall} + {$undef ManualLeakReportingControl} + {$undef ShareMM} + {$undef AttemptToUseSharedMM} + {$ifdef dllforide} + {$define NeverUninstall} + {$define HideMemoryLeakHintMessage} + {$undef RequireIDEPresenceForLeakReporting} + {$ifndef debugdll} + {$undef EnableMemoryLeakReporting} + {$endif} + {$else} + {$define EnableMemoryLeakReporting} + {$undef NeverUninstall} + {$undef HideMemoryLeakHintMessage} + {$define RequireIDEPresenceForLeakReporting} + {$endif} + {$ifdef debugdll} + {$define FullDebugMode} + {$define RawStackTraces} + {$undef CatchUseOfFreedInterfaces} + {$define LogErrorsToFile} + {$define LogMemoryLeakDetailToFile} + {$undef ClearLogFileOnStartup} + {$else} + {$undef FullDebugMode} + {$endif} +{$endif} + +{Move BCB related definitions here, because CB2006/CB2007 can build borlndmm.dll + for tracing memory leaks in BCB applications with "Build with Dynamic RTL" + switched on} +{------------------------------Patch BCB Terminate----------------------------} +{To enable the patching for BCB to make uninstallation and leak reporting + possible, you may need to add "BCB" definition + in "Project Options->Pascal/Delphi Compiler->Defines". + (Thanks to JiYuan Xie for implementing this.)} + +{$ifdef BCB} + {$ifdef CheckHeapForCorruption} + {$define PatchBCBTerminate} + {$else} + {$ifdef DetectMMOperationsAfterUninstall} + {$define PatchBCBTerminate} + {$else} + {$ifdef EnableMemoryLeakReporting} + {$define PatchBCBTerminate} + {$endif} + {$endif} + {$endif} + + {$ifdef PatchBCBTerminate} + {$define CheckCppObjectType} + {$undef CheckCppObjectTypeEnabled} + + {$ifdef CheckCppObjectType} + {$define CheckCppObjectTypeEnabled} + {$endif} + + {Turn off "CheckCppObjectTypeEnabled" option if neither "CheckHeapForCorruption" + option or "EnableMemoryLeakReporting" option were defined.} + {$ifdef CheckHeapForCorruption} + {$else} + {$ifdef EnableMemoryLeakReporting} + {$else} + {$undef CheckCppObjectTypeEnabled} + {$endif} + {$endif} + {$endif} +{$endif} diff --git a/vendor/kam_remake/src/ext/FastMM5.pas b/vendor/kam_remake/src/ext/FastMM5.pas new file mode 100644 index 0000000..1acf609 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMM5.pas @@ -0,0 +1,10355 @@ +{ + +FastMM 5.04 + +Description: + A fast replacement memory manager for Embarcadero Delphi applications that scales well across multiple threads and CPU + cores, is not prone to memory fragmentation, and supports shared memory without the use of external .DLL files. + +Developed by: + Pierre le Riche, copyright 2004 - 2021, all rights reserved + +Sponsored by: + gs-soft AG + +Homepage: + https://github.com/pleriche/FastMM5 + +Licence: + FastMM 5 is dual-licensed. You may choose to use it under the restrictions of the GPL v3 licence at no cost to you, + or you may purchase a commercial licence. A commercial licence grants you the right to use FastMM5 in your own + applications, royalty free, and without any requirement to disclose your source code nor any modifications to FastMM + to any other party. A commercial licence lasts into perpetuity, and entitles you to all future updates, free of + charge. A commercial licence is sold per developer developing applications that use FastMM, as follows: + 1 developer = $99 + 2 developers = $189 + 3 developers = $269 + 4 developers = $339 + 5 developers = $399 + >5 developers = $399 + $50 per developer from the 6th onwards + site licence = $999 (unlimited number of developers affiliated with the owner of the licence, i.e. employees, + co-workers, interns and contractors) + + Please send an e-mail to fastmm@leriche.org to request an invoice before or after payment is made. Payment may be + made via PayPal at https://www.paypal.me/fastmm (paypal@leriche.org), or via bank transfer. Bank details will be + provided on the invoice. + + Support (via e-mail) is available for users with a commercial licence. Enhancement requests submitted by users with a + commercial licence will be prioritized. + +Usage Instructions: + Add FastMM5.pas as the first unit in your project's DPR file. It will install itself automatically during startup, + replacing the default memory manager. + + In order to share the memory manager between the main application and libraries call + FastMM_AttemptToUseSharedMemoryManager (in order to use the memory manager of another module in the process) or + FastMM_ShareMemoryManager (to share the memory manager instance of the current module with other modules). It is + important to share the memory manager between modules where memory allocated in the one module may be freed by the + other. + + If the application requires memory alignment greater than the default, call FastMM_EnterMinimumAddressAlignment and + once the greater alignment is no longer required call FastMM_ExitMinimumAddressAlignment. Calls may be nested. The + coarsest memory alignment requested takes precedence. + + At the cost of performance and increased memory usage FastMM can log additional metadata together with every block. + In order to enable this mode call FastMM_EnterDebugMode and to exit debug mode call FastMM_ExitDebugMode. Calls may + be nested in which case debug mode will be active as long as the number of FastMM_EnterDebugMode calls exceed the + number of FastMM_ExitDebugMode calls. In debug mode freed memory blocks will be filled with the byte pattern + $808080... so that usage of a freed memory block or object, as well as corruption of the block header and/or footer + will likely be detected. If the debug support library, FastMM_FullDebugMode.dll, is available and the application has + not specified its own handlers for FastMM_GetStackTrace and FastMM_ConvertStackTraceToText then the support library + will be loaded during the first call to FastMM_EnterDebugMode. + + Events (memory leaks, errors, etc.) may be logged to file, displayed on-screen, passed to the debugger or any + combination of the three. Specify how each event should be handled via the FastMM_LogToFileEvents, + FastMM_MessageBoxEvents and FastMM_OutputDebugStringEvents variables. The default event log filename will be built + from the application filepath, but may be overridden via FastMM_SetEventLogFilename. Messages are built from + templates that may be changed/translated by the application. + + The optimization strategy of the memory manager may be tuned via FastMM_SetOptimizationStrategy. It can be set to + favour performance, low memory usage, or a blend of both. The default strategy is to blend the performance and low + memory usage goals. + + The following conditional defines are supported: + FastMM_FullDebugMode (or FullDebugMode) - If defined then FastMM_EnterDebugMode will be called on startup so that + the memory manager starts in debug mode. If FastMM_FullDebugMode is defined and FastMM_DebugLibraryDynamicLoading + (or LoadDebugDLLDynamically) is not defined then FastMM_DebugLibraryStaticDependency is implied. + + FastMM_FullDebugModeWhenDLLAvailable (or FullDebugModeWhenDLLAvailable) - If defined an attempt will be made to load + the debug support library during startup. If successful then FastMM_EnterDebugMode will be called so that the + memory manager starts up in debug mode. + + FastMM_DebugLibraryStaticDependency - If defined there will be a static dependency on the debug support library, + FastMM_FullDebugMode.dll (32-bit) or FastMM_FullDebugMode64.dll (64-bit). If FastMM_EnterDebugMode will be called + in the startup code and the memory manager will also be shared between an application and libraries, then it + may be necessary to enable this define in order to avoid DLL unload order issues during application shutdown + (typically manifesting as an access violation when attempting to report on memory leaks during shutdown). + It is a longstanding issue with Windows that it is not always able to unload DLLs in the correct order during + application shutdown when DLLs are loaded dynamically during startup. Note that while enabling this define will + introduce a static dependency on the debug support library, it does not actually enter debug mode by default - + FastMM_EnterDebugMode must still be called to enter debug mode, and FastMM_ExitDebugMode can be called to exit debug + mode at any time. + + FastMM_ClearLogFileOnStartup (or ClearLogFileOnStartup) - When defined FastMM_DeleteEventLogFile will be called + during startup, deleting the event log file (if it exists). + + FastMM_Align16Bytes (or Align16Bytes) - When defined FastMM_EnterMinimumAddressAlignment(maa16Bytes) will be called + during startup, forcing a minimum of 16 byte alignment for memory blocks. Note that this has no effect under 64 + bit, since 16 bytes is already the minimum alignment. + + FastMM_5Arenas, FastMM_6Arenas .. FastMM_16Arenas - Increases the number of arenas from the default values. See the + notes for the CFastMM_SmallBlockArenaCount constant for guidance on the appropriate number of arenas. + + FastMM_DisableAutomaticInstall - Disables automatic installation of FastMM as the memory manager. If defined then + FastMM_Initialize should be called from application code in order to install FastMM, and FastMM_Finalize to + uninstall and perform the leak check (if enabled), etc. + + FastMM_EnableMemoryLeakReporting (or EnableMemoryLeakReporting) - If defined then the memory leak summary and detail + will be added to the set of events logged to file (FastMM_LogToFileEvents) and the leak summary will be added to the + set of events displayed on-screen (FastMM_MessageBoxEvents). + + FastMM_RequireDebuggerPresenceForLeakReporting (or RequireDebuggerPresenceForLeakReporting) - Used in conjunction + with EnableMemoryLeakReporting - if the application is not running under the debugger then the + EnableMemoryLeakReporting define is ignored. + + FastMM_NoMessageBoxes (or NoMessageBoxes) - Clears the set of events that will cause a message box to be displayed + (FastMM_MessageBoxEvents) on startup. + + FastMM_ShareMM (or ShareMM) - If defined then FastMM_ShareMemoryManager will be called during startup, sharing the + memory manager of the module if the memory manager of another module is not already being shared. + + FastMM_ShareMMIfLibrary (or ShareMMIfLibrary) - If defined and the module is not a library then the ShareMM define + is disabled. + + FastMM_AttemptToUseSharedMM (or AttemptToUseSharedMM) - If defined FastMM_AttemptToUseSharedMemoryManager will be + called during startup, switching to using the memory manager shared by another module (if there is a shared memory + manager). + + FastMM_NeverUninstall (or NeverUninstall) - Sets the FastMM_NeverUninstall global variable to True. Use this if any + leaked pointers should remain valid after this unit is finalized. + + PurePascal - The assembly language code paths are disabled, and only the Pascal code paths are used. This is + normally used for debugging purposes only. + +Supported Compilers: + Delphi XE3 and later + +Supported Platforms: + Windows, 32-bit and 64-bit + +} + +unit FastMM5; + +interface + +uses + Winapi.Windows; + +{$RangeChecks Off} +{$BoolEval Off} +{$OverflowChecks Off} +{$Optimization On} +{$StackFrames Off} +{$TypedAddress Off} +{$LongStrings On} +{$Align 8} + +{Translate legacy v4 defines to their current names.} +{$ifdef FullDebugMode} {$define FastMM_FullDebugMode} {$endif} +{$ifdef LoadDebugDLLDynamically} {$define FastMM_DebugLibraryDynamicLoading} {$endif} +{$ifdef FullDebugModeWhenDLLAvailable} {$define FastMM_FullDebugModeWhenDLLAvailable} {$endif} +{$ifdef ClearLogFileOnStartup} {$define FastMM_ClearLogFileOnStartup} {$endif} +{$ifdef Align16Bytes} {$define FastMM_Align16Bytes} {$endif} +{$ifdef EnableMemoryLeakReporting} {$define FastMM_EnableMemoryLeakReporting} {$endif} +{$ifdef RequireDebuggerPresenceForLeakReporting} {$define FastMM_RequireDebuggerPresenceForLeakReporting} {$endif} +{$ifdef NoMessageBoxes} {$define FastMM_NoMessageBoxes} {$endif} +{$ifdef ShareMM} {$define FastMM_ShareMM} {$endif} +{$ifdef ShareMM} {$define FastMM_ShareMMIfLibrary} {$endif} +{$ifdef ShareMM} {$define FastMM_AttemptToUseSharedMM} {$endif} +{$ifdef ShareMM} {$define FastMM_NeverUninstall} {$endif} + +{If the "FastMM_FullDebugMode" is defined then a static dependency on the debug support library is assumed, unless +dynamic loading is explicitly specified.} +{$ifdef FastMM_FullDebugMode} + {$ifndef FastMM_DebugLibraryDynamicLoading} + {$define FastMM_DebugLibraryStaticDependency} + {$endif} +{$endif} + +{Calling the deprecated GetHeapStatus is unavoidable, so suppress the warning.} +{$warn Symbol_Deprecated Off} +{$warn Symbol_Platform Off} + +{$if SizeOf(Pointer) = 8} + {$define 64Bit} +{$else} + {$define 32Bit} +{$endif} + +{$ifdef CPUX86} + {$ifndef PurePascal} + {$define X86ASM} + {$endif} +{$else} + {$ifdef CPUX64} + {$ifndef PurePascal} + {$define X64ASM} + {$endif} + {$else} + {x86/x64 CPUs do not reorder writes, but ARM CPUs do.} + {$define WeakMemoryOrdering} + {$define PurePascal} + {$endif} +{$endif} + +const + + {The current version of FastMM. The first digit is the major version, followed by a two digit minor version number.} + CFastMM_Version = 504; + + {The number of arenas for small, medium and large blocks. Increasing the number of arenas decreases the likelihood + of thread contention happening (when the number of threads inside a GetMem call is greater than the number of arenas), + at a slightly higher fixed cost per GetMem call. Usually two threads can be served simultaneously from the same arena + (a new block can be split off for one thread while a freed block can be recycled for the other), so the optimal number + of arenas is usually somewhere between 0.5x and 1x the number of threads. Large block arenas are cheaper in both + performance and memory usage than small and medium block arenas, so typically more large block arenas are used. If + you suspect that thread contention may be dragging down performance, inspect the FastMM_...BlockThreadContentionCount + variables - if their numbers are high then an increase in the number of arenas will reduce thread contention.} +{$if defined(FastMM_16Arenas)} + CFastMM_SmallBlockArenaCount = 16; + CFastMM_MediumBlockArenaCount = 16; + CFastMM_LargeBlockArenaCount = 16; +{$elseif defined(FastMM_15Arenas)} + CFastMM_SmallBlockArenaCount = 15; + CFastMM_MediumBlockArenaCount = 15; + CFastMM_LargeBlockArenaCount = 15; +{$elseif defined(FastMM_14Arenas)} + CFastMM_SmallBlockArenaCount = 14; + CFastMM_MediumBlockArenaCount = 14; + CFastMM_LargeBlockArenaCount = 14; +{$elseif defined(FastMM_13Arenas)} + CFastMM_SmallBlockArenaCount = 13; + CFastMM_MediumBlockArenaCount = 13; + CFastMM_LargeBlockArenaCount = 13; +{$elseif defined(FastMM_12Arenas)} + CFastMM_SmallBlockArenaCount = 12; + CFastMM_MediumBlockArenaCount = 12; + CFastMM_LargeBlockArenaCount = 12; +{$elseif defined(FastMM_11Arenas)} + CFastMM_SmallBlockArenaCount = 11; + CFastMM_MediumBlockArenaCount = 11; + CFastMM_LargeBlockArenaCount = 11; +{$elseif defined(FastMM_10Arenas)} + CFastMM_SmallBlockArenaCount = 10; + CFastMM_MediumBlockArenaCount = 10; + CFastMM_LargeBlockArenaCount = 10; +{$elseif defined(FastMM_9Arenas)} + CFastMM_SmallBlockArenaCount = 9; + CFastMM_MediumBlockArenaCount = 9; + CFastMM_LargeBlockArenaCount = 9; +{$elseif defined(FastMM_8Arenas)} + CFastMM_SmallBlockArenaCount = 8; + CFastMM_MediumBlockArenaCount = 8; + CFastMM_LargeBlockArenaCount = 8; +{$elseif defined(FastMM_7Arenas)} + CFastMM_SmallBlockArenaCount = 7; + CFastMM_MediumBlockArenaCount = 7; + CFastMM_LargeBlockArenaCount = 8; +{$elseif defined(FastMM_6Arenas)} + CFastMM_SmallBlockArenaCount = 6; + CFastMM_MediumBlockArenaCount = 6; + CFastMM_LargeBlockArenaCount = 8; +{$elseif defined(FastMM_5Arenas)} + CFastMM_SmallBlockArenaCount = 5; + CFastMM_MediumBlockArenaCount = 5; + CFastMM_LargeBlockArenaCount = 8; +{$else} + {Default values - typically performs fine up to 8 simultaneous threads.} + CFastMM_SmallBlockArenaCount = 4; + CFastMM_MediumBlockArenaCount = 4; + CFastMM_LargeBlockArenaCount = 8; +{$endif} + + {The default name of debug support library.} + CFastMM_DefaultDebugSupportLibraryName = {$ifndef 64Bit}'FastMM_FullDebugMode.dll'{$else}'FastMM_FullDebugMode64.dll'{$endif}; + +type + + {The optimization strategy for the memory manager.} + TFastMM_MemoryManagerOptimizationStrategy = (mmosOptimizeForSpeed, mmosBalanced, mmosOptimizeForLowMemoryUsage); + + TFastMM_MemoryManagerEventType = ( + {Another third party memory manager has already been installed.} + mmetAnotherThirdPartyMemoryManagerAlreadyInstalled, + {FastMM cannot be installed, because memory has already been allocated through the default memory manager.} + mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed, + {When an attempt is made to install or use a shared memory manager, but the memory manager has already been used to + allocate memory.} + mmetCannotSwitchToSharedMemoryManagerWithLivePointers, + {Details about an individual memory leak.} + mmetUnexpectedMemoryLeakDetail, + {Summary of memory leaks} + mmetUnexpectedMemoryLeakSummary, + {When an attempt to free or reallocate a debug block that has already been freed is detected.} + mmetDebugBlockDoubleFree, + mmetDebugBlockReallocOfFreedBlock, + {When a corruption of the memory pool is detected.} + mmetDebugBlockHeaderCorruption, + mmetDebugBlockFooterCorruption, + mmetDebugBlockModifiedAfterFree, + {When a virtual method is called on a freed object.} + mmetVirtualMethodCallOnFreedObject); + TFastMM_MemoryManagerEventTypeSet = set of TFastMM_MemoryManagerEventType; + + TFastMM_MemoryManagerInstallationState = ( + {The default memory manager is currently in use.} + mmisDefaultMemoryManagerInUse, + {Another third party memory manager has been installed.} + mmisOtherThirdPartyMemoryManagerInstalled, + {A shared memory manager is being used.} + mmisUsingSharedMemoryManager, + {This memory manager has been installed.} + mmisInstalled); + + {The debug block header. Must be a multiple of 64 in order to guarantee that minimum block alignment restrictions + are honoured.} +{$PointerMath On} + PFastMM_DebugBlockHeader = ^TFastMM_DebugBlockHeader; +{$PointerMath Off} + TFastMM_DebugBlockHeader = packed record + {The first two pointer sized slots cannot be used by the debug block header. The medium block manager uses the + first two pointers in a free block for the free block linked list, and the small block manager uses the first + pointer for the free block linked list. This space is thus reserved.} + Reserved1: Pointer; + Reserved2: Pointer; + {Reserved space for future use.} +{$ifdef 32Bit} + ReservedSpace1: array[0..23] of Byte; +{$else} + ReservedSpace1: array[0..7] of Byte; +{$endif} + {The xor of all subsequent dwords in this structure.} + HeaderCheckSum: Cardinal; + {The allocation number: All debug mode allocations are numbered sequentially. This number may be useful in memory + leak analysis. If it reaches 4G it wraps back to 0.} + AllocationNumber: Cardinal; + {The user requested size for the block.} + UserSize: NativeInt; + {The object class this block was used for the previous time it was allocated. When a block is freed, the pointer + that would normally be in the space of the class pointer is copied here, so if it is detected that the block was + used after being freed we have an idea what class it is.} + PreviouslyUsedByClass: Pointer; + {The value of the FastMM_CurrentAllocationGroup when the block was allocated. Can be used in the debugging process + to group related memory leaks together.} + AllocationGroup: Cardinal; + {The ID of the thread that allocated the block} + AllocatedByThread: Cardinal; + {The ID of the thread that freed the block} + FreedByThread: Cardinal; + {Reserved space for future use.} + ReservedSpace2: Byte; + {The number of entries in the allocation and free call stacks in the debug footer.} + StackTraceEntryCount: Byte; + {The debug block signature. This will always be CIsDebugBlockFlag.} + DebugBlockFlags: SmallInt; + {Returns a pointer to the start of the debug footer. The debug footer consists of the footer checksum (dword), + followed by the allocation stack trace and then the free stack trace.} + function DebugFooterPtr: PCardinal; inline; + {Returns a pointer to the first entry in the allocation stack trace in the debug footer.} + function DebugFooter_AllocationStackTracePtr: PNativeUInt; inline; + {Returns a pointer to the first entry in the free stack trace in the debug footer.} + function DebugFooter_FreeStackTracePtr: PNativeUInt; inline; + {Calculate the header checksum} + function CalculateHeaderCheckSum: Cardinal; + {Calculate the checksum for the stack traces that follow after the user data.} + function CalculateFooterCheckSum: Cardinal; + {Calculates and sets both the header and footer checksums.} + procedure CalculateAndSetHeaderAndFooterCheckSums; + end; + + TFastMM_WalkAllocatedBlocksBlockType = ( + btLargeBlock, + btMediumBlockSpan, + btMediumBlock, + btSmallBlockSpan, + btSmallBlock); + TFastMM_WalkBlocksBlockTypes = set of TFastMM_WalkAllocatedBlocksBlockType; + + TFastMM_WalkAllocatedBlocks_BlockInfo = record + BlockAddress: Pointer; + {If there is additional debug information for the block, this will be a pointer to it. (Will be nil if there is no + additional debug information for the block.} + DebugInformation: PFastMM_DebugBlockHeader; + {The size of the block or span. This includes the size of the block header, padding and internal fragmentation.} + BlockSize: NativeInt; + {The usable size of the block. This is BlockSize less any headers, footers, other management structures and + internal fragmentation.} + UsableSize: NativeInt; + {An arbitrary pointer value passed in to the WalkAllocatedBlocks routine, which is passed through to the callback.} + UserData: Pointer; + {The arena number for the block} + ArenaIndex: Byte; + {The type of block} + BlockType: TFastMM_WalkAllocatedBlocksBlockType; + {True if the block is free, False if it is in use} + BlockIsFree: Boolean; + {--------Medium block spans only-------} + {If True this is the current sequential feed medium block span for ArenaIndex} + IsSequentialFeedMediumBlockSpan: Boolean; + {If this is the sequential feed span for the medium block arena then this will contain the number of bytes + currently unused.} + MediumBlockSequentialFeedSpanUnusedBytes: Integer; + {----Small block spans only-----} + {If True this is the current sequential feed small block span for ArenaIndex and the block size} + IsSequentialFeedSmallBlockSpan: Boolean; + {If IsSmallBlockSpan = True then this will contain the size of the small block.} + SmallBlockSpanBlockSize: Word; + {If this is a sequential feed small block span then this will contain the number of bytes currently unused.} + SmallBlockSequentialFeedSpanUnusedBytes: Integer; + end; + + TFastMM_WalkBlocksCallback = procedure(const ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); + + {The enumeration returned by the FastMM_DetectStringData, which is used to determine whether a memory block + potentially contains string data.} + TFastMM_StringDataType = (sdtNotAString, sdtAnsiString, sdtUnicodeString); + + TFastMM_MinimumAddressAlignment = (maa8Bytes, maa16Bytes, maa32Bytes, maa64Bytes); + TFastMM_MinimumAddressAlignmentSet = set of TFastMM_MinimumAddressAlignment; + + {The formats in which text files (e.g. the event log) may be written. Controlled via the FastMM_TextFileEncoding + variable.} + TFastMM_TextFileEncoding = ( + {UTF-8 with no byte-order mark} + teUTF8, + {UTF-8 with a byte-order mark} + teUTF8_BOM, + {UTF-16 little endian, with no byte-order mark} + teUTF16LE, + {UTF-16 little endian, with a byte-order mark} + teUTF16LE_BOM); + + {A routine used to obtain the current stack trace up to AMaxDepth levels deep. The first ASkipFrames frames in the + stack trace are skipped. Unused entries will be set to 0.} + TFastMM_GetStackTrace = procedure(APReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); + + {A routine used to convert a stack trace to a textual representation (typically unit and line information). + APReturnAddresses points to a buffer with up to AMaxDepth return addresses (zero return addresses are ignored). The + textual representation is stored to APBufferPosition. The routine will update both APBufferPosition and + ARemainingBufferSpaceInWideChars.} + TFastMM_ConvertStackTraceToText = function(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBuffer, APBufferEnd: PWideChar): PWideChar; + + {List of registered leaks} + TFastMM_RegisteredMemoryLeak = record + LeakAddress: Pointer; + LeakedClass: TClass; + LeakSize: NativeInt; + LeakCount: Integer; + end; + TFastMM_RegisteredMemoryLeaks = array of TFastMM_RegisteredMemoryLeak; + + TFastMM_UsageSummary = record + {The total number of bytes allocated by the application.} + AllocatedBytes: NativeUInt; + {The committed virtual address space less AllocatedBytes: The total number of address space bytes used by control + structures, or lost due to fragmentation and other overhead. Blocks that have been freed by the application but + not yet released back to the operating system are included in this total.} + OverheadBytes: NativeUInt; + {The efficiency of the memory manager expressed as a percentage. This is: + 100 * AllocatedBytes / (AllocatedBytes + OverheadBytes).} + EfficiencyPercentage: Double; + end; + +{------------------------Core memory manager interface------------------------} +function FastMM_GetMem(ASize: NativeInt): Pointer; +function FastMM_FreeMem(APointer: Pointer): Integer; +function FastMM_ReallocMem(APointer: Pointer; ANewSize: NativeInt): Pointer; +function FastMM_AllocMem(ASize: NativeInt): Pointer; + +{------------------------Debug mode core memory manager interface------------------------} +function FastMM_DebugGetMem(ASize: NativeInt): Pointer; +function FastMM_DebugFreeMem(APointer: Pointer): Integer; +function FastMM_DebugReallocMem(APointer: Pointer; ANewSize: NativeInt): Pointer; +function FastMM_DebugAllocMem(ASize: NativeInt): Pointer; + +{------------------------Expected memory leak management------------------------} + +{Registers expected memory leaks. Returns True on success. The list of leaked blocks is limited, so failure is +possible if the list is full.} +function FastMM_RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +function FastMM_RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +function FastMM_RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +{Removes expected memory leaks. Returns True on success.} +function FastMM_UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +function FastMM_UnregisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +function FastMM_UnregisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +{Returns a list of all expected memory leaks} +function FastMM_GetRegisteredMemoryLeaks: TFastMM_RegisteredMemoryLeaks; + +{------------------------Diagnostics------------------------} + +{Returns the user size of the block, normally the number of bytes requested in the original GetMem or ReallocMem call. +Exception: Outside of debug mode the requested size for small and medium blocks is not tracked, and in these instances +the value returned will be the same as the value returned by the FastMM_BlockMaximumUserBytes call.} +function FastMM_BlockCurrentUserBytes(APointer: Pointer): NativeInt; +{Returns the maximum number of bytes that may safely be used by the application for the block starting at APointer. +This will be greater or equal to the size requested in the original GetMem or ReallocMem call. Note that using more +than the value returned by FastMM_BlockCurrentUserBytes is not recommended, since a reallocation request will only move +up to FastMM_BlockCurrentUserBytes bytes.} +function FastMM_BlockMaximumUserBytes(APointer: Pointer): NativeInt; + +{Attempts to release all pending free blocks. Returns True if there were no pending frees, or all pending frees could +be released. Returns False if there were locked (currently in use) managers with pending frees.} +function FastMM_ProcessAllPendingFrees: Boolean; + +{Walks the block types indicated by the AWalkBlockTypes set, calling ACallBack for each allocated block. If +AWalkBlockTypes = [] then all block types is assumed. Note that pending free blocks are treated as used blocks for the +purpose of the AWalkUsedBlocksOnly parameter. Call FastMM_ProcessAllPendingFrees first in order to process all pending +frees if this is a concern. ALockTimeoutMilliseconds is the maximum number of millseconds that FastMM_WalkBlocks will +wait to acquire a lock on an arena, skipping the arena if it is unable to do so. Returns True if all blocks were walked +successfully, False if one or more arenas were skipped due to a lock timeout.} +function FastMM_WalkBlocks(ACallBack: TFastMM_WalkBlocksCallback; AWalkBlockTypes: TFastMM_WalkBlocksBlockTypes = []; + AWalkUsedBlocksOnly: Boolean = True; AUserData: Pointer = nil; ALockTimeoutMilliseconds: Cardinal = 1000): Boolean; + +{Attempts to determine whether APMemoryBlock points to string data. Used by the leak classification code when a block +cannot be identified as a class instance. May also be used inside the FastMM_WalkBlocks callback in order to determine +the content of walked blocks.} +function FastMM_DetectStringData(APMemoryBlock: Pointer; AAvailableSpaceInBlock: NativeInt): TFastMM_StringDataType; +{Attempts to determine whether APointer points to a valid class instance. Returns the class if it does, otherwise nil. +APointer is assumed to point to to at least 4 (32-bit) or 8 (64-bit) readable bytes of memory. This may be used inside +the FastMM_WalkBlocks callback in order to determine the content of walked blocks.} +function FastMM_DetectClassInstance(APointer: Pointer): TClass; + +{Walks all debug mode blocks (blocks that were allocated between a FastMM_EnterDebugMode and FastMM_ExitDebugMode call), +checking for corruption of the debug header, footer, and in the case of freed blocks whether the block content was +modified after the block was freed. If a corruption is encountered an error message will be logged and/or displayed +(as per the error logging configuration) and an invalid pointer exception will be raised. This is a function that +always returns True (unless an exception is raised), so may be used in a debug watch to scan blocks every time the +debugger stops on a breakpoint, etc.} +function FastMM_ScanDebugBlocksForCorruption: Boolean; + +{Returns the number of bytes of address space that is currently either committed or reserved by FastMM. This includes +the total used by the heap, as well as all internal management structures. This may be restricted via the +FastMM_SetMemoryUsageLimit call.} +function FastMM_GetCurrentMemoryUsage: NativeUInt; + +{Returns a THeapStatus structure with information about the current memory usage.} +function FastMM_GetHeapStatus: THeapStatus; + +{Returns the number of allocated bytes, the number of overhead bytes (wastage due to management structures and internal +fragmentation), as well as the efficiency percentage. The efficiency percentage is the total allocated bytes divided +by the total address space committed (whether in use or reserved for future use) multiplied by 100. Note that freed +blocks not yet released to the operating system are included in the overhead, which differs from FastMM_GetHeapStatus +that exposes freed blocks in separate fields.} +function FastMM_GetUsageSummary: TFastMM_UsageSummary; + +{Writes a log file containing a summary of the memory manager state and a list of allocated blocks grouped by class. +The file will be saved in the encoding specified by FastMM_TextFileEncoding. ALockTimeoutMilliseconds is the maximum +amount of time to wait for a lock on a manager to be released, before it is skipped. Returns True on success.} +function FastMM_LogStateToFile(const AFilename: string; const AAdditionalDetails: string = ''; + ALockTimeoutMilliseconds: Cardinal = 1000): Boolean; + +{------------------------Memory Manager Sharing------------------------} + +{Searches the current process for a shared memory manager. If no memory has been allocated using this memory manager +it will switch to using the shared memory manager instead. Returns True if another memory manager was found and it +could be shared. If this memory manager instance *is* the shared memory manager, it will do nothing and return True.} +function FastMM_AttemptToUseSharedMemoryManager: Boolean; + +{Starts sharing this memory manager with other modules in the current process. Only one memory manager may be shared +per process, so this function may fail.} +function FastMM_ShareMemoryManager: Boolean; + +{------------------------Configuration------------------------} + +{Executes the initialization and finalization code for the memory manager. FastMM_Initialize will run during unit +initialization and FastMM_Finalize during unit finalization, unless "FastMM_DisableAutomaticInstall" is defined. If +"FastMM_DisableAutomaticInstall" is defined then FastMM_Initialize must be called from application code in order to +initialize and install the memory manager, and FastMM_Finalize must be called to uninstall it and perform leak checks, +etc. Note that FastMM cannot be installed if another third party memory manager has already been installed, or if +memory has already been allocated through the default memory manager. FastMM_Initialize will return True on successful +installation, False otherwise. FastMM_Finalize will return True if FastMM_Initialize was previously called, False +otherwise.} +function FastMM_Initialize: Boolean; +function FastMM_Finalize: Boolean; + +{Returns the current installation state of the memory manager.} +function FastMM_GetInstallationState: TFastMM_MemoryManagerInstallationState; + +{Gets/sets the optimization strategy for the memory manager. FastMM can be optimized for maximum performance, low +memory usage or a blend of the two.} +procedure FastMM_SetOptimizationStrategy(AStrategy: TFastMM_MemoryManagerOptimizationStrategy); +function FastMM_GetCurrentOptimizationStrategy: TFastMM_MemoryManagerOptimizationStrategy; + +{Call FastMM_EnterMinimumAddressAlignment to request that all subsequent allocated blocks are aligned to the specified +minimum. Call FastMM_ExitMinimumAddressAlignment to rescind a prior request. Requests for coarser alignments have +precedence over requests for lesser alignments. These calls are thread safe. In the current implementation the +following minimum alignments are always in effect, regardless of any alignment requests: + 32-Bit applications: >= maa8Bytes + 64-bit applications: >= maa16Bytes + Allocations greater than 150 bytes: >= maa16Bytes + Allocations greater than 302 bytes: >= maa32Bytes + Allocations greater than 606 bytes: maa64Bytes} +procedure FastMM_EnterMinimumAddressAlignment(AMinimumAddressAlignment: TFastMM_MinimumAddressAlignment); +procedure FastMM_ExitMinimumAddressAlignment(AMinimumAddressAlignment: TFastMM_MinimumAddressAlignment); +{Returns the current minimum address alignment in effect.} +function FastMM_GetCurrentMinimumAddressAlignment: TFastMM_MinimumAddressAlignment; + +{Allows the application to specify a maximum amount of memory that may be allocated through FastMM. An attempt to +allocate more than this amount will fail and lead to an "Out of Memory" exception. Note that after the first failure +the maximum amount of memory that may be allocated is slightly increased in order to allow the application to allocate +some additional memory in subsequent attempts. This is to allow for a graceful shutdown. Specify 0 for no limit (the +default).} +procedure FastMM_SetMemoryUsageLimit(AMaximumAllowedMemoryUsage: NativeUInt); +function FastMM_GetMemoryUsageLimit: NativeUInt; + +{Attempts to load the debug support library specified by FastMM_DebugSupportLibraryName. On success it will set the +FastMM_GetStackTrace and FastMM_ConvertStackTraceToText handlers to point to the routines in the debug library, provided +alternate handlers have not yet been assigned by the application. Returns True if the library was loaded successfully, +or was already loaded successfully prior to this call. FastMM_EnterDebugMode will call FastMM_LoadDebugSupportLibrary +the first time it is called, unless the debug support library has already been loaded or handlers for both +FastMM_GetStackTrace and FastMM_ConvertStackTraceToText have been set by the application.} +function FastMM_LoadDebugSupportLibrary: Boolean; +{Frees the debug support library, pointing the stack trace handlers currently using the debug support library back to +the default no-op handlers.} +function FastMM_FreeDebugSupportLibrary: Boolean; + +{Enters/exits debug mode. Calls may be nested, in which case debug mode is only exited when the number of +FastMM_ExitDebugMode calls equal the number of FastMM_EnterDebugMode calls. In debug mode extra metadata is logged +before and after the user data in the block, and extra checks are performed in order to catch common programming +errors. Returns True on success, False if this memory manager instance is not currently installed or the installed +memory manager has changed. Note that debug mode comes with a severe performance penalty, and due to the extra +metadata all blocks that are allocated while debug mode is active will use significantly more address space.} +function FastMM_EnterDebugMode: Boolean; +function FastMM_ExitDebugMode: Boolean; +{Returns True if debug mode is currently active, i.e. FastMM_EnterDebugMode has been called more times than +FastMM_ExitDebugMode.} +function FastMM_DebugModeActive: Boolean; + +{Gets/sets the depth of allocation and free stack traces in debug mode. The minimum stack trace depth is 0, and the +maximum is CFastMM_MaximumStackTraceEntryCount.} +function FastMM_GetDebugModeStackTraceEntryCount: Byte; +procedure FastMM_SetDebugModeStackTraceEntryCount(AStackTraceEntryCount: Byte); + +{No-op call stack routines.} +procedure FastMM_NoOpGetStackTrace(APReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); +function FastMM_NoOpConvertStackTraceToText(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBufferPosition, APBufferEnd: PWideChar): PWideChar; + +{Sets the default event log path and filename. If the FastMMLogFilePath environment variable is set then that will be +used as the path, otherwise the path to the application will be used. The filename is built from the name of the +application.} +procedure FastMM_SetDefaultEventLogFilename; +{Sets the full path and filename for the event log. if APEventLogFilename = nil then the default event log filename +will be set.} +procedure FastMM_SetEventLogFilename(APEventLogFilename: PWideChar); +{Returns the current full path and filename for the event log.} +function FastMM_GetEventLogFilename: PWideChar; +{Deletes the event log file.} +function FastMM_DeleteEventLogFile: Boolean; + +var + + {-----------Stack trace support routines----------} + {The active routines used to get a call stack and to convert it to a textual representation. These will be set to + the no-op routines during startup. If either of these have not been assigned a different value when + FastMM_EnterDebugMode is called for the first time then an attempt will be made to load the debug support DLL and + any of these still set to the no-op routines will be rerouted to the handlers in the debug support DLL.} + FastMM_GetStackTrace: TFastMM_GetStackTrace; + FastMM_ConvertStackTraceToText: TFastMM_ConvertStackTraceToText; + + {---------Debug options---------} + + {The name of the library that contains the functionality used to obtain the current call stack, and also to convert a + call stack to unit and line number information. The first time EnterDebugMode is called an attempt will be made to + load this library, unless handlers for both FastMM_GetStackTrace and FastMM_ConvertStackTraceToText have already been + set.} + FastMM_DebugSupportLibraryName: PWideChar = CFastMM_DefaultDebugSupportLibraryName; + {If True then FastMM will not be finalized and uninstalled when this unit is finalized. Use this option when for some + reason there are live pointers that will still be in use after this unit is finalized. Under normal operation this + should not be necessary.} + FastMM_NeverUninstall: Boolean = False; + {When this variable is True and debug mode is enabled, all debug blocks will be checked for corruption on entry to any + memory manager operation (i.e. GetMem, FreeMem, AllocMem and ReallocMem). Note that this comes with an extreme + performance penalty.} + FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation: Boolean = False; + {The events that are passed to OutputDebugString.} + FastMM_OutputDebugStringEvents: TFastMM_MemoryManagerEventTypeSet = [mmetDebugBlockDoubleFree, + mmetDebugBlockReallocOfFreedBlock, mmetDebugBlockHeaderCorruption, mmetDebugBlockFooterCorruption, + mmetDebugBlockModifiedAfterFree, mmetVirtualMethodCallOnFreedObject, mmetAnotherThirdPartyMemoryManagerAlreadyInstalled, + mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed, mmetCannotSwitchToSharedMemoryManagerWithLivePointers]; + {The events that are logged to file.} + FastMM_LogToFileEvents: TFastMM_MemoryManagerEventTypeSet = [mmetDebugBlockDoubleFree, + mmetDebugBlockReallocOfFreedBlock, mmetDebugBlockHeaderCorruption, mmetDebugBlockFooterCorruption, + mmetDebugBlockModifiedAfterFree, mmetVirtualMethodCallOnFreedObject, mmetAnotherThirdPartyMemoryManagerAlreadyInstalled, + mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed, mmetCannotSwitchToSharedMemoryManagerWithLivePointers]; + {The events that are displayed in a message box.} + FastMM_MessageBoxEvents: TFastMM_MemoryManagerEventTypeSet = [mmetDebugBlockDoubleFree, + mmetDebugBlockReallocOfFreedBlock, mmetDebugBlockHeaderCorruption, mmetDebugBlockFooterCorruption, + mmetDebugBlockModifiedAfterFree, mmetVirtualMethodCallOnFreedObject, mmetAnotherThirdPartyMemoryManagerAlreadyInstalled, + mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed, mmetCannotSwitchToSharedMemoryManagerWithLivePointers]; + {All debug blocks are tagged with the current value of this variable when the block is allocated. This may be used + by the application to track memory issues.} + FastMM_CurrentAllocationGroup: Cardinal; + {This variable is incremented during every debug getmem call (wrapping to 0 once it hits 4G) and stored in the debug + header. It may be useful for debugging purposes.} + FastMM_LastAllocationNumber: Cardinal; + {These variables are incremented every time all the arenas for the block size are locked simultaneously and FastMM had + to relinquish the thread's timeslice during a GetMem or ReallocMem call. (FreeMem frees can always be deferred, so + will never cause a thread contention). If these numbers are excessively high then it is an indication that the number + of small, medium and/or large block arenas are insufficient for the number of application threads and should be + increased. (The CFastMM_SmallBlockArenaCount, CFastMM_MediumBlockArenaCount and CFastMM_LargeBlockArenaCount constants.)} + FastMM_SmallBlockThreadContentionCount: Cardinal; + FastMM_MediumBlockThreadContentionCount: Cardinal; + FastMM_LargeBlockThreadContentionCount: Cardinal; + + {---------Message and log file text configuration--------} + + {The text encoding to use for the event log and other text file output.} + FastMM_TextFileEncoding: TFastMM_TextFileEncoding; + + {Messages contain numeric tokens that will be substituted. The available tokens are: + 0: A blank string (invalid token IDs will also translate to this) + 1: The current date in yyyy-mm-dd format. + 2: The current time in HH:nn:ss format. + 3: Block size in bytes + 4: The ID of the allocating thread (in hexadecimal). + 5: The ID of the freeing thread (in hexadecimal). + 6: The stack trace when the block was allocated. + 7: The stack trace when the block was freed. + 8: The object class for the block. For freed blocks this will be the prior object class, otherwise it will be the + current object class. + 9: The allocation number for the block (in decimal). + 10: Hex and ASCII dump size in bytes + 11: Block address (in hexadecimal). + 12: Hex dump of block (each line is followed by #13#10) + 13: ASCII dump of block (each line is followed by #13#10) + 14: Leak summary entries + 15: The size and offsets for modifications to a block after it was freed. + 16: The full path and filename of the event log. + 17: The virtual method name for a virtual method calls on a freed object + 18: The total kilobytes allocated (FastMM_LogStateToFile) + 19: The total kilobytes overhead (FastMM_LogStateToFile) + 20: The efficiency percentage (FastMM_LogStateToFile) + 21: The total number of bytes used by the class (FastMM_LogStateToFile) + 22: The number of instances of the class (FastMM_LogStateToFile) + 23: The average number of bytes per instance for the class (FastMM_LogStateToFile) + 24: The stack trace for a virtual method call on a freed object + } + + {This entry precedes every entry in the event log.} + FastMM_LogFileEntryHeader: PWideChar = '--------------------------------{1} {2}--------------------------------'#13#10; + {Memory manager installation errors} + FastMM_CannotInstallAfterDefaultMemoryManagerHasBeenUsedMessage: PWideChar = 'FastMM cannot be installed, because the ' + + 'default memory manager has already been used to allocate memory.'; + FastMM_CannotSwitchToSharedMemoryManagerWithLivePointersMessage: PWideChar = 'Cannot switch to the shared memory ' + + 'manager, because the local memory manager instance has already been used to allocate memory.'; + FastMM_AnotherMemoryManagerAlreadyInstalledMessage: PWideChar = 'FastMM cannot be installed, because another third ' + + 'party memory manager has already been installed.'; + FastMM_CannotSwitchMemoryManagerMessageBoxCaption: PWideChar = 'Cannot Switch Memory Managers'; + + {Memory leak messages.} + FastMM_MemoryLeakDetailMessage_NormalBlock: PWideChar = 'A memory block has been leaked. The size is: {3}'#13#10#13#10 + + 'The block is currently used for an object of class: {8}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_MemoryLeakDetailMessage_DebugBlock: PWideChar = 'A memory block has been leaked. The size is: {3}'#13#10#13#10 + + 'This block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'The block is currently used for an object of class: {8}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_MemoryLeakSummaryMessage_LeakDetailNotLogged: PWideChar = 'This application has leaked memory. ' + + 'The leaks ordered by size are:'#13#10'{14}'#13#10; + FastMM_MemoryLeakSummaryMessage_LeakDetailLoggedToEventLog: PWideChar = 'This application has leaked memory. ' + + 'The leaks ordered by size are:'#13#10'{14}'#13#10#13#10 + + 'Memory leak detail was logged to {16}'#13#10; + FastMM_MemoryLeakMessageBoxCaption: PWideChar = 'Unexpected Memory Leak'; + {Attempts to free or reallocate a debug block that has alredy been freed.} + FastMM_DebugBlockDoubleFree: PWideChar = 'An attempt was made to free a block that has already been freed.'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'This block was freed by thread 0x{5}, and the stack trace (return addresses) at the time was:' + + '{7}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10; + FastMM_DebugBlockReallocOfFreedBlock: PWideChar = 'An attempt was made to resize a block that has already been freed.'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'This block was freed by thread 0x{5}, and the stack trace (return addresses) at the time was:' + + '{7}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10; + + {Memory pool corruption messages.} + FastMM_BlockModifiedAfterFreeMessage: PWideChar = 'A memory block was modified after it was freed.'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'Modifications were detected at offsets (with lengths in brackets): {15}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'This block was freed by thread 0x{5}, and the stack trace (return addresses) at the time was:' + + '{7}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_BlockHeaderCorruptedMessage: PWideChar = 'A memory block header has been corrupted.'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_BlockFooterCorruptedMessage_AllocatedBlock: PWideChar = 'A memory block footer has been corrupted.'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_BlockFooterCorruptedMessage_FreedBlock: PWideChar = 'A memory block footer has been corrupted.'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'This block was freed by thread 0x{5}, and the stack trace (return addresses) at the time was:' + + '{7}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_MemoryCorruptionMessageBoxCaption: PWideChar = 'Memory Corruption Detected'; + + {Virtual method call on a freed object.} + FastMM_VirtualMethodCallOnFreedObjectMessage: PWideChar = 'A virtual method was called on a freed object.'#13#10#13#10 + + 'Freed object class: {8}'#13#10#13#10 + + 'Virtual method: {17}'#13#10#13#10 + + 'The block size is {3}.'#13#10#13#10 + + 'The block was allocated by thread 0x{4}, and the stack trace (return addresses) at the time was:' + + '{6}'#13#10#13#10'This block was freed by thread 0x{5}, and the stack trace (return addresses) at the time was:' + + '{7}'#13#10#13#10'The stack trace for the virtual call that lead to this error is:' + + '{24}'#13#10#13#10 + + 'The allocation number is: {9}'#13#10#13#10 + + 'Current memory dump of {10} bytes starting at pointer address {11}:'#13#10 + + '{12}'#13#10'{13}'#13#10; + FastMM_VirtualMethodCallOnFreedObjectMessageBoxCaption: PWideChar = 'Virtual Method Call On Freed Object'; + + {Memory state logging messages} + FastMM_LogStateToFileTemplate: PWideChar = 'FastMM State Capture:'#13#10 + + '---------------------'#13#10 + + '{18}K Allocated'#13#10 + + '{19}K Overhead'#13#10 + + '{20}% Efficiency'#13#10#13#10 + + 'Usage Detail:'#13#10; + FastMM_LogStateToFileTemplate_UsageDetail: PWideChar = '{21} bytes: {8} x {22} ({23} bytes avg.)'#13#10; + +implementation + +{All blocks are preceded by a block header. The block header varies in size according to the block type. The block +type and state may be determined from the bits of the word preceding the block address, as follows: + + All block types: + ---------------- + + Bit 0: Block is free flag + 0 = Block is in use + 1 = Block is free + + Bit 1: Debug info flag + 0 = the block contains no additional debug information + 1 = the block contains a debug mode sub-block + + Bit 2: Block type 1 + 0 = Is not a small block + 1 = Is a small block + + + Small blocks only (bit 2 = 1): + ------------------------------ + + Bits 3..15: Offset to small block span header + The offset of the block from the start of the small block span header, divided by 64. + + + Medium, Large and Debug Blocks (bit 2 = 0): + ------------------------------------------- + + Bit 3: Block type 2 + 0 = Is not a medium block + 1 = Is a medium block + + Bit 4: Block type 3 + 0 = Is not a large block + 1 = Is a large block + + Bit 5: Block type 4 + 0 = Is not a debug sub-block + 1 = Is a debug sub-block + + Bits 6..15: Reserved (always 0) + +} + +const + + {$ifdef 32Bit} + CPointerSizeBitShift = 2; //1 shl 2 = 4 + CTObjectInstanceSize = 8; + {$else} + CPointerSizeBitShift = 3; //1 shl 3 = 8 + CTObjectInstanceSize = 16; + {$endif} + + {Block status flags} + CBlockIsFreeFlag = 1; + CHasDebugInfoFlag = 2; + CIsSmallBlockFlag = 4; + CIsMediumBlockFlag = 8; + CIsLargeBlockFlag = 16; + CIsDebugBlockFlag = 32; + + {-----Small block constants-----} +{$ifdef 32Bit} + CSmallBlockTypeCount = 61; + CSmallBlockGranularityBits = 3; +{$else} + CSmallBlockTypeCount = 51; + CSmallBlockGranularityBits = 4; +{$endif} + CSmallBlockGranularity = 1 shl CSmallBlockGranularityBits; + CMaximumSmallBlockSize = 2624; //Must be a multiple of 64 for the 64-byte alignment option to work + CSmallBlockFlagCount = 3; + CDropSmallBlockFlagsMask = - (1 shl CSmallBlockFlagCount); + CSmallBlockSpanOffsetBitShift = 6 - CSmallBlockFlagCount; + + {-----Medium block constants-----} + {Medium blocks are always aligned to at least 64 bytes (which is the typical cache line size). Spans must be a + multiple of 64K (to make optimal use of the virtual address space), and offsets divided by the granularity must fit + inside a 16-bit word.} + CMediumBlockAlignmentBits = 6; + CMediumBlockAlignment = 1 shl CMediumBlockAlignmentBits; + CMaximumMediumBlockSpanSize = 64 * 1024 * CMediumBlockAlignment; // = 4MB + + {Medium blocks are binned in linked lists - one linked list for each size.} + CMediumBlockBinsPerGroup = 32; + CMediumBlockBinGroupCount = 32; + CMediumBlockBinCount = CMediumBlockBinGroupCount * CMediumBlockBinsPerGroup; + + {The smallest medium block should be <= 10% greater than the largest small block. It is an odd multiple + of the typical cache line size in order to facilitate better cache line utilization.} + CMinimumMediumBlockSize = CMaximumSmallBlockSize + 256; // = 2880 + + {The spacing between medium block bins is not constant. There are three groups: initial, middle and final.} + CInitialBinCount = 384; + CInitialBinSpacingBits = 8; + CInitialBinSpacing = 1 shl CInitialBinSpacingBits; // = 256 + + CMediumBlockMiddleBinsStart = CMinimumMediumBlockSize + CInitialBinSpacing * CInitialBinCount; + CMiddleBinCount = 384; + CMiddleBinSpacingBits = 9; + CMiddleBinSpacing = 1 shl CMiddleBinSpacingBits; // = 512 + + CMediumBlockFinalBinsStart = CMediumBlockMiddleBinsStart + CMiddleBinSpacing * CMiddleBinCount; + CFinalBinCount = CMediumBlockBinCount - CMiddleBinCount - CInitialBinCount; + CFinalBinSpacingBits = 10; + CFinalBinSpacing = 1 shl CFinalBinSpacingBits; // = 1024 + + {The maximum size allocatable through medium blocks. Blocks larger than this are allocated via the OS from the + virtual memory pool ( = large blocks).} + CMaximumMediumBlockSize = CMediumBlockFinalBinsStart + (CFinalBinCount - 1) * CFinalBinSpacing; + + {-----Large block constants-----} + CLargeBlockGranularity = 64 * 1024; //Address space obtained from VirtualAlloc is always aligned to a 64K boundary + + {-----Small block span constants-----} + {Allocating and deallocating small block spans are expensive, so it is not something that should be done frequently.} + CMinimumSmallBlocksPerSpan = 16; + COptimalSmallBlocksPerSpan = 64; + COptimalSmallBlockSpanSizeLowerLimit = CMinimumMediumBlockSize + 16 * 1024; + COptimalSmallBlockSpanSizeUpperLimit = CMinimumMediumBlockSize + 96 * 1024; + {The maximum amount by which a small block span may exceed the optimal size before the block will be split instead of + using it as-is.} + CSmallBlockSpanMaximumAmountWithWhichOptimalSizeMayBeExceeded = 4 * 1024; + + {-------------Block resizing constants---------------} + CSmallBlockDownsizeCheckAdder = 64; + CSmallBlockUpsizeAdder = 32; + {When a medium block is reallocated to a size smaller than this, then it must be reallocated to a small block and the + data moved. If not, then it is shrunk in place.} + CMediumInPlaceDownsizeLimit = CMinimumMediumBlockSize div 4; + + {------Debug constants-------} +{$ifdef 32Bit} + {The number of bytes of address space that is reserved and only released once the first OS allocation request fails. + This allows some subsequent memory allocation requests to succeed in order to allow the application to allocate some + memory for error handling, etc. in response to the first EOutOfMemory exception. This only applies to 32-bit + applications. The default reserve is enough address space for a medium block span as well as a similarly sized + large block.} + CEmergencyReserveAddressSpace = 2 * CMaximumMediumBlockSpanSize; +{$endif} + + {Event and state log tokens} + CEventLogTokenBlankString = 0; + CEventLogTokenCurrentDate = 1; + CEventLogTokenCurrentTime = 2; + CEventLogTokenBlockSize = 3; + CEventLogTokenAllocatedByThread = 4; + CEventLogTokenFreedByThread = 5; + CEventLogTokenAllocationStackTrace = 6; + CEventLogTokenFreeStackTrace = 7; + CEventLogTokenObjectClass = 8; + CEventLogTokenAllocationNumber = 9; + CEventLogTokenMemoryDumpSize = 10; + CEventLogTokenBlockAddress = 11; + CEventLogTokenHexDump = 12; + CEventLogTokenASCIIDump = 13; + CEventLogTokenLeakSummaryEntries = 14; + CEventLogTokenModifyAfterFreeDetail = 15; + CEventLogTokenEventLogFilename = 16; + CEventLogTokenVirtualMethodName = 17; + CEventLogTokenVirtualMethodCallOnFreedObject = 24; + + CStateLogTokenAllocatedKB = 18; + CStateLogTokenOverheadKB = 19; + CStateLogTokenEfficiencyPercentage = 20; + CStateLogTokenClassTotalBytesUsed = 21; + CStateLogTokenClassInstanceCount = 22; + CStateLogTokenClassAverageBytesPerInstance = 23; + + {The highest ID of an event log token.} + CEventLogMaxTokenID = 30; + + {The maximum size of an event message, in wide characters.} + CEventMessageMaxWideChars = 32768; + CTokenBufferMaxWideChars = 32768; + + CFilenameMaxLength = 1024; + + {The size of the memory block reserved for maintaining the list of registered memory leaks.} + CExpectedMemoryLeaksListSize = 64 * 1024; + + CHexDigits: array[0..15] of Char = '0123456789ABCDEF'; + + {The maximum size of hexadecimal and ASCII dumps.} + CMemoryDumpMaxBytes = 256; + CMemoryDumpMaxBytesPerLine = 32; + + {The debug block fill pattern, in several sizes.} + CDebugFillPattern8B = $8080808080808080; + CDebugFillPattern4B = $80808080; + CDebugFillPattern2B = $8080; + CDebugFillPattern1B = $80; + + {The first few frames of a GetMem or FreeMem stack trace are inside system.pas and this unit, so does not provide any + useful information. Specify how many of the initial frames should be skipped here. Note that these are actual + frames, so routines that do not have frames will also be skipped.} + CFastMM_StackTrace_SkipFrames_GetMem = 0; + CFastMM_StackTrace_SkipFrames_FreeMem = 0; + + {The maximum number of entries per stack trace.} + CFastMM_StackTrace_MaximumEntryCount = 64; + {The default number of entries per stack trace.} + CFastMM_StackTrace_DefaultEntryCount = 20; + + {The number of bytes in a memory page. It is assumed that pages are aligned at page size boundaries, and that memory + protection is set at the page level.} + CVirtualMemoryPageSize = 4096; + + CCopyrightMessage: PAnsiChar = 'FastMM (c) 2004 - 2021 Pierre le Riche'; + +type + + TFastMM_MaximumLengthStackTrace = array[0..CFastMM_StackTrace_MaximumEntryCount - 1] of NativeUInt; + + {Event log token values are pointers #0 terminated text strings. The payload for the tokens is in TokenData.} + TEventLogTokenValues = array[0..CEventLogMaxTokenID] of PWideChar; + + TMoveProc = procedure(const ASource; var ADest; ACount: NativeInt); + + TIntegerWithABACounter = record + case Integer of + 0: (IntegerAndABACounter: Int64); + 1: (IntegerValue, ABACounter: Integer); + end; + + TBlockStatusFlags = Word; + +{$PointerMath On} + PBlockStatusFlags = ^TBlockStatusFlags; +{$PointerMath Off} + + {------------------------Small block structures------------------------} + + {Small blocks have a 16-bit header.} + TSmallBlockHeader = record + { + Bit 0: Block is free flag + 0 = Block is in use + 1 = Block is free + + Bit 1: Debug flag + 0 = the block contains no additional debug information + 1 = the block contains a debug mode sub-block + + Bit 2: Small block indicator + Must be 1 + + Bits 3..15 (0..8191): + The offset of the block from the start of the small block span header, divided by 64. + } + BlockStatusFlagsAndSpanOffset: TBlockStatusFlags; + end; +{$PointerMath On} + PSmallBlockHeader = ^TSmallBlockHeader; +{$PointerMath Off} + + {Small block layout: + Offset: -2 = This block's header + Offset: 0 = User data / Pointer to next free block (if this block is free)} + + PSmallBlockSpanHeader = ^TSmallBlockSpanHeader; + + {Always 64 bytes in size in order to fit inside a cache line, under both 32-bit and 64-bit. It must be aligned to 64 + bytes in order to ensure proper alignment of the small blocks following it.} + TSmallBlockManager = record + {The first/last partially free span in the arena. This field must be at the same offsets as + TSmallBlockSpanHeader.NextPartiallyFreeSpan and TSmallBlockSpanHeader.PreviousPartiallyFreeSpan.} + FirstPartiallyFreeSpan: PSmallBlockSpanHeader; //Do not change position + LastPartiallyFreeSpan: PSmallBlockSpanHeader; //Do not change position + + {The offset from the start of SequentialFeedSmallBlockSpan of the last block that was fed sequentially, as well as + an ABA counter to solve concurrency issues.} + LastSmallBlockSequentialFeedOffset: TIntegerWithABACounter; + + {The span that is current being used to serve blocks in sequential order, from the last block down to the first.} + SequentialFeedSmallBlockSpan: PSmallBlockSpanHeader; + + {Singly linked list of blocks in this arena that should be freed. If a block must be freed but the arena is + currently locked by another thread then the block is added to the head of this list. It is the responsibility of + the next thread that locks this arena to clean up this list.} + PendingFreeList: Pointer; + + {The fixed size move procedure used to move data for this block size when it is upsized. When a block is downsized + (which typically occurs less often) the variable size move routine is used.} + UpsizeMoveProcedure: TMoveProc; + + {0 = unlocked, 1 = locked, cannot be Boolean due to RSP-25672} + SmallBlockManagerLocked: Integer; + + {The minimum and optimal size of a small block span for this block type} + MinimumSpanSize: Integer; + OptimalSpanSize: Integer; + + {The block size for this small block manager} + BlockSize: Word; + +{$ifdef 64Bit} + Padding: array[0..1] of Byte; +{$else} + Padding: array[0..21] of Byte; +{$endif} + end; + PSmallBlockManager = ^TSmallBlockManager; + + TSmallBlockArena = array[0..CSmallBlockTypeCount - 1] of TSmallBlockManager; + PSmallBlockArena = ^TSmallBlockArena; + + TSmallBlockArenas = array[0..CFastMM_SmallBlockArenaCount - 1] of TSmallBlockArena; + + {This is always 64 bytes in size in order to ensure proper alignment of small blocks under all circumstances.} + TSmallBlockSpanHeader = packed record + {The next and previous spans in this arena that have free blocks of this size. These fields must be at the same + offsets as TSmallBlockManager.FirstPartiallyFreeSpan and TSmallBlockManager.LastPartiallyFreeSpan.} + NextPartiallyFreeSpan: PSmallBlockSpanHeader; //Do not change position + PreviousPartiallyFreeSpan: PSmallBlockSpanHeader; //Do not change position + {Pointer to the first free block inside this span.} + FirstFreeBlock: Pointer; + {Pointer to the small block manager to which this span belongs.} + SmallBlockManager: PSmallBlockManager; + {The total number of blocks in this small block span.} + TotalBlocksInSpan: Integer; + {The number of blocks currently in use in this small block span.} + BlocksInUse: Integer; +{$ifdef 64Bit} + Padding: array[0..21] of Byte; +{$else} + Padding: array[0..37] of Byte; +{$endif} + {The header for the first block} + FirstBlockHeader: TSmallBlockHeader; + end; + + {------------------------Medium block structures------------------------} + + TMediumBlockHeader = packed record + + {Multiply with CMediumBlockAlignment in order to get the size of the block.} + MediumBlockSizeMultiple: Word; + + {The offset from the start of medium block span header to the start of the block. Multiply this with + CMediumBlockAlignment and subtract the result from the pointer in order to obtain the address of the medium block + span.} + MediumBlockSpanOffsetMultiple: Word; + + {True if the previous medium block in the medium block span is free. If this is True then the size of the previous + block will be stored in the Integer immediately preceding this header.} + PreviousBlockIsFree: Boolean; + {True if this medium block is used as a small block span.} + IsSmallBlockSpan: Boolean; + {The block status and type} + BlockStatusFlags: TBlockStatusFlags; + end; +{$PointerMath On} + PMediumBlockHeader = ^TMediumBlockHeader; +{$PointerMath Off} + + {Medium block layout: + Offset: - SizeOf(TMediumBlockHeader) - 4 = Integer containing the previous block size (only if PreviousBlockIsFree = True) + Offset: - SizeOf(TMediumBlockHeader) = This block's header + Offset: 0 = User data / Pointer to previous free block (if this block is free) + Offset: SizeOf(Pointer) = Next Free Block (if this block is free) + Offset: BlockSize - SizeOf(TMediumBlockHeader) - 4 = Size of this block (if this block is free) + Offset: BlockSize - SizeOf(TMediumBlockHeader) = Header for the next block} + + PMediumBlockManager = ^TMediumBlockManager; + + {The medium block span from which medium blocks are drawn. This is always 64 bytes in size.} + PMediumBlockSpanHeader = ^TMediumBlockSpanHeader; + TMediumBlockSpanHeader = packed record + {Points to the previous and next medium block spans. This circular linked list is used to track memory leaks on + program shutdown. Must be at the same offsets as TMediumBlockManager.FirstMediumBlockSpanHeader and + TMediumBlockManager.LastMediumBlockSpanHeader.} + NextMediumBlockSpanHeader: PMediumBlockSpanHeader; //Do not change position + PreviousMediumBlockSpanHeader: PMediumBlockSpanHeader; //Do not change position + {The manager for the arena to which this medium block span belongs.} + MediumBlockManager: PMediumBlockManager; + {The size of this medium block span, in bytes.} + SpanSize: Integer; +{$ifdef 64Bit} + Padding: array[0..27] of Byte; +{$else} + Padding: array[0..39] of Byte; +{$endif} + {The header for the first block} + FirstBlockHeader: TMediumBlockHeader; + end; + + {The contents of a medium block that is unused. This data follows the block header.} + PMediumFreeBlockContent = ^TMediumFreeBlockContent; + TMediumFreeBlockContent = record + {This will point to the bin if this is the last free medium block in the bin.} + NextFreeMediumBlock: PMediumFreeBlockContent; + {This will point to the bin if this is the first free medium block in the bin.} + PreviousFreeMediumBlock: PMediumFreeBlockContent; + end; + + {Free medium blocks always store their size before the header of the next block} + TMediumFreeBlockFooter = packed record + MediumFreeBlockSize: Integer; + NextBlockHeader: TMediumBlockHeader; + end; +{$PointerMath On} + PMediumFreeBlockFooter = ^TMediumFreeBlockFooter; +{$PointerMath Off} + + {Medium block manager. It should preferably be aligned to 64 bytes.} + TMediumBlockManager = record + {Maintains a circular list of all medium block spans to enable memory leak detection on program shutdown. These + fields must be at the same position as the corresponding fields in TMediumBlockSpanHeader.} + FirstMediumBlockSpanHeader: PMediumBlockSpanHeader; //Do not change position + LastMediumBlockSpanHeader: PMediumBlockSpanHeader; //Do not change position + + {The sequential feed medium block span.} + LastMediumBlockSequentialFeedOffset: TIntegerWithABACounter; + SequentialFeedMediumBlockSpan: PMediumBlockSpanHeader; + + {Singly linked list of blocks in this arena that should be freed. If a block must be freed but the arena is + currently locked by another thread then the block is added to the head of this list. It is the responsibility of + the next thread that locks this arena to clean up this list.} + PendingFreeList: Pointer; + {0 = unlocked, 1 = locked, cannot be Boolean due to RSP-25672} + MediumBlockManagerLocked: Integer; + + {The medium block bins are divided into groups of 32 bins. If a bit is set in this group bitmap, then at least one + bin in the group has free blocks.} + MediumBlockBinGroupBitmap: Cardinal; + {The medium block bins: total of 32 * 32 = 1024 bins of a certain minimum size. The minimum size of blocks in the + first bin will be CMinimumMediumBlockSize.} + MediumBlockBinBitmaps: array[0..CMediumBlockBinGroupCount - 1] of Cardinal; + {The medium block bins. There are 1024 LIFO circular linked lists each holding blocks of a specified minimum size. + The bin sizes vary from CMinimumMediumBlockSize to CMaximumMediumBlockSize. The value for each bin is a pointer to + the first free medium block in the bin. Will point to itself if the bin is empty. The last block in the bin will + point back to the bin.} + FirstFreeBlockInBin: array[0..CMediumBlockBinCount - 1] of Pointer; + end; + + TMediumBlockArenas = array[0..CFastMM_MediumBlockArenaCount - 1] of TMediumBlockManager; + + {-------------------------Large block structures------------------------} + + PLargeBlockManager = ^TLargeBlockManager; + + {Large block header. Always 64 bytes in size.} + {$PointerMath On} + PLargeBlockHeader = ^TLargeBlockHeader; + {$PointerMath Off} + TLargeBlockHeader = packed record + {Points to the previous and next large blocks. This circular linked list is used to track memory leaks on program + shutdown.} + NextLargeBlockHeader: PLargeBlockHeader; //Do not change position + PreviousLargeBlockHeader: PLargeBlockHeader; //Do not change position + {The large block manager for the arena to which this block belongs.} + LargeBlockManager: PLargeBlockManager; + {The actual block size as obtained from the operating system.} + ActualBlockSize: NativeInt; + {The user allocated size of the large block} + UserAllocatedSize: NativeInt; + {If True then the large block is built up from more than one chunk allocated through VirtualAlloc} + BlockIsSegmented: Boolean; + {Alignment padding} +{$ifdef 64Bit} + Padding: array[0..20] of Byte; +{$else} + Padding: array[0..40] of Byte; +{$endif} + {The block status and type} + BlockStatusFlags: TBlockStatusFlags; + end; + + TLargeBlockManager = record + {Maintains a circular list of all large blocks to enable memory leak detection on program shutdown.} + FirstLargeBlockHeader: PLargeBlockHeader; //Do not change position + LastLargeBlockHeader: PLargeBlockHeader; //Do not change position + {Singly linked list of blocks in this arena that should be freed. If a block must be freed but the arena is + currently locked by another thread then the block is added to the head of this list. It is the responsibility of + the next thread that locks this arena to clean up this list.} + PendingFreeList: Pointer; + {0 = unlocked, 1 = locked, cannot be Boolean due to RSP-25672} + LargeBlockManagerLocked: Integer; //0 = unlocked, 1 = locked +{$ifdef 64Bit} + Padding: array[0..35] of Byte; +{$else} + Padding: array[0..47] of Byte; +{$endif} + end; + + TLargeBlockArenas = array[0..CFastMM_LargeBlockArenaCount - 1] of TLargeBlockManager; + + {-------------------------Expected Memory Leak Structures--------------------} + + {The layout of an expected leak. All fields may not be specified, in which case it may be harder to determine which + leaks are expected and which are not.} + PExpectedMemoryLeak = ^TExpectedMemoryLeak; + PPExpectedMemoryLeak = ^PExpectedMemoryLeak; + TExpectedMemoryLeak = record + {Leaks are maintained in doubly linked list.} + PreviousLeak, NextLeak: PExpectedMemoryLeak; + LeakAddress: Pointer; + LeakedClass: TClass; + LeakSize: NativeInt; + LeakCount: Integer; + end; + + TExpectedMemoryLeaks = record + {The number of entries used in the expected leaks buffer} + EntriesUsed: Integer; + {Freed entries that are available for reuse} + FirstFreeSlot: PExpectedMemoryLeak; + {Entries with the address specified} + FirstEntryByAddress: PExpectedMemoryLeak; + {Entries with no address specified, but with the class specified} + FirstEntryByClass: PExpectedMemoryLeak; + {Entries with only size specified} + FirstEntryBySizeOnly: PExpectedMemoryLeak; + {The expected leaks buffer (Need to leave space for this header)} + ExpectedLeaks: array[0..(CExpectedMemoryLeaksListSize - 64) div SizeOf(TExpectedMemoryLeak) - 1] of TExpectedMemoryLeak; + end; + PExpectedMemoryLeaks = ^TExpectedMemoryLeaks; + + {-------Memory leak reporting structures--------} + + TMemoryLeakType = (mltUnexpectedLeak, mltExpectedLeakRegisteredByPointer, mltExpectedLeakRegisteredByClass, + mltExpectedLeakRegisteredBySize); + + TMemoryAccessRight = (marExecute, marRead, marWrite); + TMemoryAccessRights = set of TMemoryAccessRight; + TMemoryRegionInfo = record + RegionStartAddress: Pointer; + RegionSize: NativeUInt; + RegionIsFree: Boolean; + AccessRights: TMemoryAccessRights; + end; + + {An entry in the binary search tree of memory leaks. Leaks are grouped by block size and class.} + TMemoryLeakSummaryEntry = record + {The user size of the block} + BlockUsableSize: NativeInt; + {The content of the leaked block.} + BlockContentType: NativeUInt; //0 = unknown, 1 = AnsiString, 2 = UnicodeString, other values = class pointer + {The number of leaks of this block size and content type.} + NumLeaks: NativeInt; + {The indexes of the left (False) and right (True) leaks in the binary search tree.} + ChildIndexes: array[Boolean] of Integer; + end; + PMemoryLeakSummaryEntry = ^TMemoryLeakSummaryEntry; + + TMemoryLeakSummary = record + MemoryLeakEntries: array[0..4095] of TMemoryLeakSummaryEntry; + LeakCount: Integer; + end; + PMemoryLeakSummary = ^TMemoryLeakSummary; + + {-------Catching virtual calls on freed objects--------} + + {When a debug block is freed the header is set to point to this class in order to catch virtual method calls on a + freed object.} + TFastMM_FreedObject = class(TObject) + protected + class var FVirtualMethodStackTrace: TFastMM_MaximumLengthStackTrace; + procedure VirtualMethodOnFreedObject_LogEvent(APMethodName: PWideChar); + procedure VirtualMethodOnFreedObject(APMethodName: PWideChar); overload; + procedure VirtualMethodOnFreedObject(AIndex: Byte); overload; + public + {Virtual method calls that will redirect to VirtualMethodOnFreedObject} + function Equals(Obj: TObject): Boolean; override; + function GetHashCode: Integer; override; + function ToString: string; override; + function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + procedure Dispatch(var Message); override; + procedure DefaultHandler(var Message); override; + procedure FreeInstance; override; + destructor Destroy; override; + {Virtual method intercepts - these will redirect to VirtualMethodOnFreedObject} + procedure VirtualMethod0; virtual; procedure VirtualMethod1; virtual; procedure VirtualMethod2; virtual; + procedure VirtualMethod3; virtual; procedure VirtualMethod4; virtual; procedure VirtualMethod5; virtual; + procedure VirtualMethod6; virtual; procedure VirtualMethod7; virtual; procedure VirtualMethod8; virtual; + procedure VirtualMethod9; virtual; procedure VirtualMethod10; virtual; procedure VirtualMethod11; virtual; + procedure VirtualMethod12; virtual; procedure VirtualMethod13; virtual; procedure VirtualMethod14; virtual; + procedure VirtualMethod15; virtual; procedure VirtualMethod16; virtual; procedure VirtualMethod17; virtual; + procedure VirtualMethod18; virtual; procedure VirtualMethod19; virtual; procedure VirtualMethod20; virtual; + procedure VirtualMethod21; virtual; procedure VirtualMethod22; virtual; procedure VirtualMethod23; virtual; + procedure VirtualMethod24; virtual; procedure VirtualMethod25; virtual; procedure VirtualMethod26; virtual; + procedure VirtualMethod27; virtual; procedure VirtualMethod28; virtual; procedure VirtualMethod29; virtual; + procedure VirtualMethod30; virtual; procedure VirtualMethod31; virtual; procedure VirtualMethod32; virtual; + procedure VirtualMethod33; virtual; procedure VirtualMethod34; virtual; procedure VirtualMethod35; virtual; + procedure VirtualMethod36; virtual; procedure VirtualMethod37; virtual; procedure VirtualMethod38; virtual; + procedure VirtualMethod39; virtual; procedure VirtualMethod40; virtual; procedure VirtualMethod41; virtual; + procedure VirtualMethod42; virtual; procedure VirtualMethod43; virtual; procedure VirtualMethod44; virtual; + procedure VirtualMethod45; virtual; procedure VirtualMethod46; virtual; procedure VirtualMethod47; virtual; + procedure VirtualMethod48; virtual; procedure VirtualMethod49; virtual; procedure VirtualMethod50; virtual; + procedure VirtualMethod51; virtual; procedure VirtualMethod52; virtual; procedure VirtualMethod53; virtual; + procedure VirtualMethod54; virtual; procedure VirtualMethod55; virtual; procedure VirtualMethod56; virtual; + procedure VirtualMethod57; virtual; procedure VirtualMethod58; virtual; procedure VirtualMethod59; virtual; + procedure VirtualMethod60; virtual; procedure VirtualMethod61; virtual; procedure VirtualMethod62; virtual; + procedure VirtualMethod63; virtual; procedure VirtualMethod64; virtual; procedure VirtualMethod65; virtual; + procedure VirtualMethod66; virtual; procedure VirtualMethod67; virtual; procedure VirtualMethod68; virtual; + procedure VirtualMethod69; virtual; procedure VirtualMethod70; virtual; procedure VirtualMethod71; virtual; + procedure VirtualMethod72; virtual; procedure VirtualMethod73; virtual; procedure VirtualMethod74; virtual; + end; + + {-------Legacy debug support DLL interface--------} + {The interface for the legacy (version 4) stack trace conversion routine in the FastMM_FullDebugMode library.} + TFastMM_LegacyConvertStackTraceToText = function(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBuffer: PAnsiChar): PAnsiChar; + +const + {Structure size constants} + CBlockStatusFlagsSize = SizeOf(TBlockStatusFlags); + CSmallBlockHeaderSize = SizeOf(TSmallBlockHeader); + CMediumBlockHeaderSize = SizeOf(TMediumBlockHeader); + CMediumFreeBlockFooterSize = SizeOf(TMediumFreeBlockFooter); + CLargeBlockHeaderSize = SizeOf(TLargeBlockHeader); + CDebugBlockHeaderSize = SizeOf(TFastMM_DebugBlockHeader); + CDebugBlockFooterCheckSumSize = SizeOf(Cardinal); + + CSmallBlockSpanHeaderSize = SizeOf(TSmallBlockSpanHeader); + CMediumBlockSpanHeaderSize = SizeOf(TMediumBlockSpanHeader); + + CSmallBlockManagerSize = SizeOf(TSmallBlockManager); + CSmallBlockManagerSizeBits = 6; + + CMediumBlockManagerSize = SizeOf(TMediumBlockManager); + + CLargeBlockManagerSize = SizeOf(TLargeBlockManager); + + {Small block sizes (including the header). The 8 byte aligned sizes are not available under 64-bit. The first block + in a small block span is always 64 byte aligned, so if a block size is a multiple of 8 it will be 8 byte aligned, a + multiple of 16 will be 16 byte aligned, a multiple of 32 will be 32 byte aligned, etc.} + CSmallBlockSizes: array[0..CSmallBlockTypeCount - 1] of Word = ( + {8 byte jumps} +{$ifdef 32Bit} + 8, +{$endif} + 16, +{$ifdef 32Bit} + 24, +{$endif} + 32, +{$ifdef 32Bit} + 40, +{$endif} + 48, +{$ifdef 32Bit} + 56, +{$endif} + 64, +{$ifdef 32Bit} + 72, +{$endif} + 80, +{$ifdef 32Bit} + 88, +{$endif} + 96, +{$ifdef 32Bit} + 104, +{$endif} + 112, +{$ifdef 32Bit} + 120, +{$endif} + 128, +{$ifdef 32Bit} + 136, +{$endif} + 144, +{$ifdef 32Bit} + 152, +{$endif} + 160, + {16 byte jumps} + 176, + 192, + 208, + 224, + 240, + 256, + 272, + 288, + 304, + 320, + {32 byte jumps} + 352, + 384, + 416, + 448, + 480, + 512, + 544, + 576, + 608, + 640, + {64 byte jumps} + 704, + 768, + 832, + 896, + 960, + 1024, + 1088, + 1152, + 1216, + 1280, + 1344, + {128 byte jumps} + 1472, + 1600, + 1728, + 1856, + 1984, + 2112, + 2240, + 2368, + 2496, + CMaximumSmallBlockSize // = 2624 + ); + +var + {Lookup table for converting a block size to a small block type index from 0..CSmallBlockTypeCount - 1} + SmallBlockTypeLookup: array[0.. CMaximumSmallBlockSize div CSmallBlockGranularity - 1] of Byte; + + {The small block managers. Every arena has a separate manager for each small block size. This should ideally be + aligned on a 64-byte (cache line) boundary in order to prevent false dependencies between adjacent small block + managers (RSP-28144).} + SmallBlockManagers: TSmallBlockArenas; + + {The default size of new medium block spans. Must be a multiple of 64K and may not exceed CMaximumMediumBlockSpanSize.} + DefaultMediumBlockSpanSize: Integer; + + {The medium block manager for each medium block arena.} + MediumBlockManagers: TMediumBlockArenas; + + {The large block manager for each large block arena.} + LargeBlockManagers: TLargeBlockArenas; + + {Counts the number of time FastMM_EnterMinimumAddressAlignment less the number of times + FastMM_ExitMinimumAddressAlignment has been called for each alignment type.} + AlignmentRequestCounters: array[TFastMM_MinimumAddressAlignment] of Integer; + + {The current optimization stategy in effect.} + OptimizationStrategy: TFastMM_MemoryManagerOptimizationStrategy; + +{$ifdef 32Bit} + {Pointer to the emergency reserve address space. This allows some subsequent memory allocation requests to succeed + in order to allow the application to allocate some memory for error handling, etc. in response to the first + EOutOfMemory exception. This only applies to 32-bit applications.} + EmergencyReserveAddressSpace: Pointer; +{$endif} + + {The amount of address space that is currently allocated.} + MemoryUsageCurrent: NativeUInt; + + {The current memory usage limit. 0 = no limit.} + MemoryUsageLimit: NativeUInt; + MemoryUsageLimitGraceAmount: NativeUInt; + + {True between the FastMM_Initialize call and the FastMM_Finalize call.} + UnitCurrentlyInitialized: Boolean; + {The current installation state of FastMM.} + CurrentInstallationState: TFastMM_MemoryManagerInstallationState; + + {The difference between the number of times EnterDebugMode has been called vs ExitDebugMode.} + DebugModeCounter: Integer; + + {The number of entries in stack traces in debug mode.} + DebugMode_StackTrace_EntryCount: Byte; + + {A lock that allows switching between debug and normal mode to be thread safe.} + SettingMemoryManager: Integer; //0 = False, 1 = True; + + {The memory manager that was in place before this memory manager was installed.} + PreviousMemoryManager: TMemoryManagerEx; + {The memory manager that is currently set. This is used to detect the installation of another 3rd party memory + manager which would prevent the switching between debug and normal mode.} + InstalledMemoryManager: TMemoryManagerEx; + {The handle to the debug mode support DLL.} +{$ifndef FastMM_DebugLibraryStaticDependency} + DebugSupportLibraryHandle: NativeUInt; +{$endif} + DebugSupportConfigured: Boolean; + + {The full path and filename for the event log.} + EventLogFilename: array[0..CFilenameMaxLength] of WideChar; + {The file handle for the event log while it is open.} + EventLogFileHandle: THandle; + + {The expected memory leaks list} + ExpectedMemoryLeaks: PExpectedMemoryLeaks; + ExpectedMemoryLeaksListLocked: Integer; //1 = Locked + +{$ifdef MSWindows} + {A string uniquely identifying the current process (for sharing the memory manager between DLLs and the main + application).} + SharingFileMappingObjectName: array[0..25] of AnsiChar = ('L', 'o', 'c', 'a', 'l', '\', 'F', 'a', 's', 't', 'M', 'M', + '_', 'P', 'I', 'D', '_', '?', '?', '?', '?', '?', '?', '?', '?', #0); + {The handle of the memory mapped file.} + SharingFileMappingObjectHandle: NativeUInt; +{$endif} + +{$ifndef FastMM_DebugLibraryStaticDependency} + {The stack trace routines from the FastMM_FullDebugMode support DLL. These will only be set if the support DLL is + loaded.} + DebugLibrary_GetRawStackTrace: TFastMM_GetStackTrace; + DebugLibrary_GetFrameBasedStackTrace: TFastMM_GetStackTrace; + {The legacy stack trace to text conversion routine from the FastMM_FullDebugMode support DLL. This will only be set + if the support DLL is loaded. This is used by the FastMM_DebugLibrary_LegacyLogStackTrace_Wrapper function.} + DebugLibrary_LogStackTrace_Legacy: TFastMM_LegacyConvertStackTraceToText; +{$else} +procedure DebugLibrary_GetRawStackTrace(APReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); + external CFastMM_DefaultDebugSupportLibraryName name 'GetRawStackTrace'; +procedure DebugLibrary_GetFrameBasedStackTrace(APReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); + external CFastMM_DefaultDebugSupportLibraryName name 'GetFrameBasedStackTrace'; +function DebugLibrary_LogStackTrace_Legacy(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBuffer: PAnsiChar): PAnsiChar; external CFastMM_DefaultDebugSupportLibraryName name 'LogStackTrace'; +{$endif} + +{--------------------------------------------------------} +{--------------Debug header record methods---------------} +{--------------------------------------------------------} + +{ TFastMM_DebugBlockHeader } + +function TFastMM_DebugBlockHeader.DebugFooterPtr: PCardinal; +begin + {The block footer follows immediately after the user data, the first dword of which is the footer checksum.} + Result := @PByte(@Self)[UserSize + CDebugBlockHeaderSize]; +end; + +function TFastMM_DebugBlockHeader.DebugFooter_AllocationStackTracePtr: PNativeUInt; +begin + {The allocation stack trace follows immediately after the footer checksum.} + Result := @PByte(@Self)[UserSize + (CDebugBlockHeaderSize + CDebugBlockFooterCheckSumSize)]; +end; + +function TFastMM_DebugBlockHeader.DebugFooter_FreeStackTracePtr: PNativeUInt; +begin + {The free stack trace follows immediately after the allocation stack trace.} + Result := @PByte(@Self)[UserSize + (StackTraceEntryCount * SizeOf(Pointer)) + + (CDebugBlockHeaderSize + CDebugBlockFooterCheckSumSize)]; +end; + +procedure TFastMM_DebugBlockHeader.CalculateAndSetHeaderAndFooterCheckSums; +begin + HeaderCheckSum := CalculateHeaderCheckSum; + DebugFooterPtr^ := CalculateFooterCheckSum; +end; + +function TFastMM_DebugBlockHeader.CalculateFooterCheckSum: Cardinal; +var + LPCurPos, LPEnd: PCardinal; +begin + LPCurPos := PCardinal(DebugFooter_AllocationStackTracePtr); + LPEnd := @PByte(LPCurPos)[StackTraceEntryCount * (2 * SizeOf(Pointer))]; + + Result := Cardinal(-1); + while LPCurPos <> LPEnd do + begin + Result := Result xor LPCurPos^; + Inc(LPCurPos); + end; +end; + +function TFastMM_DebugBlockHeader.CalculateHeaderCheckSum: Cardinal; +var + LPCurPos, LPEnd: PCardinal; +begin + LPCurPos := @HeaderCheckSum; + LPEnd := @PByte(@Self)[CDebugBlockHeaderSize]; + + Result := Cardinal(-1); + while True do + begin + Inc(LPCurPos); + if LPCurPos = LPEnd then + Break; + + Result := Result xor LPCurPos^; + end; +end; + +{------------------------------------------} +{--------------Move routines---------------} +{------------------------------------------} + +{Moves 16 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned for 32-bit code and 16 byte +aligned for 64-bit code, and the buffers may not overlap.} +procedure Move16(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + .noframe + movdqa xmm0, [rcx] + movdqa [rdx], xmm0 +{$endif} +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; +{$endif} +end; + +{Moves 32 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned for 32-bit code and 16 byte +aligned for 64-bit code, and the buffers may not overlap.} +procedure Move32(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + .noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 +{$endif} +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; + PInt64Array(@ADest)[3] := PInt64Array(@ASource)[3]; +{$endif} +end; + +{Moves 48 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned for 32-bit code and 16 byte +aligned for 64-bit code, and the buffers may not overlap.} +procedure Move48(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + .noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 +{$endif} +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; + PInt64Array(@ADest)[3] := PInt64Array(@ASource)[3]; + PInt64Array(@ADest)[4] := PInt64Array(@ASource)[4]; + PInt64Array(@ADest)[5] := PInt64Array(@ASource)[5]; +{$endif} +end; + +{Moves 64 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned for 32-bit code and 16 byte +aligned for 64-bit code, and the buffers may not overlap.} +procedure Move64(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + fild qword ptr [eax + 48] + fild qword ptr [eax + 56] + fistp qword ptr [edx + 56] + fistp qword ptr [edx + 48] + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} + .noframe + movdqa xmm0, [rcx] + movdqa xmm1, [rcx + 16] + movdqa xmm2, [rcx + 32] + movdqa xmm3, [rcx + 48] + movdqa [rdx], xmm0 + movdqa [rdx + 16], xmm1 + movdqa [rdx + 32], xmm2 + movdqa [rdx + 48], xmm3 +{$endif} +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; + PInt64Array(@ADest)[3] := PInt64Array(@ASource)[3]; + PInt64Array(@ADest)[4] := PInt64Array(@ASource)[4]; + PInt64Array(@ADest)[5] := PInt64Array(@ASource)[5]; + PInt64Array(@ADest)[6] := PInt64Array(@ASource)[6]; + PInt64Array(@ADest)[7] := PInt64Array(@ASource)[7]; +{$endif} +end; + +{Blocks under 64-bit are always a multiple of 16 bytes, so the 8 byte multiple moves are not needed under 64-bit.} +{$ifdef 32Bit} +{Moves 8 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned and the buffers may not overlap.} +procedure Move8(const ASource; var ADest; ACount: NativeInt); +{$ifdef X86ASM} +asm + fild qword ptr [eax] + fistp qword ptr [edx] +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; +{$endif} +end; + +{Moves 24 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned and the buffers may not overlap.} +procedure Move24(const ASource; var ADest; ACount: NativeInt); +{$ifdef X86ASM} +asm + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; +{$endif} +end; + +{Moves 40 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned and the buffers may not overlap.} +procedure Move40(const ASource; var ADest; ACount: NativeInt); +{$ifdef X86ASM} +asm + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; + PInt64Array(@ADest)[3] := PInt64Array(@ASource)[3]; + PInt64Array(@ADest)[4] := PInt64Array(@ASource)[4]; +{$endif} +end; + +{Moves 56 bytes from ASource to ADest. Both ASource and ADest must be 8 byte aligned and the buffers may not overlap.} +procedure Move56(const ASource; var ADest; ACount: NativeInt); +{$ifdef X86ASM} +asm + fild qword ptr [eax] + fild qword ptr [eax + 8] + fild qword ptr [eax + 16] + fild qword ptr [eax + 24] + fild qword ptr [eax + 32] + fild qword ptr [eax + 40] + fild qword ptr [eax + 48] + fistp qword ptr [edx + 48] + fistp qword ptr [edx + 40] + fistp qword ptr [edx + 32] + fistp qword ptr [edx + 24] + fistp qword ptr [edx + 16] + fistp qword ptr [edx + 8] + fistp qword ptr [edx] +{$else} +begin + PInt64Array(@ADest)[0] := PInt64Array(@ASource)[0]; + PInt64Array(@ADest)[1] := PInt64Array(@ASource)[1]; + PInt64Array(@ADest)[2] := PInt64Array(@ASource)[2]; + PInt64Array(@ADest)[3] := PInt64Array(@ASource)[3]; + PInt64Array(@ADest)[4] := PInt64Array(@ASource)[4]; + PInt64Array(@ADest)[5] := PInt64Array(@ASource)[5]; + PInt64Array(@ADest)[6] := PInt64Array(@ASource)[6]; +{$endif} +end; + +{Moves 8x bytes from ASource to ADest, where x is an integer >= 1. ASource and ADest are assumed to be aligned on a 8 +byte boundary. The source and destination buffers may not overlap. ACount will be rounded up to a multiple of 8.} +procedure MoveMultipleOf8(const ASource; var ADest; ACount: NativeInt); +{$ifdef X86ASM} +asm + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + fild qword ptr [eax + ecx] + fistp qword ptr [edx + ecx] + add ecx, 8 + js @MoveLoop +{$else} +var + LPSource, LPDest: PByte; +begin + LPSource := @PByte(@ASource)[ACount]; + LPDest := @PByte(@ADest)[ACount]; + ACount := - ACount; + + while True do + begin + PInt64Array(@LPDest[ACount])[0] := PInt64Array(@LPSource[ACount])[0]; + + Inc(ACount, 8); + if ACount >= 0 then + Break; + end; +{$endif} +end; + +{$ifdef X86ASM} + +{Multiple of 16 moves for x86 SSE2. Both ASource and ADest must be aligned on a 8 byte boundary.} + +procedure Move16_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + movdqu xmm0, [eax] + movdqu [edx], xmm0 +end; + +procedure Move32_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + movdqu xmm0, [eax] + movdqu xmm1, [eax + 16] + movdqu [edx], xmm0 + movdqu [edx + 16], xmm1 +end; + +procedure Move48_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + movdqu xmm0, [eax] + movdqu xmm1, [eax + 16] + movdqu xmm2, [eax + 32] + movdqu [edx], xmm0 + movdqu [edx + 16], xmm1 + movdqu [edx + 32], xmm2 +end; + +procedure Move64_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + movdqu xmm0, [eax] + movdqu xmm1, [eax + 16] + movdqu xmm2, [eax + 32] + movdqu xmm3, [eax + 48] + movdqu [edx], xmm0 + movdqu [edx + 16], xmm1 + movdqu [edx + 32], xmm2 + movdqu [edx + 48], xmm3 +end; + +procedure MoveMultipleOf16_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + movdqu xmm0, [eax + ecx] + movdqu [edx + ecx], xmm0 + add ecx, 16 + js @MoveLoop +end; + +procedure MoveMultipleOf32_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + movdqu xmm0, [eax + ecx] + movdqu xmm1, [eax + ecx + 16] + movdqu [edx + ecx], xmm0 + movdqu [edx + ecx + 16], xmm1 + add ecx, 32 + js @MoveLoop +end; + +procedure MoveMultipleOf64_Small_x86_SSE2(const ASource; var ADest; ACount: NativeInt); +asm + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + movdqu xmm0, [eax + ecx] + movdqu xmm1, [eax + ecx + 16] + movdqu xmm2, [eax + ecx + 32] + movdqu xmm3, [eax + ecx + 48] + movdqu [edx + ecx], xmm0 + movdqu [edx + ecx + 16], xmm1 + movdqu [edx + ecx + 32], xmm2 + movdqu [edx + ecx + 48], xmm3 + add ecx, 64 + js @MoveLoop +end; +{$endif} + +{$endif} + +{Moves 16x bytes from ASource to ADest, where x is an integer >= 1. Both ASource and ADest must be 8 byte aligned for +32-bit code and 16 byte aligned for 64-bit code, and the buffers may not overlap. ACount will be rounded up to a +multiple of 16.} +procedure MoveMultipleOf16(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + fild qword ptr [eax + ecx] + fild qword ptr [eax + ecx + 8] + fistp qword ptr [edx + ecx + 8] + fistp qword ptr [edx + ecx] + add ecx, 16 + js @MoveLoop +{$else} + .noframe + add rcx, r8 + add rdx, r8 + neg r8 +@MoveLoop: + movdqa xmm0, [rcx + r8] + movdqa [rdx + r8], xmm0 + add r8, 16 + js @MoveLoop +{$endif} +{$else} +var + LPSource, LPDest: PByte; +begin + LPSource := @PByte(@ASource)[ACount]; + LPDest := @PByte(@ADest)[ACount]; + ACount := - ACount; + + while True do + begin + PInt64Array(@LPDest[ACount])[0] := PInt64Array(@LPSource[ACount])[0]; + PInt64Array(@LPDest[ACount])[1] := PInt64Array(@LPSource[ACount])[1]; + + Inc(ACount, 16); + if ACount >= 0 then + Break; + end; +{$endif} +end; + +{Moves 32x bytes from ASource to ADest, where x is an integer >= 1. Both ASource and ADest must be 8 byte aligned for +32-bit code and 16 byte aligned for 64-bit code, and the buffers may not overlap. ACount will be rounded up to a +multiple of 32.} +procedure MoveMultipleOf32(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + fild qword ptr [eax + ecx] + fild qword ptr [eax + ecx + 8] + fild qword ptr [eax + ecx + 16] + fild qword ptr [eax + ecx + 24] + fistp qword ptr [edx + ecx + 24] + fistp qword ptr [edx + ecx + 16] + fistp qword ptr [edx + ecx + 8] + fistp qword ptr [edx + ecx] + add ecx, 32 + js @MoveLoop +{$else} + .noframe + add rcx, r8 + add rdx, r8 + neg r8 +@MoveLoop: + movdqa xmm0, [rcx + r8] + movdqa xmm1, [rcx + r8 + 16] + movdqa [rdx + r8], xmm0 + movdqa [rdx + r8 + 16], xmm1 + add r8, 32 + js @MoveLoop +{$endif} +{$else} +var + LPSource, LPDest: PByte; +begin + LPSource := @PByte(@ASource)[ACount]; + LPDest := @PByte(@ADest)[ACount]; + ACount := - ACount; + + while True do + begin + PInt64Array(@LPDest[ACount])[0] := PInt64Array(@LPSource[ACount])[0]; + PInt64Array(@LPDest[ACount])[1] := PInt64Array(@LPSource[ACount])[1]; + PInt64Array(@LPDest[ACount])[2] := PInt64Array(@LPSource[ACount])[2]; + PInt64Array(@LPDest[ACount])[3] := PInt64Array(@LPSource[ACount])[3]; + + Inc(ACount, 32); + if ACount >= 0 then + Break; + end; +{$endif} +end; + +{Moves 64x bytes from ASource to ADest, where x is an integer >= 1. Both ASource and ADest must be 8 byte aligned for +32-bit code and 16 byte aligned for 64-bit code, and the buffers may not overlap. ACount will be rounded up to a +multiple of 64.} +procedure MoveMultipleOf64_Small(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + add eax, ecx + add edx, ecx + neg ecx +@MoveLoop: + fild qword ptr [eax + ecx] + fild qword ptr [eax + ecx + 8] + fild qword ptr [eax + ecx + 16] + fild qword ptr [eax + ecx + 24] + fild qword ptr [eax + ecx + 32] + fild qword ptr [eax + ecx + 40] + fild qword ptr [eax + ecx + 48] + fild qword ptr [eax + ecx + 56] + fistp qword ptr [edx + ecx + 56] + fistp qword ptr [edx + ecx + 48] + fistp qword ptr [edx + ecx + 40] + fistp qword ptr [edx + ecx + 32] + fistp qword ptr [edx + ecx + 24] + fistp qword ptr [edx + ecx + 16] + fistp qword ptr [edx + ecx + 8] + fistp qword ptr [edx + ecx] + add ecx, 64 + js @MoveLoop +{$else} + .noframe + add rcx, r8 + add rdx, r8 + neg r8 +@MoveLoop: + movdqa xmm0, [rcx + r8] + movdqa xmm1, [rcx + r8 + 16] + movdqa xmm2, [rcx + r8 + 32] + movdqa xmm3, [rcx + r8 + 48] + movdqa [rdx + r8], xmm0 + movdqa [rdx + r8 + 16], xmm1 + movdqa [rdx + r8 + 32], xmm2 + movdqa [rdx + r8 + 48], xmm3 + add r8, 64 + js @MoveLoop +{$endif} +{$else} +var + LPSource, LPDest: PByte; +begin + LPSource := @PByte(@ASource)[ACount]; + LPDest := @PByte(@ADest)[ACount]; + ACount := - ACount; + + while True do + begin + PInt64Array(@LPDest[ACount])[0] := PInt64Array(@LPSource[ACount])[0]; + PInt64Array(@LPDest[ACount])[1] := PInt64Array(@LPSource[ACount])[1]; + PInt64Array(@LPDest[ACount])[2] := PInt64Array(@LPSource[ACount])[2]; + PInt64Array(@LPDest[ACount])[3] := PInt64Array(@LPSource[ACount])[3]; + PInt64Array(@LPDest[ACount])[4] := PInt64Array(@LPSource[ACount])[4]; + PInt64Array(@LPDest[ACount])[5] := PInt64Array(@LPSource[ACount])[5]; + PInt64Array(@LPDest[ACount])[6] := PInt64Array(@LPSource[ACount])[6]; + PInt64Array(@LPDest[ACount])[7] := PInt64Array(@LPSource[ACount])[7]; + + Inc(ACount, 64); + if ACount >= 0 then + Break; + end; +{$endif} +end; + +{As above, but optimized for larger blocks. The startup cost for REP MOVS is high, but it is significantly faster with +large blocks on modern CPUs. If ACount is not a multiple of 64 then at least ACount bytes will be moved, possibly +more.} +procedure MoveMultipleOf64_Large(const ASource; var ADest; ACount: NativeInt); +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + cld + add ecx, 3 //round up the number of dwords + shr ecx, 2 + push esi + push edi + mov esi, eax + mov edi, edx + rep movsd + pop edi + pop esi +{$else} + .noframe + .pushnv rsi + .pushnv rdi + cld + add r8, 7 //round up the number of qwords + shr r8, 3 + mov rsi, rcx + mov rdi, rdx + mov rcx, r8 + rep movsq +{$endif} +{$else} +var + LPSource, LPDest: PByte; +begin + LPSource := @PByte(@ASource)[ACount]; + LPDest := @PByte(@ADest)[ACount]; + ACount := - ACount; + + while True do + begin + PInt64Array(@LPDest[ACount])[0] := PInt64Array(@LPSource[ACount])[0]; + PInt64Array(@LPDest[ACount])[1] := PInt64Array(@LPSource[ACount])[1]; + PInt64Array(@LPDest[ACount])[2] := PInt64Array(@LPSource[ACount])[2]; + PInt64Array(@LPDest[ACount])[3] := PInt64Array(@LPSource[ACount])[3]; + PInt64Array(@LPDest[ACount])[4] := PInt64Array(@LPSource[ACount])[4]; + PInt64Array(@LPDest[ACount])[5] := PInt64Array(@LPSource[ACount])[5]; + PInt64Array(@LPDest[ACount])[6] := PInt64Array(@LPSource[ACount])[6]; + PInt64Array(@LPDest[ACount])[7] := PInt64Array(@LPSource[ACount])[7]; + + Inc(ACount, 64); + if ACount >= 0 then + Break; + end; +{$endif} +end; + + +{------------------------------------------} +{---------Operating system calls-----------} +{------------------------------------------} + +procedure ReleaseEmergencyReserveAddressSpace; forward; +function CharCount(APFirstFreeChar, APBufferStart: PWideChar): Integer; forward; + +{Releases a block of memory back to the operating system. Returns 0 on success, -1 on failure.} +function OS_FreeVirtualMemory(APointer: Pointer; ABlockSize: NativeInt): Integer; +begin + if Winapi.Windows.VirtualFree(APointer, 0, MEM_RELEASE) then + begin + AtomicDecrement(MemoryUsageCurrent, NativeUInt(ABlockSize)); + Result := 0; + end + else + Result := -1; +end; + +{Allocates a block of memory from the operating system. The block will be aligned to at least a 64 byte boundary, and +will be zero initialized. Returns nil on error.} +function OS_AllocateVirtualMemory(ABlockSize: NativeInt; AAllocateTopDown: Boolean; + AReserveOnlyNoReadWriteAccess: Boolean): Pointer; +begin + if AReserveOnlyNoReadWriteAccess then + begin + Result := Winapi.Windows.VirtualAlloc(nil, ABlockSize, MEM_RESERVE, PAGE_NOACCESS); + end + else + begin + Result := Winapi.Windows.VirtualAlloc(nil, ABlockSize, MEM_COMMIT, PAGE_READWRITE); + {The emergency address space reserve is released when address space runs out for the first time. This allows some + subsequent memory allocation requests to succeed in order to allow the application to allocate some memory for error + handling, etc. in response to the EOutOfMemory exception. This only applies to 32-bit applications.} + if Result = nil then + ReleaseEmergencyReserveAddressSpace; + end; + + if Result <> nil then + begin + AtomicIncrement(MemoryUsageCurrent, NativeUInt(ABlockSize)); + + if (MemoryUsageLimit > 0) + and (MemoryUsageCurrent > MemoryUsageLimit) then + begin + Inc(MemoryUsageLimit, MemoryUsageLimitGraceAmount); + MemoryUsageLimitGraceAmount := 0; + + OS_FreeVirtualMemory(Result, ABlockSize); + Result := nil; + end; + end; + +end; + +function OS_AllocateVirtualMemoryAtAddress(APAddress: Pointer; ABlockSize: NativeInt; + AReserveOnlyNoReadWriteAccess: Boolean): Boolean; +begin + if AReserveOnlyNoReadWriteAccess then + begin + Result := Winapi.Windows.VirtualAlloc(APAddress, ABlockSize, MEM_RESERVE, PAGE_NOACCESS) <> nil; + end + else + begin + Result := (Winapi.Windows.VirtualAlloc(APAddress, ABlockSize, MEM_RESERVE, PAGE_READWRITE) <> nil) + and (Winapi.Windows.VirtualAlloc(APAddress, ABlockSize, MEM_COMMIT, PAGE_READWRITE) <> nil); + end; + + if Result then + begin + AtomicIncrement(MemoryUsageCurrent, NativeUInt(ABlockSize)); + + if (MemoryUsageLimit > 0) + and (MemoryUsageCurrent > MemoryUsageLimit) then + begin + Inc(MemoryUsageLimit, MemoryUsageLimitGraceAmount); + MemoryUsageLimitGraceAmount := 0; + + OS_FreeVirtualMemory(APAddress, ABlockSize); + Result := False; + end; + end; +end; + +{Determines the size and state of the virtual memory region starting at APRegionStart.} +procedure OS_GetVirtualMemoryRegionInfo(APRegionStart: Pointer; var AMemoryRegionInfo: TMemoryRegionInfo); +var + LMemInfo: TMemoryBasicInformation; +begin + if Winapi.Windows.VirtualQuery(APRegionStart, LMemInfo, SizeOf(LMemInfo)) > 0 then + begin + AMemoryRegionInfo.RegionStartAddress := LMemInfo.BaseAddress; + AMemoryRegionInfo.RegionSize := LMemInfo.RegionSize; + AMemoryRegionInfo.RegionIsFree := LMemInfo.State = MEM_FREE; + AMemoryRegionInfo.AccessRights := []; + if (LMemInfo.State = MEM_COMMIT) and (LMemInfo.Protect and PAGE_GUARD = 0) then + begin + if (LMemInfo.Protect and (PAGE_READONLY or PAGE_READWRITE or PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0) then + Include(AMemoryRegionInfo.AccessRights, marRead); + if (LMemInfo.Protect and (PAGE_READWRITE or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0) then + Include(AMemoryRegionInfo.AccessRights, marWrite); + if (LMemInfo.Protect and (PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0) then + Include(AMemoryRegionInfo.AccessRights, marExecute); + end; + end + else + begin + {VirtualQuery fails for addresses above the highest memory address accessible to the process. (Experimentally + determined as addresses >= $ffff0000 under 32-bit, and addresses >= $7fffffff0000 under 64-bit.)} + AMemoryRegionInfo := Default(TMemoryRegionInfo); + end; +end; + +{If another thread is ready to run on the current CPU, give it a chance to execute. This is typically called if the +current thread is unable to make any progress, because it is waiting for locked resources.} +procedure OS_AllowOtherThreadToRun; inline; +begin + Winapi.Windows.SwitchToThread; +end; + +{Returns the thread ID for the calling thread.} +function OS_GetCurrentThreadID: Cardinal; inline; +begin + Result := Winapi.Windows.GetCurrentThreadID; +end; + +{Returns the current system date and time. The time is in 24 hour format.} +procedure OS_GetCurrentDateTime(var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliseconds: Word); +var + LSystemTime: TSystemTime; +begin + Winapi.Windows.GetLocalTime(LSystemTime); + AYear := LSystemTime.wYear; + AMonth := LSystemTime.wMonth; + ADay := LSystemTime.wDay; + AHour := LSystemTime.wHour; + AMinute := LSystemTime.wMinute; + ASecond := LSystemTime.wSecond; + AMilliseconds := LSystemTime.wMilliseconds; +end; + +{Returns the number of milliseconds that have elapsed since the system was started. Note that this wraps back to 0 +after 49.7 days.} +function OS_GetMillisecondsSinceStartup: Cardinal; +begin + Result := Winapi.Windows.GetTickCount; +end; + +{Fills a buffer with the full path and filename of the application. If AReturnLibraryFilename = True and this is a +library then the full path and filename of the library is returned instead.} +function OS_GetApplicationFilename(APFilenameBuffer, APBufferEnd: PWideChar; AReturnLibraryFilename: Boolean): PWideChar; +var + LModuleHandle: HMODULE; + LNumChars: Cardinal; +begin + Result := APFilenameBuffer; + + LModuleHandle := 0; + if AReturnLibraryFilename and IsLibrary then + LModuleHandle := HInstance; + + LNumChars := Winapi.Windows.GetModuleFileNameW(LModuleHandle, Result, CharCount(APBufferEnd, APFilenameBuffer)); + Inc(Result, LNumChars); +end; + +function OS_GetEnvironmentVariableValue(APEnvironmentVariableName, APValueBuffer, APBufferEnd: PWideChar): PWideChar; +var + LNumChars, LBufferSize: Cardinal; +begin + Result := APValueBuffer; + + if Result >= APBufferEnd then + Exit; + + LBufferSize := (NativeInt(APBufferEnd) - NativeInt(Result)) div SizeOf(WideChar); + LNumChars := Winapi.Windows.GetEnvironmentVariableW(APEnvironmentVariableName, Result, LBufferSize); + if LNumChars < LBufferSize then + Inc(Result, LNumChars); +end; + +{Returns True if the given file exists. APFileName must be a #0 terminated string.} +function OS_FileExists(APFileName: PWideChar): Boolean; +begin + {This will return True for folders and False for files that are locked by another process, but is "good enough" for + the purpose for which it will be used.} + Result := Winapi.Windows.GetFileAttributesW(APFileName) <> INVALID_FILE_ATTRIBUTES; +end; + +{Attempts to delete the file. Returns True if it was successfully deleted.} +function OS_DeleteFile(APFileName: PWideChar): Boolean; +begin + Result := Winapi.Windows.DeleteFileW(APFileName); +end; + +{Opens the given file for writing, returning the file handle. If the file does not exist it will be created. The file +pointer will be set to the current end of the file.} +function OS_OpenOrCreateFile(APFileName: PWideChar; var AFileHandle: THandle): Boolean; +begin + {Try to open/create the file in read/write mode.} + AFileHandle := Winapi.Windows.CreateFileW(APFileName, GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_ALWAYS, + FILE_ATTRIBUTE_NORMAL, 0); + if AFileHandle = INVALID_HANDLE_VALUE then + Exit(False); + + {Move the file pointer to the end of the file} + SetFilePointer(AFileHandle, 0, nil, FILE_END); + + Result := True; +end; + +{Writes data to the given file handle, returning True on success} +function OS_WriteFile(AFileHandle: THandle; APData: Pointer; ADataSizeInBytes: Integer): Boolean; +var + LBytesWritten: Cardinal; +begin + Winapi.Windows.WriteFile(AFileHandle, APData^, Cardinal(ADataSizeInBytes), LBytesWritten, nil); + Result := LBytesWritten = Cardinal(ADataSizeInBytes); +end; + +{Closes the given file handle} +procedure OS_CloseFile(AFileHandle: THandle); +begin + CloseHandle(AFileHandle); +end; + +procedure OS_OutputDebugString(APDebugMessage: PWideChar); inline; +begin + Winapi.Windows.OutputDebugString(APDebugMessage); +end; + +{Shows a message box if the program is not showing one already.} +procedure OS_ShowMessageBox(APText, APCaption: PWideChar); +begin + Winapi.Windows.MessageBoxW(0, APText, APCaption, MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_DEFAULT_DESKTOP_ONLY); +end; + + +{------------------------------------------} +{--------Logging support subroutines-------} +{------------------------------------------} + +function CharCount(APFirstFreeChar, APBufferStart: PWideChar): Integer; inline; +begin + Result := (NativeInt(APFirstFreeChar) - NativeInt(APBufferStart)) div SizeOf(WideChar); +end; + +{Converts the UTF-16 text pointed to by APWideText to UTF-8 in the buffer provided. Returns a pointer to the byte +after the last output character.} +function ConvertUTF16toUTF8(APWideText: PWideChar; ANumWideChars: Integer; APOutputBuffer: PByte): PByte; +var + LPIn, LPEnd: PWord; + LCode: Cardinal; +begin + Result := Pointer(APOutputBuffer); + + LPIn := Pointer(APWideText); + LPEnd := LPIn; + Inc(LPEnd, ANumWideChars); + + while NativeUInt(LPIn) < NativeUInt(LPEnd) do + begin + LCode := PCardinal(LPIn)^; + if Word(LCode) <= $7f then + begin + if LCode <= $7fffff then + begin + {Both characters are single byte} + PWord(Result)^ := Word(LCode or (LCode shr 8)); + Inc(Result, 2); + Inc(LPIn, 2); + end + else + begin + {The second character is not single byte} + Result[0] := Byte(LCode); + Inc(Result); + Inc(LPIn); + end; + end + else + begin + if Word(LCode) <= $7ff then + begin + {Two byte encoding} + Result[0] := Byte(LCode shr 6) or $c0; + Result[1] := Byte(LCode and $3f) or $80; + Inc(Result, 2); + Inc(LPIn); + end + else + begin + if (LCode and $fc00fc00) <> $dc00d800 then + begin + {Three byte encoding} + Result[0] := Byte((LCode shr 12) and $0f) or $e0; + Result[1] := Byte((LCode shr 6) and $3f) or $80; + Result[2] := Byte(LCode and $3f) or $80; + Inc(Result, 3); + Inc(LPIn); + end + else + begin + {It is a surrogate pair (4 byte) encoding: Surrogate pairs are encoded in four bytes, with the high word + first} + LCode := ((LCode and $3ff) shl 10) + ((LCode shr 16) and $3ff) + $10000; + Result[0] := Byte((LCode shr 18) and $07) or $e0; + Result[1] := Byte((LCode shr 12) and $3f) or $80; + Result[2] := Byte((LCode shr 6) and $3f) or $80; + Result[3] := Byte(LCode and $3f) or $80; + Inc(Result, 4); + Inc(LPIn, 2); + end; + end; + end; + end; + {Did we convert past the end?} + if NativeUInt(LPIn) > NativeUInt(LPEnd) then + Dec(Result); +end; + +function OpenOrCreateTextFile(APFileName: PWideChar; AAddLineBreakToExistingFile: Boolean; + var AFileHandle: THandle): Boolean; +const + CUTF8_BOM: Cardinal = $BFBBEF; + CUTF16LE_BOM: Word = $FEFF; + CLineBreakUTF8: Word = $0A0D; + CLineBreakUTF16: Cardinal = $000A000D; +var + LFileExisted: Boolean; +begin + LFileExisted := OS_FileExists(APFileName); + + if OS_OpenOrCreateFile(APFileName, AFileHandle) then + begin + if LFileExisted then + begin + if AAddLineBreakToExistingFile then + begin + if FastMM_TextFileEncoding in [teUTF8, teUTF8_BOM] then + OS_WriteFile(AFileHandle, @CLineBreakUTF8, SizeOf(CLineBreakUTF8)) + else + OS_WriteFile(AFileHandle, @CLineBreakUTF16, SizeOf(CLineBreakUTF16)); + end; + end + else + begin + {It's a new file, so add the BOM if required.} + if FastMM_TextFileEncoding = teUTF8_BOM then + OS_WriteFile(AFileHandle, @CUTF8_BOM, 3) + else if FastMM_TextFileEncoding = teUTF16LE_BOM then + OS_WriteFile(AFileHandle, @CUTF16LE_BOM, SizeOf(CUTF16LE_BOM)); + end; + + Result := True; + end + else + Result := False; +end; + +function AppendTextFile(AFileHandle: THandle; APText: PWideChar; AWideCharCount: Integer): Boolean; +var + LBufferSize: Integer; + LPBufferStart, LPBufferPos: PByte; +begin + {We need to add either a BOM or a couple of line breaks before the text, so a larger buffer is needed than the + maximum text size. If converting to UTF-8 it is also possible for the resulting text to be bigger than the UTF-16 + encoded text.} + LBufferSize := (AWideCharCount + 4) * 3; + + LPBufferStart := OS_AllocateVirtualMemory(LBufferSize, False, False); + if LPBufferStart = nil then + Exit(False); + + try + LPBufferPos := LPBufferStart; + + {Copy the text across to the buffer, converting it as appropriate.} + if FastMM_TextFileEncoding in [teUTF8, teUTF8_BOM] then + begin + LPBufferPos := ConvertUTF16toUTF8(APText, AWideCharCount, LPBufferPos); + end + else + begin + System.Move(APText^, LPBufferPos^, AWideCharCount * 2); + Inc(LPBufferPos, AWideCharCount * 2); + end; + + Result := OS_WriteFile(AFileHandle, LPBufferStart, NativeInt(LPBufferPos) - NativeInt(LPBufferStart)); + + finally + OS_FreeVirtualMemory(LPBufferStart, LBufferSize); + end; +end; + +{Attempts to determine whether APointer points to a valid class instance. Returns the class if it does, otherwise nil. +APointer is assumed to point to to at least 4 (32-bit) or 8 (64-bit) readable bytes of memory.} +function FastMM_DetectClassInstance(APointer: Pointer): TClass; +var + LMemoryRegionInfo: TMemoryRegionInfo; + + {Checks whether the given address is a valid address for a VMT entry.} + function IsValidVMTAddress(APAddress: Pointer): Boolean; + begin + {Do some basic pointer checks: Must be pointer aligned and beyond 64K. (The low 64K is never readable, at least + under Windows.)} + if (NativeUInt(APAddress) <= 65535) + or (NativeUInt(APAddress) and (SizeOf(Pointer) - 1) <> 0) then + begin + Exit(False); + end; + + {Fetch the memory access flags for the region surrounding the pointer, if required.} + if (NativeUInt(APAddress) < NativeUInt(LMemoryRegionInfo.RegionStartAddress)) + or (NativeUInt(APAddress) - NativeUInt(LMemoryRegionInfo.RegionStartAddress) >= LMemoryRegionInfo.RegionSize) then + begin + OS_GetVirtualMemoryRegionInfo(APAddress, LMemoryRegionInfo); + end; + + {The address must be readable.} + Result := (not LMemoryRegionInfo.RegionIsFree) + and (marRead in LMemoryRegionInfo.AccessRights); + end; + + {Returns True if AClassPointer points to a class VMT} + function InternalIsValidClass(AClassPointer: Pointer; ADepth: Integer = 0): Boolean; + var + LParentClassSelfPointer: PPointer; + begin + {Check that the self pointer as well as parent class self pointer addresses are valid} + if (ADepth < 1000) + and (NativeUInt(AClassPointer) > 65535) + and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtSelfPtr)) + and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtParent)) then + begin + {Get a pointer to the parent class' self pointer} + LParentClassSelfPointer := PPointer(PByte(AClassPointer) + vmtParent)^; + {Is the "Self" pointer valid?} + if PPointer(PByte(AClassPointer) + vmtSelfPtr)^ <> AClassPointer then + Exit(False); + {No more parent classes?} + if LParentClassSelfPointer = nil then + Exit(True); + {Recursively check the parent class for validity.} + Result := IsValidVMTAddress(LParentClassSelfPointer) + and InternalIsValidClass(LParentClassSelfPointer^, ADepth + 1); + end + else + Result := False; + end; + +begin + {Get the class pointer from the (suspected) object} + Result := TClass(PPointer(APointer)^); + {No VM info yet} + LMemoryRegionInfo.RegionSize := 0; + {Check the block. Never return TFastMM_FreedObject as the class.} + if (Result = TFastMM_FreedObject) or (not InternalIsValidClass(Pointer(Result), 0)) then + Result := nil; +end; + +{Attempts to determine whether APMemoryBlock points to string data. Used by the leak classification code when a block +cannot be identified as a class instance.} +function FastMM_DetectStringData(APMemoryBlock: Pointer; AAvailableSpaceInBlock: NativeInt): TFastMM_StringDataType; +type + {The layout of a string header.} + PStrRec = ^StrRec; + StrRec = packed record +{$ifdef 64Bit} + _Padding: Integer; +{$endif} + codePage: Word; + elemSize: Word; + refCnt: Integer; + length: Integer; + end; +const + {If the string reference count field contains a value greater than this, then it is assumed that the block is not a + string.} + CMaxRefCount = 255; + {The lowest ASCII character code considered valid string data. If there are any characters below this code point + then the data is assumed not to be a string.} + CMinCharCode = #9; //#9 = Tab. +var + LStringLength, LElementSize, LCharInd: Integer; + LPAnsiString: PAnsiChar; + LPUnicodeString: PWideChar; +begin + {Check that the reference count is within a reasonable range} + if PStrRec(APMemoryBlock).refCnt > CMaxRefCount then + Exit(sdtNotAString); + + {Element size must be either 1 (Ansi) or 2 (Unicode)} + LElementSize := PStrRec(APMemoryBlock).elemSize; + if (LElementSize <> 1) and (LElementSize <> 2) then + Exit(sdtNotAString); + + {Get the string length and check whether it fits inside the block} + LStringLength := PStrRec(APMemoryBlock).length; + if (LStringLength <= 0) + or (LStringLength >= (AAvailableSpaceInBlock - SizeOf(StrRec)) div LElementSize) then + begin + Exit(sdtNotAString); + end; + + {Check for no characters outside the expected range. If there are, then it is probably not a string.} + if LElementSize = 1 then + begin + LPAnsiString := PAnsiChar(PByte(APMemoryBlock) + SizeOf(StrRec)); + + {There must be a trailing #0} + if LPAnsiString[LStringLength] <> #0 then + Exit(sdtNotAString); + + {Check that all characters are in the range considered valid.} + for LCharInd := 0 to LStringLength - 1 do + begin + if LPAnsiString[LCharInd] < CMinCharCode then + Exit(sdtNotAString); + end; + + Result := sdtAnsiString; + end + else + begin + LPUnicodeString := PWideChar(PByte(APMemoryBlock) + SizeOf(StrRec)); + + {There must be a trailing #0} + if LPUnicodeString[LStringLength] <> #0 then + Exit(sdtNotAString); + + {Check that all characters are in the range considered valid.} + for LCharInd := 0 to LStringLength - 1 do + begin + if LPUnicodeString[LCharInd] < CMinCharCode then + Exit(sdtNotAString); + end; + + Result := sdtUnicodeString; + end; +end; + +{Attempts to detect the class or string type of the given block. Possible return values are: + 0 = Unknown class + 1 = AnsiString text + 1 = UnicodeString text + > 1 = TClass Pointer} +function DetectBlockContentType(APMemoryBlock: Pointer; AAvailableSpaceInBlock: NativeInt): NativeUInt; +var + LLeakedClass: TClass; + LStringType: TFastMM_StringDataType; +begin + {Attempt to determine the class type for the block.} + LLeakedClass := FastMM_DetectClassInstance(APMemoryBlock); + if LLeakedClass <> nil then + Exit(NativeUInt(LLeakedClass)); + + LStringType := FastMM_DetectStringData(APMemoryBlock, AAvailableSpaceInBlock); + Result := Ord(LStringType); +end; + +{Counts the number of characters up to the trailing #0} +function GetStringLength(APWideText: PWideChar): Integer; +begin + Result := 0; + + if APWideText = nil then + Exit; + + while APWideText^ <> #0 do + begin + Inc(Result); + Inc(APWideText); + end; +end; + +{Adds text to a buffer, returning the new buffer position.} +function AppendTextToBuffer(APSource: PWideChar; ACharCount: Integer; + APTarget, APTargetBufferEnd: PWideChar): PWideChar; overload; +begin + Result := APTarget; + + if @Result[ACharCount] > APTargetBufferEnd then + ACharCount := CharCount(APTargetBufferEnd, Result); + + if ACharCount > 0 then + begin + System.Move(APSource^, Result^, ACharCount * SizeOf(WideChar)); + Inc(Result, ACharCount); + end; +end; + +{As above, but if APSource is non-nil then it is assumed to be #0 terminated. The trailing #0 is not copied.} +function AppendTextToBuffer(APSource, APTarget, APTargetBufferEnd: PWideChar): PWideChar; overload; +var + LChar: WideChar; +begin + Result := APTarget; + + if APSource = nil then + Exit; + + while Result < APTargetBufferEnd do + begin + LChar := APSource^; + if LChar = #0 then + Break; + + Result^ := LChar; + Inc(APSource); + Inc(Result); + end; +end; + +{Converts a NativeUInt to hexadecimal text in the given target buffer.} +function NativeUIntToHexadecimalBuffer(AValue: NativeUInt; APTarget, APTargetBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..15] of WideChar; + LDigit: NativeInt; + LDigitCount: Integer; + LPPos: PWideChar; +begin + Result := APTarget; + + LPPos := @LTempBuffer[High(LTempBuffer)]; + LDigitCount := 0; + while True do + begin + LDigit := AValue mod 16; + LPPos^ := CHexDigits[LDigit]; + Inc(LDigitCount); + + AValue := AValue div 16; + if AValue = 0 then + Break; + + Dec(LPPos); + end; + + Result := AppendTextToBuffer(LPPos, LDigitCount, Result, APTargetBufferEnd); +end; + +{Converts a NativeUInt to text in the given target buffer.} +function NativeUIntToTextBuffer(AValue: NativeUInt; APTarget, APTargetBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..20] of WideChar; + LDigit: NativeInt; + LDigitCount: Integer; + LPPos: PWideChar; +begin + Result := APTarget; + + LPPos := @LTempBuffer[High(LTempBuffer)]; + LDigitCount := 0; + while True do + begin + LDigit := AValue mod 10; + LPPos^ := WideChar(Ord('0') + LDigit); + Inc(LDigitCount); + + AValue := AValue div 10; + if AValue = 0 then + Break; + + Dec(LPPos); + end; + + Result := AppendTextToBuffer(LPPos, LDigitCount, Result, APTargetBufferEnd); +end; + +{Converts a NativeInt to text in the given target buffer.} +function NativeIntToTextBuffer(AValue: NativeInt; APTarget, APTargetBufferEnd: PWideChar): PWideChar; +const + CMinusSign: PWideChar = '-'; +begin + Result := APTarget; + + if AValue < 0 then + Result := AppendTextToBuffer(@CMinusSign, 1, Result, APTargetBufferEnd); + + Result := NativeUIntToTextBuffer(Abs(AValue), Result, APTargetBufferEnd); +end; + +function BlockContentTypeToTextBuffer(ABlockContentType: NativeUInt; APTarget, APTargetBufferEnd: PWideChar): PWideChar; +type + PClassData = ^TClassData; + TClassData = record + ClassType: TClass; + ParentInfo: Pointer; + PropCount: SmallInt; + UnitName: ShortString; + end; +const + CUnknown = 'Unknown'; + CAnsiString = 'AnsiString'; + CUnicodeString = 'UnicodeString'; +var + LClass: TClass; + LBuffer: array[0..511] of WideChar; + LPTarget: PWideChar; + LPSource: PAnsiChar; + LCharInd, LNumChars: Integer; + LClassInfo: Pointer; + LPShortString: PShortString; +begin + Result := APTarget; + + case ABlockContentType of + 0: Result := AppendTextToBuffer(CUnknown, Length(CUnknown), Result, APTargetBufferEnd); + 1: Result := AppendTextToBuffer(CAnsiString, Length(CAnsiString), Result, APTargetBufferEnd); + 2: Result := AppendTextToBuffer(CUnicodeString, Length(CUnicodeString), Result, APTargetBufferEnd); + + else + begin + {All other content types are classes.} + LClass := TClass(ABlockContentType); + + LPTarget := @LBuffer; + + {Get the name of the unit.} + LClassInfo := LClass.ClassInfo; + if LClassInfo <> nil then + begin + LPShortString := @PClassData(PByte(LClassInfo) + 2 + PByte(PByte(LClassInfo) + 1)^).UnitName; + LPSource := @LPShortString^[1]; + LNumChars := Length(LPShortString^); + + while LNumChars > 0 do + begin + if LPSource^ = ':' then + Break; + + if LPSource^ <> '@' then + begin + LPTarget^ := WideChar(LPSource^); + Inc(LPTarget); + end; + + Inc(LPSource); + Dec(LNumChars); + end; + LPTarget^ := '.'; + Inc(LPTarget); + end; + + {Append the class name} + LPShortString := PShortString(PPointer(PByte(LClass) + vmtClassName)^); + LPSource := @LPShortString^[1]; + LNumChars := Length(LPShortString^); + for LCharInd := 1 to LNumChars do + begin + LPTarget^ := WideChar(LPSource^); + Inc(LPTarget); + Inc(LPSource); + end; + + Result := AppendTextToBuffer(@LBuffer, CharCount(LPTarget, @LBuffer), Result, APTargetBufferEnd); + end; + + end; +end; + +{Copies a token value to the buffer and sets the pointer to the token in the values array. Copies up to the size of +the target buffer.} +function AddTokenValue(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; APTokenValue: PWideChar; + ACharCount: Integer; APBuffer, APBufferEnd: PWideChar): PWideChar; +begin + Result := APBuffer; + + if Cardinal(ATokenID) > High(ATokenValues) then + Exit; + + if (ACharCount <= 0) + or (@Result[ACharCount] >= APBufferEnd) then + begin + ATokenValues[ATokenID] := nil; + Exit; + end; + + ATokenValues[ATokenID] := Result; + Result := AppendTextToBuffer(APTokenValue, ACharCount, Result, APBufferEnd); + + {Store the trailing #0} + Result^ := #0; + Inc(Result); +end; + +function AddTokenValue_NativeInt(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; ATokenValue: NativeInt; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..21] of WideChar; + LPPos: PWideChar; +begin + Result := APTokenValueBufferPos; + + LPPos := NativeIntToTextBuffer(ATokenValue, @LTempBuffer, @LTempBuffer[High(LTempBuffer)]); + + Result := AddTokenValue(ATokenValues, ATokenID, @LTempBuffer, CharCount(LPPos, @LTempBuffer), Result, APBufferEnd); +end; + +function AddTokenValue_NativeUInt(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; ATokenValue: NativeUInt; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..20] of WideChar; + LPPos: PWideChar; +begin + Result := APTokenValueBufferPos; + + LPPos := NativeUIntToTextBuffer(ATokenValue, @LTempBuffer, @LTempBuffer[High(LTempBuffer)]); + + Result := AddTokenValue(ATokenValues, ATokenID, @LTempBuffer, CharCount(LPPos, @LTempBuffer), Result, APBufferEnd); +end; + +function AddTokenValue_Hexadecimal(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; ATokenValue: NativeUInt; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..15] of WideChar; + LPPos: PWideChar; +begin + Result := APTokenValueBufferPos; + + LPPos := NativeUIntToHexadecimalBuffer(ATokenValue, @LTempBuffer, @LTempBuffer[High(LTempBuffer)]); + + Result := AddTokenValue(ATokenValues, ATokenID, @LTempBuffer, CharCount(LPPos, @LTempBuffer), Result, APBufferEnd); +end; + +function AddTokenValue_HexDump(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; APBlock: PByte; + ANumBytes: Integer; APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..CMemoryDumpMaxBytes * 5] of WideChar; //Worst case scenario: Allow for CRLF after every byte + LPTarget: PWideChar; + LBytesLeftInLine: Integer; + LByteVal: Byte; +begin + Result := APTokenValueBufferPos; + + if ANumBytes > CMemoryDumpMaxBytes then + ANumBytes := CMemoryDumpMaxBytes; + if ANumBytes <= 0 then + Exit; + + LPTarget := @LTempBuffer; + LBytesLeftInLine := CMemoryDumpMaxBytesPerLine; + while True do + begin + LByteVal := APBlock^; + LPTarget^ := CHexDigits[LByteVal div 16]; + Inc(LPTarget); + LPTarget^ := CHexDigits[LByteVal and 15]; + Inc(LPTarget); + Inc(APBlock); + + Dec(ANumBytes); + if ANumBytes = 0 then + Break; + + {Add the separator: Either a space or a line break.} + Dec(LBytesLeftInLine); + if LBytesLeftInLine <= 0 then + begin + {Add a CRLF at the end of the line} + LPTarget^ := #13; + Inc(LPTarget); + LPTarget^ := #10; + Inc(LPTarget); + + LBytesLeftInLine := CMemoryDumpMaxBytesPerLine; + end + else + begin + LPTarget^ := ' '; + Inc(LPTarget); + end; + + end; + + Result := AddTokenValue(ATokenValues, ATokenID, @LTempBuffer, CharCount(LPTarget, @LTempBuffer), Result, APBufferEnd); +end; + +function AddTokenValue_ASCIIDump(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; APBlock: PByte; + ANumBytes: Integer; APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTempBuffer: array[0..CMemoryDumpMaxBytes * 5] of WideChar; //Worst case scenario: Allow for CRLF after every byte + LPTarget: PWideChar; + LBytesLeftInLine: Integer; + LByteVal: Byte; +begin + Result := APTokenValueBufferPos; + + if ANumBytes > CMemoryDumpMaxBytes then + ANumBytes := CMemoryDumpMaxBytes; + if ANumBytes <= 0 then + Exit; + + LPTarget := @LTempBuffer; + LBytesLeftInLine := CMemoryDumpMaxBytesPerLine; + while True do + begin + LByteVal := APBlock^; + if (LByteVal > Ord(' ')) and (LByteVal < 128) then + LPTarget^ := Char(LByteVal) + else + LPTarget^ := '.'; + Inc(LPTarget); + Inc(APBlock); + + Dec(ANumBytes); + if ANumBytes = 0 then + Break; + + {Add the separator: Either a space or a line break.} + Dec(LBytesLeftInLine); + if LBytesLeftInLine <= 0 then + begin + {Add a CRLF at the end of the line} + LPTarget^ := #13; + Inc(LPTarget); + LPTarget^ := #10; + Inc(LPTarget); + + LBytesLeftInLine := CMemoryDumpMaxBytesPerLine; + end + else + begin + LPTarget^ := ' '; + Inc(LPTarget); + LPTarget^ := ' '; + Inc(LPTarget); + end; + + end; + + Result := AddTokenValue(ATokenValues, ATokenID, @LTempBuffer, CharCount(LPTarget, @LTempBuffer), Result, APBufferEnd); +end; + +function AddTokenValue_StackTrace(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; APStackTrace: PNativeUInt; + AStackTraceEntryCount: Cardinal; APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LStackTraceBuffer: array[0..CFastMM_StackTrace_MaximumEntryCount * 160] of WideChar; + LPBuffer: PWideChar; +begin + Result := APTokenValueBufferPos; + + LPBuffer := @LStackTraceBuffer; + if AStackTraceEntryCount > 0 then + begin + LPBuffer := FastMM_ConvertStackTraceToText(APStackTrace, AStackTraceEntryCount, LPBuffer, + @LStackTraceBuffer[High(LStackTraceBuffer)]); + end; + + Result := AddTokenValue(ATokenValues, ATokenID, LStackTraceBuffer, CharCount(LPBuffer, @LStackTraceBuffer), Result, + APBufferEnd); +end; + +{Adds a date token in ISO 8601 date format, e.g. 2020-01-01} +function AddTokenValue_Date(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; AYear, AMonth, ADay: Word; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LDateBuffer: array[0..9] of WideChar; +begin + Result := APTokenValueBufferPos; + + LDateBuffer[3] := WideChar(Ord('0') + AYear mod 10); + AYear := AYear div 10; + LDateBuffer[2] := WideChar(Ord('0') + AYear mod 10); + AYear := AYear div 10; + LDateBuffer[1] := WideChar(Ord('0') + AYear mod 10); + AYear := AYear div 10; + LDateBuffer[0] := WideChar(Ord('0') + AYear mod 10); + + LDateBuffer[4] := '-'; + LDateBuffer[6] := WideChar(Ord('0') + AMonth mod 10); + AMonth := AMonth div 10; + LDateBuffer[5] := WideChar(Ord('0') + AMonth mod 10); + + LDateBuffer[7] := '-'; + LDateBuffer[9] := WideChar(Ord('0') + ADay mod 10); + ADay := ADay div 10; + LDateBuffer[8] := WideChar(Ord('0') + ADay mod 10); + + Result := AddTokenValue(ATokenValues, ATokenID, @LDateBuffer, Length(LDateBuffer), Result, APBufferEnd); +end; + +{Adds a date token in ISO 8601 date format, e.g. 2020-01-01} +function AddTokenValue_Time(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; AHour, AMinute, ASecond: Word; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LTimeBuffer: array[0..7] of WideChar; +begin + Result := APTokenValueBufferPos; + + LTimeBuffer[1] := WideChar(Ord('0') + AHour mod 10); + AHour := AHour div 10; + LTimeBuffer[0] := WideChar(Ord('0') + AHour mod 10); + + LTimeBuffer[2] := ':'; + LTimeBuffer[4] := WideChar(Ord('0') + AMinute mod 10); + AMinute := AMinute div 10; + LTimeBuffer[3] := WideChar(Ord('0') + AMinute mod 10); + + LTimeBuffer[5] := ':'; + LTimeBuffer[7] := WideChar(Ord('0') + ASecond mod 10); + ASecond := ASecond div 10; + LTimeBuffer[6] := WideChar(Ord('0') + ASecond mod 10); + + Result := AddTokenValue(ATokenValues, ATokenID, @LTimeBuffer, Length(LTimeBuffer), Result, APBufferEnd); +end; + +{Adds the tokens for the current date and time.} +function AddTokenValues_CurrentDateAndTime(var ATokenValues: TEventLogTokenValues; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +var + LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliseconds: Word; +begin + Result := APTokenValueBufferPos; + + OS_GetCurrentDateTime(LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliseconds); + + Result := AddTokenValue_Date(ATokenValues, CEventLogTokenCurrentDate, LYear, LMonth, LDay, Result, APBufferEnd); + Result := AddTokenValue_Time(ATokenValues, CEventLogTokenCurrentTime, LHour, LMinute, LSecond, Result, APBufferEnd); +end; + +function AddTokenValue_BlockContentType(var ATokenValues: TEventLogTokenValues; ATokenID: Integer; + ABlockContentType: NativeUInt; APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +const + CContentBufferSize = 512; +var + LBuffer: array[0..CContentBufferSize] of WideChar; + LPPos: PWideChar; +begin + Result := APTokenValueBufferPos; + + LPPos := BlockContentTypeToTextBuffer(ABlockContentType, @LBuffer, @LBuffer[High(LBuffer)]); + + Result := AddTokenValue(ATokenValues, ATokenID, @LBuffer, CharCount(LPPos, @LBuffer), Result, APBufferEnd); +end; + +function AddTokenValues_GeneralTokens(var ATokenValues: TEventLogTokenValues; + APTokenValueBufferPos, APBufferEnd: PWideChar): PWideChar; +begin + Result := AddTokenValues_CurrentDateAndTime(ATokenValues, APTokenValueBufferPos, APBufferEnd); + Result := AddTokenValue(ATokenValues, CEventLogTokenEventLogFilename, @EventLogFilename, + GetStringLength(@EventLogFilename), Result, APBufferEnd); +end; + +function AddTokenValues_BlockTokens(var ATokenValues: TEventLogTokenValues; APBlock: Pointer; + APBuffer, APBufferEnd: PWideChar): PWideChar; +var + LBlockUserSize: NativeInt; + LBlockContentType: NativeUInt; + LMemoryDumpSize, LBlockHeader: Integer; + LPDebugBlockHeader: PFastMM_DebugBlockHeader; +begin + Result := APBuffer; + + {Add the token for the block size.} + LBlockUserSize := FastMM_BlockMaximumUserBytes(APBlock); + Result := AddTokenValue_NativeInt(ATokenValues, CEventLogTokenBlockSize, LBlockUserSize, Result, APBufferEnd); + + {Add the token for the block content type.} + LBlockContentType := DetectBlockContentType(APBlock, LBlockUserSize); + Result := AddTokenValue_BlockContentType(ATokenValues, CEventLogTokenObjectClass, LBlockContentType, Result, + APBufferEnd); + + {Add the token for the block adddress in hex.} + Result := AddTokenValue_Hexadecimal(ATokenValues, CEventLogTokenBlockAddress, NativeUInt(APBlock), Result, + APBufferEnd); + + {Add the block dump tokens. The maximum dump size is less than the size of a medium block, so it's safe to read + beyond the end of the block (due to the medium block header that will always follow a small block span).} + if LBlockUserSize < CMemoryDumpMaxBytes - CMediumBlockHeaderSize then + LMemoryDumpSize := LBlockUserSize + CMediumBlockHeaderSize + else + LMemoryDumpSize := CMemoryDumpMaxBytes; + + Result := AddTokenValue_NativeInt(ATokenValues, CEventLogTokenMemoryDumpSize, LMemoryDumpSize, Result, APBufferEnd); + + Result := AddTokenValue_HexDump(ATokenValues, CEventLogTokenHexDump, APBlock, LMemoryDumpSize, Result, APBufferEnd); + + Result := AddTokenValue_ASCIIDump(ATokenValues, CEventLogTokenASCIIDump, APBlock, LMemoryDumpSize, Result, APBufferEnd); + + {If this is a debug sub-block, log the additional debug information.} + LBlockHeader := PBlockStatusFlags(APBlock)[-1]; + if LBlockHeader and (CIsSmallBlockFlag or CIsMediumBlockFlag or CIsLargeBlockFlag or CIsDebugBlockFlag) = CIsDebugBlockFlag then + begin + LPDebugBlockHeader := @PFastMM_DebugBlockHeader(APBlock)[-1]; + + Result := AddTokenValue_Hexadecimal(ATokenValues, CEventLogTokenAllocatedByThread, LPDebugBlockHeader.AllocatedByThread, + Result, APBufferEnd); + + Result := AddTokenValue_NativeUInt(ATokenValues, CEventLogTokenAllocationNumber, LPDebugBlockHeader.AllocationNumber, + Result, APBufferEnd); + + Result := AddTokenValue_StackTrace(ATokenValues, CEventLogTokenAllocationStackTrace, + LPDebugBlockHeader.DebugFooter_AllocationStackTracePtr, LPDebugBlockHeader.StackTraceEntryCount, Result, APBufferEnd); + + if LBlockHeader and CBlockIsFreeFlag = CBlockIsFreeFlag then + begin + Result := AddTokenValue_Hexadecimal(ATokenValues, CEventLogTokenFreedByThread, LPDebugBlockHeader.FreedByThread, + Result, APBufferEnd); + + Result := AddTokenValue_StackTrace(ATokenValues, CEventLogTokenFreeStackTrace, LPDebugBlockHeader.DebugFooter_FreeStackTracePtr, + LPDebugBlockHeader.StackTraceEntryCount, Result, APBufferEnd); + + {If it is a freed debug block then get the prior class from the debug header.} + LBlockContentType := NativeUInt(FastMM_DetectClassInstance(@LPDebugBlockHeader.PreviouslyUsedByClass)); + Result := AddTokenValue_BlockContentType(ATokenValues, CEventLogTokenObjectClass, LBlockContentType, Result, + APBufferEnd); + + end; + end; + +end; + +{The template as well as token values must be #0 terminated.} +function SubstituteTokenValues(APTemplate: PWideChar; const ATokenValues: TEventLogTokenValues; + APBuffer, APBufferEnd: PWideChar): PWideChar; +const + CTokenStartChar = '{'; + CTokenEndChar = '}'; +var + LInputChar: WideChar; + LInsideToken: Boolean; + LTokenNumber: Cardinal; + LPTokenValue: PWideChar; +begin + LInsideToken := False; + LTokenNumber := 0; + Result := APBuffer; + + while Result < APBufferEnd do + begin + LInputChar := APTemplate^; + if LInputChar = #0 then + Break; + Inc(APTemplate); + + if not LInsideToken then + begin + if LInputChar <> CTokenStartChar then + begin + Result^ := LInputChar; + Inc(Result); + end + else + begin + LInsideToken := True; + LTokenNumber := 0; + end; + end + else + begin + if LInputChar <> CTokenEndChar then + begin + LTokenNumber := LTokenNumber * 10 + Ord(LInputChar) - Ord('0'); + end + else + begin + if LTokenNumber <= CEventLogMaxTokenID then + begin + LPTokenValue := ATokenValues[LTokenNumber]; + if LPTokenValue <> nil then + begin + while Result < APBufferEnd do + begin + LInputChar := LPTokenValue^; + if LInputChar = #0 then + Break; + Inc(LPTokenValue); + + Result^ := LInputChar; + Inc(Result); + + end; + end; + + end; + LInsideToken := False; + end; + end; + + end; +end; + +function EventLogFileIsOpen: Boolean; +begin + Result := EventLogFileHandle <> INVALID_HANDLE_VALUE; +end; + +function OpenEventLogFile: Boolean; +begin + Result := EventLogFileIsOpen or OpenOrCreateTextFile(@EventLogFilename, True, EventLogFileHandle); +end; + +procedure CloseEventLogFile; +begin + if EventLogFileIsOpen then + begin + OS_CloseFile(EventLogFileHandle); + EventLogFileHandle := INVALID_HANDLE_VALUE; + end; +end; + +{Logs an event to OutputDebugString, file or the display (or any combination thereof) depending on configuration.} +procedure LogEvent(AEventType: TFastMM_MemoryManagerEventType; const ATokenValues: TEventLogTokenValues); +var + LPTextTemplate, LPMessageBoxCaption: PWideChar; + LTextBuffer: array[0..CEventMessageMaxWideChars] of WideChar; + LPLogHeaderStart, LPBodyStart: PWideChar; + LPBuffer, LPBufferEnd: PWideChar; + LEventLogFileWasOpen: Boolean; +begin + LPLogHeaderStart := @LTextBuffer; + LPBufferEnd := @LTextBuffer[CEventMessageMaxWideChars - 1]; + LPBuffer := LPLogHeaderStart; + + {Add the log file header.} + if AEventType in FastMM_LogToFileEvents then + LPBuffer := SubstituteTokenValues(FastMM_LogFileEntryHeader, ATokenValues, LPBuffer, LPBufferEnd); + LPBodyStart := LPBuffer; + + {Add the message itself.} + case AEventType of + + mmetAnotherThirdPartyMemoryManagerAlreadyInstalled: + begin + LPTextTemplate := FastMM_AnotherMemoryManagerAlreadyInstalledMessage; + LPMessageBoxCaption := FastMM_CannotSwitchMemoryManagerMessageBoxCaption; + end; + + mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed: + begin + LPTextTemplate := FastMM_CannotInstallAfterDefaultMemoryManagerHasBeenUsedMessage; + LPMessageBoxCaption := FastMM_CannotSwitchMemoryManagerMessageBoxCaption; + end; + + mmetCannotSwitchToSharedMemoryManagerWithLivePointers: + begin + LPTextTemplate := FastMM_CannotSwitchToSharedMemoryManagerWithLivePointersMessage; + LPMessageBoxCaption := FastMM_CannotSwitchMemoryManagerMessageBoxCaption; + end; + + mmetUnexpectedMemoryLeakDetail: + begin + {Determine which template to use from the block type: Only debug blocks have thread information.} + if ATokenValues[CEventLogTokenAllocatedByThread] <> nil then + LPTextTemplate := FastMM_MemoryLeakDetailMessage_DebugBlock + else + LPTextTemplate := FastMM_MemoryLeakDetailMessage_NormalBlock; + LPMessageBoxCaption := FastMM_MemoryLeakMessageBoxCaption; + end; + + mmetUnexpectedMemoryLeakSummary: + begin + if mmetUnexpectedMemoryLeakDetail in FastMM_LogToFileEvents then + LPTextTemplate := FastMM_MemoryLeakSummaryMessage_LeakDetailLoggedToEventLog + else + LPTextTemplate := FastMM_MemoryLeakSummaryMessage_LeakDetailNotLogged; + LPMessageBoxCaption := FastMM_MemoryLeakMessageBoxCaption; + end; + + mmetDebugBlockDoubleFree: + begin + LPTextTemplate := FastMM_DebugBlockDoubleFree; + LPMessageBoxCaption := FastMM_MemoryCorruptionMessageBoxCaption; + end; + + mmetDebugBlockReallocOfFreedBlock: + begin + LPTextTemplate := FastMM_DebugBlockReallocOfFreedBlock; + LPMessageBoxCaption := FastMM_MemoryCorruptionMessageBoxCaption; + end; + + mmetDebugBlockHeaderCorruption: + begin + LPTextTemplate := FastMM_BlockHeaderCorruptedMessage; + LPMessageBoxCaption := FastMM_MemoryCorruptionMessageBoxCaption; + end; + + mmetDebugBlockFooterCorruption: + begin + if ATokenValues[CEventLogTokenFreedByThread] <> nil then + LPTextTemplate := FastMM_BlockFooterCorruptedMessage_FreedBlock + else + LPTextTemplate := FastMM_BlockFooterCorruptedMessage_AllocatedBlock; + LPMessageBoxCaption := FastMM_MemoryCorruptionMessageBoxCaption; + end; + + mmetDebugBlockModifiedAfterFree: + begin + LPTextTemplate := FastMM_BlockModifiedAfterFreeMessage; + LPMessageBoxCaption := FastMM_MemoryCorruptionMessageBoxCaption; + end; + + mmetVirtualMethodCallOnFreedObject: + begin + LPTextTemplate := FastMM_VirtualMethodCallOnFreedObjectMessage; + LPMessageBoxCaption := FastMM_VirtualMethodCallOnFreedObjectMessageBoxCaption; + end; + + else + begin + {All event types should be handled above.} + LPTextTemplate := nil; + LPMessageBoxCaption := nil; + end; + end; + LPBuffer := SubstituteTokenValues(LPTextTemplate, ATokenValues, LPBuffer, LPBufferEnd); + + {Store the trailing #0.} + LPBuffer^ := #0; + + {Log the message to file, if needed.} + if AEventType in FastMM_LogToFileEvents then + begin + LEventLogFileWasOpen := EventLogFileIsOpen; + + if LEventLogFileWasOpen or OpenEventLogFile then + AppendTextFile(EventLogFileHandle, LPLogHeaderStart, CharCount(LPBuffer, @LTextBuffer)); + + if not LEventLogFileWasOpen then + CloseEventLogFile; + end; + + if AEventType in FastMM_OutputDebugStringEvents then + begin + OS_OutputDebugString(LPLogHeaderStart); + end; + + if AEventType in FastMM_MessageBoxEvents then + begin + {Ensure that the event log file is closed before showing any dialogs, so the user can access it while the dialog is + displayed.} + CloseEventLogFile; + + OS_ShowMessageBox(LPBodyStart, LPMessageBoxCaption); + end; + +end; + + +{--------------------------------------} +{--------Debug support class-----------} +{--------------------------------------} + +{TFastMM_FreedObject is used to catch virtual method calls on a freed object. Whenever a debug block is freed the +first pointer in the block is set to point to TFastMM_FreedObject, so that an attempt to call a virtual method (like +Destroy) will be caught.} + +{ TFastMM_FreedObject } + +procedure TFastMM_FreedObject.AfterConstruction; +begin + VirtualMethodOnFreedObject('AfterConstruction'); +end; + +procedure TFastMM_FreedObject.BeforeDestruction; +begin + VirtualMethodOnFreedObject('BeforeDestruction'); +end; + +procedure TFastMM_FreedObject.DefaultHandler(var Message); +begin + VirtualMethodOnFreedObject('DefaultHandler'); +end; + +destructor TFastMM_FreedObject.Destroy; +begin + VirtualMethodOnFreedObject('Destroy'); +end; + +procedure TFastMM_FreedObject.Dispatch(var Message); +begin + VirtualMethodOnFreedObject('Dispatch'); +end; + +function TFastMM_FreedObject.Equals(Obj: TObject): Boolean; +begin + VirtualMethodOnFreedObject('Equals'); + Result := False; //Suppress compiler warning +end; + +procedure TFastMM_FreedObject.FreeInstance; +begin + VirtualMethodOnFreedObject('FreeInstance'); +end; + +function TFastMM_FreedObject.GetHashCode: Integer; +begin + VirtualMethodOnFreedObject('GetHashCode'); + Result := 0; //Suppress compiler warning +end; + +function TFastMM_FreedObject.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; +begin + VirtualMethodOnFreedObject('SafeCallException'); + Result := 0; //Suppress compiler warning +end; + +function TFastMM_FreedObject.ToString: string; +begin + VirtualMethodOnFreedObject('ToString'); + Result := ''; //Suppress compiler warning +end; + +procedure TFastMM_FreedObject.VirtualMethodOnFreedObject(APMethodName: PWideChar); +begin + {Get the stack trace and then log the event.} + FastMM_GetStackTrace(@FVirtualMethodStackTrace, Length(FVirtualMethodStackTrace), 0); + VirtualMethodOnFreedObject_LogEvent(APMethodName); +end; + +procedure TFastMM_FreedObject.VirtualMethodOnFreedObject(AIndex: Byte); +var + LTextBuffer: array[0..4] of WideChar; + LPEnd: PWideChar; +begin + LTextBuffer[0] := '#'; + LPEnd := NativeUIntToTextBuffer(AIndex, @LTextBuffer[1], @LTextBuffer[High(LTextBuffer)]); + LPEnd^ := #0; + VirtualMethodOnFreedObject(@LTextBuffer); +end; + +procedure TFastMM_FreedObject.VirtualMethodOnFreedObject_LogEvent(APMethodName: PWideChar); +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; +begin + LTokenValues := Default(TEventLogTokenValues); + + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, LPBufferEnd); + LPBufferPos := AddTokenValues_BlockTokens(LTokenValues, Pointer(Self), LPBufferPos, LPBufferEnd); + LPBufferPos := AddTokenValue(LTokenValues, CEventLogTokenVirtualMethodName, APMethodName, + GetStringLength(APMethodName), LPBufferPos, LPBufferEnd); + AddTokenValue_StackTrace(LTokenValues, CEventLogTokenVirtualMethodCallOnFreedObject, + @TFastMM_FreedObject.FVirtualMethodStackTrace, Length(FVirtualMethodStackTrace), LPBufferPos, LPBufferEnd); + + LogEvent(mmetVirtualMethodCallOnFreedObject, LTokenValues); + + System.Error(reInvalidPtr); +end; + +procedure TFastMM_FreedObject.VirtualMethod0; begin VirtualMethodOnFreedObject(0); end; +procedure TFastMM_FreedObject.VirtualMethod1; begin VirtualMethodOnFreedObject(1); end; +procedure TFastMM_FreedObject.VirtualMethod2; begin VirtualMethodOnFreedObject(2); end; +procedure TFastMM_FreedObject.VirtualMethod3; begin VirtualMethodOnFreedObject(3); end; +procedure TFastMM_FreedObject.VirtualMethod4; begin VirtualMethodOnFreedObject(4); end; +procedure TFastMM_FreedObject.VirtualMethod5; begin VirtualMethodOnFreedObject(5); end; +procedure TFastMM_FreedObject.VirtualMethod6; begin VirtualMethodOnFreedObject(6); end; +procedure TFastMM_FreedObject.VirtualMethod7; begin VirtualMethodOnFreedObject(7); end; +procedure TFastMM_FreedObject.VirtualMethod8; begin VirtualMethodOnFreedObject(8); end; +procedure TFastMM_FreedObject.VirtualMethod9; begin VirtualMethodOnFreedObject(9); end; +procedure TFastMM_FreedObject.VirtualMethod10; begin VirtualMethodOnFreedObject(10); end; +procedure TFastMM_FreedObject.VirtualMethod11; begin VirtualMethodOnFreedObject(11); end; +procedure TFastMM_FreedObject.VirtualMethod12; begin VirtualMethodOnFreedObject(12); end; +procedure TFastMM_FreedObject.VirtualMethod13; begin VirtualMethodOnFreedObject(13); end; +procedure TFastMM_FreedObject.VirtualMethod14; begin VirtualMethodOnFreedObject(14); end; +procedure TFastMM_FreedObject.VirtualMethod15; begin VirtualMethodOnFreedObject(15); end; +procedure TFastMM_FreedObject.VirtualMethod16; begin VirtualMethodOnFreedObject(16); end; +procedure TFastMM_FreedObject.VirtualMethod17; begin VirtualMethodOnFreedObject(17); end; +procedure TFastMM_FreedObject.VirtualMethod18; begin VirtualMethodOnFreedObject(18); end; +procedure TFastMM_FreedObject.VirtualMethod19; begin VirtualMethodOnFreedObject(19); end; +procedure TFastMM_FreedObject.VirtualMethod20; begin VirtualMethodOnFreedObject(20); end; +procedure TFastMM_FreedObject.VirtualMethod21; begin VirtualMethodOnFreedObject(21); end; +procedure TFastMM_FreedObject.VirtualMethod22; begin VirtualMethodOnFreedObject(22); end; +procedure TFastMM_FreedObject.VirtualMethod23; begin VirtualMethodOnFreedObject(23); end; +procedure TFastMM_FreedObject.VirtualMethod24; begin VirtualMethodOnFreedObject(24); end; +procedure TFastMM_FreedObject.VirtualMethod25; begin VirtualMethodOnFreedObject(25); end; +procedure TFastMM_FreedObject.VirtualMethod26; begin VirtualMethodOnFreedObject(26); end; +procedure TFastMM_FreedObject.VirtualMethod27; begin VirtualMethodOnFreedObject(27); end; +procedure TFastMM_FreedObject.VirtualMethod28; begin VirtualMethodOnFreedObject(28); end; +procedure TFastMM_FreedObject.VirtualMethod29; begin VirtualMethodOnFreedObject(29); end; +procedure TFastMM_FreedObject.VirtualMethod30; begin VirtualMethodOnFreedObject(30); end; +procedure TFastMM_FreedObject.VirtualMethod31; begin VirtualMethodOnFreedObject(31); end; +procedure TFastMM_FreedObject.VirtualMethod32; begin VirtualMethodOnFreedObject(32); end; +procedure TFastMM_FreedObject.VirtualMethod33; begin VirtualMethodOnFreedObject(33); end; +procedure TFastMM_FreedObject.VirtualMethod34; begin VirtualMethodOnFreedObject(34); end; +procedure TFastMM_FreedObject.VirtualMethod35; begin VirtualMethodOnFreedObject(35); end; +procedure TFastMM_FreedObject.VirtualMethod36; begin VirtualMethodOnFreedObject(36); end; +procedure TFastMM_FreedObject.VirtualMethod37; begin VirtualMethodOnFreedObject(37); end; +procedure TFastMM_FreedObject.VirtualMethod38; begin VirtualMethodOnFreedObject(38); end; +procedure TFastMM_FreedObject.VirtualMethod39; begin VirtualMethodOnFreedObject(39); end; +procedure TFastMM_FreedObject.VirtualMethod40; begin VirtualMethodOnFreedObject(40); end; +procedure TFastMM_FreedObject.VirtualMethod41; begin VirtualMethodOnFreedObject(41); end; +procedure TFastMM_FreedObject.VirtualMethod42; begin VirtualMethodOnFreedObject(42); end; +procedure TFastMM_FreedObject.VirtualMethod43; begin VirtualMethodOnFreedObject(43); end; +procedure TFastMM_FreedObject.VirtualMethod44; begin VirtualMethodOnFreedObject(44); end; +procedure TFastMM_FreedObject.VirtualMethod45; begin VirtualMethodOnFreedObject(45); end; +procedure TFastMM_FreedObject.VirtualMethod46; begin VirtualMethodOnFreedObject(46); end; +procedure TFastMM_FreedObject.VirtualMethod47; begin VirtualMethodOnFreedObject(47); end; +procedure TFastMM_FreedObject.VirtualMethod48; begin VirtualMethodOnFreedObject(48); end; +procedure TFastMM_FreedObject.VirtualMethod49; begin VirtualMethodOnFreedObject(49); end; +procedure TFastMM_FreedObject.VirtualMethod50; begin VirtualMethodOnFreedObject(50); end; +procedure TFastMM_FreedObject.VirtualMethod51; begin VirtualMethodOnFreedObject(51); end; +procedure TFastMM_FreedObject.VirtualMethod52; begin VirtualMethodOnFreedObject(52); end; +procedure TFastMM_FreedObject.VirtualMethod53; begin VirtualMethodOnFreedObject(53); end; +procedure TFastMM_FreedObject.VirtualMethod54; begin VirtualMethodOnFreedObject(54); end; +procedure TFastMM_FreedObject.VirtualMethod55; begin VirtualMethodOnFreedObject(55); end; +procedure TFastMM_FreedObject.VirtualMethod56; begin VirtualMethodOnFreedObject(56); end; +procedure TFastMM_FreedObject.VirtualMethod57; begin VirtualMethodOnFreedObject(57); end; +procedure TFastMM_FreedObject.VirtualMethod58; begin VirtualMethodOnFreedObject(58); end; +procedure TFastMM_FreedObject.VirtualMethod59; begin VirtualMethodOnFreedObject(59); end; +procedure TFastMM_FreedObject.VirtualMethod60; begin VirtualMethodOnFreedObject(60); end; +procedure TFastMM_FreedObject.VirtualMethod61; begin VirtualMethodOnFreedObject(61); end; +procedure TFastMM_FreedObject.VirtualMethod62; begin VirtualMethodOnFreedObject(62); end; +procedure TFastMM_FreedObject.VirtualMethod63; begin VirtualMethodOnFreedObject(63); end; +procedure TFastMM_FreedObject.VirtualMethod64; begin VirtualMethodOnFreedObject(64); end; +procedure TFastMM_FreedObject.VirtualMethod65; begin VirtualMethodOnFreedObject(65); end; +procedure TFastMM_FreedObject.VirtualMethod66; begin VirtualMethodOnFreedObject(66); end; +procedure TFastMM_FreedObject.VirtualMethod67; begin VirtualMethodOnFreedObject(67); end; +procedure TFastMM_FreedObject.VirtualMethod68; begin VirtualMethodOnFreedObject(68); end; +procedure TFastMM_FreedObject.VirtualMethod69; begin VirtualMethodOnFreedObject(69); end; +procedure TFastMM_FreedObject.VirtualMethod70; begin VirtualMethodOnFreedObject(70); end; +procedure TFastMM_FreedObject.VirtualMethod71; begin VirtualMethodOnFreedObject(71); end; +procedure TFastMM_FreedObject.VirtualMethod72; begin VirtualMethodOnFreedObject(72); end; +procedure TFastMM_FreedObject.VirtualMethod73; begin VirtualMethodOnFreedObject(73); end; +procedure TFastMM_FreedObject.VirtualMethod74; begin VirtualMethodOnFreedObject(74); end; + + +{------------------------------------------} +{--------General utility subroutines-------} +{------------------------------------------} + +{$if CompilerVersion < 34} +{Returns the lowest set bit index in the 32-bit number} +function CountTrailingZeros32(AInteger: Integer): Integer; +asm +{$ifdef 64Bit} + .noframe + mov rax, rcx +{$endif} + bsf eax, eax +end; +{$endif} + +{Returns True if the block is not in use.} +function BlockIsFree(APSmallMediumOrLargeBlock: Pointer): Boolean; inline; +begin + Result := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] and CBlockIsFreeFlag <> 0; +end; + +{Tags a block as free, without affecting any other flags.} +procedure SetBlockIsFreeFlag(APSmallMediumOrLargeBlock: Pointer; ABlockIsFree: Boolean); inline; +begin + if ABlockIsFree then + PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] or CBlockIsFreeFlag + else + PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] and (not CBlockIsFreeFlag); +end; + +{Returns True if the block contains a debug sub-block.} +function BlockHasDebugInfo(APSmallMediumOrLargeBlock: Pointer): Boolean; inline; +begin + Result := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] and CHasDebugInfoFlag <> 0; +end; + +{Tags a block as having debug info, without affecting any other flags.} +procedure SetBlockHasDebugInfo(APSmallMediumOrLargeBlock: Pointer; ABlockHasDebugInfo: Boolean); inline; +begin + if ABlockHasDebugInfo then + PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] or CHasDebugInfoFlag + else + PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] := PBlockStatusFlags(APSmallMediumOrLargeBlock)[-1] and (not CHasDebugInfoFlag); +end; + +{Calculates the size of a debug block footer, given the number of stack trace entries.} +function CalculateDebugBlockFooterSize(AStackTraceDepth: Byte): NativeInt; inline; +begin + {The debug footer consists of a dword checksum, followed by the allocation and free stack traces.} + Result := CDebugBlockFooterCheckSumSize + AStackTraceDepth * (2 * SizeOf(Pointer)); +end; + +procedure LogDebugBlockHeaderInvalid(APDebugBlockHeader: PFastMM_DebugBlockHeader); +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; +begin + LTokenValues := Default(TEventLogTokenValues); + + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, LPBufferEnd); + AddTokenValues_BlockTokens(LTokenValues, APDebugBlockHeader, LPBufferPos, LPBufferEnd); + + LogEvent(mmetDebugBlockHeaderCorruption, LTokenValues); +end; + +{The debug header is assumed to be valid.} +procedure LogDebugBlockFooterInvalid(APDebugBlockHeader: PFastMM_DebugBlockHeader); +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; +begin + LTokenValues := Default(TEventLogTokenValues); + + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, LPBufferEnd); + AddTokenValues_BlockTokens(LTokenValues, PByte(APDebugBlockHeader) + CDebugBlockHeaderSize, LPBufferPos, LPBufferEnd); + + LogEvent(mmetDebugBlockFooterCorruption, LTokenValues); +end; + +{Checks the consistency of a block with embedded debug info. Returns True if the block is intact, otherwise +(optionally) logs and/or displays the error and returns False.} +function CheckDebugBlockHeaderAndFooterCheckSumsValid(APDebugBlockHeader: PFastMM_DebugBlockHeader): Boolean; +begin + if APDebugBlockHeader.CalculateHeaderCheckSum <> APDebugBlockHeader.HeaderCheckSum then + begin + LogDebugBlockHeaderInvalid(APDebugBlockHeader); + Exit(False); + end; + if APDebugBlockHeader.CalculateFooterCheckSum <> APDebugBlockHeader.DebugFooterPtr^ then + begin + LogDebugBlockFooterInvalid(APDebugBlockHeader); + Exit(False); + end; + + Result := True; +end; + +procedure FillDebugBlockWithDebugPattern(APDebugBlockHeader: PFastMM_DebugBlockHeader); +var + LByteOffset: NativeInt; + LPUserArea: PByte; +begin + LByteOffset := APDebugBlockHeader.UserSize; + LPUserArea := PByte(APDebugBlockHeader) + SizeOf(TFastMM_DebugBlockHeader); + + {Store a pointer to the freed object class if the block is large enough.} + if LByteOffset >= CTObjectInstanceSize then + begin + PPointerArray(LPUserArea)[0] := TFastMM_FreedObject; + {$ifdef 32Bit} + PIntegerArray(LPUserArea)[1] := Integer(CDebugFillPattern4B); + {$endif} + Dec(LByteOffset, 8); + Inc(LPUserArea, 8); + end; + + if LByteOffset and 1 <> 0 then + begin + Dec(LByteOffset); + LPUserArea[LByteOffset] := CDebugFillPattern1B; + end; + + if LByteOffset and 2 <> 0 then + begin + Dec(LByteOffset, 2); + PWord(@LPUserArea[LByteOffset])^ := CDebugFillPattern2B; + end; + + if LByteOffset and 4 <> 0 then + begin + Dec(LByteOffset, 4); + PCardinal(@LPUserArea[LByteOffset])^ := CDebugFillPattern4B; + end; + + {Loop over the remaining 8 byte chunks using a negative offset.} + Inc(LPUserArea, LByteOffset); + LByteOffset := - LByteOffset; + while LByteOffset < 0 do + begin + PUInt64(@LPUserArea[LByteOffset])^ := CDebugFillPattern8B; + Inc(LByteOffset, 8); + end; + +end; + +{The debug header and footer are assumed to be valid.} +procedure LogDebugBlockFillPatternCorrupted(APDebugBlockHeader: PFastMM_DebugBlockHeader); +const + CMaxLoggedChanges = 32; +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; + LPUserArea: PByte; + LOffset, LChangeStart: NativeInt; + LLogCount: Integer; +begin + + LTokenValues := Default(TEventLogTokenValues); + LPBufferPos := @LTokenValueBuffer; + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + + {Add the modification detail tokens.} + LPUserArea := PByte(APDebugBlockHeader) + SizeOf(TFastMM_DebugBlockHeader); + LLogCount := 0; + LOffset := 0; + LTokenValues[CEventLogTokenModifyAfterFreeDetail] := LPBufferPos; + while LOffset < APDebugBlockHeader.UserSize do + begin + if LPUserArea[LOffset] <> CDebugFillPattern1B then + begin + + {Found the start of a changed block, now find the length} + LChangeStart := LOffset; + while True do + begin + Inc(LOffset); + if (LOffset >= APDebugBlockHeader.UserSize) + or (LPUserArea[LOffset] = CDebugFillPattern1B) then + begin + Break; + end; + end; + + if LLogCount > 0 then + begin + LPBufferPos^ := ','; + Inc(LPBufferPos); + LPBufferPos^ := ' '; + Inc(LPBufferPos); + end; + + LPBufferPos := NativeIntToTextBuffer(LChangeStart, LPBufferPos, LPBufferEnd); + LPBufferPos^ := '('; + Inc(LPBufferPos); + LPBufferPos := NativeIntToTextBuffer(LOffset - LChangeStart, LPBufferPos, LPBufferEnd); + LPBufferPos^ := ')'; + Inc(LPBufferPos); + + Inc(LLogCount); + if LLogCount >= CMaxLoggedChanges then + Break; + + end; + Inc(LOffset); + end; + + LPBufferPos^ := #0; + Inc(LPBufferPos); + + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, LPBufferPos, LPBufferEnd); + AddTokenValues_BlockTokens(LTokenValues, PByte(APDebugBlockHeader) + CDebugBlockHeaderSize, LPBufferPos, LPBufferEnd); + + LogEvent(mmetDebugBlockModifiedAfterFree, LTokenValues); +end; + +{Checks that the debug fill pattern in the debug block is intact. Returns True if the block is intact, otherwise +(optionally) logs and/or displays the error and returns False.} +function CheckDebugBlockFillPatternIntact(APDebugBlockHeader: PFastMM_DebugBlockHeader): Boolean; +var + LByteOffset: NativeInt; + LPUserArea: PByte; + LFillPatternIntact: Boolean; +begin + LByteOffset := APDebugBlockHeader.UserSize; + LPUserArea := PByte(APDebugBlockHeader) + SizeOf(TFastMM_DebugBlockHeader); + LFillPatternIntact := True; + + {If the block is large enough the first 4/8 bytes should be a pointer to the freed object class.} + if LByteOffset >= CTObjectInstanceSize then + begin + LFillPatternIntact := (PPointer(LPUserArea)^ = TFastMM_FreedObject) + {$ifdef 32Bit} + and (PIntegerArray(LPUserArea)[1] = Integer(CDebugFillPattern4B)); + {$endif}; + Dec(LByteOffset, 8); + Inc(LPUserArea, 8); + end; + + + if LByteOffset and 1 <> 0 then + begin + Dec(LByteOffset); + if LPUserArea[LByteOffset] <> CDebugFillPattern1B then + LFillPatternIntact := False; + end; + + if LByteOffset and 2 <> 0 then + begin + Dec(LByteOffset, 2); + if PWord(@LPUserArea[LByteOffset])^ <> CDebugFillPattern2B then + LFillPatternIntact := False; + end; + + if LByteOffset and 4 <> 0 then + begin + Dec(LByteOffset, 4); + if PCardinal(@LPUserArea[LByteOffset])^ <> CDebugFillPattern4B then + LFillPatternIntact := False; + end; + + {Loop over the remaining 8 byte chunks using a negative offset.} + Inc(LPUserArea, LByteOffset); + LByteOffset := - LByteOffset; + while LByteOffset < 0 do + begin + if PUInt64(@LPUserArea[LByteOffset])^ <> CDebugFillPattern8B then + begin + LFillPatternIntact := False; + Break; + end; + + Inc(LByteOffset, 8); + end; + + if not LFillPatternIntact then + begin + {Log the block error.} + LogDebugBlockFillPatternCorrupted(APDebugBlockHeader); + Result := False; + end + else + Result := True; +end; + +{Checks a free debug block for oorruption of the header, footer or fill pattern. Returns True if it is intact.} +function CheckFreeDebugBlockIntact(APDebugBlockHeader: PFastMM_DebugBlockHeader): Boolean; +begin + Result := CheckDebugBlockHeaderAndFooterCheckSumsValid(APDebugBlockHeader) + and CheckDebugBlockFillPatternIntact(APDebugBlockHeader); +end; + +procedure EnsureEmergencyReserveAddressSpaceAllocated; +begin +{$ifdef 32Bit} + if EmergencyReserveAddressSpace = nil then + EmergencyReserveAddressSpace := OS_AllocateVirtualMemory(CEmergencyReserveAddressSpace, False, True); +{$endif} +end; + +procedure ReleaseEmergencyReserveAddressSpace; +begin +{$ifdef 32Bit} + if EmergencyReserveAddressSpace <> nil then + begin + OS_FreeVirtualMemory(EmergencyReserveAddressSpace, CEmergencyReserveAddressSpace); + EmergencyReserveAddressSpace := nil; + end; +{$endif} +end; + +{Logs a thread contention and yields execution to another thread that is ready to run.} +procedure LogSmallBlockThreadContentionAndYieldToOtherThread; +begin + Inc(FastMM_SmallBlockThreadContentionCount); + OS_AllowOtherThreadToRun; +end; + +procedure LogMediumBlockThreadContentionAndYieldToOtherThread; +begin + Inc(FastMM_MediumBlockThreadContentionCount); + OS_AllowOtherThreadToRun; +end; + +procedure LogLargeBlockThreadContentionAndYieldToOtherThread; +begin + Inc(FastMM_LargeBlockThreadContentionCount); + OS_AllowOtherThreadToRun; +end; + + +{-----------------------------------------} +{--------Debug block management-----------} +{-----------------------------------------} + +function FastMM_FreeMem_FreeDebugBlock(APointer: Pointer): Integer; +var + LPActualBlock: PFastMM_DebugBlockHeader; +begin + LPActualBlock := @PFastMM_DebugBlockHeader(APointer)[-1]; + + {Check that the debug header and footer are intact} + if not CheckDebugBlockHeaderAndFooterCheckSumsValid(LPActualBlock) then + System.Error(reInvalidPtr); + + {Avoid a potential race condition here: While the debug header and footer is being updated the block must be flagged + as not containing any debug information, otherwise a concurrent call to FastMM_ScanDebugBlocksForCorruption may flag + this block as corrupted.} + SetBlockHasDebugInfo(LPActualBlock, False); + + {Update the information in the block header.} + LPActualBlock.FreedByThread := OS_GetCurrentThreadID; + if LPActualBlock.StackTraceEntryCount > 0 then + FastMM_GetStackTrace(LPActualBlock.DebugFooter_FreeStackTracePtr, LPActualBlock.StackTraceEntryCount, CFastMM_StackTrace_SkipFrames_FreeMem); + LPActualBlock.PreviouslyUsedByClass := PPointer(APointer)^; + + {Fill the user area of the block with the debug pattern.} + FillDebugBlockWithDebugPattern(LPActualBlock); + + {The block is now free.} + LPActualBlock.DebugBlockFlags := CIsDebugBlockFlag or CBlockIsFreeFlag; + + {Update the header and footer checksums} + LPActualBlock.CalculateAndSetHeaderAndFooterCheckSums; + + {Restore the debug information flag.} + SetBlockHasDebugInfo(LPActualBlock, True); + + {Return the actual block to the memory pool.} + Result := FastMM_FreeMem(LPActualBlock); +end; + +{Reallocates a block containing debug information. Any debug information remains intact.} +function FastMM_ReallocMem_ReallocDebugBlock(APointer: Pointer; ANewSize: NativeInt): Pointer; +var + LPActualBlock: PFastMM_DebugBlockHeader; + LAvailableSpace, LDebugFooterSize: NativeInt; + LPOldFooter, LPNewFooter: Pointer; +begin + LPActualBlock := @PFastMM_DebugBlockHeader(APointer)[-1]; + + {Check that the debug header and footer are intact} + if not CheckDebugBlockHeaderAndFooterCheckSumsValid(LPActualBlock) then + System.Error(reInvalidPtr); + + {Can the block be resized in-place?} + LAvailableSpace := FastMM_BlockMaximumUserBytes(LPActualBlock); + LDebugFooterSize := CalculateDebugBlockFooterSize(LPActualBlock.StackTraceEntryCount); + if LAvailableSpace >= (ANewSize + CDebugBlockHeaderSize + LDebugFooterSize) then + begin + + {Avoid a potential race condition here: While the debug header and footer is being updated the block must be flagged + as not containing any debug information, otherwise a concurrent call to FastMM_ScanDebugBlocksForCorruption may flag + this block as corrupted.} + SetBlockHasDebugInfo(LPActualBlock, False); + + LPOldFooter := LPActualBlock.DebugFooterPtr; + + {Update the user block size and set the new header checksum. The footer checksum should be unchanged.} + LPActualBlock.UserSize := ANewSize; + LPActualBlock.HeaderCheckSum := LPActualBlock.CalculateHeaderCheckSum; + + {Move the debug footer just beyond the new user size.} + LPNewFooter := LPActualBlock.DebugFooterPtr; + System.Move(LPOldFooter^, LPNewFooter^, LDebugFooterSize); + + {Restore the debug information flag.} + SetBlockHasDebugInfo(LPActualBlock, True); + + Result := APointer; + end + else + begin + {The new size cannot fit in the existing block: We need to allocate a new block.} + Result := FastMM_GetMem(ANewSize + CDebugBlockHeaderSize + LDebugFooterSize); + + if Result <> nil then + begin + {Move the old header and data across} + System.Move(LPActualBlock^, Result^, LPActualBlock.UserSize + CDebugBlockHeaderSize); + + {Set the user size in the header for the new block and calculate the new header checksum.} + PFastMM_DebugBlockHeader(Result).UserSize := ANewSize; + PFastMM_DebugBlockHeader(Result).HeaderCheckSum := PFastMM_DebugBlockHeader(Result).CalculateHeaderCheckSum; + + {Move the debug footer over to the end of the user data.} + LPOldFooter := LPActualBlock.DebugFooterPtr; + LPNewFooter := PFastMM_DebugBlockHeader(Result).DebugFooterPtr; + System.Move(LPOldFooter^, LPNewFooter^, LDebugFooterSize); + + {Free the old block.} + FastMM_FreeMem_FreeDebugBlock(APointer); + + {Set the flag in the actual block header to indicate that the block contains debug information.} + SetBlockHasDebugInfo(Result, True); + + {Return a pointer to the user data} + Inc(PByte(Result), CDebugBlockHeaderSize); + + end; + + end; +end; + + +{----------------------------------------------------} +{------------Invalid Free/realloc handling-----------} +{----------------------------------------------------} + +{Always returns - 1.} +function HandleInvalidFreeMemOrReallocMem(APointer: Pointer; AIsReallocMemCall: Boolean): Integer; +var + LPDebugBlockHeader: PFastMM_DebugBlockHeader; + LHeaderChecksum: NativeUInt; + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; +begin + {Is this a debug block that has already been freed? If not, it could be a bad pointer value, in which case there's + not much that can be done to provide additional error information.} + if PBlockStatusFlags(APointer)[-1] <> (CBlockIsFreeFlag or CIsDebugBlockFlag) then + Exit(-1); + + {Check that the debug block header is intact. If it is, then a meaningful error may be returned.} + LPDebugBlockHeader := @PFastMM_DebugBlockHeader(APointer)[-1]; + LHeaderChecksum := LPDebugBlockHeader.CalculateHeaderCheckSum; + if LPDebugBlockHeader.HeaderCheckSum <> LHeaderChecksum then + Exit(-1); + + LTokenValues := Default(TEventLogTokenValues); + + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, LPBufferEnd); + AddTokenValues_BlockTokens(LTokenValues, APointer, LPBufferPos, LPBufferEnd); + + if AIsReallocMemCall then + LogEvent(mmetDebugBlockReallocOfFreedBlock, LTokenValues) + else + LogEvent(mmetDebugBlockDoubleFree, LTokenValues); + + Result := -1; +end; + + +{-----------------------------------------} +{--------Large block management-----------} +{-----------------------------------------} + +function FastMM_FreeMem_FreeLargeBlock_ReleaseVM(APLargeBlockHeader: PLargeBlockHeader): Integer; +var + LRemainingSize: NativeUInt; + LPCurrentSegment: Pointer; + LMemoryRegionInfo: TMemoryRegionInfo; +begin + if not APLargeBlockHeader.BlockIsSegmented then + begin + Result := OS_FreeVirtualMemory(APLargeBlockHeader, APLargeBlockHeader.ActualBlockSize); + end + else + begin + {The large block is segmented - free all segments} + LPCurrentSegment := APLargeBlockHeader; + LRemainingSize := NativeUInt(APLargeBlockHeader.ActualBlockSize); +{$if CompilerVersion < 31} + Result := 0; //Workaround for spurious warning with older compilers +{$endif} + while True do + begin + OS_GetVirtualMemoryRegionInfo(LPCurrentSegment, LMemoryRegionInfo); + + Result := OS_FreeVirtualMemory(LPCurrentSegment, LMemoryRegionInfo.RegionSize); + if Result <> 0 then + Break; + + {Done?} + if LMemoryRegionInfo.RegionSize >= LRemainingSize then + Break; + + {Decrement the remaining size} + Dec(LRemainingSize, LMemoryRegionInfo.RegionSize); + Inc(PByte(LPCurrentSegment), LMemoryRegionInfo.RegionSize); + end; + + end; +end; + +{Unlink this block from the circular list of large blocks. The manager must be locked.} +procedure UnlinkLargeBlock(APLargeBlockHeader: PLargeBlockHeader); +var + LPreviousLargeBlockHeader: PLargeBlockHeader; + LNextLargeBlockHeader: PLargeBlockHeader; +begin + LPreviousLargeBlockHeader := APLargeBlockHeader.PreviousLargeBlockHeader; + LNextLargeBlockHeader := APLargeBlockHeader.NextLargeBlockHeader; + LNextLargeBlockHeader.PreviousLargeBlockHeader := LPreviousLargeBlockHeader; + LPreviousLargeBlockHeader.NextLargeBlockHeader := LNextLargeBlockHeader; +end; + +{Processes all the pending frees in the large block arena, and unlocks the arena when done. Returns 0 on success.} +function ProcessLargeBlockPendingFrees_ArenaAlreadyLocked(APLargeBlockManager: PLargeBlockManager): Integer; +var + LOldPendingFreeList, LPCurrentLargeBlock, LPNextLargeBlock: Pointer; + LPLargeBlockHeader: PLargeBlockHeader; +begin + Result := 0; + + {Get the pending free list} + LOldPendingFreeList := AtomicExchange(APLargeBlockManager.PendingFreeList, nil); + + {Unlink all the large blocks from the manager} + LPCurrentLargeBlock := LOldPendingFreeList; + while LPCurrentLargeBlock <> nil do + begin + LPNextLargeBlock := PPointer(LPCurrentLargeBlock)^; + + LPLargeBlockHeader := @PLargeBlockHeader(LPCurrentLargeBlock)[-1]; + UnlinkLargeBlock(LPLargeBlockHeader); + + LPCurrentLargeBlock := LPNextLargeBlock; + end; + + {The large block manager no longer needs to be locked} + APLargeBlockManager.LargeBlockManagerLocked := 0; + + {Free all the memory for the large blocks} + LPCurrentLargeBlock := LOldPendingFreeList; + while LPCurrentLargeBlock <> nil do + begin + LPNextLargeBlock := PPointer(LPCurrentLargeBlock)^; + + LPLargeBlockHeader := @PLargeBlockHeader(LPCurrentLargeBlock)[-1]; + if FastMM_FreeMem_FreeLargeBlock_ReleaseVM(LPLargeBlockHeader) <> 0 then + Result := -1; + + LPCurrentLargeBlock := LPNextLargeBlock; + end; + +end; + +{Process the pending frees list for all unlocked arenas, returning 0 on success or -1 if any error occurs} +function ProcessLargeBlockPendingFrees: Integer; +var + LPLargeBlockManager: PLargeBlockManager; + LArenaIndex: Integer; +begin + Result := 0; + + LPLargeBlockManager := @LargeBlockManagers[0]; + for LArenaIndex := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + + if (LPLargeBlockManager.PendingFreeList <> nil) + and (LPLargeBlockManager.LargeBlockManagerLocked = 0) + and (AtomicExchange(LPLargeBlockManager.LargeBlockManagerLocked, 1) = 0) then + begin + + Result := ProcessLargeBlockPendingFrees_ArenaAlreadyLocked(LPLargeBlockManager); + + if Result <> 0 then + Break; + + end; + + {Do the next arena.} + Inc(LPLargeBlockManager); + end; + +end; + +{Allocates a Large block of at least ASize (actual size may be larger to allow for alignment etc.). ASize must be the +actual user requested size. This procedure will pad it to the appropriate page boundary and also add the space +required by the header.} +function FastMM_GetMem_GetLargeBlock(ASize: NativeInt): Pointer; +var + LLargeBlockActualSize: NativeInt; + LPLargeBlockManager: PLargeBlockManager; + LArenaIndex: Integer; + LOldFirstLargeBlock: PLargeBlockHeader; +begin + {Process the pending free lists of all arenas.} + if ProcessLargeBlockPendingFrees <> 0 then + Exit(nil); + + {Pad the block size to include the header and granularity, checking for overflow.} + LLargeBlockActualSize := (ASize + CLargeBlockHeaderSize + CLargeBlockGranularity - 1) and -CLargeBlockGranularity; + if LLargeBlockActualSize <= CMaximumMediumBlockSize then + Exit(nil); + {Get the large block. For segmented large blocks to work in practice without excessive move operations we need to + allocate top down.} + Result := OS_AllocateVirtualMemory(LLargeBlockActualSize, True, False); + + {Set the Large block fields} + if Result <> nil then + begin + {Set the large block size and flags} + PLargeBlockHeader(Result).UserAllocatedSize := ASize; + PLargeBlockHeader(Result).ActualBlockSize := LLargeBlockActualSize; + PLargeBlockHeader(Result).BlockIsSegmented := False; + PLargeBlockHeader(Result).BlockStatusFlags := CIsLargeBlockFlag; + + {Insert the block in the first available arena.} + while True do + begin + + LPLargeBlockManager := @LargeBlockManagers[0]; + for LArenaIndex := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + + if (LPLargeBlockManager.LargeBlockManagerLocked = 0) + and (AtomicExchange(LPLargeBlockManager.LargeBlockManagerLocked, 1) = 0) then + begin + PLargeBlockHeader(Result).LargeBlockManager := LPLargeBlockManager; + + {Insert the large block into the linked list of large blocks} + LOldFirstLargeBlock := LPLargeBlockManager.FirstLargeBlockHeader; + PLargeBlockHeader(Result).PreviousLargeBlockHeader := Pointer(LPLargeBlockManager); + LPLargeBlockManager.FirstLargeBlockHeader := Result; + PLargeBlockHeader(Result).NextLargeBlockHeader := LOldFirstLargeBlock; + LOldFirstLargeBlock.PreviousLargeBlockHeader := Result; + + LPLargeBlockManager.LargeBlockManagerLocked := 0; + + {Add the size of the header} + Inc(PByte(Result), CLargeBlockHeaderSize); + + Exit; + end; + + {Try the next arena.} + Inc(LPLargeBlockManager); + end; + + end; + + {All large block managers are locked: Back off and try again.} + LogLargeBlockThreadContentionAndYieldToOtherThread; + + end; +end; + +function FastMM_FreeMem_FreeLargeBlock(APLargeBlock: Pointer): Integer; +var + LPLargeBlockHeader: PLargeBlockHeader; + LPLargeBlockManager: PLargeBlockManager; + LOldPendingFreeList: Pointer; +begin + LPLargeBlockHeader := @PLargeBlockHeader(APLargeBlock)[-1]; + LPLargeBlockManager := LPLargeBlockHeader.LargeBlockManager; + + {Try to lock the large block manager so that the block may be freed.} + if AtomicCmpExchange(LPLargeBlockManager.LargeBlockManagerLocked, 1, 0) = 0 then + begin + {Unlink the large block from the circular queue for the manager.} + UnlinkLargeBlock(LPLargeBlockHeader); + + {The large block manager no longer has to be locked, since the large block has been unlinked.} + LPLargeBlockManager.LargeBlockManagerLocked := 0; + + {Release the memory used by the large block.} + Result := FastMM_FreeMem_FreeLargeBlock_ReleaseVM(LPLargeBlockHeader); + + end + else + begin + {The large block manager is currently locked, so we need to add this block to its pending free list.} + while True do + begin + LOldPendingFreeList := LPLargeBlockManager.PendingFreeList; + PPointer(APLargeBlock)^ := LOldPendingFreeList; + if AtomicCmpExchange(LPLargeBlockManager.PendingFreeList, APLargeBlock, LOldPendingFreeList) = LOldPendingFreeList then + Break; + end; + + Result := 0; + end; + + if Result = 0 then + Result := ProcessLargeBlockPendingFrees; +end; + +function FastMM_ReallocMem_ReallocLargeBlock(APointer: Pointer; ANewSize: NativeInt): Pointer; +var + LPLargeBlockHeader: PLargeBlockHeader; + LOldAvailableSize, LNewAllocSize, LNewSegmentSize, LOldUserSize: NativeInt; + LMemoryRegionInfo: TMemoryRegionInfo; + LPNextSegment: Pointer; +begin + {Get the block header} + LPLargeBlockHeader := @PLargeBlockHeader(APointer)[-1]; + {Large block - size is (16 + 4) less than the allocated size} + LOldAvailableSize := LPLargeBlockHeader.ActualBlockSize - CLargeBlockHeaderSize; + {Is it an upsize or a downsize?} + if ANewSize > LOldAvailableSize then + begin + {This pointer is being reallocated to a larger block and therefore it is logical to assume that it may be enlarged + again. Since reallocations are expensive, there is a minimum upsize percentage to avoid unnecessary future move + operations. This is currently set to 25%.} + LNewAllocSize := LOldAvailableSize + (LOldAvailableSize shr 2); + if LNewAllocSize < ANewSize then + LNewAllocSize := ANewSize; + + {Can another large block segment be allocated directly after this segment, thus negating the need to move the data?} + LPNextSegment := Pointer(PByte(LPLargeBlockHeader) + LPLargeBlockHeader.ActualBlockSize); + OS_GetVirtualMemoryRegionInfo(LPNextSegment, LMemoryRegionInfo); + if LMemoryRegionInfo.RegionIsFree then + begin + {Round the region size to the previous 64K} + LMemoryRegionInfo.RegionSize := LMemoryRegionInfo.RegionSize and -CLargeBlockGranularity; + {Enough space to grow in place?} + if LMemoryRegionInfo.RegionSize >= NativeUInt(ANewSize - LOldAvailableSize) then + begin + {There is enough space after the block to extend it - determine by how much} + LNewSegmentSize := (LNewAllocSize - LOldAvailableSize + CLargeBlockGranularity - 1) and -CLargeBlockGranularity; + if NativeUInt(LNewSegmentSize) > LMemoryRegionInfo.RegionSize then + LNewSegmentSize := LMemoryRegionInfo.RegionSize; + {Attempt to reserve the address range (which will fail if another thread has just reserved it) and commit it + immediately afterwards.} + if OS_AllocateVirtualMemoryAtAddress(LPNextSegment, LNewSegmentSize, False) then + begin + {Update the requested size} + LPLargeBlockHeader.UserAllocatedSize := ANewSize; + Inc(LPLargeBlockHeader.ActualBlockSize, LNewSegmentSize); + LPLargeBlockHeader.BlockIsSegmented := True; + Exit(APointer); + end; + end; + end; + + {Could not resize in place: Allocate the new block} + Result := FastMM_GetMem(LNewAllocSize); + if Result <> nil then + begin + {If it's a large block - store the actual user requested size (it may not be if the block that is being + reallocated from was previously downsized)} + if LNewAllocSize > (CMaximumMediumBlockSize - CMediumBlockHeaderSize) then + PLargeBlockHeader(Result)[-1].UserAllocatedSize := ANewSize; + {The user allocated size is stored for large blocks} + LOldUserSize := LPLargeBlockHeader.UserAllocatedSize; + {The number of bytes to move is the old user size.} + MoveMultipleOf64_Large(APointer^, Result^, LOldUserSize); + {Free the old block.} + FastMM_FreeMem(APointer); + end; + end + else + begin + {It's a downsize: Do we need to reallocate? Only if the new size is less than half the old size.} + if ANewSize >= (LOldAvailableSize shr 1) then + begin + {No need to reallocate} + Result := APointer; + {Update the requested size} + LPLargeBlockHeader.UserAllocatedSize := ANewSize; + end + else + begin + {The new size is less than half the old size: Reallocate} + Result := FastMM_GetMem(ANewSize); + if Result <> nil then + begin + {Move the data across} + System.Move(APointer^, Result^, ANewSize); + {Free the old block.} + FastMM_FreeMem(APointer); + end; + end; + end; + +end; + + +{------------------------------------------} +{--------Medium block management-----------} +{------------------------------------------} + +{Takes a user request size and converts it to a size that fits the size of a medium block bin exactly.} +function RoundUserSizeUpToNextMediumBlockBin(AUserSize: Integer): Integer; inline; +begin + if AUserSize <= (CMediumBlockMiddleBinsStart - CMediumBlockHeaderSize) then + begin + Result := (AUserSize + (CMediumBlockHeaderSize - CMinimumMediumBlockSize + CInitialBinSpacing - 1)) and -CInitialBinSpacing + + CMinimumMediumBlockSize; + end + else + begin + if AUserSize <= (CMediumBlockFinalBinsStart - CMediumBlockHeaderSize) then + begin + Result := (AUserSize + (CMediumBlockHeaderSize - CMediumBlockMiddleBinsStart + CMiddleBinSpacing - 1)) and -CMiddleBinSpacing + + CMediumBlockMiddleBinsStart; + end + else + begin + Result := (AUserSize + (CMediumBlockHeaderSize - CMediumBlockFinalBinsStart + CFinalBinSpacing - 1)) and -CFinalBinSpacing + + CMediumBlockFinalBinsStart; + end; + end; +end; + +{Determines the appropriate bin number for blocks of AMediumBlockSize. If AMediumBlockSize is not exactly aligned to a +bin size then the bin just smaller than AMediumBlockSize will be returned. It is assumed that AMediumBlockSize <= +CMaximumMediumBlockSize.} +function GetBinNumberForMediumBlockSize(AMediumBlockSize: Integer): Integer; inline; +begin + if AMediumBlockSize <= CMediumBlockMiddleBinsStart then + begin + Result := (AMediumBlockSize - CMinimumMediumBlockSize) shr CInitialBinSpacingBits; + end + else + begin + if AMediumBlockSize <= CMediumBlockFinalBinsStart then + Result := (AMediumBlockSize + (CInitialBinCount * CMiddleBinSpacing - CMediumBlockMiddleBinsStart)) shr CMiddleBinSpacingBits + else + Result := (AMediumBlockSize + ((CInitialBinCount + CMiddleBinCount) * CFinalBinSpacing - CMediumBlockFinalBinsStart)) shr CFinalBinSpacingBits; + end; +end; + +function GetMediumBlockSpan(APMediumBlock: Pointer): PMediumBlockSpanHeader; inline; +begin + Result := PMediumBlockSpanHeader(NativeUInt(APMediumBlock) + - (PMediumBlockHeader(APMediumBlock)[-1].MediumBlockSpanOffsetMultiple shl CMediumBlockAlignmentBits)); +end; + +function GetMediumBlockSize(APMediumBlock: Pointer): Integer; inline; +begin + Result := PMediumBlockHeader(APMediumBlock)[-1].MediumBlockSizeMultiple shl CMediumBlockAlignmentBits; +end; + +procedure SetMediumBlockHeader_SetIsSmallBlockSpan(APMediumBlock: Pointer; AIsSmallBlockSpan: Boolean); inline; +begin + PMediumBlockHeader(APMediumBlock)[-1].IsSmallBlockSpan := AIsSmallBlockSpan; +end; + +procedure SetMediumBlockHeader_SetMediumBlockSpan(APMediumBlock: Pointer; APMediumBlockSpan: PMediumBlockSpanHeader); inline; +begin + {Store the offset to the medium block span.} + PMediumBlockHeader(APMediumBlock)[-1].MediumBlockSpanOffsetMultiple := + (NativeUInt(APMediumBlock) - NativeUInt(APMediumBlockSpan)) shr CMediumBlockAlignmentBits; +end; + +procedure SetMediumBlockHeader_SetSizeAndFlags(APMediumBlock: Pointer; ABlockSize: Integer; ABlockIsFree: Boolean; + ABlockHasDebugInfo: Boolean); inline; +var + LPNextBlock: Pointer; +begin + if ABlockIsFree then + begin + + if ABlockHasDebugInfo then + PMediumBlockHeader(APMediumBlock)[-1].BlockStatusFlags := CHasDebugInfoFlag + CBlockIsFreeFlag + CIsMediumBlockFlag + else + PMediumBlockHeader(APMediumBlock)[-1].BlockStatusFlags := CBlockIsFreeFlag + CIsMediumBlockFlag; + + LPNextBlock := @PByte(APMediumBlock)[ABlockSize]; + {If the block is free then the size must also be stored just before the header of the next block.} + PMediumFreeBlockFooter(LPNextBlock)[-1].MediumFreeBlockSize := ABlockSize; + + {Update the flag in the next block header to indicate that this block is free.} + PMediumBlockHeader(LPNextBlock)[-1].PreviousBlockIsFree := True; + + end + else + begin + + if ABlockHasDebugInfo then + PMediumBlockHeader(APMediumBlock)[-1].BlockStatusFlags := CHasDebugInfoFlag + CIsMediumBlockFlag + else + PMediumBlockHeader(APMediumBlock)[-1].BlockStatusFlags := CIsMediumBlockFlag; + + LPNextBlock := @PByte(APMediumBlock)[ABlockSize]; + {Update the flag in the next block to indicate that this block is in use. The block size is not stored before + the header of the next block if it is not free.} + PMediumBlockHeader(LPNextBlock)[-1].PreviousBlockIsFree := False; + + end; + + {Store the block size.} + PMediumBlockHeader(APMediumBlock)[-1].MediumBlockSizeMultiple := ABlockSize shr CMediumBlockAlignmentBits; +end; + +{Inserts a medium block into the appropriate medium block bin. The header for APMediumFreeBlock must already be set +correctly.} +procedure InsertMediumBlockIntoBin(APMediumBlockManager: PMediumBlockManager; APMediumFreeBlock: PMediumFreeBlockContent; + AMediumBlockSize: Integer); +var + LBinNumber, LBinGroupNumber: Cardinal; + LPBin, LPInsertAfterBlock, LPInsertBeforeBlock: PMediumFreeBlockContent; +begin + {Get the bin for blocks of this size. If the block is not aligned to a bin size, then put it in the closest bin + smaller than the block size.} + if AMediumBlockSize < CMaximumMediumBlockSize then + LBinNumber := GetBinNumberForMediumBlockSize(AMediumBlockSize) + else + LBinNumber := CMediumBlockBinCount - 1; + LPBin := @APMediumBlockManager.FirstFreeBlockInBin[LBinNumber]; + + {Bins are LIFO, so we insert this block as the first free block in the bin} + LPInsertAfterBlock := LPBin; + LPInsertBeforeBlock := LPBin.NextFreeMediumBlock; + + APMediumFreeBlock.NextFreeMediumBlock := LPInsertBeforeBlock; + APMediumFreeBlock.PreviousFreeMediumBlock := LPInsertAfterBlock; + LPInsertAfterBlock.NextFreeMediumBlock := APMediumFreeBlock; + + {Was this bin previously empty?} + if LPInsertBeforeBlock <> LPInsertAfterBlock then + begin + {It's not a fully circular linked list: Bins have no "previous" pointer.} + if LPInsertBeforeBlock <> LPBin then + LPInsertBeforeBlock.PreviousFreeMediumBlock := APMediumFreeBlock; + end + else + begin + {Get the group number} + LBinGroupNumber := LBinNumber shr 5; //32 bins per group + {Flag this bin as used} + APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] := APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] + or (1 shl (LBinNumber and 31)); + {Flag the group as used} + APMediumBlockManager.MediumBlockBinGroupBitmap := APMediumBlockManager.MediumBlockBinGroupBitmap + or (1 shl LBinGroupNumber); + end; +end; + +{Removes a medium block from the circular linked list of free blocks. Does not change any header flags. The medium +block manager should be locked before calling this procedure.} +procedure RemoveMediumFreeBlockFromBin(APMediumBlockManager: PMediumBlockManager; APMediumFreeBlock: PMediumFreeBlockContent); +var + LPPreviousFreeBlock, LPNextFreeBlock: PMediumFreeBlockContent; + LBinNumber, LBinGroupNumber: Cardinal; +begin + {Get the current previous and next blocks} + LPNextFreeBlock := APMediumFreeBlock.NextFreeMediumBlock; + LPPreviousFreeBlock := APMediumFreeBlock.PreviousFreeMediumBlock; + {Remove this block from the linked list} + LPPreviousFreeBlock.NextFreeMediumBlock := LPNextFreeBlock; + {Is this bin now empty? If the previous and next free block pointers are equal, they must point to the bin.} + if LPNextFreeBlock <> LPPreviousFreeBlock then + begin + {It's not a fully circular linked list: Bins have no "previous" pointer. Therefore we need to check whether + LPNextFreeBlock points to the bin or not before setting the previous block pointer.} + if (NativeUInt(LPNextFreeBlock) > NativeUInt(@MediumBlockManagers) + SizeOf(MediumBlockManagers)) + or (NativeUInt(LPNextFreeBlock) < NativeUInt(@MediumBlockManagers)) then + begin + LPNextFreeBlock.PreviousFreeMediumBlock := LPPreviousFreeBlock; + end; + end + else + begin + {Calculate the bin number from the bin pointer: LPNextFreeBlock will be a pointer to the bin, since the bin is now + empty.)} + LBinNumber := (NativeInt(LPNextFreeBlock) - NativeInt(@APMediumBlockManager.FirstFreeBlockInBin)) shr CPointerSizeBitShift; + LBinGroupNumber := LBinNumber shr 5; //32 bins per group + {Flag this bin as empty} + APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] := APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] + and (not (1 shl (LBinNumber and 31))); + {Is the group now entirely empty?} + if APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] = 0 then + begin + {Flag this group as empty} + APMediumBlockManager.MediumBlockBinGroupBitmap := APMediumBlockManager.MediumBlockBinGroupBitmap + and (not (1 shl LBinGroupNumber)); + end; + end; +end; + +{Bins what remains in the current sequential feed medium block span. The medium block manager must be locked.} +procedure BinMediumSequentialFeedRemainder(APMediumBlockManager: PMediumBlockManager); +var + LPreviousLastSequentialFeedBlockOffset, LNextBlockSize: Integer; + LSequentialFeedFreeSize: Integer; + LPRemainderBlock, LPNextMediumBlock: Pointer; +begin + while True do + begin + + LPreviousLastSequentialFeedBlockOffset := APMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue; + + {Is there anything to bin?} + if LPreviousLastSequentialFeedBlockOffset <= CMediumBlockSpanHeaderSize then + Break; + + {There's no need to update the ABA counter, since the medium block manager is locked and no other thread can thus + change the sequential feed span.} + if AtomicCmpExchange(APMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue, 0, + LPreviousLastSequentialFeedBlockOffset) = LPreviousLastSequentialFeedBlockOffset then + begin + LSequentialFeedFreeSize := LPreviousLastSequentialFeedBlockOffset - CMediumBlockSpanHeaderSize; + + {Get the block for the remaining space} + LPNextMediumBlock := PByte(APMediumBlockManager.SequentialFeedMediumBlockSpan) + LPreviousLastSequentialFeedBlockOffset; + + {Point to the remainder} + LPRemainderBlock := Pointer(PByte(APMediumBlockManager.SequentialFeedMediumBlockSpan) + CMediumBlockSpanHeaderSize); + + {Can the next block be combined with the remainder?} + if BlockIsFree(LPNextMediumBlock) then + begin + LNextBlockSize := GetMediumBlockSize(LPNextMediumBlock); + {Increase the size of this block} + Inc(LSequentialFeedFreeSize, LNextBlockSize); + {Remove the next block from the bins, if it is currently binned.} + if LNextBlockSize >= CMinimumMediumBlockSize then + RemoveMediumFreeBlockFromBin(APMediumBlockManager, LPNextMediumBlock); + end; + + {Store the size of the block as well as the flags. Also updates the header of the next block to indicate that + this block is free.} + SetMediumBlockHeader_SetSizeAndFlags(LPRemainderBlock, LSequentialFeedFreeSize, True, False); + SetMediumBlockHeader_SetMediumBlockSpan(LPRemainderBlock, APMediumBlockManager.SequentialFeedMediumBlockSpan); + + {Bin this medium block} + if LSequentialFeedFreeSize >= CMinimumMediumBlockSize then + InsertMediumBlockIntoBin(APMediumBlockManager, LPRemainderBlock, LSequentialFeedFreeSize); + + Break; + end; + + end; + +end; + +{Subroutine for FastMM_FreeMem_FreeMediumBlock. The medium block manager must already be locked. Optionally unlocks the +medium block manager before exit. Returns 0 on success, -1 on failure.} +function FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked(APMediumBlockManager: PMediumBlockManager; + APMediumBlockSpan: PMediumBlockSpanHeader; APMediumBlock: Pointer; AUnlockMediumBlockManager: Boolean): Integer; +var + LPPreviousMediumBlockSpan, LPNextMediumBlockSpan: PMediumBlockSpanHeader; + LBlockSize, LNextBlockSize, LPreviousBlockSize: Integer; + LPNextMediumBlock: Pointer; +begin + LBlockSize := GetMediumBlockSize(APMediumBlock); + + if DebugModeCounter <= 0 then + begin + {Combine with the next block, if it is free.} + LPNextMediumBlock := Pointer(PByte(APMediumBlock) + LBlockSize); + if BlockIsFree(LPNextMediumBlock) then + begin + LNextBlockSize := GetMediumBlockSize(LPNextMediumBlock); + Inc(LBlockSize, LNextBlockSize); + if LNextBlockSize >= CMinimumMediumBlockSize then + RemoveMediumFreeBlockFromBin(APMediumBlockManager, LPNextMediumBlock); + end; + + {Combine with the previous block, if it is free.} + if PMediumBlockHeader(APMediumBlock)[-1].PreviousBlockIsFree then + begin + LPreviousBlockSize := PMediumFreeBlockFooter(APMediumBlock)[-1].MediumFreeBlockSize; + {This is the new current block} + APMediumBlock := Pointer(PByte(APMediumBlock) - LPreviousBlockSize); + + Inc(LBlockSize, LPreviousBlockSize); + if LPreviousBlockSize >= CMinimumMediumBlockSize then + RemoveMediumFreeBlockFromBin(APMediumBlockManager, APMediumBlock); + end; + + {Outside of debug mode medium blocks are combined, so debug info will be lost.} + SetMediumBlockHeader_SetSizeAndFlags(APMediumBlock, LBlockSize, True, False); + + end + else + begin + {Medium blocks are not coalesced in debug mode, so just flag the block as free and leave the debug info flag as-is.} + SetBlockIsFreeFlag(APMediumBlock, True); + end; + + {Is the entire medium block span free? Normally the span will be freed, but if there is not a lot of space left in + the sequential feed span and the largest free block bin is empty then the block is binned instead (if allowed by the + optimization strategy).} + if (LBlockSize <> (APMediumBlockSpan.SpanSize - CMediumBlockSpanHeaderSize)) + or ((OptimizationStrategy <> mmosOptimizeForLowMemoryUsage) + and (APMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue < CMaximumMediumBlockSize) + and (APMediumBlockManager.MediumBlockBinBitmaps[CMediumBlockBinGroupCount - 1] and (1 shl 31) = 0)) then + begin + if LBlockSize >= CMinimumMediumBlockSize then + InsertMediumBlockIntoBin(APMediumBlockManager, APMediumBlock, LBlockSize); + + if AUnlockMediumBlockManager then + APMediumBlockManager.MediumBlockManagerLocked := 0; + + Result := 0; + end + else + begin + {Remove this medium block span from the linked list} + LPPreviousMediumBlockSpan := APMediumBlockSpan.PreviousMediumBlockSpanHeader; + LPNextMediumBlockSpan := APMediumBlockSpan.NextMediumBlockSpanHeader; + LPPreviousMediumBlockSpan.NextMediumBlockSpanHeader := LPNextMediumBlockSpan; + LPNextMediumBlockSpan.PreviousMediumBlockSpanHeader := LPPreviousMediumBlockSpan; + + if AUnlockMediumBlockManager then + APMediumBlockManager.MediumBlockManagerLocked := 0; + + {Free the entire span.} + Result := OS_FreeVirtualMemory(APMediumBlockSpan, APMediumBlockSpan.SpanSize); + end; +end; + +{Frees a chain of blocks belonging to the medium block manager. The block manager is assumed to be locked. Optionally +unlocks the block manager when done. The first pointer inside each free block should be a pointer to the next free +block.} +function FastMM_FreeMem_FreeMediumBlockChain(APMediumBlockManager: PMediumBlockManager; APPendingFreeMediumBlock: Pointer; + AUnlockMediumBlockManagerWhenDone: Boolean): Integer; +var + LPNextBlock: Pointer; + LPMediumBlockSpan: PMediumBlockSpanHeader; +begin + Result := 0; + + while True do + begin + LPNextBlock := PPointer(APPendingFreeMediumBlock)^; + + LPMediumBlockSpan := GetMediumBlockSpan(APPendingFreeMediumBlock); + Result := Result or FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked(APMediumBlockManager, LPMediumBlockSpan, + APPendingFreeMediumBlock, AUnlockMediumBlockManagerWhenDone and (LPNextBlock = nil)); + + if LPNextBlock = nil then + Break; + + APPendingFreeMediumBlock := LPNextBlock; + end; +end; + +function FastMM_FreeMem_FreeMediumBlock(APMediumBlock: Pointer): Integer; +var + LPMediumBlockSpan: PMediumBlockSpanHeader; + LPMediumBlockManager: PMediumBlockManager; + LFirstPendingFreeBlock: Pointer; +begin + LPMediumBlockSpan := GetMediumBlockSpan(APMediumBlock); + LPMediumBlockManager := LPMediumBlockSpan.MediumBlockManager; + + {Try to lock the medium block manager so that the block may be freed.} + if AtomicCmpExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1, 0) = 0 then + begin + + {Memory fence required for ARM here} + + if LPMediumBlockManager.PendingFreeList = nil then + begin + Result := FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked(LPMediumBlockManager, LPMediumBlockSpan, + APMediumBlock, True); + end + else + begin + Result := FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked(LPMediumBlockManager, LPMediumBlockSpan, + APMediumBlock, False); + + {Process the pending frees list.} + LFirstPendingFreeBlock := AtomicExchange(LPMediumBlockManager.PendingFreeList, nil); + Result := Result or FastMM_FreeMem_FreeMediumBlockChain(LPMediumBlockManager, LFirstPendingFreeBlock, True); + end; + + end + else + begin + {The medium block manager is currently locked, so we need to add this block to its pending free list.} + while True do + begin + LFirstPendingFreeBlock := LPMediumBlockManager.PendingFreeList; + PPointer(APMediumBlock)^ := LFirstPendingFreeBlock; + if AtomicCmpExchange(LPMediumBlockManager.PendingFreeList, APMediumBlock, LFirstPendingFreeBlock) = LFirstPendingFreeBlock then + Break; + end; + + Result := 0; + end; + +end; + +{Allocates a new sequential feed medium block span and immediately splits off a block of the requested size. The block +size must be a multiple of 64 and medium blocks must be locked. Returns a pointer to the first block. The block +manager must be locked.} +function FastMM_GetMem_GetMediumBlock_AllocateNewSequentialFeedSpan(APMediumBlockManager: PMediumBlockManager; + AFirstBlockSize: Integer): Pointer; +var + LNewSpanSize: Integer; + LOldFirstMediumBlockSpan, LPNewSpan: PMediumBlockSpanHeader; +begin + {Bin the current sequential feed remainder} + BinMediumSequentialFeedRemainder(APMediumBlockManager); + {Allocate a new sequential feed block pool. The block is assumed to be zero initialized.} + LNewSpanSize := DefaultMediumBlockSpanSize; + LPNewSpan := OS_AllocateVirtualMemory(LNewSpanSize, False, False); + if LPNewSpan <> nil then + begin + LPNewSpan.SpanSize := LNewSpanSize; + LPNewSpan.MediumBlockManager := APMediumBlockManager; + + {Insert this span into the circular linked list of medium block spans} + LOldFirstMediumBlockSpan := APMediumBlockManager.FirstMediumBlockSpanHeader; + LPNewSpan.PreviousMediumBlockSpanHeader := PMediumBlockSpanHeader(APMediumBlockManager); + APMediumBlockManager.FirstMediumBlockSpanHeader := LPNewSpan; + LPNewSpan.NextMediumBlockSpanHeader := LOldFirstMediumBlockSpan; + LOldFirstMediumBlockSpan.PreviousMediumBlockSpanHeader := LPNewSpan; + + {Store the sequential feed span trailer. Technically, this should not be necessary since the span is + zero-initialized and the only flag that really matters is the "is free block" flag.} + PMediumBlockHeader(PByte(LPNewSpan) + LNewSpanSize)[-1].BlockStatusFlags := CIsMediumBlockFlag; + + {Get the result and set its header.} + Result := Pointer(PByte(LPNewSpan) + LNewSpanSize - AFirstBlockSize); + SetMediumBlockHeader_SetSizeAndFlags(Result, AFirstBlockSize, False, False); + SetMediumBlockHeader_SetMediumBlockSpan(Result, LPNewSpan); + + {Install this is the new sequential feed span. The new offset must be set after the new span and ABA counter, + since other threads may immediately split off blocks the moment the new offset is set.} + Inc(APMediumBlockManager.LastMediumBlockSequentialFeedOffset.ABACounter); + APMediumBlockManager.SequentialFeedMediumBlockSpan := LPNewSpan; + + {May need a memory fence here for ARM.} + + APMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue := NativeInt(Result) - NativeInt(LPNewSpan); + end + else + begin + {Out of memory} + Result := nil; + end; +end; + +{Attempts to split off a medium block from the sequential feed span for the arena. Returns the block on success, nil if +there is not enough sequential feed space available. The arena does not have to be locked.} +function FastMM_GetMem_GetMediumBlock_TryGetBlockFromSequentialFeedSpan(APMediumBlockManager: PMediumBlockManager; + AMinimumBlockSize, AOptimalBlockSize: Integer): Pointer; +{$ifdef X86ASM} +asm + push ebx + push esi + push edi + push ebp + push ecx + + {esi = APMediumBlockManager, ebp = AMinimumBlockSize, [esp] = AOptimalBlockSize} + mov esi, eax + mov ebp, edx +@TrySequentialFeedLoop: + + {Get the old ABA counter and offset in edx:eax} + mov eax, TMediumBlockManager(esi).LastMediumBlockSequentialFeedOffset.IntegerValue + mov edx, TMediumBlockManager(esi).LastMediumBlockSequentialFeedOffset.ABACounter + + {Get the available size in ecx, and check that it is sufficient.} + lea ecx, [eax - CMediumBlockSpanHeaderSize] + cmp ecx, ebp + jl @NoSequentialFeedAvailable + + {Cap the block size at the optimal size.} + cmp ecx, [esp] + jle @BlockNotTooBig + mov ecx, [esp] +@BlockNotTooBig: + + {Get the new ABA counter and offset in ecx:ebx} + mov ebx, eax + sub ebx, ecx + lea ecx, [edx + 1] + + {Get the current sequential feed span in edi} + mov edi, TMediumBlockManager(esi).SequentialFeedMediumBlockSpan + + {Try to grab the block. If it fails, try again from the start.} + lock cmpxchg8b TMediumBlockManager(esi).LastMediumBlockSequentialFeedOffset + jne @TrySequentialFeedLoop + + {Current state: eax = next block offset, ebx = this block offset, edi = sequential feed span} + + {Get the block size in ecx} + mov ecx, eax + sub ecx, ebx + + {The block address is the span + offset.} + lea eax, [edi + ebx] + + {Configure the block header. Medium block spans are always zero initialized, so it is not necessary to set the + PreviousBlockIsFree or IsSmallBlockSpan fields since they will already be zero. Similarly it is not necessary to set + the "previous block is free" flag in the next block.} + shr ecx, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSizeMultiple(eax - CMediumBlockHeaderSize), cx + shr ebx, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSpanOffsetMultiple(eax - CMediumBlockHeaderSize), bx + mov TMediumBlockHeader.BlockStatusFlags(eax - CMediumBlockHeaderSize), CIsMediumBlockFlag + + jmp @Done + +@NoSequentialFeedAvailable: + xor eax, eax +@Done: + pop ecx + pop ebp + pop edi + pop esi + pop ebx +{$else} +var + LPSequentialFeedSpan: PMediumBlockSpanHeader; + LPreviousLastSequentialFeedBlockOffset, LNewLastSequentialFeedBlockOffset: TIntegerWithABACounter; + LBlockSize: Integer; +begin + {The arena is not necessarily locked, so we may have to try several times to split off a block.} + while True do + begin + LPreviousLastSequentialFeedBlockOffset := APMediumBlockManager.LastMediumBlockSequentialFeedOffset; + + {Is there space available for at least the minimum size block?} + LBlockSize := LPreviousLastSequentialFeedBlockOffset.IntegerValue - CMediumBlockSpanHeaderSize; + if LBlockSize >= AMinimumBlockSize then + begin + if LBlockSize > AOptimalBlockSize then + LBlockSize := AOptimalBlockSize; + + {Calculate the new sequential feed parameters.} + LNewLastSequentialFeedBlockOffset.IntegerAndABACounter := LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter + - LBlockSize + (Int64(1) shl 32); + + LPSequentialFeedSpan := APMediumBlockManager.SequentialFeedMediumBlockSpan; + + if AtomicCmpExchange(APMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerAndABACounter, + LNewLastSequentialFeedBlockOffset.IntegerAndABACounter, + LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter) = LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter then + begin + Result := Pointer(PByte(LPSequentialFeedSpan) + LNewLastSequentialFeedBlockOffset.IntegerValue); + + {Set the header for the block.} + SetMediumBlockHeader_SetSizeAndFlags(Result, LBlockSize, False, False); + SetMediumBlockHeader_SetMediumBlockSpan(Result, LPSequentialFeedSpan); + + Exit; + end; + + end + else + begin + {There is either no sequential feed span, or it has insufficient space.} + Exit(nil); + end; + end; +{$endif} +end; + +{Clears the list of pending frees while attempting to reuse one of a suitable size. The arena must be locked.} +function FastMM_GetMem_GetMediumBlock_TryReusePendingFreeBlock(APMediumBlockManager: PMediumBlockManager; + AMinimumBlockSize, AOptimalBlockSize, AMaximumBlockSize: Integer): Pointer; +var + LBlockSize, LBestMatchBlockSize, LSecondSplitSize: Integer; + LPSecondSplit: PMediumFreeBlockContent; + LPPendingFreeBlock, LPNextPendingFreeBlock: Pointer; + LPMediumBlockSpan: PMediumBlockSpanHeader; +begin + {Retrieve the pending free list pointer.} + LPPendingFreeBlock := AtomicExchange(APMediumBlockManager.PendingFreeList, nil); + if LPPendingFreeBlock = nil then + Exit(nil); + + {Process all the pending frees, but keep the smallest block that is at least AMinimumBlockSize in size (if + there is one).} + LBestMatchBlockSize := MaxInt; + Result := nil; + + while True do + begin + LPNextPendingFreeBlock := PPointer(LPPendingFreeBlock)^; + LBlockSize := GetMediumBlockSize(LPPendingFreeBlock); + + if (LBlockSize >= AMinimumBlockSize) and (LBlockSize < LBestMatchBlockSize) then + begin + {Free the previous best match block.} + if Result <> nil then + begin + LPMediumBlockSpan := GetMediumBlockSpan(Result); + if FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked( + APMediumBlockManager, LPMediumBlockSpan, Result, False) <> 0 then + begin + System.Error(reInvalidPtr); + end; + end; + Result := LPPendingFreeBlock; + LBestMatchBlockSize := LBlockSize; + end + else + begin + LPMediumBlockSpan := GetMediumBlockSpan(LPPendingFreeBlock); + if FastMM_FreeMem_InternalFreeMediumBlock_ManagerAlreadyLocked( + APMediumBlockManager, LPMediumBlockSpan, LPPendingFreeBlock, False) <> 0 then + begin + System.Error(reInvalidPtr); + end; + end; + + if LPNextPendingFreeBlock = nil then + Break; + + LPPendingFreeBlock := LPNextPendingFreeBlock; + end; + + {Was there a suitable block in the pending free list?} + if Result <> nil then + begin + + {If the block currently has debug info, check it for consistency.} + if BlockHasDebugInfo(Result) + and (not CheckFreeDebugBlockIntact(Result)) then + begin + {The arena must be unlocked before the error is raised, otherwise the leak check at shutdown will hang.} + APMediumBlockManager.MediumBlockManagerLocked := 0; + System.Error(reInvalidPtr); + end; + + {Should the block be split?} + if LBestMatchBlockSize > AMaximumBlockSize then + begin + {Get the size of the second split} + LSecondSplitSize := LBestMatchBlockSize - AOptimalBlockSize; + {Adjust the block size} + LBestMatchBlockSize := AOptimalBlockSize; + {Split the block in two} + LPSecondSplit := PMediumFreeBlockContent(PByte(Result) + LBestMatchBlockSize); + LPMediumBlockSpan := GetMediumBlockSpan(Result); + SetMediumBlockHeader_SetSizeAndFlags(LPSecondSplit, LSecondSplitSize, True, False); + SetMediumBlockHeader_SetMediumBlockSpan(LPSecondSplit, LPMediumBlockSpan); + + {The second split is an entirely new block so all the header fields must be set.} + SetMediumBlockHeader_SetIsSmallBlockSpan(LPSecondSplit, False); + + {Bin the second split.} + if LSecondSplitSize >= CMinimumMediumBlockSize then + InsertMediumBlockIntoBin(APMediumBlockManager, LPSecondSplit, LSecondSplitSize); + + end; + + {Set the header and trailer for this block, clearing the debug info flag.} + SetMediumBlockHeader_SetSizeAndFlags(Result, LBestMatchBlockSize, False, False); + + end; +end; + +{Allocates a free block of at least the size in AMinimumBlockSizeBinNumber. The arena must be known to have a suitable +free block, the arena must be locked, and AOptimalBlockSize and AMaximumBlockSize must be aligned to a bin size. +Unlocks the arena before returning. Returns a pointer to the allocated block.} +function FastMM_GetMem_GetMediumBlock_AllocateFreeBlockAndUnlockArena(APMediumBlockManager: PMediumBlockManager; + AMinimumBlockSizeBinNumber, AOptimalBlockSize, AMaximumBlockSize: Integer): Pointer; +{$ifndef PurePascal} +const + {The maximum block size is stored on the stack.} + CMaximumSizeStackOffset = {$ifdef 32Bit}20{$else}80{$endif}; +asm +{$ifdef X86ASM} + {-------x86 Assembly language codepath--------} + push ebx + push esi + push edi + + {esi = medium block manager, edi = bin number, ebp = optimal block size} + mov esi, eax + mov edi, edx + mov ebp, ecx + + {Get the bin group in edx} + shr edx, 5 + + {Check the group corresponding to the minimum block size bin for available blocks.} + mov ecx, 31 + and ecx, edi + or eax, -1 + shl eax, cl + and eax, dword ptr TMediumBlockManager.MediumBlockBinBitmaps(esi + edx * 4) + jnz @GotBin + {There are no suitable free blocks in the group containing AMinimumBlockSizeBinNumber, so get a free block from any + subsequent group.} + mov ecx, edx + mov edx, -2 + shl edx, cl + and edx, TMediumBlockManager(esi).MediumBlockBinGroupBitmap + {Get the first group with large enough blocks in edx} + bsf edx, edx + {Get the bin bitmap for the next group with free blocks} + mov eax, dword ptr TMediumBlockManager.MediumBlockBinBitmaps(esi + edx * 4) +@GotBin: + + {Group bitmap is in eax, group number in edx: Find the first bin with free blocks in the group} + bsf eax, eax + {Add the index of the first bin in the group.} + shl edx, 5 + add eax, edx + + {Get the first free block in the bin} + mov edi, dword ptr TMediumBlockManager.FirstFreeBlockInBin(esi + eax * 4) + + mov eax, esi + mov edx, edi + call RemoveMediumFreeBlockFromBin + + {If the block currently has debug info, check it for consistency before resetting the flag.} + test byte ptr [edi - CBlockStatusFlagsSize], CHasDebugInfoFlag + jz @DebugInfoOK + mov eax, edi + call CheckFreeDebugBlockIntact + test al, al + jnz @DebugInfoOK + mov byte ptr TMediumBlockManager(esi).MediumBlockManagerLocked, 0 + mov al, reInvalidPtr + call System.Error +@DebugInfoOK: + + {Get the block size in ebx} + movzx ebx, TMediumBlockHeader.MediumBlockSizeMultiple(edi - CMediumBlockHeaderSize) + shl ebx, CMediumBlockAlignmentBits + + {Should the block be split?} + cmp ebx, [esp + CMaximumSizeStackOffset] + jbe @SecondSplitDone + + {Use the optimal block size, second split size in ecx} + mov ecx, ebx + sub ecx, ebp + mov ebx, ebp + + {Second split pointer in edx} + lea edx, [edi + ebx] + + {Get the span offset multiple of the first split in eax.} + movzx eax, TMediumBlockHeader.MediumBlockSpanOffsetMultiple(edi - CMediumBlockHeaderSize) + + {The second split should already be tagged as a free block in the next block's header, but we need to set the size of + the second split in its own footer.} + mov TMediumFreeBlockFooter.MediumFreeBlockSize(edx + ecx - CMediumFreeBlockFooterSize), ecx + {Set the second split's block size in its header} + mov ebp, ecx + shr ebp, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSizeMultiple(edx - CMediumBlockHeaderSize), bp + {Set the span offset for the second split. It is the sum of the offset and size multiples of the first split.} + mov ebp, ebx + shr ebp, CMediumBlockAlignmentBits + add ebp, eax + mov TMediumBlockHeader.MediumBlockSpanOffsetMultiple(edx - CMediumBlockHeaderSize), bp + {Set the block flags for the second split} + mov TMediumBlockHeader.BlockStatusFlags(edx - CMediumBlockHeaderSize), CBlockIsFreeFlag + CIsMediumBlockFlag + {Ensure the second split is not marked as a small block span.} + mov TMediumBlockHeader.IsSmallBlockSpan(edx - CMediumBlockHeaderSize), False + + {Bin the second split.} + cmp ecx, CMinimumMediumBlockSize + jb @SecondSplitDone + mov eax, esi + call InsertMediumBlockIntoBin +@SecondSplitDone: + + {Update the flag in the next block to indicate that this block is now in use. The block size is not stored before + the header of the next block if it is not free.} + mov TMediumBlockHeader.PreviousBlockIsFree(edi + ebx - CMediumBlockHeaderSize), False + {Set the block flags} + mov TMediumBlockHeader.BlockStatusFlags(edi - CMediumBlockHeaderSize), CIsMediumBlockFlag + {Update the block size.} + shr ebx, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSizeMultiple(edi - CMediumBlockHeaderSize), bx + + mov byte ptr TMediumBlockManager(esi).MediumBlockManagerLocked, 0 + + mov eax, edi + + pop edi + pop esi + pop ebx +{$else} + {-------x64 Assembly language codepath--------} + .pushnv rbx + .pushnv rsi + .pushnv rdi + .params 3 + + {rsi = medium block manager, edi = bin number, on stack = optimal block size, on stack = maximum block size} + mov rsi, rcx + mov edi, edx + mov [rsp + CMaximumSizeStackOffset + 8], r8d //Save the optimal block size in the shadow space. + mov [rsp + CMaximumSizeStackOffset], r9d //Save the maximum block size in the shadow space. + + {Get the bin group in edx} + shr edx, 5 + + {Check the group corresponding to the minimum block size bin for available blocks.} + mov ecx, 31 + and ecx, edi + or eax, -1 + shl eax, cl + and eax, dword ptr TMediumBlockManager.MediumBlockBinBitmaps(rsi + rdx * 4) + jnz @GotBin + {There are no suitable free blocks in the group containing AMinimumBlockSizeBinNumber, so get a free block from any + subsequent group.} + mov ecx, edx + mov edx, -2 + shl edx, cl + and edx, TMediumBlockManager(rsi).MediumBlockBinGroupBitmap + {Get the first group with large enough blocks in edx} + bsf edx, edx + {Get the bin bitmap for the next group with free blocks} + mov eax, dword ptr TMediumBlockManager.MediumBlockBinBitmaps(rsi + rdx * 4) +@GotBin: + + {Group bitmap is in eax, group number in edx: Find the first bin with free blocks in the group} + bsf eax, eax + {Add the index of the first bin in the group.} + shl edx, 5 + add eax, edx + + {Get the first free block in the bin} + mov rdi, qword ptr TMediumBlockManager.FirstFreeBlockInBin(rsi + rax * 8) + + mov rcx, rsi + mov rdx, rdi + call RemoveMediumFreeBlockFromBin + + {If the block currently has debug info, check it for consistency before resetting the flag.} + test byte ptr [rdi - CBlockStatusFlagsSize], CHasDebugInfoFlag + jz @DebugInfoOK + mov rcx, rdi + call CheckFreeDebugBlockIntact + test al, al + jnz @DebugInfoOK + mov byte ptr TMediumBlockManager(rsi).MediumBlockManagerLocked, 0 + mov cl, reInvalidPtr + call System.Error +@DebugInfoOK: + + {Get the block size in ebx} + movzx ebx, TMediumBlockHeader.MediumBlockSizeMultiple(rdi - CMediumBlockHeaderSize) + shl ebx, CMediumBlockAlignmentBits + + {Should the block be split?} + cmp ebx, [esp + CMaximumSizeStackOffset] + jbe @SecondSplitDone + + {Use the optimal block size, second split size in ecx} + mov ecx, ebx + mov ebx, [rsp + CMaximumSizeStackOffset + 8] + sub ecx, ebx + + {Second split pointer in rdx} + lea rdx, [rdi + rbx] + + {Get the span offset multiple of the first split in r9.} + movzx r9d, TMediumBlockHeader.MediumBlockSpanOffsetMultiple(rdi - CMediumBlockHeaderSize) + + {The second split should already be tagged as a free block in the next block's header, but we need to set the size of + the second split in its own footer.} + mov TMediumFreeBlockFooter.MediumFreeBlockSize(rdx + rcx - CMediumFreeBlockFooterSize), ecx + {Set the second split's block size in its header} + mov eax, ecx + shr eax, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSizeMultiple(rdx - CMediumBlockHeaderSize), ax + {Set the span offset for the second split. It is the sum of the offset and size multiples of the first split.} + mov eax, ebx + shr eax, CMediumBlockAlignmentBits + add eax, r9d + mov TMediumBlockHeader.MediumBlockSpanOffsetMultiple(rdx - CMediumBlockHeaderSize), ax + {Set the block flags for the second split} + mov TMediumBlockHeader.BlockStatusFlags(rdx - CMediumBlockHeaderSize), CBlockIsFreeFlag + CIsMediumBlockFlag + {Ensure the second split is not marked as a small block span.} + mov TMediumBlockHeader.IsSmallBlockSpan(rdx - CMediumBlockHeaderSize), False + + {Bin the second split.} + cmp ecx, CMinimumMediumBlockSize + jb @SecondSplitDone + mov r8d, ecx + mov rcx, rsi + call InsertMediumBlockIntoBin +@SecondSplitDone: + + {Update the flag in the next block to indicate that this block is now in use. The block size is not stored before + the header of the next block if it is not free.} + mov TMediumBlockHeader.PreviousBlockIsFree(rdi + rbx - CMediumBlockHeaderSize), False + {Set the block flags} + mov TMediumBlockHeader.BlockStatusFlags(rdi - CMediumBlockHeaderSize), CIsMediumBlockFlag + {Update the block size.} + shr ebx, CMediumBlockAlignmentBits + mov TMediumBlockHeader.MediumBlockSizeMultiple(rdi - CMediumBlockHeaderSize), bx + + mov byte ptr TMediumBlockManager(rsi).MediumBlockManagerLocked, 0 + + mov rax, rdi + +{$endif} +{$else} +var + LBinGroupNumber, LBinNumber, LBinGroupMasked, LBinGroupsMasked, LBlockSize, LSecondSplitSize: Integer; + LPSecondSplit: PMediumFreeBlockContent; +begin + LBinGroupNumber := AMinimumBlockSizeBinNumber shr 5; //32 bins per group + + {Is there an available block in the group containing the bin?} + LBinGroupMasked := APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber] and ((-1) shl (AMinimumBlockSizeBinNumber and 31)); + if LBinGroupMasked <> 0 then + begin + {There is a block in the group containing AMinimumBlockSizeBinNumber, get the exact bin number.} + LBinNumber := CountTrailingZeros32(LBinGroupMasked) + (LBinGroupNumber shl 5); + end + else + begin + {There are no suitable free blocks in the group containing AMinimumBlockSizeBinNumber, so get a free block from any + subsequent group.} + LBinGroupsMasked := APMediumBlockManager.MediumBlockBinGroupBitmap and ((-2) shl LBinGroupNumber); + {There is a suitable group with space: Get the bin group number} + LBinGroupNumber := CountTrailingZeros32(LBinGroupsMasked); + {Get the first bin with a free block in the group} + LBinNumber := CountTrailingZeros32(APMediumBlockManager.MediumBlockBinBitmaps[LBinGroupNumber]) + (LBinGroupNumber shl 5); + end; + + Result := APMediumBlockManager.FirstFreeBlockInBin[LBinNumber]; + + RemoveMediumFreeBlockFromBin(APMediumBlockManager, Result); + + {If the block currently has debug info, check it for consistency before resetting the flag.} + if BlockHasDebugInfo(Result) + and (not CheckFreeDebugBlockIntact(Result)) then + begin + APMediumBlockManager.MediumBlockManagerLocked := 0; + System.Error(reInvalidPtr); + end; + + {Get the size of the available medium block} + LBlockSize := GetMediumBlockSize(Result); + + {Should the block be split?} + if LBlockSize > AMaximumBlockSize then + begin + {Get the size of the second split} + LSecondSplitSize := LBlockSize - AOptimalBlockSize; + {Adjust the block size} + LBlockSize := AOptimalBlockSize; + {Split the block in two} + LPSecondSplit := PMediumFreeBlockContent(PByte(Result) + LBlockSize); + SetMediumBlockHeader_SetSizeAndFlags(LPSecondSplit, LSecondSplitSize, True, False); + SetMediumBlockHeader_SetMediumBlockSpan(LPSecondSplit, GetMediumBlockSpan(Result)); + + {The second split is an entirely new block so all the header fields must be set.} + SetMediumBlockHeader_SetIsSmallBlockSpan(LPSecondSplit, False); + + {Bin the second split.} + if LSecondSplitSize >= CMinimumMediumBlockSize then + InsertMediumBlockIntoBin(APMediumBlockManager, LPSecondSplit, LSecondSplitSize); + end; + + {Set the header for this block, clearing the debug info flag.} + SetMediumBlockHeader_SetSizeAndFlags(Result, LBlockSize, False, False); + + APMediumBlockManager.MediumBlockManagerLocked := 0; +{$endif} +end; + +{Allocates a medium block within the given size constraints. Sizes must be properly aligned to a bin size.} +function FastMM_GetMem_GetMediumBlock(AMinimumBlockSize, AOptimalBlockSize, AMaximumBlockSize: Integer): Pointer; +{$ifdef X86ASM} +const + {The offsets of variables on the stack.} + CMinimumBlockSizeOffset = 12; + COptimalBlockSizeOffset = 8; + CMaximumBlockSizeOffset = 4; + CBinNumberOffset = 0; +asm + push ebx + push esi + push edi + push ebp + push eax + push edx + push ecx + + {Calculate the bin number for the minimum block size.} + cmp eax, CMediumBlockMiddleBinsStart + jg @MiddleOrLastMediumBlockGroup + lea edx, [eax - CMinimumMediumBlockSize] + shr edx, CInitialBinSpacingBits + jmp @GotBinNumber +@MiddleOrLastMediumBlockGroup: + cmp eax, CMediumBlockFinalBinsStart + jg @LastMediumBlockGroup + lea edx, [eax + CInitialBinCount * CMiddleBinSpacing - CMediumBlockMiddleBinsStart] + shr edx, CMiddleBinSpacingBits + jmp @GotBinNumber +@LastMediumBlockGroup: + lea edx, [eax + (CInitialBinCount + CMiddleBinCount) * CFinalBinSpacing - CMediumBlockFinalBinsStart] + shr edx, CFinalBinSpacingBits +@GotBinNumber: + push edx + + {Minimum block size group in edi} + mov edi, edx + shr edi, 5 + + {Bin mask in ebx} + mov ecx, 31 + and ecx, edx + mov ebx, -1 + shl ebx, cl + + {Larger groups mask in ebp} + mov ecx, edi + mov ebp, -2 + shl ebp, cl + +@OuterLoop: + + {--------------Attempt 1-------------- + Try to get a block from the first arena with an available block. During the first attempt only memory that has + already been reserved for medium blocks will be used - no new spans will be allocated. We also avoid grabbing a + sequential feed block, because that may touch a new page and cause a page fault. The sequence of allocation attempts + is: + 1.1) The pending free list + 1.2) From the medium block free lists} + + mov esi, offset MediumBlockManagers +@Attempt1Loop: + cmp byte ptr TMediumBlockManager(esi).MediumBlockManagerLocked, 0 + jne @Attempt1NextManager + cmp TMediumBlockManager(esi).PendingFreeList, 0 + jne @Attempt1TryLock + test TMediumBlockManager(esi).MediumBlockBinGroupBitmap, ebp + jnz @Attempt1TryLock + test dword ptr TMediumBlockManager.MediumBlockBinBitmaps(esi + edi * 4), ebx + jz @Attempt1NextManager +@Attempt1TryLock: + mov al, 1 + xchg byte ptr TMediumBlockManager(esi).MediumBlockManagerLocked, al + test al, al + jnz @Attempt1NextManager + + {1.1) Process pending free lists: Scan the pending free lists for all medium block managers first, and reuse + a block that is of sufficient size if possible.} + cmp TMediumBlockManager(esi).PendingFreeList, 0 + je @Attempt1NoPendingFrees + mov eax, esi + mov edx, [esp + CMinimumBlockSizeOffset] + mov ecx, [esp + COptimalBlockSizeOffset] + push [esp + CMaximumBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_TryReusePendingFreeBlock + test eax, eax + jnz @UnlockManagerAndExit +@Attempt1NoPendingFrees: + + {1.2) Try to find a suitable free block in the free lists} + test TMediumBlockManager(esi).MediumBlockBinGroupBitmap, ebp + jnz @Attempt1HasFreeBlock + test dword ptr TMediumBlockManager.MediumBlockBinBitmaps(esi + edi * 4), ebx + jz @Attempt1NoFreeBlocks +@Attempt1HasFreeBlock: + mov eax, esi + mov edx, [esp + CBinNumberOffset] + mov ecx, [esp + COptimalBlockSizeOffset] + push [esp + CMaximumBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_AllocateFreeBlockAndUnlockArena + jmp @Done +@Attempt1NoFreeBlocks: + + {A different thread grabbed the last block, unlock the manager and try the next arena.} + mov TMediumBlockManager(esi).MediumBlockManagerLocked, 0 + +@Attempt1NextManager: + cmp esi, offset MediumBlockManagers + CMediumBlockManagerSize * (CFastMM_MediumBlockArenaCount - 1) + jnb @Attempt1Failed + add esi, CMediumBlockManagerSize + jmp @Attempt1Loop +@Attempt1Failed: + + {--------------Attempt 2-------------- + Try to get a block from a sequential feed span. Splitting off a sequentisal feed block is very likely to touch a new + memory page and thus cause an (expensive) page fault.} + + {edx = AMinimumBlockSize, eax = AMinimumBlockSize + CMediumBlockSpanHeaderSize} + mov edx, [esp + CMinimumBlockSizeOffset] + lea eax, [edx + CMediumBlockSpanHeaderSize] + mov esi, offset MediumBlockManagers +@Attempt2Loop: + + {2.1) Try to feed a medium block sequentially from an existing sequential feed span} + cmp eax, TMediumBlockManager(esi).LastMediumBlockSequentialFeedOffset.IntegerValue + ja @Attempt2NextManager + mov eax, esi + mov ecx, [esp + COptimalBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_TryGetBlockFromSequentialFeedSpan + test eax, eax + jnz @Done + {The call failed: Restore edx and eax to correct values} + mov edx, [esp + CMinimumBlockSizeOffset] + lea eax, [edx + CMediumBlockSpanHeaderSize] + +@Attempt2NextManager: + cmp esi, offset MediumBlockManagers + CMediumBlockManagerSize * (CFastMM_MediumBlockArenaCount - 1) + jnb @Attempt2Failed + add esi, CMediumBlockManagerSize + jmp @Attempt2Loop +@Attempt2Failed: + + {--------------Attempt 3-------------- + At this point (a) all arenas are either locked, or (b) there are no pending free blocks, no free blocks, and all + the sequential feed spans are exhausted. In this second attempt the first unlocked manager is locked and a block + will then be obtained from it in this sequence: + + 3.1) From the medium block free lists + 3.2) From the existing sequential feed span + 3.3) From the pending free list + 3.4) From a new sequential feed span.} + + mov esi, offset MediumBlockManagers +@Attempt3Loop: + + {Try to lock the manager} + mov eax, $100 + lock cmpxchg byte ptr TMediumBlockManager(esi).MediumBlockManagerLocked, ah + jne @Attempt3NextManager + + {3.1) Try to allocate a free block. Another thread may have freed a block before this arena could be locked.} + test TMediumBlockManager(esi).MediumBlockBinGroupBitmap, ebp + jnz @Attempt3HasFreeBlock + test dword ptr TMediumBlockManager.MediumBlockBinBitmaps(esi + edi * 4), ebx + jz @Attempt3NoFreeBlocks +@Attempt3HasFreeBlock: + mov eax, esi + mov edx, [esp + CBinNumberOffset] + mov ecx, [esp + COptimalBlockSizeOffset] + push [esp + CMaximumBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_AllocateFreeBlockAndUnlockArena + jmp @Done +@Attempt3NoFreeBlocks: + + {3.2) Another thread may have allocated a sequential feed span before the arena could be locked, so a second attempt + at feeding a block sequentially should be made before allocating a new span.} + mov edx, [esp + CMinimumBlockSizeOffset] + lea eax, [edx + CMediumBlockSpanHeaderSize] + cmp eax, TMediumBlockManager(esi).LastMediumBlockSequentialFeedOffset.IntegerValue + ja @Attempt3NoSequentialFeed + mov eax, esi + mov ecx, [esp + COptimalBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_TryGetBlockFromSequentialFeedSpan + test eax, eax + jnz @UnlockManagerAndExit +@Attempt3NoSequentialFeed: + + {3.3) Another thread may have added blocks to the pending free list in the meantime - again try to reuse a pending + free block. Allocating a new span is very expensive, so has to be avoided if at all possible.} + cmp TMediumBlockManager(esi).PendingFreeList, 0 + je @Attempt3NoPendingFrees + mov eax, esi + mov edx, [esp + CMinimumBlockSizeOffset] + mov ecx, [esp + COptimalBlockSizeOffset] + push [esp + CMaximumBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_TryReusePendingFreeBlock + test eax, eax + jnz @UnlockManagerAndExit +@Attempt3NoPendingFrees: + + {3.4) If we get here then there are no suitable free blocks, pending free blocks, and the current sequential feed span + has no space: Allocate a new sequential feed span and split off a block of the optimal size.} + mov eax, esi + mov edx, [esp + COptimalBlockSizeOffset] + call FastMM_GetMem_GetMediumBlock_AllocateNewSequentialFeedSpan + jmp @UnlockManagerAndExit + +@Attempt3NextManager: + cmp esi, offset MediumBlockManagers + CMediumBlockManagerSize * (CFastMM_MediumBlockArenaCount - 1) + jnb @Attempt3Failed + add esi, CMediumBlockManagerSize + jmp @Attempt3Loop +@Attempt3Failed: + + {--------Back off--------} + + {All arenas are currently locked: Back off and try again.} + call LogMediumBlockThreadContentionAndYieldToOtherThread + jmp @OuterLoop + +@UnlockManagerAndExit: + mov TMediumBlockManager(esi).MediumBlockManagerLocked, 0 + +@Done: + pop ecx + pop ecx + pop ecx + pop ecx + pop ebp + pop edi + pop esi + pop ebx + +{$else} +var + LPMediumBlockManager: PMediumBlockManager; + LMinimumBlockSizeBinNumber, LMinimumBlockSizeBinGroupNumber, LMinimumBlockSizeBinMask, LLargerBinGroupsMask: Integer; +begin + {Determine the bin for blocks of the minimum size, as well as the masks for the bins and groups that will have blocks + of at least the requested size.} + LMinimumBlockSizeBinNumber := GetBinNumberForMediumBlockSize(AMinimumBlockSize); + LMinimumBlockSizeBinGroupNumber := LMinimumBlockSizeBinNumber shr 5; //32 bins per group + LMinimumBlockSizeBinMask := ((-1) shl (LMinimumBlockSizeBinNumber and 31)); + LLargerBinGroupsMask := ((-2) shl LMinimumBlockSizeBinGroupNumber); + + while True do + begin + + {--------------Attempt 1-------------- + Try to get a block from the first arena with an available block. During the first attempt only memory that has + already been reserved for medium blocks will be used - no new spans will be allocated. We also avoid grabbing a + sequential feed block, because that may touch a new page and cause a page fault (which is expensive). The sequence + of allocation attempts is: + 1.1) The pending free list + 1.2) From the medium block free lists} + + + LPMediumBlockManager := @MediumBlockManagers[0]; + while True do + begin + + {In order to process the pending free lists or get a block from the free lists the block manager must be locked. + Locking is expensive, so first check whether locking the manager is likely to result in successful block + allocation.} + if (LPMediumBlockManager.MediumBlockManagerLocked = 0) + and ((LPMediumBlockManager.PendingFreeList <> nil) + or ((LPMediumBlockManager.MediumBlockBinGroupBitmap and LLargerBinGroupsMask) <> 0) + or ((LPMediumBlockManager.MediumBlockBinBitmaps[LMinimumBlockSizeBinGroupNumber] and LMinimumBlockSizeBinMask) <> 0)) + and (AtomicExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1) = 0) then + begin + + {1.1) Process pending free lists: Scan the pending free lists for all medium block managers first, and reuse + a block that is of sufficient size if possible.} + if LPMediumBlockManager.PendingFreeList <> nil then + begin + Result := FastMM_GetMem_GetMediumBlock_TryReusePendingFreeBlock(LPMediumBlockManager, AMinimumBlockSize, + AOptimalBlockSize, AMaximumBlockSize); + if Result <> nil then + begin + LPMediumBlockManager.MediumBlockManagerLocked := 0; + Exit; + end; + end; + + {1.2) Try to find a suitable free block in the free lists} + if ((LPMediumBlockManager.MediumBlockBinGroupBitmap and LLargerBinGroupsMask) <> 0) + or ((LPMediumBlockManager.MediumBlockBinBitmaps[LMinimumBlockSizeBinGroupNumber] and LMinimumBlockSizeBinMask) <> 0) then + begin + Exit(FastMM_GetMem_GetMediumBlock_AllocateFreeBlockAndUnlockArena(LPMediumBlockManager, + LMinimumBlockSizeBinNumber, AOptimalBlockSize, AMaximumBlockSize)); + end; + + {A different thread grabbed the last block, unlock the manager and try the next arena.} + LPMediumBlockManager.MediumBlockManagerLocked := 0; + end; + + {Try the next arena.} + if NativeUInt(LPMediumBlockManager) >= NativeUInt(@MediumBlockManagers[CFastMM_MediumBlockArenaCount - 1]) then + Break; + + Inc(LPMediumBlockManager); + end; + + {--------------Attempt 2-------------- + Try to get a block from a sequential feed span. This is likely to touch a new page and thus cause a page fault, + which is expensive.} + + LPMediumBlockManager := @MediumBlockManagers[0]; + while True do + begin + + {2.1) Try to feed a medium block sequentially from an existing sequential feed span} + if LPMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue >= (AMinimumBlockSize + CMediumBlockSpanHeaderSize) then + begin + Result := FastMM_GetMem_GetMediumBlock_TryGetBlockFromSequentialFeedSpan(LPMediumBlockManager, + AMinimumBlockSize, AOptimalBlockSize); + if Result <> nil then + Exit; + end; + + {Try the next arena.} + if NativeUInt(LPMediumBlockManager) >= NativeUInt(@MediumBlockManagers[CFastMM_MediumBlockArenaCount - 1]) then + Break; + + Inc(LPMediumBlockManager); + end; + + {--------------Attempt 3-------------- + At this point (a) all arenas are either locked, or (b) there are no pending free blocks, no free blocks, and all + the sequential feed spans are exhausted. In this second attempt the first unlocked manager is locked and a block + will then be obtained from it in this sequence: + + 3.1) From the medium block free lists + 3.2) From the existing sequential feed span + 3.3) From the pending free list + 3.4) From a new sequential feed span.} + + + LPMediumBlockManager := @MediumBlockManagers[0]; + while True do + begin + + {The first attempt failed to get a block from any manager, so in this second attempt we are more forceful: Always + try to lock the manager, and allocate a new sequential feed span if necessary.} + if AtomicCmpExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1, 0) = 0 then + begin + + {3.1) Try to allocate a free block. Another thread may have freed a block before this arena could be locked.} + if ((LPMediumBlockManager.MediumBlockBinGroupBitmap and LLargerBinGroupsMask) <> 0) + or ((LPMediumBlockManager.MediumBlockBinBitmaps[LMinimumBlockSizeBinGroupNumber] and LMinimumBlockSizeBinMask) <> 0) then + begin + Exit(FastMM_GetMem_GetMediumBlock_AllocateFreeBlockAndUnlockArena(LPMediumBlockManager, + LMinimumBlockSizeBinNumber, AOptimalBlockSize, AMaximumBlockSize)); + end; + + {3.2) Another thread may have allocated a sequential feed span before the arena could be locked, so a second + attempt at feeding a block sequentially should be made before allocating a new span.} + if LPMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue >= (AMinimumBlockSize + CMediumBlockSpanHeaderSize) then + begin + Result := FastMM_GetMem_GetMediumBlock_TryGetBlockFromSequentialFeedSpan(LPMediumBlockManager, + AMinimumBlockSize, AOptimalBlockSize); + if Result <> nil then + begin + LPMediumBlockManager.MediumBlockManagerLocked := 0; + Exit; + end; + end; + + {3.3) Another thread may have added blocks to the pending free list in the meantime - again try to reuse a + pending free block. Allocating a new span is very expensive, so has to be avoided if at all possible.} + if LPMediumBlockManager.PendingFreeList <> nil then + begin + Result := FastMM_GetMem_GetMediumBlock_TryReusePendingFreeBlock(LPMediumBlockManager, AMinimumBlockSize, + AOptimalBlockSize, AMaximumBlockSize); + if Result <> nil then + begin + LPMediumBlockManager.MediumBlockManagerLocked := 0; + Exit; + end; + end; + + {3.4) If we get here then there are no suitable free blocks, pending free blocks, and the current sequential + feed span has no space: Allocate a new sequential feed span and split off a block of the optimal size.} + Result := FastMM_GetMem_GetMediumBlock_AllocateNewSequentialFeedSpan(LPMediumBlockManager, AOptimalBlockSize); + LPMediumBlockManager.MediumBlockManagerLocked := 0; + Exit; + end; + + {The arena could not be locked - try the next one.} + if NativeUInt(LPMediumBlockManager) >= NativeUInt(@MediumBlockManagers[CFastMM_MediumBlockArenaCount - 1]) then + Break; + + Inc(LPMediumBlockManager); + end; + + {--------Back off--------} + + {All arenas are currently locked: Back off and try again.} + LogMediumBlockThreadContentionAndYieldToOtherThread; + + end; + +{$endif} +end; + +function FastMM_ReallocMem_ReallocMediumBlock_Upsize(APointer: Pointer; ANewUserSize: NativeInt): Pointer; +var + LPNextBlock: Pointer; + LBlockSize, LOldUserSize, LNextBlockSize, LCombinedUserSize, LNewAllocSize, LNewBlockSize, LSecondSplitSize: NativeInt; + LPMediumBlockSpan: PMediumBlockSpanHeader; + LPMediumBlockManager: PMediumBlockManager; +begin + {What is the available size in the block being reallocated?} + LBlockSize := GetMediumBlockSize(APointer); + {Get a pointer to the next block} + LPNextBlock := Pointer(PByte(APointer) + LBlockSize); + {Subtract the block header size from the old available size} + LOldUserSize := LBlockSize - CMediumBlockHeaderSize; + + {If the next block is free then we need to check if this block can be upsized in-place.} + if BlockIsFree(LPNextBlock) then + begin + LNextBlockSize := GetMediumBlockSize(LPNextBlock); + LCombinedUserSize := LOldUserSize + LNextBlockSize; + if ANewUserSize <= LCombinedUserSize then + begin + + {The next block is currently free and there is enough space to grow this block in place. Try to lock the + medium block manager. If it can be locked and the next block is still free and large enough then stretch the + medium block in place.} + LPMediumBlockSpan := GetMediumBlockSpan(APointer); + LPMediumBlockManager := LPMediumBlockSpan.MediumBlockManager; + if (LPMediumBlockManager.MediumBlockManagerLocked = 0) + and (AtomicExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1) = 0) then + begin + + {We need to recheck this, since another thread could have grabbed the block before the manager could be + locked.} + LNextBlockSize := GetMediumBlockSize(LPNextBlock); + LCombinedUserSize := LOldUserSize + LNextBlockSize; + + if (ANewUserSize <= LCombinedUserSize) + and BlockIsFree(LPNextBlock) then + begin + if LNextBlockSize >= CMinimumMediumBlockSize then + RemoveMediumFreeBlockFromBin(LPMediumBlockManager, LPNextBlock); + + {Grow by at least 25% for medium block in-place upsizes} + LNewAllocSize := LOldUserSize + (LOldUserSize shr 2); + if LNewAllocSize < ANewUserSize then + LNewAllocSize := ANewUserSize; + {Round up to the nearest block size granularity} + LNewBlockSize := ((LNewAllocSize + (CMediumBlockHeaderSize + CMediumBlockAlignment - 1)) + and -CMediumBlockAlignment); + {Calculate the size of the second split} + LSecondSplitSize := LCombinedUserSize + CMediumBlockHeaderSize - LNewBlockSize; + {Does it fit?} + if LSecondSplitSize <= 0 then + begin + {The block size is the full available size plus header} + LNewBlockSize := LCombinedUserSize + CMediumBlockHeaderSize; + end + else + begin + {Split the block in two} + LPNextBlock := PMediumFreeBlockContent(PByte(APointer) + LNewBlockSize); + + SetMediumBlockHeader_SetSizeAndFlags(LPNextBlock, LSecondSplitSize, True, False); + SetMediumBlockHeader_SetMediumBlockSpan(LPNextBlock, LPMediumBlockSpan); + {The second split is an entirely new block so all the header fields must be set.} + SetMediumBlockHeader_SetIsSmallBlockSpan(LPNextBlock, False); + + {Put the remainder in a bin if it is big enough} + if LSecondSplitSize >= CMinimumMediumBlockSize then + InsertMediumBlockIntoBin(LPMediumBlockManager, LPNextBlock, LSecondSplitSize); + end; + + {Set the size and flags for this block} + SetMediumBlockHeader_SetSizeAndFlags(APointer, LNewBlockSize, False, False); + + {Unlock the medium blocks} + LPMediumBlockManager.MediumBlockManagerLocked := 0; + + Exit(APointer); + end; + + {Couldn't use the next block, because another thread grabbed it: Unlock the medium blocks} + LPMediumBlockManager.MediumBlockManagerLocked := 0; + end; + end; + end; + + {Couldn't upsize in place. Allocate a new block and move the data across: If we have to reallocate and move + medium blocks, we grow by at least 25%} + LNewAllocSize := LOldUserSize + (LOldUserSize shr 2); + if LNewAllocSize < ANewUserSize then + LNewAllocSize := ANewUserSize; + {Allocate the new block} + Result := FastMM_GetMem(LNewAllocSize); + if Result <> nil then + begin + {If it's a large block - store the actual user requested size} + if LNewAllocSize > (CMaximumMediumBlockSize - CMediumBlockHeaderSize) then + PLargeBlockHeader(Result)[-1].UserAllocatedSize := ANewUserSize; + {Move the data across} + MoveMultipleOf64_Large(APointer^, Result^, LOldUserSize); + {Free the old block} + FastMM_FreeMem(APointer); + end; +end; + +function FastMM_ReallocMem_ReallocMediumBlock_Downsize(APointer: Pointer; ANewUserSize: NativeInt): Pointer; +var + LPNextBlock: Pointer; + LBlockSize, LOldUserSize, LNewBlockSize, LSecondSplitSize: NativeInt; + LPMediumBlockSpan: PMediumBlockSpanHeader; +begin + {What is the available size in the block being reallocated?} + LBlockSize := GetMediumBlockSize(APointer); + {Subtract the block header size from the old available size} + LOldUserSize := LBlockSize - CMediumBlockHeaderSize; + + {In-place downsize? Balance the cost of moving the data vs. the cost of fragmenting the address space.} + if ANewUserSize >= CMediumInPlaceDownsizeLimit then + begin + + {Medium blocks in use may never be smaller than CMinimumMediumBlockSize.} + if ANewUserSize < (CMinimumMediumBlockSize - CMediumBlockHeaderSize) then + ANewUserSize := CMinimumMediumBlockSize - CMediumBlockHeaderSize; + + {Round up to the next medium block size} + LNewBlockSize := ((ANewUserSize + (CMediumBlockHeaderSize + CMediumBlockAlignment - 1)) + and -CMediumBlockAlignment); + + LSecondSplitSize := (LOldUserSize + CMediumBlockHeaderSize) - LNewBlockSize; + if LSecondSplitSize > 0 then + begin + + LPMediumBlockSpan := GetMediumBlockSpan(APointer); + + {Set a proper header for the second split.} + LPNextBlock := PMediumBlockHeader(PByte(APointer) + LNewBlockSize); + SetMediumBlockHeader_SetSizeAndFlags(LPNextBlock, LSecondSplitSize, False, False); + SetMediumBlockHeader_SetMediumBlockSpan(LPNextBlock, LPMediumBlockSpan); + {The second split is an entirely new block so all the header fields must be set.} + SetMediumBlockHeader_SetIsSmallBlockSpan(LPNextBlock, False); + + {Adjust the size of this block.} + SetMediumBlockHeader_SetSizeAndFlags(APointer, LNewBlockSize, False, False); + + {Free the second split.} + FastMM_FreeMem(LPNextBlock); + end; + + Result := APointer; + end + else + begin + + {Allocate the new block, move the data across and then free the old block.} + Result := FastMM_GetMem(ANewUserSize); + if Result <> nil then + begin + System.Move(APointer^, Result^, ANewUserSize); + FastMM_FreeMem(APointer); + end; + + end; + +end; + +function FastMM_ReallocMem_ReallocMediumBlock(APointer: Pointer; ANewUserSize: NativeInt): Pointer; +{$ifdef X86ASM} +asm + {Get the old user size in ecx} + movzx ecx, TMediumBlockHeader.MediumBlockSizeMultiple(eax - CMediumBlockHeaderSize) + shl ecx, CMediumBlockAlignmentBits + sub ecx, CMediumBlockHeaderSize + + cmp ecx, edx + jb FastMM_ReallocMem_ReallocMediumBlock_Upsize + + {The requested size must be less than half the current size or we don't bother resizing.} + shr ecx, 1 + cmp ecx, edx + ja FastMM_ReallocMem_ReallocMediumBlock_Downsize +{$else} +var + LOldUserSize: NativeInt; +begin + LOldUserSize := GetMediumBlockSize(APointer) - CMediumBlockHeaderSize; + if LOldUserSize < ANewUserSize then + begin + Result := FastMM_ReallocMem_ReallocMediumBlock_Upsize(APointer, ANewUserSize); + end + else + begin + {The requested size must be less than half the current size or we don't bother resizing.} + if (LOldUserSize shr 1) > ANewUserSize then + Result := FastMM_ReallocMem_ReallocMediumBlock_Downsize(APointer, ANewUserSize) + else + Result := APointer; + end; +{$endif} +end; + +{-----------------------------------------} +{--------Small block management-----------} +{-----------------------------------------} + +procedure SetSmallBlockHeader(APSmallBlock: Pointer; APSmallBlockSpan: PSmallBlockSpanHeader; ABlockIsFree: Boolean; + ABlockHasDebugInfo: Boolean); inline; +begin + if ABlockIsFree then + begin + + if ABlockHasDebugInfo then + begin + PSmallBlockHeader(APSmallBlock)[-1].BlockStatusFlagsAndSpanOffset := + (((NativeInt(APSmallBlock) - NativeInt(APSmallBlockSpan)) and -CMediumBlockAlignment) shr CSmallBlockSpanOffsetBitShift) + + (CHasDebugInfoFlag + CBlockIsFreeFlag + CIsSmallBlockFlag); + end + else + begin + PSmallBlockHeader(APSmallBlock)[-1].BlockStatusFlagsAndSpanOffset := + (((NativeInt(APSmallBlock) - NativeInt(APSmallBlockSpan)) and -CMediumBlockAlignment) shr CSmallBlockSpanOffsetBitShift) + + (CBlockIsFreeFlag + CIsSmallBlockFlag); + end; + + end + else + begin + + if ABlockHasDebugInfo then + begin + PSmallBlockHeader(APSmallBlock)[-1].BlockStatusFlagsAndSpanOffset := + (((NativeInt(APSmallBlock) - NativeInt(APSmallBlockSpan)) and -CMediumBlockAlignment) shr CSmallBlockSpanOffsetBitShift) + + (CHasDebugInfoFlag + CIsSmallBlockFlag); + end + else + begin + PSmallBlockHeader(APSmallBlock)[-1].BlockStatusFlagsAndSpanOffset := + ((NativeInt(APSmallBlock) - NativeInt(APSmallBlockSpan)) and -CMediumBlockAlignment) shr CSmallBlockSpanOffsetBitShift + + CIsSmallBlockFlag; + end; + + end; + +end; + +function GetSpanForSmallBlock(APSmallBlock: Pointer): PSmallBlockSpanHeader; inline; +begin + Result := Pointer((NativeInt(APSmallBlock) and -CMediumBlockAlignment) + - (CDropSmallBlockFlagsMask and PBlockStatusFlags(APSmallBlock)[-1]) shl CSmallBlockSpanOffsetBitShift); +end; + +{Subroutine for FastMM_FreeMem_FreeSmallBlock. The small block manager must already be locked. Optionally unlocks the +small block manager before exit. Returns 0 on success.} +function FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked(APSmallBlockSpan: PSmallBlockSpanHeader; + APSmallBlock: Pointer; AUnlockSmallBlockManager: Boolean): Integer; +{$ifdef X86ASM} +asm + push ebx + + sub TSmallBlockSpanHeader(eax).BlocksInUse, 1 + jz @SpanIsEmpty +@DoNotFreeSpan: + + {Get the old first free block in ebx} + mov ebx, TSmallBlockSpanHeader(eax).FirstFreeBlock + + {Mark the block as free, keeping the other flags (e.g. debug info) intact.} + or TSmallBlockHeader.BlockStatusFlagsAndSpanOffset(edx - CSmallBlockHeaderSize), CBlockIsFreeFlag + + {Store the old first free block} + mov [edx], ebx + + {Store this as the new first free block} + mov TSmallBlockSpanHeader(eax).FirstFreeBlock, edx + + {Get the small block manager in edx} + mov edx, TSmallBlockSpanHeader(eax).SmallBlockManager + + {Was the span previously full?} + test ebx, ebx + jnz @SpanWasNotFull + + {Insert this as the first partially free span for the block size} + mov ebx, TSmallBlockManager(edx).FirstPartiallyFreeSpan + + mov TSmallBlockSpanHeader(eax).PreviousPartiallyFreeSpan, edx + mov TSmallBlockSpanHeader(eax).NextPartiallyFreeSpan, ebx + mov TSmallBlockManager(edx).FirstPartiallyFreeSpan, eax + mov TSmallBlockSpanHeader(ebx).PreviousPartiallyFreeSpan, eax + +@SpanWasNotFull: + + pop ebx + xor eax, eax + + test cl, cl + jz @DoNotUnlock2 + mov byte ptr TSmallBlockManager(edx).SmallBlockManagerLocked, 0 +@DoNotUnlock2: + + ret + +@SpanIsEmpty: + {In debug mode spans are never freed.} + cmp DebugModeCounter, 0 + jg @DoNotFreeSpan + {Remove this span from the circular linked list of partially free spans for the block type.} + mov edx, TSmallBlockSpanHeader(eax).PreviousPartiallyFreeSpan + mov ebx, TSmallBlockSpanHeader(eax).NextPartiallyFreeSpan + mov TSmallBlockSpanHeader(edx).NextPartiallyFreeSpan, ebx + mov TSmallBlockSpanHeader(ebx).PreviousPartiallyFreeSpan, edx + + {Unlock the small block manager if required} + test cl, cl + jz @DoNotUnlock1 + mov edx, TSmallBlockSpanHeader(eax).SmallBlockManager + mov byte ptr TSmallBlockManager(edx).SmallBlockManagerLocked, 0 +@DoNotUnlock1: + + {Clear the small block span flag in the header of the medium block. This is important in case the block is ever + reused and allocated blocks subsequently enumerated.} + mov TMediumBlockHeader.IsSmallBlockSpan(eax - CMediumBlockHeaderSize), False + + {Free the span} + pop ebx + jmp FastMM_FreeMem_FreeMediumBlock +{$else} +var + LPSmallBlockManager: PSmallBlockManager; + LPPreviousSpan, LPNextSpan, LPInsertBeforeSpan: PSmallBlockSpanHeader; + LOldFirstFreeBlock: Pointer; +begin + {Decrement the number of allocated blocks} + Dec(APSmallBlockSpan.BlocksInUse); + {Is the entire span now free? -> Free it, unless debug mode is active. BlocksInUse is set to the maximum that will + fit in the span when the span is added as the sequential feed span, so this can only hit zero once all the blocks have + been fed sequentially and subsequently freed.} + if (APSmallBlockSpan.BlocksInUse <> 0) or (DebugModeCounter > 0) then + begin + LOldFirstFreeBlock := APSmallBlockSpan.FirstFreeBlock; + + {Mark the block as free, keeping the other flags (e.g. debug info) intact.} + SetBlockIsFreeFlag(APSmallBlock, True); + {Store the old first free block} + PPointer(APSmallBlock)^ := LOldFirstFreeBlock; + {Store this as the new first free block} + APSmallBlockSpan.FirstFreeBlock := APSmallBlock; + + {Was the span previously full?} + if LOldFirstFreeBlock = nil then + begin + {Insert this as the first partially free span for the block size} + LPSmallBlockManager := APSmallBlockSpan.SmallBlockManager; + LPInsertBeforeSpan := LPSmallBlockManager.FirstPartiallyFreeSpan; + + APSmallBlockSpan.PreviousPartiallyFreeSpan := PSmallBlockSpanHeader(LPSmallBlockManager); + APSmallBlockSpan.NextPartiallyFreeSpan := LPInsertBeforeSpan; + LPSmallBlockManager.FirstPartiallyFreeSpan := APSmallBlockSpan; + LPInsertBeforeSpan.PreviousPartiallyFreeSpan := APSmallBlockSpan; + end; + + {Unlock the small block manager if required} + if AUnlockSmallBlockManager then + APSmallBlockSpan.SmallBlockManager.SmallBlockManagerLocked := 0; + end + else + begin + {Remove this span from the circular linked list of partially free spans for the block type.} + LPPreviousSpan := APSmallBlockSpan.PreviousPartiallyFreeSpan; + LPNextSpan := APSmallBlockSpan.NextPartiallyFreeSpan; + LPPreviousSpan.NextPartiallyFreeSpan := LPNextSpan; + LPNextSpan.PreviousPartiallyFreeSpan := LPPreviousSpan; + + {Unlock the small block manager if required} + if AUnlockSmallBlockManager then + APSmallBlockSpan.SmallBlockManager.SmallBlockManagerLocked := 0; + + {Clear the small block span flag in the header of the medium block. This is important in case the block is ever + reused and allocated blocks subsequently enumerated.} + SetMediumBlockHeader_SetIsSmallBlockSpan(APSmallBlockSpan, False); + + {It's not necessary to check nor update the sequential feed details, since BlocksInUse can only hit 0 after the + sequential feed range has been exhausted and all the blocks subsequently freed.} + + {Free the block pool} + FastMM_FreeMem_FreeMediumBlock(APSmallBlockSpan); + end; + + Result := 0; +{$endif} +end; + +{Frees a chain of blocks belonging to the small block manager. The block manager is assumed to be locked. Optionally +unlocks the block manager when done. The first pointer inside each free block should be a pointer to the next free +block. Returns 0 on success.} +function FastMM_FreeMem_FreeSmallBlockChain(APPendingFreeSmallBlock: Pointer; + AUnlockSmallBlockManagerWhenDone: Boolean): Integer; +var + LPNextBlock: Pointer; + LPSmallBlockSpan: PSmallBlockSpanHeader; +begin + while True do + begin + LPNextBlock := PPointer(APPendingFreeSmallBlock)^; + + LPSmallBlockSpan := GetSpanForSmallBlock(APPendingFreeSmallBlock); + FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked(LPSmallBlockSpan, APPendingFreeSmallBlock, + AUnlockSmallBlockManagerWhenDone and (LPNextBlock = nil)); + + if LPNextBlock = nil then + Break; + + APPendingFreeSmallBlock := LPNextBlock; + end; + + Result := 0; +end; + +{Returns a small block to the memory pool. Returns 0 on success.} +function FastMM_FreeMem_FreeSmallBlock(APSmallBlock: Pointer): Integer; inline; +var + LPSmallBlockSpan: PSmallBlockSpanHeader; + LPSmallBlockManager: PSmallBlockManager; + LOldFirstFreeBlock, LFirstPendingFreeBlock: Pointer; +begin + LPSmallBlockSpan := GetSpanForSmallBlock(APSmallBlock); + LPSmallBlockManager := LPSmallBlockSpan.SmallBlockManager; + + if AtomicCmpExchange(LPSmallBlockManager.SmallBlockManagerLocked, 1, 0) = 0 then + begin + + {ARM requires a memory fence here.} + + if LPSmallBlockManager.PendingFreeList = nil then + begin + Result := FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked(LPSmallBlockSpan, APSmallBlock, True); + Exit; + end + else + begin + FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked(LPSmallBlockSpan, APSmallBlock, False); + + {Process the pending frees list.} + LFirstPendingFreeBlock := AtomicExchange(LPSmallBlockManager.PendingFreeList, nil); + Result := FastMM_FreeMem_FreeSmallBlockChain(LFirstPendingFreeBlock, True); + end; + + end + else + begin + {The small block manager is currently locked, so we need to add this block to its pending free list.} + while True do + begin + LOldFirstFreeBlock := LPSmallBlockManager.PendingFreeList; + PPointer(APSmallBlock)^ := LOldFirstFreeBlock; + if AtomicCmpExchange(LPSmallBlockManager.PendingFreeList, APSmallBlock, LOldFirstFreeBlock) = LOldFirstFreeBlock then + Break; + end; + Result := 0; + end; +end; + +{Allocates a new sequential feed small block span and splits off the first block, returning it. The small block +manager for the block size and arena is assumed to be locked, and will be unlocked before exit. There may not be an +existing sequential feed span with available space.} +function FastMM_GetMem_GetSmallBlock_AllocateNewSequentialFeedSpanAndUnlockArena(APSmallBlockManager: PSmallBlockManager): Pointer; +{$ifdef X86ASM} +asm + push ebx + push esi + + {Small block manager in esi} + mov esi, eax + + mov eax, TSmallBlockManager(esi).MinimumSpanSize + mov edx, TSmallBlockManager(esi).OptimalSpanSize + lea ecx, [edx + CSmallBlockSpanMaximumAmountWithWhichOptimalSizeMayBeExceeded] + call FastMM_GetMem_GetMediumBlock + test eax, eax + jz @OutOfMemory + + {Save the span pointer in ebx} + mov ebx, eax + + {Get the span size in eax} + movzx eax, TMediumBlockHeader.MediumBlockSizeMultiple(eax - CMediumBlockHeaderSize) + shl eax, CMediumBlockAlignmentBits + + {Calculate the number of small blocks that will fit inside the span. We need to account for the span header, + as well as the difference in the medium and small block header sizes for the last block. All the sequential + feed blocks are initially marked as used. This implies that the sequential feed span can never be freed until + all blocks have been fed sequentially.} + sub eax, CSmallBlockSpanHeaderSize + CMediumBlockHeaderSize - CSmallBlockHeaderSize + xor edx, edx + movzx ecx, TSmallBlockManager(esi).BlockSize + div ecx + + {Update the medium block header to indicate that this medium block serves as a small block span.} + mov TMediumBlockHeader.IsSmallBlockSpan(ebx - CMediumBlockHeaderSize), True + + {Set up the block span. Blocks that will eventually be fed sequentially are counted as in use.} + mov TSmallBlockSpanHeader(ebx).SmallBlockManager, esi + mov TSmallBlockSpanHeader(ebx).FirstFreeBlock, 0 + mov TSmallBlockSpanHeader(ebx).TotalBlocksInSpan, eax + mov TSmallBlockSpanHeader(ebx).BlocksInUse, eax + + {This is the new sequential feed span. This must be set before the offset is set.} + mov TSmallBlockManager(esi).SequentialFeedSmallBlockSpan, ebx + + {Get the offset of the last block in eax} + dec eax + mul ecx + add eax, CSmallBlockSpanHeaderSize + + {Set the span up for sequential block serving} + mov TSmallBlockManager(esi).LastSmallBlockSequentialFeedOffset.IntegerValue, eax + mov TSmallBlockManager(esi).SmallBlockManagerLocked, 0 + + {Return the last block in the span} + mov ecx, eax + add eax, ebx + + {Set the header for the returned block.} + shr ecx, CMediumBlockAlignmentBits + lea ecx, [ecx * 8 + CIsSmallBlockFlag] //Low 3 bits are used by flags + mov TSmallBlockHeader.BlockStatusFlagsAndSpanOffset(eax - CSmallBlockHeaderSize), cx + +@Done: + pop esi + pop ebx + ret +@OutOfMemory: + mov TSmallBlockManager(esi).SmallBlockManagerLocked, 0 + pop esi + pop ebx +{$else} +var + LPSmallBlockSpan: PSmallBlockSpanHeader; + LSpanSize, LLastBlockOffset, LTotalBlocksInSpan: Integer; +begin + LPSmallBlockSpan := FastMM_GetMem_GetMediumBlock(APSmallBlockManager.MinimumSpanSize, + APSmallBlockManager.OptimalSpanSize, APSmallBlockManager.OptimalSpanSize + CSmallBlockSpanMaximumAmountWithWhichOptimalSizeMayBeExceeded); + + {Handle "out of memory".} + if LPSmallBlockSpan = nil then + begin + APSmallBlockManager.SmallBlockManagerLocked := 0; + Exit(nil); + end; + + {Update the medium block header to indicate that this medium block serves as a small block span.} + SetMediumBlockHeader_SetIsSmallBlockSpan(LPSmallBlockSpan, True); + + LSpanSize := GetMediumBlockSize(LPSmallBlockSpan); + + {Set up the block span} + LPSmallBlockSpan.SmallBlockManager := APSmallBlockManager; + LPSmallBlockSpan.FirstFreeBlock := nil; + {Set it as the sequential feed span. This must be done before the sequential feed offset is set.} + APSmallBlockManager.SequentialFeedSmallBlockSpan := LPSmallBlockSpan; + {Calculate the number of small blocks that will fit inside the span. We need to account for the span header, as well + as the difference in the medium and small block header sizes for the last block. All the sequential feed blocks are + initially marked as used. This implies that the sequential feed span can never be freed until all blocks have been + fed sequentially.} + LTotalBlocksInSpan := (LSpanSize - (CSmallBlockSpanHeaderSize + CMediumBlockHeaderSize - CSmallBlockHeaderSize)) + div APSmallBlockManager.BlockSize; + LPSmallBlockSpan.TotalBlocksInSpan := LTotalBlocksInSpan; + LPSmallBlockSpan.BlocksInUse := LTotalBlocksInSpan; + + {Memory fence required for ARM here.} + + {Set it up for sequential block serving} + LLastBlockOffset := CSmallBlockSpanHeaderSize + APSmallBlockManager.BlockSize * (LTotalBlocksInSpan - 1); + APSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerValue := LLastBlockOffset; + + APSmallBlockManager.SmallBlockManagerLocked := 0; + + Result := PByte(LPSmallBlockSpan) + LLastBlockOffset; + + {Set the header for the returned block.} + SetSmallBlockHeader(Result, LPSmallBlockSpan, False, False); +{$endif} +end; + +{Attempts to split off a small block from the sequential feed span for the arena. Returns the block on success, nil if +there is no available sequential feed block. The arena does not have to be locked.} +function FastMM_GetMem_GetSmallBlock_TryGetBlockFromSequentialFeedSpan(APSmallBlockManager: PSmallBlockManager): Pointer; +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + {--------x86 Assembly language codepath---------} + push ebx + push esi + push edi + + mov esi, eax +@TrySequentialFeedLoop: + + {Get the old ABA counter and offset in edx:eax} + mov eax, TSmallBlockManager(esi).LastSmallBlockSequentialFeedOffset.IntegerValue + mov edx, TSmallBlockManager(esi).LastSmallBlockSequentialFeedOffset.ABACounter + + {Get the new ABA counter and offset in ecx:ebx} + movzx edi, TSmallBlockManager(esi).BlockSize + mov ebx, eax + sub ebx, edi + lea ecx, [edx + 1] + + {Get the current sequential feed span in edi} + mov edi, TSmallBlockManager(esi).SequentialFeedSmallBlockSpan + + cmp eax, CSmallBlockSpanHeaderSize + jle @NoSequentialFeedAvailable + + {Try to grab the block. If it fails, try again from the start.} + lock cmpxchg8b TSmallBlockManager(esi).LastSmallBlockSequentialFeedOffset.IntegerAndABACounter + jne @TrySequentialFeedLoop + + {The block address is the span + offset.} + lea eax, [edi + ebx] + + {Set the header for the small block.} + and ebx, -CMediumBlockAlignment + shr ebx, CSmallBlockSpanOffsetBitShift + or ebx, CIsSmallBlockFlag + mov [eax - CSmallBlockHeaderSize], bx + + jmp @Done + +@NoSequentialFeedAvailable: + xor eax, eax +@Done: + pop edi + pop esi + pop ebx +{$else} + {--------x64 Assembly language codepath---------} + .noframe + +@TrySequentialFeedLoop: + + {Get the old ABA counter and offset in rax} + mov rax, TSmallBlockManager(rcx).LastSmallBlockSequentialFeedOffset.IntegerAndABACounter + + {Get the new ABA counter and offset in rdx} + movzx edx, TSmallBlockManager(rcx).BlockSize + neg edx + add rdx, rax + + {Get the current sequential feed span in r8} + mov r8, TSmallBlockManager(rcx).SequentialFeedSmallBlockSpan + + cmp eax, CSmallBlockSpanHeaderSize + jle @NoSequentialFeedAvailable + + {Try to grab the block. If it fails, try again from the start.} + lock cmpxchg TSmallBlockManager(rcx).LastSmallBlockSequentialFeedOffset.IntegerAndABACounter, rdx + jne @TrySequentialFeedLoop + + {The block address is the span + offset.} + mov edx, edx + lea rax, [r8 + rdx] + + {Set the header for the small block.} + and edx, -CMediumBlockAlignment + shr edx, CSmallBlockSpanOffsetBitShift + or edx, CIsSmallBlockFlag + mov [rax - CSmallBlockHeaderSize], dx + + ret + +@NoSequentialFeedAvailable: + xor eax, eax +@Done: + +{$endif} +{$else} +var + LPreviousLastSequentialFeedBlockOffset, LNewLastSequentialFeedBlockOffset: TIntegerWithABACounter; + LPSequentialFeedSpan: PSmallBlockSpanHeader; +begin + while True do + begin + LPreviousLastSequentialFeedBlockOffset := APSmallBlockManager.LastSmallBlockSequentialFeedOffset; + + {Subtract the block size and increment the ABA counter to the new sequential feed offset.} + LNewLastSequentialFeedBlockOffset.IntegerAndABACounter := LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter + - APSmallBlockManager.BlockSize + (Int64(1) shl 32); + + LPSequentialFeedSpan := APSmallBlockManager.SequentialFeedSmallBlockSpan; + + if LPreviousLastSequentialFeedBlockOffset.IntegerValue <= CSmallBlockSpanHeaderSize then + Exit(nil); + + if AtomicCmpExchange(APSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerAndABACounter, + LNewLastSequentialFeedBlockOffset.IntegerAndABACounter, + LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter) = LPreviousLastSequentialFeedBlockOffset.IntegerAndABACounter then + begin + + Result := @PByte(LPSequentialFeedSpan)[LNewLastSequentialFeedBlockOffset.IntegerValue]; + SetSmallBlockHeader(Result, LPSequentialFeedSpan, False, False); + + Exit; + end; + + end; +{$endif} +end; + +{Reuses a pending free block, freeing all pending free blocks other than the first. On entry it is assumed that +APSmallBlockManager.PendingFreeList <> nil and that the arena is locked. The arena will be unlocked before exit.} +function FastMM_GetMem_GetSmallBlock_ReusePendingFreeBlockAndUnlockArena( + APSmallBlockManager: PSmallBlockManager): Pointer; +{$ifdef X86ASM} +asm + push esi + {Get the old pending free list pointer in esi} + xor esi, esi + xchg TSmallBlockManager(eax).PendingFreeList, esi + {Get the next block in the chain in edx} + mov edx, [esi] + + {Free all subsequent blocks in the chain, if there are any.} + test edx, edx + jz @NoNextPendingFree + mov eax, edx + mov dl, 1 + call FastMM_FreeMem_FreeSmallBlockChain + jmp @CheckDebugInfo +@NoNextPendingFree: + mov byte ptr TSmallBlockManager(eax).SmallBlockManagerLocked, 0 + + {Does this block currently contain debug info? If so, check the header and footer checksums as well as the debug + fill pattern.} +@CheckDebugInfo: + test word ptr [esi - CSmallBlockHeaderSize], CHasDebugInfoFlag + jz @BlockHasNoDebugInfo + mov eax, esi + call CheckFreeDebugBlockIntact + test al, al + jnz @DebugBlockOK + mov al, reInvalidPtr + call System.Error +@DebugBlockOK: + {Reset the debug info flag in the block.} + and word ptr [esi - CSmallBlockHeaderSize], not CHasDebugInfoFlag +@BlockHasNoDebugInfo: + + {Return the first block in the pending free list} + mov eax, esi + pop esi +{$else} +var + LPNextFreeBlock: Pointer; +begin + Result := AtomicExchange(APSmallBlockManager.PendingFreeList, nil); + + LPNextFreeBlock := PPointer(Result)^; + if LPNextFreeBlock <> nil then + FastMM_FreeMem_FreeSmallBlockChain(LPNextFreeBlock, True) + else + APSmallBlockManager.SmallBlockManagerLocked := 0; + + {Does this block currently contain debug info? If so, check the header and footer checksums as well as the debug + fill pattern.} + if BlockHasDebugInfo(Result) then + begin + if not CheckFreeDebugBlockIntact(Result) then + System.Error(reInvalidPtr); + + {Reset the debug info flag in the block.} + SetBlockHasDebugInfo(Result, False); + end; +{$endif} +end; + +{Returns the first free block and unlocks the small block manager. On entry the manager must be locked and must be +known to have at least one free block.} +function FastMM_GetMem_GetSmallBlock_AllocateFreeBlockAndUnlockArena(APSmallBlockManager: PSmallBlockManager): Pointer; +{$ifdef X86ASM} +asm + push esi + mov esi, eax + + {ecx = first partially free span} + mov ecx, TSmallBlockManager(eax).FirstPartiallyFreeSpan + + {Return the first free block in the span.} + mov eax, TSmallBlockSpanHeader(ecx).FirstFreeBlock + + {Mark the block as in use.} + and word ptr [eax - CSmallBlockHeaderSize], not CBlockIsFreeFlag + + {The current content of the block will be a pointer to the next free block in the span.} + mov edx, [eax] + mov TSmallBlockSpanHeader(ecx).FirstFreeBlock, edx + + {Increment the number of used blocks} + add TSmallBlockSpanHeader(ecx).BlocksInUse, 1 + + {If there are no more free blocks in the small block span then it must be removed from the circular linked list of + small block spans with available blocks.} + test edx, edx + jnz @HasMoreFreeBlocks + mov edx, TSmallBlockSpanHeader(ecx).NextPartiallyFreeSpan + mov TSmallBlockManager(esi).FirstPartiallyFreeSpan, edx + mov TSmallBlockSpanHeader(edx).PreviousPartiallyFreeSpan, esi +@HasMoreFreeBlocks: + + mov byte ptr TSmallBlockManager(esi).SmallBlockManagerLocked, 0 + + {Does this block currently contain debug info? If so, check the header and footer checksums as well as the debug + fill pattern.} + test word ptr [eax - CSmallBlockHeaderSize], CHasDebugInfoFlag + jz @BlockHasNoDebugInfo + push eax + call CheckFreeDebugBlockIntact + test al, al + pop eax + jnz @DebugBlockOK + mov al, reInvalidPtr + call System.Error +@DebugBlockOK: + {Reset the debug info flag in the block.} + and word ptr [eax - CSmallBlockHeaderSize], not CHasDebugInfoFlag +@BlockHasNoDebugInfo: + + pop esi +{$else} +var + LPFirstPartiallyFreeSpan, LPNewFirstPartiallyFreeSpan: PSmallBlockSpanHeader; + LPNextFreeBlock: Pointer; +begin + LPFirstPartiallyFreeSpan := APSmallBlockManager.FirstPartiallyFreeSpan; + + {Return the first free block in the span.} + Result := LPFirstPartiallyFreeSpan.FirstFreeBlock; + + {Mark the block as in use.} + SetBlockIsFreeFlag(Result, False); + + {The current content of the first free block will be a pointer to the next free block in the span.} + LPNextFreeBlock := PPointer(Result)^; + LPFirstPartiallyFreeSpan.FirstFreeBlock := LPNextFreeBlock; + + {Increment the number of used blocks} + Inc(LPFirstPartiallyFreeSpan.BlocksInUse); + + {If there are no more free blocks in the small block span then it must be removed from the circular linked list of + small block spans with available blocks.} + if LPNextFreeBlock = nil then + begin + LPNewFirstPartiallyFreeSpan := LPFirstPartiallyFreeSpan.NextPartiallyFreeSpan; + APSmallBlockManager.FirstPartiallyFreeSpan := LPNewFirstPartiallyFreeSpan; + LPNewFirstPartiallyFreeSpan.PreviousPartiallyFreeSpan := PSmallBlockSpanHeader(APSmallBlockManager); + end; + + {ARM requires a data memory barrier here to ensure that all prior writes have completed before the arena is unlocked.} + + APSmallBlockManager.SmallBlockManagerLocked := 0; + + {Does this block currently contain debug info? If so, check the header and footer checksums as well as the debug + fill pattern.} + if BlockHasDebugInfo(Result) then + begin + if not CheckFreeDebugBlockIntact(Result) then + begin + APSmallBlockManager.SmallBlockManagerLocked := 0; + System.Error(reInvalidPtr); + end; + + {Reset the debug info flag in the block.} + SetBlockHasDebugInfo(Result, False); + end; + +{$endif} +end; + +{Tries to allocate a small block through the given small block manager. If the manager has no available blocks, or +it is locked, then the corresponding managers in other arenas are also tried.} +function FastMM_GetMem_GetSmallBlock(APSmallBlockManager: PSmallBlockManager): Pointer; +{$ifdef X86ASM} +asm + {--------------Attempt 1-------------- + Try to get a block from the first arena with an available block. During the first attempt only memory that has + already been reserved for use by the block type will be used - no new spans will be allocated. + + Try to obtain a block in this sequence: + 1) The pending free list + 2) From a partially free span + 3) From the sequential feed span} + +@Attempt1Loop: + {Is this manager currently locked?} + cmp byte ptr TSmallBlockManager(eax).SmallBlockManagerLocked, 0 + jne @Attempt1TrySequentialFeed + + {Is there a pending free block?} + cmp TSmallBlockManager(eax).PendingFreeList, 0 + jne @Attempt1LockManagerAndTryGetBlock + + {Are there free blocks for this manager?} + cmp TSmallBlockManager(eax).FirstPartiallyFreeSpan, eax + je @Attempt1TrySequentialFeed + +@Attempt1LockManagerAndTryGetBlock: + {Try to lock the manager} + mov cl, 1 + xchg byte ptr TSmallBlockManager(eax).SmallBlockManagerLocked, cl + test cl, cl + jnz @Attempt1TrySequentialFeed + + {1.1) Try to get a pending free block. If there's no pending free block after locking the arena, try reusing a free + block.} + cmp TSmallBlockManager(eax).PendingFreeList, 0 + jne FastMM_GetMem_GetSmallBlock_ReusePendingFreeBlockAndUnlockArena + + {1.2) Try to get a block from the first free span.} + cmp TSmallBlockManager(eax).FirstPartiallyFreeSpan, eax + jne FastMM_GetMem_GetSmallBlock_AllocateFreeBlockAndUnlockArena + + {Other threads took all the available blocks before the manager could be locked.} + mov byte ptr TSmallBlockManager(eax).SmallBlockManagerLocked, 0 + +@Attempt1TrySequentialFeed: + {1.3) Could not reuse a free block nor a pending free block: Try sequential feed.} + cmp TSmallBlockManager(eax).LastSmallBlockSequentialFeedOffset.IntegerValue, CSmallBlockSpanHeaderSize + jle @Attempt1NoSequentialFeedBlockAvailable + push eax + call FastMM_GetMem_GetSmallBlock_TryGetBlockFromSequentialFeedSpan + pop edx + test eax, eax + jz @Attempt1SequentialFeedFailed + ret +@Attempt1SequentialFeedFailed: + mov eax, edx +@Attempt1NoSequentialFeedBlockAvailable: + + {Is this the last arena? If not, try the next one.} + cmp eax, offset SmallBlockManagers + CSmallBlockManagerSize * CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1) + jnb @Attempt1Failed + add eax, CSmallBlockManagerSize * CSmallBlockTypeCount + jmp @Attempt1Loop + +@Attempt1Failed: + sub eax, CSmallBlockManagerSize * CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1) + + {--------------Attempt 2-------------- + Lock the first unlocked arena and try again. During the second attempt a new sequential feed span will be allocated + if there are no available blocks in the arena. + + Try to obtain a block in this sequence: + 1) The pending free list + 2) From a partially free span + 3) From the sequential feed span + 4) By allocating a new sequential feed span and splitting off a block from it} + +@Attempt2Loop: + + {Try to lock the manager} + mov edx, eax + xor eax, eax + mov cl, 1 + lock cmpxchg byte ptr TSmallBlockManager(edx).SmallBlockManagerLocked, cl + mov eax, edx + jne @Attempt2ManagerAlreadyLocked + + {2.1) Try to get a pending free block. If there's no pending free block after locking the arena, try reusing a free + block.} + cmp TSmallBlockManager(eax).PendingFreeList, 0 + jne FastMM_GetMem_GetSmallBlock_ReusePendingFreeBlockAndUnlockArena + + {2.2) Try to get a block from the first free span.} + cmp TSmallBlockManager(eax).FirstPartiallyFreeSpan, eax + jne FastMM_GetMem_GetSmallBlock_AllocateFreeBlockAndUnlockArena + + {2.3) Could not reuse a free block nor a pending free block: Try sequential feed.} + cmp TSmallBlockManager(eax).LastSmallBlockSequentialFeedOffset.IntegerValue, CSmallBlockSpanHeaderSize + jle @Attempt2NoSequentialFeedBlockAvailable + push eax + call FastMM_GetMem_GetSmallBlock_TryGetBlockFromSequentialFeedSpan + pop edx + test eax, eax + jz @Attempt2SequentialFeedFailed + mov byte ptr TSmallBlockManager(edx).SmallBlockManagerLocked, 0 + ret +@Attempt2SequentialFeedFailed: + mov eax, edx +@Attempt2NoSequentialFeedBlockAvailable: + + {2.4) Allocate a new sequential feed span and split off a block} + jmp FastMM_GetMem_GetSmallBlock_AllocateNewSequentialFeedSpanAndUnlockArena; + +@Attempt2ManagerAlreadyLocked: + {Is this the last arena? If not, try the next one.} + cmp eax, offset SmallBlockManagers + CSmallBlockManagerSize * CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1) + jnb @Attempt2Failed + add eax, CSmallBlockManagerSize * CSmallBlockTypeCount + jmp @Attempt2Loop + +@Attempt2Failed: + sub eax, CSmallBlockManagerSize * CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1) + + {All arenas are currently locked: Back off and start again at the first arena} + push eax + call LogSmallBlockThreadContentionAndYieldToOtherThread + pop eax + jmp @Attempt1Loop +{$else} +begin + while True do + begin + + {--------------Attempt 1-------------- + Try to get a block from the first arena with an available block. During the first attempt only memory that has + already been reserved for use by the block type will be used - no new spans will be allocated. + + Try to obtain a block in this sequence: + 1) The pending free list + 2) From a partially free span + 3) From the sequential feed span} + + {Walk the arenas for this small block type until we find an unlocked arena that can be used to obtain a block.} + while True do + begin + + {Atomic operations are very expensive, so in this first cycle through all the arenas we only try to lock the + small block manager if there is a very high probability that the lock will be successful, and if it is successful + that it will most likely have a block available.} + if APSmallBlockManager.SmallBlockManagerLocked = 0 then + begin + + {Before trying to lock the manager, first check whether it currently has either a non-empty pending free list or + it has a partially free span.} + if ((APSmallBlockManager.PendingFreeList <> nil) + or (NativeInt(APSmallBlockManager.FirstPartiallyFreeSpan) <> NativeInt(APSmallBlockManager))) + and (AtomicExchange(APSmallBlockManager.SmallBlockManagerLocked, 1) = 0) then + begin + + {Try to reuse a pending free block first.} + if APSmallBlockManager.PendingFreeList <> nil then + Exit(FastMM_GetMem_GetSmallBlock_ReusePendingFreeBlockAndUnlockArena(APSmallBlockManager)); + + {Try to allocate a block from the first partially free span.} + if NativeInt(APSmallBlockManager.FirstPartiallyFreeSpan) <> NativeInt(APSmallBlockManager) then + Exit(FastMM_GetMem_GetSmallBlock_AllocateFreeBlockAndUnlockArena(APSmallBlockManager)); + + {Other threads must have taken all the available blocks before the manager could be locked.} + APSmallBlockManager.SmallBlockManagerLocked := 0; + end; + end; + + {Try to split off a block from the sequential feed span (if there is one). Splitting off a sequential feed block + does not require the manager to be locked.} + if APSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerValue > CSmallBlockSpanHeaderSize then + begin + Result := FastMM_GetMem_GetSmallBlock_TryGetBlockFromSequentialFeedSpan(APSmallBlockManager); + if Result <> nil then + Exit; + end; + + {Could not obtain a block from this arena: Move on to the next arena.} + if NativeUInt(APSmallBlockManager) < NativeUInt(@SmallBlockManagers[CFastMM_SmallBlockArenaCount - 1]) then + Inc(APSmallBlockManager, CSmallBlockTypeCount) + else + Break; + + end; + {Go back to the corresponding manager in the first arena} + Dec(APSmallBlockManager, CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1)); + + {--------------Attempt 2-------------- + Lock the first unlocked arena and try again. During the second attempt a new sequential feed span will be allocated + if there are no available blocks in the arena. + + Try to obtain a block in this sequence: + 1) The pending free list + 2) From a partially free span + 3) From the sequential feed span + 4) By allocating a new sequential feed span and splitting off a block from it} + + while True do + begin + + if AtomicCmpExchange(APSmallBlockManager.SmallBlockManagerLocked, 1, 0) = 0 then + begin + + {Check if there is a pending free list. If so the first pending free block is returned and the rest are freed.} + if APSmallBlockManager.PendingFreeList <> nil then + Exit(FastMM_GetMem_GetSmallBlock_ReusePendingFreeBlockAndUnlockArena(APSmallBlockManager)); + + {Try to get a block from the first partially free span.} + if NativeInt(APSmallBlockManager.FirstPartiallyFreeSpan) <> NativeInt(APSmallBlockManager) then + Exit(FastMM_GetMem_GetSmallBlock_AllocateFreeBlockAndUnlockArena(APSmallBlockManager)); + + {It's possible another thread could have allocated a new sequential feed span in the meantime, so we need to + check again before allocating a new one.} + if APSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerValue > CSmallBlockSpanHeaderSize then + begin + Result := FastMM_GetMem_GetSmallBlock_TryGetBlockFromSequentialFeedSpan(APSmallBlockManager); + if Result <> nil then + begin + APSmallBlockManager.SmallBlockManagerLocked := 0; + Exit; + end; + end; + + {Allocate a new sequential feed span and split off a block from it} + Exit(FastMM_GetMem_GetSmallBlock_AllocateNewSequentialFeedSpanAndUnlockArena(APSmallBlockManager)); + + end; + + {Try the next small block arena} + if NativeUInt(APSmallBlockManager) < NativeUInt(@SmallBlockManagers[CFastMM_SmallBlockArenaCount - 1]) then + Inc(APSmallBlockManager, CSmallBlockTypeCount) + else + Break; + end; + Dec(APSmallBlockManager, CSmallBlockTypeCount * (CFastMM_SmallBlockArenaCount - 1)); + + {--------------Back off-------------- + All arenas are currently locked: Back off and start again at the first arena} + + LogSmallBlockThreadContentionAndYieldToOtherThread; + + end; +{$endif} +end; + +function FastMM_ReallocMem_ReallocSmallBlock(APointer: Pointer; ANewUserSize: NativeInt): Pointer; +{$ifdef X86ASM} +asm + {Get the span pointer in esi} + movzx ecx, word ptr [eax - CBlockStatusFlagsSize] + push esi + and ecx, CDropSmallBlockFlagsMask + shl ecx, CSmallBlockSpanOffsetBitShift + mov esi, eax + and esi, -CMediumBlockAlignment + sub esi, ecx + + {Get the small block manager in esi} + mov esi, TSmallBlockSpanHeader(esi).SmallBlockManager + + {Get the old available size in ecx} + movzx ecx, TSmallBlockManager(esi).BlockSize + sub ecx, CSmallBlockHeaderSize + + {Is it an upsize or downsize?} + cmp ecx, edx + jb @IsUpSize + + {It's a downsize. Do we need to allocate a smaller block? Only if the new block size is less than a quarter of the + available size less SmallBlockDownsizeCheckAdder bytes.} + lea esi, [edx * 4 + CSmallBlockDownsizeCheckAdder] + cmp esi, ecx + jae @Done2 + + {Keep the old pointer in ebx} + push ebx + mov ebx, eax + + {Keep the new size in esi} + mov esi, edx + + {Allocate the new block, move the old data across and then free the old block.} + mov eax, edx + call FastMM_GetMem + test eax, eax + jz @Done + mov ecx, esi + mov esi, eax + mov edx, eax + mov eax, ebx + call System.Move + mov eax, ebx + call FastMM_FreeMem + mov eax, esi + jmp @Done + +@IsUpSize: + {Keep the old pointer in ebx} + push ebx + mov ebx, eax + + {This pointer is being reallocated to a larger block and therefore it is logical to assume that it may be enlarged + again. Since reallocations are expensive, there is a minimum upsize percentage to avoid unnecessary future move + operations.} + lea eax, [ecx + ecx + CSmallBlockUpsizeAdder] + cmp eax, edx + ja @GotNewSize + mov eax, edx +@GotNewSize: + + {Allocate the new block, move the old data across and then free the old block.} + call FastMM_GetMem + test eax, eax + jz @Done + movzx ecx, TSmallBlockManager(esi).BlockSize + sub ecx, CSmallBlockHeaderSize + push eax + mov edx, eax + mov eax, ebx + call TSmallBlockManager(esi).UpsizeMoveProcedure + mov eax, ebx + call FastMM_FreeMem + pop eax + +@Done: + pop ebx +@Done2: + pop esi +{$else} +var + LPSmallBlockSpan: PSmallBlockSpanHeader; + LPSmallBlockManager: PSmallBlockManager; + LOldUserSize, LNewUserSize: NativeInt; +begin + LPSmallBlockSpan := GetSpanForSmallBlock(APointer); + + LPSmallBlockManager := LPSmallBlockSpan.SmallBlockManager; + + {Get the available size inside blocks of this type.} + LOldUserSize := LPSmallBlockManager.BlockSize - CSmallBlockHeaderSize; + {Is it an upsize or a downsize?} + if LOldUserSize >= ANewUserSize then + begin + {It's a downsize. Do we need to allocate a smaller block? Only if the new block size is less than a quarter of + the available size less SmallBlockDownsizeCheckAdder bytes} + if (ANewUserSize shl 2 + CSmallBlockDownsizeCheckAdder) >= LOldUserSize then + begin + {In-place downsize - return the pointer} + Result := APointer; + Exit; + end + else + begin + {Allocate a smaller block} + Result := FastMM_GetMem(ANewUserSize); + {Allocated OK?} + if Result <> nil then + begin + {Move the data across} + System.Move(APointer^, Result^, ANewUserSize); + {Free the old pointer} + FastMM_FreeMem(APointer); + end; + end; + end + else + begin + {This pointer is being reallocated to a larger block and therefore it is logical to assume that it may be enlarged + again. Since reallocations are expensive, there is a minimum upsize percentage to avoid unnecessary future move + operations.} + {Must grow with at least 100% + x bytes} + LNewUserSize := LOldUserSize shl 1 + CSmallBlockUpsizeAdder; + + {Still not large enough?} + if LNewUserSize < ANewUserSize then + LNewUserSize := ANewUserSize; + + {Allocate the new block, move the old data across and then free the old block.} + Result := FastMM_GetMem(LNewUserSize); + if Result <> nil then + begin + LPSmallBlockManager.UpsizeMoveProcedure(APointer^, Result^, LOldUserSize); + FastMM_FreeMem(APointer); + end; + + end; +{$endif} +end; + + +{--------------------------------------------------------} +{-------Core memory manager interface: Normal mode-------} +{--------------------------------------------------------} + +function FastMM_GetMem(ASize: NativeInt): Pointer; +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + {--------x86 Assembly language codepath---------} + cmp eax, (CMaximumSmallBlockSize - CSmallBlockHeaderSize) + ja @NotASmallBlock + {Small block: Get the small block manager index in eax} + add eax, 1 + shr eax, CSmallBlockGranularityBits + movzx eax, byte ptr SmallBlockTypeLookup[eax] + {Get a pointer to the small block manager for arena 0 in eax} + shl eax, CSmallBlockManagerSizeBits + add eax, offset SmallBlockManagers + jmp FastMM_GetMem_GetSmallBlock +@NotASmallBlock: + cmp eax, (CMaximumMediumBlockSize - CMediumBlockHeaderSize) + ja FastMM_GetMem_GetLargeBlock + {Medium block: Round the requested size up to the next medium block bin.} + cmp eax, (CMediumBlockMiddleBinsStart - CMediumBlockHeaderSize) + ja @NotFirstMediumBlockGroup + add eax, (CMediumBlockHeaderSize - CMinimumMediumBlockSize + CInitialBinSpacing - 1) + and eax, -CInitialBinSpacing + add eax, CMinimumMediumBlockSize + mov edx, eax + mov ecx, eax + jmp FastMM_GetMem_GetMediumBlock +@NotFirstMediumBlockGroup: + cmp eax, (CMediumBlockFinalBinsStart - CMediumBlockHeaderSize) + ja @LastMediumBlockGroup + add eax, (CMediumBlockHeaderSize - CMediumBlockMiddleBinsStart + CMiddleBinSpacing - 1) + and eax, -CMiddleBinSpacing + add eax, CMediumBlockMiddleBinsStart + mov edx, eax + mov ecx, eax + jmp FastMM_GetMem_GetMediumBlock +@LastMediumBlockGroup: + add eax, (CMediumBlockHeaderSize - CMediumBlockFinalBinsStart + CFinalBinSpacing - 1) + and eax, -CFinalBinSpacing + add eax, CMediumBlockFinalBinsStart + mov edx, eax + mov ecx, eax + jmp FastMM_GetMem_GetMediumBlock +{$else} + .noframe + {--------x64 Assembly language codepath---------} + cmp rcx, (CMaximumSmallBlockSize - CSmallBlockHeaderSize) + ja @NotASmallBlock + {Small block: Get the small block manager index in ecx} + add ecx, 1 + shr ecx, CSmallBlockGranularityBits + lea rdx, SmallBlockTypeLookup + movzx ecx, byte ptr [rdx + rcx] + {Get a pointer to the small block manager for arena 0 in rcx} + shl rcx, CSmallBlockManagerSizeBits + lea rdx, SmallBlockManagers + add rcx, rdx + jmp FastMM_GetMem_GetSmallBlock +@NotASmallBlock: + cmp rcx, (CMaximumMediumBlockSize - CMediumBlockHeaderSize) + ja FastMM_GetMem_GetLargeBlock + {Medium block: Round the requested size up to the next medium block bin.} + cmp ecx, (CMediumBlockMiddleBinsStart - CMediumBlockHeaderSize) + ja @NotFirstMediumBlockGroup + add ecx, (CMediumBlockHeaderSize - CMinimumMediumBlockSize + CInitialBinSpacing - 1) + and ecx, -CInitialBinSpacing + add ecx, CMinimumMediumBlockSize + mov edx, ecx + mov r8d, ecx + jmp FastMM_GetMem_GetMediumBlock +@NotFirstMediumBlockGroup: + cmp ecx, (CMediumBlockFinalBinsStart - CMediumBlockHeaderSize) + ja @LastMediumBlockGroup + add ecx, (CMediumBlockHeaderSize - CMediumBlockMiddleBinsStart + CMiddleBinSpacing - 1) + and ecx, -CMiddleBinSpacing + add ecx, CMediumBlockMiddleBinsStart + mov edx, ecx + mov r8d, ecx + jmp FastMM_GetMem_GetMediumBlock +@LastMediumBlockGroup: + add ecx, (CMediumBlockHeaderSize - CMediumBlockFinalBinsStart + CFinalBinSpacing - 1) + and ecx, -CFinalBinSpacing + add ecx, CMediumBlockFinalBinsStart + mov edx, ecx + mov r8d, ecx + jmp FastMM_GetMem_GetMediumBlock +{$endif} +{$else} +var + LPSmallBlockManager: PSmallBlockManager; + LSmallBlockTypeIndex: Integer; +begin + {Is it a small block allocation request?} + if NativeUInt(ASize) <= (CMaximumSmallBlockSize - CSmallBlockHeaderSize) then + begin + {Convert the size to a pointer to the corresponding manager in the first arena.} + LSmallBlockTypeIndex := SmallBlockTypeLookup[(NativeUInt(ASize) + (CSmallBlockHeaderSize - 1)) shr CSmallBlockGranularityBits]; + LPSmallBlockManager := @SmallBlockManagers[0][LSmallBlockTypeIndex]; + Result := FastMM_GetMem_GetSmallBlock(LPSmallBlockManager); + end + else + begin + {Medium or large block.} + if NativeUInt(ASize) <= (CMaximumMediumBlockSize - CMediumBlockHeaderSize) then + begin + {Add the size of the block header and round up to an exact bin size} + ASize := RoundUserSizeUpToNextMediumBlockBin(ASize); + Result := FastMM_GetMem_GetMediumBlock(ASize, ASize, ASize); + end + else + begin + Result := FastMM_GetMem_GetLargeBlock(ASize); + end; + end; +{$endif} +end; + +function FastMM_FreeMem(APointer: Pointer): Integer; +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + + {--------x86 Assembly language codepath---------} + + {Read the flags from the block header.} + movzx edx, word ptr [eax - CBlockStatusFlagsSize] + + {Is it a small block that is in use?} + mov ecx, (CBlockIsFreeFlag or CIsSmallBlockFlag) + and ecx, edx + cmp ecx, CIsSmallBlockFlag + jne @NotASmallBlock + + {----Start: Inline of FastMM_FreeMem_FreeSmallBlock----} + {Get the span pointer in ecx} + and edx, CDropSmallBlockFlagsMask + shl edx, CSmallBlockSpanOffsetBitShift + mov ecx, eax + and ecx, -CMediumBlockAlignment + sub ecx, edx + + {Get the small block manager in esi} + push esi + mov esi, TSmallBlockSpanHeader(ecx).SmallBlockManager + + {Get the block pointer in edx} + mov edx, eax + + mov eax, $100 + lock cmpxchg byte ptr TSmallBlockManager(esi).SmallBlockManagerLocked, ah + jne @ManagerCurrentlyLocked + + {Get the span in eax} + mov eax, ecx + + cmp TSmallBlockManager(esi).PendingFreeList, 0 + jne @HasPendingFreeList + + {No pending free list: Just free this block and unlock the block manager.} + pop esi + mov cl, 1 + jmp FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked + +@HasPendingFreeList: + xor ecx, ecx + call FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked + + {Unlink the current pending free list} + xor eax, eax + xchg TSmallBlockManager(esi).PendingFreeList, eax + + {Process the pending free list.} + pop esi + mov dl, 1 + jmp FastMM_FreeMem_FreeSmallBlockChain + + {The small block manager is currently locked, so we need to add this block to its pending free list.} +@ManagerCurrentlyLocked: + mov eax, TSmallBlockManager(esi).PendingFreeList + mov [edx], eax + lock cmpxchg TSmallBlockManager(esi).PendingFreeList, edx + jne @ManagerCurrentlyLocked + + xor eax, eax + pop esi + ret + {----End: Inline of FastMM_FreeMem_FreeSmallBlock----} + +@NotASmallBlock: + mov ecx, (not CHasDebugInfoFlag) + and ecx, edx + cmp ecx, CIsMediumBlockFlag + je FastMM_FreeMem_FreeMediumBlock + + cmp ecx, CIsLargeBlockFlag + je FastMM_FreeMem_FreeLargeBlock + + cmp edx, CIsDebugBlockFlag + je FastMM_FreeMem_FreeDebugBlock + + xor edx,edx + jmp HandleInvalidFreeMemOrReallocMem +{$else} + + {--------x64 Assembly language codepath---------} + + .params 3 + .pushnv rsi + + {Read the flags from the block header.} + movzx eax, word ptr [rcx - CBlockStatusFlagsSize] + + {Is it a small block that is in use?} + mov edx, (CBlockIsFreeFlag or CIsSmallBlockFlag) + and edx, eax + cmp edx, CIsSmallBlockFlag + jne @NotASmallBlock + + {----Start: Inline of FastMM_FreeMem_FreeSmallBlock----} + + {Get the block pointer in rdx} + mov rdx, rcx + + {Get the span pointer in rcx} + and eax, CDropSmallBlockFlagsMask + shl eax, CSmallBlockSpanOffsetBitShift + and rcx, -CMediumBlockAlignment + sub rcx, rax + + {Get the small block manager in rsi} + mov rsi, TSmallBlockSpanHeader(rcx).SmallBlockManager + + mov eax, $100 + lock cmpxchg byte ptr TSmallBlockManager(rsi).SmallBlockManagerLocked, ah + jne @ManagerCurrentlyLocked + + cmp TSmallBlockManager(rsi).PendingFreeList, 0 + jne @HasPendingFreeList + + {No pending free list: Just free this block and unlock the block manager.} + add rsp, $28 + pop rsi + pop rbp + mov r8b, 1 + jmp FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked + +@HasPendingFreeList: + xor r8d, r8d + call FastMM_FreeMem_FreeSmallBlock_ManagerAlreadyLocked + + {Unlink the current pending free list} + xor ecx, ecx + xchg TSmallBlockManager(rsi).PendingFreeList, rcx + + {Process the pending free list.} + add rsp, $28 + pop rsi + pop rbp + mov dl, 1 + jmp FastMM_FreeMem_FreeSmallBlockChain + + {The small block manager is currently locked, so we need to add this block to its pending free list.} +@ManagerCurrentlyLocked: + mov rax, TSmallBlockManager(rsi).PendingFreeList + mov [rdx], rax + lock cmpxchg TSmallBlockManager(rsi).PendingFreeList, rdx + jne @ManagerCurrentlyLocked + + xor eax, eax + jmp @Done + {----End: Inline of FastMM_FreeMem_FreeSmallBlock----} + +@NotASmallBlock: + add rsp, $28 + pop rsi + pop rbp + + mov edx, (not CHasDebugInfoFlag) + and edx, eax + cmp edx, CIsMediumBlockFlag + je FastMM_FreeMem_FreeMediumBlock + + cmp edx, CIsLargeBlockFlag + je FastMM_FreeMem_FreeLargeBlock + cmp eax, CIsDebugBlockFlag + je FastMM_FreeMem_FreeDebugBlock + xor edx,edx + jmp HandleInvalidFreeMemOrReallocMem +@Done: + +{$endif} +{$else} +var + LBlockHeader: Integer; +begin + {Read the flags from the block header.} + LBlockHeader := PBlockStatusFlags(APointer)[-1]; + + {Is it a small block that is in use?} + if LBlockHeader and (CBlockIsFreeFlag or CIsSmallBlockFlag) = CIsSmallBlockFlag then + begin + Result := FastMM_FreeMem_FreeSmallBlock(APointer); + end + else + begin + if LBlockHeader and (not CHasDebugInfoFlag) = CIsMediumBlockFlag then + begin + Result := FastMM_FreeMem_FreeMediumBlock(APointer); + end + else + begin + if LBlockHeader and (not CHasDebugInfoFlag) = CIsLargeBlockFlag then + begin + Result := FastMM_FreeMem_FreeLargeBlock(APointer); + end + else + begin + if LBlockHeader = CIsDebugBlockFlag then + begin + Result := FastMM_FreeMem_FreeDebugBlock(APointer); + end + else + begin + Result := HandleInvalidFreeMemOrReallocMem(APointer, False); + end; + end; + end; + end; +{$endif} +end; + +function FastMM_ReallocMem(APointer: Pointer; ANewSize: NativeInt): Pointer; +{$ifndef PurePascal} +asm +{$ifdef X86ASM} + {--------x86 Assembly language codepath---------} + + {Is it a small block that is in use?} + movzx ecx, word ptr [eax - CBlockStatusFlagsSize] + and ecx, (CBlockIsFreeFlag or CIsSmallBlockFlag) + cmp ecx, CIsSmallBlockFlag + je FastMM_ReallocMem_ReallocSmallBlock + + movzx ecx, word ptr [eax - CBlockStatusFlagsSize] + and ecx, (not CHasDebugInfoFlag) + cmp ecx, CIsMediumBlockFlag + je FastMM_ReallocMem_ReallocMediumBlock + + cmp ecx, CIsLargeBlockFlag + je FastMM_ReallocMem_ReallocLargeBlock + + cmp word ptr [eax - CBlockStatusFlagsSize], CIsDebugBlockFlag + je FastMM_ReallocMem_ReallocDebugBlock + + xor edx,edx + jmp HandleInvalidFreeMemOrReallocMem +{$else} + {--------x64 Assembly language codepath---------} + .noframe + {Get the block flags in r8} + movzx r8d, word ptr [rcx - CBlockStatusFlagsSize] + + {Is it a small block that is in use?} + mov eax, r8d + and eax, (CBlockIsFreeFlag or CIsSmallBlockFlag) + cmp eax, CIsSmallBlockFlag + je FastMM_ReallocMem_ReallocSmallBlock + + mov eax, r8d + and eax, (not CHasDebugInfoFlag) + cmp eax, CIsMediumBlockFlag + je FastMM_ReallocMem_ReallocMediumBlock + + cmp eax, CIsLargeBlockFlag + je FastMM_ReallocMem_ReallocLargeBlock + + cmp r8d, CIsDebugBlockFlag + je FastMM_ReallocMem_ReallocDebugBlock + + xor edx,edx + jmp HandleInvalidFreeMemOrReallocMem + +{$endif} +{$else} +var + LBlockHeader: Integer; +begin + {Read the flags from the block header.} + LBlockHeader := PBlockStatusFlags(APointer)[-1]; + + {Is it a small block that is in use?} + if LBlockHeader and (CBlockIsFreeFlag or CIsSmallBlockFlag) = CIsSmallBlockFlag then + begin + Result := FastMM_ReallocMem_ReallocSmallBlock(APointer, ANewSize); + end + else + begin + {Is this a medium block in use?} + if LBlockHeader and (not CHasDebugInfoFlag) = CIsMediumBlockFlag then + begin + Result := FastMM_ReallocMem_ReallocMediumBlock(APointer, ANewSize); + end + else + begin + if LBlockHeader and (not CHasDebugInfoFlag) = CIsLargeBlockFlag then + begin + Result := FastMM_ReallocMem_ReallocLargeBlock(APointer, ANewSize); + end + else + begin + if LBlockHeader = CIsDebugBlockFlag then + begin + Result := FastMM_ReallocMem_ReallocDebugBlock(APointer, ANewSize) + end + else + begin + HandleInvalidFreeMemOrReallocMem(APointer, True); + Result := nil; + end; + end; + + end; + end; +{$endif} +end; + +function FastMM_AllocMem(ASize: NativeInt): Pointer; +begin + Result := FastMM_GetMem(ASize); + {Large blocks are already zero filled} + if (Result <> nil) and (ASize <= (CMaximumMediumBlockSize - CMediumBlockHeaderSize)) then + FillChar(Result^, ASize, 0); +end; + + +{--------------------------------------------------------} +{-------Core memory manager interface: Debug mode--------} +{--------------------------------------------------------} + +function FastMM_DebugGetMem_GetDebugBlock(ASize: NativeInt; AFillBlockWithDebugPattern: Boolean): Pointer; +var + LStackTraceDepth: Byte; +begin + LStackTraceDepth := DebugMode_StackTrace_EntryCount; + + {Add the size of the debug header, footer checksum and two stack traces to the allocation size.} + Result := FastMM_GetMem(ASize + CDebugBlockHeaderSize + CalculateDebugBlockFooterSize(LStackTraceDepth)); + if Result = nil then + Exit; + + {Populate the debug header and set the header and footer checksums.} + PFastMM_DebugBlockHeader(Result).UserSize := ASize; + PFastMM_DebugBlockHeader(Result).StackTraceEntryCount := LStackTraceDepth; + PFastMM_DebugBlockHeader(Result).PreviouslyUsedByClass := nil; + if LStackTraceDepth > 0 then + begin + FastMM_GetStackTrace(PFastMM_DebugBlockHeader(Result).DebugFooter_AllocationStackTracePtr, LStackTraceDepth, + CFastMM_StackTrace_SkipFrames_GetMem); + FillChar(PFastMM_DebugBlockHeader(Result).DebugFooter_FreeStackTracePtr^, LStackTraceDepth * SizeOf(Pointer), 0); + end; + PFastMM_DebugBlockHeader(Result).AllocationGroup := FastMM_CurrentAllocationGroup; + PFastMM_DebugBlockHeader(Result).AllocationNumber := AtomicIncrement(FastMM_LastAllocationNumber); + PFastMM_DebugBlockHeader(Result).AllocatedByThread := OS_GetCurrentThreadID; + PFastMM_DebugBlockHeader(Result).FreedByThread := 0; + PFastMM_DebugBlockHeader(Result).DebugBlockFlags := CIsDebugBlockFlag; + PFastMM_DebugBlockHeader(Result).CalculateAndSetHeaderAndFooterCheckSums; + + {Fill the block with the debug pattern} + if AFillBlockWithDebugPattern then + FillDebugBlockWithDebugPattern(Result); + + {Set the flag in the actual block header to indicate that the block contains debug information.} + SetBlockHasDebugInfo(Result, True); + + {Return a pointer to the user data} + Inc(PByte(Result), CDebugBlockHeaderSize); +end; + +function FastMM_DebugGetMem(ASize: NativeInt): Pointer; +begin + if FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation then + FastMM_ScanDebugBlocksForCorruption; + + Result := FastMM_DebugGetMem_GetDebugBlock(ASize, True); +end; + +function FastMM_DebugFreeMem(APointer: Pointer): Integer; +begin + if FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation then + FastMM_ScanDebugBlocksForCorruption; + + Result := FastMM_FreeMem(APointer); +end; + +function FastMM_DebugReallocMem(APointer: Pointer; ANewSize: NativeInt): Pointer; +var + LBlockHeader: Integer; + LMoveCount: NativeInt; +begin + if FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation then + FastMM_ScanDebugBlocksForCorruption; + + {Read the flags from the block header.} + LBlockHeader := PBlockStatusFlags(APointer)[-1]; + + if LBlockHeader = CIsDebugBlockFlag then + begin + Result := FastMM_ReallocMem_ReallocDebugBlock(APointer, ANewSize); + end + else + begin + {Catch an attempt to reallocate a freed block.} + if LBlockHeader and CBlockIsFreeFlag <> 0 then + begin + HandleInvalidFreeMemOrReallocMem(APointer, True); + Exit(nil); + end; + + {The old block is not a debug block, so we need to allocate a new debug block and copy the data across.} + Result := FastMM_DebugGetMem_GetDebugBlock(ANewSize, False); + + if Result <> nil then + begin + {Determine the used user size of the old block and move the lesser of the old and new sizes, and then free the + old block.} + LMoveCount := FastMM_BlockCurrentUserBytes(APointer); + if LMoveCount > ANewSize then + LMoveCount := ANewSize; + System.Move(APointer^, Result^, LMoveCount); + + FastMM_FreeMem(APointer); + end; + end; + +end; + +function FastMM_DebugAllocMem(ASize: NativeInt): Pointer; +begin + if FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation then + FastMM_ScanDebugBlocksForCorruption; + + Result := FastMM_DebugGetMem_GetDebugBlock(ASize, False); + {Large blocks are already zero filled} + if (Result <> nil) + and (ASize <= (CMaximumMediumBlockSize - CMediumBlockHeaderSize - CDebugBlockHeaderSize - CalculateDebugBlockFooterSize(PFastMM_DebugBlockHeader(Result).StackTraceEntryCount))) then + begin + FillChar(Result^, ASize, 0); + end; +end; + +procedure FastMM_NoOpGetStackTrace(APReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); +var + i: Integer; +begin + for i := 1 to AMaxDepth do + begin + APReturnAddresses^ := 0; + Inc(APReturnAddresses); + end; +end; + +function FastMM_NoOpConvertStackTraceToText(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBufferPosition, APBufferEnd: PWideChar): PWideChar; +begin + {Nothing to do.} + Result := APBufferPosition; +end; + +function FastMM_DebugLibrary_LegacyLogStackTrace_Wrapper(APReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; + APBufferPosition, APBufferEnd: PWideChar): PWideChar; +var + LAnsiBuffer: array[0..CFastMM_StackTrace_MaximumEntryCount * 256] of AnsiChar; + LPEnd, LPCurPos: PAnsiChar; +begin + Result := APBufferPosition; + + LPEnd := DebugLibrary_LogStackTrace_Legacy(APReturnAddresses, AMaxDepth, @LAnsiBuffer); + LPCurPos := @LAnsiBuffer; + while (LPCurPos < LPEnd) + and (Result < APBufferEnd) do + begin + Result^ := WideChar(LPCurPos^); //Assume it is Latin-1 text + Inc(Result); + Inc(LPCurPos); + end; +end; + +{--------------------------------------------------------} +{----------------------Diagnostics-----------------------} +{--------------------------------------------------------} + +{Returns the user size of the block, i.e. the number of bytes in use by the application.} +function FastMM_BlockCurrentUserBytes(APointer: Pointer): NativeInt; +var + LBlockHeader: Integer; + LPSmallBlockSpan: PSmallBlockSpanHeader; +begin + {Read the flags from the block header.} + LBlockHeader := PBlockStatusFlags(APointer)[-1]; + {Is it a small block that is in use?} + if LBlockHeader and CIsSmallBlockFlag = CIsSmallBlockFlag then + begin + LPSmallBlockSpan := GetSpanForSmallBlock(APointer); + Result := LPSmallBlockSpan.SmallBlockManager.BlockSize - CSmallBlockHeaderSize; + end + else + begin + if LBlockHeader and CIsMediumBlockFlag = CIsMediumBlockFlag then + begin + Result := GetMediumBlockSize(APointer) - CMediumBlockHeaderSize; + end + else + begin + if LBlockHeader and CIsLargeBlockFlag = CIsLargeBlockFlag then + begin + Result := PLargeBlockHeader(APointer)[-1].UserAllocatedSize; + end + else + begin + if LBlockHeader and CIsDebugBlockFlag = CIsDebugBlockFlag then + begin + Result := PFastMM_DebugBlockHeader(APointer)[-1].UserSize; + end + else + begin + System.Error(reInvalidPtr); + Result := 0; + end; + end; + end; + end; + +end; + +{Returns the available user size of the block, i.e. the block size less any headers and footers.} +function FastMM_BlockMaximumUserBytes(APointer: Pointer): NativeInt; +var + LBlockHeader: Integer; + LPSmallBlockSpan: PSmallBlockSpanHeader; +begin + {Read the flags from the block header.} + LBlockHeader := PBlockStatusFlags(APointer)[-1]; + {Is it a small block?} + if LBlockHeader and CIsSmallBlockFlag = CIsSmallBlockFlag then + begin + LPSmallBlockSpan := GetSpanForSmallBlock(APointer); + + Result := LPSmallBlockSpan.SmallBlockManager.BlockSize - CSmallBlockHeaderSize; + end + else + begin + if LBlockHeader and CIsMediumBlockFlag = CIsMediumBlockFlag then + begin + Result := GetMediumBlockSize(APointer) - CMediumBlockHeaderSize; + end + else + begin + if LBlockHeader and CIsLargeBlockFlag = CIsLargeBlockFlag then + begin + Result := PLargeBlockHeader(APointer)[-1].ActualBlockSize - CLargeBlockHeaderSize; + end + else + begin + if LBlockHeader and CIsDebugBlockFlag = CIsDebugBlockFlag then + begin + Result := PFastMM_DebugBlockHeader(APointer)[-1].UserSize; + end + else + begin + System.Error(reInvalidPtr); + Result := 0; + end; + end; + end; + end; + +end; + +function FastMM_ProcessAllPendingFrees: Boolean; +var + LArenaIndex, LBlockTypeIndex: Integer; + LPSmallBlockManager: PSmallBlockManager; + LPPendingFreeBlock: Pointer; + LPMediumBlockManager: PMediumBlockManager; + LPLargeBlockManager: PLargeBlockManager; +begin + {Assume success, until proven otherwise.} + Result := True; + + {-------Small blocks-------} + for LArenaIndex := 0 to CFastMM_SmallBlockArenaCount - 1 do + begin + LPSmallBlockManager := @SmallBlockManagers[LArenaIndex][0]; + + for LBlockTypeIndex := 0 to CSmallBlockTypeCount - 1 do + begin + + if LPSmallBlockManager.PendingFreeList <> nil then + begin + if AtomicCmpExchange(LPSmallBlockManager.SmallBlockManagerLocked, 1, 0) = 0 then + begin + {Process the pending frees list.} + LPPendingFreeBlock := AtomicExchange(LPSmallBlockManager.PendingFreeList, nil); + if LPPendingFreeBlock <> nil then + FastMM_FreeMem_FreeSmallBlockChain(LPPendingFreeBlock, True) + else + LPSmallBlockManager.SmallBlockManagerLocked := 0; + end + else + begin + {The small block manager has pending frees, but could not be locked.} + Result := False; + end; + end; + + Inc(LPSmallBlockManager); + end; + end; + + {-------Medium blocks-------} + LPMediumBlockManager := @MediumBlockManagers[0]; + for LArenaIndex := 0 to CFastMM_MediumBlockArenaCount - 1 do + begin + + if LPMediumBlockManager.PendingFreeList <> nil then + begin + if AtomicCmpExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1, 0) = 0 then + begin + {Process the pending frees list.} + LPPendingFreeBlock := AtomicExchange(LPMediumBlockManager.PendingFreeList, nil); + if LPPendingFreeBlock <> nil then + FastMM_FreeMem_FreeMediumBlockChain(LPMediumBlockManager, LPPendingFreeBlock, True) + else + LPMediumBlockManager.MediumBlockManagerLocked := 0; + end + else + begin + {The medium block manager has pending frees, but could not be locked.} + Result := False; + end; + end; + + Inc(LPMediumBlockManager); + end; + + {-------Large blocks-------} + LPLargeBlockManager := @LargeBlockManagers[0]; + for LArenaIndex := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + + if LPLargeBlockManager.PendingFreeList <> nil then + begin + if AtomicCmpExchange(LPLargeBlockManager.LargeBlockManagerLocked, 1, 0) = 0 then + begin + if ProcessLargeBlockPendingFrees_ArenaAlreadyLocked(LPLargeBlockManager) <> 0 then + System.Error(reInvalidPtr); + end + else + begin + {The large block manager has pending frees, but could not be locked.} + Result := False; + end; + end; + + Inc(LPLargeBlockManager); + end; + +end; + +{Adjusts the block information for blocks that contain a debug mode sub-block.} +procedure FastMM_WalkBlocks_AdjustForDebugSubBlock(var ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); inline; +begin + if BlockHasDebugInfo(ABlockInfo.BlockAddress) then + begin + ABlockInfo.DebugInformation := ABlockInfo.BlockAddress; + ABlockInfo.UsableSize := ABlockInfo.DebugInformation.UserSize; + Inc(PByte(ABlockInfo.BlockAddress), CDebugBlockHeaderSize); + end + else + ABlockInfo.DebugInformation := nil; +end; + +{Checks for timeout while waiting on a locked resource. Returns False if the timeout has expired.} +function FastMM_WalkBlocks_CheckTimeout(var ALockWaitTimeMilliseconds, APreviousTimestampMilliseconds: Cardinal; + ALockTimeoutMilliseconds: Cardinal): Boolean; +var + LCurrentTimestampMilliseconds: Cardinal; +begin + LCurrentTimestampMilliseconds := OS_GetMillisecondsSinceStartup; + + {On the first pass just record the current timestamp.} + if ALockWaitTimeMilliseconds = 0 then + begin + ALockWaitTimeMilliseconds := 1; + end + else + begin + {Update the total number of milliseconds that have elapsed.} + Inc(ALockWaitTimeMilliseconds, LCurrentTimestampMilliseconds - APreviousTimestampMilliseconds); + end; + + APreviousTimestampMilliseconds := LCurrentTimestampMilliseconds; + + {If the lock timeout has expired, return False.} + Result := ALockWaitTimeMilliseconds <= ALockTimeoutMilliseconds; +end; + +{Walks the block types indicated by the AWalkBlockTypes set, calling ACallBack for each allocated block.} +function FastMM_WalkBlocks(ACallBack: TFastMM_WalkBlocksCallback; AWalkBlockTypes: TFastMM_WalkBlocksBlockTypes; + AWalkUsedBlocksOnly: Boolean; AUserData: Pointer; ALockTimeoutMilliseconds: Cardinal): Boolean; +var + LArenaIndex: Integer; + LLockWaitTimeMilliseconds, LTimestampMilliseconds: Cardinal; + LBlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo; + LPLargeBlockManager: PLargeBlockManager; + LPLargeBlockHeader: PLargeBlockHeader; + LPMediumBlockManager: PMediumBlockManager; + LPMediumBlockSpan: PMediumBlockSpanHeader; + LPMediumBlock: Pointer; + LBlockOffsetFromMediumSpanStart, LMediumBlockSize, LSmallBlockOffset, LLastBlockOffset: Integer; + LPSmallBlockManager: PSmallBlockManager; +begin + {Assume success, i.e. that all arenas will be walked. This will be reset to False if a lock timeout occurs.} + Result := True; + + LTimestampMilliseconds := 0; + + LBlockInfo.UserData := AUserData; + + if AWalkBlockTypes = [] then + AWalkBlockTypes := [Low(TFastMM_WalkAllocatedBlocksBlockType)..High(TFastMM_WalkAllocatedBlocksBlockType)]; + + {Walk the large block managers} + if btLargeBlock in AWalkBlockTypes then + begin + LBlockInfo.BlockType := btLargeBlock; + LBlockInfo.BlockIsFree := False; + + {Clear the fields that are not applicable to large blocks.} + LBlockInfo.IsSequentialFeedMediumBlockSpan := False; + LBlockInfo.MediumBlockSequentialFeedSpanUnusedBytes := 0; + LBlockInfo.SmallBlockSpanBlockSize := 0; + LBlockInfo.IsSequentialFeedSmallBlockSpan := False; + + for LArenaIndex := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + LPLargeBlockManager := @LargeBlockManagers[LArenaIndex]; + + LBlockInfo.ArenaIndex := LArenaIndex; + + LLockWaitTimeMilliseconds := 0; + while (AtomicCmpExchange(LPLargeBlockManager.LargeBlockManagerLocked, 1, 0) <> 0) + and FastMM_WalkBlocks_CheckTimeout(LLockWaitTimeMilliseconds, LTimestampMilliseconds, ALockTimeoutMilliseconds) do + begin + OS_AllowOtherThreadToRun; + end; + + if LLockWaitTimeMilliseconds > ALockTimeoutMilliseconds then + begin + Result := False; + Continue; + end; + + LPLargeBlockHeader := LPLargeBlockManager.FirstLargeBlockHeader; + while NativeUInt(LPLargeBlockHeader) <> NativeUInt(LPLargeBlockManager) do + begin + LBlockInfo.BlockAddress := @PByte(LPLargeBlockHeader)[CLargeBlockHeaderSize]; + LBlockInfo.BlockSize := LPLargeBlockHeader.ActualBlockSize; + LBlockInfo.UsableSize := LPLargeBlockHeader.UserAllocatedSize; + + FastMM_WalkBlocks_AdjustForDebugSubBlock(LBlockInfo); + ACallBack(LBlockInfo); + + LPLargeBlockHeader := LPLargeBlockHeader.NextLargeBlockHeader; + end; + + LPLargeBlockManager.LargeBlockManagerLocked := 0; + end; + + end; + + {Walk the medium block managers} + if AWalkBlockTypes * [btMediumBlockSpan, btMediumBlock, btSmallBlockSpan, btSmallBlock] <> [] then + begin + + for LArenaIndex := 0 to CFastMM_MediumBlockArenaCount - 1 do + begin + LPMediumBlockManager := @MediumBlockManagers[LArenaIndex]; + + LBlockInfo.ArenaIndex := LArenaIndex; + + LLockWaitTimeMilliseconds := 0; + while (AtomicCmpExchange(LPMediumBlockManager.MediumBlockManagerLocked, 1, 0) <> 0) + and FastMM_WalkBlocks_CheckTimeout(LLockWaitTimeMilliseconds, LTimestampMilliseconds, ALockTimeoutMilliseconds) do + begin + OS_AllowOtherThreadToRun; + end; + + if LLockWaitTimeMilliseconds > ALockTimeoutMilliseconds then + begin + Result := False; + Continue; + end; + + LPMediumBlockSpan := LPMediumBlockManager.FirstMediumBlockSpanHeader; + while NativeUInt(LPMediumBlockSpan) <> NativeUInt(LPMediumBlockManager) do + begin + + if LPMediumBlockManager.SequentialFeedMediumBlockSpan = LPMediumBlockSpan then + begin + LBlockOffsetFromMediumSpanStart := LPMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue; + if LBlockOffsetFromMediumSpanStart <= CMediumBlockSpanHeaderSize then + LBlockOffsetFromMediumSpanStart := CMediumBlockSpanHeaderSize; + + {It is possible that a new medium block is in the process of being split off from the sequential feed span by + another thread, in which case the block size may not yet be set properly. In this case we need to wait for + the other thread to complete allocation of the block.} + LPMediumBlock := PByte(LPMediumBlockSpan) + LBlockOffsetFromMediumSpanStart; + LLockWaitTimeMilliseconds := 0; + while (GetMediumBlockSize(LPMediumBlock) = 0) + and FastMM_WalkBlocks_CheckTimeout(LLockWaitTimeMilliseconds, LTimestampMilliseconds, ALockTimeoutMilliseconds) do + begin + OS_AllowOtherThreadToRun; + end; + + {Has the other thread completed the allocation, or is this perhaps a memory pool corruption?} + if GetMediumBlockSize(LPMediumBlock) = 0 then + begin + {If there was a reasonable wait time then raise an error, otherwise skip the entire span since it is not + possible to walk the blocks in the span without knowing the size of the first block.} + if ALockTimeoutMilliseconds >= 1000 then + System.Error(reInvalidPtr) + else + LBlockOffsetFromMediumSpanStart := LPMediumBlockSpan.SpanSize; + end; + + end + else + LBlockOffsetFromMediumSpanStart := CMediumBlockSpanHeaderSize; + + if btMediumBlockSpan in AWalkBlockTypes then + begin + LBlockInfo.BlockAddress := LPMediumBlockSpan; + LBlockInfo.BlockSize := LPMediumBlockSpan.SpanSize; + LBlockInfo.UsableSize := LPMediumBlockSpan.SpanSize - CMediumBlockSpanHeaderSize; + LBlockInfo.BlockType := btMediumBlockSpan; + LBlockInfo.BlockIsFree := False; + LBlockInfo.ArenaIndex := LArenaIndex; + if LBlockOffsetFromMediumSpanStart > CMediumBlockSpanHeaderSize then + begin + LBlockInfo.IsSequentialFeedMediumBlockSpan := True; + LBlockInfo.MediumBlockSequentialFeedSpanUnusedBytes := LBlockOffsetFromMediumSpanStart - CMediumBlockSpanHeaderSize; + end + else + begin + LBlockInfo.IsSequentialFeedMediumBlockSpan := False; + LBlockInfo.MediumBlockSequentialFeedSpanUnusedBytes := 0; + end; + LBlockInfo.SmallBlockSpanBlockSize := 0; + LBlockInfo.IsSequentialFeedSmallBlockSpan := False; + LBlockInfo.DebugInformation := nil; + + ACallBack(LBlockInfo); + end; + + {Walk all the medium blocks in the medium block span.} + if AWalkBlockTypes * [btMediumBlock, btSmallBlockSpan, btSmallBlock] <> [] then + begin + while LBlockOffsetFromMediumSpanStart < LPMediumBlockSpan.SpanSize do + begin + LPMediumBlock := PByte(LPMediumBlockSpan) + LBlockOffsetFromMediumSpanStart; + LMediumBlockSize := GetMediumBlockSize(LPMediumBlock); + + LBlockInfo.BlockIsFree := BlockIsFree(LPMediumBlock); + if (not AWalkUsedBlocksOnly) or (not LBlockInfo.BlockIsFree) then + begin + {Read the pointer to the small block manager in case this is a small block span.} + if (AWalkBlockTypes * [btSmallBlockSpan, btSmallBlock] <> []) + and PMediumBlockHeader(LPMediumBlock)[-1].IsSmallBlockSpan then + begin + LPSmallBlockManager := PSmallBlockSpanHeader(LPMediumBlock).SmallBlockManager; + + LLockWaitTimeMilliseconds := 0; + while (AtomicCmpExchange(LPSmallBlockManager.SmallBlockManagerLocked, 1, 0) <> 0) + and FastMM_WalkBlocks_CheckTimeout(LLockWaitTimeMilliseconds, LTimestampMilliseconds, ALockTimeoutMilliseconds) do + begin + OS_AllowOtherThreadToRun; + end; + + if LLockWaitTimeMilliseconds > ALockTimeoutMilliseconds then + begin + Result := False; + LPSmallBlockManager := nil; + LSmallBlockOffset := 0; + end + else + begin + + {Memory fence required for ARM} + + {The last block may have been released before the manager was locked, so we need to check whether it is + still a small block span.} + if PMediumBlockHeader(LPMediumBlock)[-1].IsSmallBlockSpan then + begin + if LPSmallBlockManager.SequentialFeedSmallBlockSpan = LPMediumBlock then + begin + LSmallBlockOffset := LPSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerValue; + if LSmallBlockOffset < CSmallBlockSpanHeaderSize then + LSmallBlockOffset := CSmallBlockSpanHeaderSize; + end + else + LSmallBlockOffset := CSmallBlockSpanHeaderSize; + end + else + begin + LSmallBlockOffset := 0; + LPSmallBlockManager.SmallBlockManagerLocked := 0; + LPSmallBlockManager := nil; + end; + end; + end + else + begin + LPSmallBlockManager := nil; + LSmallBlockOffset := 0; + end; + + if AWalkBlockTypes * [btMediumBlock, btSmallBlockSpan] <> [] then + begin + LBlockInfo.BlockAddress := LPMediumBlock; + LBlockInfo.BlockSize := LMediumBlockSize; + LBlockInfo.ArenaIndex := LArenaIndex; + LBlockInfo.MediumBlockSequentialFeedSpanUnusedBytes := 0; + + if LPSmallBlockManager <> nil then + begin + if btSmallBlockSpan in AWalkBlockTypes then + begin + LBlockInfo.BlockType := btSmallBlockSpan; + LBlockInfo.UsableSize := LPSmallBlockManager.BlockSize * PSmallBlockSpanHeader(LPMediumBlock).TotalBlocksInSpan; + LBlockInfo.SmallBlockSpanBlockSize := LPSmallBlockManager.BlockSize; + LBlockInfo.IsSequentialFeedSmallBlockSpan := LSmallBlockOffset > CSmallBlockSpanHeaderSize; + if LBlockInfo.IsSequentialFeedSmallBlockSpan then + LBlockInfo.SmallBlockSequentialFeedSpanUnusedBytes := LSmallBlockOffset - CSmallBlockSpanHeaderSize + else + LBlockInfo.SmallBlockSequentialFeedSpanUnusedBytes := 0; + LBlockInfo.DebugInformation := nil; + ACallBack(LBlockInfo); + end; + end + else + begin + if btMediumBlock in AWalkBlockTypes then + begin + LBlockInfo.BlockType := btMediumBlock; + LBlockInfo.UsableSize := LMediumBlockSize - CMediumBlockHeaderSize; + LBlockInfo.SmallBlockSpanBlockSize := 0; + LBlockInfo.IsSequentialFeedSmallBlockSpan := False; + LBlockInfo.SmallBlockSequentialFeedSpanUnusedBytes := 0; + FastMM_WalkBlocks_AdjustForDebugSubBlock(LBlockInfo); + ACallBack(LBlockInfo); + end; + end; + + end; + + {If small blocks need to be walked then LPSmallBlockManager will be <> nil.} + if LPSmallBlockManager <> nil then + begin + + if btSmallBlock in AWalkBlockTypes then + begin + LLastBlockOffset := CSmallBlockSpanHeaderSize + + LPSmallBlockManager.BlockSize * (PSmallBlockSpanHeader(LPMediumBlock).TotalBlocksInSpan - 1); + while LSmallBlockOffset <= LLastBlockOffset do + begin + LBlockInfo.BlockAddress := PByte(LPMediumBlock) + LSmallBlockOffset; + + LBlockInfo.BlockIsFree := BlockIsFree(LBlockInfo.BlockAddress); + if (not AWalkUsedBlocksOnly) or (not LBlockInfo.BlockIsFree) then + begin + LBlockInfo.BlockSize := LPSmallBlockManager.BlockSize; + LBlockInfo.UsableSize := LPSmallBlockManager.BlockSize - CSmallBlockHeaderSize; + LBlockInfo.ArenaIndex := (NativeInt(LPSmallBlockManager) - NativeInt(@SmallBlockManagers)) div SizeOf(TSmallBlockArena); + LBlockInfo.BlockType := btSmallBlock; + LBlockInfo.IsSequentialFeedMediumBlockSpan := False; + LBlockInfo.MediumBlockSequentialFeedSpanUnusedBytes := 0; + LBlockInfo.IsSequentialFeedSmallBlockSpan := False; + LBlockInfo.SmallBlockSpanBlockSize := 0; + LBlockInfo.SmallBlockSequentialFeedSpanUnusedBytes := 0; + + FastMM_WalkBlocks_AdjustForDebugSubBlock(LBlockInfo); + ACallBack(LBlockInfo); + end; + + Inc(LSmallBlockOffset, LPSmallBlockManager.BlockSize); + end; + end; + + LPSmallBlockManager.SmallBlockManagerLocked := 0; + end; + + end; + + Inc(LBlockOffsetFromMediumSpanStart, LMediumBlockSize); + end; + end; + + LPMediumBlockSpan := LPMediumBlockSpan.NextMediumBlockSpanHeader; + end; + + LPMediumBlockManager.MediumBlockManagerLocked := 0; + end; + + end; + +end; + +procedure FastMM_ScanDebugBlocksForCorruption_CallBack(const ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); +begin + {If it is not a debug mode block then there's nothing to check.} + if ABlockInfo.DebugInformation = nil then + Exit; + + {Check the block header and footer for corruption} + if not CheckDebugBlockHeaderAndFooterCheckSumsValid(ABlockInfo.DebugInformation) then + System.Error(reInvalidPtr); + + {If it is a free block, check whether it has been modified after being freed.} + if ABlockInfo.BlockIsFree and (not CheckDebugBlockFillPatternIntact(ABlockInfo.DebugInformation)) then + System.Error(reInvalidPtr); +end; + +function FastMM_ScanDebugBlocksForCorruption: Boolean; +begin + FastMM_WalkBlocks(FastMM_ScanDebugBlocksForCorruption_CallBack, [btLargeBlock, btMediumBlock, btSmallBlock], False); + + Result := True; +end; + +procedure FastMM_GetHeapStatus_CallBack(const ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); +var + LPHeapStatus: ^THeapStatus; +begin + LPHeapStatus := ABlockInfo.UserData; + + case ABlockInfo.BlockType of + + btLargeBlock: + begin + Inc(LPHeapStatus.TotalCommitted, ABlockInfo.BlockSize); + Inc(LPHeapStatus.TotalAllocated, ABlockInfo.UsableSize); + end; + + btMediumBlockSpan: + begin + Inc(LPHeapStatus.TotalCommitted, ABlockInfo.BlockSize); + if ABlockInfo.IsSequentialFeedMediumBlockSpan then + Inc(LPHeapStatus.Unused, ABlockInfo.MediumBlockSequentialFeedSpanUnusedBytes); + end; + + btMediumBlock: + begin + if ABlockInfo.BlockIsFree then + Inc(LPHeapStatus.FreeBig, ABlockInfo.UsableSize) + else + Inc(LPHeapStatus.TotalAllocated, ABlockInfo.UsableSize); + end; + + btSmallBlockSpan: + begin + if ABlockInfo.IsSequentialFeedSmallBlockSpan then + Inc(LPHeapStatus.Unused, ABlockInfo.SmallBlockSequentialFeedSpanUnusedBytes); + end; + + btSmallBlock: + begin + if ABlockInfo.BlockIsFree then + Inc(LPHeapStatus.FreeSmall, ABlockInfo.UsableSize) + else + Inc(LPHeapStatus.TotalAllocated, ABlockInfo.UsableSize); + end; + + end; +end; + +{Returns the number of bytes of address space that is currently either committed or reserved by FastMM.} +function FastMM_GetCurrentMemoryUsage: NativeUInt; +begin + Result := MemoryUsageCurrent; +end; + +{Returns a THeapStatus structure with information about the current memory usage.} +function FastMM_GetHeapStatus: THeapStatus; +begin + Result := Default(THeapStatus); + + FastMM_WalkBlocks(FastMM_GetHeapStatus_CallBack, + [btLargeBlock, btMediumBlockSpan, btMediumBlock, btSmallBlockSpan, btSmallBlock], False, @Result); + + Result.TotalFree := Result.FreeSmall + Result.FreeBig + Result.Unused; + Result.TotalAddrSpace := Result.TotalCommitted; + Result.Overhead := Result.TotalAddrSpace - Result.TotalAllocated - Result.TotalFree; +end; + +function FastMM_GetUsageSummary: TFastMM_UsageSummary; +var + LHeapStatus: THeapStatus; +begin + LHeapStatus := FastMM_GetHeapStatus; + + Result.AllocatedBytes := LHeapStatus.TotalAllocated; + Result.OverheadBytes := LHeapStatus.TotalAddrSpace - LHeapStatus.TotalAllocated; + + if LHeapStatus.TotalAddrSpace > 0 then + Result.EfficiencyPercentage := Result.AllocatedBytes / LHeapStatus.TotalAddrSpace * 100 + else + Result.EfficiencyPercentage := 100; +end; + +{Returns True if there are live pointers using this memory manager.} +function FastMM_HasLivePointers: Boolean; +var + i: Integer; + LPMediumBlockManager: PMediumBlockManager; + LPLargeBlockManager: PLargeBlockManager; +begin + for i := 0 to CFastMM_MediumBlockArenaCount - 1 do + begin + LPMediumBlockManager := @MediumBlockManagers[i]; + if NativeUInt(LPMediumBlockManager.FirstMediumBlockSpanHeader) <> NativeUInt(LPMediumBlockManager) then + Exit(True); + end; + + for i := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + LPLargeBlockManager := @LargeBlockManagers[i]; + if NativeUInt(LPLargeBlockManager.FirstLargeBlockHeader) <> NativeUInt(LPLargeBlockManager) then + Exit(True); + end; + + Result := False; +end; + +{Returns True if external code has changed the installed memory manager.} +function FastMM_InstalledMemoryManagerChangedExternally: Boolean; +var + LCurrentMemoryManager: TMemoryManagerEx; +begin + GetMemoryManager(LCurrentMemoryManager); + Result := (@LCurrentMemoryManager.GetMem <> @InstalledMemoryManager.GetMem) + or (@LCurrentMemoryManager.FreeMem <> @InstalledMemoryManager.FreeMem) + or (@LCurrentMemoryManager.ReallocMem <> @InstalledMemoryManager.ReallocMem) + or (@LCurrentMemoryManager.AllocMem <> @InstalledMemoryManager.AllocMem) + or (@LCurrentMemoryManager.RegisterExpectedMemoryLeak <> @InstalledMemoryManager.RegisterExpectedMemoryLeak) + or (@LCurrentMemoryManager.UnregisterExpectedMemoryLeak <> @InstalledMemoryManager.UnregisterExpectedMemoryLeak); +end; + + +{--------------------------------------------------------} +{----------FastMM_LogStateToFile Implementation----------} +{--------------------------------------------------------} + +const + CMaxMemoryLogNodes = 100000; + CQuickSortMinimumItemsInPartition = 8; + +type + {While scanning the memory pool the list of classes is built up in a binary search tree.} + PMemoryLogNode = ^TMemoryLogNode; + TMemoryLogNode = record + {The left and right child nodes} + LeftAndRightNodePointers: array[Boolean] of PMemoryLogNode; + {A class reference or a string type enum.} + BlockContentType: NativeUInt; + {The number of instances of the class} + InstanceCount: NativeUInt; + {The total memory usage for this class} + TotalMemoryUsage: NativeUInt; + end; + TMemoryLogNodes = array[0..CMaxMemoryLogNodes - 1] of TMemoryLogNode; + PMemoryLogNodes = ^TMemoryLogNodes; + + TMemoryLogInfo = record + {The number of nodes in "Nodes" that are used.} + NodeCount: Integer; + {The root node of the binary search tree. The content of this node is not actually used, it just simplifies the + binary search code.} + RootNode: TMemoryLogNode; + Nodes: TMemoryLogNodes; + end; + PMemoryLogInfo = ^TMemoryLogInfo; + +procedure FastMM_LogStateToFile_Callback(const ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); +var + LBlockContentType, LBlockContentTypeHashBits: NativeUInt; + LPLogInfo: PMemoryLogInfo; + LPParentNode, LPClassNode: PMemoryLogNode; + LChildNodeDirection: Boolean; +begin + LPLogInfo := ABlockInfo.UserData; + + {Detecting an object is very expensive (due to the VirtualQuery call), so we do some basic checks and try to find the + "class" in the tree first.} + LBlockContentType := PNativeUInt(ABlockInfo.BlockAddress)^; + if (LBlockContentType > 65535) + and (LBlockContentType and (SizeOf(Pointer) - 1) = 0) then + begin + LPParentNode := @LPLogInfo.RootNode; + LBlockContentTypeHashBits := LBlockContentType; + repeat + LChildNodeDirection := Boolean(LBlockContentTypeHashBits and 1); + {Split off the next bit of the class pointer and traverse in the appropriate direction.} + LPClassNode := LPParentNode.LeftAndRightNodePointers[LChildNodeDirection]; + if (LPClassNode = nil) or (LPClassNode.BlockContentType = LBlockContentType) then + Break; + {The node was not found: Keep on traversing the tree.} + LBlockContentTypeHashBits := LBlockContentTypeHashBits shr 1; + LPParentNode := LPClassNode; + until False; + end + else + LPClassNode := nil; + + {Was the "class" found?} + if LPClassNode = nil then + begin + {The "class" is not yet in the tree: Determine if it is actually a class.} + LBlockContentType := DetectBlockContentType(ABlockInfo.BlockAddress, ABlockInfo.UsableSize); + {Is this class already in the tree?} + LPParentNode := @LPLogInfo.RootNode; + LBlockContentTypeHashBits := LBlockContentType; + repeat + LChildNodeDirection := Boolean(LBlockContentTypeHashBits and 1); + {Split off the next bit of the class pointer and traverse in the appropriate direction.} + LPClassNode := LPParentNode.LeftAndRightNodePointers[LChildNodeDirection]; + if LPClassNode = nil then + begin + {The end of the tree was reached: Add a new child node (if possible)} + if LPLogInfo.NodeCount = CMaxMemoryLogNodes then + Exit; + LPClassNode := @LPLogInfo.Nodes[LPLogInfo.NodeCount]; + Inc(LPLogInfo.NodeCount); + LPParentNode.LeftAndRightNodePointers[LChildNodeDirection] := LPClassNode; + LPClassNode.BlockContentType := LBlockContentType; + Break; + end + else + begin + if LPClassNode.BlockContentType = LBlockContentType then + Break; + end; + {The node was not found: Keep on traversing the tree.} + LBlockContentTypeHashBits := LBlockContentTypeHashBits shr 1; + LPParentNode := LPClassNode; + until False; + end; + + {Update the statistics for the class} + Inc(LPClassNode.InstanceCount); + Inc(LPClassNode.TotalMemoryUsage, ABlockInfo.UsableSize); +end; + +{FastMM_LogStateToFile subroutine: A median-of-3 quicksort routine for sorting a TMemoryLogNodes array.} +procedure FastMM_LogStateToFile_QuickSortLogNodes(APLeftItem: PMemoryLogNodes; ARightIndex: Integer); +var + M, I, J: Integer; + LPivot, LTempItem: TMemoryLogNode; +begin + while True do + begin + {Order the left, middle and right items in descending order} + M := ARightIndex shr 1; + if APLeftItem[0].TotalMemoryUsage < APLeftItem[M].TotalMemoryUsage then + begin + LTempItem := APLeftItem[0]; + APLeftItem[0] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + end; + if APLeftItem[M].TotalMemoryUsage < APLeftItem[ARightIndex].TotalMemoryUsage then + begin + LTempItem := APLeftItem[ARightIndex]; + APLeftItem[ARightIndex] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + if APLeftItem[0].TotalMemoryUsage < APLeftItem[M].TotalMemoryUsage then + begin + LTempItem := APLeftItem[0]; + APLeftItem[0] := APLeftItem[M]; + APLeftItem[M] := LTempItem; + end; + end; + + {Move the pivot item out of the way by swapping M with R - 1} + LPivot := APLeftItem[M]; + APLeftItem[M] := APLeftItem[ARightIndex - 1]; + APLeftItem[ARightIndex - 1] := LPivot; + + {Set up the loop counters} + I := 0; + J := ARightIndex - 1; + while true do + begin + {Find the first item from the left that is not greater than the pivot} + repeat + Inc(I); + until APLeftItem[I].TotalMemoryUsage <= LPivot.TotalMemoryUsage; + {Find the first item from the right that is not less than the pivot} + repeat + Dec(J); + until APLeftItem[J].TotalMemoryUsage >= LPivot.TotalMemoryUsage; + {Stop the loop when the two indexes cross} + if J < I then + Break; + {Swap item I and J} + LTempItem := APLeftItem[I]; + APLeftItem[I] := APLeftItem[J]; + APLeftItem[J] := LTempItem; + end; + + {Put the pivot item back in the correct position by swapping I with R - 1} + APLeftItem[ARightIndex - 1] := APLeftItem[I]; + APLeftItem[I] := LPivot; + + {Sort the left-hand partition} + if J >= (CQuickSortMinimumItemsInPartition - 1) then + FastMM_LogStateToFile_QuickSortLogNodes(APLeftItem, J); + + {Sort the right-hand partition} + APLeftItem := @APLeftItem[I + 1]; + ARightIndex := ARightIndex - I - 1; + if ARightIndex < (CQuickSortMinimumItemsInPartition - 1) then + Break; + end; +end; + +{FastMM_LogStateToFile subroutine: An InsertionSort routine for sorting a TMemoryLogNodes array.} +procedure FastMM_LogStateToFile_InsertionSortLogNodes(APLeftItem: PMemoryLogNodes; ARightIndex: Integer); +var + I, J: Integer; + LCurNode: TMemoryLogNode; +begin + for I := 1 to ARightIndex do + begin + LCurNode := APLeftItem[I]; + {Scan backwards to find the best insertion spot} + J := I; + while (J > 0) and (APLeftItem[J - 1].TotalMemoryUsage < LCurNode.TotalMemoryUsage) do + begin + APLeftItem[J] := APLeftItem[J - 1]; + Dec(J); + end; + APLeftItem[J] := LCurNode; + end; +end; + +{Writes a log file containing a summary of the memory mananger state and a summary of allocated blocks grouped by class. +The file will be saved in the encoding specified by FastMM_TextFileEncoding.} +function FastMM_LogStateToFile(const AFilename: string; const AAdditionalDetails: string; + ALockTimeoutMilliseconds: Cardinal): Boolean; +const + CStateLogMaxChars = 1024 * 1024; + CRLF: PWideChar = #13#10; +var + LMemoryManagerUsageSummary: TFastMM_UsageSummary; + LBufferSize: Integer; + LPLogInfo: PMemoryLogInfo; + LPTokenBufferStart, LPStateLogBufferStart, LPBufferEnd, LPTokenPos, LPStateLogPos: PWideChar; + LTokenValues: TEventLogTokenValues; + LInd: Integer; + LPNode: PMemoryLogNode; + LFileHandle: THandle; +begin + {Get the current memory manager usage summary.} + LMemoryManagerUsageSummary := FastMM_GetUsageSummary; + + {Allocate the memory required to store the token buffer, log text, as well as the detailed allocation information.} + LBufferSize := SizeOf(TMemoryLogInfo) + (CTokenBufferMaxWideChars + CStateLogMaxChars) * SizeOf(Char); + LPLogInfo := OS_AllocateVirtualMemory(LBufferSize, False, False); + if LPLogInfo <> nil then + begin + try + {Obtain the list of classes, together with the total memory usage and block count for each.} + FastMM_WalkBlocks(FastMM_LogStateToFile_Callback, [btLargeBlock, btMediumBlock, btSmallBlock], True, LPLogInfo, + ALockTimeoutMilliseconds); + + {Sort the classes in descending total memory usage order: Do the initial QuickSort pass over the list to sort the + list in groups of QuickSortMinimumItemsInPartition size, and then do the final InsertionSort pass.} + if LPLogInfo.NodeCount >= CQuickSortMinimumItemsInPartition then + FastMM_LogStateToFile_QuickSortLogNodes(@LPLogInfo.Nodes[0], LPLogInfo.NodeCount - 1); + FastMM_LogStateToFile_InsertionSortLogNodes(@LPLogInfo.Nodes[0], LPLogInfo.NodeCount - 1); + + LPTokenBufferStart := @LPLogInfo.Nodes[LPLogInfo.NodeCount]; + LPStateLogBufferStart := @LPTokenBufferStart[CTokenBufferMaxWideChars]; + LPBufferEnd := @PByte(LPLogInfo)[LBufferSize]; + + {Add the header with the usage summary.} + LTokenValues := Default(TEventLogTokenValues); + LPTokenPos := AddTokenValues_GeneralTokens(LTokenValues, LPTokenBufferStart, LPStateLogBufferStart); + LPTokenPos := AddTokenValue_NativeUInt(LTokenValues, CStateLogTokenAllocatedKB, + LMemoryManagerUsageSummary.AllocatedBytes div 1024, LPTokenPos, LPStateLogBufferStart); + LPTokenPos := AddTokenValue_NativeUInt(LTokenValues, CStateLogTokenOverheadKB, + LMemoryManagerUsageSummary.OverheadBytes div 1024, LPTokenPos, LPStateLogBufferStart); + AddTokenValue_NativeInt(LTokenValues, CStateLogTokenEfficiencyPercentage, + Round(LMemoryManagerUsageSummary.EfficiencyPercentage), LPTokenPos, LPStateLogBufferStart); + LPStateLogPos := SubstituteTokenValues(FastMM_LogStateToFileTemplate, LTokenValues, LPStateLogBufferStart, + LPBufferEnd); + + {Add the usage information for each class} + LTokenValues := Default(TEventLogTokenValues); + for LInd := 0 to LPLogInfo.NodeCount - 1 do + begin + LPNode := @LPLogInfo.Nodes[LInd]; + + LPTokenPos := AddTokenValue_NativeUInt(LTokenValues, CStateLogTokenClassTotalBytesUsed, + LPNode.TotalMemoryUsage, LPTokenBufferStart, LPStateLogBufferStart); + LPTokenPos := AddTokenValue_NativeUInt(LTokenValues, CStateLogTokenClassInstanceCount, + LPNode.InstanceCount, LPTokenPos, LPStateLogBufferStart); + LPTokenPos := AddTokenValue_NativeUInt(LTokenValues, CStateLogTokenClassAverageBytesPerInstance, + Round(LPNode.TotalMemoryUsage / LPNode.InstanceCount), LPTokenPos, LPStateLogBufferStart); + AddTokenValue_BlockContentType(LTokenValues, CEventLogTokenObjectClass, LPNode.BlockContentType, LPTokenPos, + LPStateLogBufferStart); + LPStateLogPos := SubstituteTokenValues(FastMM_LogStateToFileTemplate_UsageDetail, LTokenValues, LPStateLogPos, + LPBufferEnd); + end; + + {Append the additional information} + if AAdditionalDetails <> '' then + begin + LPStateLogPos := AppendTextToBuffer(CRLF, 2, LPStateLogPos, LPBufferEnd); + LPStateLogPos := AppendTextToBuffer(PWideChar(AAdditionalDetails), Length(AAdditionalDetails), LPStateLogPos, + LPBufferEnd); + end; + + {Delete the old file and write the new one.} + OS_DeleteFile(PWideChar(AFilename)); + if OpenOrCreateTextFile(PWideChar(AFilename), True, LFileHandle) then + begin + Result := AppendTextFile(LFileHandle, LPStateLogBufferStart, CharCount(LPStateLogPos, LPStateLogBufferStart)); + OS_CloseFile(LFileHandle); + end + else + Result := False; + + finally + OS_FreeVirtualMemory(LPLogInfo, LBufferSize); + end; + end + else + Result := False; +end; + +{--------------------------------------------------------} +{----------------Memory Manager Sharing------------------} +{--------------------------------------------------------} + +{Generates a string identifying the process} +procedure FastMM_BuildFileMappingObjectName; +var + i, LProcessID: Cardinal; +begin + LProcessID := GetCurrentProcessId; + for i := 0 to 7 do + begin + SharingFileMappingObjectName[(High(SharingFileMappingObjectName) - 1) - i] := + AnsiChar(CHexDigits[((LProcessID shr (i * 4)) and $F)]); + end; +end; + +{Searches the current process for a shared memory manager} +function FastMM_FindSharedMemoryManager: PMemoryManagerEx; +var + LPMapAddress: Pointer; + LLocalMappingObjectHandle: NativeUInt; +begin + {Try to open the shared memory manager file mapping} + LLocalMappingObjectHandle := OpenFileMappingA(FILE_MAP_READ, False, SharingFileMappingObjectName); + {Is a memory manager in this process sharing its memory manager?} + if LLocalMappingObjectHandle = 0 then + begin + {There is no shared memory manager in the process.} + Result := nil; + end + else + begin + {Map a view of the shared memory and get the address of the shared memory manager} + LPMapAddress := MapViewOfFile(LLocalMappingObjectHandle, FILE_MAP_READ, 0, 0, 0); + Result := PPointer(LPMapAddress)^; + UnmapViewOfFile(LPMapAddress); + CloseHandle(LLocalMappingObjectHandle); + end; +end; + +{Searches the current process for a shared memory manager. If no memory has been allocated using this memory manager +it will switch to using the shared memory manager instead. Returns True if another memory manager was found and it +could be shared. If this memory manager instance *is* the shared memory manager, it will do nothing and return True.} +function FastMM_AttemptToUseSharedMemoryManager: Boolean; +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPMemoryManagerEx: PMemoryManagerEx; +begin + if CurrentInstallationState = mmisInstalled then + begin + {Is this MM being shared? If so, switching to another MM is not allowed} + if SharingFileMappingObjectHandle = 0 then + begin + {May not switch memory manager after memory has been allocated} + if not FastMM_HasLivePointers then + begin + LPMemoryManagerEx := FastMM_FindSharedMemoryManager; + if LPMemoryManagerEx <> nil then + begin + + InstalledMemoryManager := LPMemoryManagerEx^; + SetMemoryManager(InstalledMemoryManager); + CurrentInstallationState := mmisUsingSharedMemoryManager; + + {Free the address space slack, since it will not be needed.} + ReleaseEmergencyReserveAddressSpace; + + Result := True; + end + else + Result := False; + end + else + begin + {Memory has already been allocated using this memory manager. We cannot rip the memory manager out from under + live pointers.} + + LTokenValues := Default(TEventLogTokenValues); + AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, @LTokenValueBuffer[High(LTokenValueBuffer)]); + LogEvent(mmetCannotSwitchToSharedMemoryManagerWithLivePointers, LTokenValues); + + Result := False; + end; + end + else + begin + {This memory manager is being shared, and an attempt is being made by the application to use the shared memory + manager (which is this one): Don't do anything and return success. (This situation can occur when using + SimpleShareMem in a DLL together with runtime packages.)} + Result := True; + end; + end + else + begin + {Another memory manager has already been installed.} + Result := False; + end; +end; + +{Starts sharing this memory manager with other modules in the current process. Only one memory manager may be shared +per process, so this function may fail.} +function FastMM_ShareMemoryManager: Boolean; +var + LPMapAddress: Pointer; +begin + if (CurrentInstallationState = mmisInstalled) + and (not FastMM_InstalledMemoryManagerChangedExternally) + and (SharingFileMappingObjectHandle = 0) then + begin + {Is any other module already sharing its MM?} + if FastMM_FindSharedMemoryManager = nil then + begin + {Create the memory mapped file} + SharingFileMappingObjectHandle := CreateFileMappingA(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, + SizeOf(Pointer), SharingFileMappingObjectName); + {Map a view of the memory} + LPMapAddress := MapViewOfFile(SharingFileMappingObjectHandle, FILE_MAP_WRITE, 0, 0, 0); + {Set a pointer to the new memory manager} + PPointer(LPMapAddress)^ := @InstalledMemoryManager; + {Unmap the file} + UnmapViewOfFile(LPMapAddress); + {Sharing this MM} + Result := True; + end + else + begin + {Another module is already sharing its memory manager} + Result := False; + end; + end + else + begin + {Either another memory manager has been set or this memory manager is already being shared} + Result := False; + end; +end; + + +{--------------------------------------------------} +{-------------Memory leak registration----------------} +{--------------------------------------------------} + +{Adds a leak to the specified list} +function UpdateExpectedLeakList(APLeakList: PPExpectedMemoryLeak; APNewEntry: PExpectedMemoryLeak; + AExactSizeMatch: Boolean = True): Boolean; +var + LPInsertAfter, LPNewEntry: PExpectedMemoryLeak; +begin + {Default to error} + Result := False; + + {Find the insertion spot} + LPInsertAfter := APLeakList^; + while LPInsertAfter <> nil do + begin + {Too big?} + if LPInsertAfter.LeakSize > APNewEntry.LeakSize then + begin + LPInsertAfter := LPInsertAfter.PreviousLeak; + Break; + end; + {Find a matching entry. If an exact size match is not required and the leak is larger than the current entry, use + it if the expected size of the next entry is too large.} + if (LPInsertAfter.LeakAddress = APNewEntry.LeakAddress) + and ((LPInsertAfter.LeakedClass = APNewEntry.LeakedClass)) + and ((LPInsertAfter.LeakSize = APNewEntry.LeakSize) + or ((not AExactSizeMatch) + and (LPInsertAfter.LeakSize < APNewEntry.LeakSize) + and ((LPInsertAfter.NextLeak = nil) + or (LPInsertAfter.NextLeak.LeakSize > APNewEntry.LeakSize)) + )) then + begin + if (LPInsertAfter.LeakCount + APNewEntry.LeakCount) >= 0 then + begin + Inc(LPInsertAfter.LeakCount, APNewEntry.LeakCount); + {Is the count now 0?} + if LPInsertAfter.LeakCount = 0 then + begin + {Delete the entry} + if LPInsertAfter.NextLeak <> nil then + LPInsertAfter.NextLeak.PreviousLeak := LPInsertAfter.PreviousLeak; + if LPInsertAfter.PreviousLeak <> nil then + LPInsertAfter.PreviousLeak.NextLeak := LPInsertAfter.NextLeak + else + APLeakList^ := LPInsertAfter.NextLeak; + {Insert it as the first free slot} + LPInsertAfter.NextLeak := ExpectedMemoryLeaks.FirstFreeSlot; + ExpectedMemoryLeaks.FirstFreeSlot := LPInsertAfter; + end; + Result := True; + end; + Exit; + end; + {Next entry} + if LPInsertAfter.NextLeak <> nil then + LPInsertAfter := LPInsertAfter.NextLeak + else + Break; + end; + if APNewEntry.LeakCount > 0 then + begin + {Get a position for the entry} + LPNewEntry := ExpectedMemoryLeaks.FirstFreeSlot; + if LPNewEntry <> nil then + begin + ExpectedMemoryLeaks.FirstFreeSlot := LPNewEntry.NextLeak; + end + else + begin + if ExpectedMemoryLeaks.EntriesUsed < Length(ExpectedMemoryLeaks.ExpectedLeaks) then + begin + LPNewEntry := @ExpectedMemoryLeaks.ExpectedLeaks[ExpectedMemoryLeaks.EntriesUsed]; + Inc(ExpectedMemoryLeaks.EntriesUsed); + end + else + begin + {No more space} + Exit; + end; + end; + {Set the entry} + LPNewEntry^ := APNewEntry^; + {Insert it into the list} + LPNewEntry.PreviousLeak := LPInsertAfter; + if LPInsertAfter <> nil then + begin + LPNewEntry.NextLeak := LPInsertAfter.NextLeak; + if LPNewEntry.NextLeak <> nil then + LPNewEntry.NextLeak.PreviousLeak := LPNewEntry; + LPInsertAfter.NextLeak := LPNewEntry; + end + else + begin + LPNewEntry.NextLeak := APLeakList^; + if LPNewEntry.NextLeak <> nil then + LPNewEntry.NextLeak.PreviousLeak := LPNewEntry; + APLeakList^ := LPNewEntry; + end; + Result := True; + end; +end; + +{Locks the expected leaks. Returns False if the list could not be allocated.} +function LockExpectedMemoryLeaksList: Boolean; +begin + {Lock the expected leaks list} + while AtomicCmpExchange(ExpectedMemoryLeaksListLocked, 1, 0) <> 0 do + OS_AllowOtherThreadToRun; + + {Allocate the list if it does not exist} + if ExpectedMemoryLeaks = nil then + ExpectedMemoryLeaks := OS_AllocateVirtualMemory(CExpectedMemoryLeaksListSize, False, False); + + Result := ExpectedMemoryLeaks <> nil; +end; + +{Registers expected memory leaks. Returns True on success. The list of leaked blocks is limited, so failure is +possible if the list is full.} +function FastMM_RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := ALeakedPointer; + LNewEntry.LeakedClass := nil; + LNewEntry.LeakSize := 0; + LNewEntry.LeakCount := 1; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LNewEntry); + ExpectedMemoryLeaksListLocked := 0; +end; + +function FastMM_RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := nil; + LNewEntry.LeakedClass := ALeakedObjectClass; + LNewEntry.LeakSize := ALeakedObjectClass.InstanceSize; + LNewEntry.LeakCount := ACount; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByClass, @LNewEntry); + ExpectedMemoryLeaksListLocked := 0; +end; + +function FastMM_RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := nil; + LNewEntry.LeakedClass := nil; + LNewEntry.LeakSize := ALeakedBlockSize; + LNewEntry.LeakCount := ACount; + {Add it to the correct list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryBySizeOnly, @LNewEntry); + ExpectedMemoryLeaksListLocked := 0; +end; + +function FastMM_UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload; +var + LNewEntry: TExpectedMemoryLeak; +begin + {Fill out the structure} + LNewEntry.LeakAddress := ALeakedPointer; + LNewEntry.LeakedClass := nil; + LNewEntry.LeakSize := 0; + LNewEntry.LeakCount := -1; + {Remove it from the list} + Result := LockExpectedMemoryLeaksList + and UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LNewEntry); + ExpectedMemoryLeaksListLocked := 0; +end; + +function FastMM_UnregisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload; +begin + Result := FastMM_RegisterExpectedMemoryLeak(ALeakedObjectClass, -ACount); +end; + +function FastMM_UnregisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload; +begin + Result := FastMM_RegisterExpectedMemoryLeak(ALeakedBlockSize, -ACount); +end; + +{Returns a list of all expected memory leaks} +function FastMM_GetRegisteredMemoryLeaks: TFastMM_RegisteredMemoryLeaks; + + procedure AddEntries(AEntry: PExpectedMemoryLeak); + var + LInd: Integer; + begin + while AEntry <> nil do + begin + LInd := Length(Result); + SetLength(Result, LInd + 1); + {Add the entry} + Result[LInd].LeakAddress := AEntry.LeakAddress; + Result[LInd].LeakedClass := AEntry.LeakedClass; + Result[LInd].LeakSize := AEntry.LeakSize; + Result[LInd].LeakCount := AEntry.LeakCount; + {Next entry} + AEntry := AEntry.NextLeak; + end; + end; + +begin + SetLength(Result, 0); + if (ExpectedMemoryLeaks <> nil) and LockExpectedMemoryLeaksList then + begin + {Add all entries} + AddEntries(ExpectedMemoryLeaks.FirstEntryByAddress); + AddEntries(ExpectedMemoryLeaks.FirstEntryByClass); + AddEntries(ExpectedMemoryLeaks.FirstEntryBySizeOnly); + {Unlock the list} + ExpectedMemoryLeaksListLocked := 0; + end; +end; + + +{--------------------------------------------------} +{-------------Memory leak reporting----------------} +{--------------------------------------------------} + +{Tries to account for a memory leak. If the block is an expected leak then it is removed from the list of leaks and +the leak type is returned.} +function FastMM_PerformMemoryLeakCheck_DetectLeakType(AAddress: Pointer; ASpaceInsideBlock: NativeUInt): TMemoryLeakType; +var + LLeak: TExpectedMemoryLeak; +begin + Result := mltUnexpectedLeak; + + if ExpectedMemoryLeaks <> nil then + begin + {Check by pointer address} + LLeak.LeakAddress := AAddress; + LLeak.LeakedClass := nil; + LLeak.LeakSize := 0; + LLeak.LeakCount := -1; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByAddress, @LLeak, False) then + begin + Result := mltExpectedLeakRegisteredByPointer; + Exit; + end; + + {Check by class} + LLeak.LeakAddress := nil; + LLeak.LeakedClass := TClass(PNativeUInt(AAddress)^); + LLeak.LeakSize := ASpaceInsideBlock; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryByClass, @LLeak, False) then + begin + Result := mltExpectedLeakRegisteredByClass; + Exit; + end; + + {Check by size: The block must be large enough to hold the leak} + LLeak.LeakedClass := nil; + if UpdateExpectedLeakList(@ExpectedMemoryLeaks.FirstEntryBySizeOnly, @LLeak, False) then + Result := mltExpectedLeakRegisteredBySize; + end; +end; + +procedure FastMM_PerformMemoryLeakCheck_AddBlockToLeakSummary(APLeakSummary: PMemoryLeakSummary; + ABlockUsableSize: NativeInt; ABlockContentType: NativeUInt); +var + LPSummaryEntry: PMemoryLeakSummaryEntry; + LChildDirection: Boolean; + i: Integer; +begin + {If there's no space to add another entry then we need to abort in order to avoid a potential buffer overrun.} + if APLeakSummary.LeakCount >= Length(APLeakSummary.MemoryLeakEntries) then + Exit; + + {Try to find the block type in the list.} + i := 0; + if APLeakSummary.LeakCount > 0 then + begin + {$if CompilerVersion < 31} + LChildDirection := False; //Workaround for spurious warning with older compilers + {$endif} + while True do + begin + LPSummaryEntry := @APLeakSummary.MemoryLeakEntries[i]; + + if ABlockUsableSize <> LPSummaryEntry.BlockUsableSize then + begin + LChildDirection := ABlockUsableSize > LPSummaryEntry.BlockUsableSize; + end + else if ABlockContentType <> LPSummaryEntry.BlockContentType then + begin + LChildDirection := ABlockContentType > LPSummaryEntry.BlockContentType; + end + else + begin + {Found the leak type: Bump the count.} + Inc(LPSummaryEntry.NumLeaks); + Exit; + end; + + {Navigate in the correct direction, stopping if the end of the tree has been reached.} + i := LPSummaryEntry.ChildIndexes[LChildDirection]; + if i = 0 then + begin + LPSummaryEntry.ChildIndexes[LChildDirection] := APLeakSummary.LeakCount; + Break; + end; + end; + end; + + {Need to add the block type.} + LPSummaryEntry := @APLeakSummary.MemoryLeakEntries[APLeakSummary.LeakCount]; + LPSummaryEntry.BlockUsableSize := ABlockUsableSize; + LPSummaryEntry.BlockContentType := ABlockContentType; + LPSummaryEntry.NumLeaks := 1; + LPSummaryEntry.ChildIndexes[False] := 0; + LPSummaryEntry.ChildIndexes[True] := 0; + + Inc(APLeakSummary.LeakCount); +end; + +procedure FastMM_PerformMemoryLeakCheck_CallBack(const ABlockInfo: TFastMM_WalkAllocatedBlocks_BlockInfo); +var + LPLeakSummary: PMemoryLeakSummary; + LBlockContentType: NativeUInt; + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; + LPBufferPos, LPBufferEnd: PWideChar; +begin + LPLeakSummary := ABlockInfo.UserData; + + {Is this an expected memory leak? If so, ignore it.} + if FastMM_PerformMemoryLeakCheck_DetectLeakType(ABlockInfo.BlockAddress, ABlockInfo.UsableSize) <> mltUnexpectedLeak then + Exit; + + {If individual leaks must be reported, report the leak now.} + if mmetUnexpectedMemoryLeakDetail in (FastMM_OutputDebugStringEvents + FastMM_LogToFileEvents + FastMM_MessageBoxEvents) then + begin + LTokenValues := Default(TEventLogTokenValues); + + LPBufferEnd := @LTokenValueBuffer[High(LTokenValueBuffer)]; + LPBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, LPBufferEnd); + AddTokenValues_BlockTokens(LTokenValues, ABlockInfo.BlockAddress, LPBufferPos, LPBufferEnd); + + {If leak detail is logged to file, then open the log file once and close it after all leaks have been logged.} + if mmetUnexpectedMemoryLeakDetail in FastMM_LogToFileEvents then + OpenEventLogFile; + + LogEvent(mmetUnexpectedMemoryLeakDetail, LTokenValues); + end; + + {Add the block to the memory leak summary.} + LBlockContentType := DetectBlockContentType(ABlockInfo.BlockAddress, ABlockInfo.UsableSize); + FastMM_PerformMemoryLeakCheck_AddBlockToLeakSummary(LPLeakSummary, ABlockInfo.UsableSize, LBlockContentType); +end; + +procedure FastMM_PerformMemoryLeakCheck_SortNodes(var ALeakSummary: TMemoryLeakSummary); +var + LCurrentIndex, LInsertionIndex: Integer; + LCurEntry: TMemoryLeakSummaryEntry; +begin + {Performs an insertion sort. After the sort the left and right child indexes will no longer be valid.} + for LCurrentIndex := 1 to ALeakSummary.LeakCount - 1 do + begin + LCurEntry := ALeakSummary.MemoryLeakEntries[LCurrentIndex]; + + LInsertionIndex := LCurrentIndex; + while LInsertionIndex > 0 do + begin + if ALeakSummary.MemoryLeakEntries[LInsertionIndex - 1].BlockUsableSize < LCurEntry.BlockUsableSize then + Break; + + if (ALeakSummary.MemoryLeakEntries[LInsertionIndex - 1].BlockUsableSize = LCurEntry.BlockUsableSize) + and (ALeakSummary.MemoryLeakEntries[LInsertionIndex - 1].BlockContentType > LCurEntry.BlockContentType) then + begin + Break; + end; + + ALeakSummary.MemoryLeakEntries[LInsertionIndex] := ALeakSummary.MemoryLeakEntries[LInsertionIndex - 1]; + Dec(LInsertionIndex); + end; + + ALeakSummary.MemoryLeakEntries[LInsertionIndex] := LCurEntry; + end; +end; + +procedure FastMM_PerformMemoryLeakCheck_LogLeakSummary(var ALeakSummary: TMemoryLeakSummary); +const + CLeakTextMaxSize = 32768; + CLifeFeed = #13#10; + CLeakSizeSuffix = ': '; + CLeakSeparator = ', '; + CLeakMultiple = ' x '; +var + LCurrentLeakSize: NativeInt; + LLeakIndex: Integer; + LLeakEntriesText, LTokenValueBuffer: array[0..CLeakTextMaxSize] of WideChar; + LPBufferPos, LPBufferEnd, LPTokenBufferPos: PWideChar; + LTokenValues: TEventLogTokenValues; +begin + {Sort the leaks in ascending size and descending type order.} + FastMM_PerformMemoryLeakCheck_SortNodes(ALeakSummary); + + {Build the leak summary entries text: Walk the blocks from small to large, grouping leaks of the same size.} + LCurrentLeakSize := -1; + LPBufferPos := @LLeakEntriesText; + LPBufferEnd := @LLeakEntriesText[High(LLeakEntriesText)]; + for LLeakIndex := 0 to ALeakSummary.LeakCount - 1 do + begin + + {Did the leak size change? If so, add a new line.} + if ALeakSummary.MemoryLeakEntries[LLeakIndex].BlockUsableSize <> LCurrentLeakSize then + begin + LCurrentLeakSize := ALeakSummary.MemoryLeakEntries[LLeakIndex].BlockUsableSize; + + LPBufferPos := AppendTextToBuffer(CLifeFeed, Length(CLifeFeed), LPBufferPos, LPBufferEnd); + LPBufferPos := NativeIntToTextBuffer(LCurrentLeakSize, LPBufferPos, LPBufferEnd); + LPBufferPos := AppendTextToBuffer(CLeakSizeSuffix, Length(CLeakSizeSuffix), LPBufferPos, LPBufferEnd); + end + else + begin + LPBufferPos := AppendTextToBuffer(CLeakSeparator, Length(CLeakSeparator), LPBufferPos, LPBufferEnd); + end; + + LPBufferPos := NativeIntToTextBuffer(ALeakSummary.MemoryLeakEntries[LLeakIndex].NumLeaks, LPBufferPos, LPBufferEnd); + LPBufferPos := AppendTextToBuffer(CLeakMultiple, Length(CLeakMultiple), LPBufferPos, LPBufferEnd); + LPBufferPos := BlockContentTypeToTextBuffer(ALeakSummary.MemoryLeakEntries[LLeakIndex].BlockContentType, LPBufferPos, LPBufferEnd); + end; + + {Build the token dictionary for the leak summary.} + LTokenValues := Default(TEventLogTokenValues); + LPTokenBufferPos := AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, + @LTokenValueBuffer[High(LTokenValueBuffer)]); + AddTokenValue(LTokenValues, CEventLogTokenLeakSummaryEntries, @LLeakEntriesText, + CharCount(LPBufferPos, @LLeakEntriesText), LPTokenBufferPos, @LTokenValueBuffer[High(LTokenValueBuffer)]); + + LogEvent(mmetUnexpectedMemoryLeakSummary, LTokenValues); +end; + +procedure FastMM_PerformMemoryLeakCheck; +var + LLeakSummary: TMemoryLeakSummary; +begin + LLeakSummary := Default(TMemoryLeakSummary); + + FastMM_WalkBlocks(FastMM_PerformMemoryLeakCheck_CallBack, [btLargeBlock, btMediumBlock, btSmallBlock], True, + @LLeakSummary); + + {Build the leak summary by walking all the block categories.} + if (LLeakSummary.LeakCount > 0) + and (mmetUnexpectedMemoryLeakSummary in (FastMM_OutputDebugStringEvents + FastMM_LogToFileEvents + FastMM_MessageBoxEvents)) then + begin + FastMM_PerformMemoryLeakCheck_LogLeakSummary(LLeakSummary); + end; + + {The event log file would have been opened when the first leak was detected.} + CloseEventLogFile; +end; + + +{--------------------------------------------------------} +{-------------Initialization/installation----------------} +{--------------------------------------------------------} + +procedure FastMM_SetOptimizationStrategy(AStrategy: TFastMM_MemoryManagerOptimizationStrategy); +begin + OptimizationStrategy := AStrategy; + + case AStrategy of + + mmosOptimizeForSpeed: + begin + DefaultMediumBlockSpanSize := CMaximumMediumBlockSpanSize; + end; + + mmosOptimizeForLowMemoryUsage: + begin + DefaultMediumBlockSpanSize := 1024 * 1024 * 3 div 2; + end; + + else + begin + DefaultMediumBlockSpanSize := 3 * 1024 * 1024; + end; + + end; +end; + +function FastMM_GetCurrentOptimizationStrategy: TFastMM_MemoryManagerOptimizationStrategy; +begin + Result := OptimizationStrategy; +end; + +{Adjacent small block managers may straddle the same cache line and thus have a false dependency. Many CPUs also +prefetch adjacent cache lines on a cache miss (e.g. the "Adjacent Cache Line Prefetch" BIOS option), so even if the +small block managers are perfectly aligned on cache line (64-byte) boundaries, these prefetch mechanisms may still +introduce false dependencies. We do not want the managers for frequently used block sizes to have false dependencies +between them, so the frequently used (small) sizes are interspersed with the less frequently used (larger) sizes.} +function SmallBlockManagerIndexFromSizeIndex(ASizeIndex: Integer): Integer; inline; +begin + {Fill up the uneven slots first from the front to the back, and then the even slots from the back to the front.} + Result := ASizeIndex * 2 + 1; + if Result >= CSmallBlockTypeCount then + Result := (2 * CSmallBlockTypeCount - 1) - Result; +end; + +{Builds the lookup table used for translating a small block allocation request size to a small block type.} +procedure FastMM_BuildSmallBlockTypeLookupTable; +var + LBlockSizeIndex, LSmallBlockSize, LManagerIndex, LStartIndex, LNextStartIndex, LAndValue: Integer; +begin + {Determine the allowed small block alignments. Under 64-bit the minimum alignment is always 16 bytes.} + if AlignmentRequestCounters[maa64Bytes] > 0 then + LAndValue := 63 + else if AlignmentRequestCounters[maa32Bytes] > 0 then + LAndValue := 31 + else if (SizeOf(Pointer) = 8) or (AlignmentRequestCounters[maa16Bytes] > 0) then + LAndValue := 15 + else + LAndValue := 0; + + LStartIndex := 0; + for LBlockSizeIndex := 0 to High(CSmallBlockSizes) do + begin + LSmallBlockSize := CSmallBlockSizes[LBlockSizeIndex]; + {Is this a valid block type for the alignment restriction?} + if LSmallBlockSize and LAndValue = 0 then + begin + {Store the block type index in the appropriate slots.} + LManagerIndex := SmallBlockManagerIndexFromSizeIndex(LBlockSizeIndex); + LNextStartIndex := LSmallBlockSize div CSmallBlockGranularity; + while LStartIndex < LNextStartIndex do + begin + SmallBlockTypeLookup[LStartIndex] := LManagerIndex; + Inc(LStartIndex); + end; + {Set the start of the next block type} + LStartIndex := LNextStartIndex; + end; + end; +end; + +procedure FastMM_EnterMinimumAddressAlignment(AMinimumAddressAlignment: TFastMM_MinimumAddressAlignment); +var + LOldMinimumAlignment: TFastMM_MinimumAddressAlignment; +begin + LOldMinimumAlignment := FastMM_GetCurrentMinimumAddressAlignment; + AtomicIncrement(AlignmentRequestCounters[AMinimumAddressAlignment]); + + {Rebuild the small block type lookup table if the minimum alignment changed.} + if LOldMinimumAlignment <> FastMM_GetCurrentMinimumAddressAlignment then + FastMM_BuildSmallBlockTypeLookupTable; +end; + +procedure FastMM_ExitMinimumAddressAlignment(AMinimumAddressAlignment: TFastMM_MinimumAddressAlignment); +var + LOldMinimumAlignment: TFastMM_MinimumAddressAlignment; +begin + LOldMinimumAlignment := FastMM_GetCurrentMinimumAddressAlignment; + AtomicDecrement(AlignmentRequestCounters[AMinimumAddressAlignment]); + + {Rebuild the small block type lookup table if the minimum alignment changed.} + if LOldMinimumAlignment <> FastMM_GetCurrentMinimumAddressAlignment then + FastMM_BuildSmallBlockTypeLookupTable; +end; + +{Returns the current minimum address alignment in effect.} +function FastMM_GetCurrentMinimumAddressAlignment: TFastMM_MinimumAddressAlignment; +begin + if AlignmentRequestCounters[maa64Bytes] > 0 then + Result := maa64Bytes + else if AlignmentRequestCounters[maa32Bytes] > 0 then + Result := maa32Bytes + else if (SizeOf(Pointer) = 8) or (AlignmentRequestCounters[maa16Bytes] > 0) then + Result := maa16Bytes + else + Result := maa8Bytes; +end; + +{Allows the application to specify a maximum amount of memory that may be allocated through FastMM. An attempt to +allocate more than this amount will fail and lead to an "Out of Memory" exception. Note that after the first failure +the maximum amount of memory that may be allocated is slightly increased in order to allow the application to allocate +some additional memory in subsequent attempts. This is to allow for a graceful shutdown. Specify 0 for no limit (the +default).} +procedure FastMM_SetMemoryUsageLimit(AMaximumAllowedMemoryUsage: NativeUInt); +const + CMemoryUsageLimitGraceAmount = 32 * 1024 * 1024; //Hopefully enough to allow shutdown code to run +begin + MemoryUsageLimit := AMaximumAllowedMemoryUsage; + MemoryUsageLimitGraceAmount := CMemoryUsageLimitGraceAmount; +end; + +function FastMM_GetMemoryUsageLimit: NativeUInt; +begin + Result := MemoryUsageLimit; +end; + +{Gets the optimal move procedure for the given small block size.} +function FastMM_InitializeMemoryManager_GetOptimalMoveProc(ASmallBlockSize: Integer): TMoveProc; +{$ifdef X86ASM} +var + LSSE2Available: Boolean; +{$endif} +begin +{$ifdef X86ASM} + LSSE2Available := System.TestSSE and 2 <> 0; //Bit 1 = 1 means the CPU supports SSE2 +{$endif} + + case ASmallBlockSize of + + {64-bit is always 16 byte aligned, so the 8 byte aligned moves are not needed under 64-bit.} +{$ifdef 32Bit} + 8: Result := @Move8; + 24: Result := @Move24; + 40: Result := @Move40; + 56: Result := @Move56; +{$endif} + + 16: + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @Move16_x86_SSE2 + else +{$endif} + Result := @Move16; + end; + 32: + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @Move32_x86_SSE2 + else +{$endif} + Result := @Move32; + end; + 48: + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @Move48_x86_SSE2 + else +{$endif} + Result := @Move48; + end; + 64: + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @Move64_x86_SSE2 + else +{$endif} + Result := @Move64; + end + + else + begin + if (ASmallBlockSize and 63) = 0 then + begin + if ASmallBlockSize < 1024 then + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @MoveMultipleOf64_Small_x86_SSE2 + else +{$endif} + Result := @MoveMultipleOf64_Small; + end + else + Result := @MoveMultipleOf64_Large; + end else if (ASmallBlockSize and 31) = 0 then + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @MoveMultipleOf32_x86_SSE2 + else +{$endif} + Result := @MoveMultipleOf32; + end else if (ASmallBlockSize and 15) = 0 then + begin +{$ifdef X86ASM} + if LSSE2Available then + Result := @MoveMultipleOf16_x86_SSE2 + else +{$endif} + Result := @MoveMultipleOf16; +{$ifdef 32Bit} + {Under 64-bit there are no block sizes that are a multiple of 8.} + end else if (ASmallBlockSize and 7) = 0 then + begin + Result := @MoveMultipleOf8; +{$endif} + end + else + begin + {Sanity check - should never get here.} + System.Error(reRangeError); + Result := nil; + end; + end; + + end; +end; + +procedure FastMM_InitializeMemoryManager; +var + LBlockSizeIndex, LSmallBlockSize, LArenaInd, LMinimumSmallBlockSpanSize, LBinInd, LOptimalSmallBlockSpanSize, + LBlocksPerSpan, LManagerIndex: Integer; + LPSmallBlockManager: PSmallBlockManager; + LPMediumBlockManager: PMediumBlockManager; + LPLargeBlockManager: PLargeBlockManager; + LPBin: PPointer; +begin + {---------Bug checks-------} + + {$if CSmallBlockHeaderSize <> 2} {$message error 'Small block header size must be 2 bytes'} {$endif} + {$if CMediumBlockHeaderSize <> 8} {$message error 'Medium block header size must be 8 bytes'} {$endif} + {$if CLargeBlockHeaderSize and 63 <> 0} {$message error 'Large block header size must be multiple of 64 bytes'} {$endif} + {In order to ensure minimum alignment is always honoured the debug block header must be a multiple of 64.} + {$if CDebugBlockHeaderSize and 63 <> 0} {$message error 'Debug block header must be a multiple of 64 bytes'} {$endif} + + {Span headers have to be a multiple of 64 bytes in order to ensure that 64-byte alignment of user data is possible.} + {$if CSmallBlockSpanHeaderSize and 63 <> 0} {$message error 'Small block span header size must be multiple of 64 bytes'} {$endif} + {$if CMediumBlockSpanHeaderSize and 63 <> 0} {$message error 'Medium block span header size must be multiple of 64 bytes'} {$endif} + + {$if CSmallBlockManagerSize and 63 <> 0} {$message error 'Small block manager size must be a multiple of 64 bytes'} {$endif} + {$if CSmallBlockManagerSize <> (1 shl CSmallBlockManagerSizeBits)} {$message error 'Small block manager size mismatch'} {$endif} + + {$if CLargeBlockManagerSize and 63 <> 0} {$message error 'Large block manager size must be a multiple of 64 bytes'} {$endif} + + {---------General configuration-------} + + FastMM_SetOptimizationStrategy(mmosBalanced); + FastMM_SetDebugModeStackTraceEntryCount(CFastMM_StackTrace_DefaultEntryCount); + + GetMemoryManager(PreviousMemoryManager); + InstalledMemoryManager := PreviousMemoryManager; + if IsMemoryManagerSet then + CurrentInstallationState := mmisOtherThirdPartyMemoryManagerInstalled; + + {---------Small blocks-------} + + {Build the request size to small block type lookup table.} + FastMM_BuildSmallBlockTypeLookupTable; + + {Initialize all the small block arenas} + for LBlockSizeIndex := 0 to CSmallBlockTypeCount - 1 do + begin + LSmallBlockSize := CSmallBlockSizes[LBlockSizeIndex]; + + {The minimum useable small block span size. The first small block's header is inside the span header, so we need + space for one less small block heaader.} + LMinimumSmallBlockSpanSize := RoundUserSizeUpToNextMediumBlockBin( + CMinimumSmallBlocksPerSpan * LSmallBlockSize + (CSmallBlockSpanHeaderSize - CSmallBlockHeaderSize)); + if LMinimumSmallBlockSpanSize < CMinimumMediumBlockSize then + LMinimumSmallBlockSpanSize := CMinimumMediumBlockSize; + + {The optimal small block span size is rounded so as to minimize wastage due to a partial last block.} + LOptimalSmallBlockSpanSize := LSmallBlockSize * COptimalSmallBlocksPerSpan; + if LOptimalSmallBlockSpanSize < COptimalSmallBlockSpanSizeLowerLimit then + LOptimalSmallBlockSpanSize := COptimalSmallBlockSpanSizeLowerLimit; + if LOptimalSmallBlockSpanSize > COptimalSmallBlockSpanSizeUpperLimit then + LOptimalSmallBlockSpanSize := COptimalSmallBlockSpanSizeUpperLimit; + LBlocksPerSpan := LOptimalSmallBlockSpanSize div LSmallBlockSize; + {The first small block's header is inside the span header, so we need space for one less small block heaader.} + LOptimalSmallBlockSpanSize := RoundUserSizeUpToNextMediumBlockBin(LBlocksPerSpan * LSmallBlockSize + + (CSmallBlockSpanHeaderSize - CSmallBlockHeaderSize)); + + {Small block managers are not kept in memory in size order, because they may straddle the same cache lines (or may + be prefetched together) and we want to avoid false dependencies between frequently used managers (usually similarly + sized small blocks).} + LManagerIndex := SmallBlockManagerIndexFromSizeIndex(LBlockSizeIndex); + + for LArenaInd := 0 to CFastMM_SmallBlockArenaCount - 1 do + begin + LPSmallBlockManager := @SmallBlockManagers[LArenaInd, LManagerIndex]; + + {The circular list is empty initially.} + LPSmallBlockManager.FirstPartiallyFreeSpan := PSmallBlockSpanHeader(LPSmallBlockManager); + LPSmallBlockManager.LastPartiallyFreeSpan := PSmallBlockSpanHeader(LPSmallBlockManager); + + LPSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerAndABACounter := 0; + LPSmallBlockManager.BlockSize := LSmallBlockSize; + LPSmallBlockManager.MinimumSpanSize := LMinimumSmallBlockSpanSize; + LPSmallBlockManager.OptimalSpanSize := LOptimalSmallBlockSpanSize; + + LPSmallBlockManager.UpsizeMoveProcedure := FastMM_InitializeMemoryManager_GetOptimalMoveProc( + LPSmallBlockManager.BlockSize); + + end; + end; + + {---------Medium blocks-------} + for LArenaInd := 0 to CFastMM_MediumBlockArenaCount - 1 do + begin + LPMediumBlockManager := @MediumBlockManagers[LArenaInd]; + + {The circular list of spans is empty initially.} + LPMediumBlockManager.FirstMediumBlockSpanHeader := PMediumBlockSpanHeader(LPMediumBlockManager); + LPMediumBlockManager.LastMediumBlockSpanHeader := PMediumBlockSpanHeader(LPMediumBlockManager); + + {All the free block bins are empty.} + for LBinInd := 0 to CMediumBlockBinCount - 1 do + begin + LPBin := @LPMediumBlockManager.FirstFreeBlockInBin[LBinInd]; + LPBin^ := LPBin; + end; + + end; + + {---------Large blocks-------} + + {The circular list is empty initially.} + for LArenaInd := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + LPLargeBlockManager := @LargeBlockManagers[LArenaInd]; + + LPLargeBlockManager.FirstLargeBlockHeader := PLargeBlockHeader(LPLargeBlockManager); + LPLargeBlockManager.LastLargeBlockHeader := PLargeBlockHeader(LPLargeBlockManager) + end; + + {---------Debug setup-------} + {Reserve 64K starting at address $80800000. $80808080 is the debug fill pattern under 32-bit, so we don't want any + pointer dereferences at this address to succeed. This is only necessary under 32-bit, since $8080808000000000 is + already reserved for the OS under 64-bit.} +{$ifdef 32Bit} + OS_AllocateVirtualMemoryAtAddress(Pointer($80800000), $10000, True); +{$endif} + + FastMM_GetStackTrace := @FastMM_NoOpGetStackTrace; + FastMM_ConvertStackTraceToText := FastMM_NoOpConvertStackTraceToText; + {The first time EnterDebugMode is called an attempt will be made to load the debug support DLL.} + DebugSupportConfigured := False; + + EventLogFileHandle := INVALID_HANDLE_VALUE; + FastMM_SetDefaultEventLogFilename; + + {---------Sharing setup-------} + + FastMM_BuildFileMappingObjectName; +end; + +procedure FastMM_FreeAllMemory; +var + LArenaIndex, LBinIndex, LBlockTypeIndex: Integer; + LPMediumBlockManager: PMediumBlockManager; + LPMediumBlockSpan, LPNextMediumBlockSpan: PMediumBlockSpanHeader; + LPSmallBlockArena: PSmallBlockArena; + LPSmallBlockManager: PSmallBlockManager; + LPLargeBlockManager: PLargeBlockManager; + LPLargeBlock, LPNextLargeBlock: PLargeBlockHeader; +begin + {Free all medium block spans.} + for LArenaIndex := 0 to CFastMM_MediumBlockArenaCount - 1 do + begin + LPMediumBlockManager := @MediumBlockManagers[LArenaIndex]; + LPMediumBlockSpan := LPMediumBlockManager.FirstMediumBlockSpanHeader; + while NativeUInt(LPMediumBlockSpan) <> NativeUInt(LPMediumBlockManager) do + begin + LPNextMediumBlockSpan := LPMediumBlockSpan.NextMediumBlockSpanHeader; + OS_FreeVirtualMemory(LPMediumBlockSpan, LPMediumBlockSpan.SpanSize); + LPMediumBlockSpan := LPNextMediumBlockSpan; + end; + + LPMediumBlockManager.FirstMediumBlockSpanHeader := PMediumBlockSpanHeader(LPMediumBlockManager); + LPMediumBlockManager.LastMediumBlockSpanHeader := PMediumBlockSpanHeader(LPMediumBlockManager); + + LPMediumBlockManager.MediumBlockBinGroupBitmap := 0; + FilLChar(LPMediumBlockManager.MediumBlockBinBitmaps, SizeOf(LPMediumBlockManager.MediumBlockBinBitmaps), 0); + for LBinIndex := 0 to CMediumBlockBinCount - 1 do + LPMediumBlockManager.FirstFreeBlockInBin[LBinIndex] := @LPMediumBlockManager.FirstFreeBlockInBin[LBinIndex]; + LPMediumBlockManager.LastMediumBlockSequentialFeedOffset.IntegerValue := 0; + LPMediumBlockManager.SequentialFeedMediumBlockSpan := nil; + LPMediumBlockManager.PendingFreeList := nil; + end; + + {Clear all small block types} + for LArenaIndex := 0 to High(SmallBlockManagers) do + begin + LPSmallBlockArena := @SmallBlockManagers[LArenaIndex]; + + for LBlockTypeIndex := 0 to CSmallBlockTypeCount - 1 do + begin + LPSmallBlockManager := @LPSmallBlockArena[LBlockTypeIndex]; + LPSmallBlockManager.FirstPartiallyFreeSpan := PSmallBlockSpanHeader(LPSmallBlockManager); + LPSmallBlockManager.LastPartiallyFreeSpan := PSmallBlockSpanHeader(LPSmallBlockManager); + LPSmallBlockManager.LastSmallBlockSequentialFeedOffset.IntegerValue := 0; + LPSmallBlockManager.SequentialFeedSmallBlockSpan := nil; + LPSmallBlockManager.PendingFreeList := nil; + end; + end; + + {Free all large blocks.} + for LArenaIndex := 0 to CFastMM_LargeBlockArenaCount - 1 do + begin + LPLargeBlockManager := @LargeBlockManagers[LArenaIndex]; + + LPLargeBlock := LPLargeBlockManager.FirstLargeBlockHeader; + while NativeUInt(LPLargeBlock) <> NativeUInt(LPLargeBlockManager) do + begin + LPNextLargeBlock := LPLargeBlock.NextLargeBlockHeader; + FastMM_FreeMem_FreeLargeBlock_ReleaseVM(LPLargeBlock); + LPLargeBlock := LPNextLargeBlock; + end; + + LPLargeBlockManager.FirstLargeBlockHeader := PLargeBlockHeader(LPLargeBlockManager); + LPLargeBlockManager.LastLargeBlockHeader := PLargeBlockHeader(LPLargeBlockManager); + end; + +end; + +procedure FastMM_FinalizeMemoryManager; +begin + ReleaseEmergencyReserveAddressSpace; + + if ExpectedMemoryLeaks <> nil then + begin + OS_FreeVirtualMemory(ExpectedMemoryLeaks, CExpectedMemoryLeaksListSize); + ExpectedMemoryLeaks := nil; + end; + + FastMM_FreeDebugSupportLibrary; + + if SharingFileMappingObjectHandle <> 0 then + begin + CloseHandle(SharingFileMappingObjectHandle); + SharingFileMappingObjectHandle := 0; + end; + +end; + +{Returns True if FastMM was successfully installed.} +function FastMM_GetInstallationState: TFastMM_MemoryManagerInstallationState; +begin + Result := CurrentInstallationState; +end; + +function FastMM_SetNormalOrDebugMemoryManager: Boolean; +var + LNewMemoryManager: TMemoryManagerEx; +begin + {SetMemoryManager is not thread safe.} + while AtomicCmpExchange(SettingMemoryManager, 1, 0) <> 0 do + OS_AllowOtherThreadToRun; + + {Check that the memory manager has not been changed since the last time it was set.} + if FastMM_InstalledMemoryManagerChangedExternally then + begin + SettingMemoryManager := 0; + Exit(False); + end; + + {Debug mode or normal memory manager?} + if DebugModeCounter <= 0 then + begin + LNewMemoryManager.GetMem := FastMM_GetMem; + LNewMemoryManager.FreeMem := FastMM_FreeMem; + LNewMemoryManager.ReallocMem := FastMM_ReallocMem; + LNewMemoryManager.AllocMem := FastMM_AllocMem; + LNewMemoryManager.RegisterExpectedMemoryLeak := FastMM_RegisterExpectedMemoryLeak; + LNewMemoryManager.UnregisterExpectedMemoryLeak := FastMM_UnregisterExpectedMemoryLeak; + end + else + begin + LNewMemoryManager.GetMem := FastMM_DebugGetMem; + LNewMemoryManager.FreeMem := FastMM_DebugFreeMem; + LNewMemoryManager.ReallocMem := FastMM_DebugReallocMem; + LNewMemoryManager.AllocMem := FastMM_DebugAllocMem; + LNewMemoryManager.RegisterExpectedMemoryLeak := FastMM_RegisterExpectedMemoryLeak; + LNewMemoryManager.UnregisterExpectedMemoryLeak := FastMM_UnregisterExpectedMemoryLeak; + end; + + SetMemoryManager(LNewMemoryManager); + InstalledMemoryManager := LNewMemoryManager; + + SettingMemoryManager := 0; + + Result := True; +end; + +procedure FastMM_InstallMemoryManager; +var + LTokenValues: TEventLogTokenValues; + LTokenValueBuffer: array[0..CTokenBufferMaxWideChars - 1] of WideChar; +begin + {FastMM may only be installed if no other replacement memory manager has already been installed, and no memory has + been allocated through the default memory manager.} + if CurrentInstallationState <> mmisDefaultMemoryManagerInUse then + begin + LTokenValues := Default(TEventLogTokenValues); + AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, @LTokenValueBuffer[High(LTokenValueBuffer)]); + LogEvent(mmetAnotherThirdPartyMemoryManagerAlreadyInstalled, LTokenValues); + + Exit; + end; + + if System.GetHeapStatus.TotalAllocated <> 0 then + begin + LTokenValues := Default(TEventLogTokenValues); + AddTokenValues_GeneralTokens(LTokenValues, @LTokenValueBuffer, @LTokenValueBuffer[High(LTokenValueBuffer)]); + LogEvent(mmetCannotInstallAfterDefaultMemoryManagerHasBeenUsed, LTokenValues); + + Exit; + end; + + if FastMM_SetNormalOrDebugMemoryManager then + begin + CurrentInstallationState := mmisInstalled; + + EnsureEmergencyReserveAddressSpaceAllocated; + end; +end; + +procedure FastMM_UninstallMemoryManager; +begin + if CurrentInstallationState in [mmisInstalled, mmisUsingSharedMemoryManager] then + begin + {Has another memory manager been installed by external code? If so, it is not possible to uninstall.} + if not FastMM_InstalledMemoryManagerChangedExternally then + begin + SetMemoryManager(PreviousMemoryManager); + InstalledMemoryManager := PreviousMemoryManager; + CurrentInstallationState := mmisDefaultMemoryManagerInUse; + end; + end; +end; + +function FastMM_LoadDebugSupportLibrary: Boolean; +begin +{$ifndef FastMM_DebugLibraryStaticDependency} + {Already loaded? If so, return success.} + if DebugSupportLibraryHandle <> 0 then + Exit(True); + + DebugSupportLibraryHandle := LoadLibrary(FastMM_DebugSupportLibraryName); + if DebugSupportLibraryHandle <> 0 then + begin + DebugLibrary_GetRawStackTrace := GetProcAddress(DebugSupportLibraryHandle, PAnsiChar('GetRawStackTrace')); + DebugLibrary_GetFrameBasedStackTrace := GetProcAddress(DebugSupportLibraryHandle, PAnsiChar('GetFrameBasedStackTrace')); + DebugLibrary_LogStackTrace_Legacy := GetProcAddress(DebugSupportLibraryHandle, PAnsiChar('LogStackTrace')); + + {Try to use the stack trace routines from the debug support library, if available.} + if (@FastMM_GetStackTrace = @FastMM_NoOpGetStackTrace) + and Assigned(DebugLibrary_GetRawStackTrace) then + begin + FastMM_GetStackTrace := DebugLibrary_GetRawStackTrace; + end; + + if (@FastMM_ConvertStackTraceToText = @FastMM_NoOpConvertStackTraceToText) + and Assigned(DebugLibrary_LogStackTrace_Legacy) then + begin + FastMM_ConvertStackTraceToText := FastMM_DebugLibrary_LegacyLogStackTrace_Wrapper; + end; + + Result := True; + end + else + Result := False; +{$else} + {Use the stack trace routines from the debug support library.} + if (@FastMM_GetStackTrace = @FastMM_NoOpGetStackTrace) then + FastMM_GetStackTrace := @DebugLibrary_GetRawStackTrace; + + if (@FastMM_ConvertStackTraceToText = @FastMM_NoOpConvertStackTraceToText) then + FastMM_ConvertStackTraceToText := @FastMM_DebugLibrary_LegacyLogStackTrace_Wrapper; + + Result := True; +{$endif} +end; + +function FastMM_FreeDebugSupportLibrary: Boolean; +begin +{$ifndef FastMM_DebugLibraryStaticDependency} + if DebugSupportLibraryHandle = 0 then + Exit(False); +{$endif} + + if (@FastMM_GetStackTrace = @DebugLibrary_GetRawStackTrace) + or (@FastMM_GetStackTrace = @DebugLibrary_GetFrameBasedStackTrace) then + begin + FastMM_GetStackTrace := @FastMM_NoOpGetStackTrace; + end; + + if @FastMM_ConvertStackTraceToText = @FastMM_DebugLibrary_LegacyLogStackTrace_Wrapper then + begin + FastMM_ConvertStackTraceToText := @FastMM_NoOpConvertStackTraceToText; + end; + +{$ifndef FastMM_DebugLibraryStaticDependency} + FreeLibrary(DebugSupportLibraryHandle); + DebugSupportLibraryHandle := 0; + + DebugLibrary_GetRawStackTrace := nil; + DebugLibrary_GetFrameBasedStackTrace := nil; + DebugLibrary_LogStackTrace_Legacy := nil; +{$endif} + + Result := True; +end; + +procedure FastMM_ConfigureDebugMode; +begin + {If both handlers have been assigned then we do not need to load the support DLL.} + if (@FastMM_GetStackTrace = @FastMM_NoOpGetStackTrace) + or (@FastMM_ConvertStackTraceToText = @FastMM_NoOpConvertStackTraceToText) then + begin + FastMM_LoadDebugSupportLibrary; + end; + + DebugSupportConfigured := True; +end; + +function FastMM_EnterDebugMode: Boolean; +begin + if CurrentInstallationState = mmisInstalled then + begin + if AtomicIncrement(DebugModeCounter) = 1 then + begin + if not DebugSupportConfigured then + FastMM_ConfigureDebugMode; + + Result := FastMM_SetNormalOrDebugMemoryManager + end + else + Result := True; + end + else + Result := False; +end; + +function FastMM_ExitDebugMode: Boolean; +begin + if CurrentInstallationState = mmisInstalled then + begin + if AtomicDecrement(DebugModeCounter) = 0 then + Result := FastMM_SetNormalOrDebugMemoryManager + else + Result := True; + end + else + Result := False; +end; + +function FastMM_DebugModeActive: Boolean; +begin + Result := DebugModeCounter > 0; +end; + +function FastMM_GetDebugModeStackTraceEntryCount: Byte; +begin + Result := DebugMode_StackTrace_EntryCount; +end; + +procedure FastMM_SetDebugModeStackTraceEntryCount(AStackTraceEntryCount: Byte); +begin + if AStackTraceEntryCount > CFastMM_StackTrace_MaximumEntryCount then + AStackTraceEntryCount := CFastMM_StackTrace_MaximumEntryCount; + + DebugMode_StackTrace_EntryCount := AStackTraceEntryCount; +end; + +procedure FastMM_ApplyConditionalDefines; +begin + {This procedure provides backward compatibility with the conditional defines of FastMM4.} + + {$ifdef FastMM_ClearLogFileOnStartup} + FastMM_DeleteEventLogFile; + {$endif} + + {$ifdef FastMM_Align16Bytes} + FastMM_EnterMinimumAddressAlignment(maa16Bytes); + {$endif} + + {$ifdef FastMM_EnableMemoryLeakReporting} + {$ifdef FastMM_RequireDebuggerPresenceForLeakReporting} + if DebugHook <> 0 then + {$endif} + begin + FastMM_LogToFileEvents := FastMM_LogToFileEvents + [mmetUnexpectedMemoryLeakDetail, mmetUnexpectedMemoryLeakSummary]; + FastMM_MessageBoxEvents := FastMM_MessageBoxEvents + [mmetUnexpectedMemoryLeakSummary]; + end; + {$endif} + + {$ifdef FastMM_NoMessageBoxes} + FastMM_MessageBoxEvents := []; + {$endif} + + {$ifdef FastMM_FullDebugModeWhenDLLAvailable} + {$define StartInDebugMode} + {$endif} + + {$ifdef FastMM_FullDebugMode} + {$define StartInDebugMode} + {$endif} + + {$ifdef StartInDebugMode} + if FastMM_LoadDebugSupportLibrary then + FastMM_EnterDebugMode; + {$endif} + + {$ifdef FastMM_ShareMM} + {$ifndef FastMM_ShareMMIfLibrary} + if not IsLibrary then + {$endif} + FastMM_ShareMemoryManager; + {$endif} + + {$ifdef FastMM_AttemptToUseSharedMM} + FastMM_AttemptToUseSharedMemoryManager; + {$endif} + + {$ifdef FastMM_NeverUninstall} + FastMM_NeverUninstall := True; + {$endif} +end; + +procedure FastMM_SetDefaultEventLogFilename; +const + CLogFilePathEnvironmentVariable: PWideChar = 'FastMMLogFilePath'; + CLogFileExtension: PWideChar = '_MemoryManager_EventLog.txt'; +var + LModuleFilename: array[0..CFilenameMaxLength] of WideChar; + LPModuleFilenamePos, LPModuleFilenameStart, LPModuleFilenameEnd, LPBufferPos, LPBufferEnd: PWideChar; +begin + CloseEventLogFile; + + {Get the module filename into a buffer.} + LPModuleFilenameEnd := OS_GetApplicationFilename(@LModuleFilename, @LModuleFilename[High(LModuleFilename)], False); + + {Drop the file extension from the module filename.} + LPModuleFilenamePos := LPModuleFilenameEnd; + while NativeUInt(LPModuleFilenamePos) > NativeUInt(@LModuleFilename) do + begin + if LPModuleFilenamePos^ = '.' then + begin + LPModuleFilenameEnd := LPModuleFilenamePos; + Break; + end; + Dec(LPModuleFilenamePos); + end; + LPModuleFilenameEnd^ := #0; + + {Try to get the path override from the environment variable. If there is a path override then that is used instead + of the application path.} + LPBufferEnd := @EventLogFilename[High(EventLogFilename)]; + LPBufferPos := OS_GetEnvironmentVariableValue(CLogFilePathEnvironmentVariable, @EventLogFilename, LPBufferEnd); + if LPBufferPos <> @EventLogFilename then + begin + {Strip the trailing path separator from the path override.} + Dec(LPBufferPos); + if (LPBufferPos^ <> '\') and (LPBufferPos^ <> '/') then + Inc(LPBufferPos); + + {Strip the path from the module filename.} + LPModuleFilenameStart := LPModuleFilenameEnd; + while NativeUInt(LPModuleFilenameStart) > NativeUInt(@LModuleFilename) do + begin + if (LPModuleFilenameStart^ = '\') or (LPModuleFilenameStart^ = '/') then + Break; + Dec(LPModuleFilenameStart); + end; + end + else + LPModuleFilenameStart := @LModuleFilename; + + LPBufferPos := AppendTextToBuffer(LPModuleFilenameStart, LPBufferPos, LPBufferEnd); + LPBufferPos := AppendTextToBuffer(CLogFileExtension, LPBufferPos, LPBufferEnd); + LPBufferPos^ := #0; +end; + +procedure FastMM_SetEventLogFilename(APEventLogFilename: PWideChar); +var + LPBufferPos, LPBufferEnd: PWideChar; +begin + CloseEventLogFile; + + if APEventLogFilename <> nil then + begin + LPBufferEnd := @EventLogFilename[High(EventLogFilename)]; + LPBufferPos := AppendTextToBuffer(APEventLogFilename, @EventLogFilename, LPBufferEnd); + LPBufferPos^ := #0; + end + else + FastMM_SetDefaultEventLogFilename; +end; + +function FastMM_GetEventLogFilename: PWideChar; +begin + Result := @EventLogFilename; +end; + +function FastMM_DeleteEventLogFile: Boolean; +begin + CloseEventLogFile; + + Result := OS_DeleteFile(@EventLogFilename); +end; + +function FastMM_Initialize: Boolean; +begin + {Ignore attemts to initialize twice.} + if UnitCurrentlyInitialized then + Exit(False); + UnitCurrentlyInitialized := True; + + FastMM_InitializeMemoryManager; + FastMM_InstallMemoryManager; + + {If installation was successful, check for any legacy FastMM4 conditional defines and adjust the configuration + accordingly.} + if CurrentInstallationState = mmisInstalled then + begin + FastMM_ApplyConditionalDefines; + Result := True; + end + else + Result := False; +end; + +function FastMM_Finalize: Boolean; +begin + if not UnitCurrentlyInitialized then + Exit(False); + UnitCurrentlyInitialized := False; + + {Prevent a potential crash when the finalization code in system.pas tries to free PreferredLanguagesOverride after + FastMM has been uninstalled: https://quality.embarcadero.com/browse/RSP-16796} + if CurrentInstallationState = mmisInstalled then + SetLocaleOverride(''); + + {All pending frees must be released before a leak check can be performed.} + FastMM_ProcessAllPendingFrees; + + {Backward compatibility: If ReportMemoryLeaksOnShutdown = True then display the leak summary.} + if ReportMemoryLeaksOnShutdown then + Include(FastMM_MessageBoxEvents, mmetUnexpectedMemoryLeakSummary); + + {Do a memory leak check if required.} + if [mmetUnexpectedMemoryLeakDetail, mmetUnexpectedMemoryLeakSummary] * (FastMM_OutputDebugStringEvents + FastMM_LogToFileEvents + FastMM_MessageBoxEvents) <> [] then + FastMM_PerformMemoryLeakCheck; + + if not FastMM_NeverUninstall then + begin + FastMM_FinalizeMemoryManager; + FastMM_UninstallMemoryManager; + + {Free all memory. If this is a .DLL that owns its own memory manager, then it is necessary to prevent the main + application from running out of address space.} + FastMM_FreeAllMemory; + end; + + Result := True; +end; + +{$ifndef FastMM_DisableAutomaticInstall} +initialization + FastMM_Initialize; + +finalization + FastMM_Finalize; +{$endif} + +end. diff --git a/vendor/kam_remake/src/ext/FastMMUsageTracker.pas b/vendor/kam_remake/src/ext/FastMMUsageTracker.pas new file mode 100644 index 0000000..c5ec6d8 --- /dev/null +++ b/vendor/kam_remake/src/ext/FastMMUsageTracker.pas @@ -0,0 +1,1186 @@ +(* + +Fast Memory Manager Usage Tracker 2.00 + +Description: + + - Shows FastMM4 allocation usage + + - Shows VM Memory in graphical map + - Free + - Commit + - Reserved + - EXE (Red) + - DLLs (Blue) + + - VM Dump of the whole process + (2GB standard, 3GB with the /3G switch set, and 4GB under WoW64) + + - General Information + - System memory usage + - Process memory usage + - 5 Largest contiguous free VM memory spaces + - FastMM4 summary information + +Usage: + - Add the FastMMUsageTracker unit + - Add the ShowFastMMUsageTracker procedure to an event + - FastMMUsageTracker form should not be autocreated + +Notes: + - Consider setting the base adress of your BPLs & DLLs or use Microsoft's + ReBase.exe to set third party BPLs and DLLs. Libraries that do not have to + be relocated can be shared across processes, thus conserving system + resources. + - The first of the "Largest contiguous free VM memory spaces" gives you an + indication of the largest single memory block that can be allocated. + +Change log: + + Version 2.10 (22 September 2009): + - New usage tracker implemented by Hanspeter Widmer with many new features. + (Thanks Hanspeter!); + - Colour coding of changes in the allocation map added by Murray McGowan + (red for an increase in usage, green for a decrease). (Thanks Murray!) + +*) + +unit FastMMUsageTracker; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, Grids, Buttons, ComCtrls, Menus, FastMM4; + +type + TChunkStatusEx = ( + {Items that correspond to the same entry in TChunkStatus} + csExUnallocated, + csExAllocated, + csExReserved, + csExSysAllocated, + csExSysReserved, + {TChunkStatusEx additional detail} + csExSysExe, + csExSysDLL); + + TMemoryMapEx = array[0..65535] of TChunkStatusEx; + + TfFastMMUsageTracker = class(TForm) + tTimer: TTimer; + bClose: TBitBtn; + bUpdate: TBitBtn; + ChkAutoUpdate: TCheckBox; + smVMDump: TPopupMenu; + smMM4Allocation: TPopupMenu; + smGeneralInformation: TPopupMenu; + miVMDumpCopyAlltoClipboard: TMenuItem; + miGeneralInformationCopyAlltoClipboard: TMenuItem; + siMM4AllocationCopyAlltoClipboard: TMenuItem; + pcUsageTracker: TPageControl; + tsAllocation: TTabSheet; + tsVMGraph: TTabSheet; + tsVMDump: TTabSheet; + tsGeneralInformation: TTabSheet; + mVMStatistics: TMemo; + sgVMDump: TStringGrid; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + eAddress: TEdit; + eState: TEdit; + eDLLName: TEdit; + ChkSmallGraph: TCheckBox; + sgBlockStatistics: TStringGrid; + dgMemoryMap: TDrawGrid; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure tTimerTimer(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure bCloseClick(Sender: TObject); + procedure dgMemoryMapDrawCell(Sender: TObject; ACol, ARow: Integer; + Rect: TRect; State: TGridDrawState); + procedure dgMemoryMapSelectCell(Sender: TObject; ACol, ARow: Integer; + var CanSelect: Boolean); + procedure bUpdateClick(Sender: TObject); + procedure ChkAutoUpdateClick(Sender: TObject); + procedure ChkSmallGraphClick(Sender: TObject); + procedure sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer; + Rect: TRect; State: TGridDrawState); + procedure miVMDumpCopyAlltoClipboardClick(Sender: TObject); + procedure miGeneralInformationCopyAlltoClipboardClick(Sender: TObject); + procedure siMM4AllocationCopyAlltoClipboardClick(Sender: TObject); + procedure sgBlockStatisticsDrawCell(Sender: TObject; ACol, + ARow: Integer; Rect: TRect; State: TGridDrawState); + private + {The current and previous memory manager states} + FMemoryManagerState, FPrevMemoryManagerState: TMemoryManagerState; + FMemoryMapEx: TMemoryMapEx; + AddressSpacePageCount: Integer; + OR_VMDumpDownCell: TGridCoord; + procedure HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord); + procedure SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean); + procedure UpdateGraphMetrics; + public + {Refreshes the display} + procedure RefreshSnapShot; + end; + +function ShowFastMMUsageTracker: TfFastMMUsageTracker; + +implementation + +uses + Clipbrd, PsAPI; + +{$R *.dfm} + +const + SystemBasicInformation = 0; + SystemPerformanceInformation = 2; + SystemTimeInformation = 3; + + +type + {To get access to protected methods} + TLocalStringGrid = class(TStringGrid); + + TMemoryStatusEx = packed record + dwLength: DWORD; + dwMemoryLoad: DWORD; + ullTotalPhys: Int64; + ullAvailPhys: Int64; + ullTotalPageFile: Int64; + ullAvailPageFile: Int64; + ullTotalVirtual: Int64; + ullAvailVirtual: Int64; + ullAvailExtendedVirtual: Int64; + end; + PMemoryStatusEx = ^TMemoryStatusEx; + LPMEMORYSTATUSEX = PMemoryStatusEx; + + TP_GlobalMemoryStatusEx = function( + var PR_MemStatusEx: TMemoryStatusEx): LongBool; stdcall; + + TSystem_Basic_Information = packed record + dwUnknown1: DWORD; + uKeMaximumIncrement: ULONG; + uPageSize: ULONG; + uMmNumberOfPhysicalPages: ULONG; + uMmLowestPhysicalPage: ULONG; + uMmHighestPhysicalPage: ULONG; + uAllocationGranularity: ULONG; + pLowestUserAddress: Pointer; + pMmHighestUserAddress: Pointer; + uKeActiveProcessors: ULONG; + bKeNumberProcessors: Byte; + bUnknown2: Byte; + wUnknown3: Word; + end; + + TSystem_Performance_Information = packed record + liIdleTime: LARGE_INTEGER; + dwSpare: array[0..75] of DWORD; + end; + + TSystem_Time_Information = packed record + liKeBootTime: LARGE_INTEGER; + liKeSystemTime: LARGE_INTEGER; + liExpTimeZoneBias: LARGE_INTEGER; + uCurrentTimeZoneId: ULONG; + dwReserved: DWORD; + end; + + TP_NtQuerySystemInformation = function(InfoClass: DWORD; Buffer: Pointer; + BufSize: DWORD; ReturnSize: PCardinal): DWORD; stdcall; + +var + MP_GlobalMemoryStatusEx: TP_GlobalMemoryStatusEx = nil; + MP_NtQuerySystemInformation: TP_NtQuerySystemInformation = nil; + +//----------------------------------------------------------------------------- +// Various Global Procedures +//----------------------------------------------------------------------------- + +function ShowFastMMUsageTracker: TfFastMMUsageTracker; +begin + Application.CreateForm(TfFastMMUsageTracker, Result); + if Assigned(Result) then + begin + Result.RefreshSnapShot; + Result.Show; + end; +end; + +function CardinalToStringFormatted(const ACardinal: Cardinal): string; +begin + Result := FormatFloat('#,##0', ACardinal); +end; + +function Int64ToStringFormatted(const AInt64: Int64): string; +begin + Result := FormatFloat('#,##0', AInt64); +end; + +function CardinalToKStringFormatted(const ACardinal: Cardinal): string; +begin + Result := FormatFloat('#,##0', ACardinal div 1024) + 'K'; +end; + +function Int64ToKStringFormatted(const AInt64: Int64): string; +begin + Result := FormatFloat('#,##0', AInt64 div 1024) + 'K'; +end; + +procedure CopyGridContentsToClipBoard(AStringGrid: TStringGrid); +const + TAB = Chr(VK_TAB); + CRLF = #13#10; +var + LI_r, LI_c: Integer; + LS_S: string; +begin + LS_S := ''; + for LI_r := 0 to AStringGrid.RowCount - 1 do + begin + for LI_c := 0 to AStringGrid.ColCount - 1 do + begin + LS_S := LS_S + AStringGrid.Cells[LI_c, LI_r]; + if LI_c < AStringGrid.ColCount - 1 then + LS_S := LS_S + TAB; + end; + if LI_r < AStringGrid.RowCount - 1 then + LS_S := LS_S + CRLF; + end; + ClipBoard.SetTextBuf(PChar(LS_S)); +end; + +//----------------------------------------------------------------------------- +// Form TfFastMMUsageTracker +//----------------------------------------------------------------------------- + +procedure TfFastMMUsageTracker.FormCreate(Sender: TObject); +var + LR_SystemInfo: TSystemInfo; +begin + pcUsageTracker.ActivePage := tsAllocation; + GetSystemInfo(LR_SystemInfo); + {Get the number of address space pages} + if (Cardinal(LR_SystemInfo.lpMaximumApplicationAddress) and $80000000) = 0 then + AddressSpacePageCount := 32768 + else + AddressSpacePageCount := 65536; + {Update the graph metricx} + UpdateGraphMetrics; + {Set up the StringGrid columns} + with sgBlockStatistics do + begin + Cells[0, 0] := 'Block Size'; + Cells[1, 0] := '# Live Pointers'; + Cells[2, 0] := 'Live Size'; + Cells[3, 0] := 'Used Space'; + Cells[4, 0] := 'Efficiency'; + end; + with sgVMDump do + begin + Cells[0, 0] := 'VM Block'; + Cells[1, 0] := 'Size'; + Cells[2, 0] := 'Type'; + Cells[3, 0] := 'State'; + Cells[4, 0] := 'EXE/DLL'; + end; +end; + +procedure TfFastMMUsageTracker.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure TfFastMMUsageTracker.SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean); + + function CompareNumeric(const S1, S2: string): Integer; + var + LVal1, LVal2: Integer; + begin + begin + LVal1 := StrToInt(S1); + LVal2 := StrToInt(S2); + if LVal1 = LVal2 then + begin + Result := 0; + end + else + begin + if LVal1 > LVal2 then + Result := 1 + else + Result := -1; + end; + end; + end; + + procedure ExchangeGridRows(i, j: Integer); + var + k: Integer; + begin + for k := 0 to Grid.ColCount - 1 do + Grid.Cols[k].Exchange(i, j); + end; + + procedure QuickSortNummeric(L, R: Integer); + var + I, J: Integer; + P: string; + begin + repeat + I := L; + J := R; + P := Grid.Cells[byColumn, (L + R) shr 1]; + repeat + while CompareNumeric(Grid.Cells[byColumn, I], P) < 0 do + Inc(I); + while CompareNumeric(Grid.Cells[byColumn, J], P) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + ExchangeGridRows(I, J); + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSortNummeric(L, J); + L := I; + until I >= R; + end; + + procedure QuickSortString(L, R: Integer); + var + I, J: Integer; + P: string; + begin + repeat + I := L; + J := R; + P := Grid.Cells[byColumn, (L + R) shr 1]; + repeat + while CompareText(Grid.Cells[byColumn, I], P) < 0 do + Inc(I); + while CompareText(Grid.Cells[byColumn, J], P) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + ExchangeGridRows(I, J); + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSortString(L, J); + L := I; + until I >= R; + end; + + procedure InvertGrid; + var + i, j: Integer; + begin + i := Grid.Fixedrows; + j := Grid.Rowcount - 1; + while i < j do + begin + ExchangeGridRows(I, J); + Inc(i); + Dec(j); + end; + end; + +begin + Screen.Cursor := crHourglass; + Grid.Perform(WM_SETREDRAW, 0, 0); + try + if PB_Nummeric then + QuickSortNummeric(Grid.FixedRows, Grid.Rowcount - 1) + else + QuickSortString(Grid.FixedRows, Grid.Rowcount - 1); + if not Ascending then + InvertGrid; + finally + Grid.Perform(WM_SETREDRAW, 1, 0); + Grid.Refresh; + Screen.Cursor := crDefault; + end; +end; + + +procedure TfFastMMUsageTracker.HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord); +var + i: Integer; + LNumericSort: Boolean; +begin + // The header cell stores a flag in the Objects property that signals the + // current sort order of the grid column. A value of 0 shows no sort marker, + // 1 means sorted ascending, -1 sorted descending + // clear markers + for i := AGrid.FixedCols to AGrid.ColCount - 1 do + begin + if Assigned(AGrid.Objects[i, 0]) and (i <> ACell.x) then + begin + AGrid.Objects[i, 0] := nil; + TLocalStringGrid(AGrid).InvalidateCell(i, 0); + end; + end; + // Sort grid on new column. If grid is currently sorted ascending on this + // column we invert the sort direction, otherwise we sort it ascending. + if ACell.X = 1 then + LNumericSort := True + else + LNumericSort := False; + if Integer(AGrid.Objects[ACell.x, ACell.y]) = 1 then + begin + SortGrid(AGrid, LNumericSort, ACell.x, False); + AGrid.Objects[ACell.x, 0] := Pointer(-1); + end + else + begin + SortGrid(AGrid, LNumericSort, ACell.x, True); + AGrid.Objects[ACell.x, 0] := Pointer(1); + end; + TLocalStringGrid(AGrid).InvalidateCell(ACell.x, ACell.y); +end; + +procedure TfFastMMUsageTracker.UpdateGraphMetrics; +begin + if ChkSmallGraph.Checked then + begin + dgMemoryMap.DefaultColWidth := 4; + dgMemoryMap.ColCount := 128; + end + else + begin + dgMemoryMap.DefaultColWidth := 8; + dgMemoryMap.ColCount := 64; + end; + dgMemoryMap.DefaultRowHeight := dgMemoryMap.DefaultColWidth; + dgMemoryMap.RowCount := AddressSpacePageCount div dgMemoryMap.ColCount; +end; + +procedure TfFastMMUsageTracker.RefreshSnapShot; +var + LP_FreeVMList: TList; + LU_MEM_FREE: DWord; + LU_MEM_COMMIT: DWord; + LU_MEM_RESERVE: DWord; + LAllocatedSize, LTotalBlocks, LTotalAllocated, LTotalReserved, + LPrevAllocatedSize, LPrevTotalBlocks, LPrevTotalAllocated, LPrevTotalReserved: Cardinal; + + procedure UpdateVMGraph(var AMemoryMap: TMemoryMapEx); + var + LInd, LIndTop, I1: Integer; + LChunkState: TChunkStatusEx; + LMBI: TMemoryBasicInformation; + LA_Char: array[0..MAX_PATH] of Char; + begin + LInd := 0; + repeat + {If the chunk is not allocated by this MM, what is its status?} + if AMemoryMap[LInd] = csExSysAllocated then + begin + {Get all the reserved memory blocks and windows allocated memory blocks, etc.} + VirtualQuery(Pointer(LInd * 65536), LMBI, SizeOf(LMBI)); + if LMBI.State = MEM_COMMIT then + begin + if (GetModuleFileName(DWord(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then + begin + if DWord(LMBI.AllocationBase) = SysInit.HInstance then + LChunkState := csExSysExe + else + LChunkState := csExSysDLL; + end + else + begin + LChunkState := csExSysAllocated; + end; + if LMBI.RegionSize > 65536 then + begin + LIndTop := (Cardinal(LMBI.BaseAddress) + Cardinal(LMBI.RegionSize)) div 65536; + // Fill up multiple tables + for I1 := LInd to LIndTop do + AMemoryMap[I1] := LChunkState; + LInd := LIndTop; + end + else + begin + AMemoryMap[LInd] := LChunkState; + end; + end + end; + Inc(LInd); + until LInd >= AddressSpacePageCount; + end; + + procedure UpdateVMDump; + var + LP_Base: PByte; + LR_Info: TMemoryBasicInformation; + LU_rv: DWORD; + LI_I: Integer; + LA_Char: array[0..MAX_PATH] of Char; + begin + LP_Base := nil; + LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info)); + LI_I := 1; + while LU_rv = sizeof(LR_Info) do + begin + with sgVMDump do + begin + Cells[0, LI_I] := IntToHex(Integer(LR_Info.BaseAddress), 8); + Cells[1, LI_I] := IntToStr(LR_Info.RegionSize); + Cells[3, LI_I] := IntToHex(Integer(LR_Info.Protect), 8); + case LR_Info.State of + + MEM_Commit: + begin + LU_MEM_COMMIT := LU_MEM_COMMIT + LR_Info.RegionSize; + if (GetModuleFileName(dword(LR_Info.AllocationBase), LA_Char, MAX_PATH) <> 0) then + begin + if DWord(LR_Info.AllocationBase) = SysInit.HInstance then + Cells[2, LI_I] := 'Exe' + else + Cells[2, LI_I] := 'DLL'; + Cells[4, LI_I] := ExtractFileName(LA_Char); + end + else + begin + Cells[4, LI_I] := ''; + Cells[2, LI_I] := 'Commited'; + end; + end; + + MEM_RESERVE: + begin + LU_MEM_RESERVE := LU_MEM_RESERVE + LR_Info.RegionSize; + Cells[2, LI_I] := 'Reserved'; + Cells[4, LI_I] := ''; + end; + + MEM_FREE: + begin + LP_FreeVMList.Add(Pointer(LR_Info.RegionSize)); + LU_MEM_FREE := LU_MEM_FREE + Lr_Info.RegionSize; + Cells[2, LI_I] := 'Free'; + Cells[4, LI_I] := ''; + end; + end; + + Inc(LP_Base, LR_Info.RegionSize); + LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info)); + Inc(LI_I); + end; + end; + + sgVMDump.RowCount := LI_I; + end; + + + procedure UpdateFastMM4Data; + var + LInd: Integer; + LU_StateLength: Cardinal; + LPrevSBState, LSBState: ^TSmallBlockTypeState; + + procedure UpdateBlockStatistics(c, r, current, prev: Integer); + var + s : string; + begin + s := IntToStr(current); + if current > prev then + s := s + ' (+' + IntToStr(current - prev) + ')' + else if current < prev then + s := s + ' (-' + IntToStr(prev - current) + ')'; + sgBlockStatistics.Cells[c, r] := s; + sgBlockStatistics.Objects[c, r] := Pointer(current - prev); + end; + + begin + LU_StateLength := Length(FMemoryManagerState.SmallBlockTypeStates); + {Set up the row count} + sgBlockStatistics.RowCount := LU_StateLength + 4; + sgBlockStatistics.Cells[0, LU_StateLength + 1] := 'Medium Blocks'; + sgBlockStatistics.Cells[0, LU_StateLength + 2] := 'Large Blocks'; + sgBlockStatistics.Cells[0, LU_StateLength + 3] := 'Overall'; + for LInd := 0 to High(FMemoryManagerState.SmallBlockTypeStates) do + begin + sgBlockStatistics.Cells[0, LInd + 1] := + IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].InternalBlockSize) + + '(' + IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize) + ')'; + end; + {Set the texts inside the results string grid} + for LInd := 0 to High(FMemoryManagerState.SmallBlockTypeStates) do + begin + LPrevSBState := @FPrevMemoryManagerState.SmallBlockTypeStates[LInd]; + LSBState := @FMemoryManagerState.SmallBlockTypeStates[LInd]; + UpdateBlockStatistics(1, LInd + 1, LSBState.AllocatedBlockCount, LPrevSBState.AllocatedBlockCount); + Inc(LTotalBlocks, LSBState.AllocatedBlockCount); + Inc(LPrevTotalBlocks, LPrevSBState.AllocatedBlockCount); + LAllocatedSize := LSBState.AllocatedBlockCount * LSBState.UseableBlockSize; + LPrevAllocatedSize := LPrevSBState.AllocatedBlockCount * LPrevSBState.UseableBlockSize; + UpdateBlockStatistics(2, LInd + 1, LAllocatedSize, LPrevAllocatedSize); + Inc(LTotalAllocated, LAllocatedSize); + Inc(LPrevTotalAllocated, LPrevAllocatedSize); + UpdateBlockStatistics(3, LInd + 1, LSBState.ReservedAddressSpace, LPrevSBState.ReservedAddressSpace); + Inc(LTotalReserved, LSBState.ReservedAddressSpace); + Inc(LPrevTotalReserved, LPrevSBState.ReservedAddressSpace); + if LSBState.ReservedAddressSpace > 0 then + sgBlockStatistics.Cells[4, LInd + 1] := FormatFloat('0.##%', LAllocatedSize / LSBState.ReservedAddressSpace * 100) + else + sgBlockStatistics.Cells[4, LInd + 1] := 'N/A'; + end; + {-----------Medium blocks---------} + LInd := length(FMemoryManagerState.SmallBlockTypeStates) + 1; + UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedMediumBlockCount, FPrevMemoryManagerState.AllocatedMediumBlockCount); + Inc(LTotalBlocks, FMemoryManagerState.AllocatedMediumBlockCount); + Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedMediumBlockCount); + UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedMediumBlockSize, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize); + Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedMediumBlockSize); + Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize); + UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedMediumBlockAddressSpace, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace); + Inc(LTotalReserved, FMemoryManagerState.ReservedMediumBlockAddressSpace); + Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace); + if FMemoryManagerState.ReservedMediumBlockAddressSpace > 0 then + sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedMediumBlockSize / FMemoryManagerState.ReservedMediumBlockAddressSpace * 100) + else + sgBlockStatistics.Cells[4, LInd] := 'N/A'; + {----------Large blocks----------} + LInd := Length(FMemoryManagerState.SmallBlockTypeStates) + 2; + UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedLargeBlockCount, FPrevMemoryManagerState.AllocatedLargeBlockCount); + Inc(LTotalBlocks, FMemoryManagerState.AllocatedLargeBlockCount); + Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedLargeBlockCount); + UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedLargeBlockSize, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize); + Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedLargeBlockSize); + Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize); + UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedLargeBlockAddressSpace, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace); + Inc(LTotalReserved, FMemoryManagerState.ReservedLargeBlockAddressSpace); + Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace); + if FMemoryManagerState.ReservedLargeBlockAddressSpace > 0 then + sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedLargeBlockSize / FMemoryManagerState.ReservedLargeBlockAddressSpace * 100) + else + sgBlockStatistics.Cells[4, LInd] := 'N/A'; + {-----------Overall--------------} + LInd := Length(FMemoryManagerState.SmallBlockTypeStates) + 3; + UpdateBlockStatistics(1, Lind, LTotalBlocks, LPrevTotalBlocks); + UpdateBlockStatistics(2, Lind, LTotalAllocated, LPrevTotalAllocated); + UpdateBlockStatistics(3, Lind, LTotalReserved, LPrevTotalReserved); + if LTotalReserved > 0 then + sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', LTotalAllocated / LTotalReserved * 100) + else + sgBlockStatistics.Cells[4, LInd] := 'N/A'; + end; + + procedure UpdateStatisticsData; + + function LocSort(P1, P2: Pointer): Integer; + begin + if Cardinal(P1) = Cardinal(P2) then + Result := 0 + else + begin + if Cardinal(P1) > Cardinal(P2) then + Result := -1 + else + Result := 1; + end; + end; + + const + CI_MaxFreeBlocksList = 9; + + var + LR_SystemInfo: TSystemInfo; + LR_GlobalMemoryStatus: TMemoryStatus; + LR_GlobalMemoryStatusEx: TMemoryStatusEx; + LR_ProcessMemoryCounters: TProcessMemoryCounters; + LR_SysBaseInfo: TSystem_Basic_Information; + LU_MinQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend}; + LU_MaxQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend}; + LI_I: Integer; + LI_Max: Integer; + begin + mVMStatistics.Lines.BeginUpdate; + try + mVMStatistics.Clear; + + LU_MinQuota := 0; + LU_MaxQuota := 0; + + if Assigned(MP_GlobalMemoryStatusEx) then + begin + ZeroMemory(@LR_GlobalMemoryStatusEx, SizeOf(TMemoryStatusEx)); + LR_GlobalMemoryStatusEx.dwLength := SizeOf(TMemoryStatusEx); + + if not MP_GlobalMemoryStatusEx(LR_GlobalMemoryStatusEx) then + begin + mVMStatistics.Lines.Add('GlobalMemoryStatusEx err: ' + SysErrorMessage(GetLastError)); + end; + end + else + begin + LR_GlobalMemoryStatus.dwLength := SizeOf(TMemoryStatus); + GlobalMemoryStatus(LR_GlobalMemoryStatus); + end; + + LP_FreeVMList.Sort(@LocSort); + + GetProcessWorkingSetSize(GetCurrentProcess, LU_MinQuota, LU_MaxQuota); + GetSystemInfo(LR_SystemInfo); + + with mVMStatistics.Lines do + begin + Add('System Info:'); + Add('------------'); + + Add('Processor Count = ' + IntToStr(LR_SystemInfo.dwNumberOfProcessors)); + Add('Allocation Granularity = ' + IntToStr(LR_SystemInfo.dwAllocationGranularity)); + + if Assigned(MP_GlobalMemoryStatusEx) then + begin + with LR_GlobalMemoryStatusEx do + begin + Add('Available Physical Memory = ' + Int64ToKStringFormatted(ullAvailPhys)); + Add('Total Physical Memory = ' + Int64ToKStringFormatted(ullTotalPhys)); + Add('Available Virtual Memory = ' + Int64ToKStringFormatted(ullAvailVirtual)); + Add('Total Virtual Memory = ' + Int64ToKStringFormatted(ullTotalVirtual)); + Add('Total Virtual Extended Memory = ' + Int64ToKStringFormatted(ullAvailExtendedVirtual)); + end; + end + + else + begin + with LR_GlobalMemoryStatus do + begin + Add('Available Physical Memory = ' + CardinalToKStringFormatted(dwAvailPhys)); + Add('Total Physical Memory = ' + CardinalToKStringFormatted(dwTotalPhys)); + Add('Available Virtual Memory = ' + CardinalToKStringFormatted(dwAvailVirtual)); + Add('Total Virtual Memory = ' + CardinalToKStringFormatted(dwTotalVirtual)); + end; + end; + + if Assigned(MP_NtQuerySystemInformation) then + begin + if MP_NtQuerySystemInformation(SystemBasicInformation, @LR_SysBaseInfo, SizeOf(LR_SysBaseInfo), nil) = 0 then + begin + with LR_SysBaseInfo do begin + Add('Maximum Increment = ' + CardinalToKStringFormatted(uKeMaximumIncrement)); + Add('Page Size = ' + CardinalToKStringFormatted(uPageSize)); + Add('Number of Physical Pages = ' + CardinalToKStringFormatted(uMmNumberOfPhysicalPages)); + Add('Lowest Physical Page = ' + CardinalToStringFormatted(uMmLowestPhysicalPage)); + Add('Highest Physical Page = ' + CardinalToKStringFormatted(uMmHighestPhysicalPage)); + end; + end; + end; + + // same as GetProcessMemoryInfo & NtQuerySystemInformation (SystemBasicInformation + + // The working set is the amount of memory physically mapped to the process context at a given + // time. Memory in the paged pool is system memory that can be transferred to the paging file + // on disk (paged) when it is not being used. Memory in the nonpaged pool is system memory + // that cannot be paged to disk as long as the corresponding objects are allocated. The pagefile + // usage represents how much memory is set aside for the process in the system paging file. + // When memory usage is too high, the virtual memory manager pages selected memory to disk. + // When a thread needs a page that is not in memory, the memory manager reloads it from the + // paging file. + + + if GetProcessMemoryInfo(GetCurrentProcess, @LR_ProcessMemoryCounters, SizeOf(LR_ProcessMemoryCounters)) then + begin + with LR_ProcessMemoryCounters do + begin + Add('Page Fault Count = ' + CardinalToKStringFormatted(PageFaultCount)); + Add('Peak Working Set Size = ' + CardinalToKStringFormatted(PeakWorkingSetSize)); + Add('Working Set Size = ' + CardinalToKStringFormatted(WorkingSetSize)); + Add('Quota Peak Paged Pool Usage = ' + CardinalToKStringFormatted(QuotaPeakPagedPoolUsage)); + Add('Quota Paged Pool Usage = ' + CardinalToStringFormatted(QuotaPagedPoolUsage)); + Add('Quota Peak Non-Paged Pool Usage = ' + CardinalToStringFormatted(QuotaPeakNonPagedPoolUsage)); + Add('Quota Non-Paged Pool Usage = ' + CardinalToStringFormatted(QuotaNonPagedPoolUsage)); + Add('Pagefile Usage = ' + CardinalToKStringFormatted(PagefileUsage)); + Add('Peak Pagefile Usage = ' + CardinalToKStringFormatted(PeakPagefileUsage)); + end; + end; + + Add(''); + Add('Process Info: PID (' + IntToStr(GetCurrentProcessId) + ')'); + Add('------------------------'); + Add('Minimum Address = ' + CardinalToStringFormatted(Cardinal(LR_SystemInfo.lpMinimumApplicationAddress))); + Add('Maximum VM Address = ' + CardinalToKStringFormatted(Cardinal(LR_SystemInfo.lpMaximumApplicationAddress))); + Add('Page Protection & Commit Size = ' + IntToStr(LR_SystemInfo.dWPageSize)); + Add(''); + Add('Quota info:'); + Add('-----------'); + Add('Minimum Quota = ' + CardinalToStringFormatted(LU_MinQuota)); + Add('Maximum Quota = ' + CardinalToStringFormatted(LU_MaxQuota)); + Add(''); + Add('VM Info:'); + Add('--------'); + Add('Total Free = ' + CardinalToKStringFormatted(LU_MEM_FREE)); + Add('Total Reserve = ' + CardinalToKStringFormatted(LU_MEM_RESERVE)); + Add('Total Commit = ' + CardinalToKStringFormatted(LU_MEM_COMMIT)); + + if LP_FreeVMList.Count > CI_MaxFreeBlocksList then + LI_Max := CI_MaxFreeBlocksList - 1 + else + LI_Max := LP_FreeVMList.Count - 1; + + for LI_I := 0 to LI_Max do + begin + Add('Largest Free Block ' + IntToStr(LI_I + 1) + '. = ' + CardinalToKStringFormatted(Cardinal(LP_FreeVMList.List[LI_I]))); + end; + + Add(''); + Add('FastMM4 Info:'); + Add('-------------'); + Add('Total Blocks = ' + CardinalToStringFormatted(LTotalBlocks)); + Add('Total Allocated = ' + CardinalToStringFormatted(LTotalAllocated)); + Add('Total Reserved = ' + CardinalToStringFormatted(LTotalReserved)); + end; + + finally + mVMStatistics.Lines.EndUpdate; + end; + end; + +var + Save_Cursor: TCursor; +begin + if SizeOf(TMemoryMap) <> SizeOf(TMemoryMapEx) then + begin + Showmessage('Internal implementation error'); + Exit; + end; + + LU_MEM_FREE := 0; + LU_MEM_COMMIT := 0; + LU_MEM_RESERVE := 0; + + LTotalBlocks := 0; + LTotalAllocated := 0; + LTotalReserved := 0; + + LPrevTotalBlocks := 0; + LPrevTotalAllocated := 0; + LPrevTotalReserved := 0; + + // Set hourglass cursor + Save_Cursor := Screen.Cursor; + Screen.Cursor := crHourGlass; + LP_FreeVMList := TList.Create; + try + // retrieve FastMM4 info + + GetMemoryManagerState(FMemoryManagerState); + GetMemoryMap(TMemoryMap(FMemoryMapEx)); + + // Update FastMM4 Graph with EXE & DLL locations + UpdateVMGraph(FMemoryMapEx); + + // VM dump + UpdateVMDump; + + // FastMM4 data + UpdateFastMM4Data; + + // General Information + UpdateStatisticsData; + + // Screen updates + dgMemoryMap.Invalidate; + + FPrevMemoryManagerState := FMemoryManagerState; + finally + FreeAndNil(LP_FreeVMList); + Screen.Cursor := Save_Cursor; + end; +end; + +procedure TfFastMMUsageTracker.sgBlockStatisticsDrawCell(Sender: TObject; + ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); +var + d: integer; + y: integer; + s: string; + LOldColour, LColour: TColor; +begin + d := Integer(sgBlockStatistics.Objects[ACol, ARow]); + if d <> 0 then + begin + LOldColour := sgBlockStatistics.Canvas.Brush.Color; + if d < 0 then + LColour := clLime + else + LColour := clRed; + sgBlockStatistics.Canvas.Brush.Color := LColour; + sgBlockStatistics.Canvas.Font.Color := clWindowText; + s := sgBlockStatistics.Cells[ACol, ARow]; + y := sgBlockStatistics.Canvas.TextHeight(s); + y := ((Rect.Bottom - Rect.Top) - y) div 2; + sgBlockStatistics.Canvas.TextRect(Rect, Rect.Left + 2, Rect.top + y, s); + sgBlockStatistics.Canvas.Brush.Color := LOldColour; + end; +end; + +procedure TfFastMMUsageTracker.tTimerTimer(Sender: TObject); +begin + tTimer.Enabled := False; + try + RefreshSnapShot; + finally + tTimer.Enabled := True; + end; +end; + +procedure TfFastMMUsageTracker.bCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TfFastMMUsageTracker.dgMemoryMapDrawCell(Sender: TObject; ACol, + ARow: Integer; Rect: TRect; State: TGridDrawState); +var + LChunkIndex: integer; + LChunkColour: TColor; +begin + {Get the chunk index} + LChunkIndex := ARow * dgMemoryMap.ColCount + ACol; + + {Get the correct colour} + case FMemoryMapEx[LChunkIndex] of + + csExAllocated: + begin + LChunkColour := $9090FF; + end; + + csExReserved: + begin + LChunkColour := $90F090; + end; + + csExSysAllocated: + begin + LChunkColour := $707070; + end; + + csExSysExe: + begin + LChunkColour := clRed; + end; + + csExSysDLL: + begin + LChunkColour := clBlue; + end; + + csExSysReserved: + begin + LChunkColour := $C0C0C0; + end + + else + begin + {ExUnallocated} + LChunkColour := $FFFFFF; + end; + end; + + {Draw the chunk background} + dgMemoryMap.Canvas.Brush.Color := LChunkColour; + + if State = [] then + dgMemoryMap.Canvas.FillRect(Rect) + else + dgMemoryMap.Canvas.Rectangle(Rect); +end; + +procedure TfFastMMUsageTracker.dgMemoryMapSelectCell(Sender: TObject; ACol, + ARow: Integer; var CanSelect: Boolean); +var + LChunkIndex: Cardinal; + LMBI: TMemoryBasicInformation; + LA_Char: array[0..MAX_PATH] of char; +begin + eDLLName.Text := ''; + LChunkIndex := ARow * dgMemoryMap.ColCount + ACol; + eAddress.Text := Format('$%0.8x', [LChunkIndex shl 16]); + + case FMemoryMapEx[LChunkIndex] of + + csExAllocated: + begin + eState.Text := 'FastMM Allocated'; + end; + + csExReserved: + begin + eState.Text := 'FastMM Reserved'; + end; + + csExSysAllocated: + begin + eState.Text := 'System Allocated'; + end; + + csExSysExe: + begin + eState.Text := 'System Exe'; + VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI)); + if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then + begin + eDLLName.Text := LA_Char; + end; + end; + + csExSysDLL: + begin + eState.Text := 'System/User DLL'; + VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI)); + if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then + begin + eDLLName.Text := LA_Char; + end; + end; + + csExSysReserved: + begin + eState.Text := 'System Reserved'; + end + + else + begin + {ExUnallocated} + eState.Text := 'Free'; + end; + end; +end; + +procedure TfFastMMUsageTracker.bUpdateClick(Sender: TObject); +begin + RefreshSnapShot; +end; + +procedure TfFastMMUsageTracker.ChkAutoUpdateClick(Sender: TObject); +begin + tTimer.Enabled := ChkAutoUpdate.Checked; +end; + +procedure TfFastMMUsageTracker.ChkSmallGraphClick(Sender: TObject); +begin + UpdateGraphMetrics; + dgMemoryMap.Invalidate; + dgMemoryMap.SetFocus; +end; + +procedure TfFastMMUsageTracker.sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if (Button = mbLeft) and (Shift = [ssLeft]) then + begin + (Sender as TStringgrid).MouseToCell(X, Y, OR_VMDumpDownCell.X, OR_VMDumpDownCell.Y); + end + else + begin + OR_VMDumpDownCell.X := 0; + OR_VMDumpDownCell.Y := 0; + end; +end; + +procedure TfFastMMUsageTracker.sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + p: TGridCoord; + LGrid: TStringgrid; +begin + LGrid := Sender as TStringGrid; + if (Button = mbLeft) and (Shift = []) then + begin + LGrid.MouseToCell(X, Y, p.X, p.Y); + if CompareMem(@p, @OR_VMDumpDownCell, sizeof(p)) + and (p.Y < LGrid.FixedRows) + and (p.X >= LGrid.FixedCols) then + begin + HeaderClicked(LGrid, p); + end; + end; + OR_VMDumpDownCell.X := 0; + OR_VMDumpDownCell.Y := 0; +end; + +procedure TfFastMMUsageTracker.sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); +var + LGrid: TStringgrid; + LMarker: Char; +begin + LGrid := Sender as TStringgrid; + // paint the sort marker on header columns + if (ACol >= LGrid.FixedCols) and (aRow = 0) then + begin + if Assigned(LGrid.Objects[aCol, aRow]) then + begin + if Integer(LGrid.Objects[aCol, aRow]) > 0 then + LMarker := 't' // up wedge in Marlett font + else + LMarker := 'u'; // down wedge in Marlett font + with LGrid.canvas do + begin + Font.Name := 'Marlett'; + Font.Charset := SYMBOL_CHARSET; + Font.Size := 12; + TextOut(Rect.Right - TextWidth(LMarker), Rect.Top, LMarker); + Font := LGrid.font; + end; + end; + end; +end; + +procedure TfFastMMUsageTracker.siMM4AllocationCopyAlltoClipboardClick(Sender: TObject); +begin + CopyGridContentsToClipBoard(sgBlockStatistics); +end; + +procedure TfFastMMUsageTracker.miVMDumpCopyAlltoClipboardClick(Sender: TObject); +begin + CopyGridContentsToClipBoard(sgVMDump); +end; + +procedure TfFastMMUsageTracker.miGeneralInformationCopyAlltoClipboardClick(Sender: TObject); +begin + with mVMStatistics do + begin + Lines.BeginUpdate; + try + SelectAll; + CopyToClipboard; + SelStart := 0; + finally + Lines.EndUpdate; + end; + end; +end; + +procedure ModuleInit; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + MP_GlobalMemoryStatusEx := TP_GlobalMemoryStatusEx( + GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx')); + MP_NtQuerySystemInformation := TP_NtQuerySystemInformation( + GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQuerySystemInformation')); + end; +end; + +initialization + ModuleInit; + +end. diff --git a/vendor/kam_remake/src/ext/JsonDataObjects.pas b/vendor/kam_remake/src/ext/JsonDataObjects.pas new file mode 100644 index 0000000..111fdf4 --- /dev/null +++ b/vendor/kam_remake/src/ext/JsonDataObjects.pas @@ -0,0 +1,8391 @@ +(***************************************************************************** +The MIT License (MIT) + +Copyright (c) 2015-2016 Andreas Hausladen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +*****************************************************************************) + +{$A8,B-,C+,E-,F-,G+,H+,I+,J-,K-,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Z1} +{$WARN WIDECHAR_REDUCED OFF} // All sets only use ASCII chars (<=#127) and the compiler generates the >=#128 check itself +{$STRINGCHECKS OFF} // It only slows down Delphi strings, doesn't help C++Builder migration and is finally gone in XE+ +{$WARN SYMBOL_DEPRECATED OFF} // for StrLen/StrLComp +{$POINTERMATH ON} + +unit JsonDataObjects; + +{$IFDEF VER200} + // Delphi 2009's ErrorInsight parser uses the CompilerVersion's memory address instead of 20.0, failing all the + // IF CompilerVersion compiler directives + {$DEFINE CPUX86} +{$ELSE} + {$IF CompilerVersion >= 24.0} // XE3 or newer + {$LEGACYIFEND ON} + {$IF CompilerVersion >= 35.0} //11.0 + {$DEFINE USE_NATIVEINT} + {$IFEND} + {$IFEND} + {$IF CompilerVersion >= 23.0} + {$DEFINE HAS_UNIT_SCOPE} + {$DEFINE HAS_RETURN_ADDRESS} + {$IFEND} + {$IF CompilerVersion <= 22.0} // XE or older + {$DEFINE CPUX86} + {$IFEND} +{$ENDIF VER200} + +{$IFDEF NEXTGEN} + {$IF CompilerVersion >= 31.0} // 10.1 Berlin or newer + {$DEFINE SUPPORTS_UTF8STRING} // Delphi 10.1 Berlin supports UTF8String for mobile compilers + {$IFEND} +{$ELSE} + {$DEFINE SUPPORTS_UTF8STRING} +{$ENDIF} + +{$IFDEF CPUX64} + {$IFNDEF LINUX64} // Linux 64 compiler doesn't support ASM for x64 code => LLVM + {$DEFINE ASMSUPPORT} + {$ENDIF ~LINUX64} +{$ENDIF CPUX64} +{$IFDEF CPUX86} + {$DEFINE ASMSUPPORT} +{$ENDIF CPUX86} +{$IFDEF EXTERNALLINKER} // implicates LLVM + {$UNDEF ASMSUPPORT} +{$ENDIF EXTERNALLINKER} + +// Enables the progress callback feature +{$DEFINE SUPPORT_PROGRESS} + +// Sanity checks all array index accesses and raise an EListError exception. +{$DEFINE CHECK_ARRAY_INDEX} + +// JSON allows the slash to be escaped. This is only necessary if you plan to put the JSON string +// into a